File:  [gforth] / gforth / arch / alpha / disasm.fs
Revision 1.3: download - view: text, annotated - select for diffs
Sat Jun 17 12:01:55 2000 UTC (22 years, 3 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Assembler and disassembler are included in gforth.fi if available
Alpha assembler and disassembler tweaks

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

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