         PROC  &PT,0,&INPT=,            OS/3 DM PAPER TAPE SYSTEM      XPTI00010
               &LIST=YES,&OUPT=,&SECT=YES,&SHIFT=                       PTI00020
PTIO     NAME  00                                                       PTI00030
         GBL   &SDU$PT1                                                 PTI00040
         GBL   &DU$SA                                                   PTI00050
         LCL   &SFAC                                                    PTI00060
         LCL   &SIN,&SOU,&SHFT,&SLST                                    PTI00070
         DO    '&SDU$PT1'=''                                            PTI00080
&SDU$PT1 SET   0                                                        PTI00090
&SFAC    SET   0                                                        PTI00100
&SIN     SET   0                                                        PTI00110
&SOU     SET   0                                                        PTI00120
&SHFT    SET   0                                                        PTI00130
&SLST    SET   0                                                        PTI00140
         DO    '&SECT'='YES'=0                                          PTI00150
         DS    0H                                                       PTI00160
         ENDO                                                           PTI00170
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  PTI00180
*                                                                    *  PTI00190
*   THE FOLLOWING PROGRAMS ARE THE SOLE PROPERTY OF SPERRY           *  PTI00200
* UNIVAC CONTAINING ITS PROPRIETARY, CONFIDENTIAL INFORMATION        *  PTI00210
*                                                                    *  PTI00220
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  PTI00230
         DO    '&LIST'='YES'                                            PTI00240
&SLST    SET   1                        PRINT NOGEN FOR DSECTS          PTI00250
         ENDO                                                           PTI00260
         DO    ('&INPT'=''=0)++(('&INPT'='')**('&OUPT'=''))             PTI00270
&SIN     SET   1                                                        PTI00280
&SFAC    SET   &SFAC+1                                                  PTI00290
         ENDO                                                           PTI00300
         DO    '&INPT'=''=0                                             PTI00310
         DO    '&INPT'='YES'=0                                          PTI00320
         PNOTE *,'INPT SPECIFICATION MISSPELLED. ACCEPTED AS INPT=YES.' PTI00330
         ENDO                                                           PTI00340
         ENDO                                                           PTI00350
         DO    '&OUPT'=''=0                                             PTI00360
&SOU     SET   1                                                        PTI00370
&SFAC    SET   &SFAC+2                                                  PTI00380
         DO    '&OUPT'='YES'=0                                          PTI00390
         PNOTE *,'OUPT SPECIFICATION MISSPELLED. ACCEPTED AS OUPT=YES.' PTI00400
         ENDO                                                           PTI00410
         ENDO                                                           PTI00420
         DO    '&SHIFT'=''=0                                            PTI00430
&SHFT    SET   1                                                        PTI00440
&SFAC    SET   &SFAC+4                                                  PTI00450
         DO    '&SHIFT'='YES'=0                                         PTI00460
         PNOTE *,'SHIFT SPECIFICATION MISSPELLED.'                      PTI00470
         PNOTE *,'ACCEPTED AS SHIFT=YES.'                               PTI00480
         ENDO                                                           PTI00490
         ENDO                                                           PTI00500
         DO    '&SECT'='YES'                                            PTI00510
DU$PT&SFAC   CSECT                                                      PTI00520
         GOTO  .L010                                                    PTI00530
         ENDO                                                           PTI00540
DU$PT&SFAC   EQU   *                                                    PTI00550
         ENTRY  DU$PT&SFAC                                              PTI00560
.L010    LABEL                                                          PTI00570
         DO    (&SFAC=1=0)**(&SFAC=2=0)                                 PTI00580
         DO    &SIN                                                     PTI00590
DU$PT1   EQU   *                                                        PTI00600
         ENTRY DU$PT1                                                   PTI00610
         ENDO                                                           PTI00620
         DO    &SOU                                                     PTI00630
DU$PT2   EQU   *                                                        PTI00640
         ENTRY DU$PT2                                                   PTI00650
         ENDO                                                           PTI00660
         ENDO                                                           PTI00670
         DO    (&SIN**&SOU)**(&SFAC=3=0)                                PTI00680
