Annotation of gforth/asm/bitmask.fs, revision 1.4

1.1       pazsan      1: \ bitmask.fs Generic Bitmask compiler                                  13aug97jaw
                      2: 
1.4     ! anton       3: \ Copyright (C) 1998,2000 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
                      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: \ 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>