*DECK CONT
          IDENT  T8.CNT 
          TITLE  ROUTINES CONT, NXDIGP, NXTNMA
 CONT     TITLE  CONT - IBM/370 SOURCE CONVERSIONS                      004540
*                                                                       004550
**    CONT - ROUTINES TO PICK UP IBM SOURCE FIELDS (NUMERIC MODE) 
*                                                                       004570
*         INPUT  -  B1 = 1                                              004580
*                   X1 = SOURCE POINTER                                 004590
*                   B5 = RETURN ADDRESS                                 004600
*                                                                       004610
*         OUTPUT -  NONE IN REGISTERS                                   004620
*                                                                       004630
*         PRESERVED  --, --, --, --, --, --, --, --                     004640
*                    A0, --, --, --, --, --, --, --                     004650
*                        B1, --, --, --, B5, B6, B7                     004660
*                                                                       004670
*         TEMPORARY CELLS USED..                                        004680
*                                                                       004690
*                T.NUM,+1,+2    RESULT, A TRIPLE PRECISION NUMBER       004700
*                T.TEMP1     TEMPORARY                                  004710
*                                                                       004720
*         NOTES..   THE ROUTINES THAT FOLLOW ARE NAMED -CONT.Q.-,       004730
*                 WHERE -Q- IS A VALID SOURCE TYPE FOR IBM/8-BIT FIELDS 004740
*                 (B,X,H,W,G,F,L,E,P,S).                                004750
*                                                                       004760
*                   THESE ROUTINES ARE FOR NUMERIC PICKUP ONLY, AND     004770
*                LEAVE A TRIPLE PRECISION REAL NUMBER IN T.NUM.         004780
*                                                                       004790
          SPACE  1
*CALL COM2
          SPACE  4                                                      004810
*                                                                       004880
* CHARACTER FIELDS                                                      004890
*                                                                       004900
 CONT.X.  SX6    B6          GET CHARACTER SET TYPE                     004910
          SB6    CONT.0                                                 004920
          EQ     TXTEST                                                 004930
 CONT.0   SB6    X6                                                     004940
          NZ     B4,CONT.01                                             004950
          SB4    NXTNMC      EBCDIC                                     004960
          EQ     CONA.X                                                 004970
 CONT.01  SB4    NXTNMA      ASCII                                      004980
          EQ     CONA.X                                                 004990
*                                                                       005000
          SPACE  2                                                      005010
*                                                                       005020
* H FIELDS  (16 BIT INTEGERS)                                           005030
*                                                                       005040
 CONT.H.  SX5    B6          GET -H- ITEM                               005050
          SX2    16                                                     005060
          SB6    CONT.1                                                 005070
          EQ     NXBITS                                                 005080
*                                                                       005090
 CONT.1   LX6    60-16       EXTEND SIGN                                005100
          SX7    5                                                      005110
          AX6    60-16                                                  005120
 CONT.2   MX0    59          -1                                         005130
          PL     X6,CONT.3                                              005140
          IX6    X0+X6       CHANGE 2-S COMP TO 1-S COMP                005150
 CONT.3   SB6    X5                                                     005160
          SA7    T.P                                                    005170
          PX6    X6,B0                                                  005180
          SX7    B0                                                     005190
          NX6    X6                                                     005200
          SA6    T.NUM                                                  005210
          DX7    X6+X7                                                  005220
          SA7    A6+B1                                                  005230
          DX6    X7+X7                                                  005240
          SA6    A7+B1                                                  005250
          JP     B5          EXIT                                       005260
*                                                                       005270
          SPACE  2                                                      005280
*                                                                       005290
* W FIELDS  (32 BIT INTEGERS)                                           005300
*                                                                       005310
 CONT.W.  SX5    B6          GET -W- ITEM                               005320
          SX2    32                                                     005330
          SB6    CONT.4                                                 005340
          EQ     NXBITS                                                 005350
*                                                                       005360
 CONT.4   LX6    60-32       EXTEND SIGN                                005370
          SX7    10                                                     005380
          AX6    60-32                                                  005390
          EQ     CONT.2      JOIN -H-                                   005400
*                                                                       005410
          SPACE  2                                                      005420
*                                                                       005430
* G FIELDS  (LONG INTEGERS -64 BITS)                                    005440
*                                                                       005450
 CONT.G.  SX5    B6          GET -G- ITEM                               005460
          SX2    32                                                     005470
          SB6    CONT.5                                                 005480
          EQ     NXBITS      GET FIRST 32 BITS                          005490
*                                                                       005500
 CONT.5   SA6    T.NUM       SAVE                                       005510
          SB6    CONT.6                                                 005520
          EQ     NXBITS      GET NEXT 32 BITS                           005530
