         PROC  &P,1,&OUTPUT=YES,&INPUT=YES,&UPDATE=YES                  SAM00010
SAMIO3   NAME  1                                                        SAM00020
SAMIO    NAME  1        CALL TO GENERATE SAM PROCESSOR                  SAM00030
DSPIO    NAME  1                                                        SAM00040
DSPS1    NAME  1                                                        SAM00050
DAMIO3   NAME  2                                                        SAM00060
DAMIO    NAME  2        CALL TO GENERATE DAM PROCESSOR                  SAM00070
NAMIO3   NAME  3                                                        SAM00080
NAMIO    NAME  3        CALL TO GENERATE COMBINED I/O PROCESSOR         SAM00090
         LCL   &FB,&N1,&N2,&N3,&N4,&N5                                  SAM00100
         GBL   &M$D                                                     SAM00110
         DO    &P(0)=2                                                  SAM00120
&FB      SET   7964                                                     SAM00130
&N5      SET   64                                                       SAM00140
DD$D111  CSECT                                                          SAM00150
&N2      SET   'D'                                                      SAM00160
&N1      SET   1                                                        SAM00170
&N3      SET   1                                                        SAM00180
&N4      SET   1                                                        SAM00190
         GOTO  .LBL1                                                    SAM00200
         ENDO                                                           SAM00210
&N1      SET   1*('&OUTPUT'='YES')                                      SAM00220
&N3      SET   1*(('&INPUT'='YES')**('&UPDATE'='YES'))                  SAM00230
&N4      SET   1*('&INPUT'='YES')                                       SAM00240
         DO    &P(0)=1                                                  SAM00250
&N2      SET   'S'                                                      SAM00260
&FB      SET   2077                                                     SAM00270
&N5      SET   32                                                       SAM00280
         GOTO  .LBL2                                                    SAM00290
         ENDO                                                           SAM00300
&N2      SET   'N'                                                      SAM00310
&FB      SET   7965                                                     SAM00320
&N5      SET   96                                                       SAM00330
.LBL2    LABEL                                                          SAM00340
&FB      SET   &FB+64*('&OUTPUT'='YES')+32*('&INPUT'='YES')             SAM00350
&FB      SET   &FB+2*(('&INPUT'='YES')**('&UPDATE'='YES'))              SAM00360
DD$&N2.&N1.&N3.&N4   CSECT                                              SAM00370
         DO    (&N1=1)**(&N3=1)**(&N4=1)                                SAM00380
         DO    &P(0)=3                                                  SAM00390
         ENTRY DD$S001                                                  SAM00400
         ENTRY DD$S011                                                  SAM00410
         ENTRY DD$S100                                                  SAM00420
         ENTRY DD$S101                                                  SAM00430
         ENTRY DD$S111                                                  SAM00440
         ENTRY DD$D111                                                  SAM00450
         ENDO                                                           SAM00460
         ENTRY DD$&N2.001                                               SAM00470
         ENTRY DD$&N2.011                                               SAM00480
         ENTRY DD$&N2.100                                               SAM00490
         ENTRY DD$&N2.101                                               SAM00500
         DO    &P(0)=3                                                  SAM00510
DD$S001  EQU   *                                                        SAM00520
DD$S011  EQU   *                                                        SAM00530
DD$S100  EQU   *                                                        SAM00540
DD$S101  EQU   *                                                        SAM00550
DD$S111  EQU   *                                                        SAM00560
DD$D111  EQU   *                                                        SAM00570
         ENDO                                                           SAM00580
DD$&N2.001   EQU *                                                      SAM00590
DD$&N2.011   EQU *                                                      SAM00600
DD$&N2.100   EQU *                                                      SAM00610
DD$&N2.101   EQU  *                                                     SAM00620
         GOTO  .LBL1                                                    SAM00630
         ENDO                                                           SAM00640
         DO    (&N1=1)**(&N3=0)**(&N4=1)                                SAM00650
         DO    &P(0)=3                                                  SAM00660
         ENTRY DD$S001                                                  SAM00670
         ENTRY DD$S100                                                  SAM00680
         ENTRY DD$S101                                                  SAM00690
         ENTRY DD$D111                                                  SAM00700
         ENDO                                                           SAM00710
         ENTRY DD$&N2.100                                               SAM00720
         ENTRY DD$&N2.001                                               SAM00730
         DO    &P(0)=3                                                  SAM00740
DD$S001  EQU   *                                                        SAM00750
DD$S100  EQU   *                                                        SAM00760
DD$S101  EQU   *                                                        SAM00770
DD$D111  EQU   *                                                        SAM00780
         ENDO                                                           SAM00790
DD$&N2.100   EQU *                                                      SAM00800
DD$&N2.001   EQU *                                                      SAM00810
         GOTO  .LBL1                                                    SAM00820
         ENDO                                                           SAM00830
         DO    (&N1=1)**(&N3=0)**(&N4=0)                                SAM00840
         DO    &P(0)=3                                                  SAM00850
         ENTRY DD$S100                                                  SAM00860
         ENTRY DD$D111                                                  SAM00870
DD$S100  EQU   *                                                        SAM00880
DD$D111  EQU   *                                                        SAM00890
         ENDO                                                           SAM00900
         ENDO                                                           SAM00910
         DO    (&N1=0)**(&N3=1)**(&N4=1)                                SAM00920
         DO    &P(0)=3                                                  SAM00930
         ENTRY DD$S001                                                  SAM00940
         ENTRY DD$S011                                                  SAM00950
         ENTRY DD$D111                                                  SAM00960
         ENDO                                                           SAM00970
         ENTRY DD$&N2.001                                               SAM00980
         DO    &P(0)=3                                                  SAM00990
DD$S001  EQU   *                                                        SAM01000
DD$S011  EQU   *                                                        SAM01010
DD$D111  EQU   *                                                        SAM01020
         ENDO                                                           SAM01030
DD$&N2.001   EQU *                                                      SAM01040
         ENDO                                                           SAM01050
.LBL1    LABEL                                                          SAM01060
         DO    0                                                        SAM01070
*   REGISTER UTILIZATION:                                               SAM01080
*        RF$ _ COVER REGISTER FOR I/O PROCESSOR/SAT PROCESSOR           SAM01090
*        R1$ _ POINTS TO DTF/CCB                                        SAM01100
*        DC$ _ COVER FOR PARTITION                                      SAM01110
*        RE$ _ RETURN ADDR TO CALLING PROG/LINKAGE TO SAT PROCESSOR     SAM01120
*        RD$ _ REGISTER SAVE AREA ADDRESS                               SAM01130
         ENDO                                                           SAM01140
         USING *,RF$                                                    SAM01150
         USING DM$DSCT,1                                                SAM01160
         USING NI$DPCA,12                                               SAM01170
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  SAM01180
*                                                                    *  SAM01190
*   THE FOLLOWING PROGRAMS ARE THE SOLE PROPERTY OF SPERRY           *  SAM01200
*                                                                    *  SAM01210
* UNIVAC CONTAINING ITS PROPRIETARY, CONFIDENTIAL INFORMATION        *  SAM01220
*                                                                    *  SAM01230
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  SAM01240
         DO    '&M$D'=''                                                SAM01250
&M$D     SET   0                                                        SAM01260
R0$      EQU   0                                                        SAM01270
R1$      EQU   1                                                        SAM01280
D2$      EQU   2                                                        SAM01290
D3$      EQU   3                                                        SAM01300
D4$      EQU   4                                                        SAM01310
D5$      EQU   5                                                        SAM01320
D6$      EQU   6                                                        SAM01330
D7$      EQU   7                                                        SAM01340
D8$      EQU   8                                                        SAM01350
D9$      EQU   9                                                        SAM01360
DA$      EQU   10                                                       SAM01370
DB$      EQU   11                                                       SAM01380
DC$      EQU   12                                                       SAM01390
RD$      EQU   13                                                       SAM01400
RE$      EQU   14                                                       SAM01410
RF$      EQU   15                                                       SAM01420
         ENDO                                                           SAM01430
*  COMMON IOCS PROCESSOR                                                SAM01440
         B     DD$IO                                                    SAM01450
         DC    Y(&N5)                   PROCESSOR TYPE CODE             SAM01460
         DC    Y(&FB)                   PROCESSOR FACILITIES BYTES      SAM01470
DD$IOA   DC    A(DD$ERRTN-DD$&N2.&N1.&N3.&N4)  DISP TO I/O ERROR RTNE   SAM01480
         DC    X'FFFF'                  PROCESSOR ID                    SAM01490
         DC    10F'0'                                                   SAM01500
DD$IO    EQU   *                                                        SAM01510
         ST    RD$,DC$SAVR              STORE REG 13                    SAM01520
         CLI   DC$SAV,X'F0'             SAVAREA SPECIFIED ?             SAM01530
         BE    DD$C1                    NO,DD$C1                        SAM01540
         L     RD$,DC$SAV               YES,LOAD SAVAREA ADDRESS        SAM01550
DD$C1    STM   RE$,DC$,12(RD$)          STORE USER REGS.                SAM01560
         LR    14,15                    PUT BASE ADDR                   SAM01562
         A     14,DD$IOA                PLUS ERROR RTNE DISP            SAM01564
         ST    14,DC$ERCD               IN ERROR ADDR                   SAM01566
         TM    DC$MFLG,X'80'       FILE OPEN ?                          SAM01570
         BO    DD$C10              YES, CONTINUE                        SAM01580
         OI    DC$ERFLG,X'02'      SET INVALID MACRO SEQ FLAG           SAM01590
         MVI   DC$ERCD,X'13'       SET FILE NOT OPEN ERROR CODE         SAM01600
         BAL   14,DD$ERRTN         EXIT WITH ERROR                      SAM01610
DD$C10   MVC   DC$FCS(1),DC$REQS   SAVE FUNCTION CODE                   SAM01620
         L     12,DC$PADDR              LOAD CURRENT PCA COVER          SAM01630
         MVI   DC$ERCD,0                CLEAR ERROR CORE FIELD          SAM01640
         NI    DC$ERFLG,X'80'           CLEAR ERROR FLAG 1              SAM01650
         TM    DC$DTF,X'60'             VALID DTF TYPE CODE ?           SAM01660
         BNZ   DD$C2                    YES, CONTINUE                   SAM01670
         OI    DC$ERFLG,X'40'           SET INVALID DTF FLAG            SAM01680
         MVI   DC$ERCD,X'15'            SET INVALID DTF CODE            SAM01690
         BAL   14,DD$ERRTN              LINK TO ERROR ROUTINE           SAM01700
DD$C2    EQU   *                                                        SAM01710
         DO    &P(0)=2=0                                                SAM01720
         TM    DC$FG1,X'80'             OPTIONAL FILE ?                 SAM01730
         BNO   DD$C2A                   NO                              SAM01740
         DO    '&OUTPUT'='YES'                                          SAM01750
         TM    DC$FG3,X'80'             OUTPUT FILE ?                   SAM01760
         BO    DD$EXIT                  YES, RETURN                     SAM01770
         ENDO                                                           SAM01780
         DO    '&INPUT'='YES'                                           SAM01790
         TM    DC$FG3,X'60'             INPUT FILE ?                    SAM01800
         BNZ   DD$EOF1                  YES, GO TO EOF                  SAM01810
         ENDO                                                           SAM01820
         B     DD$ERR                   INVALID MACRO                   SAM01830