DU$PT3   EQU   *                                                        PTI00690
         ENTRY DU$PT3                                                   PTI00700
         ENDO                                                           PTI00710
         DO    (&SIN**&SHFT)**(&SFAC=5=0)                               PTI00720
DU$PT5   EQU   *                                                        PTI00730
         ENTRY DU$PT5                                                   PTI00740
         ENDO                                                           PTI00750
         DO    (&SOU**&SHFT)**(&SFAC=6=0)                               PTI00760
DU$PT6   EQU   *                                                        PTI00770
         ENTRY DU$PT6                                                   PTI00780
         ENDO                                                           PTI00790
         USING *,15                                                     PTI00800
         USING DM$DSCT,1                                                PTI00810
         USING SA$DSECT,13                                              PTI00820
         B     DU$PT010                                                 PTI00830
         DC    XL3'400140'                                              PTI00840
         DC    AL1(&SFAC)                                               PTI00850
         DC    XL2'6114'                76/1/14
DU$PT010 EQU   *                                                        PTI00870
         TSTBIT  DU$B200,DC$CCB         SAVAREA SPEC?                   PTI00880
         BZ    DU$PT020                 NO                              PTI00890
         ST    13,DU$SAVR                                               PTI00900
         L     13,DU$SAVE                                               PTI00910
DU$PT020 EQU   *                                                        PTI00920
         STM   14,12,12(13)             SAVE USER REGISTERS             PTI00930
         MVI   DU$ERFLG,X'00'           CLEAR ERROR FLAGS               PTI00940
         ST    14,SA$R15                STORE NORMAL RETURN ADDRESS     PTI00950
         LA    12,DU$ER000              ERROR/RETURN SUBROUTINE         PTI00960
         SPACE                                                          PTI00970
*        IMPERATIVE MACRO INTERPRETATION                                PTI00980
         SPACE                                                          PTI00990
         TSTBIT DU$B080,DC$CCB                                          PTI01000
         BO    DU$PT030                                                 PTI01010
         MVI   DU$ERCD,DU$ER13          ATTEMP ACCESS TO UNOPEND FILE   PTI01020
         SETBIT DU$B406,DC$CCB          INVALID IMPERATIVE MACRO        PTI01030
         BR    12                       RETURN/ERROR SUBRTN             PTI01040
         EJECT                                                          PTI01050
DU$PT030 EQU   *                                                        PTI01060
         LR    10,0                     WORK AREA                       PTI01070
         DO    &SIN                                                     PTI01080
         TSTBIT  DU$B120,DC$CCB         INPUT FILE?                     PTI01090
         BZ    DU$PT040                 NO                              PTI01100
         CLI   DU$REQS,X'10'            GET?                            PTI01110
         BE    DU$PT100                 YES GET RTN                     PTI01120
DU$PT040 EQU   *                                                        PTI01130
         ENDO                                                           PTI01140
         DO    &SOU                                                     PTI01150
         TSTBIT  DU$B310,DC$CCB         OUTPUT FILE?                    PTI01160
         BZ    DU$PT050                 NO                              PTI01170
         CLI   DU$REQS,X'20'            PUT?                            PTI01180
         BE    DU$PT500                 YES PUT RTN                     PTI01190
DU$PT050 EQU   *                                                        PTI01200
         ENDO                                                           PTI01210
         MVI   DU$ERCD,DU$ER14          INVALID IMPERATIVE MACRO        PTI01220
         SETBIT  DU$B406,DC$CCB         INVALID IMPERATIVE MACRO        PTI01230
         BR    12                       RETURN/ERROR SUBRTN             PTI01240
         DO    &SIN                                                     PTI01250
         EJECT                                                          PTI01260
*        PAPER TAPE GET ROUTINE                                         PTI01270
         SPACE 2                                                        PTI01280
DU$PT100 EQU   *                                                        PTI01290
         L     7,DU$BCW                 DATA ADDR                       PTI01300
         LA    8,DU$IW000               WAIT ROUTINE                    PTI01310
         TSTBIT  DU$B170,DC$CCB                                         PTI01320
         BZ    DU$PT105                 IF OPTIONAL FILE PROCESSING     PTI01330
         SETBIT DU$B050,DC$CCB          SET E-O-F BIT                   PTI01340
