File:  [gforth] / gforth / arch / alpha / disasm.fs
Revision 1.2: download - view: text, annotated - select for diffs
Wed Oct 13 13:00:08 1999 UTC (22 years, 11 months ago) by anton
Branches: MAIN
CVS tags: HEAD
bugixes

    1: 
    2: \ bernd thallner 9725890 e881
    3: \ disassembler in forth for alpha
    4: 
    5: \ util
    6: 
    7: : h@ ( addr -- n )  \ 32 bit fetch
    8: dup dup aligned = if
    9:   @
   10:   $00000000ffffffff and
   11: else
   12:   4 - @
   13:   $20 rshift
   14: endif
   15: ;
   16: 
   17: create string_table
   18: 1000 allot
   19: 
   20: \ makes an table entry with following data structure
   21: \ 64 start address in string_table 48 strlen 32 format (cOpc, cBra, cF-P, cMem, cMfc, cMbr, cOpr, cPcd) 0
   22: 
   23: : mktbentry, { start format straddr strlen -- start }  \ make table entry
   24:   straddr string_table start + strlen cmove
   25:   start 48 lshift
   26:   strlen 32 lshift or
   27:   format or
   28:   ,
   29:   start strlen +
   30: ;
   31: 
   32: \ prints the string from stringtable
   33: \ table_entry = 64 start address in string_table 48 strlen 32 unused 0
   34: 
   35: : print_string ( table_entry -- )  \ print string entry
   36:   dup
   37:   48 rshift string_table +
   38:   swap
   39:   32 rshift $000000000000ffff and
   40:   type
   41: ;
   42: 
   43: \ Opr tab0 opcode 10.xxx
   44: \ Opr tab1 opcode 11.xxx
   45: \ Opr tab2 opcode 12.xxx
   46: \ Opr tab3 opcode 13.xxx
   47: 
   48: \ F-P tab0 opcode 15.xxx
   49: \ F-P tab1 opcode 16.xxx
   50: \ F-P tab2 opcode 17.xxx
   51: 
   52: : tab0 2* 2* ;
   53: : tab1 2* 2* 1 + ;
   54: : tab2 2* 2* 2 + ;
   55: : tab3 2* 2* 3 + ;
   56: 
   57: 0 \ string_table offset
   58: 
   59: create Opr_list
   60: 
   61: $00 tab0 s" addl"          mktbentry,
   62: $40 tab0 s" addlv"         mktbentry,
   63: $20 tab0 s" addq"          mktbentry,
   64: $60 tab0 s" addqv"         mktbentry,
   65: $0f tab0 s" cmpbge"        mktbentry,
   66: $2d tab0 s" cmpeq"         mktbentry,
   67: $6d tab0 s" cmple"         mktbentry,
   68: $4d tab0 s" cmplt"         mktbentry,
   69: $3d tab0 s" cmpule"        mktbentry,
   70: $1d tab0 s" cmpult"        mktbentry,
   71: $02 tab0 s" s4addl"        mktbentry,
   72: $22 tab0 s" s4addq"        mktbentry,
   73: $0b tab0 s" s4subl"        mktbentry,
   74: $2b tab0 s" s4subq"        mktbentry,
   75: $12 tab0 s" s8addl"        mktbentry,
   76: $32 tab0 s" s8addq"        mktbentry,
   77: $1b tab0 s" s8ubl"         mktbentry,
   78: $3b tab0 s" s8ubq"         mktbentry,
   79: $09 tab0 s" subl"          mktbentry,
   80: $49 tab0 s" sublv"         mktbentry,
   81: $29 tab0 s" subq"          mktbentry,
   82: $69 tab0 s" subqv"         mktbentry,
   83: 
   84: $00 tab1 s" and"           mktbentry,
   85: $08 tab1 s" bic"           mktbentry,
   86: $20 tab1 s" bis"           mktbentry,
   87: $24 tab1 s" cmoveq"        mktbentry,
   88: $46 tab1 s" cmovge"        mktbentry,
   89: $66 tab1 s" cmovgt"        mktbentry,
   90: $16 tab1 s" cmovlbc"       mktbentry,
   91: $14 tab1 s" cmovlbs"       mktbentry,
   92: $64 tab1 s" cmovle"        mktbentry,
   93: $44 tab1 s" cmovlt"        mktbentry,
   94: $26 tab1 s" cmovne"        mktbentry,
   95: $48 tab1 s" eqv"           mktbentry,
   96: $28 tab1 s" ornot"         mktbentry,
   97: $40 tab1 s" xor"           mktbentry,
   98: 
   99: $06 tab2 s" extbl"         mktbentry,
  100: $6a tab2 s" extlh"         mktbentry,
  101: $26 tab2 s" extll"         mktbentry,
  102: $7a tab2 s" extqh"         mktbentry,
  103: $36 tab2 s" extql"         mktbentry,
  104: $5a tab2 s" extwh"         mktbentry,
  105: $16 tab2 s" extwl"         mktbentry,
  106: $0b tab2 s" insbl"         mktbentry,
  107: $67 tab2 s" inslh"         mktbentry,
  108: $2b tab2 s" insll"         mktbentry,
  109: $77 tab2 s" insqh"         mktbentry,
  110: $3b tab2 s" insql"         mktbentry,
  111: $57 tab2 s" inswh"         mktbentry,
  112: $1b tab2 s" inswl"         mktbentry,
  113: $02 tab2 s" mskbl"         mktbentry,
  114: $62 tab2 s" msklh"         mktbentry,
  115: $22 tab2 s" mskll"         mktbentry,
  116: $72 tab2 s" mskqh"         mktbentry,
  117: $32 tab2 s" mskql"         mktbentry,
  118: $52 tab2 s" mskwh"         mktbentry,
  119: $12 tab2 s" mskwl"         mktbentry,
  120: $39 tab2 s" sll"           mktbentry,
  121: $3c tab2 s" sra"           mktbentry,
  122: $34 tab2 s" srl"           mktbentry,
  123: $30 tab2 s" zap"           mktbentry,
  124: $31 tab2 s" zapnot"        mktbentry,
  125: 
  126: $00 tab3 s" mull"          mktbentry,
  127: $20 tab3 s" mullq"         mktbentry,
  128: $30 tab3 s" umulh"         mktbentry,
  129: $40 tab3 s" mullv"         mktbentry,
  130: $60 tab3 s" mullqv"        mktbentry,
  131: 
  132: create Mfc_list
  133: 
  134: $0000 s" trapb"            mktbentry,
  135: $0400 s" excb"             mktbentry,
  136: $4000 s" mb"               mktbentry,
  137: $4400 s" wmb"              mktbentry,
  138: $8000 s" fetch"            mktbentry,
  139: $a000 s" fetch_m"          mktbentry,
  140: $c000 s" rpcc"             mktbentry,
  141: $e000 s" rc"               mktbentry,
  142: $f000 s" rs"               mktbentry,
  143: 
  144: create Mbr_table
  145: 
  146: ( 00 ) 0 s" jmp"           mktbentry, 
  147: ( 01 ) 0 s" jsr"           mktbentry,
  148: ( 02 ) 0 s" ret"           mktbentry,
  149: ( 03 ) 0 s" jsr_coroutine" mktbentry,
  150: 
  151: create F-P_list
  152: 
  153: $080 tab0 s" addf"         mktbentry,
  154: $081 tab0 s" subf"         mktbentry,
  155: $082 tab0 s" mulf"         mktbentry,
  156: $083 tab0 s" divf"         mktbentry,
  157: $09e tab0 s" cvtdg"        mktbentry,
  158: $0a0 tab0 s" addg"         mktbentry,
  159: $0a1 tab0 s" subg"         mktbentry,
  160: $0a2 tab0 s" mulg"         mktbentry,
  161: $0a3 tab0 s" divg"         mktbentry,
  162: $0a5 tab0 s" cmpgeq"       mktbentry,
  163: $0a6 tab0 s" cmpglt"       mktbentry,
  164: $0a7 tab0 s" cmpgle"       mktbentry,
  165: $0ac tab0 s" cvtgf"        mktbentry,
  166: $0ad tab0 s" cvtgd"        mktbentry,
  167: $0af tab0 s" cvtgq"        mktbentry,
  168: $0bc tab0 s" cvtqf"        mktbentry,
  169: $0be tab0 s" cvtqg"        mktbentry,
  170: 
  171: $080 tab1 s" adds"         mktbentry,
  172: $081 tab1 s" subs"         mktbentry,
  173: $082 tab1 s" mulls"        mktbentry,
  174: $083 tab1 s" divs"         mktbentry,
  175: $0a0 tab1 s" addt"         mktbentry,
  176: $0a1 tab1 s" subt"         mktbentry,
  177: $0a2 tab1 s" mullt"        mktbentry,
  178: $0a3 tab1 s" divt"         mktbentry,
  179: $0a4 tab1 s" cmptun"       mktbentry,
  180: $0a5 tab1 s" cmpteq"       mktbentry,
  181: $0a6 tab1 s" cmptlt"       mktbentry,
  182: $0a7 tab1 s" cmptle"       mktbentry,
  183: $0ac tab1 s" cvtts"        mktbentry,
  184: $0af tab1 s" cvttq"        mktbentry,
  185: $0bc tab1 s" cvtqs"        mktbentry,
  186: $0be tab1 s" cvtqt"        mktbentry,
  187: $2ac tab1 s" cvtst"        mktbentry,
  188: 
  189: $010 tab2 s" cvtlq"        mktbentry,
  190: $020 tab2 s" cpys"         mktbentry,
  191: $021 tab2 s" cpysn"        mktbentry,
  192: $022 tab2 s" cpyse"        mktbentry,
  193: $024 tab2 s" mt_fpcr"      mktbentry,
  194: $025 tab2 s" mf_fpcr"      mktbentry,
  195: $02a tab2 s" fcmoveq"      mktbentry,
  196: $02b tab2 s" fcmovne"      mktbentry,
  197: $02c tab2 s" fcmovlt"      mktbentry,
  198: $02d tab2 s" fcmovge"      mktbentry,
  199: $02e tab2 s" fcmovle"      mktbentry,
  200: $02f tab2 s" fcmovgt"      mktbentry,
  201: $030 tab2 s" cvtql"        mktbentry,
  202: $130 tab2 s" cvtqlv"       mktbentry,
  203: $530 tab2 s" cvtqlsv"      mktbentry,
  204: 
  205: create register_table
  206: 
  207: ( 00 ) 0 s" v0"           mktbentry,
  208: ( 01 ) 0 s" t0"           mktbentry,
  209: ( 02 ) 0 s" t1"           mktbentry,
  210: ( 03 ) 0 s" t2"           mktbentry,
  211: ( 04 ) 0 s" t3"           mktbentry,
  212: ( 05 ) 0 s" t4"           mktbentry,
  213: ( 06 ) 0 s" t5"           mktbentry,
  214: ( 07 ) 0 s" t6"           mktbentry,
  215: ( 08 ) 0 s" t7"           mktbentry,
  216: ( 09 ) 0 s" s0"           mktbentry,
  217: ( 0a ) 0 s" s1"           mktbentry,
  218: ( 0b ) 0 s" s2"           mktbentry,
  219: ( 0c ) 0 s" s3"           mktbentry,
  220: ( 0d ) 0 s" s4"           mktbentry,
  221: ( 0e ) 0 s" s5"           mktbentry,
  222: ( 0f ) 0 s" fp"           mktbentry,
  223: ( 10 ) 0 s" a0"           mktbentry,
  224: ( 11 ) 0 s" a1"           mktbentry,
  225: ( 12 ) 0 s" a2"           mktbentry,
  226: ( 13 ) 0 s" a3"           mktbentry,
  227: ( 14 ) 0 s" a4"           mktbentry,
  228: ( 15 ) 0 s" a5"           mktbentry,
  229: ( 16 ) 0 s" t8"           mktbentry,
  230: ( 17 ) 0 s" t9"           mktbentry,
  231: ( 18 ) 0 s" t10"          mktbentry,
  232: ( 19 ) 0 s" t11"          mktbentry,
  233: ( 1a ) 0 s" ra"           mktbentry,
  234: ( 1b ) 0 s" t12"          mktbentry,
  235: ( 1c ) 0 s" at"           mktbentry,
  236: ( 1d ) 0 s" gp"           mktbentry,
  237: ( 1e ) 0 s" sp"           mktbentry,
  238: ( 1f ) 0 s" zero"         mktbentry,
  239: 
  240: defer decode_register
  241: 
  242: : decode_register_symb ( register -- )
  243:   cells register_table +
  244:   @ print_string $20 emit
  245: ;
  246: 
  247: : decode_register_number ( register -- )
  248:   .
  249: ;
  250: 
  251: ' decode_register_number is decode_register
  252: \ ' decode_register_symb is decode_register
  253: 
  254: create decode_code
  255: 
  256: : decode_Opc ( instruction tbentry -- )
  257:   print_string drop
  258: ;
  259: 
  260: : decode_Bra ( instruction tbentry -- )
  261:   swap
  262:   dup $03e00000 and 21 rshift decode_register
  263:   $001fffff and .
  264:   print_string
  265: ;
  266: 
  267: : decode_F-P ( instruction tbentry -- )
  268:   drop
  269:   dup $03e00000 and 21 rshift decode_register
  270:   dup $001f0000 and 16 rshift decode_register
  271:   dup $0000001f and decode_register
  272:   dup 26 rshift $15 -
  273:   swap $0000fff0 and 3 rshift or F-P_list
  274:   begin
  275:     dup @ rot swap over over $00000000ffffffff and
  276:     = if print_string swap drop register_table swap else drop endif
  277:     swap 1 cells + dup register_table >
  278:   until
  279:   drop drop
  280: ;
  281: 
  282: : decode_Mem ( instruction tbentry -- )
  283:   swap
  284:   dup $03e00000 and 21 rshift decode_register
  285:   dup $0000ffff and .
  286:   $001f0000 and 16 rshift decode_register
  287:   print_string
  288: ;
  289: 
  290: : decode_Mfc ( instruction tbentry -- )
  291:   drop
  292:   dup $03e00000 and 21 rshift decode_register
  293:   dup $001f0000 and 16 rshift decode_register
  294:   $0000ffff and Mfc_list
  295:   begin
  296:     dup @ rot swap over over $00000000ffffffff and
  297:     = if print_string drop drop register_table 1 else drop endif
  298:     swap 1 cells + dup F-P_list >
  299:   until
  300:   drop drop
  301: ;
  302: 
  303: : decode_Mbr ( instruction tbentry -- )
  304:   drop
  305:   dup $03e00000 and 21 rshift decode_register
  306:   dup $001f0000 and 16 rshift decode_register
  307:   dup $00003fff and decode_register
  308:   $0000c000 and 14 rshift cells Mbr_table +
  309:   @ print_string
  310: ;
  311: 
  312: : decode_Opr ( instruction tbentry -- )
  313:   drop
  314:   dup $03e00000 and 21 rshift decode_register
  315:   dup dup $00001000 and $00001000
  316:   = if
  317:     $001fe000 and 13 rshift . -1
  318:   else
  319:     $001f0000 and 16 rshift decode_register 0
  320:   endif
  321:   swap dup $0000001f and decode_register
  322:   dup 26 rshift $10 -
  323:   swap $00000fe0 and 3 rshift or Opr_list
  324:   begin
  325:     dup @ rot swap over over $00000000ffffffff and
  326:     = if print_string swap drop register_table swap else drop endif
  327:     swap 1 cells + dup Mfc_list >
  328:   until
  329:   drop drop if $23 emit endif
  330: ;
  331: 
  332: : decode_Pcd ( instruction tbentry -- )
  333:   swap
  334:   $0000000003ffffff and .
  335:   print_string
  336: ;
  337: 
  338: \ format
  339: 
  340: ' decode_Opc decode_code - constant cOpc
  341: ' decode_Bra decode_code - constant cBra
  342: ' decode_F-P decode_code - constant cF-P
  343: ' decode_Mem decode_code - constant cMem
  344: ' decode_Mfc decode_code - constant cMfc
  345: ' decode_Mbr decode_code - constant cMbr
  346: ' decode_Opr decode_code - constant cOpr
  347: ' decode_Pcd decode_code - constant cPcd
  348: 
  349: create opcode_table
  350: 
  351: ( 00 ) cPcd s" call_pal" mktbentry,
  352: ( 01 ) cOpc s" opc01"       mktbentry,
  353: ( 02 ) cOpc s" opc02"       mktbentry,
  354: ( 03 ) cOpc s" opc03"       mktbentry,
  355: ( 04 ) cOpc s" opc04"       mktbentry,
  356: ( 05 ) cOpc s" opc05"       mktbentry,
  357: ( 06 ) cOpc s" opc06"       mktbentry,
  358: ( 07 ) cOpc s" opc07"       mktbentry,
  359: ( 08 ) cMem s" lda"         mktbentry,
  360: ( 09 ) cMem s" ldah"        mktbentry,
  361: ( 0a ) cOpc s" opc0a"       mktbentry,
  362: ( 0b ) cMem s" ldq_u"       mktbentry,
  363: ( 0c ) cOpc s" opc0c"       mktbentry,
  364: ( 0d ) cOpc s" opc0d"       mktbentry,
  365: ( 0e ) cOpc s" opc0e"       mktbentry,
  366: ( 0f ) cMem s" stq_u"       mktbentry,
  367: ( 10 ) cOpr s" "            mktbentry,
  368: ( 11 ) cOpr s" "            mktbentry,
  369: ( 12 ) cOpr s" "            mktbentry,
  370: ( 13 ) cOpr s" "            mktbentry,
  371: ( 14 ) cOpc s" opc14"       mktbentry,
  372: ( 15 ) cF-P s" "            mktbentry,
  373: ( 16 ) cF-P s" "            mktbentry,
  374: ( 17 ) cF-P s" "            mktbentry,
  375: ( 18 ) cMfc s" "            mktbentry,
  376: ( 19 ) cOpc s" pal19"       mktbentry,
  377: ( 1a ) cMbr s" "            mktbentry,
  378: ( 1b ) cOpc s" pal1b"       mktbentry,
  379: ( 1c ) cOpc s" opc1c"       mktbentry,
  380: ( 1d ) cOpc s" pal1d"       mktbentry,
  381: ( 1e ) cOpc s" pal1e"       mktbentry,
  382: ( 1f ) cOpc s" pal1f"       mktbentry,
  383: ( 20 ) cMem s" ldf"         mktbentry,
  384: ( 21 ) cMem s" ldg"         mktbentry,
  385: ( 22 ) cMem s" lds"         mktbentry,
  386: ( 23 ) cMem s" ldt"         mktbentry,
  387: ( 24 ) cMem s" stf"         mktbentry,
  388: ( 25 ) cMem s" stg"         mktbentry,
  389: ( 26 ) cMem s" sts"         mktbentry,
  390: ( 27 ) cMem s" stt"         mktbentry,
  391: ( 28 ) cMem s" ldl"         mktbentry,
  392: ( 29 ) cMem s" ldq"         mktbentry,
  393: ( 2a ) cMem s" ldl_l"       mktbentry,
  394: ( 2b ) cMem s" ldq_l"       mktbentry,
  395: ( 2c ) cMem s" stl"         mktbentry,
  396: ( 2d ) cMem s" stq"         mktbentry,
  397: ( 2e ) cMem s" stl_c"       mktbentry,
  398: ( 2f ) cMem s" stq_c"       mktbentry,
  399: ( 30 ) cBra s" br"          mktbentry,
  400: ( 31 ) cBra s" fbeq"        mktbentry,
  401: ( 32 ) cBra s" fblt"        mktbentry,
  402: ( 33 ) cBra s" fble"        mktbentry,
  403: ( 34 ) cBra s" bsr"         mktbentry,
  404: ( 35 ) cBra s" fbne"        mktbentry,
  405: ( 36 ) cBra s" fbge"        mktbentry,
  406: ( 37 ) cBra s" fbgt"        mktbentry,
  407: ( 38 ) cBra s" blbc"        mktbentry,
  408: ( 39 ) cBra s" beq"         mktbentry,
  409: ( 3a ) cBra s" blt"         mktbentry,
  410: ( 3b ) cBra s" ble"         mktbentry,
  411: ( 3c ) cBra s" blbs"        mktbentry,
  412: ( 3d ) cBra s" bne"         mktbentry,
  413: ( 3e ) cBra s" bge"         mktbentry,
  414: ( 3f ) cBra s" bgt"         mktbentry,
  415: 
  416: drop \ string_table end
  417: 
  418: : decode_inst ( n -- )  \ instruction decoder
  419:   dup $fc000000 and
  420:   26 rshift cells
  421:   opcode_table +
  422:   @ dup $00000000ffffffff and
  423:   decode_code + execute
  424:   $2c emit cr
  425: ;
  426: 
  427: : disasm ( addr n -- )  \ disassembler
  428: cr 0
  429: ?do
  430:   dup h@
  431:   over $28 emit space . $29 emit space
  432:   decode_inst
  433:   4 +
  434: loop
  435: drop
  436: ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>