home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
pd6.lzh
/
LIB
/
TILE
/
bitfields.f83
next >
Wrap
Text File
|
1989-12-21
|
3KB
|
101 lines
\
\ BIT FIELD MANAGEMENT
\
\ Copyright (c) 1989 by Mikael R.K. Patel
\
\ Computer Aided Design Laboratory (CADLAB)
\ Department of Computer and Information Science
\ Linkoping University
\ S-581 83 LINKOPING
\ SWEDEN
\
\ Email: mip@ida.liu.se
\
\ Started on: 30 June 1988
\
\ Last updated on: 24 November 1989
\
\ Dependencies:
\ (forth) forth
\
\ Description:
\ Forth level definitions for bit field manipulation. Bit fields are
\ extracted and altered on the top of stack element.
\
\ Copying:
\ This program is free software; you can redistribute it and\or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 1, or (at your option)
\ any later version.
\
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with this program; see the file COPYING. If not, write to
\ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
.( Loading Bit Field definitions...) cr
vocabulary bitfields ( Bit field vocabulary)
bitfields definitions
0 field +pos ( bits -- pos) private
4 field +width ( bits -- width) private
: bitfield.type ( -- pos0)
create 0 does> drop variable ; ( Create a bitfield type)
: bits ( pos1 width -- pos2)
create over , dup , + ; ( Create a named bitfield and adjust)
: field ( width -- )
create , does> @ bits ; private ( Generate names for bitfields)
( Initial set of bit field names)
1 field bit ( -- )
4 field nibble ( -- )
8 field byte ( -- )
16 field word ( -- )
: bitfield.end ( pos3 -- )
32 > abort" bitfield: warning too many fields" ;
: .field ( field -- )
." bitfield#" dup . ( Print field address)
." pos: " dup +pos @ . ( Print position of field)
." width: " +width @ . ; ( Print width of field)
#ifdef f@ ( Check if the kernel supports field access as a primitive)
: get ( x field -- y)
dup +pos @ swap +width @ f@ ; ( Access field structure and data)
: put ( x y field -- z)
dup +pos @ swap +width @ f! ; ( Access field structure and modify)
#else ( without field access primitives)
: mask ( width -- mask)
-1 swap << not ; private ( Create a mask for access)
: get ( x field -- y)
dup >r +pos @ >> ( Get position and adjust for access)
r> +width @ mask and ; ( Mask of right part)
: put ( x y field -- z)
dup >r +width @ mask swap over ( Create a mask for access)
r@ +pos @ << not and ( Remove field)
swap rot and ( Mask out part of source)
r> +pos @ << or ; ( Adjust position and include)
#then
forth only