*DECK C$U09R1 
          IDENT  C$U09R1
          TITLE  C.U09R1 -  9 DIGIT UNSIGNED NUMERIC DISPLAY TO COMP-1
          COMMENT  9 DIGIT UNSIGNED NUMERIC DISPLAY TO COMP-1 
          SST 
          SPACE  4
**        C.U09R1 -  9 DIGIT UNSIGNED NUMERIC DISPLAY TO COMP-1 
* 
*         X1 = 9 DIGIT UNSIGNED NUMERIC DISPLAY INPUT 
*         RJ     C.U09R1
* 
*         SETS X1 = POSITIVE COMP-1 VALUE 
* 
*         CODING PRIORITIES ARE-
*                1)  BE FAST. 
*                2)  USE FEW X-REGISTERS. 
*                3)  BE SMALL IN SIZE.
* 
*         USES   X  0 1 2 3 4 - - - 
*                A  - - 2 3 4 - - - 
*                B    * - - - - - 7    *B1=1
  
  
          ENTRY  C.U09R1
          IFEQ   OP.MODEL,OP.6400 
 C.U09R1  DATA   0
          MX0    12          77770000000000000000B
          SA2    =XC.ZEROS   10H0000000000
          IX3    X1-X2       REMOVE DISPLAY ZERO BIAS 
          BX1    -X0*X3      KEEP:  0  0 D7 D6 D5 D4 D3 D2 D1 D0
          MX0    -6          00000000000000000077B
          SA2    =XC.CNVRT   00770077007700770077B
          LX3    12          GETS: D7 D6 D5 D4 D3 D2 D1 D0 XX D8
          BX3    -X0*X3      DIGIT: 0  0  0  0  0  0  0  0  0 D8
          SB7    X3          D8 
          BX0    -X2*X1      ODD:   0  0 D7  0 D5  0 D3  0 D1  0
          IX3    X0+X0       ODD DIGITS * 2 
          BX1    X2*X1       EVEN:  0  0  0 D6  0 D4  0 D2  0 D0
          LX0    -3          ODD DIGITS * 8 / 2'6 
          SA2    A2+B1       00007777000077770000B
          LX3    -6          ODD DIGITS * 2 / 2'6 
          IX0    X0+X3       ODD DIGITS *10 / 2'6 
          IX0    X0+X1       10*D7+D6, 10*D5+D4, 10*D3+D2, 10*D1+D0 
          BX3    X2*X0       10*D7+D6,        0, 10*D3+D2,        0 
          BX0    -X2*X0             0, 10*D5+D4,        0, 10*D1+D0 
          LX3    -6          (10*D7+D6, 0, 10*D3+D2, 0) * 64 / 2'12 
          AX1    X3,B1       (10*D7+D6, 0, 10*D3+D2, 0) * 32 / 2'12 
          IX3    X3+X1       (10*D7+D6, 0, 10*D3+D2, 0) * 96 / 2'12 
          LX1    -3          (10*D7+D6, 0, 10*D3+D2, 0) *  4 / 2'12 
          IX3    X3+X1       (10*D7+D6, 0, 10*D3+D2, 0) *100 / 2'12 
          MX2    -24         77777777777700000000B
          IX1    X3+X0       1000*D7+100*D6+10*D5+D4, 1000*D3+ +10*D1+D0
          SX3    B7          D8 
          BX0    X2*X1       1000*D7+100*D6+10*D5+D4, 0 
          SA2    A2+B1       10000/2'24 - 1 
          PX0    X0 
          FX0    X0*X2       -(1000*D7+100*D6+10*D5+D4),
*                            10'7*D7+10'6*D6+10'5*D5+10'4*D4
          UX0    X0,B7
          LX0    X0,B7
          IX1    X1+X0       EVERYTHING CANCELS, LEAVING *IT* 
          SA2    A2+B1       10'8  (INTEGER)
          IX3    X2*X3       10'8*D8
          IX1    X1+X3       ADD 10'8*D8
          EQ     C.U09R1     EXIT 
          ELSE
 C.U09R1  DATA   0
          SA4    =XC.ZERO 
          SA2    =XC.CNVT6   EVEN DIGITS MASK 
          IX0    X1-X4       REMOVE DPC ZERO BIAS 
          SA3    A2+B1       -1+10/2**6 
          PX4    B0,X0       LOW 8 DIGITS (PACKED)
          BX2    -X2*X4      LOW ODD DIGITS (PACKED)
          FX1    X2*X3
          SA3    A3+B1       EVEN SUMS MASK 
          SA2    A3+B1       -1*10**2/2**12 
          AX0    48          TOP DIGIT
          FX4    X4+X1       10*ODD DIGITS + EVEN DIGITS
          BX3    -X3*X4      ODD SUMS (PACKED)
          PX1    B0,X0       PACKED TOP DIGITS
          FX0    X3*X2
          SA2    A2+B1       10**8
          MX3    36          UPPER  DOUBLE SUM MASK 
          DX1    X1*X2       TOP DIGITS * 10**8 
          FX4    X4+X0       DOUBLE SUMS
          SA2    A2+B1       -1+10**4/2**24 
          BX0    X3*X4       UPPER DOUBLE SUMS
          FX4    X4+X1       DOUBLE SUMS + TOP DIGITS * 10**8 
          FX1    X0*X2
          FX1    X4+X1       RESULT 
          UX1    B0,X1
          EQ     C.U09R1
          ENDIF 
  
  
          END 
