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