The ModulaTor

How to count bits in Modula-2

The old fashioned type transfer function versus ISO Modula-2's SYSTEM.CAST

by Günter Dotzel, ModulaWare

3rd revision, 26-Jan-1999: The Modula-2 and Oberon-2 algorithms shown below are now 64 bit upward compatible, i.e.: the source code can be compiled in either 32 bit and 64 bit mode.

Type casting was previously called type transfer function in Wirth's Programming in Modula-2 (PIM).

PIM described the type transfer as system dependent facility. Syntactically the type transfer was equivalent to a function call: A type identifier T denoted the type-transfer function from the type of the parameter (operand) to the type T. ISO Modula-2 removed this type transfer notation and introduced a new pervasive function in module SYSTEM called CAST. The notation is now SYSTEM.CAST(T, expression) instead of T(expression). Evidently, this functions is data representation-dependent and hence system dependent. Normally the type transfer involves no explicit conversion instruction.

Examples:

With the declaration

    VAR f: [0..31];

    IF ODD (f DIV 8) THEN  (* bit 3 set in f *) END

    CASE f OF
    | 8..15, 24..31: (*  bit 3 set in f *) 
    ELSE (* ... *)
    END

    IF 3 IN BITSET (f) THEN (* bit 3 set in f *) END

    IF {3} <= BITSET (f) THEN (* bit 3 set in f *) END

    IF 3 IN CAST(BITSET, f) THEN (* bit 3 set in f *) END

    IF BITSET{3} <= CAST(BITSET, f) THEN (* bit 3 set in f *) END

    TYPE PS = PACKEDSET OF [0..4];

    IF 3 IN CAST(PS, f) THEN (* bit 3 set in f *) END

    IF PS{3} <= CAST(PS, f) THEN (* bit 3 set in f *) END

Procedure Bitsum0 is straight-forward, incrementing a counter for all bits set in a variable of type INTEGER.

The algorithm of procedure Bitsum1 is a bit tricky but faster for most bit patterns.

Procedure BitSum2 is more complex, but may be more efficient with certain compilers/processors. The auxiliary variables needed are initialized in the module body.

Procedure BitSum3 is more general in that it accepts variables of any data type and uses a data vector initialized in the module body.

Procedure BitSum4 also accepts variables of any data type as Bitsum3 but eliminates the restriction of Bitsum3 which assumes that SIZE(CHAR)=SIZE(LOC).

Procedure BitSum5 is a fully portable version of bit-summing.

The example module Use_CountBits compares the five different methods to count bits in a word.

___________________________________________________________________

DEFINITION MODULE CountBits;
(* Modula-2 example: different methods to count the bits set in 
   a cardinal or structure *)
IMPORT SYSTEM;

TYPE Bits = CARDINAL[0 .. SIZE(CARDINAL)*SYSTEM.BITSPERLOC - 1] ;

  PROCEDURE Bitsum0(B: CARDINAL): CARDINAL; 
  PROCEDURE Bitsum1(B: CARDINAL): CARDINAL;
  PROCEDURE Bitsum2(B: CARDINAL): CARDINAL;
  PROCEDURE Bitsum3(VAR B: ARRAY OF SYSTEM.LOC): CARDINAL;
  PROCEDURE Bitsum4(VAR B: ARRAY OF SYSTEM.LOC): CARDINAL;
  PROCEDURE Bitsum5(Num: CARDINAL): Bits ;
END CountBits.

___________________________________________________________________

IMPLEMENTATION MODULE CountBits;
(* Written in ISO Modula-2 by Guenter Dotzel, Nov-1992 
   GD/16-Feb-1993: Bitsum5 added
   GD/12-Jun-1994: revised 
   GD/23-Jan-1999: 64 bit upward compatible;
     compiles with ModulaWare's OpenVMS Modula-2 compiler
     MVR|MaX V4 and MaX V5 in 64 bit and 32 bit mode

   Copyright (1992-1999) by Gunter Dotzel,
   http://www.modulaware.com
*)
FROM SYSTEM IMPORT CAST, SHIFT, LOC;

CONST maxPR = 6; maxSet=64;

TYPE
  byte = [0..255];
  PBS = PACKEDSET OF [0..SIZE(CARDINAL)*8-1];
  PBSmax = PACKEDSET OF [0..maxSet-1];
  PR = ARRAY [0..maxPR] OF RECORD
    ShiftCount: INTEGER;
    Mask: PBSmax;
  END;

