*DECK CONC6 
          IDENT  T8.CNC6
 CONC6    TITLE  CONVERSION FROM CARD TO INTERNAL FORMAT                077210
*                                                                       077220
**    CONC6 - CONVERT CARD(PUNCH) SOURCE FIELDS TO INTERNAL 
*             DESTINATION FIELDS
*                                                                       077240
*         INPUT  -  B1 = 1                                              077250
*                   B6 = RETURN ADDRESS                                 077260
*                                                                       077270
*                T.INREC     POINTER TO CURRENT POSITION IN SOURCE      077280
*                T.OUTREC    POINTER TO CURRENT POSITION IN DESTINATION 077290
*                                                                       077300
*         OUTPUT -  NONE IN REGISTERS                                   077310
*                                                                       077320
*         PRESERVED  --, --, --, --, --, --, --, --                     077330
*                    A0, --, --, --, --, --, --, --                     077340
*                        B1, --, --, --, --, --, --                     077350
*                                                                       077360
*         TEMPORARY CELLS USED..                                        077370
*                                                                       077380
*                T.SAVEB6    SAVES B6 VALUE                             077390
*                T.I1        SOURCE FIELD POINTER                       077400
*                T.I2        DESTINATION FIELD POINTER                  077410
*                T.S1        TEMPORARY                                  077420
*                T.S2        TEMPORARY                                  077430
          SPACE  1
*                                                                       077440
*CALL COM2
          SPACE  4                                                      077460
*                                                                       077470
* JUMP VECTOR FOR CONVERSION                                            077480
*                                                                       077490
 CONC6    LETMASK R,(BQX)    LEGAL T1 TYPES                             077500
          J      *                                                      077510
          ECHO   1,P=(X,Q,B)                                            077520
          J      CONC6._P                                               077530
*                                                                       077540
          ECHO   4,P=(X,B)
 CONC6._P  LETMASK R,(ABCDEINSUXZ),00B   LEGAL T2 TYPES                 077560
          J      *
           ECHO  1,Q=(Z,X,U,S,N,I,E,D,C,B,A,0)
          J      CONC6._P_Q                                             077580
*                                                                       077590
 CONC6.Q  LETMASK R,,0       Q CODE                                     077600
          J      *
          J      CONC6.Q0                                               077610
*                                                                       077620
*                                                                       077630
          SPACE  4                                                      077640
*                                                                       077650
* Q CODE (QUIT)                                                         077660
*                                                                       077670
 CONC6.Q0 EQ     CONA..Q     DONE, EXIT CONVERSION                      077680
*                                                                       077690
          SPACE  2                                                      077700
*                                                                       077710
* STRING TYPE CONVERSIONS                                               077720
*                                                                       077730
          SPACE  1                                                      077740
*                                                                       077750
 CONC6.B0 SA5    T.M1        B-0 DEFAULTS TO B-B                        077760
          BX6    X5                                                     077770
          SA6    T.M2                                                   077780
*                                                                       077790
 CONC6.BB SB5    CC6.1       B-B                                        077800
          EQ     GSBX 
 CC6.1    SB5    CC6.2                                                  077820
          EQ     GDB                                                    077830
 CC6.2    SA2    T.I2        CALL MVBITS                                077840
          SA3    T.SAVEB6                                               077850
          SA1    T.I1                                                   077860
          BX7    X2                                                     077870
          SB6    X3                                                     077880
          AX2    36                                                     077890
          EQ     MVBITS                                                 077900
*                                                                       077910
          SPACE  2                                                      077920
*                                                                       077930
 CONC6.BA SB5    CC6.3       B-A                                        077940
          EQ     GSBX 
 CC6.3    SB5    CC6.4                                                  077960
          EQ     GDC                                                    077970
 CC6.4    SX5    TR.BTOA                                                077980
          SX6    ZERO.A                                                 TB8   31
          SX3    SIZE.A                                                 078000
          EQ     CC6.9                                                  078010
*                                                                       078020
 CONC6.BC SB5    CC6.5       B-C                                        078030
          EQ     GSBX 
 CC6.5    SB5    CC6.6                                                  078050
          EQ     GDC                                                    078060
 CC6.6    SX5    TR.BTOC                                                078070
          SX6    ZERO.C                                                 TB8   33
          SX3    SIZE.C                                                 078090
          EQ     CC6.9                                                  078100
