&LBL     PROC  &PAR,1,&CSECT=YES        DM PAPER TAPE (DTFPI) SYSTEM    PII00010
PIIO     NAME  1                                                        PII00020
&LBL     DC    0Y(0)                                                    PII00030
         EJECT                                                          PII00040
*                                                                     * PII00050
*********************************************************************** PII00060
*                                                                     * PII00070
*        GET MODUL FOR SPERRY UNIVAC 0921 PAPERTAPE SUBSYSTEM         * PII00080
*        HANDLING ALL COMBINATIONS OF RECFORM FIXUNB OR UNDEFINED:    * PII00090
*              SHIFT OR NONSHIFT CODE TRANSLATION                     * PII00100
*              DELETING                                               * PII00110
*              ALTERNATE I/O AREA                                     * PII00120
*              WORKAREA                                               * PII00130
*              RECORD SIZE REGISTER FOR UNDEFINED RECORDS             * PII00140
*              I/O REGISTER                                           * PII00150
*              HANDLING BEGIN OF FILE MARKER                          * PII00160
*              PARITY CHECKING                                        * PII00170
*                                                                     * PII00180
*                                                                     * PII00190
*********************************************************************** PII00200
*                                                                     * PII00210
*    THE FOLLOWING PROGRAM IS THE SOLE PROPERTY OF SPERRY             * PII00220
*                                                                     * PII00230
* UNIVAC CONTAINING ITS PROPRIETARY, CONFIDENTIAL INFORMATION         * PII00240
*                                                                     * PII00250
*********************************************************************** PII00260
         EJECT                                                          PII00270
         LCL   &SCT                                                     PII00280
&SCT     SET   0                                                        PII00290
         DO    '&CSECT'='YES'                                           PII00300
&SCT     SET   1                                                        PII00310
DU$PII1  CSECT                                                          PII00320
         ENDO                                                           PII00330
         DO    '&CSECT'='YES'=0                                         PII00340
DU$PII1  EQU   *                                                        PII00350
         ENTRY DU$PII1                                                  PII00360
         ENDO                                                           PII00370
         USING *,15                                                     PII00380
         USING SA$DSECT,13                                              PII00390
         USING DM$DSCT,1                                                PII00400
         DTFDM PT=YES                                                   PII00410
         SA$DSECT                                                       PII00420
         B     PI$START                                                 PII00430
         DC    XL2'6114'                76/1/14                         PII00445
PI$START EQU   *                                                        PII00450
         ST    13,DU$SAVR               SAVE REGISTER 13                PII00460
         TSTBIT DU$B200,DC$CCB          SAVAREA SPECIFIED               PII00470
         BZ    *+8                      NO: SKIP NEXT INSTRUCTION       PII00480
         L     13,DU$SAVE               YES: GET ADDRESS SAVEAREA       PII00490
         STM   14,12,SA$R14             SAVE USER REGISTERS             PII00500
         XC    DU$ERFLG,DU$ERFLG        CLEAR ERROR FLAG                PII00510
         MVI   DU$ERCD,0                CLEAR MESSAGE CODE              PII00520
         TSTBIT DU$B080,DC$CCB          FILE OPEN                       PII00530
         BO    PI$G010                  YES: ENTER PROCESSING           PII00540
         MVI   DU$ERCD,DU$ER13          SET MSG CODE FILE NOT OPEN      PII00550
         SETBIT DU$B406,DC$CCB          SET INVALID MACRO CALL          PII00560
*                                                                       PII00570
*        ERROR SUBROUTINE FOR MESSAGE DISPLAY                           PII00580
*                                                                       PII00590
PI$ER    EQU   *                                                        PII00600
         TSTBIT DU$B320,DC$CCB          ERROR SPECIFIED                 PII00610
         BZ    PI$ER10                  NO: SKIP NEXT TWO INSTRUCTIONS  PII00620
         MVC   SA$R15,DU$ERCD           ADDRESS ERROR ROUTINE TO REG15  PII00630
         BZ    PI$ER10+6                SKIP NEXT INSTRUCTION           PII00640
PI$ER10  EQU   *                                                        PII00650
         MVC   SA$R15,SA$R14            SET REG15 TO RETURN ADDRESS     PII00660
         LM    14,12,SA$R14             RESTORE USER REGISTERS          PII00670
         L     13,DU$SAVR                                               PII00680
         SVC   61                       CALL MESSAGE TRANSIENT          PII00690
*                                                                       PII00700
*        INITIALIZE GET MODUL                                           PII00710
*                                                                       PII00720
PI$G010  EQU   *                                                        PII00730
         TSTBIT DU$B050,DC$CCB          END OF FILE                     PII00740
         BZ    PI$G020                  NO: CONTINUE PROCESSING         PII00750
