[MI400] decode a string of bits

["Leif Svalgaard" <leif@xxxxxxxx>]

Folks,

just to round off the long discussion we had before Christmas
(Harry's problem), here is the solution based on a table (not
the more theoretical 'trie'):

DCL DD SOURCE CHAR(32000);
DCL DD RESULT(0:32000) BIN(2);

DCL DD RESULT-POS  BIN(4) UNSGND;
    DCL DD RESULT-POSX CHAR(4) DEF(RESULT-POS)   POS(1);

DCL DD SHIFTX      CHAR(4);
    DCL DD SHIFT    BIN(2) UNSGND DEF(SHIFTX)    POS(3);

DCL DD BYTE-POSX   CHAR(4);
    DCL DD BYTE-POS BIN(4) UNSGND DEF(BYTE-POSX) POS(1);

DCL DD BIT-POSX    CHAR(4);
    DCL DD BIT-POS  BIN(4) UNSGND DEF(BIT-POSX)  POS(1);

DCL DD BITS        CHAR(4);
    DCL DD IDX      BIN(2) UNSGND DEF(BITS)      POS(1);

DCL DD ITEM-AREA CHAR(6) INIT(X'0000');
    DCL DD ITEM-LENGTHX CHAR(4) DEF(ITEM-AREA)   POS(1);
    DCL DD ITEM         CHAR(4) DEF(ITEM-AREA)   POS(3);
        DCL DD ITEM-LENGTH  BIN(2) UNSGND DEF(ITEM) POS(1);
        DCL DD ITEM-VALUE   BIN(2) UNSGND DEF(ITEM) POS(3);

ENTRY * EXT;
/*  TEST INPUT:  should line up, use fixed font    */
/*  01  2  3   4   5     6     00017          10     8192   */
/*  10100110010001100010000010111100000000111100001110000...*/
/*  A   6   4   6   2   0   B   C   0   3   C   3   8   0...*/

    CPYBLAP        SOURCE, X'A64620BC03C380', X'00';

/* TEST RESULT SHOULD BE:                                   */
/*        0           1           2           3           4 */
/*        5           6           0           0           0 */
/*       17          10           8192                      */

    CPYNV          BIT-POS, 8; /* START AT CHAR POS 1 */
    CPYBLA         RESULT-POSX, X'00000000'; /* ZERO BASED */

GET-THE-BITS:
    AND            SHIFTX, BIT-POS, X'00000007';
    CPYBTL         BYTE-POS, BIT-POS, 0, 29;
    CPYBTLLS       BITS, SOURCE(BYTE-POS:4), SHIFT;
    CPYBTL         IDX, BITS, 0, 13; /* 13-bit max bit-entry size */
    CPYBLA         ITEM, TABLE(IDX);
    CPYNV          RESULT(RESULT-POS), ITEM-VALUE;
    ADDLC(S)       RESULT-POSX, X'00000001';
    ADDLC(S)       BIT-POSX, ITEM-LENGTHX;
    CMPNV(B)       ITEM-VALUE, 8192/LO(GET-THE-BITS);

DONE:
    BRK "1"; /* LOOK AT 'RESULT' */
    RTX            *;

/* each table entry: 2 char length, 2 char value */
DCL DD TABLE(0:8191) CHAR(4) INIT(
  /*'000D2000' @      0: 0000000000000 -> 8192   */
  /*'000D0013' @      2: 0000000000010 ->   19   */
  /*'000D0014' @      3: 0000000000011 ->   20   */
   X'000D2000',X'000D2000',X'000D0013',X'000D0014',
   X'000D0014',X'000D0014',X'000D0014',X'000D0014',
   X'000D0014',X'000D0014',X'000D0014',X'000D0014',
   X'000D0014',X'000D0014',X'000D0014',X'000D0014',
  /*'000C0010' @     18: 000000001001  ->   16   */
   X'000D0014',X'000D0014',X'000C0010',X'000C0010',
   X'000C0010',X'000C0010',X'000C0010',X'000C0010',
   X'000C0010',X'000C0010',X'000C0010',X'000C0010',
  /*'000C0011' @     30: 000000001111  ->   17   */
   X'000C0010',X'000C0010',X'000C0011',X'000C0011',
  /*'000A000E' @     32: 0000000100    ->   14   */
   X'000A000E',X'000A000E',X'000A000E',X'000A000E',
   X'000A000E',X'000A000E',X'000A000E',X'000A000E',
   X'000A000E',X'000A000E',X'000A000E',X'000A000E',
   X'000A000E',X'000A000E',X'000A000E',X'000A000E',
  /*'000A000F' @     48: 0000000110    ->   15   */
   X'000A000F',X'000A000F',X'000A000F',X'000A000F',
   X'000A000F',X'000A000F',X'000A000F',X'000A000F',
...
   X'000A000F',X'000A000F',X'000A000F',X'000A000F',
   X'000A000F',X'000A000F',X'000A000F',X'000A000F',
   X'000A000F',X'000A000F',X'000A000F',X'000A000F',
  /*'0009000B' @    128: 000001000     ->   11   */
   X'0009000B',X'0009000B',X'0009000B',X'0009000B',
   X'0009000B',X'0009000B',X'0009000B',X'0009000B',
   X'0009000B',X'0009000B',X'0009000B',X'0009000B',
   X'0009000B',X'0009000B',X'0009000B',X'0009000B',
  /*'0009000C' @    144: 000001001     ->   12   */
   X'0009000C',X'0009000C',X'0009000C',X'0009000C',
   X'0009000C',X'0009000C',X'0009000C',X'0009000C',
   X'0009000C',X'0009000C',X'0009000C',X'0009000C',
   X'0009000C',X'0009000C',X'0009000C',X'0009000C',
  /*'0009000D' @    160: 000001010     ->   13   */
   X'0009000D',X'0009000D',X'0009000D',X'0009000D',
   X'0009000D',X'0009000D',X'0009000D',X'0009000D',
...
   X'00030002',X'00030002',X'00030002',X'00030002',
   X'00030002',X'00030002',X'00030002',X'00030002',
  /*'00010000' @   4096: 1             ->    0   */
   X'00010000',X'00010000',X'00010000',X'00010000',
   X'00010000',X'00010000',X'00010000',X'00010000',
   X'00010000',X'00010000',X'00010000',X'00010000',
...
   X'00010000',X'00010000',X'00010000',X'00010000',
   X'00010000',X'00010000',X'00010000',X'00010000');
PEND;

The TABLE is generated from the following input (just
for illustration):

0       1
1       010
2       011
3       0010
4       0011
5       000100
6       000101
7       0000100
8       0000101
9       0000110
10      0000111
11      000001000
12      000001001
13      000001010
14      0000000100
15      0000000110
16      000000001001
17      000000001111
19      0000000000010
20      0000000000011
8192    0000000000000        DONE
        1234567890123

----

The solution is very general and is readily adapted to any table.
The 9 MI-instructions generate an execution path of about 40
RISC-instructions (of which half could be optimized away!) per
decoded value.
On a 400 MHz AS/400, this code decodes about 10 million
result numbers per second, quite respectable with the result
that the bit-decoding is not the bottleneck anymore that Harry
feared.

Leif (home alone, so had time to fiddle...)