Annotation of gforth/arch/mips/asm.fs, revision 1.11

1.1       anton       1: \ asm.fs       assembler file (for MIPS R3000)
                      2: \
                      3: \ Copyright (C) 1995-97 Martin Anton Ertl, Christian Pirker
                      4: \
                      5: \ This file is part of RAFTS.
                      6: \
                      7: \      RAFTS 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., 675 Mass Ave, Cambridge, MA 02139, USA.
                     20: 
1.8       anton      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: 
1.4       anton      24: require code.fs
                     25: 
1.7       anton      26: get-current
1.4       anton      27: also assembler definitions
                     28: 
1.1       anton      29: $20 constant asm-registers
                     30: 
1.3       anton      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
1.1       anton      64: 
                     65: $00 constant asm-init-code
                     66: 
1.3       anton      67: $1F constant asm-bm05
                     68: $3F constant asm-bm06
                     69: $FFFF constant asm-bm10
                     70: $3FFFFFF constant asm-bm1A
1.1       anton      71: 
                     72: : asm-op ( n -- code )
                     73:     asm-bm06 and $1a lshift ;
                     74: 
1.8       anton      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 ;
1.1       anton      81: 
                     82: : asm-rt ( n code -- code )
1.8       anton      83:     over 0 $20 check-range
                     84:     swap $10 lshift or ;
1.1       anton      85: 
                     86: : asm-imm ( n code -- code )
1.8       anton      87:     over -$8000 $8000 check-range
                     88:     swap $ffff and or ;
1.1       anton      89: ' asm-imm alias asm-offset
                     90: 
1.8       anton      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: 
1.1       anton      99: : asm-target ( n code -- code )
1.8       anton     100:     over here cell+ xor $f0000003 and 0<> -24 and throw
1.1       anton     101:     swap 2 rshift asm-bm1A and or ;
                    102: 
                    103: : asm-rd ( n code -- code )
1.8       anton     104:     over 0 $20 check-range
                    105:     swap $b lshift or ;
1.1       anton     106: 
                    107: : asm-shamt ( n code -- code )
1.8       anton     108:     over 0 $20 check-range
                    109:     swap $6 lshift or ;
1.1       anton     110: ' asm-shamt alias asm-sa
                    111: 
                    112: : asm-funct ( n code -- code )
                    113:     swap asm-bm06 and or ;
                    114: 
1.3       anton     115: : asm-special ( code1 -- code2 )
                    116:     asm-init-code asm-funct ;
                    117: 
1.1       anton     118: \ ***** I-types
1.3       anton     119: : asm-I-rt,imm ( code -- )
                    120:     create ,
                    121: does> ( rt imm -- )
                    122:     @ asm-imm asm-rt , ;
                    123: 
1.7       anton     124: : asm-I-rt,uimm ( code -- )
                    125:     create ,
                    126: does> ( rt uimm -- )
                    127:     @ asm-uimm asm-rt , ;
                    128: 
1.3       anton     129: : asm-I-rs,imm ( code -- )
                    130:     create ,
                    131: does> ( rs imm -- )
1.8       anton     132:     @ asm-rel asm-rs , ;
1.3       anton     133: 
                    134: : asm-I-rt,rs,imm ( code -- )
                    135:     create ,
                    136: does> ( rt rs imm -- )
                    137:     @ asm-imm asm-rs asm-rt , ;
                    138: 
1.7       anton     139: : asm-I-rt,rs,uimm ( code -- )
                    140:     create ,
                    141: does> ( rt rs uimm -- )
                    142:     @ asm-uimm asm-rs asm-rt , ;
                    143: 
1.3       anton     144: : asm-I-rs,rt,imm ( code -- )
                    145:     create ,
                    146: does> ( rs rt imm -- )
1.8       anton     147:     @ asm-rel asm-rt asm-rs , ;
1.3       anton     148: 
                    149: : asm-I-rt,offset,rs ( code -- )
                    150:     create ,
                    151: does> ( rt offset rs -- )
                    152:     @ asm-rs asm-offset asm-rt , ;
1.1       anton     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: 
1.3       anton     160: : asm-I-imm,z ( code -- )
                    161:     create ,
                    162: does> ( imm z -- )
1.8       anton     163:     @ swap asm-op or asm-rel , ;
1.1       anton     164: 
                    165: : asm-copz-imm ( code -- )
                    166:     $10 asm-op or asm-I-imm,z ;
                    167: 
1.3       anton     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 , ;
1.1       anton     172: 
                    173: : asm-copz-rt,offset,rs ( code -- )
                    174:     asm-op asm-I-rt,offset,rs,z ;
                    175: 
1.3       anton     176: : asm-J-target ( code -- )
                    177:     create ,
                    178: does> ( target -- )
                    179:     @ asm-target , ;
1.1       anton     180: 
                    181: \ ***** special types
1.3       anton     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 , ;
1.1       anton     221: 
                    222: \ ***** copz types 2
                    223: : asm-copz0 ( funct -- )