DD$C2A   EQU   *                                                        SAM01840
         ENDO                                                           SAM01850
         CLI   DC$REQS,X'41'            CNTRL SEEK ?                    SAM01860
         BE    DD$CTL3                  YES                             SAM01870
         DO    &P(0)=2=0                                                SAM01880
         TM    DC$DTF,X'20'             SD SPECIFIED ?                  SAM01890
         BNO   DD$DA                    NO, TEST DA                     SAM01900
         DO    '&INPUT'='YES'                                           SAM01910
         CLI   DC$REQS,X'10'            GET ?                           SAM01920
         BE    DD$GET                   YES                             SAM01930
         ENDO                                                           SAM01940
         DO    ('&OUTPUT'='YES')++(('&INPUT'='YES')**('&UPDATE'='YES')) SAM01950
         CLI   DC$REQS,X'20'            PUT ?                           SAM01960
         BE    DD$PUT                   YES                             SAM01970
         ENDO                                                           SAM01980
         DO    '&OUTPUT'='YES'                                          SAM01990
         CLI   DC$REQS,X'82'            TRUNC ?                         SAM02000
         BE    DD$TRUNC                 YES                             SAM02010
         ENDO                                                           SAM02020
       DO  '&INPUT'='YES'                                               SAM02030
         CLI   DC$REQS,X'80'            RELSE ?                         SAM02040
         BE    DD$RELSE                 YES                             SAM02050
       ENDO                                                             SAM02060
         CLI   DC$DTF,X'20'       SD FILE ?                             SAM02070
         BNE   DD$DA              NO                                    SAM02080
         CLI   DC$REQS,X'84'            FEOV ISSUED ?                   SAM02090
         BE    DD$FEOV                  YES                             SAM02100
         ENDO                                                           SAM02110
DD$DA    EQU   *                                                        SAM02120
         DO    &P(0)=1=0                                                SAM02130
         TM    DC$DTF,X'40'             DA SPECIFIED ?                  SAM02140
         BNO   DD$NI                    NO, TEST NI                     SAM02150
         CLI   DC$REQS,X'86'            WAITF ISSUED ?                  SAM02160
         BE    DD$WTF                   YES                             SAM02170
         TM    DC$REQS,X'30'            READ/WRITE ?                    SAM02180
         BM    DD$INOUT                 YES                             SAM02190
         ENDO                                                           SAM02200
DD$NI    EQU   *                                                        SAM02210
         DO    &P(0)=3                                                  SAM02220
         CLI   DC$DTF,X'60'             NI FILE ?                       SAM02230
         BNE   DD$ERR                   NO, INVALID MACRO               SAM02240
         CLI   DC$REQS,X'C4'            SETP ?                          SAM02250
         BE    DD$SET1                  YES                             SAM02260
         TM    DC$REQS,X'C0'            NOTE/POINT/POINTS ?             SAM02270
         BO    DD$CTL                   YES                             SAM02280
         ENDO                                                           SAM02290
DD$ERR   OI    DC$ERFLG,X'02'           SET INVALID MACRO FLAG          SAM02300
DD$ERR1  MVI   DC$ERCD,X'14'            SET INVALID MACRO/MACRO SEQ     SAM02310
         MVC   DC$REQS(1),DC$FCS        RESTORE FUNCTION CODE           SAM02320
DD$ERR2  BAL   14,DD$ERRTN              LINK TO ERROR ROUTINE           SAM02330
DD$EXIT  EQU   *                                                        SAM02335
         DO    &P(0)=2=0                                                SAM02340
         DO    ('&OUTPUT'='YES')++(('&INPUT'='YES')**('&UPDATE'='YES')) SAM02341
         TM    DC$FG3,X'80'             OUTPUT?                         SAM02342
         BO    DD$EXIT0                 YES                             SAM02343
         TM    DC$FG6,X'20'             EXTEND ACTIVE?                  SAM02344
         BZ    DD$EXIT3                 NO,EXIT                         SAM02345
DD$EXIT0 CLC   DC$PCAID(4),DC$PMBA      CURRENT=MAX?                    SAM02346
         BL    DD$EXIT3                 LOW EXIT                        SAM02347
         BH    DD$EXIT1                 HIGH,CHECK BUFFER               SAM02348
         TM    DC$FG4,X'40'             IF EQUAL,IOA2?                  SAM02349
         BZ    DD$EXIT3                 NO,EXIT                         SAM02350
DD$EXIT1 TM    DC$FG5,X'10'             BUFFER UPDATED?                 SAM02351
         BO    DD$EXIT2                 YES,EXTEND                      SAM02352
         TM    DC$FG6,X'02'             IF NO,BUFFER ACTIVE?            SAM02353
         BZ    DD$EXIT3                 NO,EXIT                         SAM02354
DD$EXIT2 LR    10,1                     EXTEND                          SAM02355
         SVC   46                       SV$EXSAT                        SAM02356
         SVC   48                       SV$UL3                          SAM02357
         B     DD$ERRTN                 ERROR IN EXTEND                 SAM02358
DD$EXIT3 EQU   *                                                        SAM02359
         ENDO                                                           SAM02360
         ENDO
         LM    14,12,12(13)             RESTORE USER REGS               SAM02361
         L     13,DC$SAVR                                               SAM02362
         BR    14                       RETURN                          SAM02363
DD$INOUT EQU   *                                                        SAM02370
         DO    &P(0)=1=0                                                SAM02380
         TM    DC$FG4,X'04'             WAITF REQUIRED                  SAM02390
         BNO   DD$INOT1                NO                               SAM02400
         OI    DC$ERFLG,X'03'           SET WAITF/MACRO SEQ ERROR       SAM02410
         B     DD$ERR1                  EXIT WITH ERROR                 SAM02420
DD$INOT1 EQU   *                                                        SAM02430
         ENDO                                                           SAM02440
         DO    &P(0)=1=0                                                SAM02450
         DO    &P(0)=3                                                  SAM02460
         TM    DC$FG1,X'80'             OPTIONAL FILE FLAG SET ?        SAM02470
         BNO   DD$RDWR1                 NO, CONTINUE                    SAM02480
         MVI   DC$ERCD,X'33'            SET ERROR CODE                  SAM02490
         OI    DC$ERFLG,X'02'           SET INV MACRO CODE              SAM02500
         BAL   14,DD$ERRTN              EXIT WITH ERROR                 SAM02510
         ENDO                                                           SAM02520
DD$RDWR1 NI    DC$PFG1,X'DF'       CLEAR SEQ BIT                        SAM02530
         NI    DC$RFM+1,X'7F'           CLEAR FORMAT WRITE LAST ISSUED  SAM02540
         DO    &P(0)=3                                                  SAM02550
         TM    DC$FG4,X'10'             IOREG SPECIFIED ?               SAM02560
         BNO   DD$RDWR                  NO, CONTINUE                    SAM02570
         L     3,DC$A2                  LOAD BUFFER ADDRESS             SAM02580
         CLI   DS$IRG,X'10'             R13 SPECIFIED FOR IOREG ?       SAM02590
         BNE   DD$RDWR0                 NO                              SAM02600
         ST    3,DC$SAVR                YES, STORE FOR R13              SAM02610
         B     DD$RDWR                                                  SAM02620
DD$RDWR0 LH    7,DS$IRG                 LOAD IOREG DISPLACEMENT         SAM02630
         ST    3,0(7,13)                STORE IN SAVEAREA               SAM02640
         ENDO                                                           SAM02650
DD$RDWR  OI    DC$FG4,X'04'             SET WAITF REQUIRED              SAM02660
         CLI   DC$REQS,X'11'            READ/IR ?                       SAM02670
         BNE   DD$RW50                  NO                              SAM02680
         NI    DC$FG5,X'D0'             SET READ/ID ISSUED              SAM02690
         B     DD$RW50A                 EXIT                            SAM02700
DD$RW50  CLI   DC$REQS,X'12'            READ/KEY ISSUED ?               SAM02710
         BNE   DD$RW5                   NO                              SAM02720
         OI    DC$FG5,X'04'             SET READ/KEY ISSUED             SAM02730
         NI    DC$FG5,X'D4'                                             SAM02740
         TM    DC$FG1,X'10'            SEARCH MULTIPLE REQUIRED ?       SAM02750
         BNO   DD$RW50A                 NO                              SAM02760
         TM    DC$MFLG+1,X'40'          CYLINDER ALIGNED ?              SAM02770
         BNO   DD$RW50A                 NO                              SAM02780
         OI    DC$PBKS+2,X'40'          YES, SET MULTI-TRK SEARCH BIT   SAM02790
DD$RW50A BAL   3,DD$WAIT                WAIT OUTSTANDING I/O            SAM02800
         OI    DC$CCBF2,X'20'           SET ACCEPT UNIQUE FLAG          SAM02810
         B     DD$RW10A                 EXIT                            SAM02820
DD$RW5   CLI   DC$REQS,X'21'            WRITE/ID ?                      SAM02830
         BNE   DD$RW7A                  NO                              SAM02840
         OI    DC$FG5,X'08'             SET WRITE/ID ISSUED             SAM02850
         NI    DC$FG5,X'D8'                                             SAM02860
         B     DD$RW10A                 EXIT TO CONVERT ADDRESS         SAM02870
DD$RW7A  CLI   DC$REQS,X'22'            WRITE/KEY ?                     SAM02880
         BNE   DD$RW9A                  NO                              SAM02890
         TM    DC$FG5,X'0C'             WRITE/KEY LAST ISSUED ?         SAM02900
         BO    DD$ERR                   YES, EXIT WITH ERROR            SAM02910
DD$RW7B  OI    DC$FG5,X'0C'             SET WRITE/KEY ISSUED            SAM02920
         NI    DC$FG5,X'DC'                                             SAM02930
         B     DD$RW10A                 EXIT TO CONVERT ADDRESS         SAM02940
DD$RW9A  TM    DC$FG2,X'40'             AFTER SPEC ?                    SAM02950
         BNO   DD$ERR                   NO, ERROR                       SAM02960
         OI    DC$RFM+1,X'80'           SET FORMAT WRITE ISSUED         SAM02970
         CLI   DC$REQS,X'25'            RZERO ?                         SAM02980
         BNE   DD$RW11A                 NO                              SAM02990
         NI    DC$ERFLG,X'7F'           CLEAR END TRACK FLAG            SAM03000
         BAL   14,DD$RCVRT              CONVERT RELATIVE ADDRESS        SAM03010
         NI    DC$RFM+1,X'7F'           CLEAR FORMAT WRITE BIT          SAM03020
         B     DD$EXIT                  EXIT                            SAM03030
DD$RW11A CLI   DC$REQS,X'23'            WRITE AFTER ?                   SAM03040
         BE    DD$RW12A                 YES                             SAM03050
         CLI   DC$REQS,X'24'            AFTER/EOF ?                     SAM03060
         BE    DD$EXIT                  YES, RETURN                     SAM03070
         B     DD$ERR                   NO, SET INVALID MACRO ERROR     SAM03080