PI$G015  EQU   *                                                        PII00760
         MVC   SA$R15+1(3),DU$EOD       SET EOFADDR TO USER REGISTER 15 PII00770
         B     PI$RET+6                                                 PII00780
PI$G020  EQU   *                                                        PII00790
         L     3,DU$A1                  GET IOAREA1                     PII00800
         LH    5,DU$BKS                 GET BUFFER LENGTH               PII00810
         TSTBIT DU$B090,DC$CCB          FIRST GET AFTER OPEN            PII00820
         BO    PI$G030                  YES: CALL READ                  PII00830
        TSTBIT (DU$B290++DU$B130),DC$CCB IOAREA2AND/OR WORKA SPECIFIED  PII00840
         BNZ   PI$G030+4                YES: SKIP READ                  PII00850
PI$G030  EQU   *                                                        PII00860
         BAL   14,PI$RD                 CALL READ SUBROUTINE            PII00870
         BAL   14,PI$WTC                CALL WAITCHECK                  PII00880
         L     3,DU$A1                  RESTORE REG 3                   PII00890
         LH    5,DU$BKS                 AND REG 5                       PII00900
         TSTBIT DU$B090,DC$CCB          FIRST GET                       PII00910
         BO    PI$BOF                   YES: CALL BOF-HANDLING          PII00920
PI$G035  EQU   *                        ENTRY IF NO BOFM SPECIFIED      PII00930
         SETBIT DU$B050,DC$CCB          SET END OF FILE EXIT            PII00940
         LH    6,DU$REC                 GET RECORD SIZE                 PII00950
         BAL   14,PI$FET                CALL FILE END TEST              PII00960
         BAL   14,PI$PAR                CALL PARITY CHECK               PII00970
*                                                                       PII00980
*        IOREG SPECIFIED                                                PII00990
*                                                                       PII01000
         TSTBIT DU$B140,DC$CCB          I/O REG SPECIFIED               PII01010
         BZ    PI$G050                  NO                              PII01020
         CLI   DU$IRG,72                IOREG=(13)                      PII01030
         BNE   PI$G040                  NO                              PII01040
         ST    3,DU$SAVR                STORE I/O REGISTER              PII01050
         B     PI$G050                                                  PII01060
PI$G040  EQU   *                                                        PII01070
         XR    2,2                      CLEAR REGISTER 2                PII01080
         IC    2,DU$IRG                 GET DISPLACEMENT IOREG IN SAVAR PII01090
         ST    3,0(2,13)                EA AND STORE IOREG              PII01100
PI$G050  EQU   *                                                        PII01110
         L     4,DU$A1                  GET IOAREA ADDRESS              PII01120
         TSTBIT DU$B210,DC$CCB          EXISTS SCAN TABLE               PII01130
         BO    PI$SC                    CALL SCAN HANDLING              PII01140
*                                                                       PII01150
*        HANDLING WITHOUT SCAN TABLE: SHIFT DATAS TO WORKAREA           PII01160
*                                                                       PII01170
         TSTBIT DU$B290,DC$CCB          WORKAREA SPECIFIED              PII01180
         BZ    PI$G060                  NO                              PII01190
         L     4,SA$R0                  GET ADDRESS WORKAREA            PII01200
         BAL   14,PI$MOVE               MOVE DATA TO WORKAREA           PII01210
*                                                                       PII01220
*        TRANSLATION OF NONSHIFT CODE                                   PII01230
*                                                                       PII01240
PI$G060  EQU   *                                                        PII01250
         TSTBIT DU$B240,DC$CCB          TRANS SPECIFIED                 PII01260
         BZ    PI$G080                  NO                              PII01270
         L     10,DU$TAB                GET TRANSLATE TABLE             PII01280
         LA    7,256                    GET MAX. TRANSLATE LENGTH       PII01290
PI$G070  EQU   *                                                        PII01300
         CR    6,7                      LENGTH LESS MAXIMUM             PII01310
         BNL   *+6                      NO: SKIP NEXT INSTRUCTION       PII01320
         LR    7,6                      GET LENGTH                      PII01330
         BCTR  7,0                      GET EXECUTION LENGTH            PII01340
         EX    7,PI$TR                  TRANSLATE                       PII01350
         LA    7,1(,7)                  RESTORE LENGTH                  PII01360
         LA    4,0(7,4)                 GET ADDR OF REM                 PII01370
         SR    6,7                      GET REM. LENGTH                 PII01380
         BP    PI$G070                  PERFORM NEXT TRANSLATE          PII01390
         LH    6,DU$REC                 RESTORE REG 6                   PII01400
