%%HP: T(3)A(D)F(.);
@ Saturn Disassembler package
@ by Kevin Pryor;
@ improvements by John Gilbert.
DIR
  DISR
    \<< HEX
      CASE DUP TYPE 10 ==
        THEN DUP 'ADDR' STO PKS
        END DUP TYPE 12 ==
        THEN ODMP
          IF DUP SIZE DUP 16 <
          THEN ADDR + PKS +
          ELSE DROP
          END
        END
      END \-> ob
      \<< ob DIS SWAP PCAD SWAP \-> code ob2
        \<< code ADDR B2S \->TAG ob2 ob SIZE ob2 SIZE - ADDR + 'ADDR' STO
          'ODMP' STO
        \>>
      \>>
    \>>
  DISJ
    \<< ADRJ DISR
    \>>
  PKS
    \<< "000000000000000" SWAP PEEK B2S + RVRS 1 16 SUB
    \>>
  DIS
    \<< HEX \-> m
      \<< m 2 1000 SUB {
        \<< O0
        \>>
        \<< O1
        \>>
        \<< "MOVE.1 " m 2 2 SUB + ",P" + CUT1
        \>>
        \<< m 2 2 SUB XTON \-> i
          \<< "MOVE.P" i 1 + R\->B B2S + " " + m 3 3 i + SUB RVRS + ",C" +
            i 2 + CUTX
          \>>
        \>>
        \<< "BRCS PC" m 2 3 SUB DUP
          CASE "20" ==
            THEN DROP2 "NOP3"
            END DUP "00" ==
            THEN DROP2 "RETCS"
            END RVRS 1 PCA +
          END CUT2
        \>>
        \<< "BRCC PC" m 2 3 SUB
          IF DUP "00" ==
          THEN DROP2 "RETCC"
          ELSE RVRS 1 PCA +
          END CUT2
        \>>
        \<< "JUMP.3 PC" m 2 4 SUB DUP
          CASE "300" ==
            THEN DROP2 "NOP4"
            END m 2 5 SUB "4000" ==
            THEN DROP2 "NOP5" CUT1
            END RVRS 1 PCA +
          END CUT3
        \>>
        \<< "CALL.3 PC" m 2 4 SUB RVRS 4 PCA + CUT3
        \>>
        \<< O8
        \>>
        \<< m
          IF m 2 2 SUB "8" <
          THEN OTT
          ELSE OZZ
          END CUT4
          IF DUP 1 2 SUB "BR" == m 4 5 SUB "00" == AND
          THEN DUP ",PC" POS 1 - 3 SWAP SUB "RET" SWAP +
          END
        \>>
        \<< m 2 2 SUB
          IF DUP "8" <
          THEN T2F m 3 3 SUB OKK
          ELSE XTON 8 - \->STR T2F m 3 3 SUB OPP
          END CUT2
        \>>
        \<< m 2 2 SUB
          IF DUP "8" <
          THEN T2F m 3 3 SUB OQQ
          ELSE XTON 8 - \->STR T2F m 3 3 SUB ORR
          END CUT2
        \>>
        \<< "A" m 2 2 SUB OKK CUT1
        \>>
        \<< "A" m 2 2 SUB OPP CUT1
        \>>
        \<< "A" m 2 2 SUB OQQ CUT1
        \>>
        \<< "A" m 2 2 SUB ORR CUT1
        \>> } m 1 1 SUB XTOM GET EVAL SWAP
      \>>
    \>>
  ADDR # 1FCCh
  ADRJ # 1FC6h
  ODMP "8576310857660084785285680C"
  PEEK
    \<< B\->R R\->B Code
    \>>
  RVRS @ [replaced with Derek Nickel's REV machine-code!  -jkh-]
    \<< \-> s
      \<< "" s SIZE 1
        FOR x s x x SUB + -1
        STEP
      \>>
    \>>
  S2B
    \<< "#" SWAP +STR\->
    \>>
  B2S
    \<< \->STR DUP SIZE1 - 3 SWAP SUB
    \>>
  PCA
    \<< \-> s n
      \<<
        IF s 1 1SUB "7" >
        THEN "-" 16s SIZE ^ s S2B - n- B2S +
        ELSE "+" sS2B n + B2S +
        END
      \>>
    \>>
  XTON
    \<< "#" SWAP +STR\-> B\->R
    \>>
  O8
    \<< \-> m
      \<< m 2 1000SUB {
        \<< O80
        \>>
        \<< O81
        \>>
        \<< "CLRB " m 2 2 SUB X2D + CUT1
        \>>
        \<< "BRBC " m 2 2 SUB X2D + ",PC" + m 3 4 SUB RVRS 3 PCA + CUT3
        \>>
        \<< "CLRB " m 2 2 SUB + ",ST" + CUT1
        \>>
        \<< "SETB " m 2 2 SUB + ",ST" + CUT1
        \>>
        \<< "BRBC " m 2 2 SUB + ",ST,PC" + m 3 4 SUB RVRS 3 PCA + CUT3
        \>>
        \<< "BRBS " m 2 2 SUB + ",ST,PC" + m 3 4 SUB RVRS 3 PCA + CUT3
        \>>
        \<< "BRNE.1 P," m 2 2 SUB + ",PC" + m 3 4 SUB RVRS 3 PCA + CUT3
        \>>
        \<< "BREQ.1 P," m 2 2 SUB + ",PC" + m 3 4 SUB RVRS 3 PCA + CUT3
        \>>
        \<< "8" m + OTT CUT3
        \>>
        \<< "8" m + OZZ CUT3
        \>>
        \<< "JUMP.4 PC" m 2 5 SUB RVRS 2 PCA + CUT4
        \>>
        \<< "JUMP.A " m 2 6 SUB RVRS DUP S2B 'ADRJ' STO + CUT5
        \>>
        \<< "CALL.4 PC" m 2 5 SUB RVRS 6 PCA + CUT4
        \>>
        \<< "CALL.A " m 2 6 SUB RVRS DUP S2B 'ADRJ' STO + CUT5
        \>> } m 1 1 SUB XTOM GET EVAL
        IF DUP 1 2 SUB "BR" == m 3 4 SUB "00" == AND
        THEN DUP ",PC" POS 1 - 3 SWAP SUB "RET" SWAP +
        END
      \>>
    \>>
  OZZ
    \<< \-> m
      \<< { "BRGT." "BRLT." "BRGE." "BRLE." } m 3 3 SUB XTON 4 / IP 1 + GET
        m 1 2 SUB TT2F + " " + m 3 3 SUB W2D + "," + m 3 3 SUB W2D2 + ",PC"
        + m 4 5 SUB RVRS 3 PCA +
      \>>
    \>>
  OTT
    \<< \-> m
      \<< { "BREQ." "BRNE." "BRZ." "BRNZ." } m 3 3 SUB XTON 4 / IP 1 + GET
        m 1 2 SUB TT2F + " " + m 3 3 SUB W2D +
        IF m 3 3 SUB DUP "8" <
        THEN W2D2 "," SWAP + +
        ELSE DROP
        END ",PC" + m 4 5 SUB RVRS 3 PCA +
      \>>
    \>>
  O808
    \<< \-> m
      \<< m 2 1000 SUB { "INTON"
        \<<
          IF m 2 2 SUB "0" ==
          THEN "RSI"
          ELSE ""
          END CUT1
        \>>
        \<< m 2 2 SUB STR\-> \-> i
          \<< "MOVE.P" i 1 + \->STR + " " + m 3 3 i + SUB RVRS + ",A" + i 2 +
            CUTX
          \>>
        \>> "BUSCB"
        \<< "CLRB " m 2 2 SUB + ",A" + CUT1
        \>>
        \<< "SETB " m 2 2 SUB + ",A" + CUT1
        \>>
        \<< "BRBC " m 2 2 SUB + ",A,PC" + m 3 4 SUB RVRS 5 PCA + CUT3
        \>>
        \<< "BRBS " m 2 2 SUB + ",A,PC" + m 3 4 SUB RVRS 5 PCA + CUT3
        \>>
        \<< "CLRB " m 2 2 SUB + ",C" + CUT1
        \>>
        \<< "SETB " m 2 2 SUB + ",C" + CUT1
        \>>
        \<< "BRBC " m 2 2 SUB + ",C,PC" + m 3 4 SUB RVRS 5 PCA + CUT3
        \>>
        \<< "BRBS " m 2 2 SUB + ",C,PC" + m 3 4 SUB RVRS 5 PCA + CUT3
        \>>
"JUMP.A @A" "BUSCD" "JUMP.A @C" "INTOFF" } m 1 1 SUB XTOM GET EVAL
        IF DUP 1 2 SUB "BR" == m 3 4 SUB "00" == AND
        THEN 3 8 SUB "RET" SWAP +
        END
      \>>
    \>>
  Z2SD
    \<< XTOM { "" "" "" "" "B,A" "C,B" "A,C" "C,D" "A,B" "B,C" "C,A" "D,C" }
SWAP GET
    \>>
  OQQ
    \<< \-> m
      \<<
        CASE m "B" >
          THEN "SUBN." SWAP + " " + m XTON 4 MOD \->STR X2SD +
          END m "3" > m "8" < AND 
          THEN "INC." SWAP + " " + m XTON 4 MOD \->STR W2D +
          END "SUB." SWAP + " " + m X2SD +
        END
      \>>
    \>>
  OPP
    \<< \-> m
      \<<
        CASE m "4" <
          THEN "CLR." SWAP + " " + m W2D +
          END m "B" >
          THEN "SWAP." SWAP + " " + m XTON 4 MOD \->STR X2SD +
          END "MOVE." SWAP + " " + m Z2SD +
        END
      \>>
    \>>
  X2D
    \<< "#" SWAP + STR\-> \-> n
      \<< ""
        IF n # 1h AND B\->R
        THEN "XM," +
        END
        IF n # 2h AND B\->R
        THEN "SB," +
        END
        IF n # 4h AND B\->R
        THEN "SR," +
        END
        IF n # 8h AND B\->R
        THEN "MP," +
        END DUP SIZE 1 - 1 SWAP SUB
      \>>
    \>>
  O0
    \<< \-> m
      \<< m 2 1000 SUB { "RETSETXM" "RET" "RETSETC" "RETCLRC" "SETHEX"
"SETDEC" "PUSH.A C" "POP.A C" "CLR.X ST" "MOVE.X C,ST" "MOVE.X ST,C"
"SWAP.X C,ST" "INC.1 P" "DEC.1 P"
        \<< O0E
        \>> "RETI" } m 1 1 SUB XTOM GET EVAL
      \>>
    \>>
  X2SD
    \<< XTOM { "B,A" "C,B" "A,C" "C,D" "A,A" "B,B" "C,C" "D,D" "A,B" "B,C"
"C,A" "D,C" } SWAP GET
    \>>
  OKK
    \<< \-> m
      \<<
        IF m "C" <
        THEN "ADD." SWAP + " " + m X2SD +
        ELSE "DEC." SWAP + " " + m W2D +
        END
      \>>
    \>>
  ORR
    \<< \-> m
      \<<
        CASE m "4" <
          THEN "SLN." SWAP + " " + m W2D +
          END m "8" <
          THEN "SRN." SWAP + " " + m W2D +
          END m "C" <
          THEN "NEG." SWAP + " " + m W2D +
          END "NOT." SWAP + " " + m W2D +
        END
      \>>
    \>>
  TT2F
    \<<
      IF 1 2 SUB DUP "90" <
      THEN DROP "A"
      ELSE XTON 8 MOD \->STR T2F
      END
    \>>
  W2D2
    \<< XTON 4 MOD 1 + { "B" "C" "A" "C" } SWAP GET
    \>>
  O81B
    \<< \-> m
      \<< m 2 1000 SUB { "" "" "JUMP.A A" "JUMP.A C" "MOVE.A. PC,A"
"MOVE.A PC,C" "SWAP.A A,PC" "SWAP.A C,PC" } m 1 1 SUB XTOM GET EVAL
      \>>
    \>>
  O81A
    \<< \-> m
      \<< m 4 1000 SUB { "MOVE." "SWAP." } m 2 2 SUB "2" == 1 + GET m 1 1 SUB
T2F + " " +
        IF m 3 3 SUB DUP "8" <
        THEN "A"
        ELSE "C"
        END SWAP J2R
        IF "1" m 2 2 SUB ==
        THEN SWAP
        END "," SWAP + + +
      \>>
    \>>
  J2R
    \<< XTON 8 MOD \->STR "R" SWAP +
    \>>
  W2D
    \<< XTON 4 MOD 65 + CHR
    \>>
  T2F
    \<< { "P" "WP" "XS" "X" "S" "M" "B" "W" "" "" "" "" "" "" "" "A" } SWAP
XTOM GET
    \>>
  O81
    \<< \-> m
      \<< m 2 1000 SUB { "RLN.W A" "RLN.W B" "RLN.W C" "RLN.W D" "RRN.W A"
"RRN.W B" "RRN.W C" "RRN.W D" 
        \<<
          IF m 3 3 SUB "4" <
          THEN "ADD."
          ELSE "SUB."
          END m 2 2 SUB T2F + " " + m 4 4 SUB XINC + "," + m 3 3 SUB W2D + CUT3
        \>>
        \<< "SRB." m 2 2 SUB T2F + " " + m 3 3 SUB W2D + CUT2
        \>>
        \<< O81A
        \>>
        \<< O81B
        \>> "SRB.W A" "SRB.W B" "SRB.W C" "SRB.W D" } m 1 1 SUB XTOM GET EVAL
      \>>
    \>>
  O80
    \<< \-> m
      \<< m 2 1000 SUB { "OUT.S C" "OUT.X C" "IN.4 A" "IN.4 C" "UNCNFG"
"CONFIG" "MOVE.A ID,C" "SHUTDN"
        \<< O808
        \>> "ADD.A P+1,C" "RESET" "BUSCC"
        \<< "MOVE.1 P,C," m 2 2 SUB + CUT1
        \>>
        \<< "MOVE.1 C," m 2 2 SUB + ",P" + CUT1
        \>> "SREQ"
        \<< "SWAP.1 P,C," m 2 2 SUB + CUT1
        \>> } m 1 1 SUB XTOM GET EVAL
      \>>
    \>>
  O1
    \<< \-> m
      \<< m 2 1000 SUB {
        \<< O10
        \>>
        \<< O11
        \>>
        \<< O12
        \>>
        \<< O13
        \>>
        \<< O14
        \>>
        \<< O15
        \>>
        \<< "ADD.A " m 2 2 SUB XINC + ",D0" + CUT1
        \>>
        \<< "ADD.A " m 2 2 SUB XINC + ",D1" + CUT1
        \>>
        \<< "SUB.A " m 2 2 SUB XINC + ",D0" + CUT1
        \>>
        \<< "MOVE.2 " m 2 3 SUB RVRS + ",D0" + CUT2
        \>>
        \<< "MOVE.4 " m 2 5 SUB RVRS + ",D0" + CUT4
        \>>
        \<< "MOVE.5 " m 2 6 SUB RVRS + ",D0" + CUT5
        \>>
        \<< "SUB.A " m 2 2 SUB XINC + ",D1" + CUT1
        \>>
        \<< "MOVE.2 " m 2 3 SUB RVRS + ",D1" + CUT2
        \>>
        \<< "MOVE.4 " m 2 5 SUB RVRS + ",D1" + CUT4
        \>>
        \<< "MOVE.5 " m 2 6 SUB RVRS + ",D1" + CUT5
        \>> } m 1 1 SUB XTOM GET EVAL
      \>>
    \>>
  XADD
    \<< "#" ROT + STR\-> + \->STR DUP SIZE 1 - 3 SWAP SUB
    \>>
  CUT3
    \<< SWAP 4 1000 SUB SWAP
    \>>
  XINC
    \<< "#" SWAP + STR\-> 1 + \->STR DUP SIZE 1 - 3 SWAP SUB
    \>>
  CUTX
    \<< ROT SWAP 1 + 1000 SUB SWAP
    \>>
  O15
    \<< \-> m
      \<< m 3 1000 SUB "MOVE." m 2 2 SUB m 1 1 SUB
        IF "8" <
        THEN { "P" "WP" "XS" "X" "S" "M" "B" "W" } SWAP XTOM GET +
        ELSE XINC +
        END " " + m 1 1 SUB O14X +
      \>>
    \>>
  CUT5
    \<< SWAP 6 1000 SUB SWAP
    \>>
  CUT4
    \<< SWAP 5 1000 SUB SWAP
    \>>
  CUT2
    \<< SWAP 3 1000 SUB SWAP
    \>>
  CUT1
    \<< SWAP 2 1000 SUB SWAP
    \>>
  O12
    \<< \-> m
      \<< m 2 1000 SUB "SWAP.W " m 1 1 SUB DUP
        IF "8" <
        THEN "A,"
        ELSE "C,"
        END SWAP O10X + +
      \>>
    \>>
  O10
    \<< \-> m
      \<< m 2 1000 SUB "MOVE.W " m 1 1 SUB DUP
        IF "8" <
        THEN "A,"
        ELSE "C,"
        END SWAP O10X + +
      \>>
    \>>
  O14X
    \<< XTOM DUP
      IF 8 >
      THEN 8 -
      END { "A,@D0" "A,@D1" "@D0,A" "@D1,A" "C,@D0" "C,@D1" "@D0,C" "@D1.C" }
SWAP GET
    \>>
  O14
    \<< \-> m
      \<< m 2 1000 SUB m 1 1 SUB DUP
        IF "8" <
        THEN "MOVE.A "
        ELSE "MOVE.B "
        END SWAP O14X +
      \>>
    \>>
  O13
    \<< \-> m
      \<< m 2 1000 SUB { "MOVE.A A,D0" "MOVE.A A,D1" "SWAP.A A,D0"
"SWAP.A A,D1" "MOVE.A C,D0" "MOVE.A C,D1" "SWAP.A C,D0" "SWAP.A C,D1"
"MOVE.4 A,D0" "MOVE.4 A,D1" "SWAP.4 A,D0" "SWAP.4 A,D1" "MOVE.4 C,D0"
"MOVE.4 C,D1" "SWAP.4 C,D0" "SWAP.4 C,D1" } m 1 1 SUB XTOM GET 
      \>>
    \>>
  O11
    \<< \-> m
      \<< m 2 1000 SUB "MOVE.W " m 1 1 SUB DUP O10X SWAP
        IF "8" <
        THEN ",A"
        ELSE ",C"
        END + +
      \>>
    \>>
  O10X
    \<< XTON DUP
      IF 7 >
      THEN 8 -
      END \->STR "R" SWAP +
    \>>
  O0EXP
    \<< 1 1 SUB XTON
      IF 8 <
      THEN "AND."
      ELSE "OR."
      END
    \>>
  O0EXS
    \<< 1 1 SUB XTOM DUP
      IF 8 >
      THEN 8 -
      END { " B,A" " C,B" " A,C" " C,D" " A,B" " B,C" " C,A" " D,C" } SWAP GET
    \>>
  O0E
    \<< \-> m
      \<< m 3 1000 SUB m 2 1000 SUB DUP O0EXS SWAP O0EXP { "P" "WP" "XS" "X"
"S" "M" "B" "W" "" "" "" "" "" "" "" "A" } m 1 1 SUB XTOM GET + SWAP +
      \>>
    \>>
  XTOM
    \<< "#" SWAP + STR\-> 1 + B\->R
    \>>
  PCAD
    \<< \-> s
      \<<
        CASE s "PC+" POS DUP
          THEN \-> n
            \<< s 1 n 1 - SUB s n 3 + 1000 SUB S2B ADDR + DUP 'ADRJ' STO B2S +
            \>>
          END DROP s "PC-" POS DUP
          THEN \-> n
            \<< s 1 n 1 - SUB ADDR s n 3 + 1000 SUB S2B - DUP 'ADRJ' STO B2S +
            \>>
          END DROP s
        END
      \>>
    \>>
END