DU$PT105 EQU   *                                                        PTI01350
         BAL   14,DU$EF00               END-OF-FILE TEST                PTI01360
         TSTBIT  DU$B090,DC$CCB         FIRST GET AFTER OPEN ?          PTI01370
         BZ    DU$PT110                                                 PTI01380
         CLRBIT  DU$B090,DC$CCB         CLEAR FIRST GET AFTER OPEN      PTI01390
         B     DU$PT120                                                 PTI01400
DU$PT110 EQU   *                                                        PTI01410
         TSTBIT  (DU$B130++DU$B290),DC$CCB   I/O 2 OR WORK?             PTI01420
         BNZ   DU$PT130                                                 PTI01430
DU$PT120 EQU   *                                                        PTI01440
         EXCP  (1)                      READ RECORD                     PTI01450
DU$PT130 EQU   *                                                        PTI01460
         BALR  14,8                     WAIT/CHECK                      PTI01470
         BAL   14,DU$EF00               END-OF-FILE TEST                PTI01480
         TSTBIT DU$B402,DC$CCB                                          PTI01490
         BO    DU$PT140                 IF NO PARITY ERROR THEN         PTI01500
         TSTBIT  DU$B240,DC$CCB         TRANSLATE TABLE ?               PTI01510
         BZ    DU$PT140                                                 PTI01520
         LR    2,11                     NO OF BYTES TO BE TRANSLATED    PTI01530
         BAL   14,DU$PTTL               TRANSLATE ROUTINE               PTI01540
DU$PT140 EQU   *                                                        PTI01550
         DO    &SHFT                                                    PTI01560
         TSTBIT (DU$B210++DU$B220),DC$CCB                               PTI01570
         BZ    DU$PT160                 IF SCAN OR SHIFT TABLES SPEC    PTI01580
         BAL   14,DU$PTIS               INPUT SHIFT ROUTINE             PTI01590
DU$PT160 EQU   *                                                        PTI01600
         ENDO                                                           PTI01610
         TSTBIT  DU$B130,DC$CCB         I/O 2?                          PTI01620
         BZ    DU$PT190                                                 PTI01630
         BAL   14,DU$PTBS               BUFFER SWAP RTN                 PTI01640
DU$PT190 EQU   *                                                        PTI01650
         TSTBIT  DU$B140,DC$CCB         I/O REG ?                       PTI01660
         BZ    DU$PT170                                                 PTI01670
         BAL   14,DU$PTIR               I/O REG RTN                     PTI01680
         B     DU$PT180                                                 PTI01690
DU$PT170 EQU   *                                                        PTI01700
         TSTBIT  DU$B290,DC$CCB         WORK AREA                       PTI01710
         BZ    DU$PT180                                                 PTI01720
         LR    2,11                                                     PTI01730
         TSTBIT  DU$B250,DC$CCB                                         PTI01740
         BZ    DU$PT173                 IF UNDEF RECORDS THEN           PTI01750
         LA    2,1(,2)                  1 TO NO  OF BYTES TO MOVE EOR   PTI01760
DU$PT173 EQU   *                        ENDIF                           PTI01770
         BAL   14,DU$PTMV               MOVE ROUTINE                    PTI01780
DU$PT180 EQU   *                                                        PTI01790
         TSTBIT  (DU$B130++DU$B290),DC$CCB   I/O A2  OR WORK            PTI01800
         BZR   12                                                       PTI01810
         EXCP  (1)                                                      PTI01820
         BR    12                       RETURN/ERROR RTN                PTI01830
         EJECT                                                          PTI01840
*        INPUT WAIT ROUTINE                                             PTI01850
         SPACE 2                                                        PTI01860
DU$IW000 EQU   *                                                        PTI01870
         WAIT  (1)                                                      PTI01880
         TSTBIT  DU$B280,DC$CCB                                         PTI01890
         BZ    DU$IW030                 IF UNRECOV ERROR THEN           PTI01900
         CLRBIT  DU$B280,DC$CCB         CLEAR UNREC ERROR BIT           PTI01910
         TSTBIT  DU$B185,DC$CCB                                         PTI01920
         BO    DU$IW010                 IF NOT PARITY ERROR THEN        PTI01930
         SETBIT  DU$B403,DC$CCB         SET UNRECOV ERROR FLAG BIT      PTI01940
         B     DU$IW020                                                 PTI01950