*                                                                       005540
 CONT.6   SA4    T.NUM       FIRST 32                                   005550
          SB6    X5                                                     005560
          MX0    60-32       FOR SIGN EXTENSION                         005570
          SB4    32          EXPONENT FOR HIGH PART                     005580
          LX4    60-32                                                  005590
          AX4    60-32                                                  005600
          BX0    X0*X4       SIGN                                       005610
          PX4    X4,B4                                                  005620
          BX6    X0+X6       SIGN ON LOW BITS                           005630
          PL     X4,CONT.7                                              005640
          SX7    B1          -, CHANGE 2-S COMP TO 1-S COMP             005650
          IX6    X6-X7                                                  005660
 CONT.7   NX4    X4                                                     005670
          PX6    X6,B0                                                  005680
          SX7    19                                                     005690
          NX6    X6                                                     005700
          SA7    T.P                                                    005710
          FX7    X4+X6                                                  005720
          SA7    A4          (T.NUM)                                    005730
          DX6    X4+X6                                                  005740
          SA6    A7+B1                                                  005750
          SX4    B0                                                     005760
          DX7    X6+X4                                                  005770
          SA7    A6+B1                                                  005780
          JP     B5          EXIT                                       005790
*                                                                       005800
          SPACE  2                                                      005810
*                                                                       005820
* F,L,E  ITEMS (FLOATING POINT)                                         005830
*                                                                       005840
 CONT.F.  SX5    32-8-32+8   GET -F- ITEM                               005850
          SX7    8                                                      005860
          EQ     CONT.8                                                 005870
*                                                                       005880
 CONT.L.  SX5    64-8-32+8   GET -L- ITEM                               005890
          SX7    17                                                     005900
          EQ     CONT.8                                                 005910
*                                                                       005920
 CONT.E.  SX5    128-8-32+8  GET -E- ITEM                               005930
          SX7    34                                                     005940
*                                                                       005950
 CONT.8   SA7    T.P                                                    005960
          SB7    B6 
          SX2    8
          SB6    CONT.9 
          EQ     NXBITS      PICK UP SIGN AND EXPONENT
* 
 CONT.9   BX7    X6 
          MX0    60-7 
          LX7    52          LEFT JUSTIFY SIGN
          BX6    -X0*X6      EXPONENT (HEX) 
          AX7    60          SIGN 
          SX6    X6-64-48/4 
          LX6    2           6000 EXPONENT (BINARY) 
          SB4    X6 
          PX7    X7,B4       SET UP MATRIX FOR VALUE
          SA7    T.NUM
          SB4    B4-48
          PX6    X7,B4
          SA6    A7+B1
          SB4    B4-48
          PX7    X7,B4
          SA7    A6+B1
* 
          SX2    32-8        PICK UP FIRST PART OF MANTISSA 
          SB6    CONT.10
          EQ     NXBITS 
* 
 CONT.10  SA4    T.NUM
          LX6    48-32+8
          SX2    32 
          BX6    X6-X4
          IX5    X5-X2
          SA6    A4 
          NG     X5,CONT.14  DONE 
          SB6    CONT.11     PICK UP SECOND PART OF MANTISSA
          EQ     NXBITS 
* 
 CONT.11  SA3    A4 
          MX0    60-8 
          SA4    A4+B1
          BX0    -X0*X6 
          AX6    8
          SX2    8
          BX6    X3-X6
          LX0    48-8 
          SA6    A3 
          BX7    X4-X0
          IX5    X5-X2
          SA7    A4 
          NG     X5,CONT.14  DONE 
          SB6    CONT.12     PICK UP REMAINDER OF MANTISSA
          EQ     NXBITS      -SKIP LOW ORDER EXPONENT-
* 
 CONT.12  SX2    64-8 
          SB6    CONT.13
          EQ     NXBITS 
* 
 CONT.13  SA3    A4 
          MX0    60-16
          SA4    A4+B1
          BX0    -X0*X6 
          AX6    16 
          BX6    X3-X6
          LX0    48-16
          SA6    A3 
          BX7    X4-X0
          SA7    A4 
* 
 CONT.14  SA1    T.NUM       NORMALIZE NUMBER 
          SA2    A1+B1
          SA3    A2+B1
          SB6    B7          RESTORE B6 
          NX2    X2 
          NX3    X3 
          FX0    X2+X3
          NX1    X1 
          FX6    X1+X0
          SA6    A1 
          DX3    X2+X3
          DX1    X1+X0
          FX7    X1+X3
          SA7    A2 
          DX6    X1+X3
          SA6    A3 
          JP     B5          EXIT                                       006680
