*DECK CONC
          IDENT  T8.CNC 
          TITLE  ROUTINES CONC, NEXTNUMP, TRANSPC 
 CONC     TITLE  CONC - CARD IMAGE SOURCE CONVERSION ROUTINES           004140
*                                                                       004150
**    CONC - ROUTINES TO PICK UP CARD SOURCE FIELDS (NUMERIC MODE)
*                                                                       004170
*         INPUT  -  B1 = 1                                              004180
*                   X1 = SOURCE POINTER                                 004190
*                   B5 = RETURN ADDRESS                                 004200
*                                                                       004210
*         OUTPUT -  NONE IN REGISTERS                                   004220
*                                                                       004230
*         PRESERVED  --, --, --, --, --, --, --, --                     004240
*                    A0, --, --, --, --, --, --, --                     004250
*                        B1, --, --, --, B5, B6, B7                     004260
*                                                                       004270
*         TEMPORARY CELLS USED..                                        004280
*                                                                       004290
*                T.NUM,+1,+2    RESULT, A TRIPLE PRECISION NUMBER       004300
*                T.TEMP1     TEMPORARY                                  004310
*                                                                       004320
*         NOTES..   THE ROUTINES THAT FOLLOW ARE NAMED -CONC.Q.-,       004330
*                WHERE -Q- IS A VALID SOURCE TYPE FOR CARD FIELDS       004340
*                (B,X).                                                 004350
*                                                                       004360
*                   THESE ROUTINES ARE FOR NUMERIC PICKUP ONLY, AND     004370
*                LEAVE A TRIPLE PRECISION REAL NUMBER IN T.NUM.         004380
*                                                                       004390
          SPACE  1
*CALL COM2
          SPACE  4                                                      004410
*                                                                       004480
* CHARACTER (X) FIELDS                                                  004490
*                                                                       004500
 CONC.X.  SB4    NEXTNUMP    PICK UP -X- ITEM                           004510
          EQ     CONA.X                                                 004520
*                                                                       004530
 NEXTNUMP TITLE  SUBROUTINE NEXTNUMP  - GET NEXT NUMERIC CHARACTER      010100
*                                                                       010110
**    NEXTNUMP - GET NEXT NUMERIC CHARACTER FROM PUNCH-CARD 
*                                                                       010130
*         INPUT  -  B1 = 1                                              010140
*                   X1 = SOURCE POINTER                                 010150
*                   B5 = RETURN ADDRESS                                 010160
*                                                                       010170
*         OUTPUT -  X1 = UPDATED SOURCE POINTER                         010180
*                   X6 = RETURN CHARACTER                               010190
*                                                                       010200
*         PRESERVED  --, --, --, --, --, --, --, --                     010210
*                    A0, A1, --, --, --, --, --, --                     010220
*                        B1, --, --, --, B5, B6, B7                     010230
*                                                                       010240
*         NOTES..   THIS ROUTINE IS DESIGNED TO BE USED IN CONJUNCTION  010250
*                WITH THE -GETNUM- ROUTINE.  THE CHARACTER RETURNED     010260
*                IN X6 IS REDUCED TO THE RANGE (0D TO 9D) IF IT IS      010270
*                NUMERIC.  IN THE CASE OF A NON-NUMERIC CHARACTER       010280
*                (OR END OF STRING), A CODE WILL BE RETURNED IN         010290
*                ACCORDANCE WITH THE FOLLOWING TABLE..                  010300
*                                                                       010310
*                      +           -4                                   010320
*                      -           -3                                   010330
*                      .           -2                                   010340
*                      E           -1                                   010350
*                     OTHER        -0                                   010360
*                                                                       010370
*                BLANKS ARE IGNORED (SKIPPED)                           010380
*                                                                       010390
*         TEMPORARY CELLS USED                                          010400
*                                                                       010410
*                T.CHR       COPY OF RETURN VALUE                       010420
*                                                                       010430
          SPACE  4                                                      010450
 NEXTNUMP SX6    B6          SAVE B6                                    010460
          SX2    12          CHARACTER SIZE                             010470
          SA6    T.CHR                                                  010480
          SB6    NXTP.1                                                 010490
          EQ     NXBITS      GET THE CHARACTER                          010500