DU$IW010 EQU   *                                                        PTI01960
         SETBIT  DU$B402,DC$CCB         SET PARITY ERROR FLAG BYTE      PTI01970
DU$IW020 EQU   *                                                        PTI01980
         MVI   DU$ERCD,DU$ER23          UNREC ERR MSG CODE              PTI01990
DU$IW030 EQU   *                                                        PTI02000
         TSTBIT  DU$B260,DC$CCB                                         PTI02010
         BZ    DU$IW040                 IF END-OF-TAPE DETECTED THEN    PTI02020
         CLRBIT DU$B260,DC$CCB          CLEAR UNIQUE ERROR BIT          PTI02030
         SETBIT  DU$B050,DC$CCB         SET EOF BIT                     PTI02040
DU$IW040 EQU   *                                                        PTI02050
         TSTBIT  DU$B250,DC$CCB                                         PTI02060
         BZ    DU$IW050                 IF UNDEF RECORDS THEN           PTI02070
         LH    11,DU$CWCT               BYTE COUNT                      PTI02080
         SH    11,DC$RBC+2              RESIDUAL BYTE COUNT             PTI02090
         BCTR  11,0                                                     PTI02100
         TSTBIT  DU$B190,DC$CCB                                         PTI02110
         BZ    DU$IW047                 IF RECSIZE REG SPEC THEN        PTI02120
         CLI   DU$RCR,68                                                PTI02130
         BH    DU$IW043                 IF NOT REG 13 THEN              PTI02140
         SR    3,3                                                      PTI02150
         IC    3,DU$RCR                                                 PTI02160
         ST    11,0(3,13)                                               PTI02170
         B     DU$IW047                                                 PTI02180
DU$IW043 EQU   *                        RECSIZE REG=13                  PTI02190
         ST    11,DU$SAVR                                               PTI02200
DU$IW047 EQU   *                                                        PTI02210
         TSTBIT  DU$B050,DC$CCB                                         PTI02220
         BOR   14                       IF EOF BIT NOT SET THEN         PTI02230
         TSTBIT  DU$B270,DC$CCB                                         PTI02240
         BOR   14                       IF EOR CHAR NOT DETECTED THEN   PTI02250
         SETBIT  DU$B401,DC$CCB                                         PTI02260
         MVI   DU$ERCD,DU$ER30          WRONG LENGTH ERROR MESSAGE      PTI02270
         BR    14                                                       PTI02280
DU$IW050 EQU   *                                                        PTI02290
         LH    11,DU$CWCT                                               PTI02300
         BR    14                                                       PTI02310
         EJECT                                                          PTI02320
         SPACE 3                                                        PTI02330
*        END-OF-FILE TEST                                               PTI02340
         SPACE                                                          PTI02350
DU$EF00  EQU   *                                                        PTI02360
         TSTBIT  DU$B050,DC$CCB                                         PTI02370
         BZR   14                       IF END-OF-FILE SET THEN         PTI02380
         L     2,DU$PFG1                EOFADDR                         PTI02390
         ST    2,SA$R15                                                 PTI02400
         BR    12                                                       PTI02410
         DO    &SHFT                                                    PTI02420
DU$PTIS  BR    14                       INPUT SHIFT ROUTINE             PTI02430
         ENDO                                                           PTI02440
DU$PTIM  MVC   0(1,10),0(7)             INPUT MOVE INSTR (I/O TO WORK)  PTI02450
         ENDO                                                           PTI02460
         DO    &SOU                                                     PTI02470
         EJECT                                                          PTI02480
*        PUT ROUTINE                                                    PTI02490
         SPACE 2                                                        PTI02500
