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>