DDR      TITLE 'DMKDDR     (CP)        VM/370 - RELEASE 6'              00001000
*.                                                                      00002000
*                                                                       00003000
*  MODULE NAME                                                          00004000
*                                                                       00005000
*        DMKDDR         DASD DUMP RESTORE PROGRAM                       00006000
*                                                                       00007000
*  FUNCTION                                                             00008000
*                                                                       00009000
*        DUMP - TO SAVE DATA FROM A DIRECT ACCESS VOLUME ONTO           00010000
*        A MAGNETIC TAPE OR TAPES.  THE DATA IS SAVED CYLINDER          00011000
*        BY CYLINDER.  ANY NUMBER OF CYLINDERS MAY BE SAVED.            00012000
*        THE FORMAT OF THE TAPE WILL BE:                                00013000
*                                                                       00014000
*             RECORD (1) VOLUME HEADER RECORD:  CONSISTING              00015000
*             OF DATA DESCRIBING THE VOLUME.                            00016000
*                                                                       00017000
*             RECORD (2) TRACK HEADER RECORD:  CONSISTING OF            00018000
*             A LIST OF COUNT FIELDS TO RESTORE THE TRACK AND           00019000
*             THE NUMBER OF DATA RECORDS WRITTEN ON TAPE.               00020000
*             AFTER THE LAST COUNT FIELD THE RECORD WILL CONTAIN        00021000
*             KEY AND DATA RECORDS TO FILL THE 4K BUFFER.               00022000
*                                                                       00023000
*             RECORD (3) TRACK DATA RECORDS: CONSISTING OF KEY          00024000
*             AND DATA RECORDS PACKED INTO 4K BLOCKS WITH THE           00025000
*             LAST RECORD TRUNCATED.                                    00026000
*                                                                       00027000
*             RECORD (4) END OF VOLUME OR END OF JOB TRAILER            00028000
*             LABEL:  IT WILL CONTAIN THE SAME INFORMATION              00029000
*             AS THE NEXT VOLUME HEADER RECORD.                         00030000
*                                                                       00031000
*        RESTORE - TO RETURN DATA WHICH HAS BEEN DUMPED BY THIS         00032000
*        PROGRAM.  DATA WILL BE RESTORED ONLY TO A VOLUME               00033000
*        OF THE SAME DEVICE TYPE AS IT WAS DUMPED FROM.                 00034000
*                                                                       00035000
*        COPY - TO COPY DATA FROM ONE DEVICE TO ANOTHER                 00036000
*        DEVICE OF THE SAME TYPE.  DATA MAY BE REORDERED ON A           00037000
*        CYLINDER BASIS FROM INPUT DEVICE TO OUTPUT DEVICE.             00038000
*        TAPE TO TAPE COPY WILL WORK ONLY WITH DATA DUMPED              00039000
*        BY THIS PROGRAM.                                               00040000
*                                                                       00041000
*        PRINT - TO PRINT A TRANSLATION OF EACH RECORD                  00042000
*        SPECIFIED ONTO THE SYSPRINT DEVICE.                            00043000
*                                                                       00044000
*        TYPE - TO PRINT A TRANSLATION OF EACH RECORD                   00045000
*        SPECIFIED ONTO THE CONSOLE.                                    00046000
*                                                                       00047000
         EJECT                                                          00048000
*  COMMAND LINE UNDER CMS                                               00049000
*                                                                       00050000
*  +-----------------------------------------+                          00051000
*  |  DDR  <FILENAME  FILETYPE  <FILEMODE>>  |                          00052000
*  +-----------------------------------------+                          00053000
*                                                                       00054000
*        THE DDR COMMAND WILL INVOKE THE PROGRAM UNDER                  00055000
*        CMS.  IF NO FILENAME AND FILETYPE ARE PROVDED THE              00056000
*        PROGRAM WILL SOLICIT CONTROL STATEMENTS FROM THE               00057000
*        CONSOLE.  ELSE IT WILL READ THE CONTROL STATEMENTS             00058000
*        FROM THE CMS FILE.  THE FILEMODE WILL DEFAULT                  00059000
*        TO * IF NOT PROVIDED.                                          00060000
*                                                                       00061000
*  CONTROL STATEMENTS                                                   00062000
*                                                                       00063000
*        ALL CONTROL STATEMENTS MAY BE ENTERED FROM THE CONSOLE         00064000
*        OR A CARD READER.  ONLY COLUMN 1 TO 71 WILL BE                 00065000
*        INSPECTED BY THE PROGRAM.  ALL DATA AFTER THE LAST             00066000
*        POSSIBLE PARAMETER ,FOR THE STATEMENT, WILL BE IGNORED.        00067000
*        AN AT SIGN WILL BE TREATED AS A LOGICAL BACKSPACE AND          00068000
*        A CENT SIGN WILL CANCEL THE TOTAL LINE AND RESULT IN           00069000
*        A NEW READ TO THE CONSOLE OR CARD READER.  BECAUSE A           00070000
*        TAPE MUST HAVE ITS CYLINDER HEADER RECOTDS WRITTEN             00071000
*        IN ASSENDING SEQUENCE, THE EXTENTS MUST BE ENTERED IN          00072000
*        SEQUENCE BY REORDED CYLINDERS.  ONLY ONE TYPE OF               00073000
*        BACKUP FUNCTION MAY BE EXECUTED IN ONE STEP.  BUT UP           00074000
*        TO 20 STATEMENTS DESCRIBING CYLINDER EXTENTS MAY BE            00075000
*        ENTERED.  THE FUNCTION STATEMENTS WILL BE DELIMITED BY         00076000
*        DETECTION OF AN INPUT OR OUTPUT STATEMENT.  ALSO A NULL        00077000
*        LINE IF THE CONSOLE IS USED FOR INPUT.  IF ADDITIONAL          00078000
*        FUNCTIONS ARE TO BE PERFORMED, THAN THE SEQUENCE IS            00079000
*        REPEATED.  ONLY THOSE STATEMENTS NEEDED TO REDEFINE            00080000
*        THE IO DEFINITIONS ARE NECESSARY FOR SUBSEQUENT STEPS.         00081000
*        ALL OTHER IO DEFINITIONS WILL REMAIN THE SAME.                 00082000
*        THE PRINT AND TYPE STATEMENTS WORK SLIGHTLY DIFFERENT          00083000
*        IN THAT THAY WILL WORK WITH ONLY ONE DATA EXTENT               00084000
*        AT A TIME.  IF THE INPUT IS FROM A TAPE CREATED BY             00085000
*        THE DUMP FUNCTION, IT MUST BE POSITIONED AT THE                00086000
*        HEADER RECORD FOR EACH STEP.  ALSO THE PRINT AND TYPE          00087000
*        STATEMENT HAS AN INPLIED OUTPUT DEFINITION, DESCRIBING         00088000
*        THE CONSOLE OR SYSPRINT DEVICE.  THEREFOR PRINT AND            00089000
*        TYPE STATEMENTS NEAD NOT BE DELIMITED BY AN INPUT              00090000
*        OR OUTPUT STATEMENT.                                           00091000
*                                                                       00092000
         EJECT                                                          00093000
*  IO DEFINITION STATEMENTS                                             00094000
*                                                                       00095000
*  +--------+-----------------------------------------------------+     00096000
*  | INPUT  |  CCU  TYPE  <VOLSER>                                |     00097000
*  | IN     |             <ALTAPE>  ( SKIP XX MODE 6250 REWIND )  |     00098000
*  | OUTPUT |                         SK      MO   62   RE        |     00099000
*  | OUT    |                                      1600 UNLOAD    |     00100000
*  |        |                                      16   UN        |     00101000
*  |        |                                      800  LEAVE     |     00102000
*  |        |                                      80   LE        |     00103000
*  +--------+-----------------------------------------------------+     00104000
*                                                                       00105000
*        THE INPUT OR OUTPUT CARD IS USED TO DESCRIBE                   00106000
*        ALL TAPE AND DASD UNITS USED.                                  00107000
*                                                                       00108000
*        CCU = THE UNIT ADDRESS OF THE DEVICE                           00109000
*                                                                       00110000
*        TYPE = 2305-1,2305-2,2314,2319,3330,3330-11,3340-35,3340-70,   00111000
*               3350, 3380                                     HRC012DK 00112490
*               2400,2401,2415,2420,3410,3411,3420 (NO 7-TRK SUPPORT)   00113000
*               2400,2420 OR 3420    (NO 7 TRACK SUPPORT)               00114000
*                                                                       00115000
*        VOLSER = THE VOLUME SERIAL NUMBER OF A DASD DEVICE.            00116000
*          NOTE:   IF THE KEYWORD 'SCRATCH' IS SPECIFIED, NO LABEL      00117000
*                  VERIFICATION WILL BE PERFORMED.                      00118000
*                                                                       00119000
*        ALTAPE = THE ADDRESS OF AN ALTERNATE TAPE DRIVE.               00120000
*                                                                       00121000
*        THE OPTIONS WILL BE DELIMITED BY A LEFT PARENTHESIS.           00122000
*        THE RIGHT PARENTHESIS IS OPTIONAL.  THE OPTIONS ONLY           00123000
*        APPLY TO TAPE AND MAY BE ENTERED WITHOUT REDEFINING            00124000
*        THE INPUT OR OUTPUT UNIT DEFINITION.  THE DEFAULT              00125000
*        OPTIONS WILL BE SKIP 0 AND UNLOAD. (NO MODE WILL BE SET)       00126000
*        NOTE:  THE DEFAULTS ARE ASSIGNED WHEN THE DEVICE IS            00127000
*        DEFINED.  ALL OPTIONS ENTERED WILL THEN OVERRIDE               00128000
*        ANY PREVIOUS DEFINITION.  ALL OPTIONS ARE SELF DEFINING        00129000
*        AND NOT POSITIONAL.                                            00130000
*                                                                       00131000
*        SKIP XX WILL FORWARD SPACE FILE THE NUMBER OF                  00132000
*        TIMES SPECFIED.  XX = ANY NUMBER UP TO 255                     00133000
*        NOTE: THE SKIP OPTION IS RESET TO ZERO AFTER THE               00134000
*        TAPE HAS BEEN POSITIONED.                                      00135000
*                                                                       00136000
*        THE MODE OPTION WILL CAUSE ALL OUTPUT TAPES, OPENED FOR        00137000
*        FIRST TIME AND AT LOAD POINT, TO BE SET TO THE SPECIFIED       00138000
*        MODE.  ALL SUBSEQUENT TAPES MOUNTED WILL ALSO BE               00139000
*        SET TO THE SPECIFIED MODE. IF NO MODE OPTION IS                00140000
*        SPECFIED, THAN NO MODE SET IS PERFORMED.                       00141000
*                                                                       00142000
*             1600 = 9 TRACK  1600 BPI  X'C3'                           00143000
*             800  = 9 TRACK   800 BPI  X'CB'                           00144000
*                                                                       00145000
         EJECT                                                          00146000
*        REWIND WILL REWIND THE TAPE AT THE END OF A FUNCTION.          00147000
*                                                                       00148000
*        UNLOAD WILL REWIND UNLOAD THE TAPE  AT THE                     00149000
*        END OF A FUNCTION.                                             00150000
*                                                                       00151000
*        LEAVE WILL LEAVE THE TAPE POSITIONED AFTER THE TAPE            00152000
*        MARK AT THE COMPLETION OF A FUNCTION.                          00153000
*                                                                       00154000
*  +-----------------+                                                  00155000
*  |  SYSPRINT  CCU  |                                                  00156000
*  |  SYS       CONS |                                         HRC012DK 00156500
*  |  SY             |                                                  00157000
*  +-----------------+                                                  00158000
*                                                                       00159000
*        THIS CARD IS USED TO DESCRIBE A PRINTER DEVICE.  IT IS         00160000
*        USED TO PRINT DATA EXTENTS SPECIFIED BY THE PRINT              00161000
*        STATEMENT.  IT IS ALSO USED TO PRINT A MAP OF THE              00162000
*        CYLINDER EXTENTS FROM THE DUMP, RESTORE OR COPY                00163000
*        STATEMENT. IF THE SYSPRINT STATEMENT IS NOT PROVIDED           00164000
*        THE DEFAULT DEVICE ADDRESS IS 00E.                             00165000
*                                                                       00166000
*        CCU = THE UNIT ADDRESS OF THE DEVICE                           00167000
*                                                                       00168000
*  FUNCTION STATEMENT                                                   00169000
*                                                                       00170000
*  +----------+--------------------------------------------+            00171000
*  |  DUMP    |  CCC  <TO>  <CCC  <REORDER>  <TO>  <CCC>>  |            00172000
*  |  DU      |  CPVOL T           R          T            |            00173000
*  |  COPY    |  CP                                        |            00174000
*  |  CO      |  ALL                                       |            00175000
*  |  RESTORE |  AL                                        |            00176000
*  |  RE      |                                            |            00177000
*  |          |  NUCLEUS                                   |      (NUC) 00178000
*  |          |  NU                                        |      (NUC) 00179000
*  +----------+--------------------------------------------+            00180000
*                                                                       00181000
*        THE FUNCTION COMMANDS WILL DESCRIBE THE EXTENTS TO BE          00182000
*        DUMPED,COPIED OR RESTORED.  IF THE 'CCC' PARAMETER             00183000
*        IS USED, THAN ONLY THOSE CYLINDERS SPECIFIED WILL BE           00184000
*        MOVED STARTING WITH THE FIRST TRACK OF THE FIRCT 'CCC'         00185000
*        AND ENDING WITH THE LAST TRACK OF THE SECOND 'CCC'.  THE       00186000
*        REORDER PARAMITER WILL CAUSE THE OUTPUT TO BE REORDERED        00187000
*        STARTING AT THE SPECIFIED CYLINDER.  IF 'ALL' IS               00188000
*        SPECIFIED, THEN ALL PRIMARY DATA CYLINDERS ARE MOVED.          00189000
*        ALTERNATE CYLINDERS ARE NOT INCLUDED IN THE MOVE AS            00190000
*        CYLINDERS, HOWEVER THE CONTENTS OF ASSIGNED ALTERNATE          00191000
*        TRACKS ARE MOVED TO SUBSTITUTE FOR THE CORRESPONDING           00192000
*        DEFECTIVE TRACKS.  (ALTERNATE CYLINDERS CAN ONLY               00193000
*        BE MOVED BY AN EXPLICITE 'CCC TO CCC' SPECIFICATION            00194000
*        AND THEN ONLY TO TAPE UNLESS THE 'REORDER' FUNCTION            00195000
*        IF SPECIFIED.  IF 'CPVOL' IS                                   00196000
*        SPECIFIED THAN CYLINDER 0 AND ALL ALLOCATED                    00197000
*        DIRECTORY AND PERMANENT SPACE WILL BE DUMPED OR COPIED         00198000
*        AS INDICATED BY THE 'VM/370' ALLOCATION RECORD FROM            00199000
*        THE INPUT DEVICE.  IN THE CASE OF A TAPE INPUT FUNCTION        00200000
*        SPECIFYING CPVOL, ALL THE DATA IS RESTORED OR COPIED.          00201000
*        THE NUCLEUS PARAMITER WILL CAUSE RECORD 2 ON CYLINDER 0  (NUC) 00202000
*        TRACK 0 AND THE NUCLEUS CYLINDERS (INDICATED BY RECORD   (NUC) 00203000
*        2) TO BE DUMPED COPIED OR RESTORED.                      (NUC) 00204000
*        IT IS THE RESPONSIBILITY OF THE USER TO                        00205000
*        INSURE THAT ALL THE DATA NOT RESTORED OR COPIED                00206000
*        IS IN THE PROPER FORMAT, AS DESCRIBED IN THE 'VM/370'          00207000
*        ALLOCATION RECORD.  THE 'TO' AND 'REORDER' KEYWORD'S           00208000
*        ARE OPTIONAL.                                                  00209000
*                                                                       00210000
*        NOTE: IF THE CYLINDER EXTENTS ARE BEING EXPLICITY DEFINED      00211000
*        FROM THE CONSOLE, THE MESSAGE 'ENTER CYLINDER EXTENTS'         00212000
*        FOLLOWED BY THE ENTER: PROMPT WILL BE TYPED.  THE USER MAY     00213000
*        RESPOND BY ENTERING ADDITIONAL EXTENTS, OR A NULL LINE         00214000
*        TO START THE JOB STEP.                                         00215000
*                                                                       00216000
*        RESTRICTIONS:                                                  00217000
*                                                                       00218000
*        EACH TRACK MUST CONTAIN A VALID HOME ADDRESS, CONTAINING       00219000
*        THE REAL CYLINDER AND TRACK LOCATION.                          00220000
*                                                                       00221000
*        RECORD ZERO MUST NOT CONTAIN A TOTAL OF OVER 8 KEY             00222000
*        AND/OR DATA CHARACTERS.                                        00223000
*                                                                       00224000
*        FLAGGED TRACKS WILL BE TREATED AS ANY OTHER TRACK FOR          00225000
*        2305 (SEE NOTE BELOW), 2314, AND 2319.  THAT IS, NO ATTEMPT    00226000
*        WILL BE MADE TO SUBSTITUTE THE ALTERNATE TRACK DATA WHEN A     00227000
*        DEFECTIVE PRIMARY TRACK IS READ.  ALSO TRACK'S WILL NOT        00228000
*        BE INSPECTED, TO DETERMINE IF THAY WERE PREVIOUSLY FLAGGED,    00229000
*        WHEN WRITTEN.  IT IS THEREFORE RECOMMENDED THAT VOLUMES        00230000
*        DUMPED, CONTAINING FLAGGED TRACKS, BE RESTORED TO THE          00231000
*        SAME VOLUME.  MSG DMKDDR715E WILL BE TYPED EACH TIME           00232000
*        A DEFECTIVE TRACK IS DUMPED, COPIED OR RESTORED AND THE        00233000
*        OPERATION WILL CONTINUE.                                       00234000
*        NOTE: ON THE 2305, DEFECTIVE TRACKS ARE USUALLY REWIRED TO     00235000
*        AN ALTERNATE TRACK BY THE CE RATHER THAN BEING FLAGGED IN      00236000
*        THE USUAL MANNER.  IN THIS CASE THE FACT THAT A TRACK IS       00237000
*        DEFECTIVE AND HAS AN ALTERNATE WIRED IN IS TRANSPARENT TO      00238000
*        ALL PROGRAMMING.                                               00239000
*                                                                       00240000
*        FLAGGED TRACKS FOR A 3330/3350 ARE AUTOMATICALLY HANDLED BY    00241000
*        THE CONTROL UNIT AND SHOULD NEVER BE DETECTED BY THE           00242000
*        PROGRAM.  HOWEVER IF A FLAGGED TRACK IS DETECTED               00243000
*        THE MSG DMKDDR715E WILL BE TYPED AND THE JOB STEP WILL         00244000
*        TERMINATE.                                                     00245000
*                                                                       00246000
*        FLAGGED TRACKS ON A 3340/3344 ARE HANDLED BY SOFTWARE ERROR    00247000
*        RECOVERY (AS OF RELEASE 5 PLC 5).  THERE IS NO HARDWARE        00248000
*        ERROR RECOVERY FOR FLAGGED TRACKS ON A 3340/3344.              00249000
*        THE SOFTWARE SUPPORT IS SUCH THAT THE ALTERNATE TRACKS WILL    00250000
*        BE LOCATED IN THE TRUE ALTERNATE TRACK CYLINDER(S) AT THE      00251000
*        END OF THE REAL DISK, NOT WITHIN A CYLINDER OF THE AFFECTED    00252000
*        MINI-DISK AS HAS SOMETIMES BEEN THE PRACTICE WITH 2314 DISKS.  00253000
*        THE DDR PROGRAM HAS ERROR RECOVERY FOR FLAGGED TRACKS TO       00254000
*        ALLOW IT TO GO AND GET DATA FROM THE ASSIGNED ALTERNATE WHEN   00255000
*        A FLAGGED TRACK IS ENCOUNTERED.  THE SAME APPLIES WHEN DATA    00256000
*        IS BEING WRITTEN TO A FLAGGED TRACK; THE DATA WILL GET         00257000
*        WRITTEN ON THE ALTERNATE.  THE FORMAT OF THE DATA WRITTEN ON   00258000
*        TAPE IS INDEPENDENT OF WHICH TRACKS WERE FLAGGED, IT ALWAYS    00259000
*        LOOKS LIKE ALL TRACKS WERE GOOD TRACKS.  THEREFORE, DATA CAN   00260000
*        BE DUMPED FROM ONE 3340/3344 PACK WITH FLAGGED TRACKS AND      00261000
*        CAN LATER BE RESTORED TO ANOTHER PACK HAVING DIFFERENT         00262000
*        TRACKS FLAGGED.                                                00263000
*                                                                       00264000
*        COMPATABILITY OF THE NEW DDR WITH OLD TAPES:                   00265000
*                                                                       00266000
*        AS LONG AS ALL CYLINDERS DUMPED TO TAPE WITH THE OLD PROGRAM   00267000
*        WERE FREE OF FLAGGED TRACKS, THE CYLINDERS CAN BE RESTORED     00268000
*        TO DISK WITH THE NEW PROGRAM, EVEN TO CYLINDERS HAVING FLAGGED 00269000
*        TRACKS.  EVEN IF SOME CYLINDERS DUMPED WITH THE OLD PROGRAM    00270000
*        DID HAVE FLAGGED TRACKS, IT SHOULD BE POSSIBLE TO RESTORE      00271000
*        THE OTHER CYLINDERS FROM THE OLD TAPE USING THE NEW PROGRAM.   00272000
*                                                                       00273000
*        EITHER PROGRAM, OLD OR NEW, CAN DUMP FROM ALL CYLINDERS,       00274000
*        INCLUDING THE ALTERNATE TRACK CYLINDERS.  THIS IS ALLOWED TO   00275000
*        PERMIT CONVERSION TO THE NEW SYSTEM FROM THE OLD WAY OF        00276000
*        DOING THINGS WHERE SOME USERS MAY HAVE USED THE ALTERNATE      00277000
*        TRACK CYLINDERS AS A PRIMARY DATA AREA SINCE AFTER ALL         00278000
*        THERE WAS NO SUPPORT FOR USING IT FOR ALTERNATE TRACKS.        00279000
*                                                                       00280000
*        BUT WITH THE NEW PROGRAM YOU CANNOT EVER RESTORE A CYLINDER    00281000
*        TO THE ALTERNATE TRACK CYLINDER(S).  ANY MINI-DISK THAT        00282000
*        EXTENDED INTO THE ALTERNATE TRACK CYLINDER(S) WILL HAVE TO     00283000
*        BE MOVED TO ANOTHER AREA OF THE DISK OR TO ANOTHER DISK.       00284000
*        THIS CAN BE DONE BY USING THE 'REORDER' FUNCTION TO COPY OR    00285000
*        RESTORE A MINI-DISK TO ANOTHER AREA.                           00286000
         EJECT                                                          00287000
*  EXAMPLE                                                              00288000
*                                                                       00289000
*        INPUT 191 3330 SYSRES                                          00290000
*        OUTPUT 180 2400 181 ( MODE 800                                 00291000
*        SYSPRINT 00F                                                   00292000
*        DUMP CPVOL                                                     00293000
*        INPUT 130 3330 MINI01                                          00294000
*        DUMP 1 TO 50 REORDER 51                                        00295000
*        60 70 101                                                      00296000
*                                                                       00297000
*        THIS EXAMPLE WILL SET THE MODE TO 800 BPI AND THEN DUMP        00298000
*        ALL PERTINENT DATA FROM THE VOLUME LABELED 'SYSRES'            00299000
*        ONTO THE TAPE THAT IS MOUNTED ON UNIT 180.  IF                 00300000
*        THE PROGRAM RUNS OUT OF ROOM ON THE FIRST TAPE                 00301000
*        IT WILL CONTINUE DUMPING ONTO THE ALTERNATE DEVICE 181.        00302000
*        WHILE DUMPING, A MAP OF THE CYLINDERS DUMPED WILL BE           00303000
*        PRINTED ON 00F.  THEN THE VOLUME LABELED 'MINI01' WILL         00304000
*        BE DUMPED ONTO A NEW TAPE.  ITS CYLINDERS                      00305000
*        HEADER  RECORDS WILL BE LABELED 51 TO 100. A MAP               00306000
*        OF THE CYLINDERS DUMPED WILL BE PRINTED ON                     00307000
*        UNIT 00F.  NEXT CYLINDERS 60 TO 70 WILL DUMPED                 00308000
*        AND LABELED 101 TO 110.  THIS EXTENT WILL BE                   00309000
*        ADDED TO THE CYLINDER MAP ON THE SYSPRINT DEVICE,              00310000
*        UNIT 00F.   TAPES MOUNTED WILL BE UNLODED AND                  00311000
*        THE PROGRAM WILL GO TO TERMINATION.                            00312000
*                                                                       00313000
*  +--------+--------------------------------------------------------+  00314000
*  |  PRINT |  CC1  <HH1  <RR1>>  <TO  CC2  <HH2  <RR2>>>  (OPTIONS) |  00315000
*  |  PR    |                      T                                 |  00316000
*  |  TYPE  |      OPTIONS: ( HEX GRAPHIC COUNT )                    |  00317000
*  |  TY    |                 H   G       C                          |  00318000
*  +--------+--------------------------------------------------------+  00319000
*                                                                       00320000
*        THIS FUNCTION WILL PRINT OR TYPE A HEXADECIMAL AND GRAPHIC     00321000
*        TRANSLATION OF EACH RECORD SPECIFIED DEPENDING ON THE          00322000
*        OPTIONS SPECIFIED.  THE DEFAULT OPTIONS ARE HEX AND GRAPHIC.   00323000
*        THE INPUT DEVICE MUST BE DEFINED AS A DASD OR                  00324000
*        TAPE DEVICE.  THE OUTPUT WILL GO TO THE CONSOLE                00325000
*        FOR THE TYPE FUNCTION OR THE SYSPRINT DEVICE                   00326000
*        FOR THE PRINT FUNCTION. THIS WILL NOT REDEFIN                  00327000
*        THE OUTPUT UNIT DEFINITION.                                    00328000
*                                                                       00329000
*        CC1 = THE STARTING CYLINDER. THIS MUST BE THE                  00330000
*              FIRST PARAMETER AFTER THE PRINT PARAMETER.               00331000
*                                                                       00332000
*        HH1 = THE STARTING TRACK.  IF PRESENT IT MUST FOLLOW           00333000
*              THE CC1 PARAMETER.  THE DEFAULT IS TRACK ZERO.           00334000
*                                                                       00335000
*        RR1 = THE STARTING RECORD ID FROM THE DASD DEVICE              00336000
*              IF PRESENT IT MUST FOLLOW THE HH1 PRAMETER.              00337000
*              THE DEFAULT IS HOME ADDRESS AND RECORD ZERO.             00338000
*                                                                       00339000
         EJECT                                                          00340000
*        TO  = A KEYWORD DELIMITING THE STARTING AND ENDING             00341000
*              ADDRESS.  IF NOT PRESENT THAN ONLY ONE CYLINDER,         00342000
*              TRACK OR RECORD WILL BE PRINTED.  DEPENDING              00343000
*              UPON THE EXTENT OF THE DEFINITION.                       00344000
*                                                                       00345000
*        CC2 = THE ENDING CYLINDER.  THIS MUST BE THE FIRST             00346000
*              PARAMETER AFTER THE TO KEYWORD.                          00347000
*                                                                       00348000
*        HH2 = THE ENDING TRACK.  IF PRESENT IT MUST FOLLOW             00349000
*              THE CC2 PARAMETER.  THE DEFAULT IS THE LAST              00350000
*              TRACK ON THE ENDING CYLINDER.                            00351000
*                                                                       00352000
*        RR2 = THE RECORD ID OF THE LAST RECORD TO PRINT.               00353000
*              THE DEFAULT IS THE LAST RECORD ON THE                    00354000
*              ENDING TRACK.                                            00355000
*                                                                       00356000
*        OPTIONS:                                                       00357000
*                                                                       00358000
*        HEX   PRINT OR TYPE A HEXADECIMAL TRANSLATION OF EACH          00359000
*              RECORD SPECIFIED.                                        00360000
*                                                                       00361000
*        GRAPHIC  PRINT OR TYPE A GRAPHIC TRANSLATION OF EACH           00362000
*              RECORD SPECIFIED.                                        00363000
*                                                                       00364000
*        COUNT  PRINT OR TYPE ONLY THE COUNT FIELD FOR EACH             00365000
*              RECORD SPECIFIED.                                        00366000
*                                                                       00367000
*  EXAMPLE:                                                             00368000
*                                                                       00369000
*        PRINT 0 TO 3                                                   00370000
*        THIS WILL PRINT ALL OF THE RECORDS ON CYLINDER                 00371000
*        0,1,2 AND 3.                                                   00372000
*                                                                       00373000
*        PRINT 0 1 3                                                    00374000
*        THIS WILL PRINT ONLY ONE RECORD, RECORD 3 ON                   00375000
*        CYLINDER 0 TRACK 1.                                            00376000
*                                                                       00377000
*        PRINT 1 10 3 TO 1 15 4                                         00378000
*        THIS WILL PRINT ALL RECORDS STARTING WITH RECORD 3             00379000
*        ON CYLINDER 1 TRACK 10 AND ENDING WITH RECORD 4                00380000
*        ON CYLINDER 1 TRACK 15.                                        00381000
*                                                                       00382000
         EJECT                                                          00383000
*  ATTRIBUTES                                                           00384000
*                                                                       00385000
*        SERIALLY REUSABLE                                              00386000
*                                                                       00387000
*  ENTRY POINTS                                                         00388000
*                                                                       00389000
*        DMKDDREP   DASD DUMP RESTORE PROGRAM ENTRY POINT               00390000
*                                                                       00391000
*        DMKDDRED  END OF THE LOAD MODULE FOR CMS                       00392000
*                                                                       00393000
*  ENTRY CONDITIONS                                                     00394000
*                                                                       00395000
*        NONE IF ON THE BARE MACHINE                                    00396000
*                                                                       00397000
*        UNDER CMS REG 1 WILL POINT TO A PARAMITER LIST                 00398000
*              CONTAINING THE FILE NAME, TYPE NAD MODE OF A             00399000
*              CMS FILE CONTAINING THE CONTROL STATEMENTS.              00400000
*              IF NOT PROVIDED THAN THE CONSOLE WILL BE                 00401000
*              AS INPUT.                                                00402000
*                                                                       00403000
*  EXIT CONDITIONS                                                      00404000
*                                                                       00405000
*        NONE IF ON THE BARE MACHINE                                    00406000
*                                                                       00407000
*        UNDER CMS REG 15 WILL CONTAIN A RETURN CODE:                   00408000
*                                                                       00409000
*            1 = INVALED FILE NAME OR FILE NOT FOUND                    00410000
*            2 = ERROR RUNNING THE PROGRAM                              00411000
*            3 = FLAGGED DASD TRACK                                     00412000
*            4 = PERMANENT TAPE OR DASD IO ERROR                        00413000
*            1XX = ERROR IN THE PRINTIO ROUTINE                         00414000
*            2XX = ERROR IN THE CONREAD ROUTINE                         00415000
*            3XX = ERROR IN THE RDBUF ROUTINE                           00416000
*            4XX = ERROR IN THE TYPLIN ROUTINE                          00417000
*                       XX = THE CMS ROUTINE RETURN CODE                00418000
*                                                                       00419000
*  EXTERNAL REFERENCES                                                  00420000
*                                                                       00421000
*        DMSACF  DMSCRD  DMSCWR                                         00422000
*                                                                       00423000
*  TABLES / WORK AREAS                                                  00424000
*                                                                       00425000
*        NAMETABLE      LIST OF VALID KEYWORDS FROM INPUT               00426000
*        EXTABLE        LIST OF EXTENTS TO BE DUMPED, RESTORED OR       00427000
*                       COPIED                                          00428000
*                                                                       00429000
*                                                                       00430000
         EJECT                                                          00431000
*  REGISTER USAGE                                                       00432000
*                                                                       00433000
*                                                                       00434000
*        R0 = WORK                                                      00435000
*        R1 = POINTER TO INPUT FIELD FROM SCANCONT                      00436000
*             POINTER TO THE OUTPUT BUFFER (PRINT/TYPE)                 00437000
*             WORK                                                      00438000
*        R2 = INPUT COUNT FROM SCANCONT                                 00439000
*             UNIT ADDRESS FOR STARTIO                                  00440000
*             DATA BLOCK COUNT (PRINT/TYPE)                             00441000
*             WORK                                                      00442000
*        R3 = END OF CURRENT LINE (PRINT/TYPE)                          00443000
*             WORK                                                      00444000
*        R4 = LENGTH OF ONE LINE (PRINT/TYPE)                           00445000
*             POINTER TO KEY (PRINT/TYPE)                               00446000
*             WORK                                                      00447000
*        R5 = TOTAL LENGTH OF DATA (PRINT/TYPE)                         00448000
*             WORK                                                      00449000
*        R6 = DATA COUNT (PRINT/TYPE)                                   00450000
*             NUMBER OF RECORDS ON THE TRACK (PRINT/TYPE)               00451000
*             WORK                                                      00452000
*        R7 = POINTER TO THE EXTENT TABLE ENTEY                         00453000
*             CURRENT LINE POINTER (PRINT/TYPE)                         00454000
*        R8 = EXTENT TABLE ENTRY SIZE                                   00455000
*             LAST LINE POINTER (PRINT/TYPE)                            00456000
*        R9 = BASE 5                                                    00457000
*        R10 = BASE 1                                                   00458000
*        R11 = BASE 2                                                   00459000
*        R12 = BASE 3                                                   00460000
*        R13 = BASE 4                                                   00461000
*        R14 = RETURN ADDRESS                                           00462000
*        R15 = POINTER TO THE IOB                                       00463000
*                                                                       00464000
         EJECT                                                          00465000
*  MESSAGES                                                             00466000
*                                                                       00467000
*        DMKDDR700E INPUT UNIT IS NOT A CPVOL                           00468000
*                                                                       00469000
*        DMKDDR701E INVALID OPERAND - XXXXXX                            00470000
*                       XXXXXX = THE PARAMETER IN ERROR FROM THE        00471000
*                       LAST INPUT LINE.                                00472000
*                                                                       00473000
*        DMKDDR702E CONTROL STATMENT SEQUENCE ERROR                     00474000
*                                                                       00475000
*        DMKDDR703E OPERAND MISSING                                     00476000
*                                                                       00477000
*        DMKDDR704E DEV CCU  NOT OPERATIONAL                            00478000
*                       CCU  = THE ADDRESS OF THE UNIT                  00479000
*                                                                       00480000
*        DMKDDR705E IO ERROR CCU CSW XXXXXXXXXXXXXXXX SENSE XXXXXXXXXXX 00481000
*        XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX                           00482000
*        INPUT XXXXXXXXXXXX OUTPUT XXXXXXXXXXXX CCW XXXXXXXXXXXXXXXX    00483000
*                       CCU  = THE UNIT ADDRESS OF THE DEVICE           00484000
*                       SENSE XX = 2, 6 OR 24 SENSE BYTES               00485000
*                       CSW = THE CSW FROM THE ERROR                    00486000
*             NOTE: SECOND HALF OF MSG APPLIES ONLY TO DASD AND TAPE    00487000
*                       INPUT XX = BB CC HH OF THE INPUT CYLINDER       00488000
*                       OUTPUT XX = BB CC HH OF THE OUTPUT CYL          00489000
*                       CCW XX = THE CCW IN ERROR                       00490000
*                                                                       00491000
*                                                                       00492000
*        DMKDDR707E MACHINE CHECK RUN SEREP AND SAVE OUTPUT FOR CE      00493000
*                                                                       00494000
*        DMKDDR708E INVALID INPUT OR OUTPUT DEFINITION                  00495000
*                                                                       00496000
*        DMKDDR709E WRONG INPUT TAPE MOUNTED                            00497000
*                                                                       00498000
*        DMKDDR710A DEV  CCU  INTERVENTION REQUIRED                     00499000
*                       CCU  = THE UNIT ADDRESS OF THE DEVICE           00500000
*                                                                       00501000
*        DMKDDR711R VOLID READ IS VOLSE1 NOT VOLSE2                     00502000
*        DO YOU WISH TO CONTINUE? RESPOND YES NO OR REREAD:             00503000
*                       VOLSE1 = THE VSN FROM THE                       00504000
*                       INPUT OR OUTPUT CARD.                           00505000
*                       VOLSE2 = THE VSN FROM THE                       00506000
*                       VOL1 LABEL ON THE DASD UNIT                     00507000
*                                                                       00508000
*        DMKDDR712E NUMBER OF EXTENTS EXCEEDES 20                       00509000
*                                                                       00510000
*        DMKDDR713E OVERLAPPING OR INVALID EXTENTS                      00511000
*                                                                       00512000
*        DMKDDR714E RECORD XXXXXXXXXXXX NOT FOUND ON TAPE               00513000
*                       XXXX = BB CC HH CYLINDER ADDRESS OF             00514000
*                       OF THE INPUT TAPE HEADER RECORD.                00515000
*                                                                       00516000
         EJECT                                                          00517000
*        DMKDDR715E LOCATION XXXXXXXXXXXX IS A FLAGGED TRACK            00518000
*                       XXXX = BB CC HH OF THE FLAGGED TRACK            00519000
*                                                                       00520000
*        DMKDDR716R NO VOL1 LABEL FOUND FOR XXXXXX                      00521000
*        DO YOU WISH TO CONTINUE? RESPOND YES NO OR REREAD:             00522000
*                       XXXXXX = THE VSN OF THE DASD DEVICE             00523000
*                       FROM THE INPUT OR THE OUTPUT CARD.              00524000
*                                                                       00525000
*        DMKDDR717R DATA DUMPED FROM VOL1 TO BE RESTORED TO VOL2        00526000
*        DO YOU WISH TO CONTINUE? RESPOND YES NO OR REREAD:             00527000
*                       VOL1 = THE VSN FROM THE INPUT TAPE              00528000
*                       HEADER RECORD. (VOLUME DUMPED)                  00529000
*                       VOL2 = THE VSN FROM THE OUTPUT                  00530000
*                       DASD DEVICE.                                    00531000
*                                                                       00532000
*        DMKDDR718E OUTPUT UNIT IS FILE PROTECTED                       00533000
*                                                                       00534000
*        DMKDDR719E INVALID FILENAME OR FILE NOT FOUND                  00535000
*                                                                       00536000
*        DMKDDR720E ERROR IN XXXXXXXX                                   00537000
*                       XXXXXXXX = THE NAME OF THE CMS                  00538000
*                       ROUTINE IN ERROR                                00539000
*                                                                       00540000
*        DMKDDR721E RECORD XXXXXXXXXX NOT FOUND                         00541000
*                       XXXXXXXXXX = THE CC HH R OF THE                 00542000
*                       RECORD NOT FOUND BY THE PRINT OR                00543000
*                       TYPE ROUTINE.                                   00544000
*                                                                       00545000
*                                                                 (NUC) 00546000
*        DMKDDR722E OUTPUT UNIT NOT PROPERLY FORMATED FOR THE     (NUC) 00547000
*        CP NUCLEUS                                               (NUC) 00548000
*                                                                 (NUC) 00549000
*        DMKDDR723E NO VALID CP NUCLEUS ON THE INPUT UNIT         (NUC) 00550000
*                                                                 (NUC) 00551000
*        DMKDDR724E INPUT TAPE CONTAINS A CP NUCLEUS DUMP         (NUC) 00552000
*                                                                       00553000
*        DMKDDR756E PROGRAM CHECK PSW = XXXXXXXXXXXXXXXX                00554000
*                       XXXX = THE PROGRAM CHECK OLD PSW                00555000
*        DMKDDR725R DASD INPUT DEVICE WAS(IS) LARGER THAN OUTPUT DEVICE 00556000
*        DO YOU WISH TO CONTINUE? RESPOND YES OR NO:                    00557000
*                                                                       00558000
*        DMKDDR726E MOVING DATA INTO THE ALTERNATE TRACK CYLINDER(S)    00559000
*                   IS PROHIBITED.                                      00560000
*                                                                       00561000
*        DMKDDR727E FLAGGED TRK XXXXXXXXXXXX HAS NO PROPER ALTERNATE;   00562000
*                   SKIPPING THIS TRACK.                                00563000
         EJECT                                                          00564000
*        VM/370 DASD DUMP/RESTORE PROGRAM RELEASE 6                     00565000
*        ENTER CARD READER ADDRESS OR CONTOL STATEMENTS                 00566000
*                                                                       00567000
*        ENTER CYLINDER EXTENTS                                         00568000
*        ENTER:                                                         00569000
*                                                                       00570000
*        ENTER NEXT EXTENT OR NULL LINE                                 00571000
*        ENTER:                                                         00572000
*                                                                       00573000
*        END OF CYL XXX HD XX, MOUNT NEXT TAPE                          00574000
*                                                                       00575000
*        RESTORING XXXXXX                                               00576000
*                       XXXXXX = THE VOLUME SERIAL NUMBER               00577000
*                       OF THE DISK DUMPED.                             00578000
*                                                                       00579000
*        COPYING   XXXXXX                                               00580000
*                       XXXXXX = THE VOLUME SERIAL NUMBER               00581000
*                       DESCRIBED BY THE INPUT UNIT.                    00582000
*                                                                       00583000
*        DUMPING   XXXXXX                                               00584000
*                       XXXXXX = THE VOLUME SERIAL NUMBER               00585000
*                       OF THE DISK BEING DUMPED.                       00586000
*                                                                       00587000
*        PRINTING  XXXXXX                                               00588000
*                       XXXXXX = THE VOLUME SERIAL NUMBER               00589000
*                       DESCRIBED BY THE INPUT UNIT.                    00590000
*                                                                       00591000
*                                                                       00592000
*        END OF DUMP                                                    00593000
*                                                                       00594000
*        END OF RESTORE                                                 00595000
*                                                                       00596000
*        END OF COPY                                                    00597000
*                                                                       00598000
*        END OF PRINT                                                   00599000
*                                                                       00600000
*        END OF JOB                                                     00601000
*                                                                       00602000
*        ENTER:                                                         00603000
*                                                                       00604000
*.                                                                      00605000
         SPACE 3                                                        00606000
         MACRO                                                          00607000
&SYMBOL  TABLE &NAME,&MIN,&CLASS,&TYPE,&RECMAX,&CYLMAXP,               X00608000
               &CYLMAXA,&TKMAX,&LAST                                    00609000
         LCLC  &C,&SC                                                   00610000
         AIF   (K'&NAME LT 5).SHORT                                     00611000
         AIF   ('&NAME'(5,1) NE '-').SHORT                              00612000
&C       SETC  '&NAME'(1,4).'M'.'&NAME'(6,2)                            00613000
         AGO   .SC                                                      00614000
.SHORT   ANOP                                                           00615000
&C       SETC  '&NAME'(1,7)                                             00616000
.SC      ANOP                                                           00617000
&SC      SETC  '&NAME'(1,4)                                             00618000
         AIF   (T'&TKMAX EQ 'O').POINT                                  00619000
         AIF   ('&LAST' EQ 'LAST').LASTCON                              00620000
&SYMBOL  DC    XL.4'4',AL.4(&MIN-1)  FLAG = CONSTENT+LENGTH             00621000
         AGO   .CON                                                     00622000
.LASTCON ANOP                                                           00623000
&SYMBOL  DC    XL.4'C',AL.4(&MIN-1)  FLAG = LAST CONSTANT+LENGTH        00624000
.CON     DC    X'00'                                                    00625000
         DC    AL1(&CLASS)    DEVICE CLASS                     @V2A2063 00626000
         DC    AL1(&TYPE)     DEVICE TYPE                      @V2A2063 00627000
         DC    H'&RECMAX'     MAX NUMBER OF RECORDS OR SKIP COUNT       00628000
         DC    H'&CYLMAXP'    MAX PRIM CYL OR MODE COMMAND CODE@V56BDA8 00629000
         DC    H'&CYLMAXA'    MAX ALT CYL ADDRESS (IF DASD).   @V56BDA8 00630000
         DC    H'&TKMAX'      MAX TRACK OR DISPOSITION COMMAND CODE     00631000
         AGO   .NAME                                                    00632000
.POINT   AIF   ('&CLASS' EQ 'LAST').LASTPT                              00633000
&SYMBOL  DC    AL1(&MIN-1)      FLAG = POINTER TO ROUTINE+LENGTH        00634000
         AGO   .PT                                                      00635000
.LASTPT  ANOP                                                           00636000
&SYMBOL  DC    XL.4'8',AL.4(&MIN-1)  FLAG = LAST POINTER+LENGTH         00637000
.PT      DC    AL3(SCAN&SC)   ADDRESS OF THE ROUTINE                    00638000
         DC    8X'00'                                          @V56BDA8 00639000
.NAME    ANOP                                                           00640000
C&C      DC    CL8'&NAME'     NAME                                      00641000
         SPACE                                                          00642000
         MEND                                                           00643000
         SPACE                                                          00644000
         MACRO                                                          00645000
&SYMBOL  COMP  &NAME                                                    00646000
&SYMBOL  LA    R3,&NAME                                                 00647000
         BAL   R14,COMPARE .  GO COMPARE THE KEYWORD RETURN WITH CC SET 00648000
         MEND                                                           00649000
         SPACE                                                          00650000
         MACRO                                                          00651000
&SYMBOL  MOVE  &NAME                                                    00652000
&SYMBOL  BCT   R2,*+10                                                  00653000
         MVC   &NAME(1)(1),0(R1)                                        00654000
         EX    R2,*-6                                                   00655000
         MEND                                                           00656000
         SPACE                                                          00657000
         MACRO                                                          00658000
&SYMBOL  MSG   &MESSAGE,&RETURN                                         00659000
         AIF   ( T'&RETURN EQ 'O').YES                                  00660000
&SYMBOL  LA    R14,&RETURN                                              00661000
         BAL   R2,MSGWRITE                                              00662000
         AGO   .CONT                                                    00663000
.YES     ANOP                                                           00664000
&SYMBOL  BAL   R2,MSGWRITE                                              00665000
.CONT    DC    AL2(L&SYSNDX)                                            00666000
M&SYSNDX DC    C&MESSAGE                                                00667000
L&SYSNDX EQU   *-M&SYSNDX                                               00668000
         SPACE                                                          00669000
         MEND                                                           00670000
         EJECT                                                          00671000
*        THIS DSECT MUST APPEAR AT THE FRONT OF THE LISTING BECAUSE     00672000
*        THE IOBSIZE LABEL EQUATED IN THE DSECT MUST BE A PREVIOUSLY    00673000
*        DEFINED SYMBOL FOR THE ASSEMBLER TO ACCEPT THE WAY IT IS       00674000
*        USED LATER IN THE CSECT.                                       00675000
IOB      DSECT                                                 @V56BDA8 00676000
IOBSTAT  DS    X'80'          STATUS OF IOB                    @V56BDA8 00677000
IOBOPT   DS    1X             IOB FLAGS                        @V56BDA8 00678000
IOBUADD  DS    1H             UNIT ADDRESS OF DEVICE           @V56BDA8 00679000
IOBCCW   DS    1F             POINTER TO CCW                   @V56BDA8 00680000
IOBERROR DS    A              ADDRESS OF IO ERROR ROUTINE      @V56BDA8 00681000
IOBCSW   DS    2F             CSW OF IO ERROR STACKED          @V56BDA8 00682000
IOBCLASS DS    X              DEVICE CLASS                     @V56BDA8 00683000
IOBTYPE  DS    X              DEVICE TYPE                      @V56BDA8 00684000
IOBSKIP  EQU   *              IOB TAPE SKIP COUNT              @V56BDA8 00685000
IOBMREC  DS    H'0'           MAX NUM OR RECORDS THAT WILL     @V56BDA8 00686000
*                             FIT A TRACK                               00687000
IOBCYLP  DC    H'0'           MAX PRIMARY CYL ADDR OF DASD.    @V56BDA8 00688000
IOBCYLA  DC    H'0'           MAX ALTERNATE CYL ADDR OF DASD.  @V56BDA8 00689000
IOBMTCK  DC    H'0'           MAX NO. OF TRKS (NUMBERING 0-N). @V56BDA8 00690000
IOBMODE  DS    X              TAPE MODE COMMAND CODE.          @V56BDA8 00691000
IOBDISP  DS    X              TAPE DISPOSITION COMMAND CODE.   @V56BDA8 00692000
IOBVSER  DS    CL6' '         VOL SER NO OF DASD UNIT          @V56BDA8 00693000
IOBATAPE DS    X'0000'        ADDRESS OF AN ALTERNATE TAPE UNIT@V56BDA8 00694000
IOBFLAG  DS    X              IOB FLAGS                        @V56BDA8 00695000
         DS    3X             RESERVED                         @V56BDA8 00696000
IOBSIZE  EQU   *-IOB                                           @V56BDA8 00697000
         SPACE 2                                                        00698000
*        BITS USED IN IOBOPT                                            00699000
IOBDEW   EQU   X'80'          WAIT FOR DEVICE END INTERRUPT    @V56BDA8 00700000
IOBERST  EQU   X'40'          STOP ON IOERROR AND WAIT FOR     @V56BDA8 00701000
*                             NEXT INT                                  00702000
IOBEEXIT EQU   X'20'          REPEAT CCW ON ERROR              @V56BDA8 00703000
IOBSIO   EQU   X'10'          DO NOT USE DIAGNOSE I/O          @V56BDA8 00704000
         SPACE                                                          00705000
*        BITS USED IN IOBSTAT                                           00706000
IOBST    EQU   X'80'          IO UNIT IS TO BE STARTED         @V56BDA8 00707000
IOBSTACK EQU   X'40'          IOERROR HAS BEEN STACKED         @V56BDA8 00708000
IOBLAST  EQU   X'20'          LAST IOB                         @V56BDA8 00709000
IOBNOPER EQU   X'10'          DEVICE IS NOT OPERATIONAL        @V56BDA8 00710000
IOBCPVOL EQU   X'08'          UNIT IS A CPVOL                  @V56BDA8 00711000
IOBOPEN  EQU   X'04'          THE IOB IS OPEN                  @V56BDA8 00712000
IOBSCRAT EQU   X'02'          THE DASD DEVICE IS A SCRATCH     @V56BDA8 00713000
*                             VOLUME                                    00714000
IOBTPSWP EQU   X'01'          SWITCH TO ALT. TAPE IN PROGRESS  @V56BDA8 00715000
         SPACE 3                                                        00716000
DMKDDR   START 0                                                        00717000
         USING *,R0                                                     00718000
         USING CYLENTRY,R7                                              00719000
         USING IOB,R15                                                  00720000
         USING NAMETABL,R4                                              00721000
         USING DMKDDREP+2,R10                                           00722000
         USING DMKDDREP+4096,R11                                        00723000
         USING DMKDDREP+8190,R12                                        00724000
         USING DMKDDREP+12284,R13                                       00725000
         USING DMKDDREP+16378,R9                               @V200731 00726000
IPLUSE   DS    3D                                                       00727000
EXTOLD   DC    D'0'                                                     00728000
SUPOLD   DC    D'0'                                                     00729000
PROOLD   DC    D'0'                                                     00730000
MCOLD    DC    D'0'                                                     00731000
IOOLD    DC    D'0'                                                     00732000
CSW      DS    1D                                                       00733000
CAW      DS    1F                                                       00734000
         DC    F'0'                                                     00735000
TIMER    DC    X'7FFFFFFF'                                              00736000
         DC    F'0'                                                     00737000
EXTNEW   DC    X'0104000000'                                            00738000
         DC    AL3(EXTINT)                                              00739000
SVCNEW   DC    X'0106000000000000'                                      00740000
PRONEW   DC    X'0104000000'                                            00741000
         DC    AL3(DDR756)                                     @V305435 00742000
MCNEW    DC    X'0000000000'                                            00743000
         DC    AL3(DDR707)                                              00744000
IONEW    DC    X'0104000000'                                            00745000
         DC    AL3(IOINT)                                               00746000
         EJECT                                                          00747000
******************************************************************      00748000
*.                                                                      00749000
*  1.    DMKDDR HOUSEKEEPING ROUTINE                                    00750000
*                                                                       00751000
*              1. IF UNDER CMS GO TO STEP 7, ELSE PRINT MSG002.         00752000
*                                                                       00753000
*              2. IF NULL LINE DEFAULT TO IPL UNIT ADDRESS AND GO       00754000
*                 TO STEP 4.                                            00755000
*                                                                       00756000
*              3. LINK TO SCANNAME, RETURN ONLY IF NAME NOT FOUND.      00757000
*                                                                       00758000
*              4. SET UP CARD IOB AND TURN ON CARD IN FLAG.             00759000
*                                                                       00760000
*              5. LINK TO ROUTINE 25 TO  GET THE NEXT STATEMENT.        00761000
*                                                                       00762000
*              6. IF A NULL LINE GO TO STEP 11, ELSE GO TO ROUTINE 2.   00763000
*                                                                       00764000
*              7. ERROR DDR701 IF RETURN FROM SCANNAME.                 00765000
*                                                                       00766000
*              8. BUILD STATE P-LIST FROM THE COMMAND LINE P-LIST.      00767000
*                 IF NO P-LIST GO TO STEP 5.                            00768000
*                                                                       00769000
*              9. STATE THE FILE, IF NOT FOUND GO TO ERROR              00770000
*                 DDR709.                                               00771000
*                                                                       00772000
*              10. TURN ON THE CARDIN FLAG, SET UP P-LIST FOR READBUF   00773000
*                  AND GO TO STEP 5.                                    00774000
*                                                                       00775000
*              11. IF INPUT IS FROM THE CONCOLE GO TO ROUTINE 28.       00776000
*                                                                       00777000
*              12. IF THE CARD END OF FILE FLAG IS ON GO TO             00778000
*                  ROUTINE 28, ELSE GO TO STEP 5.                       00779000
*.                                                                      00780000
******************************************************************      00781000
         ENTRY DMKDDREP                                                 00782000
DMKDDREP BALR  R10,0          SET UP BASE 1                             00783000
         LA    R10,0(,R10)    CLEAR HIGH ORDER BYTE FOR BARE MAC COMP   00784000
         LA    R11,4094(,R10) SET UP BASE 2                             00785000
         LA    R12,4094(,R11) SET UP BASE 3                             00786000
         LA    R13,4094(,R12) SET UP BASE 4                             00787000
         LA    R9,4094(,R13)  SET UP BASE 5                    @V200731 00788000
         STIDP CPUID          STORE THE CPU ID                          00789000
         ST    R10,MACHINE    SAVE FOR BAREMAC COMPARE         HRC012DK 00789500
         CL    R10,BAREMAC    IS THIS A BARE MACHINE                    00790000
         BNE   CMS1           NO- GO TO CMS ROUTINE                     00791000
         SSM   =X'01'         ENABLED TO ACCEPT EXT INTERRUPT           00792000
         B     NEWADD                                                   00793000
EXTINT   DS    0H                                                       00794000
         MVI   TIMER,X'7F'    SET HI TIMER FOR ANY EXT INTERRUPT        00795000
         TM    EXTOLD+3,X'40' WAS EXT INT KEY PUSHED                    00796000
         BO    NEWADD         BRANCH IF SO                              00797000
         LPSW  EXTOLD         IGNORE   EXT INT IF NOT                   00798000
NEWADD   LA    R15,CONIOB     POINT TO IOB                     @VA10621 00799100
         NI    IOBSTAT,X'FF'-IOBNOPER ASSUME OPERATIONAL CONS  HRC012DK 00801100
         BAL   R14,MSG002     PRINT MSG                                 00804000
         BAL   R14,MSG002A    PRINT MSG                        HRC012DK 00804200
MSGRET   NI    SENSECCW+4,255-CC RESET CHAINING FLAG           @VA13103 00804500
         LA    R3,CONERROR    POINT TO ERROR ROUTINE           @VA13103 00805000
         ST    R3,IOBERROR    *                                         00806000
         LA    R15,PRINTIOB   WE WILL DO AN INITIALIZE PRINTER @VA10621 00806200
         LA    R1,INITCCW     IN CASE THE PRINTER IS A 3800    @VA10621 00806400
         ST    R1,IOBCCW      SAVE THE CCW STRING              @VA10621 00806600
         BAL   R14,STARTIO    GO DO IT                         @VA10621 00806800
         BAL   R14,READCONT   GET INPUT FROM USER                       00807000
         BAL   R14,SCANCONT   GET CARD READER ADD OR CONT STATEMENT     00808000
         BC    4,DEFAULT      DEFAULT TO IPL INPUT ADD                  00809000
         BAL   R14,SCANNAME   GO LOOK FOR THE NAME IF NOT FOUND         00810000
FIRSTIME BAL   R14,HEXCONV    THEN GO CONVERT THE UNIT ADD              00811000
STOREADD OI    DDRFLAG,CARDIN      TURN ON CARD INPUT FLAG              00812000
         STH   R2,CARDIOB+(IOBUADD-IOB) SAVE ADD                        00813000
STARTNEW NI    DDRFLAG,255-RESTALL TURN OFF THE RESTALL FLAG            00814000
         MVI   DDRFLAG2,0     RESET DDRFLAG2                            00815000
         NI    DDRFLAG,255-NUCLEUS NUCLEUS FLAG ALSO              (NUC) 00816000
         XC    TAPEERCT(4),TAPEERCT     ZERO THE DASD AND TAPE ER COUNT 00817000
         LA    R1,INOUTER               *    POINT THE INPUT AND OUTPUT 00818000
         ST    R1,INIOB+(IOBERROR-IOB)  *    IOB'S TO THE ERROR ROUTINE 00819000
         ST    R1,OUTIOB+(IOBERROR-IOB) *                               00820000
         TM    DDRFLAG,CARDIN CARD INPUT??                     @VA04550 00821000
         BZ    GTCARD         NOPE                             @VA04550 00822000
         TM    DDRFLAG,VLDRDR HAVE A VALID RDR ADDR YET?       @VA04550 00823000
         BO    GTCARD         YES - CONTINUE NORMALLY          @VA04550 00824000
         BAL   R14,READCONT   NO - TRY A READ                  @VA04550 00825000
         OI    DDRFLAG,VLDRDR ADDR'S OK IF WE GET HERE         @VA04550 00826000
         B     GTSCAN         JOIN REGULAR LOGIC               @VA04550 00827000
GTCARD   BAL   R14,READCONT   GO GET THE FIRST CARD                     00828000
GTSCAN   EQU   *                                               @VA04550 00829000
         BAL   R14,SCANCONT   GO GET THE FIRST FIELD                    00830000
         BC    4,TESTEND      ERROR IF NO INPUT                         00831000
         BAL   R14,SCANNAME   GO TO ROUTINE                             00832000
         B     DDR701         ERROR IF RETURNING FROM SCANNAME          00833000
CMS1     ST    R14,CMSSAVE    SAVE THE RETURN ADD                       00834000
         LR    R8,R1               SAVE THE PARAMETER LIST     @V60B9BA 00835000
         LA    R15,PRINTIOB   WE WILL DO AN INITIALIZE PRINTER @V60B9BA 00836000
         LA    R1,INITCCW     IN CASE THE PRINTER IS A 3800    @V60B9BA 00837000
         ST    R1,IOBCCW           SAVE THE CCW STRING         @V60B9BA 00838000
         BAL   R14,STARTIO    GO DO IT                         @V60B9BA 00839000
         LR    R1,R8               RESTORE PARAMETER LIST      @V60B9BA 00840000
         CLI   8(R1),X'FF'    DID I GET A PARAMETER LIST       @VM08604 00841000
         BNE   GTFILE                                          HRC012DK 00842190
         BAL   R14,MSG002                                      HRC012DK 00842380
         B     GTCARD         NO- BRANCH AND GET THE FIRST STATHRC012DK 00842570
GTFILE   EQU   *                                               HRC012DK 00842760
         MVC   INFCB+8(16),8(R1)   SET UP FILE NAME AND TYPE            00843000
         CLI   16(R1),X'FF'    DID I GET A FILE TYPE                    00844000
         BE    DDR719         NO- ERROR                                 00845000
         OI    DDRFLAG,CARDIN TURN ON THE CARD IN SWITCH                00846000
         CLI   24(R1),X'FF'   DO I HAVE A MODE                          00847000
         BE    *+10           NO- BRANCH                                00848000
         MVC   INFCB+24(2),24(R1)  YES- MOVE IT IN                      00849000
         LA    R1,INFCB       POINT TO THE INPUT FCB                    00850000
         SVC   202            STATE THE FILE                            00851000
         DC    AL4(DDR719)      ERROR RETURN                            00852000
         MVC   INFCB(8),=CL8'RDBUF'     SET UP FOR FIRST READ           00853000
         LA    R1,CONTBUFF    POINT TO THE INPUT BUFFER                 00854000
         ST    R1,INFCBUF     AND SAVE IT IN THE FCB                    00855000
         B     GTCARD         GO READ THE CMS FILE OR CONSOLE           00856000
DEFAULT  LH    R2,IPLUSE+2    USE IPL UNIT ADD                          00857000
         B     STOREADD                                                 00858000
SETUPERR TM    IOBSTAT,IOBNOPER    WAS THE UNIT NOT OPER                00859000
         BO    CONPARM        YES, GO TEST FOR CORRECT DEVICE  @V200731 00860000
         TM    IOBCSW+4,UC    IS UNIT CHECK INDICATED ?        @V200731 00861000
         BZ    CONERROR       NO, GO TO ERROR HANDLER          @V200731 00862000
CONPARM  EQU   *                                               @V200731 00863000
         TM    PARM,PARM321   IS THIS A 3215/3210/1052         @V200731 00864000
         BO    DDRLPSW        YES, GO WAIT FOR I/O INTERRUPT   @V200731 00865000
         TM    PARM,PARM01F   IS THIS ADDRESS 01F ?            @V200731 00866000
         BO    TESTGRAP       YES, GO CHECK FOR GRAPHIC        @V200731 00867000
*                             DEVICE ?                                  00868000
         OI    PARM,PARM01F   SET INDICATOR FOR 01F            @V200731 00869000
         MVI   CONIOB+((IOBUADD+1)-IOB),X'1F' SET DEVICE ADDR  @V200731 00870000
*                             TO 1F                                     00871000
         B     NEWADD         GO TRY THIS ADDRESS - 01F        @V200731 00872000
TESTGRAP EQU   *                                               @V200731 00873000
         TM    PARM,PARMGRP   IS THIS A GRAPHIC DEVICE ?       @V200731 00874000
         BO    TES3270T       YES, GO TEST FOR 3270 DEVICE     @V200731 00875000
         OI    PARM,PARMGRP+PARMCLE SET GRAPHIC & ERASE        @V200731 00876000
*                             INDICATORS                                00877000
DDRLPSW  EQU   *                                               @V200731 00878000
         LPSW  CONWAIT        WAIT FOR I/O INTERRUPT           @V200731 00879000
TES3270T EQU   *                                               @V200731 00880000
         TM    PARM,PARMGRP+PARM327 IS THIS A 3270 DEVICE ?    @V200731 00881000
         BO    TEST3278       YES, GO TEST FOR 20 LINE DEVICE  @V60A6B6 00882000
         OI    PARM,PARM327                                    @V60A6B6 00883000
**********************************************************************  00884000
*SINCE THIS IS A 3277.       THE MAXIMUM ALLOW SCREEN SIZE IS 24 LINE*  00885000
*WE MUST THEREFORE CHANGE THE DATA STREAM TO HANDLE THIS SCREEN SIZE *  00886000
**********************************************************************  00887000
         MVC   LAB3270A+2(2),ADDR1                             @V60A6B6 00888000
         MVC   LAB3270A+8(2),ADDR2                             @V60A6B6 00889000
         MVC   LAB3270B+2(2),ADDR1                             @V60A6B6 00890000
         MVC   LAB3270B+8(2),ADDR2                             @V60A6B6 00891000
         MVC   LAB3270C+2(2),ADDR2                             @V60A6B6 00892000
         MVC   LAB3270D+2(2),ADDR1                             @V60A6B6 00893000
         MVC   LAB3270E+5(2),ADDR1                             @V60A6B6 00894000
         MVC   LAB3270E+12(2),ADDR2                            @V60A6B6 00895000
         MVC   ADDR5,ADDR6        EST. ADDR FOR CURSOR CK      @V60A6B6 00896000
         MVC   MAXLEN,LEN3270                                  @V60A6B6 00897000
         B     NEWADD             GO TRY THIS ADDR FOR         @V60A6B6 00898000
*                                 GRAPHIC SUPPORT                       00899000
TEST3278 EQU   *                                               @V60A6B6 00900000
         CLC   LAB3270A+2(2),ADDR3   HAVE WE TRIED IT AS 3278  @V60A6B6 00901000
         BE    TEST3215           MUST BE 3210,3215,1052       @V60A6B6 00902000
**********************************************************************  00903000
*SINCE THIS IS A 3278 MOD2A. THE MAXIMUM ALLOW SCREEN SIZE IS 20 LINE*  00904000
*WE MUST THEREFORE CHANGE THE DATA STREAM TO HANDLE THIS SCREEN SIZE *  00905000
**********************************************************************  00906000
         MVC   LAB3270A+2(2),ADDR3                             @V60A6B6 00907000
         MVC   LAB3270A+8(2),ADDR4                             @V60A6B6 00908000
         MVC   LAB3270B+2(2),ADDR3                             @V60A6B6 00909000
         MVC   LAB3270B+8(2),ADDR4                             @V60A6B6 00910000
         MVC   LAB3270C+2(2),ADDR4                             @V60A6B6 00911000
         MVC   LAB3270D+2(2),ADDR3                             @V60A6B6 00912000
         MVC   LAB3270E+5(2),ADDR3                             @V60A6B6 00913000
         MVC   LAB3270E+12(2),ADDR4                            @V60A6B6 00914000
         MVC   ADDR5,ADDR7    EST. CORRECT ADDR FOR CURSOR CK  @V60A6B6 00915000
         MVC   MAXLEN,LEN3278                                  @V60A6B6 00916000
         B     NEWADD         GO TRY THIS ADDRESS WITH         @V200731 00917000
*                             GRAPHIC SUPPORT                           00918000
TEST3215 EQU   *                                               @V200731 00919000
         MVI   PARM,PARM321   SET THE 3210-3215-1052 FLAG      @V200731 00920000
         B     NEWADD         GO TRY THIS ADDRESS WITH 3215    @V200731 00921000
*                             SUPPORT                                   00922000
CONRET   EQU   *                                               @V200731 00923000
         MVC   IOBUADD,IOOLD+2 GET DEVICE ADDRESS FROM PSW     @V200731 00924000
         B     NEWADD         GO AND TRY THIS ADDRESS          @V200731 00925000
TESTEND  TM    DDRFLAG,CARDIN IS THIS CARD INPUT                        00926000
         BZ    EXIT           NO- TERMINATE                             00927000
         TM    DDRFLAG,CARDEOF     IS IT EOF                            00928000
         BO    EXIT           YES- TERMINATE                            00929000
         B     GTCARD         SKIP THE BLANK CARD                       00930000
         EJECT                                                          00931000
***************************************************************         00932000
*.                                                                      00933000
*  2.    SUBROUTINE TO SCAN NAME AND UNIT TABLE                         00934000
*                                                                       00935000
*              1. SCAN THE TABLE LOOKING FOR NAME.                      00936000
*                                                                       00937000
*              2. IF NOT FOUND GO TO ERROR DDR701.                      00938000
*                                                                       00939000
*              3. IF ADDRESS, GO TO THE ROUTINE, ELSE RETURN.           00940000
*.                                                                      00941000
***************************************************************         00942000
SCANUNIT STM   R3,R5,REGSAVE1 SAVE REG                                  00943000
         LA    R4,TABLE2      POINT TO THE UNIT TABLE                   00944000
         B     SCAN                                                     00945000
SCANNAME STM   R3,R5,REGSAVE1 SAVE REG                                  00946000
         LA    R4,TABLE1      POINT TO NAME TABLE                       00947000
SCAN     BCTR  R2,0           -1                                        00948000
RESCAN   L     R3,NAMEFLAG    GET THE FLAG AND POINTER TO THE ROUTINE   00949000
         EX    R2,COMPNAME    COMPARE THE NAME TO THE CON               00950000
         BE    GOODNAME       GET OUT IF EQ                             00951000
ADDSIZE  LA    R4,NAMESIZE(,R4)    POINT TO NEXT NAME TABLE ENTRY       00952000
         LTR   R3,R3          IS THIS THE LAST NAME                     00953000
         BNM   RESCAN         LOOP                                      00954000
         LA    R2,1(,R2)      +1                                        00955000
         CLM   R14,7,=AL3(FIRSTIME)    FIRST TIME (SCAN FROM MSG002)    00956000
         BCR   8,R14          YES- RETURN TO CALLER                     00957000
         B     DDR701         ERROR IF NOT FOUND                        00958000
GOODNAME SLL   R3,4           DROP THE FLAGS                            00959000
         SRL   R3,28          SET UP THE COUNT                          00960000
         CR    R2,R3          COMPARE THE MIN COUNT                     00961000
         BL    ADDSIZE        IF COUNT IS LOW CONT SCAN                 00962000
         TM    NAMEFLAG,X'40' IS THIS AN ADD.                           00963000
         BO    RETURNCD       NO RETURN DEVICE CODE                     00964000
         ST    R14,SAVERET    SAVE RETURN REGISTER                      00965000
         L     R14,NAMEFLAG   GET THE FLAG AND ROUTINE ADD              00966000
         LA    R4,1(,R2)      RESTORE REG 2                             00967000
RETURNCD LR    R2,R4          POINT TO THE TABLE OR RESTORE THE REG     00968000
         LM    R3,R5,REGSAVE1 RETURN REG                                00969000
         BR    R14            RETURN TO CALLER OR LINK TO SUBROUTINE    00970000
COMPNAME CLC   NAME-NAMETABL(0,R4),0(R1)     COMP NAME TO INPUT         00971000
         SPACE 2                                                        00972000
         DROP  R4                                                       00973000
         USING NAMETABL,R2                                              00974000
         SPACE 2                                                        00975000
*****    NAME TABLE                                                     00976000
         SPACE                                                          00977000
         DS    0F                                                       00978000
TABLE1   TABLE INPUT,2                                                  00979000
         TABLE OUTPUT,3                                                 00980000
         TABLE SYSPRINT,2                                               00981000
         TABLE PRINT,2                                                  00982000
         TABLE TYPE,2                                                   00983000
         TABLE DUMP,2                                                   00984000
         TABLE RESTORE,2                                                00985000
         TABLE COPY,2,LAST                                              00986000
         SPACE 3                                                        00987000
*        THE DASD TABLE ENTRIES HAVE THE FOLLOWING EFFECTS IN REGARD    00988000
*        TO THE TREATMENT OF ALTERNATE TRACK CYLINDERS:  IN GENERAL,    00989000
*        &CYLMAXP SHOULD SPECIFY THE NUMBER (NUMBERING 0-N) OF THE      00990000
*        LAST (NTH) PRIMARY DATA CYLINDER WHILE &CYLMAXA SHOULD         00991000
*        SPECIFY THE NUMBER OF THE LAST ALTERNATE CYLINDER.  &CYLMAXA   00992000
*        DETERMINES THE LAST CYLINDER THAT CAN BE DUMPED TO TAPE OR     00993000
*        ACCESSED VIA TYPE/PRINT.  &CYLMAXP DETERMINES THE LAST         00994000
*        CYLINDER THAT CAN BE RESTORED TO OR COPIED TO.  IT ALSO        00995000
*        DETERMINES THE LAST CYLINDER MOVED WHEN 'DUMP ALL' OR          00996000
*        'COPY ALL' IS SPECIFIED.  YOU CAN FALSIFY THE &CYLMAXP AND     00997000
*        &CYLMAXA VALUES TO ACHIEVE THE RESULT YOU DESIRE.  FOR         00998000
*        EXAMPLE, SPECIFYING 202 FOR BOTH &CYLMAXP AND &CYLMAXA ON      00999000
*        THE 2314 MEANS USERS CAN RESTORE DATA INTO THE ALTERNATE       01000000
*        TRACK CYLINDERS.                                               01001000
         SPACE                                                          01002000
TABLE2   TABLE 2305-1,6,CLASDASD,TYP2305,34,47,47,7            @V56BDA8 01003000
         TABLE 2305-2,6,CLASDASD,TYP2305,75,95,95,7            @V56BDA8 01004000
         TABLE 2311,4,CLASDASD,TYP2311,62,202,202,9            @V56BDA8 01005000
         TABLE 2314,4,CLASDASD,TYP2314,75,202,202,19           @V56BDA8 01006000
         TABLE 2319,4,CLASDASD,TYP2319,75,202,202,19           @V56BDA8 01007000
         TABLE 3330,4,CLASDASD,TYP3330,100,403,410,18          @V56BDA8 01008000
         TABLE 3330-11,7,CLASDASD,TYP3330,100,807,814,18       @V56BDA8 01009000
         TABLE 3350,4,CLASDASD,TYP3350,110,554,559,29          @V56BDA8 01010000
         TABLE 3380,4,CLASDASD,TYP3380,100,884,885,14          HRC012DK 01010500
         TABLE 3340-35,7,CLASDASD,TYP3340,55,347,348,11        @V56BDA8 01011000
         TABLE 3340-70,7,CLASDASD,TYP3340,55,695,697,11        @V56BDA8 01012000
         TABLE 2400,4,CLASTAPE,TYP2401,0,3,0,15                @V56BDA8 01013000
         TABLE 2401,4,CLASTAPE,TYP2401,0,3,0,15                @V56BDA8 01014000
         TABLE 2415,4,CLASTAPE,TYP2415,0,3,0,15                @V56BDA8 01015000
         TABLE 2420,4,CLASTAPE,TYP2420,0,3,0,15                @V56BDA8 01016000
         TABLE 3410,4,CLASTAPE,TYP3410,0,3,0,15                @V56BDA8 01017000
         TABLE 3411,4,CLASTAPE,TYP3411,0,3,0,15                @V56BDA8 01018000
         TABLE 3420,4,CLASTAPE,TYP3420,0,3,0,15,LAST           @V56BDA8 01019000
         EJECT                                                          01020000
*****************************************************************       01021000
*.                                                                      01022000
*  3.    ROUTINE TO SCAN INPUT AND OUTPUT STATEMENTS                    01023000
*                                                                       01024000
*              1. POINT TO INPUT IOB.                                   01025000
*                                                                       01026000
*              2. FILL IN THE DEVICE ADDRESS AND TYPE, IF LEFT          01027000
*                 PARENTHESIS GO TO STEP 5.                             01028000
*                                                                       01029000
*              3. IF TAPE GO TO STEP 4 ELSE GET  THE VOL SER NO         01030000
*                 AND GO TO ROUTINE 1 STEP 5.                           01031000
*                                                                       01032000
*              4. FILL IN THE ALTERNATE TAPE ADDRESS, DEFAULTIND        01033000
*                 TO FIRST DEVICE ADDRESS.                              01034000
*                                                                       01035000
*              5. FILL IN OPTIONS.                                      01036000
*                                                                       01037000
*              6. GO TO ROUTINE 1 STEP 5.                               01038000
*.                                                                      01039000
*****************************************************************       01040000
SCANINPU LA    R15,INIOB      POINT TO IOB                              01041000
         NI    DDRFLAG3,X'FF'-INERROR TURN OFF FLAG            @VA13582 01041010
         B     BUILDIOB                                                 01042000
SCANOUTP LA    R15,OUTIOB     POINT TO IOB                              01043000
         NI    DDRFLAG3,X'FF'-OUTERROR TURN OFF FLAG           @VA13582 01043010
BUILDIOB NI    IOBSTAT,255-(IOBSTACK+IOBNOPER+IOBCPVOL+IOBOPEN+IOBSCRAT*01044000
               )              RESET THE IOB STAT FIELD                  01045000
         BAL   R14,SCANCONT   GET UNIT ADD                              01046000
         BC    4,DDR703       ERROR IF NO INPUT                         01047000
         BC    2,GETPARM      BRANCH IF (                               01048000
         CL    R2,=F'3'       IS IT OVER 3                              01049000
         BH    DDR701         YES- ERROR                                01050000
         MVC   CCU(8),BLANKS  INITIALIZE FIELD FOR CMS RELEASE @VA04324 01051000
         BCTR  R2,0           SET UP LENGTH FOR NEXT           @VA04324 01052000
*                             INSTRUCTION                               01053000
         EX    R2,MOVECCU     MOVE IN CCU FOR POSSIBLE CMS     @VA04324 01054000
*                             RELEASE PROCESSING                        01055000
         LA    R2,1(,R2)      RESTORE LENGTH                   @VA04324 01056000
         BAL   R14,HEXCONV                                              01057000
         STH   R2,IOBUADD     SAVE UNIT ADD OF DEVICE                   01058000
         STH   R2,IOBATAPE    SET UP DEFAULT                            01059000
         BAL   R14,SCANCONT                                             01060000
         BC    4,DDR703       ERROR IF NO INPUT                         01061000
         BAL   R14,SCANUNIT   GET DEVICE DATA                           01062000
         MVC   IOBCLASS(L10),NAMECLAS MOVE IN DEV DATA.        @V56BDA8 01063000
         TM    IOBTYPE,TYP3380 IS IT 3380 DEVICE               HRC012DK 01063060
         BZ    CKTAPE                                          HRC012DK 01063120
         LA    R1,SNSE4CCW    GET ADDRESS OF SENSE ID X'E4'    HRC012DK 01063180
         ST    R1,IOBCCW      SAV ADDRESS OF SENSE ID X'E4'    HRC012DK 01063240
         XC    SENSE,SENSE    ZERO OUT SENSE                   HRC012DK 01063300
         BAL   R14,STARTIO    GO ISSUE SENSE                   HRC012DK 01063360
         TM    SENSEB6,RDEVMD82  IS THIS A MODEL 2 OR 3        HRC012DK 01063420
         BZ    CONTINUE                                        HRC012DK 01063480
         MVC   IOBCYLP(L4),PRIM3382 MOVE IN MAX & ALT CYL MDL2 HRC012DK 01063540
         TM    SENSEB6,RDEVMD83  IS THIS A MODEL 3             HRC012DK 01063600
         BZ    CONTINUE                                        HRC012DK 01063660
         MVC   IOBCYLP(L4),PRIM3383 MOVE IN MAX & ALT CYL MDL3 HRC012DK 01063720
         B     CONTINUE                                        HRC012DK 01063780
CKTAPE   EQU   *                                               HRC012DK 01063840
         TM    IOBCLASS,CLASTAPE TAPE TYPE DEVICE              @V56BDA8 01064000
         BZ    CONTINUE       DON'T BOTHER WITH MODE + DISP    HRC012DK 01065490
         MVC   IOBMODE(1),NAMECYLP+1 MOVE TAPE MODE            @V56BDA8 01066000
         MVC   IOBDISP(1),NAMEMTCK+1 MOVE TAPE DISP CODE       @V56BDA8 01067000
CONTINUE CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE        @V56BDA8 01068000
         BNE   BLNKVSER       NO                               @V2A2063 01069000
         LH    R5,IOBUADD     YES - GET VIRT. DEV ADDR         @V2A2063 01070000
         DC    X'83560024'    SEE WHAT VM THINKS IT IS         @V2A2063 01071000
         STCM  R6,B'0010',SVDSTAT SAVE VDEVSTAT                HRC012DK 01071500
         CLM   R6,12,IOBCLASS DO USER AND VM AGREE?            @V2A2063 01072000
         BNE   PREDR708     BRANCH IF TYPES INCOMPATIBLE       @VA13582 01073000
         TM    IOBCLASS,CLASDASD DISK DEVICE                   HRC012DK 01073010
         BNO   CONTINUT                                        HRC012DK 01073020
         TM    SVDSTAT,VDVDED                                  HRC012DK 01073030
         BO    CONTINUT                                        HRC012DK 01073040
         STM   R3,R8,MDSKREGS                                  HRC012DK 01073050
         MVC   DEVCUU,CCU                                      HRC012DK 01073060
         CLI   DEVCUU,C'0'                                     HRC012DK 01073070
         BNE   ISSQUERY                                        HRC012DK 01073080
         MVI   DEVCUU,C' '                                     HRC012DK 01073090
ISSQUERY EQU   *                                               HRC012DK 01073100
         LA    R3,QRYDEV                                       HRC012DK 01073110
         LA    R4,QRYRESP                                      HRC012DK 01073120
         LA    R5,L'QRYDEV+L'DEVCUU                            HRC012DK 01073130
         ICM   R5,B'1000',BUFFRET                              HRC012DK 01073140
         LA    R6,L'QRYRESP                                    HRC012DK 01073150
*        DIAG  R3,R5,X'0008'                                   HRC012DK 01073160
         DC    X'83350008'                                     HRC012DK 01073170
         BNZ   CONTINUT                                        HRC012DK 01073180
*----------------------------------------------------------*   HRC012DK 01073190
*  FIND THE CYLINDER FIELD BY SKIPPING OVER THE APPROPRIATE    HRC012DK 01073200
*  NUMBER OF BLANKS.                                           HRC012DK 01073210
*----------------------------------------------------------*   HRC012DK 01073220
         LA    R7,CYLPOS-1                                     HRC012DK 01073230
         LA    R8,QRYRESP                                      HRC012DK 01073240
KPSRCH   DS    0H                                              HRC012DK 01073250
         CLI   0(R8),C' '                                      HRC012DK 01073260
         BE    NXTBLANK                                        HRC012DK 01073270
NEXTCHAR DS    0H                                              HRC012DK 01073280
         LA    R8,1(R8)                                        HRC012DK 01073290
         B     KPSRCH                                          HRC012DK 01073300
NXTBLANK DS    0H                                              HRC012DK 01073310
         LA    R8,1(R8)           IF THERE ARE MORE THAN 1     HRC012DK 01073320
         CLI   0(R8),C' '         BLANK IN BUFFER, THEN        HRC012DK 01073330
         BE    NXTBLANK           SKIP IT                      HRC012DK 01073340
         BCT   R7,NEXTCHAR                                     HRC012DK 01073350
*----------------------------------------------------------*   HRC012DK 01073360
*  FIND THE FIRST EBCDIC CODED DECIMAL NUMBER IN THE           HRC012DK 01073370
*  CYLINDER FIELD AND CONVERT IT TO A BINARY VALUE.            HRC012DK 01073380
*----------------------------------------------------------*   HRC012DK 01073390
         LR    R1,R8              SAVE CYLINDER FIELD POSITION HRC012DK 01073400
         LA    R7,CYLPRMSZ        MAXUMUM SIZE                 HRC012DK 01073410
         SR    R2,R2              ACTUAL SIZE IN R2            HRC012DK 01073420
NEXTNUM  DS    0H                                              HRC012DK 01073430
         TM    0(R8),X'F0'                                     HRC012DK 01073440
         BNO   MDSKBINC                                        HRC012DK 01073450
         LA    R8,1(,R8)                                       HRC012DK 01073460
         LA    R2,1(,R2)                                       HRC012DK 01073470
         BCT   R7,NEXTNUM                                      HRC012DK 01073480
MDSKBINC DS    0H                                              HRC012DK 01073490
         BAL   R14,BINCONV                                     HRC012DK 01073500
         BCTR  R2,0              -1 TO GET TOTAL NUM CYLINDERS HRC012DK 01073510
         CLM   R2,B'0011',IOBCYLP DO WE HAVE A FULLPACK MINI?  HRC012DK 01073520
         BNL   CONTINUT         YES, LEAVE SETTINGS            HRC012DK 01073530
         STH   R2,IOBCYLP       SAVE ADDR OF LAST PRIMARY CYL  HRC012DK 01073540
         STH   R2,IOBCYLA       LAST ALT CYL = LAST PRIM CYL   HRC012DK 01073550
CONTINUT EQU   *                                               HRC012DK 01073560
         CL    R10,BAREMAC    IS THIS UNDER CMS?               @VA04324 01074000
         BE    BLNKVSER       BRANCH, IF NOT                   @VA04324 01075000
         CL    R15,=A(OUTIOB) IS THIS AN OUTPUT DEFINITION     @VA04324 01076000
         BNE   BLNKVSER       BRANCH IF NOT                    @VA04324 01077000
         CLI   IOBCLASS,CLASDASD IS OUTPUT DEVICE A DASD       @VA04324 01078000
*                             DEVICE?                                   01079000
         BNE   BLNKVSER       BRANCH, IF NOT                   @VA04324 01080000
         ST    R15,SAVEREGS+8 SAVE R15 ACROSS CMS CALL         @VA04324 01081000
         LA    R1,RELP        SET UP R1 WITH PLIST ADDRESS     @VA04324 01082000
         SVC   202                                             @VA04324 01083000
         DC    AL4(*+4)       NO ERROR RETURN                  @VA04324 01084000
         L     R15,SAVEREGS+8 RESTORE R15                      @VA04324 01085000
BLNKVSER EQU   *                                               @VA04324 01086000
         MVC   IOBVSER(6),BLANKS        BLANK OUT THE VOLUME SERIAL NO  01087000
         BAL   R14,SCANCONT                                             01088000
         BC    4,GTCARD       IF NO INPUT BRANCH                        01089000
         BC    2,GETPARM      IF ( BRANCH                               01090000
         CLI   IOBCLASS,CLASTAPE   IS THIS A TAPE                       01091000
         BE    TAPE                                                     01092000
         CL    R2,=F'7'       IS IT OVER 6 OR EQ TO 7                   01093000
         BE    SCRATCH        EQ- GO TEST FOR 'SCRATCH'                 01094000
         BH    DDR701         YES- ERROR                                01095000
         BCTR  R2,0           SET UP O-RING                             01096000
         EX    R2,MOVEVSER    MOVE IN VOLUME SERIAL NUMBER              01097000
         B     GTCARD         GET NEXT CARD                             01098000
SCRATCH  CLC   0(7,R1),=C'SCRATCH'  IS IT SCRATCH                       01099000
         BNE   DDR701              NO- ERROR                            01100000
         OI    IOBSTAT,IOBSCRAT    TURN ON THE SCRATCH VOL BIT          01101000
         B     GTCARD              GET THE NEXT CARD                    01102000
MOVEVSER MVC   IOBVSER(0),0(R1)     MOVE VOL SER NO FROM CARD TO IOB    01103000
MOVECCU  MVC   CCU(0),0(R1)                                    @VA04324 01104000
TAPE     CL    R2,=F'3'       IS IT OVER 3                              01105000
         BH    DDR701         YES- ERROR                                01106000
         BAL   R14,HEXCONV                                              01107000
         STH   R2,IOBATAPE    SAVE ALTERNATE TAPE ADD                   01108000
         BAL   R14,SCANCONT   GET THE NEXT PARM                @VA00967 01109000
         BC    2,GETPARM      IF ( BRANCH                      @VA00967 01110000
         B     GTCARD         GET NEXT CARD                    @VA00967 01111000
GETPARM  TM    IOBCLASS,CLASTAPE   IS IT TAPE                           01112000
         BZ    DDR703         NO- ERROR                                 01113000
         BAL   R14,SCANCONT   GET THE NEXT PARM                         01114000
         BNZ   GTCARD         LAST PARM GO GET THE NEXT CARD            01115000
         CL    R2,=F'2'       IS PARM 2 CHAR OR LARGER                  01116000
         BL    DDR701         NO- ERROR                                 01117000
         COMP  =C'SKIP '      IS THE PARM SKIP                          01118000
         BE    SCANSKIP       YES- GO GET THE COUNT                     01119000
         COMP  =C'MODE '      IS IT MODE                                01120000
         BE    SCANMODE       YES- GO GET THE MODE                      01121000
         COMP  =C'REWIND '    IS IT REWIND                              01122000
         BNE   SCANUNLO       NO- BRANCH                                01123000
         MVI   IOBDISP,X'07'  SET UP THE REWIND COMMAND CODE            01124000
         B     GETPARM        GO GET THE NEXT PARM                      01125000
SCANUNLO COMP  =C'UNLOAD '    IS THE PARM UNLOAD                        01126000
         BNE   SCANLEAV       NO- BRANCH                                01127000
         MVI   IOBDISP,X'0F'  SET UP THE REWIND UNLOAD COMMAND CODE     01128000
         B     GETPARM                                                  01129000
SCANLEAV COMP  =C'LEAVE '      IS IT LEAVE                              01130000
         BNE   DDR701         NO- ERROR                                 01131000
         MVI   IOBDISP,X'03'  SET UP A NOP                              01132000
         B     GETPARM        GO GET THE NEXT PARM                      01133000
SCANSKIP BAL   R14,SCANCONT   GO GET THE  COUNT                         01134000
         BNZ   DDR703         ERROR IF NO INPUT                         01135000
         BAL   R14,BINCONV    CONVERT IT TO BINARY                      01136000
         CH    R2,=H'255'     IS IT TO BIG                              01137000
         BH    DDR701         YES- ERROR                                01138000
         STH   R2,IOBSKIP     SET UP THE SKIP COUNT                     01139000
         B     GETPARM                                                  01140000
SCANMODE BAL   R14,SCANCONT   GET THE TAPE MODE                         01141000
         BNE   DDR703         ERROR IF NO INPUT                         01142000
         CL    R2,=F'2'       IS PARM 2 CHAR OR GREATER?       @V200438 01143000
         BL    DDR701         NOPE, SORRY ABOUT THAT.          @V200438 01144000
         COMP  =C'6250 '      IS IT 6250?                      @V200438 01145000
         BNE   TEST1600       NOPE, GO TRY 1600...             @V200438 01146000
         MVI   IOBMODE,X'D3'  SET MODE TO 6250 BPI, 9 TRACK    @V200438 01147000
         B     GETPARM        NOW GO READ IN THE NEXT CARD     @V200438 01148000
TEST1600 COMP  =C'1600 '      IS IT 1600?                      @V200438 01149000
         BNE   TEST800        NO- BRANCH                                01150000
         MVI   IOBMODE,X'C3'  SET MODE TO 1600 BPI 9 TRACK              01151000
         B     GETPARM             READ IN THE NEXT CARD                01152000
TEST800  COMP  =C'800 '       IS IT 800                                 01153000
         BNE   DDR701         NO- ERROR                                 01154000
         MVI   IOBMODE,X'CB'  SET MODE TO 800 BPI 9 TRACK               01155000
         B     GETPARM        GO GET THE NEXT PARM                      01156000
         EJECT                                                          01157000
*****************************************************************       01158000
*.                                                                      01159000
*  4.    ROUTINE TO SCAN SYSPRINT STATEMENT                             01160000
*                                                                       01161000
*              1. FILL IN THE PRINTER IOB.                              01162000
*                                                                       01163000
*              2. SET UP THE PRINTER ADDRESS FOR DIAG. 8 IN THE         01164000
*                 EXIT ROUTINE.                                         01165000
*                                                                       01166000
*              3. GO TO ROUTINE 1 STEP 5.                               01167000
*.                                                                      01168000
*****************************************************************       01169000
SCANSYSP LA    R15,PRINTIOB   POINT TO IOB                              01170000
         NI    SPRNTDEV,X'00' CLEAR OPTION FLAG                HRC012DK 01170300
         MVC   PRINTIOB+(IOBUADD-IOB)(2),=XL2'000E' RESET      HRC012DK 01170600
         BAL   R14,SCANCONT   GET THE NEXT PARM                         01171000
         BC    4,DDR703       ERROR IF NO INPUT                         01172000
         CL    R2,=F'4'       SEE IF LENGTH OF CONS SPEC       HRC012DK 01173080
         BNE   NOTCONS1       NO, CANT BE CONS                 HRC012DK 01173160
         CLC   =C'CONS',0(R1)                                  HRC012DK 01173240
         BNE   DDR701         NO, GIVE ERROR MESSAGE           HRC012DK 01173320
         OI    SPRNTDEV,CONS  INDICATE SYSPRINT=CONS OPTION    HRC012DK 01173400
         MVC   PRINTIOB+(IOBUADD-IOB)(2),CONIOB+(IOBUADD-IOB)  HRC012DK 01173480
         NI    IOBSTAT,X'FF'-IOBNOPER PRESUME CONS WORKS       HRC012DK 01173560
         B     GTCARD                                          HRC012DK 01173640
NOTCONS1 EQU   *                                               HRC012DK 01173720
         CL    R2,=F'3'       IS IT OVER 3                     HRC012DK 01173800
         BH    DDR701         YES- ERROR                                01174000
         CLC   MACHINE,BAREMAC IS THIS UNDER CMS ?             HRC012DK 01174300
         BNE   GTCARD          YES, IGNORE THIS CARD           HRC012DK 01174600
         MVC   CPADD(4),BLANKS     BLANK OUT THE ADD                    01175000
         MOVE  CPADD         SET UP THE ADD                             01176000
         LA    R2,1(,R2)      +1                                        01177000
         BAL   R14,HEXCONV                                              01178000
         STH   R2,IOBUADD     SAVE UNIT ADD                             01179000
         BAL   R3,PRTINIT                                      HRC012DK 01181990
         B     GTCARD              READ IN THE NEXT CARD                01184000
         SPACE 3 ,                                             HRC012DK 01184090
PRTINIT  EQU   *                                               HRC012DK 01184180
         LA    R15,PRINTIOB   DO AN INITIALIZE PRINTER IN CASE HRC012DK 01184270
         NI    IOBSTAT,255-IOBNOPER                            HRC012DK 01184360
         LA    R1,INITCCW     THIS IS A   3800 PRINTER         HRC012DK 01184450
         ST    R1,IOBCCW           SAVE THE CCW STRING         HRC012DK 01184540
         BAL   R14,STARTIO    GO DO IT                         HRC012DK 01184630
         NI    SPRNTDEV,X'00'                                  HRC012DK 01184720
         OI    SPRNTDEV,PRT                                    HRC012DK 01184810
         BR    R3                                              HRC012DK 01184900
         SPACE 3                                                        01185000
*****************************************************************       01186000
*.                                                                      01187000
*  5.    ROUTINE TO SCAN PRINT AND TYPE STATEMENT                       01188000
*                                                                       01189000
*              1. SET UP THE TRANSLATE TABLE, AND FUNCTION NAME.        01190000
*                                                                       01191000
*              2. IF INPUT IS NOT FROM TAPE OR DASD DEVICE GO TO        01192000
*                 ERROR DDR708.                                         01193000
*                                                                       01194000
*              3. SET UP THE START ADDRESS, DEFAULTING TO TRACK 0       01195000
*                 RECORD 0 IF NOT PROVIDED.                             01196000
*                                                                       01197000
*              4. IF NO 'TO' KEYWORD GO TO STEP 6.                      01198000
*                                                                       01199000
*              5. FILL IN THE STOP ADDRESS, DEFAULTING TO THE LAST      01200000
*                 TRACK AND THE LAST RECORD IF NOT PROVIDED.            01201000
*                                                                       01202000
*              6. SPACE ONE LINE ON THE CONSOLE OR SKIP TO CHANNEL      01203000
*                 ONE ON THE PRINTER.                                   01204000
*                                                                       01205000
*              7. GO TO ROUTINE 9.                                      01206000
*.                                                                      01207000
*****************************************************************       01208000
SCANTYPE MVI   DDRFLAG2,TYPE  SET UP THE TYPE FLAG                      01209000
         MVC   SAVENAME(8),CTYPE   SET UP ROUTINE NAME                  01210000
         MVC   LOWCASE(41),LOWERCAS     SET TRAN TABLE TO LOWER CASE    01211000
         MVC   SPECIALC(55),SPECTYPE    SET THE TABLE UP FOR TYPE       01212000
         B     TSTINPUT                                                 01213000
SCANPRIN MVI   DDRFLAG2,PRINT SET UP THE PRINT FLAG                     01214000
         TM    SPRNTDEV,CONS+PRT                               HRC012DK 01214200
         BNZ   SETABLES                                        HRC012DK 01214400
         BAL   R3,PRTINIT                                      HRC012DK 01214600
SETABLES EQU   *                                               HRC012DK 01214800
         MVC   LOWCASE(41),UPPERCAS     SET TRAN TABLE TO UPPER CASE    01215000
         MVC   SPECIALC(55),SPECPTR     SET TRAN TABER SPECIAL CH IN    01216000
         MVC   SAVENAME(8),CPRINT       SET UP ROUTINE NAME             01217000
TSTINPUT TM    INIOB+(IOBCLASS-IOB),CLASDASD+CLASTAPE                   01218000
         BZ    DDR708         ERROR IF NOT TAPE OR DASD                 01219000
         TM    INIOB+(IOBSTAT-IOB),IOBOPEN   IS THIS DEVICE OPEN        01220000
         BZ    OPENIN1        NO- OPEN THE INPUT UNIT AND RETURN TO    *01221000
                              THE NEXT STATMENT                         01222000
         SPACE                                                          01223000
CONTSCAN SR    R0,R0          ZERO OUT R 0                              01224000
         LA    R1,EXTABLE     POINT TO THE EXTENT TABLE                 01225000
         ST    R1,CUREXT      POINT TO THE FIRST EXTENT                 01226000
         ST    R1,LASTEXT     POINT TO THE LAST EXTENT                  01227000
         BAL   R14,SCANCONT   GET THE START CYLINDER                    01228000
         BNE   DDR703         ERROR                                     01229000
         BAL   R14,BINCONV    CONVERT TO BINARY                         01230000
         CH    R2,INIOB+(IOBCYLA-IOB) IS IT OVER THE MAX CYL?  @V56BDA8 01231000
         BH    DDR701         YES- ERROR                                01232000
         STH   R2,EXTABLE     SET UP START EXT                          01233000
         STH   R2,EXTABLE+2   SET UP STOP EXT                           01234000
         STH   R2,EXTABLE+4   SET UP REORDER EXTENT                     01235000
         STH   R2,PSTARTCC    SET UP PRINTER START CYLINDER             01236000
         ST    R0,PSTARTHH    SET UP DEFAULT START TRACK AND HEAD       01237000
         STH   R2,PSTOPCC     SET UP DEFAULT STOP CYLINDER              01238000
         MVC   PSTOPHH,VHRMTCK   SET UP DEFAULT STOP TRACK              01239000
         MVC   PSTOPRR(2),=4X'FF'  SET UP THE DEFAULT REC STOP ID       01240000
         BAL   R14,SCANCONT   GET THE TRACK ID                          01241000
         BNE   SCANCOMP                                                 01242000
         COMP  TO             IS IT TO                                  01243000
         BE    SETSTOP        YES- BRANCH                               01244000
         BAL   R14,BINCONV    CONVERT TO BINARY                         01245000
         CH    R2,VHRMTCK    IS IT OVER THE MAX                         01246000
         BH    DDR701         YES- ERROR                                01247000
         STH   R2,PSTARTHH    SET UP THE START TRACK                    01248000
         STH   R2,PSTOPHH     SET UP THE DEFAULT STOP TRACK             01249000
         BAL   R14,SCANCONT   GET THE RECORD ID                         01250000
         BNE   SCANCOMP       GET OUT IF NO INPUT                       01251000
         COMP  TO             IS IT TO                                  01252000
         BE    SETSTOP        YES- BRANCH                               01253000
         BAL   R14,BINCONV    CONVERT TO BINARY                         01254000
         CH    R2,=H'255'     IS IT OVER 255                            01255000
         BH    DDR701         YES- ERROR                                01256000
         STC   R2,PSTARTRR    SET UP THE RECORD ID                      01257000
         STC   R2,PSTOPRR     SET UP THE DEFAULT RECORD ID              01258000
         STC   R0,PSTOPRR+1   ZERO OUT THE RECORD FLAG                  01259000
         BAL   R14,SCANCONT   GET THE TO KEYWORD                        01260000
         BNZ   SCANCOMP       NO INPUT GET OUT                          01261000
         COMP  TO             IS THE INPUT EQ TO                        01262000
         BNE   DDR701         NO- ERROR                                 01263000
SETSTOP  BAL   R14,SCANCONT   GET THE STOP CYLINDER                     01264000
         BNZ   DDR703         ERROR IF NO INPUT                         01265000
         BAL   R14,BINCONV    CONVERT TO BINARY                         01266000
         CH    R2,INIOB+(IOBCYLA-IOB) IS IT OVER THE MAX?      @V56BDA8 01267000
         BH    DDR701         YES- ERROR                                01268000
         CH    R2,PSTARTCC    IS IT SMALLER THAN THE START CYLINDER     01269000
         BL    DDR701         YES- ERROR                                01270000
         STH   R2,PSTOPCC     SET UP THE STOP CYLINDER                  01271000
         STH   R2,EXTABLE+2   SET UP THE STOP EXTENT CYLINDER           01272000
         MVC   PSTOPHH(2),VHRMTCK   SET UP DEFAULT TRACK SIZE           01273000
         MVC   PSTOPRR(2),=4X'FF'  SET UP THE DEFAULT REC STOP ID       01274000
         BAL   R14,SCANCONT   GET THE STOP TRACK                        01275000
         BNZ   SCANCOMP       IF NO INPUT GET OUT                       01276000
         BAL   R14,BINCONV    CONVERT TO BINARY                         01277000
         CH    R2,VHRMTCK  IS IT OVER THE MAX TRACK                     01278000
         BH    DDR701         YES- ERROR                                01279000
         STH   R2,PSTOPHH     SET UP THE HEAD ADD                       01280000
         CLC   PSTARTCC(4),PSTOPCC IS THE START ADD LARGER THAN        X01281000
                                   THE STOP ADD                         01282000
         BH    DDR701         YES- ERROR                                01283000
         BAL   R14,SCANCONT   GET THE RECORD ID                         01284000
         BNZ   SCANCOMP       GET OUT IF NO INPUT                       01285000
         BAL   R14,BINCONV    CONVERT TO BINARY                         01286000
         CH    R2,=H'255'     IS IT TO BIG                              01287000
         BH    DDR701         YES- ERROR                                01288000
         STC   R2,PSTOPRR     SET UP THE RECORD ID                      01289000
         STC   R0,PSTOPRR+1   SET RECORD FLAG TO ZERO                   01290000
         CLC   PSTARTCC(5),PSTOPCC IS THE START ID SMALLER THAN        X01291000
                                        THE STOP ID                     01292000
         BNH   TESTOPT        YES- BRANCH                               01293000
         BAL   R14,DDR713     NO- ERROR                                 01294000
         B     GTCARD                                                   01295000
TESTOPT  BAL   R14,SCANCONT   GET THE OPTION IF ANY                     01296000
SCANCOMP BC    13,DEFAULT5    BRANCH IF NOT LEFT PERENTHIESIS           01297000
         BAL   R14,SCANCONT   GET THE FIRST OPTION                      01298000
         BNZ   DDR703         ERROR IF NO OPTION                        01299000
         B     COMPOPT                                                  01300000
LOOP14   BAL   R14,SCANCONT   GET THE NEXT OPTION                       01301000
         BC    5,ALLSET       GET OUT IF NONE OR RIGHT PERENTHIESIS     01302000
COMPOPT  COMP  =C'HEX '       IS THIS THE HEX OPTION                    01303000
         BNE   COMPGRAP       NO- BRANCH                                01304000
         OI    DDRFLAG2,HEXOPT     TURN ON THE HEX OPTION FLAG          01305000
         B     LOOP14         NEXT                                      01306000
COMPGRAP COMP  =C'GRAPHIC '   IS IT THE GRAPHIC OPTION                  01307000
         BNE   COMPCOUN       NO- BRANCH                                01308000
         OI    DDRFLAG2,GRAPHOPT   TURN ON THE GRAPHIC OPTION           01309000
         B     LOOP14         NEXT                                      01310000
COMPCOUN COMP  =C'COUNT '     IS IT THE COUNT OPTION                    01311000
         BNE   DDR701         NO- ERROR                                 01312000
         OI    DDRFLAG2,COUNTOPT   TURN ON THE COUNT OPTION FLAG        01313000
         B     LOOP14                                                   01314000
DEFAULT5 OI    DDRFLAG2,GRAPHOPT+HEXOPT DEFAULT TO HEX AND GRAPHIC      01315000
ALLSET   XC    INADD(16),INADD     ZERO THE INPUT AND OUTPUT ADDRESS    01316000
         MVC   INADD+2(4),PSTARTCC SET UP THE SEEK ADDRESS FOR          01317000
         MVC   OUTADD+2(4),PSTARTCC     THE FIRST TRACK TO PRINT.       01318000
         STH   R0,LINECT      SET LINE COUNT TO ZERO                    01319000
         TM    DDRFLAG2,PRINT IS THIS A PRINT OPERATION                 01320000
         BZ    SPACEONE       NO- BRANCH                                01321000
         CLC   PRINTIOB+(IOBUADD-IOB)(2),CONIOB+(IOBUADD-IOB)  HRC012DK 01321300
         BE    SPACEONE       YES, GO PRINT A BLANK ONE        HRC012DK 01321600
         LA    R15,PRINTIOB   *    SKIP TO THE FIRST PAGE               01322000
         LA    R1,SKTO1CCW    *                                         01323000
         BAL   R14,CMS2       *                                         01324000
         BAL   R14,MSG004     *                                HRC012DK 01325290
         B     TESTIN         GO START THE JOB STEP            HRC012DK 01325580
SPACEONE LA    R2,BLANKMSG    POINT TO THE MSG                          01326000
         BAL R14,MSGWRITE     GO PRINT ONE BLANK                        01327000
         B     TESTIN         GO START THE JOB STEP (NO MSG)            01328000
         EJECT                                                          01329000
*****************************************************************       01330000
*.                                                                      01331000
* 6.     ROUTINE TO SCAN DUMP STATEMENT                                 01332000
*                                                                       01333000
*              1. IF INPUT IS FROM DASD AND OUTPUT TO TAPE CONT,        01334000
*                 ELSE GO TO ERROR DDR708.                              01335000
*                                                                       01336000
*              2. SET UP FUNCTION NAME AND GO TO ROUTINE 9.             01337000
*.                                                                      01338000
*****************************************************************       01339000
SCANDUMP EQU   *                                               HRC012DK 01340090
         TM    SPRNTDEV,CONS+PRT                               HRC012DK 01340180
         BNZ   DEVTEST                                         HRC012DK 01340270
         BAL   R3,PRTINIT                                      HRC012DK 01340360
DEVTEST  EQU   *                                               HRC012DK 01340450
         TM    INIOB+(IOBCLASS-IOB),CLASDASD   IS IT A DASD DEVHRC012DK 01340540
         BZ    DDR708         NO- BRANCH                                01341000
         TM    OUTIOB+(IOBCLASS-IOB),CLASTAPE   IS IT A TAPE DEVICE     01342000
         BZ    DDR708         NO- BRANCH                                01343000
         TM    DDRFLAG3,INERROR+OUTERROR TEST FOR I/O DEF ERROR@VA13582 01343010
         BM    DDR708         AGAIN ERROR MSG                  @VA13582 01343020
         MVC   OUTIOB+(IOBVSER-IOB)(6),INIOB+(IOBVSER-IOB)             X01344000
                              SET UP THE VOL SER NO                     01345000
         MVC   SAVENAME(8),CDUMP   SAVE NAME                            01346000
         B     OPENIN                                                   01347000
         SPACE 3                                                        01348000
*****************************************************************       01349000
*.                                                                      01350000
*  7.    ROUTINE TO SCAN RESTORE STATEMENT                              01351000
*                                                                       01352000
*              1. IF INPUT IS FROM TAPE AND OUTPUT IS TO DASD CONT,     01353000
*                 ELSE GO TO ERROR DDR708.                              01354000
*                                                                       01355000
*              2. SET UP FUNCTION NAME AND GO TO ROUTINE 9.             01356000
*.                                                                      01357000
*****************************************************************       01358000
SCANREST EQU   *                                               HRC012DK 01359090
         TM    SPRNTDEV,CONS+PRT SYSPRINT DEVICE PROCESSED?    HRC012DK 01359180
         BNZ   DEVTST                                          HRC012DK 01359270
         BAL   R3,PRTINIT                                      HRC012DK 01359360
DEVTST   EQU   *                                               HRC012DK 01359450
         TM    INIOB+(IOBCLASS-IOB),CLASTAPE IS THE INPUT A TAPHRC012DK 01359540
         BZ    DDR708         NO- ERROR                                 01360000
         TM    OUTIOB+(IOBCLASS-IOB),CLASDASD IS THE OUTPUT A DASD UNIT 01361000
         BZ    DDR708         NO- ERROR                                 01362000
         TM    DDRFLAG3,INERROR+OUTERROR TEST FOR I/O DEF ERROR@VA13582 01362010
         BM    DDR708         AGAIN ERROR MSG                  @VA13582 01362020
         MVC   INIOB+(IOBVSER-IOB)(6),OUTIOB+(IOBVSER-IOB)             X01363000
                              SET UP THE VOL SER NO                     01364000
         MVC   SAVENAME(8),CRESTORE SAVE THE NAME                       01365000
         B     OPENIN         OPEN THE INPUT UNITS                      01366000
         EJECT                                                          01367000
*****************************************************************       01368000
*.                                                                      01369000
*  8.    ROUTINE TO SCAN COPY STATEMENT                                 01370000
*                                                                       01371000
*              1. IF INPUT AND OUTPUT ARE FROM THE SAME DEVICE TYPE     01372000
*                 CONT, ELSE GO TO ERROR DDR708.                        01373000
*                                                                       01374000
*              2. SET UP FUNCTION NAME AND GO TO NEXT ROUTINE.          01375000
*.                                                                      01376000
*****************************************************************       01377000
SCANCOPY EQU   *                                               HRC012DK 01378090
         TM    SPRNTDEV,CONS+PRT SYSPRINT DEVICE PROCESSED?    HRC012DK 01378180
         BNZ   TSTDEV                                          HRC012DK 01378270
         BAL   R3,PRTINIT                                      HRC012DK 01378360
TSTDEV   EQU   *                                               HRC012DK 01378450
         TM    INIOB+(IOBCLASS-IOB),255    IS THE CLASS = ZERO HRC012DK 01378540
         BZ    DDR708              YES- ERROR                           01379000
*        VERIFY THAT DEVICE CLASSES AND TYPES ARE THE SAME              01380000
         CLC   INIOB+(IOBCLASS-IOB)(2),OUTIOB+(IOBCLASS-IOB)   @V2A2063 01381000
         BNE   DDR708         NO - THAT'S AN ERROR             @V2A2063 01382000
         TM    INIOB+(IOBCLASS-IOB),CLASTAPE TAPES?            @V2A2063 01383000
         BO    SETNAME        YES                              @V2A2063 01384000
*        COMPARE RELATIVE SIZES OF THE DASD DEVICES                     01385000
         CLC   INIOB+(IOBCYLP-IOB)(L2),OUTIOB+(IOBCYLP-IOB)    @V56BDA8 01386000
         BNH   SETNAME        A<B OR A=B                       @V2A2063 01387000
         BAL   R14,DDR725     A>B - BETTER LET HIM KNOW        @V2A2063 01388000
RSPCPY   EQU   *                                               @V2A2063 01389000
         BAL   R14,RESPONS2   SEE WHAT TO DO                   @V2A2063 01390000
         CLC   =C'YES ',RESPDATA YES?                          @V2A2063 01391000
         BE    SETNAME        OK - CONTINUE                    @V2A2063 01392000
         CLC   =C'NO ',RESPDATA PUNT??                         @V2A2063 01393000
         BE    GTCARD         DROP BACK 5                      @V2A2063 01394000
         B     RSPCPY         THAT'S YES OR NO GUY.            @V2A2063 01395000
SETNAME  MVC   SAVENAME(8),CCOPY   SET UP NAME OF THE CALLING ROUTINE   01396000
         SPACE 3                                                        01397000
*****************************************************************       01398000
*.                                                                      01399000
*  9.    SUBROUTINE TO OPEN THE INPUT UNITS                             01400000
*                                                                       01401000
*              1. IF THE ERROR AND CARDIN FLAGS ARE ON GO TO THE        01402000
*                 NEXT ROUTINE.                                         01403000
*                                                                       01404000
*              2. IF DASD, LINK TO ROUTINE 21 TO                        01405000
*                 OPEN THE DASD UNIT, ELSE GO TO STEP 4.                01406000
*                                                                       01407000
*              3. BUILD A VOLUME HEADER RECORD AND GO TO ROUTINE 10.    01408000
*                                                                       01409000
*              4. SKIP THE PROPER NUMBER OF FILES ON THE TAPE.          01410000
*                                                                       01411000
*              5. READ IN THE VOLUME HEADER RECORD.                     01412000
*                                                                       01413000
*              6. MOVE THE VOL SER NO INTO THE PROPER IOB'S,            01414000
*                 AND GO TO THE NEXT ROUTINE.                           01415000
*.                                                                      01416000
*****************************************************************       01417000
OPENIN   TM    DDRFLAG,ERROR+CARDIN  WAS THERE AN ERROR                 01418000
         BO    GETEXT         YES- SKIP THE OPEN AND CHECK THE CARD     01419000
OPENIN1  LA    R15,INIOB      POINT TO THE INPUT IOB                    01420000
         TM    IOBCLASS,CLASTAPE   IS INPUT TAPE                        01421000
         BO    GETVHR         YES- GO READ TAPE                         01422000
         BAL   R14,OPENDASD   OPEN THE INPUT DASD UNIT                  01423000
         MVC   VHRVSER,IOBVSER     MOVE IN INPUT VOL SER NO             01424000
         STCK  VHRCLOCK       SET UP ID                                 01425000
         MVC   VHRMREC(L2),IOBMREC OUTPUT TAPE HDR, OTHER USES.@V56BDA8 01426000
         MVC   VHRCYLA(L2),IOBCYLA OUTPUT TAPE HDR.            @V56BDA8 01427000
         MVC   VHRMTCK(L2),IOBMTCK OUTPUT TAPE HDR, OTHER USES.@V56BDA8 01428000
         MVC   VHR(4),=C'VHR '     SET UP ID                            01429000
         TM    OUTIOB+(IOBCLASS-IOB),CLASTAPE OUTPUT IS TAPE?  @V56BDA8 01430000
         BZ    MARKOPEN       NO, DASD, SO OUTIOB HAS CYL      @V56BDA8 01431000
*                             LIMITS ALREADY (FROM 'OUTPUT' CTL CARD    01432000
*                             PROCESSING).                              01433000
         MVC   OUTIOB+(IOBCYLA-IOB)(L2),IOBCYLA OUTIOB GETS CYL@V56BDA8 01434000
*                                               LIMIT OF INIOB.         01435000
         MVC   OUTIOB+(IOBCYLP-IOB)(L2),IOBCYLA OUT CYLP EQUAL @V56BDA8 01436000
*                                               TO INPUT CYLA ALLOWS    01437000
*                                               ALL CYL TO BE DUMPED.   01438000
         B     MARKOPEN                                                 01439000
GETVHR   LH    R2,IOBSKIP     GET THE SKIP COUNT                        01440000
         LTR   R2,R2          IS IT ZERO                                01441000
         BZ    NOFSR1         YES- BRANCH                               01442000
NEXTFSF1 LA    R1,FSFCCW      POINT TO THE CCW                          01443000
         BAL   R14,STARTIO    SPACE 1 FILE                              01444000
         BCT   R2,NEXTFSF1    DO IT FOR EACH FILE                       01445000
         STH   R2,IOBSKIP     SAVE THE COUNT                            01446000
NOFSR1   LA    R1,RVHRCCW     POINT TO THE CCW                          01447000
         BAL   R14,STARTIO    READ IN THE RECORD                        01448000
         CLC   =C'VHR ',VHR   IS THIS A VOLUME HEADER RECORD            01449000
         BE    SETVSN         YES- BRANCH                              *01450000
                              NO- BACK THE TAPE UP 1 FILE AND READ IT  *01451000
                              ONE TIME TO ENSURE IT WAS AT THE HEADER   01452000
BSFILE   LA    R15,INIOB      RESET THE IOB POINTER                     01453000
         LA    R1,BSFCCW      *    POINT AT THE BSFILE CCW              01454000
         BAL   R14,STARTIO    *    AND BACK IT UP                       01455000
         LA    R1,RVHRCCW     SET UP TO READ THE VHR                    01456000
         BAL   R14,STARTIO    READ THE VHR                              01457000
         CLC   =C'VHR ',VHR   IS THIS A VOLUME HEADER RECORD            01458000
         BNE   ERRCLOSE       NO- ERROR                                 01459000
SETVSN   MVC   INIOB+(IOBVSER-IOB)(6),VHRVSER     SET UP VOL SER NO     01460000
         MVC   INIOB+(IOBCYLA-IOB)(L2),VHRCYLA FILL IN INPUT   @V56BDA8 01461000
*                                               IOB FROM TAPE HEADER.   01462000
         MVC   INIOB+(IOBCYLP-IOB)(L2),VHRCYLA FILL IN INPUT   @V56BDA8 01463000
*                                               IOB FROM TAPE HEADER.   01464000
         TM    OUTIOB+(IOBCLASS-IOB),CLASDASD     IS THE OUTPUT DASD    01465000
         BNZ   SETDASD                            YES- BRANCH           01466000
         MVC   OUTIOB+(IOBVSER-IOB)(6),VHRVSER    SET UP VOL SER NO     01467000
         MVC   OUTIOB+(IOBCYLA-IOB)(L2),INIOB+(IOBCYLA-IOB)    @V56BDA8 01468000
*                             FILLS OUTPUT IOB WITH DATA FROM INPUT     01469000
*                             TAPE HEADER.                              01470000
         MVC   OUTIOB+(IOBCYLP-IOB)(L2),INIOB+(IOBCYLP-IOB)    @V56BDA8 01471000
*                             FILLS OUTPUT IOB WITH DATA FROM INPUT     01472000
*                             TAPE HEADER.                              01473000
         B     MARKOPEN                                                 01474000
SETDASD  CLC   IOBVSER(6),OUTIOB+(IOBVSER-IOB)     IS THE V SER FROM   *01475000
                              THE DUMPED DISK THE SAME AS THE OUTPUT   *01476000
                              DISK'S VOLUME SERIAL NUMBER.              01477000
         BE    MARKOPEN            YES- BRANCH                          01478000
         TM    OUTIOB+(IOBSTAT-IOB),IOBSCRAT OUTPUT VOL A SCRETCH VOL   01479000
         BO    MARKOPEN            YES- AOK                             01480000
         BAL   R14,DDR717          NO- GO TO THE ERROR ROUTINE          01481000
OPNINRSP EQU   *                                               @V2A2063 01482000
         BAL   R14,RESPONSE   ASK FOR YES NO OR REREAD                  01483000
         CLC   =C'YES ',RESPDATA   IS IT YES                            01484000
         BE    MARKOPEN       YES- CONTINUE                             01485000
         CLC   =C'REREAD ',RESPDATA     IS IT REREAD                    01486000
         BE    BSFILE         YES- GO BACK UP THE TAPE                  01487000
         CLC   =C'NO ',RESPDATA    IS IT NO                             01488000
         BNE   OPNINRSP       NONE OF THE ABOVE                @V2A2063 01489000
         OI    DDRFLAG,ERROR  TURN ON THE ERROR BIT                     01490000
         B     GTCARD         GO READ THE NEXT CARD                     01491000
         SPACE                                                          01492000
MARKOPEN OI    INIOB+(IOBSTAT-IOB),IOBOPEN MARK THE IOB OPEN   @VA00735 01493000
         MVC   THRHADD+1(4),=4X'FF' AND MASK THE THR HOME ADD  @VA00735 01494000
         TM    DDRFLAG2,VERIFY+REPLACE   VER-REP OPERATION              01495000
*        BNZ   CONTVR         YES- BRANCH                               01496000
         TM    DDRFLAG2,PRINT+TYPE PRINT OR TYPE OPERATION              01497000
         BNZ   CONTSCAN                                                 01498000
         SPACE 3                                                        01499000
*  UPON EXITING FROM THE OPENING OF THE INPUT IOB, THE CYLINDER         01500000
*  EXTENT LIMITS IN THE INIOB AND THE OUTIOB WILL HAVE BEEN SET         01501000
*  AS FOLLOWS:                                                          01502000
*                                                                       01503000
*                 |                         |                         | 01504000
*                 |          INIOB          |          OUTIOB         | 01505000
*                 |                         |                         | 01506000
*-----------------|------------|------------|------------|------------| 01507000
*  TYPE OF        |            |            |            |            | 01508000
*  OPERATION      |  IOBCYLP   |  IOBCYLA   |  IOBCYLP   |  IOBCYLA   | 01509000
*-----------------|------------|------------|------------|------------| 01510000
*                 |            |            |            |            | 01511000
*  DASD IN,TAP OUT|            |            |            |            | 01512000
*    (DUMP)       | NAMECYLP   | NAMECYLA   | NAMECYLA(I)| NAMECYLA(I)| 01513000
*                 |            |            |            |            | 01514000
*  TAP IN,DASD OUT|            |            |            |            | 01515000
*    (RESTORE)    | NAMECYLA(H)| NAMECYLA(H)| NAMECYLP   | NAMECYLA   | 01516000
*                 |            |            |            |            | 01517000
*  DASD IN & OUT  |            |            |            |            | 01518000
*    (COPY)       | NAMECYLP   | NAMECYLA   | NAMECYLP   | NAMECYLA   | 01519000
*                 |            |            |            |            | 01520000
*  TAPE IN & OUT  |            |            |            |            | 01521000
*    (COPY)       | NAMECYLA(H)| NAMECYLA(H)| NAMECYLA(H)| NAMECYLA(H)| 01522000
*                 |            |            |            |            | 01523000
*  DASD IN, NO OUT|            |            |            |            | 01524000
*    (TYPE/PRINT) | NAMECYLP   | NAMECYLA   |     ---    |     ---    | 01525000
*                 |            |            |            |            | 01526000
*  TAPE IN, NO OUT|            |            |            |            | 01527000
*    (TYPE/PRINT) | NAMECYLA(H)| NAMECYLA(H)|     ---    |     ---    | 01528000
*                 |            |            |            |            | 01529000
*---------------------------------------------------------------------- 01530000
*                                                                       01531000
*                                                                       01532000
*        WHERE 'NAMECYLP' AND 'NAMECYLA' REPRESENT VALUES TAKEN FROM    01533000
*        THE CORRESPONDING LOCATIONS IN THE DEVICE DESCRIPTION TABLE.   01534000
*                                                                       01535000
*        (H) INDICATES VALUE CAME FROM INPUT TAPE HEADER.               01536000
*                                                                       01537000
*        (I) INDICATES VALUE USED IN OUTIOB WAS COPIED FROM THE INIOB.  01538000
*                                                                       01539000
*        WHERE NOT OTHERWISE NOTED (I.E., FOR DASD DEVICES) THE VALUE   01540000
*        COMES DIRECTLY FROM THE CORRESPONDING DEVICE ENTRY IN THE      01541000
*        DEVICE DESCRIPTION TABLE.                                      01542000
*                                                                       01543000
*  THE SIGNIFICANCE OF ALL THIS IS THAT DASD EXTENT TESTING THAT        01544000
*  COMES LATER WILL BE GREATLY SIMPLIFIED.                              01545000
         EJECT                                                          01546000
*******************************************************************     01547000
*.                                                                      01548000
*  10.   SUBROUTINE TO BUILD THE EXTENT TABLE                           01549000
*                                                                       01550000
*              1. IF FIRST KEYWORD IS CPVOL GO TO STEP 4.               01551000
*                                                                       01552000
*              1A. IF THE KEYWORD IS NUCLEUS READ THE DMKCKP            01553000
*                 RECORD (CYL 0 TRK 0 REC 2). THEN BUILD THE            01554000
*                 EXTENT TABLE FROM THE POINTERS IN THE RECORD          01555000
*                 AND GO TO THE NEXT ROUTINE.                           01556000
*                                                                       01557000
*              2. IF THE KEYWORD IS ALL, SET UP THE EXTENT              01558000
*                 TABLE TO WORK WITH THE FULL DASD EXTENT, ELSE         01559000
*                 GO TO STEP 7.                                         01560000
*                                                                       01561000
*              3. TURN ON THE RESTALL FLAG AND GO TO STEP 9.            01562000
*                                                                       01563000
*              4. IF NOT DASD INPUT, GO TO STEP 2. ELSE TEST            01564000
*                 THE CPVOL FLAG. IF NOT ON GO TO ERROR DDR700.         01565000
*                                                                       01566000
*              5. READ IN ALLOCATION TABLE FROM DISK AND BUILD          01567000
*                 THE EXTENT TABLE TO DUMP OR COPY CYL 0 AND ALL        01568000
*                 DIRECTORY AND PERMANENT SPACE.                        01569000
*                                                                       01570000
*              6. GO TO STEP 9.                                         01571000
*                                                                       01572000
*              7. BUILD EXTENT TABLE FROM EXTENT INFO. IN THE CARD      01573000
*                                                                       01574000
*              8. GET THE NEXT STATEMENT. IF NOT A NULL LINE, AN        01575000
*                 INPUT OR OUTPUT STATEMENT, GO TO STEP 7.              01576000
*                 OTHERWISE GO TO STEP 10.                              01577000
*                                                                       01578000
*              9. READ THE NEXT STATEMENT. IF NOT A NULL LINE, AN       01579000
*                 INPUT OR OUTPUT STATEMENT, GO TO ERROR DDR702.        01580000
*                                                                       01581000
*              10. SAVE POINTER TO INPUT OR OUTPUT STATEMENT AND GO     01582000
*                 TO THE NEXT ROUTINE.                                  01583000
*.                                                                      01584000
*                                                                       01585000
*******************************************************************     01586000
GETEXT   SR    R0,R0                                                    01587000
         MVC   LASTREOR(4),=4X'FF'     SET LAST STOP AND REOR TO -1     01588000
         LA    R7,EXTABLE     POINT TO EXTENT TABLE                     01589000
         LA    R8,EXTSIZE     SET UP SIZE OF EXTENT TBL        @V200731 01590000
         BAL   R14,SCANCONT   GET FIRST PARM                            01591000
         BE    GETOK          OK, THERE IS ONE                 @VA07705 01592000
         BAL   R14,MSG003     GO GET EXTENTS                   @VA07705 01593000
         BAL   R14,SCANCONT   GET FIRST PARM                   @VA07705 01594000
         BNE   ALL1           NO ONE, ASSUME ALL               @VA07705 01595000
GETOK    EQU   *                                               @VA07705 01596000
         CL    R2,=F'2'       INPUT MUST BE  2 OR OVER                  01597000
         BL    EXTENTIN       GO CHECK FOR EXTENT                       01598000
         COMP  SAVENAME       IS THIS THE ROUTINE NAME                  01599000
         BE    GETEXT         YES- GET THE NEXT PARAMITER               01600000
         COMP  =C'CPVOL '     IS IT CPVOL                               01601000
         BE    CPVOL          YES- BRANCH                               01602000
         COMP  =C'NUCLEUS '   EQUAL                               (NUC) 01603000
         BNE   NOTNUC         NO- BRANCH                          (NUC) 01604000
         LA    R15,INIOB      POINT TO THE INPUT IOB              (NUC) 01605000
         TM    IOBCLASS,CLASDASD   INPUT UNIT DASD                (NUC) 01606000
         BNZ   GETDASD        YES- BRANCH                         (NUC) 01607000
         LA    R1,RTHRCCW     SET UP TO READ REC FROM TAPE        (NUC) 01608000
         BAL   R14,STARTIO    READ IN THE DMKCKP MODULE           (NUC) 01609000
         B     CHECKCKP                                           (NUC) 01610000
GETDASD  TM    IOBSTAT,IOBCPVOL    INPUT A CPVOL                  (NUC) 01611000
         BZ    DDR700         NO- ERROR                           (NUC) 01612000
         LA    R1,RCKPDASD    SET UP THE READ REC FROM DASD       (NUC) 01613000
         BAL   R14,STARTIO    READ IN THE DMKCKP MODULE           (NUC) 01614000
CHECKCKP CLC   =CL8'DMKCKP',THR+14 IS THIS THE DMKCKP MODULE      (NUC) 01615000
         BNE   DDR723         NO- ERROR                           (NUC) 01616000
         ICM   R1,15,THR+22   GET THE CYL EXTENTS FOR THE NUCLEUS (NUC) 01617000
         CLM   R1,3,OUTIOB+(IOBCYLP-IOB) VERIFY THAT STOP CYL  @V56BDA8 01618000
*                                        WILL NOT GET PUT INTO AN       01619000
*                                        ALTERNATE TRACK CYLINDER.      01620000
*                                        (THIS WAS ALLOWED PRIOR TO     01621000
*                                        REL 5.6, BUT NO LONGER.)  IF   01622000
*                                        OUTPUT IS TAPE, THIS TEST IS   01623000
*                                        A NO-OP BECAUSE IOBCYLP WILL   01624000
*                                        CONTAIN NAMECYLA,NOT NAMECYLP. 01625000
         LA    R14,GTCARD     ERROR RETURN ADDR.               @V56BDA8 01626000
         BH    DDR726         ERROR, OLD DISK HAD NUCLEUS ON   @V56BDA8 01627000
*                             ALTERNATE TRACK CYLINDER.                 01628000
         ST    R1,CYLSTART    SAVE THE START AND STOP CYL ADD     (NUC) 01629000
         STCM  R1,12,CYLREOR  SET UP THE REORDER CYL ADD ALSO     (NUC) 01630000
         OI    DDRFLAG,NUCLEUS     TURN ON THE NUCLEUS FLAG       (NUC) 01631000
         B     ENDLIST1                                           (NUC) 01632000
NOTNUC   EQU   *                                                  (NUC) 01633000
         COMP  =C'ALL '       IS INPUT EQ ALL                           01634000
         BNE   EXTENTIN       NO- BRANCH                                01635000
ALL      EQU   *                                               @VA01453 01636000
         BAL   R14,SCANCONT   ANY MORE PARMS?                  @VA01453 01637000
         BC    11,DDR701      YES - ERROR 701 PLEASE           @VA01453 01638000
ALL1     EQU   *                                               @VA07705 01639000
         STH   R0,CYLSTART    NO - POINT AT FIRST CYL          @VA01453 01640000
         STH   R0,CYLREOR     POINT TO REORDER CYL                      01641000
         LH    R14,OUTIOB+(IOBCYLP-IOB) PREPARE TO USE IOBCYLP @V56BDA8 01642000
*                                       OF OUTPUT DEVICE AS STOP LIMIT  01643000
         TM    OUTIOB+(IOBCLASS-IOB),CLASDASD PROVIDED OUTPUT  @V56BDA8 01644000
*                                             IS DASD.                  01645000
         BO    ALLSTOP        OKAY, OUTPUT IS DASD.            @V56BDA8 01646000
         LH    R14,INIOB+(IOBCYLP-IOB) OUTPUT NOT DASD.  GET   @V56BDA8 01647000
*                                      IOBCYLP OF INPUT DEVICE INSTEAD. 01648000
ALLSTOP  STH   R14,CYLSTOP    USE IT AS STOP CYL FOR 'ALL' XTNT@V56BDA8 01649000
         OI    DDRFLAG,RESTALL     TURN ON THE RESTORE ALL FLAG         01650000
ENDLIST1 TM    DDRFLAG,CARDIN      IS THE INPUT FROM CARD               01651000
         BZ    SETUPADD            NO- BRANCH                           01652000
ENDLIST  BAL   R14,READCONT   GO GET NEXT CARD                          01653000
         BAL   R14,SCANCONT   GET FIRST PARM                            01654000
         BNE   TESTCON        BRANCH IF NO INPUT                        01655000
         COMP  CINPUT         IS IT AN INPUT CARD                       01656000
         BE    SAVEPT         YES- BRANCH                               01657000
         COMP  COUTPUT        IS IT AN OUTPUT CARD                      01658000
         BNE   DDR702         CARDS OUT OF SEQUENCE                     01659000
SAVEPT   STM   R1,R2,NEXTFILD                                           01660000
         B     SETUPADD       GO SET UP DASD IO ADDRESS                 01661000
CPVOL    TM    INIOB+(IOBCLASS-IOB),CLASTAPE   IS INPUT A TAPE          01662000
         BO    ALL            DEFAULT TO ALL IF INPUT IS A TAPE         01663000
         TM    INIOB+(IOBSTAT-IOB),IOBCPVOL  IS THE INPUT UNIT A CPVOL  01664000
         BNO   DDR700         NO- GO TO ERROR ROUTINE                   01665000
         LA    R15,INIOB      POINT TO THE IOB                          01666000
         LA    R1,ALLOCCW     POINT TO THE CCW                          01667000
         BAL   R14,STARTIO    GO READ ALLOCATION TABLE                  01668000
         SR    R1,R1          POINT TO THE FIRST BYTE                   01669000
         L     R2,ALLOBUFA    POINT TO THE ALLOCATION RECORD            01670000
SAVEST   STH   R1,CYLSTART    POINT TO THE START CYL                    01671000
         STH   R1,CYLREOR     POINT TO REORDER CYL                      01672000
POINT1   LA    R2,1(,R2)      POINT TO THE NEXT BYTE IN THE ALLO REC    01673000
         CLI   0(R2),X'0C'    IS IT A DIRECTORY ENTRY                   01674000
         BE    ADD1           YES- BRANCH                               01675000
         CLI   0(R2),X'01'    IS IT A PERMANENT                         01676000
         BE    ADD1           YES- BRANCH                               01677000
         CLI   0(R2),X'FF'    END OF LIST?                              01678000
         BE    ENDSCAN                                                  01679000
         STH   R1,CYLSTOP     POINT TO THE STOP CYL                     01680000
         CH    R1,OUTIOB+(IOBCYLP-IOB) VERIFY THAT STOP CYL    @V56BDA8 01681000
*                                      WILL NOT GET PUT INTO AN ALT     01682000
*                                      TRK CYL.  (THIS WAS ALLOWED      01683000
*                                      PRIOR TO REL 5.6, BUT NO         01684000
*                                      LONGER.)  IF OUTPUT IS TAPE THIS 01685000
*                                      TEST IS A NO-OP BECAUSE IOBCYLP  01686000
*                                      WILL CONTAIN THE NAMECYLA VALUE, 01687000
*                                      NOT THE NAMECYLP VALUE.          01688000
         LA    R14,GTCARD     ERROR RETURN ADDR.               @V56BDA8 01689000
         BH    DDR726         ERROR, OLD DISK HAD DATA ON      @V56BDA8 01690000
*                             ALTERNATE CYLINDER(S).                    01691000
         LA    R1,1(,R1)      POINT TO THE NEXT CYLINDER                01692000
         CL    R7,ENDEXT      IS THIS END OF THE EXTENT TABLE  @V200731 01693000
         BH    DDR712         YES, GO TO ERROR MESSAGE         @V200731 01694000
         AR    R7,R8          NO - POINT TO NEXT EXTRY         @V200731 01695000
POINT2   LA    R1,1(,R1)      POINT TO THE NEXT CYLINDER                01696000
         LA    R2,1(,R2)      POINT TO THE NEXT BYTE IN THE ALLO REC    01697000
         CLI   0(R2),X'0C'    IS IT A DIRECTORY ENTRY                   01698000
         BE    SAVEST         YES- BRANCH                               01699000
         CLI   0(R2),X'01'    IS IT PERMENENT                           01700000
         BE    SAVEST         YES- BRANCH                               01701000
         CLI   0(R2),X'FF'    END OF THE LIST ?                         01702000
         BNE   POINT2                                                   01703000
         SR    R7,R8          SUBTRACT ONE FROM THE CYL EXTENT TABLE    01704000
         B     ENDLIST1                                                 01705000
ADD1     LA    R1,1(,R1)      POINT TO THE NEXT CYLINDER                01706000
         B     POINT1                                                   01707000
ENDSCAN  STH   R1,CYLSTOP     SAVE STOP CYLINDER                        01708000
         CH    R1,OUTIOB+(IOBCYLP-IOB) VERIFY THAT STOP CYL    @V56BDA8 01709000
*                                      WILL NOT GET PUT INTO AN ALT     01710000
*                                      TRK CYL.  (THIS WAS ALLOWED      01711000
*                                      PRIOR TO REL 5.6, BUT NO         01712000
*                                      LONGER.)  IF OUTPUT IS TAPE THIS 01713000
*                                      TEST IS A NO-OP BECAUSE IOBCYLP  01714000
*                                      WILL CONTAIN THE NAMECYLA VALUE, 01715000
*                                      NOT THE NAMECYLP VALUE.          01716000
         LA    R14,GTCARD     ERROR RETURN ADDR.               @V56BDA8 01717000
         BH    DDR726         ERROR, OLD DISK HAD DATA ON      @V56BDA8 01718000
*                             ALTERNATE CYLINDER(S).                    01719000
         B     ENDLIST1                                                 01720000
EXTENTIN CL    R2,=F'3'       IS IT OVER 3                              01721000
         BH    DDR701         YES- ERROR                                01722000
         BAL   R14,BINCONV                                              01723000
         BAL   R14,VALEXT     VALIDATE CYLINDER NUMBER.        @V2A2063 01724000
         STH   R2,CYLSTART    SAVE THE START CYL NO                     01725000
GETSTOP  BAL   R14,SCANCONT                                             01726000
         BNE   DEFAULT3       IF NO INPUT DEFAULT TO START              01727000
         COMP  TO             IS THE INPUT EQ TO                        01728000
         BE    GETSTOP        YES- BRANCH                               01729000
         CL    R2,=F'3'       IS IT OVER 3                              01730000
         BH    DDR701         YES- ERROR                                01731000
         BAL   R14,BINCONV                                              01732000
         BAL   R14,VALEXT     VALIDATE CYLINDER NUMBER.        @V2A2063 01733000
         STH   R2,CYLSTOP     SAVE THE STOP CYL                         01734000
GETREOR  BAL   R14,SCANCONT                                             01735000
         BNE   DEFAULT4       IF NO REORDER CYL DEFAULT TO START CYL    01736000
         COMP  =C'REORDER '        IS IT REORDER                        01737000
         BE    GETREOR        YES- GET NEXT PARM                        01738000
         COMP  TO             IS IT TO                                  01739000
         BE    GETREOR        YES- GET NEXT PARM                        01740000
         CL    R2,=F'3'       COUNT EQ 3                                01741000
         BH    DDR701         NO ERROR                                  01742000
         BAL   R14,BINCONV                                              01743000
         STH   R2,CYLREOR     SAVE REORDERED CYLINDER                   01744000
*                             NO NEED TO VALIDATE REORDER STARTING      01745000
*                             ADDR NOW; LATER VALIDATION OF REORDER     01746000
*                             STOP ADDR (YES, STOP) WILL BE SUFFICIENT. 01747000
POINT3   DS    0H                                              @V56BDA8 01748000
         LA    R14,NEWEXT     SET UP RETURN ADD FOR ERROR DDR713        01749000
         LH    R1,CYLSTART    PICK UP START CYL                         01750000
         CH    R1,LASTSTOP    WILL START OVERLAP LAST STOP CYL          01751000
         BNH   DDR713         YES- ERROR                                01752000
         LH    R3,CYLSTOP     GET STOP CYLINDER                         01753000
         SR    R3,R1          IS START LESS THAN STOP (COMPUTE LENGTH)  01754000
         BM    DDR713         NO- ERROR                                 01755000
         TM    OUTIOB+(IOBCLASS-IOB),CLASTAPE   IS THE OUTPUT TAPE      01756000
         BZ    CHKSAME        NO, BYPASS NEXT CHECK IF DASD    @VA04585 01757000
         CH    R2,LASTREOR    WILL THIS EXT OVERLAP THE LAST EXT        01758000
         BNH   DDR713              YES- ERROR                           01759000
         B     POINTEND                                        @VA04585 01760000
CHKSAME  EQU   *                                               @VA04585 01761000
         CLC   INIOB+(IOBUADD-IOB)(2),OUTIOB+(IOBUADD-IOB)     @VA04585 01762000
*                             SAME DEVICE FOR OUTPUT AS WELL AS INPUT?  01763000
         BNE   POINTEND       NO, DONT BOTHER CHECKING FOR     @VA04585 01764000
*                             OVERLAPPING EXTENTS WHEN REORDERING       01765000
         CH    R2,CYLSTART    FIRST REORDER CYL LESS THAN      @VA04585 01766000
*                             STARTING CYL?                             01767000
         BL    NEXTCHK        YES, NOW CHECK FURTHER           @VA04585 01768000
         CH    R2,CYLSTOP     FIRST REORDER CYL GREATER THAN   @VA04585 01769000
*                             STOP CYL?                                 01770000
         BH    POINTEND       YES, EVERYTHING O.K.             @VA04585 01771000
         B     DDR713         NO, CANT BE DONE                 @VA04585 01772000
NEXTCHK  AR    R3,R2          GET LAST REORDER CYL             @VA04585 01773000
         CLR   R1,R3          LAST REORDER CYL LESS THAN       @VA04585 01774000
*                             STARTING CYL                              01775000
         BH    LARGECHK       YES, EVERYTHING O.K.             @VA04585 01776000
         B     DDR713         NO, CANT BE DONE                 @VA04585 01777000
POINTEND AR    R3,R2     ADD THE LENGHT OF THE EXTENT TO REOR           01778000
LARGECHK DS    0H                                              @V56BDA8 01779000
         LR    R2,R3          REORDER-STOP-CYL, INPUT TO VALEXT@V56BDA8 01780000
         BAL   R14,VALEXT     CHECK FOR STOP CYL BEYOND END OF @V56BDA8 01781000
*                             DISK.                                     01782000
         CH    R3,OUTIOB+(IOBCYLP-IOB) STOP CYL IN ALT TRK CYL?@V56BDA8 01783000
         LA    R14,NEWEXT     SET ERROR MSG RETURN ADDR.       @V56BDA8 01784000
         BH    DDR726         USER TRIED TO REORDER TO ALT CYL.@V56BDA8 01785000
         STH   R3,LASTREOR    SAVE THE REORDER EXTENT                   01786000
         MVC   LASTSTOP,CYLSTOP    SAVE LAST STOP ADD                   01787000
         CL    R7,ENDEXT      AT THE END OF THE TABLE          @V200731 01788000
         BH    DDR712         YES - TELL USER ABOUT THE PROB   @V200731 01789000
         AR    R7,R8          NO - POINT TO THE NEXT ENTRY     @V200731 01790000
NEWEXT   BAL   R14,MSG003B    PRINT THE MSG AND READ THE NEXT CARD      01791000
GETSTART BAL   R14,SCANCONT   GET START CYL                             01792000
         BNE   TESTCON1       GET OUT IF NO INPUT                       01793000
         COMP  SAVENAME       IS INPUT THE SAME AS THE CALLING ROUTINE  01794000
         BE    GETSTART       YES- GET START CYL                        01795000
         COMP  CINPUT         IS IT INPUT                               01796000
         BE    SAVEPTR        YES- BRANCH                               01797000
         COMP  COUTPUT        IS IT OUTPUT                              01798000
         BNE   EXTENTIN       NO- BRANCH                                01799000
SAVEPTR  SR    R7,R8          BACK UP TO THE LAST EXTENT                01800000
         STM   R1,R2,NEXTFILD SAVE POINTERS TO THE NEXT FIELD           01801000
         B     SETUPADD                                                 01802000
DEFAULT3 MVC   CYLSTOP,CYLSTART    DEFAULT TO START ADD                 01803000
DEFAULT4 MVC   CYLREOR,CYLSTART    DEFAULT TO START ADDRESS             01804000
         LH    R2,CYLREOR     SET UP TO CHECK EXTENT                    01805000
         B     POINT3         GET NEXT INPUT LINE                       01806000
TESTCON1 SR    R7,R8          POINT TO LAST EXTENT  ENTRY               01807000
TESTCON  TM    DDRFLAG,CARDIN IS IT CARD INPUT                          01808000
         BZ    SETUPADD       NO- BRANCH                                01809000
         TM    DDRFLAG,CARDEOF     END OF FILE ?                        01810000
         BZ    NEWEXT         NO- SKIP THE BLANK CARD                   01811000
SETUPADD EQU   *                                               @V2A2063 01812000
         C     R7,=A(EXTABLE) AT LEAST ONE VALID EXTENT??      @V2A2063 01813000
         BL    GTCARD         NO - LET HIM TRY NEW OPERATION   @V2A2063 01814000
         ST    R7,LASTEXT     YES - SET END OF TBL ADDR        @V2A2063 01815000
         LA    R7,EXTABLE     POINT TO EXTENT TABLE                     01816000
         ST    R7,CUREXT      POINT TO FIRST EXT                        01817000
         XC    INADD(8),INADD    *    ZERO OUT DASD ADD                 01818000
         XC    OUTADD(8),OUTADD  *                                      01819000
         MVC   INADD+2(2),CYLSTART SET UP INPUT DASD ADDRESS            01820000
         MVC   OUTADD+2(2),CYLREOR SET UP OUTPUT DASD ADDRESS           01821000
         B     OPENOUT        GO OPEN THE OUTPUT UNIT          @V2A2063 01822000
         SPACE 2                                                        01823000
VALEXT   EQU   *                                               @V2A2063 01824000
         LA    R15,INIOB                                       @V56BDA8 01825000
         CH    R2,IOBCYLA     IS CYLINDER LEGAL?               @V56BDA8 01826000
         BCR   12,R14         EQUAL OR LOW IS OK               @V2A2063 01827000
         LA    R14,NEWEXT     CYL INVALID - SET RETURN ADDR    @V2A2063 01828000
         B     DDR713         GIVE HIM INVALID EXTENT MSG      @V2A2063 01829000
         EJECT                                                          01830000
*****************************************************************       01831000
*.                                                                      01832000
*  11.   SUBROUTINE TO OPEN OUTPUT UNITS                                01833000
*                                                                       01834000
*              1. IF THE ERROR AND CARDIN FLAGS ARE ON GO TO ROUTINE 1  01835000
*                 STEP 5 TO GET THE NEXT CARD.                          01836000
*                                                                       01837000
*              2. IF OUTPUT UNIT IS DASD LINK TO ROUTINE 21 TO OPEN     01838000
*                 THE DASD UNIT, THEN GO TO STEP 4.                     01839000
*                                                                       01840000
*              2A. IF A NUCLEUS FUNCTION CHECK FOR A VALID        (NUC) 01841000
*                 VOLUME AND WRITE THE DMKCKP RECORD. THEN GO TO  (NUC) 01842000
*                 STEP 4.                                         (NUC) 01843000
*                                                                 (NUC) 01844000
*              3. SKIP THE PROPER NUMBER OF FILES ON THE TAPE AND       01845000
*                 WRITE THE VOLUME HEADER RECORD IN THE PROPER MODE.    01846000
*                                                                       01847000
*              3A. IF A NUCLEUS FUNCTION WRITE OUT THE DMKCKP     (NUC) 01848000
*                 RECORD.                                         (NUC) 01849000
*                                                                 (NUC) 01850000
*              4. IF THE INPUT UNIT IS DASD GO TO THE NEXT ROUTINE.     01851000
*                                                                       01852000
*              5. IF THE  FIRST CYLINDER ON TAPE IS GREATER THEN THE    01853000
*                 THE START CYL THEN GO TO ROUTINE 20 STEP 1,           01854000
*                 ELSE GO TO THE NEXT ROUTINE.                          01855000
*.                                                                      01856000
*****************************************************************       01857000
OPENOUT  TM    DDRFLAG,ERROR+CARDIN  WAS THERE AN ERROR                 01858000
         BO    GTCARD         YES- SKIP THE OPEN AND GO READ THE CARD   01859000
         LA    R15,OUTIOB     POINT TO THE OUTPUT IOB                   01860000
         TM    IOBCLASS,CLASTAPE   IS THE OUTPUT A TAPE                 01861000
         BZ    GETVSER        NO- BRANCH                                01862000
         LH    R2,IOBSKIP     GET THE SKIP COUNT                        01863000
         LTR   R2,R2          DO I HAVE FILES TO SKIP                   01864000
         BZ    NOFSF2         NO- BRANCH                                01865000
NEXTFSF2 LA    R1,FSFCCW      POINT TO THE FSF CCW                      01866000
         BAL   R14,STARTIO    SPACE 1 FILE                              01867000
         BCT   R2,NEXTFSF2    DO IT FOR EACH FILE                       01868000
         STH   R2,IOBSKIP     SAVE THE SKIP COUNT (0)                   01869000
NOFSF2   MVC   VHRCYLNO,OUTADD     SET UP OUTPUT CYLINDER ID            01870000
         LA    R1,WRITEVHR    POINT TO THE WRITE CCW                    01871000
         MVC   WRITEVHR(1),IOBMODE SET UP THE MODE                      01872000
         BAL   R14,STARTIO                                              01873000
         TM    DDRFLAG,NUCLEUS     NUCLEUS FLAG ON                (NUC) 01874000
         BNO   TESTAPE        NO- BRANCH                          (NUC) 01875000
         LA    R1,WCKPTAPE    SET UP TO WRITE THE DMKCKP MODULE   (NUC) 01876000
         BAL   R14,STARTIO    AND WRITE IT TO TAPE                (NUC) 01877000
TESTAPE  TM    INIOB+(IOBCLASS-IOB),CLASTAPE IS THE INPUT A TAPE        01878000
         BZ    PRINTH         NO- BRANCH                                01879000
TSTEXT   EQU   *                                               @V2A2063 01880000
         CLC   EXTABLE(2),VHRCYLNO+2  IS THE INPUT CYLINDER GREATER    X01881000
                              THAN THE FIRST EXTENT START CYLINDER?     01882000
         BNL   PRINTH         NO- BRANCH                                01883000
         TM    DDRFLAG,RESTALL     IS THIS A RESTORE ALL FUNCTION       01884000
         BO    PRINTH              YES- BRANCH                          01885000
         LA    R15,INIOB      POINT TO THE IOB                          01886000
         B     ERRCLOSE       YES- ERROR (NOT THE FIRST TAPE )          01887000
GETVSER  BAL   R14,OPENDASD   OPEN THE DASD UNIT                        01888000
         TM    DDRFLAG,NUCLEUS     NUCLEUS FLAG ON                (NUC) 01889000
         BZ    CHKOPNSZ       NO - CHK DASD SIZES              @V2A2063 01890000
         TM    IOBSTAT,IOBCPVOL    OUTPUT A CPVOL                 (NUC) 01891000
         BNO   DDR722         NO- ERROR                           (NUC) 01892000
         CLC   INIOB+(IOBVSER-IOB)(6),OUTIOB+(IOBVSER-IOB)        (NUC)*01893000
                              INPUT AND OUTPUT VOLID THE SAME     (NUC) 01894000
         BNE   DDR722         NO- ERROR                           (NUC) 01895000
         LA    R1,ALLOCCW     SET UP TO READ IN THE ALLO REC      (NUC) 01896000
         BAL   R14,STARTIO    READ IT IN                          (NUC) 01897000
         L     R1,ALLOBUFA    POINT TO THE ALLOCATION BUFFER      (NUC) 01898000
         LH    R2,CYLSTART    GET STARTING ADD OF NUC             (NUC) 01899000
         LA    R2,0(R1,R2)    AND POINT TO THE BYTE MAP           (NUC) 01900000
         LH    R3,CYLSTOP     GET THE END ADD OF THE NUCLEUS      (NUC) 01901000
         LA    R3,0(R3,R1)    AND POINT TO THE BYTE MAP           (NUC) 01902000
TESTPERM CLI   0(R3),X'01'    IS THE ALLO BYTE FOR PERM SPACE     (NUC) 01903000
         BNE   DDR722         NO- ERROR                           (NUC) 01904000
         CLR   R3,R2          FIRST NUCLEUS CYLINDER              (NUC) 01905000
         BL    DDR722         LOW- ERROR (DMKCPK MODULE BAD)      (NUC) 01906000
         BE    WRITENUC       EQU- ALL OK                         (NUC) 01907000
         BCT   R3,TESTPERM    HIGH- GO TEST THE NEXT CYL          (NUC) 01908000
WRITENUC LA    R1,WCKPDASD    SET UP TO WRITE THE DMKCKP MODULE   (NUC) 01909000
         BAL   R14,STARTIO    WRITE IT OUT                        (NUC) 01910000
         B     PRINTH                                             (NUC) 01911000
         SPACE                                                          01912000
CHKOPNSZ EQU   *                                               @V2A2063 01913000
         CLC   SAVENAME,CRESTORE RESTORE OPERATION?            @V2A2063 01914000
         BNE   PRINTH         NO - NO CHK NEEDED HERE.         @V56BDA8 01915000
         CLC   INIOB+(IOBCYLA-IOB)(L2),OUTIOB+(IOBCYLA-IOB)    @V56BDA8 01916000
*                             CHECK THAT DUMPED DISK ALREADY ON TAPE IS 01917000
*                             NO LARGER THAN DISK TO BE RESTORED TO.    01918000
         BNH   TSTEXT         LOW OR EQUAL - OK                @V2A2063 01919000
         BAL   R14,DDR725     A>B - WARN HIM ABOUT IT          @V2A2063 01920000
OPNOUTR  EQU   *                                               @V2A2063 01921000
         BAL   R14,RESPONS2   SEE WHAT TO DO                   @V2A2063 01922000
         CLC   =C'YES ',RESPDATA CONTINUE?                     @V2A2063 01923000
         BE    TSTEXT         OK                               @V2A2063 01924000
         CLC   =C'NO ',RESPDATA QUIT?                          @V2A2063 01925000
         BE    GTCARD         OK - TRY A NEW OPER.             @V2A2063 01926000
         B     OPNOUTR        YES OR NO FELLA...               @V2A2063 01927000
         EJECT                                                          01928000
******************************************************************      01929000
*.                                                                      01930000
*  12.   ROUTINE TO PRINT THE CYLINDER MAP                              01931000
*                                                                       01932000
*        A  PRINTH                                                      01933000
*                                                                       01934000
*              1. COMPUTE THE TIME AND DATE FROM THE TOD CLOCK VALUE    01935000
*                 IN THE VOLUME HEADER RECORD.                          01936000
*                                                                       01937000
*              2. BUILD THE HEADER RECORD AND ITS CCW STRING FOR THE    01938000
*                 CYLINDER MAP.                                         01939000
*                                                                       01940000
*              3. PRINT THE HEADER ON THE SYSPRINT DEVICE, AND GO       01941000
*                 MSG004 TO START THE JOB, RETURN AT STEP 7.            01942000
*                                                                       01943000
*        B  PRINTEXT                                                    01944000
*                                                                       01945000
*              4. CONVERT THE INPUT AND OUTPUT CYLINDER EXTENR DATA.    01946000
*                                                                       01947000
*              5. PRINT THE EXTENT DATA ON THE SYSPRINT DEVICE.         01948000
*                                                                       01949000
*              6. RETURN  TO CALLER.                                    01950000
*                                                                       01951000
*        C  TESTIN                                                      01952000
*                                                                       01953000
*              7. IF THE INPUT IS FROM TAPE GO TO THE NEXT ROUTINE,     01954000
*                 ELSE GO TO ROUTINE 14.                                01955000
*.                                                                      01956000
******************************************************************      01957000
PRINTH   LM    R0,R1,VHRCLOCK GET TOD CLOCK VALUE                       01958000
         SRDL  R0,12          CONVERT TO MICROSECONDS                   01959000
         D     R0,=F'8000000' GET NUMBER OF SECONDS BY THE FOLLOWING    01960000
         LR    R3,R0          DOUBLE PRECISION DIVISION:                01961000
         SLR   R2,R2          X/Y=8*(X/(8*Y))+MOD(X,8*Y)/Y              01962000
         D     R2,=F'1000000' WHERE X = NUMBER OF MICROSECONDS SINCE    01963000
         SLR   R0,R0                    EPOCH                           01964000
         SLDL  R0,3                 Y = 1000000                         01965000
         ALR   R1,R3          ...                                       01966000
         BC    12,*+8         ...                                       01967000
         A     R0,=F'1'                                                 01968000
         D     R0,=F'86400'   R1 = NUMBER OF DAYS SINCE EPOCH          *01969000
                              R0 = NUMBER OF SECONDS PAST MIDNIGHT      01970000
*.                                                                      01971000
* NOTE:  CHANGE THE NEXT TWO STATEMENTS FOR LOCAL TIME                  01972000
*                                                                       01973000
         MVC   ZONE(3),=C'GMT'     SET UP THE ZONE ID                   01974000
         S     R0,=F'0'       ADD OR SUB THE TIME ZONE DIFERENTIAL      01975000
*     TO GET THE LOCAL TIME CHANGE THE LITERALS IN THE ABOVE STATEMENTS 01976000
* EXAMPLE: EAST COAST USA STANDARD TIME USE -5 HOURS                    01977000
*        S     R0,=F'18000'   WILL GIVE THE TIME IN EST                 01978000
*                             18000 IS THE NUMBER OF SEC FROM GMT       01979000
* EXAMPLE: GERMANY STANDARD TIME USE +1 HOUR                            01980000
*        A     R0,=F'3600'    WILL GIVE THE TIME IN GERMANY             01981000
*                             3600 = 1 HOUR IN SEC FROM GMT             01982000
*.                                                                      01983000
         BNM   *+10           BRANCH IF RESULT .GE. ZERO                01984000
         A     R0,=F'86400'   ADD A DAYS WORTH OF SECONDS               01985000
         BCTR  R1,0           AND SUBTRACT A DAY                        01986000
         C     R0,=F'86400'   SEC .LT. 1 DAY ?                          01987000
         BL    *+12           YES                                       01988000
         S     R0,=F'86400'   SUBTRACT A DAYS WORTH OF SECONDS          01989000
         A     R1,=F'1'       AND ADD A DAY                             01990000
         LR    R5,R0                                                    01991000
         M     R4,=F'1000000' MULTIPLY CORRECTED SECONDS BY 1000000     01992000
         ALR   R5,R2          ADD REMAINDER FROM FIRST DIVISION         01993000
         BC    12,*+8         ...                                       01994000
         A     R4,=F'1'       ...                                       01995000
         SLDL  R4,12                                                    01996000
         LM    R14,R15,VHRCLOCK    GET INITIAL TOD CLOCK VALUE          01997000
         SLR   R15,R5         - NUMBER OF SECONDS INTO THE DAY          01998000
         BC    11,*+8         ...                                       01999000
         SL    R14,=F'1'      ...                                       02000000
         SLR   R14,R4         ...                                       02001000
         STM   R14,R15,TODATE RESULT IS TOD CLOCK VALUE AT MIDNIGHT    *02002000
                              TODAY LOCAL TIME                          02003000
         SPACE                                                          02004000
         LA    R3,365                                                   02005000
         CR    R1,R3          IS DAYS .LT. 365 ?                        02006000
         BNL   NOT1900        NO                                        02007000
         LR    R6,R1          GET NUMBER OF DAYS HERE                   02008000
         SLR   R1,R1          INDICATE YEAR = 00                        02009000
         B     YEARSET                                                  02010000
         SPACE                                                          02011000
NOT1900  EQU   *  HERE IF YEAR IS GREATER THAN 1900                     02012000
         SR    R1,R3          SUBTRACT THE YEAR 1900 OUT                02013000
         SLR   R0,R0          CLEAR FOR DIVIDE                          02014000
         D     R0,=A(4*365+1) DIVIDE BY THE NUMBER OF DAYS IN 4 YEARS   02015000
         LR    R7,R0          R7 = NUMBER OF DAYS SINCE LAST LEAP       02016000
         SLR   R6,R6                                                    02017000
         DR    R6,R3                                                    02018000
         A     R6,=F'1'       R6 = NUMBER OF DAYS SINCE START OF YEAR   02019000
         C     R7,=F'3'       TAKE MIN(TRUNC(NUMBER OF DAYS SINCE LAST  02020000
         BNH   *+8            LEAP/365),3)                              02021000
         L     R7,=F'3'       ...                                       02022000
         ALR   R1,R1                                                    02023000
         ALR   R1,R1                                                    02024000
         A     R1,=F'1'                                                 02025000
         AR    R1,R7                                                    02026000
         SPACE                                                          02027000
YEARSET  EQU   *  HERE WHEN YEAR HAS BEEN DETERMINED                    02028000
         CVD   R1,WORK1    CONVERT DATE TO DECIMAL                      02029000
         UNPK  DATE+6(2),WORK1+6(2)  UNPACK AND                         02030000
         OI    DATE+7,X'F0'   FORMAT IT                                 02031000
         SPACE 1                                                        02032000
*              HERE TO CONVERT JULIAN DATE TO GREGORIAN                 02033000
         SLR   R2,R2          CLEAR                                     02034000
         N     R1,=F'3'       YEAR MOD 4                                02035000
         BNZ   *+8            BRANCH IF NOT A LEAP YEAR                 02036000
         LA    R2,1           GET GREGORIAN DATE FROM JULIAN            02037000
         LA    R1,59(,R2)     BY THIS OBSCURE SERIES OF                 02038000
         CR    R6,R1          WELL RESEARCHED INSTRUCTIONS              02039000
         BNH   *+10           ...                                       02040000
         A     R6,=F'2'       ...                                       02041000
         SR    R6,R2          ...                                       02042000
         A     R6,=F'91'      ...                                       02043000
         LR    R5,R6          ...                              @V200731 02044000
         M     R4,=F'100'     ...                              @V200731 02045000
         D     R4,=F'3055'    ...                              @V200731 02046000
         LR    R15,R5         ...                              @V200731 02047000
         M     R14,=F'3055'   ...                              @V200731 02048000
         D     R14,=F'100'    ...                              @V200731 02049000
         SR    R6,R15         ...                              @V200731 02050000
         BCTR  R5,R0          ...                              @V200731 02051000
         BCTR  R5,R0          ...                              @V200731 02052000
         CVD   R6,WORK1    CONVERT DAY TO DECIMAL                       02053000
         UNPK  DATE+3(2),WORK1+6(2)  UNPACK AND                         02054000
         OI    DATE+4,X'F0'   FORMAT IT                                 02055000
         MVI   DATE+5,C'/'                                              02056000
         CVD   R5,WORK1       CONVERT MONTH TO DECIMAL         @V200731 02057000
         UNPK  DATE(2),WORK1+6(2)    UNPACK AND                         02058000
         OI    DATE+1,X'F0'   FORMAT IT                                 02059000
         MVI   DATE+2,C'/'                                              02060000
         SPACE 1                                                        02061000
*              SET UP TIME                                              02062000
         LA    R2,TIME        POINT TO THE TIME IN MSG                  02063000
         LM    R0,R1,VHRCLOCK GET TOD CLOCK VALUE IN R0 AND R1          02064000
         SL    R1,TODATE+4    SUBTRACT CORRECT TIME AT MIDNIGHT         02065000
         BC    11,*+8         ...                                       02066000
         SL    R0,=F'1'       ...                                       02067000
         SL    R0,TODATE      ...                                       02068000
         SRDL  R0,12          GET NUMBER OF MICROSECONDS PAST MIDNIGHT  02069000
         D     R0,=F'1000000' GET NUMBER OF SECONDS PAST MIDNIGHT       02070000
         SR    R0,R0          IGNORE REMAINDER                          02071000
         D     R0,=F'3600'    GET NUMBER OF HOURS PAST MIDNIGHT         02072000
         CVD   R1,WORK1    CONVERT NUMBER OF HOURS TO DECIMAL           02073000
         UNPK  0(4,R2),WORK1+6(3)    UNPACK                             02074000
         MVI   2(R2),C'.'     NEATEN UP                        @VA10358 02075100
         LR    R1,R0          GET REMAINDER FROM LAST DEVIDE            02076000
         SR    R0,R0          CLEAR                                     02077000
         D     R0,=F'60'         GET NUMBER OF MINUTES PAST THIS HOUR   02078000
         CVD   R1,WORK1    CONVERT NUMBER OF MINUTES TO DECIMAL         02079000
         UNPK  3(4,R2),WORK1+6(3)    UNPACK                             02080000
         MVI   5(R2),C'.'     NEATEN UP                        @VA10358 02081100
         CVD   R0,WORK1    CONVERT NUMBER OF SECONDS TO DECIMAL         02082000
         UNPK  6(2,R2),WORK1+6(2)    UNPACK                             02083000
         OI    7(R2),X'F0'    MAKE UP FOR HARDWARE DEFICIENCIES         02084000
         BAL   R14,MSG004     PRINT THE STARTING MSG           HRC012DK 02084500
         SPACE                                                          02085000
*              MOVE MSG INTO THE BUFFER AND FILL IT IN                  02086000
         LA    R15,PRINTIOB   POINT TO THE IOB                          02087000
         LA    R1,HEADCCW     POINT TO THE CCW                          02088000
         LA    R0,CONCCW1     POINT TO THE CCW                 HRC012DK 02088500
         MVI   SYSPTRBF,C' '            *    BLANK OUT THE BUFFER       02089000
         MVC   SYSPTRBF+1(71),SYSPTRBF  *                               02090000
         MVC   SYSPTRBF(L'HEADER),HEADER     MOVE IN THE HEADER         02091000
         MVC   SYSPTRBF+(L'HEADER+1)(6),VHRVSER   MOVE IN VOL ID        02092000
         TM    INIOB+(IOBCLASS-IOB),CLASTAPE IS THE INPUT A TAPE        02093000
         BZ    TESTOUT1                           NO- BRANCH            02094000
         MVC   SYSPTRBF(12),DATA   SET UP 'DATA DUMPED '                02095000
         B     TESTDASD                 GO PRINT IT                     02096000
TESTOUT1 TM    OUTIOB+(IOBCLASS-IOB),CLASTAPE     IS THE OUTPUT A TAPE  02097000
         BZ    TESTDASD                           NO- BRANCH            02098000
         MVC   SYSPTRBF(4),CDUMP     SET UP 'DUMPING DATA '             02099000
TESTDASD TM    OUTIOB+(IOBCLASS-IOB),CLASDASD IS IT DASD                02100000
         BZ    PRINTIT                            NO- BRANCH            02101000
         MVC   SYSPTRBF+(L'HEADER+8)(2),TO        * SET UP OUTPUT       02102000
         MVC   SYSPTRBF+(L'HEADER+11)(6),OUTIOB+(IOBVSER-IOB)          X02103000
                                                  * VOL SER NO          02104000
         TM    OUTIOB+(IOBSTAT-IOB),IOBSCRAT IS THE OUTPUT SCRATCH      02105000
         BNO   *+10                          NO- BRANCH                 02106000
         MVC   SYSPTRBF+(L'HEADER+11)(7),=C'SCRATCH'   YES- MOVE IT IN  02107000
         CLI   SAVENAME,C'R'  IS THIS A RESTORE                         02108000
         BNE   PRINTIT        NO- BRANCH                                02109000
         MVC   SYSPTRBF+(L'HEADER+8)(11),RESTORED SET UP RESTORED TO    02110000
         MVC   SYSPTRBF+(L'HEADER+20)(6),OUTIOB+(IOBVSER-IOB)          X02111000
                              SET UP VSN                                02112000
         TM    OUTIOB+(IOBSTAT-IOB),IOBSCRAT IS THE OUTPUT SCRATCH      02113000
         BNO   *+10                          NO- BRANCH                 02114000
         MVC   SYSPTRBF+(L'HEADER+20)(7),=C'SCRATCH'   YES- MOVE IT IN  02115000
         SPACE                                                          02116000
*              PRINT THE HEADER MSG                                     02117000
PRINTIT  BAL   R14,CMSA       GO TEST FOR BARE MAC             HRC012DK 02118490
         MVI   SYSPTRBF,C' '            *    BLANK OUT THE BUFFER       02119000
         MVC   SYSPTRBF+1(71),SYSPTRBF  *                               02120000
         B     TESTIN                                          HRC012DK 02121490
         SPACE 3                                                        02122000
CMSA     CLC   PRINTIOB+(IOBUADD-IOB)(2),CONIOB+(IOBUADD-IOB)  HRC012DK 02123090
         BNE   CMS2                                            HRC012DK 02123180
         LR    R1,R0                                           HRC012DK 02123270
         LA    R15,CONIOB                                      HRC012DK 02123360
         CLC   MACHINE,BAREMAC                                 HRC012DK 02123450
         BNE   SKIP1                                           HRC012DK 02123540
         B     GRAPHID                                         HRC012DK 02123630
         SPACE 3                                               HRC012DK 02123720
CMS2     CL    R10,BAREMAC    TEST FOR BARE MAC                HRC012DK 02123810
         BE    STARTIO        GO TO STARTIO IF ON THE BARE MACHINE      02124000
SKIP1    EQU   *                                               HRC012DK 02124500
         STM   R1,R4,REGSAVE1 SAVE THE REGS                             02125000
         LR    R4,R1          POINT TO THE CCW                          02126000
NEXT     L     R2,0(R4)       GET THE FIRST HALF OF THE CCW             02127000
         LH    R3,6(R4)       AND THE COUNT ALSO                        02128000
         CLC   PRINTIOB+(IOBUADD-IOB)(2),CONIOB+(IOBUADD-IOB)  HRC012DK 02128100
         BNE   NTCNS01                                         HRC012DK 02128200
         STCM  R2,B'0111',CONFCB+9                             HRC012DK 02128300
         STH   R3,CONFCB+14                                    HRC012DK 02128400
         LA    R1,CONFCB                                       HRC012DK 02128500
         B     ISCNS01                                         HRC012DK 02128600
NTCNS01  EQU   *                                               HRC012DK 02128700
         CL    R3,=F'1'       IS THE COUNT EQ TO 1                      02129000
         BE    STCCWOP        YES GET OUT (CARRIAGE CONTROL)            02130000
         BCTR  R3,0           -1                                        02131000
         EX    R3,MOVEDATA    MOVE THE DATA INTO THE BUFFER             02132000
         LA    R3,2(,R3)      +2                                        02133000
STCCWOP  STCM  R2,8,CCBUFFER  SET UP THE CCW OP CODE IN THE BUFFER      02134000
         STH   R3,PRINTL      SET UP THE COUNT                          02135000
         LA    R1,PRINTFCB    POINT TO THE PLIST                        02136000
ISCNS01  EQU   *                                               HRC012DK 02136500
         SVC   202            CALL CMS                                  02137000
         DC    AL4(ERROR1)      ERROR RETURN                            02138000
NEXTCCW  TM    4(R4),CC       COMMAND CHAINING?                @VA01298 02139000
         LA    R4,8(,R4)      POINT TO THE NEXT CCW                     02140000
         BO    NEXT           YES- GO PRINT IT                          02141000
         LM    R1,R4,REGSAVE1 RETURN REGS                               02142000
         BR    R14            RETURN TO THE CALLER                      02143000
MOVEDATA MVC   SYSPTRBF(0),0(R2)                                        02144000
         SPACE 3                                                        02145000
PRINTEXT STM   R14,R3,REGSAVE3     SAVE THE REGS                        02146000
         LA    R15,PRINTIOB                                             02147000
         LA    R1,PTEXTCCW    *    POINT TO CCW                         02148000
         LR    R0,R1          *    SAVE FOR CONS OUTPUT        HRC012DK 02148500
         OI    INSTART+3,X'F0'     *    SET ZONE TO F                   02149000
         OI    INSTOP+3,X'F0'      *                                    02150000
         OI    OUTSTART+3,X'F0'    *                                    02151000
         OI    OUTSTOP+3,X'F0'     *                                    02152000
         BAL   R14,CMSA       GO TEST FOR CMS                  HRC012DK 02153490
         LM    R14,R3,REGSAVE3     RETURN REGS                          02154000
         BR    R14            RETURN TO CALLER                          02155000
PTRERROR TM    SENSE,INTREQ   IS IT INTERVENTION REQUIRED               02156000
         BO    DDR710         YES- BRANCH                               02157000
         CLC   IOBCCW,=A(INITCCW)  IS IT INITIALIZE PRINTER?   @V60B9BA 02158000
         BE    SIORET          XFER IF SO, IGNORE ERROR        @V60B9BA 02159000
         TM    IOBSTAT,IOBNOPER    IS THE PRINTER NOT OPERATIONAL       02160000
         BO    DDR704         YES- ERROR                                02161000
         TM    SENSE,X'BE'    IS IT COM REJ, BUS OUT CHECK, EQU CHECK, *02162000
                              DATA CHECK, UCS PARITY OR UNUSUAL COMMAND 02163000
         BNZ   DDR705         YES- BRANCH                               02164000
         TM    IOBCSW+4,UE    IS ERROR CH. 12?                 @VA13315 02164200
         BO    PTRESTRT       YES, SEE IF MORE IN THE CHAIN    @VA13315 02164400
         TM    SENSE,CH9      IS ERROR CH. 9?                  @VA13315 02164600
         BO    PTRESTRT       YES, CHECK CHAIN FOR MORE        @VA13315 02164800
         B     IORETURN       RETURN TO THE START IO ROUTINE            02165000
         SPACE 3                                                        02165070
PTRESTRT EQU   *              HERE FOR CH9, CH12 TO DRIVE      @VA13315 02165140
*                             REST OF CCW CHAIN                         02165210
         L     R1,IOBCSW      GET POINTER TO NEXT CCW          @VA13315 02165280
         LTR   R1,R1          IS THERE ONE?                    @VA13315 02165350
         BZ    SIORET         NOPE, ALL DONE                   @VA13315 02165420
         S     R1,=F'8'       BACK UP TO LAST EXECUTED CCW     @VA13315 02165490
         TM    4(R1),CC       COMMAND CHAIN?                   @VA13315 02165560
         BZ    SIORET         NO,CH9 OR CH12 WAS LAST CCW IN   @VA13315 02165630
*                             CHAIN                                     02165700
         LA    R1,8(,R1)      GET NEXT CCW....                 @VA13315 02165770
         B     RESTART        AND 'REDRIVE' IT                 @VA13315 02165840
         SPACE 3                                                        02166000
TESTIN   LA    R15,INIOB      POINT TO INPUT IOB                        02167000
         CLC   INADD+2(4),THRHADD+1     * IF THE INPUT ADDRESS IS       02168000
         BE    REORCYL                  * EQ TO THE THR ADDRESS        *02169000
                                        * THEN SKIP THE READ.           02170000
         TM    IOBCLASS,CLASTAPE   IS THE INPUT A TAPE                  02171000
         BZ    BUILDTHR       NO- BRANCH                                02172000
         SPACE 3                                                        02173000
*******************************************************************     02174000
*.                                                                      02175000
*  13.   SUBROUTINE TO GET TRACK HEADER RECORD                          02176000
*                                                                       02177000
*              1. READ THE TRACK HEADER RECORD FROM THE TRACK.          02178000
*                                                                       02179000
*              2. BUILD A CCW STRING TO READ IN THE DATA RECORDS        02180000
*                 FROM THE TAPE, AND READ THEM IN.                      02181000
*                                                                       02182000
*              3. IF THE THR IS LOW GO TO STEP 1, ELSE GO TO            02183000
*                 ROUTINE 14 STEP 3.                                    02184000
*.                                                                      02185000
*******************************************************************     02186000
GETTHR   LA    R1,RTHRCCW     POINT TO THE CCW                          02187000
         BAL   R14,STARTIO                                              02188000
         CLC   =C'THR ',THR   IS THIS THE TRACK HEADER RECORD           02189000
         BE    GOTTHR         YES- BRANCH                               02190000
         CLC   =C'EOV ',THR   IS IT EOV                                 02191000
         BE    CLOSE1         YES- BRANCH                               02192000
         CLC   =C'EOJ ',THR   IS IT EOJ                                 02193000
         BE    CLOSEJOB       YES- BRANCH                               02194000
         CLC   =CL8'DMKCKP',THR+14 IS THIS A NUCLEUS RECORD       (NUC) 02195000
         BE    DDR724         YES- ERROR                          (NUC) 02196000
         B     DDR714         ERROR MUST BE ONE OF THE ABOVE            02197000
GOTTHR   EQU   *                                                        02198000
         LA    R3,TAPRCCW     POINT TO THE FIRST CCW                    02199000
         LH    R0,THRDRL      GET THE DATA LENGTH OF THE SHORT BLOCK    02200000
         LH    R1,THRNDRT     GET THE NUMBER OF 4K DATA RECORDS         02201000
         S     R1,=F'1'       ARE THERE ANY RECORDS TO READ IN          02202000
         BM    COMPCYL        NO- BRANCH                                02203000
         BP    SET4K          YES GO READ THEM                          02204000
         LTR   R0,R0          DO I HAVE A SHORT BLOCK                   02205000
         BP    SETSHORT       YES- GO GET IT                            02206000
         B     COMPCYL                                                  02207000
CLOSE1   LH    R1,INADD+2     POINT TO THE CYLINDER ADD                 02208000
         LH    R2,INADD+4     POINT TO THE HEAD ADDRESS                 02209000
         BAL   R14,MSG005     AND TYPE THE END OF VOL MSG               02210000
         LA    R15,INIOB      POINT TO THE IOB                          02211000
         BAL   R14,CLOSE      CLOSE TAPE AND GET THE NEXT ONE           02212000
         CLC   VHRCLOCK,THR+(VHRCLOCK-VHR)   IS THE TIME EQ             02213000
         BNE   DDR709         NO- ERROR                                 02214000
         B     GETTHR         GO READ THE TRACK HEADER RECORD           02215000
SET4K    L     R4,=X'40001000'     GET THE SECOND HALF OF THE CCW       02216000
LOOP2    ST    R4,4(,R3)      SET UP THE SECOND HALF OF THE CCW         02217000
         LA    R3,8(,R3)      POINT TO THE NEXT CCW                     02218000
         BCT   R1,LOOP2       LOOP                                      02219000
         LTR   R0,R0          IS THE LAST RECORD ZERO                   02220000
         BZ    NOCHAIN        YES- BRANCH                               02221000
SETSHORT ST    R0,4(,R3)      SET UP LENGTH                             02222000
READTAPE LA    R1,TAPRCCW     POINT TO THE CCW                          02223000
         BAL   R14,STARTIO                                              02224000
COMPCYL  CLC   THRHADD+1(4),INADD+2     IS THIS THE PROPER ADD          02225000
         BH    UPDTEXT        NO- GO TEST FOR RESTORE ALL               02226000
         BL    GETTHR         LOW- READ NEXT RECORD                     02227000
         B     REORCYL        GO REORDER THE CYLINDER ADD               02228000
NOCHAIN  S     R3,=F'8'       BACK UP 8                                 02229000
         MVI   4(R3),X'0'     NO FLAG ON                                02230000
         B     READTAPE                                                 02231000
UPDTEXT  TM    DDRFLAG,RESTALL     IS THIS A RESTORE ALL FUNCTION       02232000
         BZ    DDR714         NO- ERROR                                 02233000
         LH    R1,THRHADD+3   GET THE TRACK NUMBER FROM THE THR         02234000
         LTR   R1,R1          IS IT ZERO                                02235000
         BNZ   DDR714         NO- ERROR                                 02236000
         CH    R1,INADD+4     IS THE INADD ON A CYL BOUNDRY ALSO       X02237000
                                   (TRACK = ZERO)                       02238000
         BNE   DDR714         NO- ERROR                                 02239000
         L     R1,INADD+2               *    IF THIS IS CYLINDER ZERO   02240000
         LTR   R1,R1                    *    THEN SET UP FOR THE NEXT   02241000
         BP    SETEXT                   *    TIME AND RETURN            02242000
         MVC   INADD+2(4),THRHADD+1     *                               02243000
         MVC   OUTADD+2(4),THRHADD+1    *                               02244000
         MVC   EXTABLE(2),INADD+2       *                               02245000
         MVC   EXTABLE+4(2),OUTADD+2    *                               02246000
         B     REORCYL                  *                               02247000
SETEXT   LH    R1,THRHADD+1   PICK UP THE CYLINDER NUMBER OF THE START X02248000
                              OF THE NEXT EXTENT.                       02249000
         LH    R2,INADD+2          *    SUB  1 FROM THE INPUT ADD TO    02250000
         BCTR  R2,0                *    POINT AT THE STOP CYLINDER      02251000
         CVD   R2,WORK1            *                                    02252000
         UNPK  INSTOP(4),WORK1     *                                    02253000
         UNPK  OUTSTOP(4),WORK1    *                                    02254000
         LH    R3,EXTABLE          *    PICK UP THE START OF EXTENT ADD 02255000
         CVD   R3,WORK1            *    AND SAVE IT                     02256000
         UNPK  INSTART(4),WORK1    *                                    02257000
         UNPK  OUTSTART(4),WORK1   *                                    02258000
         STH   R1,EXTABLE          *    POINT TO THE START OF THE NEXT  02259000
         STH   R1,EXTABLE+4        *    EXTENT                          02260000
         STH   R1,INADD+2          *                                    02261000
         STH   R1,OUTADD+2         *                                    02262000
         BAL   R14,PRINTEXT   PRINT OUT THE EXTENT INFORMATION          02263000
         B     REORCYL                                                  02264000
         EJECT                                                          02265000
*******************************************************************     02266000
*.                                                                      02267000
*  14.   SUBROUTINE TO BUILD TRACK HEADER RECORD                        02268000
*                                                                       02269000
*              1. BUILD A CHAIN OF CCWS TO READ THE HOME ADD, REC       02270000
*                 ZERO AND ALL THE COUNT FIELDS INTO THE THR, AND       02271000
*                 READ THEM IN.                                         02272000
*                                                                       02273000
*              2. BUILD A CCW STRING TO READ THE KEY-DATA FIELDS INTO   02274000
*                 THE THR AND DATA RECORDS, AND READ THEM IN.           02275000
*                                                                       02276000
*              3. IF THE OUTPUT IS TO THE PRINTER OR CONSOLE GO TO      02277000
*                 ROUTINE 17.                                           02278000
*                                                                       02279000
*              4. GO TO THE NEXT ROUTINE.                               02280000
*.                                                                      02281000
*********************************************************************** 02282000
BUILDTHR XC    THR+4(76),THR+4     ZERO OUT OLD THR                     02283000
         MVC   THR(4),=C'THR '     SET UP ID                            02284000
         L     R3,CCWWORKA    POINT TO START OF CHAIN                   02285000
         LA    R4,8           SET UP LENGTH OF A CCW                    02286000
         LH    R5,VHRMREC     SET UP THE MAX NUM OF RECORDS             02287000
         TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380         HRC012DK 02288490
         BNZ   LOOPCCW        YES - DON'T MOVE REC 0 CCW       @V2A2063 02289000
         LM    R1,R2,READR0   MOVE READ REC ZERO CCW IN        @VA01049 02290000
         STM   R1,R2,0(R3)    DYNAMIC CCW AREA                 @VA01049 02291000
         LA    R3,8(,R3)      BUMP STARTING POINT BY 8         @VA01049 02292000
LOOPCCW  LM    R1,R2,COUNTCCW RESUME BUILDING COUNT CCWS       @VA01049 02293000
STCCW    STM   R1,R2,0(R3)    STORE THE CCW                             02294000
         LA    R3,8(,R3)      POINT TO THE NEXT  CCW                    02295000
         AR    R1,R4          ADD 8 TO FIRST HALF OF CCW                02296000
         BCT   R5,STCCW       LOOP UNTIL MAX NUM OF CCW'S ARE BUILT     02297000
         MVC   0(8,R3),NOOP   MOVE IN NO OP                             02298000
         LA    R1,READ231X         *    POINT TO THE READ DASD CCW'S    02299000
         TM    IOBTYPE,TYP2311+TYP2314                         @V2A2063 02300000
         BNZ   READCT         *                                @V2A2063 02301000
         LA    R1,READ333X         *                                    02302000
*        DEFAULT TO 3330/3340/3350/3380 DEFAULT TO 33XX DASD   HRC012DK 02303490
READCT   BAL   R14,STARTIO    READ IN COUNTS                            02304000
         LA    R15,INIOB      RESTORE POINTER TO THE INPUT IOB          02305000
         L     R1,KEYCCW      *    GET DUMMEY CCW TO BUILD READ         02306000
         L     R0,KEYCCW+4    *    KEY-DATA CCW'S                       02307000
         L     R3,CCWWORKA    POINT TO START OF CHAIN                   02308000
         TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380         HRC012DK 02309490
         BNZ   BYPASS         YES - BYPASS                     @V2A2063 02310000
         LA    R3,8(,R3)      SKIP OVER READ R0 CCW            @VA01049 02311000
BYPASS   LH    R4,THRNDRD     GET THE NUMBER OF DATD RECORDS   @VA01049 02312000
         LR    R2,R4          WHICH IS ALSO THE NUMBER OF      @V56BDA8 02313000
*                             COUNT FIELDS ALREADY READ.                02314000
         SLL   R2,3           MULTIPLY BY 8                             02315000
         LA    R2,THR001(R2)  COMPUTE THE SIZE OF THE THR               02316000
         OR    R1,R2          START READING DATA AFTER THE LAST KEY     02317000
         LA    R5,THR001      POINT TO THE FIRST COUNT FIELD            02318000
         NI    DDRFLAG,255-FIRSTEOF RESET E-O-F INDICATOR      @VA02229 02319000
         LTR   R4,R4          FOUND DATA RECORDS ON TRACK?     @V56BDA8 02320000
         BZ    FINALCCW       NO. SKIP AHEAD,TACK ON FINAL CCWS@V56BDA8 02321000
BUILDCCW SR    R2,R2          SET UP FOR WORK                           02322000
         IC    R2,5(,R5)      GET THE KEY COUNT                         02323000
         ICM   R0,3,6(R5)    GET THE DATA COUNT                         02324000
         BNZ   NOEOF          BRANCH IF NOT END-OF-FILE                 02325000
         TM    DDRFLAG,FIRSTEOF FIRST E-O-F ENCOUNTERED?       @VA02229 02326000
         BO    TESTKEY        YES, GO SEE IF THERE'S A KEY     @VA02229 02327000
         OI    DDRFLAG,FIRSTEOF NO, SET E-O-F INDICATOR ON     @VA02229 02328000
         MVC   0(8,R3),READEOF     SET UP TO READ EOF NO UNIT EXCEPTION 02329000
         LA    R3,8(,R3)      POINT TO THE NEXT CCW                     02330000
TESTKEY  LTR   R2,R2          DO I HAVE A KEY                  @VA02229 02331000
         BNZ   NOEOF          YES- BRANCH MUST READ IN KEY              02332000
         MVC   0(8,R3),READEOF     SET UP TO READ COUNT OF THE NEXT CCW 02333000
         B     SKIPCCW                                                  02334000
NOEOF    NI    DDRFLAG,225-FIRSTEOF RESET E-O-F INDICATOR      @VA02229 02335000
         ALR   R2,R0          SET UP CCW COUNT                 @VA02229 02336000
         STM   R1,R2,0(R3)    STORE CCW                                 02337000
         LA    R2,0(,R2)      ZERO OUT HIGH ORDER BYTE                  02338000
         ALR   R1,R2          POINT TO THE NEXT DATA BUFFER             02339000
SKIPCCW  LA    R3,8(,R3)      POINT TO THE NEXT CCW                     02340000
         LA    R5,8(,R5)      POINT TO THE NEXT COUNT                   02341000
         BCT   R4,BUILDCCW    LOOP UNTILL ALL CCW'S ARE BUILT           02342000
FINALCCW MVC   0(L8,R3),NOOP  MOVE IN NO-OP.                   @V56BDA8 02343000
         TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380 ?       HRC012DK 02344490
         BZ    *+10                NO- BRANCH                           02345000
         MVC   0(16,R3),RR0CCW     MOVE IN SET SECTOR AND READ R0 CCW   02346000
*                             INSTEAD OF NO-OP, BECAUSE: ONLY THE DATA  02347000
*                             PORTION OF RECORD R0 WAS READ EARLIER.    02348000
         LA    R1,0(,R1)      ZERO OUT THE HIGH ORDER BYTE              02349000
         LA    R2,THR         POINT TO THE START OF THE FIRST RECORD    02350000
         SR    R1,R2          GET THE TOTAL DATA LENGTH                 02351000
         SR    R0,R0          SET UP FOR THE DEVIDE                     02352000
         D     R0,=F'4096'    DEVIDE BY BUFFER SIZE (4K)                02353000
         CL    R0,=F'80'      IS THE RECORD SIZE LARGER THAN 80         02354000
         BH    OK             YES- BRANCH                               02355000
         LTR   R0,R0          IS IT ZERO                                02356000
         BZ    OK             YES- BRANCH                               02357000
         L     R0,=F'80'      MAKE THE RECORD BIG ENOUGH FOR           X02358000
                              ERROR RECOVERY TO FIND.                   02359000
OK       STH   R0,THRDRL      R0 = THE SIZE OF THE LAST DATA RECORD     02360000
         STH   R1,THRNDRT     R1 = THE NUMBER OF 4K DATA RECORDS        02361000
         LA    R1,READ231X         *    POINT TO THE READ DASD CCW'S    02362000
         TM    IOBTYPE,TYP2311+TYP2314                         @V2A2063 02363000
         BNZ   READKEYD       *                                @V2A2063 02364000
         LA    R1,READ333X         *                                    02365000
         TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380         HRC012DK 02366490
         BNZ   READKEYD                                        @V2A2063 02367000
         LA    R1,READ230X         *                                    02368000
READKEYD BAL   R14,STARTIO    READ IN THE KEY AND DATA                  02369000
REORCYL  TM    DDRFLAG2,PRINT+TYPE PRINT OR TYPE OPERATION              02370000
         BNZ   DISPLAY        YES- BRANCH                               02371000
         LA    R15,INIOB                                       @V56BDA8 02372000
         TM    IOBTYPE,TYP2311+TYP2314+TYP2305 2311/2314/2305? @V56BDA8 02373000
         BNZ   KEEPFLAG       YES, BRANCH.                     @V56BDA8 02374000
         NI    THRHADD,255-X'02' REMOVE FLAG FOR COPY/DUMP     @V56BDA8 02375000
KEEPFLAG DS    0H                                              @V56BDA8 02376000
         MVC   THRHADD+1(4),OUTADD+2    SET UP THE REORDED CYLINDER     02377000
         SPACE 3                                                        02378000
******************************************************************      02379000
*.                                                                      02380000
*  15.   SUBROUTINE TO WRITE A TRACK HEADER RECORD                      02381000
*                                                                       02382000
*              1. IF THE OUTPUT IS NOT TAPE GO TO STEP 3, ELSE          02383000
*                 BUILD A CCWSTRING TO WRITE OUT THE VHR AND DATA       02384000
*                 RECORDS.                                              02385000
*                                                                       02386000
*              2. WRITE OUT THE RECORDS, AND GO TO STEP 4.              02387000
*                                                                       02388000
*              3. BUILD A CCW STRING TO RECREATE THE DASD TRACK,        02389000
*                 AND WRITE IT OUT.                                     02390000
*                                                                       02391000
*              4. GO TO THE NEXT ROUTINE.                               02392000
*.                                                                      02393000
*******************************************************************     02394000
TESTOUT  LA    R15,OUTIOB     POINT TO THE OUTPUT IOB                   02395000
         TM    IOBCLASS,CLASTAPE   IS THE OUTPUT TAPE                   02396000
         BZ    DASDWRIT                                                 02397000
         LA    R3,TAPWCCW-8   POINT TO THE TAPE WRITE CCW               02398000
         LH    R0,THRDRL      GET THE SIZE OF THE LAST DATA RECORD      02399000
         LH    R1,THRNDRT     GET THE NUMBER OF TAPE 4K DATA RECORDS    02400000
         LTR   R1,R1          IS IT ZERO                                02401000
         BZ    STSHORT        YES- BRANCH                               02402000
         L     R4,=X'60001000'     SET UP LEFT HALF OF CCW              02403000
LOOP     LA    R3,8(,R3)      POINT TO THE NEXT CCW                     02404000
         ST    R4,4(,R3)      SET UP FOR A 4K READ WITH CC+SILI         02405000
         BCT   R1,LOOP        DO IT FOR ALL 4K TAPE WRITES              02406000
         LTR   R0,R0          DO I HAVE A SHORT BLOCK TO WRITE          02407000
         BZ    ZEROFLAG       NO- BRANCH                                02408000
STSHORT  LA    R3,8(,R3)      POINT TO THE NEXT CCW                     02409000
         ST    R0,4(,R3)      MOVE IN RECORD SIZE                       02410000
ZEROFLAG MVI   4(R3),SILI  TURN OFF THE CC BIT IN LAST CCW              02411000
         LA    R1,TAPWCCW     POINT TO THE CCW CHAIN                    02412000
         BAL   R14,STARTIO                                              02413000
         B     UPDTADD                                                  02414000
         SPACE                                                          02415000
DASDWRIT LM    R3,R5,DASDWCCW PICK UP FORMAT WRITE CCW'S                02416000
         L     R0,DASDWCCW+12 GET SECOND HALF OF SECOND CCW             02417000
         L     R2,CCWWORKA    POINT TO WORK AREA FOR BUILDING CCW'S     02418000
         LH    R1,THRNDRD     GET NUMBER OF RECORDS TO WRITE            02419000
         LTR   R6,R1          SAVE THE NUMBER OF DATA RECORDS IN R6     02420000
         BZ    DASDE          BRANCH IF NO DATA RECORDS                 02421000
         SLL   R6,3           MULTIPLY BY 8                             02422000
         LA    R6,THR001(R6)  COMPUTE THE SIZE OF THE THR               02423000
         OR    R5,R6          POINT TO THE FIRST DATA AREA              02424000
         LA    R7,8           SET UP LENGTH OF COUNT FIELD              02425000
LOOP1    SR    R6,R6          ZERO OUT WORK AREA                        02426000
         IC    R6,5(,R3)      GET THE KEY LENGTH                        02427000
         ICM   R0,3,6(R3)    GET THE DATA LENGTH                        02428000
         BNZ   NOTEOF         BRANCH IF NOT ZERO DATA LENGTH            02429000
         LTR   R6,R6          IS THE KEY ALSO ZERO                      02430000
         BNZ   NOTEOF         NO- BRANCH                                02431000
         ST    R3,0(,R2)      FILL IN FIRST HALF OF CCW                 02432000
         MVC   4(4,R2),COUNTCCW+4  FILL IN SECOND HALF OF CCW           02433000
         ALR   R2,R7          POINT TO THE NEXT CCW IN THE CHAIN        02434000
         B     UPDATE                                                   02435000
DASDE    TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380         HRC012DK 02436490
         BZ    DASDNOP             NO- BRANCH                           02437000
         MVC   0(8,R2),DASDECCW    SET UP ERASE CCW TO CLEAN UP THE    X02438000
                                   TRACK (HOME ADD AND R ZERO ONLY)     02439000
         B     WTDASD                                                   02440000
NOTEOF   ALR   R6,R0          SET UP RIGHT HALF OF CCW 2                02441000
         STM   R3,R6,0(R2)    STORE FORMAT WRITE CCW'S                  02442000
         LA    R6,0(,R6)      ZERO OUT HIGH ORDER BYTE (CC)             02443000
         ALR   R5,R6          ADD BYTE COUNT OF LAST CCW TO DATA       X02444000
                              ADDRESS OF NEXT WRITE DATA CCW            02445000
         LA    R2,16(,R2)     POINT TO THE NEXT CCW IN THE CHAIN        02446000
UPDATE   ALR   R3,R7          UPDATE POINTER TO NEXT COUNT FIELD        02447000
         BCT   R1,LOOP1       DO IT FOR EACH RECORD                     02448000
DASDNOP  DS    0H                                                       02449000
         MVC   0(8,R2),NOOP   BRAKE CHAIN WITH A NO OP                  02450000
         TM    THRFLAG,SPECIAL     WAS THE LAST RECORD A SPECIAL WRITE  02451000
         BZ    WTDASD         NO- OK GO WRITE IT OUT                    02452000
         SL    R2,=F'16'      BACK UP TO LAST FORMAT WRITE CCW          02453000
         MVI   0(R2),X'01'    CHANGE IT TO A WRITE SPECIAL C,K,D        02454000
WTDASD   LA    R1,WT333X      POINT TO CCW CHAIN                        02455000
         TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380         HRC012DK 02456490
         BNZ   WDSIO          YES                              @V2A2063 02457000
         MVC   THRHADD+1(4),OUTADD+2    RELOCATE THE HOME ADDRESS       02458000
         TM    THRHADD,X'02'       IS THIS A DEFECTIVE TRACK            02459000
         BNO   *+8                 NO- BRANCH                           02460000
         BAL   R14,DDR715          YES- TYPE THE MSG                    02461000
         LA    R15,OUTIOB     RESTORE POINTER TO THE OUTPUT IOB         02462000
         LA    R1,WT231X      POINT TO CCW CHAIN                        02463000
         TM    IOBTYPE,TYP2311+TYP2314 2311, 2314, OR 2319     @V2A2063 02464000
         BNZ   WDSIO          YES- BRANCH                      @V2A2063 02465000
         LA    R1,WT230X      SET UP FOR 230X TYPE DEVICE               02466000
WDSIO    BAL   R14,STARTIO                                              02467000
         SPACE 3                                                        02468000
*****************************************************************       02469000
*.                                                                      02470000
*  16.   SUBROUTINE TO UPDATE POINTERS TO THE NEXT TRACK OR CYLINDER    02471000
*                                                                       02472000
*              1. UPDATE THE INPUT AND OUTPUT DASD ADDRESS.             02473000
*                                                                       02474000
*              2. IF THE END OF A CYLINDER EXTENT LINK TO               02475000
*                 ROUTINE 12 STEP 4 TO PRINT THE CYLINDER MAP.          02476000
*                                                                       02477000
*              3. IF THE END OF THE LAST EXTENT GO TO ROUTINE 22 TO     02478000
*                 END THE JOB STEP.                                     02479000
*                                                                       02480000
*              4. IF THE INPUT UNIT IS TAPE GO TO ROUTINE 13, ELSE      02481000
*                 GO TO ROUTINE 14.                                     02482000
*.                                                                      02483000
*****************************************************************       02484000
UPDTADD  EQU   *                                               @V200731 02485000
         L     R7,CUREXT      GET ADDR OF CURRENT EXTENT ENTRY @V200731 02486000
         LA    R8,EXTSIZE     AND SIZE OF EACH ENTRY           @V200731 02487000
         LA    R15,INIOB      POINT TO INPUT IOB                        02488000
         XC    TAPEERCT(4),TAPEERCT     ZERO OUT THE TAPE AND DASD     X02489000
                                        ERROR COUNT                     02490000
         CLC   VHRMTCK,INADD+4     IS THIS THE LAST TRACK ON THE CYL    02491000
         BH    NEXTTCK                  NO- BRANCH                      02492000
         CLC   CYLSTOP,INADD+2     IS THIS THE LAST CYL IN THIS EXTENT  02493000
         BH    NEXTCYL             NO- BRANCH                           02494000
         TM    DDRFLAG2,PRINT+TYPE PRINT OR TYPE OPERATION              02495000
         BNZ   EOJ            YES- GO TO END OF JOB                     02496000
         LH    R1,CYLSTART         *    POINT TO THE START AND STOP     02497000
         LH    R2,CYLSTOP          *    CYLINDER EXTENTS FOR THE CYL    02498000
         LH    R3,CYLREOR          *    MAP ROUTINE.                    02499000
         CVD   R1,WORK1            *                                    02500000
         UNPK  INSTART(4),WORK1    *                                    02501000
         CVD   R2,WORK1            *                                    02502000
         UNPK  INSTOP(4),WORK1     *                                    02503000
         CVD   R3,WORK1            *                                    02504000
         UNPK  OUTSTART(4),WORK1   *                                    02505000
         SR    R2,R1               *                                    02506000
         AR    R3,R2               *                                    02507000
         CVD   R3,WORK1            *                                    02508000
         UNPK  OUTSTOP(4),WORK1    *                                    02509000
         BAL   R14,PRINTEXT   GO PRINT THE CYLINDER MAP                 02510000
         AR    R7,R8          POINT TO THE NEXT EXTENT ENTRY   @V200731 02511000
         CL    R7,LASTEXT     WAS ENTRY JUST PROCESSED THE     @V200731 02512000
*                             LAST ONE?                                 02513000
         BH    EOJ            YES - GET NEW FUNCTION OR QUIT   @V200731 02514000
         ST    R7,CUREXT      SAVE THE POINTER TO THE EXTENT            02515000
         XC    INADD(16),INADD     ZERO OUT THE IN AND OUT DASD ADD     02516000
         MVC   INADD+2(2),CYLSTART SET UP A NEW START CYLINDER          02517000
         MVC   OUTADD+2(2),CYLREOR SET UP A NEW REORDERED CYLINDER      02518000
         B     NEXTREC                                                  02519000
NEXTTCK  LH    R1,INADD+4     SET UP TO ADD ONE                         02520000
         LA    R1,1(,R1)      ADD THE TRACK ADD                         02521000
         STH   R1,OUTADD+4         *    SAVE THE ADDRESS                02522000
         STH   R1,INADD+4          *                                    02523000
NEXTREC  TM    IOBCLASS,CLASTAPE   IS THIS A TAPE DEVICE                02524000
         BO    GETTHR         YES- GO READ TAPE                         02525000
         B     BUILDTHR       NO- GO BUILD A THR                        02526000
NEXTCYL  LH    R1,INADD+2     PICK UP CYLINDER                          02527000
         LA    R1,1(,R1)           ADD ONE                              02528000
         STH   R1,INADD+2          SAVE IT                              02529000
         LH    R1,OUTADD+2         GET THE OUTPUT ADD                   02530000
         LA    R1,1(,R1)           ADD ONE                              02531000
         STH   R1,OUTADD+2         SAVE IT                              02532000
         SR    R1,R1          *    ZERO OUT THE TRACK ADD               02533000
         STH   R1,INADD+4     *                                         02534000
         STH   R1,OUTADD+4    *                                         02535000
         B     NEXTREC                                                  02536000
         SPACE 3                                                        02537000
******************************************************************      02538000
*.                                                                      02539000
*  17.   SUBROUTINE TO DISPLAY A TRACK                                  02540000
*                                                                       02541000
*              1. DISPLAY HOME ADD AND RECORD ZERO IF THE START ADD     02542000
*                 IS NOT GREATER THAN THE THRHADD.                      02543000
*                                                                       02544000
*              2. FIND THE START ADDRESS                                02545000
*                                                                       02546000
*              3. IF RECORD HAS A KEY, LINK TO ROUTINE 18 TO DISPLAY    02547000
*                 THE KEY.                                              02548000
*                                                                       02549000
*              4. IF RECORD HAS DATA LINK TO ROUTINE 18 TO DISPLAY      02550000
*                 IT, ELSE DISPLAY THE END OF FILE RECORD MSG.          02551000
*                                                                       02552000
*              5. IF THE STOP RECORD IS FOUND GO TO ROUTINE 1 STEP 5.   02553000
*                                                                       02554000
*              6. IF THIS IS THE LAST RECORD ON THE TRACK CONT, ELSE    02555000
*                 GO TO STEP 3.                                         02556000
*                                                                       02557000
*              7. IF THE LAST RECORD WAS WRITTEN USING RECORD OVERFLOW  02558000
*                 DISPLAY THE RECORD OVERFLOW MSG.                      02559000
*                                                                       02560000
*              8. GO TO ROUTINE 12 STEP 7.                              02561000
*.                                                                      02562000
******************************************************************      02563000
DISPLAY  LH    R6,THRNDRD     GET THE NUMBER OF DATA RECORDS ON TRACK   02564000
         LR    R7,R6          *    POINT TO THE DATA (THRNDRD*8+THR001) 02565000
         SLL   R7,3           *                                         02566000
         LA    R7,THR001(R7)  *                                         02567000
         LA    R4,THR001-8    POINT TO THE FIRST COUNT -8               02568000
         CLC   INADD+2(4),PSTARTCC DO I PRINT RECORD ZERO               02569000
         BNE   DISPR0                   YES- NEW CYL SO PRINT REC ZERO  02570000
         CLI   PSTARTRR,X'00' DO I PRINT REC ZERO ON THE FIRST CYL      02571000
         BNE   GETR1          NO- BRANCH                                02572000
DISPR0   LH    R1,THR000                *    CONVERT THE CYLINDER       02573000
         CVD   R1,WORK1                 *    ADDRESS TO DEC             02574000
         UNPK  PHADDMSG+6(3),WORK1      *                               02575000
         OI    PHADDMSG+8,X'F0'         *                               02576000
         LH    R1,THR000+2              *    CONVERT THE HEAD           02577000
         CVD   R1,WORK1                 *    ADDRESS TO DEC             02578000
         UNPK  PHADDMSG+13(2),WORK1     *                               02579000
         OI    PHADDMSG+14,X'F0'        *                               02580000
         LA    R1,PHADDMSG+29 POINT TO THE MSG DATA                     02581000
         LA    R2,5           SET UP THE SIZE OF HOME ADD               02582000
         MVC   0(5,R1),THRHADD     MOVE IN THE HOME ADD                 02583000
         BAL   R14,DECCONV    CONVERT IT                                02584000
         LA    R1,PHADDMSG+52 POINT TO THE REC 0 FIELD                  02585000
         LA    R2,5           SET UP THE SIZE                           02586000
         MVC   0(5,R1),THR000 MOVE IN THE ID OF THE COUNT               02587000
         BAL   R14,DECCONV                                              02588000
         LA    R1,11(,R1)     POINT TO THE KEY LENGTH                   02589000
         LA    R2,1           SET UP THE COUNT                          02590000
         MVC   0(1,R1),THR000+5    MOVE IT IN                           02591000
         BAL   R14,DECCONV    CONVERT IT                                02592000
         LA    R1,3(,R1)      POINT TO THE DATA LENGTH OF THE KEY       02593000
         LA    R2,2           SET UP THE LENGTH                         02594000
         MVC   0(2,R1),THR000+6    MOVE IT IN                           02595000
         BAL   R14,DECCONV    CONVERT IT                                02596000
         LA    R1,5(,R1)      POINT TO THE DATA                         02597000
         LA    R2,4           SET UP THE COUNT                          02598000
         MVC   0(4,R1),THR000+8      POINT TO THE FIRST 4  DATA BYTES   02599000
         BAL   R14,DECCONV    CONVERT IT                                02600000
         LA    R1,9(,R1)      POINT TO THE NEXT 4 DATA BYTES            02601000
         MVC   0(4,R1),THR000+12   MOVE IN THE LAST OF THE DATA         02602000
         BAL   R14,DECCONV    CONVERT IT                                02603000
         LA    R2,PHADDMSG    POINT TO THE MSG                          02604000
         BAL   R14,PRINT2     GO DO IT                                  02605000
         CLC   INADD+2(5),PSTOPCC  LAST RECORD ?                        02606000
         BE    EOJ            YES- BRANCH                               02607000
         LTR   R6,R6          DO I HAVE ANY RECORDS TO PRINT            02608000
         BZ    SKIPMSG        NO- BRANCH                                02609000
         B     LOOP13                                                   02610000
GETR1    LTR   R6,R6          DO I HAVE ANY RECORDS TO PRINT            02611000
         BZ    NOSTART        NO- BRANCH                                02612000
LOOP12   LA    R4,8(,R4)      POINT TO THE NEXT COUNT                   02613000
         CLC   4(1,R4),PSTARTRR IS THIS COUNT EQ TO THE START  @VA01816 02614000
         BE    PTCOUNT        YES- GO PRINT IT                          02615000
         SR    R5,R5          *    POINT TO THE NEXT DATA               02616000
         IC    R5,5(R4)       *    FIELD FOR THE NEXT RECORD            02617000
         AR    R7,R5          *                                         02618000
         ICM   R5,3,6(R4)     *                                         02619000
         AR    R7,R5          *                                         02620000
         BCT   R6,LOOP12      GO LOOK AT THE NEXT RECORD                02621000
NOSTART  MVC   DDR721A+28(5),PSTARTCC   SET UP THE START ADD FOR DDR721 02622000
         B     DDR721+6       ERROR IF NOT FOUND                        02623000
LOOP13   LA    R4,8(,R4)      POINT TO THE NEXT COUNT FIELD             02624000
PTCOUNT  SR    R5,5           ZERO OUT THE LENGTH REG                   02625000
PCOUNT   LH    R1,0(R4)                 *    CONVERT THE CYLINDER       02626000
         CVD   R1,WORK1                 *    ADDRESS TO DEC             02627000
         UNPK  PRECMSG+6(3),WORK1       *                               02628000
         OI    PRECMSG+8,X'F0'          *                               02629000
         LH    R1,2(R4)                 *    CONVERT THE HEAD           02630000
         CVD   R1,WORK1                 *    ADDRESS TO DEC             02631000
         UNPK  PRECMSG+13(2),WORK1      *                               02632000
         OI    PRECMSG+14,X'F0'         *                               02633000
         IC    R5,4(R4)       GET THR RECORD ID                         02634000
         CVD   R5,WORK1       *    CONVERT THE RECORD ID AND            02635000
         UNPK  PRECMSG+20(3),WORK1  MOVE IT INTO THE MSG                02636000
         OI    PRECMSG+22,X'F0'    SET SINE TO NUM                      02637000
         LA    R1,PRECMSG+30  POINT TO THE COUNT FIELD                  02638000
         LA    R2,5           SET UP THE NUM OF BYTES                   02639000
         MVC   0(5,R1),0(R4)  MOVE IN THE COUNT ID                      02640000
         BAL   R14,DECCONV    CONVERT IT                                02641000
         LA    R1,11(,R1)     POINT  TO THE KEY LENGTH                  02642000
         LA    R2,1           SET UP TH BYTE LENGTH                     02643000
         MVC   0(1,R1),5(R4)  MOVE IN THE KEY LENGTH                    02644000
         BAL   R14,DECCONV    CONVERT IT                                02645000
         LA    R1,3(,R1)      POINT TO THE DATA LENGTH                  02646000
         LA    R2,2           SET UP THE BYTE LENGTH                    02647000
         MVC   0(2,R1),6(R4)  MOVE IT IN                                02648000
         BAL   R14,DECCONV    CONVERT IT                                02649000
         LA    R2,PRECMSG     POINT TO THE MSG                          02650000
         BAL   R14,PRINT2     GO PRINT IT                               02651000
         ICM   R5,1,5(R4)     GET THE KEY                               02652000
         BZ    PDATA          IF NO KEY THAN GO GET THE DATA            02653000
         MVC   PLENMSG+15(4),=C'KEY '    SET KEY INTO THE LENGTH MSG    02654000
         BAL   R14,DISPIT     GO PRINT THE KEY DATA                     02655000
PDATA    AR    R7,R5          POINT TO THE DATA                         02656000
         ICM   R5,3,6(R4)     GET THE DATA LENGTH                       02657000
         BNZ   PRINTDAT       BRANCH IF NOT EOF                         02658000
         LA    R2,PEOFMSG     POINT TO THE EOF MSG                      02659000
         BAL   R14,PRINT2     GO PRINT THE MSG                          02660000
         B     TSTCOUNT       GO GET THE NEXT RECORD                    02661000
PRINTDAT MVC   PLENMSG+15(4),DATA   SET UP THE MSG                      02662000
         BAL   R14,DISPIT     GO PRINT THE DATA OUT                     02663000
ADDIT    AR    R7,R5          POINT TO THE NEXT DATA                    02664000
         CLC   INADD+2(4),PSTOPCC LAST TRACK?                  @VA01816 02665000
         BNE   GOSUB1         GO PRINT                         @VA01816 02666000
TSTCOUNT CLC   4(1,R4),PSTOPRR IS THIS LAST RECORD             @VA01816 02667000
         BNE   GOSUB1         NO- BRANCH                                02668000
         TM    PSTOPRR+1,X'FF'     DO I PRINT TO THE END OF THE TRACK   02669000
         BO    GOSUB1         YES- GO DO IT                             02670000
         BCTR  R6,0           -1                                        02671000
         B     LASTONE                                                  02672000
GOSUB1   BCT   R6,LOOP13      GET THE NEXT RECORD                       02673000
LASTONE  TM    THRFLAG,SPECIAL     WAS THE LAST RECORD WRITEN WITH  01  02674000
         BNO   SKIPMSG        NO- BRANCH                                02675000
         LTR   R6,R6          LAST RECORD ?                             02676000
         BNZ   SKIPMSG        NO- SKIP THE MSG                          02677000
         LA    R2,POFMSG      YES- SET UP TO PRINT MSG                  02678000
         BAL   R14,PRINT2     GO PRINT IT                               02679000
SKIPMSG  CLC   INADD+2(4),PSTOPCC  IS THIS THE LAST TRACK               02680000
         BL    UPDTADD             NO- GO GET THE NEXT TRACK            02681000
         CLC   0(5,R4),PSTOPCC     IS THIS COUNT EQ THE STOP            02682000
         BE    EOJ            YES - ALL OK                              02683000
         TM    PSTOPRR+1,X'FF'     DO I DUMP THE FULL TRACK             02684000
         BZ    DDR721         NO- RECORD NOT FOUND                      02685000
         B     EOJ            GO TO END OF JOB                          02686000
UPDATE1  IC    R5,5(R4)       GET THE KEY LENGTH                        02687000
         AR    R7,R5          PIONT TO THE DATA                         02688000
         ICM   R5,3,6(R4)     GET THE DATA LENGTH                       02689000
         B     ADDIT                                                    02690000
         SPACE 3                                                        02691000
****************************************************************        02692000
*.                                                                      02693000
*  18.   SUBROUTINE TO DISP KEY OR DATA FIELD FROM A RECORD             02694000
*                                                                       02695000
*              1. DISPLAY THE KEY/DATA MSG, WITH A CALL TO ROUTINE      02696000
*                 19 STEP 1.                                            02697000
*                                                                       02698000
*              2. POINT TO THE CURRENT AND LAST LINE.                   02699000
*                                                                       02700000
*              3. IF THE LINE IS A DUPLICATE, TURN ON THE SUPLINE       02701000
*                 FLAG, AND GO TO STEP 2.                               02702000
*                                                                       02703000
*              4. IF THE SUPLINE FLAG IS ON DISPLAY THE SUPPRESSED      02704000
*                 CHARECTOR MSG, WITH A CALL TO ROUTINE 19.             02705000
*                                                                       02706000
*              5. TRANSLATE THE LINE AND DISPLAY IT WITH A LINK TO      02707000
*                 ROUTINE 19.                                           02708000
*                                                                       02709000
*              6. IF THE LAST LINE, RETURN TO CALLER, ELSE GO TO        02710000
*                 STEP 2.                                               02711000
*.                                                                      02712000
***************************************************************         02713000
DISPIT   TM    DDRFLAG2,COUNTOPT   IS THE COUNT OPTION ON               02714000
         BCR   1,R14               YES- RETURN TO CALLER                02715000
         STM   R4,R7,REGSAVE4 SAVE THE CALLERS REG'S                    02716000
         ST    R14,SAVERET         SAVE THE RETURN REG ALSO             02717000
         CVD   R5,WORK1            *    SET UP THE LENGTH IN DECMAL     02718000
         UNPK  PLENMSG+2(5),WORK1  *                                    02719000
         OI    PLENMSG+6,X'F0'     *                                    02720000
         LA    R1,PLENMSG+9        *    SET UP THE LENGTH IN HEX        02721000
         LA    R2,2                *                                    02722000
         STH   R5,0(R1)            *                                    02723000
         BAL   R14,DECCONV         *                                    02724000
         LA    R2,PLENMSG     POINT TO THE MSG                          02725000
         BAL   R14,PRINT2     GO PRINT THE MSG                          02726000
         SR    R6,R6                                                    02727000
         LR    R8,R7          SET LAST LINE POINTER EQ TO CURRANT      X02728000
                              LINE POINTER.                             02729000
         LA    R4,32          SET UP LENGTH OF ONE LINE (TO PRINT)      02730000
ADDLINE  BXH   R6,R4,LASTIME  ADD LINE COUNT TO DISPLACEMENT            02731000
         CR    R7,R8          IS THE CURRENT LINE THE SAME AS LAST LINE 02732000
         BE    SETUPBUF       YES- SKIP THE COMP (FIRST TIME)           02733000
         BCTR  R4,0           -1                                        02734000
         EX    R4,COMPDAT     DUP LINE ?                                02735000
         LA    R4,1(,R4)      +1                                        02736000
         BNE   SUPMSG         NO- GO TEST FOR SUP MSG                   02737000
         OI    DDRFLAG,SUPLINE     TURN ON THE SUP LINE FLAG            02738000
         AR    R7,R4          POINT TO THE NEXT LINE                    02739000
         CR    R6,R5          WAS THAT THE LAST LINE                    02740000
         BL    ADDLINE        NO- GO SET UP THE COUNT                   02741000
         NI    DDRFLAG,255-SUPLINE TURN OFF THE SUPPRESSED LINE FLAG    02742000
         LA    R2,PSUPMSG     POINT TO THE PRINT SUPPRESSED MSG         02743000
         BAL   R14,PRINT2     PRINT THE MSG                             02744000
         B     NEXTONE        RETURN                                    02745000
SUPMSG   TM    DDRFLAG,SUPLINE     IS THE SUP LINE SWITCH ON            02746000
         BZ    SETUPBUF       NO- GO PRINT THE LINE                     02747000
         NI    DDRFLAG,255-SUPLINE TURN THE FLAG OFF                    02748000
         LA    R2,PSUPMSG     POINT TO THE PRINT SUP MSG                02749000
         BAL   R14,PRINT1     GO PRINT THE MSG                          02750000
SETUPBUF MVI   PTBUFFER,C' '            *    SET UP AND CLEAR           02751000
         MVC   PTBUFFER+1(121),PTBUFFER *    THE PRINTER BUFFER         02752000
         MVI   AST1,C'*'                *                               02753000
         MVI   AST2,C'*'                *                               02754000
         LR    R2,R6          SAVE THE DISPLACEMENT                     02755000
         SR    R2,R4          BACK UP THE LENGTH                        02756000
         CVD   R2,WORK1            *    CONVERT THE DISPLACEMENT        02757000
         UNPK  DISPDEC(5),WORK1    *    TO DECMAL                       02758000
         OI    DISPDEC+4,X'F0'     *                                    02759000
         LA    R1,DISPHEX     POINT TO THE DISPLACEMENT COUNTER         02760000
         STH   R2,0(R1)       SET IN DISPLACEMENT                       02761000
         LA    R2,2           NUMBER OF BYTES TO CONVERT                02762000
         BAL   R14,DECCONV    CONVERT THE DISPLACEMENT TO HEX           02763000
TRANS    BCTR  R4,0           -1                                        02764000
         EX    R4,MOVEDAT     MOVE IN THE DATA                          02765000
         EX    R4,TRANDAT     TRANSLATE THE DATA                        02766000
         LA    R3,0(R4,R7)    POINT TO END OF THE BUFFER (NEXT LINE)    02767000
         LA    R4,1(,R4)      +1                                        02768000
         LA    R2,4           SET UP BYTE COUNT                         02769000
         LA    R1,HEXDATA     POINT TO THE OUTPUT BUFFER                02770000
         LR    R8,R7          SET UP THE LAST LINE POINTER              02771000
LOOP11   MVC   0(4,R1),0(R7)  MOVE IN THE DATA TO BE CONVERTED          02772000
         BAL   R14,DECCONV    CONVERT IT                                02773000
         LA    R1,9(,R1)      POINT TO THE NEXT FIELD                   02774000
         CL    R1,=A(MIDDLE)  IS THIS THE MIDDLE OF THE BUFFER          02775000
         BNE   *+8            NO- BRANCH                                02776000
         LA    R1,1(,R1)      ADD 1 TO THE BUFFER                       02777000
         BXLE  R7,R2,LOOP11   DO IT UP TO THE END OF THIS LINE          02778000
         CR    R6,R5          IS THIS THE LAST LINE                     02779000
         BL    PBUFFER        NO- BRANCH                                02780000
         LA    R3,1(,R3)      +1                                        02781000
         SR    R7,R3          DID I COME OUT EVEN ?                     02782000
         BZ    PBUFFER        YES- BRANCH                               02783000
         LA    R7,1(R7,R7)    *2+1 = NUMBER OF BYTES TO BACK UP         02784000
         SR    R1,R7          BACK UP                                   02785000
         EX    R7,BLANKIT     BLANK OUT THE EXTRA BYTES                 02786000
PBUFFER  LA    R2,PBUFLEN     POINT TO THE PRINT BUFFER -2              02787000
         LA    R1,L'PTBUFFER  SET UP THE BUFFER LENGTH                  02788000
         TM    DDRFLAG2,HEXOPT+GRAPHOPT DEFAULT OPTIONS ON              02789000
         BO    SAVELEN        BRANCH IF BOUTH ON                        02790000
         LA    R1,AST1-(PTBUFFER+1)     LENGTH OF THE HEX DATA          02791000
         TM    DDRFLAG2,HEXOPT     HEX OPTION ON                        02792000
         BO    SAVELEN        YES- BRANCH                               02793000
         LA    R1,((AST2+1)-AST1)+(HEXDATA-PTBUFFER)  GET GRAPHIC LEN   02794000
         MVC   HEXDATA((AST2+1)-AST1),AST1  MOVE IN THE GRAPHIC DATA    02795000
SAVELEN  STH   R1,0(,R2)      SAVE THE LENGTH COUNT                     02796000
         CR    R6,R5          IS THIS THE LAST TIME                     02797000
         BNL   *+12           YES- BRANCH                               02798000
         BAL   R14,PRINT1     GO PRINT THE BUFFER                       02799000
         B     ADDLINE        GO PRINT NEXT LINE                        02800000
         BAL   R14,PRINT2     GO PRINT THE LAST LINE                    02801000
NEXTONE  LM    R4,R7,REGSAVE4 RETURN REGS                               02802000
         L     R14,SAVERET    AND R14 ALSO                              02803000
         BR    R14            GO BACK                                   02804000
LASTIME  SR    R6,R4          -32  ( BACK UP THE DATA COUNT)            02805000
         LR    R4,R5          GET THE TOTAL DATA LENGTH                 02806000
         SR    R4,R6          FIND THE REMAINING BYTES                  02807000
         B     ADDLINE        RETURN TO ROUTINE                         02808000
COMPDAT  CLC   0(0,R8),0(R7)                                            02809000
MOVEDAT  MVC   DATATRAN(0),0(R7)                                        02810000
TRANDAT  TR    DATATRAN(0),TRANTABL                                     02811000
BLANKIT  MVC   0(0,R1),BLANKS                                           02812000
         SPACE 3                                                        02813000
******************************************************************      02814000
*.                                                                      02815000
*  19.   SUBROUTINE TO PRINT OR TYPE THE DATA                           02816000
*                                                                       02817000
*        A  PRINT2                                                      02818000
*                                                                       02819000
*              1. IF THE OUTPUT IS TO THE PRINTER GO TO STEP 3.         02820000
*                                                                       02821000
*              2. TYPE THE MSG ON THE CONSOLE, THEN TYPE 1 BLANK LINE   02822000
*                 AND RETURN TO THE CALLER.                             02823000
*                                                                       02824000
*              3. ADD 2 TO THE LINE COUNT.                              02825000
*                                                                       02826000
*              4. BUILD A CCW TO PRINT SPACE 2.                         02827000
*                                                                       02828000
*              5. GO TO STEP 10.                                        02829000
*                                                                       02830000
*        B  PRINT1                                                      02831000
*                                                                       02832000
*              6. IF OUTPUT IS TO PRINTER GO TO STEP 8.                 02833000
*                                                                       02834000
*              7. TYPE THE MSG ON THE CONSOLE, AND RETURN TO CALLER.    02835000
*                                                                       02836000
*              8. ADD 1 TO THE LINE COUNT.                              02837000
*                                                                       02838000
*              9. BUILD A CCW TO PRINT SPACE 1.                         02839000
*                                                                       02840000
*              10. IF THE LINE COUNT IS OVER THE MAX CHANGE THE CCW TO  02841000
*                  PRINT SKIP TO 1.                                     02842000
*                                                                       02843000
*              11. PRINT THE LINE AND RETURN TO THE CALLER.             02844000
*.                                                                      02845000
*****************************************************************       02846000
PRINT2   EQU   *                                               HRC012DK 02847190
         CLC   PRINTIOB+(IOBUADD-IOB)(2),CONIOB+(IOBUADD-IOB)  HRC012DK 02847380
         BE    CONSOUT1                                        HRC012DK 02847570
         TM    DDRFLAG2,TYPE  TYPE OPERATION                   HRC012DK 02847760
         BZ    PRINTER2       NO- GO TO THE PRINTER ROUTINE             02848000
CONSOUT1 EQU   *                                               HRC012DK 02848500
         ST    R14,PRINTRET   SAVE THE RETURN ADD                       02849000
         BAL   R14,MSGWRITE   GO PRINT THE MSG ON THE CON               02850000
         L     R14,PRINTRET   GET THE RETURN REG                        02851000
         LA    R2,BLANKMSG    POINT TO THE BLANK MSG                    02852000
         B     MSGWRITE       GE TYPE A BLANK LINE (RETURN ON R14)      02853000
PRINTER2 LH    R1,LINECT      GET THE LINE COUNT                        02854000
         LA    R1,2(,R1)      ADD 2 TO THE LINE COUNT                   02855000
         MVI   PRINTCCW,X'11' SET UP CCW TO PRINT SPACE 2               02856000
         B     TESTNPAG       GO TEST FOR NEXT PAGE                     02857000
PRINT1   TM    DDRFLAG2,TYPE  IS THIS A TYPE OPERATION                  02858000
         BZ    PRINTER1       NO- GO TO THE PRINTER ROUTINE             02859000
         B     MSGWRITE       GO TYPE THE MSG ON THE CONS (RET ON R14)  02860000
PRINTER1 LH    R1,LINECT      GET THE LINE COUNT                        02861000
         LA    R1,1(,R1)      ADD 1 TO THE COUNT                        02862000
         MVI   PRINTCCW,X'09' SET UP THE CCW TO PRINT ONE LINE          02863000
TESTNPAG CH    R1,MAXLINE     IS IT TIME TO SKIP TO CH 1                02864000
         BL    SAVECT         NO- GO SAVE THE COUNT                     02865000
         MVI   PRINTCCW,X'89' PRINT ONE LINE AND SKIP TO 1              02866000
         SR    R1,R1          SET LINE COUNT TO 0                       02867000
SAVECT   STH   R1,LINECT      SAVE THE LINE COUNT                       02868000
         LA    R15,PRINTIOB   POINT TO THE PRINTER IOB                  02869000
         LH    R1,0(R2)       GET THE COUNT                             02870000
         LA    R2,2(,R2)      POINT TO THE MSG                          02871000
         STH   R1,PRINTCCW+6      SET UP THE MSG LENGTH                 02872000
         STCM  R2,7,PRINTCCW+1    SET IN THE DATA ADD                   02873000
         ST    R14,PRINTRET   SAVE THE RETURN ADD                       02874000
         LA    R1,PRINTCCW    POINT AT THE PRINTER CCW                  02875000
         BAL   R14,CMS2       GO TEST IF RUNNING UNDER CMS              02876000
         L     R14,PRINTRET   RETURN THE RETURN REG                     02877000
         BR    R14            GO BACK                                   02878000
         SPACE 3                                                        02879000
*****************************************************************       02880000
*.                                                                      02881000
*  20.   SUBROUTINE TO CLOSE THE OLD TAPE AND OPEN THE NEXT TAPE        02882000
*                                                                       02883000
*              1. REWIND UNLOAD THE OLD TAPE.                           02884000
*                                                                       02885000
*              2. REVERSE THE TAPE AND ALTERNATE TAPE UNIT ADDERSS.     02886000
*                                                                       02887000
*              3. READ THE NEW TAPE VOLUME HEADER RECORD.               02888000
*                                                                       02889000
*              4. RETURN TO THE CALLING ROUTINE.                        02890000
*.                                                                      02891000
*****************************************************************       02892000
ERRCLOSE STM   R14,R1,REGSAVE3     SAVE REGS                            02893000
         B     DDR709         PRINT ERROR (RETURN TO CLOSERET)          02894000
CLOSE    STM   R14,R1,REGSAVE3     SAVE REGS                            02895000
CLOSERET CL    R10,BAREMAC    UNDER CMS ?                               02896000
         BE    NOTCMS         NO- BRANCH                                02897000
         WAITT                WAIT FOR THE MSG TO GET OUT               02898000
NOTCMS   L     R15,REGSAVE3+4 RESTORE REG 15 (POINTER TO THE IOB )      02899000
         LA    R1,RUNCCW      *    POINT IOB AT THE CCW                 02900000
         CLC   IOBUADD,IOBATAPE    PRIMARY & ALT. TAPE SAME?   @VA01624 02901000
         BE    TPSWP          YES -                            @VA01624 02902000
         OI    IOBSTAT,IOBTPSWP    NO - FLAG SWAP IN PROGRESS  @VA01624 02903000
TPSWP    EQU   *                                               @VA01624 02904000
         BAL   R14,STARTIO                                              02905000
         LH    R1,IOBUADD          *    REVERSE POINTERS TO UNIT ADD    02906000
         MVC   IOBUADD,IOBATAPE    *                                    02907000
         STH   R1,IOBATAPE         *                                    02908000
         LA    R1,RVHRCCW     *    POINT IOB AT CCW                     02909000
         BAL   R14,STARTIO                                              02910000
         CLC   =C'VHR ',VHR   IS IT A VOLUME HEADER RECORD              02911000
         BNE   DDR709         NO- ERROR                                 02912000
         LM    R14,R1,REGSAVE3     RETURN REGS                          02913000
         BR    R14            RETURN TO CALLER                          02914000
         EJECT                                                          02915000
*****************************************************************       02916000
*.                                                                      02917000
*  21.   SUBROUTINE TO OPEN THE DASD UNITS                              02918000
*                                                                       02919000
*              1. READ IN THE VOL1 LABLE.                               02920000
*                                                                       02921000
*              2. IF IT IS A CPVOL TURN ON THE CPVOL FLAG.              02922000
*                                                                       02923000
*              3. IF THE VOL SER NO IS NOT EQ GO TO THE ERROR DDR711.   02924000
*                                                                       02925000
*              4. RETURN TO THE CALLING ROUTINE.                        02926000
*.                                                                      02927000
******************************************************************      02928000
OPENDASD STM   R14,R3,REGSAVE3     SAVE REGS                            02929000
         LA    R1,DDR716      POINT TO THE ERROR ROUTINE                02930000
         ST    R1,IOBERROR    FOR DASD OPEN                             02931000
         LA    R1,VOL1CCW     *    SET UP TO READ THE VOL1 LABLE        02932000
         BAL   R14,STARTIO    *    SERIAL NUMBER                        02933000
         LA    R1,INOUTER     POINT TO THE ERROR ROUTINE                02934000
         ST    R1,IOBERROR    AND SAVE IT                               02935000
         CLC   VOL1BUFF+46(5),=C'CP370' IS THE UNIT A CPVOL             02936000
         BNE   TESTSCR                  NO- BRANCH                      02937000
         OI    IOBSTAT,IOBCPVOL         TURN ON CPVOL BIT               02938000
TESTSCR  TM    IOBSTAT,IOBSCRAT    IS THIS A SCRATCH VOL                02939000
         BNO   TESTVSN             NO- BRANCH                           02940000
         MVC   IOBVSER(6),VOL1BUFF+4    MOVE THE VOLID INTO THE  IOB    02941000
TESTVSN  CLC   VOL1BUFF+4(6),IOBVSER  IS VOL SER EQ                     02942000
         BE    OPENCOMP       YES- BRANCH                               02943000
         CLC   VOL1BUFF(6),IOBVSER      IS IT A NSL                     02944000
         BNE   DDR711         NO- ERROR                                 02945000
OPENCOMP LM    R14,R3,REGSAVE3     RETURN REGS                          02946000
         BR    R14                                                      02947000
         SPACE 3                                                        02948000
OPENER   BAL   R14,RESPONSE                                    @VA03507 02949000
         LM    R14,R3,REGSAVE3     RETURN REGS                          02950000
         CLC   =C'YES ',RESPDATA   IS IT YES                            02951000
         BNE   TESTR          NO- BRANCH                                02952000
         CLI   MSGFLAG,X'F1'  DMKDDR711 MSG ISSUED             @VA03507 02953000
         BNE   OPENCOMP       NO, DONT SET REAL VOLSER         @VA03507 02954000
         MVI   MSGFLAG,X'00'  RESET MESSAGE FLAG               @VA03507 02955000
         MVC   IOBVSER,VOL1BUFF+4  SET IN THE REAL VOL SER NO           02956000
         B     OPENCOMP       OK GET OUT                                02957000
TESTR    CLC   =C'REREAD ',RESPDATA     IS IT REREAD                    02958000
         BE    OPENDASD+4     REOPEN THE UNIT (DO NOT SAVE RERS)        02959000
         CLC   =C'NO ',RESPDATA    IS IT NO                             02960000
         BNE   OPENER         YES, NO, OR REREAD PLEASE        @V2A2063 02961000
         OI    DDRFLAG,ERROR  SET THE ERROR BIT ON                      02962000
         B     GTCARD                                                   02963000
         EJECT                                                          02964000
****************************************************************        02965000
*.                                                                      02966000
*  22.   ROUTINE TO END A JOB STEP                                      02967000
*                                                                       02968000
*              1. IF THE INPUT UNIT IS TAPE POSITION IT.                02969000
*                                                                       02970000
*              2. IF THIS IS A TYPE FUNCTION GO TO STEP 5.              02971000
*                                                                       02972000
*              3. PRINT AND TYPE THE END OF STEP MSG.                   02973000
*                                                                       02974000
*              4. IF THE OUTPUT UNIT IS TAPE WRITE AN EOJ TRAILER       02975000
*                 RECORD AND POSITION THE TAPE.                         02976000
*                                                                       02977000
*              5. IF THE CARD SWITCH IS ON CONT, ELSE GO TO ROUTINE 1   02978000
*                 STEP 5.                                               02979000
*                                                                       02980000
*              6. IF THE CARD END OF FILE SWITCH IS ON GO TO            02981000
*                 ROUTINE 28.                                           02982000
*                                                                       02983000
*              7. IF THIS IS A PRINT OR TYPE FUNCTION GO TO ROUTINE 1   02984000
*                 STEP 5.                                               02985000
*                                                                       02986000
*              8. RETURN THE POINTER TO THE INPUT/OUTPUT STATEMENT      02987000
*                 AND GO TO ROUTINE 2.                                  02988000
*.                                                                      02989000
******************************************************************      02990000
CLOSEJOB L     R7,CUREXT      POINT TO THE EXTENT TABLE                 02991000
         CLC   CYLSTART(2),INADD+2 HAVE I STARTED ON THIS EXTENT?       02992000
         BNL   EOJ            NO- BRANCH                                02993000
         LH    R1,CYLSTART              *    SET UP THE CYLINDER        02994000
         CVD   R1,WORK1                 *    EXTENTS FOR THE            02995000
         UNPK  INSTART(4),WORK1         *    CYLINDER MAP               02996000
         LH    R1,INADD+2               *                               02997000
         BCTR  R1,0                     *                               02998000
         CVD   R1,WORK1                 *                               02999000
         UNPK  INSTOP(4),WORK1          *                               03000000
         LH    R1,CYLREOR               *                               03001000
         CVD   R1,WORK1                 *                               03002000
         UNPK  OUTSTART(4),WORK1        *                               03003000
         LH    R1,OUTADD+2              *                               03004000
         BCTR  R1,0                     *                               03005000
         CVD   R1,WORK1                 *                               03006000
         UNPK  OUTSTOP(4),WORK1         *                               03007000
         BAL   R14,PRINTEXT             *                               03008000
EOJ      LA    R15,INIOB      POINT TO THE INPUT IOB                    03009000
         TM    IOBCLASS,CLASTAPE   IS THE INPUT A TAPE                  03010000
         BZ    SETEND         NO- BRANCH                                03011000
         CLI   IOBDISP,X'03'  LEAVE OPTION                              03012000
         BNE   SETDISP        NO, BRANCH                       @VA02383 03013000
         CLC   =C'EOJ',THR    END-OF-FILE ON TAPE              @VA02383 03014000
         BE    SETEND         YES, BRANCH                      @VA02383 03015000
         MVI   DISPCCW,X'3F'  CHANGE OP CODE TO FSF            @VA02383 03016000
         B     MOVETAPE       GO SET UP THE IOB                @VA02383 03017000
SETDISP  MVC   DISPCCW(1),IOBDISP SET UP THE DISP CCW CODE     @VA02383 03018000
MOVETAPE LA    R1,DISPCCW     SET UP CCW IN IOB                @VA02383 03019000
         CLC   IOBUADD,IOBATAPE    PRIMARY AND ALT. TAPE SAME? @VA01135 03020000
         BE    TPSWP1         YES - NO FLAG.                   @VA01135 03021000
         OI    IOBSTAT,IOBTPSWP    NO - SET FLAG AS REMINDER.  @VA01135 03022000
TPSWP1   EQU   *                                               @VA01135 03023000
         BAL   R14,STARTIO                                              03024000
         LH    R1,IOBUADD          *    SWAP UNIT ADDRESSES             03025000
         MVC   IOBUADD,IOBATAPE    *                                    03026000
         STH   R1,IOBATAPE         *                                    03027000
SETEND   TM    DDRFLAG2,TYPE  IS THIS THE TYPE OPERATION                03028000
         BO    TESTCARD       YES BRANCH (DO NOT PRINT MSG)             03029000
         MVC   MSG001+13(7),SAVENAME    SET UP TO PRINT 'END OF DUMP'  X03030000
                              RESTORE, COPY OR PRINT                    03031000
         CLC   PRINTIOB+(IOBUADD-IOB)(2),CONIOB+(IOBUADD-IOB)  HRC012DK 03031300
         BE    CONSOUT2                                        HRC012DK 03031600
         LA    R15,PRINTIOB   POINT TO THE IOB                          03032000
         LA    R1,PTENDCCW    POINT TO THE CCW                          03033000
         BAL   R14,CMS2       PRINT IT OUT ON THE CYLINDER MAP          03034000
CONSOUT2 EQU   *                                               HRC012DK 03034500
         BAL   R14,MSG001     PRINT MSG ON THE CONS ALSO                03035000
         LA    R15,OUTIOB     POINT TO THE OUTPUT IOB                   03036000
         TM    IOBCLASS,CLASTAPE   IS THIS A TAPE                       03037000
         BZ    TESTCARD       NO- BRANCH                                03038000
         MVC   VHR(4),=C'EOJ '     SET UP EOJ LABEL                     03039000
         MVC   VHRCYLNO,OUTADD     SET UP LAST CYLINDER NO              03040000
         MVC   DISPCCW(1),IOBDISP  SET UP THE DISP CCW CODE             03041000
         LA    R1,BACKCCW6    *    POINT IOB AT THE FIRCT CCW           03042000
         CLC   IOBUADD,IOBATAPE    PRIMARY AND ALT. SAME?      @VA01135 03043000
         BE    TPSWP2         YES - FORGET FLAG.               @VA01135 03044000
         OI    IOBSTAT,IOBTPSWP    NO - REMEMBER SWAP IN PROG. @VA01135 03045000
TPSWP2   EQU   *                                               @VA01135 03046000
         BAL   R14,STARTIO                                              03047000
         MVC   VHR(4),=C'VHR '     SET UP FOR NEXT TIME                 03048000
         CLI   IOBDISP,X'03'  LEAVE OPTION                              03049000
         BE    TESTCARD       YES- BRANCH                               03050000
         LH    R7,IOBUADD          *    SWAP ADDRESSES                  03051000
         MVC   IOBUADD,IOBATAPE    *                                    03052000
         STH   R7,IOBATAPE         *                                    03053000
TESTCARD MVC   THRHADD+1(4),INADD+2     RESET THE THRADD TO THE IN ADD  03054000
         XC    INADD(16),INADD     ZERO THE INPUT AND OUTPUT DASD ADD   03055000
         NI    DDRFLAG,255-(RESTALL)   RESET BITS                       03056000
         NI    DDRFLAG,255-NUCLEUS RESET THE BIT                  (NUC) 03057000
         XC    TAPEERCT(4),TAPEERCT     ZERO OUT THE TAPE AND DASD     X03058000
                                        ERROR COUNT                     03059000
         TM    DDRFLAG,CARDIN CARD INPUT ?                              03060000
         BZ    CARDLP         NO, GO GET NEXT PARM             @VA02251 03061000
         TM    DDRFLAG,CARDEOF     WAS EOF READ                         03062000
         BO    EXIT           YES- BRANCH                               03063000
         TM    DDRFLAG2,PRINT+TYPE PRINT OR TYPE OPERATION              03064000
         BNZ   CARDLP         YES, GO GET THE NEXT STATEMENT   @VA02251 03065000
         LM    R1,R2,NEXTFILD RETURN POINTERS TO THE LAST PARM          03066000
         B     SCANNAME                                                 03067000
         SPACE                                                          03068000
CARDLP   MVI   DDRFLAG2,0     RESET DDRFLAG2                   @VA02251 03069000
         B     GTCARD         GET NEXT CARD                    @VA02251 03070000
         EJECT                                                          03071000
*****************************************************************       03072000
*.                                                                      03073000
*  23.   INPUT AND OUTPUT UNIT ERROR ROUTINE                            03074000
*                                                                       03075000
*              1. IF THE NOTOPER FLAG IS ON GO TO ERROR DDR704.         03076000
*                                                                       03077000
*              2. POINT TO THE ERROR CCW.                               03078000
*                                                                       03079000
*              3. IF THE UNIT IS TAPE GO TO STEP 12.                    03080000
*                                                                       03081000
*        A  DASD                                                        03082000
*                                                                       03083000
*              4. IF UNIT EXCEPTION CHANGE THE CCW TO A READ READ       03084000
*                 COUNT AND RESTART THE CCW STRING.                     03085000
*                                                                       03086000
*              5. IF INTERVENTION REQUIRED GO TO ERROR DDR710.          03087000
*                                                                       03088000
*              6. IF SEEK CHECK DO A RECALIBRATE AND  RESTART THE CCW   03089000
*                 STRING.                                               03090000
*                                                                       03091000
*              7. IF A TRACK CONDITION CHECK, THEN:                     03092000
*                    IF NOT 3330/3340/3350/3380 NOT USR WITH MEHRC012DK 03093490
*                       DMKDDR715E, THEN CONTINUE WITH NEXT TRACK.      03094000
*                    IF TRACK IS FLAGGED AND HAS NO ALTERNATE ASSIGNED, 03095000
*                       ISSUE MSG DMKDDR727E & CONTINUE WITH NEXT TRK.  03096000
*                    IF PRESENTLY WORKING ON THE DEFECTIVE TRACK,       03097000
*                       SWITCH TO ALTERNATE AND RESTART CHANNEL PROG.   03098000
*                    IF PRESENTLY WORKING ON THE ALTERNATE, THEN        03099000
*                       CHANNEL PROG TRIED TO RUN OFF END OF TRACK.     03100000
*                       THIS GETS TREATED SAME AS WHEN HE TRIES TO GET  03101000
*                       OFF OF A NORMAL TRACK AND CAUSES 'FILE PROTECT  03102000
*                       CHECK': DO NOT RESTART; THE CHANNEL PROG WAS    03103000
*                       INTENDED TO TERMINATE; GO TO STEP 9.            03104000
*                                                                       03105000
*              8. IF NOT A FILE PROTECT ERROR GO TO STEP 11.            03106000
*                                                                       03107000
*              9. IF CCW IS A READ COUNT MT COMPUTE THE NUMBER OF       03108000
*                 RECORDS ON THE TRACK AND RETURN TO CALLER.            03109000
*                                                                       03110000
*              10. IF CCW IS A READ KEY-DATA MT TURN ON THE SPECIAL     03111000
*                  FLAG AND RETURN TO THE CALLER.                       03112000
*                                                                       03113000
*              11. RETRY THE ERROR UP TO 20 TIMES THEN GO TO ERROR      03114000
*                  DDR705.                                              03115000
*                                                                       03116000
*        B  TAPE                                                        03117000
*                                                                       03118000
*              12. IF UNIT EXCEPTION GO TO STEP 17.                     03119000
*                                                                       03120000
*              13. IF EQUIPMENT CHECK GO TO DDR710.                     03121000
*                                                                       03122000
*              14. IF INTERVENTION REQUIRED GO TO ERROR DDR710.         03123000
*                                                                       03124000
*              15. IF FILE PROTECT GO TO ERROR DDR718.                  03125000
*                                                                       03126000
*              16. REPOSITION THE TAPE AND RETRY UP TO 50               03127000
*                  TIMES.  THEN GO TO ERROR DDR705.                     03128000
*                                                                       03129000
*              17. IF UNIT EXCEPTION WAS FRON A READ REPEAT THE CCW     03130000
*                  STRING SKIPPING THE TAPE MARK.                       03131000
*                                                                       03132000
*              18. IF WRITING AN EOV OR EOF TRAILER LABLE, FINISH THE   03133000
*                  WRITE AND RETURN TO CALLING ROUTINE.                 03134000
*                                                                       03135000
*              19. IF WRITING A THR AND ITS DATA RECORDS, BACK  THE     03136000
*                  TAPE UP TO THE THR AND WRITE AN EOV TRAILER LABLE.   03137000
*                                                                       03138000
*              20. REWIND UNLOAD THE TAPE AND SWAP TO THE ALTERNATE     03139000
*                  TAPE DRIVE.                                          03140000
*                                                                       03141000
*              21. WRITE A VOLUME HEADER RECORD ON THE NEW TAPE.        03142000
*                                                                       03143000
*              22. RESTART THE CCW STRING TO WRITE THE THR AND ITS      03144000
*                  DATA RECORDS.                                        03145000
*                                                                       03146000
*  INPUTS:  R15 = ADDR OF IOB.                                          03147000
*           R14 = RETURN ADDR TO GET BACK TO CALLER OF 'STARTIO'.       03148000
*.                                                                      03149000
*****************************************************************       03150000
INOUTER  TM    IOBSTAT,IOBNOPER    IS THE DEVICE NOT OPERATIONAL        03151000
         BO    DDR704         YES- ERROR                                03152000
         L     R5,IOBCSW      PICK UP THE ERROR CSW COMMAND ADDRESS     03153000
         LA    R5,0(,R5)      AND ZERO THE HIGH ORDER BYTE              03154000
         S     R5,=F'8'       BACK UP BY 8                              03155000
         BP    FOUNDIT        OK IF +                                   03156000
         L     R5,IOBCCW      GET START OF CCW CHAIN                    03157000
FINDCCW  TM    4(R5),CC+CD    IS IT CHAINED                             03158000
         BZ    FOUNDIT        NO- BEANCH                                03159000
TESTTIC  CLI   8(R5),08       IS THE NEXT CCW A TIC                     03160000
         BNE   POINT8         NO- POINT TO THAT CCW                     03161000
         CLM   R5,7,9(R5)     IS THE TIC  *-8                           03162000
         BE    POINT16        POINT TO THE CCW                          03163000
         L     R5,8(R5)       PICK UP TIC  ADD                          03164000
         B     FINDCCW        GO FIND THE END OF THE CHAIN              03165000
POINT16  LA    R5,8(,R5)      ADD 8 TO THE CCW ADD (POINT TO THE TIC )  03166000
         B     TESTTIC        GO TEST IF THE NEXT CCW IS TIC            03167000
POINT8   LA    R5,8(,R5)      POINT TO THE NEXT CCW                     03168000
         B     FINDCCW                                                  03169000
FOUNDIT  TM    IOBCLASS,CLASTAPE   IS THIS A TAPE                       03170000
         BO    TAPEER         YES- BRANCH                               03171000
         TM    IOBCSW+4,UE    WAS THE ERROR A UNIT EXCEPTION            03172000
         BO    UNITEXEC       YES- BRANCH                               03173000
         TM    SENSE,X'40'    IS IT INTERVENTION REQUIRED               03174000
         BO    DDR710         YES- ERROR                                03175000
         TM    SENSE,X'01'    TEST FOR SEEK CHECK                       03176000
         BO    RECAL          BRANCH IF ON                              03177000
         TM    SENSE,X'2C'    TEST FOR BUS-OUT,DATA OR OVERRUN          03178000
         BNZ   REPEAT         BRANCH IF ON                              03179000
         TM    SENSE,X'02'    TEST FOR TRACK CONDITION CHECK            03180000
         BO    TRKCOND        BRANCH IF TRACK CONDITION CHECK. @V56BDA8 03181000
         TM    SENSE+1,X'04'  FILE PROTECT CHECK?              @V56BDA8 03182000
         BO    ALTXPROT       YES, GO SEE WHAT CAUSED IT.      @V56BDA8 03183000
         TM    SENSE+1,X'08'  NO RECORD FOUND?                 @V56BDA8 03184000
         BO    NORECFND       TRUE, GO SEE WHAT CAUSED IT.     @V56BDA8 03185000
         B     DDR705         SOME UNKNOWN ERROR.              @V56BDA8 03186000
         SPACE 3                                                        03187000
TRKCOND  TM    IOBTYPE,TYP2311+TYP2314+TYP2305 2311/2314/2305? @V56BDA8 03188000
         BNZ   DEFTRACK       YES, IT IS ONE OF THEM.          @V56BDA8 03189000
*        IF 3340, GREAT, CONTINUE.  NOTE THAT 3330 & 3350 WILL GENERATE 03190000
*        TRK-COND-CHECK AND COME THRU HERE TOO IN THE CASE WHERE        03191000
*        THE HARDWARE FINDS THE DEFECTIVE TRACK HAS NO ALTERNATE        03192000
*        ASSIGNED.  IF THE 3330/3350 HARDWARE FAILED WE CAN'T RECOVER   03193000
*        WITH SOFTWARE EITHER, HOWEVER WE LET 3330/3350 GO THRU THE     03194000
*        FIRST PART OF ERROR RECOVERY ANYWAY BECAUSE WE WANT ERROR      03195000
*        RECOVERY TO READ RECORD R0 FROM THE DEFECTIVE TRACK FOR US;    03196000
*        IN CASE OF TYPE/PRINT WE STILL WANT TO DISPLAY HA AND R0.      03197000
*                                                                       03198000
*        FIRST DETERMINE CCHH OF CURRENT TRACK,                         03199000
*        THEN READ HA AND RECORD R0 FROM THIS CURRENT TRACK, THEN READ  03200000
*        HA AND R0 OF TRACK POINTED TO BY CURRENT TRACK'S R0.           03201000
         ST    R14,ALTSAVE    SAVE CALLER'S RETURN ADDRESS.    @V56BDA8 03202000
         BAL   R14,GETCCHH    RETURN CCHH OF CURRENT TRK IN R1.@V56BDA8 03203000
         BAL   R14,GETHAR0    PASS R1; READS HA/R0, RETURNS.   @V56BDA8 03204000
         MVC   ALTHASAV(L5),ALTHA SAVE HA JUST READ.           @V56BDA8 03205000
         MVC   ALTR0SAV(L16),ALTR0 SAVE RECORD R0 JUST READ.   @V56BDA8 03206000
         ICM   R1,15,ALTR0    CCHH OF OTHER TRK (FROM R0).     @V56BDA8 03207000
         BAL   R14,GETHAR0    PASS R1; READS HA/R0, RETURNS.   @V56BDA8 03208000
         L     R14,ALTSAVE    RESTORE CALLERS RETURN ADDRESS.  @V56BDA8 03209000
         ST    R14,SIOSAVE    RESTORE FOR 'STARTIO' ROUTINE.   @V56BDA8 03210000
         TM    IOBTYPE,TYP3330+TYP3350+TYP3380                 HRC012DK 03211490
*                                       IS IT 3330/3350?                03212000
         BNZ   XDDR727        YES, 3330/3350 (DEF TRK & NO ALT)@V56BDA8 03213000
*        DETERMINE WHETHER TRK-COND-CHECK OCCURRED WHILE TRYING TO      03214000
*        BEGIN ON A DEFECTIVE TRACK OR WHILE TRYING TO RUN OFF THE      03215000
*        END OF AN ALTERNATE TRACK.                                     03216000
         TM    ALTHASAV,X'03' TRK FLAGGED BOTH ALT & DEFECTIVE?@V56BDA8 03217000
         BO    ALTXDEF        YES, BRANCH.                     @V56BDA8 03218000
         TM    ALTHASAV,X'02' HA FLAG SAYS TRK IS DEFECTIVE?   @V56BDA8 03219000
         BZ    ALTXPROT       NO,MUST BE ALT (& WE RAN OFF END)@V56BDA8 03220000
*        TRACK-COND-CHECK OCCURRED WHILE BEGINNING ON A DEFECTIVE       03221000
*        TRACK.  NOW VERIFY THAT RECORD R0 OF DEFECTIVE TRACK POINTS    03222000
*        TO A PROPER ALTERNATE TRACK.                                   03223000
         TM    ALTHA,X'03'    TRK POINTED TO IS BOTH ALT & DEF?@V56BDA8 03224000
         BO    XDDR727        YES.  NOT A PROPER ALTERNATE.    @V56BDA8 03225000
         TM    ALTHA,X'01'    TRK POINTED TO IS NOT AN ALT?    @V56BDA8 03226000
         BZ    XDDR727        YES.  NOT AN ALTERNATE.          @V56BDA8 03227000
         CLC   ALTHASAV+1(L4),ALTR0 ALT POINTS BACK TO DEF?    @V56BDA8 03228000
         BNE   XDDR727        NO.  NOT A PROPER ALTERNATE.     @V56BDA8 03229000
*        FALLING THRU THE ABOVE TESTS MEANS DEFECTIVE TRK POINTS TO A   03230000
*        PROPER ALTERNATE.  SO WE NOW DO A RESTART TO THE ALTERNATE.    03231000
         LA    R1,ALTSEEK     CCWS TO RESTART WITH.            @V56BDA8 03232000
         STCM  R5,7,ALTTIC+1  FILL IN TIC TO CONNECT RESTART   @V56BDA8 03233000
*                             CCWS TO FAILING CCW (POINTED TO BY R5).   03234000
         MVC   ALTSKADD+2(L4),ALTR0SAV SET SO RESTART CCWS     @V56BDA8 03235000
*                                       SEEK TO ALT TRACK.              03236000
         B     RETRYIO        RESUME OPERATION (ON ALTERNATE). @V56BDA8 03237000
         SPACE                                                          03238000
*        TRACK DOES NOT HAVE A PROPER ALTERNATE.  WE'LL ISSUE MSG 727,  03239000
*        BUT IF IT IS TYPE/DUMP WE STILL WANT TO BE ABLE TO DISPLAY     03240000
*        HA AND R0 OF THIS TRACK.  HA WAS READ SUCCESSFULLY PRIOR TO    03241000
*        TRK-COND-CHECK.  R0 WAS READ AFTERWARDS IN ERROR RECOVERY.     03242000
XDDR727  CL    R15,=A(INIOB)  FAILED I/O WAS INPUT, OR OUTPUT? @V56BDA8 03243000
         BNE   XDDR727A       OUTPUT, CAN'T BE TYPE/PRINT.     @V56BDA8 03244000
         MVC   THR000(L16),ALTR0SAV MVC R0, COMPLETES TRK HDR. @V56BDA8 03245000
XDDR727A B     DDR727         ISSUE ERROR MSG, THEN RETURN TO  @V56BDA8 03246000
*                             CALLER OF 'STARTIO'.                      03247000
         SPACE                                                          03248000
*        TRACK IS FLAGGED BOTH ALTERNATE & DEFECTIVE.  IT MUST BE A     03249000
*        DEFECTIVE TRACK IN THE ALTERNATE TRACK CYLINDER.  WE WANT      03250000
*        TYPE/PRINT TO BE ABLE TO DISPLAY HA AND R0 OF THIS TRACK.      03251000
*        HA WAS READ SUCCESSFULLY PRIOR TO TRK-COND-CHECK.  R0 WAS      03252000
*        READ AFTERWARDS AS PART OF ERROR RECOVERY.                     03253000
ALTXDEF  CL    R15,=A(INIOB)  FAILED I/O WAS INPUT, OR OUTPUT? @V56BDA8 03254000
         BNER  R14            DOING OUTPUT, CAN'T BE TYPE/PRINT@V56BDA8 03255000
         MVC   THR000(L16),ALTR0SAV PUT R0 INTO TRACK HEADER.  @V56BDA8 03256000
         BR    R14            RETURN TO CALLER OF 'STARTIO'.   @V56BDA8 03257000
         SPACE                                                          03258000
*  WE ARRIVE HERE FOR ONE OF TWO REASONS:                               03259000
*  (1) WE HAVE A GOOD ALTERNATE TRACK AND GOT TRACK                     03260000
*      CONDITION CHECK READING BEYOND LAST RECORD; OR,                  03261000
*  (2) WE GOT FILE PROTECTION CHECK ON AN ORDINARY TRACK WHEN TRYING    03262000
*      TO READ BEYOND THE LAST RECORD.                                  03263000
ALTXPROT CLI   0(R5),146      RD COUNT CCW?                    @V56BDA8 03264000
         BE    ALTTRACK       YES, WE WERE FINDING RECORDS     @V56BDA8 03265000
         CLI   0(R5),142      RD KEY/DATA CCW?                 @V56BDA8 03266000
         BNE   DDR705         NO.  PERMANENT ERROR.            @V56BDA8 03267000
*        YES, WE MUST HAVE HIT AN OVERFLOW RECORD.                      03268000
         OI    THRFLAG,SPECIAL RECORD WAS WRITTEN WITH A       @V56BDA8 03269000
*                               WRITE SPECIAL COUNT KEY AND DATA.       03270000
         TM    IOBTYPE,TYP2311+TYP2314+TYP2305 2311/2314/2305? @V56BDA8 03271000
         BNZR  R14            YES, ONE OF THEM.  FOR THESE     @V56BDA8 03272000
*                             DEVICES THERE IS NO 'READ R0' AT THE END  03273000
*                             OF THE CHANNEL PROGRAM TO WORRY ABOUT.    03274000
*        OTHERWISE, TERMINATION DUE TO OVERFLOW RECORD AT END OF TRACK  03275000
*        PREVENTED LAST CCWS (SEE 'RR0CCW') FROM READING R0 COUNT.      03276000
*        WE MUST THEREFORE READ R0 COUNT NOW.                           03277000
         ST    R14,ALTSAVE    SAVE CALLERS RETURN ADDRESS.     @V56BDA8 03278000
         BAL   R14,GETCCHH    RETURN CCHH OF CURRENT TRK IN R1.@V56BDA8 03279000
*                             (CURRENT TRK IS PROBABLY 'INADD', BUT     03280000
*                             COULD BE AN ALTERNATE INSTEAD.)           03281000
         BAL   R14,GETHAR0    PASS R1; READS HA/R0, RETURNS.   @V56BDA8 03282000
         MVC   THR000(L8),ALTR0 PUT R0 COUNT IN TRK HEADER.    @V56BDA8 03283000
         L     R14,ALTSAVE    RESTORE RETURN ADDR.             @V56BDA8 03284000
         BR    R14            RETURN TO CALLER OF 'STARTIO'.   @V56BDA8 03285000
         SPACE                                                          03286000
DEFTRACK TM    THRHADD,X'02'  IS THIS A DEFECTIVE TRACK                 03287000
         BO    DDR715         YES- TYPE THE MSG AND RETURN TO THE      *03288000
                                   CALLER USING THE CALLERS REG 14      03289000
         CLI   0(R5),146      IS CCW A READ COUNT MT           @VA01816 03290000
         BNER  R14            NO.  RETURN TO THE CALLER.       @V56BDA8 03291000
*                             NOTE: THE THRNDRD FIELD WAS INITIALIZED   03292000
*                             TO ZERO WHEN TRACK HEADER WAS CLEARED.    03293000
*        FALL THRU IMPLIES ALT TRK ON 2314/2311/2305.  IT IS ALLOWED.   03294000
ALTTRACK EQU   *              ENTRY FOR AN ALT. TRACK IN USE.  @VA01816 03295000
*                             ENTRY ALSO FOR FILE PROTECT, TRYING TO    03296000
*                             RUN OFF END OF TRACK IN VIOLATION OF      03297000
*                             FILE MASK.                                03298000
         L     R6,CCWWORKA    *    COMPUTE THE NUMBER OF COUNT FILES    03299000
         TM    IOBTYPE,TYP3330+TYP3340+TYP3350+TYP3380         HRC012DK 03300490
         BNZ   *+8            NO                               @V2A2063 03301000
         LA    R6,8(,R6)      SKIP OVER READ REC 0 CCW         @VA01049 03302000
         SLR   R5,R6          *    READ IN. NUMBER OF RECORDS ON TRACK  03303000
         SRL   R5,3           *                                         03304000
         STH   R5,THRNDRD     SAVE THE NUMBER OF DATA RECORDS           03305000
         BR    R14            RETURN TO CALLER                          03306000
         SPACE                                                          03307000
*        HANDLE A 'NO-RECORD-FOUND' CHECK.                              03308000
NORECFND TM    D5(R5),ALTRDPRG FAILING CCW HAS FLAG            @V56BDA8 03309000
*                               INDICATING IT IS ONE OF OUR             03310000
*                               'SEARCH-FOR-RECORD-R0' CCWS?            03311000
         BZ    DDR705         DON'T KNOW WHY 'NO RECORD FOUND'.@V56BDA8 03312000
*        FALL THRU MAY MEAN WE BEGAN ON AN ALTERNATE TRACK (PROBABLY    03313000
*        THE USER IS USING TYPE/PRINT TO ACCESS IT DIRECTLY).           03314000
*        ANOTHER POSSIBILITY IS THAT WE ARE ON A NORMAL, UNFLAGGED,     03315000
*        TRACK HAVING INVALID DATA IN THE COUNT FIELD OF RECORD R0.     03316000
*        IN EITHER CASE WE WANT TO CONTINUE.  BUT OUR USUAL CHANNEL     03317000
*        PROGRAM (WHICH JUST FAILED) CANNOT READ THE TRACK BECAUSE THE  03318000
*        CONTENTS OF RECORD R0 DO NOT MATCH OUR INITIAL SEEK ADDRESS.   03319000
*        WE RECOVER BY RESTARTING THE CHANNEL PROGRAM WITH INITIAL CCWS 03320000
*        THAT OMIT THE 'SEARCH-FOR-RECORD-R0' AND DO A READ R0 INSTEAD. 03321000
         LA    R1,READ333Y    ADDR OF 'READ' RESTART CCWS.     @V56BDA8 03322000
         B     RETRYIO        GO RESTART THE READ.             @V56BDA8 03323000
         SPACE                                                          03324000
RECAL    LA    R4,RECALCCW              *    CHAIN A RECALABRATE TO THE 03325000
         CL    R4,IOBCCW                *    CCW STRING THAT WAS BEING  03326000
         BE    REPEAT                   *    EXECUTED, IF IT IS NOT     03327000
         MVC   RECALTIC+1(3),IOBCCW+1   *    ALREADY CHAINED IN.        03328000
         LR    R1,R4                    *                               03329000
REPEAT   LA    R3,1                                                     03330000
         AH    R3,DASDERCT    ADD ONE TO ERROR COUNT                    03331000
         STH   R3,DASDERCT    SAVE COUNT                                03332000
         CLI   DASDERCT+1,20  DID I DO IT 20 TIMES                      03333000
         BH    DDR705         YES- ERROR                                03334000
         CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE                 03335000
         BE    DDR705         YES, GET OUT                              03336000
         B     RETRYIO        REPEAT THE CCW STRING.           @V56BDA8 03337000
UNITEXEC CLI   0(R5),142      IS IT A READ KEY-DATA MT                  03338000
         BE    MOVECCW        YES CHANGE CCW TO READ COUNT SO  @VA01049 03339000
*                             NO EOF                                    03340000
         CLI   0(R5),X'16'    IS IT READ REC ZERO/             @VA01049 03341000
         BNE   DDR705         TO... BAD...ERROR                @VA01049 03342000
         MVI   0(R5),X'03'    MOVE IN NO-OP                    @VA01049 03343000
         B     RETRYIO        REPEAT THE CCW STRING.           @V56BDA8 03344000
MOVECCW  MVC   0(8,R5),READEOF CHANGE THE CCW TO A READ        @VA01049 03345000
*                                   COUNT SO THAT NEXT TIME I           03346000
*                               WILL NOT GET A UNIT EXCEPTION           03347000
*                              (THE KEY IS ALREADY READ)                03348000
         B     RETRYIO        REPEAT THE CCW STRING.           @V56BDA8 03349000
         SPACE 3                                                        03350000
*********************************************************************** 03351000
*                                                                       03352000
*  GETCCHH:  SUBROUTINE RETURNS CCHH ADDRESS FROM SENSE DATA.           03353000
*                                                                       03354000
*********************************************************************** 03355000
*  INPUTS:  R14 = RETURN ADDRESS.                                       03356000
*  OUTPUTS: R1  = CCHH ADDRESS OF LAST TRACK SEEKED TO PRIOR TO LAST    03357000
*                 UNIT CHECK.                                           03358000
*********************************************************************** 03359000
GETCCHH  CLI   CPUID,X'FF'    RUNNING REAL MACHINE OR VIRTUAL? @V56BDA8 03360000
         BE    GETCCHHV       BRANCH IF VIRTUAL MACHINE.       @V56BDA8 03361000
*                             DIAGNOSE I/O DOES NOT RETURN SUFFICIENT   03362000
*                             SENSE DATA TO COMPUTE THE SEEK ADDRESS.   03363000
         TM    IOBTYPE,TYP3340 IS IT A 3340/3344?              @V56BDA8 03364000
         BZ    GETCCHHV       NO.                              @V56BDA8 03365000
         IC    R1,SENSE+6     HIGH C AND GARBAGE.              @V56BDA8 03366000
         SRL   R1,5           ISOLATE 512 + 256.               @V56BDA8 03367000
         STC   R1,GETCCWRK    STORE HIGH C AND GARBAGE.        @V56BDA8 03368000
         NI    GETCCWRK,X'03' GET RID OF GARBAGE.              @V56BDA8 03369000
         MVC   GETCCWRK+1(1),SENSE+5 LOW C.                    @V56BDA8 03370000
         MVN   GETCCWRK+3(L1),SENSE+6 LOW H.                   @V56BDA8 03371000
         L     R1,GETCCWRK    LOAD CCHH FOR RETURN.            @V56BDA8 03372000
         BR    R14                                             @V56BDA8 03373000
         SPACE                                                          03374000
*        LOOK AT THE CHANNEL PROGRAM TO FIND THE SEEK ADDRESS.          03375000
*        (THIS IS PERHAPS NOT AS RELIABLE AS USING SENSE DATA?)         03376000
GETCCHHV L     R1,IOBCCW      ADDR OF CHNL PROG (& SEEK CCW).  @V56BDA8 03377000
         L     R1,0(0,R1)     ADDR OF BBCCHH.                  @V56BDA8 03378000
         ICM   R1,15,D2(R1)   LOAD CCHH.                       @V56BDA8 03379000
         BR    R14                                             @V56BDA8 03380000
         SPACE                                                          03381000
*********************************************************************** 03382000
*                                                                       03383000
*  GETHAR0:  SUBROUTINE READS HA AND RECORD R0 FROM TRACK WHOSE         03384000
*            CCHH ADDRESS IS RECEIVED IN R1.                            03385000
*                                                                       03386000
*********************************************************************** 03387000
*  INPUTS:  R14 = RETURN ADDRESS.                                       03388000
*           R1  = CCHH OF TRACK TO BE READ.                             03389000
*  OUTPUTS: ALTHA DS  XL5  = CONTENTS OF HA OF SPECIFIED TRACK.         03390000
*           ALTR0 DS  XL16 = CONTENTS OF RECORD R0 OF SPECIFIED TRACK.  03391000
*********************************************************************** 03392000
GETHAR0  STCM  R1,15,ALTSKADD+2 FOR SEEK TO SPECIFIED TRACK.   @V56BDA8 03393000
         ST    R14,SIOSAVE    FORCE 'STARTIO' TO RETURN TO OUR @V56BDA8 03394000
*                             CALLER.                                   03395000
         LA    R1,READHAR0    READ HA/R0 CHANNEL PROGRAM.      @V56BDA8 03396000
         B     RETRYIO        GO EXECUTE CHNL PROG.            @V56BDA8 03397000
         SPACE 3                                                        03398000
TAPEER   TM    IOBCSW+4,UE    IS IT UNIT EXCEPTION                      03399000
         BO    ENDOFVOL       YES- BRANCH                               03400000
         TM    SENSE,X'10'    IS IT EQU CHECK                           03401000
         BZ    TSTBUSO        NO - TEST FOR BUSOUT             @VA11415 03402200
         TM    SENSE,X'40'    TEST FOR DEV NOT READY           @VA08827 03402400
         BZ    DDR705         NO - WRITE ERROR MESSAGE         @VA08827 03402600
         B     DDR710         YES - THATS INTV. REQUIRED       @VA08827 03402800
TSTBUSO  TM    SENSE,X'20'    IS IT A BUS-OUT CHECK?           @VA08827 03403100
         BZ    TSTINREQ       NO- BRANCH                                03404000
         TM    IOBCSW+4,DE    IS IT DEVICE END                          03405000
         BZ    RETRY          NO- BRANCH                                03406000
         CLI   0(R5),X'01'    IS IT A WRITE CCW                         03407000
         BNE   RETRY          NO- BRANCH                                03408000
         LA    R1,BACKCCW     POINT TO THE BSR CCW                      03409000
         B     REPOTAPE                                                 03410000
TSTINREQ TM    SENSE,X'40'    IS IT INTERVENTION REQUIRED               03411000
         BZ    TESTCOMR       NO- BRANCH                                03412000
         TM    IOBCSW+4,DE    IS IT DEVICE END                          03413000
         BO    RETRYIO        YES- RETURN                      @V56BDA8 03414000
         B     DDR710         PRINT ERROR MSG                           03415000
TESTCOMR TM    SENSE,X'80'    IS  IT COMMAND REJECT                     03416000
         BNO   TESTORUN       NO- BRANCH                                03417000
         CLI   0(R5),X'01'    IS IT A WRITE?                   @VA10205 03417300
         BNE   NOFPTST        NO - DON'T TEST FOR FILE PROTECT @VA10205 03417600
         TM    SENSE+1,X'02'  IS THE UNIT FILE PROTECTED                03418000
         BO    DDR718         YES- BRANCH                               03419000
         B     DDR705         NO- ERROR                                 03420000
NOFPTST  EQU   *                                               @VA10205 03420500
TESTORUN TM    SENSE,X'04'    IS IT OVERRUN                             03421000
         BZ    TESTLP         NO- BRANCH                                03422000
TESTCONT TM    0(R5),X'03'    IS IT A CONTROL CCW                       03423000
         BO    RETRY          YES- BRANCH                               03424000
         B     NOISE          GO AND REPOSITION THE TAPE                03425000
TESTLP   TM    SENSE+1,X'08'  IS IT AT LOAD POINT                       03426000
         BZ    TESTDACK       NO- BRANCH                                03427000
         CLI   0(R5),X'2F'    IS THIS A BACK SPACE FILE                 03428000
         BE    SIORET         RETURN TO THE CALLER                      03429000
         CLI   0(R5),X'0F'    WAS IT REWIND UNLOAD ???         @VA04901 03430000
         BE    RETRYIO        YES, JUST RESTART I/O            @V56BDA8 03431000
         CLI   0(R5),X'27'    IS IT A BSR CCW                           03432000
         BNE   TESTDACK       NO- BRANCH                                03433000
         SR    R6,R6                                                    03434000
LOOP10   CLI   0(R5),X'27'    IS IT A BSR CCW                           03435000
         BNE   SETFSR         NO- BRANCH                                03436000
         LA    R6,8(,R6)      ADD 8 TO R6(COUNT THE BSR CCW'S)          03437000
         SL    R5,=F'8'       BACK UP 8                                 03438000
         B     LOOP10                                                   03439000
SETFSR   LA    R1,FSR1CCW+8   POINT TO THE END OF THE FSR CCW           03440000
         SR    R1,R6          POINT TO THE PROPER NUMBER OF FSR CCW'S   03441000
         B     GO                                                       03442000
TESTDACK TM    SENSE,X'08'    IS IT A  DATA CHECK                       03443000
         BZ    TESTCHDC       NO- BRANCH                                03444000
         CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE                 03445000
         BE    DDR705         YES, GET OUT                              03446000
         CLI   0(R5),X'01'    IS IT A WRITE CCW                         03447000
         BE    BACKERG        YES- BRANCH                               03448000
         CLI   0(R5),X'1F'    IS IT A WTM                               03449000
         BE    BACKERG        YES- BRANCH                               03450000
         CLI   0(R5),X'02'    IS IT A READ                              03451000
         BNE   RETRY          NO- BRANCH                                03452000
         TM    SENSE+1,X'80'  IS THE NOISE BIT ON                       03453000
         BO    NOISE          YES- BRANCH                               03454000
         LA    R6,12          SET UP TO TEST FOR NOISE RECORD           03455000
         AH    R6,IOBCSW+6    ADD THE RESIDUAL COUNT FROM THE CSW       03456000
         CH    R6,6(R5)       IS IT GREATER THAN THE CCW COUNT          03457000
         BH    RETRY          YES- BRANCH (DO NOT REPOSITION THE TAPE)  03458000
NOISE    LA    R1,BACKCCW     SET UP FOR READ REPOSITION                03459000
         B     REPOTAPE                                                 03460000
TESTCHDC TM    IOBCSW+5,X'09' IS IT A CHANNEL DATA, OR CHAINING CHECK   03461000
         BNZ   TESTCONT       YES- BRANCH                               03462000
         TM    IOBCSW+5,X'70' IS  IT A PRO, PROT OR INCORRECT LENGTH    03463000
         BNZ   DDR705         YES- ERROR                                03464000
         B     RETRY                                                    03465000
BACKERG  LA    R1,BACKECCW    SET UP FOR WRITE REPOSITION               03466000
REPOTAPE MVC   ERSAVE(28),SIOSAVE  SAVE STARTIO REGS                    03467000
         ST    R5,R5SAVE      SAVE THE CCW RESTART POINTER              03468000
GO       BAL   R14,STARTIO    REPOSITION THE TAPE                       03469000
         LM    R14,R4,ERSAVE  RETURN THE START IO REGS         @VM01075 03470000
         L     R5,R5SAVE      RESTORE CCW RESTART POINTER      @VM01075 03471000
         STM   R14,R4,SIOSAVE RETURN THE START IO REGS                  03472000
RETRY    LR    R1,R5          POINT TO THE NEW CCW CHAIN                03473000
         LA    R3,1           *    ADD ONE TO ERROR COUNT. IF OVER      03474000
         AH    R3,TAPEERCT    *    50 GO TO ERROR.  IF NOT THAN RETRY   03475000
         STH   R3,TAPEERCT    *    THE FAILING CCW.  EVERY 4 READS      03476000
         CLI   TAPEERCT+1,50  *    CLEAN THE TAPE.  IF UNDER VM/370     03477000
         BH    DDR705         *    DO NOT RETRY.                        03478000
         CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE ?               03479000
         BE    DDR705         YES, GET OUT                              03480000
         TM    TAPEERCT+1,3   *                                         03481000
         BNZ   RETRYIO        *                                @V56BDA8 03482000
         CLI   0(R5),X'02'    *                                         03483000
         BNE   RETRYIO        *                                @V56BDA8 03484000
         LA    R1,BSR4CCW     *                                         03485000
         B     REPOTAPE       *                                         03486000
ENDOFVOL TM    0(R5),X'01'    WAS THE LAST CCW A WRITE OR CONTROL       03487000
         BNO   RETRYIO        NO- MUST HAVE READ A TAPE MARK           *03488000
                              SKIP IT AND GO READ THE NEXT RECORD       03489000
         CLC   =C'VHR ',VHR   *    IF WRITING AN EOV OR AN EOF          03490000
         BNE   LABELRST       *    LABLE EVERYTHING IS OK.              03491000
         SR    R6,R6          SET UP TO COUNT THE WRITE CCW'S           03492000
LOOP3    CLI   0(R5),X'01'    IS THIS A WRITE CCW                       03493000
         BNE   BACKUP1        NO- BRANCH END OF STRING                  03494000
         LA    R6,8(R6)       ADD 8 TO CCW COUNT                        03495000
         SL    R5,=F'8'       BACK UP 8                                 03496000
         B     LOOP3          LOOP COUNTING WRITE CCW'S                 03497000
BACKUP1  LA    R1,BACKCCW6    POINT TO THE LAST CCW IN THE CHAIN        03498000
         SR    R1,R6          *    POINT TO THE PROPER NO. OF          *03499000
                              *    BSR CCW'S AND CHAIN THEM IN.         03500000
         MVC   VHR(4),=C'EOV '     MAKE THE VHR RECORD AN EOV RECORD    03501000
         MVC   VHRCYLNO,OUTADD     SET UP CYLINDER ID                   03502000
         MVI   DISPCCW,X'0F'    SET UP THE DISP COMMAND CODE TO UNLOAD  03503000
         CLC   IOBUADD,IOBATAPE    SAME TAPE??                 @VA01624 03504000
         BE    TPSWP3         YEP                              @VA01624 03505000
         OI    IOBSTAT,IOBTPSWP    NO - SET FLAG               @VA01624 03506000
TPSWP3   EQU   *                                               @VA01624 03507000
         BAL   R14,STARTIO    BACK UP AND WRITE IT OUT                  03508000
LABELOK  MVC   VHR(4),=C'VHR '     CHANGE THE EOV RECORD BACK TO A VHR  03509000
         LH    R7,IOBUADD          *    SET UP THE ALTERNATE TAPE       03510000
         MVC   IOBUADD,IOBATAPE    *    UNIT ADDRESS                    03511000
         STH   R7,IOBATAPE         *                                    03512000
         LH    R1,OUTADD+2    POINT TO THE CYLINDER ADD                 03513000
         LH    R2,OUTADD+4    AND THE TRACK ADDRESS                     03514000
         BAL   R14,MSG005          GO PRINT THE END OF VOL MSG          03515000
         L     R7,CUREXT      POINT TO THE CURRENT EXTENT               03516000
         LH    R1,CYLSTART              *    SET UP THE CYLINDER        03517000
         CVD   R1,WORK1                 *    EXTENTS FOR THE            03518000
         UNPK  INSTART(4),WORK1         *    CYLINDER MAP AND RESET THE 03519000
         LH    R1,INADD+2               *    EXTENT TABLE FOR THE NEXT  03520000
         STH   R1,CYLSTART              *    TIME                       03521000
         CVD   R1,WORK1                 *                               03522000
         UNPK  INSTOP(4),WORK1          *                               03523000
         LH    R1,CYLREOR               *                               03524000
         CVD   R1,WORK1                 *                               03525000
         UNPK  OUTSTART(4),WORK1        *                               03526000
         LH    R1,OUTADD+2              *                               03527000
         STH   R1,CYLREOR               *                               03528000
         CVD   R1,WORK1                 *                               03529000
         UNPK  OUTSTOP(4),WORK1         *                               03530000
         BAL   R14,PRINTEXT             *                               03531000
         CL    R10,BAREMAC    UNDER CMS ?                               03532000
         BE    NOTCMS1        NO- BRANCH                                03533000
         WAITT                WAIT FOR THE MSG TO GET OUT               03534000
NOTCMS1  EQU   *                                                        03535000
         LA    R1,WRITEVHR    SET UP TO WRITE VHR                       03536000
         LA    R15,OUTIOB     RESET THE IOB POINTER                     03537000
         BAL   R14,STARTIO    DO IT                                     03538000
         B     TESTOUT        GO WRITE THE SAME DATA ON A NEW TAPE      03539000
LABELRST TM    4(R5),CC       IS THIS CCW CHAINED                       03540000
         BZ    IORETURN       NO- RETURN TO CALLER                      03541000
         ICM   R1,7,IOBCSW+1  POINT TO THE NEXT CCW                     03542000
         B     RETRYIO        RESTART THE CHAIN.                        03543000
         EJECT                                                          03544000
******************************************************************      03545000
*.                                                                      03546000
*  24.   START IO ROUTINE                                               03547000
*                                                                       03548000
*              1. IF RUNNING UNDER VM/370 GO TO STEP 10.                03549000
*                                                                       03550000
*              2. IF AN ERROR IS STACKED, UNSTACK IT AND GO TO          03551000
*                 STEP 5.                                               03552000
*                                                                       03553000
*              3. START THE DEVICE.                                     03554000
*                                                                       03555000
*              4. IF CHANNEL STATUS IS ZERO AND IF NO UC, UE OR         03556000
*                 ATTN IS IN THE UNIT STATUS GO TO STEP 7.              03557000
*                                                                       03558000
*              5. IF THIS IS THE DEVICE I STARTED GO TO DO A SENSE,     03559000
*                 ELSE STACK THE ERROR IN THE IOB.                      03560000
*                                                                       03561000
*              6. GO TO THE ERROR ROUTINE IF PROVIDED, ELSE CHECK       03562000
*                 THE OPTION SWITCHES TO STOP, REPEAT OR RETURN.        03563000
*                                                                       03564000
*              7. IF THIS IS THE DEVICE I STARTED CONTINUE, ELSE WAIT   03565000
*                 FOR THE NEXT IO INTERRUPT. (RENTER AT STEP 4)         03566000
*                                                                       03567000
*              8. IF PROPER ENDING STATUS, CE AND/OR DE, RETURN TO      03568000
*                 CALLER. ELSE RETURN TO CALLER.                        03569000
*                                                                       03570000
*              9. IF THIS IS A DASD DEVICE CONTINUE, ELSE GO TO         03571000
*                 STEP 2.                                               03572000
*                                                                       03573000
*              10. DO A DIAGNOSE CALL TO VM/370 AND LET CP DO THE       03574000
*                  WORK.                                                03575000
*                                                                       03576000
*              11. IF ERROR GO TO THE ERROR ROUTINE, ELSE RETURN        03577000
*                  TO THE CALLER.                                       03578000
*.                                                                      03579000
******************************************************************      03580000
STARTIO  STM   R14,R4,SIOSAVE SAVE REGS                                 03581000
RETRYIO  L     R2,IOB         GET IOB FROM CALLER              @V56BDA8 03582000
         TM    IOBOPT,IOBSIO  DO SIO'S FOR THIS DEVICE ?       @V2A2063 03583000
         BO    RETSIO         YES - BRANCH                     @V2A2063 03584000
         CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE ?               03585000
         BE    DIAGNOSE       YES - LET CP DO THE WORK                  03586000
RETSIO   TM    IOBSTAT,IOBSTACK    IS AN IO ERROR STACKED FOR THIS UNIT 03587000
         BO    UNSTACK        YES- BRANCH TO UNSTACK IT                 03588000
RESTART  ST    R1,CAW         SET UP CAW                                03589000
         XC    CSW,CSW        ZERO THE CSW                              03590000
         L     R4,TRACEPT     *    TRACE ROUTINE                        03591000
         STM   R1,R2,0(R4)    *                                         03592000
         STM   R14,R15,8(R4)  *                                         03593000
         MVI   0(R4),C'S'     *                                         03594000
         LA    R4,16(R4)      *                                         03595000
         CL    R4,TRACEEND    *                                         03596000
         BL    *+8            *                                         03597000
         L     R4,TRACEST     *                                         03598000
         ST    R4,TRACEPT     *                                         03599000
         SIO   0(R2)                                                    03600000
         BC    4,CSWSTORE     GO AND TEST STATUS                        03601000
         BC    2,IOWAIT       BUSY -- WAIT FOR INTERRUPT.      @VA01135 03602000
         BC    1,NOTOPER      GO TO THE NOT OPER ERROR ROUTINE          03603000
         LA    R2,0(,R2)      INDICATE IO STARTED                       03604000
         ST    R1,IOBCCW      SAVE POINTER TO THE CCW STRING            03605000
IOWAIT   LPSW  IOWPSW         INABLE IO INTERRUPTIONS                   03606000
IOINT    MVI   IOOLD,X'01'    TURN OFF ALL BUT EXTERNAL INTERRUPT       03607000
         NI    IOOLD+1,X'FD'  TURN OFF WAIT BIT                         03608000
         LPSW  IOOLD          LOAD IO OLD PSW                           03609000
CSWSTORE EQU   *                                                        03610000
         TM    CSW+4,BUSY     IS THE UNIT BUSY                          03611000
         BZ    LOOKATCE       NO- GO LOOK AT CE                         03612000
         TM    CSW+4,DE+ATTN+CUE+CE     IS THIS ENDING STATUS           03613000
         BNZ   STUADD         YES- BRANCH                               03614000
         LPSW  IOWPSW         WAIT FOR ENDING STATUS                    03615000
LOOKATCE TM    CSW+4,CE       IS THIS CHANNEL END                       03616000
         BZ    STUADD         NO- BRANCH                                03617000
         LA    R2,0(,R2)      INDICATE IO STARTED                       03618000
         ST    R1,IOBCCW      POINT TO THE CCW STRING                   03619000
         LA    R4,8(,R1)      POINT TO THE FIRST CCW + 8                03620000
         ST    R4,CSW         AND SAVE IT IN THE CSW                    03621000
STUADD   STH   R2,IOOLD+2     POINT TO THE INTERRUPTING DEVICE          03622000
TESTATTN EQU   *                                                        03623000
         L     R4,TRACEPT     *    TRACE ROUTINE                        03624000
         MVC   0(16,R4),IOOLD *                                         03625000
         MVI   0(R4),C'I'     *                                         03626000
         LA    R4,16(,R4)     *                                         03627000
         CL    R4,TRACEEND    *                                         03628000
         BL    *+8            *                                         03629000
         L     R4,TRACEST     *                                         03630000
         ST    R4,TRACEPT     *                                         03631000
TESTSTAT TM    CSW+5,X'FF'    TEST ALL CHANNEL STATUS.  IS IT ZERO?     03632000
         BNZ   IOERROR        NO- ERROR                                 03633000
         TM    CSW+4,UC+UE+ATTN TEST UNIT STATUS, IS IT BAD?            03634000
         BNZ   IOERROR        YES- ERROR                                03635000
TESTDEV  LR    R4,R2          GET THE ADDRESS OF THE DEVICE WAITING FOR 03636000
         TM    CSW+4,X'20'    IS THIS A CU END INT                      03637000
         BZ    TESTADD        NO- GO TEST THE ADD                       03638000
         LTR   R2,R2          WAS THE UNIT STARTED             @VA01134 03639000
         BM    RESTART        NO-RESTART                       @VA01134 03640000
         B     IOWAIT         GO WAIT FOR NEXT INTERRUPT       @VA01134 03641000
TESTADD  CLM   R4,3,IOOLD+2   IS THIS THE DEVICE WAITING FOR            03642000
         BNE   IOWAIT         NO- GO WAIT FOR THE NEXT INT              03643000
         LTR   R2,R2          WAS THE UNIT STARTED                      03644000
         BM    RESTART        NO- RESTART THE UNIT                      03645000
         TM    IOBOPT,IOBDEW MUST I WAIT FOR DEVICE END                 03646000
         BZ    TESTCE         NO- BRANCH                                03647000
         TM    CSW+4,DE       IS IT DEVICE END                          03648000
         BC    1,SIORET       YES- RETURN TO CALLER                     03649000
         LPSW  IOWPSW         WAIT FOR THE NEXT IO INTERRUPT            03650000
TESTCE   TM    CSW+4,CE+DE    IS IT CHANEL END OR DEVICE END            03651000
         BNZ   SIORET         YES- RETURN                               03652000
         LPSW  IOWPSW         WAIT                                      03653000
IOERROR  CLC   IOBUADD,IOOLD+2     IS THIS THE DEVICE I AM WORKING WITH 03654000
         BNE   STACK          NO- BRANCH TO STACK THE IO ERROR          03655000
         MVC   IOBCSW(8),CSW  MOVE IN CSW                               03656000
UNSTACK  NI    IOBSTAT,255-IOBSTACK     TURN IOBSTACK BIT OFF           03657000
         LA    R4,SENSECCW    POINT TO SENSE CCW                        03658000
         ST    R4,CAW         SET UP CAW                                03659000
         XC    SENSE,SENSE    ZERO OUT SENSE                            03660000
         SIO   0(R2)          DO A SENSE                                03661000
TIO      TIO   0(R2)          CLEAR ANY INTERRUPT                       03662000
         BC    2,TIO          LOOP IF CHANNEL IS BUSY                   03663000
         L     R4,TRACEPT     *    TRACE ROUTINE                        03664000
         STM   R1,R2,0(R4)    *                                         03665000
         MVC   8(8,R4),SENSE  *                                         03666000
         MVI   0(R4),C'E'     *                                         03667000
         LA    R4,16(,R4)     *                                         03668000
         CL    R4,TRACEEND    *                                         03669000
         BL    *+8            *                                         03670000
         L     R4,TRACEST     *                                         03671000
         ST    R4,TRACEPT     *                                         03672000
         LA    R4,24          CALULATE NUMBER OF SENSE BYTES   @V2B3729 03673000
         SH    R4,CSW+6       ..                               @V2B3729 03674000
         STC   R4,SNSCNT      READ AND SAVE                    @V2B3729 03675000
         L     R4,IOBERROR    GET THE ADDRESS OF THE ERROR ROUTINE      03676000
         LTR   R4,R4          DO I HAVE AN IO ERROR ROUTINE             03677000
         BCR   7,R4           YES- GO TO IT                             03678000
IORETURN TM    IOBOPT,IOBEEXIT     DO I REPEAT THE CCW STRING           03679000
         BNO   TESTSTOP       NO- BRANCH                                03680000
         L     R2,IOB         SET UP TO REPEAT CCW STRING               03681000
TESTSTOP TM    IOBOPT,IOBERST      DO I STOP ON ERROR                   03682000
         BNO   TESTST         NO- BRANCH                                03683000
         LPSW  IOWPSW                                                   03684000
TESTST   LTR   R2,R2          IS DEVICE STARTED                         03685000
         BM    RESTART        NO- BRANCH TO START DEVICE                03686000
SIORET   LM    R14,R4,SIOSAVE RETURN REGS                               03687000
         BR    R14            RETURN TO CALLER                          03688000
         DROP  R15                                                      03689000
         USING IOB,R4                                                   03690000
* REMEMBER - R15 STILL POINTS TO ACTIVE IOB.                            03691000
STACK    LA    R4,INIOB                                                 03692000
SCANIOBS CLC   IOBUADD,IOOLD+2     IS THIS THE ERROR IOB                03693000
         BNE   UPDATE2        NO- BRANCH                                03694000
         MVC   IOBCSW(8),CSW  MOVE ERROR CSW INTO IOB                   03695000
         OI    IOBSTAT,IOBSTACK    TURN ON ERROR STACKED BIT            03696000
         LPSW  IOWPSW         NOW WAIT FOR MY INTERRUP                  03697000
UPDATE2  TM    IOBSTAT,IOBLAST     IS THIS THE LAST IOB                 03698000
         LA    R4,IOBSIZE(,R4)     POINT TO THE NEXT IOB                03699000
         BNO   SCANIOBS       NO- BRANCH IF THIS IS NOT THE LAST IOB    03700000
* 1ST PASS => NO DEV. ADDR. MATCHED 'IOBUADD'. CHK POSSIBLE ENDING      03701000
* INT. ON TAPE 'REWIND-UNLOAD' OPERATION ON 'ALTERNATE' TAPE.           03702000
         CLI   CSW+4,CUE+DE+UC     POSSIBILITY??               @VA01135 03703000
         BNE   IOWAIT         NO - WAIT FOR INTERRUPT          @VA01135 03704000
         TM    IOBSTAT-IOB(R15),IOBTPSWP     YES -  THIS IOB?  @VA01135 03705000
         BZ    IOBSCN2        NO - LOCATE IOB                  @VA01135 03706000
         CLC   IOBATAPE-IOB(2,R15),IOOLD+2   THIS THE ONE??    @VA01624 03707000
         BNE   IOBSCN2        NO - FIND THE DEVICE             @VA01135 03708000
         NI    IOBSTAT-IOB(R15),255-IOBTPSWP RESET FLAG.       @VA01135 03709000
         B     RESTART        RESTART I/O                      @VA01135 03710000
IOBSCN2  EQU   *                                               @VA01135 03711000
         LA    R4,INIOB       START AT THE TOP                 @VA01135 03712000
TSTSWP   EQU   *                                               @VA01135 03713000
         TM    IOBSTAT,IOBTPSWP    THIS THE ONE MAYBE?         @VA01135 03714000
         BZ    UPDATE5        NO - TRY NEXT                    @VA01135 03715000
         CLC   IOBATAPE,IOOLD+2    THIS THE ONE?               @VA01135 03716000
         BNE   UPDATE5        NO                               @VA01135 03717000
         NI    IOBSTAT,255-IOBTPSWP     YES - RESET THE FLAG   @VA01135 03718000
         LPSW  IOWPSW         AND WAIT FOR INT. ON ACT. IOB    @VA01135 03719000
UPDATE5  EQU   *                                               @VA01135 03720000
         TM    IOBSTAT,IOBLAST     THIS THE LAST IOB?          @VA01135 03721000
         LA    R4,IOBSIZE(,R4)     POINT TO NEXT IOB           @VA01135 03722000
         BNO   TSTSWP         NOT LAST - ANALYZE               @VA01135 03723000
         LPSW  IOWPSW         INTERRUP WAS NOT FROM A UNIT I           X03724000
                              STARTED SO IGNORE IT AND WAIT FOR MINE    03725000
         DROP  R4                                                       03726000
         USING IOB,R15                                                  03727000
NOTOPER  L     R15,SIOSAVE+4  RETURN THE IOB POINTER                    03728000
         OI    IOBSTAT,IOBNOPER    TURN ON THE NOT OPER BIT             03729000
         L     R4,IOBERROR    GET THE ADDRESS OF THE IO ERROR ROUTINE   03730000
         LTR   R4,R4          IS THERE AN ERROR ROUTINE                 03731000
         BCR   2,R4           YES- GO TO IT                             03732000
         B     DDR704                                                   03733000
DIAGNOSE TM    IOBCLASS,CLASTAPE+CLASDASD    IS IT TAPE OR DASD         03734000
         BZ    RETSIO                        NO- RETURN TO SIO          03735000
         MVI   DEVBUCT+1,X'00' CLEAR BUSY COUNTER              @VA10042 03735300
BUSYRTRY EQU   *                                               @VA10042 03735600
         LR    R3,R1          SET UP R3 FOR DIAG                        03736000
         L     R4,TRACEPT     *    TRACE ROUTINE                        03737000
         STM   R1,R2,0(R4)    *                                         03738000
         STM   R14,R15,8(R4)  *                                         03739000
         MVI   0(R4),C'S'     *                                         03740000
         LA    R4,16(R4)      *                                         03741000
         CL    R4,TRACEEND    *                                         03742000
         BL    *+8            *                                         03743000
         L     R4,TRACEST     *                                         03744000
         ST    R4,TRACEPT     *                                         03745000
         SSM   *+1            LOCK OUT CMS                              03746000
         ST    R1,IOBCCW      POINT TO THE CCW STRING                   03747000
         LA    R2,0(,R2)      INDICATE IO STARTED                       03748000
         DC    X'83230020'    DIAGNOSE CALL TO VM/370                   03749000
         BE    SIORET         IF CC = 0 ALL OK (RETURN TO CALLER)       03750000
         L     R4,TRACEPT     *    TRACE ROUTINE                        03751000
         ST    R3,0(R4)       *                                         03752000
         ST    R15,4(R4)      *                                         03753000
         MVC   8(8,R4),CSW    *                                         03754000
         MVI   0(R4),C'I'     *                                         03755000
         LA    R4,16(,R4)     *                                         03756000
         CL    R4,TRACEEND    *                                         03757000
         BL    *+8            *                                         03758000
         L     R4,TRACEST     *                                         03759000
         ST    R4,TRACEPT     *                                         03760000
         XC    SENSE,SENSE    CLEAN UP SENSE                   @VA12739 03760500
         CL    R15,=F'1'      IS THE RETURN CODE 1                      03761000
         BE    NOTOPER        YES- THE UNIT IS NOT OPERATIONAL          03762000
         CL    R15,=F'5'      BUSY OR INTPT. PENDING?          @VA10042 03762100
         BNE   CKMOR          NO-CONTINUE CHECK                @VA10042 03762200
         LA    R4,1                                            @VA10042 03762300
         AH    R4,DEVBUCT     ADD ONE TO BUSY COUNT            @VA10042 03762400
         STH   R4,DEVBUCT     STORE COUNT                      @VA10042 03762500
         CLI   DEVBUCT+1,20   HAVE WE GONE 20 TIMES?           @VA10042 03762600
         BH    DDR705         YES-BUSY TOO LONG                @VA10042 03762700
         B     BUSYRTRY                                        @VA10042 03762800
CKMOR    EQU   *                                               @VA10042 03762900
         CL    R15,=F'13'     IS THE RETURN CODE 13                     03763000
         BNE   RET            NO- BRANCH                                03764000
         STH   R3,SENSE       SAVE THE SENSE                            03766000
         MVI   SNSCNT,X'02'   INDICATE 2 SENSE BYTES PRESENT   @V2B3729 03767000
RET      L     R15,SIOSAVE+4  RETURN THE IOB POINTER                    03768000
         MVC   IOBCSW(8),CSW  MOVE IN THE CSW FROM CMS                  03769000
         L     R4,IOBERROR    GET THE ERROR ROUTINE POINTER             03770000
         LTR   R4,R4          DO I HAVE AN ERROR ROUTINE                03771000
         BCR   2,R4           YES- GO TO IT                             03772000
         B     SIORET         NO- RETURN TO THE CALLER                  03773000
         EJECT                                                          03774000
********************************************************************    03775000
GRAPHID  EQU   *                                               @V200731 03776000
         TM    PARM,PARMGRP   IS THE GRAPHIC INDICATOR ACTIVE ?@V200731 03777000
         BZ    STARTIO        NO, GO START THE I/O REQUEST     @V200731 03778000
         STM   R14,R5,GRAPHSAV SAVE THE REGISTERS              @V200731 03779000
         LR    R4,R1          GET THE ADDRESS OF THE CCW STRING@V200731 03780000
GETCCW   EQU   *                                               @V200731 03781000
         LH    R3,6(R4)       GET THE DATA COUNT FROM THE CCW  @V200731 03782000
         STM   R3,R4,SAVEAREA SAVE THE DATA REGISTERS          @V200731 03783000
         NI    PARM,X'FF'-(PARMREA+PARMNDA) CLEAR THE READ     @V200731 03784000
*                             REQUEST                                   03785000
*                             AND NO DATA INDICATOR                     03786000
         LA    R2,5           SET THE LOOP COUNT               @V200731 03787000
         LA    R1,TABLGRAP    GET THE ADDRESS OF THE COMMAND   @V200731 03788000
*                             OP TABLE                                  03789000
         ICM   R5,1,0(R4)     GET THE OP CODE                  @V200731 03790000
CCWEXEC  EQU   *                                               @V200731 03791000
         EX    R5,CLIP        TEST THE COMMAND OP CODE WITH    @V200731 03792000
*                             TABLE CODE                                03793000
         BE    GRAPHADD       YES, FOUND THE COMMAND OP CODE   @V200731 03794000
         LA    R1,4(R1)       UPDATE THE ADDRESS IN THE TABLE  @V200731 03795000
         BCT   R2,CCWEXEC     GO TEST THE NEXT OP CODE         @V200731 03796000
         B     EXIT           INVALID OP CODE - GO EXIT        @V200731 03797000
CLIP     CLI   0(R1),X'00'    TEST THE OP CODE IN THE TABLE    @V200731 03798000
GRAPHADD EQU   *                                               @V200731 03799000
         ICM   R2,7,1(R1)     GET THE ADDRESS OF THE OP CODE   @V200731 03800000
*                             ROUTINE                                   03801000
         BR    R2             GO TO THE ROUTINE                @V200731 03802000
         SPACE 2                                                        03803000
READ66   EQU   *                                               @V200731 03804000
         OI    PARM,PARMREA+PARMATT INDICATE READ AND ATTENTION@V200731 03805000
*                             REQUESTS                                  03806000
         LA    R14,GRAPHIC0   RETURN ADDRESS FROM I/O HANDLER  @V200731 03807000
         XC    BLNKLINE(140),BLNKLINE CLEAR THE READ AREA      @VM08604 03808000
         MVI   IOBCSW+4,X'00' CLEAR THE CSW STATUS             @V200731 03809000
         XC    RDMIDATA(6),RDMIDATA CLEAR THE READ DATA FIELD  @V200731 03810000
         MVC   CPXYSTAT(20),REALABEL                           @V200731 03811000
         LA    R1,REQREAD     GET THE ADDRESS OF THE CHANNEL   @V200731 03812000
*                             PROGRAM                                   03813000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03814000
         BZ    STARTIO        NO, GO ISSUE SIO                 @V200731 03815000
         LA    R1,REQREAD1    GET THE ADDRESS OF THE CHANNEL   @V200731 03816000
*                             PROGRAM                                   03817000
         B     STARTIO        GO TO THE I/O HANDLER            @V200731 03818000
         SPACE 2                                                        03819000
WRT66    EQU   *                                               @V200731 03820000
         MVC   CPXYSTAT(20),RUNLABEL                           @V200731 03821000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03822000
         BO    YES3270        YES, GO TO 3270 SUPPORT          @V200731 03823000
         MVC   WRT3066+1(3),1(R4) GET THE MESSAGE ADDRESS      @V200731 03824000
         STH   R3,WRT3066+6   SAVE THE DATA COUNT IN THE CCW   @V200731 03825000
         LA    R1,WRTCRTXY    GET THE ADDRESS OF THE CHANNEL   @V200731 03826000
*                             PROGRAM                                   03827000
         TM    PARM,PARMCLE   IS THE ERASE INDICATOR ON ?      @V200731 03828000
         BZ    GRAPWRT        NO, GO TO SIO SECTION            @V200731 03829000
         LA    R1,ERSE3066    GET THE ADDRESS OF THE CHANNEL   @V200731 03830000
*                             PROGRAM                                   03831000
         MVI   SBADDR,X'00'   CLEAR LINE POINTER               @V200731 03832000
GRAPWRT  EQU   *                                               @V200731 03833000
         LA    R14,GRAPHIC1   RETURN ADDRESS FROM I/O HANDLER  @V200731 03834000
         B     STARTIO        GO TO THE I/O HANDLER            @V200731 03835000
YES3270  EQU   *                                               @V200731 03836000
         SR    R14,R14        CLEAR REGISTER 14                @V200731 03837000
         LA    R1,WRTCRT70    GET THE ADDRESS OF THE CHANNEL   @V200731 03838000
*                             PROGRAM                                   03839000
         TM    PARM,PARMCLE   IS THE ERASE INDICATOR ON ?      @V200731 03840000
         BZ    NOCL3270       NO, DON'T CLEAR SCREEN           @V200731 03841000
         MVI   SBADDR,X'00'   CLEAR LINE POINTER               @V200731 03842000
         LA    R1,ERSE3270    GET THE ADDRESS OF THE CHANNEL   @V200731 03843000
*                             PROGRAM                                   03844000
NOCL3270 EQU   *                                               @V200731 03845000
         IC    R14,SBADDR     GET THE CURRENT LINE POINTER     @V200731 03846000
         SLL   R14,1          SETUP THE INDEX INTO THE TABLE   @V200731 03847000
         LH    R14,TABLE70(R14) GET THE LINE ADDRESS           @V200731 03848000
         STCM  R14,3,LAB3270+2 SAVE THE CURRENT LINE POINTER   @V200731 03849000
         MVC   WRTCR70+1(3),1(R4) GET THE MESSAGE ADDRESS      @V200731 03850000
         STH   R3,WRTCR70+6   SAVE THE BYTE COUNT IN THE CCW   @V200731 03851000
         B     GRAPWRT        GO GET THE RETURN ADDRESS        @V200731 03852000
         SPACE 2                                                        03853000
GRAPHIC1 EQU   *                                               @V200731 03854000
         LM    R3,R4,SAVEAREA GET THE DATA REGISTERS           @V200731 03855000
         NI    PARM,X'FF'-PARMCLE CLEAR THE ERASE INDICATOR    @V200731 03856000
         SR    R2,R2          CLEAR REGISTER 2                 @V200731 03857000
         IC    R2,SBADDR      GET THE Y COORDINATE             @V200731 03858000
         LA    R2,1(R2)       UPDATE THE Y COORDINATE          @V200731 03859000
         CH    R3,=H'80'      IS THE DATA COUNT LONGER THAN 1  @V200731 03860000
*                             LINE                                      03861000
         BNH   *+8            NO, GO SAVE Y COORDINATE         @V200731 03862000
         LA    R2,1(R2)       UPDATE THE Y COORDINATE AGAIN    @V200731 03863000
         STC   R2,SBADDR      SAVE THE Y COORDINATE            @V200731 03864000
         MH    R2,=H'80'      GET THE BYTE LENGTH              @V200731 03865000
         L     R1,=F'2640'    GET THE MAX. LENGTH              @V200731 03866000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03867000
         BZ    TEST3066       NO, GO TEST FOR END OF CRT       @V200731 03868000
         L     R1,MAXLEN      GET THE MAX. LEN FOR 3270=1760   @V60A6B6 03869000
*                             MAXLEN FOR 3278 MOD2A=1440                03870000
TEST3066 EQU   *                                               @V200731 03871000
         CR    R2,R1          IS THE Y COORDINATE AT THE END   @V200731 03872000
*                             OF THE                                    03873000
*                             CRT                                       03874000
         BL    RETWORD        NO, CHECK FOR CMD CHAINING       @VA08599 03875000
         OI    PARM,PARMATT   SET THE ATTENTION REQUEST        @V200731 03876000
         MVI   IOBCSW+4,X'00' CLEAR THE CSW STATUS             @V200731 03877000
         MVC   CPXYSTAT(20),MORLABEL                           @V200731 03878000
         LA    R14,GRAPHIC3   RETURN ADDRESS FROM I/O HANDLER  @V200731 03879000
         LA    R1,CRTWORD     GET THE ADDRESS OF THE CHANNEL   @V200731 03880000
*                             PROGRAM                                   03881000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03882000
         BZ    STARTIO        NO, GO ISSUE SIO                 @V200731 03883000
         LA    R1,MORECCW1    GET THE ADDRESS OF THE CHANNEL   @V200731 03884000
*                             PROGRAM                                   03885000
         B     STARTIO        GO ISSUE SIO                     @V200731 03886000
GRAPHIC3 EQU   *                                               @V200731 03887000
         TM    IOBCSW+4,ATTN  IS THE ATTENTION FLAG ACTIVE ?   @V200731 03888000
         BZ    GRAPPSW        NO, GO WAIT FOR AN ATTENTION     @V200731 03889000
*                             INTERRUPT                                 03890000
         NI    PARM,X'FF'-PARMATT CLEAR THE ATTENTION INDICATOR@V200731 03891000
CANCEL1  EQU   *                                               @V200731 03892000
         LM    R3,R4,SAVEAREA GET THE DATA REGISTERS           @V200731 03893000
         MVI   SBADDR,X'00'   SET THE Y COORDINATE TO ZERO     @V200731 03894000
         MVC   CPXYSTAT(20),RUNLABEL CRT DISPLAY RUN STATUS    @V200731 03895000
         LA    R1,CNCL3066    GET THE ADDRESS OF THE CHANNEL   @V200731 03896000
*                             PROGRAM                                   03897000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03898000
         BZ    RETURNCN       NO, GO GET RETURN ADDRESS        @V200731 03899000
         LA    R1,CNCL3270    GET THE ADDRESS OF THE CHANNEL   @V200731 03900000
*                             PROGRAM                                   03901000
RETURNCN EQU   *                                               @V200731 03902000
         LA    R14,READ66     GET THE ADDRESS OF THE READ      @V200731 03903000
*                             SECTION                                   03904000
         TM    PARM,PARMREA   IS THIS A READ REQUEST ?         @V200731 03905000
         BO    STARTIO        YES, GO TO THE I/O HANDLER       @V200731 03906000
         LA    R14,RETWORD    RETURN ADDRESS FROM I/O HANDLER  @V200731 03907000
         B     STARTIO        GO TO THE I/O HANDLER            @V200731 03908000
         SPACE 1                                                        03909000
GRAPHIC0 EQU   *                                               @V200731 03910000
         TM    IOBCSW+4,ATTN  IS THE ATTENTION FLAG ACTIVE ?   @V200731 03911000
         BO    GRAPATTN       YES, GO SETUP CCW FOR READ       @V200731 03912000
*                             MANUAL INPUT                              03913000
GRAPPSW  EQU   *                                               @V200731 03914000
         LPSW  IOWPSW         GO WAIT FOR INTERRUPT            @V200731 03915000
         SPACE 1                                                        03916000
GRAPATTN EQU   *                                               @V200731 03917000
         LM    R3,R4,SAVEAREA GET THE DATA REGISTERS           @V200731 03918000
         NI    PARM,X'FF'-PARMATT CLEAR ATTENTION REQUEST      @V200731 03919000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03920000
         BO    YES3270A       YES, GO TO 3270 SUPPORT          @V200731 03921000
         STH   R3,RD3066DA+6  STORE THE COUNT IN THE CCW       @V200731 03922000
         MVC   RD3066DA+1(3),1(R4) MOVE THE ADDRESS OF THE READ@V200731 03923000
*                             BUFFER INTO THE CCW                       03924000
         LA    R1,RDMI3066    GET THE ADDRESS OF THE CHANNEL   @V200731 03925000
*                             PROGRAM                                   03926000
RETURNAD EQU   *                                               @V200731 03927000
         LA    R14,RET66MI    RETURN ADDRESS FROM I/O HANDLER  @V200731 03928000
         B     STARTIO        GO TO THE I/O HANDLER            @V200731 03929000
YES3270A EQU   *                                               @V200731 03930000
         LA    R1,6(R3)       ADD  6 T0 THE TOTAL COUNT        @V200731 03931000
         STH   R1,RD3270DA+6  STORE THE COUNT IN THE CCW       @V200731 03932000
         LA    R1,BLNKLINE    GET THE ADDRESS OF THE BUFFER    @V200731 03933000
         STCM  R1,7,RD3270DA+1 MOVE THE ADDRESS OF THE READ    @V200731 03934000
*                             BUFFER INTO THE CCW                       03935000
         LA    R1,RDMI3270    GET THE ADDRESS OF THE CHANNEL   @V200731 03936000
*                             PROGRAM                                   03937000
         B     RETURNAD       GO GET THE RETURN ADDRESS        @V200731 03938000
         SPACE 2                                                        03939000
RET66MI  EQU   *                                               @V200731 03940000
         LM    R3,R4,SAVEAREA GET THE DATA REGISTERS           @V200731 03941000
         MVC   CPXYSTAT(20),RUNLABEL CRT DISPLAY RUN STATUS    @V200731 03942000
         LA    R1,CRTWORD     GET THE ADDRESS OF THE CHANNEL   @V200731 03943000
*                             PROGRAM                                   03944000
         LA    R14,RETINPUT   RETURN ADDRESS FROM I/O HANDLER  @V200731 03945000
         TM    PARM,PARM327   IS THIS A 3270 GRAPHIC ?         @V200731 03946000
         BO    YES3270B       YES, GO CHECK 3270 SUPPORT       @V200731 03947000
         TM    RDMIDATA+2,X'40' DID THE OPERATOR HIT THE       @V200731 03948000
*                             CANCEL KEY                                03949000
         BO    CANCEL1        YES, GO CLEAR SCREEN             @V200731 03950000
         CLC   RDMIDATA(2),SBAREAD DID THE CURSOR MOVE ?       @V200731 03951000
         BNE   STARTIO        YES, GO WRITE STATUS             @V200731 03952000
         OI    PARM,PARMNDA   SET INDICATOR FOR NO DATA        @V200731 03953000
         B     STARTIO        GO WRITE OUT STATUS              @V200731 03954000
YES3270B EQU   *                                               @V200731 03955000
         CLI   BLNKLINE,X'6E' DID THE OPERATOR HIT THE CANCEL  @V200731 03956000
*                             KEY                                       03957000
         BE    CANCEL1        YES, GO CLEAR SCREEN             @V200731 03958000
         CLI   BLNKLINE,X'6D' DID THE OPERATOR HIT THE CLEAR   @V200731 03959000
*                             KEY                                       03960000
         BE    CANCEL1        YES, GO CLEAR SCREEN             @V200731 03961000
         CLI   BLNKLINE,X'6C' DID OPERATOR HIT PA1 KEY         @V200731 03962000
         BE    CANCEL1        YES, GO CLEAR SCREEN             @V200731 03963000
         OI    PARM,PARMNDA   SET INDICATOR FOR NO DATA        @V200731 03964000
         CLI   BLNKLINE,X'01' DID OPERATOR HIT TEST REQ. KEY   @VM08604 03965000
         BE    ENT3270        YES, GO WRITE STATUS             @VM08604 03966000
         CLI   BLNKLINE,X'E6' IS THIS THE CARD READER          @VM08604 03967000
         BE    ENT3270        YES, GO WRITE STATUS             @VM08604 03968000
         CLI   BLNKLINE+6,X'00' DATA IN INPUT AREA ?           @VM08604 03969000
         BNE   DATA3270       YES, GO DISPLAY DATA             @VM08604 03970000
         CLC   BLNKLINE+1(2),ADDR5 DID CURSOR MOVE             @V60A6B6 03971000
         BE    ENT3270        NO, GO WRITE STATUS              @VM08604 03972000
DATA3270 EQU   *                                               @VM08604 03973000
         NI    PARM,X'FF'-PARMNDA SET INDICATOR FOR NO DATA    @VM08604 03974000
         ICM   R1,7,1(R4)     GET ADDRESS OF USER'S BUFFER              03975000
         BCTR  R3,R0          SUBTRACT ONE FROM COUNT                   03976000
         EX    R3,MOV3270     MOVE DATA INTO USER'S BUFFER     @VM08921 03977000
         LA    R3,1(,R3)      UPDATE THE DATA COUNT            @VM08921 03978000
MOVEBLNK EQU   *                                               @VM08921 03979000
         OI    0(R1),X'40'    SET UP FOR UPPERCASE LETTER      @VM08921 03980000
         LA    R1,1(,R1)      UPDATE THE BUFFER ADDRESS BY ONE @VM08921 03981000
         BCT   R3,MOVEBLNK    GO SET CHARACTERS TO UPPERCASE   @VM08921 03982000
ENT3270  EQU   *                                               @VM08921 03983000
         LA    R1,CRTWORD1    GET ADDR OF CHANNEL PROGRAM      @VM08921 03984000
         B     STARTIO        GO ISSUE SIO                     @VM08921 03985000
**********************************************************************  03986000
MOV3270  MVC   0(0,R1),BLNKLINE+6 MOVE THE DATA INTO THE       @V200731 03987000
*                             USER'S BUFFER                             03988000
*********************************************************************   03989000
         SPACE 2                                                        03990000
RETINPUT EQU   *                                               @V200731 03991000
         LM    R3,R4,SAVEAREA GET THE DATA REGISTERS           @VM08531 03992000
         NI    PARM,X'FF'-PARMREA  TURN OFF READ REQUEST       @VA12548 03992100
         TM    PARM,PARMNDA   IS NO DATA INDICATED ?           @VM08531 03993000
         BZ    WRT66          NO, GO DISPLAY INPUT ON CRT      @VM08531 03994000
RETWORD  EQU   *                                               @VM08531 03995000
         TM    4(R4),CC       IS COMMAND CHAINING ON ?         @VM08531 03996000
         LA    R4,8(R4)       UPDATE THE CCW ADDRESS TO NEXT   @VM08531 03997000
*                             CCW                                       03998000
         BO    GETCCW         YES, GET DATA COUNT FROM CCW     @VM08531 03999000
         LM    R14,R5,GRAPHSAV GET CALLER'S REGISTERS          @VM08531 04000000
         BR    R14            RETURN TO CALLER                 @VM08531 04001000
         EJECT                                                          04002000
******************************************************************      04003000
*.                                                                      04004000
*  25.   INPUT CONTROL STATEMENT READ ROUTINE                           04005000
*                                                                       04006000
*              1. IF THE INPUT IS FROM CARD OR A CMS FILE READ IT,      04007000
*                 ELSE READ FROM THE CONSOLE.                           04008000
*                                                                       04009000
*              2. SCAN THE INPUT FOR AN AT SIGN, IF FOUND SHIFT THE     04010000
*                 BUFFER LEFT 2 BYTES FROM THE AT SIGN.                 04011000
*                                                                       04012000
*              3. IF A CENT SIGN IS FOUND GO TO STEP 1.                 04013000
*                                                                       04014000
*              4. RETURN TO THE CALLING ROUTINE.                        04015000
*.                                                                      04016000
******************************************************************      04017000
READCONT STM   R14,R2,REGSAVE2     SAVE REG'S                           04018000
REREAD   MVI   CONTBUFF,C' '            *    CLEAR CONTROL BUFFER       04019000
         MVC   CONTBUFF+1(71),CONTBUFF  *    TO BLANKS                  04020000
         TM    DDRFLAG,CARDIN IS INPUT FROM CARD                        04021000
         BZ    CONIN          NO- BRANCH                                04022000
         CL    R10,BAREMAC    IS THIS CMS                               04023000
         BNE   CMS3           YES- GO TO IT                             04024000
         LA    R15,CARDIOB    POINT TO THE CARD READER IOB              04025000
         LA    R1,CARDCCW     POINT TO THE CCW                          04026000
         BAL   R14,STARTIO    READ IN CARD                              04027000
         B     SCANDATA                                                 04028000
CMS3     LA    R1,INFCB       POINT TO THE FCB                          04029000
         SVC   202            GO TO CMS                                 04030000
         DC    AL4(TESTEOF)     POINTER TO THE ERROR ROUTINE            04031000
         B     SCANDATA       RETURN IF NO ERROR                        04032000
CONIN    LA    R15,CONIOB     POINT TO THE CONSOLE IOB                  04033000
         LA    R1,CONINCCW    *    POINT TO THE CCW STRING              04034000
         CL    R10,BAREMAC    IS THIS CMS                               04035000
         BNE   CMS4           YES- GO TO IT                             04036000
         BAL   R14,GRAPHID    READ IN CONTROL STATEMENT        @V200731 04037000
SCANDATA LA    R1,CONTBUFF    *    SET UP POINTERS TO CONTROL BUFFER    04038000
         LA    R2,72          *                                         04039000
         STM   R1,R2,CURPOINT *                                         04040000
NEXTBYTE CLI   0(R1),X'7C'    TEST FOR CHARACTER DELEAT                 04041000
         BE    BACKUP2        BRANCH IF EQ                              04042000
         CLI   0(R1),X'4A'    TEST FOR LINE DELEAT                      04043000
         BE    REREAD         BRANCH IF EQ                              04044000
         LA    R1,1(,R1)      POINT TO THE NEXT BYTE                    04045000
         BCT   R2,NEXTBYTE    TEST EACH BYTE                            04046000
         LM    R14,R2,REGSAVE2     RETURN REGS                          04047000
         BR    R14            RETURN TO CALLER                          04048000
BACKUP2  S     R1,=F'1'       SUB 1                                     04049000
         C     R1,CURPOINT    DID I BACK UP PAST THE START              04050000
         BL    BACK1           YES- BRANCH                              04051000
         EX    R2,MOVEBACK    DELEAT THIS AND THE LAST CHARECTER        04052000
         MVC   CONTBUFF+70(2),BLANKS  CLEAN UP THE LAST TWO BYTES       04053000
         B     NEXTBYTE       GO CHECK IT OUT                           04054000
BACK1    MVC   CONTBUFF(71),CONTBUFF+1  SHIFT LEFT ONE BYTE             04055000
         MVI   CONTBUFF+71,C' '    CLEAN UP THE LAST BYTE               04056000
         B     SCANDATA       RESET THE POINTERS                        04057000
MOVEBACK MVC   0(0,R1),2(R1)  SHIFT DATA LEFT TWO BYTES                 04058000
READERR  TM    IOBSTAT,IOBNOPER    IS THE NOT OPER BIT ON               04059000
         BO    DDR704         YES- BRANCH                               04060000
         TM    IOBCSW+4,UE         IS ERROR UNIT EXCEPTION              04061000
         BO    EOF            YES- BRANCH                               04062000
         TM    DDRFLAG,CARDEOF     IS THE EOF BIT ON                    04063000
         BO    EXIT           YES- GO TO EOJ                            04064000
         TM    SENSE,INTREQ   IS IT INTERVENTION REQ                    04065000
         BO    DDR710         YES- BRANCH                               04066000
         B     DDR705         NO- GO PRINT ERROR                        04067000
CMS4     LA    R1,ENTERFCB    POINT TO THE FCB                          04068000
         SVC   202            CALL CMS                                  04069000
         DC    AL4(ERROR4)    ERROR RETURN                              04070000
         LA    R1,CONRDFCB    POINT TO THE FCB                          04071000
         SVC   202            GO TO CMS                                 04072000
         DC    AL4(ERROR2)      POINTER TO THE ERROR ROUTINE            04073000
         B     SCANDATA                                                 04074000
TESTEOF  CL    R15,=F'12'     IS IT EOF                                 04075000
         BNE   ERROR3         NO- ERROR                                 04076000
EOF      OI    DDRFLAG,CARDEOF     TURN ON END OF FILE BIT              04077000
         BR    R14                                                      04078000
         SPACE 3                                                        04079000
*****************************************************************       04080000
*.                                                                      04081000
*  26.   ROUTINE TO SCAN CONTROL STATEMENT BUFFER FOR NEXT FIELD        04082000
*                                                                       04083000
*              1. IF END OF CARD, COL NUMBER 71, RETURN CC = 1.         04084000
*                                                                       04085000
*              2. FIND NEXT COLUMN NOT A COMMA OR BLANK,                04086000
*                 IF NONE RETURN CC = 1.                                04087000
*                                                                       04088000
*              3. IF LEFT PERENTHIESIS RETURN CC = 2.                   04089000
*                                                                       04090000
*              4. IF RIGHT PERENTHESIS RETURN CC = 3.                   04091000
*                                                                       04092000
*              5. COUNT THE NUMBER OF CHARACTERS UNTIL THE NEXT         04093000
*                 BLANK, COMMA OR PERENTHESIS.                          04094000
*                                                                       04095000
*              6. RETURN CC = 0.                                        04096000
*.                                                                      04097000
******************************************************************      04098000
SCANCONT STM   R3,R4,SAVEREGS SAVE REG                                  04099000
         L     R1,CURPOINT                                              04100000
         SR    R2,R2          SET COUNT TO ZERO                         04101000
         L     R3,CURCOUNT    GET COUNT OF BYTES LEFT IN BUFFER         04102000
         LTR   R3,R3          IS IT ZERO                                04103000
         BZ    SETCC1         YES END OF INPUT                          04104000
LOOP5    CLI   0(R1),C' '     IS INPUT EQ BLANK                         04105000
         BE    UPDATE3        YES- BRANCH                               04106000
         CLI   0(R1),C'('     IS IT EQU (                               04107000
         BE    SETCC2         YES- GO SET THE PARM CC                   04108000
         CLI   0(R1),C')'     IS IT EQ TO )                             04109000
         BE    SETCC3         YES- BRANCH TO SET CONT CODE              04110000
         CLI   0(R1),C','     IS INPUT EQ ,                             04111000
         BNE   UPDATE4        NO- BRANCH                                04112000
UPDATE3  LA    R1,1(,R1)      UPDATE POINTER TO INPUT                   04113000
         BCT   R3,LOOP5       BRANCH IF END OF CARD                     04114000
         B     SETCC1         DO IT AGAIN                               04115000
UPDATE4  OI    0(R1),C' '     SET TO UPPER CASE                         04116000
         LA    R2,1(,R1)      POINT TO INPUT                            04117000
         BCTR  R3,0           SET UP COUNT                              04118000
LOOP6    CLI   0(R2),C' '     IS INPUT A BLANK                          04119000
         BE    SETCC0         YES- BRANCH                               04120000
         CLI   0(R2),C','     IS INPUT A ,                              04121000
         BE    SETCC0         YES- BRANCH                               04122000
         CLI   0(R2),C')'     IS IT EQ TO )                             04123000
         BE    SETCC0         YES- BRANCH                               04124000
         OI    0(R2),C' '     CONVERT TO UPPER CASE                     04125000
         LA    R2,1(,R2)      POINT TO NEXT INPUT BYTE                  04126000
         BCT   R3,LOOP6       DO IT AGAIN                               04127000
SETCC0   ST    R2,CURPOINT    SET UP CURRENT POINTER                    04128000
         SR    R2,R1          SET UP COUNT                              04129000
         TM    *,X'00'        SET CC = 0                                04130000
RETURNCT ST    R3,CURCOUNT    SET UP REMAINING COUNT                    04131000
         LM    R3,R4,SAVEREGS RETURN REG                                04132000
         STM   R1,R2,OPADDCNT REMEMBER OPERAND ADDRESS & COUNT @VM01159 04133000
         BR    R14            RETURN TO CALLER                          04134000
SETCC1   TM    *,X'FF'        SET CC = 1 (NO INPUT)                     04135000
         ST    R1,CURPOINT    SET UP CURRENT POINTER                    04136000
         B     RETURNCT                                                 04137000
SETCC2   CLI   *,X'00'        SET CC = 2                                04138000
         B     UPOINT                                                   04139000
SETCC3   TM    *,X'91'        SET CC = 3                                04140000
UPOINT   LA    R1,1(,R1)      ADD ONE TO THE POINTER                    04141000
         BCTR  R3,0           -1 FROM THE COUNT                         04142000
         ST    R1,CURPOINT    SAVE THE POINTER                          04143000
         B     RETURNCT                                                 04144000
         SPACE                                                          04145000
OPADDCNT DC    2F'0'          REMEMBER OPERAND ADDRESS & COUNT @VM01159 04146000
         EJECT                                                          04147000
******************************************************************      04148000
*.                                                                      04149000
*  27.   MESSAGE WRITER SUBROUTINE                                      04150000
*                                                                       04151000
*              1. IF UNDER CMS USE SVC 202 ELSE SET                     04152000
*                 UP THE CCW AND CALL STARTIO.                          04153000
*                                                                       04154000
*              2. RETURN USING R5.                                      04155000
*.                                                                      04156000
******************************************************************      04157000
MSGWRITE CL    R10,BAREMAC    IS THIS A BARE MACHINE                    04158000
         BNE   CMS5                                                     04159000
         LH    R1,0(,R2)      MSG LENGTH INTO R1               @VA01388 04160000
         LA    R2,2(,R2)      MSG TEXT ADDR INTO R2            @VA01388 04161000
         CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE?       @VA01388 04162000
         BNE   NODIAG         NO, DON'T EDIT THE MSG           @VA01388 04163000
         CLC   0(3,R2),=C'DMK' IS THIS AN ERROR MSG?           @VA01388 04164000
         BNE   NODIAG         NO, DON'T EDIT THE MSG           @VA01388 04165000
         DC    X'83',X'21',XL2'005C' YES, DO DIAGNOSE TO EDIT  @VA01388 04166000
*                                MSG ACCORDING TO USER'S EMSG SETTING   04167000
         LTR   R1,R1          LENGTH OF 0 (I.E., EMSG OFF)?    @VA01388 04168000
         BCR   8,R14          YES, NO MSG TO SEND. JUST RETURN.@VA01388 04169000
NODIAG   STH   R1,CONCCW+6    BUILD CCWS: LENGTH               @VA01388 04170000
         ICM   R2,8,=X'09'    WRITE OP CODE                    @VA01388 04171000
         ST    R2,CONCCW           *                                    04172000
         LA    R15,CONIOB     POINT TO THE IOB                          04173000
         LA    R1,CONCCW      POINT AT OUTPUT CCW                       04174000
         B     GRAPHID        GO TO START I/O ROUTINE (RETURN  @V200731 04175000
*                             ON R14)                                   04176000
CMS5     SSM   =4X'FF'        LET CMS CLEAR THE LAST INT                04177000
         CLC   2(3,R2),=C'DMK'     IS THIS AN ERROR MSG                 04178000
         BE    CMSERMSG            YES- GO TO ERROR MSG ROUTINE         04179000
         LA    R1,2(,R2)      POINT TO THE MSG TEXT                     04180000
         LH    R2,0(R2)       GET THE LENGTH                            04181000
CMS6     STCM  R1,7,CONFCB+9  SET UP POINTER TO MSG IN FCB              04182000
         STH   R2,CONFCB+14   SET UP THE MSG LENGTH ALSO                04183000
         LA    R1,CONFCB      POINT TO THE FCB                          04184000
         SVC   202            GO TO CMS                                 04185000
         DC    AL4(ERROR4)      ERROR RETURN                            04186000
         BR    R14            RETURN TO CALLER                          04187000
CMSERMSG LA    R2,1(,R2)      POINT TO A ONE BYTE COUNT AND THE TEXT    04188000
         LINEDIT DISP=ERRMSG,TEXTA=(R2),RENT=NO,DOT=NO                  04189000
         BR    R14            RETURN TO THE CALLER                      04190000
PRINTBUF OI    DDRFLAG,ERROR       TURN ON THE ERROR SWITCH             04191000
         TM    DDRFLAG,CARDIN      IS THIS CARD INPUT                   04192000
         BCR   8,R14          NO- RETURN (DO NOT PRINT INPUT LINE)      04193000
         LA    R2,CONTBUFF+71           *    BUILD CCW, DO NOT PRINT    04194000
LOOP7    CLI   0(R2),C' '               *    TRAILING BLANKS. IF BUFFER 04195000
         BNE   SETCOUNT                 *    IS ALL BLANKS RETURN TO    04196000
         BCT   R2,LOOP7                 *    CALLER. (USING R14)        04197000
SETCOUNT S     R2,=A(CONTBUFF-1)        *                               04198000
         BCR   13,R14                   *                               04199000
         LA    R1,CONTBUFF              *                               04200000
         CL    R10,BAREMAC              *                               04201000
         BNE   CMS6                     *                               04202000
         STCM  R1,7,CONCCW+1            *                               04203000
         STH   R2,CONCCW+6              *                               04204000
         LA    R15,CONIOB     POINT TO THE IOB                          04205000
         LA    R1,CONCCW      *    POINT TO THE IOB                     04206000
         B     GRAPHID        GO TO START I/O ROUTINE (RETURN  @V200731 04207000
*                             ON R14)                                   04208000
CONERROR EQU   *                                               @V200731 04209000
         TM    IOBCSW+4,ATTN  IS THIS AN ATTENTION INTERRUPT ? @V200731 04210000
         BNO   CONUNITE       NO, GO CHECK FOR UNIT EXECPTION  @V200731 04211000
         TM    PARM,PARMGRP   IS THE GRAPHIC SUPPORT ACTIVE ?  @V200731 04212000
         BZ    DDRCARD        NO, GO CLEAR CARD FLAG           @V200731 04213000
         TM    PARM,PARMATT   IS THIS A ATTENTION REQUEST ?    @V200731 04214000
         BCR   1,R14          YES, GO CHECK FOR ATTENTION      @V200731 04215000
*                             INTERRUPT                                 04216000
         B     CONUNITE       GO CHECK FOR UNIT CHECK          @V200731 04217000
DDRCARD  EQU   *                                               @V200731 04218000
         NI    DDRFLAG,255-CARDIN CLEAR CARD FLAG              @V200731 04219000
         B     STARTNEW       GO READ THE CONSOLE INPUT        @V200731 04220000
CONUNITE EQU   *                                               @V200731 04221000
         TM    IOBCSW+4,UE    IS THIS A UNIT EXECPTION ?       @V200731 04222000
         BZ    CKCMDR         NO - CHK FURTHER                 @VM01077 04223000
         MVI   CONTBUFF,C' '  YES - 'CANCEL' HIT - CLEAR       @VM01077 04224000
         MVC   CONTBUFF+1(71),CONTBUFF THE BUFFER              @VM01077 04225000
         B     NOERROR        & RETURN TO DO THE I/O           @VM01077 04226000
CKCMDR   EQU   *                                               @VM01077 04227000
         TM    SENSE,X'80'    COMMAND REJECT                            04228000
         BNO   ERRORCT        NO- BRANCH                                04229000
         B     EXIT           YES - BAD                        @VA01388 04230000
NOERROR  LM    R14,R4,SIOSAVE RETURN THE STARTIO REG'S                  04231000
         B     STARTIO        GO RESTART                                04232000
ERRORCT  ICM   R4,3,CONERCT   GET THE ERROR COUNT                       04233000
         BM    EXIT           IF OVER 20 ERRORS GO TO EXIT              04234000
         BCT   R4,RETCON      IS IT ZERO                                04235000
         STH   R4,CONERCT     SAVE THE ERROR COUNT                      04236000
         OI    DDRFLAG,ERROR  TURN ON THE ERROR FLAG                    04237000
         B     DDR705         PRINT OUT ERROR                           04238000
RETCON   STH   R4,CONERCT     SAVE COUNT                                04239000
         B     IORETURN       RETURN TO START IO ROUTINE                04240000
         SPACE                                                          04241000
*****    MESSAGE TABLE                                                  04242000
         SPACE                                                          04243000
DDR700   OI    DDRFLAG,ERROR  TURN ON THE ERROR FLAG                    04244000
         MSG   'DMKDDR700E INPUT UNIT IS NOT A CPVOL',DDR700A           04245000
DDR700A  LA    R14,GETEXT     SET UP RETURN ADDRESS                     04246000
         B     MSG003         GO TO MSG003                              04247000
DDR701   MVI   DDR701A+39,C' '               *    BLANK IT OUT          04248000
         MVC   DDR701A+40(11),DDR701A+39     *                          04249000
         LM    R1,R2,OPADDCNT RECOVER OPERAND ADDRESS & COUNT  @VM01159 04250000
         LTR   R2,R2          ENSURE COUNT NOT ZERO (OR MINUS) @VM01159 04251000
         BNP   DDR701AA       IF NOT > 0, DON'T DO ANY MOVING. @VM01159 04252000
         CL    R2,=F'12'      IS IT OVER 12                             04253000
         BNH   MOVE           NO- BRANCH                                04254000
         LA    R2,12          SET COUNT TO 12                           04255000
MOVE     MOVE  DDR701A+39     MOVE IN ERROR WORD                        04256000
DDR701AA BAL   R14,PRINTBUF   PRINT OUT CARD-IMAGE             @VM01159 04257000
DDR701A  MSG   'DMKDDR701E INVALID OPERAND - XXXXXXXXXXXX',GTCARD       04258000
DDR702   BAL   R14,PRINTBUF   PRINT OUT ERROR CARD                      04259000
         MSG   'DMKDDR702E CONTROL STATEMENT SEQUENCE ERROR',  @VM08514X04260000
               GTCARD                                          @VM08514 04261000
DDR703   BAL   R14,PRINTBUF   PRINT OUT ERROR CARD                      04262000
         MSG   'DMKDDR703E OPERAND MISSING',GTCARD                      04263000
DDR704   NI    IOBSTAT,255-IOBNOPER     TURN OFF NOT OPERATIONAL BIT    04264000
         LA    R1,DDR704A+21  SET UP POINTER TO FIELD          @VA04550 04265000
         STH   R2,0(,R1)      SAVE DATA TO BE CONVERTED                 04266000
         LA    R2,2           SET UP COUNT                              04267000
         BAL   R14,DECCONV                                              04268000
         OI    DDRFLAG,ERROR       TURN ON THE ERROR SWITCH             04269000
         LA    R14,STARTNEW   NORMAL RESUME POINT              @VA04550 04270000
         C     R15,=A(CARDIOB) WE WORKING WITH THE RDR??       @VA04550 04271000
         BNE   DDR704A        NOPE -                           @VA04550 04272000
         LA    R14,MSG002A    YES - WILL ASK FOR A NEW ADDR    @VA04550 04273000
*        RESET ERROR, CARDIN, AND VLDRDR FLAGS SO WE CAN TRY FOR        04274000
         NI    DDRFLAG,255-(VLDRDR+CARDIN+ERROR) A NEW ADDR.   @VA04550 04275000
DDR704A  MSG   'DMKDDR704E DEV XXXX NOT OPERATIONAL'           @VA04550 04276000
DDR705   LA    R1,DDR705A1+26 MOVE IN CONVERTED IO ADDRESS     @V2B3729 04277000
         MVC   0(2,R1),IOBUADD    *                                     04278000
         LA    R2,2               *                                     04279000
         BAL   R14,DECCONV        *                                     04280000
         LA    R1,DDR705A1+35 CONVERT CSW                      @V2B3729 04281000
         MVC   0(8,R1),IOBCSW ..                               @V2B3729 04282000
         LA    R2,8           ..                               @V2B3729 04283000
         BAL   R14,DECCONV                                     @V2B3729 04284000
         LA    R1,SENSE       CONVERT SENSE                    @V2B3729 04285000
         LA    R2,24          ..                               @V2B3729 04286000
         BAL   R14,DECCONV    ..                               @V2B3729 04287000
         MVC   DDR705A1+58(12),SENSE MOVE SENSE BYTES TO MSG   @V2B3729 04288000
         MVC   DDR705AA+6(36),SENSE+12 ..                      @V2B3729 04289000
         TM    IOBCLASS,CLASDASD+CLASTAPE+CLASTERM RDR OR PUN? @V2A2063 04290000
         BNZ   NOTUR          NOPE                             @V2A2063 04291000
         MVC   ERSAVE(28),SIOSAVE  SAVE THE STARTIO REGS                04292000
         BAL   R14,DDR705A1   TYPE THE MSG                              04293000
         TM    DDRFLAG,CARDIN CARD INPUT??                     @VA04550 04294000
         BZ    RST705         NO - GO RETRY THE TASK           @VA04550 04295000
         L     R15,ERSAVE+4   RETRIEVE ORIG. IOB POINTER       @VA04550 04296000
         C     R15,=A(CARDIOB) THIS A RDR ERROR?               @VA04550 04297000
         BNE   RST705         NOPE                             @VA04550 04298000
         TM    DDRFLAG,VLDRDR VALID RDR ADDR YET??             @VA04550 04299000
         BO    RST705         YES - RETRY THE OPERATION        @VA04550 04300000
         NI    DDRFLAG,255-CARDIN RESET THE CARD INPUT FLAG    @VA04550 04301000
         B     MSG002A        ASK FOR A NEW RDR ADDR           @VA04550 04302000
RST705   EQU   *                                               @VA04550 04303000
         LM    R14,R4,ERSAVE  RETURN THE STARTIO REGS                   04304000
         B     STARTIO        RESTART THE IO OPERATION                  04305000
NOTUR    LA    R1,DDR705B+16  *    CONVERT INADD                        04306000
         MVC   0(6,R1),INADD  *                                         04307000
         LA    R2,6           *                                         04308000
         BAL   R14,DECCONV    *                                         04309000
         LA    R1,DDR705B+36       *    CONVERT OUTADD                  04310000
         MVC   0(6,R1),OUTADD      *                                    04311000
         LA    R2,6                *                                    04312000
         BAL   R14,DECCONV         *                                    04313000
         LA    R1,DDR705B+53  *    CONVERT CCW                          04314000
         MVC   0(8,R1),0(R5)  *                                         04315000
         LA    R2,8           *                                         04316000
         BAL   R14,DECCONV    *                                         04317000
         MVC   ERRORRET,=F'4' SET THE CMS RETURN CODE TO 4              04318000
         CLI   SNSCNT,2       DIAGNOSE I/O ?                   @V2B3729 04319000
         BNE   WRBAL          NO,                              @V2B3729 04320000
         MVC   DDR705A1+62(8),BLANKS BLANK LAST 4 BYTES        @V2B3729 04321000
WRBAL    BAL   R14,DDR705A1   WRITE ERROR MSG                  @V2B3729 04322000
         CLI   SNSCNT,X'06'   SENSE BYTE > 6 ??                @V2B3729 04323000
         BNH   DDR705B        NO, WRITE ONE MESSAGE            @V2B3729 04324000
         BAL   R14,DDR705AA   WRITE SENSE MSG                  @V2B3729 04325000
         B     DDR705B        WRITE MSG                        @V2B3729 04326000
DDR705A1 MSG   'DMKDDR705E IO ERROR XXXX CSW XXXXXXXXXXXXXXXX SENSE XXX*04327000
               XXXXXXXXX'                                               04328000
DDR705AA MSG   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'          @V2B3729 04329000
DDR705B MSG    'INPUT XXXXXXXXXXXX OUTPUT XXXXXXXXXXXX CCW XXXXXXXXXXXXX04330000
               XXXX',CLOSEJOB                                           04331000
DDR756   MVC   DDR756A+41(8),PROOLD MOVE IN OLD PSW AND CONVERT@V305435 04332000
         LA    R1,DDR756A+41  * IT TO DECIMAL                  @V305435 04333000
         LA    R2,8                *                                    04334000
         BAL   R14,DECCONV         *                                    04335000
         OI    DDRFLAG,ERROR       TURN ON THE ERROR SWITCH             04336000
DDR756A  MSG   'DMKDDR756E PROGRAM CHECK PSW = XXXXXXXXXXXXXXXX'        04337000
DDR707   OI    DDRFLAG,ERROR       TURN ON THE ERROR SWITCH             04338000
         MSG   'DMKDDR707E MACHINE CHECK RUN SEREP AND SAVE OUTPUT FOR X04339000
               CE',EXIT                                                 04340000
PREDR708 DS    0H                                              @VA13582 04341010
         CL    R15,=A(OUTIOB) IS AN OUT DEF. ERROR             @VA13582 04341020
         BNE   ERINMSG        IF NOT BRANCH                    @VA13582 04341030
         OI    DDRFLAG3,OUTERROR SET OUT ERROR FLAG            @VA13582 04341040
DDR708   DS    0H                                              @VA13582 04341050
         OI    DDRFLAG,ERROR        TURN ON THE ERROR SWITCH            04341060
         MSG   'DMKDDR708E INVALID INPUT OR OUTPUT DEFINITION',STRGAIN  04341070
ERINMSG  DS    0H                                              @VA13582 04341080
         OI    DDRFLAG3,INERROR SET IN ERROR FLAG              @VA13582 04341090
         B     DDR708         GO WRITE MSG                     @VA13582 04341100
STRGAIN  DS    0H                                              @VA13582 04341110
         TM    DDRFLAG,CARDIN  IS THIS A CARD INPUT            @VA13582 04341120
         BO    GTCARD         GO TO SCAN OTHER                 @VA13582 04341130
         B     STARTNEW       BEGIN AGAIN                      @VA13582 04341140
DDR709   MSG   'DMKDDR709E WRONG INPUT TAPE MOUNTED',CLOSERET           04343000
DDR710   STM   R2,R3,IOBSAVE  SAVE IOB REGS                             04344000
         MVC   IRSAVE(28),SIOSAVE SAVE START IO REGS           @VA12496 04345010
WAITINT  LA    R1,DDR710A+22   POINT AT DATA TO BE CONVERTED            04346000
         MVC   0(2,R1),IOBSAVE+2   MOVE IN THE UNIT ADD                 04347000
         LA    R2,2           SET UP COUNT                              04348000
         BAL   R14,DECCONV    CONVERT DATA                              04349000
         BAL   R14,DDR710A    SET UP RETURN ADDRESS                     04350000
         LM    R14,R4,IRSAVE  RETURN STARTIO REGS                       04351000
         STM   R14,R4,SIOSAVE *    FAKE A START IO AND WAIT FOR THE     04352000
         LM    R2,R3,IOBSAVE  *    IO INTERRUPT FROM THE IO UNIT        04353000
         B     IOWAIT         *    REQUIRING INTERVENTION               04354000
DDR710A  MSG   'DMKDDR710A DEV  XXXX INTERVENTION REQUIRED'             04355000
DDR711   MVC   DDR711A+35(6),VOL1BUFF+4      MOVE IN LABLE              04356000
         MVC   DDR711A+46(6),IOBVSER         IOB LABEL ALSO             04357000
         LA    R2,42          SET UP TO TYPE FULL MSG                   04358000
         CLC   DDR711A+46(6),BLANKS     VOLID = BLANKS                  04359000
         BNE   *+8            NO- TYPE THE FULL MSG                     04360000
         LA    R2,31          SET COUNT TO SHORT MSG (DROP THE NOT)     04361000
         STH   R2,DDR711A+8   SET UP THE COUNT                          04362000
         MVI   MSGFLAG,X'F1'  INDICATE DMKDDR711 ISSUED        @VA03507 04363000
DDR711A  MSG   'DMKDDR711R VOLID READ IS XXXXXX NOT XXXXXX',OPENER      04364000
*                                                              @VA03507 04365000
DDR712   OI    DDRFLAG,ERROR       TURN ON THE ERROR SWITCH             04366000
         MSG   'DMKDDR712E NUMBER OF EXTENTS EXCEEDS 20',      @VM08514X04367000
               CLOSEJOB                                        @VM08514 04368000
DDR713   ST    R14,SAVERET    SAVE THE RETURN ADD                       04369000
         BAL   R14,PRINTBUF   GO PRINT THE CARD                         04370000
         L     R14,SAVERET    RETURN THE RETURN ADD                     04371000
         MSG   'DMKDDR713E OVERLAPPING OR INVALID EXTENTS'              04372000
DDR714   MVC   DDR714A+28(6),INADD      SET UP RECORD ID                04373000
         LA    R1,DDR714A+28  POINT TO DATA TO BE CONVERTED             04374000
         LA    R2,6           SET UP COUNT                              04375000
         BAL   R14,DECCONV    CONVERT TO DECIMAL                        04376000
         OI    DDRFLAG,ERROR       TURN ON THE ERROR SWITCH             04377000
DDR714A  MSG   'DMKDDR714E RECORD XXXXXXXXXXXX NOT FOUND ON INPUT TAPE'X04378000
               ,CLOSEJOB                                                04379000
DDR715   ST    R14,SAVERET    SAVE THE RETURN ADDRESS                   04380000
         LA    R1,DDR715A+26  POINT TO THE DASD ADDRESS 'BBCCHH'        04381000
         MVC   0(2,R1),INADD  SET UP THE 'BB' OF THE ADDRESS            04382000
         MVC   2(4,R1),THRHADD+1   SET UP THE 'CCHH' OF THE ADDRESS     04383000
         LA    R2,6           SET UP LENGTH                             04384000
         BAL   R14,DECCONV    CONVERT IT TO DECIMAL                     04385000
         MVC   ERRORRET,=F'3'      SET UP AN ERROR RETURN OF 3          04386000
         L     R14,SAVERET    RETURN THE RETURN ADDRESS                 04387000
DDR715A  MSG   'DMKDDR715E LOCATION XXXXXXXXXXXX IS A FLAGGED TRACK'    04388000
DDR716   CLI   DASDERCT+1,10  HAVE I HAD 10 ERRRORS                     04389000
         BH    BADPACK        YES- ERROR                                04390000
         TM    SENSE+1,X'08'   IS IT NO RECORD FOUND                    04391000
         BZ    INOUTER        NO- BRANCH TO THE ERROR ROUTINE           04392000
         LA    R1,R3CCW       POINT TO THE READ RECORD 3 CCW STRING     04393000
         CL    R1,IOBCCW      WAS I WORKING WITH R3                     04394000
         BE    BADPACK        YES- BRANCH LOOPING                       04395000
         B     RETRYIO        NO VOL1 REC SO LOOK FOR REC3 AND @V56BDA8 04396000
*                             READ IT.                                  04397000
BADPACK  LA    R1,INOUTER     POINT TO THE ERROR ROUTINE                04398000
         ST    R1,IOBERROR    AND SAVE IT                               04399000
         TM    IOBSTAT,IOBSCRAT    IS THIS A SCRATCH VOL                04400000
         BO    OPENCOMP       YES- ALL SET                              04401000
         MVC   DDR716A+45(6),IOBVSER    MOVE IN THE VOL SER NO          04402000
         LA    R2,41          SET UP TO TYPE FULL MSG                   04403000
         CLC   DDR716A+45(6),BLANKS VOLID = BLANKS                      04404000
         BNE   *+8            NO- TYPE THE FULL MSG                     04405000
         LA    R2,30          SET COUNT TO SHORT MSG (DROP THE FOR)     04406000
         STH   R2,DDR716A+8   SET UP THE COUNT                          04407000
DDR716A  MSG   'DMKDDR716R NO VOL1 LABEL FOUND FOR XXXXXX',OPENER       04408000
DDR717   MVC   DDR717A+34(6),VHRVSER    MOVE IN THE FROM V SER          04409000
         MVC   DDR717A+59(6),OUTIOB+(IOBVSER-IOB) MOVE IN TO V SER      04410000
DDR717A  MSG   'DMKDDR717R DATA DUMPED FROM XXXXXX TO BE RESTORED TO XXX04411000
               XXXX'                                                    04412000
DDR718   STM   R1,R2,IOBSAVE  SAVE IOB REGS                             04413000
         MVC   IRSAVE(28),SIOSAVE  SAVE STARTIO REGS                    04414000
         LA    R1,RUNCCW      POINT TO THE RUN CCW                      04415000
         BAL   R14,STARTIO    REWIND UNLOAD THE TAPE                    04416000
         BAL   R14,DDR718A    PRINT MSG                                 04417000
         LM    R14,R4,IRSAVE  RETURN START IO REGS                      04418000
         LM    R1,R2,IOBSAVE  RETURN THE CCW POINTER                    04419000
         B     STARTIO        RESTART   (DO NOT CHANGE R14)             04420000
DDR718A  MSG   'DMKDDR718E OUTPUT UNIT IS FILE PROTECTED'               04421000
DDR719   MVC   ERRORRET,=F'1' SET THE RETURN CODE TO 1                  04422000
         MSG   'DMKDDR719E INVALID FILENAME OR FILE NOT FOUND',EXIT     04423000
ERROR4   LA    R15,100(,R15)   ADD 100 TO THE ERROR RETURN CODE         04424000
ERROR3   LA    R15,100(,R15)   ADD 100 TO THE ERROR RETURN CODE         04425000
ERROR2   LA    R15,100(,R15)   ADD 100 TO THE ERROR RETURN CODE         04426000
ERROR1   LA    R15,100(,R15)   ADD 100 TO THE ERROR RETURN CODE         04427000
         CL    R15,=F'102'     CH 12 ON V3211 OR V3203??       @V386298 04428000
         BE    NEXTCCW        YES - GET NEXT CCW               @VA01298 04429000
         CL    R15,=F'103'     CH 9 ON V3211 OR V3203??        @V386298 04430000
         BE    NEXTCCW        YES - GET NEXT CCW               @VA01298 04431000
         ST    R15,ERRORRET                                             04432000
         MVC   DDR720+30(8),0(R1)  MOVE IN THE CMS ROUTINE NAME         04433000
DDR720   MSG   'DMKDDR720E ERROR IN XXXXXXXX',EXIT                      04434000
DDR721   MVC   DDR721A+28(5),PSTOPCC    MOVE IN THE STOP ADD            04435000
         LA    R1,DDR721A+28  POINT TO THE DATA                         04436000
         LA    R2,5           SET UP THE COUNT                          04437000
         BAL   R14,DECCONV    GO CONVERT THE ADD                        04438000
DDR721A  MSG   'DMKDDR721E RECORD XXXXXXXXXX NOT FOUND',EOJ             04439000
DDR722   OI    DDRFLAG,ERROR  TURN ON THE ERROR BIT               (NUC) 04440000
         MSG   'DMKDDR722E OUTPUT UNIT NOT PROPERLY FORMATED FOR THE CP*04441000
                NUCLEUS',STARTNEW                                 (NUC) 04442000
DDR723   OI    DDRFLAG,ERROR  TURN ON THE ERROR BIT               (NUC) 04443000
         MSG   'DMKDDR723E NO VALID CP NUCLEUS ON THE INPUT UNIT',START*04444000
               NEW                                                (NUC) 04445000
DDR724   OI    DDRFLAG,ERROR  TURN ON THE ERROR BIT               (NUC) 04446000
         MSG   'DMKDDR724E INPUT TAPE CONTAINS A CP NUCLEUS DUMP',CLOSE*04447000
               JOB                                                (NUC) 04448000
DDR725   EQU   *                                               @V2A2063 04449000
         MSG   'DMKDDR725R DASD INPUT DEVICE WAS(IS) LARGER THAN OUTPUTX04450000
                DEVICE'                                        @VA03326 04451000
DDR726   ST    R14,SAVERET    SAVE THE RETURN ADDR.            @V56BDA8 04452000
         BAL   R14,PRINTBUF   PRINT OUT ERROR CARD.            @V56BDA8 04453000
         L     R14,SAVERET    RESTORE RETURN ADDR.             @V56BDA8 04454000
         MSG   'DMKDDR726E MOVING DATA INTO THE ALTERNATE TRACK CYLINDE*04455000
               R(S) IS PROHIBITED.'                                     04456000
DDR727   DS    0H                                              @V56BDA8 04457000
         ST    R14,SAVERET    SAVE THE RETURN ADDRESS.         @V56BDA8 04458000
         LA    R1,DDR727A+29  POINT TO DASD 'BBCCHH' ADDRESS.  @V56BDA8 04459000
         XC    0(L2,R1),0(R1) BB IS ZEROES.                    @V56BDA8 04460000
         MVC   2(L4,R1),THRHADD+1 GET CCHH.                    @V56BDA8 04461000
         LA    R2,6           LENGTH OF DATA TO CONVERT.       @V56BDA8 04462000
         BAL   R14,DECCONV    CONVERT TO PRINTABLE HEX.        @V56BDA8 04463000
         MVC   ERRORRET,=F'16' SET UP AN ERROR RETURN OF 16.   @V56BDA8 04464000
         L     R14,SAVERET    RE-LOAD RETURN ADDRESS.          @V56BDA8 04465000
DDR727A  MSG   'DMKDDR727E FLAGGED TRK XXXXXXXXXXXX HAS NO PROPER ALTER*04466000
               NATE; SKIPPING THIS TRK.'                                04467000
MSG001   MSG   'END OF XXXXXXX'                                         04468000
MSG002   MSG   'VM/370 DASD DUMP/RESTORE PROGRAM RELEASE 6'    HRC012DK 04469490
MSG002A  MSG   'ENTER CARD READER ADDRESS OR CONTROL STATEMENTS',MSGRET 04470000
MSG003   ST    R14,SAVERET    SAVE THE RETURN ADD                       04471000
         TM    DDRFLAG,CARDIN IS THE INPUT FROM CARD                    04472000
         BO    MSG003A        YES- DO NOT PRINT THE MSG                 04473000
         MSG   'ENTER CYLINDER EXTENTS',MSG003A                         04474000
MSG003A  L     R14,SAVERET    SET UP RETURN ADD                         04475000
         B     READCONT                                                 04476000
         SPACE                                                          04477000
MSG003B  ST    R14,SAVERET    SAVE THE RETURN ADD                       04478000
         TM    DDRFLAG,CARDIN IS THE INPUT FROM CARD                    04479000
         BO    MSG003A        YES- DO NOT PRINT THE MSG                 04480000
         MSG   'ENTER NEXT EXTENT OR NULL LINE',MSG003A                 04481000
MSG004   EQU   *                                               HRC012DK 04482290
         ST    R14,MSG00414                                    HRC012DK 04482580
         MVC   MSG4AOTL,=CL10' '                               HRC012DK 04482870
         MVC   MSG4AALL,=CL10' '                               HRC012DK 04483160
         MVC   MSG4AMOD,=CL9'PRINTING'                         HRC012DK 04483450
         CLI   SAVENAME,C'P'  IS THIS A PRINT                  HRC012DK 04483740
         BE    VSNMOVE                                         HRC012DK 04484030
         MVC   MSG4AMOD,=CL9'COPYING'                          HRC012DK 04484320
         CLI   SAVENAME,C'C'  IS THIS A COPY                   HRC012DK 04484610
         BE    OUTCUUMV                                        HRC012DK 04484900
         MVC   MSG4AMOD,=CL9'DUMPING'   SET UP DUMPING         HRC012DK 04485190
         CLI   SAVENAME,C'D'  IS THIS A DUMP                   HRC012DK 04485480
         BNE   MSG4RSTR       NO, MUST BE RESTORING            HRC012DK 04485770
         LH    R1,OUTIOB+(IOBATAPE-IOB)                        HRC012DK 04486060
CHKALTAD EQU   *                                               HRC012DK 04486350
         LTR   R1,R1                                           HRC012DK 04486640
         BZ    OUTCUUMV                                        HRC012DK 04486930
         MVC   MSG4AALL,=CL10'ALT(CUU'                         HRC012DK 04487220
         STH   R1,MSG4AALA                                     HRC012DK 04487510
         LA    R1,MSG4AALA                                     HRC012DK 04487800
         LA    R2,2           LENGTH                           HRC012DK 04488090
         BAL   R14,DECCONV    CONVERT IT                       HRC012DK 04488380
         MVC   MSG4AALA,MSG4AALA+1                             HRC012DK 04488670
         MVI   MSG4AALA+L'MSG4AALA,C')'                        HRC012DK 04488960
         B     OUTCUUMV                                        HRC012DK 04489250
MSG4RSTR EQU   *                                               HRC012DK 04489540
         MVC   MSG4AMOD,=CL9'RESTORING'                        HRC012DK 04489830
         LH    R1,INIOB+(IOBATAPE-IOB)                         HRC012DK 04490120
         B     CHKALTAD                                        HRC012DK 04490410
OUTCUUMV EQU   *                                               HRC012DK 04490700
         MVC   MSG4AOTL,=CL10'OUT(CUU'                         HRC012DK 04490990
         LH    R1,OUTIOB+(IOBUADD-IOB)                         HRC012DK 04491280
         STH   R1,MSG4AOTA                                     HRC012DK 04491570
         LA    R1,MSG4AOTA                                     HRC012DK 04491860
         LA    R2,2           LENGTH                           HRC012DK 04492150
         BAL   R14,DECCONV    CONVERT IT                       HRC012DK 04492440
         MVC   MSG4AOTA,MSG4AOTA+1                             HRC012DK 04492730
         MVI   MSG4AOTA+L'MSG4AOTA,C')'                        HRC012DK 04493020
VSNMOVE  EQU   *                                               HRC012DK 04493310
         MVC   MSG4AINL,=CL9'IN(CUU'                           HRC012DK 04493600
         LH    R1,INIOB+(IOBUADD-IOB)                          HRC012DK 04493890
         STH   R1,MSG4AINA                                     HRC012DK 04494180
         LA    R1,MSG4AINA                                     HRC012DK 04494470
         LA    R2,2           LENGTH                           HRC012DK 04494760
         BAL   R14,DECCONV    CONVERT IT                       HRC012DK 04495050
         MVC   MSG4AINA,MSG4AINA+1                             HRC012DK 04495340
         MVI   MSG4AINA+L'MSG4AINA,C')'                        HRC012DK 04495630
         MVC   MSG004A+16(6),INIOB+(IOBVSER-IOB)   SET UP VSN  HRC012DK 04495920
         L     R14,MSG00414                                    HRC012DK 04496210
*        MSG   'PRINTING  XXXXXX IN(CUU)                    '  HRC012DK 04496500
*        MSG   'DUMPING   XXXXXX IN(CUU)  OUT(CUU)  ALT(CUU)'  HRC012DK 04496790
*        MSG   'COPYING   XXXXXX IN(CUU)  OUT(CUU)          '  HRC012DK 04497080
MSG004A  MSG   'RESTORING XXXXXX IN(CUU)  OUT(CUU)  ALT(CUU)'  HRC012DK 04497370
MSG4ABNK EQU   MSG004A+13,3                                    HRC012DK 04497660
MSG4AMOD EQU   MSG004A+06,9                                    HRC012DK 04497950
MSG4AVSN EQU   MSG004A+16,6                                    HRC012DK 04498240
MSG4AINL EQU   MSG004A+23,9                                    HRC012DK 04498530
MSG4AINA EQU   MSG004A+26,3                                    HRC012DK 04498820
MSG4AOTL EQU   MSG004A+32,10                                   HRC012DK 04499110
MSG4AOTA EQU   MSG004A+36,3                                    HRC012DK 04499400
MSG4AALL EQU   MSG004A+42,10                                   HRC012DK 04499690
MSG4AALA EQU   MSG004A+46,3                                    HRC012DK 04499980
MSG00414 DC    F'0'                                            HRC012DK 04500270
MSG005   CVD   R2,WORK1            *    CONVERT THE HEAD                04503000
         OI    WORK1+7,X'0F'       *                                    04504000
         UNPK  MSG005A+31(2),WORK1 *                                    04505000
         CVD   R1,WORK1            *    CONVERT THE CYLINDER            04506000
         OI    WORK1+7,X'0F'       *                                    04507000
         UNPK  MSG005A+24(3),WORK1 *                                    04508000
MSG005A  MSG   'END OF VOLUME CYL XXX HD XX, MOUNT NEXT TAPE'           04509000
RESPONSE STM   R14,R2,REGSAVE2                                          04510000
         CL    R10,BAREMAC    IS THIS CMS                               04511000
         BNE   CMS7           YES- BRANCH                               04512000
         XC    RESPDATA(8),RESPDATA     ZERO OUT THE OLD DATA           04513000
         LA    R15,CONIOB     *    POINT TO THE IOB                     04514000
         LA    R1,RESPCCW     *    AND THE CCW.                         04515000
         BAL   R14,GRAPHID    GO TO I/O HANDLER                @V200731 04516000
SHFTUP   EQU   *                                               @V2A2063 04517000
         OC    RESPDATA(8),BLANKS  SHIFT TO UPPER CASE                  04518000
RETREGS  LM    R14,R2,REGSAVE2     RETUR REGS                           04519000
         BR    R14                                                      04520000
CMS7     LA    R1,TYPEFCB                                               04521000
         SVC   202            GO TO CMS                                 04522000
         DC    AL4(ERROR4)      ERROR RETURN                            04523000
         LA    R1,CONINFCB    POINT TO THE FCB                          04524000
         SVC   202            READ THE CON                              04525000
         DC    AL4(ERROR2)      ERROR RETURN                            04526000
         B     RETREGS                                                  04527000
RESPMSG  DC    C'DO YOU WISH TO CONTINUE?  RESPOND YES NO OR REREAD: '  04528000
         SPACE 3                                                        04529000
RESPONS2 EQU   *                                               @V2A2063 04530000
         STM   R14,R2,REGSAVE2                                 @V2A2063 04531000
         CL    R10,BAREMAC    UNDER CMS??                      @V2A2063 04532000
         BNE   CMS9           YES                              @V2A2063 04533000
         XC    RESPDATA(8),RESPDATA CLEAR RESPONSE AREA        @V2A2063 04534000
         LA    R15,CONIOB     POINT AT CONSOLE IOB             @V2A2063 04535000
         LA    R1,RESPCCW2    CCW'S                            @V2A2063 04536000
         LA    R14,SHFTUP     RETURN ADDRESS                   @V2A2063 04537000
         B     GRAPHID        DO THE I/O                       @V2A2063 04538000
CMS9     EQU   *                                               @V2A2063 04539000
         LA    R1,TYPEFCB2                                     @V2A2063 04540000
         B     CMS7+4                                          @V2A2063 04541000
RESPMSG2 DC    C'DO YOU WISH TO CONTINUE?  RESPOND YES OR NO:'          04542000
MSGFLAG  DC    X'00'          FLAG FOR DDR711 OR DDR716 MSG    @VA03507 04543000
         EJECT                                                          04544000
******************************************************************      04545000
*                                                                       04546000
*        SUBROUTINE TO CONVERT HEXADECIMAL DIGTS TO DECIMAL             04547000
*                                                                       04548000
*****************************************************************       04549000
HEXCONV  STM   R3,R5,REGSAVE1  SAVE REG                                 04550000
         SR    R3,R3                                                    04551000
         LA    R5,15          SET UP FOR AND                            04552000
CONVERTH TM    0(R1),X'F0'    IS IT NUMERIC                             04553000
         BO    NUMERIC        YES- BRANCH                               04554000
         BZ    DDR701        NO- ERROR IF ALL BITS OFF                  04555000
         TM    0(R1),X'38'    IS IT ALPHA                               04556000
         BNZ   DDR701        NO- ERROR IF BITS ON                       04557000
         TM    0(R1),X'07'    IS IT G                                   04558000
         BO    DDR701        YES- ERROR IF BITS ON                      04559000
         IC    R4,0(R1)       PICK UP ALPHA INPUT BYTE                  04560000
         LA    R4,9(,R4)      ADD 9 TO CONVERT FROM ALPHA INPUT         04561000
         B     SAVEIT                                                   04562000
NUMERIC  IC    R4,0(,R1)      PICK UP NUMERIC INPUT                     04563000
SAVEIT   NR    R4,R5          ZERO OUT ZONE                             04564000
         SLL   R3,4           SHIFT TO MAKE ROOM FOR INPUT              04565000
         OR    R3,R4          MOVE IN NUMERICS                          04566000
         LA    R1,1(,R1)      POINT AT THE NEXT INPUT BYTE              04567000
         BCT   R2,CONVERTH    DO IT  TO EVERY INPUT BYTE                04568000
         LR    R2,R3          PLACE CONVERTED DATA INTO R2              04569000
         LM    R3,R5,REGSAVE1 RETURN REG                                04570000
         BR    R14            RETURN TO CALLER                          04571000
         SPACE 3                                                        04572000
*****************************************************************       04573000
*                                                                       04574000
*        SUBROUTINE TO CONVERT DECIMAL DIGITS TO HEXADECIMAL            04575000
*                                                                       04576000
*****************************************************************       04577000
DECCONV  STM   R1,R5,REGSAVE1 SAVE REGS                                 04578000
         BCTR  R1,0           SET UP INPUT AND OUTPUT ADD               04579000
         LA    R3,0(R2,R2)    DOBBLE THE COUNT                          04580000
         LA    R3,0(R3,R1)    ADD COUNT TO INPUT ADDRESS (ALSO OUTPUT)  04581000
         SR    R4,R4                                                    04582000
LOOP4    IC    R4,0(R2,R1)    GET BYTE  (INPUT + COUNT)                 04583000
         N     R4,=F'15'      ZERO OUT ALL BUT LAST 4 BITS              04584000
         LA    R5,DECTABLE(R4)     POINT TO BYTE TO BE MOVED            04585000
         MVC   0(1,R3),0(R5)  MOVE IN BYTE                              04586000
         BCTR  R3,0           POINT TO NEXT OUTPUT BYTE                 04587000
         IC    R4,0(R2,R1)    GET BYTE  (INPUT + COUNT)                 04588000
         SRL   R4,4           SET UP ZONE                               04589000
         LA    R5,DECTABLE(R4)     POINT AT BYTE TO BE MOVED            04590000
         MVC   0(1,R3),0(R5)  MOVE IN BYTE                              04591000
         BCTR  R3,0           POINT TO NEXT OUTPUT BYTE                 04592000
         BCT   R2,LOOP4       DO IT FOR ALL INPUT BYTES                 04593000
         LM    R1,R5,REGSAVE1 RETURN REG                                04594000
         BR    R14            RETURN TO CALLER                          04595000
         EJECT                                                          04596000
****************************************************************        04597000
*                                                                       04598000
*        SUBROUTINE TO CONVERT DECIMAL DIGITS TO BINARY                 04599000
*                                                                       04600000
****************************************************************        04601000
BINCONV  STM   R1,R3,REGSAVE1 SAVE REGS                                 04602000
         CL    R2,=F'8'       IS IT OVER 8                              04603000
         BH    DDR701         YES- ERROR                                04604000
LOOP9    TM    0(R1),X'F0'    IS IT NUM                                 04605000
         BNO   DDR701         NO- ERROR                                 04606000
         LA    R1,1(,R1)      POINT TO THE NEXT BYTE                    04607000
         BCT   R2,LOOP9       DO IT TO ALL INPUT                        04608000
         LM    R1,R3,REGSAVE1 RETURN REGS                               04609000
         BCTR  R2,0           SUB 1 FROM COUNT                          04610000
         EX    R2,PACK        PACK DATA INTO WORK1                      04611000
         CVB   R2,WORK1       SET UP DATA IN R2                         04612000
         BR    R14                                                      04613000
PACK     PACK  WORK1,0(1,R1)                                            04614000
         SPACE 3                                                        04615000
*****************************************************************       04616000
*                                                                       04617000
*        SUBROUTINE TO COMPARE KEYWORDS                                 04618000
*                                                                       04619000
*****************************************************************       04620000
COMPARE  BCTR  R2,0           -1                                        04621000
         EX    R2,EXECOMP     DO THE COMPARE                            04622000
         LA    R2,1(,R2)      +1                                        04623000
         BR    R14            RETURN WITH THE CC SET                    04624000
EXECOMP  CLC   0(0,R3),0(R1)  COMPARE R1 TO R3 USING R2                 04625000
         EJECT                                                          04626000
******************************************************************      04627000
*.                                                                      04628000
*  28.   EXIT ROUTINE                                                   04629000
*                                                                       04630000
*              1. LINK TO MSG001 TO TYPE THE END OF JOB MSG.            04631000
*                                                                       04632000
*              2. IF UNDER VM/370 CLOSE THE SYSPRINT DEVICE WITH A      04633000
*                 DIAGNOSE 8.                                           04634000
*                                                                       04635000
*              3. IF NOT UNDER CMS LOAD A DISABLED PSW.                 04636000
*                                                                       04637000
*              4. SET UP THE CMS RETURN ADDRESS AND RETURN CODE.        04638000
*                                                                       04639000
*              5. RETURN TO CMS USING R14, R15 = RETURN CODE.           04640000
*.                                                                      04641000
******************************************************************      04642000
EXIT     MVC   MSG001+13(7),BLANKS                                      04643000
         MVC   MSG001+13(3),=C'JOB '    SET UP EOJ MSG                  04644000
         BAL   R14,MSG001     PRINT MSG                                 04645000
         CLI   CPUID,X'FF'    IS THIS A VIRTUAL MACHINE ?               04646000
         BNE   TESTCMS        NO, GO TEST FOR CMS                       04647000
         TM    SPRNTDEV,CONS  WAS CONS SPECIFIED               HRC012DK 04647200
         BO    TESTCMS        UES DON'T CLOSE 00E              HRC012DK 04647400
         TM    SPRNTDEV,PRT   WAS PRINTER INITIALIZED ?        HRC012DK 04647600
         BNO   TESTCMS        NO, DON'T CLOSE 00E              HRC012DK 04647800
         SSM   *+1            LOCK OUT CMS                              04648000
         LA    R1,CPCLOSE     POINT TO LIST                             04649000
         LA    R2,L'CPCLOSE+L'CPADD  SET UP THE LENGTH                  04650000
         DC    X'83120008'    DIAG CALL TO VM/370 TO CLOSE THE SYSPRINT*04651000
                              DEVICE                                    04652000
TESTCMS  CL    R10,BAREMAC    IS THIS UNDER CMS                         04653000
         BNE   CMS8           YES- BRANCH                               04654000
         LPSW  SVCNEW         STOP!!!                                   04655000
CMS8     EQU   *                                                        04656000
         TM    DDRFLAG,CARDIN IS THE INPUT FROM A CMS FILE              04657000
         BZ    NOCLOSE        NO- BRANCH SKIP THE CLOSE                 04658000
         LA    R1,INFCB       POINT TO THE FCB                          04659000
         MVC   0(8,R1),=CL8'FINIS' SET UP THE FCB TO CLOSE FILE         04660000
         SVC   202            CALL CMS TO CLOSE THE FILE                04661000
         DC    AL4(*+4)       NO ERROR RETURN                           04662000
NOCLOSE  EQU   *                                                        04663000
         BAL   R1,CMSREL      THE FOLLOWING ROUTINE IS A       @VA08841 04664000
         DC    X'962005E107F1' SIMULATION OF THE DMSEXS        @VA08841 04665000
CMSREL   SVC   203            MACRO TO SET CMS RELPAGES BIT    @VA08841 04666000
         DC    H'-9'                                           @VA08841 04667000
         LM    R14,R15,CMSSAVE     GET THE RETURN ADDRESS AND CODE      04668000
         LTR   R15,R15        DO I HAVE A RETURN CODE                   04669000
         BCR   7,R14          YES- RETURN WITH IT                       04670000
         TM    DDRFLAG,CARDIN+ERROR     DID I HAVE AN ERROR IN THE CMS X04671000
                                        INPUT FILE                      04672000
         BCR   14,R14         NO- RETURN TO CMS                         04673000
         LA    R15,2          SET RETURN CODE TO 2                      04674000
         BR    R14            RETURN TO CMS                             04675000
         EJECT                                                          04676000
         LTORG                                                          04677000
         SPACE 3                                                        04678000
*****    CHARACTER CONSTANTS                                            04679000
CPCLOSE  DC    C'CLOSE '                                                04680000
CPADD    DC    C'00E '                                                  04681000
ENTER    DC    C'ENTER: '                                               04682000
DDRFLAG  DC    X'0'                                                     04683000
VLDRDR   EQU   X'80'          RDR ADDRESS IS REALLY A RDR      @VA04550 04684000
CARDIN   EQU   X'40'          INPUT IS FROM CARD                        04685000
CARDEOF  EQU   X'20'          END OF FILE ON CARD READER                04686000
RESTALL  EQU   X'10'          RESTORE ALL SWITCH                        04687000
         SPACE ,                                               HRC012DK 04687005
DDRFLAG3 DC    X'0'           INPUT OR OUTPUT ERROR FLAG       @VA13582 04687010
OUTERROR EQU   X'04'          FOR FLAG OUT DEF. ERROR          @VA13582 04687020
INERROR  EQU   X'02'          FOR FLAG IN DEF. ERROR           @VA13582 04687030
ERROR    EQU   X'08'          ERROR SWITCH                              04688000
SUPLINE  EQU   X'04'          SUPPRES LINE SWITCH                       04689000
NUCLEUS  EQU   X'02'                                              (NUC) 04690000
FIRSTEOF EQU   X'01'          E-O-F INDICATOR                  @VA02229 04691000
         SPACE ,                                               HRC012DK 04691500
DDRFLAG2 DC    X'0'                                                     04692000
PRINT    EQU   X'80'          PRINT FUNCTION                            04693000
TYPE     EQU   X'40'          TYPE FUNCTION                             04694000
VERIFY   EQU   X'20'          VERIFY FUNCTION                           04695000
REPLACE  EQU   X'10'          REPLACE FUNCTION                          04696000
HEXOPT   EQU   X'08'          HEX OPTION                                04697000
GRAPHOPT EQU   X'04'          GRAPHIC OPTION                            04698000
COUNTOPT EQU   X'02'          COUNT OPTION                              04699000
DECDATA  EQU   X'01'          1= DEC DATA INPUT  0= HEX DATA INPUT      04700000
         SPACE ,                                               HRC012DK 04700100
SPRNTDEV DC    X'00'          FLAG FOR SYSPRINT OPTION         HRC012DK 04700200
PRT      EQU   X'02'          PRINTER                          HRC012DK 04700300
CONS     EQU   X'01'          CONSOLE                          HRC012DK 04700400
         SPACE ,                                               HRC012DK 04700500
NOSKMASK DC    X'D8'          READ ONLY ONE TRACK                       04701000
SVDSTAT  DC    X'00'          VDEVSTAT ON DIAG X'24'           HRC012DK 04702290
VDVDED   EQU   X'01'          DED DEVICE                       HRC012DK 04702580
HEADER   DC    C'COPYING DATA  XX/XX/XX AT XX.XX.XX  GMT FROM' @VA10358 04703100
DATE     EQU   HEADER+14                                                04704000
TIME     EQU   HEADER+26                                                04705000
ZONE     EQU   HEADER+36                                                04706000
DATA     DC    C'DATA '                                                 04707000
DUMPED   DC    C'DUMPED '                                               04708000
RESTORED DC    C'RESTORED '                                             04709000
TO       DC    C'TO '                                                   04710000
HEADER2  DC    C'INPUT CYLINDER EXTENTS      OUTPUT CYLINDER EXTENTS'   04713000
HEADER3  DC    C'        START     STOP      START     STOP'            04714000
BLANKS   EQU   HEADER3                                                  04715000
PHADDMSG DC    AL2(L'X1)                                                04716000
X1       DC    C'CYL XXX HD XX HOME ADDRESS XXXXXXXXXX RECORD ZERO XXXX*04717000
               XXXXXX XX XXXX XXXXXXXX XXXXXXXX'                        04718000
PRECMSG  DC    AL2(L'X2)                                                04719000
X2       DC    C'CYL XXX HD XX REC XXX COUNT XXXXXXXXXX XX XXXX'        04720000
PLENMSG  DC    AL2(L'X3)                                                04721000
X3       DC    C'XXXXX  XXXX  DATA LENGTH'                              04722000
*              C'XXXXX  XXXX  KEY  LENGTH'                              04723000
PEOFMSG  DC    AL2(L'X4)                                                04724000
X4       DC    C'END OF FILE RECORD'                                    04725000
POFMSG   DC    AL2(L'X5)                                                04726000
X5       DC    C'ABOVE RECORD WRITTEN USING RECORD OVERFLOW'            04727000
PSUPMSG  DC    AL2(L'X6)                                                04728000
X6       DC    C'SUPPRESSED CHARACTERS SAME AS ABOVE ...'               04729000
BLANKMSG DC    AL2(1),C' '    PRINT A BLANK                             04730000
DECTABLE DC    C'0123456789ABCDEF'                                      04731000
CONTBUFF DC    CL132' '                                                 04732000
RESPDATA DC    CL130' '                                                 04733000
         SPACE                                                          04734000
*        TRANSLATE TABLE                                                04735000
TRANTABL DC    64C'.'         UNPRINTABLE CHARACTERS                    04736000
         DC    C' '           BLANK                                     04737000
         DC    9C'.'                                                    04738000
SPECIALC DC    X'4A'          CENT SIGN                                 04739000
         DC    C'.<(+|&&'                                               04740000
         DC    9C'.'                                                    04741000
         DC    C'!$*);¬-/'                                              04742000
         DC    9C'.'                                                    04743000
         DC    X'6B6C'        'COMMA' & 'PERCENT' SIGNS                 04744000
         DC    C'_>?'                                                   04745000
         DC    10C'.'                                                   04746000
         DC    C':'                                                     04747000
         DC    X'7B7C'        'POUND' & 'AT' SIGNS                      04748000
         DC    C'''=".'                                                 04749000
LOWCASE  DC    C'ABCDEFGHI'   LOWER CASE CHARACTERS                     04750000
         DC    7C'.'                                                    04751000
         DC    C'JKLMNOPQR'   LOWER CASE CHARACTERS                     04752000
         DC    8C'.'                                                    04753000
         DC    C'STUVWXYZ'    LOWER CASE CHARACTERS                     04754000
         DC    23C'.'                                                   04755000
UPPERCAS DC    C'ABCDEFGHI'                                             04756000
         DC    7C'.'                                                    04757000
         DC    C'JKLMNOPQR'                                             04758000
         DC    8C'.'                                                    04759000
         DC    C'STUVWXYZ'                                              04760000
         DC    6C'.'                                                    04761000
         DC    C'0123456789'                                            04762000
         DC    6C'.'                                                    04763000
         SPACE                                                          04764000
SPECTYPE DC    X'4A'          CENT SIGN                                 04765000
         DC    C'.<(+|&&'                                               04766000
         DC    9C'.'                                                    04767000
         DC    C'!$*);¬-/'                                              04768000
         DC    9C'.'                                                    04769000
         DC    X'6B6C'        'COMMA' & 'PERCENT' SIGNS                 04770000
         DC    C'_>?'                                                   04771000
         DC    10C'.'                                                   04772000
         DC    C':'                                                     04773000
         DC    X'7B7C'        'POUND' & 'AT' SIGNS                      04774000
         DC    C'''=".'                                                 04775000
         SPACE                                                          04776000
SPECPTR  DC    C'.'           CENT SIGN                                 04777000
         DC    C'..(+.&&'                                               04778000
         DC    9C'.'                                                    04779000
         DC    C'.$*)..-/'                                              04780000
         DC    9C'.'                                                    04781000
         DC    C'..'          'COMMA' & 'PERCENT' SIGNS                 04782000
         DC    C'...'                                                   04783000
         DC    10C'.'                                                   04784000
         DC    C'.'                                                     04785000
         DC    C'..'          'POUND' & 'AT' SIGNS                      04786000
         DC    C'....'                                                  04787000
         SPACE                                                          04788000
LOWERCAS DC    C'abcdefghi'   LOWER CASE CHARACTERS                     04789000
         DC    7C'.'                                                    04790000
         DC    C'jklmnopqr'                                             04791000
         DC    8C'.'                                                    04792000
         DC    C'stuvwxyz'                                              04793000
         SPACE                                                          04794000
         DS    0H                                                       04795000
*****    HALF WORD CONSTANTS                                            04796000
LINECT   DC    H'0'           LINE COUNT                                04797000
MAXLINE  DC    H'60'          MAX LINE COUNT                            04798000
CONERCT  DC    H'20'          SET UP FOR TWENTY ERRORS                  04799000
EXTSIZE  EQU   6                                               @V200731 04800000
EXTABLE  DC    (20*EXTSIZE)X'00'                               @V200731 04801000
PBUFLEN  DC    XL1'0'                                                   04802000
CCBUFFER DC    XL1'0'                                                   04803000
SYSPTRBF DC    CL72' '                                                  04804000
INSTART  EQU   SYSPTRBF+8                                               04805000
INSTOP   EQU   SYSPTRBF+18                                              04806000
OUTSTART EQU   SYSPTRBF+28                                              04807000
OUTSTOP  EQU   SYSPTRBF+38                                              04808000
         ORG   SYSPTRBF                                                 04809000
PTBUFFER DC    CL122' '                                                 04810000
DISPDEC  EQU   PTBUFFER                                                 04811000
DISPHEX  EQU   PTBUFFER+7                                               04812000
HEXDATA  EQU   PTBUFFER+13                                              04813000
MIDDLE   EQU   HEXDATA+36                                               04814000
AST1     EQU   HEXDATA+74                                               04815000
DATATRAN EQU   AST1+1                                                   04816000
AST2     EQU   AST1+33                                                  04817000
         SPACE                                                          04818000
         DS    0F                                                       04819000
*****    FULL WORD CONSTANTS                                            04820000
PRINTRET DC    A(0)           REG 14 SAVE AREA FOR PRINT ROUTINE        04821000
ENDEXT   DC    A(EXTABLE+EXTSIZE*19)                           @V200731 04822000
CMSSAVE  DC    1F'0'                                                    04823000
ERRORRET DC    A(0)           ERROR RETURN                              04824000
ERSAVE   DC    7F'0'                                                    04825000
CHKSV    DC    3F'0'                                           @V2A2063 04826000
R5SAVE   DC    1F'0'                                                    04827000
SAVEREGS DC    3F'0'          SAVE AREA FOR SCANCONT                    04828000
CURPOINT DC    A(0)           POINTER TO CURRENT SCAN LINE              04829000
CURCOUNT DC    A(72)          COUNT OF BYTES NOT SCANNNED IN CONTROL BU 04830000
TAPEERCT DC    H'0'           TAPE ERROR COUNT                          04831000
DASDERCT DC    H'0'           DASD ERROR COUNT                          04832000
LASTREOR DC    X'FFFF'        CYL ADD OF THE END OF THE LAST REOR EXT   04833000
LASTSTOP DC    X'FFFF'        CYL ADD OF THE LAST STOP EXT              04834000
SENSE    DC    XL48'0'        SENSE DATA FROM LAST IO ERROR    @V2B3729 04835000
         SPACE ,                                               HRC012DK 04835040
SENSEB0  EQU   SENSE                                           HRC012DK 04835080
SENSEB1  EQU   SENSE+1                                         HRC012DK 04835120
SENSEB2  EQU   SENSE+2                                         HRC012DK 04835160
SENSEB3  EQU   SENSE+3                                         HRC012DK 04835200
SENSEB6  EQU   SENSE+6                                         HRC012DK 04835240
         SPACE ,                                               HRC012DK 04835280
RDEVMD82 EQU   X'08'          3380-2                           HRC012DK 04835320
RDEVMD83 EQU   X'0C'          3380-3                           HRC012DK 04835360
         DS    0H                                              HRC012DK 04835400
PRIM3383 DS    0CL4           PARM FOR 3380-3                  HRC012DK 04835440
MCYL3383 DC    H'2654'                                         HRC012DK 04835480
ALT3383  DC    H'2655'                                         HRC012DK 04835520
         SPACE ,                                               HRC012DK 04835560
PRIM3382 DS    0CL4           PARM FOR 3380-2                  HRC012DK 04835600
MCYL3382 DC    H'1769'                                         HRC012DK 04835640
ALT3382  DC    H'1770'                                         HRC012DK 04835680
         SPACE ,                                               HRC012DK 04835720
PRIM3380 DS    0CL4           PARM FOR 3380-1                  HRC012DK 04835760
MCYL3380 DC    H'0884'                                         HRC012DK 04835800
ALT3380  DC    H'0885'                                         HRC012DK 04835840
         SPACE ,                                               HRC012DK 04835880
MHD3380  DC    H'14'          MAX HEAD NUMBER FOR 3380         HRC012DK 04835920
         SPACE ,                                               HRC012DK 04835960
SNSCNT   DC    X'00'                                           @V2B3729 04836000
DEVBUCT  DC    H'0'           DEVICE BUSY COUNT                @VA10042 04836500
SIOSAVE  DC    7F'0'                                                    04837000
IRSAVE   DC    7F'0'                                                    04838000
IOBSAVE  DC    2F'0'                                                    04839000
NEXTFILD DC    2F'0'          SAVE AREA                                 04840000
CUREXT   DC    A(0)           ADDRESS OF THE CURRENT EXTENT TABLE ENTRY 04841000
LASTEXT  DC    A(0)           ADDRESS OF THE LAST EXTENT TABLE ENTRY    04842000
BAREMAC  DC    A(DMKDDREP+2-DMKDDR)                                     04843000
SAVENAME DC    CL8' '                                                   04844000
REGSAVE1 DC    5F'0'                                                    04845000
REGSAVE2 DC    5F'0'                                                    04846000
REGSAVE3 DC    6F'0'                                                    04847000
REGSAVE4 DC    4F'0'                                                    04848000
SAVERET  DC    1F'0'                                                    04849000
ADDR1    DC    X'5B5F'        LOCATION LINE 22 COL 80          @V60A6B6 04850000
ADDR2    DC    X'5D6B'        LOCATION LINE 24 COL 60          @V60A6B6 04851000
ADDR3    DC    X'D65F'        LOCATION LINE 18 COL 80          @V60A6B6 04852000
ADDR4    DC    X'D86B'        LOCATION LINE 20 COL 60          @V60A6B6 04853000
ADDR5    DC    X'4040'        INITIAL AREA FOR CURSOR CHECK    @V60A6B6 04854000
ADDR6    DC    X'5B60'        LOCATION LINE 23 COL 01          @V60A6B6 04855000
ADDR7    DC    X'D660'        LOCATION LINE 19 COL 01          @V60A6B6 04856000
MAXLEN   DC    F'0000'        INITIALIZED MAX LENGTH ON CONS.  @V60A6B6 04857000
LEN3270  DC    F'1760'        24 LINE CONSOLE SCREEN           @V60A6B6 04858000
LEN3278  DC    F'1440'        20 LINE CONSOLE FOR 3278 MOD2A   @V60A6B6 04859000
INIOB    DC    X'80000000'                                              04860000
         DC    A(0)           POINTER TO THE CCW                        04861000
         DC    A(INOUTER)     POINTER TO THE ERROR ROUTINE              04862000
         DC    (IOBSIZE-(*-INIOB))X'00'                        @V56BDA8 04863000
         DS    0F                                              @V56BDA8 04864000
OUTIOB   DC    X'80000000'                                              04865000
         DC    A(0)           POINTER TO THE CCW                        04866000
         DC    A(INOUTER)     POINTER TO THE ERROR ROUTINE              04867000
         DC    (IOBSIZE-(*-OUTIOB))X'00'                       @V56BDA8 04868000
         DS    0F                                              @V56BDA8 04869000
PRINTIOB DC    X'8000000E'                                              04870000
         DC    A(HEADCCW)     POINTER TO CCW                            04871000
         DC    A(PTRERROR)    ERROR ROUTINE                             04872000
         DC    (IOBSIZE-(*-PRINTIOB))X'00'                     @V56BDA8 04873000
         DS    0F                                              @V56BDA8 04874000
CONIOB   DC    X'80200009'                                              04875000
         DC    A(CONCCW)      POINTER TO CCW                            04876000
         DC    A(SETUPERR)    POINTER TO THE ERROR ROUTINE              04877000
         DC    2F'0'          ERROR CSW                                 04878000
         DC    AL1(CLASTERM,0)                                 @V2A2063 04879000
         DC    (IOBSIZE-(*-CONIOB))X'00'                       @V56BDA8 04880000
         DS    0F                                              @V56BDA8 04881000
CARDIOB  DC    X'A060FFFF'                                              04882000
         DC    A(CARDCCW)     POINTER TO THE CCW                        04883000
         DC    A(READERR)     POINTER TO THE ERROR ROUTINE              04884000
         DC    (IOBSIZE-(*-CARDIOB))X'00'                      @V56BDA8 04885000
         SPACE                                                          04886000
         DS    0D                                                       04887000
*****    DOUBLE WORD CONSTANTS                                          04888000
TODATE   DC    D'0'                                                     04889000
TYPEFCB  DC    CL8'TYPLIN'                                              04890000
         DC    AL1(1)                                                   04891000
         DC    AL3(RESPMSG)                                             04892000
         DC    CL1'B'                                                   04893000
         DC    X'80'                                                    04894000
         DC    AL2(L'RESPMSG)                                           04895000
TYPEFCB2 DC    CL8'TYPLIN'                                     @V2A2063 04896000
         DC    AL1(1)                                          @V2A2063 04897000
         DC    AL3(RESPMSG2)                                   @V2A2063 04898000
         DC    C'B'                                            @V2A2063 04899000
         DC    X'80'                                           @V2A2063 04900000
         DC    AL2(L'RESPMSG2)                                 @V2A2063 04901000
CONINFCB DC    CL8'CONREAD'                                             04902000
         DC    AL1(1)                                                   04903000
         DC    AL3(RESPDATA)                                            04904000
         DC    CL1'U'                                                   04905000
         DC    AL3(130)                                                 04906000
CONFCB   DC    CL8'TYPLIN'                                              04907000
         DC    AL1(1)                                                   04908000
         DC    AL3(0)                                                   04909000
         DC    C'B'                                                     04910000
         DC    X'00'                                                    04911000
         DC    AL2(0)                                                   04912000
ENTERFCB DC    CL8'TYPLIN'                                              04913000
         DC    AL1(1)                                                   04914000
         DC    AL3(ENTER)                                               04915000
         DC    C'B'                                                     04916000
         DC    X'80'                                                    04917000
         DC    AL2(L'ENTER)                                             04918000
CONRDFCB DC    CL8'CONREAD'                                             04919000
         DC    AL1(1)                                                   04920000
         DC    AL3(CONTBUFF)                                            04921000
         DC    CL1'U'                                                   04922000
         DC    AL3(130)                                                 04923000
PRINTFCB DC    CL8'PRINTIO'                                             04924000
         DC    A(CCBUFFER)                                              04925000
         DC    H'1'                                                     04926000
PRINTL   DC    H'0'                                                     04927000
CPUID    DC    1F'0'                                                    04928000
CPUMODEL DC    1F'0'                                                    04929000
INFCB    DC    CL8'STATE'                                               04930000
         DC    CL16' '                                                  04931000
         DC    CL2'* '                                                  04932000
         DC    H'0'                                                     04933000
INFCBUF  DC    F'0'                                                     04934000
         DC    F'80'                                                    04935000
         DC    CL2'F'                                                   04936000
         DC    H'1'                                                     04937000
         DC    F'0'                                                     04938000
RELP     DS    0D                                              @VA04324 04939000
         DC    CL8'REL'                                        @VA04324 04940000
CCU      DC    CL8' '                                          @VA04324 04941000
         DC    8X'FF'                                          @VA04324 04942000
         SPACE ,                                               HRC012DK 04942100
CYLPRMSZ EQU   6                   CYLINDER PARAMETER SIZE     HRC012DK 04942200
CYLPOS   EQU   6                   CYLINDER PARAMETER POSITION HRC012DK 04942300
MDSKREGS DC    6F'0'               REGISTER SAVE AREA          HRC012DK 04942400
BUFFRET  DC    X'40'               INDICATE BUFFER RETURN.     HRC012DK 04942500
QRYDEV   DC    CL15'QUERY VIRTUAL' QUERY VIRTUAL COMMAND       HRC012DK 04942600
DEVCUU   DC    CL4' '              DEVICE ADDRESS FOR QUERY    HRC012DK 04942700
QRYRESP  DC    CL80' '             QUERY RESPONSE BUFFER       HRC012DK 04942800
         SPACE ,                                               HRC012DK 04942900
WORK1    DS    1D                                                       04943000
IOWPSW   DC    X'FF060000'                                              04944000
         DC    A(TESTATTN)                                              04945000
CONWAIT  DC    X'FF060000'                                              04946000
         DC    A(CONRET)                                                04947000
MACHINE  DS    F                  USED FOR BARE MACHINE COMP   HRC012DK 04947500
         SPACE 3                                                        04948000
******************************************************************      04949000
*                                                                       04950000
*        CCW'S AND SEEK SEARCH ADDRESSES                                04951000
*                                                                       04952000
******************************************************************      04953000
         SPACE                                                          04954000
VOL1ID   DC    C'VOL1'                                                  04955000
ALLOADD  DC    X'00000000000004'   ALLOCATION RECORD DASD ADDRESS       04956000
REC3VOL1 DC    XL5'0000000003'                                          04957000
         CNOP  2,4                                                      04958000
INADD    DC    4H'0'          BBCCHHR OF CURRENT INPUT TRACK            04959000
OUTADD   DC    4H'0'          BBCCHHR OF CURRENT OUTPUT TRACK           04960000
PSTARTCC DC    H'0'           STARTING CYLINDER FOR THE PRINT ROUTINE   04961000
PSTARTHH DC    H'0'           STARTING TRACK FOR THE PRINT ROUTINE      04962000
PSTARTRR DC    H'0'           STARTING RECORD FOR THE PRINT ROUTINE     04963000
PSTOPCC  DC    H'0'           ENDING CYLINDER FOR THE PRINT ROUTINE     04964000
PSTOPHH  DC    H'0'           ENDING TRACK FOR THE PRINT ROUTINE        04965000
PSTOPRR  DC    H'0'           ENDING RECORD FOR THE PRINT ROUTINE       04966000
         SPACE                                                          04967000
IPLADD   DC    XL5'0000000001'                                    (NUC) 04968000
CKPMOD   DC    XL5'0000000002'                                    (NUC) 04969000
         SPACE                                                          04970000
RCKPDASD CCW   07,ALLOADD,CC,6                                    (NUC) 04971000
         CCW   49,CKPMOD,CC+SILI,5                                (NUC) 04972000
         CCW   08,*-8,0,0                                         (NUC) 04973000
         CCW   06,THR,0,4096                                      (NUC) 04974000
WCKPDASD CCW   07,ALLOADD,CC,6                                    (NUC) 04975000
         CCW   49,IPLADD,CC+SILI,5                                (NUC) 04976000
         CCW   08,*-8,0,0                                         (NUC) 04977000
         CCW   05,IPLDATA,CC,24                                   (NUC) 04978000
         CCW   49,CKPMOD,CC+SILI,5                                (NUC) 04979000
         CCW   08,*-8,0,0                                               04980000
         CCW   05,THR,0,4096                                      (NUC) 04981000
         SPACE                                                          04982000
IPLDATA  DC    X'000C000000000800' EXTENDED PSW FOR IPL           (NUC) 04983000
         CCW   6,X'800',0,4096     CCW TO READ IN DMKCKPT         (NUC) 04984000
         DC    A(0,0)         UNUSED                              (NUC) 04985000
         SPACE                                                          04986000
WCKPTAPE CCW   01,THR,SILI,4096                                   (NUC) 04987000
         SPACE                                                          04988000
PRINTCCW CCW   09,*,SILI,1          PRINTER CCW                         04989000
INITCCW  CCW   X'37',0,SILI,1       'INITIALIZE PRINTER' CCW   @V60B9BA 04990000
FSFCCW   CCW   63,*,SILI,1                                              04991000
SKTO1CCW CCW   X'8B',*,SILI,1                                           04992000
RESPCCW  CCW   01,RESPMSG,CC+SILI,52                                    04993000
         CCW   10,RESPDATA,SILI,72                                      04994000
RESPCCW2 CCW   01,RESPMSG2,CC+SILI,45                          @V2A2063 04995000
         CCW   10,RESPDATA,SILI,72                             @V2A2063 04996000
PTENDCCW CCW   19,*,CC+SILI,1                                           04997000
         CCW   09,MSG001+6,SILI,14                                      04998000
CARDCCW  CCW   02,CONTBUFF,SILI,72                                      04999000
HEADCCW  CCW   X'8B',*,CC+SILI,1                                        05000000
         CCW   25,SYSPTRBF,CC+SILI,L'SYSPTRBF                  HRC012DK 05001390
         CCW   17,HEADER2,CC+SILI,L'HEADER2                    HRC012DK 05001780
         CCW   09,HEADER3,SILI,L'HEADER3                       HRC012DK 05002170
CONCCW1  CCW   09,SYSPTRBF,CC+SILI,L'SYSPTRBF                  HRC012DK 05002560
         CCW   09,HEADER2,CC+SILI,L'HEADER2                    HRC012DK 05002950
         CCW   09,HEADER3,SILI,L'HEADER3                       HRC012DK 05003340
PTEXTCCW CCW   09,SYSPTRBF,SILI,42                                      05004000
CONCCW   CCW   09,MSG002+6,SILI,46                                      05005000
CONINCCW CCW   01,ENTER,CC+SILI,7                                       05006000
         CCW   10,CONTBUFF,SILI,72                                      05007000
RVHRCCW  CCW   02,VHR,SILI,80                                           05008000
BSR4CCW  CCW   39,*,SILI+CC,1                                           05009000
         CCW   39,*,SILI+CC,1                                           05010000
         CCW   39,*,SILI+CC,1                                           05011000
         CCW   39,*,SILI+CC,1                                           05012000
         CCW   55,*,SILI+CC,1                                  @VA01466 05013000
         CCW   55,*,SILI+CC,1                                  @VA01466 05014000
         CCW   55,*,SILI+CC,1                                  @VA01466 05015000
FSR1CCW  CCW   55,*,SILI+CC,1                                  @VA01466 05016000
         CCW   03,*,SILI,1                                              05017000
BACKECCW CCW   39,*,SILI+CC,1                                           05018000
         CCW   23,*,SILI+CC,1                                           05019000
         CCW   03,*,SILI,1                                              05020000
BACKCCW  CCW   39,*,SILI+CC,1                                           05021000
NOOP     CCW   03,*,SILI,1                                              05022000
RR0CCW   CCW   35,*+6,CC,1    SET SECTOR TO ZERO                        05023000
         CCW   22,THR000,SILI,8    READ RECORD ZERO                     05024000
BSFCCW   CCW   47,*,SILI,1                                              05025000
BACKCCW1 CCW   39,*,CC+SILI,1                                           05026000
BACKCCW2 CCW   39,*,CC+SILI,1                                           05027000
BACKCCW3 CCW   39,*,CC+SILI,1                                           05028000
BACKCCW4 CCW   39,*,CC+SILI,1                                           05029000
BACKCCW5 CCW   39,*,CC+SILI,1                                           05030000
BACKCCW6 CCW   01,VHR,CC+SILI,80                                        05031000
         CCW   31,*,CC+SILI,1                                           05032000
DISPCCW  CCW   15,*,SILI,1                                              05033000
RUNCCW   CCW   15,*,SILI,1                                              05034000
WRITEVHR CCW   03,*,CC+SILI,1                                           05035000
WVHRCCW  CCW   01,VHR,SILI,80                                           05036000
RTHRCCW  CCW   02,THR,SILI,4096                                         05037000
TAPRCCW  CCW   02,DB1,CC,0                                              05038000
         CCW   02,DB2,CC,0                                              05039000
         CCW   02,DB3,CC,0                                              05040000
         CCW   02,DB4,CC,0                                     @V304498 05041000
         CCW   02,DB5,CC,0                                     HRC012DK 05041070
         CCW   02,DB6,CC,0                                     HRC012DK 05041140
         CCW   02,DB7,CC,0                                     HRC012DK 05041210
         CCW   02,DB8,CC,0                                     HRC012DK 05041280
         CCW   02,DB9,CC,0                                     HRC012DK 05041350
         CCW   02,DB10,CC,0                                    HRC012DK 05041420
         CCW   02,DB11,CC,0                                    HRC012DK 05041490
         CCW   02,DB12,CC,0                                    HRC012DK 05041560
         CCW   02,DB13,CC,0                                    HRC012DK 05041630
         CCW   02,DB14,CC,0                                    HRC012DK 05041700
         CCW   02,DB15,CC,0                                    HRC012DK 05041770
         CCW   02,DB16,CC,0                                    HRC012DK 05041840
ALLOCCW  CCW   07,ALLOADD,CC,6                                          05042000
         CCW   49,ALLOADD+2,CC,5                                        05043000
         CCW   08,*-8,CC,0                                              05044000
ALLOBUFA CCW   06,ALLOBUFF,0,1024                                       05045000
VOL1CCW  CCW   07,ALLOADD,CC,6                                          05046000
         CCW   41,VOL1ID,CC+SILI,4                                      05047000
         CCW   08,*-8,0,0                                               05048000
VOL1BUFA CCW   06,VOL1BUFF,SILI,80                                      05049000
R3CCW    CCW   07,ALLOADD,CC,6                                          05050000
         CCW   49,REC3VOL1,CC+SILI,5                                    05051000
         CCW   08,*-8,0,0                                               05052000
         CCW   06,VOL1BUFF,SILI,80                                      05053000
READ333X CCW   07,INADD,CC,6                                            05054000
         CCW   31,NOSKMASK,CC,1                                         05055000
         CCW   35,*+6,CC,1    SET SECTOR TO ZERO                        05056000
         CCW   26,THRHADD,CC+SILI,5                                     05057000
         CCW   49,INADD+2,CC+SILI,5 SEARCH ID EQ LOOKS FOR     @V56BDA8 05058000
*                                    RECORD R0 AND CAUSES TRK-COND-CHK  05059000
*                                    IF WE ARE ON A DEF TRK.  THIS PUTS 05060000
*                                    US THRU ERROR RECOVERY AND GETS US 05061000
*                                    TO ALT TRK BEFORE WE READ R0.      05062000
         ORG   *-3                                             @V56BDA8 05063000
         DC    AL1(ALTRDPRG)  FLAG SEARCH CCW                  @V56BDA8 05064000
         ORG   *+2                                             @V56BDA8 05065000
         CCW   08,*-8,0,0                                               05066000
         CCW   14,THR000+8,CC+SILI,8                                    05067000
         CCW   08,CCWWORK,0,0                                           05068000
READ333Y CCW   07,INADD,CC,6  SEEK                             @V56BDA8 05069000
         CCW   31,NOSKMASK,CC,1 SET FILE MASK                  @V56BDA8 05070000
         CCW   35,*+6,CC,1    SET SECTOR TO ZERO.              @V56BDA8 05071000
         CCW   22,THR000,CC+SILI,16 READ RECORD R0             @V56BDA8 05072000
         CCW   08,CCWWORK,0,0 TIC  TO THE READ CCWS.           @V56BDA8 05073000
READ231X CCW   07,INADD,CC,6                                            05074000
         CCW   31,NOSKMASK,CC,1                                         05075000
         CCW   08,RDCONT,0,0                                            05076000
READ230X CCW   07,INADD,CC,6                                            05077000
         CCW   31,NOSKMASK,CC,1                                         05078000
         CCW   35,*+6,CC,1    SET SECTOR TO ZERO                        05079000
RDCONT   EQU   *                                                        05080000
         CCW   26,THRHADD,CC+SILI,5                                     05081000
CCWWORKA CCW   08,CCWWORK,CC,1                                 @VA01049 05082000
READR0   CCW   22,THR000,CC+SILI,16                            @VA01049 05083000
COUNTCCW CCW   146,THR001,CC,8                                          05084000
KEYCCW   CCW   142,0,CC,0                                               05085000
SNSE4CCW CCW   E4,SENSE,SILI,L7               E4 SENSE ID CCW  HRC012DK 05086110
E4       EQU   X'E4'                                           HRC012DK 05086120
SENSECCW CCW   04,SENSE,SILI+CC,24                             HRC012DK 05086130
         CCW   08,CURS3066,SILI+CC,1                           @VA11504 05086200
RECALCCW CCW   19,*,CC+SILI,1                                           05087000
RECALTIC CCW   08,*,CC+SILI,1                                           05088000
TAPWCCW  CCW   01,THR,CC+SILI,0                                         05089000
         CCW   01,DB1,CC+SILI,0                                         05090000
         CCW   01,DB2,CC+SILI,0                                         05091000
         CCW   01,DB3,CC+SILI,0                                         05092000
         CCW   01,DB4,CC+SILI,0                                @V304498 05093000
         CCW   01,DB5,CC+SILI,0                                HRC012DK 05093070
         CCW   01,DB6,CC+SILI,0                                HRC012DK 05093140
         CCW   01,DB7,CC+SILI,0                                HRC012DK 05093210
         CCW   01,DB8,CC+SILI,0                                HRC012DK 05093280
         CCW   01,DB9,CC+SILI,0                                HRC012DK 05093350
         CCW   01,DB10,CC+SILI,0                               HRC012DK 05093420
         CCW   01,DB11,CC+SILI,0                               HRC012DK 05093490
         CCW   01,DB12,CC+SILI,0                               HRC012DK 05093560
         CCW   01,DB13,CC+SILI,0                               HRC012DK 05093630
         CCW   01,DB14,CC+SILI,0                               HRC012DK 05093700
         CCW   01,DB15,CC+SILI,0                               HRC012DK 05093770
         CCW   01,DB16,CC+SILI,0                               HRC012DK 05093840
WT231X   CCW   07,OUTADD,CC,6                                           05094000
         CCW   31,NOSKMASK,CC,1                                         05095000
         CCW   08,WTCONT,0,0                                            05096000
WT230X   CCW   07,OUTADD,CC,6                                           05097000
         CCW   31,NOSKMASK,CC,1                                         05098000
         CCW   35,*+6,CC,1    SET SECTOR TO ZERO                        05099000
WTCONT   EQU   *                                                        05100000
         CCW   57,OUTADD+2,CC+SILI,4                                    05101000
         CCW   08,*-8,0,0                                               05102000
         CCW   25,THRHADD,CC,5                                          05103000
         CCW   21,THR000,CC+SILI,16                                     05104000
         CCW   08,CCWWORK,0,0                                           05105000
WT333X   CCW   07,OUTADD,CC,6                                           05106000
         CCW   31,NOSKMASK,CC,1                                         05107000
         CCW   49,OUTADD+2,CC+SILI,5 SEARCH ID EQ LOOKS FOR    @V56BDA8 05108000
*                                    RECORD R0 AND CAUSES TRK-COND-CHK  05109000
*                                    IF WE ARE ON A DEF TRK.  THIS PUTS 05110000
*                                    US THRU ERROR RECOVERY AND GETS US 05111000
*                                    TO THE ALT TRK BEFORE WE READ R0.  05112000
         ORG   *-3                                             @V56BDA8 05113000
         DC    AL1(ALTWRPRG)  FLAG SEARCH CCW                  @V56BDA8 05114000
         ORG   *+2                                             @V56BDA8 05115000
         CCW   08,*-8,0,0                                               05116000
         CCW   05,THR000+8,CC+SILI,8                                    05117000
         CCW   49,OUTADD+2,CC+SILI,5                                    05118000
         CCW   08,*-8,0,0                                               05119000
         CCW   08,CCWWORK,0,0                                           05120000
DASDWCCW CCW   29,THR001,CD,8                                           05121000
         CCW   29,0,CC,0                                                05122000
READEOF  CCW   18,*,CC+SKIP,8                                           05123000
DASDECCW CCW   17,INADD+2,SILI,8                                        05124000
READHAR0 CCW   7,ALTSKADD,CC,6 SEEK                            @V56BDA8 05125000
         CCW   35,*+6,CC,1    SET SECTOR TO 0.                 @V56BDA8 05126000
         CCW   26,ALTHA,CC+SILI,5 READ HA                      @V56BDA8 05127000
         CCW   22,ALTR0,SILI,16 READ R0                        @V56BDA8 05128000
ALTSEEK  CCW   7,ALTSKADD,CC,6 SEEK                            @V56BDA8 05129000
         CCW   31,NOSKMASK,CC,1 SET FILE MASK                  @V56BDA8 05130000
         CCW   35,*+6,CC,1    SET SECTOR TO 0.                 @V56BDA8 05131000
         CCW   26,0,CC+SILI+SKIP,5 READ HA                     @V56BDA8 05132000
ALTTIC   CCW   8,*-*,0,0      TIC                              @V56BDA8 05133000
         EJECT                                                          05134000
**********************************************************************  05135000
*              GRAPHIC SUPPORT CCWS                                     05136000
**********************************************************************  05137000
CRTWORD  CCW   X'27',SBACP,SILI+CC,2 SET BAR TO (STATUS WORD)  @V200731 05138000
         CCW   X'01',CPXYSTAT,SILI+CC,20 WRITE 'RUNNING' ON    @V200731 05139000
*                             SCREEN                                    05140000
         CCW   X'27',SBAREAD,SILI+CC,2 SET BUFFER ADDR FOR     @V200731 05141000
*                             WRITE                                     05142000
         CCW   X'01',BLNKZERO,SILI+CC,140 CLEAR INPUT LINE     @VM08604 05143000
CURS3066 CCW   X'0F',SBAREAD,SILI+CC,2 REPOSITION CURSOR       @V200731 05144000
         CCW   X'03',*-*,SILI,3 END OF READ CCW STRING         @V200731 05145000
         SPACE 2                                                        05146000
CRTWORD1 CCW   X'01',LAB3270A,SILI+CC,LEN THE CONTROL DATA     @VM08630 05147000
         CCW   X'03',*-*,SILI,2                                @V200731 05148000
         SPACE 2                                                        05149000
REQREAD  CCW   X'27',SBACP,SILI+CC,2 SET BUFFER ADDR TO CP X-Y @V200731 05150000
         CCW   X'01',CPXYSTAT,SILI+CC,20 WRITE SCREEN STATUS   @V200731 05151000
         CCW   X'08',CURS3066,SILI,1 RESET CURSOR POSITION     @V200731 05152000
         SPACE 2                                                        05153000
REQREAD1 CCW   X'01',LAB3270B,SILI+CC,LEN1 THE CONTROL DATA    @VM08630 05154000
         CCW   X'03',*-*,SILI,2                                @V200731 05155000
         SPACE 2                                                        05156000
ERSE3066 CCW   X'07',*-*,SILI+CC,1 ERASE ENTIRE SCREEN         @V200731 05157000
WRTCRTXY CCW   X'27',SBADDR,SILI+CC,2 SET CORRECT LINE IN      @V200731 05158000
*                             BUFFER                                    05159000
WRT3066  CCW   X'01',*-*,SILI+CC,140 WRITE OUT USER DATA       @V200731 05160000
         CCW   X'08',CRTWORD,SILI,1 NOW DISPLAY STATUS         @V200731 05161000
         SPACE 2                                                        05162000
ERSE3270 CCW   X'05',LAB3270E,SILI+CD,LEN3 ERASE THE SCREEN    @V200731 05163000
         CCW   X'00',CPXYSTAT,SILI+CC,20 WRITE SCREEN STATUS   @V200731 05164000
WRTCRT70 CCW   X'01',LAB3270,SILI+CD,4 THE CONTROL DATA        @V200731 05165000
WRTCR70  CCW   X'00',*-*,SILI+CD,0 THE WRITE CCW               @V200731 05166000
         CCW   X'00',LAB3270A+1,SILI+CC,LEN-1 WRITE SCREEN     @V200731 05167000
*                             STATUS                                    05168000
         CCW   X'03',*-*,SILI,2                                @V200731 05169000
         SPACE 2                                                        05170000
RDMI3066 CCW   X'0E',RDMIDATA,SILI+CC,3 READ CCW FOR MI COMMAND@V200731 05171000
RD3066   CCW   X'27',SBAREAD,SILI+CC,2 SET BUFFER ADDR FOR READ@V200731 05172000
RD3066DA CCW   X'06',*-*,SILI+CC,140 READ INPUT DATA           @V200731 05173000
         CCW   X'08',CURS3066,SILI,1 REPOSITION CURSOR         @V200731 05174000
         SPACE 2                                                        05175000
RDMI3270 CCW   X'01',LAB3270D,SILI+CC,4                        @V200731 05176000
RD3270DA CCW   X'06',*-*,SILI+CC,0 THE CCW FOR READ            @V200731 05177000
         CCW   X'03',*-*,SILI,2                                @V200731 05178000
         SPACE 2                                                        05179000
CNCL3270 CCW   X'01',LAB3270E,SILI+CD,LEN3 THE CONTROL DATA    @V200731 05180000
         CCW   X'00',CPXYSTAT,SILI+CC,20 WRITE SCREEN STATUS   @V200731 05181000
         CCW   X'03',*-*,SILI,2                                @V200731 05182000
         SPACE 2                                                        05183000
CNCL3066 CCW   X'07',*-*,SILI+CC,1 ERASE SCREEN                @V200731 05184000
         CCW   X'08',CRTWORD,SILI,1 NOW DISPLAY STATUS         @V200731 05185000
         SPACE 2                                                        05186000
MORECCW1 CCW   X'01',LAB3270C,SILI+CC,LEN2 THE CONTROL DATA    @V200731 05187000
         CCW   X'03',*-*,SILI,2                                @V200731 05188000
         SPACE 2                                                        05189000
**********************************************************************  05190000
*********************************************************************   05191000
*        FIRST DC ARE ADDRESSES FOR LINES 1 -6                          05192000
*        SECOND DC ARE ADDRESSES FOR LINES 7 - 12                       05193000
*        THIRD  DC ARE ADDRESSES FOR LINES 13 - 18                      05194000
*        FOURTH DC ARE ADDRESSES FOR LINES 19 - 24                      05195000
*********************************************************************   05196000
         SPACE 2                                                        05197000
TABLE70  DS    0D                                              @V200731 05198000
         DC    X'4040C150C260C3F0C540C650'                     @V200731 05199000
         DC    X'C760C8F04A404B504C604DF0'                     @V200731 05200000
         DC    X'4F405050D160D2F0D440D550'                     @V200731 05201000
         DC    X'D660D7F0D9405A505B605CF0'                     @V200731 05202000
         SPACE 2                                                        05203000
TABLGRAP EQU   *                                               @V200731 05204000
         DC    X'0A',AL3(READ66) ADDRESS OF THE READ SECTION   @V200731 05205000
         DC    X'01',AL3(WRT66) ADDRESS OF THE WRITE SECTION   @V200731 05206000
         DC    X'09',AL3(WRT66) ADDRESS OF THE WRITE SECTION   @V200731 05207000
         DC    X'05',AL3(WRT66) ADDRESS OF THE WRITE SECTION   @V200731 05208000
         DC    X'03',AL3(RETWORD) ADDRESS OF THE RETURN SECTION@V200731 05209000
         SPACE 2                                                        05210000
*        X'5B60' - LINE 23, COL. 1                                      05211000
*        X'5D6A' - LINE 24, COL. 59                                     05212000
         SPACE 2                                                        05213000
**********************************************************************  05214000
WC6      EQU   X'C2'          WRITE CONTROL BIT 6              @V200731 05215000
AT7      EQU   X'C1'          ATTRIBUTE BIT 7                  @V200731 05216000
AT2      EQU   X'E0'          ATTRIBUTE BIT 2                  @V200731 05217000
LAC      EQU   X'C0'                                           @V200731 05218000
SF       EQU   X'1D'          START OF FIELD CONTROL           @V200731 05219000
SBA      EQU   X'11'          SET BUFFER ADDRESS               @V200731 05220000
IC       EQU   X'13'          INSERT CURSOR                    @V200731 05221000
EUA      EQU   X'12'          ERASE UNPROTECTED                @V200731 05222000
RA       EQU   X'3C'          REPEAT TO ADDRESS                @V200731 05223000
         SPACE 2                                                        05224000
LAB3270A DC    AL1(WC6),AL1(SBA),X'5B60',AL1(SF),AL1(AT7)      @V200731 05225000
         DC    AL1(IC),AL1(EUA),X'5D6B',AL1(SF),AL1(AT2)       @V200731 05226000
RUNLABEL DC    CL20'RUNNING'                                   @V200731 05227000
LEN      EQU   *-LAB3270A                                      @V200731 05228000
LAB3270B DC    AL1(WC6),AL1(SBA),X'5B60',AL1(SF),AL1(AT7)      @V200731 05229000
         DC    AL1(IC),AL1(SBA),X'5D6B',AL1(SF),AL1(AT2)       @V200731 05230000
REALABEL DC    CL20'CP READ'                                   @VM08531 05231000
LEN1     EQU   *-LAB3270B                                      @V200731 05232000
LAB3270C DC    AL1(WC6),AL1(SBA),X'5D6B',AL1(SF),AL1(AT2)      @V200731 05233000
MORLABEL DC    CL20'HOLDING'                                   @V200731 05234000
LEN2     EQU   *-LAB3270C                                      @V200731 05235000
LAB3270D DC    AL1(LAC),AL1(SBA),X'5B60'                       @V200731 05236000
LAB3270  DC    AL1(WC6),AL1(SBA),X'0000'                       @V200731 05237000
LAB3270E DC    AL1(WC6),AL1(SBA),X'4040',AL1(RA),X'5B60',X'00' @V200731 05238000
         DC    AL1(SF),AL1(AT7),AL1(IC),AL1(SBA)               @V200731 05239000
         DC    X'5D6B',AL1(SF),AL1(AT2)                        @V200731 05240000
LEN3     EQU   *-LAB3270E                                      @V200731 05241000
         SPACE 2                                                        05242000
*********************************************************************   05243000
PARM     DC    X'00'          THE GRAPHIC FLAG BYTE            @V200731 05244000
PARMATT  EQU   X'80'          ATTENTION REQUEST                @V200731 05245000
PARMGRP  EQU   X'40'          GRAPHIC SUPPORT                  @V200731 05246000
PARMREA  EQU   X'20'          READ REQUEST                     @V200731 05247000
PARMCLE  EQU   X'10'          CLEAR/ERASE REQUEST              @V200731 05248000
PARM327  EQU   X'08'          3270 GRAPHIC                     @V200731 05249000
PARMNDA  EQU   X'04'          NO DATA INDICATED                @V200731 05250000
PARM01F  EQU   X'02'          01F REQUESTED                    @V200731 05251000
PARM321  EQU   X'01'          3215/3210/1052                   @V200731 05252000
**********************************************************************  05253000
         SPACE 2                                                        05254000
*********************************************************************   05255000
SBADDR   DC    AL1(00,00)     CURRENT OUTPUT LINE COORDINATES  @V200731 05256000
*                             FOR THE                                   05257000
*                             3066                                      05258000
SBACP    DC    AL1(34,60)     COORDINATES FOR SCREEN 'STATUS'  @V200731 05259000
*                             WORD                                      05260000
SBAREAD  DC    AL1(33,00)     COORDINATES FOR CURSOR POSITION  @V200731 05261000
RDMIDATA DC    XL6'00'        READ DATA FROM 'MI' COMMAND      @V200731 05262000
CPXYSTAT DC    CL20' '        SCREEN 'STATUS' WORD             @V200731 05263000
BLNKLINE DC    XL140'00'      CLEAR INPUT AREA FOR DATA        @VM08604 05264000
BLNKZERO DC    CL140' '       BLANKS FOR READ AREA             @VM08604 05265000
GRAPHSAV DC    8F'00'         SAVE AREA FOR GRAPHIC SUPPORT    @V200731 05266000
SAVEAREA DC    2F'00'         SAVE AREA FOR GRAPHIC DATA       @V200731 05267000
*                             REGISTERS                                 05268000
*********************************************************************   05269000
         SPACE 2                                                        05270000
**********************************************************************  05271000
*                                                                       05272000
* WORKAREAS FOR 3340/3344 ALTERNATE TRACK SUPPORT                       05273000
*                                                                       05274000
ALTSAVE  DS    F              SAVEAREA FOR SIO RETURN ADDRESS  @V56BDA8 05275000
GETCCWRK DC    F'0'           CCHH WORK AREA.                  @V56BDA8 05276000
ALTSKADD DC    XL6'0'         BBCCHH ADDR FOR ALT TRK RESTARTS.@V56BDA8 05277000
ALTHA    DS    XL5            HA (FCCHH) READ FROM DEF OR ALT. @V56BDA8 05278000
ALTHASAV DS    XL5            SAV 1 HA OF PAIR WHILE READ OTHER@V56BDA8 05279000
ALTR0    DS    XL16           R0 READ FROM DEF TRK OR ALT TRK. @V56BDA8 05280000
ALTR0SAV DS    XL16           SAV 1 R0 OF PAIR WHILE READ OTHER@V56BDA8 05281000
ALTRDPRG EQU   128            THIS IS THE FIRST READ333X SEARCH@V56BDA8 05282000
ALTWRPRG EQU   64             THIS IS THE FIRST WR333X SEARCH  @V56BDA8 05283000
**********************************************************************  05284000
         SPACE                                                          05285000
VOL1BUFF DC    80C' '         VOL1 BUFFER                               05286000
         SPACE                                                          05287000
TRACEST  DC    A(TRACETBL)    START OF THE TRACE TABLE                  05288000
TRACEEND DC    A(TRACETBL+4080) END OF TRACE TABLE             @V2A2063 05289000
TRACEPT  DC    A(TRACETBL)    NEXT ENTRY IN THE TABLE                   05290000
ORGCHK1  EQU   *                                               @V56BDA8 05291000
         ORG   DMKDDR+20480-80                                 @VM01076 05292000
ORGCHK2  EQU   *-ORGCHK1      IF ASSEMBLER FLAGS THIS, WE HAVE @V56BDA8 05293000
*                             A PROGRAM THAT HAS GROWN TO BIG TO FIT    05294000
*                             ABOVE THE PRECEEDING ORG STATEMENT.       05295000
         DS    0D                                              @V56BDA8 05296000
VHR      DC    CL80'VHR '     CYLINDER HEADER RECORD                    05297000
         ORG   *-76                                                     05298000
         SPACE 1                                                        05299000
VHRCYLNO DS    CL6'0'         BBCCHH OF INPUT DASD UNIT                 05300000
         DS    CL6            NOT USED.  AVAILABLE.            @V56BDA8 05301000
VHRCLOCK DS    D'0'           TIME OF DAY CLOCK VALUE                   05302000
VHRMREC  DS    H                                                        05303000
VHRCYLA  DS    H                                               @V56BDA8 05304000
VHRMTCK  DS    H                                                        05305000
VHRVSER  DS    CL6'VOLSER'    VOLUME SERIAL NUMBER OF INPUT DASD UNIT   05306000
         ORG   VHR+80                                                   05307000
         SPACE 1                                                        05308000
THR      DC    CL4'THR '      ID OF THE TRACK HEADER RECORD             05309000
THRNDRD  DC    H'0'           THE NUMBER OF COUNT FIELDS IN THE THR     05310000
THRNDRT  DC    H'0'           THE NUMBER OF 4K DATA RECORDS ON TAPE     05311000
THRDRL   DC    H'0'           LENGTH OF THE SHORT (LAST) DATA RECORD    05312000
THRFLAG  DC    XL1'0'         FLAG                                      05313000
SPECIAL  EQU   X'01'                                                    05314000
THRHADD  DC    XL5'0'         THE HOME ADDRESS REORDERED                05315000
THR000   DC    XL16'0'        RECORD ZERO FROM THE DASD UNIT            05316000
THR001   DC    XL8'0'         COUNT FIELD OF THE FIRST RECORD           05317000
         SPACE 1                                                        05318000
         DS    0D                                                       05319000
         ENTRY DMKDDRED       END OF CMS MODULE                         05320000
DMKDDRED EQU   *                                                        05321000
         SPACE 1                                                        05322000
         ORG   THR+4096       4K TRACK HEADER RECORD           @VM01076 05323000
         SPACE 1                                                        05324000
DB1      DS    4096X          DATA BUFFER 1                             05325000
DB2      DS    4096X          DATA BUFFER 2                             05326000
DB3      DS    4096X          DATA BUFFER 3                             05327000
DB4      DS    4096X          DATA BUFFER 4                    @V304498 05328000
DB5      DS    4096X          DATA BUFFER 5                    HRC012DK 05328070
DB6      DS    4096X          DATA BUFFER 6                    HRC012DK 05328140
DB7      DS    4096X          DATA BUFFER 7                    HRC012DK 05328210
DB8      DS    4096X          DATA BUFFER 8                    HRC012DK 05328280
DB9      DS    4096X          DATA BUFFER 9                    HRC012DK 05328350
DB10     DS    4096X          DATA BUFFER 10                   HRC012DK 05328420
DB11     DS    4096X          DATA BUFFER 11                   HRC012DK 05328490
DB12     DS    4096X          DATA BUFFER 12                   HRC012DK 05328560
DB13     DS    4096X          DATA BUFFER 13                   HRC012DK 05328630
DB14     DS    4096X          DATA BUFFER 14                   HRC012DK 05328700
DB15     DS    4096X          DATA BUFFER 15                   HRC012DK 05328770
DB16     DS    4096X          DATA BUFFER 16                   HRC012DK 05328840
TRACETBL DS    4096X          1 PAGE TRACE TABLE               @V2A2063 05329000
         SPACE                                                          05330000
ALLOBUFF EQU   *              ALLOCATION TABLE BUFFER                   05331000
CCWWORK  DS    214D           ROOM TO BUILD CCW'S FOR 106      @V304498 05332000
*                             RECORDS                                   05333000
         SPACE                                                          05334000
BUFFSIZE EQU   (*-DMKDDRED)/8 SIZE OF THE BUFFER/WORK AREA FOR CMS      05335000
         SPACE 3                                                        05336000
NAMETABL DSECT                                                          05337000
NAMEFLAG DS    X'00'          FLAGS + MIN COUNT                         05338000
         DS    X                                               @V2A2063 05339000
NAMECLAS DS    X                                               @V2A2063 05340000
NAMETYPE DS    X                                               @V2A2063 05341000
NAMEMREC DS    H              MAX NUM OF RECORDS THAT WILL FIT A TRACK  05342000
NAMECYLP DS    H              MAX PRIM CYL ADDR OF A DASD DVC. @V56BDA8 05343000
NAMECYLA DS    H              MAX ALT CYL ADDR OF A DASD DVC.  @V56BDA8 05344000
NAMEMTCK DS    H              MAX HEAD ADDRESS OF A DASD DEVICE         05345000
NAME     DS    CL8            NAME OF DEVICE OR ROUTINE                 05346000
NAMESIZE EQU   *-NAMETABL                                               05347000
         ORG   NAMEFLAG+1                                      @V2A2063 05348000
NAMEROUT DS    AL3            ADDRESS OF ROUTINE                        05349000
         SPACE                                                          05350000
*        BITS USED IN NAMEFLAG                                          05351000
NAMELAST EQU   X'80'          LAST ENTRY IN TABLE                       05352000
NAMECON  EQU   X'40'          ENTRY IS A CONSTANT                       05353000
         SPACE 2                                                        05354000
CYLENTRY DSECT                USED TO DEFINE THE EXTENT TABLE           05355000
CYLSTART DS    X'0000'                                                  05356000
CYLSTOP  DS    X'0000'                                                  05357000
CYLREOR  DS    X'0000'                                                  05358000
         SPACE 6                                                        05359000
CH9      EQU   X'01'          CH9 SENSE BIT ON PRINTER         @VA13315 05369500
         EJECT                                                          05370000
L1       EQU   1                                               HRC012DK 05370090
L2       EQU   2                                               HRC012DK 05370180
L4       EQU   4                                               HRC012DK 05370270
L5       EQU   5                                               HRC012DK 05370360
L7       EQU   7                                               HRC012DK 05370450
L8       EQU   8                                               HRC012DK 05370540
L10      EQU   10                                              HRC012DK 05370630
L16      EQU   16                                              HRC012DK 05370720
D2       EQU   2                                               HRC012DK 05370810
D5       EQU   5                                               HRC012DK 05370900
         COPY  EQU                                                      05371000
         SPACE 3                                                        05372000
         COPY  DEVTYPES                                        @V2A2063 05373000
         END   DMKDDREP                                                 05374000