1.3       anton     224:     $10 $10 asm-op asm-rs asm-funct create ,
                    225: does> ( addr -- )
                    226:     @ , ;
1.1       anton     227: 
                    228: : asm-copz-rt,rd ( funct -- )
1.3       anton     229:     $10 asm-op or create ,
                    230: does> ( rt rd z addr -- )
                    231:     @ swap asm-op or asm-rd asm-rt , ;
1.1       anton     232: 
                    233: : nop, ( -- )
1.3       anton     234:     0 , ;
1.1       anton     235: 
1.5       anton     236: include ./insts.fs
1.1       anton     237: 
                    238: : move, ( rd rs -- )
1.3       anton     239:     $zero addu, ;
1.1       anton     240: 
1.9       anton     241: \ commented out to reduce delay slot exceptions
                    242: \  : abs, ( rd rs -- )
                    243: \      dup $0008 bgez,
                    244: \      2dup move,
                    245: \      $zero swap subu, ;
1.1       anton     246: 
                    247: : neg, ( rd rs -- )
1.3       anton     248:     $zero swap subu, ;
1.1       anton     249: 
                    250: : negu, ( rd rs -- )
1.3       anton     251:     $zero swap subu, ;
1.1       anton     252: 
                    253: : not, ( rd rs -- )
1.3       anton     254:     $zero nor, ;
1.1       anton     255: 
                    256: : li, ( rd imm -- )
                    257:     dup 0= if
1.3       anton     258:        drop dup $zero = if
1.1       anton     259:            drop nop, assert( false )
                    260:        else
1.3       anton     261:            $zero move,
1.1       anton     262:        endif
                    263:     else
                    264:        dup $8000 u< if
1.3       anton     265:            $zero swap addiu,
1.1       anton     266:        else
                    267:            dup $10000 u< if
1.3       anton     268:                $zero swap ori,
1.1       anton     269:            else
                    270:                dup $ffff and 0= if
                    271:                    $10 rshift lui,
                    272:                else
                    273:                    dup $ffff8000 and $ffff8000 = if
1.3       anton     274:                        $zero swap addiu,
1.1       anton     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 -- )                \ <
1.3       anton     285:     >r $at rot rot slt,
                    286:     $at $zero r> bne, ;
1.1       anton     287: 
                    288: : ble, ( rs rt imm -- )                \ <=
1.3       anton     289:     >r $at rot rot swap slt,
                    290:     $at $zero r> beq, ;
1.1       anton     291: 
                    292: : bgt, ( rs rt imm -- )                \ >
1.3       anton     293:     >r $at rot rot swap slt,
                    294:     $at $zero r> bne, ;
1.1       anton     295: 
                    296: : bge, ( rs rt imm -- )                \ >=
1.3       anton     297:     >r $at rot rot slt,
                    298:     $at $zero r> beq, ;
1.1       anton     299: 
                    300: : bltu, ( rs rt imm -- )       \ < unsigned
1.3       anton     301:     >r $at rot rot sltu,
                    302:     $at $zero r> bne, ;
1.1       anton     303: 
                    304: : bleu, ( rs rt imm -- )       \ <= unsigned
1.3       anton     305:     >r $at rot rot swap sltu,
                    306:     $at $zero r> beq, ;
1.1       anton     307: 
                    308: : bgtu, ( rs rt imm -- )       \ > unsigned
1.3       anton     309:     >r $at rot rot swap sltu,
                    310:     $at $zero r> bne, ;
1.1       anton     311: 
                    312: : bgeu, ( rs rt imm -- )       \ >= unsigned
1.3       anton     313:     >r $at rot rot sltu,
                    314:     $at $zero r> beq, ;
1.9       anton     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
1.10      anton     320: \ inverse condition, cf. 0branch).
1.9       anton     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
1.10      anton     328: \ bczf, bczt, \ these don't teke the relative address as last argument
1.9       anton     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: 
1.10      anton     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.
1.9       anton     343: 
1.10      anton     344: : magic-asm ( u1 u2 -- u3 u4 )
1.9       anton     345:     \ turns a magic number into an asm-magic number or back
                    346:     $87654321 xor ;
                    347: 
1.10      anton     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: 
1.9       anton     355: : if, ( ... xt -- asm-orig )
                    356:     \ xt is for a branch word ( ... addr -- )
                    357:     0 swap execute
1.10      anton     358:     here live-orig magic-asm live-orig ;
1.9       anton     359: 
                    360: : ahead, ( -- asm-orig )
                    361:     $zero $zero ne if, ;
                    362: 
                    363: : then, ( asm-orig -- )
1.10      anton     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: 
1.11    ! anton     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: 
1.10      anton     389: : repeat, ( asm-orig asm-dest -- )
1.11    ! anton     390:     again, delayed-then, ;
1.1       anton     391: 
1.4       anton     392: previous
1.10      anton     393: set-current

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