DU$PT500 EQU   *                                                        PTI02510
         TSTBIT  DU$B170,DC$CCB                                         PTI02520
         BOR   12                       IF NOT OPTIONAL FILE THEN       PTI02530
         L     7,DU$A2                  DATA ADDR TO R7                 PTI02540
         LA    8,DU$W000                WAIT RTN ADDR                   PTI02550
         LH    11,DU$CWCT                                               PTI02560
         BALR  14,8                     WAIT/CHECK                      PTI02570
         TSTBIT  DU$B100,DC$CCB         FIXUNB REC?                     PTI02580
         BO    DU$PT550                 YES                             PTI02590
         CLI   DU$RCR,68                                                PTI02600
         BH    DU$PT510                 PROCESS RECSIZE REG             PTI02610
         SR    2,2                      FOR UNDEFINED RECORDS           PTI02620
         IC    2,DU$RCR                                                 PTI02630
         L     11,0(2,13)                                               PTI02640
         B     DU$PT520                                                 PTI02650
DU$PT510 EQU   *                                                        PTI02660
         L     11,DU$SAVR                                               PTI02670
DU$PT520 EQU   *                                                        PTI02680
         CH    11,DU$BKS                RECSIZE TOO LARGE               PTI02690
         BH    DU$PT530                                                 PTI02700
         LTR   11,11                    RECSIZE ZERO OR MINUS           PTI02710
         BP    DU$PT540                                                 PTI02720
DU$PT530 EQU   *                                                        PTI02730
         MVI   DU$ERCD,DU$ER18          RECORD SIZE INVALID             PTI02740
         SETBIT DU$B407,DC$CCB                                          PTI02750
         BR    12                       RETURN/ERROR SUBRTN             PTI02760
DU$PT540 EQU   *                                                        PTI02770
         STH   11,DU$CWCT               BYTE COUNT TO CCW               PTI02780
         AI    DU$CWCT,1                ADD 1 TO BYTE COUNT             PTI02790
DU$PT550 EQU   *                                                        PTI02800
         DO    &SHFT                                                    PTI02810
         TSTBIT  DU$B220,DC$CCB         SHIFT TABLES ?                  PTI02820
         BO    DU$PTOS                  IF THERE ARE NO SHIFT TABLES    PTI02830
DU$PT555 EQU   *                                                        PTI02840
         ENDO                                                           PTI02850
         TSTBIT  DU$B130,DC$CCB         2 I/O AREAS                     PTI02860
         BZ    DU$PT560                                                 PTI02870
         BAL   14,DU$PTBS               BUFFER SWAP RTN                 PTI02880
DU$PT560 EQU   *                                                        PTI02890
         TSTBIT  DU$B140,DC$CCB         I/O REGISTER                    PTI02900
         BZ    DU$PT570                 NO                              PTI02910
         BAL   14,DU$PTIR               I/O REGISTER RTN                PTI02920
         B     DU$PT590                                                 PTI02930
DU$PT570 EQU   *                                                        PTI02940
         TSTBIT  DU$B290,DC$CCB         WORK AREA                       PTI02950
         BZ    DU$PT590                 IF WORK AREA SPEC THEN          PTI02960
         LR    2,11                     NO OF BYTES TO MOVE TO R2       PTI02970
         BAL   14,DU$PTMV                                               PTI02980
DU$PT590 EQU   *                                                        PTI02990
         TSTBIT  DU$B240,DC$CCB         TRANSLATE TABLE ?               PTI03000
         BZ    DU$PT600                                                 PTI03010
         LR    2,11                     NO OF BYTES TO TRANSLATE TO R2  PTI03020
         BAL   14,DU$PTTL               TRANSLATE ROUTINE               PTI03030
DU$PT600 EQU   *                                                        PTI03040
         TSTBIT  DU$B250,DC$CCB         UNDEFINED RECORDS?              PTI03050
         BZ    DU$PT610                                                 PTI03060
         LR    2,7                                                      PTI03070
         AR    2,11                                                     PTI03080
         MVC   0(1,2),DU$ERM            EORCHAR TO RECORD               PTI03090
DU$PT610 EQU   *                                                        PTI03100
         EXCP  (1)                                                      PTI03110
DU$PT620 EQU   *                                                        PTI03120
         TSTBIT (DU$B130++DU$B290),DC$CCB    IOA2 OR WORK?              PTI03130
         BNZR  12                       RETURN                          PTI03140
         LR    14,12                                                    PTI03150
         BR    8                       WAIT/CHECK AND RETURN TO USER    PTI03160
         SPACE 2                                                        PTI03170
*        OUTPUT WAIT ROUTINE                                            PTI03180
         SPACE 2                                                        PTI03190
