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

1.1       pazsan      1: \ generic.fs implements generic assembler definitions          13aug97jaw
                      2: 
1.2       anton       3: \ Copyright (C) 1998 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
1.3     ! anton      19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1       pazsan     20: 
                     21: \ These are generic routines to build up a table-driven assembler
                     22: \ fo any modern (RISC)-CPU
                     23: 
                     24: \ Revision Log:
                     25: \
                     26: \ 13aug97jaw-14aug97   Initial Version -> V0.5
                     27: \                      ToDo: operand count checking
                     28: \      
                     29: 
                     30: \ general definitions
                     31: 
                     32: : clearstack depth 0 ?DO drop LOOP ;
                     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: 
                     60: : reset
                     61:   modes modes# cells erase
                     62:   1 Mode# !
                     63:   depth Start-Depth ! ;
                     64: 
                     65: : Mode! ( n -- )
                     66:   Modes Mode# @ cells + ! ;
                     67: 
                     68: : +Mode! ( n -- )
                     69:   Modes Mode# @ cells + tuck @ or swap ! ;
                     70: 
                     71: : 0Mode! ( n -- )
                     72:   Modes ! ;
                     73: 
                     74: : ,
                     75:   1 Mode# +! ;
                     76: 
                     77: : Mode
                     78:   Create dic, DOES> @ +Mode! ;
                     79: 
                     80: : 0Mode
                     81:   Create dic, DOES> @ 0Mode! ;
                     82: 
                     83: : Reg
                     84:   Create dic, dic, DOES> dup perform cell+ @ ;
                     85: 
                     86: \ --------- Instruction Latch
                     87: 
                     88: Create I-Latch 10 chars allot
                     89: Variable I-Len
                     90: 
                     91: : opc! ( adr len -- )
                     92:   dup I-Len @ max I-Len !
                     93:   I-Latch -rot bounds DO I c@ over c@ or over c! char+ LOOP drop ;
                     94: 
                     95: : I-Init 0 I-Len ! I-Latch 10 erase ;
                     96: : I-Flush I-Latch I-len @ bounds DO i c@ X c, LOOP reset ;
                     97: 
                     98: : (g!) ( val addr n -1/1 -- )
                     99:   dup 0< IF rot 2 pick + 1- -rot THEN
                    100:   swap >r -rot r> 0 
                    101:   DO 2dup c! 2 pick + swap 8 rshift swap LOOP 
                    102:   2drop drop ;
                    103: 
                    104: : (g@) ( addr n -1/1 -- val )
                    105:   negate dup 0< IF rot 2 pick + 1- -rot THEN
                    106:   swap >r swap 0 swap r> 0 
                    107:   DO swap 8 lshift over c@ or swap 2 pick + LOOP
                    108:   drop nip ;
                    109: 
                    110: Variable ByteDirection \ -1 = big endian; 1 = little endian
                    111: 
                    112: : g@ ByteDirection @ (g@) ;
                    113: : g! ByteDirection @ (g!) ;
                    114: 
                    115: \ ---------------- Tables
                    116: 
                    117: : >modes ( addr -- addr ) 5 cells + ;
                    118: : >data  ( addr -- addr ) >modes modes# cells + ;
                    119: 
                    120: 0 Value Describ
                    121: 
                    122: : Table-Exec ( addr -- )
                    123:   to Describ
                    124:   Describ 2 cells + perform    \ to store the opcode
                    125:   Describ 3 cells + perform    \ to store the operands
                    126:   Describ 4 cells + perform    \ to flush the instruction
                    127:   ;
                    128: 
                    129: : 1st-mc   ( addr -- flag ) 
                    130:   dup >modes modes Mode-Compare
                    131:   IF   Table-Exec
                    132:        true
                    133:   ELSE  false
                    134:   THEN ;
                    135: 
                    136: : 1st-always ( addr -- flag )
                    137:   Table-Exec true ;
                    138: 
                    139: : 1st-thru
                    140:   dup Table-Exec false ;
                    141: 
                    142: : 2nd-opc!
                    143:   Describ >data count opc! ;
                    144: 
                    145: : opcode,
                    146:   here 0 c,
                    147:   BEGIN bl word count dup WHILE s>number drop c,
                    148:   REPEAT 2drop here over - 1- swap c! ;        
                    149: 
                    150: : modes,
                    151:   modes# 0 DO I cells modes + @ dic, LOOP ;
                    152: 
                    153: 0 Value Table-Link
                    154: 
                    155: : Table
                    156:   Reset 
                    157:   Create here to Table-Link 0 dic,
                    158:   DOES> I-Init
                    159:        BEGIN   @ dup WHILE dup
                    160:                cell+ perform           \ first element is executed always
                    161:                                        \ makes check
                    162:                ?EXIT
                    163:        REPEAT  -1 ABORT" no valid mode!"
                    164:   ;
                    165: 
                    166: : Follows
                    167:   ' >body @ Table-Link @ ! ;
                    168: 
                    169: : opc,
                    170:   modes, opcode, clearstack reset ;
                    171: 
                    172: : (Opc()
                    173: \ Opcode with Operands
                    174:   ['] 1st-mc dic,
                    175:   ['] 2nd-opc! dic,
                    176:   dic,
                    177:   ['] I-Flush dic,
                    178:   opc, ;
                    179: 
                    180: : (Opc)
                    181: \ Opcode without Operands
                    182:   ['] 1st-always dic,
                    183:   ['] 2nd-opc! dic,
                    184:   ['] Noop dic,
                    185:   ['] I-Flush dic,
                    186:   opc, ;
                    187: 
                    188: : Opc(
                    189: \ Opcode with Operands
                    190:   Table-Link linked
                    191:   (Opc() ;
                    192: 
                    193: : Opc
                    194: \ Opcode without Operands
                    195:   Table-Link linked
                    196:   (Opc) ;
                    197: 
                    198: : Opc+
                    199: \ Additional Opcode
                    200:   Table-Link linked
                    201:   ['] 1st-thru dic,
                    202:   ['] 2nd-opc! dic,
                    203:   ['] Noop dic,
                    204:   ['] Noop dic, 
                    205:   opc, ;
                    206: 
                    207: : Opc(+
                    208: \ Additional Opcode with Operands
                    209:   Table-Link linked
                    210:   ['] 1st-thru dic,
                    211:   ['] 2nd-opc! dic,
                    212:   dic,
                    213:   ['] Noop dic, 
                    214:   opc, ;
                    215: 
                    216: : End-Table ;
                    217: 
                    218: : alone
                    219:   Create 0 dic, ( Dummy Linkfield ) (opc)
                    220:   DOES> dup cell+ perform 0= ABORT" must work always!" ;
                    221: 
                    222: : alone(
                    223:   Create 0 dic, ( Dummy Linkfield ) (opc()
                    224:   DOES> dup cell+ perform 0= ABORT" must work always!" ;

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