Annotation of gforth/asm/generic.fs, revision 1.11

1.1       pazsan      1: \ generic.fs implements generic assembler definitions          13aug97jaw
                      2: 
1.11    ! anton       3: \ Copyright (C) 1998,2000,2003,2007,2010 Free Software Foundation, Inc.
1.2       anton       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
1.6       anton       9: \ as published by the Free Software Foundation, either version 3
1.2       anton      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
1.6       anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1       pazsan     19: 
                     20: \ These are generic routines to build up a table-driven assembler
                     21: \ fo any modern (RISC)-CPU
                     22: 
                     23: \ Revision Log:
                     24: \
                     25: \ 13aug97jaw-14aug97   Initial Version -> V0.5
                     26: \                      ToDo: operand count checking
1.8       dvdkhlng   27: \
                     28: \ 24apr10dk             Added documentation
1.1       pazsan     29: 
                     30: \ general definitions
                     31: 
1.8       dvdkhlng   32: : clearstack ( k*x -- ) depth 0 ?DO drop LOOP ;
1.1       pazsan     33: 
                     34: \ redefinitions to avoid conflicts
                     35: 
                     36: ' ,    ALIAS dic,
                     37: ' NOOP ALIAS X
                     38: 
                     39: \ ------------ Modes
                     40: 
                     41: [IFUNDEF] modes#
                     42: 4 Constant modes#
                     43: [THEN]
                     44: 
                     45: Create modes modes# cells allot        \ Modes for differend operands are stored here
                     46:                                \ Example:
                     47:                                \ Offset 0: general modifier ( .B, .W, .L)
                     48:                                \ Offset 1: addressing mode operand 1
                     49:                                \ Offset 2: addressing mode operand 2
                     50: 
                     51: : Mode-Compare ( adr1 adr2 -- flag )
                     52:   modes# 
                     53:   BEGIN dup WHILE >r 2dup @ swap @ <> IF rdrop 2drop false EXIT THEN 
                     54:                cell+ swap cell+ r> 1- 
                     55:   REPEAT drop 2drop true ;
                     56: 
                     57: Variable Start-Depth
                     58: Variable Mode#
                     59: 
1.8       dvdkhlng   60: : reset  ( -- )
                     61:   \G End an opcode / star a new opcode.  
1.1       pazsan     62:   modes modes# cells erase
                     63:   1 Mode# !
                     64:   depth Start-Depth ! ;
                     65: 
1.8       dvdkhlng   66: : Mode! ( x -- )
                     67:   \G Set current operand's mode to X
1.1       pazsan     68:   Modes Mode# @ cells + ! ;
                     69: 
1.8       dvdkhlng   70: : +Mode! ( x -- )
                     71:   \G Logically OR X to current operand's mode 
1.1       pazsan     72:   Modes Mode# @ cells + tuck @ or swap ! ;
                     73: 
1.8       dvdkhlng   74: : 0Mode! ( x -- )
                     75:   \G Set mode of operand #0.  Use operand #0 for an (optional) operands that
                     76:   \G can be placed anywhere, e.g. condition codes or operand lengths .B .W .L
                     77:   \G etc.
1.1       pazsan     78:   Modes ! ;
                     79: 
1.8       dvdkhlng   80: : ,  ( -- )
                     81:   \G Advance to next operand
1.1       pazsan     82:   1 Mode# +! ;
                     83: 
1.8       dvdkhlng   84: : Mode  ( x "name" -- )
                     85:   \G Define a new mode that logically ors X to current mode when executed
1.1       pazsan     86:   Create dic, DOES> @ +Mode! ;
                     87: 
1.8       dvdkhlng   88: : 0Mode  ( x "name" -- )
                     89:   \G Define a new mode that sets operand #0 when executed
1.1       pazsan     90:   Create dic, DOES> @ 0Mode! ;
                     91: 
1.8       dvdkhlng   92: : Reg  ( xt x "name" -- )
                     93:   \G Define a parametrized mode, that executes mode XT, then puts X onto the
                     94:   \G stack
1.1       pazsan     95:   Create dic, dic, DOES> dup perform cell+ @ ;
                     96: 
                     97: \ --------- Instruction Latch
                     98: 
                     99: Create I-Latch 10 chars allot
                    100: Variable I-Len
                    101: 
                    102: : opc! ( adr len -- )
1.8       dvdkhlng  103:   \G Logically OR string of bytes into instruction latch
1.1       pazsan    104:   dup I-Len @ max I-Len !
1.9       dvdkhlng  105:   I-Latch -rot bounds ?DO I c@ over c@ or over c! char+ LOOP drop ;
1.1       pazsan    106: 
1.8       dvdkhlng  107: : I-Init  ( -- )  0 I-Len ! I-Latch 10 erase ;
                    108: : I-Flush  ( -- )
                    109:   \G Append contents of instruction latch to dictionary
                    110:   I-Latch I-len @ bounds DO i c@ X c, LOOP reset ;