*                                                                       PII01410
*        COMPUTE REMAINDING DATA IN BUFFER. RETURN FROM SCAN HANDLING   PII01420
*                                                                       PII01430
PI$G080  EQU   *                                                        PII01440
         XC    DU$LGTH,DU$LGTH          CLEAR REMAINDER LENGTH          PII01450
         SR    5,6                      GET LENGTH                      PII01460
         BZ    PI$G090                  LENGTH ZERO                     PII01470
         STH   5,DU$LGTH                STOR LENGTH AND DESPLACEMENT    PII01480
         STH   6,DU$DISP                OF REMAINDER                    PII01490
*                                                                       PII01500
*        SWAP BUFFERS IF IOAREA2                                        PII01510
*                                                                       PII01520
PI$G090  EQU   *                                                        PII01530
         TSTBIT DU$B130,DC$CCB          IOAREA2 SPECIFIED               PII01540
         BZ    PI$G100                  NO                              PII01550
         L     3,DU$A1                                                  PII01555
         L     4,DU$A2                  GET ADDRESS OF OTHER BUFFER     PII01560
         LH    6,DU$BKS                 GET BUFFER LENGTH               PII01570
         BAL   14,PI$MOVE               SHIFT DATAS                     PII01580
         ST    4,DU$A1                  SWAP BUFFER ADDRESSES           PII01590
         ST    3,DU$A2                                                  PII01600
*                                                                       PII01610
*        FILL UP BUFFER                                                 PII01620
*                                                                       PII01630
PI$G100  EQU   *                                                        PII01640
        TSTBIT (DU$B130++DU$B290),DC$CCB IOAREA2 AND/OR WORKA SPECIFIED PII01650
         BZ    PI$G110                  NO: SKIP  READ AND RETURN       PII01660
         L     3,DU$A1                                                  PII01670
         LH    5,DU$BKS                                                 PII01680
         BAL   14,PI$RD                 CALL READ                       PII01690
*                                                                       PII01700
*        RETURN TO USER                                                 PII01710
*                                                                       PII01720
PI$G110  EQU   *                                                        PII01730
         CLI   DU$ERFLG,0               ANY ERRORS                      PII01740
         BE    PI$RET                   NO: RETURN                      PII01750
         TSTBIT DU$B320,DC$CCB          ERROR SPECIFIED                 PII01760
         BZ    PI$RET                                                   PII01770
         MVC   SA$R15(4),DU$ERCD        SET RETURN TO ERROR ROUTINE     PII01780
         B     PI$RET+6                                                 PII01790
PI$RET   EQU   *                                                        PII01800
         MVC   SA$R15,SA$R14            SET RETURN ADDRESS              PII01810
         LM    14,12,SA$R14             RESTORE USER REGISTERS          PII01820
         L     13,DU$SAVR                                               PII01830
         BR    15                       RETURN TO USER                  PII01840
*                                                                       PII01850
*        EXECUTE INSTRUCTIONS                                           PII01860
*                                                                       PII01870
PI$BC    CLI   0(3),0                   COMPARE TO DETECT BOF MARKERS   PII01880
PI$TRT   TRT   0(1,3),0(10)             PARITY CHECK AND SCANHANDLING   PII01890
PI$TR    TR    0(1,4),0(10)             EXECUTE TRANSLATION             PII01900
PI$MVC   MVC   0(1,4),0(3)              MOVE DATA                       PII01910
*                                                                       PII01920
*        DATA MOVE SUBROUTINE                                           PII01930
*                                                                       PII01940
PI$MOVE  EQU   *                                                        PII01950
         LR    2,6                      GET MOVE LENGTH TO REG2         PII01960
         LA    7,256                    GET MAXIMAL MOVE LENGTH         PII01970
PI$M010  EQU   *                                                        PII01980
         CR    2,7                      MAXIMAL LENGTH TO SHIFT         PII01990
         BNL   *+6                      YES:SKIP NEXT INSTRUCTION       PII02000
         LR    7,2                      GET LENGTH                      PII02010
         BCTR  7,0                      GET EXECUTION LENGTH            PII02020
         EX    7,PI$MVC                 SHIFT DATAS                     PII02030
         LA    7,1(,7)                  RESTORE LENGTH                  PII02040
         LA    3,0(7,3)                 GET NEW ADDRESS FOR             PII02050
         LA    4,0(7,4)                 DATA SHIFT                      PII02060
         SR    2,7                      COMPUTE REMAINDING              PII02070
         BP    PI$M010                                                  PII02080
         SR    4,6                      RESTORE REGISTERS               PII02090
         SR    3,6                                                      PII02100
         BR    14                       RETURN                          PII02110
