         PROC  &P,0,&ID=,&CNTRL=,&MTAPE=,&URECD=                        TSA00010
TSAT     NAME                                                           TSA00020
         LCL   &N1,&N2,&N3,&N4                                          TSA00030
&N1      SET   1
&N2      SET   1*(('&MTAPE'='YES')++(('&MTAPE'='')**('&URECD'='')))
&N3      SET   1*(('&URECD'='YES')++(('&MTAPE'='')**('&URECD'='')))
&N4      SET   0
ST$&N1.&N2.&N3.&N4   CSECT                                              TSA00040
         DO    (&N2=1)**(&N3=1)
ST$1100  EQU   *                                                        TSA00050
ST$1010  EQU   *
ST$TSAT  EQU   *
         ENTRY ST$1100
         ENTRY ST$1010
         ENTRY ST$TSAT
         ENDO                                                           TSA00060
         USING *,15                                                     TSA00100
         USING ST$DPCA,12               PCA COVER                       TSA00110
         USING ST$DTF,10                DTF COVER                       TSA00120
         TM    46(1),X'02'             SAT DTF                          TSA00160
         BC    8,ST$ENTRY                NO                             TSA00170
         STM   14,12,12(13)             STORE USER REGS                 TSA00180
ST$ENTRY LA    10,0(1)                 COVER DTF                        TSA00190
         L     12,ST$DPCA1             COVER DEVICE APPENDAGE           TSA00200
         TM    36(1),X'80'              FILE OPEN                       TSA00210
         BC    1,ST$CK                    YES                           TSA00220
         DO    ('&CNTRL'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA00230
         B     ST$RETRN                                                 TSA00240
         ENDO                                                           TSA00250
ST$OPNER MVI   56(1),X'13'             **ERROR**  FILE NOT OPEN         TSA00260
         B     ST$ERET1                   .                             TSA00270
ST$CK    MVI   ST$DIOCT+1,X'01'        SET I/O FUNCTIONS TO ONE         TSA00280
         CLI   ST$DFUNC,X'86'           WAIT FUNCTION                   TSA00290
         BNE   ST$CKTCA                   NO                            TSA00300
         TM    ST$DMFLG,X'40'           WAIT REQUIRED                   TSA00310
         BC    8,ST$RETRN                 NO                            TSA00320
         B     ST$WAITF                 WAIT I/O                        TSA00330
ST$CKTCA ST    12,ST$DPUB+2             STORE TCA ADDRESS               TSA00340
         L     1,ST$DLAF                TCA VALID FOR                   TSA00350
         LA    1,0(1)                     THIS DTF                      TSA00360
         CR    10,1                       .                             TSA00370
         BE    ST$CKWT                    YES                           TSA00380
         MVI   ST$DECOD,X'15'           **ERROR**  INVALID TCA          TSA00390
         B     ST$ERET1                   .                             TSA00400
ST$CKWT  TM    ST$DMFLG,X'40'           WAIT REQUIRED                   TSA00410
         BC    8,ST$CKCTL                 NO                            TSA00420
         BAL   7,ST$WAIT                ISSUE WAIT                      TSA00430
ST$CKCTL XC    ST$DEFLG(2),ST$DEFLG    CLEAR ERROR FLAGS                TSA00440
         NI    ST$DMFLG+1,X'DF'        CLEAR READ FUNCTION              TSA00450
         MVC   ST$DCCW1(3),ST$DIOA1+1  SET CCW                          TSA00460
         LH    7,ST$DBKSZ                INFO                           TSA00470
         ST    7,ST$DCCW4                .                              TSA00480
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA00488
         CLI   ST$DEODI,X'10'          TAPE DVC                         TSA00490
         BNE   ST$ANAOP                  NO                             TSA00500
         ENDO                                                           TSA00502
         MVC   ST$DCCW1(7),ST$DIOA1+1  SET CCW INFO                     TSA00510
         CLI   ST$DFUNC,X'40'           CONTROL FUNCTION                TSA00520
         BNE   ST$CKPOS                 NO                              TSA00530
         NI    ST$DTFG2,X'FD'          CLEAR AUTO                       TSA00540
ST$CNTRL EXCP  (1)                     ISSUE I/O                        TSA00550
         CLI   ST$DCCW,X'07'           REWIND                           TSA00560
         BNE   ST$CTL1                   NO                             TSA00570
         LA    6,1                     RESET CURRENT                    TSA00580
         ST    6,ST$DCURR                POSITION                       TSA00590
         ST    6,ST$DCPID                .                              TSA00600
         B     ST$CTL1A                 LINK TO WAIT                    TSA00610
ST$CTL1  TM    ST$DCCW,X'0F'           RECORD FUNCTION                  TSA00620
         BC    4,ST$WAITF                 YES                           TSA00630
ST$CTL1A BAL   7,ST$WAIT                GO WAIT                         TSA00634
         B     ST$RETRN                                                 TSA00635
ST$CTL2  OI    ST$DMFLG,X'40'          SET WAIT REQUIRED                TSA00640
         B     ST$RETRN                EXIT                             TSA00650
ST$CKPOS EQU   *                                                        TSA00960
         DO    ('&ID'='YES')++(('&MTAPE'='')**('&URECD'=''))            TSA00970
         TM    ST$DTFG2,X'02'           AUTO POSITION ACTIVE            TSA00990
         BC    8,ST$CKLBK                 NO                            TSA01000
         CLC   ST$DCURR(4),ST$DCPID     POSITIONING REQUIRED            TSA01010
         BE    ST$CKLBK                   NO                            TSA01020
         TM    ST$DTFG2,X'01'          OUTPUT FILE                      TSA01030
         BC    8,ST$POSRD                NO                             TSA01040
         CLI   ST$DFUNC,X'20'                                           TSA01050
         BE    ST$NOTMK                                                 TSA01060
         MVC   ST$DLACE(1),ST$DTFG2    STORE FLAGS                      TSA01070
         MVI   ST$DTFG2,X'A2'          SET NO RWD                       TSA01080
         SVC   39                       CLOSE                           TSA01090
         SVC   38                       OPEN                            TSA01100
         MVC   ST$DTFG2(1),ST$DLACE  RESTORE FLAGS                      TSA01110
         MVI   ST$DLACE,X'00'            .                              TSA01120
ST$NOTMK MVC   ST$DEODI+1(3),ST$DCPID+1                                 TSA01130
ST$POSRD MVI   ST$DCCW,X'2F'           SET BSF OPCODE                   TSA01140
         LA    8,1                      BLOCK ONE                       TSA01150
         C     8,ST$DCURR                 REQUESTED                     TSA01160
         BNE   ST$CKFWD                   NO                            TSA01170
         ST    8,ST$DCPID               SET CURRENT POSITION ID =1      TSA01180
         B     ST$POSEX                 EXECUTE I/O                     TSA01190
ST$CKFWD MVI   ST$DCCW,X'37'            CALCULATE NUMBER                TSA01200
         L     8,ST$DCURR                 OF BLOCKS FOR                 TSA01210
         S     8,ST$DCPID                 FWD POSITIONING               TSA01220
         LTR   8,8                      BACKWARD POSITIONING REQUIRED   TSA01230
         BC    8,ST$POSEX                 NO                            TSA01240
         MVI   ST$DCCW,X'27'            CALCULATE NUMBER                TSA01250
         L     8,ST$DCPID                 OF BLOCKS FOR                 TSA01260
         S     8,ST$DCURR                 BACKWARD POSITIONING          TSA01270
ST$POSEX EXCP  (1)                      ISSUE I/O                       TSA01280
         BAL   7,ST$WAIT                WAIT I/O                        TSA01290
         BCT   8,ST$POSEX               LOOP TO POSITION                TSA01300
         MVC   ST$DCPID(4),ST$DCURR     UPDATE CURRENT POSITION ID      TSA01310
         ENDO                                                           TSA01320
ST$CKLBK XR    6,6                      CLEAR WORKING                   TSA01330
         XR    7,7                        REGS                          TSA01340
         IC    6,ST$DCCW7               CALCULATE EFFECTIVE             TSA01350
ST$ADJ   AH    7,ST$DCCW4                BLOCK SIZE                     TSA01360
         BCT   6,ST$ADJ                                                 TSA01370
         STH   7,ST$DCCW4                                               TSA01380
ST$ANAOP EQU   *                                                        TSA01386
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA01388
         CLI   ST$DEODI,X'04'           PRINT DVC?                      TSA01390
         BNE   ST$RDR                     NO                            TSA01400
         TM    ST$DFUNC,X'40'           CNTRL FUNCTION                  TSA01410
         BC    1,ST$PCTL                  YES                           TSA01420
         TM    ST$DFUNC,X'20'           PUT FUNCTION                    TSA01430
         BC    8,ST$OPCK                  NO                            TSA01440
         MVI   ST$DCCW,X'01'            SET PRINT OPCODE                TSA01450
         TM    ST$DPRFG,X'20'           SPACE BEFORE PRINT              TSA01460
         BC    8,ST$SPAFT                 NO                            TSA01470
         TM    ST$DPRFG,X'08'           STD CNTRL NOP                   TSA01480
         BC    8,ST$AFTER                 NO                            TSA01490
         NI    ST$DPRFG,X'F7'           CLEAR INDICATOR                 TSA01500
         B     ST$TSTB                  SET DELAY CNTRL IF REQUIRED     TSA01510
ST$AFTER MVI   ST$DCCW8,X'07'          SET CNTRL OPCODE                 TSA01520
         MVI   ST$DCCW,X'01'           SET PRINT SP 0                   TSA01530
         OC    ST$DCCW8(1),ST$DPADV     SET PRINT ADVANCE               TSA01540
         OI    ST$DPRFG,X'04'           ISSUE FORMS CNTRL               TSA01550
ST$IEXCP LA    6,ST$DCCW8               POINT TO SECONDARY              TSA01560
         ST    6,ST$DACCW                 CCW                           TSA01570
         EXCP  (1)                      ISSUE I/O                       TSA01580
         WAIT  (1)                      WAIT I/O                        TSA01590
         LA    6,ST$DCCW                RESTORE PRIMARY                 TSA01600
         ST    6,ST$DACCW                 CCW                           TSA01610
         TM    ST$DTRAN,X'48'           GOOD STATUS                     TSA01620
         BC    8,ST$TSTA                 YES                            TSA01630
         TM    ST$DTRAN,X'20'             NO                            TSA01640
         BC    8,ST$WTERR              ERROR RETURN                     TSA01650
         MVI   ST$DCTL,X'B8'            SET DELAY HOME PAPER CNTRL      TSA01660
ST$SPAFT MVI   ST$DCCW8,X'BF'             .                             TSA01670
ST$TSTA  TM    ST$DPRFG,X'04'           DELAY CNTRL REQUIRED            TSA01680
         BC    8,ST$PRTA                  NO                            TSA01690
ST$TSTB  NI    ST$DPRFG,X'FB'           CLEAR INDICATOR                 TSA01700
         OC    ST$DCCW(1),ST$DCTL       SET DELAY CNTRL                 TSA01710
         MVI   ST$DICTL,X'00'           CLEAR CNTRL INFO                TSA01720
         B     ST$ISSUE                 ISSUE I/O                       TSA01730
ST$PRTA  OC    ST$DCCW(1),ST$DPADV      SET STANDARD SPACE AFTER        TSA01740
         TM    ST$DPRFG,X'40'           CNTRL CHARACTER SPECIFIED       TSA01750
         BC    8,ST$ISSUE                 NO                            TSA01760
         L     6,ST$DCCW4              DECREMENT BLOCK SIZE             TSA01770
         BCTR  6,0                        .                             TSA01780
         ST    6,ST$DCCW4                .                              TSA01790
         LA    7,1                     INCREMENT I/O                    TSA01800
         L     6,ST$DCCW                 AREA                           TSA01810
         AR    7,6                       .                              TSA01820
         ST    7,ST$DCCW                  .                             TSA01830
         IC    4,0(6)                  CONVERT CTLCHR TO                TSA01840
         SLL   4,3                       STANDARD OP CODE               TSA01850
         STC   4,ST$DCCW                 .                              TSA01860
         NI    ST$DCCW,X'F8'             .                              TSA01870
         OI    ST$DCCW,X'01'           SET PRINT/ADVANCE                TSA01880
         CLI   0(6),X'17'              PRINT FUNCTION                   TSA01890
         BNH   ST$ISSUE                  YES                            TSA01900
         OI    ST$DCCW,X'07'           SET ADVANCE                      TSA01910
         XI    ST$DCCW,X'80'             .                              TSA01920
         B     ST$ISSUE                                                 TSA01930
ST$PCTL  STH   0,ST$DICTL               STORE CNTRL INFO                TSA01940
         MVO   ST$DICTL(2),ST$DICTL                                     TSA01950
         OI    ST$DPRFG,X'04'           SET DELAY CNTRL ISSUED          TSA01960
         TM    ST$DICTL,X'04'           DELAY CNTRL                     TSA01970
         BC    8,ST$PCTL1                 YES                           TSA01980
         NI    ST$DPRFG,X'FB'           CLEAR DELAY CNTRL BIT           TSA01990
ST$PCTL1 NI    ST$DICTL,X'FB'           CLEAR IMMEDIATE CNTRL ONLY BIT  TSA02000
         CLI   ST$DICTL,X'00'           IMMEDIATE CNTRL ZERO            TSA02010
         BE    ST$PCTL2                   YES                           TSA02020
         MVI   ST$DCCW,X'87'           SET CNTRL OP CODE                TSA02030
         LH    6,ST$DICTL                .                              TSA02040
         SRL   6,1                       .                              TSA02050
         STH   6,ST$DICTL                .                              TSA02060
         OC    ST$DCCW(1),ST$DICTL      SET IMMEDIATE CNTRL INFO        TSA02070
         MVI   ST$DICTL,X'00'           CLEAR IMMEDIATE INFO            TSA02080
         EXCP  (1)                                                      TSA02090
         B     ST$CTL2                                                  TSA02100
ST$PCTL2 OI    ST$DPRFG,X'08'           SET NOP SPACE BEFORE PRINT      TSA02110
         B     ST$RETRN                                                 TSA02120
ST$ISSUE L     9,ST$DACCW              VERIFY MAX                       TSA02130
         CLC   5(1,9),ST$DMBKZ           BLOCK SIZE                     TSA02140
         BNH   ST$PIOCS                  .                              TSA02150
         MVC   5(1,9),ST$DMBKZ           .                              TSA02160
         B     ST$PIOCS                                                 TSA02170
ST$RDR   CLI   ST$DEODI,X'08'           READ DVC                        TSA02180
         BNE   ST$PNCH                    NO                            TSA02190
         MVI   ST$DCCW,X'02'            SET READ OPCODE                 TSA02200
         CLI   ST$DFUNC,X'10'           GET FUNCTION                    TSA02210
         BNE   ST$OPCK                    NO                            TSA02220
         B     ST$ISSUE                                                 TSA02230
ST$PNCH  CLI   ST$DEODI,X'02'           PUNCH DVC                       TSA02240
         BNE   ST$TAPE                    NO                            TSA02250
         MVI   ST$DCCW,X'41'            SET PUNCH OPCODE                TSA02260
         MVC   ST$DCCW8(8),ST$DCCW     SETUP PUNCH ERROR RECOVERY       TSA02270
         CLI   ST$DFUNC,X'20'           PUT FUNCTION                    TSA02280
         BE    ST$ISSUE                  YES                            TSA02290
         TM    ST$DEODI+3,X'04'         READ FEATURE AVAILABLE          TSA02300
         BC    8,ST$OPCK                  NO                            TSA02310
         CLI   ST$DFUNC,X'10'           GET FUNCTION                    TSA02320
         BNE   ST$OPCK                    NO                            TSA02330
         MVI   ST$DCCW,X'42'           SET READ OP CODE                 TSA02340
         B     ST$ISSUE                                                 TSA02350
         ENDO                                                           TSA02352
ST$TAPE  NI    ST$DMFLG,X'FB'           YES,CLEAR WAIT BIT              TSA02353
         DO    ('&MTAPE'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA02360
         TM    ST$DFUNC,X'10'           GET FUNCTION?                   TSA02361
         BC    1,ST$GET                   YES                           TSA02370
         TM    ST$DFUNC,X'20'           PUT FUNCTION                    TSA02380
         BC    1,ST$PUT                   YES                           TSA02390
         ENDO                                                           TSA02391
ST$OPCK  MVI   ST$DECOD,X'14'           **ERROR** INVALID FUNCTION      TSA02400
         OI    ST$DEFLG,X'02'          SET INVALID FUNCTION             TSA02410
ST$ERET1 OC    ST$DECOD+1(3),ST$DECOD+1   ERROR EXIT SPECIFIED          TSA02420
         BC    8,ST$DMSG                    NO                          TSA02430
         L     14,ST$DECOD              EXIT TO USER                    TSA02440
         B     ST$RETRN                   ERROR EXIT                    TSA02450
         DO    ('&MTAPE'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA02451
ST$GET   MVI   ST$DCCW,X'02'            SET READ FUNCTION               TSA02460
         OI    ST$DMFLG+1,X'20'         SET READ FUNCTION BIT           TSA02470
         TM    ST$DTFG2,X'04'           READ = FWD                      TSA02480
         BC    1,ST$PIOCS                 YES                           TSA02490
         OI    ST$DCCW6,X'40'           SET READ BACK FLAG              TSA02500
         L     6,ST$DCPID               UPDATE CURRENT POSITION ID      TSA02510
         BCTR  6,0                        .                             TSA02520
         BCTR  6,0                        .                             TSA02530
         TM    ST$DMFLG,X'04'           IMM WAIT REQD?(ONLY FOR CKPT)   TSA02532
         BC    1,ST$GET1                YES,BYPASS UPDATE               TSA02534
         ST    6,ST$DCPID                 .                             TSA02540
ST$GET1  L     6,ST$DIOA1               ADJUST BUFFER ADR FOR BWD READ  TSA02550
         AH    6,ST$DCCW4                .                              TSA02560
         BCTR  6,0                       .                              TSA02570
         ST    6,ST$DCCW                  .                             TSA02580
         MVI   ST$DCCW,X'0C'            SET READ BACK OP-CODE           TSA02590
         B     ST$PIOCS                   .                             TSA02600
ST$PUT   MVI   ST$DCCW,X'01'            SET WRITE OPCODE                TSA02610
         OI    ST$DCCW6,X'80'            OUTPUT BIT AND                 TSA02620
         OI    ST$DTFG2,X'01'             FILE DIRECTION INDICATOR      TSA02630
         L     6,ST$DCURR               UPDATE EOD ID                   TSA02640
         LA    6,1(6)                     .                             TSA02650
         ST    6,ST$DEODI                 .                             TSA02660
         MVI   ST$DEODI,X'10'          RESET DVC TYPE                   TSA02670
         BAL   3,ST$TNSLT              CHECK ASCII                      TSA02680
         ENDO                                                           TSA02681
ST$PIOCS OI    ST$DMFLG,X'40'          SET WAIT REQUIRED                TSA02690
         EXCP  (1)                      ISSUE I/O                       TSA02700
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA02708
         CLI   ST$DEODI,X'10'          TAPE DVC                         TSA02710
         BNE   ST$PIO                    NO                             TSA02720
         ENDO                                                           TSA02722
         TM    ST$DMFLG,X'04'           IMM.WAIT REQ?(ONLY FOR CKPT)    TSA02724
         BC    1,ST$WAITF               YES,BYPASS UPDATE               TSA02725
         L     6,ST$DCPID               UPDATE CURRENT POSITION         TSA02730
         LA    6,1(6)                     .                             TSA02740
         ST    6,ST$DCPID                 .                             TSA02750
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA02778
ST$PIO   TM    ST$DCDFG,X'80'          PUNCH ERROR RECOVERY             TSA02780
         BC    1,ST$WAITF                YES                            TSA02790
         ENDO                                                           TSA02792
         TM    ST$DMFLG,X'20'          WAIT = YES                       TSA02800
         BC    8,ST$RETRN                 NO                            TSA02810
ST$WAITF LA    7,ST$SEQ                 SET SUBROUTINE EXIT             TSA02820
ST$WAIT  WAIT  (1)                      WAIT I/O                        TSA02830
         NI    ST$DMFLG,X'BF'           CLEAR WAIT REQUIRED             TSA02840
         MVC   ST$DEFLG+1(1),ST$DTRAN   STORE TRANSMISSION BYTE         TSA02850
         TM    ST$DTRAN,X'68'           GOOD STATUS                     TSA02860
         BC    5,ST$CKIO                 NO                             TSA02870
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA02900
ST$CKUR  TM    ST$DEODI,X'0A'           READER/PUNCH?                   TSA03060
         BCR   8,7                       NO                             TSA03070
         TM    ST$DCCW,X'02'           READ FUNCTION                    TSA03080
         BCR   8,7                       NO                             TSA03090
         L     6,ST$DCCW               CHECK EOF                        TSA03100
         CLC   0(6,6),ST$FIN             .                              TSA03110
         BE    ST$EOF                    .                              TSA03120
         ENDO                                                           TSA03122
         BR    7                         .                              TSA03130
ST$CKIO  EQU   *                                                        TSA03136
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA03138
         CLI   ST$DEODI,X'10'           TAPE DVC?                       TSA03140
         BE    ST$WAIT1                  YES                            TSA03150
         TM    ST$DCDFG,X'80'          PUNCH RECOVERY ACTIVE            TSA03160
         BC    1,ST$CKPRT                YES                            TSA03170
         CLI   ST$DEODI,X'02'          PUNCH DEVICE                     TSA03180
         BNE   ST$CKPRT                  NO                             TSA03190
         OI    ST$DCDFG,X'80'          SET PUNCH RECOVERY ACTIVE        TSA03200
         MVC   ST$DCCW(8),ST$DCCW8     RESTORE PUNCH CCW                TSA03210
         CLI   ST$DCCW,X'41'           PUNCH FUNCTION                   TSA03220
         BE    ST$PIOCS                  YES                            TSA03230
ST$CKPRT NI    ST$DCDFG,X'7F'          CLEAR PUNCH RECOVERY             TSA03240
         CLI   ST$DEODI,X'04'           PRINT DVC                       TSA03250
         BNE   ST$WTERR                   NO                            TSA03260
         TM    ST$DTRAN,X'08'           OVFLO CONDITION?                TSA03270
         BC    8,ST$WTERR                 NO                            TSA03280
         TM    ST$DPRFG,X'80'           OVFLO EXIT                      TSA03290
         BC    8,ST$CKATO                 NO                            TSA03300
         L     15,ST$DEODA              EXIT TO OVFLO ADDRS             TSA03310
         LM    0,12,20(13)                .                             TSA03320
         BR    15                         .                             TSA03330
ST$CKATO TM    ST$DPRFG,X'10'           AUTO SKIP                       TSA03340
         BC    1,ST$RETRN                 NO                            TSA03350
         MVI   ST$DCCW,X'BF'           HOME PAPER                       TSA03360
         B     ST$CNTRL                                                 TSA03370
         ENDO                                                           TSA03372
ST$WAIT1 TM    ST$DTRAN,X'08'          END OF VOLUME                    TSA03380
         BC    1,ST$EOV                   YES                           TSA03390
         TM    ST$DTRAN,X'20'          REWIND IN PROGRESS               TSA03400
         BC    8,ST$WTERR                NO                             TSA03410
         EXCP  (1)                     RE-ISSUE I/O                     TSA03420
         B     ST$WAIT                   .                              TSA03430
ST$WTERR OI    ST$DEFLG,X'10'          SET HARDWARE ERROR BIT           TSA03440
         MVI   ST$DECOD,X'22'           **ERROR** HARDWARE ERROR        TSA03450
         B     ST$ERET1                   .                             TSA03460
ST$SEQ   EQU   *                                                        TSA03466
         DO    ('&URECD'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA03468
         CLI   ST$DEODI,X'10'           TAPE DVC?                       TSA03470
         BNE   ST$RETRN                  NO                             TSA03480
         ENDO                                                           TSA03482
         DO    ('&MTAPE'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA03483
         L     6,ST$DCURR              UPDATE CURRENT                   TSA03490
         BCTR  6,0                        .                             TSA03500
         CLI   ST$DCCW,X'27'           BACK SP BLOCK                    TSA03510
         BE    ST$CLR                    YES                            TSA03520
         TM    ST$DCCW6,X'40'                                           TSA03530
         BC    8,ST$CLR1                                                TSA03540
         L     7,ST$DCCW                IF SHORT BLOCK                  TSA03550
         SH    7,ST$DCCW4                .                              TSA03560
         LA    7,1(7)                    .                              TSA03570
         L     5,ST$DRBC                 ADJUST TO                      TSA03580
         LA    3,0(5,7)                   START OF BUFFER               TSA03590
         LTR   5,5                       .                              TSA03600
         BC    8,ST$CLR                  .                              TSA03610
         LH    5,ST$DCCW4                 .                             TSA03620
         S     5,ST$DRBC                  .                             TSA03630
         XR    4,4                        .                             TSA03640
         D     4,ST$F256                  .                             TSA03650
         LTR   5,5                        .                             TSA03660
         BC    8,ST$EX                    .                             TSA03670
ST$MLOP  MVC   0(256,7),0(3)              .                             TSA03680
         LA    7,256(7)                   .                             TSA03690
         LA    3,256(3)                   .                             TSA03700
         BCT   5,ST$MLOP                  .                             TSA03710
ST$EX    LTR   4,4                        .                             TSA03720
         BC    8,ST$CLR                   .                             TSA03730
         BCTR  4,0                        .                             TSA03740
         EX    4,ST$MOVE                  .                             TSA03750
         B     ST$CLR                     .                             TSA03760
ST$MOVE  MVC   0(0,7),0(3)                .                             TSA03770
ST$CLR1  LA    6,2(6)                                                   TSA03780
ST$CLR   TM    ST$DMFLG,X'04'           IMM WAIT REQ?(ONLY FOR CKPT)    TSA03790
         BO    ST$CLR3                  YES,BYPASS UPDATE               TSA03792
         ST    6,ST$DCURR               UPDATE CURRENT                  TSA03794
         CLI   ST$DFUNC,X'40'           CNTRL?                          TSA03795
         BNE   ST$CLR3                  NO                              TSA03796
         ST    6,ST$DCPID               YES                             TSA03797
ST$CLR3  MVI   ST$DCCW6,X'00'                                           TSA03800
         CLI   ST$DCCW,X'02'           IF READ OP CODE                  TSA03810
         BE    ST$CLR2                   CHECK ASCII INPUT              TSA03820
         CLI   ST$DCCW,X'0C'             .                              TSA03830
         BNE   ST$RETRN                  .                              TSA03840
ST$CLR2  BAL   3,ST$TNSLT                .                              TSA03850
ST$CKPT1 TM    ST$DTFG1,X'10'           CKPT SPECIFIED?                 TSA03851
         BC    8,ST$CKPT4               NO,RETURN                       TSA03852
         TM    ST$DMFLG+1,X'20'         PREV. FN.READ?                  TSA03853
         BC    8,ST$CKPT4               NO,RETURN                       TSA03854
         L     6,ST$DIOA1               BUFFER ADR                      TSA03855
         CLC   0(12,6),ST$CKREC         CKPT HEADER/TRAILER RECORD?     TSA03856
         BNE   ST$CKPT3                 NO,COULD BE DATA OR CKPT RECORD TSA03857
         TM    ST$DMFLG,X'0C'           IMM.WAIT & CKPT PROCG.-BOTH SET TSA03858
         BNO   ST$CKPT2                 NO,CONTINUE CKPT PROCESSING     TSA03859
         NI    ST$DMFLG,X'F7'           YES,TRL.REC.-END OF CKPT. PROCS TSA03860
         B     ST$GET                   READ & WAIT NEXT DATA BLK       TSA03861
ST$CKPT2 OI    ST$DMFLG,X'0C'           SET IMM.WAIT+CKPT PROCESSING    TSA03862
ST$CKPT3 TM    ST$DMFLG,X'08'           CKPT PROCESSING IN PROGRESS?    TSA03863
         BO    ST$GET                   YES,READ NEXT CKPT RECORD       TSA03864
ST$CKPT4 NI    ST$DMFLG,X'F3'           CLEAR CKPT PROCESSING FLAGS     TSA03865
         ENDO
ST$RETRN TM    ST$DTYPE,X'02'           SAT DTF                         TSA03866
         BCR   8,14                      NO                             TSA03870
         LM    15,12,16(13)             RESTORE USER REGS               TSA03880
         BR    14                         EXIT                          TSA03890
         DO    ('&MTAPE'='YES')++(('&MTAPE'='')**('&URECD'=''))         TSA03891
ST$TNSLT TM    ST$DTFG1,X'80'           ASCII                           TSA03900
         BCR   8,3                       NO                             TSA03910
         LH    7,ST$DCCW4               DEVELOPE TRANSLATE              TSA03920
         XR    6,6                        LOOP COUNT                    TSA03930
         D     6,ST$F256                  .                             TSA03940
         L     5,ST$DCCW                POINT TO I/O AREA               TSA03950
         TM    ST$DTFG2,X'04'          READ FORWARD                     TSA03960
         BC    1,ST$T                    YES                            TSA03970
         SH    5,ST$DCCW4              ADJUST TR ADDRESS                TSA03980
         LA    5,1(5)                    FOR READ BACK                  TSA03990
ST$T     L     4,ST$DPCNT              POINT TO TRANSLATE TABLE         TSA04000
         TM    ST$DTFG2,X'01'           OUTPUT FILE                     TSA04010
         BC    1,ST$TSTTR                YES                            TSA04020
         LA    4,256(4)                 POINT TO INPUT TRANSLATE TABLE  TSA04030
ST$TSTTR LTR   7,7                      TRANSLATE LOOP REQUIRED         TSA04040
         BC    8,ST$SBLK                  NO                            TSA04050
ST$TRAN  TR    0(256,5),0(4)            TRANSLATE 256 BYTE              TSA04060
         LA    5,256(5)                   SEGMENTS                      TSA04070
         BCT   7,ST$TRAN                  .                             TSA04080
ST$SBLK  LTR   6,6                      SHORT SEGMENT                   TSA04090
         BCR   8,3                       NO                             TSA04100
         BCTR  6,0                      TRANSLATE                       TSA04110
         EX    6,ST$TRANS                 SHORT SEGMENT                 TSA04120
         BR    3                                                        TSA04130
ST$TRANS TR    0(0,5),0(4)             TRANSLATE SHORT BLOCK            TSA04140
         ENDO                                                           TSA04141
ST$DMSG  LM    14,12,12(13)             RESTORE USER REGS               TSA04150
         SVC   61                       CALL MESSAGE ROUTINE            TSA04160
ST$EOV   TM    ST$DTYPE,X'02'           SAT FILE                        TSA04170
         BC    1,ST$EOV2                  YES                           TSA04180
         OI    207(10),X'40'            SET EOV FLAG                    TSA04190
         BR    14                       RETURN                          TSA04200
ST$EOV2  CLC   ST$DPUB+1(1),ST$DPUB     LAST VOLUME                     TSA04210
         BNE   ST$EOV3                    NO                            TSA04220
ST$EOF   OC    ST$DEODA+1(3),ST$DEODA+1  EOF ADDRESS SPECIFIED          TSA04230
         BC    8,ST$EOV1                    NO                          TSA04240
         L     14,ST$DEODA             EXIT TO EOF ADDRESS              TSA04250
         B     ST$RETRN+6                                               TSA04260
ST$EOV1  MVI   ST$DECOD,X'24'                                           TSA04270
         B     ST$ERET1                                                 TSA04280
ST$EOV3  LA    0,C'V'                  EOV INDICATOR                    TSA04290
         SVC   39                       CLOSE                           TSA04300
         SVC   40                       FEOV                            TSA04310
         SVC   38                       OPEN                            TSA04320
         CLI   ST$DFUNC,X'86'          WAIT FUNCTION                    TSA04330
         BCR   8,14                      YES                            TSA04340
         B     ST$ANAOP                                                 TSA04350
ST$F256  DC    F'256'                                                   TSA04360
ST$FIN   DC    CL6'// FIN'                                              TSA04370
ST$CKREC DC    CL12'/// CHKPT //'                                       TSA04380
ST$UPDAT DC    X'092176'                I4.6                            TSA04381
         VTOC  SAT=YES,PCA=YES                                          TSA04390
ST$DPUB1 EQU   ST$DFLH                                                  TSA04400
ST$DPUB2 EQU   ST$DFHH                                                  TSA04410
ST$DTCA  EQU   ST$DPCA                                                  TSA04420
ST$DTFG1 EQU   ST$DPCA+4                                                TSA04430
ST$DTFG2 EQU   ST$DPCA+5                                                TSA04440
ST$DCPID EQU   ST$DPCA+8                                                TSA04450
ST$DCDFG EQU   ST$DMRB+2                                                TSA04460
ST$DPRFG EQU   ST$DMRB+3                                                TSA04470
ST$DICTL EQU   ST$DBPT                                                  TSA04480
ST$DCTL  EQU   ST$DBPT+1                                                TSA04490
ST$DMBKZ EQU   ST$DBPT+2                                                TSA04500
ST$DPADV EQU   ST$DBPT+3                                                TSA04510
         END                                                            TSA04520