DD$RW12A OI    DC$PFG1,X'20'       SET SEQ BIT                          SAM03090
         CLC   DC$EODID(3),DD$HIEOD+1   CUR EOD>HI EOD ?                SAM03100
         BNH   DD$RW10A            NO, BYPASS SWAP                      SAM03110
         BAL   11,DD$SWEOD              SWAP HI/CURRENT EOD             SAM03120
DD$RW10A BAL   14,DD$RCVRT              LINK TO ADDRESS CONVERSION      SAM03130
         DO    &P(0)=3                                                  SAM03140
         NI    DC$FG6,X'FB'        CLEAR IOA2 READ REQUIRED             SAM03150
         ENDO                                                           SAM03160
         TM    DC$REQS,X'20'           WRITE ?                          SAM03170
         BNO   DD$RW10B                NO                               SAM03180
         CLI   DC$RFM,X'02'            VARUNB ?                         SAM03190
         BNE   DD$RW10B                 NO                              SAM03200
         L     3,DC$A1                 LOAD I/O BUFFER ADDRESS          SAM03210
         XR    5,5                                                      SAM03220
         TM    DC$PFG1,X'40'           INTERLACED FILE ?                SAM03230
         BO    DD$RW10C                YES                              SAM03240
         AH    3,DD$KLE                ADD KLEN                         SAM03250
         LH    5,DD$KLE                                                 SAM03260
DD$RW10C MVC   DS$NOTED(2),4(3)         LOAD RCSZ                       SAM03270
         LH    4,DS$NOTED               *                               SAM03280
         LA    4,4(,4)                 VALID RCSZ ?                     SAM03290
         AR    4,5                                                      SAM03300
         CH    4,DC$PBKS               *                                SAM03310
         BNH   DD$RW10D                YES                              SAM03320
         MVI   DC$ERRF+3,X'80'         SET RCSZ ERROR                   SAM03330
         MVI   DC$ERCD,X'18'           *                                SAM03340
         BAL   14,DD$ERRTN             *                                SAM03350
DD$RW10D SR    4,5                                                      SAM03360
         STH   4,DS$NOTED               STORE BKSZ IN HEADER            SAM03370
         MVC   0(2,3),DS$NOTED          *                               SAM03380
DD$RW10B EQU   *                                                        SAM03390
         DO    &P(0)=3                                                  SAM03400
         TM    DC$FG4,X'40'        IOA2 ?                               SAM03410
         BO    DD$RW1AA            YES                                  SAM03420
         ENDO                                                           SAM03430
         ENDO                                                           SAM03440
         DO    &P(0)=2=0                                                SAM03450
DD$TRIN  EQU   *                                                        SAM03460
DD$RW4   EQU   *                                                        SAM03470
DD$RW1A  NI    DC$FG4,X'FD'       CLEAR READ REQUIRED                   SAM03480
         ENDO                                                           SAM03490
         DO    &P(0)=1=0                                                SAM03500
DD$RW1AA CLI   DC$REQS,X'12'        READ/KEY ISSUED ?                   SAM03510
         BNE   DD$RW1                   NO                              SAM03520
         LH    6,DD$KLE                 LOAD KEY LENGTH                 SAM03530
         BCTR  6,0                      DECREMENT KEY LENGTH BY 1       SAM03540
         L     3,DC$A1                  LOAD BUFFER ADDRESS             SAM03550
         L     4,DD$KYL                 LOAD KEY ADDRESS                SAM03560
         EX    6,DD$MVKEY               MOVE KEY TO BUFFER              SAM03570
         ENDO                                                           SAM03580
DD$RW1   BAL   11,DD$ISSUE              LINK TO COMMON ISSUE ROUTINE    SAM03590
         DO    &P(0)=2=0                                                SAM03600
DD$RW1B  TM    DC$FG6,X'20'             EXTEND MODE ?                   SAM03610
         BNO   DD$RW2B                  NO                              SAM03620
         NI    DC$PFG1,X'7F'            YES, CLEAR FORMAT WRITE BIT     SAM03630
DD$RW2B  EQU   *                                                        SAM03640
         ENDO                                                           SAM03650
         DO    &P(0)=1=0                                                SAM03660
         TM    DC$RFM+1,X'80'           FORMAT WRITE ISSUED ?           SAM03670
         BNO   DD$RWFMT                 NO                              SAM03680
         CLC   DC$EODID(3),DD$HIEOD+1   CUR EOD <HI EOD ?               SAM03690
         BL    DD$RWSP                  YES, SWAP CUR/HI EOD            SAM03700
         MVC   DD$HIEOD+1(3),DC$EODID   MOVE CUR EOD TO HI EOD          SAM03710
         B     DD$RWFMT                                                 SAM03720
DD$RWSP  BAL   11,DD$SWEOD              SWAP CUR/HI EOD                 SAM03730
DD$RWFMT EQU   *                                                        SAM03740
         ENDO                                                           SAM03750
         DO    &P(0)=2=0                                                SAM03760
         NI    DC$MFLG,X'DF'            CLEAR WAIT=YES BIT              SAM03770
         OI    DC$PFG1,X'20'            RESET SEQ FLAG BIT              SAM03780
         DO    &P(0)=3                                                  SAM03790
         TM    DC$FG5,X'03'        GET/PUT LAST ISSUED ?                SAM03800
         BZ    DD$RSET0            NO, SWAP BUFFERS                     SAM03810
         ENDO                                                           SAM03820
         TM    DC$RFM+1,X'20'           EXTEND MODE PUT ?               SAM03830
         BO    DD$RSET0            YES, SWAP I/O BUFFERS                SAM03840
         TM    DC$FG3,X'20'             UPDATE MODE                     SAM03850
         BO    DD$RSET                  YES                             SAM03860
DD$RSET0 BAL   11,DD$SWAP               NO, SWAP I/O BUFFERS            SAM03870
DD$RSET  XC    DS$CUR(4),DS$CUR         RESET BUFFER POINTERS           SAM03880
         NI    DC$FG5,X'6F'             CLEAR FLAGS                     SAM03890
         DO    '&OUTPUT'='YES'                                          SAM03900
         TM    DC$RFM+1,X'01'           INTERNAL PUT REQUIRED ?         SAM03910
         BNO   DD$PUTB                  NO                              SAM03920
         NI    DC$RFM+1,X'FE'           CLEAR INTERNAL PUT              SAM03930
         NI    DC$FG5,X'FE'            CLEAR PUT LAST ISSUED  FLAG      SAM03940
         B     DD$PUT                                                   SAM03950
         ENDO                                                           SAM03960
DD$PUTB  CLI   DC$REQS,X'20'            PUT ?                           SAM03970
         BE    DD$EXIT                  YES, EXIT                       SAM03980
         DO    '&INPUT'='YES'                                           SAM03990
         TM    DC$FG4,X'02'             READ REQUIRED ?                 SAM04000
         BO    DD$GET                   YES, ENTER GET ROUTINE          SAM04010
         ENDO                                                           SAM04020
         ENDO                                                           SAM04030
         B     DD$EXIT                  RETURN                          SAM04040
         DO    &P(0)=1=0                                                SAM04050
DD$MVKEY MVC   0(0,3),0(4)              MOVE KEY TO BUFFER              SAM04060
         ENDO                                                           SAM04070
         DO    &P(0)=2=0                                                SAM04080
         DO    (('&INPUT'='YES')**('&UPDATE'='YES'))++('&OUTPUT'='YES') SAM04090
DD$PUT   EQU   *                                                        SAM04100
         OI    DC$RFM+1,X'02'           SET BUFFER ACTIVE BIT           SAM04110
         TM    DC$FG3,X'A0'               PUT PERMITTED ?               SAM04120
         BZ    DD$ERR              NO, INVALID MACRO ERROR              SAM04130
DD$PUTA1 TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM04140
         BNO   DD$PT1                   NO                              SAM04150
         TM    DC$FG5,X'01'             UPDATE PUT PERMITTED ?          SAM04160
         BO    DD$ERR                   NO, EXIT WITH ERROR             SAM04170
DD$PUTC  OI    DC$FG5,X'10'             SET BUFFER UPDATED              SAM04180
         NI    DC$RFM+1,X'FD'           CLEAR BUF ACTIVE FLAG           SAM04190
DD$PT1   TM    DC$FG4,X'40'             IOA2 ?                          SAM04200
         BO    DD$PT2                   YES                             SAM04210
         BAL   3,DD$WAIT                NO, ISSUE WAIT                  SAM04220
DD$PT2   EQU   *                                                        SAM04230
         DO    &P(0)=3                                                  SAM04240
         L     3,DC$PCAID               LOAD BLOCK ADDRESS FOR NOTE     SAM04250
         TM    DC$MFLG,X'40'            WAIT REQUIRED ?                 SAM04260
         BNO   DD$PT2B                  NO                              SAM04270
         LA    3,1(,3)                  INCR BLOCK ID BY 1              SAM04280
DD$PT2B  ST    3,DC$BBB                 STORE NOTE ADDRESS              SAM04290
         CLI   DC$DTF,X'20'        SD FILE ?                            SAM04300
         BNE   DD$PT2A             NO, BYPASS EOV CHECK                 SAM04310
         ENDO                                                           SAM04320
         CLC   DC$PUB+1(1),DC$PUB       LAST VOLUME ACTIVE              SAM04330
         BNE   DD$PT2A0                 NO                              SAM04340
         NI    DC$PFG1,X'FB'            CLEAR NO EXTENSION FLAG         SAM04350
         B     DD$PT2A                                                  SAM04360
DD$PT2A0 CLC   DC$PCAID(4),DC$PMBA      EOV ?                           SAM04370
         BNH   DD$PT2A                  NO                              SAM04380
         NI    DC$RFM+1,X'FD'           YES, SWAP VOLS                  SAM04390
         B     DD$FEOV                  *                               SAM04400
DD$PT2A  NI    DC$FG5,X'D0'             CLEAR FLAGS                     SAM04410
         OI    DC$FG5,X'01'             SET PUT ISSUED                  SAM04420
         TM    DC$RFM+1,X'20'           EXTEND MODE SET ?               SAM04430
         BNO   DD$PT3                   NO                              SAM04440
         OI    DC$PFG1,X'80'            YES, SET FORMAT WRITE BIT       SAM04450
         NI    DC$FG3,X'DF'        CLEAR UPDATE MODE INDICATOR          SAM04460
DD$PT3   BAL   11,DD$RCP                LINK TO RECORD PROCESSOR        SAM04470
         TM    DC$RFM+1,X'20'           EXTEND MODE SET ?               SAM04480
         BNO   DD$PT4                   NO                              SAM04490
         OI    DC$FG3,X'20'             YES, RESET UPDATE MODE FOR GET  SAM04500
DD$PT4   TM    DC$FG5,X'80'             END OF BUFFER SET ?             SAM04510
         BNO   DD$EXIT             NO, RETURN                           SAM04520
         BAL   3,DD$WAIT                ISSUE WAIT                      SAM04530
         XC    DC$ERRF(4),DC$ERRF       CLEAR FN.C                      SAM04540