1.1       pazsan    111: 
                    112: : (g!) ( val addr n -1/1 -- )
                    113:   dup 0< IF rot 2 pick + 1- -rot THEN
                    114:   swap >r -rot r> 0 
                    115:   DO 2dup c! 2 pick + swap 8 rshift swap LOOP 
                    116:   2drop drop ;
                    117: 
                    118: : (g@) ( addr n -1/1 -- val )
                    119:   negate dup 0< IF rot 2 pick + 1- -rot THEN
                    120:   swap >r swap 0 swap r> 0 
                    121:   DO swap 8 lshift over c@ or swap 2 pick + LOOP
                    122:   drop nip ;
                    123: 
                    124: Variable ByteDirection \ -1 = big endian; 1 = little endian
                    125: 
1.8       dvdkhlng  126: : g@  ( addr n -- val )
                    127:   \G read n-byte integer from addr using current endianess
                    128:   ByteDirection @ (g@) ;
                    129: : g!  ( val addr n -- )
                    130:   \G  write n-byte integer to addr using current endianess
                    131:   ByteDirection @ (g!) ;
1.1       pazsan    132: 
                    133: \ ---------------- Tables
                    134: 
                    135: : >modes ( addr -- addr ) 5 cells + ;
                    136: : >data  ( addr -- addr ) >modes modes# cells + ;
                    137: 
                    138: 0 Value Describ
                    139: 
                    140: : Table-Exec ( addr -- )
                    141:   to Describ
                    142:   Describ 2 cells + perform    \ to store the opcode
                    143:   Describ 3 cells + perform    \ to store the operands
                    144:   Describ 4 cells + perform    \ to flush the instruction
                    145:   ;
                    146: 
1.8       dvdkhlng  147: : 1st-mc   ( addr -- flag )
                    148:   \G mnemonic check?  check for matching operands.  if matching, execute code
                    149:   \G to encode mode and operands and return true, else return false
1.1       pazsan    150:   dup >modes modes Mode-Compare
                    151:   IF   Table-Exec
                    152:        true
                    153:   ELSE  false
                    154:   THEN ;
                    155: 
                    156: : 1st-always ( addr -- flag )
1.8       dvdkhlng  157:   \G Undconditionally encode operands and/or instruction used for instructions
                    158:   \G that do not have any operands.  Return true i.e. make the assembler stop
                    159:   \G looking for more instruction variants
1.1       pazsan    160:   Table-Exec true ;
                    161: 
                    162: : 1st-thru
1.8       dvdkhlng  163:   \G Unconditionally encode, but return false to make assembler execute next
                    164:   \G table rows also.
1.1       pazsan    165:   dup Table-Exec false ;
                    166: 
1.8       dvdkhlng  167: : 2nd-opc!  ( -- )
                    168:   \G encode opcode by ORing data column of current instruction row into
                    169:   \G instruction latch
1.1       pazsan    170:   Describ >data count opc! ;
                    171: 
1.8       dvdkhlng  172: : opcode,  ( "<NNN> ..." -- )
                    173:   \G Append a counted string to dictionary, reading in every character as
                    174:   \G space-terminated numbers form the parser until the end of line is
                    175:   \G reached.
1.1       pazsan    176:   here 0 c,
                    177:   BEGIN bl word count dup WHILE s>number drop c,
                    178:   REPEAT 2drop here over - 1- swap c! ;        
                    179: 
1.8       dvdkhlng  180: : modes,  ( -- )
                    181:   \G append contents of MODES to dictionary
1.1       pazsan    182:   modes# 0 DO I cells modes + @ dic, LOOP ;
                    183: 
                    184: 0 Value Table-Link
                    185: 
1.8       dvdkhlng  186: : Table  ( "name" -- )
                    187:   \G create table that lists allowed operand/mode combinations for opcode
1.10      dvdkhlng  188:   \G "name".  Note that during assembling, table will be scanned in reverse
                    189:   \G order!
1.1       pazsan    190:   Reset 
                    191:   Create here to Table-Link 0 dic,
                    192:   DOES> I-Init
                    193:        BEGIN   @ dup WHILE dup
                    194:                cell+ perform           \ first element is executed always
                    195:                                        \ makes check
                    196:                ?EXIT
                    197:        REPEAT  -1 ABORT" no valid mode!"
                    198:   ;
1.8       dvdkhlng  199:  
                    200: : Follows  ( "name" -- )
                    201:   \G Link current instruction's table to execute all rows of table "name"
                    202:   \G (after executing all rows already defined).  Do not add any more rows to
                    203:   \G current table, after executing Follows.  Else you're going to modify
                    204:   \G "name"'s table!