*                                                                       PII02120
*        WAIT CHECK SUBROUTINE                                          PII02130
*                                                                       PII02140
PI$WTC   EQU   *                                                        PII02150
         TSTBIT DU$B230,DC$CCB          I/O COMPLETE                    PII02160
         BO    *+6                      YES                             PII02170
         SVC   1                        NO                              PII02180
         TSTBIT DU$B280,DC$CCB         ANY I/O ERRORS                   PII02190
         BZR   14                       NO: RETURN                      PII02200
         MVI   DU$ERCD,DU$ER22          YES: SET MSG CODE HARDWARE ERR. PII02210
         SETBIT DU$B403,DC$CCB          SET ERROR BIT                   PII02220
         B     PI$ER                    EXIT TO ERROR MESSAGE RETURN    PII02230
*                                                                       PII02240
*        PARITY CHECK SUBROUTINE                                        PII02250
*                                                                       PII02260
PI$PAR   EQU   *                                                        PII02270
         TSTBIT DU$B300,DC$CCB          PARITY CHECK SPECIFIED          PII02280
         BZR   14                       NO: RETURN                      PII02290
         LR    2,6                      GET CHECK LENGTH                PII02300
         LA    7,256                    MAXIMAL LENGTH FOR CHECK        PII02310
         L     10,DU$PAR                GET ADDRESS PARITY TABLE        PII02320
         LR    11,3                     GET CHECK ADDRESS               PII02330
PI$P010  EQU   *                                                        PII02340
         CR    2,7                      MAXIMAL LENGTH TO BE CHECKED    PII02350
         BNL   *+6                      YES: SKIP NEXT INSTRUCTION      PII02360
         LR    7,2                      NO: GET LENGTH                  PII02370
         BCTR  7,0                      GET EXECUTE LENGTH              PII02380
         EX    7,PI$TRT                 EXECUTE CHECK                   PII02390
         BNZ   PI$P020                  UNPARITY DETECTED               PII02400
         LA    7,1(,7)                  RESTORE LENGTH                  PII02410
         SR    2,7                      GET REM LENGTH                  PII02420
         BNP   PI$P040                  ZERO: RETURN                    PII02430
         LA    3,0(7,3)                 GET NEXT ADDRESS                PII02440
         B     PI$P010                  PERFORM NEXT CHECK              PII02450
PI$P020  EQU   *                                                        PII02460
         L     1,SA$R1                  RESTORE REG 1                   PII02470
         TSTBIT DU$B250,DC$CCB          RECFORM=UNDEFINED               PII02480
         BZ    PI$P030                  NO                              PII02490
         STC   2,DU$REP                 STORE UNPARITY TYPE             PII02500
         CLI   DU$REP,X'10'             IS IT EORM                      PII02510
         BE    PI$P040                  YES: RETURN                     PII02520
PI$P030  EQU   *                                                        PII02530
         SETBIT DU$B402,DC$CCB          SET PARITY ERROR BIT            PII02540
PI$P040  EQU   *                                                        PII02550
         LR    3,11                                                     PII02560
         BR    14                       RETURN TO CALLER.               PII02570
*                                                                       PII02580
*        SUBROUTINE TO DELETE AND SHIFT OUT BEGIN OF FILE MARKER        PII02590
*                                                                       PII02600
PI$BOF   EQU   *                                                        PII02610
         TSTBIT DU$B030,DC$CCB          ANY BOFM SPECIFIED              PII02620
         BO    PI$B020                  YES: PROCESS                    PII02630
PI$B010  EQU   *                                                        PII02640
         CLRBIT DU$B090,DC$CCB          CLEAR FIRST GET                 PII02650
         B     PI$G035                  RETURN                          PII02660
PI$B020  EQU   *                                                        PII02670
         IC    2,DU$BF0                 GET BOFM                        PII02680
         EX    2,PI$BC                  COMPARE ACTUAL CHARACTER        PII02690
         BNE   PI$B040                  NOT EQUAL                       PII02700
         NI    DU$OPS,X'EF'             CLEAR BOFM NOT FOUND            PII02710
PI$B030  EQU   *                                                        PII02720
         LA    3,1(,3)                  GET NEXT CHARACTER              PII02730
         BCT   5,PI$B020                PERFORM LOOP                    PII02740
         L     3,DU$A1                  RESTORE REG3                    PII02750
         LH    5,DU$BKS                 AND REG 5                       PII02760
         B     PI$G030                                                  PII02770
PI$B040  EQU   *                                                        PII02780
         TM    DU$OPS,2                 BFM1 SPECIFIED                  PII02790
         BZ    PI$B070                  NO                              PII02800
         IC    2,DU$BF1                 GET BFM1 AND                    PII02810
         EX    2,PI$BC                  COMPARE WITH ACTUAL CHARACTER   PII02820
         BNE   PI$B050                  NOT EQUAL                       PII02830
         NI    DU$OPS,X'DF'             CLEAR BFM NOT FOUND             PII02840
         B     PI$B030                  RETURN TO HANDLE NEXT CHARACTER PII02850