DD$PT40  NI    DC$RFM+1,X'FD'           CLEAR BUF ACTIVE FLAG           SAM04550
         TM    DC$FG6,X'20'             EXTEND PUT ?                    SAM04560
         BO    DD$PT50                  YES                             SAM04570
         TM    DC$FG3,X'20'             UPDATE ?                        SAM04580
         BNO   DD$PT50                  NO                              SAM04590
         TM    DC$FG5,X'40'             EOF SENSED                      SAM04591
         BO    DD$PT41                  YES                             SAM04592
         BAL   3,DD$DCRID               SET CURR ID                     SAM04600
DD$PT41  EQU   *                                                        SAM04601
         OI    DC$MFLG,X'20'            SET WAIT=YES                    SAM04610
         BAL   11,DD$ISSUE              WRITE BLOCK                     SAM04620
         TM    DC$FG4,X'40'             IOA2 SPECIFIED ?                SAM04630
         BNO   DD$PT45                  NO                              SAM04640
         TM    DC$FG6,X'40'             EOF SENSED ?                    SAM04650
         BO    DD$RW1B                  YES, BYPASS READ                SAM04660
         BAL   3,DD$INCID               SET ID FOR READ                 SAM04670
         CLC   DC$EODID(3),DC$PCAID+1   EOF ID REACHED ?                SAM04680
         BH    DD$PT45                  NO                              SAM04690
         BAL   11,DD$SWAP               YES, SET BUFFER ADDRESS         SAM04700
         OI    DC$FG4,X'01'             SET UPDATE FLAG                 SAM04701
         B     DD$RW1B                  EXIT                            SAM04710
DD$PT45  OI    DC$FG4,X'02'             SET READ REQUIRED               SAM04720
         B     DD$RW1B                  EXIT                            SAM04730
DD$PT50  XC    DS$LRPB(4),DS$LRPB       CLEAR BLOCK RECORD COUNT        SAM04740
DD$PT50A CLC   DC$PCAID(4),DC$PMBA     EOV ?                            SAM04750
         BNL   DD$PT70                  YES                             SAM04760
         TM    DC$FG4,X'C0'             WORKA/IOA2 ?                    SAM04770
         BNZ   DD$RW1                   YES, EXIT TO WRITE              SAM04780
DD$PT70  OI    DC$MFLG,X'20'            SET WAIT=YES FLAG               SAM04790
         B     DD$RW1                                                   SAM04800
         ENDO                                                           SAM04810
         DO    '&INPUT'='YES'                                           SAM04820
DD$GET   EQU   *                                                        SAM04830
         TM    DC$FG3,X'60'               GET PERMITTED ?               SAM04840
         BZ    DD$ERR              NO, INVALID MACRO ERROR              SAM04850
         OI    DC$FG5,X'02'             SET GET ISSUED                  SAM04860
         TM    DC$FG6,X'20'             EXTEND ACTIVE ?                 SAM04870
         BNO   DD$GETA                  NO                              SAM04880
         NI    DC$FG5,X'D2'             CLEAR FLAGS                     SAM04890
         B     DD$EXIT                  EXIT                            SAM04900
DD$GETA  TM    DC$FG5,X'40'             EOF SET ?                       SAM04910
         BO    DD$EOF                   YES, EXIT EOF                   SAM04920
         OI    DC$PFG1,X'20'            SET SEQ=YES                     SAM04921
DD$GT0   TM    DC$FG5,X'20'             POINT LAST ISSUED ?             SAM04930
         BO    DD$GT0A                  YES, ENTER READ                 SAM04940
         TM    DC$FG4,X'02'             READ REQUIRED ?                 SAM04950
         BNO   DD$GT1                   NO                              SAM04960
DD$GT0B  XC    DS$CUR(4),DS$CUR         CLEAR BUFFER POINTERS           SAM04970
DD$GT0A  EQU   *                                                        SAM04980
         CLC   DC$EODID(3),DC$PCAID+1   EOF SENSED ?                    SAM04990
         BNH   DD$EOF                   YES, EXIT EOF                   SAM05000
         BAL   11,DD$ISSUE              LINK TO ISSUE ROUTINE           SAM05010
DD$GT0C  NI    DC$FG5,X'7F'             CLEAR END OF BUFFER FLAG        SAM05020
         NI    DC$FG4,X'FD'             CLEAR READ REQUIRED             SAM05030
         BAL   11,DD$SWAP               SWAP BUFFERS                    SAM05040
         TM    DC$FG6,X'04'             IOA2 READ REQ'D ?               SAM05050
         BNO   DD$GT2                   NO                              SAM05060
         NI    DC$FG6,X'FB'             CLEAR FLAG                      SAM05070
         BAL   3,DD$WAIT                WAIT READ                       SAM05080
         CLC   DC$EODID(3),DC$PCAID+1   EOV ?                           SAM05090
         BNH   DD$GT4                   YES, BYPASS READ                SAM05100
         BAL   11,DD$ISSUE              NO, READ                        SAM05110
DD$GT4   BAL   11,DD$SWAP               SWAP BUFFERS                    SAM05120
DD$GT2   TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM05130
         BNO   DD$GT1                   NO                              SAM05140
         OI    DC$FG4,X'01'             SET UPDATE FLAG                 SAM05150
DD$GT1   TM    DC$FG4,X'40'             IOA2 ?                          SAM05160
         BO    DD$GT3                   YES                             SAM05170
         BAL   3,DD$WAIT                NO, WAIT READ                   SAM05180
DD$GT3   NI    DC$FG5,X'D2'             CLEAR FLAGS                     SAM05190
         CLC   DC$EODID(3),DC$PCAID+1   EOF SENSED ?                    SAM05200
         BH    DD$GT3A                  NO                              SAM05210
DD$GT3B  OI    DC$FG6,X'40'             SET EOF SENSED                  SAM05220
DD$GT3A  TM    DC$FG4,X'01'             UPDATE FLAG SET ?               SAM05230
         BNO   DD$GT3C                  NO                              SAM05240
         NI    DC$FG4,X'FE'             CLEAR FLAG                      SAM05250
         BAL   3,DD$DCR0                SET ID FOR UPDATE               SAM05260
DD$GT3C  EQU   *                                                        SAM05270
         BAL   11,DD$RCP                LINK TO RECORD PROCESSOR        SAM05280
         TM    DC$FG5,X'80'             END OF BUFFER                   SAM05290
         BNO   DD$EXIT                  NO,EXIT                         SAM05300
         BAL   3,DD$WAIT                WAIT I/O                        SAM05310
         TM    DC$FG3,X'20'             UPDATE MODE                     SAM05320
         BO    DD$RDWT                  YES,EXIT                        SAM05330
         CLC   DC$EODID(3),DC$PCAID+1   EOF ?                           SAM05340
         BNH   DD$RW1B                                                  SAM05350
         TM    DC$FG4,X'80'             WORKA SPEC ?                    SAM05360
         BO    DD$RW4                   YES                             SAM05370
DD$RDWT  TM    DC$RFM+1,X'08'           SHORT BLOCK IN PROCESS ?        SAM05380
         BO    DD$EOF                   YES, EXIT TO EOF                SAM05390
         OI    DC$FG4,X'02'             NO, SET READ REQUIRED           SAM05400
         TM    DC$FG5,X'10'             BUFFER UPDATED ?                SAM05410
         BO    DD$RDWT1                 YES                             SAM05420
         TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM05430
         BNO   DD$EXIT                  NO, EXIT                        SAM05440
         L     6,DC$PCAID               SET ID TO READ NEXT BLOCK       SAM05450
         LA    6,1(0,6)                 *                               SAM05460
         ST    6,DC$PCAID               *                               SAM05470
DD$RDWT0 EQU   *                                                        SAM05471
         TM    DC$FG4,X'40'        IOA2 SPECIFIED ?                     SAM05480
         BNO   DD$GT0B             NO                                   SAM05490
         CLC   DC$EODID(3),DC$PCAID+1                                   SAM05500
         BH    DD$RW1B                  NO                              SAM05510
         XC    DS$CUR(4),DS$CUR                                         SAM05520
         TM    DC$FG5,X'40'             EOF ?                           SAM05530
         BO    DD$EOF                   YES                             SAM05540
         B     DD$GT0C                  ENTER READ                      SAM05550
DD$RDWT1 NI    DC$FG5,X'EF'             CLEAR BUFFER UPDATED BIT        SAM05560
         TM    DC$FG5,X'40'             EOF SENSED                      SAM05561
         BO    DD$EOFS                                                  SAM05562
         BAL   3,DD$DCRID               DECR CURR ID                    SAM05570
DD$EOFS  EQU   *                                                        SAM05571
         MVI   DC$REQS,X'20'            SET FOR OUTPUT OF BLOCK         SAM05580
         OI    DC$PFG1,X'20'            SET SEQ BIT                     SAM05590
         OI    DC$MFLG,X'20'            SET WAIT = YES BIT              SAM05600
         BAL   11,DD$ISSUE              WRITE UPDATED BLOCK             SAM05610
         BAL   3,DD$INCID               SET CURRENT ID FOR READ         SAM05620
         B     DD$RDWT0                 *                               SAM05630
         DO    ('&INPUT'='YES')++('&OUTPUT'='YES')++('&UPDATE'='YES')   SAM05640
DD$EOF   EQU   *                                                        SAM05650
         DO    &P(0)=3                                                  SAM05660
         CLI   DC$DTF,X'20'        SD FILE ?                            SAM05670
         BNE   DD$EOF2             NO, BYPASS EOV CHECK                 SAM05680
         ENDO                                                           SAM05690
         CLC   DC$PUB+1(1),DC$PUB       LAST VOLUME ACTIVE ?            SAM05700
         BE    DD$EOF2                  YES, EXEC EOF PROCEDURE         SAM05710
         NI    DC$FG5,X'3F'             CLEAR EOF ACTIVE/END OF BUFFER  SAM05720
         B     DD$FEOV                  SWAP VOLUMES                    SAM05730
DD$EOF2  EQU   *                                                        SAM05740
         NI    DC$FG4,X'FC'             CLEAR SEQ READ/WAIT REQ         SAM05750
         TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM05760
         BNO   DD$EOF1                  NO                              SAM05770
         NI    DC$FG5,X'3F'             CLEAR EOF ACTIVE/END OF BUFFER  SAM05780
         NI    DC$FG6,X'B7'             AND EOV SENSED/SHROT BLOCK      SAM05790
         XC    DS$LST(2),DS$LST         SET BUFF DISP FOR EXTEND MODE   SAM05800
         OI    DC$RFM+1,X'20'           SET EXTEND ACTIVE               SAM05810
DD$EOF1  EQU   *                                                        SAM05820
         DO    &P(0)=3                                                  SAM05830
         OC    DS$EOFA(4),DS$EOFA       EOFADDR SPECIFIED ?             SAM05840
         BNZ   DD$EOF1A                 YES                             SAM05850
         L     12,DC$PCA1               SET PCA COVER TO PCA 1          SAM05860
         ENDO                                                           SAM05870
