arm-disasm.f

这个是关于G.726算法的源程序

	['] EXTRA-MEM-INDEX. MEM-OPERANDS.
;

: SWAP-OP   ( x -- x )   \ Decode SWAP instruction
	00000F00 SBZ
	S" swp" S.BL.CC.
	BIT22? IF [CHAR] b C.BL. THEN
	TAB. REG12. REG0. [. REG16. ].
;

: STREX-OP   ( x -- x )   \ Decode SWAP instruction
	00000F00 SBO
	S" strex" S.BL.CC.
	TAB. REG12. REG0. [. REG16. ].
;

: LDREX-OP   ( x -- x )   \ Decode SWAP instruction
	00000F0F SBO
	S" ldrex" S.BL.CC.
	TAB. REG12. [. REG16. ].
;

: MULTI-MODE.   ( x -- x )   \ Output LDM/STM address mode
	DUP 17 RSHIFT 3 AND SELECT" 2daiadbib" S.BL.
;

: MULTI-OP   ( x -- x )   \ Decode LDM and STM instructions
	BIT20? ?SELECT" stmldm" S.BL.CC.
	MULTI-MODE.
	TAB. REG16. !.
	[CHAR] { C.BL.
	10 0
	DO
		1 I LSHIFT OVER AND
		IF I REG. THEN
	LOOP
	[CHAR] } C.BL.
	BIT22? IF [CHAR] ^ C. THEN
;

: RFE-OP   ( x -- x )   \ Decode RFE instruction
	0000F0FF SBZ
	S" rfe" S.BL.
	MULTI-MODE.
	TAB. REG16. !.
;

: SRS-OP   ( x -- x )   \ Decode SRS instruction
	0000F0E0 SBZ
	S" srs" S.BL.
	MULTI-MODE.
	TAB. DUP 1F AND #. !.
;

\ ----------------------------------------------------------------------------
\ Branch instructions...

: BRANCH-OP   ( a-addr x -- a-addr x )   \ Decode B,BL and BLX(1) instructions
	2DUP 8 LSHIFT 6 ARSHIFT + 8 + >R
	DUP F0000000 U<
	IF
		DUP 01000000 AND ?SELECT" b bl" S.BL.CC.
	ELSE
		\ blx instruction...
		DUP 17 RSHIFT 2 AND R> + >R   \ add in the half-word bit to target
		S" blx" S.BL.
	THEN
	TAB. R> U#.
;

: BX-OP   ( x -- x )   \ Decode BX instruction (register form)
	000fff00 SBO
	DUP 4 RSHIFT 3 AND SELECT" 3   bx bxjblx" S.BL.CC.
	TAB. REG0.
;

: SWI-OP   ( x -- x )   \ Decode SWI instructions
	S" swi" S.BL.CC. TAB.   DUP 00FFFFFF AND #. ;

\ ----------------------------------------------------------------------------
\ Decode MRS and MSR instructions...

: PSR.   ( x -- x )
	BIT22? ?SELECT" cpsrspsr" S.
;

: MRS-OP   ( x -- x )   \ Decode MRS instruction
	000F0000 SBO 00000FFF SBZ
	S" mrs" S.BL.CC.
	TAB. REG12. PSR.
;

: MSR-OP   ( x -- x )
	0000F000 SBO
	S" msr" S.BL.CC.
	TAB. PSR. [CHAR] _ C.BL.
	000F0000 2DUP AND 0= ?UNPREDICTABLE   \ treat no flags as unpredictable	
	DUP 10 RSHIFT FLAGS." cxsf" BL.
;

: MSR-IMM-OP   ( x -- x)   \ Decode MSR immediate instruction
	MSR-OP IMMEDIATE. ;

: MSR-REG-OP   ( x -- x)   \ Decode MSR immediate instruction
	00000F00 SBZ   MSR-OP REG0. ;

\ ----------------------------------------------------------------------------
\ Coprocessor instructions...

: 0-15.   ( x -- )   \ Output bottom 4 bits of x as decimal number
	0F AND SELECT" 20 1 2 3 4 5 6 7 8 9 101112131415" S.BL.
;

: CREG.   ( x -- )   \ Output coprocessor register given by bottom 4 bits of x
	[CHAR] c C. 0-15. ;

: CP.   ( x -- x )   \ Output coprocessor number in op-code x
	[CHAR] p C.   DUP 8 RSHIFT 0-15. ;

: COP.   ( x c-addr u - u )   \ Output coprocessor op name and condition code
	S.
	DUP 1C RSHIFT 0F =
	IF [CHAR] 2 C.BL.   \ Append '2' for condition code = 0F
	ELSE BL. CC.
	THEN
;

: CO-MEM-OP   ( x -- x )   \ Decode LDC and STC instructions
	BIT20? ?SELECT" stcldc" COP.
	BIT22? IF [CHAR] l C.BL. THEN
	TAB. CP.
	DUP 0C RSHIFT CREG.
	[. REG16.
	DUP 0FF AND 2 LSHIFT
	OVER 01000000 AND
	IF
		INDEX#. ]. !.
	ELSE
		].
		OVER 00200000 AND
		IF
			INDEX#.
		ELSE
			[CHAR] { C.BL.
			2 ARSHIFT #.
			[CHAR] } C.BL.
			DUP 00800000 AND 0= IF UNDEFINED-OP THEN
		THEN
	THEN
;

: CO-OPERANDS.   ( x -- x )   \ Output final coprocessor instruction arguments
	DUP 10 RSHIFT CREG.
	DUP CREG.
	DUP 5 RSHIFT 7 AND #.
;

: CDP-OP   ( x -- x )   \ Decode CDP instruction
	S" cdp" COP.
	TAB. CP.
	DUP 14 RSHIFT 0F AND #.
	DUP 0C RSHIFT CREG.
	CO-OPERANDS.
;

: CO-REG-OP   ( x -- x )   \ Decode MRC and MCR instructions
	BIT20? ?SELECT" mcrmrc" COP.
	TAB. CP.
	DUP 15 RSHIFT 7 AND #.
	REG12.
	CO-OPERANDS.
;

: CO-REG2-OP   ( x -- x )   \ Decode MRRC and MCRR instructions
	BIT20? ?SELECT" mcrrmrrc" COP.
	TAB. CP.
	DUP 4 RSHIFT 0F AND #.
	REG12. REG16.
	DUP CREG.
;

\ ----------------------------------------------------------------------------
\ Miscelaneous instructions...

: CLZ-OP   ( x -- x )   \ Decode CLZ instruction
	000F0F00 SBO
	S" clz" S.BL.CC. TAB. REG12. REG0. ;

: BKPT-OP   ( x -- x )   \ Decode BKPT instruction
	F0000000 2DUP AND E0000000 <> ?UNPREDICTABLE
	DUP 0000000F AND
	OVER 000FFF00 AND
	4 RSHIFT OR
	S" bkpt" S.BL. TAB. #. ;

: CPSI-OP   ( x -- x )   \ Decode CPS instruction
	0000FE00 SBZ
	DUP 00040000 AND ?SELECT" cpsiecpsid" S. TAB.
	1C0 2DUP AND 0= ?UNPREDICTABLE   \ treat no flags changed as unpredictable
	DUP 6 RSHIFT FLAGS." fia" BL.
	DUP 1F AND
	OVER 00020000 AND
	IF #.
	ELSE 1 ?UNPREDICTABLE   \ mode SBZ if not changing it
	THEN
;

: CPS-OP   ( x -- x )   \ Decode CPS instruction
	0004FFC0 SBZ 00020000 SBO
	S" cps" S. TAB.
	DUP 1F AND #.
;

: SETEND-OP   ( x -- x )   \ Decode SETEND instruction
	0000FC0F SBZ
	S" setend" S. TAB.
	DUP 00000200 AND ?SELECT" lebe" S.
;

\ ----------------------------------------------------------------------------
\ Media instructions

SARRAY PAS1
	," "  ," s"  ," q"   ," sh"
	," "  ," u"  ," uq"  ," uh"

SARRAY PAS2
   ," add16"  ," addsubx"  ," subaddx"  ," sub16"
   ," add8"   ," "         ," "         ," sub8"

: PARALLEL-ADD-SUB-OP   ( x -- x )   \ Decode parallel add/sub instructions
	00000F00 SBO
	DUP 14 RSHIFT 7 AND PAS1 -UNDEFINED S.
	DUP 5 RSHIFT 7 AND PAS2 -UNDEFINED S.BL.CC.
	TAB. REG12. REG16. REG0.
;

: PACK-HALFWORD-OP   ( x -- x )   \ Decode PKHBT and PKHTB instruction
	DUP 40 AND ?SELECT" pkhbtpkhtb" S.BL.CC.
	TAB. REG12. REG16. REG0. SHIFT#.
;

: WORD-SATURATE-OP   ( x -- x )   \ Decode SSAT and USAT instruction
	BIT22? ?SELECT" ssatusat" S.BL.CC.
	TAB. REG12. DUP 10 RSHIFT 1F AND #. REG0. SHIFT#.
;

: HALF-WORD-SATURATE-OP   ( x -- x )   \ Decode SSAT16 and USAT16 instructions
	00000F00 SBO
	BIT22? ?SELECT" ssat16usat16" S.BL.CC.
	TAB. REG12. DUP 10 RSHIFT F AND #. REG0.
;

: SEL-OP   ( x -- x)   \ Decode SEL instruction
	00000F00 SBO
	S" sel" S.BL.CC.
	TAB. REG12. REG16. REG0.	
;

: EXTEND-OP   ( x -- x )   \ Decode extend instructions
	00000300 SBZ
	DUP 10 RSHIFT F AND F <> >R   \ flag true if extend with add
	BIT22? ?SELECT" sxtuxt" S.
	R@ IF [CHAR] a C. THEN
	DUP 14 RSHIFT 3 AND SELECT" 3b16   b  h  " -UNDEFINED S.BL.CC.
	TAB. REG12. R> IF REG16. THEN REG0.
	DUP C00 AND IF SHIFT#. THEN
;

: REV-OP.   ( x c-addr u -- x )
	S.BL.CC.
	000F0F00 SBO
	TAB. REG12. REG0.
;

: REV-OP   ( x -- x )   \ Decode extend instructions
	S" rev" REV-OP. ;

: REV16-OP   ( x -- x )   \ Decode extend instructions
	S" rev16" REV-OP. ;

: REVH-OP   ( x -- x )   \ Decode extend instructions
	S" revsh" REV-OP. ;

: USAD8-OP   ( x -- x )   \ Decode USDA instruction
	S" usad8" S.BL.CC. TAB. REG16. REG0. REG8. ;

: USADA8-OP   ( x -- x )   \ Decode USDA8 instruction
	S" usada8" S.BL.CC. TAB. REG16. REG0. REG8. REG12. ;

\ ----------------------------------------------------------------------------
\ Top level functions...

: PATTERN   ( "name<space>" -- )   \ Define a list of patterns to match
	CREATE
	DOES>   ( x -- x )   \ Find match for x in list of patterns
	BEGIN
		2DUP @ AND
		OVER CELL+ @ <>
	WHILE
		CELL+ CELL+ CELL+
	REPEAT
	CELL+ CELL+ @ EXECUTE
;

PATTERN PATTERN-0E000090-00000090   ( x -- x )
	\ Multiplies and extra load/store instructions...
	0FE000F0 , 00000090 , ' MUL-OP ,
	0FE000F0 , 00200090 , ' MLA-OP ,
	0FF000F0 , 00400090 , ' UMAAL-OP ,
	0F8000F0 , 00800090 , ' LONG-MUL-OP ,
	0FB000F0 , 01000090 , ' SWAP-OP ,
	0FF000F0 , 01800090 , ' STREX-OP ,
	0FF000F0 , 01900090 , ' LDREX-OP ,
	000000F0 , 00000090 , ' UNDEFINED-OP ,
	01200000 , 00200000 , ' UNDEFINED-OP , 	\ post index without writeback
	00100040 , 00000040 , ' DOUBLE-MEM-OP ,
	0 , 0 , ' EXTRA-MEM-OP ,

PATTERN MISCELANEOUS-OP   ( x -- x )
	\ Miscelaneous instructions...
	FFF90020 , F1080000 , ' CPSI-OP ,
	FFF90020 , F1000000 , ' CPS-OP ,
	FFFFFDFF , F1010000 , ' SETEND-OP ,
	0FB000F0 , 01000000 , ' MRS-OP ,
	0FF000C0 , 01200000 , ' BX-OP ,
	0FF000F0 , 01600010 , ' CLZ-OP ,
	0F9000F0 , 01000050 , ' QADD/SUB-OP ,
	0FF000F0 , 01200070 , ' BKPT-OP ,
	0FF00090 , 01000080 , ' SMLAXY-OP ,
	0FF000B0 , 01200080 , ' SMLAWY-OP ,
	0FF000B0 , 012000A0 , ' SMULWY-OP ,
	0FF00090 , 01400080 , ' SMLALXY-OP ,
	0FF00090 , 01600080 , ' SMULXY-OP ,
	0 , 0 , ' UNDEFINED-OP ,

PATTERN MEDIA-OP   ( x -- x )
	\ Media instructions...
	0F800010 , 06000010 , ' PARALLEL-ADD-SUB-OP ,
	0FF00030 , 06800010 , ' PACK-HALFWORD-OP ,
	0FA00030 , 06A00010 , ' WORD-SATURATE-OP ,
	0FF000F0 , 06B00030 , ' REV-OP ,
	0FF000F0 , 06B000B0 , ' REV16-OP ,
	0FF000F0 , 06F000B0 , ' REVH-OP ,
	0FB000F0 , 06A00030 , ' HALF-WORD-SATURATE-OP ,
	0FF000F0 , 068000B0 , ' SEL-OP ,
	0F8000F0 , 06800070 , ' EXTEND-OP ,
	0FF0F090 , 0700F010 , ' DUAL-MUL-OP ,
	0FF00090 , 07000010 , ' DUAL-MULA-OP ,
	0FF0F0D0 , 0750F010 , ' MOST-SIG-MUL-OP ,
	0FF000D0 , 07500010 , ' MOST-SIG-MULA-OP ,
	0FF000D0 , 075000D0 , ' MOST-SIG-MULA-OP ,
	0FF00090 , 07400010 , ' LONG-DUAL-MULA-OP ,
	0FF0F0F0 , 0780F010 , ' USAD8-OP ,
	0FF000F0 , 07800010 , ' USADA8-OP ,
	0 , 0 , ' UNDEFINED-OP ,

PATTERN (disasm-op)   ( a-addr x -- a-addr x )
	\ Decode op-code x with origin a-addr
	0E000090 , 00000090 , ' PATTERN-0E000090-00000090 ,
	0FB00000 , 03200000 , ' MSR-IMM-OP ,
	0FB000F0 , 01200000 , ' MSR-REG-OP ,
	0F900000 , 01000000 , ' MISCELANEOUS-OP ,
	0DA00000 , 01A00000 , ' MOV-OP ,
	0D900000 , 01000000 , ' UNDEFINED-OP , \ CMP/TST without S flag
	0D900000 , 01100000 , ' CMP-TST-OP ,
	0C000000 , 00000000 , ' DATA-OP ,

	0E000010 , 06000010 , ' MEDIA-OP ,
	FD70F000 , F550F000 , ' PLD-OP ,
	0C000000 , 04000000 , ' MEM-OP ,

	FE500F00 , F8100A00 , ' RFE-OP ,
	FE5F0F00 , F84D0A00 , ' SRS-OP ,
	0E000000 , 08000000 , ' MULTI-OP ,
	0E000000 , 0A000000 , ' BRANCH-OP ,

	0FE00000 , 0C400000 , ' CO-REG2-OP ,
	0E000000 , 0C000000 , ' CO-MEM-OP ,
	0F000010 , 0E000000 , ' CDP-OP ,
	0F000010 , 0E000010 , ' CO-REG-OP ,
	0F000000 , 0F000000 , ' SWI-OP ,

: BEGIN-DISASM   ( -- )   \ Initialise disassembler state
	0 BUFFER C!
	FALSE UNDEFINED !
	FALSE UNPREDICTABLE !
;

: END-DISASM   ( -- c-addr u )   \ Return text for disassembly of instruction
	BUFFER COUNT -TRAILING
;

: DISASM-OP   ( a-addr x -- a-addr x )
	BUFFER C@ >R
	(disasm-op) 2DROP
	UNDEFINED @
	IF
		R> BUFFER C! S" UNDEFINED" S.
		EXIT
	THEN
	R> DROP
	UNPREDICTABLE @
	IF TAB. S" \ UNPREDICTABLE" S. THEN
;

: H32.   ( x -- )   \ Output x as a 32 bit hexadecimal value
	BASE @ >R
	HEX 0 <# # # # # # # # # #> S.BL.
	R> BASE ! ;

\ ----------------------------------------------------------------------------
\ Public words for producing disassembly

PREVIOUS DEFINITIONS ALSO ARM-DISASSEMBLER

: ARM-DISASM-OP   ( a-addr x -- c-addr u )   \ Disassemble a single opcode
	\ Disassemble op-code x with origin a-addr
	BEGIN-DISASM
	DISASM-OP
	END-DISASM
;

: ARM-DISASM ( a-addr u -- )   \ Disassemble memory
	\ Disassemble instructions a-addr thru a-addr+u-1
	OVER + SWAP
 	BEGIN
		2DUP U>
	WHILE
		BEGIN-DISASM
		DUP H32. BL.
		DUP @ H32. BL.
		DUP DUP @ DISASM-OP
		END-DISASM
		TYPE CR
		CELL+
	REPEAT
	2DROP
;

\ ----------------------------------------------------------------------------

PREVIOUS DEFINITIONS

DECIMAL