VAR Parameter: PR;
  V: ARRAY byte OF CARDINAL;
  x: CARDINAL;

  PROCEDURE Bitsum0(B: CARDINAL): CARDINAL; 
  CONST MaxBitsPerCard = SIZE(CARDINAL)*8-1;
  VAR c, i: CARDINAL;
  BEGIN
    c := 0;
    FOR i := 0 TO MaxBitsPerCard DO
      IF i IN CAST(PBS, B) THEN
        INC(c);
      END;
    END;
    RETURN c;
  END Bitsum0;

  PROCEDURE Bitsum1(B: CARDINAL): CARDINAL;
  VAR c: CARDINAL;
  BEGIN
    c := 0;
    WHILE B # 0 DO
      INC(c);
      B := CAST(CARDINAL,CAST(PBS,B) * CAST(PBS,B-1));
    END;
    RETURN c;
  END Bitsum1;

  (* count the number of bits in a bitstring via decomposition technique, 
     see ~+Combinatorial Algorithms [Reingold 1977]~- *)
  PROCEDURE Bitsum2(B: CARDINAL): CARDINAL;

    PROCEDURE BitSum(length: CARDINAL): CARDINAL;
    (* length := LOG2(bit string length)  *)
    VAR bs: PBSmax;
    BEGIN
      IF length=0 THEN RETURN B; END;
      bs := CAST(PBSmax, BitSum(length-1));
      WITH Parameter[length] DO
        RETURN
         CAST(CARDINAL, SHIFT(bs, ShiftCount) * Mask) + 
         CAST(CARDINAL, bs * Mask);
      END;
    END BitSum;

  BEGIN
    IF SIZE(CARDINAL) = 4 THEN RETURN BitSum(5)
    ELSE RETURN BitSum(6)
    END;
  END Bitsum2;

  PROCEDURE Bitsum3(VAR B: ARRAY OF LOC): CARDINAL;
  VAR i,c: CARDINAL;
  BEGIN
    c:=0;
    FOR i:=0 TO HIGH(B) DO
      INC(c, V[ORD(CAST(CHAR, B[i]))]);
    END;
    RETURN c;
  END Bitsum3;

  PROCEDURE Bitsum4(VAR B: ARRAY OF LOC): CARDINAL;
  VAR i,c: CARDINAL;
  BEGIN
    c:=0;
    FOR i:=0 TO HIGH(B) DO
      INC(c, V[CAST(byte, B[i])]);
    END;
    RETURN c;
  END Bitsum4;

  PROCEDURE Bitsum5(Num : CARDINAL): Bits;
  (* fully portable version of Bit-summing by Keith Hopper
     , 16-Feb-1993
  *)
  CONST One_Left = -1 ;
  TYPE Card_Set = PACKEDSET OF Bits;
  VAR Ans: Bits;
  BEGIN
    Ans := 0;
    LOOP
      IF Num = 0 THEN RETURN Ans
      ELSE
        IF ODD(Num) THEN INC(Ans)
        END;
        Num := CAST(CARDINAL, SHIFT(CAST(Card_Set,Num),One_Left))
      END
    END
  END Bitsum5;

BEGIN
  (* Initialisation for procedure Bitsum2 *)
  Parameter[1].ShiftCount:=-1; (* right shift one bit *)
  Parameter[2].ShiftCount:=-2;
  Parameter[3].ShiftCount:=-4;
  Parameter[4].ShiftCount:=-8;
  Parameter[5].ShiftCount:=-16;
  Parameter[6].ShiftCount:=-32;
  IF SIZE(CARDINAL) = 4 THEN
    Parameter[1].Mask:=PBSmax{0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30};
    Parameter[2].Mask:=PBSmax{0,1,4,5,8,9, 12,13,16,17,20,21,24,25,28,29};
    Parameter[3].Mask:=PBSmax{0..3,   8..11,     16..19,     24..27};
    Parameter[4].Mask:=PBSmax{0..7, 16..23};
    Parameter[5].Mask:=PBSmax{0..15};
  ELSIF SIZE(CARDINAL) = 8 THEN
    Parameter[1].Mask:=PBSmax{0, 2, 4, 6, 8,10,12,14,16,18,20,22,24,26,28,30,
                             32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62};
    Parameter[2].Mask:=PBSmax{0,1,  4,5,  8,9, 12,13,16,17,20,21,24,25,28,29,
                             32,33,36,37,40,41,44,45,48,49,52,53,56,57,60,61};
    Parameter[3].Mask:=PBSmax{0..3,       8..11,     16..19,     24..27,
                             32..35,     40..43,     48..51,     56..59};
    Parameter[4].Mask:=PBSmax{0..7,                  16..23,
                             32..39,                 48..55};
    Parameter[5].Mask:=PBSmax{0..15,
                             32..47};
    Parameter[6].Mask:=PBSmax{0..31};
  ELSE HALT
  END;

  (* Initialisation for procedure Bitsum3 and Bitsum4 *)
  FOR x:=0 TO MAX(byte) DO
    V[x]:=Bitsum0(x);
  END;