DD$EOF1A L     14,DS$EOFA               LOAD EOF ADDRESS                SAM05880
         ST    14,16(,13)               STORE IN SAVE AREA              SAM05890
         MVI   DC$ERRF+3,X'60'          SET EOF/EOV FLAGS               SAM05900
         LM    14,12,12(13)             RESTORE USER REGISTERS          SAM05910
         L     RD$,DC$SAVR              USER REGISTERS                  SAM05920
         BR    RF$                 EXIT TO EOF ROUTINE                  SAM05930
         ENDO                                                           SAM05940
         ENDO                                                           SAM05950
DD$INCID TM    DC$FG4,X'40'             IOA2 SPEC ?                     SAM05960
         BNOR  3                        NO, RETURN                      SAM05970
         L     6,DC$PCAID               INCREMENT                       SAM05980
         LA    6,1(0,6)                   CURRENT                       SAM05990
         ST    6,DC$PCAID                   ID BY 1                     SAM06000
         BR    3                        RETURN                          SAM06010
DD$DCRID TM    DC$FG4,X'40'             IOA2 SPEC ?                     SAM06020
         BNOR  3                        NO, RETURN                      SAM06030
DD$DCR0  L     6,DC$PCAID               LOAD CURRENT ID                 SAM06040
         BCTR  6,0                      DECR BY 1                       SAM06050
         LTR   6,6                      ID EQ ZERO ?                    SAM06051
         BZR   3                        YES, EXIT                       SAM06052
         ST    6,DC$PCAID               RESTORE CURR ID                 SAM06060
         BR    3                        RETURN                          SAM06070
DD$SWAP  XC    DC$A1(4),DC$A2           SWAP                            SAM06080
         XC    DC$A2(4),DC$A1             I/O BUFFER                    SAM06090
         XC    DC$A1(4),DC$A2                 ADDRESSES                 SAM06100
         BR    DB$                      RETURN                          SAM06110
         DO    (&P(0)=1)++(&P(0)=3)                                     SAM06120
DD$FEOV  OI    DC$ERRF+3,X'20'          SET EOV                         SAM06130
         CLC   DC$PUB(1),DC$PUB+1       LAST VOLUME ACTIVE ?            SAM06140
         BNE   DD$FEOVS                 NO, SWAP VOLUMES                SAM06150
         OI    DC$ERRF+3,X'40'          SET EOF                         SAM06160
         DO    ('&INPUT'='YES')**('&OUTPUT'='YES')                      SAM06170
         TM    DC$FG3,X'80'             OUTPUT FILE ?                   SAM06180
         BO    DD$ERRTN                 EXIT TO ERROR ROUTINE           SAM06190
         ENDO                                                           SAM06200
         DO    ('&INPUT'='YES')                                         SAM06210
         MVC   DC$PCAID+1(3),DC$EODID   SET CURRENT ID TO EOD           SAM06220
         B     DD$EOF                   EXIT TO EOF PROCESSING          SAM06230
         ENDO                                                           SAM06240
         DO    ('&OUTPUT'='YES')**('&INPUT'='YES'=0)                    SAM06250
         B     DD$ERRTN                 EXIT TO ERROR ROUTINE           SAM06260
         ENDO                                                           SAM06270
DD$FEOVS LM    14,12,12(13)             RESTORE REGS                    SAM06280
         L     13,DC$SAVR               FOR EOV CLOSE                   SAM06290
         ST    15,DC$SAVR               SAVE R15                        SAM06291
         LA    0,C'V'                   *                               SAM06300
         SVC   39                       CALL CLOSE                      SAM06310
         L     15,DC$SAVR               RESTORE R15                     SAM06320
         LA    14,DD$FEOV1              SET NO ALLOC RETURN             SAM06330
         SVC   40                       CALL FEOV                       SAM06340
         LR    14,1                     SAVE DTF ADDRESS                SAM06350
         LA    0,512               LOAD R0 WITH NO FCB IN CORE CODE     SAM06360
         IC    0,DC$PUB+1            AND VOLUME SEQUENCE NUMBER         SAM06370
         LA    1,DC$NME                 POINT TO LFD NAME FOR ALLOC     SAM06380
         SVC   33                       CALL ALLOCATE                   SAM06390
         LR    1,14                     RESTORE DTF ADDRESS             SAM06400
         LTR   0,0                      ERROR ?                         SAM06410
         BM    DD$FERR                  YES, CANCEL                     SAM06420
DD$FEOV1 SVC   38                       CALL OPEN                       SAM06430
         L     15,DC$SAVR               RESTORE R15                     SAM06440
         ST    13,DC$SAVR               SAVE R13                        SAM06441
         BAL   14,DD$RSTOR              RESTORE R14                     SAM06450
         STM   1,12,24(13)              RESET USER REGS                 SAM06460
         L     12,DC$PADDR              COVER PCA                       SAM06461
         CLI   DC$REQS,X'84'       FEOV ISSUED ?                        SAM06470
         BE    DD$EXIT             YES, EXIT                            SAM06480
         DO    ('&OUTPUT'='YES')**('&INPUT'='YES')                      SAM06490
         CLI   DC$REQS,X'20'            PUT ISSUED ?                    SAM06500
         BE    DD$PUT                   YES                             SAM06510
         B     DD$GT0                   NO, EXIT TO GET                 SAM06520
         ENDO                                                           SAM06530
         DO    ('&OUTPUT'='YES')**('&INPUT'='YES'=0)                    SAM06540
         B     DD$PUT                   EXIT TO PUT                     SAM06550
         ENDO                                                           SAM06560
         DO    ('&OUTPUT'='YES'=0)**('&INPUT'='YES')                    SAM06570
         B     DD$GT0              EXIT TO GET                          SAM06580
         ENDO                                                           SAM06590
DD$FERR  BAL   14,DD$RSTOR              RESTORE SAVEAREA ADDRESS        SAM06600
         LM    14,15,12(13)             RESTORE USER REGS               SAM06610
         LM    1,12,24(13)              *                               SAM06620
         L     13,DC$SAVR               *                               SAM06630
         SVC   28                       CANCEL                          SAM06640
DD$RSTOR CLI   DC$SAV,X'F0'             SAVAREA SPECIFIED ?             SAM06650
         BER   14                       NO, RETURN                      SAM06660
         L     13,DC$SAV                LOAD SAVAREA ADDRESS            SAM06670
         BR    14                       RETURN                          SAM06680
         ENDO                                                           SAM06690
*    RECORD PROCESSING ROUTINE                                          SAM06700
DD$RCP   L     D3$,DC$A1                LOAD CURRENT I/O BUFFER ADDR    SAM06710
         TM    DC$PFG1,X'40'            INTERLACED FILE ?               SAM06720
         BO    DD$RCP91                 YES                             SAM06730
         AH    3,DD$KLE                 ADD KEY LENGTH                  SAM06740
DD$RCP91 L     4,20(,13)                LOAD WORK AREA ADDRESS          SAM06750
         TM    DC$RFM,X'14'                                             SAM06760
         BNM   DD$VBL                   NO,DD$VBL                       SAM06770
         CLI   DC$REQS,X'10'            GET ?                           SAM06780
         BNE   DD$RCP20                 NO                              SAM06790
         TM    DC$RFM+1,X'40'           EOF SENSED ?                    SAM06800
         BNO   DD$RCP20                 NO                              SAM06810
         CLI   DC$RFM,X'10'       FIXBLK FILE ?                         SAM06820
         BNE   DD$RCP20           NO                                    SAM06830
         LH    7,DC$REC                 LOAD RCSZ                       SAM06840
         M     6,DS$LRPB                MULT BY LAST BLK COUNT TO       SAM06850
         LTR   7,7                      SHORT BLOCK ?                   SAM06860
         BZ    DD$RCP20                 NO, LOAD MAX BLKSIZE            SAM06870
         LR    5,7                         CALC BKSZ FOR LAST BLOCK     SAM06880
         OI    DC$RFM+1,X'08'           SET SHORT BLOCK IN PROCESS      SAM06890
         B     DD$RCP21                                                 SAM06900
DD$RCP20 LH    5,DC$PBKS                LOAD MAX BLOCK SIZE             SAM06910
DD$RCP21 LH    6,DC$REC                 LOAD RCSZ                       SAM06920
         LR    7,6                      LOAD RCSZ FOR VALIDITY CHECK    SAM06930
         AH    D3$,DS$CUR               ADD CURREN BUF.DISP. TO POINT   SAM06940
         CLI   DC$REQS,X'20'            PUT ISSUE                       SAM06950
         BNE   DD$RCP1                  NO,DD$RCP1                      SAM06960
         TM    DC$FG3,X'20'             UPDATE MODE                     SAM06970
         BO    DD$RCP3                  YES                             SAM06980
         AI    DS$LRPB+2,1              INCR CUR RECORD COUNT           SAM06990
DD$RCP1  AH    D3$,DS$LST               NO,ADD SIZE OF LAST R/N         SAM07000
DD$RCP2  LTR   7,7                      RCSZ > ZERO ?                   SAM07010
         BNP   DD$RCP8                  NO, INVALID RCSZ                SAM07020
         SH    7,DC$PBKS          VALID BKSZ ?                          SAM07030
         BNP   DD$RCP2A                 YES                             SAM07040
DD$RCP8  MVI   DC$ERRF+3,X'80'          SET INVALID RECSIZE FLAG        SAM07050
         MVI   DC$ERCD,X'18'            SET INVALID RECSIZE CODE        SAM07060
         BAL   14,DD$ERRTN              LINK TO ERROR ROUTINE           SAM07070
DD$RCP2A LH    7,DS$CUR                 UPDATE CURRENT BUFFER           SAM07080
         AH    D7$,DS$LST                  DISPLACEMENT BY SIZE         SAM07090
         STH   D7$,DS$CUR                     OF LAST R/W               SAM07100
         STH   7,DS$NOTED         SET BLOCK DISP FOR NOTE               SAM07110
         STH   D6$,DS$LST               UPDATE LAST R/W WITH CUR RCSZ   SAM07120
         MVC   DC$BBB(4),DC$PCAID       SET BLK NUMBER FOR NOTE         SAM07121
DD$RCP3  LH    D7$,DS$CUR               CALCULATE BYTES                 SAM07130
         TM    DC$PFG1,X'40'            INTERLACED FILE ?               SAM07131
         BO    DD$RCP3A                 YES                             SAM07132
         AH    7,DD$KLE                 ADD KEY LENGTH                  SAM07140
DD$RCP3A EQU   *                                                        SAM07141
         CLI   DC$REQS,X'20'            PUT ISSUED ?                    SAM07150
         BE    DD$RCP11                 YES                             SAM07160
         TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM07170
         BO    DD$RCP7                  YES                             SAM07180
DD$RCP11 AH    7,DS$LST                 ADD CURRENT R/W SIZE            SAM07190
DD$RCP7  TM    DC$RFM,X'0A'             VARIABLE ?                      SAM07200
         BNM   DD$RCP5                  NO                              SAM07210
         LA    D7$,4(0,D7$)             ADD BKSZ OFFSET                 SAM07220
         LR    0,7                 SAVE VARIABLE BLOCK SIZE             SAM07230