*                                                                       006690
          SPACE  2                                                      006700
*                                                                       006710
*  P ITEMS (PACKED DECIMAL) AND  S ITEMS (SIGNED NUMERIC)               006720
*                                                                       006730
 CONT.P.  SB4    NXDIGP      GET -P- ITEM                               006740
          SA5    T.M1                                                   006750
          SX6    -B1                                                    006760
          LX5    1                                                      006770
          IX5    X5+X6       2M-1 
          EQ     CONT.15                                                006790
*                                                                       006800
 CONT.S.  SB4    NXDIGS      GET -S- ITEM                               006810
          SA5    T.M1                                                   006820
*                                                                       006830
 CONT.15  BX7    X5                                                     006840
          SA7    T.P                                                    006850
* 
*         SAVE B5, B6, AND B7 IN T.TEMP1
* 
          MX5    -18         (X5) = 42/77...7B,18/0 
          SX6    B5-0 
          SX7    B6-0 
          BX6    -X5*X6 
          BX7    -X5*X7 
          LX6    18 
          BX6    X6+X7       (X6) = 24/0,18/B5,18/B6
          SX7    B7-0 
          BX7    -X5*X7 
          LX6    18 
          BX6    X6+X7       (X6) = 6/0,18/B5,18/B6,18/B7 
          SB7    B4 
          SB6    CONA.R      THIS IS IN THE COMMON CODE AREA            006940
          SA6    T.TEMP1                                                006950
          EQ     GETZSN.S    CONVERT                                    006960
*                                                                       006970
 NXDIGP   TITLE  NXDIGP,S - PICK UP DIGITS FOR IBM S AND P CONVERSION   018260
*                                                                       018270
**    NXDIGP,S - PICK UP A NUMERIC CHARACTER FOR P,S (IBM) CONVERSION 
*         BY -GETZSN-                                                   018290
*                                                                       018300
*         INPUT  -  B1 = 1                                              018310
*                   X1 = SOURCE POINTER                                 018320
*                   B5 = RETURN ADDRESS                                 018330
*                   B7 = LINKAGE TO THIS ROUTINE                        018340
*                                                                       018350
*         OUTPUT -  X1 = UPDATED SOURCE POINTER (=0 IF END OF STRING)   018360
*                   X6 = CHARACTER (DIGIT)                              018370
*                                                                       018380
*         PRESERVED  --, --, X2, --, X4, X5, --, --                     018390
*                    A0, A1, A2, --, A4, A5, A6, A7                     018400
*                        B1, --, --, --, B5, B6, --                     018410
*                                                                       018420
*         NOTES..   IF THE CHARACTER IS A DIGIT, IT IS RETURNED IN      018430
*                 X6 REDUCED TO (0D TO 9D).  IF THE CHARACTER IS A      018440
*                 ZONE, A CODE IS PLACED IN X6 AS FOLLOWS..             018450
*                                                                       018460
*                      -          -1                                    018470
*                      +          -2                                    018480
*                    OTHER        -3                                    018490
*                                                                       018500
*                 FOR -S- CONVERSION, THE FINAL DIGIT IS RETURNED       018510
*                 FIRST, FOLLOWED BY ITS SIGN (ZONE)                    018520
*                                                                       018530
*                   THIS ROUTINE EXPECTS TO BE ENTERED VIA A -JP B7-,   018540
*                 AND MAY MODIFY B7.                                    018550
*                                                                       018560
          SPACE  4                                                      018580
 NXDIGP   SB7    B6          P-FIELD, 4-BIT BYTE CHARACTERS             018590
          SB6    NXDT.1                                                 018600
          SX2    4                                                      018610
          EQ     NXBITS                                                 018620
*                                                                       018630
 NXDT.1   SB6    B7                                                     018640
          SB7    NXDIGP                                                 018650
          ZR     X0,NXDT.X   OUT OF STRING                              018660
          SB4    X6-10D                                                 018670
          LT     B4,B0,NXDT.Y  DIGIT, DONE                              018680
 NXDT.5   SA3    NXDT.ZS+B4   ZONE, GET IT                              018690
          BX6    X3                                                     018700
          JP     B5          RETURN                                     018710
*                                                                       018720
 NXDT.X   SX1    B0          OUT OF STRING                              018730
          SX6    -3                                                     018740
 NXDT.Y   JP     B5          RETURN                                     018750
*                                                                       018760
          SPACE  2                                                      018770
*                                                                       018780
 NXDIGS   SB7    B6          S-FIELD, 8-BIT BYTES                       018790
          SB6    NXDT.2                                                 018800
          SX2    8                                                      018810
          EQ     NXBITS                                                 018820