*                                                                       010510
 NXTP.1   ZR     X0,NXTP.X   NO MORE                                    010520
          SB6    NXTP.2      TRANSLATE X6 TO EBCDIC                     010530
          EQ     TRANSPC                                                010540
*                                                                       010550
 NXTP.2   SA3    TR.CTOX     TRANSLATE EBCDIC TO DISPLAY CODE           010560
          SA4    T.CHR                                                  010570
          SB3    X6                                                     010580
          SA5    X3+B3       TRANSLATED CHAR-WORD                       010590
          AX3    18                                                     010600
          SB6    X4                                                     010610
          SB2    X3          SHIFT COUNT                                010620
          AX3    18          MASK                                       010630
          AX5    X5,B2                                                  010640
          BX6    X5*X3       CHR NOW IN X6
          SB2    X6-SPACE.X  CHECK FOR BLANK                            010660
          NZ     B2,NEXTN.X  NOT BLANK, JOIN -NEXTNUM- FOR TESTING      010670
          SB6    NXTP.1                                                 010680
          EQ     NXBITS      GET ANOTHER IF BLANK                       010690
*                                                                       010700
 NXTP.X   SA4    T.CHR       OUT OF STRING (-0)                         010710
          BX6    -X6-X6                                                 010720
          SB6    X4                                                     010730
          JP     B5          RETURN                                     010740
 TRANSPC  TITLE  SUBROUTINE TRANSPC - CONVERT PUNCH TO EBCDIC           017810
*                                                                       017820
**    TRANSPC - CONVERT A PUNCH CODE TO EBCDIC
*                                                                       017840
*         INPUT  -  B1 = 1                                              017850
*                   X6 = CHARACTER TO CONVERT                           017860
*                   B6 = RETURN ADDRESS                                 017870
*                                                                       017880
*         OUTPUT -  X6 = EBCDIC CHARACTER                               017890
*                                                                       017900
*         PRESERVED  --, X1, X2, X3, --, X5, --, --                     017910
*                    A0, A1, A2, A3, --, A5, A6, A7                     017920
*                        B1, --, B3, B4, B5, B6, B7                     017930
*                                                                       017940
          SPACE  4                                                      017960
 TRANSPC  SX4    774B                                                   017970
          BX4    X4*X6       DIGIT (1-7) PUNCHES                        017980
          CX0    X4                                                     017990
          SB2    X0                                                     018000
          GT     B2,B1,TRNS.X  JP ILLEGAL PUNCH CODE                    018010
          ZR     B2,TRNS.1   JP NO DIGIT PUNCHES                        018020
          LX4    46-8        DIGIT PUNCH                                018030
          PX4    X4,B0                                                  018040
          NX4    X4,B2       PUNCH VALUE IN B2                          018050
*                                                                       018060
 TRNS.1   SX4    3B                                                     018070
          BX4    X6*X4       BITS 8,9                                   018080
          AX6    9           BITS Y,X,0                                 018090
          LX6    2           YX0--                                      018100
          IX6    X4+X6       YX089                                      018110
          SA4    TR.PTOC
          LX6    3           YX089---                                   018130
          SB2    X6+B2       YX089(0-7)                                 018140
          BX6    X4                                                     018150
          SA4    X6+B2       ENTRY WORD                                 018160
          AX6    18                                                     018170
          SB2    X6          SHIFT COUNT                                018180
          AX6    18          MASK                                       018190
          AX4    X4,B2                                                  018200
          BX6    X4*X6       CHARACTER IN X6                            018210
          JP     B6          EXIT                                       018220
*                                                                       018230
 TRNS.X   SX6    XFF         USE -E0- IF ILLEGAL PUNCH                  018240
          JP     B6                                                     018250
          END 