DD$RCP5  SR    D5$,D7$                      REMAINING IN BUFFER         SAM07240
         BH    DD$RCP4                  POSITIVE,DD$RCP4                SAM07250
         BL    DD$RCP10                 LOW,DD$RCP10                    SAM07260
         CLI   DC$REQS,X'10'           GET ISSUED ?                     SAM07270
         BE    DD$RCP51                YES, SET END OF BUFFER           SAM07280
         TM    DC$FG3,X'20'        UPDATE PUT ?                         SAM07290
         BO    DD$RCP51            YES                                  SAM07300
         TM    DC$RFM,X'08'       VARBLK ?                              SAM07310
         BO    DD$RCP50           YES, BYPASS SET END OF BUFFER         SAM07320
DD$RCP51 OI    DC$FG5,X'80'            SET END OF BUFFER FLAG           SAM07330
DD$RCP50 TM    DC$RFM+1,X'40'     EOF SENSED ?                          SAM07340
         BNO   DD$RCP22                 NO                              SAM07350
         OI    DC$FG5,X'40'             SET EOF ACTIVE                  SAM07360
DD$RCP22 CLI   DC$REQS,X'20'            PUT ISSUED ?                    SAM07370
         BE    DD$RCP4                  YES                             SAM07380
         TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM07390
         BNO   DD$RCP4                  NO                              SAM07400
         B     DD$RCP6                  YES                             SAM07410
DD$RCP10 TM    DC$RFM,X'08'       VARBLK ?                              SAM07420
         BNO   DD$RCP8            NO, ERROR                             SAM07430
         TM    DC$FG4,X'80'       WORKA SPECIFIED ?                     SAM07440
         BNO   DD$RCP8            NO, ERROR                             SAM07450
         OI    DC$FG5,X'80'             SET END OF BUFFER               SAM07460
         OI    DC$RFM+1,X'01'           SET INTERNAL PUT REQUIRED       SAM07470
         TM    DC$FG4,X'40'             IOA2 SPEC ?                     SAM07480
         BOR   11                       YES, EXIT                       SAM07490
         OI    DC$MFLG,X'20'            SET WAIT=YES BIT                SAM07500
         BR    11                       EXIT                            SAM07510
DD$RCP4  TM    DC$RFM,X'06'        UNBLOCKED ?                          SAM07520
         BZ    DD$RCP4A            NO                                   SAM07530
         CLI   DC$REQS,X'20'       PUT ?                                SAM07540
         BNE   DD$RCP4A            NO                                   SAM07550
         OI    DC$FG5,X'80'        SET END OF BUFFER                    SAM07560
DD$RCP4A TM    DC$FG4,X'80'        WORKA SPECIFIED ?                    SAM07570
         BNO   DD$RCP6                  NO                              SAM07580
         BAL   2,DD$RMVE                YES, MOVE RECORD                SAM07590
DD$RCP6  TM    DC$FG4,X'10'             IOREG SPECIFIED ?               SAM07600
         BNO   DD$RCP12                 NO                              SAM07610
         LA    14,DD$RCP12              LOAD EXIT ADDRESS FOR IOREG     SAM07620
DD$IOREG LH    7,DS$IRG                 LOAD IOREG DISPLACEMENT         SAM07630
         L     3,DC$A1                  LOAD CUR BUFFER ADDRESS         SAM07640
         AH    3,DS$CUR           ADD CURRENT BUFFER DISPLACEMENT       SAM07650
         TM    DC$PFG1,X'40'            INTERLACED FILE ?               SAM07660
         BO    DD$RCP90                 YES                             SAM07670
         AH    3,DD$KLE                 ADD KEYLEN                      SAM07680
DD$RCP90 CLI   DC$REQS,X'10'       GET ?                                SAM07690
         BE    DD$RCP15            YES                                  SAM07700
DD$RCP14 AH    3,DS$LST                 ADD SIZE OF LAST RECORD         SAM07710
DD$RCP15 TM    DC$FG5,X'80'             END OF BUFFER SET ?             SAM07720
         BNO   DD$RCP17                 NO                              SAM07730
         CLI   DC$REQS,X'20'       PUT ?                                SAM07740
         BE    DD$RCP18            YES                                  SAM07750
         TM    DC$FG3,X'20'        UPDATE GET ?                         SAM07760
         BNO   DD$RCP17            NO                                   SAM07770
         TM    DC$FG6,X'08'             SHORT BLOCK IN PROCESS ?        SAM07780
         BO    DD$RCP17                 YES, LEAVE IOREG INTACT         SAM07790
DD$RCP18 L     3,DC$A2             LOAD IOAREA2 ADDRESS FOR IOREG       SAM07800
DD$RCP17 TM    DC$RFM,X'0A'             VARIABLE FORMAT ?               SAM07810
         BNM   DD$RCP16                 NO                              SAM07820
         LA    3,4(0,3)                 ADD BKSZ HEADER OFFSET          SAM07830
DD$RCP16 CLI   DS$IRG,X'10'             R13 SPECIFIED FOR IOREG ?       SAM07840
         BNE   DD$RCP60                 NO                              SAM07850
         ST    3,DC$SAVR                YES, SET R13 FOR IOREG          SAM07860
         BR    14                                                       SAM07870
DD$RCP60 ST    3,0(7,13)                STORE IOREG IN SAVE AREA        SAM07880
         BR    14                       EXIT                            SAM07890
DD$RCP12 CLI   DC$REQS,X'20'            PUT ?                           SAM07900
         BNER  DB$                      NO,EXIT                         SAM07910
         TM    DC$RFM,X'0A'             VARIABLE ?                      SAM07920
         BNMR  11                       NO, RETURN                      SAM07930
         TM    DC$FG3,X'20'             UPDATE ?                        SAM07940
         BOR   11                       YES, RETURN                     SAM07950
         L     3,DC$A1                  SET BKSZ FOR VARIABLE BLK       SAM07960
         STH   0,0(,3)                                                  SAM07970
DD$RCP9  TM    DC$FG4,X'08'             VARBLD SPECIFIED ?              SAM07980
         BNOR  DB$                      NO,EXIT                         SAM07990
         CLI   DC$VBL,X'10'             R13 SPECIFIED FOR VARBLD ?      SAM08000
         BNE   DD$RCP70                 NO                              SAM08010
         ST    5,DC$SAVR                YES, SET R13 FOR VARBLD         SAM08020
         BR    11                       RETURN                          SAM08030
DD$RCP70 LH    7,DC$VBL                 LOAD VARBLD REG DISPLACEMENT    SAM08040
         ST    D5$,0(D7$,RD$)           STORE BYTES REM. IN USER REG    SAM08050
         BR    DB$                      EXIT                            SAM08060
DD$VBL   LH    D5$,0(,D3$)         LOAD BKSZ FROM BUFFER                SAM08070
         CLI   DC$REQS,X'10'            GET ?                           SAM08080
         BE    DD$V1                    YES                             SAM08090
         TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM08100
         BO    DD$V1                    YES                             SAM08110
         LH    D5$,DC$PBKS              LOAD MAX BKSZ                   SAM08120
DD$V1    LA    D3$,4(0,D3$)             INCR BUF POINTER BY BKSZ OFFSET SAM08130
         AH    D3$,DS$CUR               ADD CURRENT BUF DISPLACEMENT    SAM08140
         CLI   DC$REQS,X'10'            GET ?                           SAM08150
         BNE   DD$VPUT                  NO,DD$VPUT                      SAM08160
         AH    D3$,DS$LST               ADD SIZE OF LAST R/W            SAM08170
         LR    7,3                      CALC BUFFER DISPLACEMENT        SAM08180
         L     6,DC$A1                  *                               SAM08190
         LA    6,0(,6)                  *                               SAM08200
         SR    7,6                      *                               SAM08210
         CR    5,7                      END OF BUFFER ?                 SAM08220
         BE    DD$RCP5                  YES                             SAM08230
DD$VPT2A MVC   DS$NOTED(2),0(3)         MOVE RCSZ TO HOLD               SAM08240
         LH    6,DS$NOTED               LOAD RCSZ IN R6                 SAM08250
         B     DD$VPT3                  EXIT                            SAM08260
DD$VPUT  TM    DC$FG3,X'20'             UPDATE MODE ?                   SAM08270
         BNO   DD$VPT1                  NO,DD$VPT1                      SAM08280
         LH    D6$,DS$LST               LOAD RCSZ FROM LAST R/W         SAM08290
         B     DD$RCP3                  EXIT                            SAM08300
DD$VPT1  AH    D3$,DS$LST               INCR BUF POINTER BY LAST R/W    SAM08310
         TM    DC$FG4,X'80'             WORKA SPECIFIED                 SAM08320
         BNO   DD$VPT2A                 NO, DD$VPT2A                    SAM08330
DD$VPT2  MVC   DS$NOTED(2),0(4)         LOAD RCSZ FROM WORKAREA         SAM08340
         LH    6,DS$NOTED               *                               SAM08350
DD$VPT3  XC    DS$NOTED(2),DS$NOTED     CLEAR RCSZ HOLD                 SAM08360
         LTR   6,6                      RCSZ=0 ?                        SAM08370
         BZ    DD$RCP8                  YES, ERROR                      SAM08380
         LA    7,4                      SET RCSZ FOR                    SAM08390
         AR    7,6                  VALIDITY CHECK                      SAM08400
         B     DD$RCP2                                                  SAM08410
DD$RMVE  BCTR  D6$,0                    DECREMENT RCSZ BY 1             SAM08420
         LR    D7$,D6$             LOAD 7 WITH RCSZ-1                   SAM08430
         CLI   DC$REQS,X'20'            PUT ?                           SAM08440
         BE    DD$RMV1                  YES                             SAM08450
         XR    D3$,D4$                  NO,SWAP                         SAM08460
         XR    D4$,D3$                       I/O BUFFER AND             SAM08470
         XR    D3$,D4$                          WORKAREA ADDRESSES      SAM08480
DD$RMV1  SR    6,6                     CLEAR R6                         SAM08490
         D     6,DD$256                DIV RCSZ-1 BY 256                SAM08500
         LTR   7,7                     QUOTIENT$                        SAM08510
         BZ    DD$RMV3                  NO,DD$RMV3                      SAM08520
DD$RMV2  MVC   0(256,D3$),0(D4$)        MOVE 256 BYTES                  SAM08530
         LA    D3$,256(,D3$)            INCREMENT I/O BUFFER AND        SAM08540
         LA    D4$,256(,D4$)                WORKAREA POINTERS BY 256    SAM08550
         BCT   7,DD$RMV2               ALL BLOCKS MOVED ?               SAM08560
DD$RMV3  EX    6,DD$MOVE               YES,MOVE REMAINDER               SAM08570
         BR    D2$                      RETURN                          SAM08580
DD$MOVE  MVC   0(0,D3$),0(D4$)          MOVE REMAINDER                  SAM08590
DD$256   DC    F'256'                   CONSTANT FOR DIVIDE             SAM08600
         ENDO                                                           SAM08610
         DO    &P(0)=1=0                                                SAM08620
