File:  [gforth] / gforth / arch / alpha / asm.fs
Revision 1.9: download - view: text, annotated - select for diffs
Sat Sep 23 15:47:01 2000 UTC (21 years, 2 months ago) by anton
Branches: MAIN
CVS tags: v0-6-2, v0-6-1, v0-6-0, v0-5-0, HEAD
changed FSF address in copyright messages

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

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