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

    1: \ bitmask.fs Generic Bitmask compiler          			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: \ This is a tool for building up assemblers.
   22: \ In modern CPU's instrutions there are often some bitfields that
   23: \ sepcify a register, a addressing mode, an immediate value.
   24: \ A value in an instruction word might be represented in one bitfield
   25: \ or several bitfields.
   26: \ If you code it yourself, you have to think about the right shifting
   27: \ operators. E.g. if you want to store a 2-bit value at bit position 3
   28: \ you would code: ( value opcode -- opcode ) swap 3 lshift or
   29: \ If the value is stored at bit-position 2-3 and 5-6 it gets more difficult:
   30: \ ( value opcode -- opcode ) swap dup 3 and 2 lshift rot or swap 3 and 5 lshift or
   31: \ This is no fun! This can be created automatically by: "maskinto %bitfield".
   32: \ This compiles some code like above into the current definition.
   33: \ This code has the same stack-effect then our examples.
   34: \ Additional things compiled: A check whether the value could be represented
   35: \ by the bitfield, the area of the bitfield is cleared in the opcode.
   36: 
   37: \ Code Compliance:
   38: \
   39: \ This is for 32 bit and 64 bit systems and for GForth only.
   40: \ 
   41: 
   42: \ Revision Log:
   43: \
   44: \ 13aug97 Jens Wilke	Creation
   45: 
   46: decimal
   47: 
   48: : ?bitexceed ( u1 u2 -- u1 )
   49: \G if u1 is greater than u2 the value could not be represented in the bitfield
   50:   over u< ABORT" value exceeds bitfield!" ;
   51: 
   52: : bitset# ( u -- )
   53: \G returns the number of bits set in a cell
   54:   0 swap 64 0 DO dup 1 and IF swap 1+ swap THEN 1 rshift LOOP drop ;
   55: 
   56: : max/bits ( u -- u2 )
   57: \G returns the highes number that could be represented by u bits
   58:   1 swap lshift 1- ;
   59: 
   60: Variable mli	\ masked last i
   61: Variable mst	\ masked state
   62: 
   63: : (maskinto) ( n -- )
   64:   0 mst !
   65:   0 mli !
   66:   [ -1 bitset# ] literal 0
   67:   DO	mst @
   68: 	IF	dup 1 and 0=
   69: 		IF I mli @ - ?dup 
   70: 		   IF  	postpone dup max/bits mli @ lshift
   71: 			postpone literal postpone and postpone rot 
   72: 			postpone or postpone swap
   73: 		   THEN
   74: 		   I mli ! 0 mst !
   75: 		THEN
   76: 	ELSE	dup 1 and
   77: 		IF I mli @ - ?dup
   78: 		   IF postpone literal postpone lshift THEN
   79: 		   I mli ! 1 mst !
   80: 		THEN
   81: 	THEN
   82: 	1 rshift 
   83:   LOOP drop 
   84:   postpone drop ;
   85: 
   86: : maskinto ( <mask> )
   87:   name s>number drop
   88:   \ compile: clear maskarea
   89:   dup invert 
   90:   postpone literal postpone and postpone swap
   91:   \ compile: make check
   92:   dup bitset# max/bits
   93:   postpone literal postpone ?bitexceed
   94:   (maskinto) ; immediate
   95: 
   96: \ : test maskinto %110010 ;

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