END CountBits.


___________________________________________________________________

MODULE Use_CountBits;
(* Written in Modula-2 by Guenter Dotzel, Nov-1992
   GD/23-Jan-1999: 64 bit upward compatible
   http://www.modulaware.com/
*)
IMPORT STextIO, SWholeIO; (* uses ISO M2 Std Lib *)
IMPORT CountBits;

CONST max=1000000;
VAR i,k, r,s: CARDINAL;
  arr: ARRAY [0..max] OF CARDINAL;

  PROCEDURE Random (VAR i: CARDINAL):CARDINAL;
  BEGIN
    i:=69069*i + 1;
    RETURN i;
  END Random;

  PROCEDURE count(k: CARDINAL): CARDINAL;
  VAR a,b,c,d,e,f: CARDINAL;
  BEGIN
    a:=CountBits.Bitsum0(k);
    b:=CountBits.Bitsum1(k);
    c:=CountBits.Bitsum2(k);
    d:=CountBits.Bitsum3(k);
    e:=CountBits.Bitsum4(k);
    f:=CountBits.Bitsum5(k);
    IF (a#b)OR(b#c)OR(c#d)OR(d#e)OR(e#f) THEN HALT END;
    RETURN a;
  END count;

BEGIN
  r:=0; s:=0;
  FOR i:=0 TO max DO
    k:=Random(r);
    arr[i]:=k;
    INC(s,count(k));
    IF i MOD (max DIV 10) = 0 THEN STextIO.WriteChar("."); END;
  END;
  STextIO.WriteString('bit sum = ');
  SWholeIO.WriteInt(s,0);
  STextIO.WriteLn;
  IF (s # CountBits.Bitsum3(arr)) OR (s # CountBits.Bitsum4(arr))
  OR ~ ((SIZE(CARDINAL)=4) & (s=16001986)
     OR (SIZE(CARDINAL)=8) & (s=32007585)) THEN (*self check error*) HALT END;
END Use_CountBits.

___________________________________________________________________

How to count bits in Oberon-2

by Guenter Dotzel, ModulaWare

Let's convert the Modula-2 module CountBits to Oberon-2. In Oberon-2, SYSTEM.LOC is called SYSTEM.BYTE, SYSTEM.CAST is called SYSTEM.VAL and SYSTEM.SHIFT is called SYSTEM.LSH. There is no unqualified import in Oberon-2, but the name of an imported module can be assigned another one in the import list. Unsigned arithmetic is not available in Oberon-2, hence the type CARDINAL of Modula-2 is declared identical to LONGINT. A set (SET) has 32 bits in the Oberon-2 Compiler for OpenVMS Alpha and VAX. The constant, type and variable declarations must precede the procedure declaration section in Oberon-2. The with-statement which syntactically serves as type guard in Oberon-2; hence it must be removed in procedure BitSum. A temporary variable ms is declared locally to keep the current bitmask which is needed two times in the return-expression. Since there is only one type of sets (equivalent to Modula-2's PACKEDSET OF [0..31] in the OpenVMS Alpha and VAX implementation) in Oberon-2, there is no need to specify the set type-name with set constructors. The set constructor type-name has to be removed in the module body. Modula-2's HIGH (openArray) is replaced by LEN (openArray)-1.

Simply replacing ISO Modula-2's SYSTEM.CAST (T, v) by Oberon-2's SYSTEM.VAL (T, v) is dangerous. Both language allow different type size for source v and target T. If the source and target types have different type size then we probably get serious trouble. In ISO Modula-2 the minimum storage units that would be allocated for a variable of type T and for the type of v are copied from the source. If SIZE(T) > SIZE(type_of_v) then the the rest of T is not defined. In fact, most Oberon-2 implementations take exactly SIZE(T) storage locations from the source. This is why a simple replacement of CAST by VAL in procedure BitSum4 will not work. A single byte B[i] is to casted to a 4 byte type; remember, CARDINAL was declared identical to LONGINT. In procedure Bitsum3, we assume that SIZE (CHAR) = SIZE (SYSTEM.BYTE) and in procedure Bitsum4, now SIZE(SHORTINT) = SIZE(BYTE) is required.

___________________________________________________________________

MODULE CountBits;
(* Written in Oberon-2 by Gunter Dotzel, Nov-1992, revised 05-Dec-1992 
   GD/16-Feb-1993: Bitsum5 added
   GD/12-Jun-1994: revised 
   GD/23-Jan-1999: 64 bit upward compatible;
     compiles with ModulaWare's OpenVMS Oberon-2 compiler
     A2O V3 in 64 bit and 32 bit mode

   Copyright (1992-1999) by Gunter Dotzel,
   http://www.modulaware.com
*)
IMPORT s:=SYSTEM;

TYPE PBS=SET; PBSmax=LONGSET;

VAR Parameter: ARRAY 7 OF RECORD
    ShiftCount: INTEGER;
    Mask: PBSmax;
  END;

  MaxBitsPerLongint: LONGINT;
  V3, V4: ARRAY 256 OF LONGINT;
  x: LONGINT;

  PROCEDURE Bitsum0*(B: LONGINT): LONGINT; 
  VAR c, i: LONGINT; pm: PBSmax;
  BEGIN
    c := 0;
    pm := s.VAL(PBSmax, B);
    FOR i := 0 TO MaxBitsPerLongint DO
      IF i IN pm THEN
        INC(c);
      END;
    END;
    RETURN c;
  END Bitsum0;

  PROCEDURE Bitsum1*(B: LONGINT): LONGINT;
  VAR c: LONGINT;
  BEGIN
    c := 0;
    IF SIZE(LONGINT)=4 THEN
      WHILE B # 0 DO
        INC(c);
        B := s.VAL(LONGINT,s.VAL(PBS,B) * s.VAL(PBS,B-1));
      END;
    ELSE
      WHILE B # 0 DO
        INC(c);
        B := s.VAL(LONGINT,s.VAL(PBSmax,B) * s.VAL(PBSmax,B-1));
      END;
    END;
    RETURN c;
  END Bitsum1;

  PROCEDURE Bitsum2*(B: LONGINT): LONGINT;
  (* count the number of bits in a bitstring via decomposition technique, 
     see "Combinatorial Algorithms" [Reingold 1977] *)

    PROCEDURE BitSum(length: LONGINT): LONGINT;
    (* length := LOG2(bit string length)  *)
    VAR bs: s.SIGNED_64; ms: PBSmax;
    BEGIN
      IF length=0 THEN RETURN B; END;
      bs := BitSum(length-1);
      ms:= Parameter[length].Mask;
      RETURN 
         s.VAL(LONGINT, 
          s.VAL(PBSmax, s.LSH(bs, Parameter[length].ShiftCount)) * ms)
        + s.VAL(LONGINT, s.VAL(PBSmax, bs) * ms);
    END BitSum;

  BEGIN
    IF SIZE(LONGINT) = 4 THEN RETURN BitSum(5)
    ELSE RETURN BitSum(6)
    END;
  END Bitsum2;

  PROCEDURE Bitsum3*(VAR B: ARRAY OF s.BYTE): LONGINT;
  VAR i,c: LONGINT;
  BEGIN
    c:=0;
    FOR i:=0 TO LEN(B)-1 DO
    (*INC(c, V3[s.VAL(LONGINT, B[i])]); compiler allows it, 
      but will not work, because B[i..(i+3)] is taken as index! *)
      INC(c, V3[ORD(s.VAL(CHAR, B[i]))]); (* ok! *)
    END;
    RETURN c;
  END Bitsum3;

  PROCEDURE Bitsum4*(VAR B: ARRAY OF s.BYTE): LONGINT;
  VAR i,c: LONGINT;
  BEGIN
    c:=0;
    FOR i:=0 TO LEN(B)-1 DO
    (*INC(c, V4[s.VAL(SHORTINT, B[i])]); not ok 
      (subscript error, byte is converted to signed) *)
    (*INC(c, V4[s.VAL(SHORTINT, B[i])-MIN(SHORTINT)]); not ok 
      (subscript error, still signed byte range) *)
      INC(c, V4[s.VAL(SHORTINT, B[i])-LONG(MIN(SHORTINT))]); (* ok! *)
    END;
    RETURN c;
  END Bitsum4;

  PROCEDURE Bitsum5*(Num : LONGINT): LONGINT;
  VAR Ans: LONGINT; n: s.SIGNED_64;
  BEGIN
    Ans := 0; n:= Num;
    IF n < 0 THEN
      Ans := 1;
      n := s.VAL(LONGINT, s.VAL(LONGSET, n)*LONGSET{0.. SIZE(LONGINT)*8-2});
    END;
    LOOP
      IF n = 0 THEN RETURN Ans
      ELSE
        IF ODD(n) THEN INC(Ans);
        END;
        n := s.VAL(LONGINT, s.LSH(s.VAL(LONGSET,n),-1))
      END
    END
  END Bitsum5;

BEGIN
  MaxBitsPerLongint := SIZE(LONGINT)*8 -1;

  (* Initialisation for procedure Bitsum2 *)
  Parameter[1].ShiftCount:=-1; (* right shift one bit *)
  Parameter[2].ShiftCount:=-2;
  Parameter[3].ShiftCount:=-4;
  Parameter[4].ShiftCount:=-8;
  Parameter[5].ShiftCount:=-16;
  Parameter[6].ShiftCount:=-32;
  IF SIZE(LONGINT) = 4 THEN
    Parameter[1].Mask:=LONGSET{0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30};
    Parameter[2].Mask:=LONGSET{0,1,4,5,8,9, 12,13,16,17,20,21,24,25,28,29};
    Parameter[3].Mask:=LONGSET{0..3,   8..11,     16..19,     24..27};
    Parameter[4].Mask:=LONGSET{0..7, 16..23};
    Parameter[5].Mask:=LONGSET{0..15};
  ELSIF SIZE(LONGINT) = 8 THEN
    Parameter[1].Mask:=LONGSET{0, 2, 4, 6, 8,10,12,14,16,18,20,22,24,26,28,30,
                             32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62};
    Parameter[2].Mask:=LONGSET{0,1,  4,5,  8,9, 12,13,16,17,20,21,24,25,28,29,
                             32,33,36,37,40,41,44,45,48,49,52,53,56,57,60,61};
    Parameter[3].Mask:=LONGSET{0..3,       8..11,     16..19,     24..27,
                             32..35,     40..43,     48..51,     56..59};
    Parameter[4].Mask:=LONGSET{0..7,                  16..23,
                             32..39,                 48..55};
    Parameter[5].Mask:=LONGSET{0..15,
                             32..47};
    Parameter[6].Mask:=LONGSET{0..31};
  ELSE HALT (20)
  END;

  (* Initialisation for procedure Bitsum3 *)
  FOR x:=0 TO LEN(V3)-1 DO
    V3[x]:=Bitsum0(x);
  END;

  (* Initialisation for procedure Bitsum4 *)
  FOR x:=0 TO LEN(V4)-1 DO
    V4[x]:=-1;
  END;
  FOR x:=0 TO LEN(V4)-1 DO
    V4[SHORT(SHORT(x))-LONG(MIN(SHORTINT))]:=Bitsum0(x);
        (* ^compile with range_check=off: $a2o/NoCheck *)
  END;
  FOR x:=0 TO LEN(V4)-1 DO
    IF V4[x]=-1 THEN HALT(21) END;
  END;
END CountBits.
___________________________________________________________________

Because the object file inherits the module key of its symbol file, the Oberon-2 module CountBits has to be compiled a second time after modifying the key of the symbol file. In the case of an existing Oberon-2 symbol file, the Oberon-2 compiler compares the old symbol file with the new one. If the files are the same except for the module key (which holds true for the now modified symbol file), the new symbol file is deleted.

The following is a log of commands to compile the source code, convert the symbol file key, link the objectys and execute the images using different implementations of CountBits listed above. The lines starting with a "$"-character are the VMS-commands which are typed in or contained in a command procedure (you may call it shell script):

___________________________________________________________________

$! mod invokes the Modula-2 compiler
$ mod mli:countbits.def
VAX/VMS Modula-2 MVR V3.23b(C)1992 by ModulaWare GmbH, D-8520 Erlangen/FRG
 compiling _DUB0:[000000.M2LIB]COUNTBITS.DEF;3/DEBUG/NORELATIONAL/NAME_SEPARATOR='.'
Syntax analysis
Declaration analysis
Symbol file generation
End of compilation, source file: _DUB0:[000000.M2LIB]COUNTBITS.DEF;3
$ mod mli:countbits/object=x.obj
VAX/VMS Modula-2 MVR V3.23b(C)1992 by ModulaWare GmbH, D-8520 Erlangen/FRG
 compiling _DUB0:[000000.M2LIB]COUNTBITS.MOD;25/DEBUG/NORELATIONAL/NAME_SEPARATOR='.'
Syntax analysis
 CountBits: _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.SYM;2
Declaration analysis
Body analysis
Code generation
End of compilation, source file: _DUB0:[000000.M2LIB]COUNTBITS.MOD;25
$ mod mli:use_countbits
VAX/VMS Modula-2 MVR V3.23b(C)1992 by ModulaWare GmbH, D-8520 Erlangen/FRG
 compiling _DUB0:[000000.M2LIB]USE_COUNTBITS.MOD;25/DEBUG/NORELATIONAL/NAME_SEPARATOR
='.'
Syntax analysis
 STextIO: _DUB0:[000000.EDISON.ISO]STEXTIO.SYM;1
 SWholeIO: _DUB0:[000000.EDISON.ISO]SWHOLEIO.SYM;1
 CountBits: _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.SYM;2
Declaration analysis
Body analysis
Code generation
End of compilation, source file: _DUB0:[000000.M2LIB]USE_COUNTBITS.MOD;25
$ link use_countbits,x/exe=x.exe
$! h2o invokes the Oberon-2 compiler
$ h2o countbits/nocheck
VAX/VMS Oberon-2 H2O V1.1F(C) 1992 by ModulaWare GmbH, D-8520 Erlangen/FRG
 compiling _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.MOD;42/NOCHECK/DEBUG/LIST/MACHINE_CODE
 CountBits: _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.SYN;8
%H2O-I-OLDSF, No new symbol file generated
%H2O-I-CODGEN, back-end: code generation, with disassembly
%H2O-I-CODAS, code size=    816, data size=        2096
%H2O-I-LISGEN, back-end: Listing generation
End of compilation, source file: _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.MOD;42
$ k2syn :== $oli:k2syn.exe
$ k2syn countbits! modifies countbits.syn
$ h2o countbits
VAX/VMS Oberon-2 H2O V1.1F(C) 1992 by ModulaWare GmbH, D-8520 Erlangen/FRG
 compiling _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.MOD;42/DEBUG/LIST/MACHINE_CODE
 CountBits: _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.SYN;9
%H2O-I-OLDSF, No new symbol file generated
%H2O-I-CODGEN, back-end: code generation, with disassembly
%H2O-I-CODAS, code size=   1504, data size=        2096
%H2O-I-LISGEN, back-end: Listing generation
End of compilation, source file: _DUB0:[EDISON.OBERON2.OLI]COUNTBITS.MOD;42
$ link use_countbits,countbits
$ run x
bit sum =  16001986

___________________________________________________________________

MODULE K2Syn;
(* Inter-language operability utility of the H2O distribution kit: 

   Copies the key value of a Modula2 symbol file into the
   associated Oberon2 symbol file.

   Arguments: 'module-name', passed by command line

   Opens two files: 'module-name'.SYM and 'module-name'.SYN
   and creates a new version of the latter.

   Imports the ISO Modula-2 Standard IO-Library.

   Written in Oberon-2 by Elmar Baumgart, Aug-1992 
*)
IMPORT 
  SF:= SeqFile, 
  PA:= ProgramArgs,
  IOR:= IOResult,
  TIO:= TextIO, 
  BIN:= RawIO,
  ST:= STextIO,
  IOChan;

CONST 
  SYMID1 = 006X;
  SYMID2 = 040X;    (* id of sym file, byte 0 and 1 *)
  SYMID2alt = 004X; (* alternative sym file key     *)
  SYMID2new = 080X; (* new MVR V4 sym file key      *)

  SYNID1 = 0FAX;
  SYNID2 = CHR(22); (* id of syn file, byte 0 and 1 *)

VAR
  modulename, nameSYM, nameSYN: ARRAY 80 OF CHAR;
  M2ext, O2ext: ARRAY 5 OF CHAR;
  reclen, i, j: INTEGER; 
  ID1, ID2, IDsyn1, IDsyn2, LOC, ch: CHAR;

  M2INP, O2INP, OUT: IOChan.ChanId;
  ores: SF.OpenResults;

  KeyLow, KeyHigh: ARRAY 4 OF CHAR;
BEGIN
  M2ext:= '.SYM';
  O2ext:= '.SYN';
  IF PA.IsArgPresent() THEN 
    TIO.ReadToken(PA.ArgChan(), modulename);
    i:= 0;
    ch:= modulename[i];
    WHILE ch # 0X DO
      nameSYM[i]:= ch; nameSYN[i]:= ch; INC(i); ch:= modulename[i];
    END; (* copy module name *)
    FOR j:= 0 TO 3 DO
      nameSYM[i+j]:= M2ext[j]; nameSYN[i+j]:= O2ext[j];
    END; (* add extension *)
    nameSYM[i+4]:= 0X; nameSYN[i+4]:= 0X; (* terminate string *)

    SF.OpenRead(M2INP, nameSYM, SF.read + SF.raw, ores); 
    (*m2: 1 *) BIN.Read(M2INP, ID1);
    (*m2: 2 *) BIN.Read(M2INP, ID2);

    IF (ID1 = SYMID1) & ((ID2 = SYMID2) OR (ID2 = SYMID2alt)
    OR (ID2 = SYMID2new)) THEN
      SF.OpenRead(O2INP, nameSYN, SF.read + SF.raw, ores); 
      (*h2o: 1 *) BIN.Read(O2INP, IDsyn1);
      (*h2o: 2 *) BIN.Read(O2INP, IDsyn2);

      IF (IDsyn1 = SYNID1) & (IDsyn2 = SYNID2) THEN
        SF.OpenWrite(OUT, nameSYN, SF.write + SF.raw, ores);
        BIN.Write(OUT, IDsyn1); (*res: 1 *)
        BIN.Write(OUT, IDsyn2); (*res: 2 *)

        (*m2:  3 -  6 *) BIN.Read(M2INP, KeyLow);  (* skip *)
        (*m2:  7 - 10 *) BIN.Read(M2INP, KeyLow);  (* lower 4 bytes of key *)
        (*m2:      11 *) BIN.Read(M2INP, LOC);     (* skip *)
        (*m2: 12 - 15 *) BIN.Read(M2INP, KeyHigh); (* read rest of key *)
        SF.Close(M2INP);

        BIN.Write(OUT, KeyLow); (*res: 3 -  6 *)
        BIN.Write(OUT, KeyHigh);(*res: 7 - 10 *)

        (*h2o: 3 -  6 *) BIN.Read(O2INP, KeyLow); (* skip *)
        (*h2o: 7 - 10 *) BIN.Read(O2INP, KeyLow); (* skip *)
 
        BIN.Read(O2INP, LOC); (* copy rest *)
        WHILE IOR.ReadResult(O2INP) # IOR.endOfInput DO
          BIN.Write(OUT, LOC);
          BIN.Read(O2INP, LOC);
        END;
        SF.Close(OUT);
        SF.Close(O2INP);
      ELSE
        ST.WriteString('not an Oberon-2 .syn file'); ST.WriteLn;
        SF.Close(O2INP);
      END;
    ELSE
      ST.WriteString('not a Modula-2 .sym file'); ST.WriteLn;
      SF.Close(M2INP);
    END;
  ELSE
    ST.WriteString('command syntax/usage:   k2syn modulename');
    ST.WriteLn;
  END;    
END K2Syn.

IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication: The Editor of The ModulaTor is Guenter Dotzel; he can be reached by tel/fax: [removed due to abuse] or by mailto:[email deleted due to spam]