DU$W000  EQU   *                                                        PTI03200
         WAIT  (1)                                                      PTI03210
         TSTBIT  DU$B280,DC$CCB                                         PTI03220
         BZR   14                       IF UNRECOV ERROR THEN           PTI03230
         CLRBIT DU$B280,DC$CCB          CLEAR UNREC ERROR BIT           PTI03240
         SETBIT  DU$B403,DC$CCB         SET UNRECOV ERROR FLAG BYTE     PTI03250
         MVI   DU$ERCD,DU$ER23          UNRECOV ERROR MSG               PTI03260
         BR    14                                                       PTI03270
DU$PTOM  MVC   0(1,7),0(10)             OUTPUT MOVE INSTR   WORK TO I/O PTI03280
         DO    &SHFT                                                    PTI03290
DU$PTOS  EQU   *                        OUTPUT SHIFT ROUTINE            PTI03300
         B     DU$PT555                                                 PTI03310
         ENDO                                                           PTI03320
         ENDO                                                           PTI03330
         SPACE 3                                                        PTI03340
*        I/O REGISTER RTN                                               PTI03350
         SPACE                                                          PTI03360
DU$PTIR  EQU   *                                                        PTI03370
         L     2,DU$A2                                                  PTI03380
         CLI   DU$IRG,68                IF I/O REG NOT 13               PTI03390
         BH    DU$IR10                  THEN                            PTI03400
         SR    3,3                                                      PTI03410
         IC    3,DU$IRG                                                 PTI03420
         ST    2,0(3,13)                                                PTI03430
         BR    14                       RETURN                          PTI03440
DU$IR10  EQU   *                        ELSE                            PTI03450
         ST    2,DU$SAVR                                                PTI03460
         BR    14                       RETURN                          PTI03470
         SPACE 3                                                        PTI03480
*        BUFFER SWAP RTN                                                PTI03490
         SPACE                                                          PTI03500
DU$PTBS  XC    DU$IOB(3),DU$A2+1                                        PTI03510
         XC    DU$A2+1(3),DU$IOB                                        PTI03520
         EX    0,DU$PTBS                                                PTI03530
         BR    14                                                       PTI03540
         EJECT                                                          PTI03550
*        MOVE  DATA ROUTINE                                             PTI03560
         SPACE                                                          PTI03570
DU$PTMV  EQU   *                                                        PTI03580
         LA    3,256                                                    PTI03590
         LR    4,2                      PRESERVE RECORD SIZE            PTI03600
DU$MV10  EQU   *                                                        PTI03610
         CR    2,3                                                      PTI03620
         BNL   DU$MV20                  IF  R2 .LTE. R3 THEN            PTI03630
         LR    3,2                                                      PTI03640
DU$MV20  EQU   *                        ENDIF                           PTI03650
         BCTR  3,0                                                      PTI03660
         DO    &SIN**&SOU                                               PTI03670
         TSTBIT  DU$B120,DC$CCB                                         PTI03680
         BZ    DU$MV30                  IF INPUT FILE THEN              PTI03690
         ENDO                                                           PTI03700
         DO    &SIN                                                     PTI03710
         EX    3,DU$PTIM                INPUT MOVE                      PTI03720
         ENDO                                                           PTI03730
         DO    &SIN**&SOU                                               PTI03740
         B     DU$MV40                                                  PTI03750
DU$MV30  EQU   *                        ELSE  OUTPUT FILE               PTI03760
         ENDO                                                           PTI03770
         DO    &SOU                                                     PTI03780
         EX    3,DU$PTOM                OUTPUT MOVE                     PTI03790
         ENDO                                                           PTI03800
         DO    &SIN**&SOU                                               PTI03810
DU$MV40  EQU   *                        ENDIF                           PTI03820
         ENDO                                                           PTI03830
         LA    3,1(,3)                                                  PTI03840
         AR    7,3                                                      PTI03850
         AR    10,3                                                     PTI03860
         SR    2,3                                                      PTI03870
         BP    DU$MV10                  IF R2  .LTE.  0 THEN            PTI03880
         SR    7,4                      RESTORE DATA ADDR               PTI03890
         SR    10,4                     RESTORE WORK AREA ADDRESS       PTI03900
         BR    14                       RETURN                          PTI03910
         SPACE 3                                                        PTI03920