PI$B050  EQU   *                                                        PII02860
         TM    DU$OPS,4                 BFM2 SPECIFIED                  PII02870
         BZ    PI$B070                  NO                              PII02880
         IC    2,DU$BF2                 GET BFM2 AND                    PII02890
         EX    2,PI$BC                  COMPARE WITH ACTUAL CHARACTER   PII02900
         BNE   PI$B060                  NOT EQUAL                       PII02910
         NI    DU$OPS,X'BF'             CLEAR BFM2 NOT FOUND            PII02920
         B     PI$B030                                                  PII02930
PI$B060  EQU   *                                                        PII02940
         TM    DU$OPS,8                 BFM3&SPECIFIED                  PII02950
         BZ    PI$B070                  NO                              PII02960
         IC    2,DU$BF3                 GET BFM3 AND                    PII02970
         EX    2,PI$BC                  COMPARE WITH ACTUAL CHARACTER   PII02980
         BNE   PI$B070                                                  PII02990
         NI    DU$OPS,X'7F'             CLEAR BFM3 NOT FOUND            PII03000
         B     PI$B030                  RETURN TO HANDLE NEXT CHARACTER PII03010
PI$B070  EQU   *                                                        PII03020
         TM    DU$OPS,X'F0'             ALL SPECIFIED BFM POUND         PII03030
         BNZ   PI$B090                  NO: DISPLAY MESSAGE             PII03040
PI$B080  EQU   *                                                        PII03050
         C     3,DU$A1                  ANY TO SHIFT OUT                PII03060
         BE    PI$B010                  NO: CALL EXIT                   PII03070
         S     3,DU$A1                  GET DISPLACEMENT                PII03080
         STH   3,DU$DISP                STORE TO DISPLACEMENT           PII03090
         STH   5,DU$LGTH                STORE LENGTH OF REMAINDER       PII03100
         L     3,DU$A1                  RESTORE REG3                    PII03110
         CLRBIT DU$B090,DC$CCB          CLEAR FIRST ENTRY AFTER GET     PII03120
         B     PI$G030                  EXIT TO FILL UP BUFFER          PII03130
PI$B090  EQU   *                                                        PII03140
         LA    2,DU$REP                 GET REPLY ADDRESS               PII03150
         LA    1,DU$MSG1                GET MESSAGE ADDRESS             PII03160
         LA    0,60                     GET MESSAGE LENGTH              PII03170
         LA    7,1                      GET REPLY LENGTH                PII03180
PI$B100  EQU   *                                                        PII03190
         OPR   (1),(0),,REPLY,(2),(7)   DISPLAY MESSAGE                 PII03200
         CLI   0(2),C'C'                REPLY=CANCEL                    PII03210
         BNE   PI$B110                  NO                              PII03220
         LM    14,12,SA$R14             RESTORE USER REGISTERS          PII03230
         L     13,DU$SAVR                                               PII03240
         CANCEL                                                         PII03250
PI$B110  EQU   *                                                        PII03260
         CLI   0(2),C'I'                REPLY=IGNORE                    PII03270
         BNE   PI$B100                  NO:REPEAT MESSAGE               PII03280
         L     1,SA$R1                  RESTORE REGISTER 1              PII03290
         B     PI$B080                  GOTO EXIT                       PII03300
*                                                                       PII03310
*        SCAN TABLE HANDLING                                            PII03320
*                                                                       PII03330
PI$SC    EQU   *                                                        PII03340
         XR    8,8                      CLEAR REGISTER 8 FOR BYTE COUNT PII03350
         LR    4,3                      GET I/O ADDRESS                 PII03360
         TSTBIT DU$B290,DC$CCB          WORKA SPECIFIED                 PII03370
         BZ    *+8                      NO: SKIP NEXT INSTRUCTION       PII03380
         L     4,SA$R0                  YES: GET ADDR. WORKAREA         PII03390
PI$S010  EQU   *                                                        PII03400
         XR    2,2                      CLEAR REGISTER 2                PII03410
         L     10,DU$SCAN               GET ADDRESS OF SCAN TABLE       PII03420
         LA    7,256                    GET MAXIMAL LENGTH              PII03430
         CR    7,6                      GREATER THAN REMAINDER          PII03440
         BNH   *+6                      NO: SKIP NEXT INSTRUCTION       PII03450
         LR    7,6                      GET REMS. LENGTH                PII03460
         BCTR  7,0                      GET EXECUTION LENGTH            PII03470
         EX    7,PI$TRT                 ANY SCANNING SPECIFIED          PII03480
         BNZ   PI$S040                  YES                             PII03490
         BAL   14,PI$SHAN               CALL PROCESSING OF CHARACTERS   PII03500