*                                                                       SAM08630
*    CONVERT RELATIVE ADDRESS                                           SAM08640
*                                                                       SAM08650
DD$RCVRT EQU   *                        ENTRY TO ADDRESS CONVERSION     SAM08660
         OC    DD$SKAD(4),DD$SKAD       SEEKADR SPECIFIED ?             SAM08670
         BNZ   DD$RW8              YES                                  SAM08680
         B     DD$ERR                   EXIT WITH INV IMP MACRO ERROR   SAM08690
DD$RW8   L     D4$,DD$SKAD         LOAD SEEKADR ADDRESS                 SAM08700
         MVC   DC$BBB(4),0(4)           STORE REL ADDRESS               SAM08710
         CLI   DC$REQS,X'23'            WRITE AFTER ?                   SAM08720
         BER   14                       YES, EXIT                       SAM08730
         L     7,DC$BBB                 LOAD RRR/TTR                    SAM08740
         CLI   DC$REQS,X'22'            WRITE/KEY ISSUED ?              SAM08750
         BER   14                       YES,BYPASS ADDRESS CONVERSION   SAM08760
         LTR   7,7                      VALID SKAD ?                    SAM08761
         BNP   DD$RW15                  NO, INV ID                      SAM08762
         TM    DC$FG2,X'01'             REL=T ?                         SAM08770
         BNO   DD$RW9                   NO                              SAM08780
         SRL   D7$,8                    SHIFT OUT R                     SAM08790
DD$RW8A  M     6,DC$BPT                 MULT TT BY BLK/TRK TO           SAM08800
         S     D7$,DC$BPT                 CALC REL BLOCK ADDRESS        SAM08810
         BL    DD$RW15                  NEG=INVALID ID                  SAM08820
         TM    DC$RFM+1,X'80'           FORMAT WRITE ISSUED ?           SAM08830
         BO    DD$RW16                  YES                             SAM08840
         CLI   DC$REQS,X'12'            READ/KEY ISSUED ?               SAM08850
         BNE   DD$RW13                  NO                              SAM08860
DD$RW16  LA    7,1(0,7)                 SET BLK ADDRESS                 SAM08870
         B     DD$RW12                                                  SAM08880
DD$RW13  LR    D8$,D7$                  SAVE REL BLOCK IN R8            SAM08890
         L     7,DC$BPT                 LOAD BLOCKS/TRACK               SAM08900
         M     6,DS$RPB                 CALC MAX REC #/TRACK            SAM08910
         LR    6,7                      SAVE MAX REC #/TRACK            SAM08920
         SR    D7$,D7$                  CLEAR REG 7                     SAM08930
         IC    D7$,3(,D4$)              PICK UP REC NUM IN REG 7        SAM08940
         LTR   7,7                      REC NUMBER > 0 ?                SAM08950
         BNP   DD$RW15                  NO, INVALID ID                  SAM08960
         CR    7,6                      COMP CUR REC# : MAX REC#/TRACK  SAM08970
         BH    DD$RW17B            HIGH, SET NO-FIND ERROR              SAM08980
DD$RW9   SR    6,6                     CLEAR R6                         SAM08990
         D     6,DS$RPB                DIVIDE REC # BY REC/BLK          SAM09000
         TM    DC$RFM+1,X'80'      FORMAT WRITE ISSUED ?                SAM09010
         BNO   DD$RW9B             NO                                   SAM09020
         SR    6,6                                                      SAM09030
         D     6,DC$BPT            CALC REL TT                          SAM09040
         LTR   6,6                 REMAINDER                            SAM09050
         BZ    DD$RW8A             NO                                   SAM09060
         LA    7,1(0,7)            YES, INCR TT BY 1                    SAM09070
         B     DD$RW8A                                                  SAM09080
DD$RW9B  LTR   6,6                 REMAINDER ?                          SAM09090
         BNZ   DD$RW10                  YES                             SAM09100
         L     6,DS$RPB                NO,SET REM TO REC/BLK            SAM09110
         B     DD$RW11                                                  SAM09120
DD$RW10  LA    7,1(7,0)                                                 SAM09130
DD$RW11  TM    DC$FG2,X'01'             REL=T ?                         SAM09140
         BNO   DD$RW12                  NO                              SAM09150
         AR    7,8                      ALC FINAL REL BLOCK             SAM09160
DD$RW12  AH    7,DC$SUBF           ADD BLOCK OFFSET TO ID               SAM09170
         ST    7,DC$PCAID          SET RELATIVE BLOCK ADDRESS           SAM09180
         TM    DC$RFM+1,X'80'           FORMAT WRITE ISSUED ?           SAM09190
         BNO   DD$RW17                  NO                              SAM09200
         BAL   11,DD$SWEOD              SWAP CUR/HI EOD                 SAM09210
         MVC   DC$EODID(3),DC$PCAID+1   MOVE CUR BLK ADDR TO EOD        SAM09220
         CLC   DC$EODID(3),DD$HIEOD+1   CUR EOD>HI EOD ?                SAM09230
         BH    DD$RW18                  YES                             SAM09240
         BAL   11,DD$SWEOD              SWAP CUR/HI EOD                 SAM09250
         BR    14                       EXIT                            SAM09260
DD$RW18  MVC   DD$HIEOD+1(3),DC$EODID   MOVE CUR EOD TO HI EOD          SAM09270
         BR    14                       EXIT                            SAM09280
DD$RW17  CLC   DC$PCAID+1(3),DC$EODID   COMP CUR BLK ADDR:CUR EOD       SAM09290
         BNE   DD$RW17A            NOT EQ, CONTINUE                     SAM09300
         CLI   DC$REQS,X'11'      READ ID ?                             SAM09310
         BNE   DD$RW17A                 NO, CONTINUE                    SAM09320
DD$RW17C OI    DC$ERRF+3,X'40'    SET EOF BIT                           SAM09330
         BAL   14,DD$ERRTN        EXIT WITH EOF CONDITION               SAM09340
DD$RW17B OI    DC$ERFLG+1,X'10'    SET RECORD NOT FOUND                 SAM09350
         BAL   14,DD$ERRTN         EXIT WITH ERROR                      SAM09360
DD$RW17A CLI   DC$REQS,X'12'           READ KEY ?                       SAM09370
         BER   14                      YES, EXIT                        SAM09380
         LR    7,6                     SAVE REMAINDER                   SAM09390
         SR    6,6                 CALC RECORD DISP                     SAM09400
DD$RW17D AH    6,DC$REC            *                                    SAM09410
         BCT   7,DD$RW17D          *                                    SAM09420
         SH    6,DC$REC            *                                    SAM09430
         STH   6,DS$NOTED               STORE DISP IN FILENAME.D        SAM09440
         BR    14                       RETURN                          SAM09450
DD$RW15  MVI   DC$ERCD,X'24'            SET INVALID ID CODE             SAM09460
         OI    DC$ERFLG,X'40'                                           SAM09470
         BAL   14,DD$ERRTN              LINK TO ERROR ROUTINE           SAM09480
DD$SWEOD XC    DD$HIEOD+1(3),DC$EODID   SWAP HI EOD AND CURRENT EOD     SAM09490
         XC    DC$EODID(3),DD$HIEOD+1                                   SAM09500
         XC    DD$HIEOD+1(3),DC$EODID                                   SAM09510
         BR    11                       RETURN                          SAM09520
         ENDO                                                           SAM09530
         DO    &P(0)=1=0                                                SAM09540
*         IDLOC ADDRESS CONVERSION                                      SAM09550
*                                                                       SAM09560
DD$CVRT1 TM    DC$FG5,X'04'             READ/WRITE KEY SET ?            SAM09570
         BNO   DD$CVRTM                 NO                              SAM09580
         L     6,DC$BBB                 LOAD REL ADDRESS                SAM09590
         BR    14                       EXIT                            SAM09600
DD$CVRTM TM    DC$FG2,X'01'        REL=T ?                              SAM09610
         BNO   DD$CVRT4            NO                                   SAM09620
         L     7,DS$RPB                 LOAD REC/BLK                    SAM09630
         M     6,DC$BPT                 MULT BY B/T TO CALC REC/TRK     SAM09640
         IC    6,DC$BBB+3               PICK UP REC NUMBER              SAM09650
         CR    6,7                      COMPARE REC NUM TO REC/TRK      SAM09660
         L     7,DC$BBB                 LOAD REL ADDR (TTR)             SAM09670
         SRL   7,8                      SHIFT OUT R                     SAM09680
         BL    DD$CVRTL                 REC NUM < REC/TRK               SAM09690
         LA    6,1(0,0)                 NO, SET REC NUM TO 1            SAM09700
         LA    7,1(0,7)                 INCR TT                         SAM09710
         B     DD$CVRTX                                                 SAM09720
DD$CVRTL LA    6,1(0,6)                 YES, INCR REC NUM BY 1          SAM09730
DD$CVRTX SLL   7,8                      SHIFT TT                        SAM09740
         OR    6,7                      DEVELOP TTR                     SAM09750
         BR    14                       EXIT                            SAM09760
DD$CVRT4 L     6,DC$BBB                 LOAD RRR                        SAM09770
         LA    6,1(0,6)                 INCR BY 1                       SAM09780
         BR    14                       EXIT                            SAM09790
         ENDO                                                           SAM09800
         DO    &P(0)=3                                                  SAM09810
DD$SET1  BAL   3,DD$WAIT                ISSUE WAIT                      SAM09820
         ST    0,DC$PADDR               SET CURRENT PCA ADDRESS         SAM09830
         LR    12,0                     *                               SAM09840
         TM    DC$FG4,X'08'       VARBLD REG SPECIFIED ?                SAM09850
         BNO   DD$SET1E           NO                                    SAM09860
         LH    5,DC$PBKS          YES, SET VARBLD VALUE                 SAM09870
         LH    7,DS$CUR           *                                     SAM09880
         AH    7,DS$LST           *                                     SAM09890
         TM    DC$RFM,X'0A'       VARIABLE FORMAT ?                     SAM09900
         BNO   DD$SET1D           NO                                    SAM09910
         LA    7,4(,7)            YES, ADD BLK HEADER OFFSET            SAM09920
DD$SET1D SR    5,7                CALCULATE BUFFER RESID SPACE          SAM09930
         BAL   11,DD$RCP9         SET VARBLD REG                        SAM09940
DD$SET1E TM    DC$FG4,X'10'       IOREG SPECIFIED ?                     SAM09950
         BNO   DD$SET1F                 NO                              SAM09960
         L     3,DC$A1             LOAD CURRENT I/O BUFFER ADDRESS      SAM09970
         TM    DC$FG5,X'03'        GET/PUT LAST ISSUED THIS PCA ?       SAM09980
         BZ    DD$SET1C                 NO                              SAM09990
         AH    3,DS$CUR            YES, ADD CURRENT BUFFER OFFSET       SAM10000
         BAL   14,DD$IOREG              LINK TO IOREG PROCESS           SAM10010
         B     DD$SET1F                                                 SAM10020
