home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / tile-forth-2.1-bin.lha / lib / tile-forth / bitfields.f83 next >
Text File  |  1996-10-12  |  2KB  |  109 lines
  1. \
  2. \  BIT FIELD DEFINITIONS
  3. \
  4. \  Copyright (C) 1988-1990 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: 25 July 1990
  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. Additional
  24. \       functions for bit and field access are also provided.
  25. \
  26. \  Copying:
  27. \       This program is free software; you can redistribute it and\or modify
  28. \       it under the terms of the GNU General Public License as published by
  29. \       the Free Software Foundation; either version 1, or (at your option)
  30. \       any later version.
  31. \
  32. \       This program is distributed in the hope that it will be useful,
  33. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  34. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35. \       GNU General Public License for more details.
  36. \
  37. \       You should have received a copy of the GNU General Public License
  38. \       along with this program; see the file COPYING.  If not, write to
  39. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  40.  
  41. .( Loading Bitfields definitions...) cr
  42.  
  43. #ifundef b@  ( Check if bit and field access are not supported by the kernel)
  44.  
  45. : b@ ( x pos -- bool)
  46.   1 swap << and boolean
  47. ;
  48.  
  49. : b! ( x y pos -- z)
  50.   >r 1 tuck
  51.   r@ << not and
  52.   swap rot and
  53.   r> << or
  54. ;  
  55.  
  56. : f@ ( x pos width -- y)
  57.   >r >> -1 r> << not and
  58. ;
  59.  
  60. : <f@ ( x pos width -- y)
  61.   >r >> -1 r@ << not and
  62.   dup 1 r@ 1- << and
  63.   if -1 r> << or
  64.   else r> drop then
  65. ;
  66.  
  67. : f! ( x y pos width -- z)
  68.   swap >r -1 swap << not tuck
  69.   r@ << not and
  70.   swap rot and
  71.   r> << or
  72. ;
  73.  
  74. #then
  75.  
  76. vocabulary bitfields ( -- )
  77.  
  78. bitfields definitions
  79.  
  80. : bitfield.type ( -- bitfield.type pos0)
  81.   create here 0 , 0 
  82. does> ( bitfield.type -- )
  83.   drop variable
  84. ;
  85.  
  86. : bits ( pos1 width -- pos2)
  87.   create dup , over , +
  88. does> ( bits -- pos width)
  89.   2@
  90. ;
  91.  
  92. : bitfield.field ( width -- )
  93.   create ,
  94. does> ( bitfield.field -- )
  95.   @ bits
  96. ; private
  97.     
  98. ( Initial set of bit field names)
  99. 1  bitfield.field bit ( -- )
  100. 4  bitfield.field nibble ( -- )
  101. 8  bitfield.field byte ( -- )
  102. 16 bitfield.field word ( -- )
  103.  
  104. : bitfield.end ( bitfield.type pos3 -- )
  105.   last rot ! 32 > abort" bitfield.end: warning too many fields"
  106. ;
  107.  
  108. forth only
  109.