PI$S015  EQU   *                                                        PII03510
         SR    6,7                      ANY REMAINDING IN BUFFER        PII03520
         BNZ   PI$S010                  YES                             PII03530
         CH    8,DU$REC                 DESIRED RECORD LENGTH REACHED   PII03540
         BNE   PI$S020                  NO                              PII03550
         LR    6,8                      YES RECORD LENGTH TO REG 6      PII03560
         TSTBIT DU$B250,DC$CCB          RECFOR=UNDEFINED                PII03570
         BZ    PI$G080                  NO: RETURN                      PII03580
         SETBIT DU$B401,DC$CCB          YES: SET WRONG LENGTH ERROR     PII03590
         B     PI$EOR                   CALL EXIT TO USER IN EOR.       PII03600
PI$S020  EQU   *                                                        PII03610
         L     6,DU$A1                  GET ADDRESS OF FIRST BYTE       PII03620
         AH    6,DU$BKS                 BEHIND IOAREA                   PII03630
         SR    6,3                      IN PROCESS                      PII03640
         BZ    PI$S030                  YES                             PII03650
PI$S025  EQU   *                                                        PII03660
         LH    11,DU$REC                GET RECSIZE                     PII03670
         SR    11,8                     GET NUMBER OF BYTES TO FILL     PII03680
         CR    6,11                     MORE BYTE IN BUFFER THAN TO BE  PII03690
         BNH   PI$S010                  PROCESSED  NO                   PII03700
         LR    6,11                     YES. GET COUNT                  PII03710
         B     PI$S010                  RETURN TO HANDLING              PII03720
PI$S030  EQU   *                                                        PII03730
         XC    DU$LGTH(4),DU$LGTH       CLEAR REMAINDER POINTER         PII03740
         SR    5,8                      GET REM. LENGTH                 PII03750
         L     3,DU$A1                  GET I/O AREA                    PII03760
         AR    3,8                      GET READ ADDRESS                PII03770
         BAL   14,PI$R010               CALL READ                       PII03780
         BAL   14,PI$WTC                CALL WAIT CHECK                 PII03790
         BAL   14,PI$FET                CALL FILE END TEST              PII03800
         BAL   14,PI$PAR                CALL PARITY CHECK               PII03810
         LR    6,5                      GET REM LENGTH                  PII03820
         LH    5,DU$BKS                 RESTORE REG 5                   PII03830
         B     PI$S025                  CONTINUE PROCESSING             PII03840
PI$S040  EQU   *                                                        PII03850
         LR    7,1                      GET SCAN-ADDRESS TO 7           PII03860
         L     1,SA$R1                  RESTORE REG 1                   PII03870
         SR    7,3                      GET LENGTH                      PII03880
         BAL   14,PI$SHAN                                               PII03890
PI$BT    B     PI$BT(2)                 BRANCH TABLE FOR SCAN-CHAR.     PII03900
         B     PI$SFIG                  FIGURE SHIFT CHARACTER          PII03910
         B     PI$SLIT                  LETTER SHIFT CHARACTER          PII03920
         B     PI$SDEL                  DELETE CHARACTER                PII03930
PI$EOR   EQU   *                        END OF RECORD MARKER            PII03940
         TSTBIT DU$B250,DC$CCB          RECORD FORMAT UNDEFINED         PII03950
         BZ    PI$S015                  NO: GO TO EXIT                  PII03960
         TSTBIT DU$B190,DC$CCB          RECSIZE=(R) SPECIFIED           PII03970
         BZ    PI$E030                  NO                              PII03980
         CLI   DU$RCR,72                YES: R=13                       PII03990
         BNE   PI$E020                  NO                              PII04000
         ST    8,DU$SAVR                STORE LENGTH TO USER REG 13     PII04010
         B     PI$E030                  GO TO EXIT                      PII04020
PI$E020  EQU   *                                                        PII04030
         IC    2,DU$RCR                 GET DISPLACEMENT OF R           PII04040
         ST    8,0(2,13)                STORE LENGTH TO R               PII04050
PI$E030  EQU   *                                                        PII04060
         LR    6,3                      GET ADDRESS FIRST BYTE BEHIND   PII04070
         S     6,DU$A1                  RECORD. GET RECORD LENGTH GROSS PII04080
         B     PI$G080                  EXIT                            PII04090
*                                                                       PII04100
*        FIGURE SHIFT HANDLING, LETTER SHIFT HANDLING                   PII04110
*                                                                       PII04120
PI$SFIG  EQU   *                                                        PII04130
         TSTBIT DU$B220,DC$CCB          SHIFT TABLES SPECIFIED          PII04140
         BZ    PI$S015                  NO: IGNORE SHIFT AND RETURN     PII04150
         MVC   DU$TAB(4),DU$TABF        SET FTRANS NEW ACT. TRANSTABLE  PII04160
         B     PI$SDEL                  EXIT TO DELETE CHARACTER        PII04170
