Turbo Toolbox/Turbo_Toolbox.iso/spezial/13/bit/bit.pas

Pascal/Delphi Source File | 1988-09-26 | 5.8 KB | 186 lines

(* ------------------------------------------------------ *)
(*                     BIT.PAS                            *)
(*   Funktionen zur Bitmanipulation in Turbo Pascal 4.0   *)
(*        Verbesserung der Unit aus PASCAL 8/9'88         *)
(*                                                        *)
(*        (c) 1988 by Ralf Randermann & TOOLBOX           *)
(* ------------------------------------------------------ *)

UNIT Bit;

INTERFACE

(* ------------------------------------------------------ *)
(* Die Bits einer Integerzahl werden entsprechend ihrer   *)
(* Wertigkeit durchnumeriert, d.h. Bit 0 entspricht der   *)
(* ersten Stelle vor dem Komma (Wertigkeit 2 hoch 0) usw. *)
(* Bits, deren Wertigkeit außerhalb des Geltungsbereichs  *)
(* des entsprechenden Typs liegen, z.B. Bit 128, sind     *)
(* immer Null. Achtung: bei shortint ist Bit 7 und bei    *)
(* integer Bit 15 das Vorzeichenbit!                      *)
(* ------------------------------------------------------ *)

FUNCTION TestBit(Zahl: WORD; BitNr: BYTE): BOOLEAN;
(* true, wenn das Bit <BitNr> in Zahl gesetzt ist         *)

FUNCTION SetBit(Zahl: WORD; BitNr: BYTE): WORD;
(* liefert als Ergebnis den Wert von <Zahl> mit gesetztem *)
(* Bit <BitNr>.                                           *)

FUNCTION ClrBit(Zahl: WORD; BitNr: BYTE): WORD;
(* liefert als Ergebnis den Wert von <Zahl> mit gelöschtem*)
(* Bit <BitNr>.                                           *)

FUNCTION BitMaske(Min,Breite: BYTE): WORD;
(* liefert eine Zahl, in der <Breite> Bits von Bit <Min>  *)
(* an gesetzt sind.                                       *)

FUNCTION BitGrp(Zahl: WORD; Min,Breite: BYTE): WORD;
(* liefert den Wert der <Breite> Bits, die in <Zahl> ab   *)
(* <Min> stehen.                                          *)

FUNCTION RoL(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
(* liefert den Wert der ersten <Laenge> Bits von <Zahl>,  *)
(* nachdem diese <Anzahl>-mal nach links rotiert wurden.  *)

FUNCTION RoR(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;

(* liefert den Wert der ersten <Laenge> Bits von <Zahl>,  *)
(* nachdem diese <Anzahl>-mal nach rechts rotiert wurden. *)

FUNCTION IntStr(Zahl: WORD; Basis,Laenge: BYTE): string;
(* liefert einen String, der die Darstellung von <Zahl>   *)
(* zur Basis <Basis> enthält. Ist <Basis> kleiner als 2   *)
(* oder größer als 16, dann wird Zahl byteweise in ASCII- *)
(* Zeichen umgewandelt. Das Ergebnisstring hat mindestens *)
(* die Länge <Laenge>. Gegebenfalls werden bei einer      *)
(* Zahlendarstellung entsprechend viele Nullen ergänzt.   *)
(* Bei ASCII-Darstellung werden Leerzeichen eingefügt.    *)

FUNCTION IntVal(Zahl: string; Basis: BYTE;
                                   var Code: INTEGER): WORD;
(* liefert den Wert von <Zahl> zurück, das eine Zahl in   *)
(* der Darstellung zur Basis <Basis> enthält. Enthält     *)
(* <Zahl> falsche (z. B. führende Leerzeichen) oder zu    *)
(* viele Ziffern, so liefert Code die Position des ersten *)
(* falschen Zeichens zurück. Bei einer erfolgreichen      *)
(* Übersetzung ist <Code> Null. Ist <Basis> kleiner als 2 *)
(* oder größer als 16, dann wird der ASCII-Code der       *)
(* Zeichen als Ziffern genutzt (siehe IntStr).            *)


IMPLEMENTATION

FUNCTION TestBit(Zahl: WORD; BitNr: BYTE): BOOLEAN;
BEGIN
  TestBit:=(((Zahl SHR BitNr) AND 1)=1)
END;

FUNCTION SetBit(Zahl: WORD; BitNr: BYTE): WORD;
BEGIN
  SetBit:=Zahl OR (1 SHL BitNr)
END;

FUNCTION ClrBit(Zahl: WORD; BitNr: BYTE): WORD;
BEGIN
  ClrBit:=Zahl AND NOT (1 SHL BitNr)
END;

FUNCTION BitMaske(Min,Breite: BYTE): WORD;
VAR LV      : BYTE;
    Ergebnis: WORD;
BEGIN
  Ergebnis:=0;
  FOR LV:=1 TO Breite DO Ergebnis:=Ergebnis SHL 1+1;
  BitMaske:=Ergebnis SHL Min
END;

FUNCTION BitGrp(Zahl: WORD; Min,Breite: BYTE): WORD;
BEGIN
  BitGrp:=(Zahl AND BitMaske(Min,Breite)) SHR Min
END;

FUNCTION RoL(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
VAR LV     : BYTE;
    Max,Inv: WORD;
BEGIN
  Zahl:=Zahl AND BitMaske(0,Laenge);
  Max:=SetBit(0,pred(Laenge));
  Inv:=NOT Max;
  FOR LV:=1 TO Anzahl DO
    IF Zahl AND Max > 0 THEN Zahl:=(Zahl AND Inv) SHL 1+1
    ELSE Zahl:=Zahl SHL 1;
    RoL:=Zahl
END;

FUNCTION RoR(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
VAR LV : BYTE;
    Max: WORD;
BEGIN
  Zahl:=Zahl AND BitMaske(0,Laenge);
  Max:=SetBit(0,pred(Laenge));
  FOR LV:=1 TO Anzahl DO
    Zahl:=(Zahl SHR 1) OR (Zahl AND 1)*Max;
  RoR:=Zahl
END;


CONST Ziffer: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';

FUNCTION IntStr(Zahl: WORD; Basis,Laenge: BYTE): string;
VAR InsChar : CHAR;
    Ergebnis: string;
BEGIN
  Ergebnis:='';
  IF (Basis>16) OR (Basis<2) THEN BEGIN
    REPEAT
      Ergebnis:=char(Zahl AND $FF)+Ergebnis;
      Zahl:=Zahl SHR 8
    UNTIL Zahl=0;
    InsChar:=' '
  END ELSE BEGIN
    REPEAT
      Ergebnis:=Ziffer[Zahl MOD Basis]+Ergebnis;
      Zahl:=Zahl DIV Basis
    UNTIL Zahl=0;
    InsChar:='0'
  END;
  WHILE Laenge>length(Ergebnis) DO
    Ergebnis:=InsChar+Ergebnis;
  IntStr:=Ergebnis;
END;

FUNCTION IntVal(Zahl: string; Basis: BYTE;
                                   VAR Code: integer): WORD;
CONST WMax = 65535;
VAR   Ergebnis: longint;
      Zif     : BYTE;
BEGIN
  Ergebnis:=0;
  Code:=0;
  IF (Basis>16) OR (Basis<2) THEN
    WHILE Code<length(Zahl) do BEGIN
      inc(Code);
      Ergebnis:=Ergebnis*256+ord(Zahl[Code]);
      IF Ergebnis>WMax THEN BEGIN
        IntVal:=0;
        EXIT;
      END;
    END
  ELSE
    WHILE Code<length(Zahl) DO BEGIN
      inc(Code);
      Zif:=pos(Zahl[Code],Ziffer);
      Ergebnis:=Ergebnis*Basis+pred(Zif);
      IF (Ergebnis>WMax)OR(Zif>Basis) OR (Zif=0) THEN BEGIN
        IntVal:=0;
        EXIT;
      END;
    END;
  Code:=0;
  IntVal:=Ergebnis
END;

END.
(* ------------------------------------------------------ *)