File:  [gforth] / gforth / asm / generic.fs
Revision 1.7: download - view: text, annotated - select for diffs
Mon Dec 31 19:02:25 2007 UTC (12 years, 1 month ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year after changing license notice

    1: \ generic.fs implements generic assembler definitions		13aug97jaw
    2: 
    3: \ Copyright (C) 1998,2000,2003,2007 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 3
   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, see http://www.gnu.org/licenses/.
   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
   27: \	
   28: 
   29: \ general definitions
   30: 
   31: : clearstack depth 0 ?DO drop LOOP ;
   32: 
   33: \ redefinitions to avoid conflicts
   34: 
   35: ' ,    ALIAS dic,
   36: ' NOOP ALIAS X
   37: 
   38: \ ------------ Modes
   39: 
   40: [IFUNDEF] modes#
   41: 4 Constant modes#
   42: [THEN]
   43: 
   44: Create modes modes# cells allot	\ Modes for differend operands are stored here
   45: 				\ Example:
   46: 				\ Offset 0: general modifier ( .B, .W, .L)
   47: 				\ Offset 1: addressing mode operand 1
   48: 				\ Offset 2: addressing mode operand 2
   49: 
   50: : Mode-Compare ( adr1 adr2 -- flag )
   51:   modes# 
   52:   BEGIN dup WHILE >r 2dup @ swap @ <> IF rdrop 2drop false EXIT THEN 
   53: 		cell+ swap cell+ r> 1- 
   54:   REPEAT drop 2drop true ;
   55: 
   56: Variable Start-Depth
   57: Variable Mode#
   58: 
   59: : reset
   60:   modes modes# cells erase
   61:   1 Mode# !
   62:   depth Start-Depth ! ;
   63: 
   64: : Mode! ( n -- )
   65:   Modes Mode# @ cells + ! ;
   66: 
   67: : +Mode! ( n -- )
   68:   Modes Mode# @ cells + tuck @ or swap ! ;
   69: 
   70: : 0Mode! ( n -- )
   71:   Modes ! ;
   72: 
   73: : ,
   74:   1 Mode# +! ;
   75: 
   76: : Mode
   77:   Create dic, DOES> @ +Mode! ;
   78: 
   79: : 0Mode
   80:   Create dic, DOES> @ 0Mode! ;
   81: 
   82: : Reg
   83:   Create dic, dic, DOES> dup perform cell+ @ ;
   84: 
   85: \ --------- Instruction Latch
   86: 
   87: Create I-Latch 10 chars allot
   88: Variable I-Len
   89: 
   90: : opc! ( adr len -- )
   91:   dup I-Len @ max I-Len !
   92:   I-Latch -rot bounds DO I c@ over c@ or over c! char+ LOOP drop ;
   93: 
   94: : I-Init 0 I-Len ! I-Latch 10 erase ;
   95: : I-Flush I-Latch I-len @ bounds DO i c@ X c, LOOP reset ;
   96: 
   97: : (g!) ( val addr n -1/1 -- )
   98:   dup 0< IF rot 2 pick + 1- -rot THEN
   99:   swap >r -rot r> 0 
  100:   DO 2dup c! 2 pick + swap 8 rshift swap LOOP 
  101:   2drop drop ;
  102: 
  103: : (g@) ( addr n -1/1 -- val )
  104:   negate dup 0< IF rot 2 pick + 1- -rot THEN
  105:   swap >r swap 0 swap r> 0 
  106:   DO swap 8 lshift over c@ or swap 2 pick + LOOP
  107:   drop nip ;
  108: 
  109: Variable ByteDirection	\ -1 = big endian; 1 = little endian
  110: 
  111: : g@ ByteDirection @ (g@) ;
  112: : g! ByteDirection @ (g!) ;
  113: 
  114: \ ---------------- Tables
  115: 
  116: : >modes ( addr -- addr ) 5 cells + ;
  117: : >data  ( addr -- addr ) >modes modes# cells + ;
  118: 
  119: 0 Value Describ
  120: 
  121: : Table-Exec ( addr -- )
  122:   to Describ
  123:   Describ 2 cells + perform 	\ to store the opcode
  124:   Describ 3 cells + perform	\ to store the operands
  125:   Describ 4 cells + perform 	\ to flush the instruction
  126:   ;
  127: 
  128: : 1st-mc   ( addr -- flag ) 
  129:   dup >modes modes Mode-Compare
  130:   IF 	Table-Exec
  131: 	true
  132:   ELSE  false
  133:   THEN ;
  134: 
  135: : 1st-always ( addr -- flag )
  136:   Table-Exec true ;
  137: 
  138: : 1st-thru
  139:   dup Table-Exec false ;
  140: 
  141: : 2nd-opc!
  142:   Describ >data count opc! ;
  143: 
  144: : opcode,
  145:   here 0 c,
  146:   BEGIN bl word count dup WHILE s>number drop c,
  147:   REPEAT 2drop here over - 1- swap c! ;	
  148: 
  149: : modes,
  150:   modes# 0 DO I cells modes + @ dic, LOOP ;
  151: 
  152: 0 Value Table-Link
  153: 
  154: : Table
  155:   Reset 
  156:   Create here to Table-Link 0 dic,
  157:   DOES> I-Init
  158: 	BEGIN 	@ dup WHILE dup
  159: 		cell+ perform		\ first element is executed always
  160: 					\ makes check
  161: 		?EXIT
  162: 	REPEAT	-1 ABORT" no valid mode!"
  163:   ;
  164: 
  165: : Follows
  166:   ' >body @ Table-Link @ ! ;
  167: 
  168: : opc,
  169:   modes, opcode, clearstack reset ;
  170: 
  171: : (Opc()
  172: \ Opcode with Operands
  173:   ['] 1st-mc dic,
  174:   ['] 2nd-opc! dic,
  175:   dic,
  176:   ['] I-Flush dic,
  177:   opc, ;
  178: 
  179: : (Opc)
  180: \ Opcode without Operands
  181:   ['] 1st-always dic,
  182:   ['] 2nd-opc! dic,
  183:   ['] Noop dic,
  184:   ['] I-Flush dic,
  185:   opc, ;
  186: 
  187: : Opc(
  188: \ Opcode with Operands
  189:   Table-Link linked
  190:   (Opc() ;
  191: 
  192: : Opc
  193: \ Opcode without Operands
  194:   Table-Link linked
  195:   (Opc) ;
  196: 
  197: : Opc+
  198: \ Additional Opcode
  199:   Table-Link linked
  200:   ['] 1st-thru dic,
  201:   ['] 2nd-opc! dic,
  202:   ['] Noop dic,
  203:   ['] Noop dic, 
  204:   opc, ;
  205: 
  206: : Opc(+
  207: \ Additional Opcode with Operands
  208:   Table-Link linked
  209:   ['] 1st-thru dic,
  210:   ['] 2nd-opc! dic,
  211:   dic,
  212:   ['] Noop dic, 
  213:   opc, ;
  214: 
  215: : End-Table ;
  216: 
  217: : alone
  218:   Create 0 dic, ( Dummy Linkfield ) (opc)
  219:   DOES> dup cell+ perform 0= ABORT" must work always!" ;
  220: 
  221: : alone(
  222:   Create 0 dic, ( Dummy Linkfield ) (opc()
  223:   DOES> dup cell+ perform 0= ABORT" must work always!" ;

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