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