*        TRANSLATE DATA ROUTINE                                         PTI03930
         SPACE                                                          PTI03940
DU$PTTL  EQU   *                                                        PTI03950
         LA    3,256                                                    PTI03960
         LR    4,2                      RECORD SIZE                     PTI03970
         L     5,DU$TAB                 TRANSLATION TABLE ADDRESS       PTI03980
DU$TL10  EQU   *                                                        PTI03990
         CR    2,3                                                      PTI04000
         BNL   DU$TL20                  IF R2  .LTE. R3 THEN            PTI04010
         LR    3,2                                                      PTI04020
DU$TL20  EQU   *                        ENDIF                           PTI04030
         BCTR  3,0                                                      PTI04040
         EX    3,DU$PTTR                TRANSLATE DATA                  PTI04050
         LA    3,1(,3)                                                  PTI04060
         AR    7,3                                                      PTI04070
         SR    2,3                                                      PTI04080
         BP    DU$TL10                  IF  R2 .LTE. 0  THEN            PTI04090
         SR    7,4                      RESTORE DATA ADDR               PTI04100
         BR    14                       RETURN                          PTI04110
DU$PTTR  TR    0(1,7),0(5)              TRANSLATE INSTRUCTION           PTI04120
         EJECT                                                          PTI04130
*        ERROR/RETURN ROUTINE                                           PTI04140
DU$ER000 EQU   *                                                        PTI04150
         TSTBIT  X'FF',DU$ERFLG                                         PTI04160
         BZ    DU$ER030                 IF ERRORS THEN                  PTI04170
         TSTBIT  DU$B320,DC$CCB                                         PTI04180
         BZ    DU$ER020                 IF USER ERROR RTN               PTI04190
         TSTBIT  DU$B200,DC$CCB                                         PTI04200
         BZ    DU$ER010                 IF SAVAREA SPEC THEN            PTI04210
         LM    14,12,12(13)              RESTORE REG                    PTI04220
         L     13,DU$SAVR                                               PTI04230
         SVC   61                                                       PTI04240
DU$ER010 EQU   *                        SAVAREA NOT SPEC                PTI04250
         LM    14,12,12(13)                                             PTI04260
         SVC   61                                                       PTI04270
DU$ER020 EQU   *                                                        PTI04280
         LA    14,DU$ER030                                              PTI04290
         SVC   61                                                       PTI04300
DU$ER030 EQU   *                                                        PTI04310
         TSTBIT  X'FF',DU$ERFLG                                         PTI04320
         BNZ   DU$ER035                 IF NO ERRORS THEN               PTI04330
         CLRBIT DU$B050,DC$CCB          CLEAR E-O-F BIT                 PTI04340
DU$ER035 EQU   *                                                        PTI04350
         TSTBIT  DU$B200,DC$CCB                                         PTI04360
         BZ    DU$ER040                 IF SAVAREA SPEC THEN            PTI04370
         LM    14,12,12(13)                                             PTI04380
         L     13,DU$SAVR                                               PTI04390
         BR    15                                                       PTI04400
DU$ER040 EQU   *                        ELSE                            PTI04410
         LM    14,12,12(13)                                             PTI04420
         BR    15                                                       PTI04430
         DC    XL50'00'                 50 BYTE PATCH AREA              PTI04440
         DO    &SLST=0                                                  PTI04450
         PRINT NOGEN                                                    PTI04460
         ENDO                                                           PTI04470
         DO    '&DU$SA'=''                                              PTI04480
&DU$SA   SET   0                                                        PTI04490
         SA$DSECT                                                       PTI04500
         ENDO                                                           PTI04510
         DTFDM PT=YES                                                   PTI04520
         DO    &SLST=0                                                  PTI04530
         PRINT GEN                                                      PTI04540
         ENDO                                                           PTI04550
         DO    '&SECT'='YES'                                            PTI04560
&SYSECT  CSECT                                                          PTI04570
         ENDO                                                           PTI04580
         EJECT                                                          PTI04590
         ENDO                                                           PTI04600
         END                                                            PTI04610
