gcc/m2/gm2-libs-pim/BitWordOps.mod

   1 (* BitWordOps.mod provides a Logitech-3.0 compatible library.
   2
   3 Copyright (C) 2007-2021 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE BitWordOps ;
  28
  29 FROM SYSTEM IMPORT BYTE, ADR, SHIFT, ROTATE, TSIZE ;
  30
  31
  32 (*
  33    GetBits - returns the bits firstBit..lastBit from source.
  34              Bit 0 of word maps onto the firstBit of source.
  35 *)
  36
  37 PROCEDURE GetBits (source: WORD; firstBit, lastBit: CARDINAL) : WORD ;
  38 VAR
  39    si  : CARDINAL ;
  40    sb  : BITSET ;
  41    mask: BITSET ;
  42    i   : CARDINAL ;
  43 BEGIN
  44    sb := VAL (BITSET, source) ;
  45    mask := {} ;
  46    FOR i := firstBit TO lastBit DO
  47       INCL (mask, i)
  48    END ;
  49    sb := VAL (BITSET, source) * mask ;
  50    i := 1 ;
  51    WHILE firstBit > 0 DO
  52       DEC (firstBit) ;
  53       i := i*2
  54    END ;
  55    si := VAL (CARDINAL, sb) ;
  56    RETURN VAL (WORD, si DIV i)
  57 END GetBits ;
  58
  59
  60 (*
  61    SetBits - sets bits in, word, starting at, firstBit, and ending at,
  62              lastBit, with, pattern.  The bit zero of, pattern, will
  63              be placed into, word, at position, firstBit.
  64 *)
  65
  66 PROCEDURE SetBits (VAR word: WORD; firstBit, lastBit: CARDINAL;
  67                    pattern: WORD) ;
  68 VAR
  69    pw, pp: BITSET ;
  70    i, j  : CARDINAL ;
  71 BEGIN
  72    pw := VAL (BITSET, word) ;
  73    pp := VAL (BITSET, pattern) ;
  74    j := 0 ;
  75    FOR i := firstBit TO lastBit DO
  76       IF j IN pp
  77       THEN
  78          INCL (pw, i)
  79       ELSE
  80          EXCL (pw, i)
  81       END ;
  82       INC (j)
  83    END ;
  84    word := VAL (WORD, pw)
  85 END SetBits ;
  86
  87
  88 (*
  89    WordAnd - returns a bitwise (left AND right)
  90 *)
  91
  92 PROCEDURE WordAnd (left, right: WORD) : WORD ;
  93 BEGIN
  94    RETURN VAL (WORD, VAL (BITSET, left) * VAL (BITSET, right))
  95 END WordAnd ;
  96
  97
  98 (*
  99    WordOr - returns a bitwise (left OR right)
 100 *)
 101
 102 PROCEDURE WordOr (left, right: WORD) : WORD ;
 103 BEGIN
 104    RETURN VAL (WORD, VAL (BITSET, left) + VAL (BITSET, right))
 105 END WordOr ;
 106
 107
 108 (*
 109    WordXor - returns a bitwise (left XOR right)
 110 *)
 111
 112 PROCEDURE WordXor (left, right: WORD) : WORD ;
 113 BEGIN
 114    RETURN VAL (WORD, VAL (BITSET, left) DIV VAL (BITSET, right))
 115 END WordXor ;
 116
 117
 118 (*
 119    WordNot - returns a word with all bits inverted.
 120 *)
 121
 122 PROCEDURE WordNot (word: WORD) : WORD ;
 123 BEGIN
 124    RETURN VAL (WORD, -VAL (BITSET, word))
 125 END WordNot ;
 126
 127
 128 (*
 129    WordShr - returns a, word, which has been shifted, count
 130              bits to the right.
 131 *)
 132
 133 PROCEDURE WordShr (word: WORD; count: CARDINAL) : WORD ;
 134 BEGIN
 135    RETURN SHIFT (VAL (BITSET, word), count)
 136 END WordShr ;
 137
 138
 139 (*
 140    WordShl - returns a, word, which has been shifted, count
 141              bits to the left.
 142 *)
 143
 144 PROCEDURE WordShl (word: WORD; count: CARDINAL) : WORD ;
 145 BEGIN
 146    RETURN SHIFT (VAL (BITSET, word), -VAL (INTEGER, count))
 147 END WordShl ;
 148
 149
 150 (*
 151    WordSar - shift word arthemetic right.  Preserves the top
 152              end bit and as the value is shifted right.
 153 *)
 154
 155 PROCEDURE WordSar (word: WORD; count: CARDINAL) : WORD ;
 156 VAR
 157    w: WORD ;
 158 BEGIN
 159    IF MAX (BITSET) IN VAL (BITSET, word)
 160    THEN
 161       w := VAL (WORD, SHIFT (VAL (BITSET, word), count)) ;
 162       SetBits(w, MAX (BITSET) - count, MAX (BITSET), -BITSET{}) ;
 163       RETURN w
 164    ELSE
 165       RETURN SHIFT(VAL(BITSET, word), count)
 166    END
 167 END WordSar ;
 168
 169
 170 (*
 171    WordRor - returns a, word, which has been rotated, count
 172              bits to the right.
 173 *)
 174
 175 PROCEDURE WordRor (word: WORD; count: CARDINAL) : WORD ;
 176 BEGIN
 177    RETURN ROTATE (VAL (BITSET, word), count)
 178 END WordRor ;
 179
 180
 181 (*
 182    WordRol - returns a, word, which has been rotated, count
 183              bits to the left.
 184 *)
 185
 186 PROCEDURE WordRol (word: WORD; count: CARDINAL) : WORD ;
 187 BEGIN
 188    RETURN ROTATE (VAL (BITSET, word), -VAL (INTEGER, count))
 189 END WordRol ;
 190
 191
 192 (*
 193    HighByte - returns the top byte only from, word.
 194               The byte is returned in the bottom byte
 195               in the return value.
 196 *)
 197
 198 PROCEDURE HighByte (word: WORD) : WORD ;
 199 VAR
 200    p, q  : POINTER TO ARRAY [0..TSIZE(WORD)-1] OF BYTE ;
 201    result: WORD ;
 202 BEGIN
 203    p := ADR (word) ;
 204    q := ADR (result) ;
 205    result := 0 ;
 206    q^[0] := p^[TSIZE(WORD)-1] ;
 207    RETURN result
 208 END HighByte ;
 209
 210
 211 (*
 212    LowByte - returns the low byte only from, word.
 213              The byte is returned in the bottom byte
 214              in the return value.
 215 *)
 216
 217 PROCEDURE LowByte (word: WORD) : WORD ;
 218 VAR
 219    p, q  : POINTER TO ARRAY [0..TSIZE(WORD)-1] OF BYTE ;
 220    result: WORD ;
 221 BEGIN
 222    p := ADR (word) ;
 223    q := ADR (result) ;
 224    result := 0 ;
 225    q^[0] := p^[0] ;
 226    RETURN result
 227 END LowByte ;
 228
 229
 230 (*
 231    Swap - byte flips the contents of word.
 232 *)
 233
 234 PROCEDURE Swap (word: WORD) : WORD ;
 235 VAR
 236    p   : POINTER TO ARRAY [0..TSIZE(WORD)-1] OF BYTE ;
 237    i, j: CARDINAL ;
 238    b   : BYTE ;
 239 BEGIN
 240    p := ADR (word) ;
 241    j := TSIZE (WORD)-1 ;
 242    FOR i := 0 TO (TSIZE (WORD) DIV 2)-1 DO
 243       b := p^[i] ;
 244       p^[i] := p^[j] ;
 245       p^[j] := b ;
 246       DEC (j)
 247    END ;
 248    RETURN word
 249 END Swap ;
 250
 251
 252 END BitWordOps.