* 52 27 F R00091 ROWCOL$
        LEX    'ROWCOL2'
        ID     #52
        MSG    0
        POLL   0
        ENTRY  ROWCOL
        CHAR   #F
        KEY    'ROWCOL$'
        TOKEN  #27
        NIBHEX 1FF
        NIBHEX 411
ROWCOL  GOSBVL #0BD38     =POP1S 
        C=0    W          
        LCHEX  10         16 nibs, 8 bytes max?
        ?C>=A  A
        GOYES  R000AF     yes, input parm is 8 bytes or less
        LCHEX  0B         eInvalid Arg (too long)
        GOVLNG #09393     =MFERR 
R000AF  C=C-A  A          # of missing bytes (8 - actual)
        R3=C              save count
        D1=D1- 16         move down to header
        GOSBVL #1A44E     =XXHEAD remove header, set-up R1, D[A] ,D1 for 
        AD1EX             ADHEAD
        C=R3              # of 00/missing bytes
        A=A-C  A          desired start of string
        D1=A              set pointer to start of 8 byte string
        A=DAT1 W          read string
        C=C-1  A          clear the missing bytes
        GOC    R000D9     unless there were none
        P=C    0          set up pointer for clearing
        A=0    WP         clear completed
R000D9  P=     15         loop counter for handling 16 nobs
        LCHEX  7          set-up B[S]= 7 for our byte counter (we do 8 bytes)
        B=C    S          
        C=0    W          clear C[W], our output register
*********************************************
* this is the conversion routine. A=A+A W sets carry if leading bit is set
* if it is set, then set the least significant bit of output byte in C.
* The bits of the original A[15]] go to C[14], C[12]...
* when we are done with the first byte, C=C+C W shifts all output bits to the
* left, and we process byte 2,3,...
*
* let A be as follows:
* '1234 5678 9abc defg hijk lmno pqrs tuvw .....
* on the first pass, C will be:
* '0000 0001 0000 0002 0000 0003 0000 0004 0000 0005 ...
* then, on the second pass:
* '0000 0019 0000 002a 0000 003b 0000 004c 0000 005d ...
* '0000 019h 0000 02ai 0000 03bj 0000 04ck 0000 05dl ... until done 
R000E4  P=     14         # bits remaining
        C=C+C  W          shift output register for next bit
R000E9  A=A+A  W          set carry if if bit set
        GONC   R000F2     leading bit of input is clear, skip
        C=C+1  P          set bit in output register
R000F2  P=P-1             shift to next output byte
        GOC    R000FD     if carry, we just processed nib 0, do next byte
        P=P-1             (two nibs per byte)
        GOTO   R000E9     loop to do next bit in byte
R000FD  B=B-1  S          decrement byte counter
        GONC   R000E4     keep going if not last byte
        DAT1=C W          store output
        P=     0          
        ST=0   0          
        GOVLNG #181B7     =ADHEAD put header on string and exit.
        END