*                                                                       078110
 CONC6.BX SB5    CC6.7       B-X                                        078120
          EQ     GSBX 
 CC6.7    SB5    CC6.8                                                  078140
          EQ     GD6                                                    078150
 CC6.8    SX5    TR.BTOX                                                078160
          SX6    ZERO.X                                                 TB8   35
          SX3    SIZE.X                                                 078180
*                                                                       078190
 CC6.9    SA2    T.I2        SET UP AND CALL CNA..MV                    078200
          SA4    T.SAVEB6                                               078210
          SA1    T.I1                                                   078220
          BX7    X2                                                     078230
          SB5    X4                                                     078240
          SX2    B1                                                     078250
          EQ     CNA..MV                                                078260
*                                                                       078270
          SPACE  2                                                      078280
*                                                                       078290
 CONC6.XB SB5    CC6.10      X-B                                        078300
          EQ     GSCX 
 CC6.10   SB5    CC6.11                                                 078320
          EQ     GDB                                                    078330
*                                                                       078340
 CC6.11   SX2    SIZE.P      SPECIAL VERSION OF CNA..MB                 078350
          SB6    CC6.12                                                 078360
          SA1    T.I1                                                   078370
          EQ     NXBITS      GET CHARACTER                              078380
*                                                                       078390
 CC6.12   ZR     X2,CC6.16   JP NO MORE SOURCE                          078400
          SX6    X6-ZERO.P                                              078410
          SA7    A1                                                     078420
          SA2    B1                                                     078430
          SA1    T.I2                                                   078440
          ZR     X6,CC6.13   JP ZERO                                    078450
          SX5    X6+ZERO.P-ONE.P                                        078460
          NZ     X5,CC6.E1   JP NOT (0-1)                               078470
          SX6    B1                                                     078480
 CC6.13   SB6    CC6.14                                                 078490
          EQ     STBITS      STORE BIT                                  078500
*                                                                       078510
 CC6.14   SA7    A1          SAVE POINTER                               078520
          NZ     X2,CC6.11   JP NOT DONE                                078530
 CC6.15   SA5    T.SAVEB6    DONE                                       078540
          SB6    X5                                                     078550
          JP     B6                                                     078560
*                                                                       078570
 CC6.16   SA5    T.I2        SOURCE EMPTY, FILL OUT WITH ZEROES         078580
          SX6    B0                                                     078590
          BX1    X5                                                     078600
          SX2    60                                                     078610
          AX5    36          LEFT TO FILL                               078620
          SB6    CC6.17                                                 078630
 CC6.17   ZR     X5,CC6.15   DONE                                       078640
          IX5    X5-X2                                                  078650
          PL     X5,STBITS                                              078660
          IX2    X5+X2                                                  078670
          SX5    B0                                                     078680
          EQ     STBITS                                                 078690
*                                                                       078700
          SPACE  2                                                      078710
*                                                                       078720
 CONC6.XA SB5    CC6.18      X-A                                        078730
          EQ     GSCX 
 CC6.18   SB5    CC6.19                                                 078750
          EQ     GDC                                                    078760
 CC6.19   SX5    TR.CTOA                                                078770
          SX6    SPACE.A                                                078780
          SX7    SIZE.A                                                 078790
          EQ     CC6.24                                                 078800
*                                                                       078810
 CONC6.XC SB5    CC6.20      X-C                                        078820
          EQ     GSCX 
 CC6.20   SB5    CC6.21                                                 078840
          EQ     GDC                                                    078850
 CC6.21   SX6    SPACE.C                                                078860
          SX7    SIZE.C                                                 078870
          SX5    B0                                                     078880
          EQ     CC6.24                                                 078890
*                                                                       078900
 CONC6.X0 SA5    T.M1        X-DEFAULT                                  078910
          BX7    X5                                                     078920
          SA7    T.M2                                                   078930
*                                                                       078940
 CONC6.XX SB5    CC6.22      X-X                                        078950
          EQ     GSCX 
 CC6.22   SB5    CC6.23                                                 078970
          EQ     GD6                                                    078980
 CC6.23   SX5    TR.CTOX                                                078990
          SX6    SPACE.X                                                079000
          SX7    SIZE.X                                                 079010
