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 >
Text File  |  1989-12-21  |  3KB  |  101 lines
  1. \
  2. \  BIT FIELD MANAGEMENT
  3. \
  4. \  Copyright (c) 1989 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 24 November 1989
  17. \
  18. \  Dependencies:
  19. \       (forth) forth
  20. \
  21. \  Description:
  22. \       Forth level definitions for bit field manipulation. Bit fields are
  23. \       extracted and altered on the top of stack element.
  24. \
  25. \  Copying:
  26. \       This program is free software; you can redistribute it and\or modify
  27. \       it under the terms of the GNU General Public License as published by
  28. \       the Free Software Foundation; either version 1, or (at your option)
  29. \       any later version.
  30. \
  31. \       This program is distributed in the hope that it will be useful,
  32. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  33. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34. \       GNU General Public License for more details.
  35. \
  36. \       You should have received a copy of the GNU General Public License
  37. \       along with this program; see the file COPYING.  If not, write to
  38. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  39.  
  40. .( Loading Bit Field definitions...) cr
  41.  
  42. vocabulary bitfields                   ( Bit field vocabulary)
  43.  
  44. bitfields definitions
  45.  
  46. 0 field +pos ( bits -- pos) private
  47. 4 field +width ( bits -- width) private
  48.  
  49. : bitfield.type ( -- pos0)
  50.   create 0 does> drop variable ;       ( Create a bitfield type)
  51.  
  52. : bits ( pos1 width -- pos2)
  53.   create over , dup , + ;              ( Create a named bitfield and adjust)
  54.  
  55. : field ( width -- )
  56.   create , does> @ bits ; private      ( Generate names for bitfields)
  57.     
  58. ( Initial set of bit field names)
  59. 1  field bit    ( -- )
  60. 4  field nibble ( -- )
  61. 8  field byte   ( -- )
  62. 16 field word   ( -- )
  63.  
  64. : bitfield.end ( pos3 -- )
  65.   32 > abort" bitfield: warning too many fields" ;
  66.  
  67. : .field ( field -- )
  68.   ." bitfield#" dup .                  ( Print field address)
  69.   ." pos: " dup +pos @ .               ( Print position of field)
  70.   ." width: " +width @ . ;             ( Print width of field)
  71.  
  72. #ifdef f@  ( Check if the kernel supports field access as a primitive)
  73.  
  74. : get ( x field -- y)
  75.   dup +pos @ swap +width @ f@ ;                ( Access field structure and data)
  76.  
  77. : put ( x y field -- z)
  78.   dup +pos @ swap +width @ f! ;                ( Access field structure and modify)
  79.  
  80. #else  ( without field access primitives)
  81.  
  82. : mask ( width -- mask)
  83.   -1 swap << not ; private             ( Create a mask for access)
  84.  
  85. : get ( x field -- y)
  86.   dup >r +pos @ >>                     ( Get position and adjust for access)
  87.   r> +width @ mask and ;               ( Mask of right part)
  88.  
  89. : put ( x y field -- z)
  90.   dup >r +width @ mask swap over       ( Create a mask for access)
  91.   r@ +pos @ << not and                 ( Remove field)
  92.   swap rot and                         ( Mask out part of source)
  93.   r> +pos @ << or ;                    ( Adjust position and include)
  94.  
  95. #then
  96.  
  97. forth only
  98.  
  99.  
  100.  
  101.