urflibs/init/zxdisasm.f

   1 \ GPLv3 ONLY
   2 $DEFINE UFO-ZXDISASM-INCLUDED
   3
   4 HERE  \ for size reports
   5
   6 VOCABULARY zxdis
   7 ALSO zxdis DEFINITIONS
   8
   9 <public-words>
  10
  11 0 value zxdis-pc
  12 1 value zxdis-hex
  13
  14
  15 <hidden-words>
  16
  17 0 value (zxdis-ixiy)  \ contains 0, [char] x or [char] y
  18 0 value (zxdis-disp)
  19 0 value (zxdis-dptr)
  20 0 value (zxdis-dofs)
  21 0 value (zxdis-opcode)
  22
  23 create (zxdis-ixydisp-table)
  24   0x00 C, 0x00 C, 0x00 C, 0x00 C,
  25   0x00 C, 0x00 C, 0x70 C, 0x00 C,
  26   0x40 C, 0x40 C, 0x40 C, 0x40 C,
  27   0x40 C, 0x40 C, 0xBF C, 0x40 C,
  28   0x40 C, 0x40 C, 0x40 C, 0x40 C,
  29   0x40 C, 0x40 C, 0x40 C, 0x40 C,
  30   0x00 C, 0x08 C, 0x00 C, 0x00 C,
  31   0x00 C, 0x00 C, 0x00 C, 0x00 C,
  32 create;
  33
  34
  35 \ ////////////////////////////////////////////////////////////////////////// //
  36 : (zxdis-draw-str)  ( -- ) (zxdis-dptr) 1+ (zxdis-dofs) xtype cr ;
  37
  38 : (zxdis-put-char)  ( ch -- )
  39   (zxdis-dptr) (zxdis-dofs) + 1+ C!
  40   (zxdis-dofs) 1+ to (zxdis-dofs)
  41 ;
  42
  43 : (zxdis-put-str)  ( addr len -- )
  44   dup 0> if
  45     over + swap do
  46       i c@ (zxdis-put-char)
  47     loop
  48   else
  49     2drop
  50   endif
  51 ;
  52
  53 : (zxdis-put-space)  ( -- ) bl (zxdis-put-char) ;
  54 : (zxdis-put-comma)  ( -- ) [char] , (zxdis-put-char) ;
  55 : (zxdis-put-lpar)  ( -- ) [char] ( (zxdis-put-char) ;
  56 : (zxdis-put-rpar)  ( -- ) [char] ) (zxdis-put-char) ;
  57
  58
  59 : (zxdis-put-str-2)  ( addr -- ) 2 (zxdis-put-str) ;
  60 : (zxdis-put-str-4)  ( addr -- ) drop + 4 (zxdis-put-str) ;
  61 : (zxdis-put-str-4x)  ( addr -- ) dup 3 + C@ bl = if 3 else 4 endif (zxdis-put-str) ;
  62
  63
  64 \ ////////////////////////////////////////////////////////////////////////// //
  65 : (zxdis-put-n8)  ( n -- )
  66   0xff and
  67   base @ >r
  68   zxdis-hex if
  69     hex <#n # # [char] # hold
  70   else
  71     decimal <#n #s
  72   endif
  73   #>
  74   (zxdis-put-str) r> base !
  75 ;
  76
  77 : (zxdis-put-n16)  ( n -- )
  78   0xffff and
  79   base @ >r
  80   zxdis-hex if
  81     hex <#n # # # # [char] # hold
  82   else
  83     decimal <#n #s
  84   endif
  85   #>
  86   (zxdis-put-str) r> base !
  87 ;
  88
  89 : (zxdis-put-disp)  ( -- )
  90   (zxdis-disp) 0< if [char] - else [char] + endif (zxdis-put-char)
  91   (zxdis-disp) abs
  92   base @ >r decimal <#n #s #>
  93   (zxdis-put-str) r> base !
  94 ;
  95
  96
  97 \ ////////////////////////////////////////////////////////////////////////// //
  98 \ advances PC
  99 : (zxdis-get-byte)  ( -- b )
 100   zxdis-pc URASM:C@
 101   zxdis-pc 1+ 0xFFFF and to zxdis-pc
 102 ;
 103
 104
 105 \ advances PC
 106 : (zxdis-get-word)  ( -- b )
 107   (zxdis-get-byte) (zxdis-get-byte) 8 lshift or
 108 ;
 109
 110
 111 : (zxdis-byte-to-signed)  ( b -- n )  dup 0x80 >= if 0x100 - endif ;
 112
 113
 114 \ ////////////////////////////////////////////////////////////////////////// //
 115 : (zxdis-put-ixy-mem) ( -- )
 116   " (i" (zxdis-put-str)
 117   (zxdis-ixiy) (zxdis-put-char)
 118   (zxdis-put-disp)
 119   (zxdis-put-rpar)
 120 ;
 121
 122
 123 : (zxdis-put-r8)  ( r8 -- )
 124   7 and  " bcdehl.a" drop + c@
 125   dup [char] . = if
 126     \ (hl)
 127     drop
 128     (zxdis-ixiy) if
 129       (zxdis-put-ixy-mem)
 130     else
 131       " (hl)" (zxdis-put-str)
 132     endif
 133   else
 134     \ undocumented IX/IY 8-bit part access
 135     (zxdis-ixiy) if
 136       dup [char] h = over [char] l = or if
 137         \ [char] i (zxdis-put-char)
 138         (zxdis-ixiy) (zxdis-put-char)
 139       endif
 140     endif
 141     (zxdis-put-char)
 142   endif
 143 ;
 144
 145
 146 : (zxdis-put-r16-hl-ixy)  ( -- )
 147   \ hl
 148   (zxdis-ixiy) if
 149     " i" (zxdis-put-str)
 150     (zxdis-ixiy) (zxdis-put-char)
 151   else
 152     " hl" (zxdis-put-str)
 153   endif
 154 ;
 155
 156 : (zxdis-put-v16)  ( -- ) (zxdis-get-word) (zxdis-put-n16) ;
 157 : (zxdis-put-m16)  ( -- )  (zxdis-put-lpar) (zxdis-put-v16) (zxdis-put-rpar) ;
 158
 159 : (zxdis-put-r16-common)  ( r16 addr count -- )
 160   drop swap 3 and 2u* +
 161   dup c@ [char] h = if
 162     drop (zxdis-put-r16-hl-ixy)
 163   else
 164     (zxdis-put-str-2)
 165   endif
 166 ;
 167
 168 : (zxdis-put-r16-sp)  ( r16 -- )
 169   (zxdis-opcode) 4 rshift
 170   " bcdehlsp" (zxdis-put-r16-common)
 171 ;
 172
 173
 174 : (zxdis-put-r16-af)  ( r16 -- )
 175   (zxdis-opcode) 4 rshift
 176   " bcdehlaf" (zxdis-put-r16-common)
 177 ;
 178
 179
 180 : (zxdis-put-cc)  ( cc -- )
 181   7 and 2u* " nzz ncc popep m " drop +
 182   dup c@ (zxdis-put-char)
 183   1+ c@ dup 32 <> if (zxdis-put-char) else drop endif
 184 ;
 185
 186
 187 \ ////////////////////////////////////////////////////////////////////////// //
 188 : (zxdis-decode-cb-unixy)  ( -- )
 189   \ special undocumented thing
 190   (zxdis-ixiy) if
 191     \ `bit` doesn't need undoc ixy
 192     (zxdis-opcode) 0x80 and if
 193       (zxdis-opcode) 7 and 6 <> if
 194         (zxdis-put-comma)
 195         (zxdis-put-ixy-mem)
 196       endif
 197     endif
 198   endif
 199 ;
 200
 201 : (zxdis-decode-cb)  ( -- )
 202   (zxdis-opcode) 0xc0 and
 203   if
 204     (zxdis-opcode) 4 rshift 0x0c and 4- " bit res set " (zxdis-put-str-4)
 205     (zxdis-put-space)
 206     (zxdis-opcode) 3 rshift 7 and [char] 0 + (zxdis-put-char)
 207     (zxdis-put-comma)
 208   else
 209     (zxdis-opcode) 2u/ 0x1c and
 210     " rlc rrc rl  rr  sla sra sll srl " (zxdis-put-str-4)
 211     (zxdis-put-space)
 212   endif
 213   (zxdis-opcode) (zxdis-put-r8)
 214   (zxdis-decode-cb-unixy)
 215 ;
 216
 217
 218 \ ////////////////////////////////////////////////////////////////////////// //
 219 : (zxdis-decode-ed-xrep)  ( -- )
 220   \ two instructions with the wrong mnemonic length
 221   (zxdis-opcode) 0xa3 = if " outi" (zxdis-put-str) exit endif
 222   (zxdis-opcode) 0xab = if " outd" (zxdis-put-str) exit endif
 223   \ common code
 224   (zxdis-opcode) 3 and 2u* " ldcpinot" drop + (zxdis-put-str-2)
 225   (zxdis-opcode) 0x08 and if [char] d else [char] i endif (zxdis-put-char)
 226   (zxdis-opcode) 0x10 and if [char] r (zxdis-put-char) endif
 227 ;
 228
 229 : (zxdis-decode-ed)  ( -- )
 230   (zxdis-opcode) 0xa4 and 0xa0 = if (zxdis-decode-ed-xrep) exit endif
 231   (zxdis-opcode) 0xc0 and 0x40 <> if " nope" (zxdis-put-str) exit endif
 232   (zxdis-opcode) 0x04 and if
 233     (zxdis-opcode) 7 and case
 234       0x04 of " neg" (zxdis-put-str) endof
 235       0x05 of " ret" (zxdis-put-str) (zxdis-opcode) 0x08 and if [char] i else [char] n endif (zxdis-put-char) endof
 236       0x06 of \ im
 237         " im   " (zxdis-put-str)
 238         (zxdis-opcode) 0x47 = if " 0/1" (zxdis-put-str) exit endif
 239         (zxdis-opcode) 0x10 and if
 240           (zxdis-opcode) 0x08 and if [char] 2 else [char] 1 endif
 241         else
 242           [char] 0
 243         endif
 244         (zxdis-put-char)
 245       endof
 246       0x07 of
 247         (zxdis-opcode) case
 248           0x47 of " ld   i,a" endof
 249           0x4f of " ld   r,a" endof
 250           0x57 of " ld   a,i" endof
 251           0x5f of " ld   a,r" endof
 252           0x67 of " rrd" endof
 253           0x6f of " rld" endof
 254           otherwise drop " nope"
 255         endcase
 256         (zxdis-put-str)
 257       endof
 258       otherwise drop " nope" (zxdis-put-str)
 259     endcase
 260   else
 261     (zxdis-opcode) 0x02 and if
 262       \ r16
 263       (zxdis-opcode) 0x01 and if
 264         " ld   " (zxdis-put-str)
 265         \ direction
 266         (zxdis-opcode) 0x08 and if
 267           \ to rr
 268           (zxdis-put-r16-sp)
 269           (zxdis-put-comma)
 270           (zxdis-put-m16)
 271         else
 272           \ to mem
 273           (zxdis-put-m16)
 274           (zxdis-put-comma)
 275           (zxdis-put-r16-sp)
 276         endif
 277       else
 278         (zxdis-opcode) 2u/ 4 and " sbc adc " (zxdis-put-str-4)
 279         "  hl," (zxdis-put-str)
 280         (zxdis-put-r16-sp)
 281       endif
 282     else
 283       (zxdis-opcode) 0x01 and if
 284         " out  (c)," (zxdis-put-str)
 285         (zxdis-opcode) 3 rshift
 286         \ check for `(hl)`, it is special here
 287         dup 7 and 6 = if
 288           drop [char] 0 (zxdis-put-char)
 289         else
 290           (zxdis-put-r8)
 291         endif
 292       else
 293         " in   " (zxdis-put-str)
 294         (zxdis-opcode) 3 rshift
 295         \ check for `(hl)`, it is special here
 296         dup 7 and 6 <> if
 297           (zxdis-put-r8)
 298           (zxdis-put-comma)
 299         else
 300           drop
 301         endif
 302         " (c)" (zxdis-put-str)
 303       endif
 304     endif
 305   endif
 306 ;
 307
 308
 309 \ ////////////////////////////////////////////////////////////////////////// //
 310 \ ld r8,r8 (and halt)
 311 : (zxdis-decode-norm-grp1)  ( -- )
 312   (zxdis-opcode) 0x76 = if " halt" (zxdis-put-str) exit endif
 313   " ld   " (zxdis-put-str)
 314   (zxdis-opcode) 3 rshift (zxdis-put-r8)
 315   (zxdis-put-comma)
 316   (zxdis-opcode) (zxdis-put-r8)
 317 ;
 318
 319 : (zxdis-put-alu-str)  ( -- )
 320   (zxdis-opcode) 2u/ 0x1c and " add adc sub sbc and xor or  cp  " (zxdis-put-str-4)
 321   (zxdis-put-space)
 322   \ two special opcodes
 323   (zxdis-opcode) 0x38 and dup 0x08 = over 0x18 = or swap 0x00 = or if " a," (zxdis-put-str) endif
 324 ;
 325
 326
 327 \ call,ret,push,pop,etc.
 328 : (zxdis-decode-norm-grp3)  ( -- )
 329   (zxdis-opcode) 7 and case
 330     0x00 of " ret  " (zxdis-put-str)  (zxdis-opcode) 3 rshift (zxdis-put-cc) endof
 331     0x01 of
 332       (zxdis-opcode) 0x08 and if
 333         (zxdis-opcode) 0x30 and case
 334           0x00 of " ret" (zxdis-put-str) endof
 335           0x10 of " exx" (zxdis-put-str) endof
 336           0x20 of " jp   (" (zxdis-put-str) (zxdis-put-r16-hl-ixy) (zxdis-put-rpar) endof
 337           0x30 of " ld   sp," (zxdis-put-str) (zxdis-put-r16-hl-ixy) endof
 338         endcase
 339       else
 340         " pop  " (zxdis-put-str)
 341         (zxdis-put-r16-af)
 342       endif
 343     endof
 344     0x02 of " jp   " (zxdis-put-str)  (zxdis-opcode) 3 rshift (zxdis-put-cc) (zxdis-put-comma) (zxdis-put-v16) endof
 345     0x03 of
 346       (zxdis-opcode) 0x38 and case
 347         0x00 of " jp   " (zxdis-put-str) (zxdis-put-v16) endof
 348         \ CB:0x08 of endof
 349         0x10 of " out  (" (zxdis-put-str) (zxdis-get-byte) (zxdis-put-n8) " ),a" (zxdis-put-str) endof
 350         0x18 of " in   a,(" (zxdis-put-str) (zxdis-get-byte) (zxdis-put-n8) (zxdis-put-rpar) endof
 351         0x20 of " ex   (sp)," (zxdis-put-str) (zxdis-put-r16-hl-ixy)  endof
 352         0x28 of " ex   de,hl" (zxdis-put-str) endof
 353         0x30 of " di" (zxdis-put-str) endof
 354         0x38 of " ei" (zxdis-put-str) endof
 355       endcase
 356     endof
 357     0x04 of " call " (zxdis-put-str)  (zxdis-opcode) 3 rshift (zxdis-put-cc) (zxdis-put-comma) (zxdis-put-v16) endof
 358     0x05 of
 359       (zxdis-opcode) 0x08 and if
 360         \ prefixes already done, so only call is left
 361         " call " (zxdis-put-str)
 362         (zxdis-put-v16)
 363       else
 364         " push " (zxdis-put-str)
 365         (zxdis-put-r16-af)
 366       endif
 367     endof
 368     0x06 of
 369       (zxdis-put-alu-str)
 370       (zxdis-get-byte) (zxdis-put-n8)
 371     endof
 372     0x07 of
 373       " rst  " (zxdis-put-str)
 374       (zxdis-opcode) 0x38 and (zxdis-put-n8)
 375     endof
 376   endcase
 377 ;
 378
 379 : (zxdis-decode-norm-grp0)  ( -- )
 380   (zxdis-opcode) 0x06 and case
 381     0x00 of
 382       (zxdis-opcode) 1 and if
 383         (zxdis-opcode) 0x08 and if
 384           " add  " (zxdis-put-str)
 385           (zxdis-put-r16-hl-ixy)
 386           (zxdis-put-comma)
 387           (zxdis-put-r16-sp)
 388         else
 389           " ld   " (zxdis-put-str)
 390           (zxdis-put-r16-sp)
 391           (zxdis-put-comma)
 392           (zxdis-put-v16)
 393         endif
 394       else
 395         (zxdis-opcode) 0x20 and if
 396           " jr   " (zxdis-put-str)
 397           (zxdis-opcode) 3 rshift 3 and (zxdis-put-cc)
 398           (zxdis-put-comma)
 399           (zxdis-get-byte) dup 0x80 >= if 0x100 - endif
 400           zxdis-pc + (zxdis-put-n16)
 401           exit
 402         endif
 403         (zxdis-opcode) 0x10 and if
 404           (zxdis-opcode) 2u/ 4 and " djnzjr  " (zxdis-put-str-4)
 405           (zxdis-put-space)
 406           (zxdis-get-byte) dup 0x80 >= if 0x100 - endif
 407           zxdis-pc + (zxdis-put-n16)
 408           exit
 409         endif
 410         (zxdis-opcode) 0x08 and if " ex   af,af'" else " nop" endif (zxdis-put-str)
 411       endif
 412     endof
 413     0x02 of
 414       (zxdis-opcode) 1 and if
 415         (zxdis-opcode) 2u/ 4 and " inc dec " (zxdis-put-str-4)
 416         (zxdis-put-space)
 417         (zxdis-put-r16-sp)
 418       else
 419         " ld   " (zxdis-put-str)
 420         (zxdis-opcode) 0x3c and case
 421           0x00 of " (bc),a" (zxdis-put-str) endof
 422           0x08 of " a,(bc)" (zxdis-put-str) endof
 423           0x10 of " (de),a" (zxdis-put-str) endof
 424           0x18 of " a,(de)" (zxdis-put-str) endof
 425           0x20 of (zxdis-put-m16) (zxdis-put-comma) (zxdis-put-r16-hl-ixy) endof
 426           0x28 of (zxdis-put-r16-hl-ixy) (zxdis-put-comma) (zxdis-put-m16) endof
 427           0x30 of (zxdis-put-m16) " ,a" (zxdis-put-str) endof
 428           0x38 of " a," (zxdis-put-str) (zxdis-put-m16) endof
 429         endcase
 430       endif
 431     endof
 432     0x04 of
 433       (zxdis-opcode) 0x01 and 2 lshift " inc dec " (zxdis-put-str-4)
 434       (zxdis-put-space)
 435       (zxdis-opcode) 3 rshift (zxdis-put-r8)
 436     endof
 437     0x06 of
 438       (zxdis-opcode) 1 and if
 439         (zxdis-opcode) 2u/ 0x1c and " rlcarrcarla rra daa cpl scf ccf " drop + (zxdis-put-str-4x)
 440       else
 441         " ld   " (zxdis-put-str)
 442         (zxdis-opcode) 3 rshift (zxdis-put-r8)
 443         (zxdis-put-comma)
 444         (zxdis-get-byte) (zxdis-put-n8)
 445       endif
 446     endof
 447   endcase
 448 ;
 449
 450 : (zxdis-decode-norm)  ( -- )
 451   (zxdis-opcode) 0xc0 and case
 452     0x00 of (zxdis-decode-norm-grp0) endof
 453     0x40 of (zxdis-decode-norm-grp1) endof
 454     0x80 of (zxdis-put-alu-str) (zxdis-opcode) (zxdis-put-r8) endof \ alu a,r8
 455     otherwise drop (zxdis-decode-norm-grp3)
 456   endcase
 457 ;
 458
 459
 460 \ ////////////////////////////////////////////////////////////////////////// //
 461 <public-words>
 462
 463 \ returns disassembled test (only command, no address or bytes )
 464 : zx-disasm-one ( addr -- saddr slen )
 465   to zxdis-pc
 466   0 to (zxdis-ixiy)
 467   PAD 420 + to (zxdis-dptr)
 468   0 to (zxdis-dofs)
 469   0 to (zxdis-disp)
 470   (zxdis-get-byte)
 471
 472   \ check if I<X|Y> prefix
 473   dup 0xdd = if [char] x to (zxdis-ixiy) endif
 474   dup 0xfd = if [char] y to (zxdis-ixiy) endif
 475   (zxdis-ixiy) if
 476     drop (zxdis-get-byte) dup to (zxdis-opcode)
 477     dup 0xdd = over 0xfd = or if
 478       drop " nopx" (zxdis-put-str)
 479       \ one byte back
 480       zxdis-pc 1- 0xFFFF and to zxdis-pc
 481       exit
 482     endif
 483     \ check if we have disp here
 484     dup 3 rshift (zxdis-ixydisp-table) + c@
 485     1 rot 7 and lshift and
 486     if
 487       \ has disp
 488       (zxdis-get-byte) (zxdis-byte-to-signed) to (zxdis-disp)
 489     endif
 490   else
 491     to (zxdis-opcode)
 492   endif
 493
 494   (zxdis-opcode) case
 495     0xcb of (zxdis-get-byte) to (zxdis-opcode) (zxdis-decode-cb) endof
 496     0xed of (zxdis-get-byte) to (zxdis-opcode) (zxdis-decode-ed) endof
 497     otherwise drop (zxdis-decode-norm)
 498   endcase
 499   (zxdis-dofs) (zxdis-dptr) C!
 500   (zxdis-dptr) 1+ (zxdis-dofs)
 501 ;
 502
 503 PREVIOUS DEFINITIONS
 504
 505 HERE SWAP -
 506 \ DUP ." Z80 disasm size: " . ." bytes" CR
 507 DROP
 508
 509
 510 \ $IFZX
 511 \ : dct  ( addr -- )
 512 \   \ 0 to zxdis-pc
 513 \   to zxdis-pc
 514 \   endcr
 515 \   begin
 516 \     zxdis-pc dup
 517 \     zx-disasm-one  \ ( staddr addr count )
 518 \     rot
 519 \     base @ over hex <#n # # # # #> type base ! ." : "
 520 \     zxdis-pc over -
 521 \     >r zxdis-pc swap
 522 \     do
 523 \       base @ i asm-c@ hex <#n bl hold # # #> type base !
 524 \     loop
 525 \     4 r> - 3 * spaces
 526 \     2dup upcase-str
 527 \     type cr
 528 \   key 7 = until
 529 \ ;
 530 \ $ENDIF