*                                                                       079020
 CC6.24   SA6    T.S1        SPECIAL VERSION OF CNA..MV                 079030
          SA7    T.S2                                                   079040
          SA1    T.I1                                                   079050
          SX2    SIZE.P                                                 079060
          SB6    CC6.25                                                 079070
          EQ     NXBITS      GET A CHARACTER                            079080
*                                                                       079090
 CC6.25   SA1    T.I2                                                   079100
          ZR     X2,CC6.29   NO CHARACTER, BLANK FILL                   079110
          SA7    T.I1                                                   079120
          SB6    CC6.26                                                 079130
          EQ     TRANSPC     CONVERT TO EBCDIC                          079140
*                                                                       079150
 CC6.26   ZR     X5,CC6.27   JP NO TRANSLATION NEEDED                   079160
          SA3    X5                                                     079170
          SB4    X6                                                     079180
          SA4    X3+B4       CHAR + BASE                                079190
          AX3    18                                                     079200
          SB4    X3                                                     079210
          AX6    X4,B4       SHIFT TO LOW END                           079220
          AX3    18                                                     079230
          BX6    X6*X3       AND MASK OFF                               079240
*                                                                       079250
 CC6.27   SA2    T.S2        STORE DEST . CHAR                          079260
          SB6    CC6.28                                                 079270
          EQ     STBITS                                                 079280
*                                                                       079290
 CC6.28   AX1    36                                                     079300
          ZR     X1,CC6.31   DONE, DEST. FIELD FULL                     079310
          SA7    A1          NOT DONE, GET NEXT                         079320
          SA1    T.I1                                                   079330
          SX2    SIZE.P                                                 079340
          SB6    CC6.25                                                 079350
          EQ     NXBITS                                                 079360
*                                                                       079370
 CC6.29   SA4    T.S1        COME HERE WHEN SOURCE EMPTY, SPACE FILL    079380
          SA2    T.S2                                                   079390
          BX7    X1                                                     079400
          SB6    CC6.30                                                 079410
          BX6    X4                                                     079420
 CC6.30   AX7    36          STORE BLANKS TO END OF FIELD               079430
          NZ     X7,STBITS                                              079440
*                                                                       079450
 CC6.31   SA5    T.SAVEB6    EXIT                                       079460
          SB6    X5                                                     079470
          JP     B6                                                     079480
*                                                                       079490
          SPACE  2                                                      079500
*                                                                       079510
* NUMERIC MODE CONVERSIONS                                              079520
*                                                                       079530
 .A       ECHO   ,P=(B,X),R=(B,CX)
 .B       ECHO   ,Q=(D,E,I,N,S,U,Z),S=(D,E,E,6,6,E,6)                   079550
 XXX      SYMBOL                                                        079560
 YYY      SYMBOL                                                        079570
 CONC6._P_Q  SB5   "XXX"       P-Q                                      079580
          EQ     GS_R                                                   079590
 "XXX"    SB5    "YYY"                                                  079600
          EQ     GD_S                                                   079610
 "YYY"    SB5    CC6.._Q                                                079620
          SA1    T.I1                                                   079630
          EQ     CONC._P_.                                              079640
          SPACE  1                                                      079650
 .B       ENDD                                                          079660
 .A       ENDD                                                          079670
*                                                                       079680
          SPACE  2                                                      079690
*                                                                       079700
 .A       ECHO   ,Q=(D,E,I,N,S,U,Z)                                     079710
 CC6.._Q   SA2    T.SAVEB6                                              079720
          SA1    T.I2                                                   079730
          SB5    X2                                                     079740
          EQ     CON6.._Q                                               079750
          SPACE  1                                                      079760
 .A       ENDD                                                          079770
*                                                                       079780
          SPACE  2                                                      079790
**    ERROR ACTIONS 
*                                                                       079820
 CC6.E1   SA2    CC6.M1      CHARACTER NOT (0-1) IN BIT CONVERSION
          EQ     ERR.CON                                                079840
****
*                                                                       079860
 CC6.M1   VFD    12/0,18/E.CON,12/0,18/*+1
          DATA    C/SOURCE CHARACTER NOT 0 OR 1, TO BIT STRING/         079880
****
          END 
