File:  [gforth] / gforth / arch / mips / asm.fs
Revision 1.18: download - view: text, annotated - select for diffs
Sat Sep 23 15:47:02 2000 UTC (19 years, 10 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: \ asm.fs	assembler file (for MIPS R3000)
    2: \
    3: \ Copyright (C) 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: \ test this with
   22: \ gforth arch/mips/asm.fs -e "also assembler here" arch/mips/testasm.fs -e "here over - here" arch/mips/testdisasm.fs -e "here over - compare throw bye"
   23: 
   24: require ./../../code.fs
   25: 
   26: get-current
   27: also assembler definitions
   28: 
   29: $20 constant asm-registers
   30: 
   31: \ register names
   32: 0 constant $zero
   33: 1 constant $at
   34: 2 constant $v0
   35: 3 constant $v1
   36: \ 4 constant $a0 \ commented out to avoid shadowing hex numbers
   37: \ 5 constant $a1
   38: \ 6 constant $a2
   39: \ 7 constant $a3
   40: 8 constant $t0
   41: 9 constant $t1
   42: 10 constant $t2
   43: 11 constant $t3
   44: 12 constant $t4
   45: 13 constant $t5
   46: 14 constant $t6
   47: 15 constant $t7
   48: 16 constant $s0
   49: 17 constant $s1
   50: 18 constant $s2
   51: 19 constant $s3
   52: 20 constant $s4
   53: 21 constant $s5
   54: 22 constant $s6
   55: 23 constant $s7
   56: 24 constant $t8
   57: 25 constant $t9
   58: 26 constant $k0
   59: 27 constant $k1
   60: 28 constant $gp
   61: 29 constant $sp
   62: 30 constant $s8
   63: 31 constant $ra
   64: 
   65: $00 constant asm-init-code
   66: 
   67: $1F constant asm-bm05
   68: $3F constant asm-bm06
   69: $FFFF constant asm-bm10
   70: $3FFFFFF constant asm-bm1A
   71: 
   72: : asm-op ( n -- code )
   73:     asm-bm06 and $1a lshift ;
   74: 
   75: : check-range ( u1 u2 u3 -- )
   76:     within 0= -24 and throw ;
   77: 
   78: : asm-rs ( u code -- code )
   79:     over 0 $20 check-range
   80:     swap $15 lshift or ;
   81: 
   82: : asm-rt ( n code -- code )
   83:     over 0 $20 check-range
   84:     swap $10 lshift or ;
   85: 
   86: : asm-imm ( n code -- code )
   87:     over -$8000 $8000 check-range
   88:     swap $ffff and or ;
   89: ' asm-imm alias asm-offset
   90: 
   91: : asm-uimm ( u code -- code )
   92:     over 0 $10000 check-range
   93:     or ;
   94: 
   95: : asm-rel ( n code -- code )
   96:     over 3 and 0<> -24 and throw \ check lower 2 bits
   97:     swap 2/ 2/ swap asm-imm ;
   98: 
   99: : asm-target ( n code -- code )
  100:     over here cell+ xor $f0000003 and 0<> -24 and throw
  101:     swap 2 rshift asm-bm1A and or ;
  102: 
  103: : asm-rd ( n code -- code )
  104:     over 0 $20 check-range
  105:     swap $b lshift or ;
  106: 
  107: : asm-shamt ( n code -- code )
  108:     over 0 $20 check-range
  109:     swap $6 lshift or ;
  110: ' asm-shamt alias asm-sa
  111: 
  112: : asm-funct ( n code -- code )
  113:     swap asm-bm06 and or ;
  114: 
  115: : asm-special ( code1 -- code2 )
  116:     asm-init-code asm-funct ;
  117: 
  118: \ ***** I-types
  119: : asm-I-rt,imm ( code -- )
  120:     create ,
  121: does> ( rt imm -- )
  122:     @ asm-imm asm-rt , ;
  123: 
  124: : asm-I-rt,uimm ( code -- )
  125:     create ,
  126: does> ( rt uimm -- )
  127:     @ asm-uimm asm-rt , ;
  128: 
  129: : asm-I-rs,imm ( code -- )
  130:     create ,
  131: does> ( rs imm -- )
  132:     @ asm-rel asm-rs , ;
  133: 
  134: : asm-I-rt,rs,imm ( code -- )
  135:     create ,
  136: does> ( rt rs imm -- )
  137:     @ asm-imm asm-rs asm-rt , ;
  138: 
  139: : asm-I-rt,rs,uimm ( code -- )
  140:     create ,
  141: does> ( rt rs uimm -- )
  142:     @ asm-uimm asm-rs asm-rt , ;
  143: 
  144: : asm-I-rs,rt,imm ( code -- )
  145:     create ,
  146: does> ( rs rt imm -- )
  147:     @ asm-rel asm-rt asm-rs , ;
  148: 
  149: : asm-I-rt,offset,rs ( code -- )
  150:     create ,
  151: does> ( rt offset rs -- )
  152:     @ asm-rs asm-offset asm-rt , ;
  153: 
  154: \ ***** regimm types
  155: : asm-regimm-rs,imm ( funct -- )
  156:     $01 asm-op asm-rt asm-I-rs,imm ;
  157: 
  158: \ ***** copz types 1
  159: 
  160: : asm-I-imm,z ( code -- )
  161:     create ,
  162: does> ( imm z -- )
  163:     @ swap asm-op or asm-rel , ;
  164: 
  165: : asm-copz-imm ( code -- )
  166:     $10 asm-op or asm-I-imm,z ;
  167: 
  168: : asm-I-rt,offset,rs,z ( code -- )
  169:     create ,
  170: does> ( rt offset rs z -- )
  171:     @ swap asm-op or asm-rs asm-offset asm-rt , ;
  172: 
  173: : asm-copz-rt,offset,rs ( code -- )
  174:     asm-op asm-I-rt,offset,rs,z ;
  175: 
  176: : asm-J-target ( code -- )
  177:     create ,
  178: does> ( target -- )
  179:     @ asm-target , ;
  180: 
  181: \ ***** special types
  182: : asm-special-nothing ( code -- )
  183:     asm-special create ,
  184: does> ( addr -- )
  185:     @ , ;
  186: 
  187: : asm-special-rd ( code -- )
  188:     asm-special create ,
  189: does> ( rd addr -- )
  190:     @ asm-rd , ;
  191: 
  192: : asm-special-rs ( code -- )
  193:     asm-special create ,
  194: does> ( rs addr -- )
  195:     @ asm-rs , ;
  196: 
  197: : asm-special-rd,rs ( code -- )
  198:     asm-special create ,
  199: does> ( rd rs addr -- )
  200:     @ asm-rs asm-rd , ;
  201: 
  202: : asm-special-rs,rt ( code -- )
  203:     asm-special create ,
  204: does> ( rs rt addr -- )
  205:     @ asm-rt asm-rs , ;
  206: 
  207: : asm-special-rd,rs,rt ( code -- )
  208:     asm-special create ,
  209: does> ( rd rs rt addr -- )
  210:     @ asm-rt asm-rs asm-rd , ;
  211: 
  212: : asm-special-rd,rt,rs ( code -- )
  213:     asm-special create ,
  214: does> ( rd rt rs addr -- )
  215:     @ asm-rs asm-rt asm-rd , ;
  216: 
  217: : asm-special-rd,rt,sa ( code -- )
  218:     asm-special create ,
  219: does> ( rd rt sa addr -- )
  220:     @ asm-sa asm-rt asm-rd , ;
  221: 
  222: \ ***** copz types 2
  223: : asm-copz0 ( funct -- )
  224:     $10 $10 asm-op asm-rs asm-funct create ,
  225: does> ( addr -- )
  226:     @ , ;
  227: 
  228: : asm-copz-rt,rd ( funct -- )
  229:     $10 asm-op or create ,
  230: does> ( rt rd z addr -- )
  231:     @ swap asm-op or asm-rd asm-rt , ;
  232: 
  233: : nop, ( -- )
  234:     0 , ;
  235: 
  236: include ./insts.fs
  237: 
  238: : move, ( rd rs -- )
  239:     $zero addu, ;
  240: 
  241: \ commented out to reduce delay slot exceptions
  242: \  : abs, ( rd rs -- )
  243: \      dup $0008 bgez,
  244: \      2dup move,
  245: \      $zero swap subu, ;
  246: 
  247: : neg, ( rd rs -- )
  248:     $zero swap subu, ;
  249: 
  250: : negu, ( rd rs -- )
  251:     $zero swap subu, ;
  252: 
  253: : not, ( rd rs -- )
  254:     $zero nor, ;
  255: 
  256: : li, ( rd imm -- )
  257:     dup 0= if
  258: 	drop dup $zero = if
  259: 	    drop nop, assert( false )
  260: 	else
  261: 	    $zero move,
  262: 	endif
  263:     else
  264: 	dup $8000 u< if
  265: 	    $zero swap addiu,
  266: 	else
  267: 	    dup $10000 u< if
  268: 		$zero swap ori,
  269: 	    else
  270: 		dup $ffff and 0= if
  271: 		    $10 rshift lui,
  272: 		else
  273: 		    dup $ffff8000 and $ffff8000 = if
  274: 			$zero swap addiu,
  275: 		    else
  276: 			2dup $10 rshift lui,
  277: 			over swap ori,
  278: 		    endif
  279: 		endif
  280: 	    endif
  281: 	endif
  282:     endif ;
  283: 
  284: : blt, ( rs rt imm -- )		\ <
  285:     >r $at rot rot slt,
  286:     $at $zero r> bne, ;
  287: 
  288: : ble, ( rs rt imm -- )		\ <=
  289:     >r $at rot rot swap slt,
  290:     $at $zero r> beq, ;
  291: 
  292: : bgt, ( rs rt imm -- )		\ >
  293:     >r $at rot rot swap slt,
  294:     $at $zero r> bne, ;
  295: 
  296: : bge, ( rs rt imm -- )		\ >=
  297:     >r $at rot rot slt,
  298:     $at $zero r> beq, ;
  299: 
  300: : bltu, ( rs rt imm -- )	\ < unsigned
  301:     >r $at rot rot sltu,
  302:     $at $zero r> bne, ;
  303: 
  304: : bleu, ( rs rt imm -- )	\ <= unsigned
  305:     >r $at rot rot swap sltu,
  306:     $at $zero r> beq, ;
  307: 
  308: : bgtu, ( rs rt imm -- )	\ > unsigned
  309:     >r $at rot rot swap sltu,
  310:     $at $zero r> bne, ;
  311: 
  312: : bgeu, ( rs rt imm -- )	\ >= unsigned
  313:     >r $at rot rot sltu,
  314:     $at $zero r> beq, ;
  315: 
  316: \ control structures
  317: 
  318: \ conditions; they are reversed because of the if and until logic (the
  319: \ stuff enclosed by if is performed if the branch around has the
  320: \ inverse condition, cf. 0branch).
  321: 
  322: ' beq,  constant ne
  323: ' bne,  constant eq
  324: ' blez, constant gtz
  325: ' bgtz, constant lez
  326: ' bltz, constant gez
  327: ' bgez, constant ltz
  328: \ bczf, bczt, \ these don't take the relative address as last argument
  329: ' blt,  constant ge
  330: ' ble,  constant gt
  331: ' bgt,  constant le
  332: ' bge,  constant lt
  333: ' bltu, constant geu
  334: ' bleu, constant gtu
  335: ' bgtu, constant leu
  336: ' bgeu, constant ltu
  337: 
  338: \ an asm-cs-item consists of ( addr magic1 magic2 ).  addr is the
  339: \ address behind the branch or the destination. magic2 is LIVE-ORIG or
  340: \ DEST xored with asm-magic to make it harder to confuse with a
  341: \ register number or immediate value. magic1 is LIVE-orig or DEST.
  342: \ It's there to make CS-ROLL etc. work.
  343: 
  344: : magic-asm ( u1 u2 -- u3 u4 )
  345:     \ turns a magic number into an asm-magic number or back
  346:     $87654321 xor ;
  347: 
  348: : patch-branch ( branch-delay-addr target-addr -- )
  349:     \ there is a branch just before branch-delay-addr; PATCH-BRANCH
  350:     \ patches this branch to branch to target-addr
  351:     over - ( branch-delay-addr rel )
  352:     swap cell - dup >r ( rel branch-addr R:branch-addr )
  353:     @ asm-rel r> ! ; \ !! relies on the imm field being 0 before
  354: 
  355: : if, ( ... xt -- asm-orig )
  356:     \ xt is for a branch word ( ... addr -- )
  357:     0 swap execute
  358:     here live-orig magic-asm live-orig ;
  359: 
  360: : ahead, ( -- asm-orig )
  361:     $zero $zero ne if, ;
  362: 
  363: : then, ( asm-orig -- )
  364:     orig? magic-asm orig?
  365:     here patch-branch ;
  366: 
  367: : begin, ( -- asm-dest )
  368:     here dest magic-asm dest ;
  369: 
  370: : until, ( asm-dest ... xt -- )
  371:     \ xt is a condition and ... are its arguments
  372:     0 swap execute
  373:     dest? magic-asm dest?
  374:     here swap patch-branch ;
  375: 
  376: : again, ( asm-dest -- )
  377:     $zero $zero ne until, ;
  378: 
  379: : while, ( asm-dest -- asm-orig asm-dest )
  380:     if, 1 cs-roll ;
  381: 
  382: : delayed-then, ( asm-orig -- )
  383:     \ set the target of asm-orig to one instruction after the current one
  384:     0 , then, -1 cells allot ;
  385: 
  386: : else, ( asm-orig1 -- asm-orig2 )
  387:     ahead, 1 cs-roll delayed-then, ;
  388: 
  389: : repeat, ( asm-orig asm-dest -- )
  390:     again, delayed-then, ;
  391: 
  392: : endif, ( asm-orig -- )
  393:     then, ;
  394: 
  395: previous
  396: set-current

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