PI$SLIT  EQU   *                                                        PII04180
         TSTBIT DU$B220,DC$CCB          SHIFT TABLES SPECIFIED          PII04190
         BZ    PI$S015                  NO: IGNORE SHIFT AND RETURN     PII04200
         MVC   DU$TAB(4),DU$TABL        SET LTRANS TO NEW ACT.TRANSTAB. PII04210
         B     PI$SDEL                  EXIT TO DELETE CHARACTER        PII04220
*                                                                       PII04230
*        DELETING OF CHARACTERS                                         PII04240
*                                                                       PII04250
PI$SDEL  EQU   *                                                        PII04260
         BCTR  8,0                      DECREMENT DATA COUNT            PII04270
         BCTR  4,0                      DECREMENT NEXT WORKA-ADDR.      PII04280
         B     PI$S015                  EXIT                            PII04290
*                                                                       PII04300
*        NONSHIFT=DATA CHARACTER HANDLING                               PII04310
*                                                                       PII04320
PI$SHAN  EQU   *                                                        PII04330
         CR    4,3                      PROCESSING IN THIS AREA         PII04340
         BE    *+8                      YES:SKIP NEXT INSTRUCTION       PII04350
         EX    7,PI$MVC                 MOVE TO PROCESSING AREA         PII04360
        TSTBIT (DU$B220++DU$B240),DC$CCB ANY TRANSLATION SPECIFIED      PII04370
         BZ    PI$SH10                  NO                              PII04380
         L     10,DU$TAB                GET TRANLATE TABLE              PII04390
         EX    7,PI$TR                  TRANSLATE                       PII04400
PI$SH10  EQU   *                                                        PII04410
         LA    7,1(,7)                  INCREMENT PROC. SIZE            PII04420
         LA    8,0(8,7)                 INCREMENT COUNTER               PII04430
         LA    3,0(3,7)                 GET NEXT DATA ADDRESS           PII04440
         LA    4,0(4,7)                 GET NEXT WORKADDR               PII04450
         BR    14                                                       PII04460
*                                                                       PII04470
*        END OF FILE TEST ROUTINE                                       PII04480
*                                                                       PII04490
PI$FET   EQU   *                                                        PII04500
         CLC   0(5,3),DU$EFCON          END OF FILE CONDITION           PII04510
         BNE   PI$F010                  NO                              PII04520
         TSTBIT DU$B050,DC$CCB          END OF FILE INDICATOR ON        PII04530
         BO    PI$G015                  GOTO EOFADDR. EXIT              PII04540
         SETBIT DU$B050,DC$CCB          SET END OF FILE INDICATOR       PII04550
         SETBIT DU$B110,DC$CCB          SET INHIBIT READ                PII04560
         BR    14                                                       PII04570
PI$F010  EQU   *                                                        PII04580
         CLRBIT DU$B050,DC$CCB          CLEAR EOF-EXIT                  PII04590
         NC    DC$RBC(4),DC$RBC         RESIDUAL BYTE COUNT ZERO        PII04600
         BZR   14                       YES                             PII04610
         L     2,DU$BCW                 GET LAST READ ADDRESS           PII04620
         AH    2,DU$CWCT                ADD LAST READ LENGTH            PII04630
         S     2,DC$RBC                 GET LAST READ BYTE              PII04640
         SH    2,=H'5'                  SUBTRACT 5                      PII04650
         CLC   0(5,2),DU$EFCON          LAST 5 BYTE EOF-CONDITION       PII04660
         BE    PI$F010-6                GO TO RETURN                    PII04670
         LA    2,DU$REP                 GET REPLY ADDRESS               PII04680
         LA    0,60                     GET MESSAGE LENGTH              PII04690
         LA    1,DU$MSG2                GET MESSAGE ADDRESS             PII04700
         LA    7,1                      GET REPLY LENGTH                PII04710
