File:  [gforth] / gforth / arch / alpha / asm.fs
Revision 1.11: download - view: text, annotated - select for diffs
Mon Dec 31 19:02:24 2007 UTC (14 years, 6 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year after changing license notice

    1: \ assembler in forth for alpha
    2: 
    3: \ Copyright (C) 1999,2000,2007 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation, either version 3
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   19: 
   20: \ contributed by Bernd Thallner
   21: 
   22: require ./../../code.fs
   23: 
   24: get-current
   25: also assembler definitions
   26: 
   27: \ register
   28: 
   29:  $0 constant v0
   30:  $1 constant t0
   31:  $2 constant t1
   32:  $3 constant t2
   33:  $4 constant t3
   34:  $5 constant t4
   35:  $6 constant t5
   36:  $7 constant t6
   37:  $8 constant t7
   38:  $9 constant s0
   39:  $a constant s1
   40:  $b constant s2
   41:  $c constant s3
   42:  $d constant s4
   43:  $e constant s5
   44:  $f constant fp
   45: \ commented out to avoid shadowing hex numbers
   46: \  $10 constant a0
   47: \  $11 constant a1
   48: \  $12 constant a2
   49: \  $13 constant a3
   50: \  $14 constant a4
   51: \  $15 constant a5
   52: $16 constant t8
   53: $17 constant t9
   54: $18 constant t10
   55: $19 constant t11
   56: $1a constant ra
   57: $1b constant t12
   58: $1c constant at
   59: $1d constant gp
   60: $1e constant sp
   61: $1f constant zero
   62: 
   63: \ util
   64: 
   65: : h@ ( addr -- n )		\ 32 bit fetch
   66: dup dup aligned = if
   67:   @
   68:   $00000000ffffffff and
   69: else
   70:   4 - @
   71:   $20 rshift
   72: endif
   73: ;
   74: 
   75: : h! ( n addr -- )		\ 32 bit store
   76: dup dup aligned = if
   77:   dup @
   78:   $ffffffff00000000 and
   79:   rot or
   80:   swap !
   81: else
   82:   4 - dup @
   83:   $00000000ffffffff and
   84:   rot $20 lshift or
   85:   swap !
   86: endif
   87: ;
   88: 
   89: : h, ( h -- )			\ 32 bit store + allot
   90: here here aligned = if
   91:   here !
   92: else
   93:   32 lshift
   94:   here 4 - dup
   95:   @ rot or
   96:   swap !
   97: endif
   98: 4 allot
   99: ;
  100: 
  101: \ operands
  102: 
  103: : check-range ( u1 u2 u3 -- )
  104:     within 0= -24 and throw ;
  105: 
  106: : rega ( rega code -- code )
  107:     \ ra field, named rega to avoid conflict with register ra
  108:     swap dup 0 $20 check-range
  109:     21 lshift or ;
  110: 
  111: : rb ( rb code -- code )
  112:     swap dup 0 $20 check-range
  113:     16 lshift or ;
  114: 
  115: : rc ( rc code -- code )
  116:     swap dup 0 $20 check-range
  117:     or ;
  118: 
  119: : hint ( addr code -- code )
  120:     swap 2 rshift $3fff and or ;
  121: 
  122: : disp ( n code -- code )
  123:     swap dup -$8000 $8000 check-range
  124:     $ffff and or ;
  125: 
  126: : branch-rel ( n code -- code )
  127:     swap dup 3 and 0<> -24 and throw
  128:     2/ 2/
  129:     dup -$100000 $100000 check-range
  130:     $1fffff and or ;
  131: 
  132: : branch-disp ( addr code -- code )
  133:     swap here 4 + - swap branch-rel ;
  134: 
  135: : imm ( u code -- code )
  136:     swap dup 0 $100 check-range
  137:     13 lshift or ;
  138: 
  139: : palcode ( u code -- code )
  140:     swap dup 0 $4000000 check-range or ;
  141: 
  142: \ formats
  143: 
  144: : Bra ( opcode -- )			\ branch instruction format
  145:     create 26 lshift ,
  146: does> ( rega target-addr -- )
  147:     @ branch-disp rega h, ;
  148: 
  149: : Mbr ( opcode hint -- )		\ memory branch instruction format
  150:     create 14 lshift swap 26 lshift or ,
  151: does> ( rega rb hint -- )
  152:     @ hint rb rega h, ; 
  153: 
  154: : F-P ( opcode func -- )	\ floating-point operate instruction format
  155:     create 5 lshift swap 26 lshift or ,
  156: does> ( fa fb fc -- )
  157:     @ rc rb rega h, ;
  158: 
  159: : Mem ( opcode -- )		\ memory instruction format
  160:   create 26 lshift ,
  161: does> ( rega memory_disp rb -- )
  162:   @ rb disp rega h, ;
  163: 
  164: : Mfc ( opcode func -- )	\ memory instruction with function code format
  165:   create swap 26 lshift or ,
  166: does> ( rega rb -- )
  167:   @ rb rega h, ;
  168: 
  169: : Opr ( opcode.ff )		\ operate instruction format
  170:   create 5 lshift swap 26 lshift or ,
  171: does> ( rega rb rc -- )
  172:   @ rc rb rega h, ;
  173: 
  174: : Opr# ( opcode func -- )		\ operate instruction format
  175:   create 5 lshift swap 26 lshift or 1 12 lshift or ,
  176: does> ( rega imm rc -- )
  177:   @ rc imm rega h, ;
  178: 
  179: : Pcd ( opcode -- )		\ palcode instruction format
  180:   create 26 lshift ,
  181: does> ( palcode addr -- )
  182:   @ palcode h, ;
  183: 
  184: \ instructions
  185: 
  186: $15 $80   F-P  addf,
  187: $15 $a0   F-P  addg,
  188: $10 $00   Opr  addl,
  189: $10 $00   Opr# addl#,
  190: $10 $40   Opr  addlv,
  191: $10 $40   Opr# addlv#,
  192: $10 $20   Opr  addq,
  193: $10 $20   Opr# addq#,
  194: $10 $60   Opr  addqv,
  195: $10 $60   Opr# addqv#,
  196: $16 $80   F-P  adds,
  197: $16 $a0   F-P  addt,
  198: $11 $00   Opr  and,
  199: $11 $00   Opr# and#,
  200: $39       Bra  beq,
  201: $3e       Bra  bge,
  202: $3f       Bra  bgt,
  203: $11 $08   Opr  bic,
  204: $11 $08   Opr# bic#,
  205: $11 $20   Opr  bis,
  206: $11 $20   Opr# bis#,
  207: $38       Bra  blbc,
  208: $3c       Bra  blbs,
  209: $3b       Bra  ble,
  210: $3a       Bra  blt,
  211: $3d       Bra  bne, 
  212: $30       Bra  br,
  213: $34       Bra  bsr,
  214: $00       Pcd  call_pal,
  215: $11 $24   Opr  cmoveq,
  216: $11 $24   Opr# cmoveq#,
  217: $11 $46   Opr  cmovge,
  218: $11 $46   Opr# cmovge#,
  219: $11 $66   Opr  cmovgt,
  220: $11 $66   Opr# cmovgt#,
  221: $11 $16   Opr  cmovlbc,
  222: $11 $16   Opr# cmovlbc#,
  223: $11 $14   Opr  cmovlbs,
  224: $11 $14   Opr# cmovlbs#,
  225: $11 $64   Opr  cmovle,
  226: $11 $64   Opr# cmovle#,
  227: $11 $44   Opr  cmovlt,
  228: $11 $44   Opr# cmovlt#,
  229: $11 $26   Opr  cmovne,
  230: $11 $26   Opr# cmovne#,
  231: $10 $0f   Opr  cmpbge,
  232: $10 $0f   Opr# cmpbge#,
  233: $10 $2d   Opr  cmpeq,
  234: $10 $2d   Opr# cmpeq#,
  235: $15 $a5   F-P  cmpgeq,
  236: $15 $a7   F-P  cmpgle,
  237: $15 $a6   F-P  cmpglt,
  238: $10 $6d   Opr  cmple,
  239: $10 $6d   Opr# cmple#,
  240: $10 $4d   Opr  cmplt,
  241: $10 $4d   Opr# cmplt#,
  242: $16 $a5   F-P  cmpteq,
  243: $16 $a7   F-P  cmptle,
  244: $16 $a6   F-P  cmptlt,
  245: $16 $a4   F-P  cmptun,
  246: $10 $3d   Opr  cmpule,
  247: $10 $3d   Opr# cmpule#,
  248: $10 $1d   Opr  cmpult,
  249: $10 $1d   Opr# cmpult#,
  250: $17 $20   F-P  cpys,
  251: $17 $22   F-P  cpyse,
  252: $17 $21   F-P  cpysn,
  253: $15 $9e   F-P  cvtdg,
  254: $15 $ad   F-P  cvtgd,
  255: $15 $ac   F-P  cvtgf,
  256: $15 $af   F-P  cvtgq,
  257: $17 $10   F-P  cvtlq,
  258: $15 $bc   F-P  cvtqf,
  259: $15 $be   F-P  cvtqg,
  260: $17 $30   F-P  cvtql,
  261: $17 $530  F-P  cvtqlsv,
  262: $17 $130  F-P  cvtqlv,
  263: $16 $bc   F-P  cvtqs,
  264: $16 $be   F-P  cvtqt,
  265: $16 $2ac  F-P  cvtst,
  266: $16 $af   F-P  cvttq,
  267: $16 $ac   F-P  cvtts,
  268: $15 $83   F-P  divf,
  269: $15 $a3   F-P  divg,
  270: $16 $83   F-P  divs,
  271: $16 $a3   F-P  divt,
  272: $11 $48   Opr  eqv,
  273: $11 $48   Opr# eqv#,
  274: $18 $400  Mfc  excb,
  275: $12 $06   Opr  extbl,
  276: $12 $06   Opr# extbl#,
  277: $12 $6a   Opr  extlh,
  278: $12 $6a   Opr# extlh#,
  279: $12 $26   Opr  extll,
  280: $12 $26   Opr# extll#,
  281: $12 $7a   Opr  extqh,
  282: $12 $7a   Opr# extqh#,
  283: $12 $36   Opr  extql,
  284: $12 $36   Opr# extql#,
  285: $12 $5a   Opr  extwh,
  286: $12 $5a   Opr# extwh#,
  287: $12 $16   Opr  extwl,
  288: $12 $16   Opr# extwl#,
  289: $31       Bra  fbeq,
  290: $36       Bra  fbge,
  291: $37       Bra  fbgt,
  292: $33       Bra  fble,
  293: $32       Bra  fblt,
  294: $35       Bra  fbne,
  295: $17 $2a   F-P  fcmoveq,
  296: $17 $2d   F-P  fcmovge,
  297: $17 $2f   F-P  fcmovgt,
  298: $17 $2e   F-P  fcmovle,
  299: $17 $2c   F-P  fcmovlt,
  300: $17 $2b   F-P  fcmovne,
  301: $18 $8000 Mfc  fetch,
  302: $18 $a000 Mfc  fetch_m,
  303: $12 $0b   Opr  insbl,
  304: $12 $0b   Opr# insbl#,
  305: $12 $67   Opr  inslh,
  306: $12 $67   Opr# inslh#,
  307: $12 $2b   Opr  insll,
  308: $12 $2b   Opr# insll#,
  309: $12 $77   Opr  insqh,
  310: $12 $77   Opr# insqh#,
  311: $12 $3b   Opr  insql,
  312: $12 $3b   Opr# insql#,
  313: $12 $57   Opr  inswh,
  314: $12 $57   Opr# inswh#,
  315: $12 $1b   Opr  inswl,
  316: $12 $1b   Opr# inswl#,
  317: $1a $00   Mbr  jmp,
  318: $1a $01   Mbr  jsr,
  319: $1a $03   Mbr  jsr_coroutine,
  320: $08       Mem  lda,
  321: $09       Mem  ldah,
  322: $20       Mem  ldf,
  323: $21       Mem  ldg,
  324: $28       Mem  ldl,
  325: $2a       Mem  ldl_l,
  326: $29       Mem  ldq,
  327: $2b       Mem  ldq_l,
  328: $0b       Mem  ldq_u,
  329: $22       Mem  lds,
  330: $23       Mem  ldt,
  331: $18 $4000 Mfc  mb,
  332: $17 $25   F-P  mf_fpcr,
  333: $12 $02   Opr  mskbl,
  334: $12 $02   Opr# mskbl#,
  335: $12 $62   Opr  msklh,
  336: $12 $62   Opr# msklh#,
  337: $12 $22   Opr  mskll,
  338: $12 $22   Opr# mskll#,
  339: $12 $72   Opr  mskqh,
  340: $12 $72   Opr# mskqh#,
  341: $12 $32   Opr  mskql,
  342: $12 $32   Opr# mskql#,
  343: $12 $52   Opr  mskwh,
  344: $12 $52   Opr# mskwh#,
  345: $12 $12   Opr  mskwl,
  346: $12 $12   Opr# mskwl#,
  347: $17 $24   F-P  mt_fpcr,
  348: $15 $82   F-P  mulf,
  349: $15 $a2   F-P  mulg,
  350: $13 $00   Opr  mull,
  351: $13 $00   Opr# mull#,
  352: $13 $40   Opr  mullv,
  353: $13 $40   Opr# mullv#,
  354: $13 $20   Opr  mullq,
  355: $13 $20   Opr# mullq#,
  356: $13 $60   Opr  mullqv,
  357: $13 $60   Opr# mullqv#,
  358: $16 $82   F-P  mulls,
  359: $16 $a2   F-P  mullt,
  360: $11 $28   Opr  ornot,
  361: $11 $28   Opr# ornot#,
  362: $18 $e000 Mfc  rc,
  363: $1a $02   Mbr  ret,
  364: $18 $c000 Mfc  rpcc,
  365: $18 $f000 Mfc  rs,
  366: $10 $02   Opr  s4addl,
  367: $10 $02   Opr# s4addl#,
  368: $10 $22   Opr  s4addq,
  369: $10 $22   Opr# s4addq#,
  370: $10 $0b   Opr  s4subl,
  371: $10 $0b   Opr# s4subl#,
  372: $10 $2b   Opr  s4subq,
  373: $10 $2b   Opr# s4subq#,
  374: $10 $12   Opr  s8addl,
  375: $10 $12   Opr# s8addl#,
  376: $10 $32   Opr  s8addq,
  377: $10 $32   Opr# s8addq#,
  378: $10 $1b   Opr  s8ubl,
  379: $10 $1b   Opr# s8ubl#,
  380: $10 $3b   Opr  s8ubq,
  381: $10 $3b   Opr# s8ubq#,
  382: $12 $39   Opr  sll,
  383: $12 $39   Opr# sll#,
  384: $12 $3c   Opr  sra,
  385: $12 $3c   Opr# sra#,
  386: $12 $34   Opr  srl,
  387: $12 $34   Opr# srl#,
  388: $24       Mem  stf,
  389: $25       Mem  stg,
  390: $26       Mem  sts,
  391: $2c       Mem  stl,
  392: $2e       Mem  stl_c,
  393: $2d       Mem  stq,
  394: $2f       Mem  stq_c,
  395: $0f       Mem  stq_u,
  396: $27       Mem  stt,
  397: $15 $81   F-P  subf,
  398: $15 $a1   F-P  subg,
  399: $10 $09   Opr  subl,
  400: $10 $09   Opr# subl#,
  401: $10 $49   Opr  sublv,
  402: $10 $49   Opr# sublv#,
  403: $10 $29   Opr  subq,
  404: $10 $29   Opr# subq#,
  405: $10 $69   Opr  subqv,
  406: $10 $69   Opr# subqv#,
  407: $16 $81   F-P  subs,
  408: $16 $a1   F-P  subt,
  409: $18 $00   Mfc  trapb,
  410: $13 $30   Opr  umulh,
  411: $13 $30   Opr# umulh#,
  412: $18 $4400 Mfc  wmb,
  413: $11 $40   Opr  xor,
  414: $11 $40   Opr# xor#,
  415: $12 $30   Opr  zap,
  416: $12 $30   Opr# zap#,
  417: $12 $31   Opr  zapnot,
  418: $12 $31   Opr# zapnot#,
  419: 
  420: \ conditions; they are reversed because of the if and until logic (the
  421: \ stuff enclosed by if is performed if the branch around has the
  422: \ inverse condition).
  423: 
  424: ' beq,  constant ne
  425: ' bge, 	constant lt
  426: ' bgt, 	constant le
  427: ' blbc,	constant lbs
  428: ' blbs,	constant lbc
  429: ' ble, 	constant gt
  430: ' blt,  constant ge
  431: ' bne,  constant eq
  432: ' fbeq, constant fne
  433: ' fbge, constant flt
  434: ' fbgt, constant fle
  435: ' fble, constant fgt
  436: ' fblt, constant fge
  437: ' fbne, constant feq
  438: 
  439: \ control structures
  440: 
  441: : magic-asm ( u1 u2 -- u3 u4 )
  442:     \ turns a magic number into an asm-magic number or back
  443:     $fedcba0987654321 xor ;
  444: 
  445: : patch-branch ( behind-branch-addr target-addr -- )
  446:     \ there is a branch just before behind-branch-addr; PATCH-BRANCH
  447:     \ patches this branch to branch to target-addr
  448:     over - ( behind-branch-addr rel )
  449:     swap 4 - dup >r ( rel branch-addr R:branch-addr )
  450:     h@ branch-rel r> h! ; \ !! relies on the imm field being 0 before
  451: 
  452: : if, ( reg xt -- asm-orig )
  453:     \ xt is for a branch word ( reg addr -- )
  454:     here 4 + swap execute \ put 0 into the disp field
  455:     here live-orig magic-asm live-orig ;
  456: 
  457: : ahead, ( -- asm-orig )
  458:     zero ['] br, if, ;
  459: 
  460: : then, ( asm-orig -- )
  461:     orig? magic-asm orig?
  462:     here patch-branch ;
  463: 
  464: : begin, ( -- asm-dest )
  465:     here dest magic-asm dest ;
  466: 
  467: : until, ( asm-dest reg xt -- )
  468:     \ xt is a condition ( reg addr -- )
  469:     here 4 + swap execute
  470:     dest? magic-asm dest?
  471:     here swap patch-branch ;
  472: 
  473: : again, ( asm-dest -- )
  474:     zero ['] br, until, ;
  475: 
  476: : while, ( asm-dest -- asm-orig asm-dest )
  477:     if, 1 cs-roll ;
  478: 
  479: : else, ( asm-orig1 -- asm-orig2 )
  480:     ahead, 1 cs-roll then, ;
  481: 
  482: : repeat, ( asm-orig asm-dest -- )
  483:     again, then, ;
  484: 
  485: : endif, ( asm-orig -- )
  486:     then, ;
  487: 
  488: \  \ jump marks
  489: 
  490: \  \ example:
  491: 
  492: \  \ init_marktbl		\ initializes mark table
  493: \  \ 31 0 br,
  494: \  \ 0 store_branch	\ store jump address for mark 0
  495: \  \ 1 2 3 addf,
  496: \  \ 0 set_mark		\ store mark 0
  497: \  \ 2 3 4 addf,
  498: \  \ 2 0 beq,
  499: \  \ 0 store_branch	\ store jump address for mark 0
  500: \  \ calculate_marks       \ calculate all jumps
  501: 
  502: \  \ with <mark_address> <jump_address> calculate_branch you can calculate the
  503: \  \ displacement field without the mark_table for one branch
  504: 
  505: \  \ example:
  506: \  \ here 31 0 br,
  507: \  \ here 1 2 3 addf,
  508: \  \ calculate_branch
  509: 
  510: \  5 constant mark_numbers
  511: \  5 constant mark_uses
  512: 
  513: \  create mark_table
  514: \  mark_numbers mark_uses 1+ * cells allot
  515: 
  516: \  : init_marktbl ( -- )			\ initializes mark table
  517: \    mark_table mark_numbers mark_uses 1+ * cells +
  518: \    mark_table
  519: \    begin
  520: \      over over >
  521: \    while
  522: \      dup 0 swap !
  523: \      1 cells +
  524: \    repeat
  525: \    drop drop
  526: \  ;
  527: 
  528: \  : set_mark ( mark_number -- )		\ sets mark, store address in mark table
  529: \    dup mark_numbers >= abort" error, illegal mark number"
  530: \    mark_uses 1+ * cells
  531: \    mark_table + here 8 - swap !
  532: \  ;
  533: 
  534: \  : store_branch ( mark_number -- )	\ stores address of branch in mark table
  535: \    dup mark_numbers >= abort" error, illegal mark number"
  536: \    mark_uses 1+ * cells
  537: \    mark_table + 1 cells +
  538: \    dup mark_uses cells + swap
  539: \    begin
  540: \      over over > over @ and 
  541: \    while
  542: \      1 cells +
  543: \    repeat
  544: \    swap over = abort" error, not enough space in mark_table, increase mark_uses"
  545: \    here 4 - swap !
  546: \  ;
  547: 
  548: \  : calculate_branch ( mark_addr branch_addr -- ) \ calculate branch displacement field for one branch
  549: \    swap over - 4 + 4 /
  550: \    $1fffff and
  551: \    over h@ or swap h!
  552: \  ;
  553: 
  554: \  : calculate_mark ( tb mark_address -- tb )	\ calculates branch displacement field for one mark
  555: \    over 1 cells +
  556: \    dup mark_uses cells + swap
  557: \    begin
  558: \      over over >
  559: \    while
  560: \      2over swap drop ( ei i markaddr ej j markaddr )
  561: \      over @
  562: \      dup if
  563: \        calculate_branch
  564: \      else
  565: \        drop drop
  566: \      endif
  567: \      1 cells +
  568: \    repeat drop drop drop
  569: \  ;
  570: 
  571: \  : calculate_marks ( -- )		\ calculates branch displacement field for all marks
  572: \    mark_table mark_numbers 1- mark_uses 1+ * cells +
  573: \    mark_table
  574: \    begin
  575: \      over over >=
  576: \    while
  577: \      dup @
  578: \        dup if \ used mark
  579: \          calculate_mark
  580: \        else
  581: \          drop
  582: \        endif
  583: \      mark_uses 1+ cells +
  584: \    repeat
  585: \    drop drop
  586: \  ;
  587: 
  588: previous set-current
  589: 
  590: 
  591: 

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