DD$SET1C LH    7,DS$IRG            LOAD IOREG DISPLACEMENT              SAM10030
         BAL   14,DD$RCP17                                              SAM10040
DD$SET1F TM    DC$FG3,X'80'            OUTPUT FILE                      SAM10050
         BNO   DD$EXIT                                                  SAM10060
         TM    DC$FG6,X'04'            READ REQUIRED ?                  SAM10070
         BNO   DD$EXIT                  NO                              SAM10080
         NI    DC$FG6,X'FB'             CLEAR EXTEND READ FLAG          SAM10090
         OI    DC$MFLG,X'20'            SET WAIT=YES                    SAM10100
         NI    DC$PFG1,X'DF'            CLEAR SEQ=YES                   SAM10110
         MVI   DC$REQS,X'10'            SET READ FUNCTION               SAM10120
         BAL   11,DD$ISSUE              ISSUE READ                      SAM10130
         NI    DC$MFLG,X'DF'            CLEAR WAIT=YES                  SAM10140
         OI    DC$PFG1,X'20'            RESET SEQ=YES                   SAM10150
         B     DD$EXIT             EXIT                                 SAM10160
         ENDO                                                           SAM10170
         DO    &P(0)=2=0                                                SAM10180
         DO    ('&OUTPUT'='YES')++(('&INPUT'='YES')**('&UPDATE'='YES')) SAM10190
DD$TRUNC TM    DC$FG3,X'80'             OUTPUT FILE ?                   SAM10200
         BO    DD$TRNC2                 YES                             SAM10210
         TM    DC$FG6,X'20'             EXTEND MODE ?                   SAM10220
         BNO   DD$ERR                   NO, INVALID MACRO ERROR         SAM10230
DD$TRNC2 NI    DC$FG6,X'FD'             CLEAR BUFFER ACTIVE FLAG        SAM10240
         TM    DC$FG4,X'10'       IOREG SPECIFIED ?                     SAM10250
         BNO   DD$TRNC1           NO                                    SAM10260
         LH    7,DS$IRG           LOAD IOREG DISPLACEMENT               SAM10270
         BAL   14,DD$RCP18        SET IOREG                             SAM10280
DD$TRNC1 LH    5,DC$PBKS           CALC VBLD                            SAM10290
         SH    5,DD$FOUR           *                                    SAM10300
         BAL   11,DD$RCP9          *                                    SAM10310
         BAL   3,DD$WAIT                WAIT I/O                        SAM10320
         MVI   DC$REQS,X'20'            SET PUT CODE                    SAM10330
         B     DD$PT50A                                                 SAM10340
DD$FOUR  DC    Y(4)                                                     SAM10360
         ENDO                                                           SAM10370
         DO    '&INPUT'='YES'                                           SAM10380
DD$RELSE TM    DC$FG3,X'60'        INPUT FILE ?                         SAM10390
         BZ    DD$ERR                   NO, INVALID MACRO ERROR         SAM10400
         TM    DC$FG4,X'10'       IOREG SPECIFIED ?                     SAM10410
         BNO   DD$RELS1           NO                                    SAM10420
         LH    7,DS$IRG           LOAD IOREG DISPLACEMENT               SAM10430
         BAL   14,DD$RCP18        SET IOREG                             SAM10440
DD$RELS1 BAL   3,DD$WAIT                ISSUE WAIT                      SAM10450
         MVI   DC$REQS,X'10'            SET GET CODE                    SAM10451
         OI    DC$FG4,X'02'             SET READ REQUIRED               SAM10460
         TM    DC$FG5,X'10'             BUFFER UPDATED                  SAM10470
         BNO   DD$RW1B                  NO                              SAM10480
         MVI   DC$FCS,X'20'             *                               SAM10490
         B     DD$RDWT1                 WRITE UPDATED BLOCK             SAM10500
         ENDO                                                           SAM10510
         ENDO                                                           SAM10520
         DO    &P(0)=3                                                  SAM10530
DD$CTL   EQU   *                                                        SAM10540
         CLI   DC$REQS,X'C1'            POINTS ISSUED ?                 SAM10550
         BNE   DD$CTL1                 NO                               SAM10560
         LA    D7$,1(0,0)               YES, SET CURRENT PCA            SAM10570
         ST    D7$,DC$PCAID                  RELATIVE ADDRESS TO 1      SAM10580
         XC    DS$CUR(4),DS$CUR         RESET BUFFER POINTERS           SAM10590
DD$CTL00 OI    DC$FG5,X'20'             SET POINT ISSUED                SAM10600
         NI    DC$FG5,X'BF'             CLEAR EOF SENSED                SAM10610
         NI    DC$FG6,X'B7'             EOF ACTIVE, SHORT BLOCK         SAM10620
         B     DD$EXIT                  RETURN                          SAM10630
DD$CTL1  CLI   DC$REQS,X'C2'            NOTE ISSUED ?                   SAM10640
         BNE   DD$CTL2                 NO                               SAM10650
         L     6,DC$BBB                 LOAD ID FOR NOTE                SAM10660
         TM    DC$FG5,X'02'       GET LAST ISSUED ?                     SAM10670
         BNO   DD$EXIT                  NO, EXIT                        SAM10680
         TM    DC$FG3,X'20'       UPDATE GET ?                          SAM10690
         BO    DD$CTLST           YES                                   SAM10700
         BCTR  6,0                SET CURRENT ID                        SAM10710
DD$CTLST ST    6,DC$BBB           SET ID FOR NOTE                       SAM10720
         B     DD$EXIT                  EXIT                            SAM10730
DD$CTL2  CLI   DC$REQS,X'C3'            POINT ISSUED ?                  SAM10740
         BNE   DD$CTL3                 NO                               SAM10750
         TM    DC$FG5,X'10'             BUFFER UPDATED ?                SAM10752
         BNO   DD$CTL2A                 NO                              SAM10753
         MVI   DC$REQS,X'20'            WRITE AND WAIT UPDATED BLOCK    SAM10754
         OI    DC$MFLG,X'20'            *                               SAM10755
         BAL   11,DD$ISSUE              *                               SAM10756
DD$CTL2A TM    DC$FG4,X'40'             IOA2 SPEC ?                     SAM10757
         BNO   DD$CTL2B                 NO                              SAM10758
         OI    DC$FG6,X'04'             YES, SET IOA2 READ REQUIRED     SAM10759
DD$CTL2B XC    DS$LST(2),DS$LST         CLEAR LAST RCSZ FIELD           SAM10760
         LR    4,0                 LOAD ADDRESS FIELD POINTER           SAM10770
         MVC   DC$PCAID(4),0(4)    SET RELATIVE ID AND DISPLACEMENT     SAM10780
         MVC   DS$CUR(2),4(4)      *                                    SAM10790
         B     DD$CTL00                 EXIT                            SAM10800
         ENDO                                                           SAM10810
         DO    &P(0)=1                                                  SAM10820
DD$CTL3  EQU   *                                                        SAM10830
         GOTO  .L100                                                    SAM10840
         ENDO                                                           SAM10850
DD$CTL3  OC    DD$SKAD(4),DD$SKAD       SEEKADR SPECIFIED?              SAM10860
         BZ    DD$CTL4                  NO,DD$CTL4                      SAM10870
         BAL   RE$,DD$RCVRT             LINK TO CONVERT REL ADDRESS     SAM10880
         NI    DC$RFM+1,X'7F'           CLEAR FORMAT WRITE BIT          SAM10890
.L100    LABEL                                                          SAM10900
DD$CTL4  MVI   DC$REQS,X'85'            SET FUNCTION CODE TO SEEK       SAM10910
         BAL   11,DD$ISSUE              LINK TO COMMON ISSUE ROUTINE    SAM10920
         B     DD$EXIT                  RETURN                          SAM10930
         DO    &P(0)=1=0                                                SAM10940
DD$WTF   NI    DC$FG4,X'FB'             CLEAR WAITF REQUIRED            SAM10950
         BAL   3,DD$WAIT                ISSUE WAIT                      SAM10960
         NI    DC$CCBF2,X'DF'           CLEAR ACCEPT UNIQUE FLAG        SAM10970
         TM    DC$FG2,X'80'       IDLOC ?                               SAM10980
         BNO   DD$WTF1                  NO                              SAM10990
         BAL   RE$,DD$CVRT1       LINK TO NOTE/IDLOC ADDRESS CONVERT    SAM11000
         L     7,DD$IDLOC               LOAD IDLOC ADDRESS              SAM11010
         L     14,DC$BBB                SET IDLOC VALUE                 SAM11020
         ST    6,DC$BBB                 *                               SAM11030
         MVC   0(4,7),DC$BBB            *                               SAM11040
         ST    14,DC$BBB                *                               SAM11050
DD$WTF1  TM    DC$FG5,X'04'             READ KEY ?                      SAM11060
         BNO   DD$EXIT                  NO, EXIT                        SAM11070
         CLC   DC$SB+2(2),DC$HIHD       GOOD READ ?                     SAM11080
         BNH   DD$EXIT                  YES, EXIT                       SAM11090
         OI    DC$ERFLG,X'10'           SET NO-FIND/END TRACK           SAM11100
         OI    DC$ERFLG+1,X'13'           H/W ERROR FLAGS               SAM11110
         MVI   DC$ERCD,X'31'            SET ERROR CODE                  SAM11120
         BAL   14,DD$ERRTN              LINK TO UTINE                 SAM11130
         ENDO                                                           SAM11140
DD$ISSUE L     15,DC$RELOC         LOAD SAT ADDRESS                     SAM11150
         BALR  14,15                    LINK TO SAT                     SAM11160
         L     15,16(13)                RESTORE I/O COVER               SAM11170
         MVC   DC$REQS(1),DC$FCS        RESTORE FUNCTION CODE           SAM11180
         BR    11                       RETURN                          SAM11190
DD$WAIT  TM    DC$MFLG,X'40'            WAIT REQ'D ?                    SAM11200
         BNOR  3                        NO                              SAM11210
         MVI   DC$REQS,X'86'            SET WAITF CODE                  SAM11220
         BAL   11,DD$ISSUE              ISSUE WAIT                      SAM11230
         MVC   DC$ERRF(2),DC$ERFLG      SET FILENAME.C                  SAM11240
         MVC   DC$ERRF+2(1),DC$SB       *                               SAM11250
         MVI   DC$ERRF+3,0              *                               SAM11260
         BR    3                        RETURN                          SAM11270
DD$ERRTN LM    14,12,12(13)             RESTORE USER REGISTERS          SAM11280
         L     13,DC$SAVR                   REGISTERS                   SAM11290
         SVC   60                       CALL ERROR TRANSIENT            SAM11300
         DC    X'110576'                REVISION DATE                   SAM11310
         EJECT                                                          SAM11320
*   CALL FILE TABLE DSECT FOR NON-INDEXED PROCESSOR SYSTEM   *          SAM11330
         DTFDM NI=YES                                                   SAM11340
         DROP  R1$,DC$,RF$                                              SAM11350
&SYSECT  CSECT                                                          SAM11360
         END                                                            SAM11370