PI$F020  EQU   *                                                        PII04720
         OPR   (1),(0),,REPLY,(2),(7)   DISPLAY MESSAGE                 PII04730
         CLI   0(2),C'F'                END OF FILE                     PII04740
         BE    PI$F030                  YES                             PII04750
         CLI   0(2),C'T'                NO: END OF TAPE                 PII04760
         BNE   PI$F020                  NO:REPEAT MESSAGE               PII04770
         L     1,SA$R1                  RESTORE REGISTER 1              PII04780
         L     2,DU$A1                  GET ADDRESS                     PII04790
         AH    2,DU$BKS                 TO FILL UP                      PII04800
         S     2,DC$RBC                 BUFFER                          PII04810
         ST    2,DU$BCW                 PREPARE                         PII04820
         MVC   DU$CWCT(2),DC$RBC+2      CHANNEL                         PII04830
         MVI   DU$BCW,2                 COMMAND WORD                    PII04840
         SVC   0                        FILL UP BUFFER                  PII04850
         LR    12,14                    SAVE RETURN ADDRESS             PII04860
         BAL   14,PI$WTC                CALL WAIT CHECK                 PII04870
         LR    14,12                    RESTORE RETURN ADDRESS          PII04880
         B     PI$F010+4                RETURN TO CHECK RDC             PII04890
PI$F030  EQU   *                                                        PII04900
         L     1,SA$R1                  RESTORE REGISTER 1              PII04910
         LR    9,14                     SAVE RETURN REGISTER            PII04920
         L     7,DC$RBC                 GET RESIDUAL BYTE COUNT         PII04930
         LR    11,3                     SAVE REGISTER 3                 PII04940
         L     3,DU$A1                  GET ADDRESS IN BUFFER TO BE     PII04950
         AH    3,DU$BKS                 FILLED UP FROM WITH EOFM        PII04960
         SR    3,7                                                      PII04970
         LR    12,4                     SAVE REGISTER 4                 PII04980
         BAL   14,PI$R025               FILL UP BUFFER WITH EOFM        PII04990
         XC    DC$RBC(4),DC$RBC         CLEAR RBC                       PII05000
        SETBIT (DU$B060++DU$B110),DC$CCB SET END OF FILE MOVE AND INHI- PII05010
         BR    9                        BIT READ. RETURN                PII05020
*                                                                       PII05030
*        READ  SUBROUTINE                                               PII05040
*                                                                       PII05050
PI$RD    EQU   *                                                        PII05060
         OC    DU$LGTH(2),DU$LGTH       ANY REMAINDER IN BUFFER         PII05070
         BZ    PI$R010                  NO                              PII05080
         LR    4,3                      GET MOVE ADDRESSES              PII05090
         LH    5,DU$DISP                GET READ LENGTH                 PII05100
         AR    3,5                      GET MOVE ADDRES                 PII05110
         LR    12,14                    SAVE RETURN ADDRESS             PII05120
         LH    6,DU$LGTH                GET REMAINDER LENGTH            PII05130
         BAL   14,PI$MOVE               CALL SHIFT                      PII05140
         SR    3,5                      RESTORE REGISTER 3              PII05150
         LR    14,12                    RESTORE RETURN ADDRESS          PII05160
         AR    3,6                                                      PII05170
PI$R010  EQU   *                                                        PII05180
         ST    3,DU$BCW                 PREPARE CCW                     PII05190
         STH   5,DU$CWCT                                                PII05200
         MVI   DU$BCW,2                                                 PII05210
         TSTBIT DU$B060,DC$CCB          EOF MOVE                        PII05220
         BO    PI$R020                  YES                             PII05230
         TSTBIT DU$B110,DC$CCB          NO: INHIBIT READ                PII05240
         BOR   14                       YES: RETURN                     PII05250
         SVC   0                        NO: READ                        PII05260
         BR    14                       RETURN                          PII05270
PI$R020  EQU   *                                                        PII05280
         LR    12,4                     SAVE REGISTER4                  PII05290
         LR    11,3                     AND 3                           PII05300
         LR    7,5                      GET FILL UP LENGTH              PII05310
PI$R025  EQU   *                                                        PII05320
         LA    2,5                      GET EFCON LENGTH                PII05330
         LR    4,3                                                      PII05340
         LA    3,DU$EFCON                                               PII05350
PI$R030  EQU   *                                                        PII05360
         CR    2,7                      FILL UP BUFFER                  PII05370
         BNH   *+6                      WITH END OF FILE                PII05380
         LR    2,7                      MARKERS                         PII05390
         BCTR  2,0                                                      PII05400
         EX    2,PI$MVC                 SHIFT EOF TO BUFFER             PII05410
         LA    2,1(,2)                                                  PII05420
         SR    7,2                                                      PII05430
         BZ    PI$R040                                                  PII05440
         LA    4,0(2,4)                                                 PII05450
         B     PI$R030                                                  PII05460
PI$R040  EQU   *                                                        PII05470
         LR    4,12                     RESTORE REGISTER 4              PII05480
         LR    3,11                     AND REG 3                       PII05490
         BR    14                       RETURN                          PII05500
         LTORG                                                          PII05510
         ORG   *+200                                                    PII05520
         DO    &SCT                                                     PII05530
&SYSECT  CSECT                                                          PII05540
         ENDO                                                           PII05550
         END                                                            PII05560