1.1       pazsan    205:   ' >body @ Table-Link @ ! ;
                    206: 
1.8       dvdkhlng  207: : opc,  ( k*x "<NNN> ..." -- )
                    208:   \G Append current modes and opcode given byte-wise on current input line to
                    209:   \G dictionary.  Clear forth stack to remove any data provided by the
                    210:   \G otherwise unused operands that wer used to set up the modes array.
1.1       pazsan    211:   modes, opcode, clearstack reset ;
                    212: 
1.8       dvdkhlng  213: : (Opc()  ( k*x xt "<NNN> ..." -- )
                    214:   \G Fill table row for opcode with Operands.  XT will be executed by the
                    215:   \G assembler for encoding the operands using data from the stack.
1.1       pazsan    216:   ['] 1st-mc dic,
                    217:   ['] 2nd-opc! dic,
                    218:   dic,
                    219:   ['] I-Flush dic,
                    220:   opc, ;
                    221: 
1.8       dvdkhlng  222: : (Opc)  ( k*x xt "<NNN> ..." -- )
1.1       pazsan    223: \ Opcode without Operands
                    224:   ['] 1st-always dic,
                    225:   ['] 2nd-opc! dic,
                    226:   ['] Noop dic,
                    227:   ['] I-Flush dic,
                    228:   opc, ;
                    229: 
1.8       dvdkhlng  230: : Opc(  ( k*x xt "<NNN> ..." -- )
                    231:   \G Append a new table row for an opcode with Operands.  Use your assembler
                    232:   \G operands to fill the MODES array with data showing how the opcode is
                    233:   \G used.  Only the types of operands are recorded, any operand parameters
                    234:   \G passed on the stack are dropped.  The opcode's instruction code is read
                    235:   \G as 8-bit numbers from the current input line and stored as counted string
                    236:   \G in the table's opcode column
                    237:   \G
                    238:   \G When assembling an instruction, the assembler checks for matching
                    239:   \G operands.  If this row matches, first XT is called to consume operands
                    240:   \G parameters from the stack and encode them into the instruction latch.
                    241:   \G Then the opcode column is ORed to the instruction latch and the assembler
                    242:   \G quits assembly of the current instruction.
1.1       pazsan    243:   Table-Link linked
                    244:   (Opc() ;
                    245: 
1.8       dvdkhlng  246: : Opc  ( k*x "<NNN> ..." -- )
                    247:   \G Append a new table row for an opcode without operand parameters.
                    248:   \G
                    249:   \G When assembling an instruction, and the assembler reaches this row, it
                    250:   \G will assume the opcode is fully assembled and quits assembly of the
                    251:   \G instruction, after endcoding the opcode.
1.1       pazsan    252:   Table-Link linked
                    253:   (Opc) ;
                    254: 
1.8       dvdkhlng  255: : Opc+  ( k*x "<NNN> ..." -- )
                    256:   \G Append a new table row that encodes part of an opcode, but falls through
                    257:   \G to following lines.
1.1       pazsan    258:   Table-Link linked
                    259:   ['] 1st-thru dic,
                    260:   ['] 2nd-opc! dic,
                    261:   ['] Noop dic,
                    262:   ['] Noop dic, 
                    263:   opc, ;
                    264: 
1.8       dvdkhlng  265: : Opc(+  ( k*x xt "<NNN> ..." -- )
                    266:   \G Like OPC+ but for a table row that has operands
1.1       pazsan    267:   Table-Link linked
                    268:   ['] 1st-thru dic,
                    269:   ['] 2nd-opc! dic,
                    270:   dic,
                    271:   ['] Noop dic, 
                    272:   opc, ;
                    273: 
                    274: : End-Table ;
                    275: 
1.8       dvdkhlng  276: : alone  ( k*x "<NNN> ..." -- )
                    277:   \G Create a single-row instruction table for an instruction without operands.
1.1       pazsan    278:   Create 0 dic, ( Dummy Linkfield ) (opc)
                    279:   DOES> dup cell+ perform 0= ABORT" must work always!" ;
1.8       dvdkhlng  280:     
                    281: : alone(   ( k*x xt "<NNN> ..." -- )
                    282:   \G Create a single-row instruction table for an instruction with operands.
1.1       pazsan    283:   Create 0 dic, ( Dummy Linkfield ) (opc()
                    284:   DOES> dup cell+ perform 0= ABORT" must work always!" ;
1.8       dvdkhlng  285: 
                    286: 
                    287: \ Configure Emacs forth-mode to keep this file's formatting
                    288: 0 [IF]
                    289:    Local Variables:
                    290:    forth-indent-level: 2
                    291:    forth-local-indent-words:
                    292:    (((";") (0 . -2) (0 . -2))
                    293:     (("does>") (0 . 0) (0 . 0)))
                    294:    End:
                    295: [THEN]

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