f



Latest update of dis.of public domain powerpc assembler posted here

\ "dis.of" (27-Nov-2009) includes AltiVec & asm one-line assembler
\
\ To use, place an all-user-readable file named 'dis.of' containing
\ this source in the root directory of your ppc Mac's Startup Volume
\ Make sure the backslash beginning the first line is the first
\ character in the file. Restart, holding down the Cmd-Option-O-F
\ key combination. When Open Firmware's '0 > ' prompt appears type:
\
\ boot hd:\dis.of
\
\ Alternatively, if you have a multi-boot setup, you might need to
\ insert the relevant Mac OS X partition number, something like:
\
\ boot hd:2,\dis.of
\
\ **** IF YOU PASTED THIS TEXT FROM A WEB-BASED NEWSREADER 
\ AND GET COMPILE ERRORS caused by some weird-looking chars, 
\ load it into BBEdit or TextWrangler and choose "Zap Gremlins"
\ from the Text Menu. Nominate a single space char to replace them.
\
\ This disassembler always jumps silently to the next-lowest 32-bit
\ aligned address when requestd to disassemble a non-aligned address
\ The assembler jumps to the next-highest aligned address.
\
\ Numeric output longer than four digits defaults to hexadecimal to
\ blend better with the Mac's Open Firmware interface.
\
\ "dis" can be used both locally and remotely, but "asm" suffers
\ certain environmental penalties when used remotely. See comments
\ in source below re minimizing Open Firmware contrariness
\ if you need to use "asm" remotely.

\ NB: nbrs prefixed with '0' are hexadecimal, not octal. The G4
\ implements big-endian mode only, and likewise this package. Hence
\ the bit numbering in this src: bit-0 is msb, bit-31 (rhs) is lsb.

align hex     \ just in case

0 value ADDR  \ global place-marker changed by dis, +dis, asm,...
: addr@ addr @ ; \ the prev/next/current instr'n being handled

\ 021 proxies for other primary opcodes with same validation case
: prep-rA=rT-rejection ( u -- u|021 )
    CASE 
       023 OF  021 >r  ENDOF
       029 OF  021 >r  ENDOF
       02b OF  021 >r  ENDOF
       DUP >r
    ENDCASE
    r>
;
: prep-rA=r0-rejection ( u -- u|025 ) \ one validation case does all
    CASE
       027 OF  025 >r  ENDOF
       02d OF  025 >r  ENDOF
       031 OF  025 >r  ENDOF
       033 OF  025 >r  ENDOF
       035 OF  025 >r  ENDOF
       037 OF  025 >r  ENDOF
       DUP >r
    ENDCASE
    r>
; 
: ?rA=0-averse ( -- flag ) 
    addr@   ( instruction with Secondary Mask = 07ff )
         07e AND   06e =
;
: ?rA=rT-averse ( -- flag ) 
    addr@   ( instruction with Secondary Mask = 07ff )
         57e AND   06e =
; 
: rT@ ( -- n )        \ extract contents of ppc instruction field rT
    addr@ 015 >> 0000001f AND
;
: rA@ ( -- n )        \ get contents of field rA
    addr@ 010 >> 0000001f AND
;
: nB@ ( -- n )        \ get contents of field nB
    addr@ 0b >> 0000001f AND  
; 
: rB@ nB@
;
: nR@ ( -- n )  ( rT+n = last reg in range needed to hold nB bytes )
     nB@ 0= IF d# 32  ( result matches 'lswi' instruction's )
     ELSE  nB@  THEN  ( Power ISA v2.05 p.59 refers )
     1-               
     4 /   \ this rslt + the T in rT gives # of last gpr overwritten
;

variable last-reg    \ temp for roughmask 'lswi' validation

: incompatible-operands ( lswi-instruction -- flag )
      rT@ nR@ +  last-reg !
      last-reg @ d# 32 <  \ will there be wrap-around ?
      IF    rA@ rT@  >=   rA@ last-reg @ <=   AND
      ELSE  rA@ rT@  >=   rA@ d# 32 +  last-reg @ <=   OR 
      THEN
;