*                                                                       018830
 NXDT.2   SB6    B7                                                     018840
          SB7    NXDIGS                                                 018850
          ZR     X0,NXDT.X   OUT OF STRING                              018860
          AX7    36                                                     018870
          NZ     X7,NXDT.3   JP NOT LAST BYTE                           018880
          SB7    NXDT.S      LAST BYTE, SAVE ZONE                       018890
          BX1    X6                                                     018900
          AX1    4                                                      018910
*                                                                       018920
 NXDT.3   SX3    17B         CHECK DIGIT                                018930
          BX6    X3*X6                                                  018940
          SB4    X6-9                                                   018950
          LE     B4,B0,NXDT.Y  OK                                       018960
 NXDT.4   SX6    -3                                                     018970
          JP     B5          RETURN                                     018980
*                                                                       018990
 NXDT.S   SB4    X1-10D     GET ZONE                                    019000
          SB7    NXDT.4B           NEW RETURN 
          LT     B4,B0,NXDT.4A     TRY ASCII
          SX1    B1                NOT DONE FLAG
          EQ     NXDT.5 
 NXDT.4A  SB4    X1-6 
          GE     B4,B0,NXDT.4      ILLEGAL ZONE 
          SB4    X1-3 
          LT     B4,B0,NXDT.4      BR ON ILLEGAL ZONE 
          SX1    B1                NOT DONE FLAG
          SA3    NXD.ZSS+B4        ZONE, GET IT 
          BX6    X3 
          JP     B5                RETURN 
 NXD.ZSS  DATA   -2,-2,-1          +,+,-
 NXDT.4B  SX1    B0                SIGNAL DONE
          JP     B5 
*                                                                       019040
          SPACE  2                                                      019050
*                                                                       019060
* DATA AREA -SIGN CODES VS. ZONES-                                      019070
*                                                                       019080
 NXDT.ZS  DATA   -2,-1,-2,-1,-2,-2     +,-,+,-,+,+  FROM 1010 TO 1111   019090
 NXTNMA   TITLE  SUBROUTINE NXTNMA, NXTNMC - GET NEXT NUMERIC CHARACTER 051750
**
* NXTNMA  - GET NEXT NUMERIC -ASCII- CHAR.    FOR USE WITH -GETNUM-     051770
* NXTNMC  - GET NEXT NUMERIC -EBCDIC- CHAR.   FROM -TAPE- CODES         051780
*                                                                       051790
*         INPUT  -  B1 = 1                                              051800
*                   X1 = SOURCE POINTER                                 051810
*                   B5 = RETURN ADDRESS                                 051820
*                                                                       051830
*         OUTPUT -  X1 = UPDATED SOURCE POINTER                         051840
*                   X6 = RETURN CHARACTER                               051850
*                                                                       051860
*         PRESERVED  --, --, --, --, --, --, --, --                     051870
*                    A0, A1, --, --, --, --, --, --                     051880
*                        B1, --, --, --, B5, B6, B7                     051890
*                                                                       051900
*         NOTES..   THIS ROUTINE IS DESIGNED TO BE USED IN CONJUNCTION  051910
*                 WITH THE -GETNUM- ROUTINE.  THE CHARACTER RETURNED    051920
*                 IN X6 IS REDUCED TO THE RANGE (0D TO 9D) IF IT IS     051930
*                 NUMERIC.  IN THE CASE OF A NON-NUMERIC CHARACTER      051940
*                 (OR END OF STRING), A CODE WILL BE RETURNED IN        051950
*                 ACCORDANCE WITH THE FOLLOWING TABLE..                 051960
*                                                                       051970
*                      +           -4                                   051980
*                      -           -3                                   051990
*                      .           -2                                   052000
*                      E           -1                                   052010
*                     OTHER        -0                                   052020
*                                                                       052030
*                 BLANKS ARE IGNORED (SKIPPED)                          052040
*                                                                       052050
*         TEMPORARY CELLS USED..                                        052060
*                                                                       052070
*                T.CHR       COPY OF RETURN VALUE                       052080
*                                                                       052090
          SPACE  4                                                      052110
 NXTNMA   SX5    TR.ATOX     ENTRY -A-                                  052120
          SX2    8           SIZE OF CHARACTER                          052130
          EQ     NXTN.J      JOIN  -NXTNUMA/C-                          052140
*                                                                       052150
 NXTNMC   SX5    TR.CTOX     ENTRY -C-                                  052160
          SX2    8                                                      052170
          EQ     NXTN.J      JOIN  -NXTNUMA/C-                          052180
*                                                                       052190
          END 
