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

    1: \ generic.fs implements generic assembler definitions		13aug97jaw
    2: 
    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
   19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   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>