\ wildbits may not be needed at all!ALSO CK IF ISA p.20 holds for G4
: wildbits ( bc-instr'n -- flag ) \ spurious bits in br-condition?
      addr@ DUP                       ( was 2 x DUP )
      03000000 AND   03000000 =  SWAP  ( was -ROT )
      00c00000 AND   00c00000 =        ( was SWAP )
  \    02a00000 AND 02a00000 =  OR ( not invalid, ignore - ISA p20)
      OR
;

: ?user-spr ( -- flag )
   addr@ 001ff800 AND 00010000 ( xer ) = 
   addr@ 001ff800 AND 00080000 ( lr )  = OR
   addr@ 001ff800 AND 00090000 ( ctr ) = OR
;

0 constant INVALID   \ roughmask = 0 invalidates any instruction
0 value casemask     \ to pass result fm internal to external CASE

\ Rough mask sufficient to uniquely identify candidate G4 instruct'n
( Favoured Alt Form instructns singled out for more selective masks)
( Kludge: invalid operands need detecting here b4 mnemonic printed )

: roughmask ( address -- mask ) ( instruction address also in addr )
                             
@ d# 26 >>  \ isolate hi 6-bit major opcode by shifting to far right
CASE    
\ use return stack as ENDCASE removes top item from stack
   003 OF  ffe00000 >r  ENDOF  \ 'twi' simplified form only
   004 OF  addr@ d# 32 AND    \ AltiVec
      IF fc00003f >r ELSE fc0007ff >r THEN   ENDOF
   00e OF rA@ IF  fc000000  ELSE  fc1f0000  THEN  >r  ENDOF \ 'addi'
   010 OF                      \ 'bc' group
     ( wildbits IF  INVALID >r  ELSE ) fc000003 >r ( THEN ) \ killed
      ENDOF 
   011 OF  fc000003 >r  ENDOF  \ 'sc'
   012 OF  fc000003 >r  ENDOF  \ 'b' (branch unconditional)
   013 OF  addr@ 03fc AND  20 = IF  fc0007fd  \ 'bclr','bcctr' group
              ELSE  fc0007ff  THEN  >r  ENDOF \  'cr..' etc group 
   014 OF  fc000001 >r  ENDOF  \ 'rlwimi' 'rlwimi.'
   015 OF  fc000001 >r  ENDOF  \ 'rlwinm' 'rlwinm.'
   017 OF  addr@ 5c0007fe AND  5c0000ce ( rotlw, rotlw. ) = IF 
      fc0007ff >r  ELSE  fc000001 ( rlwnm, rlwnm. ) >r  THEN  ENDOF
   01f OF   \ Load, Store, Arithmetic, Logic
      addr@ dup d# 16 AND  \ can the instruction take a dot suffix?
      IF fc0007ff ELSE fc0007fe 
      THEN to casemask   \ subject to amendment in following bloc
      ( dupd instrn ) 7ff AND 12d = IF ( stwcx. is the exception.. )
         fc0007ff to casemask THEN     ( ..having dotted versn only)
      ?rA=rT-averse   rA@ rT@ =   AND
      ?rA=0-averse    rA@ 0=      AND    OR
      IF   
        INVALID to casemask
      ELSE
        addr@ casemask AND  ( get another copy of the instruction )
        CASE 
          7c0004aa ( 'lswi' ) OF  incompatible-operands IF 
                                    INVALID to casemask  THEN  ENDOF
          7c00042a ( 'lswx' ) OF  rA@ rT@ =  rB@ rT@ = OR   IF
                                    INVALID to casemask  THEN  ENDOF
          7c0002e6 ( 'mftb' ) OF  addr@ fc1effff AND  7c0c42e6 = IF
           \ combine distinguishing operand with mftb/mftbu opcode
                                    fc1fffff to casemask THEN  ENDOF
          7c000120 ( 'mtcrf' ) OF addr@ ff000 AND  ff000 = IF
                                          fc1fffff ( 'mtcr' ) to
casemask THEN ENDOF
          \ Example where level (user or supervisor) depends on opnd
          \ Works,but too many table entries needed to elim. invalid
          7c0002a6 ( 'mfspr') OF  
             ?user-spr IF fc1fffff to casemask THEN  ENDOF
          7c0003a6 ( 'mtspr') OF              
             ?user-spr IF fc1fffff to casemask THEN  ENDOF
          \ asm 'dssall' sets stream = 0, dis & cpu'dssall'ignore it
          7c00066c ( 'dss','dssall' ) OF fe0007fe to casemask  ENDOF
          7c0002ac  ( 'dst','dstt' )  OF fe0007fe to casemask  ENDOF
          7c0002ec ( 'dstst','dststt') OF fe0007fe to casemask ENDOF
          7c000008 ( 'tw' simplified ) OF ffe007ff to casemask ENDOF
        ENDCASE
      THEN  
      casemask >r 
   ENDOF
   03b OF  fc00003f >r  ENDOF  \ First Floating-point group
\  03e OF  fc0007ff >r  ENDOF  ( needed for 64-bit cpu's only )
   03f OF  addr@ d# 32 AND    \ 2nd Floating-point group
      IF   fc00003f      ( nC operand is either 0 or unused )
      ELSE addr@ d# 30 AND IF
         fc0007ff  ELSE fc0007fe ( mcrfs, fcmpo, fcmpu ) THEN
      THEN
      \ example patch gives mtfsf's alias 'mtfs' equal visibility
      \ regardless of placement relative to each other in 'table':
      ( nb: this technique is so verbose and error-prone,it is only)
      (     worth applying to a few favoured instructions. It is   )
      (     hoped to replace it with an extra action field in table)
      addr@  fc0007fe AND  fc00058e ( mtfsf, mtfsf. ) =  IF
         addr@ 1fe0000 AND 1fe0000 ( mtfs, mtfs. )  = IF 
            drop fdfe07ff THEN
      THEN >r
   ENDOF
\ Major opcode alone identifies remaining instructions =
\    majority of Load, Store, plus some int arith & logic
   prep-rA=r0-rejection \ CASE 025 proxy for 027,02d,031,033,035,037
   025 OF  rA@ IF fc000000 >r ELSE  INVALID >r  THEN  ( rA <> r0 ? )
   ENDOF   
   prep-rA=rT-rejection \ CASE 021 proxies for CASEs 023, 029, 02b
   021 OF  rA@ DUP   0=   SWAP   rT@ =  OR  ( rA==r0 OR rA==rT ? )
      IF   INVALID >r   ELSE   fc000000 >r   THEN
   ENDOF
   02e OF  rA@ rT@ >= 
      IF   INVALID >r   ELSE   fc000000 >r   THEN  \ 'lmw'
   ENDOF
   ( Remainder ) fc000000 >r
ENDCASE
r>
;


\ In the operand-extraction functions which follow, "trimmed-
\ instruction" means the progressively reduced ppc instruction
\ remnant, after all bits to the right of the current operand
\ have been shifted out.

\ Single operand primitives. If they start with '.' they output to
\ screen. Otherwise they pass the result back to the instruction-
\ nominated calling routine which then has to do the output itself.
\
: .comma ( -- ) 2c emit ;
: .0x ( -- ) [CHAR] 0 emit [CHAR] x emit ;
: .ascii ( n -- )       \ display 32-bit cell as 4 x ASCII chars
  lbsplit 
  [CHAR] " emit
  4 0 DO 
        dup 20 7e between 0= 
        IF   drop ( then substitute ) [CHAR] .  THEN
        emit
  LOOP
  [CHAR] " emit ;
: .hexdump ( u -- )  0 <# # # # # # # # # #> type ;
  \ can substitute '8 u.r' if it pads with 0's instead of blanks
: .nbr ( trimmed-instruction -- ) 
   01f AND  0 <# decimal #s hex #> \ prints rhs 5 bits in decimal
   type ;
: .gpr ( trimmed-instruction -- )  
     [CHAR] r emit  .nbr ;   \ outputs one of r0 r1 r2 ... r31
: .fpr ( trimmed-instruction -- )   
     [CHAR] f emit  .gpr ;   \ outputs one of fr0 fr1 fr2 ... fr31
: .vec ( trimmed-instruction -- )
     [CHAR] v emit  .nbr ;   \ outputs one of v0 v1 v2 ... v31
: .fld ( trimmed-instruction -- )
     07 AND  0 <# decimal #s hex #> type ;
: .cr ( trimmed-instruction -- )
     ." cr" .fld ;           \ one of cr0 cr1 cr2 ... cr7
: .segr ( trimmed-instruction -- )  
      0f AND  [CHAR] s emit .gpr ; \ one of sr0 sr1 sr2 ... sr15
: .imm ( trimmed-instruction -- )  
      0f AND .nbr ;                \ one of 0 1 2 ... 15
: .xx ( trimmed-instruction -- ) 
      ff AND .0x 0 <# # # #> type ; \ one of 0x00 0x01 0x02 ... 0xff
: .cc ( trimmed-instruction -- ) 1f AND .xx ;
: .ui ( trimmed-instruction -- )  ( zero trimming in this case )
     ffff AND .0x 0 <# # # # # #> type ; \ 0xXXXX where X = hexdigit
: sign-extend ( ppc-instr'n -- immed-data-field-expanded-to-32-bits)
  lwsplit drop       ( works with rhs 16-bit immediate fields only )
  dup  8000 AND 
  if ffff else 0000 then   \ put sign extension on stack
  wljoin
; 
: field5-extend ( trimmed-instrn -- signed-5-bit-fld->32-bit nbr )
  01f AND                  \ limit to nbr of bits determined by mask
  DUP 010 AND              \ bit-26 was sign bit
  IF ffffffe0 OR THEN      \ pad with -ve sign extension if required
;
\ 0 alignment assumes code being disassembled fm executable location
: -align ( address -- address|address-1|address-2|address-3 )
-4 AND
;
: +align ( address -- address|address+1|address+2|address+3 )
   dup 00000003 AND ?dup IF 4 swap - + THEN
;

\ : .sd  \ alternative:outputs signed immedate data as 4 hex digits
\      sign-extend dup abs 0 \ SUBSTITUTE THIS IF FOLL --> PROBLEMS
\      <# # # # #s [char] x hold [char] 0 hold rot sign #> 
\      type ;
: .sd  \ more flexible if your computer's (.) output matches mine
      sign-extend dup (.) rot dup 0< IF
          swap 1- rot 1+  \ skip 1st char '-' and reduce length
          swap rot        \ unscramble stack
          [char] - emit   \ send a minus sign to output
      THEN  dup 
      -9 9 between NOT IF .0x THEN \ only 1 numeric digit, skip .0x
      abs a f between
           IF [CHAR] 0 emit THEN \ insert lead 0 if single hex digit
      type
;
: .si ( trimmed-instruction -- ) .sd ;  
: .s5 ( trimmed-instruction -- ) \ outpus one of -16 -15 -14 ... 15
      field5-extend
      dup abs 0
      <# decimal #s rot sign hex #> 
      type ;
: .u2 ( trimmed-instruction -- )
   03 AND  0 <# #s #> \ prints rhs 2 bits in decimal
   type 
;

: .spr ( trimmed-instruction -- )  \ as in 'mtspr'.
     0 <# decimal #s hex #> type   \ output matches documentation
;

: btarget ( offset ppc-instr'n -- to-address ) ( 24-bit abs. field )
( for relative result,supply instrn addr;absolute rslt use 0 offset)
    swap
    03fffffc AND dup   ( + 2 alignment bits -> 26 bits )
    02000000 AND       ( most G4 32-bit addr start with 00 or ff )
    if fc000000  OR  then  \ if hi bit = 1, keep address hi
    +                      \ add the offset
;
: extract-bc ( bc[lr|ctr]-instrn -- u3 ) \ untwiddle BPU bits 
  ( assumes branch-instrn's eligibility prev tested, incl. bit-8=1 )
\ eg: 41810004 = 'bgt next' = 'bc 0c,1,here+4' (bits 7,8,15=1,14=0)
    lwsplit nip wbsplit 01 AND 2 << swap 03 AND  OR
;

\ These extract-and-display-multiple-operands routines are nominated
\ within the individual ppc instruction records which make up the 
\ data table later in this source. By that means, individual
\ ppc instructions tell disasm1 how to display their operands.

: nil ( instruction -- ) DROP \ instr'ns with no operands eg 'rfi'
    8 spaces ;
: all ( instruction -- )    \ used by "data" pseudo-instruction only
\ NB: normally only one of the following 3 lines would be active:
\ .hexdump
\ .ascii
  drop  8 spaces  ( substitute if disasm1 has hex and/or ascii cols)
;
: aJ ( ppc-instruction -- ) \ used by 'ba' and 'bla'
    0 btarget               \ zero offset keeps it absolute
    .hexdump ;
: rJ ( ppc-instruction -- ) \ 'b','bl' ( r=relative src fld )
    addr btarget   \ offset = from-addr keeps it relative
   .hexdump ;
: rH \ output bc-relative displacement as absolute target address
   -align
   sign-extend addr + .hexdump ;
: aH -align sign-extend .hexdump
;
: ?TnAaH ( ppc-instruction -- )  \ eg 'bcla'
    -align 
    dup 010 rshift dup 5 rshift
    .xx .comma .nbr .comma sign-extend .hexdump  ;
: ?TnArH ( ppc-instruction -- )  \ eg 'bc'
    -align
    dup 010 rshift dup 5 rshift
    .xx .comma .nbr .comma sign-extend 
    addr +  ( rel. field + curr. instr'n addr -> final target addr )
   .hexdump  ; 
: ?SrAsI ( ppc-instruction -- )    \ 'twi' only
    dup 010 rshift dup 5 rshift
    .cc ( or use .nbr for decimal "TO" opnd ) .comma .gpr .comma .si
; 

: ?TnA ( ppc-instruction -- ) \ eg 'bcctr' ("branch to addr in CTR")
    010 rshift dup 5 rshift 
    .cc .comma .nbr
;
: ?SrAB ( ppc-instruction -- )     \ 'tw' only
    0b rshift dup 5 rshift dup 5 rshift
    .cc ( or use .nbr for decimal 1st opnd ) .comma .gpr .comma .gpr
;
: rAB ( ppc-instruction -- )   \ eg, 'tw' variants:'trap','tweq',etc
    0b rshift dup 5 rshift
    .gpr .comma .gpr
;
: r@B  ( ppc-instruction -- )  \ eg, 'dcba'
    0b rshift         \ discard all to right of right-most operand
    dup 5 rshift      \ push, then do similar for next operand
    dup 01f and IF .gpr ELSE .nbr ( substitute 0 for r0 if A=0)
                                   THEN .comma .gpr
;
: rB ( ppc-instruction -- )    \ eg, 'tlbie'
    0b rshift        \ re-position field to rhs for processing
    .gpr ;           \ display field as a general purpose register
: vB ( ppc-instruction -- )
    0b rshift
    .vec
; 
: rT ( ppc-instruction -- ) 
    015 rshift .gpr ;
  : rS ( ppc-instruction -- ) rT ;
: fpT ( ppc-instruction -- )    \ eg 'mffs.'
    015 rshift .fpr ; 
: fpB ( ppc-instruction -- )
    0b rshift .fpr ;                    \ eg 'mtfs'
: vT ( ppc-instruction -- )
    015 rshift .vec ;
: nT ( ppc-instruction -- )     \ eg 'mtfsb0' 
    015 rshift .nbr ;
: nA ( ppc-instruction -- )     \ eg 'btlr'
    010 rshift .nbr
;
: nArH ( ppc-instruction -- )   \ eg 'bt'
    -align dup 010 rshift .nbr .comma sign-extend addr + .hexdump ;
: nAaH ( ppc-instruction -- )   \ eg 'bta'
    -align dup 010 rshift .nbr .comma sign-extend .hexdump
;
: rTA ( ppc-instruction -- )    \ eg, 'neg.'
    010 rshift  
    dup 5 rshift
    .gpr .comma .gpr ;
: rxSA ( ppc-instruction -- ) 
    010 rshift
    dup 5 rshift SWAP
    .gpr .comma .gpr
;
: rTAB  ( ppc-instruction -- )  \ eg, 'mullw'
    0b rshift                   \ position last 5-bit field to rhs
    dup 5 rshift dup 5 rshift   \ push remainder fields in rvs order
    .gpr .comma .gpr .comma .gpr ;  \ pop and print them
  : rSAB ( ppc-instruction -- ) rTAB ; \ eg 'stbx'
: rT@B ( ppc-instruction -- )   \ eg, 'lbzx'
    0b rshift dup 5 rshift dup 5 rshift
    .gpr .comma dup 1f and IF .gpr ELSE .nbr THEN .comma .gpr ;
  : rS@B ( ppc-instruction -- ) rT@B ; \ eg 'ecowx'
: rxSAB ( ppc-instruction -- )  \ rSAB but with 1st 2 opnds reversed
    0b rshift dup 5 rshift dup 5 rshift SWAP
    .gpr .comma .gpr .comma .gpr ;
: rTxAB ( ppc-instruction -- )  \ eg, 'sub'
    0b rshift dup 5 rshift dup 5 rshift 
    .gpr .comma SWAP .gpr .comma .gpr
; 
: rTsI ( ppc-instruction -- ) \ eg 'li'
    dup 15 rshift .gpr .comma .sI
;
: vTAB  ( ppc-instruction -- )   \ eg, 'vminsw'
    0b rshift                    \ position last 5-bit field to rhs
    dup 5 rshift dup 5 rshift    \ push remainder flds in rvs order
    .vec .comma .vec .comma .vec \ pop and print them
;    
: vTrAB ( ppc-instruction -- )   \ eg, 'stvebx'
        0b rshift
        dup 5 rshift dup 5 rshift
        .vec .comma .gpr .comma .gpr
; : vSrAB vTrAB                                  \ eg, 'lvx'
;
: vTxnAvB ( ppc-instruction -- ) \ eg, 'vctsxs'
        0b rshift
        dup 5 rshift dup 5 rshift
        .vec .comma SWAP .vec .comma .nbr
;

: fpTAB  ( ppc-instruction -- ) \ eg 'fsubs'
    0b rshift                      \ trim to end of last operand
    dup 5 rshift dup 5 rshift
    .fpr .comma .fpr .comma .fpr ;
  : fpTrAB ( ppc-instruction -- )  \ eg,'lfsux'
    0b rshift \ shift right til only operands (and major opc) remain
    dup 5 rshift dup 5 rshift \ copy & push after prev oprnd removed
    .fpr .comma .gpr .comma .gpr ; 
  : fpSrAB ( ppc-instruction -- ) fpTrAB ; \ eg 'stfsx'
  : fpTr@B ( ppc-instruction -- )  \ eg 'lfdx'
    0b rshift dup 5 rshift dup 5 rshift
    .fpr .comma dup 1f and IF .gpr ELSE .nbr THEN .comma .gpr ;
   : fpSr@B ( ppc-instruction -- ) fpTr@B ; \ eg 'lfdx'
: nTAB ( ppc-instruction -- )   \ eg 'crxor'
    0b rshift
    dup 5 rshift dup 5 rshift
    .nbr .comma .nbr .comma .nbr ;
: rT@nB ( ppc-instruction -- )  \ eg 'lswi'
    0b rshift
    dup 5 rshift dup 5 rshift
    .gpr .comma dup 1f and IF .gpr ELSE .nbr THEN .comma .nbr ;
  : rS@nB ( ppc-instruction -- ) rT@nB ; \ eg 'stswi'
  : rxSAnB ( ppc-instruction -- )        \ eg 'srw'
    0b rshift
    dup 5 rshift dup 5 rshift SWAP
    .gpr .comma .gpr .comma .nbr 
;
: nTA ( ppc-instruction -- ) \ eg 'crmove'
    010 rshift dup 5 rshift
    .gpr .comma .gpr
;
: vTABC ( ppc-instruction -- ) \ eg 'vmhaddshs'
    06 rshift
    dup 5 rshift dup 5 rshift dup 5 rshift
    .vec .comma .vec .comma .vec .comma .vec ;
: vTAxBC ( ppc-instruction -- ) \ eg 'vnmsubfp'
    06 rshift
    dup 5 rshift dup 5 rshift dup 5 rshift
    .vec .comma .vec .comma SWAP .vec .comma .vec ;
: vTABqC
    06 rshift
    dup 5 rshift dup 5 rshift dup 5 rshift   \ 'vsldoi' only
    .vec .comma .vec .comma .vec .comma 0f AND .nbr
    ;
: fpTAxBC ( ppc-instruction -- )  \ eg, 'fmadds'
    06 rshift 
    dup 5 rshift dup 5 rshift dup 5 rshift \ xBC = output C before B
    .fpr .comma .fpr .comma SWAP .fpr .comma .fpr
;
: rxSAnBCD ( ppc-instruction -- ) \ eg, 'rlwimi'
    01 rshift
    dup 5 rshift dup 5 rshift dup 5 rshift dup 5 rshift
    SWAP .gpr .comma .gpr .comma .nbr .comma .nbr .comma .nbr ;
: rxSABnCD ( ppc-instruction -- ) \ eg, 'rlwinm.'
    01 rshift
    dup 5 rshift dup 5 rshift dup 5 rshift dup 5 rshift
    SWAP .gpr .comma .gpr .comma .gpr .comma .nbr .comma .nbr 
;

: fpTAC ( ppc-instruction -- )   \ eg, 'fmuls.'
    06 rshift
    dup 0a rshift dup 5 rshift
    .fpr .comma .fpr .comma .fpr
;
: rTB ( ppc-instruction -- ) 
    0b rshift                        \ eg, 'mfsrin'
    dup 0a rshift  ( skips register-B and unused reg-A at same time)
    .gpr .comma .gpr ;
  : rSB ( ppc-instruction -- ) rTB ; \ eg, 'fctiwz'
: vTB ( ppc-instruction -- )
    0b rshift
    dup 0a rshift  ( skips register-B and unused reg-A at same time)
    .vec .comma .vec ;
: fpTB ( ppc-instruction -- ) 
    0b rshift
    dup 0a rshift  
    .fpr .comma .fpr
;
: fpTx(rA)sD ( ppc-instruction -- ) \ eg 'lfd'
    dup 10 rshift dup 5 rshift
    .fpr .comma  SWAP  .sd  [CHAR] ( emit .gpr [CHAR] ) emit ;
: fpTx(r@)sD ( ppc-instruction -- )
    dup 10 rshift dup 5 rshift
    .fpr .comma SWAP .sd [CHAR] ( emit dup 1f and IF .gpr ELSE .nbr
        THEN  [CHAR] ) emit ; 
  : fpSx(rA)sD ( ppc-instruction -- ) fpTx(rA)sD ; \ eg, 'stfdu'
  : fpSx(r@)sD ( ppc-instruction -- ) fpTx(r@)sD   \ eg, 'lfd'
;

: vTsA ( ppc-instruction -- ) \ eg 'vspltisw'
    010 rshift dup 5 rshift
    .vec .comma .s5 
;

: tT ( ppc-instruction -- ) \ eg 'dss'
    015 rshift
    .u2 ;
: fT ( ppc-instruction -- ) 
    017 rshift                
    .fld ;
: fTqB ( ppc-instruction -- )  \ eg 'mtfsfi.' 
   0c rshift dup 0b rshift  .fld .comma .imm 
;
: crT ( ppc-instruction -- )    \ 'mcrxr', some 'bc' aliases..
    017 rshift .cr ;
: crTA ( ppc-instruction -- )   \ nb: online docs call crA "crfS"
    012 rshift dup 5 rshift
    .cr .comma .cr ;
: crTfA ( ppc-instruction -- )  \ 'mcrfs' only;
        012 rshift dup 5 rshift     \ alt to crTA matches Apple asm "as"
        .cr .comma .fld
;
: crA|nil ( bc*-instruction -- ) \ display only if cr# != 0
   0b lshift 01d rshift          \ drop surrounding bits
   dup IF .cr ELSE drop THEN
;
:  crArH ( bc*-instruction -- ) \ eg 'beq', 'beqlr', 'bnectrl' ...
   dup 0b lshift 01d rshift          \ isolate BO's cr bits
   dup IF .cr .comma ELSE drop THEN rH ;
: crAaH ( bc*-instruction -- ) \ eg 'blta', blelra, ... 'bsoctrl'
   dup 0b lshift 01d rshift          \ isolate BO's cr bits
   dup IF .cr .comma ELSE drop THEN aH
;
: crTrAB ( ppc-instruction -- )  \ eg, 'cmpw'
   0b rshift dup 5 rshift dup 7 rshift
   .cr .comma .gpr .comma .gpr ;
: crT.rAB ( ppc-instruction -- )  \ eg, 'cmp'
    0b rshift
    dup 5 rshift dup 7 rshift 0 SWAP
    .cr .comma .nbr .comma .gpr .comma .gpr ;
: crTfpAB ( ppc-instruction -- ) \ eg, 'fcmpo'
    0b rshift
    dup 5 rshift dup 7 rshift
    .cr .comma .fpr .comma .fpr 
;
: crTrAsI ( ppc-instruction -- )    \ 'cmpwi' only
   dup 010 rshift dup 7 rshift
   .cr .comma .gpr .comma .si ;
: crT.rAsI ( ppc-instruction -- )   \ 'cmpi' only
   dup 010 rshift dup 7 rshift 0 SWAP
   .cr .comma .nbr .comma .gpr .comma .si ;
: crTrAuI ( ppc-instruction -- )    \ 'cmplwi' only
   dup 010 rshift dup 7 rshift  
   .cr .comma .gpr .comma .ui ;
: crT.rAuI ( ppc-instruction -- )   \ 'cmpli' only
   dup 010 rshift dup 7 rshift 0 SWAP
   .cr .comma .nbr .comma .gpr .comma .ui
;
: rTgA ( ppc-instruction -- )      \ 'mfsr' only
   010 rshift dup 5 rshift  .gpr .comma .segr 
;

: rTx(A)sD ( ppc-instruction -- )  \ eg, 'lwzu'
   dup 010 rshift dup 5 rshift 
   .gpr .comma  SWAP .si [CHAR] ( emit .gpr [CHAR] ) emit ;
  : rSx(A)sD ( ppc-instruction -- ) rTx(A)sD ; \ eg 'stbu'
 : rTx(@)sD ( ppc-instruction -- ) 
   dup 010 rshift dup 5 rshift .gpr .comma SWAP .si 
     [CHAR] ( emit dup 1f AND IF .gpr ELSE .nbr THEN [CHAR] ) emit ;
   : rSx(@)sD ( ppc-instruction -- ) rTx(@)sD
;
: rTAsI ( ppc-instruction -- )  \ eg, 'subfic'
  dup 010 rshift dup 5 rshift
  .gpr .comma .gpr .comma .si ;
: rT@sI ( ppc-instruction -- )  \ @ = A|0 as in (eg) 'addi'
   dup 010 rshift dup 5 rshift
   .gpr .comma 
   dup 01f and IF .gpr ELSE .nbr THEN  \ rA == 0 -> '0' not 'r0'
   .comma .si ;
: rT@-sI ( ppc-instruction -- )  \ @ = A|0 as in (eg) 'subi'
   dup 010 rshift dup 5 rshift
   .gpr .comma 
   dup 01f and IF .gpr ELSE .nbr THEN .comma negate .si ;
: rT@uI ( ppc-instruction -- )  \ being trialled for 'addsi' only
   dup 010 rshift dup 5 rshift  \  which usually not sign-extended,
   .gpr .comma \ but used for loading upper half of literal constant
   dup 01f and IF .gpr ELSE .nbr THEN  \ rA == 0 -> '0' not 'r0'
   .comma .ui ;
: rAsI ( ppc-instruction -- )  \ 'twi' extended form
   dup 010 rshift
   .gpr .comma .si 
;
: rxSAuI ( ppc-instruction -- ) \ eg, 'ori'
   dup 010 rshift dup 5 rshift SWAP
   .gpr .comma .gpr .comma .ui ;
: mFfpB ( ppc-instruction -- )  \ eg, 'mtfsf'
    0b rshift dup 6 rshift \ trim to reg B, push; ditto 8-bit mask
    .xx .comma .fpr
; 
: xrSmM ( ppc-instruction -- )  \ 'mtcrf' only )
    0c rshift dup 9 rshift SWAP \ ignore hi 0 to left of 8-bit field
    .xx .comma .gpr ;
: xrSgA ( ppc-instruction -- )      \ 'mtsr' only ) 
    010 rshift dup 5 rshift 
    swap .segr .comma .gpr 
;
: xtT[rAB] ( ppc-instruction -- ) \ eg 'dstst'
    0b rshift dup 5 rshift dup 5 rshift -rot
    .gpr .comma .gpr .comma .u2
;
\ swap halves of spr/tbr spec field lo-hi to hi-lo order for display
: swap-ends ( ppc-instruction -- spr-specification )
    001ff800 AND     \ trim extraneous data from spr spec
    lwsplit          \ separate hi and lo halves
    swap             \ reverse their order
    6 rshift         \ reposition hi half to 5 of 10 most sig. bits
    +                \ recombine
;
: rTxLH ( ppc-instruction -- )   \ 'mfspr' and 'mftb'
dup swap-ends
swap
015 rshift .gpr .comma .spr ;
: xrSxLH ( ppc-instruction -- )   \ 'mtspr' only
dup swap-ends
..spr .comma 015 rshift .gpr 
;

: cX ( bc[lr|ctr]-instrn-with-bit8=1 -- ) \ not curr. used !!
   extract-bc .fld   \ output b-condition code index as number
;


\ ------( end of 'dis' extract-and-display-operands functions )-----



\ ----------(  start of 'asm' input and parse functions )-----------

\ The following improvised parsing method will hopefully be
\ replaced at some stage. Currently it precludes putting 'asm'
\ in a loop with 'accept' -- possibly because 'accept' & 'evaluate'
\ share the same variables (if in fact they do ??). In any case,
\ doing so causes 'asm' to run out of operand space when assembling
\ instructns which it has no problem assembling outside a loop.

CREATE mnom 0c ALLOT  \ instruction mnemonic & search pattern buffer
mnom 0c BL fill
CREATE opnd-buf 010 ALLOT 
" d#  " opnd-buf swap MOVE  \ preamble 1st char changes dynamically
opnd-buf 4+ CONSTANT opnd \ remainder of string = current asm arg
opnd 0c BL fill
: expect-decimal [CHAR] d opnd-buf c! ;
: expect-hex     [CHAR] h opnd-buf c! ;

: read-mnom ( -- ) ( moves mnemonic from input to mnom )
   mnom 0c BL fill
   BL word count 0c min
   dup 0= IF     
      clear quit  \ mild abort gives silent exit for nul instruction
   THEN           \   = normal exit from loops containing this word
   mnom swap move
;
: confirm ( addr c -- addr+1 ) ( aborts on error )
  \ use repeatedly to ck more than one prefix in succession, eg 'sr'
   swap tuck c@ <> IF ." ? "
              abort" missing or inappropriate register prefix"  THEN
   dup BL swap c!           \ erase successful match from buffer
   1+ dup                   \ next addr in string
   c@ BL = IF ." ? " abort" unnumbered register" THEN
;

: ignore-extra-input ( -- ) ( and warn user if too many operands )
  \ most relevant if excess follows ',' else left to parser or forth
   BL word w@ ?dup 0<> IF   ( 0000 = 0-length 0-byte = end-of-line )
      01 word ( nontypable separator makes 1 token of rest of line )
      drop                  ( dispose of it )
      015c <> IF            ( 015c = 1-chr pstring: "\" )
         ."        extra ignored  "
      THEN                  ( skip msg for "\ ..."; not an error )
   THEN                     ( no action if initial string = nul )
;

: read-opnd ( c -- ) 
   opnd 0c BL fill
   word count 0c min
   -leading \ strip leading spaces
   dup >r   \ save length
   opnd swap move
   r> 0 ( opnd 20 ) = IF ." ? " abort" missing operand" THEN
;

: get-nbr ( -- u5 ) \ like 'get-gpr' below, but no reg-prefix to cfm
   expect-decimal
   [CHAR] , read-opnd
   opnd-buf 0c evaluate
   dup 0 d# 32 within NOT IF ." ? " abort" invalid operand" THEN
;
: get-signed-nbr ( -- n5 )
   expect-decimal
   [CHAR] , read-opnd
   opnd-buf 0c evaluate
  dup d# -16 d# 16 within NOT IF ." ? " abort" invalid operand" THEN
   01f AND          \ remove sign extension if -ve
;

: get-spr-spec ( -- u10 )
  expect-decimal
  [CHAR] , read-opnd
  opnd-buf 0c evaluate
   dup 0 d# 1023 between NOT IF ." ? " 
       abort" spr spec in range 0-1023 decimal expected"
   THEN
;
: get-gpr ( -- u5 ) \ u5 signifies a 5-bit number
   expect-decimal
   [CHAR] , read-opnd
   opnd [char] r confirm drop  \ aborts on syntax error
   opnd-buf 0c evaluate \ returns register# or aborts "bad number"
   dup
   0 d# 32 within NOT IF ." ? " abort" invalid register" THEN
;
: get-(gpr) ( -- u5 ) \ always followed by (rA) or (r@)
   expect-decimal
   [CHAR] ) read-opnd
   opnd [char] r confirm drop  \ aborts on syntax error
   opnd-buf 0c evaluate \ returns register# or aborts "bad number"
   dup
   0 d# 32 within NOT IF ." ? " abort" invalid register" THEN
;
: get-segr ( -- u4 ) \ u4 signifies a 4-bit number
   expect-decimal
   [CHAR] , read-opnd
   opnd [char] s confirm [char] r confirm drop \ cfm prefix == 'sr'
   opnd-buf 0c evaluate \ returns register# or aborts "bad number"
   dup
   0 d# 16 within NOT IF ." ? " abort" invalid register" THEN
;
: get-fld ( -- u3 )
   expect-decimal
   [CHAR] , read-opnd
   opnd-buf 0c evaluate
   dup 0 d# 8 within NOT IF ." ? " abort" no such field" THEN
;
: get-cr ( -- u3 )
   expect-decimal
   [CHAR] , read-opnd
   opnd [char] c confirm [char] r confirm drop \ cfm prefix == 'cr'
   opnd-buf 0c evaluate
   dup 0 d# 8 within NOT IF ." ? " abort" no such field in CR" THEN
;
: get-cr|nil ( -- u5 ) ( return arg if next 2 chars = 'cr', else 0 )
   tib >in @ + 0c -leading drop dup 
   c@ [char] c = swap 1+ c@ [char] r = AND
   IF expect-decimal
      [CHAR] , read-opnd
      opnd [char] c confirm [char] r confirm drop \ cfm prefix == cr
      opnd-buf 0c evaluate
      dup 0 d# 8 within NOT IF ." ? " 
         abort" no such field in CR" THEN
   ELSE 0 THEN
;   

: get4bits ( -- u4 )
   expect-decimal
   [CHAR] , read-opnd
   opnd-buf 0c evaluate
   dup 0 0f between NOT IF ." ? " abort" invalid operand" THEN
;
\ to get 3 bits, use 'get-fld'
: get2bits ( -- u2 )  ( inputs a 2-bit number )
   expect-decimal
   [CHAR] , read-opnd
   opnd-buf 0c evaluate
   dup 0 4 within NOT IF ." ? " abort" invalid operand" THEN
;
: get1bit ( -- u1 )
   expect-decimal
   [CHAR] , read-opnd
   opnd-buf 0c evaluate
   dup 0 2 within NOT IF ." ? " abort" invalid operand" THEN
;
\ : get0bit ( -- 0 ) \ dedicated to L-bit (bit ten) in cmp.. instrns
\   get1bit 
\   dup 0 <> IF ." ? " abort" 2nd operand: only 0 legal for G4 cpu"
\   THEN
\ ;

: get0&rA ( -- 0 rA ) ( inserts optional arg '0' if absent fm input)
   expect-decimal
   [CHAR] , read-opnd
   opnd c@ [CHAR] r = IF \ pre-test for 'r' without normal err abort
      0  \ insert the missing arg
      opnd [char] r confirm drop 
      opnd-buf 0c evaluate dup
      0 d# 32 within NOT IF ." ? " abort" invalid register" THEN
   ELSE ( operand <> 'r' )
      opnd-buf 0c evaluate   ( checks whole arg this time )
      dup 0 <> IF ." ? "
         abort" second operand: '0' or leave it out altogether"
      THEN
      get-gpr  ( since '0' was the arg previously fetched above )
   THEN
;      

: get-fpr ( -- u5 ) \ works similar to 'get-gpr' above
   expect-decimal
   [CHAR] , read-opnd
   opnd [char] f confirm [char] r confirm drop \ cfm prefix == 'fr'
   opnd-buf 0c evaluate
   dup 0 d# 32 within NOT IF ." ? " abort" invalid register" THEN
;
: get-vec ( -- u5 ) \ like 'get-gpr' but 'v' prefix instead of 'r'
   expect-decimal
   [CHAR] , read-opnd
   opnd [char] v confirm drop
   opnd-buf 0c evaluate
   dup
   0 d# 32 within NOT IF ." ? " abort" invalid register" THEN
;
: get-rA|0 ( -- u5 )
  expect-decimal
  [CHAR] , read-opnd
  opnd c@ 
  CASE [char] 0 OF opnd 1+ c@ BL <> IF
      ." ?? " abort" literal 0 or r1 r2 ... r31 expected" THEN
    ENDOF opnd [char] r confirm drop 
  ENDCASE
  opnd-buf 0c evaluate
  dup 0 = opnd 1+ c@ BL <> AND ?dup ( abort" needs +ve item on stak)
        IF ." ??? " abort" literal 0 or r1 r2 ... r31 expected" THEN
  dup 0 d# 32 within NOT ?dup
        IF ." ???? " abort" invalid register" THEN
;
: get-(rA|0) ( -- u5 )
  expect-decimal
  [CHAR] ) read-opnd
  opnd c@ 
  CASE [char] 0 OF opnd 1+ c@ BL <> IF
      ." ?? " abort" literal 0 or r1 r2 ... r31 expected" THEN
    ENDOF opnd [char] r confirm drop 
  ENDCASE
  opnd-buf 0c evaluate
  dup 0 = opnd 1+ c@ BL <> AND ?dup ( abort" needs +ve item on stak)
        IF ." ??? " abort" literal 0 or r1 r2 ... r31 expected" THEN
  dup 0 d# 32 within NOT ?dup
        IF ." ???? " abort" invalid register" THEN
;

: get-hex-operand ( -- u16 )
   expect-hex
   [CHAR] - opnd c@ = IF     \ replace '-0x' with '-'
      [CHAR] 0 opnd 1+ c@ = IF
         [CHAR] x opnd 2+ c@ = IF
            BL opnd c! BL opnd 1+ c! [CHAR] - opnd 2+ c!
         THEN
      THEN
   THEN
   [CHAR] 0 opnd c@ = IF     \  remove '0x' prefix if present
      [CHAR] x opnd 1+ c@ = IF
         BL opnd c! BL opnd 1+ c!
         BL opnd 2+ c@ =  IF 
            ." ? " abort" operand lacks a value"
         THEN
      THEN
   THEN
   opnd-buf 10 evaluate \ larger buffer allows optional '0x' prefix
;

\ NOTE re branch-target addresses. It is natural to suspect 'asm'
\ when 'dis' echoes back a branch target different from the one you
\ just gave it. However if you consider the way 'asm' and 'dis'
\ interact, plus the peculiarities of the ppc instruction set, you
\ will soon learn not to blame this package. The rules are complex.
\ Just for starters:'dis' and 'asm' correct non-aligned addresses in
\ complementary ways.'dis' corrects to the previous aligned address,
\ 'asm' to the *following* aligned address. ppc branch instructions
\ IGNORE the rhs two bits of any branch operand they are given. Thus
\ it is legal but incorrect and futile to specify a non-aligned
\ branch target via asm. If you do this from a non-aligned starting
\ point (eg, if you take .here as gospel without noticing when it's
\ unaligned), I hope you can see the kind of hair-tearing situation
\ you could be getting yourself into. Normally, 'code' will set
\ things up properly for 'asm', but not necessarily for 'azm'.
\ When in doubt, always type 'align' before entering your initial
\ ppc instruction - if only to keep your own perception of where you
\ are branching from in line with 'asm's.


\ branch operands allow -ve input as shorthand for high memory
\ addresses, eg -4 == fffffffc. Don't know whether to outlaw it.
: get-abs-target ( -- u26 )
   BL read-opnd \ BL instead of ',' lessens chance of buffer o'flow
   get-hex-operand
   dup fe000000 ( -02000000) 02000000 within NOT IF ." ? "
      abort" branch target out of range" THEN
;
: get-rel-target ( -- n26 )
   BL read-opnd
   get-hex-operand
   addr - \ Make relative to address of current ppc-instruction
   ( re addr dependency: assemble address is also at stack depth 3 )
   dup -02000000 ( fe000000) 02000000 within NOT IF ." ? "
      abort" branch target out of range" THEN
;
: get-abs-hw ( -- n16 ) ( hw = "halfword" )
   BL read-opnd \ BL instead of ',' lessens chance of buffer o'flow
   get-hex-operand
   dup -08000 07fff between NOT IF ." ? "
      abort" branch target out of range" THEN
;
: get-rel-hw ( -- n16 )
   BL read-opnd
   get-hex-operand
   addr - \ Make relative to address of current ppc-instruction
   dup -08000 07fff between NOT IF ." ? "
      abort" branch target out of range" THEN
;
: get-unsigned-immed ( -- u16 )
  [CHAR] , read-opnd
   get-hex-operand
   dup 0 d# 65535 between NOT IF ." ? " 
       abort" immediate operand in range 0000 to ffff expected"
   THEN
;
: get-signed-immed ( -- s16 )
   [CHAR] , read-opnd
   get-hex-operand
   dup d# -32768 d# 32767 between NOT IF ." ? "
     abort" immediate operand in range -8000 (hex) to 7fff expected"
   THEN
   0000ffff AND \ keep only lower half-word
;
: get-signed-displacement ( -- s16 )
   [CHAR] ( read-opnd  \ always followed by (rA) or (r@) in src-code
   get-hex-operand
   dup d# -32768 d# 32767 between NOT IF ." ? "
     abort" displacement in range -8000 (hex) to 7fff expected"
   THEN
   0000ffff AND \ keep only lower half-word 
;
: get-8bit-mask ( -- u8 )
   get-unsigned-immed
   dup 0 d# 255 between NOT IF ." ? " 
       abort" hex operand in range 0 to 0xff expected"
   THEN  
;
: get-5hex ( -- u5 )
    get-unsigned-immed
    dup 0 01f between NOT IF ." ? "
        abort" hex operand in range 0 to 01f expected"
    THEN
;


\ -------------------------------------------------------------
\ --- operand input functions nominated in data table and  ----
\ --- executed via asm 'assemble' function near end of src ----
\
\ NB: The following 'assemble' words both input & parse argument
\     lists to suit individual ppc-instructions. Their action is
\     accumulative. Thus the more primitive words (eg '!rT', '!rA')
\     may be applied in series to define more complex words
\     (eg '!rTA'). They all share the same input and output 
\     specification ( opcode -- ppc-instruction ) which is
\     an abbreviation of
\
\     ( opcode|partially-complete-instrn -- whole|partial-instrn )
\
\     Except for a few representative cases,these and other comments
\     are omitted from most of the definitions below in the interest
\     of minimising repetition and file size.
\
\     Upper-case designators like T, A, B, etc signify position
\     of field within 32-bit ppc instruction. In use they all act
\     as wildcards for any value in the numeric range appropriate
\     to their host instr'n, most typically any value in the range
\     d# 0-31.  (See comments preceding 'table' for more info).

\ These higher level function names are prefixed with '!' to
\ distinguish from & show relationship to corresponding 'dis' functs

: !nil ;
: !all get-hex-operand ; \ any 32-bit unsigned hexadecimal number
: !nT get-nbr 015 << OR ;
: !nA get-nbr 010 << OR ;
: !nB get-nbr  0b << OR ;
: !nA=B get-nbr dup 5 << OR 0b << OR ;
: !nT=A=B get-nbr dup 5 << dup 5 << OR OR 0b << OR ; \ eg 'crset'
: !nTAB !nT !nA !nB     ; \ eg 'crand'
: !nTA=B !nT !nA=B      ; \ eg 'crmove'
: !nC get-nbr  06 << OR ;
: !nD get-nbr  01 << OR ;
: !nCD !nC !nD          ;
: !rT ( opcode -- ppc-instrn )
   get-gpr 015 << OR ;  \ eg 'mftbu rT' representing eg 'mftbu r31'
: !rA get-gpr 010 << OR ; \ primitive for other assemble functs
: !rB get-gpr 0b << OR  ; \ eg 'tlbie r31' as instance of'tlbie rB'
: !rC get-gpr 06 << OR  ;
: !rTA !rT !rA ; \ arg order reflects src syntax, ie addze rT,rA
: !rAB !rA !rB ;
: !rxAB !rB !rA ;
: !rTAB !rTA !rB ; \ eg 'mullw r0,r25,r1' as eg of mullw rT,rA,rB
: !rTxAB !rT !rxAB      ; \ eg 'sub'
: !r@ get-rA|0 010 << OR ; \ '0' (not r0) output when r@ replaces rA
: !rT@ !rT !r@ ;
: !r@B !r@ !rB ; \ eg 'dcbi'
: !rT@B !rT !r@B ; \ eg 'eciwx'
: !rT@nB !rT@ !nB ;
: !uI get-unsigned-immed OR ;
: !sI get-signed-immed OR ;
: !-sI get-signed-immed  negate  0000ffff AND  OR ;
: !rTsI !rT !sI ;
: !rT@sI !rT@ !sI ;
: !rT@-sI !rT@ !-sI ;
: !rT@uI !rT@ !uI ;
: !rTAsI !rTA !sI ;
: !rAsI !rA !sI ;
: !rAuI !rA !uI ;
: !rTB !rT !rB  ;
: !rS !rT ; \ eg 'mtmsr'
: !rS@B !rS !r@B ; \ eg 'ecowx'
: !rS@nB !rS !r@ !nB ;
: !rSB !rS !rB ;
: !rSAB !rS !rAB ;
: !sD get-signed-displacement OR ; \ primitive
: !(rA) get-(gpr) 010 << OR ;
: !(r@) get-(rA|0) 010 << OR ;
: !rTxsD !rT !sD ;
: !rTx(A)sD !rTxsD !(rA) ; \ eg 'stwu r11, -0c(r13)'
: !rTx(@)sD !rTxsD !(r@) ; \ 'x' swaps order of r@ and sD in src
: !rSx(A)sD !rTx(A)sD ;
: !rSx(@)sD !rTx(@)sD ;
: !gA get-segr 010 << OR ;
: !xLH get-spr-spec dup 001f AND 010 << swap 03e0 AND 6 << OR OR ;
: !rTgA !rT !gA ; \ 'mfsr'
: !rTxLH !rT !xLH ; \ 'mfspr'
: !rxSA !rA !rS ; \ 'x' swaps order of foll. opnds vs src syntax
: !rxSAB !rxSA !rB ;
: !rS=B get-gpr dup 0a << OR 0b << OR ; \ 1 src arg for 2 ppc-fields
: !rAS=B !rA !rS=B ; \ one src arg duplicated; 2 args -> 3 fields
  \ re !rAS=B . 'not.' forced departure from prev naming system
: !rxSABnCD !rxSAB !nCD ;     \ eg 'rlwnm'
: !rxSAnB !rxSA !nB ;
: !rxSAnBCD !rxSA !nB !nCD ;
: !rxSAuI !rxSA !uI ;  \ eg 'ori r13,r14,f' 'ori r13,r14,0x000f' etc
: !xrSgA !gA !rS ; \ 'mtsr'
: !mM get-8bit-mask 0c << OR ; \ 'mtcrf' mM = "Middle mask"=CR mask
: !mF get-8bit-mask 011 << OR ; \ 'mtfsf' mF = "FPSCR mask"
: !xrSmM !mM !rS ; \ 'mtcrf'
: !xrSxLH !xLH !rS ; \ 'mtspr'
: !fpT get-fpr 015 << OR ; \ eg 'mffs'
: !fpA get-fpr 010 << OR ; 
: !fpB get-fpr  0b << OR ;
: !fpC get-fpr  06 << OR ;
: !fpS !fpT ;
: !fpTA !fpT !fpA   ;
: !fpTAB !fpTA !fpB ; \ eg 'fsub'
: !fpTAC !fpTA !fpC ; \ eg 'fmul.'
: !fpTAxBC !fpTA !fpC !fpB ; \ nb: src order diff fm ppc field order
: !fpTr@B !fpT !r@B ;
: !fpTrAB !fpT !rAB ; \ eg 'lfsx'
: !fpTB !fpT !fpB   ; \ eg 'fneg frT,frB', as in 'fneg fr3,fr21'
: !fpSr@B !fpS !r@B ;
: !fpSrAB !fpS !rAB ;
: !fpTxsD !fpT !sD ;
: !fpTx(rA)sD !fpTxsD !(rA) ;
: !fpTx(r@)sD !fpTxsD !(r@) ;
: !fpSxsD !fpS !sD ;
: !fpSx(rA)sD !fpSxsD !(rA) ;
: !fpSx(r@)sD !fpSxsD !(r@) ;
: !mFfpB !mF !fpB ;
: !vT get-vec 015 << OR ;
: !vA get-vec 010 << OR ;
: !vB get-vec  0b << OR ;
: !vC get-vec  06 << OR ;
: !qB get4bits 0c << OR ; \ q = 'quad-bit' ie, a nybble, eg vsldoi
: !qC get4bits 06 << OR ;
: !vTAB !vT !vA !vB ;
: !vTrAB !vT !rAB ;
: !vSrAB !vTrAB ;
: !vTABC !vTAB !vC ;  \ eg 'vperm'
: !vTAxBC !vT !vA !vC !vB ; \ 'vmaddfp' and 'vnmsubfp' only
: !vTABqC !vTAB !qC ; \ eg 'vsldoi' ( doesn't like nC > 15 !!! )
: !vTB !vT !vB ;
: !sA get-signed-nbr 010 << OR ;
: !vTsA !vT !sA ; \ eg 'vspltisb v7,-f'
: !vTxnAvB !vTB !nA ;  \ eg 'vctuxs'
: !tT get2bits 015 << OR ; \ low-order 2 bits of field T, eg 'dst 3'
: !xtT[rAB] !rAB !tT ; \ eg 'dst r4,r3,2'
: !crT get-cr 017 << OR ;  \ 3 hi-bits -> field crT, eg 'mcrf'
: !crA get-cr 012 << OR ;  \ "crA" makes more sense than "crfS" here
: !crA|nil get-cr|nil 012 << OR ; \ crA defaults to 0 in br instrns
: !fA get-fld 012 << OR ; \ alt to '!crA' disallows FPSCR'cr' prefix
: !crTA !crT !crA ;  \ eg 'mcrf cr0, cr7' as example of mcrf crT,crA
: !crTfA !crT !fA ; \ no 'cr' prefix for FPSCR field,eg'mcrfs cr0,5'
: !crT.rA !crT get0&rA nip 10 << OR ; \ replace nip for G5 upgrade !
: !crTrAB !crT !rAB       ; \ 'cmpw' , 'cmplw'
: !crT.rAB !crT.rA !rB    ; \ 'cmp' , 'cmpl'
: !crTrAsI !crT !rAsI     ; \ 'cmpwi'
: !crT.rAsI !crT.rA !sI   ; \ 'cmpi'
: !crTrAuI !crT !rAuI     ; \ 'cmplwi'
: !crT.rAuI !crT.rA !uI   ; \ 'cmpli'
: !crTfpAB !crT !fpA !fpB ; \ 'fcmpo', 'fcmpu'
: !fT get-fld 017 << OR ; \ 3 hi-bits of field T, eg 'mtfsfi.'
: !fTqB !fT !qB ; \ the 'q' is for 'quad' ie, a nybble, eg 'mtfsfi'
: !?T get-5hex 015 << OR ; \ plus needs to screen out illegal codes
: !?S !?T ; \ temp?? ultimately 'S' to distinguish 'tw' fm 'b' codes
: !aJ get-abs-target 03fffffc AND OR ; \ 'ba' , 'bla'
: !rJ get-rel-target 03fffffc AND OR ; \ 'b' , 'bl'
: !aH get-abs-hw 0000fffc AND OR ; \ 'bdnza'
: !rH get-rel-hw 0000fffc AND OR ; \ 'bdz'
: !nAaH !nA !aH       ; \ 'bta', 'bfla'
: !nArH !nA !rH       ; \ 'bf', 'btl'
: !crAaH !crA|nil !aH ; \ 'bnea', 'bgta' \ '|nil' implied by crA
: !crArH !crA|nil !rH ; \ 'bne', beql    \ '|nil' implied by crA
: !?TnA !?T !nA       ; \ 'bclr', 'bclrl', 'bcctr', 'bcctrl'
: !?TnAaH !?TnA !aH   ; \ 'bca', 'bcla'
: !?TnArH !?TnA !rH   ; \ 'bc', 'bcl'
: !?SrAB !?S !rAB     ; \ 'tw'  ('S' vs 'T' implies diff. '?' codes)
: !*SrAB 7c1fffff AND !?SrAB ;  ( S* = wildcard replacement for ?S )
: !?SrAsI !?S !rA !sI ; \ 'twi' ('S' vs 'T' implies diff. '?' codes)
: !*SrAsI 7c1fffff AND !?SrAsI ; ( replace fixed ?S with user input)
\ ---------- ( end of 'asm' operand extraction functions ) ---------


\ The 'operands' fields in 'table' below have names which are a form
\ of shorthand describing their composition. These same labels are  
\ used to name and implement their extraction functions. Eg, the
\ most common register combinations derive from 5-bit fields in
\ fixed positions immediately following the obligatory six-bit
\ 'Major Opcode' on the far left of every 32-bit ppc instruction.
\ These most common operand fields are designated herein as T, A,
\ B, C.  Any lower-case letters preceding those upper-case register
\ names apply as modifiers to all following register designators
\ until a superceding lower-case letter is encountered. Thus
\ fpTrABnC would represent one floating-point register (T), two
\ general purpose registers (A and B) and a five-bit number (C).
\ The function "fpTrABnC" developed to implement it would thus
\ output (eg) fr3,r31,r4,23 , depending  on the contents extracted
\ from the fields so nominated.  Note that the upper-case names
\ refer to their relative position within 32-bit ppc instructions.
\ The disassembler syntax usually BUT NOT ALWAYS displays the
\ operands in the same left-to-right order they were extracted.
\ There are some exceptions to the above guidelines however:
\ eg a single 'x' does not necessarily supercede the preceding 
\ lower-case modifier. It means that the two registers to its right
\ are displayed in the opposite order to their relative positions
\ within the 32-bit ppc instruction they were extracted from. 
\
\ For more insights into the meanings of the uppercase designators,
\ refer to "Optimising PowerPC Code" by Gary Kacmarcik (Addison-
\ Wesley 1995). That book is the source of much of the ppc data
\ utilized for writing this disassembler. ('@' = short for 'A|0')
\ Online documention, since discovered, substitutes 'rD' for 'rT'.
\ Broadly, 'T' = Target, 'S' = "Source" ... The alphabetic symbols
\ can appear ambiguous without extra docs,esp when viewed with 'see'
\ after conversion to lower case ( 't'="Target","Transient"...? etc)
\ 'J' is a jump target address. It is a concatenation of the 
\ available fields TABCDRc except for the rhs two alignment bits
\ which are treated as part of the opcode by this disassembler.
\ 'H' is a shorter 16-bit branch target displacement address.
\
\ The lower-case modifier-prefixes are:
\
\   r  = general purpose register
\   fp = floating point register
\   v  = AltiVec register
\   m  = mask
\   n  = a number extracted from the same fields as abv, no prefix
\   t  = a 2-bit field, as used to identify an AltiVec Data Stream
\   f  = a 3-bit field nbr, typically upper 3 of normal 5-bit field
\   cf = similar to 'f', but displayed with 'cr' prefix
\   c  = a condition code: cX = normal 3-bit branch condition index 
\   g  = 4-bit number, eg seGment register id (displayed in decimal)
\   h  = 4-bit immediate data, eg bitmap of field (displayed in Hex)
\   ?  = at start of name = condition code for a branch or tw instrn
\   s  = signed (to the ppc & optionally displayed as such by 'dis')
\   u  = unsigned (applies to immed. data copied direct fm instr'n)
\   d  = a displacement or fixed offset fm number in associated reg.
\   a  = absolute address (as near as you can get with the major
\        opcode occupying the six lhs bits of the instruction).
\   r  = relative to address of current instruction.
\   (  = operand to be separated from prev one by '(' instead of ','
\   )  = Ignore. It is there to make the meaning of '(' clearer
\   x  = display the following two registers in reverse order
\   [] = group operands so x can apply to more than two registers
\   .  = Display a constant '0' at this point without affecting
\        anything else. (It can also be a '1' on 64-bit ppc's)
\   =  = Fills 2 fields fm same src operand. (NB: an infix operator)
\

\ s, works like , (comma) but appends string not nbr to dictionary
: s, ( address len -- ) ( " string" in source leaves args on stack )
here swap move
3 cells allot ;         \ requires 12-char string

: records cells 8 * ;
: record 1 records ;


0 value record->             
0 value table
0 value last-record
d# 530 constant #records
here to table  \ addr to begin appending instr'n array to dictionary

table #records records BL fill \ pre-pad for mnemonics

\ The following 530 records represent the G4 (7400) Instruction Set
\ plus a few other 32-bit PowerPC instructns not implemented on G4.
\ Simplified mnemonics, also known as Alternative Forms,are indented
\ one space adjacent to (or in place of) their instruction's Basic
\ Form. Although the Basic Form instructions are optionally sorted
\ in alphabetical order, their alternative form variants are listed
\ relative to them in reverse order of precedence. In a few cases,
\ there is a dependency on a particular arrangement of alternative
\ forms which can adversely affect recognition and display of other
\ variants of the same instruction should their relative placement
\ be changed.
\
\ 'asm' can see all mnemonics in the table, but 'dis' recognizes
\ only the final instance of any particular opcode. Thus the
\ lower in the table, the more preferred the form, since the
\ search order is backwards. A further consequence is that, when
\ one instruction variant is a synonym of another, only the lowest
\ one in the table gets echoed back by asm/azm, regardless of which
\ variant was typed when entering the instruction. That can be
\ corrected by instruction-specific patches in 'roughmask'.
\ In many, but not all, cases, that has been done.
\
\ ------------------------------------------------------------------
\ opcode   final-mask color mnemonic operands (commas do the poking)
\ ==================================================================
00000000 , 00000000 , 32 , " data" s, ' all , ' !all , ( pseudo-op )
\ Aliases placed above Basic Forms are seen by 'asm', not 'dis'
7c000214 , fc0007ff , 30 , " add" s, ' rTAB , ' !rTAB ,
7c000215 , fc0007ff , 30 , " add." s, ' rTAB , ' !rTAB ,
7c000014 , fc0007ff , 30 , " addc" s, ' rTAB , ' !rTAB ,
7c000015 , fc0007ff , 30 , " addc." s, ' rTAB , ' !rTAB ,
7c000414 , fc0007ff , 30 , " addco" s, ' rTAB , ' !rTAB ,
7c000415 , fc0007ff , 30 , " addco." s, ' rTAB , ' !rTAB ,
7c000114 , fc0007ff , 30 , " adde" s, ' rTAB , ' !rTAB ,
7c000115 , fc0007ff , 30 , " adde." s, ' rTAB , ' !rTAB ,
7c000514 , fc0007ff , 30 , " addeo" s, ' rTAB , ' !rTAB ,
7c000515 , fc0007ff , 30 , " addeo." s, ' rTAB , ' !rTAB ,
 38000000 , fc1f0000 , 30 , " li" s, ' rTsI , ' !rTsI ,   \ alias
 38000000 , fc000000 , 30 , " la" s, ' rTx(@)sD , ' !rTx(@)sD ,
 38000000 , fc000000 , 30 , " subi" s, ' rT@-sI , ' !rT@-sI ,
38000000 , fc000000 , 30 , " addi" s, ' rT@sI , ' !rT@sI ,
30000000 , fc000000 , 30 , " addic" s, ' rTAsI , ' !rTAsI ,
34000000 , fc000000 , 30 , " addic." s, ' rTAsI , ' !rTAsI ,
3c000000 , fc000000 , 30 , " addis" s, ' rT@uI , ' !rT@uI , \ ~rT@sI
7c0001d4 , fc00ffff , 30 , " addme" s, ' rTA , ' !rTA ,
7c0001d5 , fc00ffff , 30 , " addme." s, ' rTA , ' !rTA ,
7c0005d4 , fc00ffff , 30 , " addmeo" s, ' rTA , ' !rTA ,
7c0005d5 , fc00ffff , 30 , " addmeo." s, ' rTA , ' !rTA ,
7c000614 , fc0007ff , 30 , " addo" s, ' rTAB , ' !rTAB ,
7c000615 , fc0007ff , 30 , " addo." s, ' rTAB , ' !rTAB ,
7c000194 , fc00ffff , 30 , " addze" s, ' rTA , ' !rTA ,
7c000195 , fc00ffff , 30 , " addze." s, ' rTA , ' !rTA ,
7c000594 , fc00ffff , 30 , " addzeo" s, ' rTA , ' !rTA ,
7c000595 , fc00ffff , 30 , " addzeo." s, ' rTA , ' !rTA ,
7c000038 , fc0007ff , 30 , " and" s, ' rxSAB , ' !rxSAB ,
7c000039 , fc0007ff , 30 , " and." s, ' rxSAB , ' !rxSAB ,
7c000078 , fc0007ff , 30 , " andc" s, ' rxSAB , ' !rxSAB ,
7c000079 , fc0007ff , 30 , " andc." s, ' rxSAB , ' !rxSAB ,
70000000 , fc000000 , 30 , " andi." s, ' rxSAuI , ' !rxSAuI ,
74000000 , fc000000 , 30 , " andis." s, ' rxSAuI , ' !rxSAuI ,
48000000 , fc000003 , 30 , " b" s, ' rJ , ' !rJ ,
48000002 , fc000003 , 30 , " ba" s, ' aJ , ' !aJ ,
\ Basic form conditional branches are colored green since they now
\ get intercepted by a separate branch interpreter which substitutes
\ simplified forms. Since all useful branch instrns reputedly have
\ simpler forms, output of a green one probably indicates a mistake
\ (unless you specified the 'unsimplify' option described below)
40000000 , fc000003 , 32 , " bc" s, ' ?TnArH , ' !?TnArH ,
40000002 , fc000003 , 32 , " bca" s, ' ?TnAaH , ' !?TnAaH ,
4c000420 , fc00ffff , 32 , " bcctr" s, ' ?TnA , ' !?TnA ,
4c000421 , fc00ffff , 32 , " bcctrl" s, ' ?TnA , ' !?TnA ,
40000001 , fc000003 , 32 , " bcl" s, ' ?TnArH , ' !?TnArH ,
40000003 , fc000003 , 32 , " bcla" s, ' ?TnAaH , ' !?TnAaH ,
4c000020 , fc00ffff , 32 , " bclr" s, ' ?TnA , ' !?TnA ,
4c000021 , fc00ffff , 32 , " bclrl" s, ' ?TnA , ' !?TnA ,
48000001 , fc000003 , 30 , " bl" s, ' rJ , ' !rJ ,
48000003 , fc000003 , 30 , " bla" s, ' aJ , ' !aJ ,
\ cmp..'w'suffix = L-bit moved fm operand to mnemonic.Only L=0 valid
7c000000 , fc6007ff , 30 , " cmp" s, ' crT.rAB , ' !crT.rAB ,
 7c000000 , fc6007ff , 30 , " cmpw" s, ' crTrAB , ' !crTrAB ,
2c000000 , fc600000 , 30 , " cmpi" s, ' crT.rAsI , ' !crT.rAsI ,
 2c000000 , fc600000 , 30 , " cmpwi" s, ' crTrAsI , ' !crTrAsI ,
7c000040 , fc6007ff , 30 , " cmpl" s, ' crT.rAB , ' !crT.rAB ,
 7c000040 , fc6007ff , 30 , " cmplw" s, ' crTrAB , ' !crTrAB ,
28000000 , fc600000 , 30 , " cmpli" s, ' crT.rAuI , ' !crT.rAuI ,
 28000000 , fc600000 , 30 , " cmplwi" s, ' crTrAuI , ' !crTrAuI ,
7c000034 , fc00ffff , 30 , " cntlzw" s, ' rxSA , ' !rxSA ,
7c000035 , fc00ffff , 30 , " cntlzw." s, ' rxSA , ' !rxSA ,
4c000202 , fc0007ff , 30 , " crand" s, ' nTAB , ' !nTAB ,
4c000102 , fc0007ff , 30 , " crandc" s, ' nTAB , ' !nTAB ,
 4c000242 , fc0007ff , 30 , " crset" s, ' nil , ' !nT=A=B , \ alias
4c000242 , fc0007ff , 30 , " creqv" s, ' nTAB , ' !nTAB ,
4c0001c2 , fc0007ff , 30 , " crnand" s, ' nTAB , ' !nTAB ,
 4c000042 , fc0007ff , 30 , " crnot" s, ' nTAB , ' !nTA=B , \ alias
4c000042 , fc0007ff , 30 , " crnor" s, ' nTAB , ' !nTAB ,
 4c000382 , fc0007ff , 30 , " crmove" s, ' nTA , ' !nTA=B , \ alias
4c000382 , fc0007ff , 30 , " cror" s, ' nTAB , ' !nTAB ,
4c000342 , fc0007ff , 30 , " crorc" s, ' nTAB , ' !nTAB ,
 4c000182 , fc0007ff , 30 , " crclr" s, ' nTAB , ' !nT=A=B , \ alias
4c000182 , fc0007ff , 30 , " crxor" s, ' nTAB , ' !nTAB ,
7c0005ec , ffe007ff , 30 , " dcba" s, ' r@B , ' !r@B ,
7c0000ac , ffe007ff , 30 , " dcbf" s, ' r@B , ' !r@B ,
7c0003ac , ffe007ff , 34 , " dcbi" s, ' r@B , ' !r@B ,
7c00006c , ffe007ff , 30 , " dcbst" s, ' r@B , ' !r@B ,
7c00022c , ffe007ff , 30 , " dcbt" s, ' r@B , ' !r@B ,
7c0001ec , ffe007ff , 30 , " dcbtst" s, ' r@B , ' !r@B ,
7c0007ec , ffe007ff , 30 , " dcbz" s, ' r@B , ' !r@B ,
7c0003d6 , fc0007ff , 30 , " divw" s, ' rTAB , ' !rTAB ,
7c0003d7 , fc0007ff , 30 , " divw." s, ' rTAB , ' !rTAB ,
7c0007d6 , fc0007ff , 30 , " divwo" s, ' rTAB , ' !rTAB ,
7c0007d7 , fc0007ff , 30 , " divwo." s, ' rTAB , ' !rTAB ,
7c000396 , fc0007ff , 30 , " divwu" s, ' rTAB , ' !rTAB ,
7c000397 , fc0007ff , 30 , " divwu." s, ' rTAB , ' !rTAB ,
7c000796 , fc0007ff , 30 , " divwuo" s, ' rTAB , ' !rTAB ,
7c000797 , fc0007ff , 30 , " divwuo." s, ' rTAB , ' !rTAB ,
 7c00066c , ff9fffff , 31 , " dss" s, ' tT , ' !tT , \ = dss X,0
 7e00066c , ff9fffff , 31 , " dssall" s, ' nil , ' !nil , \ =dss X,1
\ ds instrns: "T" or "ALL" bit moved to mnemonic.Extra "t" means T=1
 7c0002ac , ff8007ff , 31 , " dst" s, ' xtT[rAB] , ' !xtT[rAB] ,
 7e0002ac , ff8007ff , 31 , " dstt" s, ' xtT[rAB] , ' !xtT[rAB] ,
 7c0002ec , ff8007ff , 31 , " dstst" s, ' xtT[rAB] , ' !xtT[rAB] ,
 7e0002ec , ff8007ff , 31 , " dststt" s, ' xtT[rAB] , ' !xtT[rAB] ,
7c00026c , fc0007ff , 30 , " eciwx" s, ' rT@B , ' !rT@B ,
7c00036c , fc0007ff , 30 , " ecowx" s, ' rS@B , ' !rS@B ,
7c0006ac , ffffffff , 30 , " eieio" s, ' nil , ' !nil ,
7c000238 , fc0007ff , 30 , " eqv" s, ' rxSAB , ' !rxSAB ,
7c000239 , fc0007ff , 30 , " eqv." s, ' rxSAB , ' !rxSAB ,
7c000774 , fc00ffff , 30 , " extsb" s, ' rxSA , ' !rxSA ,
7c000775 , fc00ffff , 30 , " extsb." s, ' rxSA , ' !rxSA ,
7c000734 , fc00ffff , 30 , " extsh" s, ' rxSA , ' !rxSA ,
7c000735 , fc00ffff , 30 , " extsh." s, ' rxSA , ' !rxSA ,
fc000210 , fc1f07ff , 30 , " fabs" s, ' fpTB , ' !fpTB ,
fc000211 , fc1f07ff , 30 , " fabs." s, ' fpTB , ' !fpTB ,
fc00002a , fc0007ff , 30 , " fadd" s, ' fpTAB , ' !fpTAB ,
fc00002b , fc0007ff , 30 , " fadd." s, ' fpTAB , ' !fpTAB ,
ec00002a , fc0007ff , 30 , " fadds" s, ' fpTAB , ' !fpTAB ,
ec00002b , fc0007ff , 30 , " fadds." s, ' fpTAB , ' !fpTAB ,
fc000040 , fc6007ff , 30 , " fcmpo" s, ' crTfpAB , ' !crTfpAB ,
fc000000 , fc6007ff , 30 , " fcmpu" s, ' crTfpAB , ' !crTfpAB ,
fc00001c , fc1f07ff , 30 , " fctiw" s, ' fpTB , ' !fpTB ,
fc00001d , fc1f07ff , 30 , " fctiw." s, ' fpTB , ' !fpTB ,
fc00001e , fc1f07ff , 30 , " fctiwz" s, ' fpTB , ' !fpTB ,
fc00001f , fc1f07ff , 30 , " fctiwz." s, ' fpTB , ' !fpTB ,
fc000024 , fc00003f , 30 , " fdiv" s, ' fpTAB , ' !fpTAB ,
fc000025 , fc00003f , 30 , " fdiv." s, ' fpTAB , ' !fpTAB ,
ec000024 , fc0007ff , 30 , " fdivs" s, ' fpTAB , ' !fpTAB ,
ec000025 , fc0007ff , 30 , " fdivs." s, ' fpTAB , ' !fpTAB ,
fc00003a , fc00003f , 30 , " fmadd" s, ' fpTAxBC , ' !fpTAxBC ,
fc00003b , fc00003f , 30 , " fmadd." s, ' fpTAxBC , ' !fpTAxBC ,
ec00003a , fc00003f , 30 , " fmadds" s, ' fpTAxBC , ' !fpTAxBC ,
ec00003b , fc00003f , 30 , " fmadds." s, ' fpTAxBC , ' !fpTAxBC ,
fc000090 , fc1f07ff , 30 , " fmr" s, ' fpTB , ' !fpTB ,
fc000091 , fc1f07ff , 30 , " fmr." s, ' fpTB , ' !fpTB ,
fc000038 , fc00003f , 30 , " fmsub" s, ' fpTAxBC , ' !fpTAxBC ,
fc000039 , fc00003f , 30 , " fmsub." s, ' fpTAxBC , ' !fpTAxBC ,
ec000038 , fc00003f , 30 , " fmsubs" s, ' fpTAxBC , ' !fpTAxBC ,
ec000039 , fc00003f , 30 , " fmsubs." s, ' fpTAxBC , ' !fpTAxBC ,
fc000032 , fc00f83f , 30 , " fmul" s, ' fpTAC , ' !fpTAC ,
fc000033 , fc00f83f , 30 , " fmul." s, ' fpTAC , ' !fpTAC ,
ec000032 , fc00f83f , 30 , " fmuls" s, ' fpTAC , ' !fpTAC ,
ec000033 , fc00f83f , 30 , " fmuls." s, ' fpTAC , ' !fpTAC ,
fc000110 , fc1f07ff , 30 , " fnabs" s, ' fpTB , ' !fpTB ,
fc000111 , fc1f07ff , 30 , " fnabs." s, ' fpTB , ' !fpTB ,
fc000050 , fc1f07ff , 30 , " fneg" s, ' fpTB , ' !fpTB ,
fc000051 , fc1f07ff , 30 , " fneg." s, ' fpTB , ' !fpTB ,
fc00003e , fc00003f , 30 , " fnmadd" s, ' fpTAxBC , ' !fpTAxBC ,
fc00003f , fc00003f , 30 , " fnmadd." s, ' fpTAxBC , ' !fpTAxBC ,
ec00003e , fc00003f , 30 , " fnmadds" s, ' fpTAxBC , ' !fpTAxBC ,
ec00003f , fc00003f , 30 , " fnmadds." s, ' fpTAxBC , ' !fpTAxBC ,
fc00003c , fc00003f , 30 , " fnmsub" s, ' fpTAxBC , ' !fpTAxBC ,
fc00003d , fc00003f , 30 , " fnmsub." s, ' fpTAxBC , ' !fpTAxBC ,
ec00003c , fc00003f , 30 , " fnmsubs" s, ' fpTAxBC , ' !fpTAxBC ,
ec00003d , fc00003f , 30 , " fnmsubs." s, ' fpTAxBC , ' !fpTAxBC ,
ec000030 , fc1f07ff , 30 , " fres" s, ' fpTB , ' !fpTB ,
ec000031 , fc1f07ff , 30 , " fres." s, ' fpTB , ' !fpTB ,
fc000018 , fc1f07ff , 30 , " frsp" s, ' fpTB , ' !fpTB ,
fc000019 , fc1f07ff , 30 , " frsp." s, ' fpTB , ' !fpTB ,
fc000034 , fc1f07ff , 30 , " frsqrte" s, ' fpTB , ' !fpTB ,
fc000035 , fc1f07ff , 30 , " frsqrte." s, ' fpTB , ' !fpTB ,
fc00002e , fc00003f , 30 , " fsel" s, ' fpTAxBC , ' !fpTAxBC ,
fc00002f , fc00003f , 30 , " fsel." s, ' fpTAxBC , ' !fpTAxBC ,
fc00002c , fc1f07ff , 33 , " fsqrt" s, ' fpTB , ' !fpTB ,
fc00002d , fc1f07ff , 33 , " fsqrt." s, ' fpTB , ' !fpTB ,
ec00002c , fc1f07ff , 33 , " fsqrts" s, ' fpTB , ' !fpTB ,
ec00002d , fc1f07ff , 33 , " fsqrts." s, ' fpTB , ' !fpTB ,
fc000028 , fc0007ff , 30 , " fsub" s, ' fpTAB , ' !fpTAB ,
fc000029 , fc0007ff , 30 , " fsub." s, ' fpTAB , ' !fpTAB ,
ec000028 , fc0007ff , 30 , " fsubs" s, ' fpTAB , ' !fpTAB ,
ec000029 , fc0007ff , 30 , " fsubs." s, ' fpTAB , ' !fpTAB ,
7c0007ac , ffe007ff , 30 , " icbi" s, ' r@B , ' !r@B ,
4c00012c , ffffffff , 30 , " isync" s, ' nil , ' !nil ,
88000000 , fc000000 , 30 , " lbz" s, ' rTx(@)sD , ' !rTx(@)sD ,
8c000000 , fc000000 , 30 , " lbzu" s, ' rTx(A)sD , ' !rTx(A)sD ,
7c0000ee , fc0007ff , 30 , " lbzux" s, ' rTAB , ' !rTAB ,
7c0000ae , fc0007ff , 30 , " lbzx" s, ' rT@B , ' !rT@B ,
c8000000 , fc000000 , 30 , " lfd" s, ' fpTx(r@)sD , ' !fpTx(r@)sD ,
cc000000 , fc000000 , 30 , " lfdu" s, ' fpTx(rA)sD , ' !fpTx(rA)sD ,
7c0004ee , fc0007ff , 30 , " lfdux" s, ' fpTrAB , ' !fpTrAB ,
7c0004ae , fc0007ff , 30 , " lfdx" s, ' fpTr@B , ' !fpTr@B ,
c0000000 , fc000000 , 30 , " lfs" s, ' fpTx(r@)sD , ' !fpTx(r@)sD ,
c4000000 , fc000000 , 30 , " lfsu" s, ' fpTx(rA)sD , ' !fpTx(rA)sD ,
7c00046e , fc0007ff , 30 , " lfsux" s, ' fpTrAB , ' !fpTrAB ,
7c00042e , fc0007ff , 30 , " lfsx" s, ' fpTr@B , ' !fpTr@B ,
a8000000 , fc000000 , 30 , " lha" s, ' rTx(@)sD , ' !rTx(@)sD ,
ac000000 , fc000000 , 30 , " lhau" s, ' rTx(A)sD , ' !rTx(A)sD ,
7c0002ee , fc0007ff , 30 , " lhaux" s, ' rTAB , ' !rTAB ,
7c0002ae , fc0007ff , 30 , " lhax" s, ' rT@B , ' !rT@B ,
7c00062c , fc0007ff , 30 , " lhbrx" s, ' rT@B , ' !rT@B ,
a0000000 , fc000000 , 30 , " lhz" s, ' rTx(@)sD , ' !rTx(@)sD ,
a4000000 , fc000000 , 30 , " lhzu" s, ' rTx(A)sD , ' !rTx(A)sD ,
7c00026e , fc0007ff , 30 , " lhzux" s, ' rTAB , ' !rTAB ,
7c00022e , fc0007ff , 30 , " lhzx" s, ' rT@B , ' !rT@B ,
b8000000 , fc000000 , 30 , " lmw" s, ' rTx(@)sD , ' !rTx(@)sD ,
7c0004aa , fc0007ff , 30 , " lswi" s, ' rT@nB , ' !rT@nB ,
7c00042a , fc0007ff , 30 , " lswx" s, ' rT@B , ' !rT@B ,
7c00000e , fc0007ff , 31 , " lvebx" s, ' vTrAB , ' !vTrAB ,
7c00004e , fc0007ff , 31 , " lvehx" s, ' vTrAB , ' !vTrAB ,
7c00008e , fc0007ff , 31 , " lvewx" s, ' vTrAB , ' !vTrAB ,
7c00000c , fc0007ff , 31 , " lvsl" s, ' vTrAB , ' !vTrAB ,
7c00004c , fc0007ff , 31 , " lvsr" s, ' vTrAB , ' !vTrAB ,
7c0000ce , fc0007ff , 31 , " lvx" s, ' vTrAB , ' !vTrAB ,
7c0002ce , fc0007ff , 31 , " lvxl" s, ' vTrAB , ' !vTrAB ,
7c000028 , fc0007ff , 30 , " lwarx" s, ' rT@B , ' !rT@B ,
7c00042c , fc0007ff , 30 , " lwbrx" s, ' rT@B , ' !rT@B ,
80000000 , fc000000 , 30 , " lwz" s, ' rTx(@)sD , ' !rTx(@)sD ,
84000000 , fc000000 , 30 , " lwzu" s, ' rTx(A)sD , ' !rTx(A)sD ,
7c00006e , fc0007ff , 30 , " lwzux" s, ' rTAB , ' !rTAB ,
7c00002e , fc0007ff , 30 , " lwzx" s, ' rT@B , ' !rT@B ,
4c000000 , fc63ffff , 30 , " mcrf" s, ' crTA , ' !crTA ,
fc000080 , fc63ffff , 30 , " mcrfs" s, ' crTfA , ' !crTfA ,
7c000400 , fc7fffff , 30 , " mcrxr" s, ' crT , ' !crT ,
7c000026 , fc1fffff , 30 , " mfcr" s, ' rT , ' !rT ,
fc00048e , fc1fffff , 30 , " mffs" s, ' fpT , ' !fpT ,
fc00048f , fc1fffff , 30 , " mffs." s, ' fpT , ' !fpT ,
7c0000a6 , fc1fffff , 34 , " mfmsr" s, ' rT , ' !rT ,
\ mfspr and mtspr user-level instrns simplified, supvr: use spr-nbrs
7c0002a6 , fc0007ff , 34 , " mfspr" s, ' rTxLH , ' !rTxLH , \ supvr
 7c0102a6 , fc1fffff , 30 , " mfxer" s, ' rT , ' !rT , \ =mfspr rT,1
 7c0802a6 , fc1fffff , 30 , " mflr" s, ' rT , ' !rT ,  \ =mfspr rT,8
 7c0902a6 , fc1fffff , 30 , " mfctr" s, ' rT , ' !rT , \ =mfspr rT,9
7c0004a6 , fc10ffff , 34 , " mfsr" s, ' rTgA , ' !rTgA ,
7c000526 , fc1f07ff , 34 , " mfsrin" s, ' rTB , ' !rTB ,
\ Basic Form 'mftb' removed as 268 & 269 are its only valid operands
\ 7c0002e6 , fc0007ff , 30 , " mftb" s, ' rTxLH , ' !rTxLH ,
7c0c42e6 , fc1fffff , 30 , " mftb" s, ' rT , ' !rT , \ 'mftb rT,268'
7c0d42e6 , fc1fffff , 30 , " mftbu" s, ' rT , ' !rT , \ mftb rT,269
10000604 , fc1fffff , 31 , " mfvscr" s, ' vT , ' !vT ,
7c000120 , fc100fff , 30 , " mtcrf" s, ' xrSmM , ' !xrSmM ,
 7c0ff120 , fc1fffff , 30 , " mtcr" s, ' rS , ' !rS , \ =mtcrf ff,rS
fc00008c , fc1fffff , 30 , " mtfsb0" s, ' nT , ' !nT ,
fc00008d , fc1fffff , 30 , " mtfsb0." s, ' nT , ' !nT ,
fc00004c , fc1fffff , 30 , " mtfsb1" s, ' nT , ' !nT ,
fc00004d , fc1fffff , 30 , " mtfsb1." s, ' nT , ' !nT ,
fc00058e , fe0107ff , 30 , " mtfsf" s, ' mFfpB , ' !mFfpB ,
 fdfe058e , ffff07ff , 30 , " mtfs" s, ' fpB , ' !fpB ,
fc00058f , fe0107ff , 30 , " mtfsf." s, ' mFfpB , ' !mFfpB ,
 fdfe058f , ffff07ff , 30 , " mtfs." s, ' fpB , ' !fpB ,
fc00010c , fc7f0fff , 30 , " mtfsfi" s, ' fTqB , ' !fTqB ,
fc00010d , fc7f0fff , 30 , " mtfsfi." s, ' fTqB , ' !fTqB ,
7c000124 , fc1fffff , 34 , " mtmsr" s, ' rS , ' !rS ,
\ spr# named & moved fm opnd to mnemonic for user-level mtspr's only
7c0003a6 , fc0007ff , 34 , " mtspr" s, ' xrSxLH , ' !xrSxLH , \ supr
 7c0103a6 , fc1fffff , 30 , " mtxer" s, ' rS , ' !rS , \ =mtspr 1,rS
 7c0803a6 , fc1fffff , 30 , " mtlr"  s, ' rS , ' !rS , \ =mtspr 8,rS
 7c0903a6 , fc1fffff , 30 , " mtctr" s, ' rS , ' !rS , \ =mtspr 9,rS
7c0001a4 , fc10ffff , 34 , " mtsr" s, ' xrSgA , ' !xrSgA ,
7c0001e4 , fc1f07ff , 34 , " mtsrin" s, ' rSB , ' !rSB ,
10000644 , ffff07ff , 31 , " mtvscr" s, ' vB , ' !vB ,
7c000096 , fc0007ff , 30 , " mulhw" s, ' rTAB , ' !rTAB ,
7c000097 , fc0007ff , 30 , " mulhw." s, ' rTAB , ' !rTAB ,
7c000016 , fc0007ff , 30 , " mulhwu" s, ' rTAB , ' !rTAB ,
7c000017 , fc0007ff , 30 , " mulhwu." s, ' rTAB , ' !rTAB ,
1c000000 , fc000000 , 30 , " mulli" s, ' rTAsI , ' !rTAsI ,
7c0001d6 , fc0007ff , 30 , " mullw" s, ' rTAB , ' !rTAB ,
7c0001d7 , fc0007ff , 30 , " mullw." s, ' rTAB , ' !rTAB ,
7c0005d6 , fc0007ff , 30 , " mullwo" s, ' rTAB , ' !rTAB ,
7c0005d7 , fc0007ff , 30 , " mullwo." s, ' rTAB , ' !rTAB ,
7c0003b8 , fc0007ff , 30 , " nand" s, ' rxSAB , ' !rxSAB ,
7c0003b9 , fc0007ff , 30 , " nand." s, ' rxSAB , ' !rxSAB ,
7c0000d0 , fc00ffff , 30 , " neg" s, ' rTA , ' !rTA ,
7c0000d1 , fc00ffff , 30 , " neg." s, ' rTA , ' !rTA ,
7c0004d0 , fc00ffff , 30 , " nego" s, ' rTA , ' !rTA ,
7c0004d1 , fc00ffff , 30 , " nego." s, ' rTA , ' !rTA ,
 7c0000f8 , fc0007ff , 30 , " not" s, ' rxSA , ' !rAS=B ,
7c0000f8 , fc0007ff , 30 , " nor" s, ' rxSAB , ' !rxSAB ,
 7c0000f9 , fc0007ff , 30 , " not." s, ' rxSAB , ' !rAS=B ,
7c0000f9 , fc0007ff , 30 , " nor." s, ' rxSAB , ' !rxSAB ,
 7c000378 , fc0007ff , 30 , " mr" s, ' rxSAB , ' !rAS=B ,
7c000378 , fc0007ff , 30 , " or" s, ' rxSAB , ' !rxSAB ,
 7c000379 , fc0007ff , 30 , " mr." s, ' rxSAB , ' !rAS=B ,
7c000379 , fc0007ff , 30 , " or." s, ' rxSAB , ' !rxSAB ,
7c000338 , fc0007ff , 30 , " orc" s, ' rxSAB , ' !rxSAB ,
7c000339 , fc0007ff , 30 , " orc." s, ' rxSAB , ' !rxSAB ,
 60000000 , ffffffff , 35 , " nop" s, ' nil , ' !nil , \ ori r0,r0,0
60000000 , fc000000 , 30 , " ori" s, ' rxSAuI , ' !rxSAuI ,
64000000 , fc000000 , 30 , " oris" s, ' rxSAuI , ' !rxSAuI ,
4c000064 , ffffffff , 34 , " rfi" s, ' nil , ' !nil ,
50000000 , fc000001 , 30 , " rlwimi" s, ' rxSAnBCD , ' !rxSAnBCD ,
50000001 , fc000001 , 30 , " rlwimi." s, ' rxSAnBCD , ' !rxSAnBCD ,
54000000 , fc000001 , 30 , " rlwinm" s, ' rxSAnBCD , ' !rxSAnBCD ,
54000001 , fc000001 , 30 , " rlwinm." s, ' rxSAnBCD , ' !rxSAnBCD ,
5c000000 , fc000001 , 30 , " rlwnm" s, ' rxSABnCD , ' !rxSABnCD ,
 5c0000ce , fc0007ff , 30 , " rotlw" s, ' rxSAB , ' !rxSAB ,
5c000001 , fc000001 , 30 , " rlwnm." s, ' rxSABnCD , ' !rxSABnCD ,
 5c0000cf , fc0007ff , 30 , " rotlw." s, ' rxSAB , ' !rxSAB ,
44000002 , ffffffff , 30 , " sc" s, ' nil , ' !nil ,
7c000030 , fc0007ff , 30 , " slw" s, ' rxSAB , ' !rxSAB ,
7c000031 , fc0007ff , 30 , " slw." s, ' rxSAB , ' !rxSAB ,
7c000630 , fc0007ff , 30 , " sraw" s, ' rxSAB , ' !rxSAB ,
7c000631 , fc0007ff , 30 , " sraw." s, ' rxSAB , ' !rxSAB ,
7c000670 , fc0007ff , 30 , " srawi" s, ' rxSAnB , ' !rxSAnB ,
7c000671 , fc0007ff , 30 , " srawi." s, ' rxSAnB , ' !rxSAnB ,
7c000430 , fc0007ff , 30 , " srw" s, ' rxSAB , ' !rxSAB ,
7c000431 , fc0007ff , 30 , " srw." s, ' rxSAB , ' !rxSAB ,
98000000 , fc000000 , 30 , " stb" s, ' rSx(@)sD , ' !rSx(@)sD ,
9c000000 , fc000000 , 30 , " stbu" s, ' rSx(A)sD , ' !rSx(A)sD ,
7c0001ee , fc0007ff , 30 , " stbux" s, ' rSAB , ' !rSAB ,
7c0001ae , fc0007ff , 30 , " stbx" s, ' rS@B , ' !rS@B ,
d8000000 , fc000000 , 30 , " stfd" s, ' fpSx(r@)sD , ' !fpSx(r@)sD ,
dc000000 , fc000000 , 30 , " stfdu" s, ' fpSx(rA)sD , ' !fpSx(rA)sD ,
7c0005ee , fc0007ff , 30 , " stfdux" s, ' fpSrAB , ' !fpSrAB ,
7c0005ae , fc0007ff , 30 , " stfdx" s, ' fpSr@B , ' !fpSr@B ,
7c0007ae , fc0007ff , 30 , " stfiwx" s, ' fpSr@B , ' !fpSr@B ,
d0000000 , fc000000 , 30 , " stfs" s, ' fpSx(r@)sD , ' !fpSx(r@)sD ,
d4000000 , fc000000 , 30 , " stfsu" s, ' fpSx(rA)sD , ' !fpSx(rA)sD ,
7c00056e , fc0007ff , 30 , " stfsux" s, ' fpSrAB , ' !fpSrAB ,
7c00052e , fc0007ff , 30 , " stfsx" s, ' fpSr@B , ' !fpSr@B ,
b0000000 , fc000000 , 30 , " sth" s, ' rSx(@)sD , ' !rSx(@)sD ,
7c00072c , fc0007ff , 30 , " sthbrx" s, ' rS@B , ' !rS@B ,
b4000000 , fc000000 , 30 , " sthu" s, ' rSx(A)sD , ' !rSx(A)sD ,
7c00036e , fc0007ff , 30 , " sthux" s, ' rSAB , ' !rSAB ,
7c00032e , fc0007ff , 30 , " sthx" s, ' rS@B , ' !rS@B ,
bc000000 , fc000000 , 30 , " stmw" s, ' rSx(@)sD , ' !rSx(@)sD ,
7c0005aa , fc0007ff , 30 , " stswi" s, ' rS@nB , ' !rS@nB ,
7c00052a , fc0007ff , 30 , " stswx" s, ' rS@B , ' !rS@B ,
7c00010e , fc0007ff , 31 , " stvebx" s, ' vSrAB , ' !vSrAB ,
7c00014e , fc0007ff , 31 , " stvehx" s, ' vSrAB , ' !vSrAB ,
7c00018e , fc0007ff , 31 , " stvewx" s, ' vSrAB , ' !vSrAB ,
7c0001ce , fc0007ff , 31 , " stvx" s, ' vSrAB , ' !vSrAB ,
7c0003ce , fc0007ff , 31 , " stvxl" s, ' vSrAB , ' !vSrAB ,
90000000 , fc000000 , 30 , " stw" s, ' rSx(@)sD , ' !rSx(@)sD ,
7c00052c , fc0007ff , 30 , " stwbrx" s, ' rS@B , ' !rS@B ,
7c00012d , fc0007ff , 30 , " stwcx." s, ' rS@B , ' !rS@B ,
94000000 , fc000000 , 30 , " stwu" s, ' rSx(A)sD , ' !rSx(A)sD ,
7c00016e , fc0007ff , 30 , " stwux" s, ' rSAB , ' !rSAB ,
7c00012e , fc0007ff , 30 , " stwx" s, ' rS@B , ' !rS@B ,
7c000050 , fc0007ff , 30 , " subf" s, ' rTAB , ' !rTAB ,
 7c000050 , fc0007ff , 30 , " sub" s, ' rTxAB , ' !rTxAB ,
7c000051 , fc0007ff , 30 , " subf." s, ' rTAB , ' !rTAB ,
 7c000051 , fc0007ff , 30 , " sub." s, ' rTxAB , ' !rTxAB ,
7c000010 , fc0007ff , 30 , " subfc" s, ' rTAB , ' !rTAB ,
7c000011 , fc0007ff , 30 , " subfc." s, ' rTAB , ' !rTAB ,
7c000410 , fc0007ff , 30 , " subfco" s, ' rTAB , ' !rTAB ,
7c000411 , fc0007ff , 30 , " subfco." s, ' rTAB , ' !rTAB ,
7c000110 , fc0007ff , 30 , " subfe" s, ' rTAB , ' !rTAB ,
7c000111 , fc0007ff , 30 , " subfe." s, ' rTAB , ' !rTAB ,
7c000510 , fc0007ff , 30 , " subfeo" s, ' rTAB , ' !rTAB ,
7c000511 , fc0007ff , 30 , " subfeo." s, ' rTAB , ' !rTAB ,
20000000 , fc000000 , 30 , " subfic" s, ' rTAsI , ' !rTAsI ,
7c0001d0 , fc00ffff , 30 , " subfme" s, ' rTA , ' !rTA ,
7c0001d1 , fc00ffff , 30 , " subfme." s, ' rTA , ' !rTA ,
7c0005d0 , fc00ffff , 30 , " subfmeo" s, ' rTA , ' !rTA ,
7c0005d1 , fc00ffff , 30 , " subfmeo." s, ' rTA , ' !rTA ,
7c000450 , fc0007ff , 30 , " subfo" s, ' rTAB , ' !rTAB ,
 7c000450 , fc0007ff , 30 , " subo" s, ' rTxAB , ' !rTxAB ,
7c000451 , fc0007ff , 30 , " subfo." s, ' rTAB , ' !rTAB ,
 7c000451 , fc0007ff , 30 , " subo." s, ' rTxAB , ' !rTxAB ,
7c000190 , fc00ffff , 30 , " subfze" s, ' rTA , ' !rTA ,
7c000191 , fc00ffff , 30 , " subfze." s, ' rTA , ' !rTA ,
7c000590 , fc00ffff , 30 , " subfzeo" s, ' rTA , ' !rTA ,
7c000591 , fc00ffff , 30 , " subfzeo." s, ' rTA , ' !rTA ,
7c0004ac , ffffffff , 30 , " sync" s, ' nil , ' !nil ,
7c0002e4 , ffffffff , 33 , " tlbia" s, ' nil , ' !nil , \ subj2opnd
7c000264 , ffff07ff , 34 , " tlbie" s, ' rB , ' !rB ,
7c0007a4 , ffff07ff , 34 , " tlbld" s, ' rB , ' !rB ,
7c0007e4 , ffff07ff , 34 , " tlbli" s, ' rB , ' !rB ,
7c00046c , ffffffff , 34 , " tlbsync" s, ' nil , ' !nil ,
\ All valid 'tw' variants are preempted by aliases. Others -> "data"
\ 7fc = 'tw' creates loophole to accommodate 'asm-help' and allows
\ experimental creation of undocumented trap instructions.
7fc00008 , ffe007ff , 32 , " tw" s, ' ?SrAB , ' !*SrAB , \ dummy opc
 7fe00008 , ffffffff , 30 , " trap" s, ' nil , ' !nil ,
 7d800008 , ffe007ff , 30 , " twnl" s, ' rAB , ' !rAB , \ = 'twge'
 7d800008 , ffe007ff , 30 , " twge" s, ' rAB , ' !rAB ,
 7e800008 , ffe007ff , 30 , " twng" s, ' rAB , ' !rAB , \ = 'twle'
 7e800008 , ffe007ff , 30 , " twle" s, ' rAB , ' !rAB ,
 7c800008 , ffe007ff , 30 , " tweq" s, ' rAB , ' !rAB ,
 7f000008 , ffe007ff , 30 , " twne" s, ' rAB , ' !rAB ,
 7d000008 , ffe007ff , 30 , " twgt" s, ' rAB , ' !rAB ,
 7e000008 , ffe007ff , 30 , " twlt" s, ' rAB , ' !rAB ,
 7cc00008 , ffe007ff , 30 , " twlng" s, ' rAB , ' !rAB , \ = 'twlle'
 7cc00008 , ffe007ff , 30 , " twlle" s, ' rAB , ' !rAB ,
 7ca00008 , ffe007ff , 30 , " twlnl" s, ' rAB , ' !rAB , \ = 'twlge'
 7ca00008 , ffe007ff , 30 , " twlge" s, ' rAB , ' !rAB ,
 7c400008 , ffe007ff , 30 , " twllt" s, ' rAB , ' !rAB ,
 7c200008 , ffe007ff , 30 , " twlgt" s, ' rAB , ' !rAB ,
0fc00000 , ffe00000 , 32 , " twi" s, ' ?SrAsI , ' !*SrAsI , \ dummy
 0e800000 , ffe00000 , 30 , " twngi" s, ' rAsI , ' !rAsI , \ = twlei
 0e800000 , ffe00000 , 30 , " twlei" s, ' rAsI , ' !rAsI ,
 0d800000 , ffe00000 , 30 , " twnli" s, ' rAsI , ' !rAsI , \ = twgei
 0d800000 , ffe00000 , 30 , " twgei" s, ' rAsI , ' !rAsI ,
 0c800000 , ffe00000 , 30 , " tweqi" s, ' rAsI , ' !rAsI ,
 0d000000 , ffe00000 , 30 , " twgti" s, ' rAsI , ' !rAsI ,
 0e000000 , ffe00000 , 30 , " twlti" s, ' rAsI , ' !rAsI ,
 0f000000 , ffe00000 , 30 , " twnei" s, ' rAsI , ' !rAsI ,
 0cc00000 , ffe00000 , 30 , " twlngi" s, ' rAsI , ' !rAsI , \ twllei
 0cc00000 , ffe00000 , 30 , " twllei" s, ' rAsI , ' !rAsI ,
 0ca00000 , ffe00000 , 30 , " twlnli" s, ' rAsI , ' !rAsI , \ twlgei
 0ca00000 , ffe00000 , 30 , " twlgei" s, ' rAsI , ' !rAsI ,
 0c400000 , ffe00000 , 30 , " twllti" s, ' rAsI , ' !rAsI , 
 0c200000 , ffe00000 , 30 , " twlgti" s, ' rAsI , ' !rAsI ,
10000180 , fc0007ff , 31 , " vaddcuw" s, ' vTAB , ' !vTAB ,
1000000a , fc0007ff , 31 , " vaddfp" s, ' vTAB , ' !vTAB ,
10000300 , fc0007ff , 31 , " vaddsbs" s, ' vTAB , ' !vTAB ,
10000340 , fc0007ff , 31 , " vaddshs" s, ' vTAB , ' !vTAB ,
10000380 , fc0007ff , 31 , " vaddsws" s, ' vTAB , ' !vTAB ,
10000000 , fc0007ff , 31 , " vaddubm" s, ' vTAB , ' !vTAB ,
10000200 , fc0007ff , 31 , " vaddubs" s, ' vTAB , ' !vTAB ,
10000040 , fc0007ff , 31 , " vadduhm" s, ' vTAB , ' !vTAB ,
10000240 , fc0007ff , 31 , " vadduhs" s, ' vTAB , ' !vTAB ,
10000080 , fc0007ff , 31 , " vadduwm" s, ' vTAB , ' !vTAB ,
10000280 , fc0007ff , 31 , " vadduws" s, ' vTAB , ' !vTAB ,
10000404 , fc0007ff , 31 , " vand" s, ' vTAB , ' !vTAB ,
10000444 , fc0007ff , 31 , " vandc" s, ' vTAB , ' !vTAB ,
10000502 , fc0007ff , 31 , " vavgsb" s, ' vTAB , ' !vTAB ,
10000542 , fc0007ff , 31 , " vavgsh" s, ' vTAB , ' !vTAB ,
10000582 , fc0007ff , 31 , " vavgsw" s, ' vTAB , ' !vTAB ,
10000402 , fc0007ff , 31 , " vavgub" s, ' vTAB , ' !vTAB ,
10000442 , fc0007ff , 31 , " vavguh" s, ' vTAB , ' !vTAB ,
10000482 , fc0007ff , 31 , " vavguw" s, ' vTAB , ' !vTAB ,
1000034a , fc0007ff , 31 , " vcfsx" s, ' vTxnAvB , ' !vTxnAvB ,
1000030a , fc0007ff , 31 , " vcfux" s, ' vTxnAvB , ' !vTxnAvB ,
100003c6 , fc0007ff , 31 , " vcmpbfp" s, ' vTAB , ' !vTAB ,
100007c6 , fc0007ff , 31 , " vcmpbfp." s, ' vTAB , ' !vTAB ,
100000c6 , fc0007ff , 31 , " vcmpeqfp" s, ' vTAB , ' !vTAB ,
100004c6 , fc0007ff , 31 , " vcmpeqfp." s, ' vTAB , ' !vTAB ,
10000006 , fc0007ff , 31 , " vcmpequb" s, ' vTAB , ' !vTAB ,
10000406 , fc0007ff , 31 , " vcmpequb." s, ' vTAB , ' !vTAB ,
10000046 , fc0007ff , 31 , " vcmpequh" s, ' vTAB , ' !vTAB ,
10000446 , fc0007ff , 31 , " vcmpequh." s, ' vTAB , ' !vTAB ,
10000086 , fc0007ff , 31 , " vcmpequw" s, ' vTAB , ' !vTAB ,
10000486 , fc0007ff , 31 , " vcmpequw." s, ' vTAB , ' !vTAB ,
100001c6 , fc0007ff , 31 , " vcmpgefp" s, ' vTAB , ' !vTAB ,
100005c6 , fc0007ff , 31 , " vcmpgefp." s, ' vTAB , ' !vTAB ,
100002c6 , fc0007ff , 31 , " vcmpgtfp" s, ' vTAB , ' !vTAB ,
100006c6 , fc0007ff , 31 , " vcmpgtfp." s, ' vTAB , ' !vTAB ,
10000306 , fc0007ff , 31 , " vcmpgtsb" s, ' vTAB , ' !vTAB ,
10000706 , fc0007ff , 31 , " vcmpgtsb." s, ' vTAB , ' !vTAB ,
10000346 , fc0007ff , 31 , " vcmpgtsh" s, ' vTAB , ' !vTAB ,
10000746 , fc0007ff , 31 , " vcmpgtsh." s, ' vTAB , ' !vTAB ,
10000386 , fc0007ff , 31 , " vcmpgtsw" s, ' vTAB , ' !vTAB ,
10000786 , fc0007ff , 31 , " vcmpgtsw." s, ' vTAB , ' !vTAB ,
10000206 , fc0007ff , 31 , " vcmpgtub" s, ' vTAB , ' !vTAB ,
10000606 , fc0007ff , 31 , " vcmpgtub." s, ' vTAB , ' !vTAB ,
10000246 , fc0007ff , 31 , " vcmpgtuh" s, ' vTAB , ' !vTAB ,
10000646 , fc0007ff , 31 , " vcmpgtuh." s, ' vTAB , ' !vTAB ,
10000286 , fc0007ff , 31 , " vcmpgtuw" s, ' vTAB , ' !vTAB ,
10000686 , fc0007ff , 31 , " vcmpgtuw." s, ' vTAB , ' !vTAB ,
100003ca , fc0007ff , 31 , " vctsxs" s, ' vTxnAvB , ' !vTxnAvB ,
1000038a , fc0007ff , 31 , " vctuxs" s, ' vTxnAvB , ' !vTxnAvB ,
1000018a , fc1f07ff , 31 , " vexptefp" s, ' vTB , ' !vTB ,
100001ca , fc1f07ff , 31 , " vlogefp" s, ' vTB , ' !vTB ,
1000002e , fc00003f , 31 , " vmaddfp" s, ' vTAxBC , ' !vTAxBC ,
1000040a , fc0007ff , 31 , " vmaxfp" s, ' vTAB , ' !vTAB ,
10000102 , fc0007ff , 31 , " vmaxsb" s, ' vTAB , ' !vTAB ,
10000142 , fc0007ff , 31 , " vmaxsh" s, ' vTAB , ' !vTAB ,
10000182 , fc0007ff , 31 , " vmaxsw" s, ' vTAB , ' !vTAB ,
10000002 , fc0007ff , 31 , " vmaxub" s, ' vTAB , ' !vTAB ,
10000042 , fc0007ff , 31 , " vmaxuh" s, ' vTAB , ' !vTAB ,
10000082 , fc0007ff , 31 , " vmaxuw" s, ' vTAB , ' !vTAB ,
10000020 , fc00003f , 31 , " vmhaddshs" s, ' vTABC , ' !vTABC ,
10000021 , fc00003f , 31 , " vmhraddshs" s, ' vTABC , ' !vTABC ,
1000044a , fc0007ff , 31 , " vminfp" s, ' vTAB , ' !vTAB ,
10000302 , fc0007ff , 31 , " vminsb" s, ' vTAB , ' !vTAB ,
10000342 , fc0007ff , 31 , " vminsh" s, ' vTAB , ' !vTAB ,
10000382 , fc0007ff , 31 , " vminsw" s, ' vTAB , ' !vTAB ,
10000202 , fc0007ff , 31 , " vminub" s, ' vTAB , ' !vTAB ,
10000242 , fc0007ff , 31 , " vminuh" s, ' vTAB , ' !vTAB ,
10000282 , fc0007ff , 31 , " vminuw" s, ' vTAB , ' !vTAB ,
10000022 , fc00003f , 31 , " vmladduhm" s, ' vTABC , ' !vTABC ,
1000000c , fc0007ff , 31 , " vmrghb" s, ' vTAB , ' !vTAB ,
1000004c , fc0007ff , 31 , " vmrghh" s, ' vTAB , ' !vTAB ,
1000008c , fc0007ff , 31 , " vmrghw" s, ' vTAB , ' !vTAB ,
1000010c , fc0007ff , 31 , " vmrglb" s, ' vTAB , ' !vTAB ,
1000014c , fc0007ff , 31 , " vmrglh" s, ' vTAB , ' !vTAB ,
1000018c , fc0007ff , 31 , " vmrglw" s, ' vTAB , ' !vTAB ,
10000025 , fc00003f , 31 , " vmsummbm" s, ' vTABC , ' !vTABC ,
10000028 , fc00003f , 31 , " vmsumshm" s, ' vTABC , ' !vTABC ,
10000029 , fc00003f , 31 , " vmsumshs" s, ' vTABC , ' !vTABC ,
10000024 , fc00003f , 31 , " vmsumubm" s, ' vTABC , ' !vTABC ,
10000026 , fc00003f , 31 , " vmsumuhm" s, ' vTABC , ' !vTABC ,
10000027 , fc00003f , 31 , " vmsumuhs" s, ' vTABC , ' !vTABC ,
10000308 , fc0007ff , 31 , " vmulesb" s, ' vTAB , ' !vTAB ,
10000348 , fc0007ff , 31 , " vmulesh" s, ' vTAB , ' !vTAB ,
10000208 , fc0007ff , 31 , " vmuleub" s, ' vTAB , ' !vTAB ,
10000248 , fc0007ff , 31 , " vmuleuh" s, ' vTAB , ' !vTAB ,
10000108 , fc0007ff , 31 , " vmulosb" s, ' vTAB , ' !vTAB ,
10000148 , fc0007ff , 31 , " vmulosh" s, ' vTAB , ' !vTAB ,
10000008 , fc0007ff , 31 , " vmuloub" s, ' vTAB , ' !vTAB ,
10000048 , fc0007ff , 31 , " vmulouh" s, ' vTAB , ' !vTAB ,
1000002f , fc00003f , 31 , " vnmsubfp" s, ' vTAxBC , ' !vTAxBC ,
10000504 , fc0007ff , 31 , " vnor" s, ' vTAB , ' !vTAB ,
10000484 , fc0007ff , 31 , " vor" s, ' vTAB , ' !vTAB ,
1000002b , fc00003f , 31 , " vperm" s, ' vTABC , ' !vTABC ,
1000030e , fc0007ff , 31 , " vpkpx" s, ' vTAB , ' !vTAB ,
1000018e , fc0007ff , 31 , " vpkshss" s, ' vTAB , ' !vTAB ,
1000010e , fc0007ff , 31 , " vpkshus" s, ' vTAB , ' !vTAB ,
100001ce , fc0007ff , 31 , " vpkswss" s, ' vTAB , ' !vTAB ,
1000014e , fc0007ff , 31 , " vpkswus" s, ' vTAB , ' !vTAB ,
1000000e , fc0007ff , 31 , " vpkuhum" s, ' vTAB , ' !vTAB ,
1000008e , fc0007ff , 31 , " vpkuhus" s, ' vTAB , ' !vTAB ,
1000004e , fc0007ff , 31 , " vpkuwum" s, ' vTAB , ' !vTAB ,
100000ce , fc0007ff , 31 , " vpkuwus" s, ' vTAB , ' !vTAB ,
1000010a , fc1f07ff , 31 , " vrefp" s, ' vTB , ' !vTB ,
100002ca , fc1f07ff , 31 , " vrfim" s, ' vTB , ' !vTB ,
1000020a , fc1f07ff , 31 , " vrfin" s, ' vTB , ' !vTB ,
1000028a , fc1f07ff , 31 , " vrfip" s, ' vTB , ' !vTB ,
1000024a , fc1f07ff , 31 , " vrfiz" s, ' vTB , ' !vTB ,
10000004 , fc0007ff , 31 , " vrlb" s, ' vTAB , ' !vTAB ,
10000044 , fc0007ff , 31 , " vrlh" s, ' vTAB , ' !vTAB ,
10000084 , fc0007ff , 31 , " vrlw" s, ' vTAB , ' !vTAB ,
1000014a , fc1f07ff , 31 , " vrsqrtefp" s, ' vTB , ' !vTB ,
1000002a , fc00003f , 31 , " vsel" s, ' vTABC , ' !vTABC ,
100001c4 , fc0007ff , 31 , " vsl" s, ' vTAB , ' !vTAB ,
10000104 , fc0007ff , 31 , " vslb" s, ' vTAB , ' !vTAB ,
1000002c , fc00043f , 31 , " vsldoi" s, ' vTABqC , ' !vTABqC ,
10000144 , fc0007ff , 31 , " vslh" s, ' vTAB , ' !vTAB ,
1000040c , fc0007ff , 31 , " vslo" s, ' vTAB , ' !vTAB ,
10000184 , fc0007ff , 31 , " vslw" s, ' vTAB , ' !vTAB ,
1000020c , fc0007ff , 31 , " vspltb" s, ' vTxnAvB , ' !vTxnAvB ,
1000024c , fc0007ff , 31 , " vsplth" s, ' vTxnAvB , ' !vTxnAvB ,
1000030c , fc00ffff , 31 , " vspltisb" s, ' vTsA , ' !vTsA ,
1000034c , fc00ffff , 31 , " vspltish" s, ' vTsA , ' !vTsA ,
1000038c , fc00ffff , 31 , " vspltisw" s, ' vTsA , ' !vTsA ,
1000028c , fc0007ff , 31 , " vspltw" s, ' vTxnAvB , ' !vTxnAvB ,
100002c4 , fc0007ff , 31 , " vsr" s, ' vTAB , ' !vTAB ,
10000304 , fc0007ff , 31 , " vsrab" s, ' vTAB , ' !vTAB ,
10000344 , fc0007ff , 31 , " vsrah" s, ' vTAB , ' !vTAB ,
10000384 , fc0007ff , 31 , " vsraw" s, ' vTAB , ' !vTAB ,
10000204 , fc0007ff , 31 , " vsrb" s, ' vTAB , ' !vTAB ,
10000244 , fc0007ff , 31 , " vsrh" s, ' vTAB , ' !vTAB ,
1000044c , fc0007ff , 31 , " vsro" s, ' vTAB , ' !vTAB ,
10000284 , fc0007ff , 31 , " vsrw" s, ' vTAB , ' !vTAB ,
10000580 , fc0007ff , 31 , " vsubcuw" s, ' vTAB , ' !vTAB ,
1000004a , fc0007ff , 31 , " vsubfp" s, ' vTAB , ' !vTAB ,
10000700 , fc0007ff , 31 , " vsubsbs" s, ' vTAB , ' !vTAB ,
10000740 , fc0007ff , 31 , " vsubshs" s, ' vTAB , ' !vTAB ,
10000780 , fc0007ff , 31 , " vsubsws" s, ' vTAB , ' !vTAB ,
10000400 , fc0007ff , 31 , " vsububm" s, ' vTAB , ' !vTAB ,
10000600 , fc0007ff , 31 , " vsububs" s, ' vTAB , ' !vTAB ,
10000440 , fc0007ff , 31 , " vsubuhm" s, ' vTAB , ' !vTAB ,
10000640 , fc0007ff , 31 , " vsubuhs" s, ' vTAB , ' !vTAB ,
10000480 , fc0007ff , 31 , " vsubuwm" s, ' vTAB , ' !vTAB ,
10000680 , fc0007ff , 31 , " vsubuws" s, ' vTAB , ' !vTAB ,
10000688 , fc0007ff , 31 , " vsum2sws" s, ' vTAB , ' !vTAB ,
10000708 , fc0007ff , 31 , " vsum4sbs" s, ' vTAB , ' !vTAB ,
10000648 , fc0007ff , 31 , " vsum4shs" s, ' vTAB , ' !vTAB ,
10000608 , fc0007ff , 31 , " vsum4ubs" s, ' vTAB , ' !vTAB ,
10000788 , fc0007ff , 31 , " vsumsws" s, ' vTAB , ' !vTAB ,
1000034e , fc1f07ff , 31 , " vupkhpx" s, ' vTB , ' !vTB ,
1000020e , fc1f07ff , 31 , " vupkhsb" s, ' vTB , ' !vTB ,
1000024e , fc1f07ff , 31 , " vupkhsh" s, ' vTB , ' !vTB ,
100003ce , fc1f07ff , 31 , " vupklpx" s, ' vTB , ' !vTB ,
1000028e , fc1f07ff , 31 , " vupklsb" s, ' vTB , ' !vTB ,
100002ce , fc1f07ff , 31 , " vupklsh" s, ' vTB , ' !vTB ,
100004c4 , fc0007ff , 31 , " vxor" s, ' vTAB , ' !vTAB ,
7c000278 , fc0007ff , 30 , " xor" s, ' rxSAB , ' !rxSAB ,
7c000279 , fc0007ff , 30 , " xor." s, ' rxSAB , ' !rxSAB ,
68000000 , fc000000 , 30 , " xori" s, ' rxSAuI , ' !rxSAuI ,
6c000000 , fc000000 , 30 , " xoris" s, ' rxSAuI , ' !rxSAuI ,
\ ------------------------------------
\ Aliases placed below Basic Forms are recogized by 'dis' and 'asm'.
\ Aliases like 'nop' with nulled fields only work when placed above
\ ====================================

here record - to last-record

\ here to addr \ as default, avoided "+dis: Illegal memory access"
               \ but too hazardous for added 'azm' function, making
               \ reversion to "Illegal memory access" preferable.

\ Change text foreground colour
0 value esc-seq
0 value color-code
here 3 + to esc-seq    \ = addr of real start of following string
here 6 + to color-code \ 6th foll. char '0' = replacable color code
0000001b ( ESC ) , " [30m" s,   \ 5-char ANSI ESC sequence 
: .color ( ANSI-color-code -- ) \ arg = one of 030 031 032 ... 037
\ NB: Codes 31 & 34 (blue & red) appear swapped on remote terminals
    color-code c!      \ embed requested color in esc-seq string
    esc-seq 5 type     \ set text output color
;
               
0 value opcode \ also = disasm1 return code ( 0 = invalid )

CREATE alt-branch-record 20 ALLOT
alias bc-opcode alt-branch-record             0  bc-opcode !
alt-branch-record cell+     CONSTANT bc-mask  0  bc-mask !
alt-branch-record 2 cells + CONSTANT bc-color 30 bc-color !
alt-branch-record 3 cells + CONSTANT bc-mnom
" unused      "                               bc-mnom swap move
alt-branch-record 6 cells + CONSTANT bc-opnd  0  bc-opnd !
alt-branch-record 7 cells + CONSTANT bc!opnd  0  bc!opnd !

variable bc-mnom-ptr 

: suffix-append ( addr len -- )
   tuck bc-mnom-ptr @ swap move   \ copy string to bc-mnom 
   bc-mnom-ptr tuck @ + swap !    \ update bc-mnom-ptr
;

: reveal-hint-bit ( instr'n -- ) \ output +|- suffix only if bit set
\
\ There appear to be various interpretations about which and when
\ "+" or "-" static branch prediction suffix should be displayed.
\ This version of "dis.of" will not display either one unless the
\ 'y' bit is set, i.e, the cpu's default prediction is to be
\ reversed. '+' predicts a forward branch or a branch via LR or
\ CTR will be taken; '-' predicts a backward branch will not be
\ taken. The  opposite predictions are made automatically by the G4
\ in the absence of either suffix. The arguably different behaviour
\ specified by the powerpc standard appears designed to benefit
\ compilers which predict liklihood of "branch taken" or "not taken"
\ for every conditional branch instruction. For users of an
\ in-memory native assembler like this one, it is expected the user
\ will know their cpu's default behaviour and prefer not having to
\ digress into cache control considerations unless one of these
\ suffixes flags it for their attention. In any case static branch
\ prediction appears disabled or otherwise ineffective within the
\ Macintosh Open Firmware environment. It is quite safe to ignore
\ these branch-prediction suffixes if they confuse you.
\ They do not affect the control logic or data flow of any program.

   lwsplit ( most sig. half of instr'n becomes top stack item)
   dup 0280 AND 0280 <>           \ conditional ?
   swap 0020 AND 20 =  AND        \ prediction reversal bit ON ?
   bc-mnom 1+ c@ [char] c <>  AND \ "simplified" mnemonic ? 'bcctr'?
   IF  
      8000 AND 0= IF " +" ELSE " -" THEN 
      suffix-append
   ELSE
      drop
   THEN
;

: revert-to-basic-form \ for bc-instrns lacking alternative forms
   record-> alt-branch-record 020 move
;

CREATE bc-codes ( 'dis' can see only first 8, add more for 'asm' ) 
6765 ( "ge" ) w, 6c65 ( "le" ) w, 6e65 ( "ne" ) w, 6e73 ( "ns" ) w,
6c74 ( "lt" ) w, 6774 ( "gt" ) w, 6571 ( "eq" ) w, 736f ( "so" ) w,
\ asm-only synonyms (added later):
6e6c ( "nl" ) w, 6e67 ( "ng" ) w, 0000 (  ""  ) w, 6e75 ( "nu" ) w,
0000 (  ""  ) w, 0000 (  ""  ) w, 0000 (  ""  ) w, 756e ( "un" ) w,
0 , \ returns a nul-string or, more relevant, an index >= d# 32 

\ nb: some varients like bt vs. blt are alternative interpretations
\ of the same instruction. 'dis' can't decode same instr'n two ways.
\ It favours 2-chr action-oriented condition-code & CR-fld over bit#
\ interpretation. Thus neither the user nor 'asm' has made a mistake
\ when 'dis' echoes back 'bclr 0c,2' as 'beqlr' instead of 'btlr 2')

: cr-bits ( mnom-addr -- u8|err ) ( xlate 2char to 3bit br cond'n )
      2+ dup c@ swap
      1- c@ 8 << +  >r  \ half-word align 2char input string
      0     \ initial index
      BEGIN
         dup dup d# 32 < swap bc-codes + w@ r@ <> AND WHILE
      wa1+ REPEAT
      r> drop
      1 >>       \ scale word-index to element number
      h# 17 AND  \ 0-7 = valid condition codes, >= 8 = "not found"
;

: bd-code? ( -- true|false ) addr w@ 0080 AND 0 = ;

\ the following 3 cover all alt-mnemonics starting with "b"
40000000 CONSTANT bc[la]
4c000020 CONSTANT bclr[l]
4c000420 CONSTANT bcctr[l]

: method ( -- stripped-opc )
   \ remove relevant opcode's 'l' and 'a' bits for CASE statement
   addr@ addr c@ fc AND 40 = IF fc000000 ELSE fc0007fc THEN AND
;

: create-alt-branch-record ( -- a )
\ on entry 'addr' points to a conditional branch instruction
bc-mnom 0c blank         \ clear mnemonic text buffer
bc-mnom bc-mnom-ptr !    \ initialize ptr to start of buffer
30 bc-color !            ( bc's are normal usr instructions )
" b" suffix-append       \ first char of new mnemonic

bd-code?   \ "decrement-ctr" branch instruction ?
IF
   " d" suffix-append
   ['] nA bc-opnd !
   method CASE
      bclr[l] OF
      4c000020           \ put basic-form opcode on stack
         addr w@ 0200 AND 0 = IF   \ instr'n form specifies CR bit ?
            addr w@ 0040 AND 0040 = IF
               " z"  suffix-append  ELSE " nz" suffix-append  THEN
            addr w@ 0100 AND 0100 = IF
               " t"  suffix-append  ELSE " f"  suffix-append  THEN
         ELSE             \ instruction form does not specify CR bit
            addr w@ 0040 AND 0040 = IF
               " z"  suffix-append  ELSE " nz" suffix-append  THEN
               ['] nil bc-opnd !
         THEN
      " lr" suffix-append
      addr@ 1 AND 1 = IF " l" suffix-append
         1+ THEN                   \ bump corresponding opcode bit 
         to opcode
         fc00ffff bc-mask !
      ENDOF
      bc[la] OF      
      40000000           \ put basic form opcode on stack
         addr w@ 0200 AND 0 = IF   \ instr'n form specifies CR bit ?
            addr w@ 0040 AND 0040 = IF
               " z"  suffix-append  ELSE " nz" suffix-append  THEN
            addr w@ 0100 AND 0100 = IF
               " t"  suffix-append  ELSE " f"  suffix-append  THEN
               ['] nArH bc-opnd !
         ELSE addr w@ 0040 AND 0040 = IF \ instrn disregards CR bits
               " z"  suffix-append  ELSE " nz" suffix-append  THEN
               ['] rH bc-opnd !
         THEN
         fc000003 bc-mask !
         addr@ 1 AND 1 = IF " l" suffix-append
            1+ THEN               \ bump corresponding opcode bit 
         addr@ 2 AND 2 = IF " a" suffix-append
         addr@ 02000000 AND 2000000 = IF ['] aH ELSE ['] nAaH THEN
            bc-opnd !              \ assign appropriate operand list
            2 OR                   \ amend opcode
         THEN                
         to opcode

      ENDOF
      bcctr[l] OF   \ no useful "bd*ctr" instructions exist
          revert-to-basic-form
      ENDOF
      \ default:
         45727220 ( "Err " ) bc-mnom ! \ temp precaution
         35 bc-color ! \ unanticipated programming result
         \ revert-to-basic-form (depends on what falls thru)
   ENDCASE
 
ELSE  \ handle "bc*" (as opposed to "bd*") alternative mnemonics

   addr w@ 0280 AND 0280 <> IF
      addr@ extract-bc 2*        \ convert BPU bits to bc-index 
      bc-codes + 2 suffix-append \ select & copy 2-char bc-code
      ( else ignore on nul condition, leaving "b" unsuffixed )
   THEN
   method CASE
      bcctr[l] OF
         fc00ffff bc-mask !
         4c000420                  \ place group opcode on stack
         " ctr" suffix-append      \ finish assembling new mnemonic
         addr@ 1 AND 1 = IF " l" suffix-append
         1+ THEN                   \ bump corresponding opcode bit 
         to opcode
         ['] crA|nil bc-opnd !     \ assign appropriate operand list
      ENDOF
      bclr[l]  OF
         fc00ffff bc-mask !
         4c000020                  \ place group opcode on stack
         " lr" suffix-append       \ finish assembling new mnemonic
         addr@ 1 AND 1 = IF " l" suffix-append
         1+ THEN                   \ bump corresponding opcode bit 
         to opcode
         ['] crA|nil bc-opnd !     \ assign appropriate operand list
      ENDOF
      bc[la]   OF
         fc000003 bc-mask !
         ['] crArH bc-opnd !       \ assign default operand-set
         40000000                  \ place group opcode on stack
         addr@ 1 AND 1 = IF " l" suffix-append
         1+ THEN                   \ bump corresponding opcode bit
         addr@ 2 AND 2 = IF " a" suffix-append
            ['] crAaH bc-opnd !    \ assign appropriate operand list
            2 OR                   \ amend opcode
         THEN
         to opcode
         
      ENDOF
         drop
         35 .color 
         \ redundant -- left in as a misuse-of-code warning
         ." not a conditional branch instruction " cr
         30 .color
      ENDCASE

THEN

addr@ reveal-hint-bit
alt-branch-record  ( address returned to caller )
;

variable bc-enhance  \ enable/disable branch instr'n simplification
: simplify true bc-enhance !    ;
: unsimplify false bc-enhance !
;

: find-record ( -- addr )
    table last-record DO               \ search for opcode in table
       I @ opcode = IF  I leave  THEN  \ found: put index on stack
       I table = IF I leave THEN \ not found: make 'data' the instrn
    -1 records +LOOP
;

1 value res-bits \ interpret instrns with non-0 res-bits as "data"
: conceal true to res-bits ; : reveal false to res-bits ; \ options

: disasm1 ( address --) ( on exit, opcode=FALSE for invalid instr'n)
     hex 
     -align  \ force, so that branch operands always (?) accurate
     dup to addr
     .hexdump 3a emit BL emit  ( print instruction address )
     32 .color addr@ .hexdump  \ optional: output raw code
     30 .color 3 spaces
     addr dup @ swap roughmask AND to opcode ( save candidate opc )
     find-record to record-> 
 \ -----------------------------------------------------------------
 \ -- patch: use simplified conditional branch instruction formats--
   bc-enhance @ IF
     record-> 3 cells +  ( start of instruction-record's mnemonic )
     w@ 6263 ( "bc") = IF create-alt-branch-record to record-> THEN
   THEN
 \ ---------------------- ( patch ends ) -----------------------
     record-> cell+ @      ( instr'n-nominated mask applied to...  )
     addr@ AND dup         ( ..instruction gives expanded opcode** )
     opcode = IF           ( match initially calculated opcode ?   )
        record-> 2 cells + ( advance record pointer to instr level )
        @ .color           ( let clean instrn nominate own color )
     ELSE                  ( not a clean** instruction, )
        32 .color          (   color as for "data" )
        res-bits IF        ( conceal-hidden-instructions specified?)
          table to record-> ( portray non-clean instr'n as "data"  )
          drop 0                   ( as return
code,signifies"unrecognized")
        THEN
     THEN
     ( dup'd ) to opcode   ( exit-value of "opcode" = return code )
     record-> 3 cells +    ( advance record pointer to mnemonic    )
     d# 11 type            ( output mnemonic padded to 11 chars )
     addr@ 
     record-> 6 cells + @  ( ppc instr'n rec. nominates routine to )
     execute               ( extract, format & print operands      )
\    30 .color             ( revert to normal text color           )
\     034 column# - abs spaces \ ADJUST if cols added/removed above
\     32 .color addr@ .ascii ( optional extra col interprts as txt)
     30 .color
     addr cell+ to addr    ( postincrement preps for next instr'n  )
;
: dis1 disasm1 cr ;       \ replaces built-in original
: echo disasm1 quit ;     \ alternative to 'dis1' better for asm/azm

\ ** How disasm1 validation distinguishes "clean" instructions **
\ "roughmask" selects opcode only. "final mask" extends selection
\ to include all bits not belonging to operands. If any of these
\ extra "reserved" bits are non-zero, instruction contains hidden
\ 1-bits. Thus ANDing candidate instruction with 2nd mask yields
\ different result fm original roughmask 'AND' with tainted instr'n.
\ That is the reason aliases like 'nop' with all 0 opnds hide their
\ Basic Form equivs from 'dis' when appearing below them in the
\ data table -- disasm1 has no way to tell them apart.


: dis ( address -- )      \ replaces built-in original 
    cr -1 swap 
      do i dis1 
      exit? \ displays pagination prompt; use ret-key to single-step
      if leave then
    cell +loop
;

: +dis ( -- ) addr dis ;  \ replaces built-in original

: +dasm ( -- )   \ '+dis' variant stops at end of code bloc
    cr
    begin
      addr dis1
      \ stop on any foll. unconditional return or return-unsaved jmp
      opcode 48000000 ( b ) =
      opcode 48000002 ( ba ) = OR
      opcode 7fe00008 ( trap ) = OR
      opcode 4c000064 ( rfi ) = OR
      addr cell - @ ffe0ffff AND 4e800020 ( blr, any cr ) = OR
      addr cell - @ ffe0ffff AND 4e800420 ( bctr, any cr) = OR
      addr cell - @ ffe00001 AND 42800000 ( bc-unconditional ) = OR
      addr@ deadbeef ( unused memory ) = OR
      exit? OR 
    until
;

: dasm ( address -- ) \ dis to next 'b' 'ba' 'rfi' 'blr' 'bctr'...
    to addr +dasm
;


\ --------------- Assembler-specific modules follow ----------------

\ 1. Alternative Branch Instruction Interpreter:

alias instr'n alt-branch-record \ for local use, shared at obj level
2variable mnemonic
0 0 mnemonic 2!

: SCAN          ( c-addr1 u1 c -- c-addr2 u2 )
\ courtesy of Coos Haak, comp.lang.forth
        >R
        BEGIN   DUP
        WHILE   OVER C@ R@ <>
        WHILE   SWAP 1+ SWAP 1-
        REPEAT  THEN
        R> DROP
;

: or!  ( u addr -- ) ( analagous to +! ) ( should be able to use +!)
   dup -rot @ OR swap !
;
: peek-left-char ( -- c|0 ) ( 0 = nul string )
   mnemonic 2@ IF c@ ELSE 0 THEN
;
: peek-right-char ( -- c|0 )  ( read b4 set-if-match poss. removes)
   mnemonic 2@ dup IF + 1- c@ ELSE nip THEN
;
: peek-2nd-fm-right ( -- c|0 ) ( do not use unless rhs <> "b" known)
   mnemonic 2@ dup IF + 2 - c@ ELSE nip THEN
;

: set-on-match ( u c -- true|false )
   peek-right-char = IF         \ does c match rhs char ?
      mnemonic dup @ 1- swap !  \ remove char from string
      ( swap ) instr'n or!      \ insert binary equiv -> instr'n
      true
   ELSE
      drop false
   THEN
;

: set? ( bit|bits x -- true|false ) \ input matches 2constant output
drop instr'n @ AND
;
: unset ( u c -- ) ( 'u c' as output by 2constant's bit-name )
   drop invert instr'n @ AND  instr'n !
;


\ Mnemonic-to-Binary Translation Table:
\ -------------------------------------
\ binary   text             name
\ =====================================
00000000  char b  2constant  end-stop    \ test & clear initial "b"
00000000  char t  2constant  pass-bit    \ the "t" in "ctr"
00000000  char n  2constant  n-bit
00000000  char f  2constant  false-bit
00000001  char l  2constant  link-bit
00000002  char a  2constant  abs-bit
00000020  char l  2constant  lr-bit      \ common to both dest regs
00000400  char c  2constant  ctr-bit
00000420  char c  2constant  ctr-bits
00008000  char s  2constant  sign-bit    \ not used
00200000  char -  2constant  hint-bit
00200000  char +  2constant  hint+bit
00400000  char z  2constant  z-bit
00800000  char b  2constant  style-bit
01000000  char t  2constant  true-bit
02000000  char b  2constant  always-bit
02800000  char b  2constant  always-bits
08000000  char b  2constant  uncond-bit
0c000000  char r  2constant  reg-bits    \ "r" as in "lr" or "ctr"
40000000  char c  2constant  bc-bit
\ nb: Some of these defs limited to partially-complete instructions
\ Note distinction between 'bit' & 'bits'. Some overlay others.

\ Branch Instruction Parser -- in-line sections are order-dependent
\ 'asm-b' translates text to binary & places results in alt record
: asm-b  ( addr len -- table-record-addr ) ( fills some data fields)
   mnemonic 2! \ save initial string descriptor
   alt-branch-record  ( addr remains on stack for caller on exit ) 
   mnemonic 2@ 2dup drop
   40000000 instr'n !  \ the bit common to all branch instructions
   \ Initial "b" will be used as end-marker;needs to be the only "b"
   c@ [char] b <> ABORT"  expected a branch instruction "
   swap 1+ swap 1- \ skip initial 'b'
   [char] b SCAN nip  ABORT"  too many 'b's in branch mnemonic "

  \ Consume chars backwards from rhs until end-stop 'b' encountered:
  
  \ Handle suffixes (including register id) for all branch instrns

  ( "register id" = branch target register embedded in mnemonic )
   hint-bit set-on-match  drop          \ b*-
   hint+bit set-on-match  drop          \ b*+
   abs-bit  set-on-match  drop          \ b*a
   peek-right-char [char] l = IF
      peek-2nd-fm-right [char] n <> IF  \ provides for 'bnl'
      link-bit set-on-match drop THEN   \ b*l*
   THEN
   reg-bits set-on-match IF             \ b*r*
      abs-bit set?
      ABORT"  incompatible branch attributes: r,a "
      lr-bit set-on-match NOT IF
         pass-bit set-on-match NOT   IF  
            cr space peek-right-char emit
            ." r: not a destination register"  ABORT  THEN
         ctr-bits set-on-match NOT    IF
            cr space peek-right-char emit
            ." tr: not a destination register" ABORT THEN
      THEN
   THEN

\ handle unconditional branches (b,bl,ba,bla,blr,blrl,bctr & bctrl)
   uncond-bit set-on-match IF
      hint-bit unset ( meaningless for unconditionals; clear )
      lr-bit set? IF \ lr-bit stand-in for reg-bits,avoiding a clash
         always-bits drop instr'n or! \ condition = "always"
         ['] !nil
      ELSE  
         abs-bit set? IF ['] !aJ ELSE ['] !rJ THEN
      THEN
   bc!opnd !
   exit     
   THEN

\ handle basic form conditional mnemonics starting with "bc"
   bc-bit set-on-match IF
      end-stop set-on-match NOT \ does 'b' immediately precede 'c' ?
         ABORT"  branch mnemonic: 'c' in wrong position "
      ( hint-bit redundant but no harm accepting if specified ? ) 
      reg-bits set? IF
         ['] !?TnA
      ELSE  
         abs-bit set? IF
            ['] !?TnAaH ELSE ['] !?TnArH THEN
      THEN
   bc!opnd !
   exit
   THEN

\ handle mnemonics starting with "bd" more than 2 chars long
   mnemonic 2@  2 > swap " bd" comp 0= AND IF
      ctr-bit set? ABORT"  ctr used for count,needs different dest "
      peek-right-char [char] z = IF 
         always-bit drop instr'n or!
      ELSE
         peek-2nd-fm-right [char] z = IF \ only "t"or "f" can follow
            true-bit set-on-match  drop
            false-bit set-on-match IF 
            true-bit set? 
               ABORT"  branch attribute 't' contradicts 'f' "
            THEN
         THEN
      THEN
      z-bit set-on-match drop
      n-bit set-on-match IF 
         z-bit set? IF  z-bit unset  THEN
      THEN
      0 [char] d set-on-match  end-stop set-on-match AND NOT
         ABORT"  branch instruction not recognized "
      lr-bit set? IF
         always-bit set? IF ['] !nil ELSE ['] !nA THEN
      ELSE
         always-bit set? IF 
            abs-bit set? IF ['] !aH ELSE ['] !rH THEN
         ELSE
            abs-bit set? IF ['] !nAaH  ELSE ['] !nArH  THEN
         THEN
      THEN
   bc!opnd !
   exit
   THEN
   
   \ handle bt,bf,btctr,bfctr,btlr,bflr instructions specifying bit#
   mnemonic 2@ nip 2 = IF
      style-bit drop instr'n or!
      true-bit set-on-match drop
      false-bit set-on-match IF 
         true-bit set? 
            ABORT"  incompatible branch attributes: t,f "
         THEN
      end-stop set-on-match NOT
         ABORT"  not a valid branch instruction "
      reg-bits set? IF 
         ['] !nA 
      ELSE 
         abs-bit set? IF ['] !nAaH  ELSE ['] !nArH  THEN
      THEN
   bc!opnd !
   exit
   THEN   
  
\ instructions with 2-char condition code embedded in mnemonic text
   mnemonic @ 3 = IF
      mnemonic 2@ drop cr-bits dup 8 >= 
         ABORT"  branch condition not recognized "
      dup 4 AND IF true-bit drop instr'n or! THEN 
     ( dup ) 3 AND 010 <<  instr'n or! \ fill rhs 2 bits of cr-field
      style-bit drop instr'n or!
      reg-bits set? IF 
         ['] !crA|nil 
      ELSE 
         abs-bit set? IF ['] !crAaH  ELSE ['] !crArH  THEN 
      THEN
      
   bc!opnd !
   exit
   THEN

   mnemonic @ IF 
      cr ."  unable to parse leftover chars: " mnemonic 2@ type cr
      ABORT 
      \ hopefully won't ever see either of these
   THEN
      ( addr ) ABORT"  branch mnemonic consumed unrecognized "

;    

: make-rec ( -- addr )  \ asm interface to Branch Instruction Parser
   mnom 0c -trailing    \ get branch-instruction mnemonic's length
   nip mnom swap        \ branch-instruction's start address
   asm-b                \ get instr'n-rec containing parsed instr'n
;


\ 2. The Main Assembler

: find-rec ( -- addr )  \ mnemonic = 3+4+5th cell in table rec
    table   \ default = "data", representing "unfound mnemonic"
    table record - 3 cells + last-record 3 cells +  DO
       i @ mnom @ = IF ( assumes 3-cell strings spc-padded, aligned)
          i cell+ @ mnom cell+ @ = IF  
             i 2 cells + @ mnom 2 cells + @ = IF
                drop i 3 cells - 
                leave   \ found record replaces default; exit
             THEN
          THEN
       THEN
    -1 records +LOOP
   dup table = IF ." ? " abort" mnemonic not recognized" THEN
;

: get-rec ( -- addr ) \ divert to Branch Instrn Parser if called for
   mnom c@ [char] b <> IF
      find-rec
   ELSE
      make-rec
   THEN
;

: assemble ( instrn-record-addr -- ppc-instrn )
\ NB: data table nominates instruction-specific function required
\     to parse, check & assemble current instruction's operands
   dup @ swap             ( opcode instrn-rec-addr)     
   7 cells +              ( opcode instrn-nominated-assembler-addr )
   @ execute              ( ppc-instrn )
   35 .color              \ display excess input warning in magenta
   ignore-extra-input     ( ppc-instrn ) 
   30 .color
   ( !get-rel-target & !get-rel-hw need addr pointing at curr instn)
;

: asm1 ( addr -- addr ppc-instrn ) ( type 'asm1' foll by ppc-instrn)
 \ enter text lower-case only,spaces btn opnds & separators optional
   +align            ( addr )
   dup to addr       ( addr )
   read-mnom         ( addr )
   get-rec           ( addr data-rec-addr ) \ 'find-rec' substitute
   assemble          ( addr ppc-instrn ) \ requires 'addr' in place
;

\ asm & azm are intended to assemble one ppc instr'n per command per
\ line. They terminate any loop or larger process when placed within

defer newline \ determines if asm echoes back on same or next line
: sameline ['] (cr to newline ;  \ changes "newline" behavior
: nextline ['] cr to newline ; \ typed asm commands remain on screen

: asm ( -- )          \ forth-friendly, allocates own memory,
   align here         \   compatible with 'code' and 'create'
   dup to addr            ( in case first instruction = relative branch)
   asm1 ,
   newline echo           \ two modes of operation - see "newline" above
;
: azm ( addr -- ) \ Use CAUTION choosing address - see WARNING below
   asm1 over !
  newline echo        \ two modes of operation - see "newline" above
;

\ WARNING: 'azm' does not allocate memory and will assemble direct
\ to any unprotected address you nominate. Also beware, 'here' is
\ the forth system's user-memory pointer which changes whenever
\ data is poked using the ',' operator, or whenever new forth defs
\ or declarations are made. Thus without due care and diligence,
\ code assembled to 'here' (or what was 'here' but no longer is)
\ by 'azm' can easily zap code in the line of execution or
\ be itself overwritten. It is best to get used to typing 'asm'
\ automatically to enter each new line of code, as it allots memory
\ for each ppc-instruction it assembles.
\
\ Make typing '<address> azm' a cautious and considered alternative.
\ Always think about the address you are giving it, and don't get
\ into the habit of typing 'addr azm' automatically or it is only
\ a matter of time before you WILL end up regretting it. (Because
\ all 'dis' and 'asm' variants, including 'azm', share the same
\ auto-incrementing global place marker 'addr'). If you must
\ use 'azm', the safest alternative until you have mastered it,
\ is to first 'alloc-mem' to reserve your own buffer. Start by
\ giving azm your buffer address. After that, you can literally type
\ 'addr azm' when you need auto-increment. But if you dis or dasm
\ anywhere else during the course of entering code with azm, you
\ will need to save and re-enter your continuation address manually
\ before it would be safe to resume typing 'addr azm' where you
\ left off. That hints at the reason '+asm' and '+azm' have not been
\ included in this file. 
\
\ Note however, the 'help' functions defined below are exceptions.
\ They utilize 'addr' and they DO restore it to its previous setting


\ ------------------ Help and Auxiliary Functions ------------------

#records cells buffer: help-buf  \ for sample help instructions

\ Populate help buffer with representative ppc-instructions

help-buf cell-             \ buffer pointer primed for pre-increment
last-record record + table DO  \ step thru instr'n data records
   cell+ dup   \ point at next cell inside help-buffer
   i @  ( opcode is equiv to instruction with all-0 operands, )
        ( not much help as 0 invalid for many operands,and gives no)
        ( clue to numeric syntax or nbr of like registers available)
   i cell+ @ invert     \ convert final mask to operands mask
   i @ fc000000 AND 40000000 =  \ if conditional branch instruction,
   IF  4080ffc0  AND    \ alt. values avoid invalid combinations,
   ELSE fffdf7f4 AND    \  else fill fields to (near) full capacity.
        ( reason for variation is to avoid incompatible operands. )
        ( using same register for 1st & 2nd fields is often invalid)
   THEN OR
   swap !               \ place generated instruction in help buffer
record +LOOP 
drop                    \ discard temp internal buffer pointer

\ nb: addition of asm-only aliases to data table has caused some of
\ the instructions in help displays to appear as duplicates.

: asm-help ( -- ) \ Outputs pausable disassembly of entire help-buf.
  cr
  ." A sample of most instructions supported by this G4 assembler."
  cr
  ." Press space-bar to pause listing, return-key to single-step. "
  cr
  addr          \ save current dis/asm global place marker on stack
  
\ <sigh> DO NOT use 'asm-help' while assembling a sequence of ppc-
\ instructions to 'here' (which is what 'asm' does automatically),
\ because 'exit?' allots 5 addresses for itself every time a local
\ listing is paused. (A straight 'q' without pausing avoids this
\ side-effect). exit?'s bad behaviour inserts 5 chars of junk into
\ any such sequence of code. (In that situation, favour 'asm?' help
\ instead). The above interjection can be corrected by immediate use
\ of <addr> 'azm' to overwrite the junk cells, not forgetting to
\ revert to using 'asm' once you have fixed the last trashed cell.

  help-buf #records cells bounds DO 
     i dis1  \ i.e. dis without table search; stops at end of buffer
     
     exit? \ THIS WILL HAVE TO BE REPLACED !!! It turns out that
           \ remote terminal pauses output at start of every listing
           \ command, thus interjecting sequences of "true.true...."
           \ into asm or azm code-entry sessions already under way.
           \ In the meantime,remedy is: don't explicitly disassemble
           \ or otherwise list anything during remote assembly of
           \ what is hoped to be a contiguous bloc of code. ('dis1'
           \ is ok as it does not output a list. 'asm?' is also ok
           \ as it omits the call to 'exit?').
     if leave then
     
  cell +LOOP

  to addr   \ restore previous dis/asm 'addr'
  
  cr
  ." Numeric operands wth '0x' prefix & other obviously hexadecimal"
  cr
  ." numbers need inputting as hex. Typing '0x' prefix is optional."
  cr
  ." Simplified 'li', 'mr', 'nop' ... avail, but list as basic forms"
  cr
  ." Sample branches only. Instrns like bdnzflrl+ are also possible"
  cr
  ." Instrns same color as " 33 .color ." fsqrt"  30 .color 
  ."  assemble but will not execute on G4"
  cr
;

\ Provide ASM HELP by demonstrating format of any partially-matched 
\ ppc-instruction(s). For example   " mf" find-help   will
\ disassemble all sample instrns in help-buffer starting with "mf"
\
: find-help ( addr len -- ) \ list help-buf example matches
   addr -rot             \ save dis/asm global address pointer
   help-buf cell-        \ pre-decrement help-buf pointer 
   table 3 cells +       \ mnemonic field's offset in table
   dup #records record * + \ calc. table end-address
   cr 
   swap DO               \ step thru mnemonics in table
      cell+              \ sync help-buf pointer with current record
      -rot               \ temp push it to background
      2dup               \ make consumable copies of args
      i swap comp 0= IF  \ if str-len chars in instrn-record match,
         rot dup dis1    \ disassemble corresponding help-buf entry
      ELSE rot THEN      \ prepare stack for next pass thru loop
   \ NB: exit? DELIBERATELY LEFT OUT. Only a prob. if pattern = "v"
   ( Ctrl-Z will stop local "v" listing, but also erases the screen)
   record +LOOP 
   3drop
   to addr                               \ restore dis/asm place-marker
'addr'
;

: asm? ( -- ) \ a more convenient & reliable HELP companion to 'asm'
   BL word count
   dup 0= IF 
      cr
      ." Usage:  asm? ccc   (where ccc = first char(s) of mnemonic)"
      2drop
   ELSE 
      find-help
   THEN
;

\ given exec-addr or dummy address output by 'see', find and print
\ the label, even if not in dictionary. This version delivers
\ higher yield than previously.
\
: .label ( pseudo-label-minus-the-punctuation | xt -- )
   aligned
   dup
   >flags aligned cell+ 
   dup      ( xt p-name p-name )
   count    ( xt p-name name len )
   2swap    ( name len xt p-name ) 
   -        ( name len gap )
   over     ( name len gap len )
   -        ( name len diff )
   1 8 between IF  ( allow gap for 1 count-byte + up to 7 foll. 0's)
      type ELSE 2drop 
   THEN 
;
\
\ Sample Usage: To find real name of (eg) pseudo-label ^ff87.ee12
\
\               ff87ee12 .label ( remove '^' & '.' from label )
\
\ nul or poss misleading output if used on headerless/inline address
\
alias .adr .label  ( similar to '.adr' mentioned in O.F. docs ? )

\ get xt for ^pseudo.label output by 'see'
: ^ ( u -- xt ) \ eg: 'ff8467c5 ^' gets xt for label ^ff84.67c5
   aligned dup @ 0= IF cell+ THEN   \ skip up to 7 x 0's padding
;

\ patch 'see' to include 'dasm' and '.label' capability
\ 
: (see)  ( xt -- )                 \ enhances built-in original
   dup >flags w@ 00ff AND bf = IF  \ would output have been "code" ?
   dup ." code " cr 
   35 .color .label [char] : emit 30 .color \ hilight the label
      dasm                         \ output ppc disassembly
   ELSE
      (see)                        \ other types of output as before
   THEN
;
: see  ( -- )  \ utilize updated '(see)'; replaces built-in original
   ' (see) 
; 
: (^see) ( dummy-addr-without-punctuation -- )
   dup ^ >flags w@ 00ff AND bf <> IF   ( if output not "code" )
      dup cr 35 .color .label [char] : emit 30 .color space
   THEN
   ^ (see) \ (eg) 'ff8467c5 (^see)' reveals ^ff84.67c5 name&contents
;

: ^see ( -- )  \ usage: ^see ^hexx.labl ( punctuation needed )
   expect-hex  ( assumes label was generated while base = hex )
   [char] . read-opnd 
   opnd [char] ^ confirm drop  ( sees '^' as register name)
   opnd-buf 0c evaluate
   dup 0 ffff between NOT abort" bad arg "
   BL read-opnd
   opnd-buf 0c evaluate
   dup 0 ffff between NOT abort" bad arg"
   swap d# 16 << OR
   (^see)
;
\ code defs now disassemble when (eg) 'see 2dup' is typed at prompt
\ Sometimes body data interrupts disassembly.'+dasm' if that happens
\ To disassemble non-code defs,  type:
\  ' word dasm   ( substitute any forth dictionary word for 'word' )
\ Viewing hidden defs requires no more than its pseudo label (eg)
\  ^see ^ff84.67c5
\
\ NOTE: '^see' and '(^see)' will more likely give garbage than an
\ error msg if you give them an incorrect or inappropriate address.
\ (Most common symptom: garbage dasm preceded by empty ':' label).
\ If that happens, check address or try plain 'see'. Failing that,
\ do a memory dump to ensure address is preceded by a forth-style
\ header. These words don't work with headerless/inline addresses.


\ ------------------ Set default user preferences ------------------
\ 
\ alternative choices available here or via direct command any time:
\
nextline  \ user input remains interspersed with echoed-back instrns
\ sameline \ asm/azm echoes back on same line,overwriting user input
\
reveal   \ hidden instrn extracted if present (ignore reserved bits)
\ conceal \ disassemble instrn only if res-bits clean,else -> "data"
\
\ next option only available for conditional branch instructions:
simplify     \ disassemble instr'n to a simpler form if available
\ unsimplify \ echo instr'n in basic form,regardless of alternatives


\ --------------------- Program startup banner ---------------------
cr
.." Public Domain replacement 'dis' for G4 Macintosh Open Firmware."
cr
.." Written and revised by Neville Duguid (Tinkerer) 2008 and 2009."
cr
.." PowerPC instructions are colour-coded as follows:"
cr
    030 .color ." User=30  "                  \ black 
    034 .color ." Supervisor=34  "            \ red ?  (ANSI=blue)
    033 .color ." Unimplemented=33  "         \ cyan ? (ANSI=yellow)
    031 .color ." AltiVec=31  "               \ blue ? (ANSI=red)
    032 .color ." Data=32"                    \ green
    030 .color    \ restore default text color
cr    
.." dis, +dis, dasm, +dasm await your command. Usage:<address> dis"
cr
cr
.." asm & azm one-line assemblers added by The Tinkerer, May, 2009."
cr
.." Usage: asm args ( where args = typed ppc-instuction). Some args"
cr
.." require decimal, some need hex. 'asm-help' or 'asm?' for clues."
cr
.." Each ppc instruction entered must be preceded by the word 'asm'"
cr
\ ALTERNATIVELY <address> azm      (note precautions in src abv)
\
\ The normal practice for entering new 'code' defs:
\
\               code new-name
\               asm 1st-ppc-instruction
\               asm 2nd-ppc-instruction
\               asm 3rd-ppc-instruction
\               asm ...
\               asm nth-ppc-instruction
\               c; ( or 'end-code' foll. user-specified exit code)
\
\ The sequence may be interrupted to issue other forth commands, but
\ not those allocating space in or immediately below the dictionary.
\ Especially beware of commands containing the Open Firmware word
\ 'exit?', since using its pause option can insert instances of 
\ "true." into temporarily interrupted code-entry sequences. 
\
0
tinkerer
11/27/2009 11:51:36 AM
comp.sys.powerpc.tech 819 articles. 1 followers. Post Follow

1 Replies
355 Views

Similar Articles

[PageSpeed] 31

Tinkerer Atlarge <tinkerer@optusnet.com.au> wrote:

> \ **** IF YOU PASTED THIS TEXT FROM A WEB-BASED NEWSREADER 
> \ AND GET COMPILE ERRORS caused by some weird-looking chars, 
> \ load it into BBEdit or TextWrangler and choose "Zap Gremlins"
> \ from the Text Menu. Nominate a single space char to replace them.
> \

Unfortunately two gremlins crept in which can't be fixed that way.
Some tabs disguised as blanks made two of the lines too long. The
single-line comments wrapped to the start of the following lines where
they are no longer ignored as comments.

I will attempt to cancel the original and post a corrected version.
However if that does not work, the original post can easily be fixed
with a text editor.

The two broken lines are:

Line 2089:

          drop 0                   ( as return 
code,signifies"unrecognized")

Line 2569 (2570):

   to addr                               \ restore dis/asm place-marker
'addr'

In both cases, all you need do is backspace from the start of the second
line, thereby deleting the spurious line-break between the two parts.
That will cause the 2nd half of each line to go back to the end of the
previous line where it belongs.

If accessing via google groups, don't attempt to paste src from their
webpage but download it as a file. There is a link that will do that at
the bottom of the second page you get when you click 'more' at the end
of the first one. The download file has none of the gremlins mentioned
in the source, but you will still need to fix the two broken lines if
Open Firmware reports them as errors.

Cheers

Tink
0
tinkerer
11/27/2009 12:53:12 PM
Reply: