Commit 50a958a6 authored by Julian Kranz's avatar Julian Kranz

Merge branch 'armtranslation' of versioncontrolseidl.in.tum.de:zenzl/gdsl-toolkit into lovis

parents 6c6c8849 9d9a7446
Pipeline #1407 passed with stage
in 2 minutes and 30 seconds
......@@ -92,6 +92,7 @@ set(FRONTEND_SRCS_COMMON
${GDSL_DIR}/rreil/forward-subst/forward-subst/substitute.ml
${GDSL_DIR}/rreil/forward-subst/forward-subst/substmap.ml
${GDSL_DIR}/rreil/forward-subst/forward-subst/simplify-expressions.ml
${GDSL_DIR}/rreil/fusion/fusion.ml
${GDSL_DIR}/rreil/rreil-cleanup.ml
${GDSL_DIR}/asm/asm.ml
${GDSL_DIR}/asm/asm-pretty.ml
......
......@@ -266,7 +266,8 @@ GDSL_RREIL = \
$(srcdir)/specifications/rreil/forward-subst/forward-subst/inline.ml \
$(srcdir)/specifications/rreil/forward-subst/forward-subst/substitute.ml \
$(srcdir)/specifications/rreil/forward-subst/forward-subst/substmap.ml \
$(srcdir)/specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml
$(srcdir)/specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml \
$(srcdir)/specifications/rreil/fusion/fusion.ml
if X86_RREIL
lib_LTLIBRARIES += libgdsl-x86-rreil.la
......
......@@ -32,7 +32,8 @@ GDSL_RREIL_HL = \
specifications/rreil/forward-subst/forward-subst/inline.ml \
specifications/rreil/forward-subst/forward-subst/substitute.ml \
specifications/rreil/forward-subst/forward-subst/substmap.ml \
specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml
specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml \
specifications/rreil/fusion/fusion.ml
GDSL_ASM_HL=specifications/asm/asm.ml specifications/asm/asm-pretty.ml specifications/asm/asm-cif.ml
......
......@@ -17,7 +17,7 @@ GDSLFLAGS=--maxIter=42
GDSL_BASIS_HL=specifications/basis/prelude.ml specifications/basis/bbtree.ml
GDSL_RREIL_HL=specifications/rreil/rreil.ml specifications/rreil/rreil-examples.ml specifications/rreil/rreil-cif.ml specifications/rreil/rreil-pretty.ml specifications/rreil/fmap.ml specifications/rreil/rreil-opt.ml specifications/rreil/rreil-translator.ml
GDSL_ASM_HL=specifications/asm/asm.ml specifications/asm/asm-pretty.ml specifications/asm/asm-cif.ml
GDSL_OPT_HL=specifications/rreil/rreil-liveness.ml specifications/rreil/rreil-forward-subst.ml specifications/rreil/forward-subst/delayed-forward-subst/inline.ml specifications/rreil/forward-subst/delayed-forward-subst/substitute.ml specifications/rreil/forward-subst/delayed-forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/inline.ml specifications/rreil/forward-subst/forward-subst/substitute.ml specifications/rreil/forward-subst/forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml specifications/rreil/rreil-cleanup.ml
GDSL_OPT_HL=specifications/rreil/rreil-liveness.ml specifications/rreil/rreil-forward-subst.ml specifications/rreil/forward-subst/delayed-forward-subst/inline.ml specifications/rreil/forward-subst/delayed-forward-subst/substitute.ml specifications/rreil/forward-subst/delayed-forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/inline.ml specifications/rreil/forward-subst/forward-subst/substitute.ml specifications/rreil/forward-subst/forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml specifications/rreil/fusion/fusion.ml specifications/rreil/rreil-cleanup.ml
GDSL_AVR_HL=specifications/avr/avr.ml specifications/avr/avr-traverse.ml specifications/avr/avr-pretty.ml specifications/avr/avr-asm.ml
GDSL_AVR_TRANS_HL=specifications/avr/avr-rreil-pretty.ml specifications/avr/avr-rreil-registermapping.ml specifications/avr/avr-rreil-translator.ml specifications/avr/avr-liveness.ml
......
......@@ -19,7 +19,7 @@ GDSL_BASIS_HL=specifications/basis/prelude.ml specifications/basis/bbtree.ml
#GDSL_RREIL_DECL_HL=specifications/rreil/rreil-decl.ml
GDSL_ASM_HL=specifications/asm/asm.ml specifications/asm/asm-pretty.ml specifications/asm/asm-cif.ml
GDSL_RREIL_HL=specifications/rreil/rreil.ml specifications/rreil/rreil-examples.ml specifications/rreil/rreil-cif.ml specifications/rreil/rreil-pretty.ml specifications/rreil/fmap.ml specifications/rreil/rreil-opt.ml specifications/rreil/rreil-translator.ml
GDSL_OPT_HL=specifications/rreil/rreil-liveness.ml specifications/rreil/rreil-forward-subst.ml specifications/rreil/forward-subst/delayed-forward-subst/inline.ml specifications/rreil/forward-subst/delayed-forward-subst/substitute.ml specifications/rreil/forward-subst/delayed-forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/inline.ml specifications/rreil/forward-subst/forward-subst/substitute.ml specifications/rreil/forward-subst/forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml specifications/rreil/rreil-cleanup.ml
GDSL_OPT_HL=specifications/rreil/rreil-liveness.ml specifications/rreil/rreil-forward-subst.ml specifications/rreil/forward-subst/delayed-forward-subst/inline.ml specifications/rreil/forward-subst/delayed-forward-subst/substitute.ml specifications/rreil/forward-subst/delayed-forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/inline.ml specifications/rreil/forward-subst/forward-subst/substitute.ml specifications/rreil/forward-subst/forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml specifications/rreil/fusion/fusion.ml specifications/rreil/rreil-cleanup.ml
GDSL_MIPS_HL_R5=specifications/mips/mips_r5.ml specifications/mips/mips-pretty_r5.ml specifications/mips/mips-rreil-translator_r5.ml specifications/mips/mips-asm_r5.ml specifications/mips/mips-traverse_r5.ml
GDSL_MIPS_HL_R6=specifications/mips/mips_r6.ml specifications/mips/mips-pretty_r6.ml specifications/mips/mips-rreil-translator_r6.ml specifications/mips/mips-asm_r6.ml specifications/mips/mips-traverse_r6.ml
......
......@@ -19,7 +19,7 @@ GDSL_BASIS_HL=specifications/basis/prelude.ml specifications/basis/bbtree.ml spe
#GDSL_RREIL_EMIT_HL=specifications/rreil/rreil-emit.ml specifications/rreil/rreil-examples.ml specifications/rreil/rreil-cif.ml specifications/rreil/rreil-pretty.ml specifications/rreil/fmap.ml
#GDSL_RREIL_DECL_HL=specifications/rreil/rreil-decl.ml
GDSL_RREIL_HL=specifications/rreil/rreil.ml specifications/rreil/rreil-examples.ml specifications/rreil/rreil-cif.ml specifications/rreil/rreil-pretty.ml specifications/rreil/fmap.ml specifications/rreil/rreil-opt.ml specifications/rreil/rreil-translator.ml
GDSL_OPT_HL=specifications/rreil/rreil-liveness.ml specifications/rreil/rreil-forward-subst.ml specifications/rreil/forward-subst/delayed-forward-subst/inline.ml specifications/rreil/forward-subst/delayed-forward-subst/substitute.ml specifications/rreil/forward-subst/delayed-forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/inline.ml specifications/rreil/forward-subst/forward-subst/substitute.ml specifications/rreil/forward-subst/forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml specifications/rreil/rreil-cleanup.ml
GDSL_OPT_HL=specifications/rreil/rreil-liveness.ml specifications/rreil/rreil-forward-subst.ml specifications/rreil/forward-subst/delayed-forward-subst/inline.ml specifications/rreil/forward-subst/delayed-forward-subst/substitute.ml specifications/rreil/forward-subst/delayed-forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/inline.ml specifications/rreil/forward-subst/forward-subst/substitute.ml specifications/rreil/forward-subst/forward-subst/substmap.ml specifications/rreil/forward-subst/forward-subst/simplify-expressions.ml specifications/rreil/fusion/fusion.ml specifications/rreil/rreil-cleanup.ml
GDSL_X86_HL=specifications/x86/x86.ml specifications/x86/x86-equals.ml specifications/x86/x86-traverse.ml specifications/x86/x86-pretty.ml specifications/x86/x86-asm.ml specifications/x86/x86-semantics-mapping.ml specifications/x86/x86-semantics-mapping-pretty.ml
GDSL_X86_TRANS_HL=specifications/x86/x86-rreil-translator.ml specifications/x86/x86-rreil-translator-a-l.ml specifications/x86/x86-rreil-translator-m-z.ml
......
......@@ -160,6 +160,7 @@ set GDSL_RREIL=%GDSL_RREIL% specifications/rreil/forward-subst/inline.ml
set GDSL_RREIL=%GDSL_RREIL% specifications/rreil/forward-subst/substitute.ml
set GDSL_RREIL=%GDSL_RREIL% specifications/rreil/forward-subst/substmap.ml
set GDSL_RREIL=%GDSL_RREIL% specifications/rreil/forward-subst/simplify-expressions.ml
set GDSL_RREIL=%GDSL_RREIL% specifications/rreil/fusion/fusion.ml
set GDSL_ARM7=
set GDSL_ARM7=%GDSL_ARM7% specifications/arm7/arm7.ml
......
......@@ -26,12 +26,12 @@ end
# The instruction types for pretty printing
type instruction_class =
NONE
| BR of unop # branch/jump
| DP of dp # standard data processing
| LSS of ls # load/store single operands
| LSM of lsm # load/store multiple operands
| ML of mul # multiply
| MLL of mull # mulitply long
| BR of unop # branch/jump (redundant, might get removed)
| DP of unbitTernop # standard data processing
| LSS of ternbitTernop # load/store single operands
| LSM of unbitBinop # load/store multiple operands
| ML of unbitQuaternop # multiply
| MLL of unbitQuaternop # mulitply long (redundant, might get removed)
| NULLOP of nullop
| UNOP of unop
| BINOP of binop
......@@ -130,37 +130,37 @@ val show/target label ip =
# Show data-processing instructions
val show/dp insn insn_type = case insn_type of
CMN i: show/cond insn.cond +++ "\\t" +++ show/op insn.rn +++ "," -++ show/op insn.opnd2
| CMP i: show/cond insn.cond +++ "\\t" +++ show/op insn.rn +++ "," -++ show/op insn.opnd2
| MOV i: show/s insn +++ show/cond insn.cond +++ "\\t" +++ show/op insn.rd +++ "," -++ show/op insn.opnd2
| MVN i: show/s insn +++ show/cond insn.cond +++ "\\t" +++ show/op insn.rd +++ "," -++ show/op insn.opnd2
| TEQ i: show/cond insn.cond +++ "\\t" +++ show/op insn.rn +++ "," -++ show/op insn.opnd2
| TST i: show/cond insn.cond +++ "\\t" +++ show/op insn.rn +++ "," -++ show/op insn.opnd2
| _: show/s insn +++ show/cond insn.cond +++ "\\t" +++ show/op insn.rd +++ "," -++ show/op insn.rn +++ "," -++ show/op insn.opnd2
CMN i: show/cond insn.cond +++ "\\t" +++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd3
| CMP i: show/cond insn.cond +++ "\\t" +++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd3
| MOV i: show/s insn +++ show/cond insn.cond +++ "\\t" +++ show/op insn.opnd2 +++ "," -++ show/op insn.opnd3
| MVN i: show/s insn +++ show/cond insn.cond +++ "\\t" +++ show/op insn.opnd2 +++ "," -++ show/op insn.opnd3
| TEQ i: show/cond insn.cond +++ "\\t" +++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd3
| TST i: show/cond insn.cond +++ "\\t" +++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd3
| _: show/s insn +++ show/cond insn.cond +++ "\\t" +++ show/op insn.opnd2 +++ "," -++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd3
end
val show/s insn = if insn.setflags then "S" else ""
val show/s insn = if insn.o then "S" else ""
# Show load/store (single) instructions
val show/lss insn = show/cond insn.cond +++ "\\t" +++ show/op insn.rt +++ ", [" +++ show/op insn.rn +++ "," -++ show/sign insn +++ show/op insn.offset +++ "]"
val show/lss insn = show/cond insn.cond +++ "\\t" +++ show/op insn.opnd2 +++ ", [" +++ show/op insn.opnd1 +++ "," -++ show/sign insn +++ show/op insn.opnd3 +++ "]"
val show/sign insn = if insn.u then "" else "-"
val show/wback insn = if insn.w then "!" else ""
val show/sign insn = if insn.o2 then "" else "-"
val show/wback insn = if insn.o3 then "!" else ""
# Show load/store (multiple) instructions
val show/lsm insn insn_type = show/cond insn.cond +++ "\\t" +++ (
case insn_type of
POP i: "{" +++ show/op insn.registers +++ "}"
| PUSH i: "{" +++ show/op insn.registers +++ "}"
| _: show/op insn.rn +++ ", {" +++ show/op insn.registers +++ "}"
POP i: "{" +++ show/op insn.opnd2 +++ "}"
| PUSH i: "{" +++ show/op insn.opnd2 +++ "}"
| _: show/op insn.opnd1 +++ ", {" +++ show/op insn.opnd2 +++ "}"
end
)
# Show multiplication instructions
val show/ml insn = show/s insn +++ show/cond insn.cond -++ show/op insn.rd +++ "," -++ show/op insn.rn +++ "," -++ show/op insn.rm +++ "," -++ show/op insn.ra
val show/ml insn = show/s insn +++ show/cond insn.cond -++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd2 +++ "," -++ show/op insn.opnd3 +++ "," -++ show/op insn.opnd4
# Show long multiplication instructions
val show/mll insn = show/s insn +++ show/cond insn.cond -++ show/op insn.rdlo +++ "," -++ show/op insn.rdhi +++ "," -++ show/op insn.rn +++ "," -++ show/op insn.rm
val show/mll insn = show/s insn +++ show/cond insn.cond -++ show/op insn.opnd1 +++ "," -++ show/op insn.opnd2 +++ "," -++ show/op insn.opnd3 +++ "," -++ show/op insn.opnd4
val show/cond cond = case cond of
EQ: "EQ"
......@@ -211,16 +211,22 @@ end
val show/op/immediate imm = "#" +++ (case imm of
IMMi i: show-int i
| IMM2 i: show-int (zx i)
| IMM3 i: show-int (zx i)
| IMM4 i: show-int (zx i)
| IMM5 i: show-int (zx i)
| IMM6 i: show-int (zx i)
| IMM8 i: show-int (zx i)
| IMM12 i: show-int (zx i)
| IMM16 i: "0x" +++ show-hex (zx i)
| IMM24 i: "0x" +++ show-hex (zx i)
| IMM32 i: "0x" +++ show-hex (zx i)
| IMM64 i: "0x" +++ show-hex (zx i)
| MODIMM i: show-int (armexpandimm i) +++ "\\t; #" +++ show-int (armexpandimm i) +++ " = imm: " +++ show-int (zx i.byte) +++ ", rotation: " +++ show-int (zx i.rot)
| _: "???"
end)
(*TODO: add vector case and according method*)
val show/op op = case op of
IMMEDIATE o: show/op/immediate o
| REGISTER o: show/op/register o
......@@ -237,5 +243,4 @@ val show/op/operandlist opndl =
OPNDL_NIL: ""
| _: ", "
end) +++ show/op/operandlist l.tl
end
end
\ No newline at end of file
......@@ -44,6 +44,22 @@ type sem_id =
| Sem_ISETSTATE
| Sem_ITSTATE
| Sem_ENDIANSTATE
| Sem_Q0
| Sem_Q1
| Sem_Q2
| Sem_Q3
| Sem_Q4
| Sem_Q5
| Sem_Q6
| Sem_Q7
| Sem_Q8
| Sem_Q9
| Sem_Q10
| Sem_Q11
| Sem_Q12
| Sem_Q13
| Sem_Q14
| Sem_Q15
val semantic-register-of r =
case r of
......@@ -64,3 +80,170 @@ val semantic-register-of r =
| R14 : {id=Sem_LR, offset=0, size=32}
| R15 : {id=Sem_PC, offset=0, size=32}
end
### advanced SIMD and Floating-point register mapping [A2.6.2]
type extension-register =
Q0
| Q1
| Q2
| Q3
| Q4
| Q5
| Q6
| Q7
| Q8
| Q9
| Q10
| Q11
| Q12
| Q13
| Q14
| Q15
| D0
| D1
| D2
| D3
| D4
| D5
| D6
| D7
| D8
| D9
| D10
| D11
| D12
| D13
| D14
| D15
| D16
| D17
| D18
| D19
| D20
| D21
| D22
| D23
| D24
| D25
| D26
| D27
| D28
| D29
| D30
| D31
| S0
| S1
| S2
| S3
| S4
| S5
| S6
| S7
| S8
| S9
| S10
| S11
| S12
| S13
| S14
| S15
| S16
| S17
| S18
| S19
| S20
| S21
| S22
| S23
| S24
| S25
| S26
| S27
| S28
| S29
| S30
| S31
val semantic-ext-register-of r = case r of
Q0 : {id=Sem_Q0, offset=0, size=128}
| Q1 : {id=Sem_Q1, offset=0, size=128}
| Q2 : {id=Sem_Q2, offset=0, size=128}
| Q3 : {id=Sem_Q3, offset=0, size=128}
| Q4 : {id=Sem_Q4, offset=0, size=128}
| Q5 : {id=Sem_Q5, offset=0, size=128}
| Q6 : {id=Sem_Q6, offset=0, size=128}
| Q7 : {id=Sem_Q7, offset=0, size=128}
| Q8 : {id=Sem_Q8, offset=0, size=128}
| Q9 : {id=Sem_Q9, offset=0, size=128}
| Q10 : {id=Sem_Q10, offset=0, size=128}
| Q11 : {id=Sem_Q11, offset=0, size=128}
| Q12 : {id=Sem_Q12, offset=0, size=128}
| Q13 : {id=Sem_Q13, offset=0, size=128}
| Q14 : {id=Sem_Q14, offset=0, size=128}
| Q15 : {id=Sem_Q15, offset=0, size=128}
| D0 : {id=Sem_Q0, offset=0, size=64}
| D1 : {id=Sem_Q0, offset=64, size=64}
| D2 : {id=Sem_Q1, offset=0, size=64}
| D3 : {id=Sem_Q1, offset=64, size=64}
| D4 : {id=Sem_Q2, offset=0, size=64}
| D5 : {id=Sem_Q2, offset=64, size=64}
| D6 : {id=Sem_Q3, offset=0, size=64}
| D7 : {id=Sem_Q3, offset=64, size=64}
| D8 : {id=Sem_Q4, offset=0, size=64}
| D9 : {id=Sem_Q4, offset=64, size=64}
| D10 : {id=Sem_Q5, offset=0, size=64}
| D11 : {id=Sem_Q5, offset=64, size=64}
| D12 : {id=Sem_Q6, offset=0, size=64}
| D13 : {id=Sem_Q6, offset=64, size=64}
| D14 : {id=Sem_Q7, offset=0, size=64}
| D15 : {id=Sem_Q7, offset=64, size=64}
| D16 : {id=Sem_Q8, offset=0, size=64}
| D17 : {id=Sem_Q8, offset=64, size=64}
| D18 : {id=Sem_Q9, offset=0, size=64}
| D19 : {id=Sem_Q9, offset=64, size=64}
| D20 : {id=Sem_Q10, offset=0, size=64}
| D21 : {id=Sem_Q10, offset=64, size=64}
| D22 : {id=Sem_Q11, offset=0, size=64}
| D23 : {id=Sem_Q11, offset=64, size=64}
| D24 : {id=Sem_Q12, offset=0, size=64}
| D25 : {id=Sem_Q12, offset=64, size=64}
| D26 : {id=Sem_Q13, offset=0, size=64}
| D27 : {id=Sem_Q13, offset=64, size=64}
| D28 : {id=Sem_Q14, offset=0, size=64}
| D29 : {id=Sem_Q14, offset=64, size=64}
| D30 : {id=Sem_Q15, offset=0, size=64}
| D31 : {id=Sem_Q15, offset=64, size=64}
| S0 : {id=Sem_Q0, offset=0, size=32}
| S1 : {id=Sem_Q0, offset=32, size=32}
| S2 : {id=Sem_Q0, offset=64, size=32}
| S3 : {id=Sem_Q0, offset=96, size=32}
| S4 : {id=Sem_Q1, offset=0, size=32}
| S5 : {id=Sem_Q1, offset=32, size=32}
| S6 : {id=Sem_Q1, offset=64, size=32}
| S7 : {id=Sem_Q1, offset=96, size=32}
| S8 : {id=Sem_Q2, offset=0, size=32}
| S9 : {id=Sem_Q2, offset=32, size=32}
| S10 : {id=Sem_Q2, offset=64, size=32}
| S11 : {id=Sem_Q2, offset=96, size=32}
| S12 : {id=Sem_Q3, offset=0, size=32}
| S13 : {id=Sem_Q3, offset=32, size=32}
| S14 : {id=Sem_Q3, offset=64, size=32}
| S15 : {id=Sem_Q3, offset=96, size=32}
| S16 : {id=Sem_Q4, offset=0, size=32}
| S17 : {id=Sem_Q4, offset=32, size=32}
| S18 : {id=Sem_Q4, offset=64, size=32}
| S19 : {id=Sem_Q4, offset=96, size=32}
| S20 : {id=Sem_Q5, offset=0, size=32}
| S21 : {id=Sem_Q5, offset=32, size=32}
| S22 : {id=Sem_Q5, offset=64, size=32}
| S23 : {id=Sem_Q5, offset=96, size=32}
| S24 : {id=Sem_Q6, offset=0, size=32}
| S25 : {id=Sem_Q6, offset=32, size=32}
| S26 : {id=Sem_Q6, offset=64, size=32}
| S27 : {id=Sem_Q6, offset=96, size=32}
| S28 : {id=Sem_Q7, offset=0, size=32}
| S29 : {id=Sem_Q7, offset=32, size=32}
| S30 : {id=Sem_Q7, offset=64, size=32}
| S31 : {id=Sem_Q7, offset=96, size=32}
end
\ No newline at end of file
This diff is collapsed.
#
# procedure fuse-bodies takes a sem_stmt_list and returns a sem_stmt_list
# with fused bodies of conditions.
#
# most simple implementation
#
# val fuse-bodies stmts = return stmts
#
# simple example:
#
# if a then b else c;
# if a then d else e;
#
# --> if a then do b; d; end else do c; e; end
#
# do a fusion of ITEs on a list of statements
#
# Parameter:
# list of statements
#
# Returns:
# list of statements with inlined right hand sides
#
export fuse-bodies : (sem_stmt_list)-> S sem_stmt_list <{} => {}>
val fuse-bodies stmts = case stmts of
SEM_CONS s : case s.hd of
SEM_ITE t : do
fusable <- return (SEM_CONS {hd=s.hd, tl=SEM_NIL});
fusable <- return (get-fusable t.cond fusable s.tl);
head <- return (fuse-ite-list fusable);
tail <- return (get-remainder fusable stmts);
continued <- fuse-bodies tail;
return (SEM_CONS {hd=head, tl=continued})
end
| _ : do
continued <- fuse-bodies s.tl;
return (SEM_CONS {hd=s.hd, tl=continued})
end
end
| SEM_NIL : return SEM_NIL
end
val get-fusable c fusable stmts = case stmts of
SEM_CONS s : case s.hd of
SEM_ITE t : if (equal t.cond c) then get-fusable c (append fusable (SEM_CONS {hd=s.hd, tl=SEM_NIL})) s.tl else fusable
| _ : fusable
end
| SEM_NIL : fusable
end
val fuse-ite-list fusable = case fusable of
SEM_CONS f : fuse-ite-list-ht f.hd f.tl
end
val fuse-ite-list-ht head tail = case tail of
SEM_CONS tt : case tt.hd of
SEM_ITE t : case head of
SEM_ITE h : fuse-ite-list-ht (SEM_ITE {cond=h.cond,
then_branch=(append h.then_branch t.then_branch),
else_branch=(append h.else_branch t.else_branch)}) tt.tl
end
end
| SEM_NIL : head
end
val get-remainder fusable stmts = case fusable of
SEM_CONS f : case stmts of
SEM_CONS s : get-remainder f.tl s.tl
| SEM_NIL : stmts
end
| SEM_NIL : stmts
end
val append a b = case a of
SEM_CONS s : case b of
SEM_CONS t : case s.tl of
SEM_CONS u : SEM_CONS {hd=s.hd, tl=(append s.tl b)}
| SEM_NIL : SEM_CONS {hd=s.hd, tl=b}
end
| SEM_NIL : a
end
| SEM_NIL : b
end
val equal a b = case a of
SEM_SEXPR_LIN l : case b of
SEM_SEXPR_LIN ll : lin-eq? l ll
| _ : '0'
end
| SEM_SEXPR_CMP cm : case b of
SEM_SEXPR_CMP cmcm : if cmp-eq? cm.cmp cmcm.cmp then cm.size === cmcm.size else '0'
| _ : '0'
end
| SEM_SEXPR_ARB : case b of
SEM_SEXPR_ARB : '1'
| _ : '0'
end
end
val cmp-eq? cmp1 cmp2 = case cmp1 of
SEM_CMPEQ a : case cmp2 of
SEM_CMPEQ b : if lin-eq? a.opnd1 b.opnd1 then lin-eq? a.opnd2 b.opnd2 else '0'
| _ : '0'
end
| SEM_CMPNEQ a : case cmp2 of
SEM_CMPNEQ b : if lin-eq? a.opnd1 b.opnd1 then lin-eq? a.opnd2 b.opnd2 else '0'
| _ : '0'
end
| SEM_CMPLES a : case cmp2 of
SEM_CMPLES b : if lin-eq? a.opnd1 b.opnd1 then lin-eq? a.opnd2 b.opnd2 else '0'
| _ : '0'
end
| SEM_CMPLEU a : case cmp2 of
SEM_CMPLEU b : if lin-eq? a.opnd1 b.opnd1 then lin-eq? a.opnd2 b.opnd2 else '0'
| _ : '0'
end
| SEM_CMPLTS a : case cmp2 of
SEM_CMPLTS b : if lin-eq? a.opnd1 b.opnd1 then lin-eq? a.opnd2 b.opnd2 else '0'
| _ : '0'
end
| SEM_CMPLTU a :case cmp2 of
SEM_CMPLTU b : if lin-eq? a.opnd1 b.opnd1 then lin-eq? a.opnd2 b.opnd2 else '0'
| _ : '0'
end
end
val lin-eq? lin1 lin2 = case lin1 of
SEM_LIN_VAR v : case lin2 of
SEM_LIN_VAR vv : if id-eq? v.id vv.id then v.offset === vv.offset else '0'
| _ : '0'
end
| SEM_LIN_IMM i : case lin2 of
SEM_LIN_IMM ii : i.const === ii.const
| _ : '0'
end
end
\ No newline at end of file
......@@ -37,7 +37,7 @@ type sem_preservation =
| SEM_PRESERVATION_BLOCK
| SEM_PRESERVATION_CONTEXT
val decode-translate-block-optimized-preserve config limit pres do-delayed-fsubst do-fsubst lv = case pres of
val decode-translate-block-optimized-preserve config limit pres do-delayed-fsubst do-fsubst do-fusion lv = case pres of
SEM_PRESERVATION_EVERYWHERE: do
translated <- decode-translate-block config limit;
clean <- cleanup translated;
......@@ -53,6 +53,7 @@ val decode-translate-block-optimized-preserve config limit pres do-delayed-fsubs
end else
return translated
;
translated <- fusion do-fusion translated;
clean <- cleanup translated;
return clean
end
......@@ -65,6 +66,7 @@ val decode-translate-block-optimized-preserve config limit pres do-delayed-fsubs
end else
return ($insns translated)
;
translated <- fusion do-fusion translated;
clean <- cleanup translated;
return clean
end
......@@ -83,6 +85,13 @@ val propagate do-delayed-fsubst do-fsubst translated =
forward-subsitution do-fsubst optimized
end
val fusion do-fusion translated = case do-fusion of
'1' : do
p <- fuse-bodies translated;
return p
end
| '0' : return translated
end
val delayed-forward-subsitution do-delayed-fsubst translated =
case do-delayed-fsubst of
......@@ -123,9 +132,9 @@ val decode-translate-block-optimized config limit opt-config = do
update @{insns=INSNS_NIL};
rreil <- case opt-config of
'dfs:1 fs:1 lv:1 000': decode-translate-block config limit
| 'dfs:1 fs:1 lv:1 001': decode-translate-block-optimized-preserve config limit SEM_PRESERVATION_EVERYWHERE dfs fs lv
| 'dfs:1 fs:1 lv:1 01.': decode-translate-block-optimized-preserve config limit SEM_PRESERVATION_BLOCK dfs fs lv
| 'dfs:1 fs:1 lv:1 1..': decode-translate-block-optimized-preserve config limit SEM_PRESERVATION_CONTEXT dfs fs lv
| 'dfs:1 fs:1 lv:1 001': decode-translate-block-optimized-preserve config limit SEM_PRESERVATION_EVERYWHERE dfs fs '1' lv
| 'dfs:1 fs:1 lv:1 01.': decode-translate-block-optimized-preserve config limit SEM_PRESERVATION_BLOCK dfs fs '1' lv
| 'dfs:1 fs:1 lv:1 1..': decode-translate-block-optimized-preserve config limit SEM_PRESERVATION_CONTEXT dfs fs '1' lv
end;
insns <- query $insns;
return {rreil=rreil, insns=insns}
......
......@@ -104,6 +104,7 @@ val at-offset v o = @{offset=o} v
val var x = SEM_LIN_VAR x
val varl sz x = @{size=sz}x
val lin-sum x y = SEM_LIN_ADD {opnd1=x, opnd2=y}
val lin-dif x y = SEM_LIN_SUB {opnd1=x, opnd2=y}
val address sz addr = {size=sz, address=addr}
val varl-from-var sz v = @{size=sz}v
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment