*DECK CON6T 
          IDENT  T8.CN6T
          TITLE  ROUTINES CON6T, CONT.. 
 CON6T    TITLE  CONVERSION FROM INTERNAL TO TAPE FORMAT                070420
*                                                                       070430
**    CON6T - CONVERT INTERNAL SOURCE FIELDS TO IBM(TAPE) CODE
*             DESTINATION FIELDS
*                                                                       070450
*         INPUT  -  B1 = 1                                              070460
*                   B6 = RETURN ADDRESS                                 070470
*                                                                       070480
*                T.INREC     POINTER TO CURRENT POSITION IN SOURCE      070490
*                T.OUTREC    POINTER TO CURRENT POSITION IN DESTINATION 070500
*                                                                       070510
*         OUTPUT -  NONE IN REGISTERS                                   070520
*                                                                       070530
*         PRESERVED  --, --, --, --, --, --, --, --                     070540
*                   A0, --, --, --, --, --, --, --                      070550
*                       B1, --, --, --, --, --, --                      070560
*                                                                       070570
*         TEMPORARY CELLS USED..                                        070580
*                                                                       070590
*                T.SAVEB6    SAVES B6 VALUE                             070600
*                T.I1        SOURCE FIELD POINTER                       070610
*                T.I2        DESTINATION FIELD POINTER                  070620
*                                                                       070630
          SPACE  1
*CALL COM2
          SPACE  4                                                      070650
*                                                                       070660
* JUMP VECTOR FOR CONVERSION                                            070670
*                                                                       070680
 CON6T    LETMASK R,(ABCDEINQSUXZ)  LEGAL T1 TYPES
          J      *                                                      070700
          ECHO   1,P=(Z,X,U,S,Q,N,I,E,D,C,B,A)                          070710
          J      CON6T._P                                               070720
*                                                                       070730
          ECHO   4,U=(Z,X,U,S,N,I,E,D,C,B,A)
 CON6T._U  LETMASK R,(BEFGHLPSWX),00B   LEGAL T2 TYPES                  070750
          J      *
          ECHO   1,Q=(X,W,S,P,L,H,G,F,E,B,0)                            070760
          J      CON6T._U_Q                                             070770
*                                                                       070780
 CON6T.Q  LETMASK R,,0       Q CODE                                     070790
          J      *
          J      CON6T.Q0                                               070800
*                                                                       070810
*                                                                       070820
          SPACE  4                                                      070830
*                                                                       070840
* Q CODE (QUIT)                                                         070850
*                                                                       070860
 CON6T.Q0 EQ     CONA..Q     DONE, EXIT CONVERSION                      070870
*                                                                       070880
          SPACE  2                                                      070890
*                                                                       070900
* STRING TYPE CONVERSIONS                                               070910
*                                                                       070920
          SPACE  1                                                      070930
*                                                                       070940
 CON6T.B0 SA5    T.M1        B0 DEFAULTS TO BB                          070950
          BX6    X5                                                     070960
          SA6    T.M2                                                   070970
*                                                                       070980
 CON6T.BB SB5    C6T.1       BIT-BIT                                    070990
          EQ     GSBX        SET UP POINTERS
 C6T.1    SB5    C6T.2                                                  071020
          EQ     GDB
 C6T.2    SA2    T.I2                                                   071030
          SA3    T.SAVEB6                                               071040
          SA1    T.I1                                                   071050
          BX7    X2                                                     071060
          SB6    X3                                                     071070
          AX2    36                                                     071080
          EQ     MVBITS                                                 071090
*                                                                       071100
          SPACE  2                                                      071110
*                                                                       071120
 CON6T.BX SB5    C6T.3       B-X                                        071130
          EQ     GSBX 
 C6T.3    SB5    C6T.4                                                  071150
          EQ     GD8                                                    071160
 C6T.4    SB6    C6T.5       TEST DESTINATION TYPE                      071170
          EQ     TXTEST                                                 071180
 C6T.5    SA5    T.I2        SET UP AND CALL CNA..MV                    071190
          SA4    T.SAVEB6                                               071200
          SA1    T.I1                                                   071210
          SX2    B1          SOURCE SIZE                                071220
          SX3    8           DEST. SIZE                                 071230
          BX7    X5                                                     071240
          SB5    X4                                                     071250
          ZR     B4,C6T.6    JP EBCDIC                                  071260
          SX5    TR.BTOA     ASCII                                      071270
          SX6    ZERO.A                                                 TB8   20
          EQ     CNA..MV                                                071290
 C6T.6    SX5    TR.BTOC     EBCDIC                                     071300
          SX6    ZERO.C                                                 TB8   22
          EQ     CNA..MV                                                071320
*                                                                       071330
          SPACE  2                                                      071340
*                                                                       071350
 CON6T.A0 SB7    B1          DEFAULT FROM A                             071360
 C6T.7    SA5    T.M1                                                   071370
          SB5    C6T.9                                                  071380
          BX7    X5                                                     071390
          SA7    T.M2                                                   071400
          EQ     GSCX        12-BIT SOURCE
*                                                                       071420
 CON6T.C0 SB7    B0          DEFAULT FROM C                             071430
          EQ     C6T.7                                                  071440
*                                                                       071450
 CON6T.AX SB7    B1          A-X                                        071460
 C6T.8    SB5    C6T.9                                                  071470
          EQ     GSCX 
*                                                                       071490
 CON6T.CX SB7    B0          C-X                                        071500
          EQ     C6T.8                                                  071510
*                                                                       071520
 C6T.9    SB5    C6T.10      A/C -X COMMON CODE                         071530
          EQ     GD8                                                    071540
 C6T.10   SB6    C6T.11                                                 071550
          EQ     TXTEST      TEST DESTINATION TYPE                      071560
*                                                                       071570
 C6T.11   SA5    T.I2        CALL CNA..MV                               071580
          SA4    T.SAVEB6                                               071590
          SA1    T.I1                                                   071600
          SX2    SIZE.A      SOURCE                                     071610
          SX3    8           DEST                                       071620
          BX7    X5                                                     071630
          SB5    X4                                                     071640
          NE     B4,B7,C6T.12                                           071650
          SX5    B0          NO CONVERSION                              071660
          ZR     B4,C6T.13   JP EBCDIC                                  071670
          EQ     C6T.15         ASCII                                   071680
 C6T.12   NZ     B4,C6T.14   JP ASCII                                   071690
          SX5    TR.ATOC     EBCDIC                                     071700
 C6T.13   SX6    SPACE.C                                                071710
          EQ     CNA..MV                                                071720
 C6T.14   SX5    TR.CTOA     ASCII                                      071730
 C6T.15   SX6    SPACE.A                                                071740
          EQ     CNA..MV                                                071750
*                                                                       071760
          SPACE  2                                                      071770
*                                                                       071780
 CON6T.X0 SA5    T.M1        X-DEFAULT                                  071790
          BX7    X5                                                     071800
          SA7    T.M2                                                   071810
*                                                                       071820
 CON6T.XX SB5    C6T.16      X-X                                        071830
          EQ     GS6X 
 C6T.16   SB5    C6T.17                                                 071850
          EQ     GD8                                                    071860
 C6T.17   SB6    C6T.18                                                 071870
          EQ     TXTEST                                                 071880
*                                                                       071890
 C6T.18   SA5    T.I2        CALL CNA..MV                               071900
          SA4    T.SAVEB6                                               071910
          SA1    T.I1                                                   071920
          SX2    SIZE.X                                                 071930
          SX3    8                                                      071940
          BX7    X5                                                     071950
          SB5    X4                                                     071960
          ZR     B4,C6T.19   JP EBCDIC                                  071970
          SX5    TR.XTOA     ASCII                                      071980
          SX6    SPACE.A                                                071990
          EQ     CNA..MV                                                072000
 C6T.19   SX5    TR.XTOC     EBCDIC                                     072010
          SX6    SPACE.C                                                072020
          EQ     CNA..MV
*                                                                       072040
          SPACE  2                                                      072050
*                                                                       072060
 CON6T.AB SB7    ZERO.A      A-B                                        072070
 C6T.20   SB5    C6T.21                                                 072080
          EQ     GSCX 
 C6T.21   SB5    C6T.22                                                 072100
          EQ     GDB                                                    072110
 C6T.22   SX5    B7          MOVE TO BIT FIELD                          072120
          SB7    SIZE.A                                                 072130
          EQ     CNA..MB                                                072140
*                                                                       072150
 CON6T.CB SB7    ZERO.C      C-B                                        072160
          EQ     C6T.20                                                 072170
*                                                                       072180
 CON6T.XB SB5    C6T.23      X-B
          EQ     GS6X 
 C6T.23   SB5    C6T.24 
          EQ     GDB                                                    072220
 C6T.24   SX5    ZERO.X 
          SB7    SIZE.X                                                 072240
          EQ     CNA..MB                                                072250
*                                                                       072260
          SPACE  2                                                      072270
*                                                                       072280
* NUMERIC MODE CONVERSIONS                                              072290
*                                                                       072300
 .A       ECHO   ,U=(A,B,C,X),R=(CX,B,CX,6X)
 .B       ECHO   ,Q=(E,F,G,H,L,P,S,W),S=(L,W,G,H,G,8,8,W)               072320
 XXX      SYMBOL                                                        072330
 YYY      SYMBOL                                                        072340
 CON6T._U_Q  SB5   "XXX"       U-Q                                      072350
          EQ     GS_R                                                   072360
 "XXX"    SB5    "YYY"                                                  072370
          EQ     GD_S                                                   072380
 "YYY"    SB5    C6T.._Q                                                072390
          SA1    T.I1                                                   072400
          EQ     CON6._U_.                                              072410
          SPACE  1                                                      072420
 .B       ENDD                                                          072430
 .A       ENDD                                                          072440
*                                                                       072450
          SPACE  2                                                      072460
*                                                                       072470
 .A       ECHO   ,M=(D,E,I,N,S,U,Z),R=(D,E,E,6,6,E,6) 
 .B       ECHO   ,Q=(B,E,F,G,H,L,P,S,W,X),V=(B,L,W,G,H,G,8,8,W,8) 
 XXX      SYMBOL                                                        072500
 YYY      SYMBOL                                                        072510
 CON6T._M_Q  SB5   "XXX"     M-Q
          EQ     GS_R                                                   072530
 "XXX"    SB5    "YYY"                                                  072540
          EQ     GD_V 
 "YYY"    SB5    C6T.._Q                                                072560
          SA1    T.I1                                                   072570
          EQ     CON6._M_.
          SPACE  1                                                      072590
 .B       ENDD                                                          072600
 .A       ENDD                                                          072610
*                                                                       072620
          SPACE  2                                                      072630
*                                                                       072640
* DEFAULT CASES                                                         072650
*                                                                       072660
 .A       ECHO   ,P=(D,E,I,U),R=(L,F,W,F)                               072670
 CON6T._P_0  EQU   CON6T._P_R                                           072680
 .A       ENDD                                                          072690
*                                                                       072700
 .A       ECHO   ,P=(N,S,Z),R=(S,S,X) 
 CON6T._P_0  SA5   T.M1                                                 072720
          BX7    X5                                                     072730
          SA7    T.M2                                                   072740
          EQ     CON6T._P_R                                             072750
          SPACE  1                                                      072760
 .A       ENDD                                                          072770
*                                                                       072780
          SPACE  2                                                      072790
*                                                                       072800
 .A       ECHO   ,Q=(B,E,F,G,H,L,P,S,W,X)                               072810
 C6T.._Q   SA2    T.SAVEB6                                              072820
          SA1    T.I2                                                   072830
          SB5    X2                                                     072840
          EQ     CONT.._Q                                               072850
          SPACE  1                                                      072860
 .A       ENDD                                                          072870
*                                                                       072880
 CONT..   TITLE  CONT.. - CONVERSION ROUTINES FOR TAPE DESTINATION
*                                                                       055190
**    CONT.. - A SERIES OF ROUTINES TO PERFORM NUMERIC CONVERSIONS
*        TO IBM 360/370 TAPE FORM                                       055210
*                                                                       055220
*         INPUT  -  B1 = 1                                              055230
*                   X1 = DESTINATION POINTER                            055240
*                   B5 = RETURN ADDRESS                                 055250
*                                                                       055260
*         OUTPUT -  NONE IN REGISTERS                                   055270
*                                                                       055280
*         PRESERVED  --, --, --, --, --, --, --, --                     055290
*                    A0, --, --, --, --, --, --, --                     055300
*                        B1, --, --, --, --, --, --                     055310
*                                                                       055320
*         TEMPORARY CELLS USED..                                        055330
*                                                                       055340
*                T.NUM,+1,+2    SOURCE, A TRIPLE PRECISION NUMBER       055350
*                T.TEMP1     TEMPORARY                                  055360
*                T.TEMP2     TEMPORARY                                  055370
*                T.TEMP3     TEMPORARY                                  055380
*                                                                       055390
*         NOTES..   THE ROUTINES THAT FOLLOW ARE NAMED -CONT..Q-,       055400
*                 WHERE -Q- IS A VALID DESTINATION TYPE FOR TAPE (IBM)  055410
*                 FIELDS (B,X,H,W,G,F,L,E,P,S).                         055420
*                                                                       055430
          SPACE  4                                                      055450
*                                                                       055460
* BIT FIELDS                                                            055470
*                                                                       055480
 CONT..B  SB4    B1          FLAG TWO-S COMPLEMENT                      055490
          EQ     CONA..B                                                055500
*                                                                       055510
          SPACE  2                                                      055520
*                                                                       055530
* X FIELDS                                                              055540
*                                                                       055550
 CONT..X  SB6    CNT.1       DETERMINE CODE TYPE                        055560
          EQ     TXTEST                                                 055570
 CNT.1    SX6    8           CHAR SIZE (BITS)                           055580
          ZR     B4,CONA..C  JP EBCDIC                                  055590
          EQ     CONA..A     JP ASCII                                   055600
*                                                                       055610
          SPACE  2                                                      055620
*                                                                       055630
* H, W, G  (INTEGER) FIELDS                                             055640
*                                                                       055650
 CONT..H  SB6    CNT.2       H (16 BIT) FIELD                           055660
          EQ     CONA.RN                                                055670
 CNT.2    SB2    16                                                     055680
*                                                                       055690
 CNT.3    OR     X1,CNT.E1   COMMON TO H,W                              055700
          ID     X1,CNT.E2
          UX6    X1,B3
          ZR     X1,CNT.4                                               055730
          SB4    B2-48-1     MAX EXPONENT                               055740
          GT     B3,B4,CNT.E3  VALUE TOO LARGE                          055750
          LX6    X6,B3       INTEGERIZE                                 055760
          PL     X6,CNT.4                                               055770
          SX0    B1          ADJUST IF NEGATIVE                         055780
          IX6    X6+X0                                                  055790
          NG     X6,CNT.4                                               055800
          MX6    60          -1                                         055810
 CNT.4    SA1    T.TEMP1                                                055820
          SX2    B2                                                     055830
          SB6    B5                                                     055840
          EQ     STBITS      STORE                                      055850
*                                                                       055860
*                                                                       055870
 CONT..W  SB6    CNT.5       W (32 BIT) FIELD                           055880
          EQ     CONA.RN                                                055890
 CNT.5    SB2    32                                                     055900
          EQ     CNT.3                                                  055910
*                                                                       055920
*                                                                       055930
 CONT..G  SB6    CNT.6       G (64 BIT) FIELD                           055940
          EQ     CONA.RN                                                055950
 CNT.6    PL     X1,CNT.9                                               055960
          SB2    TEN.ONE     ADJUST IF NEGATIVE 
          SB6    CNT.7                                                  055980
          EQ     T3=ADD1                                                055990
 CNT.7    NG     X1,CNT.9                                               056000
          SX2    32          RESULT IS -1, SET ALL 7-S                  056010
          SB6    CNT.8                                                  056020
          SA1    T.TEMP1                                                056030
          MX6    60                                                     056040
          EQ     STBITS                                                 056050
 CNT.8    SB6    B5                                                     056060
          EQ     STBITS                                                 056070
*                                                                       056080
 CNT.9    OR     X1,CNT.E1   ADJUSTED INTEGER IN X1,X2
          ID     X1,CNT.E2
          UX6    X1,B3
          SA1    T.TEMP1                                                056120
          SB4    64-48-1                                                056130
          GT     B3,B4,CNT.E3   VALUE TOO LARGE FOR FIELD               056140
          GT     B3,B0,CNT.11  JP MORE THAN 48 BITS IN RESULT           056150
          LX5    X6,B3
          AX6    59          LEADING SIGN                               056170
          SX2    16                                                     056180
          SB6    CNT.10                                                 056190
          EQ     STBITS      STORE 16 SIGN BITS                         056200
 CNT.10   BX6    X5                                                     056210
          SB6    B5                                                     056220
          SX2    48                                                     056230
          EQ     STBITS      STORE 48 DATA BITS                         056240
*                                                                       056250
 CNT.11   BX5    X2                                                     056260
          SA6    A1          SAVE FIRST 48 BITS                         056270
          SX2    B3-64+48                                               0001   5
          SB6    CNT.12                                                 056290
          AX6    59          SIGN                                       056300
          BX2    -X2         NUM LEADING SIGN BITS                      0001   7
          NZ     X2,STBITS                                              056310
 CNT.12   SA3    A1          48 BITS                                    056320
          SX2    48                                                     056330
          SB6    CNT.13                                                 056340
          BX6    X3                                                     056350
          EQ     STBITS                                                 056360
 CNT.13   UX6    X5,B2       PICK UP LAST BITS                          056370
          SB6    B5                                                     056380
          SX2    48+B2                                                  056390
          LX6    X6,B2                                                  056400
          EQ     STBITS                                                 056410
*                                                                       056420
          SPACE  2                                                      056430
*                                                                       056440
* F, L, E  (FLOATING) FIELDS                                            056450
*                                                                       056460
 CONT..F  SX6    32-8        F (32 BIT) VALUE                           056470
          EQ     CNT.14                                                 056480
*                                                                       056490
 CONT..L  SX6    64-8        L (64 BIT) VALUE                           056500
          EQ     CNT.14                                                 056510
*                                                                       056520
 CONT..E  SX6    64-8+64-8   E (128 BIT) VALUE                          056530
*                                                                       056540
*                                                                       056550
 CNT.14   BX7    X1                                                     056560
          SA1    T.NUM       GET NUMBER                                 056570
          SA2    A1+B1                                                  056580
          SA7    T.TEMP1     SAVE POINTER                               056590
          SA6    T.TEMP2     SAVE SIZE                                  056600
          OR     X1,CNT.E4    JP ON RANGE ERRORS                        056610
          ID     X1,CNT.E5
          ZR     X1,CNT.25    JP IF VALUE ZERO                          056630
          UX5    X1,B4       ADJUST (DENORMALIZE) TO HEX BOUNDARY 
          MX0    58                                                     056650
          SB2    T.TEMP3                                                056660
          SX5    B4+2000B 
          SB6    CNT.15                                                 056680
          BX5    -X0*X5                                                 056690
          SA3    A2+B1                                                  0006  12
          ZR     X5,CNT.15   ALREADY ON BOUNDARY                        056700
          SB3    X5-4                                                   056710
          SB4    B4-B3                                                  056720
          SX7    B0                                                     056730
          PX7    X7,B4                                                  056750
          SA7    B2                                                     056760
          EQ     T3=ADD1                                                056770
*                                                                       056780
 CNT.15   SA4    T.TEMP2     ROUND TO PROPER NUMBER OF BITS             056790
          UX0    X1,B3
          SX7    B1                                                     056810
          SB4    X4-47                                                  056820
          SB3    B3-B4       EXPONENT OF ROUNDING BIT                   056830
          PX7    X7,B3                                                  056840
          SX6    B3                                                     056850
          NX7    X7                                                     056860
          SB6    CNT.16                                                 056870
          AX6    10 
          PL     X1,CNT.15A 
          BX7    -X7         NEGATIVE ROUND 
 CNT.15A  BSS    0
          SA7    B2                                                     056890
          ZR     X6,T3=ADD1  DON-T ADD IN UNDERFLOW CASE                056900
*                                                                       056910
 CNT.16   ZR     X1,CNT.25   ADJUST TO HEX BOUNDARY                     056920
          UX5    X1,B4
          MX0    58                                                     056940
          SX5    B4+2000B 
          SB6    CNT.17                                                 056960
          BX5    -X0*X5                                                 056970
          ZR     X5,CNT.17   ALREADY ON BOUNDARY                        056980
          SB3    X5-4                                                   056990
          SB4    B4-B3                                                  057000
          SX7    B0                                                     057010
          PX7    X7,B4                                                  057020
          SA7    B2                                                     057030
          EQ     T3=ADD1                                                057040
*                                                                       057050
 CNT.17   UX4    X1,B4       DE-NORMALIZED (TO HEX) RESULT READY TO GO
          MX0    1            GET HEXPONENT                             057070
          SX5    B4                                                     057080
          BX0    X0*X1       SIGN BIT                                   057090
          AX5    2                                                      057100
          SX5    X5+64+48/4  OFFSET EXPONENT
          LX0    8                                                      057120
          BX6    X5                                                     057130
          NG     X5,CNT.25   UNDERFLOW, USE ZERO VALUE                  057140
          AX6    7                                                      057150
          IX5    X5+X0                                                  057160
          NZ     X6,CNT.E6   OVERFLOW, FLAG ERROR                       057170
          AX4    59          SIGN EXTENDED                              057180
          BX6    X1-X4       SAVE ABSOLUTE VALUE FOR LATER PICKUP       057190
          SA6    T.NUM                                                  057200
          BX7    X2-X4                                                  057210
          SA7    A6+B1                                                  057220
          BX6    X3-X4                                                  057230
          SA6    A7+B1                                                  057240
          SX2    8           SET UP TO STORE SIGN AND EXPONENT          057250
          SB6    CNT.18                                                 057260
          BX6    X5                                                     057270
          SA1    T.TEMP1                                                057280
          SA6    T.TEMP3     SAVE IN CASE -E- TYPE                      057290
          EQ     STBITS                                                 057300
*                                                                       057310
 CNT.18   SA5    T.TEMP2     SIZE OF FIELD                              057320
          SX2    32-8                                                   057330
          SA3    T.NUM                                                  057340
          IX0    X2-X5                                                  057350
          NG     X0,CNT.19   JP L OR E                                  057360
          BX6    X3 
          SB6    B5          RETURN                                     057380
          AX6    48-24       GET 32-8 BITS TO STORE 
          EQ     STBITS                                                 057400
*                                                                       057410
 CNT.19   SA4    A3+B1       STORE 64-8 BITS                            057420
          MX0    60-8                                                   057430
          SX2    64-8                                                   057440
          LX3    8                                                      057450
          BX6    X0*X3                                                  057460
          LX4    12+8                                                   057470
          BX4    -X0*X4 
          SB6    CNT.20                                                 057490
          BX6    X4+X6                                                  057500
          EQ     STBITS                                                 057510
*                                                                       057520
 CNT.20   IX2    X2-X5                                                  057530
          PL     X2,CNT.28   RETURN ID TYPE = L                         057540
          SA3    T.TEMP3     TYPE E, GET LOWER 64 BITS                  057550
          SX2    8                                                      057560
          SX6    X3-14       LOWER EXPONENT                             057570
          SB6    CNT.21                                                 057580
          PL     X6,STBITS                                              057590
          SX6    X6+128      FIX UP LOWER UNDERFLOW TO STANDARD FORM    057600
          EQ     STBITS                                                 057610
*                                                                       057620
 CNT.21   SA4    T.NUM+1     STORE LOWER 56 BITS OF MANTISSA            057630
          SA5    A4+B1                                                  057640
          MX0    60-16                                                  057650
          LX4    16                                                     057660
          BX6    X0*X4                                                  057670
          LX5    12+16                                                  057680
          BX5    -X0*X5                                                 057690
          SX2    64-8                                                   057700
          SB6    B5                                                     057710
          BX6    X5+X6       INSERT LAST 16 BITS                        0009   5
          EQ     STBITS                                                 057720
*                                                                       057730
 CNT.25   SA5    T.TEMP2     FILL OUT ZERO FIELDS                       057740
          SA1    T.TEMP1                                                057750
          SX6    B0                                                     057760
          BX0    X5                                                     057770
          SB6    CNT.27                                                 057780
          SX5    X5+8        ADD 8 EXPONENT BITS                        057790
          AX0    6           CHECK FOR MORE THAN 64 BITS                057800
          ZR     X0,CNT.26                                              057810
          SX5    X5+8        YES, ADD 8 MORE EXPONENT BITS              057820
 CNT.26   SX2    60                                                     057830
 CNT.27   ZR     X5,CNT.28   RETURN IF DONE                             057840
          IX5    X5-X2                                                  057850
          PL     X5,STBITS   STORE 60 BITS                              057860
          IX2    X5+X2       STORE LESS THAN 60 BITS                    057870
          SX5    B0                                                     057880
          EQ     STBITS                                                 057890
*                                                                       057900
 CNT.28   JP     B5          RETURN                                     057910
*                                                                       057920
*                                                                       057930
          SPACE  2                                                      057940
*                                                                       057950
* P AND S  TYPES                                                        057960
*                                                                       057970
 CONT..P  SA2    T.M2        ADJUST FOR 4-BIT BYTES (P-TYPE)            057980
          SB7    CNT.31                                                 057990
          SX6    -B1         =-1                                        058000
          LX2    1                                                      058010
          IX6    X2+X6                                                  058020
          SA6    A2          2M-1                                       058030
          EQ     CNT.30                                                 058040
*                                                                       058050
 CONT..S  SB7    CNT.32      S-TYPE                                     058060
*                                                                       058070
 CNT.30   SA2    T.NUM       CONVERT TO INTEGER STRING                  058080
          BX7    X1                                                     058090
          SX6    B1          FORCE INTEGER                              058100
          OR     X2,CNT.E7   INFINITE                                   058110
          ID     X2,CNT.E8   INDEFINITE 
          SA7    T.TEMP1                                                058130
          SA6    T.I2                                                   058140
          EQ     ECON                                                   058150
*                                                                       058160
*                                                                       058170
 CNT.31   SB7    CNT.36      P, BLANK FILL                              058180
          SX2    4                                                      058190
          EQ     CNT.33                                                 058200
*                                                                       058210
 CNT.32   SB7    CNT.37      S, BLANK FILL                              058220
          SX2    8                                                      058230
*                                                                       058240
 CNT.33   SB6    CNT.34                                                 058250
          SX6    X2 
          SA6    T.TEMP2     CHR SZ-DEST. 
          EQ     TXTEST      GET SOURCE CODE FLAG                       058260
 CNT.34   SA1    T.TEMP                                                 058270
          SX6    ZERO.C      EBCDIC                                     058280
          ZR     B4,CNT.35                                              058290
          SX6    ZERO.A      ASCII                                      058300
 CNT.35   SX7    B4                                                     058310
          SA5    T.NBL       NUMBER TO FILL                             058320
          SA7    T.TEMP3     SAVE SOURCE CODE FLAG                      058330
          NZ     X5,CONA.BL  FILL                                       058340
          SA1    T.TEMP1
          BX7    X1 
          JP     B7          NONE TO FILL, JUST QUICK RETURN            058350
*                                                                       058360
*                                                                       058370
 CNT.36   SX3    4           P, MOVE THE NUMBER IN                      058380
          SB6    CNT.40                                                 058390
          EQ     CNT.38                                                 058400
*                                                                       058410
 CNT.37   SX3    6           S, MOVE ALL BUT ONE DIGIT
          SA1    T.SPTR 
          LX3    36 
          BX2    X7          SAVE X7
          IX7    X1-X3       MOVE ALL BUT LAST CHR FROM SOURCE
          SA7    T.SPTR 
          BX7    X2          RESTORE X7 
          SX3    8           SINK CHR SIZE
          SB6    CNT.42                                                 058430
*                                                                       058440
 CNT.38   LX3    36          MOVE ALL BUT ONE CHARACTER                 058450
          SX2    SIZE.X                                                 058460
          IX7    X7-X3                                                  058470
          SA5    T.TEMP3                                                058480
          LX3    60-36                                                  058490
          SB7    B5          SAVE EVENTUAL RETURN                       058500
          SA1    T.SPTR 
          SB5    B6                                                     058510
          ZR     X5,CNT.39   JP EBCDIC                                  058520
          SX5    TR.XTOA     ASCII                                      058530
          EQ     CNA..MV                                                058540
 CNT.39   SX5    TR.XTOC     EBCDIC                                     058550
          EQ     CNA..MV                                                058560
*                                                                       058570
*                                                                       058580
 CNT.40   SA3    T.MSG       P, FILL SIGN AND RESTORE M2                058590
          SA4    T.TEMP3                                                058600
          SX2    B1                                                     058610
          SB2    B0          0 = +                                      058620
          LX2    2+36        =4S36                                      058630
          ZR     X3,CNT.41                                              058640
          SB2    B1+B1       2 = -                                      058650
 CNT.41   SB3    X4+CNT.SGN                                             058660
          IX1    X2+X7       DESTINATION POINTER                        058670
          SA5    B3+B2       PREFERRED SIGN                             058680
          LX2    60-36       =4, CHARACTER SIZE                         058690
          SB6    B7          RETURN ADDRESS                             058700
          SA4    T.M2        FIX UP M IN CASE THIS IS A MULTIPLE FIELD  058710
          SX7    B1                                                     058720
          SX6    X5                                                     058730
          IX7    X4+X7       M=((2*M-1)+1)/2
          AX7    1                                                      058750
          SA7    A4                                                     058760
          EQ     STBITS                                                 058770
*                                                                       058780
 CNT.42   SA1    T.TEMP1     SOURCE PTR 
          SA7    A1          SAVE DESTIN PTR. 
          SX3    6
          SX2    6
          LX3    36 
          IX1    X3+X1       TO PICK UP LAST DIGIT
          SB6    CNT.42A
          EQ     NXBITS 
 CNT.42A  ZR     X5,CNT.42B  JP NO TRANSLATION
          SA3    X5                                                     066410
          SB4    X6                                                     066420
          SA4    X3+B4       CHAR + BASE                                066430
          AX3    18                                                     066440
          SB4    X3                                                     066450
          AX6    X4,B4       SHIFT TO LOW END                           066460
          AX3    18                                                     066470
          BX6    X6*X3       AND MASK OFF                               066480
          LX5    60-18       LOOK FOR SECOND CONVERSION                 066490
          SB4    X5                                                     066500
          ZR     B4,CNT.42B     JUMP NO 2ND CONVERSION
          SA3    X5          CONVERT                                    066520
          SB4    X6                                                     066530
          SA4    X3+B4       CHAR+BASE                                  066540
          AX3    18                                                     066550
          SB4    X3                                                     066560
          AX6    X4,B4       SHIFT TO LOW END                           066570
          AX3    18                                                     066580
          BX6    X6*X3       AND MASK OFF                               066590
 CNT.42B  SA3    T.MSG       SIGN 
          SA1    T.TEMP1     SINK PTR 
          BX7    X1 
          SA4    T.TEMP3       CHAR IS IN X6                            058800
          SX2    B1                                                     058810
          SB2    B0          0 = +                                      058820
          LX2    3+36        =8S36                                      058830
          ZR     X3,CNT.43                                              058840
          SB2    B1+B1       2 = -                                      058850
 CNT.43   SB3    X4+CNT.SGN                                             058860
          IX1    X2+X7       DESTINATION POINTER                        058870
          SA5    B3+B2       PREFERRED CHARACTER                        058880
          LX2    60-36       =8, CHARACTER SIZE                         058890
          SB6    B7          RETURN ADDRESS                             058900
          MX0    60-4                                                   058910
          LX5    4                                                      058920
          BX6    -X0*X6                                                 058930
          IX6    X6+X5       SIGNED DIGIT                               058940
          EQ     STBITS                                                 058950
*                                                                       058960
*                                                                       058970
          SPACE  2                                                      058980
*                                                                       058990
* DATA AREA, PREFERRED SIGN CODES                                       059000
*                                                                       059010
 CNT.SGN  DATA   14B,12B,15B,13B   +EBCDIC, +ASCII, -EBCDIC, -ASCII     059020
          SPACE  2                                                      059030
**    ERROR ACTIONS 
*                                                                       059060
 CNT.E1   SA2    CNT.M1      VALUE INFINITE (INTEGER)                   059070
          EQ     ERR.CON                                                059080
 CNT.E2   SA2    CNT.M2      VALUE INDEFINITE (INTEGER)                 059090
          EQ     ERR.CON                                                059100
 CNT.E3   SA2    CNT.M3      FIELD OVERFLOW (INTEGER)                   059110
          EQ     ERR.CON                                                059120
 CNT.E4   EQU    CNT.E1      VALUE INFINITE (REAL)                      059130
 CNT.E5   EQU    CNT.E2      VALUE INDEFINITE (REAL)                    059140
 CNT.E6   SA2    CNT.M6      EXPONENT OVERFLOW (REAL)                   059150
          EQ     ERR.CON                                                059160
 CNT.E7   EQU    CNT.E1      VALUE INFINITE (P,S)                       059170
 CNT.E8   EQU    CNT.E2      VALUE INDEFINITE (P,S)                     059180
****
*                                                                       059190
 CNT.M1   VFD    12/0,18/E.CON,12/0,18/*+1
          DATA    C/INFINITE SOURCE VALUE NOT REPRESENTABLE/            059210
 CNT.M2   VFD    12/0,18/E.CON,12/0,18/*+1
          DATA    C/INDEFINITE SOURCE VALUE NOT REPRESENTABLE/          059230
 CNT.M3   VFD    12/0,18/E.CON,12/0,18/*+1
          DATA    C/INTEGER VALUE TOO LARGE FOR FIELD/                  059250
 CNT.M6   VFD    12/0,18/E.CON,12/0,18/*+1
          DATA    C/SOURCE EXPONENT TOO LARGE, NOT REPRESENTABLE/       059270
****
          END 
