IFC TITLE 'DMSIFC (CMS) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 00002000
*. 00003000
* MODULE NAME - DMSIFC 00004000
* 00005000
* DESCRIPTIVE NAME - 00006000
* 00007000
* VM/370 INTERFACE MODULE TO THE OS/VS EREP (IFCEREP1) PROGRAM 00008000
* 00009000
* COPYRIGHT - NONE 00010000
* 00011000
* CHANGE ACTIVITY - NOT APPLICABLE 00012000
* 00013000
* CONTENTS - 00014000
* 00015000
* DMSIFC - CALLED BY CPEREP COMMAND. 00016000
* DMSIFC0 - SIMULATE TRAPPED EXCP (SVC 0) TO SYS1.LOGREC. 00017000
* DMSIFC18 - SIMULATE TRAPPED BLDL (SVC 18). 00018000
* DMSIFC76 - HANDLE TRAPPED SVC 76. 00019000
*. 00020000
SPACE 3 00021000
DMSIFC CSECT @V4085A8 00022000
ENTRY DMSIFC0 @V4085A8 00023000
ENTRY DMSIFC18 @V4085A8 00024000
ENTRY DMSIFC76 @V4085A8 00025000
EJECT 00026000
*. 00027000
* SUBROUTINE NAME - DMSIFC 00028000
* 00029000
* FUNCTION - 00030000
* INTERFACE MODULE WHICH ALLOWS CLASS C, E OR 00031000
* F VIRTUAL USERS TO EDIT AND PRINT VM/370 00032000
* ERROR RECORDINGS UNDER CMS VIA THE OS/VS EREP 00033000
* EDIT AND PRINT PROGRAM - IFCEREP1. 00034000
* INTERFACE IS ALSO PROVIDED FOR CLEARING THE VM/370 00035000
* ERROR RECORDING CYLINDERS BY A CLASS F USER. 00036000
* 00037000
* ATTRIBUTES - NON-REUSABLE, CMS USER AREA, CALLED BY CMS. 00038000
* 00039000
* ENTRY CONDITIONS - 00040000
* 00041000
* R1 = POINTER TO CMS PARAMETER LIST. 00042000
* R13 = ADDRESS OF A STANDARD 72 BYTE SAVE AREA. 00043000
* R14 = RETURN ADDRESS. 00044000
* 00045000
* PLIST - 00046000
* CL8'CPEREP' 00047000
* CL8'FILENAME' ---OPTIONAL--- 00048000
* CL8'FILETYPE' ---OPTIONAL--- 00049000
* CL8'FILEMODE' ---OPTIONAL--- 00050000
* 00051000
* EXIT CONDITIONS - 00052000
* R0-R14 = RESTORED. 00053000
* R15 = RETURN CODE. 00054000
* 00055000
* CALLS TO OTHER ROUTINES - 00056000
* 00057000
* IFCEREP1 - LINK TO OS/VS EREP PROGRAM WITH R1 CONTAINING 00058000
* THE ADDRESS OF A FULLWORD WHICH IN TURN 00059000
* CONTAINS THE ADDRESS OF AN OS FORMAT PARM 00060000
* LIST. THE PARM LIST WILL BE AS FOLLOWS: 00061000
* 00062000
* -------------------------------------- 00063000
* |CC| VARIABLE LENGTH CHARACTER STRING 00064000
* ______________________________________ 00065000
* 00066000
* WHERE CC IS A TWO BYTE COUNT OF THE NUMBER 00067000
* OF CHARACTERS OF PARAMETERS THAT FOLLOW. 00068000
* THE VARIABLE LENGTH CHARACTER STRING WILL 00069000
* CONSIST OF ANY PARAMETERS PASSED TO THIS 00070000
* PROGRAM THAT ARE NOT RECOGNIZED AS 'CLEAR' 00071000
* COMMANDS OR 'SHARE=' OR 'CTLCRD=' OR 'TERMINAL' 00072010
* OR 'CONTROLLER='. 00072510
* THERE WILL BE COMMAS BETWEEN THE PARAMETERS 00073000
* IN THE PARM LIST. 00074000
* DMSREA - CALLED VIA BALR, IT READS A SPECIFIED RECORD 00075000
* FROM THE VM/370 ERROR RECORDING CYLINDERS. 00076000
* DMKIOG - CALLED VIA DIAGNOSE TO CLEAR REQUESTED 00077000
* RECORDING CYLINDERS. 00078000
* STATE/STATEW - CMS FUNCTIONS CALLED VIA SVC. 00079000
* ERASE - CMS FUNCTIONS CALLED VIA SVC. 00080000
* INCLUDE - CMS FUNCTIONS CALLED VIA SVC. 00081000
* OTHERS - SEE 'MACROS' SECTION BELOW. 00082000
* 00083000
* EXTERNAL REFERENCES - NONE 00084000
* 00085000
* TABLES / WORK AREAS 00086000
* 00087000
* WORKING STORAGE IS OBTAINED VIA A DMSFREE MACRO 00088000
* FOR USE AS A WORK AREA IN WHICH TO BUILD THE 00089000
* OS FORMAT PARM LIST. 00090000
* 00091000
* MACROS - TH 00092000
* 00093000
* OS MACROS 00094000
* LINK - USED TO LINK TO IFCEREP1. 00095000
* LOAD - LOADS DMSREA. 00096000
* DELETE - DELETES DMSREA. 00097000
* CMS MACROS 00098000
* DMSERR 00099000
* DMSKEY 00100000
* HNDSVC 00101000
* FSSTATE 00102000
* FSOPEN 00103000
* FSWRITE 00104000
* FSCLOSE 00105000
* DMSFREE 00106000
* DMSFRET 00107000
* TAPECTL 00108000
* FSCB 00109000
* WRTERM 00110000
* RDTERM 00111000
* WAITT 00112000
* REGEQU 00113000
* CMS DSECT MACROS 00114000
* SVCSAVE - SYSTEM SAVE AREA. (FOR SVC INTERRUPTS.) 00115000
* ADT - ACTIVE DISK TABLE BLOCK. 00116000
* FSCBD - FILE SYSTEM CONTROL BLOCK. 00117000
* FSTB - FILE STATUS TABLE BLOCK. 00118000
* NUCON - LOW CORE IN CMS NUCLEUS. 00119000
* 00120000
* REGISTER USAGE - 00121000
* 00122000
* R0-R1 = PARAMETER REGS. 00123000
* R2-R9 = SCRATCH. 00124000
* R10-R11 = SPARES, NOT PRESENTLY USED. 00125000
* R12 = BASE REGISTER. 00126000
* R13 = SAVE AREA ADDRESS. 00127000
* R14-R15 = LINK REGS. 00128000
* 00129000
* NOTES - 00130000
* THIS MODULE SHOULD BE LOADED ONLY AT LOCATION X'20000' IN 00131000
* STORAGE BECAUSE IT IS BUILT TO STRADDLE THE 4K PAGE BUFFER 00132000
* WHICH DMSREA REQUIRES AT LOCATION X'21000'. 00133000
* 00134000
* OPERATION - (DMSIFC) 00135000
* 00136000
* 1. PERFORM STANDARD LINKAGE AND ADDRESSABILITY FUNCTIONS. 00137000
* 2. INVOKE CMS LOAD FUNCTION TO LOAD AND RESOLVE VCON'S IN 00138000
* ABOUT A DOZEN EREP OBJECT DECKS. (NOTE: ALL OTHER EREP 00139000
* OBJECT DECKS GET BROUGHT INTO STORAGE LATER, AS NEEDED, 00140000
* BY OS LOAD AND LINK MACROS ISSUED BY OS/VS EREP.) 00141000
* 3. INVOKE 'STRINIT' FUNCTION. INDICATES THAT AREA ABOVE 00142000
* PRESENTLY LOADED PROGRAMS IS BEGINNING OF FREE STORAGE. 00143000
* (NOTE: OS LOAD AND LINK WILL ACQUIRE SPACE FROM FREE 00144000
* STORAGE TO CONTAIN THE PROGRAMS THEY LOAD.) 00145000
* 4. TURN OFF THE 'DOSSVC' FLAG IN THE CMS NUCLEUS SO THAT 00146000
* OS SIMULATION IS USED. BUT SAVE A COPY OF 'DOSSVC' SO IT 00147000
* CAN BE RESTORED LATER. 00148000
* SET COMPSWT IN CMS NUCLEUS SO THAT OS LOAD AND LINK MACROS 00149000
* BRING IN TEXT (OR TXTLIB) FILES RATHER THAN MODULE FILES. 00150000
* 4X. INVOKE OS LOAD TO LOAD DMSREA INTO STORAGE. SAVE ITS 00151000
* ADDRESS SO DMSREA CAN BE CALLED LATER DURING THE EXCP 00152000
* SIMULATION. 00153000
* 5. ESTABLISH HANDLING OF SVC 76 (ERROR LOG), SVC 18 (BLDL), 00154000
* AND SVC 0 (EXCP). 00155000
* 6. INVOKE 'FILEDEF' FUNCTION TO DEFINE: (1) PRINTER FILE FOR 00156000
* EREP, (2) SYSIN FILE TO BE CREATED FOR EREP, (3) DUMMY FILE 00157000
* FOR EREP TO OPEN AND CLOSE AS SYS1.LOGREC (FILE IS A 00158000
* DUMMY BECAUSE ATTEMPTED I/O ACTIVITY IS VIA EXCP WHICH 00159000
* WILL BE INTERCEPTED), (4) 'TOURIST' ERROR FILE TO THE 00160000
* TERMINAL, AND (5) THE 'DIRECTWK' WORK FILE ON DISK. 00161000
* 7. GET THE COMMAND LINE ARGUMENTS AND DETERMINE IF A CONTROL 00162000
* FILE IS PROVIDED FOR INPUT. IF SO, SET UP TO READ 00163000
* PARAMETERS FROM THE CONTROL FILE; OTHERWISE SET UP 00164000
* TO READ PARAMETERS FROM THE TERMINAL. 00165000
* 8. ISSUE A DMSFREE MACRO TO GET CORE IN WHICH TO BUILD AN 00166000
* OS 'PARM' LIST TO BE PASSED TO EREP. 00167000
* 9. GET INPUT PARAMETERS (FROM CONTROL FILE OR TERMINAL) AND 00168000
* CONSTRUCT EQUIVALENT OS/VS EREP PARM LIST AND SYSIN CONTROL 00169000
* CARD FILE. 00170000
* 10. IF CLEAR WAS SPECIFIED AND IT WAS NOT THE ONLY PARAMETER 00171000
* SPECIFIED, THEN TYPE ERROR MESSAGE TO TERMINAL AND 00172000
* SKIP TO 17. 00173000
* 11. IF CLEAR WAS SPECIFIED (CORRECTLY), CALL A SUBROUTINE TO 00174000
* ISSUE THE DIAGNOSE THAT ZEROS OUT THE VM ERROR CYLINDERS, 00175000
* THEN SKIP TO 17. 00176000
* 12. INVOKE 'FILEDEF' TO DEFINE THE ACCUMULATION TAPE FILE 00177000
* IF REQUESTED. ISSUE THE TAPE CONTROL MACROS NECESSARY TO 00178000
* POSITION THE TAPE FOR SUBSEQUENT WRITE OPERATIONS. 00179000
* 13. INVOKE 'FILEDEF' TO DEFINE THE HISTORY INPUT TAPE IF 00180000
* REQUESTED. AND BE SURE IT IS REWOUND. 00181000
* 14. LINK TO OS/VS EREP (IFCEREP1). 00182000
* 15. SIMULATE BLDL SVC'S ISSUED FROM OS/VS EREP. 00183000
* SIMULATE EXCP SVC'S ISSUED FROM OS/VS EREP SO THEY WILL 00184000
* APPEAR TO ACCESS A SYS1.LOGREC DATA SET; SIMULATION WILL 00185000
* RESULT IN CALLS TO DMSREA TO GET RECORDS FROM VM/370 ERROR 00186000
* RECORDING CYLINDERS; AN EXCP THAT ATTEMPTS TO RE-WRITE 00187000
* THE SYS1.LOGREC HEADER IS A RESULT OF THE 'ZERO' FUNCTION 00188000
* AND IS SIMULATED BY CALLING A SUBROUTINE TO ISSUE THE 00189000
* DIAGNOSE THAT ZEROS OUT THE ERROR RECORDING CYLINDERS. 00190000
* 16. EVENTUALLY OS/VS EREP IS DONE AND CONTROL RETURNS HERE 00191000
* FROM THE 'LINK' DONE AT 14. ABOVE 00192000
* 17. HOUSEKEEP ALL INDICATORS AND SWITCHES. FRET ANY CORE 00193000
* OBTAINED FOR THE OS 'PARM' AREA. CLEAR HANDLING OF 00194000
* SVC'S 0, 18, AND 76. CLEAR ANY FILDEFS THAT WERE SET UP 00195000
* BY CPEREP. 00196000
* 18. EXIT TO CMS. 00197000
* 00198000
* RESPONSES - 00199000
* DMSIFC827I 00200000
* DMSIFC828I 00201000
* 00202000
* ERROR MESSAGES - 00203000
* MESSAGE R15 RETURN CODE 00204000
* DMSIFC002E 28 00205000
* DMSIFC007E 32 00206000
* DMSIFC023E 24 00207000
* DMSIFC070E 24 00208000
* DMSIFC104S 100 00209000
* DMSIFC113S 100 00210000
* DMSIFC825E 12 00211000
* DMSIFC829W 88 00212000
* DMSIFC831E 62 00213000
*. 00214000
EJECT 00215000
*********************************************************************** 00216000
* 00217000
* 1. PERFORM STANDARD LINKAGE AND ADDRESSABILITY FUNCTIONS. 00218000
* 00219000
*********************************************************************** 00220000
STM R14,R12,SAVER14(R13) @V4085A8 00221000
BALR R12,0 @V4085A8 00222000
USING *,R12 @V4085A8 00223000
ST R13,SAVEAREA+4 STORE PTR TO OLD SAVE AREA IN @V4085A8 00224000
* NEW SAVE AREA. 00225000
LA R13,SAVEAREA ADDR OF NEW SAVE AREA. @V4085A8 00226000
USING NUCON,0 MAKE LOW CORE AREA ADDRESSABLE. @V4085A8 00227000
SPACE 00228000
*********************************************************************** 00229000
* 00230000
* 2. INVOKE CMS LOAD FUNCTION TO LOAD AND RESOLVE VCON'S IN 00231000
* ABOUT A DOZEN EREP OBJECT DECKS. (NOTE: ALL OTHER EREP 00232000
* OBJECT DECKS GET BROUGHT INTO STORAGE LATER, AS NEEDED, 00233000
* BY OS LOAD AND LINK MACROS ISSUED BY OS/VS EREP.) 00234000
* 00235000
*********************************************************************** 00236000
* FIRST, BEFORE LOADING, VERIFY THAT TXTLIB'S HAVE BEEN 00237000
* GLOBALED IN. 00238000
CLI TXTLIBS,X'FF' IF NOTHING HAS BEEN GLOBALED @V4085A8 00239000
* THEN TXTLIBS NAME FIELD IN THE NUCLEUS 00240000
* WILL STILL BE ALL X'FF'S. 00241000
BNE OPER2D YES, SO THERE IS AT LEAST ONE GLOBALED @V4085A8 00242000
* TXTLIB. 00243000
DMSERR NUM=826,LET=E,TEXT='EREP TXTLIBS NOT FOUND', @V4085A8X00244000
RENT=NO @V4085A8 00245000
LA R15,RC56 SET ERROR RETURN CODE. @V4085A8 00246000
B EXIT0SAV @V4085A8 00247000
SPACE 00248000
OPER2D DS 0H @V4085A8 00249000
* EXECUTE CMS 'INCLUDE' COMMAND (SIMILAR TO 'LOAD'). 00250000
L R1,=A(LOADLIST) ADDR OF PARAMETER LIST. @V4085A8 00251000
SVC 202 @V4085A8 00252000
DC AL4(EXIT0SAV) BRANCH IF ERROR RETURN, OTHERWISE@V4085A8 00253000
* FALL THRU. 00254000
SPACE 00255000
*********************************************************************** 00256000
* 00257000
* 3. INVOKE 'STRINIT' FUNCTION. INDICATES THAT AREA ABOVE 00258000
* PRESENTLY LOADED PROGRAMS IS BEGINNING OF FREE STORAGE. 00259000
* (NOTE: OS LOAD AND LINK WILL ACQUIRE SPACE FROM FREE 00260000
* STORAGE TO CONTAIN THE PROGRAMS THEY LOAD.) 00261000
* 00262000
*********************************************************************** 00263000
STRINIT * @V4085A8 00264000
SPACE 00265000
*********************************************************************** 00266000
* 00267000
* 4. TURN OFF THE 'DOSSVC' FLAG IN THE CMS NUCLEUS SO THAT 00268000
* OS SIMULATION IS USED. BUT SAVE A COPY OF 'DOSSVC' SO IT 00269000
* CAN BE RESTORED LATER. 00270000
* SET COMPSWT IN CMS NUCLEUS SO THAT OS LOAD AND LINK MACROS 00271000
* BRING IN TEXT (OR TXTLIB) FILES RATHER THAN MODULE FILES. 00272000
* 00273000
*********************************************************************** 00274000
DMSKEY NUCLEUS @V4085A8 00275000
MVC DOSSAVE,DOSFLAGS SAVE 'DOSSVC' AND OTHER FLAGS.@V4085A8 00276000
NI DOSFLAGS,X'FF'-DOSSVC FLAG ZEROED TO REQUEST @V4085A8 00277000
* OS SVC SIMULATION. 00278000
MVC OSSSAVE,OSSFLAGS SAVE 'COMPSWT' AND OTHER FLAGS@V4085A8 00279000
NI OSSFLAGS,X'FF'-COMPSWT FLAG ZEROED INDICATES @V4085A8 00280000
* SIMULATED OS LOAD/LINK WILL LOAD 00281000
* FROM 'TEXT' OR 'TXTLIB' RATHER 00282000
* THAN 'MODULE'. 00283000
DMSKEY RESET @V4085A8 00284000
SPACE 00285000
*********************************************************************** 00286000
* 00287000
* 4X. INVOKE OS LOAD TO LOAD DMSREA INTO STORAGE. SAVE ITS 00288000
* ADDRESS SO DMSREA CAN BE CALLED LATER DURING THE EXCP 00289000
* SIMULATION. 00290000
* 00291000
*********************************************************************** 00292000
LOAD EP=DMSREA @V4085A8 00293000
* ADDRESS OF ENTRY POINT IS RETURNED IN R0. 00294000
L R1,=A(DMSREAAD) @V4085A8 00295000
ST R0,0(0,R1) SAVE DMSREA ADDR SO WE CAN CALL @V4085A8 00296000
* DMSREA LATER. 00297000
SPACE 00298000
*********************************************************************** 00299000
* 00300000
* 5. ESTABLISH HANDLING OF SVC 76 (ERROR LOG), SVC 18 (BLDL), 00301000
* AND SVC 0 (EXCP). 00302000
* 00303000
*********************************************************************** 00304000
HNDSVC SET,(0,DMSIFC0),(18,DMSIFC18),(76,DMSIFC76) @V4085A8 00305000
*********************************************************************** 00306000
* 00307000
* 6. INVOKE 'FILEDEF' FUNCTION TO DEFINE: (1) PRINTER FILE FOR 00308000
* EREP, (2) SYSIN FILE TO BE CREATED FOR EREP, (3) DUMMY FILE 00309000
* FOR EREP TO OPEN AND CLOSE AS SYS1.LOGREC (FILE IS A 00310000
* DUMMY BECAUSE ATTEMPTED I/O ACTIVITY IS VIA EXCP WHICH 00311000
* WILL BE INTERCEPTED), (4) 'TOURIST' ERROR FILE TO THE 00312000
* TERMINAL, AND (5) THE 'DIRECTWK' WORK FILE ON DISK. 00313000
* 00314000
* NOTE: THE USER WILL BE PERMITTED TO OVERRIDE THE FILEDEF'S 00315000
* FOR THE PRINTER (EREPPT), HISTORY TAPE (ACCIN), AND 00316000
* ACCUMULATION TAPE (ACCDEV). SEE COMMENTS ON THE PARAMETER 00317000
* LISTS FOR THOSE FILEDEFS. 00318000
* 00319000
*********************************************************************** 00320000
* BEFORE DOING THE FILEDEF'S WE MUST FILL IN THE FILEMODE 00321000
* TO BE USED FOR THE WORK FILES (SYSIN AND DIRECTWK). 00322000
* WE DO THIS AFTER DETERMINING WHICH OF THE READ/WRITE 00323000
* DISKS HAS THE MOST SPACE. WE WILL CALL A ROUTINE IN 00324000
* THE 'DMSLAD' MODULE TO MAKE THE DETERMINATION. THIS 00325000
* ROUTINE REQUIRES A 26 BYTE P-LIST, THE FIRST 24 BYTES OF 00326000
* WHICH ARE IGNORED WHILE THE LAST TWO BYTES MUST CONTAIN 00327000
* '??'. WE WILL BUILD THIS LIST IN OUR SAVE AREA, USED 00328000
* AS A WORK AREA. 00329000
LA R1,SAVER14(0,R13) ADDR OF P-LIST (IN SAVE AREA)@V4085A8 00330000
MVC D24(L2,R1),=CL2'??' COMPLETE THE P-LIST. @V4085A8 00331000
L R15,AADTLKW VCON IN NUCLEUS POINTS TO ROUTINE @V4085A8 00332000
* IN DMSLAD. 00333000
BALR R14,R15 GO FIND ADT OF DISK WITH MOST SPACE. @V4085A8 00334000
LA R2,C'A' ASSUME FILEMODE 'A' TEMPORARILY. @V4085A8 00335000
LTR R15,R15 IF THERE WERE R/W DISKS, RET CODE = 0. @V4085A8 00336000
BNZ NORWDISK THERE ARE NO R/W DISKS. STICK WITH @V4085A8 00337000
* THE 'A' DISK ANYWAY. 00338000
* R1 WAS RETURNED WITH ADDR OF ADT BLOCK FOR DISK WITH THE 00339000
* MOST SPACE. 00340000
* R0 WAS RETURNED WITH THE NUMBER OF AVAILABLE 800 BYTE BLOCKS. 00341000
USING ADTSECT,R1 @V4085A8 00342000
IC R2,ADTM GET MODE LETTER OUT OF ADT. @V4085A8 00343000
DROP R1 @V4085A8 00344000
NORWDISK DS 0H @V4085A8 00345000
SLL R2,8 SHIFT LETTER INTO HIGH BYTE OF HALFWD. @V4085A8 00346000
LA R2,C'3'(0,R2) ADD MODE NUMBER INTO LOW BYTE. @V4085A8 00347000
* FILEMODE IS NOW READY. IN HALFWORD IN R2. 00348000
LA R1,SYSNFSCB FSCB FOR SYSIN FILE. @V4085A8 00349000
USING FSCBD,R1 @V4085A8 00350000
STH R2,FSCBFM STORE FMODE IN SYSIN'S FSCB. @V4085A8 00351000
DROP R1 @V4085A8 00352000
L R1,=A(DATAREA2) MAKE 2ND DATA SECTION... @V4085A8 00353000
USING DATAREA2,R1 ADDRESSABLE. @V4085A8 00354000
STH R2,MODPLUG1 STORE FMODE IN SYSIN'S FILEDEF. @V4085A8 00355000
STH R2,MODPLUG2 STORE FMODE IN DIRECTWK'S FILEDEF. @V4085A8 00356000
MVI MODPLUG2+1,C'4' MODE NUMBER MUST BE 4 IN ORDER @V4085A8 00357000
* FOR DIRECTWK'S COMPLICATED 00358000
* OS I/O TO WORK. 00359000
DROP R1 @V4085A8 00360000
* (WE ARE NOW FINISHED WITH THE FILEMODE IN R2.) 00361000
L R1,=A(FDEFPRT) PARM LIST FOR PRINTER FILEDEF. @V4085A8 00362000
SVC 202 @V4085A8 00363000
* DON'T BOTHER CHECKING FOR ERROR RETURN CODE; ONLY ERRORS 00364000
* FROM FILEDEF ARE FOR INVALID SPECIFICATIONS IN PARM LIST 00365000
* WHICH SHOULD NOT HAPPEN HERE; IF IT DOES HAPPEN, LET IT 00366000
* BOMB LATER WHEN I/O IS ATTEMPTED. 00367000
LA R1,=CL16'SYSIN EREPWORK' ID OF FILE TO ERASE.@V4085A8 00368000
L R15,=A(ERASFILE) CALL ROUTINE TO ERASE FILE @V4085A8 00369000
BALR R14,R15 LEFT ON DISK IF A PRIOR RUN @V4085A8 00370000
* ABENDED. 00371000
LTR R15,R15 ERROR RETURN IS ONLY SET IN THE @V4085A8 00372000
* (UNLIKELY) EVENT THAT 'STATEW' SEES A FILE AND 00373000
* 'ERASE' STILL FAILS. 00374000
BNZ EXIT1SAV EXIT BECAUSE OF PECULIAR ERROR. @V4085A8 00375000
L R1,=A(FDEFSYSI) FILEDEF FOR SYSIN FILE. @V4085A8 00376000
SVC 202 @V4085A8 00377000
L R1,=A(FDEFSERL) FILEDEF FOR DUMMY SYS1.LOGREC. @V4085A8 00378000
SVC 202 @V4085A8 00379000
L R1,=A(FDEFTOUR) FILEDEF FOR TOURIST (ERROR @V4085A8 00380000
* MESSAGE) FILE. 00381000
SVC 202 @V4085A8 00382000
LA R1,=CL16'DIRECTWKEREPWORK' ID OF FILE TO ERASE.@V4085A8 00383000
L R15,=A(ERASFILE) CALL ROUTINE TO ERASE FILE @V4085A8 00384000
BALR R14,R15 LEFT ON DISK IF A PRIOR RUN @V4085A8 00385000
* ABENDED. 00386000
LTR R15,R15 ERROR SET IF 'STATEW' SEES FILE, BUT @V4085A8 00387000
* 'ERASE' STILL FAILS. 00388000
BNZ EXIT1SAV EXIT BECAUSE OF PECULIAR ERROR. @V4085A8 00389000
L R1,=A(FDEFDIRE) FILEDEF THE EREP WORK FILE. @V4085A8 00390000
SVC 202 @V4085A8 00391000
SPACE 00392000
*********************************************************************** 00393000
* 00394000
* 7. GET THE COMMAND LINE ARGUMENTS AND DETERMINE IF A CONTROL 00395000
* FILE IS PROVIDED FOR INPUT. IF SO, SET UP TO READ 00396000
* PARAMETERS FROM THE CONTROL FILE; OTHERWISE SET UP 00397000
* TO READ PARAMETERS FROM THE TERMINAL. 00398000
* 00399000
*********************************************************************** 00400000
* REGISTER R1 IN OLD SAVE AREA POINTS TO THE INPUT PARM LIST. 00401000
L R3,SAVER13B(0,R13) LOAD PTR TO OLD SAVE AREA. @V4085A8 00402000
L R3,SAVER1(0,R3) LOAD PTR TO PARAMETER LIST. @V4085A8 00403000
L R2,=A(RDCTLSW) MAKE SWITCH ADDRESSABLE. @V4085A8 00404000
USING RDCTLSW,R2 @V4085A8 00405000
OI RDCTLSW,X'F0' ASSUME THAT EREP CONTROL DATA @V4085A8 00406000
* WILL BE ENTERED THRU THE TERMINAL AND SET 00407000
* SWITCH IN THE RDCTLREC SUBROUTINE 00408000
* ACCORDINGLY. 00409000
USING INPLIST,R3 @V4085A8 00410000
CLC INPFN,FENCEXFF END OF LIST AFTER 0 PARMS (EMPTY@V4085A8 00411000
* LIST)? 00412000
BE PARMWORK BRANCH IF NO INPUT PARMS. SINCE NO @V4085A8 00413000
* FILEID WAS SPECIFIED, INPUT WILL BE FROM THE 00414000
* TERMINAL RATHER THAN FROM A FILE. 00415000
NI RDCTLSW,X'0F' ASSUMPTION MADE ABOVE WAS WRONG. @V4085A8 00416000
* EREP CONTROL DATA IS TO BE READ FROM THE 00417000
* DISK FILE NAMED IN THE INPUTTED PARAMETER 00418000
* LIST. SET SWITCH IN RDCTLREC SUBROUTINE 00419000
* ACCORDINGLY. 00420000
DROP R2 @V4085A8 00421000
CLC INPFT,FENCEXFF SEE IF 'FENCE' IS IN FTYPE. @V4085A8 00422000
BNE HAVETYPE BRANCH IF FTYPE IS PRESENT. @V4085A8 00423000
DMSERR NUM=023,LET=E,TEXT='NO FILETYPE SPECIFIED', @V4085A8X00424000
RENT=NO @V4085A8 00425000
MVI RETCDE+1,RC24 @V4085A8 00426000
B EXIT1 @V4085A8 00427000
HAVETYPE DS 0H @V4085A8 00428000
SPACE 00429000
* FILENAME AND FILETYPE WERE SPECIFIED. FENCE SHOULD BE IN 00430000
* FILEMODE LOCATION IF FILEMODE WAS OMITTED OR IN FENCE 00431000
* LOCATION IF FILEMODE WAS NOT OMITTED. IF IT IS IN NEITHER, 00432000
* THEN THE USER SUPPLIED AN EXTRA (ILLEGAL) PARAMETER. 00433000
* CHECK FOR EXTRA: 00434000
CLC INPFM,FENCEXFF @V4085A8 00435000
BE NOEXTRA FENCE WAS IN FILEMODE SLOT. @V4085A8 00436000
CLC INPFENCE,FENCEXFF @V4085A8 00437000
BE NOEXTRA FENCE WAS IN END SLOT. @V4085A8 00438000
* IF FALL THRU, FENCE WAS NOT FOUND. THERE MUST BE EXTRA PARM. 00439000
LA R2,INPFENCE ADDRESS OF THE ILLEGAL PARAMETER. @V4085A8 00440000
DMSERR NUM=070,LET=E,TEXT='INVALID PARAMETER ''........''', X00441000
SUB=(CHARA,(R2)),RENT=NO @V4085A8 00442000
MVI RETCDE+1,RC24 @V4085A8 00443000
B EXIT1 @V4085A8 00444000
NOEXTRA DS 0H @V4085A8 00445000
SPACE 00446000
* NOW WE DO AN 'FSSTATE' TO VERIFY THAT FILENAME, FILETYPE, AND 00447000
* OPTIONAL FILEMODE ARE A VALID ID AND THAT THE SPECIFIED FILE 00448000
* EXISTS. 00449000
LA R2,INPFN SKIP INPCOM, POINT TO ID FOLLOWED BY @V4085A8 00450000
* FENCE. 00451000
DROP R3 @V4085A8 00452000
FSSTATE (R2),FSCB=CTLFSCB @V4085A8 00453000
* ERROR RETURN CODE IS IN R15. IF NO ERROR, R1 POINTS TO 00454000
* THE FILE STATUS TABLE (FST). 00455000
LTR R15,R15 TEST FOR ERROR RETURN. @V4085A8 00456000
BZ CHKATTR BRANCH IF NO ERROR; FILE WAS FOUND. @V4085A8 00457000
* AN ERROR RETURN CODE CAME BACK FROM FSSTATE. FOR ALL CODES 00458000
* EXCEPT CODE 28 (FILE NOT FOUND), AN ERROR MESSAGE HAS 00459000
* ALREADY BEEN ISSUED BY CODE CALLED BY FSSTATE. 00460000
STH R15,RETCDE SAVE ERROR CODE. WE WILL RETURN IT @V4085A8 00461000
* AS OUR OWN RETURN CODE. 00462000
CH R15,=Y(RC28) @V4085A8 00463000
BNE EXIT1 MESSAGE WAS ISSUED BY FSSTATE. @V4085A8 00464000
* FILE WAS NOT FOUND, NO ERROR MESSAGE WAS ISSUED. ISSUE NOW. 00465000
LA R3,CTLFSCB FILEID SPECIFIED ON COMMAND LINE BY @V4085A8 00466000
* THE USER WAS MOVED INTO THIS FSCB BY 00467000
* FSSTATE. WE WILL GET IT FROM HERE FOR 00468000
* PRINTING IN ERROR MESSAGE. 00469000
USING FSCBD,R3 @V4085A8 00470000
LA R4,FSCBFN ADDRESS OF FILEID. @V4085A8 00471000
LA R5,L'FSCBFN+L'FSCBFT LENGTH OF FILEID W/O MODE.@V4085A8 00472000
CLC FSCBFM,=X'FFFF' FENCE OCCUPIES MODE FIELD IF @V4085A8 00473000
* NO MODE. 00474000
BE *+8 NO FILEMODE, SO LENGTH IN R5 IS OKAY. @V4085A8 00475000
LA R5,L'FSCBFM(0,R5) FMODE PRESENT, ADD ITS LENGTH@V4085A8 00476000
DROP R3 @V4085A8 00477000
DMSERR NUM=002,LET=E,TEXT='FILE ''.....................'' NOT X00478000
FOUND',SUB=(CHAR8A,((R4),(R5))),RENT=NO @V4085A8 00479000
B EXIT1 @V4085A8 00480000
SPACE 00481000
* CHECK THAT THE FILE IS THE REQUIRED RECFM=F, LRECL=80. 00482000
USING FSTSECT,R1 @V4085A8 00483000
CHKATTR LA R3,CTLFSCB @V4085A8 00484000
USING FSCBD,R3 @V4085A8 00485000
MVC FSCBFM,FSTM GET THE FILEMODE FOUND BY FSSTATE @V4085A8 00486000
* AND PUT IT IN THE FSCB, OVERLAYING X'FFFF' 00487000
* IF USER DID NOT SPECIFY MODE. 00488000
CLI FSTFV,C'F' CHECK FOR FIXED LENGTH FORMAT. @V4085A8 00489000
BNE BADATTR INVALID FORMAT. @V4085A8 00490000
LA R2,80 SET UP FOR LRECL=80 CHECK. @V4085A8 00491000
C R2,FSTIL COMPARE WITH FILE'S RECORD LENGTH. @V4085A8 00492000
DROP R1 @V4085A8 00493000
BE GOODATTR BRANCH IF RECORD LENGTH IS CORRECT. @V4085A8 00494000
BADATTR LA R4,FSCBFN ADDR OF FILEID TO PRINT IN MSG. @V4085A8 00495000
DROP R3 @V4085A8 00496000
DMSERR NUM=007,LET=E,TEXT='FILE ''.....................'' IS NX00497000
OT FIXED, 80 CHAR. RECORDS', @V4085A8X00498000
SUB=(CHAR8A,(R4)),RENT=NO @V4085A8 00499000
MVI RETCDE+1,RC32 @V4085A8 00500000
B EXIT1 @V4085A8 00501000
GOODATTR DS 0H @V4085A8 00502000
FSOPEN FSCB=CTLFSCB @V4085A8 00503000
SPACE 00504000
*********************************************************************** 00505000
* 00506000
* 8. ISSUE A DMSFREE MACRO TO GET CORE IN WHICH TO BUILD AN 00507000
* OS 'PARM' LIST TO BE PASSED TO EREP. 00508000
* 00509000
*********************************************************************** 00510000
PARMWORK LA R0,(PARMBUFL+7)/8 LENGTH OF PARM LIST BUILD @V4085A8 00511000
* AREA IN DOUBLEWORDS. 00512000
DMSFREE DWORDS=(0),TYPE=USER @V4085A8 00513000
STH R15,RETCDE SAVE ANY ERROR RETURN CODE. @V4085A8 00514000
LTR R15,R15 TEST RETURN CODE. @V4085A8 00515000
BNZ EXIT1 NO STORAGE AVAILABLE. @V4085A8 00516000
ST R1,PARMBFAD SAVE ADDR OF PARM LIST BUILD AREA. @V4085A8 00517000
STH R15,0(0,R1) ZERO OUT THE LENGTH HALFWORD AT @V4085A8 00518000
* THE START OF THE PARM LIST. 00519000
LA R1,PARMHDRL(0,R1) SKIP LENGTH FIELD AT START OF@V4085A8 00520000
* PARM LIST. 00521000
ST R1,PARMNEXT ADDR OF NEXT AVAILABLE BYTE IN @V4085A8 00522000
* PARM AREA. 00523000
LA R1,PARMBUFL-PARMHDRL BUF LENGTH LESS HDR IS... @V4085A8 00524000
ST R1,PARMREM NUMBER OF FREE BYTES @V4085A8 00525000
* REMAINING IN WORK AREA. 00526000
EJECT 00527000
*********************************************************************** 00528000
* 00529000
* 9. GET INPUT PARAMETERS (FROM CONTROL FILE OR TERMINAL) AND 00530000
* CONSTRUCT EQUIVALENT OS/VS EREP PARM LIST AND SYSIN CONTROL 00531000
* CARD FILE. 00532000
* 00533000
*********************************************************************** 00534000
* 00535000
* THIS SECTION OF CODE CONTROLS THE SCAN OF INPUT PARAMETERS. 00536000
* 00537000
* PARAMETERS ARE READ FROM THE TERMINAL (AFTER PROMPTING) OR 00538000
* FROM AN INPUT CONTROL FILE IF ONE WAS PROVIDED. ONE OR 00539000
* MORE PARAMETERS MAY BE SPECIFIED IN EACH LINE OF INPUT. 00540000
* BUT THE 'CTLCRD' PARAMETER MUST NOT BE FOLLOWED BY ANY 00541000
* OTHER PARAMETER; ANY PARAMETER THAT FOLLOWS IT WILL APPEAR 00542000
* TO BE PART OF THE 'CTLCRD'S TITLE FIELD AND WILL NOT BE 00543000
* CAUGHT AS AN ERROR. 00544000
* 00545000
* EACH LINE IS SCANNED IMMEDIATELY AFTER IT IS ENTERED. EACH 00546000
* PARAMETER IS ISOLATED AND IDENTIFIED AND PROCESSED BEFORE 00547000
* SCANNING TO THE NEXT PARAMETER. THE PROCESSING INCLUDES ANY 00548000
* SPECIALIZED PROCESSING REQUIRED BY CERTAIN RECOGNIZED 00549000
* PARAMETERS (FOR EXAMPLE, WHEN ACC=Y IS SEEN, SET A FLAG 00550000
* INDICATING THAT AN OUTPUT TAPE WILL HAVE TO BE REWOUND AND 00551000
* POSITIONED FOR OUTPUT). THE MORE GENERALIZED PROCESSING OF 00552000
* COPYING THE PARAMETER TO THE OUTPUT 'PARM' LIST OR TO THE 00553000
* SYSIN CONTROL CARD FILE IS ALSO DONE AT THIS TIME. ANY 00554000
* UNRECOGNIZABLE PARAMETER WILL GO TO THE 'PARM' LIST. 00555000
* 00556000
* THE APPROACH TO THE HANDLING OF ERRORS IN THE INPUT 00557000
* PARAMETERS IS NOT TO DIAGNOSE THEM HERE. INSTEAD THEY ARE 00558000
* PASSED ON INTO THE 'PARM' LIST OR THE SYSIN CONTROL CARD 00559000
* FILE AND EREP WILL DIAGNOSE THEM WHEN IT SEES THEM THERE. 00560000
* 00561000
* WHEN THE USER ENTERS CLEAR AT THE TERMINAL, WE MUST NOT 00562000
* TERMINATE THE PROMPTING FOR MORE INPUT. WE CONTINUE AND THE 00563000
* USER SHOULD ENTER NULL ON THE NEXT LINE. IF HE ENTERS 00564000
* FURTHER PARAMETERS INSTEAD OF NULL THEN HE IS THINKING OF 00565000
* GETTING A REPORT FIRST, THEN CLEARING (WHICH IS NOT 00566000
* PERMITTED SINCE CLEAR ONLY WORKS STANDALONE; HE WANTS 'ZERO'). 00567000
* IF WE HAD TERMINATED PROMPTING IMMEDIATELY AFTER CLEAR, 00568000
* THEN WE WOULD HAVE ERASED HIS DATA MAKING IT IMPOSSIBLE FOR 00569000
* HIM TO GET HIS REPORT. 00570000
* 00571000
* OPERATION 00572000
* 00573000
* 1. CALL SUBROUTINE RDCTLINE TO READ A RECORD FROM THE 00574000
* TERMINAL OR THE INPUT CONTROL FILE. IT RETURNS THE DATA 00575000
* AND THE LENGTH OF THE INPUT LINE. LENGTH IS 0 IF NO RECORD 00576000
* WAS GOTTEN. IF NO RECORD WAS GOTTEN, GO TO 8. 00577000
* 2. INITIALIZE SCAN POINTER TO FIRST BYTE OF RECORD. 00578000
* 3. SKIP BLANKS (AND COMMAS) TO START OF PARAMETER (OR TO END 00579000
* OF RECORD IF NO PARAMETER). IF END OF RECORD, GO TO 1. 00580000
* 4. SCAN POINTER IS NOW AT THE BEGINNING OF A PARAMETER. 00581000
* CALL SUBROUTINE 'PARMSCAN' TO SCAN TO END OF PARAMETER (IT 00582000
* LOOKS FOR A BLANK, OR END-OF-RECORD, OR A COMMA, EXCEPT 00583000
* THAT COMMAS IN PARENTHESIZED AREA DON'T COUNT). SCAN 00584000
* POINTER REMAINS AT THE 1ST BYTE BEYOND THE PARAMETER (A 00585000
* BLANK OR A COMMA OR THE 1ST BYTE BEYOND THE END OF THE 00586000
* RECORD IF PARAMETER RAN OUT TO THE END). THE LENGTH OF 00587000
* THE PARAMETER IS RETURNED. 00588000
* NOTE: CTLCRD IS UNUSUAL IN THAT THE SCAN FINDS THE BLANK 00589000
* AFTER THE WORD 'CTLCRD' AND STOPS BEFORE SCANNING THE REST 00590000
* OF THE DATA. THE SCAN POINTER WILL BE ADJUSTED LATER AFTER 00591000
* THIS PARAMETER HAS BEEN IDENTIFIED. 00592000
* 5. IDENTIFY PARAMETER AND LOAD ADDRESS OF ROUTINE TO HANDLE 00593000
* IT. IF PARAMETER IS NOT IDENTIFIABLE, LOAD ADDRESS OF 00594000
* DEFAULT ROUTINE (WHICH WILL PUT IT IN THE OS PARM LIST). 00595000
* 6. CALL SUBROUTINE WHOSE ADDRESS WAS LOADED. SUBROUTINE 00596000
* PROCESSES THE PARTICULAR PARAMETER, INCLUDING PUTTING IT 00597000
* INTO 'PARM' LIST OR SYSIN FILE IF APPROPRIATE. 00598000
* NOTE: HANDLING OF CTLCRD INCLUDES MOVING SCAN POINTER 00599000
* TO END OF RECORD. 00600000
* 7. IF SCAN POINTER IS AT END OF RECORD, GO TO 1; 00601000
* OTHERWISE, GO TO 3. 00602000
* 8. THE PROCESSING OF INPUT PARAMETERS IS COMPLETE. 00603000
* 00604000
*********************************************************************** 00605000
* 00606000
* REGISTER USAGE DURING THE CONTROL PARAMETER SCANNING: 00607000
* 00608000
* PARMPTR - R6 - HOLDS STARTING ADDRESS OF THE PARAMETER 00609000
* CURRENTLY BEING SCANNED, WHOSE FAR (RIGHT) END 00610000
* MAY OR MAY NOT HAVE BEEN LOCATED YET. 00611000
* SCANLEN - R7 - HOLDS LENGTH LESS ONE FOR EX'ING TRT INSTR. 00612000
* SCANPTR - R8 - THIS IS THE 'SCAN POINTER'. AS WE MOVE 00613000
* ACROSS A LINE OF INPUT, IT CONTAINS THE 00614000
* ADDRESS OF THE RIGHTMOST BYTE SCANNED SO FAR. 00615000
* SCANEND - R9 - CONTAINS THE SCAN END POINT. THIS IS ALWAYS 00616000
* THE ADDRESS OF THE FIRST BYTE BEYOND THE END 00617000
* OF THE LINE OF DATA. 00618000
* TABLEREG- R15- CONTAINS THE ADDRESS OF ANY ONE OF SEVERAL 00619000
* TRT TABLES USED DURING THE SCANNING. 00620000
* 00621000
*********************************************************************** 00622000
FSOPEN FSCB=SYSNFSCB @V4085A8 00623000
OPER9X1 L R15,=A(RDCTLINE) @V4085A8 00624000
BALR R14,R15 CALL TO READ A LINE OF INPUT FROM @V4085A8 00625000
* TERMINAL OR INPUT FILE. 00626000
* R1 IS RETURNED WITH THE ADDRESS OF THE LINE OF INPUT AND 00627000
* R0 HAS ITS LENGTH (OR R0 IS ZERO IF EOF). 00628000
* R15 MAY CONTAIN AN ERROR RETURN CODE AT THIS POINT. BUT IF 00629000
* IT DOES, R0 WILL BE SIGNALING END-OF-FILE ALSO. THEREFORE, 00630000
* JUST CHECK R0 FOR END-OF-FILE NOW. IF WE FIND EOF, THEN 00631000
* WE WILL CHECK R15 FOR AN ERROR RETURN, OTHERWISE THERE IS 00632000
* NO NEED TO CHECK R15. 00633000
LTR R0,R0 TEST LENGTH IN R0 FOR EOF SIGNAL. @V4085A8 00634000
BZ OPER9X8 BRANCH IF EOF. @V4085A8 00635000
OPER9X2 LR R8,R1 INITIALIZE 'SCAN POINTER' REG. @V4085A8 00636000
LR R9,R1 @V4085A8 00637000
AR R9,R0 INITIALIZE 'SCAN END' REG TO 1ST @V4085A8 00638000
* BYTE BEYOND THE LINE OF DATA. 00639000
OPER9X3 LR R7,R9 SCAN END... @V4085A8 00640000
SR R7,R8 LESS STARTING POINT IS LENGTH... @V4085A8 00641000
BCTR R7,0 LESS ONE IS LENGTH FOR EX OF TRT. @V4085A8 00642000
L R15,=A(TABSKIP2) TABLE FOR SKIPPING BLANKS AND @V4085A8 00643000
* COMMAS. 00644000
EX R7,TRTXR8 SCAN TO NON-BLANK,NON-COMMA,OR TO END@V4085A8 00645000
BC 8,OPER9X1 SCAN RAN ALL THE WAY TO END AND @V4085A8 00646000
* HIT NOTHING. 00647000
LR R8,R1 SET 'SCAN POINTER' TO ADDRESS OF DATA @V4085A8 00648000
* FOUND. 00649000
LR R6,R1 SET 'PARMPTR' TO ADDRESS OF DATA FOUND. @V4085A8 00650000
OPER9X4 LR R0,R9 ARG FOR PARMSCAN: R0 = END OF RECORD ADDR@V4085A8 00651000
* ARG FOR PARMSCAN: R1 = PARM STARTING ADDR 00652000
L R15,=A(PARMSCAN) PREPARE TO CALL PARMSCAN. @V4085A8 00653000
BALR R14,R15 GO SCAN TO END OF CURRENT PARM & RETURN@V4085A8 00654000
* OUTPUTS RETURNED FROM PARMSCAN: 00655000
* R0 = LENGTH OF THE PARAMETER, EXCLUDING DELIMITER AT 00656000
* END (NOTE: THERE WAS A PARAMETER, SO LENGTH WILL BE 00657000
* GREATER THAN ZERO). 00658000
* R1 = CURRENT VALUE OF SCAN POINTER (ADDR OF THE 1ST 00659000
* BYTE BEYOND THE PARAMETER, I.E., DELIMITER ADDR). 00660000
* R15 = 0 OR ERROR RETURN CODE INDICATING UNBALANCED 00661000
* PARENTHESES WERE DETECTED. BUT WE IGNORE THIS, ALLOWING 00662000
* THE PARENTHESES TO BE PASSED ON TO EREP FOR DIAGNOSIS. 00663000
LR R8,R1 SAVE REVISED 'SCAN POINTER' ADDRESS. @V4085A8 00664000
LR R7,R0 @V4085A8 00665000
BCTR R7,0 SAVE LENGTH LESS ONE FOR EX'ING TRT, MVC.@V4085A8 00666000
SPACE 00667000
*---------------------------------------------------------------------- 00668000
* STATUS SUMMARY: 00669000
* WE HAVE NOW ISOLATED (BUT HAVE NOT YET IDENTIFIED) ONE 00670000
* PARAMETER. 00671000
* THE FOLLOWING REGISTER VALUES WILL REMAIN UNCHANGED DOWN 00672000
* THRU 'OP9X7' WITH THE EXCEPTION THAT IF THE PARAMETER IS 00673000
* 'CTLCRD', THEN R8 WILL HAVE TO BE ADVANCED TO END OF RECORD: 00674000
* R6 = STARTING ADDRESS OF PARAMETER. 00675000
* R7 = PARAMETER LENGTH (EXCLUDING ENDING DELIMITER) LESS 00676000
* ONE. 00677000
* R8 = THE 'SCAN POINTER' VALUE: ADDR OF THE PARAMETER'S 00678000
* ENDING DELIMITER OR ADDR OF 1ST BYTE BEYOND THE 00679000
* END OF THE RECORD IF PARAMETER EXTENDS TO END. 00680000
* R9 = END OF RECORD ADDRESS, I.E., ADDR OF 1ST BYTE 00681000
* BEYOND END OF RECORD. 00682000
*---------------------------------------------------------------------- 00683000
OPER9X5 DS 0H NOW WE HAVE TO IDENTIFY THE PARAMETER. THIS@V4085A8 00684000
* INVOLVES ISOLATING THE KEYWORD UP TO THE '=' IF 00685000
* PRESENT, OTHERWISE KEYWORD EXTENDS TO THE FIRST 00686000
* DELIMITER ENCOUNTERED. 00687000
L R15,=A(TABDLIM) ADDR OF TRT TABLE FOR FINDING @V4085A8 00688000
* DELIMITERS, BUT UNFORTUNATELY IT DOES 00689000
* NOT INCLUDE '=' AS A DELIMITER. 00690000
MVI C'='(R15),X'FF' MODIFY THE TABLE MOMENTARILY @V4085A8 00691000
* TO INCLUDE '=' AMONG THE DELIMITERS. 00692000
SR R2,R2 CLEAR TO RECEIVE FUNCTION BYTE FROM TRT. @V4085A8 00693000
LR R1,R8 THE LENGTH WE WILL USE WHEN EX'ING THE @V4085A8 00694000
* TRT BELOW FALLS ONE BYTE SHORT OF THE DELIMITER 00695000
* AT THE END OF THE PARAMETER, SO IT IS POSSIBLE 00696000
* TRT WILL END BEFORE HITTING ANYTHING. THEREFORE 00697000
* WE INITIALIZE R1 HERE SO THAT R1 WILL LOOK LIKE 00698000
* TRT RAN ALL THE WAY TO A DELIMITER AT THE END 00699000
* OF THE PARAMETER IN THE EVENT TRT FINDS NOTHING. 00700000
* (NOTE: THE LENGTH WE USE WITH TRT HAS TO BE 00701000
* ONE BYTE SHORT OF REACHING THE DELIMITER AT THE 00702000
* END OF THE PARAMETER BECAUSE THERE WILL BE NO 00703000
* ENDING DELIMITER IN THE CASE OF A PARAMETER 00704000
* THAT RUNS OUT TO THE END OF THE INPUT RECORD.) 00705000
EX R7,TRTXR6 SCAN THE PARAMETER TO '=' OR OTHER @V4085A8 00706000
* DELIMITER. 00707000
MVI C'='(R15),X'00' RESTORE TRT TABLE TO NORMAL @V4085A8 00708000
* ('=' IS NO LONGER A DELIMITER). 00709000
LR R3,R1 SAVE ADDR OF THE '=' OR OTHER DELIMITER. @V4085A8 00710000
SR R1,R6 COMPUTE LENGTH OF PARAMETER TO (BUT NOT @V4085A8 00711000
* INCLUDING) THE '=' OR OTHER DELIMITER. 00712000
CH R2,=Y(X'FF') CHECK TRT FUNCTION BYTE IN R2 TO @V4085A8 00713000
* SEE IF DELIMITER WAS A '='. (NOTE: WE 00714000
* CANNOT LOOK AT THE DELIMITER ITSELF TO SEE 00715000
* IF IT IS AN '=' BECAUSE THERE MIGHT NOT 00716000
* BE A DELIMITER, WE COULD HAVE GONE TO END 00717000
* OF RECORD. BUT THE FUNCTION BYTE IS 00718000
* STILL OKAY, BEING X'00' IN THIS CASE.) 00719000
BE *+6 BRANCH IF '='. @V4085A8 00720000
SR R3,R3 SET ADDR OF DELIMITER TO 0 TO INDICATE IT@V4085A8 00721000
* WAS NOT A '='. 00722000
*---------------------------------------------------------------------- 00723000
* STATUS SUMMARY: 00724000
* WE HAVE ISOLATED A PARAMETER AND HAVE ISOLATED ITS KEYWORD 00725000
* PORTION, I.E., THE PART EXTENDING OUT TO THE '=' OR TO THE 00726000
* FIRST DELIMITER IF IT HAS NO '='. 00727000
* REGISTERS CONTAIN THE FOLLOWING: 00728000
* R6 = STARTING ADDRESS OF PARAMETER. 00729000
* R7 = PARAMETER LENGTH (EXCLUDING ENDING DELIMITER) LESS 00730000
* ONE. 00731000
* R1 = KEYWORD LENGTH (EXCLUDING '=' DELIMITER). (OR 00732000
* LENGTH TO FIRST DELIMITER OF ANY KIND IF NO '='.) 00733000
* THIS IS TRUE LENGTH, NOT LESS ONE. 00734000
* R3 = ADDRESS OF THE '=' IN THE PARAMETER IF '=' IS 00735000
* PRESENT. ADDRESS IS ZERO IF THERE IS NO '='. 00736000
* R8 = THE 'SCAN POINTER' VALUE: ADDRESS OF THE 00737000
* PARAMETER'S ENDING DELIMITER OR ADDR OF 1ST BYTE 00738000
* BEYOND END OF RECORD IF PARAMETER EXTENDS TO END. 00739000
* R9 = END OF RECORD ADDRESS, I.E., ADDR OF 1ST BYTE 00740000
* BEYOND END OF RECORD. 00741000
*---------------------------------------------------------------------- 00742000
* 00743000
* NOW WE WILL COMPARE THE IDENTIFIED KEYWORD WITH THE KEYWORD 00744000
* ENTRIES IN A TABLE, LOOKING FOR A MATCH. EACH ENTRY IN THE 00745000
* TABLE CONSISTS OF 16 BYTES: 00746000
* DC AL1(TRUE-LENGTH-OF-KEYWORD) 00747000
* DC CL12'KEYWORD' 00748000
* DC AL3(NAME-OF-SUBROUTINE-TO-PROCESS-PARAMETER) 00749000
* TO FACILITATE COMPARISON, WE WILL NOW COPY THE KEYWORD FROM 00750000
* THE PARAMETER TO A 13 BYTE WORKAREA WHERE THE KEYWORD CAN BE 00751000
* PRECEEDED BY A LENGTH BYTE SIMILAR TO THE ENTRIES IN THE 00752000
* KEYWORD TABLE. THEN THIS WORK AREA CAN BE COMPARED WITH 00753000
* TABLE ENTRIES VIA A CLC. 00754000
STC R1,KEYWORK PUT LENGTH IN 1ST BYTE OF WORK AREA.@V4085A8 00755000
MVC KEYWORK+1(L12),0(R6) PUT KEYWORD (PADDED WITH @V4085A8 00756000
* GARBAGE TO A LENGTH OF 12) INTO 00757000
* WORK AREA. 00758000
L R2,=A(KEYTAB-KEYTABLN) ADDR OF 1ST ENTRY LESS @V4085A8 00759000
* ONE IN KEYWORD TABLE. BXH WILL 00760000
* CAUSE R2 TO STEP THRU THE TABLE. 00761000
LM R4,R5,=A(KEYTABLN,KEYTABZ-KEYTABLN) INCREMNT & @V4085A8 00762000
* COMPARAND FOR BXH. 00763000
L R15,=A(PLISTBLD) ADDR OF DEFAULT SUBROUTINE TO @V4085A8 00764000
* BE CALLED IN CASE KEYWORD IS NOT 00765000
* FOUND IN THE TABLE. 00766000
SPACE 00767000
KEYLOOP BXH R2,R4,KEYLOOPX ADVANCE TO NEXT ENTRY OF THE @V4085A8 00768000
* TABLE. BRANCH OUT IF NO MORE ENTRIES. 00769000
EX R1,KEYCLC EX OF CLC COMPARES WORK AREA LENGTH @V4085A8 00770000
* BYTE AND KEYWORD WITH TABLE ENTRY LENGTH BYTE 00771000
* AND KEYWORD. 00772000
BNE KEYLOOP NO MATCH. GO CONTINUE SEARCH. @V4085A8 00773000
SPACE 00774000
* FALL THRU INDICATES KEYWORD OF THE PARAMETER MATCHES ENTRY 00775000
* IN TABLE. 00776000
L R15,KEYTABAD(0,R2) GET ADDR OF SUBROUTINE FROM @V4085A8 00777000
* KEYWORD TABLE ENTRY. 00778000
KEYLOOPX DS 0H @V4085A8 00779000
SPACE 3 00780000
* CALL ROUTINE TO HANDLE THE PARTICULAR CONTROL PARAMETER THAT 00781000
* HAS BEEN IDENTIFIED. ARGUMENTS PASSED ARE IN REGISTERS: 00782000
* R6 = STARTING ADDRESS OF PARAMETER. 00783000
* R7 = PARAMETER LENGTH (EXCLUDING ENDING DELIMITER) LESS 00784000
* ONE. 00785000
* R3 = ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO 00786000
* IF '=' IS NOT PRESENT. 00787000
OPER9X6 LH R4,PARMCNT INCREMENT COUNT OF CONTROL PARMS. @V4085A8 00788000
LA R4,1(0,R4) (COUNT IS USED LATER IN DETERMINING @V4085A8 00789000
STH R4,PARMCNT WHETHER OR NOT 'CLEAR' IS ONLY @V4085A8 00790000
* PARAMETER.) 00791000
BALR R14,R15 GO PROCESS THE IDENTIFIED CONTROL PARM.@V4085A8 00792000
LTR R15,R15 TEST POSSIBLE ERROR RETURN CODE. @V4085A8 00793000
BNZ OPER9X8 GO DO FSCLOSE, THEN EXIT. @V4085A8 00794000
SPACE 00795000
OPER9X7 CR R8,R9 IS 'SCAN POINTER' AT END OF RECORD? @V4085A8 00796000
BNE OPER9X3 NO. GO LOOK FOR ANOTHER PARAMETER ON @V4085A8 00797000
* CURRENT RECORD. 00798000
B OPER9X1 YES, GO START A NEW RECORD. @V4085A8 00799000
SPACE 3 00800000
TRTXR8 TRT 0(0,R8),0(R15) EX'ED REMOTELY, LENGTH SUPPLIED.@V4085A8 00801000
TRTXR6 TRT 0(0,R6),0(R15) EX'ED REMOTELY, LENGTH SUPPLIED.@V4085A8 00802000
KEYCLC CLC 0(0,R2),KEYWORK EX'ED REMOTELY, LEN SUPPLIED. @V4085A8 00803000
SPACE 3 00804000
OPER9X8 LR R2,R15 SAVE POSSIBLE ERROR RETURN CODE UNTIL @V4085A8 00805000
* AFTER FSCLOSE. 00806000
FSCLOSE FSCB=SYSNFSCB SYSIN FILE BUILT FOR @V4085A8X00807000
OS/VS EREP TO READ. @V4085A8 00808000
LR R1,R15 SAVE POSSIBLE ERROR FROM FSCLOSE. @V4085A8 00809000
* IF THERE WAS AN ERROR PRIOR TO THE FSCLOSE, THEN WE EXIT NOW 00810000
* WITH THAT PRIOR ERROR SUPPLYING THE EXIT RETURN CODE. 00811000
LTR R15,R2 TEST PRIOR RETURN CODE. @V4085A8 00812000
BNZ EXIT3SAV @V4085A8 00813000
* OTHERWISE, WE SEE IF FSCLOSE GAVE AN ERROR RETURN. 00814000
LTR R15,R1 TEST FSCLOSE RETURN CODE. @V4085A8 00815000
BZ OPER9XX NO ERROR, FSCLOSE WAS GOOD. @V4085A8 00816000
CH R15,=Y(RC6) CODE 6 MEANS FSCLOSE FOUND FILE @V4085A8 00817000
* EMPTY AND COULD NOT CLOSE IT. 00818000
BNE EXIT3SAV ANYTHING ELSE IS A TRUE ERROR. @V4085A8 00819000
* RETURN CODE FROM FSCLOSE SAYS NO SYSIN FILE WAS CREATED. 00820000
* SO WE NOW HAVE TO REDEFINE THE FILEDEF TO A DUMMY SO THAT 00821000
* OS/VS EREP WILL SEE A NULL FILE IF IT TRIES TO READ 00822000
* FROM SYSIN. 00823000
L R1,=A(FDEFSYS2) PARAMETER LIST TO FILEDEF @V4085A8 00824000
* SYSIN AS A DUMMY. 00825000
SVC 202 @V4085A8 00826000
DC AL4(EXIT3SAV) EXIT POINT IN THE UNLIKELY @V4085A8 00827000
* EVENT THAT FILEDEF FAILS. 00828000
OPER9XX DS 0H @V4085A8 00829000
EJECT 00830000
*********************************************************************** 00831000
* 00832000
* 10. IF CLEAR WAS SPECIFIED AND IT WAS NOT THE ONLY PARAMETER 00833000
* SPECIFIED, THEN TYPE ERROR MESSAGE TO TERMINAL AND 00834000
* SKIP TO 17. 00835000
* 00836000
* NOTE: WHEN WE REFER TO A 'CLEAR' PARAMETER WE GENERALLY 00837000
* MEAN TO INCLUDE ANY OF THE SEVERAL VARIANTS OF CLEAR. 00838000
* 00839000
*********************************************************************** 00840000
TM CLRFLAGS,ERRFLG+FRMFLAG ANY 'CLEAR' PARM FOUND?@V5088AA 00841000
BZ OPER12 THERE WERE NO 'CLEAR' PARAMETERS. @V4085A8 00842000
* WAS THE 'CLEAR' PARAMETER THE ONLY PARAMETER? 00843000
LH R1,PARMCNT @V4085A8 00844000
CH R1,=H'1' PARAMETER COUNT SHOULD BE 1. @V4085A8 00845000
BE WANTCLR BRANCH IF 'CLEAR' WAS THE ONLY PARM. @V4085A8 00846000
DMSERR NUM=825,LET=E,TEXT='''CLEAR'' IS VALID ONLY WHEN SPECIFX00847000
IED BY ITSELF',RENT=NO @V4085A8 00848000
MVI RETCDE+1,RC12 @V4085A8 00849000
B EXIT3 @V4085A8 00850000
WANTCLR DS 0H @V4085A8 00851000
SPACE 00852000
*********************************************************************** 00853000
* 00854000
* 11. IF CLEAR WAS SPECIFIED (CORRECTLY), CALL A SUBROUTINE TO 00855000
* ISSUE THE DIAGNOSE THAT ZEROS OUT THE VM ERROR CYLINDERS, 00856000
* THEN SKIP TO 17. 00857000
* 00858000
*********************************************************************** 00859000
SR R1,R1 @V4085A8 00860000
IC R1,CLRFLAGS ARG FOR CLEARRTN SPECIFIES CLR TYPE@V4085A8 00861000
L R15,=A(CLEARRTN) @V4085A8 00862000
BALR R14,R15 CALL SUBROUTINE TO PERFORM CLEAR. @V4085A8 00863000
STH R15,RETCDE SAVE POSSIBLE ERROR RETURN CODE. @V4085A8 00864000
B EXIT3 @V4085A8 00865000
SPACE 00866000
*********************************************************************** 00867000
* 00868000
* 12. INVOKE 'FILEDEF' TO DEFINE THE ACCUMULATION TAPE FILE 00869000
* IF REQUESTED. ISSUE THE TAPE CONTROL MACROS NECESSARY TO 00870000
* POSITION THE TAPE FOR SUBSEQUENT WRITE OPERATIONS. 00871000
* 00872000
*********************************************************************** 00873000
OPER12 TM ACCFLGS,OVRIDFLG+YSPECFLG ANY OVERRIDING CON- @V4085A8 00874000
* SIDERATION FOR ACC=Y? 00875000
* OR USER REQUESTED ACC=Y? 00876000
BNZ RDYACC ACC=Y IS MANDATORY OR WAS REQUESTED. @V4085A8 00877000
TM ACCFLGS,NSPECFLG USER REQUESTED ACC=N? @V4085A8 00878000
BNZ ACCEND ACC=N IS REQUESTED. @V4085A8 00879000
* ACC WAS NOT SPECIFIED EXPLICITELY. 00880000
TM ACCFLGS,DFLTFLG TEST FLAG TO SEE WHAT THE @V4085A8 00881000
* ACC DEFAULT SHOULD BE. 00882000
* NOTE: DEFAULT IS NOT FIXED. IT DEPENDS ON THE TYPE OF REPORT. 00883000
BZ ACCEND DEFAULT IS SUPPOSED TO BE ACC=N. @V4085A8 00884000
RDYACC L R1,=A(FDEFACCD) PARM LIST FOR ACC TAPE FILEDEF.@V4085A8 00885000
SVC 202 @V4085A8 00886000
TAPECTL REW,TAP1 @V4085A8 00887000
LTR R15,R15 TEST RETURN CODE FROM REWIND. @V4085A8 00888000
BZ ACCFSF NO PROBLEMS. @V4085A8 00889000
* SOME ERROR CODE WAS RETURNED. 00890000
CH R15,=Y(RC5) TAPE NOT ATTACHED? @V4085A8 00891000
BNE TAPERROR NO, SOME OTHER ERROR. @V4085A8 00892000
* TAPE WAS NOT ATTACHED. WE WILL NOT ISSUE A DIAGNOSTIC AS 00893000
* THE USER MAY BE SUPPLYING HIS OWN FILEDEF FOR THE ACC FILE 00894000
* IN WHICH CASE THERE IS NOT NECESSARILY A REQUIREMENT FOR 00895000
* A 'TAP1'. ON THE OTHER HAND, IF TAP1 SHOULD HAVE BEEN 00896000
* ATTACHED, OS/VS EREP WILL INFORM THE USER VIA AN I/O ERROR 00897000
* MESSAGE LATER. 00898000
B ACCEND @V4085A8 00899000
SPACE 00900000
ACCFSF TAPECTL FSF,TAP1,ERROR=TAPERROR SKIP PREVIOUSLY @V4085A8 00901000
* ACCUMULATED DATA. 00902000
TAPECTL BSF,TAP1,ERROR=TAPERROR POSITION TO ADD TO @V4085A8 00903000
* EXISTING FILE. 00904000
ACCEND DS 0H @V4085A8 00905000
SPACE 00906000
*********************************************************************** 00907000
* 00908000
* 13. INVOKE 'FILEDEF' TO DEFINE THE HISTORY INPUT TAPE IF 00909000
* REQUESTED. AND BE SURE IT IS REWOUND. 00910000
* 00911000
*********************************************************************** 00912000
* NOTE: MERGE AND HIST BOTH USE THE HIST FLAGS. 00913000
OPER13 TM HISTFLGS,OVRIDFLG+YSPECFLG ANY OVERRIDING CON- @V4085A8 00914000
* SIDERATION FOR HIST=Y? 00915000
* OR USER REQUESTED HIST=Y? 00916000
BNZ RDYHIST HIST=Y IS MANDATORY OR WAS REQUESTED. @V4085A8 00917000
TM HISTFLGS,NSPECFLG USER REQUESTED HIST=N? @V4085A8 00918000
BNZ HISTEND HIST=N IS REQUESTED. @V4085A8 00919000
* HIST WAS NOT SPECIFIED EXPLICITELY. 00920000
TM HISTFLGS,DFLTFLG TEST FLAG TO SEE WHAT THE @V4085A8 00921000
* HIST DEFAULT SHOULD BE. 00922000
* NOTE: DEFAULT IS NOT FIXED. IT DEPENDS ON THE REPORT. 00923000
BZ HISTEND DEFAULT IS SUPPOSED TO BE HIST=N. @V4085A8 00924000
RDYHIST L R1,=A(FDEFACCI) PARM LIST FOR FILEDEF OF @V4085A8 00925000
* HIST TAPE. 00926000
SVC 202 @V4085A8 00927000
TAPECTL REW,TAP2 @V4085A8 00928000
LTR R15,R15 TEST RETURN CODE FROM REWIND. @V4085A8 00929000
BZ HISTEND NO PROBLEMS. @V4085A8 00930000
* SOME ERROR CODE WAS RETURNED. 00931000
CH R15,=Y(RC5) TAPE NOT ATTACHED? @V4085A8 00932000
BNE TAPERROR NO, SOME OTHER ERROR. @V4085A8 00933000
* TAPE WAS NOT ATTACHED. WE WILL NOT ISSUE A DIAGNOSTIC AS THE 00934000
* USER MAY BE SUPPLYING HIS OWN FILEDEF FOR THE HIST FILE IN 00935000
* WHICH CASE THERE IS NOT NECESSARILY A REQUIREMENT FOR 00936000
* A 'TAP2'. ON THE OTHER HAND, IF TAP2 SHOULD HAVE BEEN 00937000
* ATTACHED, OS/VS EREP WILL INFORM THE USER VIA AN I/O ERROR 00938000
* MESSAGE LATER. 00939000
HISTEND DS 0H @V4085A8 00940000
SPACE 00941000
*********************************************************************** 00942000
* 00943000
* 14. LINK TO OS/VS EREP (IFCEREP1). 00944000
* 00945000
*********************************************************************** 00946000
LA R1,PARMBFAD LOAD ADDR OF WORD THAT POINTS TO @V4085A8 00947000
* THE OS PARM LIST THAT WE BUILT. 00948000
LINK EP=IFCEREP1 BEGIN EXECUTION OF OS/VS EREP. @V4085A8 00949000
* CONTROL EVENTUALLY RETURNS HERE AND FALLS THRU TO 16. 00950000
SPACE 00951000
*********************************************************************** 00952000
* 00953000
* 15. SIMULATE BLDL SVC'S ISSUED FROM OS/VS EREP. 00954000
* SIMULATE EXCP SVC'S ISSUED FROM OS/VS EREP SO THEY WILL 00955000
* APPEAR TO ACCESS A SYS1.LOGREC DATA SET; SIMULATION WILL 00956000
* RESULT IN CALLS TO DMSREA TO GET RECORDS FROM VM/370 ERROR 00957000
* RECORDING CYLINDERS; AN EXCP THAT ATTEMPTS TO RE-WRITE 00958000
* THE SYS1.LOGREC HEADER IS A RESULT OF THE 'ZERO' FUNCTION 00959000
* AND IS SIMULATED BY CALLING A SUBROUTINE TO ISSUE THE 00960000
* DIAGNOSE THAT ZEROS OUT THE ERROR RECORDING CYLINDERS. 00961000
* 00962000
*********************************************************************** 00963000
SPACE 00964000
* NOTE: THE SVC SIMULATING CODE IS LOCATED AT LABELS DMSIFC0, 00965000
* DMSIFC18, AND DMSIFC76. 00966000
SPACE 6 00967000
*********************************************************************** 00968000
* 00969000
* 16. EVENTUALLY OS/VS EREP IS DONE AND CONTROL RETURNS HERE 00970000
* FROM THE 'LINK' DONE AT 14. ABOVE 00971000
* 00972000
*********************************************************************** 00973000
* DECIDE WHETHER OR NOT TO STORE THE RETURN CODE SENT BACK 00974000
* FROM OS/VS EREP. WE STORE IT IN 'RETCDE' ONLY IF 'RETCDE' 00975000
* WAS NOT SET EARLIER. 'RETCDE' MAY ALREADY CONTAIN AN ERROR 00976000
* CODE FROM ERRORS DETECTED BY THE SVC SIMULATION CODE AND 00977000
* THIS TAKES PRECEDENCE OVER ANY ERRORS FROM OS/VS EREP WHICH 00978000
* ARE PROBABLY A LATER INDICATION OF THE SAME PROBLEM. 00979000
CLI RETCDE+1,0 @V4085A8 00980000
BNE *+8 EXIT WITHOUT STORING R15 IN RETCDE. @V4085A8 00981000
STH R15,RETCDE SAVE ERROR CODE TO PASS BACK TO CMS.@V4085A8 00982000
SPACE 00983000
*********************************************************************** 00984000
* 00985000
* 17. HOUSEKEEP ALL INDICATORS AND SWITCHES. FRET ANY CORE 00986000
* OBTAINED FOR THE OS 'PARM' AREA. CLEAR HANDLING OF 00987000
* SVC'S 0, 18, AND 76. CLEAR ANY FILEDEFS THAT WERE SET UP 00988000
* BY CPEREP. 00989000
* 00990000
*********************************************************************** 00991000
EXIT9 DS 0H @V4085A8 00992000
* FREE ANY STORAGE ALLOCATED FOR THE SVC SIMULATION. 00993000
EXIT3 DS 0H @V4085A8 00994000
* FREE THE STORAGE ALLOCATED FOR OS PARM LIST. 00995000
LA R0,(PARMBUFL+7)/8 LENGTH OF PARM BUILD AREA @V4085A8 00996000
* IN DOUBLEWORDS. 00997000
L R1,PARMBFAD ADDRESS OF ALLOCATED PARM BLD AREA.@V4085A8 00998000
DMSFRET DWORDS=(0),LOC=(1) @V4085A8 00999000
EXIT1 DS 0H @V4085A8 01000000
* 01001000
* ERASE THE 'DIRECTWK' WORK FILE. (NOTE: THE 'SYSIN' WORK FILE 01002000
* WILL ERASE ITSELF SINCE IT HAS FILEMODE 3.) 01003000
LA R1,=CL16'DIRECTWKEREPWORK' ID OF FILE TO ERASE.@V4085A8 01004000
L R15,=A(ERASFILE) @V4085A8 01005000
BALR R14,R15 RTN ERASES FROM WHATEVER DISK IT'S ON. @V4085A8 01006000
* CLEAR ANY FILEDEF'S ESTABLISHED BY THIS PROGRAM. 01007000
* NOTE: WE WILL NOT CLEAR THE EREPPT, ACCIN, AND ACCDEV 01008000
* FILEDEF'S BECAUSE THEY MAY HAVE COME FROM THE USER (AND THEY 01009000
* MAY EVEN BE 'PERM'). 01010000
L R1,=A(FDEFCLR) @V4085A8 01011000
USING FDEFCLR,R1 @V4085A8 01012000
LA R3,CLRLIST BXLE LOOP ADVANCES R3 THRU LIST. @V4085A8 01013000
LA R4,L8 BXLE INCREMENT: LENGTH OF DDNAME. @V4085A8 01014000
LA R5,CLRLISTZ BXLE COMPARAND: END OF LIST. @V4085A8 01015000
* ENTER LOOP WITH R1 POINTING TO FILEDEF PLIST WHICH ALREADY 01016000
* CONTAINS NAME OF FIRST FILEDEF TO BE CLEARED. 01017000
CLRLOOP SVC 202 CLEAR ONE FILEDEF. @V4085A8 01018000
* IGNORE ANY ERROR RETURNS. 01019000
MVC FDEFCLRN(L8),0(R3) PUT NEXT NAME INTO PLIST. @V4085A8 01020000
BXLE R3,R4,CLRLOOP LOOP UNTIL END OF LIST. @V4085A8 01021000
DROP R1 @V4085A8 01022000
* 01023000
* CLEAR HANDLING OF SVC'S. 01024000
HNDSVC CLR,0,18,76 @V4085A8 01025000
* 01026000
* DELETE DMSREA THAT WAS LOADED BY OS SIMULATED LOAD. 01027000
DELETE EP=DMSREA @V4085A8 01028000
* 01029000
* RESTORE FLAGS IN THE CMS NUCLEUS TO THEIR ORIGINAL VALUES. 01030000
DMSKEY NUCLEUS @V4085A8 01031000
NI DOSSAVE,DOSSVC KEEP 'DOSSVC' FLAG'S INITIAL @V4085A8 01032000
* VALUE, GET RID OF OTHER FLAGS. 01033000
OC DOSFLAGS,DOSSAVE RESTORE 'DOSSVC' FLAG TO @V4085A8 01034000
* THE NUCLEUS. 01035000
NI OSSSAVE,COMPSWT KEEP 'COMPSWT' FLAG'S INITIAL @V4085A8 01036000
* VALUE, BUT GET RID OF OTHER FLAGS. 01037000
OC OSSFLAGS,OSSSAVE RESTORE 'COMPSWT' FLAG TO @V4085A8 01038000
* THE NUCLEUS. 01039000
DMSKEY RESET @V4085A8 01040000
SPACE 01041000
*********************************************************************** 01042000
* 01043000
* 18. EXIT TO CMS. 01044000
* 01045000
*********************************************************************** 01046000
EXIT0 L R13,SAVER13B(0,R13) @V4085A8 01047000
L R14,SAVER14(0,R13) @V4085A8 01048000
LH R15,RETCDE @V4085A8 01049000
LM R0,R12,SAVER0(R13) @V4085A8 01050000
BR R14 @V4085A8 01051000
SPACE 3 01052000
EXIT0SAV STH R15,RETCDE SAVE THE RETURN CODE. @V4085A8 01053000
B EXIT0 @V4085A8 01054000
SPACE 3 01055000
EXIT1SAV STH R15,RETCDE SAVE THE RETURN CODE. @V4085A8 01056000
B EXIT1 @V4085A8 01057000
SPACE 3 01058000
EXIT3SAV STH R15,RETCDE SAVE THE RETURN CODE. @V4085A8 01059000
TAPERROR EQU EXIT3SAV @V4085A8 01060000
B EXIT3 @V4085A8 01061000
DROP R12 @V4085A8 01062000
EJECT 01063000
*********************************************************************** 01064000
* 01065000
* HCLEARF: HANDLER ROUTINE FOR 'CLEARF' PARAMETER. 01066000
* 01067000
*********************************************************************** 01068000
* 01069000
* INPUTS: SEE COMMENTS IN THE HCLEAR ROUTINE BELOW. 01070000
* OUTPUTS: SEE COMMENTS IN THE HCLEAR ROUTINE BELOW. 01071000
* 01072000
*********************************************************************** 01073000
HCLEARF SR R15,R15 INITIALIZE RETURN CODE TO 0 @V5088AA 01074000
STM R14,R12,SAVER14(R13) @V5088AA 01075000
LA R0,FRMFLAG R0 CONTAINS CLEAR TYPE @V5088AA 01076000
BALR R12,0 @V5088AA 01077000
USING *,R12 @V5088AA 01078000
B HCLEAR1 GO TO SHARED CODE FOR CLEAR PARMS@V5088AA 01079000
DROP R12 @V5088AA 01080000
*********************************************************************** 01081000
* 01082000
* HCLEAR: HANDLER ROUTINE FOR THE 'CLEAR' PARAMETER * 01083000
* 01084000
*********************************************************************** 01085000
* 01086000
* INPUTS: R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' 01087000
* IS NOT PRESENT. 01088000
* R6 - STARTING ADDRESS OF PARAMETER. 01089000
* R7 - PARAMETER LENGTH LESS ONE. 01090000
* 01091000
* OUTPUTS: CLRFLAGS - CONTAINS BIT FLAGS REQUESTING CLEAR. 01092000
* PARM LIST - PARAMETER IS ADDED TO OS PARM LIST TO BE 01093000
* PASSED TO EREP FOR DIAGNOSIS IF IT CONTAINS '=' 01094000
* FOLLOWED BY SOMETHING OTHER THAN Y OR N. 01095000
* R15 - CONTAINS AN ERROR RETURN CODE ONLY IF ERROR REQUIRES 01096000
* US TO PUT IT IN OS PARM LIST AND THEN THERE 01097000
* HAPPENS TO BE NO MORE ROOM IN THE PARM LIST. 01098000
* 01099000
*********************************************************************** 01100000
HCLEAR SR R15,R15 INITIALIZE RETURN CODE TO 0. @V4085A8 01101000
STM R14,R12,SAVER14(R13) @V4085A8 01102000
LA R0,ERRFLG R0 CONTAINS FLAGS INDICATING TYPE OF@V5088AA 01103000
* CLEAR. 01104000
HCLEAR1 BALR R12,0 HCLEAR1 IS SHARED ENTRY POINT FROM @V4085A8 01105000
* HCLEARMC AND HCLEARIO. 01106000
USING *,R12 @V4085A8 01107000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01108000
* NEW SAVE AREA. 01109000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01110000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01111000
BZ HCLY NO, THERE WAS NO '='. TREAT IT AS '=Y'. @V4085A8 01112000
* COMPUTE ENDING ADDR TO SEE THAT ONLY ONE CHAR FOLLOWED THE '=' 01113000
LA R1,0(R7,R6) ADDR OF FINAL CHARACTER. @V4085A8 01114000
LA R3,L1(0,R3) ADDR OF CHAR BEYOND THE '='. @V4085A8 01115000
CR R3,R1 THESE SHOULD BOTH BE THE SAME ADDR. @V4085A8 01116000
BNE HCLPLIST ERROR. SEND IT TO THE PARM LIST. @V4085A8 01117000
* R3 NOW POINTS TO THE CHAR BEYOND '='. 01118000
CLI 0(R3),C'Y' @V4085A8 01119000
BE HCLY CLEAR=Y IS WANTED. @V4085A8 01120000
CLI 0(R3),C'N' @V4085A8 01121000
BE HCLEXIT CLEAR=N IS WANTED. @V4085A8 01122000
* FALL THRU MEANS NEITHER =Y NOR =N, AN ERROR. 01123000
* SEND THE PARAMETER TO THE OS PARM LIST. 01124000
HCLPLIST L R15,=A(PLISTBLD) @V4085A8 01125000
BALR R14,R15 @V4085A8 01126000
* R15 CONTAINS AN ERROR RETURN CODE OR ZERO. PUT IT IN 01127000
* R15 IN OLD SAVE AREA. 01128000
L R1,SAVER13B(R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01129000
ST R15,SAVER15(0,R1) PUT R15 IN OLD SAVE AREA. @V4085A8 01130000
B HCLEXIT @V4085A8 01131000
SPACE 01132000
HCLY STC R0,CLRFLAGS SET FLAGS REQUESTING CLEAR. @V4085A8 01133000
HCLEXIT L R13,SAVER13B(R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01134000
LM R14,R12,SAVER14(R13) @V4085A8 01135000
DROP R12 @V4085A8 01136000
BR R14 @V4085A8 01137000
EJECT 01138000
*********************************************************************** 01139000
* 01140000
* HTERM: HANDLER ROUTINE FOR THE 'TERMINAL' PARAMETER. 01141000
* 01142000
*********************************************************************** 01143000
* 01144000
* THE 'TERMINAL' PARAMETER CAUSES US TO SWITCH FROM READING 01145000
* INPUT FROM A CONTROL FILE ON DISK TO READING INPUT FROM THE 01146000
* TERMINAL WITH PROMPTING. 01147000
* 01148000
* INPUTS: R3 - ADDRESS OF AN '=' FOLLOWING THE PARAMETER, IF 01149000
* PRESENT. OR ZERO IS '=' IS NOT PRESENT. 01150000
* 01151000
* OUTPUTS: RDCTLSW - THIS SWITCH IN THE READ ROUTINE IS SET SO 01152000
* THAT SUBSEQUENT READING WILL BE FROM THE TERMINAL. 01153000
* 01154000
*********************************************************************** 01155000
HTERM SR R15,R15 SET ERROR RETURN CODE. NO ERRORS ARE @V4085A8 01156000
* RECOGNIZED IN THIS ROUTINE. 01157000
STM R14,R12,SAVER14(R13) @V4085A8 01158000
BALR R12,0 @V4085A8 01159000
USING *,R12 @V4085A8 01160000
L R2,=A(RDCTLSW) MAKE SWITCH ADDRESSABLE. @V4085A8 01161000
USING RDCTLSW,R2 @V4085A8 01162000
LTR R3,R3 WAS THERE AN '=' ? @V4085A8 01163000
BZ HTERMY BRANCH IF NO '='. @V4085A8 01164000
CLI D1(R3),C'N' TEST FOR TERMINAL=N @V4085A8 01165000
BE HTERMX RETURN WITHOUT SETTING SWITCH. @V4085A8 01166000
HTERMY OI RDCTLSW,X'F0' SET SWITCH TO READ TERMINAL. @V4085A8 01167000
DROP R2 @V4085A8 01168000
HTERMX LM R14,R12,SAVER14(R13) @V4085A8 01169000
DROP R12 @V4085A8 01170000
BR R14 @V4085A8 01171000
EJECT 01172000
*********************************************************************** 01173000
* 01173300
* HCONTROL: HANDLER ROUTINE FOR THE 'CONTROLLER' PARAMETER. 01173600
* 01174000
* HSHARE: HANDLER ROUTINE FOR THE 'SHARE' PARAMETER. 01175000
* 01176000
*********************************************************************** 01177000
* 01178000
* INPUTS: R6 - STARTING ADDRESS OF THE PARAMETER. 01179000
* R7 - PARAMETER LENGTH LESS ONE. 01180000
* 01181000
* OUTPUTS: - AN 80 BYTE RECORD CONTAINING THIS SHARE PARAMETER 01182000
* ALONE IS WRITTEN INTO THE SYSIN FILE FOR EREP TO 01183000
* READ LATER. 01184000
* R15- AN ERROR RETURN CODE IF THE WRITE TO THE SYSIN 01185000
* FILE FAILS. 01186000
* 01187000
*********************************************************************** 01188000
HCONTROL EQU * CONTROLLER PARAMETER @VA09381 01188500
HSHARE STM R14,R12,SAVER14(R13) @V4085A8 01189000
BALR R12,0 @V4085A8 01190000
USING *,R12 @V4085A8 01191000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN NEW @V4085A8 01192000
* SAVE AREA. 01193000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01194000
* IF THE PARAMETER IS TOO LONG TO FIT ON A RECORD OF THE SYSIN 01195000
* FILE, WE SIMPLY TRUNCATE IT. EREP SHOULD DIAGNOSE IT WHEN 01196000
* IT SEES UNBALANCED PARENTHESES BECAUSE THE RIGHT PARENTHESIS 01197000
* IS CUT OFF. 01198000
CH R7,=Y(L'SYSNBUF) @V4085A8 01199000
BL *+8 BRANCH IF LENGTH IS OKAY. @V4085A8 01200000
LA R7,L'SYSNBUF-1 REVISE LENGTH TO RECORD @V4085A8 01201000
* LENGTH LESS ONE. 01202000
* NOW WE MOVE THE PARAMETER TO THE BUFFER. NOTE THAT THE 01203000
* BUFFER CONTAINS BLANKS NOW. THE WRITSYSN ROUTINE RESETS IT 01204000
* TO BLANKS AFTER EACH USE. 01205000
L R1,=A(SYSNBUF) BUFFER ADDR NEEDED BY EX'ED MVC.@V4085A8 01206000
EX R7,HSHARMVC MOVE PARAMETER TO BUFFER. @V4085A8 01207000
L R15,=A(WRITSYSN) @V4085A8 01208000
BALR R14,R15 CALL RTN TO WRITE THE BUFFER TO SYSIN. @V4085A8 01209000
* R15 IS RETURNED WITH A RETURN CODE. 01210000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01211000
L R14,SAVER14(0,R13) RESTORE FROM OLD SAVE AREA. @V4085A8 01212000
LM R0,R12,SAVER0(R13) RESTORE FROM OLD SAVE AREA. @V4085A8 01213000
DROP R12 @V4085A8 01214000
BR R14 @V4085A8 01215000
SPACE 3 01216000
HSHARMVC MVC 0(0,R1),0(R6) EX'ED REMOTELY, LENGTH SUPPLIED. @V4085A8 01217000
EJECT 01218000
*********************************************************************** 01219000
* 01220000
* HCTLCRD: HANDLER ROUTINE FOR THE 'CTLCRD PARAMETER. 01221000
* 01222000
*********************************************************************** 01223000
* 01224000
* INPUTS: 01225000
* R6 - STARTING ADDRESS OF PARAMETER (I.E., OF THE WORD CTLCRD) 01226000
* R7 - PARAMETER LENGTH LESS ONE (I.E., 5). 01227000
* R8 - THE 'SCAN POINTER' VALUE: ADDRESS OF THE BYTE FOLLOWING 01228000
* THE WORD CTLCRD IN THE INPUT RECORD FROM THE TERMINAL 01229000
* OR DISK FILE. 01230000
* R9 - END OF RECORD ADDRESS, I.E., ADDRESS OF 1ST BYTE BEYOND 01231000
* END OF THE INPUT RECORD. 01232000
* SYSNBUF - BLANKED BUFFER IN WHICH TO BUILD OS/VS EREP 01233000
* FORMATTED CTLCRD RECORD. 01234000
* 01235000
* OUTPUTS: 01236000
* - AN 80 BYTE RECORD CONTAINING THE CTLCRD INFORMATION 01237000
* (IN THE FORMAT REQUIRED BY OS/VS EREP) IS WRITTEN INTO 01238000
* THE SYSIN FILE FOR EREP TO READ LATER. 01239000
* R15 - AN ERROR RETURN CODE IF THE WRITE TO THE SYSIN FILE 01240000
* FAILS. 01241000
* R8 - THE 'SCAN POINTER' VALUE IS ADVANCED TO END OF INPUT 01242000
* RECORD, I.E., SAME ADDRESS AS R9. THIS IS DONE BECAUSE 01243000
* THE CTLCRD PARAMETER IS REGARDED AS INCLUDING 01244000
* EVERYTHING FOLLOWING THE WORD CTLCRD, NOT JUST THE 01245000
* WORD ITSELF. 01246000
* 01247000
*********************************************************************** 01248000
HCTLCRD STM R14,R12,SAVER14(R13) @V4085A8 01249000
BALR R12,0 @V4085A8 01250000
USING *,R12 @V4085A8 01251000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01252000
* NEW SAVE AREA. 01253000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01254000
L R2,=A(SYSNBUF) BUFFER WHERE NEW CTLCRD IS TO @V4085A8 01255000
* BE BUILT. 01256000
USING CTLCRD,R2 DSECT FOR CTLCRD LAYOUT IN BUFFER. @V4085A8 01257000
EX R7,HCTLMVC MOVE 'CTLCRD' INTO PLACE. @V4085A8 01258000
CR R8,R9 'SCAN POINTER' ALREADY AT END? @V4085A8 01259000
BE HCTLEOR NO MORE OPERANDS, CTLCRD WAS AT END. @V4085A8 01260000
LR R5,R9 ADDR 1ST BYTE BEYOND INPUT RECORD. @V4085A8 01261000
BCTR R5,0 ADDR OF LAST BYTE OF RECORD. IN BXH @V4085A8 01262000
* COMPARAND REGISTER. 01263000
LA R4,1 VALUE OF 1 IN BXH INCREMENT REGISTER. @V4085A8 01264000
* FIND AND HANDLE 'DATE1' PARAMETER. 01265000
* R8 (SCAN POINTER) IS CURRENTLY AT DELIMITER BEYOND CTLCRD 01266000
* (PROBABLY A BLANK, BUT POSSIBLY A COMMA). SKIP THAT DELIMITER 01267000
* IMMEDIATELY (BXH ADDS ONE) AND THEN SKIP ANY FOLLOWING 01268000
* BLANKS UP TO THE START OF THE NEXT OPERAND (WHICH MAY 01269000
* CONSIST SOLELY OF A COMMA INDICATING NEXT OPERAND IS OMITTED). 01270000
HCTLOOP1 BXH R8,R4,HCTLEOR ADVANCE R8 TO NEXT COLUMN. @V4085A8 01271000
* BRANCH IF AT END OF RECORD. 01272000
CLI 0(R8),C' ' TEST NEW COLUMN FOR BLANK. @V4085A8 01273000
BE HCTLOOP1 CONTINUE SKIPPING IF BLANK. @V4085A8 01274000
* FALL THRU INDICATES R8 POINTS TO START OF NEXT OPERAND. 01275000
LR R6,R8 SAVE STARTING ADDR OF NEW OPERAND. @V4085A8 01276000
* CALL 'PARMSCAN' TO SCAN TO END OF OPERAND. 01277000
LR R0,R9 ARG FOR 'PARMSCAN'. END OF RECORD ADDR. @V4085A8 01278000
LR R1,R8 ARG FOR 'PARMSCAN'. ADDR OF PARAMETER. @V4085A8 01279000
L R15,=A(PARMSCAN) @V4085A8 01280000
BALR R14,R15 @V4085A8 01281000
LR R8,R1 UPDATED 'SCAN POINTER' RETURNED FROM @V4085A8 01282000
* PARMSCAN. POINTS TO DELIMITER AT END OF PARM. 01283000
LTR R0,R0 TEST RETURNED PARAMETER LENGTH. @V4085A8 01284000
BZ HCTLFIN1 LENGTH ZERO, PARAMETER OMITTED. LEAVE@V4085A8 01285000
* FIELD IN OUTPUT RECORD BLANK. 01286000
CH R0,=Y(L'CTLCRDD1) SEE IF PARAMETER IS TOO BIG @V4085A8 01287000
* FOR OUTPUT FIELD. 01288000
BNH *+8 BRANCH IF LENGTH OKAY. @V4085A8 01289000
LA R0,L'CTLCRDD1+1 CHOP LENGTH DOWN TO ALLOWED @V4085A8 01290000
* WIDTH PLUS 1 SO IT OVERFLOWS INTO THE 01291000
* NEXT COLUMN (NORMALLY BLANK) SO 01292000
* OS/VS EREP WILL SEE AN ERROR. 01293000
LR R7,R0 @V4085A8 01294000
BCTR R7,0 PARAMETER LENGTH LESS ONE FOR EX OF MVC. @V4085A8 01295000
EX R7,HCTLMVC1 MOVE 'DATE1' INTO PLACE. @V4085A8 01296000
HCTLFIN1 CR R8,R9 'SCAN POINTER' NOW AT END? @V4085A8 01297000
BE HCTLEOR NO MORE OPERANDS, DATE1 WAS AT END. @V4085A8 01298000
* FIND AND HANDLE 'DATE2' PARAMETER. 01299000
* R8 (SCAN POINTER) IS CURRENTLY AT DELIMITER BEYOND DATE1 01300000
* (PROBABLY A BLANK, BUT POSSIBLY A COMMA). SKIP THAT 01301000
* DELIMITER AND ANY FOLLOWING BLANKS. THIS GETS US UP TO THE 01302000
* START OF THE NEXT OPERAND (WHICH MAY CONSIST SOLELY OF A 01303000
* COMMA INDICATING NEXT OPERAND IS OMITTED). 01304000
HCTLOOP2 BXH R8,R4,HCTLEOR ADVANCE R8 TO NEXT COLUMN. @V4085A8 01305000
* BRANCH IF AT END OF RECORD. @V4085A8 01306000
CLI 0(R8),C' ' @V4085A8 01307000
BE HCTLOOP2 CONTINUE SKIPPING IF BLANK. @V4085A8 01308000
* FALL THRU INDICATES R8 POINTS TO START OF NEXT OPERAND. 01309000
LR R6,R8 SAVE STARTING ADDR OF 'DATE2' OPERAND. @V4085A8 01310000
* CALL 'PARMSCAN' TO SCAN TO END OF OPERAND. 01311000
LR R0,R9 ARG FOR 'PARMSCAN'. END OF RECORD ADDR. @V4085A8 01312000
LR R1,R8 ARG FOR 'PARMSCAN'. ADDR OF PARAMETER. @V4085A8 01313000
L R15,=A(PARMSCAN) @V4085A8 01314000
BALR R14,R15 @V4085A8 01315000
LR R8,R1 UPDATED 'SCAN PTR' RETURNED FROM @V4085A8 01316000
* PARMSCAN. POINTS TO DELIMITER AT END OF 01317000
* PARAMETER. 01318000
LTR R0,R0 TEST RETURNED PARAMETER LENGTH. @V4085A8 01319000
BZ HCTLFIN2 LENGTH ZERO, FIELD OMITTED. LEAVE @V4085A8 01320000
* FIELD IN OUTPUT RECORD BLANK. 01321000
CH R0,=Y(L'CTLCRDD2) SEE IF PARMATER IS TOO BIG @V4085A8 01322000
* FOR OUTPUT FIELD 01323000
BNH *+8 BRANCH IF LENGTH OKAY. @V4085A8 01324000
LA R0,L'CTLCRDD2+1 CHOP LENGTH DOWN TO ALLOWED @V4085A8 01325000
* WIDTH PLUS 1 SO IT OVERFLOWS INTO THE 01326000
* NEXT COLUMN (NORMALLY BLANK) SO 01327000
* OS/VS EREP WILL SEE AN ERROR. 01328000
LR R7,R0 @V4085A8 01329000
BCTR R7,0 PARAMETER LENGTH LESS ONE FOR EX OF MVC. @V4085A8 01330000
EX R7,HCTLMVC2 MOVE 'DATE2' INTO PLACE. @V4085A8 01331000
HCTLFIN2 CR R8,R9 'SCAN POINTER' NOW AT END? @V4085A8 01332000
BE HCTLEOR NO MORE OPERANDS, DATE2 WAS AT END. @V4085A8 01333000
* FIND AND HANDLE 'IPL CLUSTERING INTERVAL'. 01334000
* R8 (SCAN POINTER) IS CURRENTLY AT DELIMITER BEYOND DATE2 01335000
* (PROBABLY A BLANK, BUT POSSIBLY A COMMA). SKIP THAT 01336000
* DELIMITER AND ANY FOLLOWING BLANKS. THIS GETS US UP TO THE 01337000
* START OF THE NEXT OPERAND (WHICH MAY CONSIST SOLELY OF A 01338000
* COMMA INDICATING NEXT OPERAND IS OMITTED). 01339000
HCTLOOP3 BXH R8,R4,HCTLEOR ADVANCE R8 TO NEXT COLUMN. @V4085A8 01340000
* BRANCH IF AT END OF RECORD. 01341000
CLI 0(R8),C' ' @V4085A8 01342000
BE HCTLOOP3 CONTINUE SKIPPING IF BLANK. @V4085A8 01343000
* FALL THRU INDICATES R8 POINTS TO START OF NEXT OPERAND. 01344000
LR R6,R8 SAVE STARTING ADDR OF 'IPL CLUSTER @V4085A8 01345000
* INTERVAL'. 01346000
* CALL 'PARMSCAN' TO SCAN TO END OF OPERAND. 01347000
LR R0,R9 ARG FOR 'PARMSCAN'. END OF RECORD ADDR. @V4085A8 01348000
LR R1,R8 ARG FOR 'PARMSCAN'. ADDR OF PARAMETER. @V4085A8 01349000
L R15,=A(PARMSCAN) @V4085A8 01350000
BALR R14,R15 @V4085A8 01351000
LR R8,R1 UPDATED 'SCAN PTR' RETURNED FROM @V4085A8 01352000
* PARMSCAN. POINTS TO DELIMITER AT END OF PARM. 01353000
LTR R0,R0 TEST RETURNED PARAMETER LENGTH. @V4085A8 01354000
BZ HCTLFIN3 LENGTH ZERO, FIELD OMITTED. LEAVE @V4085A8 01355000
* FIELD IN OUTPUT RECORD BLANK. 01356000
CH R0,=Y(L'CTLCRDCI) SEE IF PARAMETER IS TOO BIG @V4085A8 01357000
* FOR OUTPUT FIELD. 01358000
BNH *+8 BRANCH IF LENGTH OKAY. @V4085A8 01359000
LA R0,L'CTLCRDCI+1 CHOP LENGTH DOWN TO ALLOWED @V4085A8 01360000
* WIDTH PLUS 1 SO IT OVERFLOWS INTO THE 01361000
* NEXT COLUMN (NORMALLY BLANK) SO 01362000
* OS/VS EREP WILL SEE AN ERROR. 01363000
LR R7,R0 @V4085A8 01364000
BCTR R7,0 PARAMETER LENGTH LESS ONE FOR EX OF MVC. @V4085A8 01365000
EX R7,HCTLMVC3 MOVE 'IPL CLUSTER INTERVAL' INTO @V4085A8 01366000
* PLACE. 01367000
HCTLFIN3 CR R8,R9 'SCAN POINTER' NOW AT END? @V4085A8 01368000
BE HCTLEOR NO MORE OPERANDS, 'IPL CLUSTER @V4085A8 01369000
* INTERVAL' WAS AT END. 01370000
* FIND AND HANDLE 'TITLE' FIELD. 01371000
* R8 (SCAN POINTER) IS CURRENTLY AT DELIMITER BEYOND 'IPL 01372000
* CLUSTERING INTERVAL' (PROBABLY AT A BLANK, BUT POSSIBLY A 01373000
* COMMA). SKIP THAT DELIMITER, BUT TAKE EVERYTHING ELSE 01374000
* (INCLUDING ADDITIONAL LEADING BLANKS) TO BE THE TITLE. 01375000
BXH R8,R4,HCTLEOR ADVANCE R8 PAST THE DELIMITER. @V4085A8 01376000
* BRANCH IF BEYOND END OF RECORD. 01377000
LR R7,R5 ADDR OF LAST BYTE OF RECORD... @V4085A8 01378000
SR R7,R8 LESS ADDR OF TITLE IS @V4085A8 01379000
* LENGTH OF TITLE LESS ONE. 01380000
* IF TITLE IS TOO LONG WE WILL HAVE TO TRUNCATE IT. 01381000
CH R7,=Y(L'CTLCRDTI) LENGTH LESS ONE SHOULD BE @V4085A8 01382000
* LESS THAN THIS. 01383000
BL *+8 BRANCH IF TITLE LENGTH IS OKAY. @V4085A8 01384000
LA R7,L'CTLCRDTI-1 REVISE LENGTH TO MAX. ALLOWED. @V4085A8 01385000
EX R7,HCTLMVC4 MOVE 'TITLE' INTO PLACE. @V4085A8 01386000
LR R8,R9 LOAD VALUE TO BE RETURNED FROM THIS @V4085A8 01387000
* SUBROUTINE AS OUTPUT: ADDR OF 1ST BYTE 01388000
* BEYOND RECORD. 01389000
HCTLEOR DS 0H IN EVERY CASE R8 SHOULD NOW HAVE ADDR OF @V4085A8 01390000
* 1ST BYTE BEYOND THE INPUT RECORD. 01391000
* OUTPUT CTLCRD HAS BEEN BUILT IN THE BUFFER. 01392000
L R15,=A(WRITSYSN) @V4085A8 01393000
BALR R14,R15 CALL ROUTINE TO WRITE BUFFER TO SYSIN. @V4085A8 01394000
* EXIT 01395000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01396000
L R14,SAVER14(0,R13) @V4085A8 01397000
LM R0,R7,SAVER0(R13) @V4085A8 01398000
LM R9,R12,SAVER9(R13) @V4085A8 01399000
DROP R12 @V4085A8 01400000
BR R14 @V4085A8 01401000
SPACE 3 01402000
HCTLMVC MVC CTLCRDID(0),0(R6) @V4085A8 01403000
HCTLMVC1 MVC CTLCRDD1(0),0(R6) @V4085A8 01404000
HCTLMVC2 MVC CTLCRDD2(0),0(R6) @V4085A8 01405000
HCTLMVC3 MVC CTLCRDCI(0),0(R6) @V4085A8 01406000
HCTLMVC4 MVC CTLCRDTI(0),0(R8) @V4085A8 01407000
DROP R2 @V4085A8 01408000
EJECT 01409000
*********************************************************************** 01410000
* 01411000
* HACC: HANDLER ROUTINE FOR THE 'ACC' PARAMETER. 01412000
* 01413000
*********************************************************************** 01414000
* 01415000
* INPUTS: 01416000
* R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' IS 01417000
* NOT PRESENT. 01418000
* R6 - STARTING ADDRESS OF PARAMETER. 01419000
* R7 - PARAMETER LENGTH LESS ONE. 01420000
* 01421000
* OUTPUTS: 01422000
* - PARAMETER IS ADDED TO OS PARM LIST BEING BUILT. 01423000
* ACCFLGS - CONTAINS BIT FLAGS. 01424000
* R15 - ERROR RETURN CODE OR ZERO. 01425000
* 01426000
*********************************************************************** 01427000
HACC STM R14,R12,SAVER14(R13) @V4085A8 01428000
BALR R12,0 @V4085A8 01429000
USING *,R12 @V4085A8 01430000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01431000
* NEW SAVE AREA. 01432000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01433000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01434000
BZ HACCY BRANCH IF NO '='. @V4085A8 01435000
CLI D1(R3),C'N' TEST CHAR FOLLOWING '='. @V4085A8 01436000
BNE *+8 BRANCH IF NOT ACC=N. @V4085A8 01437000
OI ACCFLGS,NSPECFLG INDICATE ACC=N WAS SPECIFIED @V4085A8 01438000
CLI D1(R3),C'Y' TEST CHAR FOLLOWING '='. @V4085A8 01439000
BNE HACCNOTY BRANCH IF NOT ACC=Y. @V4085A8 01440000
HACCY OI ACCFLGS,YSPECFLG INDICATE ACC OR ACC=Y WAS @V4085A8 01441000
* SPECIFIED. 01442000
HACCNOTY L R15,=A(PLISTBLD) CALL ROUTINE TO ADD PRESENT @V4085A8 01443000
* PARAMETER TO OS PARM LIST. 01444000
BALR R14,R15 ARGS PASSED IN R6, R7. @V4085A8 01445000
* RETURN CODE IS NOW IN R15. 01446000
* EXIT. 01447000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01448000
L R14,SAVER14(0,R13) @V4085A8 01449000
LM R0,R12,SAVER0(R13) @V4085A8 01450000
DROP R12 @V4085A8 01451000
BR R14 @V4085A8 01452000
EJECT 01453000
*********************************************************************** 01454000
* 01455000
* HHIST: HANDLER ROUTINE FOR THE 'HIST' PARAMETER. 01456000
* 01457000
*********************************************************************** 01458000
* 01459000
* INPUTS: 01460000
* R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' IS 01461000
* NOT PRESENT. 01462000
* R6 - STARTING ADDRESS OF PARAMETER. 01463000
* R7 - PARAMETER LENGTH LESS ONE. 01464000
* 01465000
* OUTPUTS: 01466000
* - PARAMETER IS ADDED TO OS PARM LIST BEING BUILT. 01467000
* HISTFLGS - CONTAINS BIT FLAGS. 01468000
* R15 - ERROR RETURN CODE OR ZERO. 01469000
* 01470000
*********************************************************************** 01471000
HHIST STM R14,R12,SAVER14(R13) @V4085A8 01472000
BALR R12,0 @V4085A8 01473000
USING *,R12 @V4085A8 01474000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01475000
* NEW SAVE AREA. 01476000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01477000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01478000
BZ HHISTY BRANCH IF NO '='. @V4085A8 01479000
CLI D1(R3),C'N' TEST CHAR FOLLOWING '='. @V4085A8 01480000
BNE *+8 BRANCH IF NOT HIST=N. @V4085A8 01481000
OI HISTFLGS,NSPECFLG INDICATE HIST=N WAS SPECIFIED@V4085A8 01482000
CLI D1(R3),C'Y' TEST CHAR FOLLOWING '='. @V4085A8 01483000
BNE HHISNOTY BRANCH IF NOT HIST=Y. @V4085A8 01484000
HHISTY OI HISTFLGS,YSPECFLG INDICATE HIST OR HIST=Y WAS @V4085A8 01485000
* SPECIFIED. 01486000
HHISNOTY L R15,=A(PLISTBLD) CALL ROUTINE TO ADD PRESENT @V4085A8 01487000
* PARAMETER TO OS PARM LIST. 01488000
BALR R14,R15 ARGS PASSED IN R6, R7. @V4085A8 01489000
* RETURN CODE IS NOW IN R15. 01490000
* EXIT. 01491000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01492000
L R14,SAVER14(0,R13) @V4085A8 01493000
LM R0,R12,SAVER0(R13) @V4085A8 01494000
DROP R12 @V4085A8 01495000
BR R14 @V4085A8 01496000
EJECT 01497000
*********************************************************************** 01498000
* 01499000
* HMERGE: HANDLER ROUTINE FOR THE 'MERGE' PARAMETER. 01500000
* 01501000
*********************************************************************** 01502000
* 01503000
* INPUTS: 01504000
* R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' IS 01505000
* NOT PRESENT. 01506000
* R6 - STARTING ADDRESS OF PARAMETER. 01507000
* R7 - PARAMETER LENGTH LESS ONE. 01508000
* 01509000
* OUTPUTS: 01510000
* - PARAMETER IS ADDED TO OS PARM LIST BEING BUILT. 01511000
* HISTFLGS - CONTAINS BIT FLAGS. 01512000
* R15 - ERROR RETURN CODE OR ZERO. 01513000
* 01514000
*********************************************************************** 01515000
HMERGE STM R14,R12,SAVER14(R13) @V4085A8 01516000
BALR R12,0 @V4085A8 01517000
USING *,R12 @V4085A8 01518000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01519000
* NEW SAVE AREA. 01520000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01521000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01522000
BZ HMERGY BRANCH IF NO '='. @V4085A8 01523000
* FOR MERGE=N WE PERFORM NO TEST BECAUSE WE DON'T WANT TO SET 01524000
* THE FLAG IN THAT CASE SINCE IT IS REALLY THE HIST FLAGS THAT 01525000
* WE ARE MANIPULATING HERE. 01526000
CLI D1(R3),C'Y' TEST CHAR FOLLOWING '='. @V4085A8 01527000
BNE HMERNOTY BRANCH IF NOT MERGE=Y. @V4085A8 01528000
HMERGY OI HISTFLGS,YSPECFLG INDICATE HIST TAPE WILL BE @V4085A8 01529000
* NEEDED (BECAUSE MERGE OR MERGE=Y 01530000
* WAS SPECIFIED). 01531000
HMERNOTY L R15,=A(PLISTBLD) CALL ROUTINE TO ADD PRESENT @V4085A8 01532000
* PARAMETER TO OS PARM LIST. 01533000
BALR R14,R15 ARGS PASSED IN R6, R7. @V4085A8 01534000
* RETURN CODE IS NOW IN R15. 01535000
* EXIT. 01536000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01537000
L R14,SAVER14(0,R13) @V4085A8 01538000
LM R0,R12,SAVER0(R13) @V4085A8 01539000
DROP R12 @V4085A8 01540000
BR R14 @V4085A8 01541000
EJECT 01542000
*********************************************************************** 01543000
* 01544000
* HMES: HANDLER ROUTINE FOR THE 'MES' AND 'THRESHOLD' PARAMETERS. 01545000
* 01546000
*********************************************************************** 01547000
* 01548000
* INPUTS: 01549000
* R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' IS 01550000
* NOT PRESENT. 01551000
* R6 - STARTING ADDRESS OF PARAMETER. 01552000
* R7 - PARAMETER LENGTH LESS ONE. 01553000
* 01554000
* OUTPUTS: 01555000
* - PARAMETER IS ADDED TO OS PARM LIST BEING BUILT. 01556000
* ACCFLGS - CONTAINS BIT FLAGS. 01557000
* R15 - ERROR RETURN CODE OR ZERO. 01558000
* 01559000
*********************************************************************** 01560000
HMES STM R14,R12,SAVER14(R13) @V4085A8 01561000
BALR R12,0 @V4085A8 01562000
USING *,R12 @V4085A8 01563000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01564000
* NEW SAVE AREA. 01565000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01566000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01567000
BZ HMESY BRANCH IF NO '='. @V4085A8 01568000
CLI D1(R3),C'Y' TEST CHAR FOLLOWING '='. @V4085A8 01569000
BNE HMESNOTY BRANCH IF NOT MES=Y. @V4085A8 01570000
HMESY NI ACCFLGS,X'FF'-DFLTFLG EITHER 'MES' OR @V4085A8 01571000
* 'THRESHOLD' IS REQUESTED WHICH 01572000
* MEANS ACC=N BECOMES THE ACC 01573000
* DEFAULT. SO WE HAVE JUST CHANGED 01574000
* THE ACC DEFAULT HERE. 01575000
HMESNOTY L R15,=A(PLISTBLD) CALL ROUTINE TO ADD PRESENT @V4085A8 01576000
* PARAMETER TO OS PARM LIST. 01577000
BALR R14,R15 ARGS PASSED IN R6, R7. @V4085A8 01578000
* RETURN CODE IS NOW IN R15. 01579000
* EXIT. 01580000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01581000
L R14,SAVER14(0,R13) @V4085A8 01582000
LM R0,R12,SAVER0(R13) @V4085A8 01583000
DROP R12 @V4085A8 01584000
BR R14 @V4085A8 01585000
EJECT 01586000
*********************************************************************** 01587000
* 01588000
* HRDESUM: HANDLER ROUTINE FOR THE 'RDESUM' PARAMETER. 01589000
* 01590000
*********************************************************************** 01591000
* 01592000
* INPUTS: 01593000
* R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' IS 01594000
* NOT PRESENT. 01595000
* R6 - STARTING ADDRESS OF PARAMETER. 01596000
* R7 - PARAMETER LENGTH LESS ONE. 01597000
* 01598000
* OUTPUTS: 01599000
* - PARAMETER IS ADDED TO OS PARM LIST BEING BUILT. 01600000
* ACCFLGS - CONTAINS BIT FLAGS. 01601000
* HISTFLGS - CONTAINS BIT FLAGS. 01602000
* R15 - ERROR RETURN CODE OR ZERO. 01603000
* 01604000
*********************************************************************** 01605000
HRDESUM STM R14,R12,SAVER14(R13) @V4085A8 01606000
BALR R12,0 @V4085A8 01607000
USING *,R12 @V4085A8 01608000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01609000
* NEW SAVE AREA. 01610000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01611000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01612000
BZ HRDEY BRANCH IF NO '='. @V4085A8 01613000
CLI D1(R3),C'Y' TEST CHAR FOLLOWING '='. @V4085A8 01614000
BNE HRDENOTY BRANCH IF NOT RDESUM=Y. @V4085A8 01615000
HRDEY NI ACCFLGS,X'FF'-DFLTFLG EITHER 'RDESUM' OR @V4085A8 01616000
* RDESUM=Y IS REQUESTED WHICH MEANS 01617000
* ACC=N BECOMES THE ACC DEFAULT. 01618000
* SO WE CHANGE THE ACC DEFAULT HERE 01619000
OI HISTFLGS,OVRIDFLG 'RDESUM' REQUIRES HIST TAPE @V4085A8 01620000
* ALWAYS. SET OVERRIDING FLAG FOR 01621000
* HIST TAPE. 01622000
HRDENOTY L R15,=A(PLISTBLD) CALL ROUTINE TO ADD PRESENT @V4085A8 01623000
* PARAMETER TO OS PARM LIST. 01624000
BALR R14,R15 ARGS PASSED IN R6, R7. @V4085A8 01625000
* RETURN CODE IS NOW IN R15. 01626000
* EXIT. 01627000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01628000
L R14,SAVER14(0,R13) @V4085A8 01629000
LM R0,R12,SAVER0(R13) @V4085A8 01630000
DROP R12 @V4085A8 01631000
BR R14 @V4085A8 01632000
EJECT 01633000
*********************************************************************** 01634000
* 01635000
* HZERO: HANDLER ROUTINE FOR THE 'ZERO' PARAMETER. 01636000
* 01637000
*********************************************************************** 01638000
* 01639000
* INPUTS: 01640000
* R3 - ADDRESS OF THE '=' IN THE PARAMETER. OR ZERO IF '=' IS 01641000
* NOT PRESENT. 01642000
* R6 - STARTING ADDRESS OF PARAMETER. 01643000
* R7 - PARAMETER LENGTH LESS ONE. 01644000
* 01645000
* OUTPUTS: 01646000
* - PARAMETER IS ADDED TO OS PARM LIST BEING BUILT. 01647000
* ACCFLGS - CONTAINS BIT FLAGS. 01648000
* R15 - ERROR RETURN CODE OR ZERO. 01649000
* 01650000
*********************************************************************** 01651000
HZERO STM R14,R12,SAVER14(R13) @V4085A8 01652000
BALR R12,0 @V4085A8 01653000
USING *,R12 @V4085A8 01654000
ST R13,SAVE2+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 01655000
* NEW SAVE AREA. 01656000
LA R13,SAVE2 NEW SAVE AREA. @V4085A8 01657000
LTR R3,R3 WAS THERE AN '='? @V4085A8 01658000
BZ HZERY BRANCH IF NO '='. @V4085A8 01659000
CLI D1(R3),C'Y' TEST CHAR FOLLOWING '='. @V4085A8 01660000
BNE HZERNOTY BRANCH IF NOT ZERO=Y. @V4085A8 01661000
HZERY OI ACCFLGS,OVRIDFLG 'ZERO=Y' REQUIRES ACC TAPE. @V4085A8 01662000
* SET OVERRIDING FLAG TO FORCE ACC SO 01663000
* TAPE GETS POSITIONED PROPERLY. 01664000
HZERNOTY L R15,=A(PLISTBLD) CALL ROUTINE TO ADD PRESENT @V4085A8 01665000
* PARAMETER TO OS PARM LIST. 01666000
BALR R14,R15 ARGS PASSED IN R6, R7. @V4085A8 01667000
* RETURN CODE IS NOW IN R15. 01668000
* EXIT. 01669000
L R13,SAVER13B(0,R13) GET ADDR OF OLD SAVE AREA. @V4085A8 01670000
L R14,SAVER14(0,R13) @V4085A8 01671000
LM R0,R12,SAVER0(R13) @V4085A8 01672000
DROP R12 @V4085A8 01673000
BR R14 @V4085A8 01674000
EJECT 01675000
*********************************************************************** 01676000
* 01677000
* PLISTBLD: A PARAMETER PASSED TO THIS ROUTINE IS ADDED TO THE 01678000
* OS FORMAT PARAMETER LIST BEING BUILT FOR OS/VS EREP. 01679000
* 01680000
*********************************************************************** 01681000
* 01682000
* INPUTS: 01683000
* R6 - STARTING ADDRESS OF THE PARAMETER TO BE ADDED. 01684000
* R7 - PARAMETER LENGTH LESS ONE. 01685000
* R13 - ADDRESS OF A 72 BYTE SAVE AREA. 01686000
* R14 - RETURN ADDRESS. 01687000
* PARMBFAD - ADDRESS OF BEGINNING OF AREA WHERE OS PARM LIST 01688000
* WILL BE BUILT. FIRST TWO BYTES ARE HALFWORD CONTAINING 01689000
* LENGTH (SO FAR) OF PARM LIST BEING BUILT. 01690000
* PARMNEXT - ADDRESS OF NEXT FREE BYTE IN PARM LIST BUILD AREA. 01691000
* PARMREM - COUNT OF UNUSED BYTES REMAINING IN PARM LIST BUILD 01692000
* AREA. 01693000
* 01694000
* OUTPUTS: 01695000
* R15 - ERROR RETURN CODE (PARM BUILD AREA FULL) OR ZERO. 01696000
* PARMBFAD - LENGTH HALFWORD AT THIS ADDRESS IS UPDATED. 01697000
* PARMNEXT - UPDATED. 01698000
* PARMREM - UPDATED. 01699000
* 01700000
*********************************************************************** 01701000
PLISTBLD SR R15,R15 ASSUME THE RETURN CODE WILL BE 0. @V4085A8 01702000
STM R14,R12,SAVER14(R13) SAVE RETURN CODE AND @V4085A8 01703000
* OTHER REGISTERS. 01704000
BALR R12,0 @V4085A8 01705000
USING *,R12 @V4085A8 01706000
L R4,PARMBFAD ADDR OF LENGTH HALFWORD. @V4085A8 01707000
LH R5,0(0,R4) 'LENGTH-BUILT-SO-FAR' VALUE. @V4085A8 01708000
L R9,PARMNEXT ADDR OF NEXT UNUSED BYTE. @V4085A8 01709000
LA R8,1(0,R7) R8 WILL COMPUTE NUMBER OF BYTES @V4085A8 01710000
* BEING ADDED TO THE PARM LIST. ONE IS ADDED 01711000
* TO COMPENSATE FOR R7 BEING 'LESS ONE'. 01712000
C R8,PARMREM COMPARE LENGTH OF CURRENT PARM WITH @V4085A8 01713000
* UNUSED SPACE REMAINING. 01714000
BL PLFITS OKAY IF CURRENT PARM LENGTH IS 'LESS'. @V4085A8 01715000
* (NOTE: 'EQUAL' WOULD USUALLY BE TOO LITTLE 01716000
* BECAUSE R8 DOES NOT YET INCLUDE LENGTH OF THE 01717000
* COMMA THAT WILL PROBABLY HAVE TO PRECEED THE 01718000
* PARAMETER.) 01719000
DMSERR NUM=831,LET=E,TEXT='MORE THAN 100 CHARS. OF OPTIONS SPEX01720000
CIFIED',RENT=NO @V4085A8 01721000
MVI SAVER15+3(R13),RC62 SET ERROR RETURN CODE IN @V4085A8 01722000
* IN R15 IN SAVE AREA. 01723000
B PLEXIT @V4085A8 01724000
SPACE 01725000
* IF THE PRESENT PARAMETER IS NOT THE FIRST ONE, IT MUST BE 01726000
* PRECEEDED BY A COMMA IN THE OUTPUT AREA TO SEPARATE IT FROM 01727000
* THE PRECEEDING PARAMETER. 01728000
PLFITS LTR R5,R5 TEST VALUE OF 'LENGTH-BUILT-SO-FAR'. @V4085A8 01729000
BZ PLSKIPCM LENGTH 0 INDICATES NO COMMA NEEDED. @V4085A8 01730000
LA R8,L1(0,R8) COUNT COMMA IN LENGTH OF NEW DATA. @V4085A8 01731000
MVI 0(R9),C',' ADD COMMA TO PARM LIST. @V4085A8 01732000
LA R9,L1(0,R9) ADVANCE TO NEXT UNUSED BYTE. @V4085A8 01733000
PLSKIPCM DS 0H @V4085A8 01734000
EX R7,PLISTMVC MOVE NEW PARAMETER INTO PARM LIST. @V4085A8 01735000
LA R9,L1(R7,R9) ADVANCE TO NEXT UNUSED BYTE. ADD @V4085A8 01736000
* ONE (L1) BECAUSE R7 HAS LENGTH OF 01737000
* PARAMETER LESS ONE. 01738000
ST R9,PARMNEXT SAVE FOR USE NEXT TIME. @V4085A8 01739000
AR R5,R8 OLD LIST LENGTH PLUS LENGTH ADDED IS NEW @V4085A8 01740000
* LIST LENGTH. 01741000
STH R5,0(0,R4) SAVE IN HALFWD AT START OF PARM LIST@V4085A8 01742000
L R5,PARMREM BYTES REMAINING PREVIOUSLY... @V4085A8 01743000
SR R5,R8 LESS BYTES ADDED, GIVES SPACE @V4085A8 01744000
* REMAINING NOW. 01745000
ST R5,PARMREM SAVE FOR USE NEXT TIME. @V4085A8 01746000
PLEXIT LM R14,R12,SAVER14(R13) @V4085A8 01747000
DROP R12 @V4085A8 01748000
BR R14 @V4085A8 01749000
SPACE 3 01750000
PLISTMVC MVC 0(0,R9),0(R6) EX'ED REMOTELY, EX SUPPLIES LEN. @V4085A8 01751000
EJECT 01752000
*********************************************************************** 01753000
* 01754000
* WRITSYSN: THIS SUBROUTINE WRITES ONE 80 BYTE RECORD OUT TO THE 01755000
* SYSIN FILE. 01756000
* 01757000
*********************************************************************** 01758000
* 01759000
* INPUTS: 01760000
* R13 - ADDRESS OF A 72 BYTE SAVE AREA. 01761000
* R14 - RETURN ADDRESS. 01762000
* SYSNBUF - BUFFER CONTAINING THE RECORD TO BE WRITTEN. 01763000
* 01764000
* OUTPUTS: 01765000
* SYSNBUF - BUFFER, RE-INITIALIZED TO BLANKS. 01766000
* R15 - ERROR RETURN CODE OR ZERO. 01767000
* 01768000
*********************************************************************** 01769000
WRITSYSN STM R14,R12,SAVER14(R13) @V4085A8 01770000
BALR R12,0 @V4085A8 01771000
USING *,R12 @V4085A8 01772000
FSWRITE FSCB=SYSNFSCB @V4085A8 01773000
USING FSCBD,R1 @V4085A8 01774000
L R1,FSCBBUFF GET ADDR OF SYSNBUF BUFFER. @V4085A8 01775000
DROP R1 @V4085A8 01776000
MVI 0(R1),C' ' BLANK IN 1ST BYTE OF BUFFER. @V4085A8 01777000
MVC D1(L'SYSNBUF-1,R1),0(R1) PROPAGATE BLANK. @V4085A8 01778000
L R14,SAVER14(0,R13) @V4085A8 01779000
LM R0,R12,SAVER0(R13) @V4085A8 01780000
DROP R12 @V4085A8 01781000
BR R14 @V4085A8 01782000
EJECT 01783000
*********************************************************************** 01784000
* 01785000
* DATA AREAS (FIRST SECTION) 01786000
* 01787000
*********************************************************************** 01788000
SPACE 01789000
RETCDE DC H'0' HOLDS ERROR RETURN CODE UNTIL EXIT TIME. @V4085A8 01790000
PARMCNT DC H'0' COUNT OF CONTROL PARAMETERS THAT HAVE BEEN@V4085A8 01791000
* ISOLATED. 01792000
SPACE 3 01793000
CLRFLAGS DC X'00' 'CLEAR' PARAMETER REQUEST FLAGS. EQUATES@V4085A8 01794000
* FOLLOW: 01795000
ERRFLG EQU X'01' FLAG SET WHEN 'CLEAR' @V5088AA 01796000
* IS REQUESTED. 01797000
FRMFLAG EQU X'02' FLAG SET WHEN CLEARF REQUESTED @V5088AA 01798000
SPACE 3 01799000
ACCFLGS DC AL1(DFLTFLG) FLAGS (EQUATED BELOW) DETERMINE @V4085A8 01800000
* WHETHER ACC TAPE IS REQUIRED. 01801000
HISTFLGS DC AL1(0) FLAGS (EQUATED BELOW) DETERMINE @V4085A8 01802000
* WHETHER HIST TAPE IS REQUIRED. 01803000
* EQUATES BELOW ARE FOR BITS IN BOTH ACCFLGS AND HISTFLGS ABOVE. 01804000
DFLTFLG EQU 128 BIT SET TO 1 MEANS DEFAULT TO Y (TAPE REQD)@V4085A8 01805000
YSPECFLG EQU 64 BIT SET TO 1 MEANS USER SPECIFIED Y (OVER- @V4085A8 01806000
* RIDES DFLTFLG). 0 MEANS Y NOT SPECIFIED. 01807000
NSPECFLG EQU 32 BIT SET TO 1 MEANS USER SPECIFIED N (OVER- @V4085A8 01808000
* RIDES DFLTFLG). 0 MEANS N NOT SPECIFIED. 01809000
OVRIDFLG EQU 16 BIT SET TO 1 MEANS SOME OVERRIDING @V4085A8 01810000
* CONSIDERATION IMPLIES Y REGARDLESS OF WHETHER 01811000
* THE USER SPECIFIED Y OR N. TAKES PRECEDENCE OVER 01812000
* ALL OTHER FLAGS. 01813000
SPACE 3 01814000
DOSSAVE DC X'00' SAVES INITIAL VALUE OF 'DOSSVC' FLAG @V4085A8 01815000
* THOUGH THE SAVING CODE IS SOMETIMES SKIPPED. 01816000
* BUT THE RESTORING CODE AT THE END (AN 'OR' 01817000
* OPERATION) IS NEVER SKIPPED, SO IT IS NECESSARY 01818000
* TO INITIALIZE WITH X'00' HERE. 01819000
OSSSAVE DC X'00' SAVES INITIAL VALUE OF 'COMPSWT' FLAG. @V4085A8 01820000
* INITIALIZED TO X'00' FOR SAME REASON AS GIVEN 01821000
* FOR DOSSAVE ABOVE. 01822000
PARMBFAD DC A(0) ADDRESS OF AREA (ALLOCATED FROM FREE @V4085A8 01823000
* STORAGE) WHERE OS PARM LIST WILL BE BUILT. THE 01824000
* LENGTH OF THIS AREA IS GIVEN BY THE PARMBUFL EQU. 01825000
PARMNEXT DC A(0) ADDRESS OF NEXT FREE BYTE IN PARM LIST @V4085A8 01826000
* BUILD AREA. 01827000
PARMREM DC F'0' COUNT OF UNUSED BYTES REMAINING IN PARM @V4085A8 01828000
* LIST BUILD AREA. 01829000
FENCEXFF DC 8X'FF' FENCE OF FF'S FOR CHECKING END OF @V4085A8 01830000
* PARAMETER LISTS. 01831000
SPACE 3 01832000
SYSNBUF DC CL80' ' BUFFER FOR WRITING OUT THE SYSIN FILE @V4085A8 01833000
* THAT IS READ BY EREP LATER. NOTE THAT THE 01834000
* BUFFER IS INITIALIZED WITH BLANKS NOW. 01835000
* AND AFTER EACH USE IT WILL BE RESET TO BLANKS. 01836000
SPACE 3 01837000
* NOTE: IN THE FSCB THAT FOLLOWS, THE FILEMODE FIELD WILL BE 01838000
* FILLED IN PRIOR TO ITS FIRST USE. 01839000
SYSNFSCB FSCB 'SYSIN EREPWORK',BUFFER=SYSNBUF, @V4085A8X01840000
RECFM=F,BSIZE=80 @V4085A8 01841000
CTLFSCB FSCB BUFFER=CTLFLBUF FOR READING CONTROL PARAMETERS @V4085A8X01842000
FROM USER SPECIFIED INPUT FILE.@V4085A8 01843000
EJECT 01844000
* THE FOLLOWING TABLE IS USED IN IDENTIFYING THE INPUTTED 01845000
* CONTROL PARAMETERS. EACH ENTRY OF THE TABLE HAS THE 01846000
* FOLLOWING FORMAT: 01847000
* DC AL1(LENGTH-OF-PARAMETER-NAME) 01848000
* DC CL12'PARAMETER-NAME' 01849000
* DC AL3(NAME-OF-ROUTINE-TO-PROCESS-PARAMETER) 01850000
KEYTAB DS 0F ALIGN TABLE FOR EFFICIENCY. @V4085A8 01851000
DC AL1(5),CL12'SHARE',AL3(HSHARE) @V4085A8 01852000
DC AL1(10),CL12'CONTROLLER',AL3(HCONTROL) @VA09381 01852500
DC AL1(5),CL12'CLEAR',AL3(HCLEAR) @V4085A8 01853000
DC AL1(6),CL12'CLEARF',AL3(HCLEARF) @V5088AA 01854000
DC AL1(6),CL12'CTLCRD',AL3(HCTLCRD) @V4085A8 01855000
DC AL1(3),CL12'ACC',AL3(HACC) @V4085A8 01856000
DC AL1(4),CL12'HIST',AL3(HHIST) @V4085A8 01857000
DC AL1(5),CL12'MERGE',AL3(HMERGE) @V4085A8 01858000
DC AL1(3),CL12'MES',AL3(HMES) @V4085A8 01859000
DC AL1(9),CL12'THRESHOLD',AL3(HMES) @V4085A8 01860000
DC AL1(6),CL12'RDESUM',AL3(HRDESUM) @V4085A8 01861000
DC AL1(4),CL12'ZERO',AL3(HZERO) @V4085A8 01862000
DC AL1(8),CL12'TERMINAL',AL3(HTERM) @V4085A8 01863000
KEYTABZ EQU * MARKS END OF KEYTAB TABLE. @V4085A8 01864000
KEYTABAD EQU 12 DISPLACEMENT TO THE 'SUBROUTINE ADDRESS' @V4085A8 01865000
* WORD OF A KEYTAB ENTRY. 01866000
KEYTABLN EQU 16 LENGTH OF AN ENTRY IN THE KEYTAB TABLE. @V4085A8 01867000
EJECT 01868000
LTORG @V4085A8 01869000
SPACE 3 01870000
SAVEAREA DS 9D A STANDARD 72 BYTE SAVE AREA. @V4085A8 01871000
SAVE2 DS 9D A STANDARD 72 BYTE SAVE AREA. @V4085A8 01872000
SPACE 3 01873000
CTLFLBUF DS CL80 BUFFER FOR READING CONTROL PARAMETERS FROM@V4085A8 01874000
* INPUT FILE. 01875000
ORG CTLFLBUF TERMINAL AND DISK FILE SHARE SAME @V4085A8 01876000
* BUFFER AREA SINCE ONLY ONE OR THE OTHER 01877000
* IS USED. 01878000
TERMBUF DS CL130 BUFFER FOR READING CONTROL PARAMETERS @V4085A8 01879000
* FROM THE TERMINAL. 01880000
ORG 01881000
SPACE 3 01882000
DS 0F FOR BEST EFFICIENCY, ALIGN KEYWORK AT FWD. @V4085A8 01883000
KEYWORK DS CL13 WORK AREA TO CONTAIN KEYWORD TO BE @V4085A8 01884000
* IDENTIFIED, PRECEEDED BY LENGTH IN 1ST BYTE. 01885000
SPACE 3 01886000
*********************************************************************** 01887000
* 01888000
* RESERVE SPACE FOR 4K PAGE BUFFER FOR DMSREA AT X'21000'. 01889000
* 01890000
*********************************************************************** 01891000
SPACE 01892000
ENDSECT1 EQU * @V4085A8 01893000
ORG DMSIFC+4096 STARTING ADDRESS OF PAGE BUFFER. @V4085A8 01894000
CHECKSIZ EQU X'80000000'+(*-ENDSECT1) IF SECTION 1 IS TOO @V4085A8 01895000
* BIG AND SPILLS OVER INTO THE 01896000
* PAGE BUFFER, THEN THE 01897000
* PARENTHESIZED PART OF THIS 01898000
* EQU WILL BE NEGATIVE AND WHEN 01899000
* ADDED TO THE HEX VALUE, WILL 01900000
* CAUSE ARITHMETIC UNDERFLOW AND 01901000
* THE ASSEMBLER WILL FLAG IT, 01902000
* THUS NOTIFYING THE PROGRAMMER. 01903000
ORG DMSIFC+8192 STARTING LOCATION FOR SECTION 2 @V4085A8 01904000
* BEYOND THE BUFFER. 01905000
EJECT 01906000
*********************************************************************** 01907000
* 01908000
* ERASFILE: ERASE A SPECIFIED FILE FROM AN UNSPECIFIED DISK 01909000
* PROVIDED THE FILE EXISTS AND THAT IT IS ON A READ/WRITE 01910000
* DISK. 01911000
* 01912000
*********************************************************************** 01913000
* 01914000
* NOTE: IF MORE THAN ONE FILE HAS THE SPECIFIED ID (I.E., FILES ON 01915000
* DIFFERENT DISKS), ALL ARE ERASED. 01916000
* 01917000
* INPUTS: 01918000
* R1 - POINTS TO 16 CHARACTERS SPECIFYING FILENAME FILETYPE. 01919000
* R13 - ADDRESS OF SAVE AREA. USED AS A WORK AREA. 01920000
* R14 - RETURN ADDRESS. 01921000
* 01922000
* OUTPUTS: 01923000
* R15 - AN ERROR RETURN CODE (FROM 'ERASE' COMMAND) OR ZERO. 01924000
* 01925000
*********************************************************************** 01926000
ERASFILE SR R15,R15 @V4085A8 01927000
STM R14,R2,SAVER14(R13) @V4085A8 01928000
BALR R2,0 @V4085A8 01929000
USING *,R2 @V4085A8 01930000
ERASMORE LA R15,SAVER3(0,R13) ADDRESS OF A 5 DOUBLEWORD @V4085A8 01931000
* WORK AREA (CHOPPED OUT OF OUR SAVE 01932000
* AREA) IN WHICH WE WILL BUILD A 01933000
* P-LIST FOR SVC 202. 01934000
MVC 0(L8,R15),=CL8'STATEW' COMMAND TO BE INVOKED. @V4085A8 01935000
MVC D8(L16,R15),0(R1) FILENAME AND FILETYPE. @V4085A8 01936000
MVC D24(L10,R15),=10X'FF' FENCE OF FF'S TO END THE @V4085A8 01937000
* 'STATEW' P-LIST AND 2 MORE FF'S 01938000
* TO END THIS P-LIST WHEN USED 01939000
* FOR 'ERASE'. 01940000
* NOTE: 'STATEW' COMMAND WILL 01941000
* REPLACE 1ST 2 BYTES OF FF BY MODE 01942000
LR R1,R15 P-LIST ADDR IN R1 FOR SVC. @V4085A8 01943000
SVC 202 @V4085A8 01944000
DC AL4(ERASEXIT) RETURN IF FILE NOT ON R/W DISK. @V4085A8 01945000
L R15,D28(0,R1) 'STATEW' STORED FST ADDR AT D28. @V4085A8 01946000
USING FSTSECT,R15 @V4085A8 01947000
MVC D24(L2,R1),FSTM GET FILEMODE FROM FST AND PUT @V4085A8 01948000
* IT IN OUR P-LIST. 01949000
DROP R15 @V4085A8 01950000
MVC 0(L8,R1),=CL8'ERASE' COMMAND TO BE INVOKED. @V4085A8 01951000
SVC 202 @V4085A8 01952000
DC AL4(ERASERRO) @V4085A8 01953000
* OKAY, WE ERASED THE FILE. BUT BEFORE LEAVING, TRY AGAIN, 01954000
* THERE COULD BE ANOTHER FILE WITH SAME NAME AND TYPE ON 01955000
* ANOTHER DISK. 01956000
L R1,SAVER1(0,R13) @V4085A8 01957000
B ERASMORE @V4085A8 01958000
SPACE 01959000
ERASERRO ST R15,SAVER15(0,R13) SET ERROR RETURN CODE. @V4085A8 01960000
ERASEXIT LM R14,R2,SAVER14(R13) @V4085A8 01961000
DROP R2 @V4085A8 01962000
BR R14 @V4085A8 01963000
EJECT 01964000
*********************************************************************** 01965000
* 01966000
* RDCTLINE: THIS SUBROUTINE IS CALLED TO READ AND RETURN ONE LINE 01967000
* OF CONTROL PARAMETERS FROM THE TERMINAL (WITH PROMPTING) 01968000
* OR FROM A CONTROL FILE ON A CMS DISK. 01969000
* 01970000
*********************************************************************** 01971000
* 01972000
* INPUTS: 01973000
* R13 - ADDRESS OF A 72 BYTE SAVE AREA. 01974000
* R14 - RETURN ADDRESS. 01975000
* RDCTLSW - THIS SWITCH, SET PRIOR TO THE FIRST CALL, 01976000
* DETERMINES WHETHER READING IS FROM THE TERMINAL OR 01977000
* FROM A DISK FILE. 01978000
* 01979000
* OUTPUTS: 01980000
* R1 - ADDRESS OF THE LINE OF CONTROL PARAMETER DATA. 01981000
* R0 - LENGTH OF THE LINE OF CONTROL PARAMETER DATA. A LENGTH 01982000
* OF ZERO SIGNALS END-OF-FILE. 01983000
* R15 - ZERO IS NORMAL RETURN; NON-ZERO INDICATES A FATAL 01984000
* ERROR OCCURRED. 01985000
* 01986000
*********************************************************************** 01987000
RDCTLINE STM R14,R12,SAVER14(R13) PRESERVE REGISTER CONTENTS@V4085A8 01988000
* FOR CALLER. 01989000
BALR R12,0 @V4085A8 01990000
USING *,R12 @V4085A8 01991000
RDCTLSW EQU *+1 @V4085A8 01992000
BC *-*,RDTERM CONDITION MASK GETS OVERLAID. @V4085A8 01993000
* BRANCH TO READ FROM TERMINAL. 01994000
* FALL THRU MEANS READ FROM DISK FILE. 01995000
L R1,=A(CTLFSCB) FSCB FOR FILE TO BE READ. @V4085A8 01996000
FSREAD FSCB=(1) READ A RECORD INTO 'CTLFLBUF'. @V4085A8 01997000
LTR R15,R15 @V4085A8 01998000
BNZ RDCHECK AN ERROR OR UNUSUAL CONDITION OCCURRED.@V4085A8 01999000
USING FSCBD,R1 @V4085A8 02000000
L R1,FSCBBUFF ADDR OF BUFFER CONTAINING RECORD @V4085A8 02001000
* JUST READ. 02002000
DROP R1 @V4085A8 02003000
LA R0,TRUNCLEN LENGTH OF RECORD JUST READ. @V4085A8 02004000
B RDEXIT @V4085A8 02005000
SPACE 02006000
RDCHECK CH R15,=Y(RC12) CHECK FOR RC=12 INDICATING END-OF-@V4085A8 02007000
* FILE. 02008000
BNE RDERR1 NOT EOF. MUST BE A FATAL READ ERROR. @V4085A8 02009000
* FALL THRU IF END-OF-FILE. 02010000
FSCLOSE FSCB=(R1) R1 WAS LOADED BY FSREAD. @V4085A8 02011000
SR R15,R15 EOF IS NOT AN ERROR, SET RC=0. @V4085A8 02012000
SR R0,R0 ZEROED LENGTH SIGNALS EOF. @V4085A8 02013000
B RDEXIT @V4085A8 02014000
SPACE 02015000
USING FSCBD,R1 R1 WAS LOADED BY FSREAD. @V4085A8 02016000
RDERR1 LA R2,FSCBFN ADDR OF FILEID FOR ERROR MESSAGE. @V4085A8 02017000
DROP R1 @V4085A8 02018000
LR R3,R15 PRESERVE ERROR CODE (FOR MSG BELOW). @V4085A8 02019000
FSCLOSE FSCB=(R1) R1 WAS LOADED BY FSREAD. @V4085A8 02020000
* NOTE: RC IN R15 IS DESTROYED BY FSCLOSE ABOVE. 02021000
DMSERR NUM=104,LET=S,TEXT='ERROR ''...'' READING FILE ''......X02022000
...............'' FROM DISK', @V4085A8X02023000
SUB=(HEX,(R3),CHAR8A,(R2)),RENT=NO @V4085A8 02024000
LA R15,RC100 @V4085A8 02025000
SR R0,R0 SIGNAL EOF ALSO, WE DO NOT WANT THE @V4085A8 02026000
* CALLER TRYING TO READ AGAIN. 02027000
B RDEXIT @V4085A8 02028000
SPACE 02029000
* ARRIVE HERE TO READ INPUT FROM THE TERMINAL. 02030000
RDTERM WRTERM 'ENTER:' PROMPT FOR INPUT. @V4085A8 02031000
WAITT @V4085A8 02032000
L R2,=A(TERMBUF) ADDRESS OF BUFFER TO ACCEPT @V4085A8 02033000
* TERMINAL INPUT. 02034000
RDTERM (R2),EDIT=UPCASE READ INPUT INTO BUFFER, @V4085A8X02035000
RETURN LENGTH OF INPUT IN R0.@V4085A8 02036000
WAITT @V4085A8 02037000
LR R1,R2 RETURN ADDRESS OF BUFFER IN R1. @V4085A8 02038000
SPACE 02039000
RDEXIT L R14,SAVER14(0,R13) RESTORE RETURN ADDRESS. @V4085A8 02040000
LM R2,R12,SAVER2(R13) RESTORE USER REGISTERS. @V4085A8 02041000
BR R14 @V4085A8 02042000
DROP R12 @V4085A8 02043000
EJECT 02044000
*********************************************************************** 02045000
* 02046000
* PARMSCAN: SCANS A CONTROL PARAMETER, LOCATING DELIMITER AT ITS END. 02047000
* 02048000
*********************************************************************** 02049000
* 02050000
* INPUTS: R0 = END-OF-RECORD ADDRESS. (ADDRESS OF 1ST BYTE BEYOND 02051000
* THE END OF THE LINE OF DATA.) 02052000
* R1 = CURRENT VALUE OF SCAN POINTER. (ADDRESS OF 1ST 02053000
* BYTE OF THE PARAMETER TO BE SCANNED.) 02054000
* R13 = ADDRESS OF A STANDARD 72 BYTE SAVE AREA. 02055000
* R14 = RETURN ADDRESS. 02056000
* 02057000
* OUTPUTS: R0 = LENGTH OF THE PARAMETER. EXCLUDES DELIMITER AT END. 02058000
* R1 = CURRENT VALUE OF SCAN POINTER. (ADDRESS OF 1ST BYTE 02059000
* BEYOND THE PARAMETER, USUALLY A DELIMITER, BUT 02060000
* SOMETIMES THE FIRST BYTE BEYOND THE LINE OF DATA.) 02061000
* R15 = ZERO: NORMAL COMPLETION. 02062000
* R15 = NON-ZERO: SCAN DETECTED UNBALANCED PARENTHESES. 02063000
* 02064000
* OPERATION - 02065000
* 1. SET R15 TO ZERO AND SAVE REGISTERS. 02066000
* 2. SCAN UNTIL ONE OF THE FOLLOWING IS ENCOUNTERED: 02067000
* BLANK - GO TO 5. 02068000
* COMMA - GO TO 5. 02069000
* END OF LINE - GO TO 5. 02070000
* LEFT PARENTHESIS - GO TO 3. 02071000
* RIGHT PARENTHESIS - SET ERROR CODE IN R15. GO TO 2. 02072000
* 3. INITIALIZE PARENTHESIS NESTING DEPTH COUNT TO 1. 02073000
* 4. SCAN UNTIL ONE OF THE FOLLOWING IS ENCOUNTERED: 02074000
* END OF LINE - SET ERROR CODE IN R15. GO TO 5. 02075000
* LEFT PARENTHESIS - ADD 1 TO PARENTHESIS DEPTH COUNT. 02076000
* GO TO 4. 02077000
* RIGHT PARENTHESIS - SUBTRACT 1 FROM PARENTHESIS DEPTH 02078000
* COUNT. IF RESULT IS ZERO, GO TO 2; 02079000
* OTHERWISE GO TO 4. 02080000
* 5. COMPUTE OUTPUT VALUES FOR R0 AND R1. 02081000
* 6. RETURN TO CALLER. 02082000
* 02083000
*********************************************************************** 02084000
PARMSCAN SR R15,R15 INITIALIZE RETURN CODE VALUE TO ZERO. @V4085A8 02085000
STM R14,R12,SAVER14(R13) @V4085A8 02086000
BALR R12,0 @V4085A8 02087000
USING *,R12 @V4085A8 02088000
LR R6,R1 SAVE A COPY OF THE PARAMETER STARTING @V4085A8 02089000
* ADDRESS THAT WAS RECEIVED IN R1. 02090000
L R15,=A(TABDLIM) ADDR OF THE ONLY TRT TABLE USED@V4085A8 02091000
* IN THIS ROUTINE. REMAINS LOADED 02092000
* IN R15 UNTIL WE EXIT. 02093000
SR R2,R2 CLEAR TO HOLD FUNCTION BYTE FROM TRT. @V4085A8 02094000
LR R9,R0 ADDR OF 1ST BYTE BEYOND THE RECORD. @V4085A8 02095000
BCTR R9,0 ADDR OF LAST BYTE OF RECORD. IN BXH @V4085A8 02096000
* COMPARAND REGISTER. 02097000
LA R8,1 VALUE 1 IN BXH INCREMENT REGISTER. @V4085A8 02098000
BCTR R1,0 BEFORE ENTERING THE 'PSCAN2' LOOP, WE @V4085A8 02099000
* BACK UP THE STARTING ADDR BY ONE BYTE TO 02100000
* COMPENSATE FOR 'PSCAN2'S IMMEDIATE ADVANCE OF 02101000
* ONE BYTE OVER WHAT IT THINKS IS A PREVIOUSLY 02102000
* SCANNED DELIMITER. 02103000
SPACE 3 02104000
PSCAN2 BXH R1,R8,PSCAN5 ADVANCE R1 ONE BYTE TO GET PAST @V4085A8 02105000
* DELIMITER JUST FOUND. THEN BRANCH IF R1 02106000
* IS BEYOND LAST BYTE OF RECORD. 02107000
LR R3,R9 LAST BYTE OF RECORD... @V4085A8 02108000
SR R3,R1 LESS 1ST BYTE TO BE SCANNED, GIVES @V4085A8 02109000
* LENGTH LESS ONE. 02110000
EX R3,PSCANTRT TRT 0(0,R1),0(R15) @V4085A8 02111000
BNZ BRANTAB(R2) IF A DELIMITER WAS HIT, USE @V4085A8 02112000
* FUNCTION BYTE TO INDEX BRANCH TABLE. 02113000
* FALL THRU IF TRT RAN TO END OF RECORD WITHOUT HITTING A 02114000
* DELIMITER. 02115000
LR R1,R0 DUMMY UP R1 TO LOOK LIKE THE TRT FOUND A @V4085A8 02116000
* DELIMITER IN 1ST BYTE BEYOND THE RECORD. 02117000
* THEN FALL THRU AND TREAT IT LIKE DUMMY DELIMITER WAS A BLANK. 02118000
BRANTAB EQU *-4 MINUS 4 BECAUSE TABLE HAS NO ZERO-TH ENTRY.@V4085A8 02119000
B PSCAN5 FUNCTION=4; BLANK WAS FOUND. @V4085A8 02120000
B PSCAN5 FUNCTION=8; COMMA WAS FOUND. @V4085A8 02121000
B PSCAN3 FUNCTION=12; LEFT PARENTHESIS WAS FOUND.@V4085A8 02122000
*--------B-----*+4----FUNCTION=16; RIGHT PARENTHESIS WAS FOUND.@V4085A8 02123000
MVI SAVER15+3(R13),RC2 UNBALANCED RIGHT @V4085A8 02124000
* PARENTHESIS; PUT ERROR CODE IN R15 02125000
* IN SAVE AREA. 02126000
B PSCAN2 CONTINUE PAST THE BAD PARENTHESIS TO @V4085A8 02127000
* FIND END OF PARAMETER. 02128000
SPACE 3 02129000
PSCAN3 LA R7,1 INITIAL PARENTHESIS NESTING DEPTH CNT=1. @V4085A8 02130000
SPACE 3 02131000
* CONTINUE SCANNING, BUT NOW WE ARE TRAVERSING A PARENTHESIZED 02132000
* AREA AND SO WE ONLY CARE ABOUT PARENTHESES AND END-OF-RECORD, 02133000
* NOT ABOUT COMMA AND BLANK. 02134000
PSCAN4 BXH R1,R8,PSCANERR ADVANCE R1 ONE BYTE TO GET PAST @V4085A8 02135000
* DELIMITER JUST FOUND. THEN BRANCH IF 02136000
* R1 IS BEYOND LAST BYTE OF RECORD. 02137000
LR R3,R9 LAST BYTE OF RECORD... @V4085A8 02138000
SR R3,R1 LESS 1ST BYTE TO BE SCANNED GIVES @V4085A8 02139000
* LENGTH LESS ONE. 02140000
EX R3,PSCANTRT TRT 0(0,R1),0(R15) @V4085A8 02141000
BNZ BRANTAB2(R2) IF A DELIMITER WAS HIT, USE @V4085A8 02142000
* FUNCTION BYTE TO INDEX BRANCH TABLE. 02143000
* FALL THRU IF TRT RAN TO END OF RECORD WITHOUT HITTING A 02144000
* DELIMITER. 02145000
LR R1,R0 DUMMY UP R1 TO LOOK LIKE THE TRT FOUND A @V4085A8 02146000
* DELIMITER IN 1ST BYTE BEYOND THE RECORD. 02147000
PSCANERR MVI SAVER15+3(R13),RC1 UNBALANCED LEFT PARENTHESIS @V4085A8 02148000
* CAUSED SCAN TO END-OF-RECORD; PUT 02149000
* ERROR CODE IN R15 IN SAVE AREA. 02150000
B PSCAN5 TREAT END-OF-RECORD AS END OF PARAMETER.@V4085A8 02151000
SPACE 02152000
BRANTAB2 EQU *-4 MINUS 4 BECAUSE TABLE HAS NO ZERO-TH ENTRY.@V4085A8 02153000
B PSCAN4 FUNCTION=4; BLANK WAS FOUND. IGNORE IT.@V4085A8 02154000
B PSCAN4 FUNCTION=8; COMMA WAS FOUND. IGNORE IT.@V4085A8 02155000
B PSCANDEP FUNCTION=12; LEFT PARENTHESIS FOUND. @V4085A8 02156000
*--------B-----*+4-----FUNCTION=16; RIGHT PARENTHESIS FOUND. @V4085A8 02157000
BCT R7,PSCAN4 SUBTRACT ONE FROM PARENTHESIS DEPTH @V4085A8 02158000
* COUNT AND GO TO PSCAN4 IF RESULT IS NOT ZERO. 02159000
B PSCAN2 PARENTHESIS DEPTH COUNT IS NOW ZERO. @V4085A8 02160000
* RESUME NORMAL SCAN OUTSIDE PARENTHESIZED AREA. 02161000
PSCANDEP LA R7,1(0,R7) ADD ONE TO PARENTHESIS DEPTH COUNT. @V4085A8 02162000
B PSCAN4 @V4085A8 02163000
SPACE 3 02164000
* COMPUTE OUTPUT VALUES FOR R0 AND R1. 02165000
PSCAN5 LR R0,R1 ENDING DELIMITER ADDRESS... @V4085A8 02166000
SR R0,R6 MINUS PARAMETER STARTING ADDR GIVES @V4085A8 02167000
* PARAMETER LENGTH. 02168000
* RETURN TO CALLER. 02169000
PSCAN6 LM R14,R15,SAVER14(R13) @V4085A8 02170000
LM R2,R12,SAVER2(R13) @V4085A8 02171000
DROP R12 @V4085A8 02172000
BR R14 @V4085A8 02173000
SPACE 3 02174000
PSCANTRT TRT 0(0,R1),0(R15) EX'ED REMOTELY WITH LENGTH @V4085A8 02175000
* SUPPLIED BY EX. 02176000
EJECT 02177000
*********************************************************************** 02178000
* 02179000
* CLEARRTN: THIS SUBROUTINE IS CALLED TO CLEAR (LOGICALLY ERASE) 02180000
* THE VM/370 ERROR RECORDING CYLINDERS. 02181000
* 02182000
*********************************************************************** 02183000
* 02184000
* INPUTS: 02185000
* R1 - CONTAINS FLAGS THAT WILL TELL THE DIAGNOSE WHICH OF THE 02186000
* CYLINDERS IS (ARE) TO BE ERASED. 02187000
* R14 - RETURN ADDRESS. 02188000
* 02189000
* OUTPUTS: 02190000
* MSG - DMSIFC828I IF CLEARED OKAY, DMSIFC829W IF CLEAR FAILED. 02191000
* R15 - ERROR RETURN CODE IF CLEAR FAILS BECAUSE USER DOES NOT 02192000
* HAVE PRIVILEGE CLASS F. 02193000
* 02194000
*********************************************************************** 02195000
CLEARRTN STM R14,R12,SAVER14(R13) @V4085A8 02196000
BALR R12,0 @V4085A8 02197000
USING *,R12 @V4085A8 02198000
DMSKEY NUCLEUS RUN WITH SUPERVISOR PROTECT KEY. @V4085A8 02199000
LM R4,R5,PROGOPSW SAVE OLD PROGRAM CHECK PSW. @V4085A8 02200000
LM R6,R7,PROGNPSW SAVE NEW PROGRAM CHECK PSW. @V4085A8 02201000
LA R2,PCHKHNDL @V4085A8 02202000
ST R2,PROGNPSW+4 ALTER NEW PROGRAM CHECK PSW TO @V4085A8 02203000
* GIVE US CONTROL. 02204000
SR R2,R2 USE R2 AS A FLAG: 1 = PROG CHECK, @V4085A8 02205000
* 0 = NO PROG CHECK. 02206000
DC X'8310001C' DIAGNOSE TO PERFORM ERASE. IF THE @V4085A8 02207000
* USER IS NOT IN PRIVILEGE CLASS F, VM/370 02208000
* WILL REFLECT BACK A PRIVILEGED OPERATION 02209000
* PROGRAM CHECK. AND WE HAVE ALTERED THE 02210000
* NEW PROGRAM CHECK PSW TO GO TO 'PCHKHNDL' 02211000
* IN THAT CASE, BEFORE CONTINUING ON HERE. 02212000
* OTHERWISE, (WHEN USER HAS CLASS F) CONTROL DROPS STRAIGHT THRU 02213000
STM R4,R5,PROGOPSW RESTORE OLD PROG CHECK PSW TO @V4085A8 02214000
* NORMAL VALUE. 02215000
STM R6,R7,PROGNPSW RESTORE NEW PROG CHECK PSW TO @V4085A8 02216000
* NORMAL VALUE. 02217000
DMSKEY RESET CHANGE BACK TO 'USER' PROTECT KEY. @V4085A8 02218000
* NOW TEST THE FLAG IN R2 TO DECIDE WHICH MESSAGE TO ISSUE. 02219000
BCT R2,CLROKAY BRANCH IF FLAG=0. @V4085A8 02220000
* FALL THRU IF FLAG=1. PROG CHECK OCCURRED BECAUSE USER WAS 02221000
* NOT CLASS F. 02222000
DMSERR NUM=829,LET=W,TEXT='ATTEMPTED ''ZERO'' WAS SUPPRESSED. X02223000
REQUIRES PRIVILEGE CLASS F',RENT=NO @V4085A8 02224000
LA R15,RC88 SET ERROR RETURN CODE. @V4085A8 02225000
B CLREXIT @V4085A8 02226000
SPACE 02227000
CLROKAY DMSERR NUM=828,LET=I,TEXT='CPEREP ZERO OR CLEAR HAS BEEN COMPLX02228000
ETED',RENT=NO @V4085A8 02229000
SR R15,R15 NORMAL RETURN CODE. @V4085A8 02230000
CLREXIT L R14,SAVER14(0,R13) @V4085A8 02231000
LM R0,R12,SAVER0(R13) @V4085A8 02232000
BR R14 @V4085A8 02233000
DROP R12 @V4085A8 02234000
SPACE 3 02235000
PCHKHNDL LA R2,1 SET R2 FLAG: 1 INDICATES PROGRAM CHECK @V4085A8 02236000
* OCCURRED. 02237000
LPSW PROGOPSW RETURN TO INSTRUCTION FOLLOWING THE @V4085A8 02238000
* DIAGNOSE THAT PROGRAM CHECKED. 02239000
EJECT 02240000
*********************************************************************** 02241000
*. 02242000
* SUBROUTINE NAME - DMSIFC18 02243000
* 02244000
* FUNCTION - 02245000
* HANDLES TRAPPED OS BLDL MACROS ISSUED BY OS/VS EREP. 02246000
* BLDL ISSUES SVC 18 WHICH IS TRAPPED VIA CMS HNDSVC MACRO 02247000
* ISSUED EARLIER. CMS SUPPORTS MOST FUNCTIONS OF OS BLDL, BUT 02248000
* NOT THE FUNCTION WHERE BLDL IS ISSUED WITH R1 CONTAINING 02249000
* ZERO WHICH INDICATES OS JOBLIB/STEPLIB PROCESSING IS 02250000
* WANTED. SINCE OS/VS EREP ATTEMPTS TO USE THIS FUNCTION 02251000
* WHICH IS NOT SUPPORTED BY CMS, WE HAVE TO TRAP THE BLDL 02252000
* OURSELVES AND SIMULATE IT. 02253000
* 02254000
* WHEN OS JOBLIB/STEPLIB PROCESSING IS REQUESTED, AN OS 02255000
* PROGRAM IS USING BLDL TO SEARCH THE DIRECTORY OF A PDS(S) 02256000
* CONTAINING OS LOAD MODULES. THE ANALOGOUS SITUATION HERE IN 02257000
* CMS IS TO SEARCH THE DIRECTORY(S) OF ANY GLOBAL TXTLIB(S) 02258000
* FOR THE DESIRED OBJECT MODULE AND THAT IS WHAT OUR SIMULATION 02259000
* DOES. 02260000
* 02261000
* ATTRIBUTES - 02262000
* SERIALLY REUSABLE, CMS USER AREA, ENTERED VIA HNDSVC TRAPPING. 02263000
* 02264000
* ENTRY CONDITIONS - 02265000
* R0 = ADDRESS OF BLDL'S LIST. 02266000
* R13 = ADDRESS OF AN EMPTY 72 BYTE SAVE AREA. 02267000
* R14 = RETURN ADDRESS (TO DMSITS). 02268000
* 02269000
* EXIT CONDITIONS - 02270000
* R0-R15 = RESTORED. 02271000
* 02272000
* CALLS TO OTHER ROUTINES - NONE. 02273000
* 02274000
* EXTERNAL REFERENCES - NONE. 02275000
* 02276000
* TABLES/WORK AREAS - NONE. 02277000
* 02278000
* MACROS - DMSKEY, DMSERR. 02279000
* 02280000
* REGISTER USAGE - 02281000
* R0-R9 = SCRATCH. 02282000
* R10-R11 = SPARES, NOT PRESENTLY USED. 02283000
* R12 = BASE REGISTER. 02284000
* R13 = SAVE AREA. 02285000
* R14-R15 = SCRATCH. 02286000
* 02287000
* NOTES - NONE. 02288000
* 02289000
* OPERATION - 02290000
* 02291000
* OS/VS EREP ISSUES THE BLDL WITH A VALUE OF 0 IN R1 TO 02292000
* INDICATE JOBLIB/STEPLIB PROCESSING WHICH CMS DOES NOT 02293000
* SIMULATE. THEREFORE WE MUST SIMULATE THE BLDL HERE. THE 02294000
* OUTPUT OF OUR SIMULATION IS SIMPLY A RETURN CODE PASSED BACK 02295000
* TO BLDL IN R15; THE TTR FIELD IN THE BLDL'S LIST WHICH (UNDER 02296000
* OS) IS NORMALLY FILLED IN IS NOT FILLED IN HERE BECAUSE WE 02297000
* KNOW EREP WILL IGNORE IT ANYWAY. (NOTE: EREP ONLY USES 02298000
* BLDL TO TEST DEVICE NAMES (BY CREATING CORRESPONDING 02299000
* ROUTINE NAMES) TO SEE IF THE DEVICES ARE KNOWN OR UNKNOWN.) 02300000
* 02301000
* CONTROL IS RECEIVED FROM OS/VS EREP THROUGH DMSITS WITH 02302000
* R0 POINTING TO THE BLDL LIST CONTAINING THE 8 CHARACTER 02303000
* MODULE NAME THAT WILL BE SEARCHED FOR; THE OTHER REGISTERS 02304000
* CONTAIN A MIXTURE OF EREP AND DMSITS VALUES. R14 HAS THE 02305000
* RETURN ADDRESS TO DMSITS. 02306000
* 02307000
* THE PROCESSING OF THE BLDL REQUEST IS PERFORMED AS FOLLOWS: 02308000
* 1. REGISTERS ARE SAVED AND ADDRESSABILITY FOR THIS ROUTINE 02309000
* IS ESTABLISHED. 02310000
* 2. REGISTERS 7 AND 8 ARE LOADED WITH THE MODULE NAME 02311000
* FOR USE IN LATER COMPARES. 02312000
* 3. BY LOADING R6 FROM TXTDIRC IN THE NUCON, R6 IS 02313000
* INITIALIZED TO POINT TO THE HEADER (DESCRIBED BY 02314000
* TXTDSECT DSECT) OF THE FIRST TXTLIB ON THE CHAIN OF 02315000
* GLOBALED TXTLIBS. BUT IF THERE ARE NO GLOBAL TXTLIBS 02316000
* (R6=0) THEN AN ERROR MESSAGE IS ISUED AND THE BLDL 02317000
* IS SIMULATED AS A MEMBER-NOT-FOUND. 02318000
* 4. THE DIRECTORY OF THE CURRENT GLOBAL TXTLIB IS 02319000
* SEARCHED FOR THE MEMBER NAME SPECIFIED BY THE BLDL. 02320000
* THIS IS DONE BY THE LOOP WHICH BEGINS WITH THE LABEL 02321000
* 'BLOOPENT'. EACH TIME THRU THIS LOOP ONE ENTRY IN THE 02322000
* DIRECTORY IS CHECKED. (THE MODNAME DSECT DESCRIBES 02323000
* A DIRECTORY ENTRY.) THE LOOP ENDS WHEN THE DESIRED 02324000
* MEMBER ENTRY IS LOCATED OR WHEN 'NXTAVAIL' (THE START 02325000
* OF UNUSED ENTRIES) IS REACHED. 02326000
* 5. IF THE DESIRED MEMBER IS LOCATED, THE BLDL IS 02327000
* SIMULATED BY SIMPLY PASSING BACK A RETURN CODE OF 0 02328000
* TO THE BLDL IN R15. NOTHING ELSE IS DONE; NO DATA IS 02329000
* INSERTED IN THE LIST OF THE BLDL (NORMALLY TTR DATA 02330000
* IS WANTED, BUT WE KNOW THAT EREP ONLY WANTS THE RETURN 02331000
* CODE IN R15). 02332000
* 6. IF THE DESIRED MEMBER ENTRY WAS NOT FOUND IN THE LOOP 02333000
* IN 4. ABOVE, WE ADVANCE TO THE NEXT GLOBAL TXTLIB IN 02334000
* THE CHAIN OF GLOBAL TXTLIBS AND GO BACK TO THE LOGIC 02335000
* AT 4. BUT IF THERE IS NOT ANOTHER GLOBAL TXTLIB, 02336000
* THEN GO TO 7. 02337000
* 7. ALL GLOBAL TXTLIBS WERE SEARCHED AND THE MEMBER 02338000
* REQUESTED BY BLDL WAS NOT FOUND. SO WE SIMULATE A 02339000
* MEMBER-NOT-FOUND RESPONSE TO THE BLDL. THIS CONSISTS 02340000
* OF RETURNING A RETURN CODE OF 4 TO BLDL IN R15 AND OF 02341000
* PLACING A ZERO IN THE R BYTE OF THE TTR FIELD OF THE 02342000
* BLDL LIST. 02343000
* 8. THE R15 RETURN CODE IS SENT BACK TO BLDL AS FOLLOWS: 02344000
* THE CURRSAVE FIELD IN THE NUCON POINTS TO THE CURRENT 02345000
* SYSTEM SAVE AREA (DESCRIBED BY THE SSAVE DSECT). THIS 02346000
* CONTAINS THE REGISTER CONTENTS AS THEY EXISTED WHEN 02347000
* THE BLDL SVC WAS EXECUTED AND THE REGISTERS WILL BE 02348000
* RESTORED FROM THIS SAVE AREA BY DMSITS WHEN IT 02349000
* RETURNS TO THE BLDL. SO WE MODIFY R15 IN THIS SYSTEM 02350000
* SAVE AREA. 02351000
* 02352000
* RESPONSES - NONE. 02353000
* 02354000
* ERROR MESSAGES - 02355000
* DMSIFC826E R15 RETURN CODE = 56 02356000
*. 02357000
*********************************************************************** 02358000
DMSIFC18 STM R14,R12,SAVER14(R13) SAVE R14 AT LEAST. DMSITS@V4085A8 02359000
* PROVIDES THE SAVE AREA. 02360000
BALR R12,0 @V4085A8 02361000
USING *,R12 @V4085A8 02362000
USING NUCON,0 MAKE LOW CORE AREA ADDRESSABLE. @V4085A8 02363000
L R2,CURRSAVE GET ADDR OF CURRENT SYSTEM SAVE @V4085A8 02364000
* AREA BEFORE ANOTHER SVC CHANGES IT. 02365000
USING SSAVE,R2 @V4085A8 02366000
LR R9,R0 SAVE ADDR OF BLDL LIST THAT BLDL PUT @V4085A8 02367000
* IN R0. 02368000
USING BLDLIST,R9 @V4085A8 02369000
LM R7,R8,BLDLNAM PUT 8 CHAR NAME INTO TWO REGS. @V4085A8 02370000
L R6,TXTDIRC GET POINTER TO 1ST LIBRARY. @V4085A8 02371000
LTR R6,R6 ARE ANY TXTLIBS GLOBALED IN? @V4085A8 02372000
BZ BLDNOFND NO. GO SIMULATE AS MEMBER-NOT-FOUND. @V4085A8 02373000
USING TXTDSECT,R6 @V4085A8 02374000
BLOOPLIB L R3,ENTRY1 BXH INDEX: ADDR 1ST ENTRY OF LIB. @V4085A8 02375000
L R4,LENTRY BXH INCR: LENGTH OF AN ENTRY. @V4085A8 02376000
L R5,NXTAVAIL BXH COMPARAND: ADDR 1ST UNUSED @V4085A8 02377000
* ENTRY OF LIB. 02378000
SR R3,R4 BACK UP ONE ENTRY SINCE BXH WILL @V4085A8 02379000
* INITIALLY ADVANCE ONE. 02380000
SR R5,R4 BACK COMPARAND UP BY ONE ENTRY BECAUSE @V4085A8 02381000
* WE HAVE ONLY BXH, NOT BXHE. 02382000
BLOOPENT BXH R3,R4,BLDNXTLB BRANCH IF NO MORE ENTRIES IN @V4085A8 02383000
* THIS LIB. 02384000
USING MODNAME,R3 DSECT FOR ENTRY IN LIB DIRECTORY. @V4085A8 02385000
CL R8,NMELST4 COMPARE LAST 4 CHARS OF REQUESTED @V4085A8 02386000
* MEMBER (IN R8) WITH LAST 4 CHARS IN 02387000
* PRESENT ENTRY. 02388000
BNE BLOOPENT NO MATCH, GO TRY NEXT ENTRY. @V4085A8 02389000
CL R7,NME1ST4 LAST 4 MATCHED. HOW ABOUT 1ST 4? @V4085A8 02390000
BNE BLOOPENT NO MATCH, GO TRY NEXT ENTRY. @V4085A8 02391000
DROP R3 @V4085A8 02392000
* FALL THRU INDICATES WE FOUND A MATCH. 02393000
SR R3,R3 RETURN CODE 0 FOR SIMULATED BLDL. @V4085A8 02394000
B BLDEXIT @V4085A8 02395000
SPACE 02396000
BLDNXTLB DS 0H DID NOT FIND IT IN CURRENT LIB. TRY NEXT @V4085A8 02397000
* LIB IN CHAIN. 02398000
L R6,NXTLIB GET POINTER TO NEXT TXTLIB. @V4085A8 02399000
LTR R6,R6 TEST POINTER FOR 0 (END OF CHAIN). @V4085A8 02400000
BNZ BLOOPLIB IF WE HAVE ANOTHER LIB, GO SEARCH IT. @V4085A8 02401000
DROP R6 @V4085A8 02402000
* FALL THRU INDICATES REQUESTED MEMBER NOT FOUND IN ANY 02403000
* GLOBALED TXTLIB. 02404000
BLDNOFND LA R3,RC4 RETURN CODE 4 FOR SIMULATED BLDL R15. @V4085A8 02405000
MVI BLDLTTR+2,X'00' 0 IN R OF TTR INDICATES MEMBER @V4085A8 02406000
* NOT FOUND. 02407000
DROP R9 ADDR OF BLDL LIST. @V4085A8 02408000
SPACE 02409000
BLDEXIT DMSKEY NUCLEUS SET KEY FOR STORING RETURN CODE IN R15@V4085A8 02410000
* OF BLDL SAVE AREA. 02411000
ST R3,EGPR15 SIMULATED CODE TO BE RETURNED TO BLDL@V4085A8 02412000
DROP R2 @V4085A8 02413000
DMSKEY RESET @V4085A8 02414000
LM R14,R12,SAVER14(R13) @V4085A8 02415000
DROP R12 @V4085A8 02416000
BR R14 @V4085A8 02417000
EJECT 02418000
*********************************************************************** 02419000
*. 02420000
* SUBROUTINE NAME - DMSIFC76 02421000
* 02422000
* FUNCTION - 02423000
* IT IS DOUBTFUL IF THIS SUBROUTINE HAS ANY FUNCTION AT ALL. 02424000
* IT IS INCLUDED HERE AS A NO-OP (I.E., BR R14) BECAUSE IT 02425000
* ALSO APPEARED IN THE EARLIER VERSION (AS A NO-OP THERE ALSO). 02426000
* THE PURPOSE, AT SOME TIME IN THE PAST, MAY HAVE BEEN 02427000
* TO PREVENT ADDITIONAL ERROR RECORDS FROM BEING PUT INTO THE 02428000
* ERROR RECORDING CYLINDERS ONCE CPEREP BEGAN PROCESSING THE 02429000
* RECORDS. HOWEVER IT IS DIFFICULT TO UNDERSTAND HOW 02430000
* INTERCEPTING SVC 76 AND NO-OPING IT COULD HAVE ACCOMPLISHED 02431000
* THIS. FOR ONE THING, HNDSVC'S TRAPPING OF SVC 76 WOULD 02432000
* ONLY INTERCEPT SVC 76 ISSUED FROM THE VIRTUAL MACHINE IN 02433000
* WHICH CPEREP WAS RUNNING. SVC 76 FROM OTHER VIRTUAL 02434000
* MACHINES WOULD STILL CAUSE NEW ENTRIES IN THE ERROR RECORDING 02435000
* CYLINDERS. FOR ANOTHER THING, IT IS DOUBTFUL IF THE 02436000
* HNDSVC WILL EVER SUCCEED IN TRAPPING ANY SVC 76'S BECAUSE 02437000
* VM TRAPS THEM BEFORE CMS AND DOES NOT SHOW THEM TO CMS. 02438000
* AN OPERATING SYSTEM IN A REAL MACHINE CAN SEND ITSELF ERROR 02439000
* RECORDS VIA SVC 76, BUT IN A VM VIRTUAL MACHINE, VM TRAPS 02440000
* THE SVC AND KEEPS THE ERROR RECORD FOR ITS OWN ERROR 02441000
* RECORDING CYLINDERS. 02442000
* 02443000
* ANOTHER POSSIBLE EXPLANATION FOR THE EXISTENCE OF THIS NO-OP 02444000
* ROUTINE IS THAT IN THE EVENT THAT CMS (OR OS/VS EREP RUNNING 02445000
* UNDER CMS) ISSUES SVC 76 AND SENDS BAD PARAMETERS ALONG WITH 02446000
* THE SVC THEN, BECAUSE OF THE BAD PARAMETERS, VM MIGHT REFLECT 02447000
* THE SVC BACK UP TO CMS INSTEAD OF HIDING IT. SO IN THIS CASE 02448000
* THE EXISTENCE OF THE NO-OP IS JUSTIFIED. 02449000
*. 02450000
*********************************************************************** 02451000
SPACE 02452000
DMSIFC76 BR R14 THIS ROUTINE IS IN EFFECT A NO-OP. @V4085A8 02453000
EJECT 02454000
*********************************************************************** 02455000
*. 02456000
* SUBROUTINE NAME - DMSIFC0 02457000
* 02458000
* FUNCTION - 02459000
* HANDLE TRAPPED EXCP'S (SVC 0). 02460000
* OS/VS EREP USES EXCP TO ACCESS THE SYS1.LOGREC DATA SET. THIS 02461000
* ROUTINE SIMULATES EXCP TO OS SYS1.LOGREC BY READING DATA 02462000
* FROM THE VM/370 ERROR RECORDING CYLINDERS AND PASSING IT 02463000
* BACK THRU THE EXCP AS IF IT CAME FROM A SYS1.LOGREC DATA SET. 02464000
* 02465000
* ATTRIBUTES - 02466000
* NON-REUSABLE, CMS USER AREA, ENTERED VIA HNDSVC MACRO. 02467000
* 02468000
* ENTRY CONDITIONS - 02469000
* SYSTEM MASK ENABLED, USER PROTECT KEY, SUPERVISOR STATE 02470000
* (CHANGED TO PROBLEM STATE SOON AFTER ENTRY). 02471000
* R0-R11 - SAME AS WHEN SVC WAS EXECUTED (R1 = ADDRESS OF 02472000
* THE OS IOB). 02473000
* R12 - ADDRESS OF THE CALLING SVC. 02474000
* R13 - ADDRESS OF AN EMPTY SAVE AREA TO BE USED BY THIS ROUTINE 02475000
* R14 - RETURN ADDRESS (TO DMSITS). 02476000
* R15 - SAME AS WHEN SVC WAS EXECUTED. 02477000
* CURRSAVE - THIS FIELD IN THE NUCON POINTS TO THE CURRENT 02478000
* SYSTEM SAVE AREA (DESCRIBED BY THE SSAVE DSECT). 02479000
* THIS CONTAINS THE REGISTER CONTENTS AS THEY 02480000
* EXISTED WHEN THE BLDL SVC WAS EXECUTED AND THESE 02481000
* CONTENTS WILL BE RESTORED BY DMSITS WHEN IT RETURNS 02482000
* TO THE SVC. 02483000
* 02484000
* EXIT CONDITIONS - 02485000
* R0-R15 - RESTORED TO ENTRY VALUES. HOWEVER DMSITS RESTORES 02486000
* ANOTHER LEVEL FROM A SYSTEM SAVE AREA BEFORE 02487000
* TRANSFERING CONTROL BACK TO THE BLDL AND R15 IN THAT 02488000
* SAVE AREA HAS THE SIMULATED RETURN CODE IN R15 TO 02489000
* BE RETURNED TO THE BLDL. 02490000
* 02491000
* CALLS TO OTHER ROUTINES - DMSREA 02492000
* 02493000
* EXTERNAL REFERENCES - NONE 02494000
* 02495000
* TABLES/WORK AREAS - 02496000
* 02497000
* MACROS - DMSERR 02498000
* 02499000
* REGISTER USAGE - 02500000
* R0-R9 - SCRATCH. 02501000
* R10-R11 - SPARES, NOT PRESENTLY USED. 02502000
* R12 - BASE REGISTER. 02503000
* R13 - SAVE AREA ADDRESS. 02504000
* R14-R15 - SCRATCH. 02505000
* 02506000
* NOTES - NONE 02507000
* 02508000
* OPERATION - SEE BELOW. 02509000
* 02510000
* RESPONSES - NONE 02511000
* 02512000
* ERROR MESSAGES - DMSIFC832S, R15 RETURN CODE = 104. 02513000
* 02514000
*********************************************************************** 02515000
* 02516000
* THE CHANNEL PROGRAM AND ITS FUNCTIONS 02517000
* 02518000
* OS/VS EREP USES EXCP (SVC 0) TO ACCESS THE SYS1.LOGREC 02519000
* DATA SET. OS/VS EREP CONTAINS ONLY ONE EXCP (LOCATED NEAR 02520000
* THE EXCPLOOP LABEL IN IFCIOHND) AND THAT EXCP USES JUST ONE 02521000
* CHANNEL PROGRAM. THE CHANNEL PROGRAM CONTAINS JUST THREE 02522000
* COMMANDS: (1) SEARCH ID EQUAL; (2) TIC *-8; (3) READ OR WRITE 02523000
* COMMAND (OPCODE GETS MODIFIED). 02524000
* 02525000
* CODE EXISTS IN IFCIOHND TO USE THE CHANNEL PROGRAM TO PERFORM 02526000
* ANY OF FOUR DIFFERENT FUNCTIONS. THE OPCODE STORED IN THE 02527000
* READ/WRITE COMMAND (THE THIRD COMMAND) VARIES ACCORDING TO 02528000
* THE FUNCTION THAT IS TO BE PERFORMED: 02529000
* (1) READ HEADER RECORD OF SYS1.LOGREC. 02530000
* OPCODE: X'06' = READ DATA 02531000
* (2) WRITE HEADER RECORD OF SYS1.LOGREC. 02532000
* OPCODE: X'05' = WRITE DATA 02533000
* (3) READ THE NEXT RECORD THAT FOLLOWS THE RECORD WHOSE 02534000
* ADDRESS (ID) IS SPECIFIED. 02535000
* OPCODE: X'9E' = READ COUNT KEY AND DATA 02536000
* (4) ZERO OUT AN ARBITRARY RECORD IN THE FILE. 02537000
* OPCODE: X'05' = WRITE DATA 02538000
* THE FOURTH FUNCTION IS NO LONGER USED ANYWHERE IN EREP, SO 02539000
* ONLY THE FIRST THREE FUNCTIONS MUST BE SIMULATED. EACH OF 02540000
* THESE THREE FUNCTIONS HAS A UNIQUE OPCODE IN THE READ/WRITE 02541000
* COMMAND AND THIS WILL BE USED TO DETERMINE WHICH FUNCTION 02542000
* IS TO BE SIMULATED WHENEVER AN EXCP IS TRAPPED. 02543000
* 02544000
* MANIPULATION OF MBBCCHHR ADDRESSES BY OS/VS EREP 02545000
* 02546000
* OS/VS EREP USES ABSOLUTE RECORD ADDRESSES (MBBCCHHR FORMAT) 02547000
* TO ACCESS THE SYS1.LOGREC DATA SET, NOT ONLY BECAUSE EXCP 02548000
* IS USED, BUT ALSO BECAUSE OS/VS MAINTAINS SEVERAL ABSOLUTE 02549000
* ADDRESSES IN THE SYS1.LOGREC HEADER RECORD. 02550000
* 02551000
* EREP'S MANIPULATION OF MBBCCHHR ADDRESSES IS MINIMAL. TO 02552000
* READ OR WRITE THE SYS1.LOGREC HEADER RECORD, EREP SETS M 02553000
* TO X'00', SETS R TO X'01', AND TAKES BBCCHH FROM THE DEB 02554000
* (DATA EXTENT BLOCK) WHICH IS POINTED TO BY A FIELD OF THE 02555000
* DCB. RECORDS OTHER THAN THE HEADER ARE ONLY READ, NEVER 02556000
* WRITTEN. EREP READS THRU THESE ERROR DATA RECORDS ONCE 02557000
* SEQUENTIALLY AND THEN (SOMETIMES) IT GOES BACK AND READS 02558000
* THEM RANDOMLY. THE ADDRESS (BBCCHHR) OF THE FIRST OF THE 02559000
* ERROR RECORDS IS FOUND IN THE HEADER RECORD, SO INITIALLY 02560000
* EREP READS THE HEADER AND GETS THIS ADDRESS. EREP THEN STARTS 02561000
* WITH THIS ADDRESS WHEN IT READS ERROR RECORDS SEQUENTIALLY. 02562000
* BECAUSE OF THE NATURE OF THE CHANNEL PROGRAM USED TO READ 02563000
* THE ERROR RECORDS, EREP NEVER HAS TO INCREMENT THE BBCCHHR 02564000
* ADDRESS WHEN IT READS THRU THE ERROR RECORDS SEQUENTIALLY. 02565000
* THE SEARCH COMMAND LOCATES THE RECORD SPECIFIED BY BBCCHHR, 02566000
* BUT BECAUSE THE READ OPCODE IS X'9E' (READ COUNT KEY AND 02567000
* DATA WITH MULTIPLE TRACK OPERATION), THE NEXT RECORD IS 02568000
* READ RATHER THAN THE ONE WHOSE ADDRESS WAS SEARCHED FOR. 02569000
* (SINCE X'9E' READS THE COUNT WHICH ALREADY PASSED UNDER 02570000
* THE HEAD FOR THE SEARCH COMMAND, IT IS TOO LATE TO READ THE 02571000
* CURRENT RECORD, SO IT READS THE NEXT ONE.) AND SINCE IT READS 02572000
* THE COUNT FIELD (CONTAINING CCHHR) OF THIS NEXT RECORD, IT 02573000
* CONVENIENTLY RETURNS THE CCHHR ADDRESS 02574000
* OF THIS NEW RECORD. THUS IN SEQUENTIAL 02575000
* READING, THE RECORD READ IS ALWAYS ONE BEYOND THE ADDRESS 02576000
* SPECIFIED AND EACH READ RETURNS THE CCHHR ADDRESS TO BE USED 02577000
* FOR THE NEXT READ. 02578000
* 02579000
* THE END OF FILE DETECTION DURING THE SEQUENTIAL READING IS 02580000
* NOT VIA A TRUE EOF. INSTEAD, EREP COMPARES THE ADDRESS OF 02581000
* THE LAST ERROR RECORD WRITTEN (AN ADDRESS FOUND 02582000
* IN THE SYS1.LOGREC HEADER RECORD) 02583000
* WITH THE CCHHR ABOUT TO BE USED TO READ THE NEXT RECORD. IF 02584000
* THEY ARE EQUAL THEN THERE IS NO NEXT RECORD. 02585000
* 02586000
* AFTER EOF HAS BEEN DETECTED DURING THE SEQUENTIAL READ OF 02587000
* ERROR RECORDS, EREP WILL EXAMINE THE HEADER RECORD TO SEE IF 02588000
* FRAME RECORDS ARE PRESENT IN SYS1.LOGREC. IF SO, EREP READS 02589000
* THROUGH THE FRAME RECORDS SEQUENTIALLY. THE STARTING ADDRESS 02590000
* FOR THE SEQUENTIAL READ OF THE FRAME RECORDS WILL BE M OF 02591000
* X'00', BBCCHH THE SAME AS THAT USED TO READ THE HEADER 02592000
* RECORD, AND R = X'02'. (THIS IS THE ADDRESS OF THE TIMESTAMP 02593000
* RECORD ON SYS1.LOGREC. NOTE THAT THE ADDRESS IS ONE RECORD 02594000
* BEFORE THE RECORD THAT IS ACTUALLY DESIRED.) THE ENDING ADDRES 02595000
* FOR THIS SEQUENTIAL READ IS THE ADDRESS OF THE FIRST ERROR 02596000
* RECORD FOUND IN THE HEADER. 02597000
* 02598000
* WHEN ERROR (AND POSSIBLY FRAME) RECORDS ARE READ RANDOMLY, 02599000
* (AFTER HAVING BEEN READ ONCE SEQUENTIALLY), THE EXCP USES 02600000
* THE SAME CHANNEL PROGRAM AND READ COMMAND (X'9E'). AND SO 02601000
* ONCE AGAIN, THE CCHHR ADDRESS USED MUST BE THE ADDRESS 02602000
* OF THE RECORD PRIOR TO THE RECORD THAT IS ACTUALLY WANTED. 02603000
* THE ADDRESSES THAT EREP USES DURING THE RANDOM READING 02604000
* ARE ADDRESSES THAT IT STORED IN A TABLE DURING THE 02605000
* SEQUENTIAL READING. NOW, WITH EVERY READ, WHETHER RANDOM OR 02606000
* SEQUENTIAL, THERE ARE TWO CCHHR ADDRESSES INVOLVED. 02607000
* FIRST, THERE IS THE ADDRESS OF THE PRIOR RECORD, USED 02608000
* FOR THE SEARCH, AND SECOND, THERE IS THE ADDRESS OF THE 02609000
* CURRENT RECORD, THAT IS READ FROM THE COUNT FIELD. 02610000
* WHEN EREP DOES RANDOM READING IT COULD USE THE FIRST 02611000
* ADDRESS AS A SEARCH ADDRESS, THE SAME AS IT DID DURING 02612000
* THE SEQUENTIAL READING, BUT IT DOESN'T. INSTEAD IT USES 02613000
* THE SECOND ADDRESS, THE ONE FROM THE COUNT FIELD OF THE 02614000
* RECORD ACTUALLY READ. THIS SECOND ADDRESS IS THE ONE 02615000
* THAT EREP SAVES IN A TABLE DURING THE SEQUENTIAL READING. 02616000
* BUT SINCE THIS IS THE ADDRESS OF THE DESIRED RECORD (AND 02617000
* NOT THE ADDRESS OF THE PRECEEDING RECORD AS REQUIRED BY 02618000
* THE CHANNEL PROGRAM), EREP HAS TO MODIFY THE ADDRESSES 02619000
* THAT IT PULLS OUT OF THE TABLE BEFORE IT CAN USE THEM IN 02620000
* THE CHANNEL PROGRAM. THIS MODIFICATION CONSISTS SIMPLY 02621000
* OF SUBTRACTING ONE FROM THE R FIELD OF CCHHR. SINCE THE 02622000
* DATA RECORDS ARE NUMBERED 1 THRU N, THE DECREMENTED VALUE 02623000
* OF R HAS THE RANGE 0 THRU (N-1). SEARCHING FOR A RECORD 0 02624000
* WHEN READING DATA RECORD 1 IS NO PROBLEM, BECAUSE EACH 02625000
* TRACK HAS A (NON-DATA) RECORD 0 WHICH IS THE STANDARD 02626000
* 8 BYTE TRACK CAPACITY RECORD (R0). (NOTE: THE DISTINCTION 02627000
* BETWEEN EREP'S USE OF 'SECOND' RATHER THAN 'FIRST' RECORD 02628000
* ADDRESSES IS EXPLAINED HERE BECAUSE WE WILL SEE LATER 02629000
* THAT IT MAKES A DIFFERENCE IN THE WAY WE DEAL WITH I/O 02630000
* ERRORS WE ENCOUNTER WHEN READING FROM THE VM/370 ERROR 02631000
* RECORDING CYLINDERS IN THE PROCESS OF SIMULATING THE 02632000
* EREP EXCP'S RANDOM READING.) 02633000
* 02634000
* SIMULATION OF THE EXCP IN GENERAL 02635000
* 02636000
* THE SYS1.LOGREC DATA SET WILL BE FILEDEF'ED AS A DUMMY AND 02637000
* THE OPEN AND THE CLOSE OF THE DATA SET WILL BE ALLOWED TO 02638000
* EXECUTE AS USUAL WITHOUT INTERCEPTION. EXCP WILL BE TRAPPED. 02639000
* WAIT WILL BE EXECUTED NORMALLY AND WILL FALL STRAIGHT THRU 02640000
* BECAUSE THE ECB WILL BE POSTED COMPLETE EACH TIME EXCP IS 02641000
* SIMULATED. A SIMULATED SYS1.LOGREC HEADER RECORD (RECORD 1) 02642000
* WILL BE MAINTAINED (IT IS DESCRIBED BY THE HDRLOGRC DSECT). 02643000
* A SIMULATED TIME STAMP RECORD (RECORD 2) WILL NOT BE 02644000
* NECESSARY SINCE EREP DOES NOT READ IT. EACH TIME AN EXCP 02645000
* IS INTERCEPTED, THE OPCODE OF THE READ/WRITE COMMAND OF THE 02646000
* CHANNEL PROGRAM IS EXAMINED TO DETERMINE WHAT FUNCTION IS TO 02647000
* BE PERFORMED. 02648000
* 02649000
* SIMULATION OF A READ OF THE HEADER RECORD 02650000
* 02651000
* THE FIRST TRAPPED EXCP SHOULD TURN OUT TO BE A READ OF THE 02652000
* HEADER RECORD. FIELDS IN THE SIMULATED HEADER RECORD WILL 02653000
* BE INITIALIZED THIS FIRST TIME, THEN A COPY OF IT WILL BE 02654000
* RETURNED TO THE CHANNEL PROGRAM'S I/O BUFFER. FOR 02655000
* SUBSEQUENT READS OF THE HEADER NO INITIALIZATION WILL BE 02656000
* NECESSARY. INITIALIZATION OF THE SIMULATED HEADER RECORD 02657000
* REQUIRES A CALL TO DMSREA TO READ THE FIRST ERROR RECORD 02658000
* FROM THE VM/370 ERROR RECORDING CYLINDERS BECAUSE: IF THE 02659000
* ATTEMPT TO READ THE FIRST ERROR RECORD SHOWS 02660000
* THAT THE ERROR CYLINDERS ARE EMPTY, THEN THE 02661000
* 'HDRLAST' FIELD OF THE SIMULATED HEADER RECORD WILL HAVE TO 02662000
* BE SET TO THE SAME VALUE AS IS IN THE 'HDRSTART' FIELD SO 02663000
* THAT THE SIMULATED SYS1.LOGREC APPEARS EMPTY IF EREP LOOKS 02664000
* AT THE HEADER. (NOTE: ACTUALLY IT APPEARS THAT EREP WILL 02665000
* NOT BOTHER COMPARING THESE TWO FIELDS WHEN IT FIRST READS 02666000
* THE HEADER AND SO IT WILL NOT FIND OUT THAT SYS1.LOGREC IS 02667000
* EMPTY UNTIL JUST BEFORE IT IS READY TO ATTEMPT 02668000
* THE FIRST SEQUENTIAL READ. NEVERTHELESS, WE 02669000
* WILL CALL DMSREA FOR THE FIRST READ NOW 02670000
* ANYWAY SINCE: (1) THE SIMULATION IS MORE REALISTIC AND IT 02671000
* MIGHT BE NECESSARY IF EREP GETS MODIFIED IN THE FUTURE; 02672000
* (2) WE HAVE TO CALL DMSREA ONCE BEFORE THE FIRST SEQUENTIAL 02673000
* READ ANYWAY AS WE HAVE TO ALWAYS BE ONE RECORD AHEAD (THIS 02674000
* IS EXPLAINED UNDER 'SIMULATION OF SEQUENTIAL READS OF ERROR 02675000
* RECORDS'). 02676000
* 02677000
* IF THE ATTEMPT TO READ THE FIRST ERROR RECORD SHOWS THAT 02678000
* ERROR RECORDS ARE PRESENT, THEN THE 'HDRLAST' FIELD OF 02679000
* THE SIMULATED HEADER RECORD WILL BE SET TO THE ADDRESS OF 02680000
* THE LAST OF THE ERROR RECORDS. BUT THE LAST RECORD IS 02681000
* UNKNOWN AT THIS POINT, SO AN ARBITRARY HIGH ADDRESS 02682000
* (ALL X'FF') WILL BE PUT IN 'HDRLAST'. THEN LATER THE 02683000
* ACTUAL LAST RECORD WILL BE SIMULATED AS IF ITS ADDRESS 02684000
* IS ALL X'FF'. 02685000
* 02686000
* SIMULATION OF A WRITE OF THE HEADER RECORD 02687000
* 02688000
* WHEN A WRITE OF THE HEADER RECORD IS DETECTED, THE EXCP'S 02689000
* WRITE BUFFER WILL BE LOCATED AND THE DATA IN IT (A REVISED 02690000
* HEADER BUILT BY EREP) WILL BE COPIED INTO THE SIMULATED 02691000
* HEADER. BEFORE COPYING IT THOUGH (I.E., WHILE WE STILL 02692000
* HAVE THE OLD HEADER), THE NEW HEADER WILL BE CHECKED TO SEE 02693000
* IF EREP IS ATTEMPTING TO ZERO SYS1.LOGREC (BY RESETTING THE 02694000
* 'HDRLAST' FIELD IN THE NEW HEADER). IF 'HDRLAST' IN THE 02695000
* NEW HEADER HAS BEEN SET TO THE SAME VALUE AS 'HDRSTART', 02696000
* THEN A 'ZERO' IS BEING DONE BY EREP (UNLESS 'HDRLAST' WAS 02697000
* ALREADY EQUAL TO 'HDRSTART'; THIS CAN BE CHECKED IN THE OLD 02698000
* HEADER). IF EREP IS DOING A 'ZERO' THEN WE WILL ZERO THE 02699000
* VM/370 ERROR RECORDING CYLINDERS. 02700000
* 02701000
* SIMULATION OF SEQUENTIAL READS OF ERROR RECORDS 02702000
* 02703000
* IN GETTING RECORDS FROM THE VM/370 ERROR CYLINDERS AND 02704000
* PRESENTING THEM TO EREP AS IF THEY CAME FROM A SYS1.LOGREC, 02705000
* NO RE-FORMATTING OF THE RECORD DATA IS NECESSARY. THE FORMATS 02706000
* OF ERROR & FRAME RECORDS IN THE OS/VS SYS1.LOGREC AND IN THE 02707000
* VM/370 ERROR CYLINDERS ARE IDENTICAL EXCEPT THAT VM/370 02708000
* BLOCKS THE RECORDS INTO 4K BLOCKS WHILE UNDER OS/VS THEY ARE 02709000
* UNBLOCKED. 02710000
* 02711000
* IN HANDLING THE EXCP'S THAT EREP ISSUES TO READ ERROR RECORDS 02712000
* SEQUENTIALLY FROM SYS1.LOGREC, WE WILL BE CALLING DMSREA TO 02713000
* READ ONE RECORD AT A TIME FROM THE VM/370 ERROR CYLINDERS. 02714000
* BUT WE WILL ALWAYS HAVE TO STAY ONE RECORD AHEAD OF THE ONE 02715000
* CURRENTLY BEING REQUESTED BY THE EXCP. THE REASON FOR 02716000
* KEEPING ONE RECORD AHEAD IS THAT DURING THE SIMULATION OF 02717000
* THE CURRENT EXCP WE HAVE TO KNOW WHETHER OR NOT THERE WILL 02718000
* BE A RECORD FOR THE NEXT EXCP. WE HAVE TO KNOW WHETHER OR 02719000
* NOT THERE WILL BE A NEXT RECORD BECAUSE OF THE NATURE OF THE 02720000
* CHANNEL PROGRAM AND BECAUSE OF THE METHOD EREP USES TO 02721000
* DETECT THE (LOGICAL) END OF FILE. THE CHANNEL PROGRAM 02722000
* RETURNS THE CCHHR ADDRESS OF THE CURRENT RECORD AFTER EACH 02723000
* EXCP. NOW IF THE CURRENT RECORD HAPPENS TO BE THE LAST 02724000
* RECORD, ITS RETURNED CCHHR ADDRESS SHOULD MATCH THE CCHHR 02725000
* ADDRESS (OF ALL X'FF') IN THE 'HDRLAST' FIELD OF THE 02726000
* (SIMULATED) HEADER (AND IN FACT EREP LOOKS FOR THIS MATCH). 02727000
* THEREFORE IN THE CASE OF THE LAST RECORD, THE SIMULATED 02728000
* CCHHR VALUE RETURNED AFTER THE EXCP MUST BE 02729000
* THE ALL X'FF' VALUE FOUND IN 'HDRLAST'. AND IN 02730000
* SIMULATING THE EXCP, THE ONLY WAY WE HAVE OF KNOWING WHETHER 02731000
* OR NOT TO RETURN THE 'HDRLAST' VALUE AS THE RETURNED CCHHR 02732000
* IS TO KNOW WHETHER OR NOT THE VM/370 ERROR CYLINDERS CONTAIN 02733000
* ANOTHER RECORD. THIS WE DETERMINE BY READING ONE RECORD 02734000
* AHEAD. (NOTE: THE RECORD READ AHEAD CAN REMAIN IN THE 02735000
* I/O BUFFER OF DMSREA UNTIL IT IS NEEDED FOR THE NEXT EXCP. 02736000
* DMSREA DOES NOT RETURN DATA TO A BUFFER OF THE CALLER; 02737000
* INSTEAD IT JUST RETURNS A POINTER TO THE DATA SO THE 02738000
* CALLER CAN GET IT ANYTIME PRIOR TO HIS NEXT CALL.) 02739000
* 02740000
* IN THE CASE OF ALL OTHER ERROR RECORDS (I.E., ALL BUT THE 02741000
* LAST), THE CCHHR VALUE RETURNED TO EREP WITH THE RECORD IS 02742000
* RATHER ARBITRARY AS FAR AS EREP IS CONCERNED; EREP NEVER 02743000
* LOOKS AT IT EXCEPT TO COMPARE IT WITH 'HDRLAST' IN THE 02744000
* CASE OF SEQUENTIAL I/O, OR TO DECREMENT THE R FIELD BY 02745000
* ONE IN THE CASE OF RANDOM I/O. 02746000
* THE ARBITRARY VALUE WE WILL USE IN THE SIMULATION WILL 02747000
* BE THE 'CCB0R' VALUE DESCRIBED IN THE PROLOGUE OF DMSREA. 02748000
* 02749000
* IN THE CASE OF SEQUENTIAL I/O, THE CCB0R VALUE THAT WE 02750000
* PASS TO EREP ON ONE READ IS PASSED BACK TO US BY EREP ON 02751000
* THE NEXT READ AS THE SEARCH ADDRESS. NOTE: WHEN WE SEE 02752000
* IT AS A SEARCH ADDRESS WE HAVE TO ADD ONE TO IT BEFORE 02753000
* PASSING IT TO DMSREA SINCE THE RECORD WE WANT IS THE 02754000
* ONE FOLLOWING THE ONE THAT THE SEARCH COMMAND FINDS. 02755000
* 02756000
* SIMULATION OF RANDOM READING OF ERROR RECORDS 02757000
* 02758000
* AFTER THE END-OF-FILE INDICATION IS GIVEN TO EREP DURING 02759000
* THE SEQUENTIAL READ, WE CHANGE OUR MODE OF SIMULATION. 02760000
* ALL SUBSEQUENT EXCP'S SHOULD BE ATTEMPTING RANDOM READS. 02761000
* WE WILL NO LONGER KEEP ONE RECORD AHEAD. EREP WILL DO 02762000
* RANDOM READING USING THE RECORD ADDRESSES THAT WERE SEEN 02763000
* BY EREP DURING THE SEQUENTIAL READING. ALL OF THE DISK 02764000
* ADDRESSES (CCHHR) SEEN BY EREP DURING THE SEQUENTIAL READING 02765000
* ARE REALLY IN THE CCB0R FORMAT RECOGNIZED BY DMSREA, SO 02766000
* WHEN EREP PASSES THEM BACK TO US NOW DURING THE RANDOM 02767000
* READING, WE CAN SIMPLY PASS THEM TO DMSREA AND DMSREA WIIL 02768000
* RETURN THE DESIRED RECORD TO US FROM THE VM/370 ERROR 02769000
* RECORDING CYLINDERS. (ACTUALLY, BEFORE PASSING THEM TO 02770000
* DMSREA, WE MUST FIRST INCREMENT THE R BYTE BY ONE SINCE EREP 02771000
* HAS DECREMENTED THE R BYTE TO MAKE IT A SEARCH ADDRESS 02772000
* RATHER THAN THE DESIRED-RECORD-ADDRESS WHICH DMSREA GOES 02773000
* BY.) THERE IS ONE EXCEPTION WHERE THE CCHHR ADDRESS PASSED 02774000
* BY EREP IS NOT IN THE DESIRED CCB0R FORMAT. THIS OCCURS 02775000
* IF EREP TRIES TO READ THE VERY LAST ERROR RECORD BECAUSE 02776000
* FOR THIS RECORD WE SHOWED EREP A CCHHR ADDRESS OF ALL X'FF' 02777000
* (I.E., END-OF-FILE SIGNAL) DURING THE SEQUENTIAL READING. 02778000
* SO DURING THE RANDOM READING WE WILL WATCH THE ADDRESSES 02779000
* THAT EREP PASSES AND IF WE SEE THE ALL X'FF' ADDRESS, WE 02780000
* WILL SUBSTITUTE THE PROPER CCB0R ADDRESS IN PLACE OF IT 02781000
* WHEN WE CALL DMSREA. (WE WILL HAVE TO SAVE A COPY OF THIS 02782000
* SUBSTITUTION ADDRESS WHEN WE SEE IT AT END-OF-FILE TIME 02783000
* DURING THE SEQUENTIAL READING.) 02784000
* 02785000
* HANDLING OF I/O ERROR AND EMPTY BLOCK INDICATIONS RETURNED BY DMSREA 02786000
* 02787000
* DMSREA CAN RETURN SEVERAL INDICATIONS OF UNUSUAL SITUATIONS: 02788000
* (1) END-OF-FILE, (2) EMPTY 4K BLOCK, (3) I/O ERROR READING 02789000
* A 4K BLOCK. 02790000
* 02791000
* WE CAN HAND I/O ERRORS OVER TO EREP BY SIMPLY 'POST'ING 02792000
* AN ERROR COMPLETION CODE IN THE EXCP'S ECB. BUT IT APPEARS 02793000
* THAT EREP WILL THEN DIE IMMEDIATELY, SO WE WANT TO AVOID 02794000
* POSTING ERRORS BACK TO EREP WHENEVER POSSIBLE. WITH THAT 02795000
* IN MIND, DMSREA IS DESIGNED TO SKIP PAST TROUBLESOME BLOCKS 02796000
* TO THE NEXT READABLE RECORD. DURING THE SEQUENTIAL 02797000
* READING WE CAN EXPECT DMSREA TO SOMETIMES SEE (AND PASS 02798000
* OVER) A BAD BLOCK. IT GIVES US BACK THE NEXT AVAILABLE 02799000
* RECORD, ALONG WITH A CODE IN R15 INDICATING A BAD BLOCK 02800000
* WAS SKIPPED. DURING THE SEQUENTIAL READING WE EXPECT 02801000
* THAT THIS MAY HAPPEN AND WE IGNORE IT. BUT DURING THE 02802000
* RANDOM READING, WE DO NOT EXPECT ANY ATTEMPTS TO READ 02803000
* FROM ANY BAD BLOCK BECAUSE EREP SHOULD ONLY ATTEMPT TO 02804000
* READ FROM BLOCKS THAT IT SAW DURING THE SEQUENTIAL READING 02805000
* AND DURING THE SEQUENTIAL READING DMSREA SKIPPED OVER 02806000
* ALL BAD BLOCKS WITHOUT SHOWING EREP ANY RECORDS FROM THEM. 02807000
* SO IF WE DO GET AN INDICATION OF A BAD BLOCK DURING THE 02808000
* RANDOM READING, IT MEANS THE BLOCK WENT BAD SOME TIME AFTER 02809000
* THE SEQUENTIAL READING. IN THIS CASE WE MUST POST IT BACK 02810000
* TO EREP AS AN I/O ERROR; WE CAN'T HIDE THE BAD RECORD 02811000
* BECAUSE EREP HAS ALREADY SEEN IT DURING THE SEQUENTIAL 02812000
* READING. 02813000
* 02814000
* NORMALLY THE 'FIRST' AND 'SECOND' (OR SEARCHED FOR AND 02815000
* DESIRED) RECORD ADDRESSES ARE TWO LOGICALLY ADJACENT RECORDS. 02816000
* HOWEVER SINCE DMSREA WILL SKIP OVER ANY TROUBLESOME BLOCKS, 02817000
* SOME INACCESSIBLE RECORDS MAY LIE BETWEEN THE RECORD HAVING 02818000
* THE FIRST ADDRESS (SEARCH ADDRESS) AND THE RECORD HAVING 02819000
* THE SECOND ADDRESS (ADDRESS OF THE RECORD THAT IS READ). 02820000
* IT WAS MENTIONED EARLIER THAT DURING THE RANDOM READING, 02821000
* EREP SUBTRACTS ONE FROM THE R FIELD OF THE 'SECOND' 02822000
* ADDRESS TO COMPUTE A SEARCH ADDRESS. NORMALLY THIS GIVES 02823000
* THE SAME SEARCH ADDRESS AS WAS USED DURING THE SEQUENTIAL 02824000
* READING. BUT WHERE INACCESSIBLE RECORDS WERE SKIPPED 02825000
* OVER IT DOES NOT. IN THIS CASE THE COMPUTED SEARCH ADDRESS 02826000
* STARTS AT THE FAR SIDE OF THE BAD AREA, SO DMSREA DOES 02827000
* NOT HAVE TO SKIP OVER THE BAD BLOCKS TO FIND THE DESIRED 02828000
* RECORD; INSTEAD DMSREA IS SENT DIRECTLY TO THE GOOD RECORD. 02829000
* THIS IS WHY WE DO NOT EXPECT TO SEE DMSREA SKIPPING BAD 02830000
* BLOCKS DURING THE RANDOM READING. 02831000
*. 02832000
*********************************************************************** 02833000
DMSIFC0 STM R14,R12,SAVER14(R13) SAVE REGS IN OLD SAVE AREA@V4085A8 02834000
BALR R12,0 @V4085A8 02835000
USING *,R12 @V4085A8 02836000
ST R13,SAVEEXCP+SAVER13B PTR TO OLD SAVE AREA IN @V4085A8 02837000
* NEW SAVE AREA. 02838000
LA R13,SAVEEXCP ADDR OF NEW SAVE AREA. @V4085A8 02839000
SPACE 3 02840000
* THE 'USING'S BELOW (NUCON, IOBD, CHPD) AND R12 ABOVE, WILL 02841000
* REMAIN IN EFFECT THROUGHOUT THIS ROUTINE. 02842000
USING NUCON,0 MAKE LOW CORE AREA ADDRESSABLE. @V4085A8 02843000
LR R9,R1 ADDR OF THE OS IOB. @V4085A8 02844000
USING IOBD,R9 MAKE IOB FIELD ADDRESSABLE VIA DSECT. @V4085A8 02845000
L R8,IOBCCW GET ADDRESS OF THE CHANNEL PROGRAM. @V4085A8 02846000
USING CHPD,R8 @V4085A8 02847000
SPACE 3 02848000
* WE ARE NOW RUNNING IN SUPERVISOR STATE AND THAT IS NO WAY 02849000
* TO RUN THRU SUCH A LARGE AMOUNT OF CODE, SO WE WILL NOW 02850000
* SWITCH TO PROBLEM STATE. WE WILL DO A LPSW TO MAKE THE 02851000
* SWITCH, BUT FIRST WE HAVE TO BUILD A PSW. SINCE WE CANNOT 02852000
* EASILY SEE THE CURRENT PSW, WE WILL LOOK AT THE ONE EREP 02853000
* WAS USING BEFORE IT DID THE SVC 0. AND WE WILL USE THE 02854000
* EMPTY SAVE AREA CURRENTLY POINTED TO BY R13 AS A WORK AREA 02855000
* IN WHICH TO BUILD IT. 02856000
L R4,CURRSAVE ADDR OF SYSTEM SAVE AREA WITH @V4085A8 02857000
* OS/VS EREP OLD PSW. 02858000
USING SSAVE,R4 @V4085A8 02859000
L R2,OLDPSW LOAD LEFT HALF OF OLD PSW. @V4085A8 02860000
LA R3,ECPPRBLM THIS ADDR BECOMES RIGHT HALF OF PSW@V4085A8 02861000
STM R2,R3,D16(R13) PUT PSW IN WORK AREA. @V4085A8 02862000
LPSW D16(R13) LOAD PROB. STATE PSW, GO TO ECPPRBLM. @V4085A8 02863000
DROP R4 @V4085A8 02864000
ECPPRBLM DS 0H THE LPSW ABOVE RESUMES EXECUTION HERE. @V4085A8 02865000
ECPSWIT1 BC *-*,ECPNOT1 FALL THRU ON 1ST CALL, BRANCH ON @V4085A8 02866000
* LATER CALLS. 02867000
* FALL THRU ON 1ST CALL TO DO ONE-TIME-INITIALIZATION. 02868000
OI ECPSWIT1+1,X'F0' THROW THE SWITCH SO LATER @V4085A8 02869000
* CALLS BYPASS THIS. 02870000
* CERTAIN ADDRESSES WILL BE SAVED PERMANENTLY AND WILL 02871000
* BE CHECKED FOR EACH EXCP TO SEE THAT THEY ALWAYS 02872000
* REMAIN THE SAME. 02873000
ST R9,ADIOB SAVE IOB ADDRESS. @V4085A8 02874000
MVC ADDCB,IOBDCB SAVE DCB ADDRESS. @V4085A8 02875000
ST R8,ADCHNPRG SAVE CHANNEL PROGRAM ADDRESS. @V4085A8 02876000
* PERFORM ONE-TIME-ONLY CHECKS ON THE CHANNEL PROGRAM. 02877000
CLI CHPSRCH,X'31' OPCODE SHOULD BE SEARCH ID EQUAL.@V4085A8 02878000
BNE EXCODE7 ERROR. @V4085A8 02879000
CLI CHPSRCNT+1,5 COUNT SHOULD BE 5 FOR CCHHR. @V4085A8 02880000
BNE EXCODE7 ERROR. @V4085A8 02881000
CLI CHPTIC,X'08' OPCODE SHOULD BE TIC. @V4085A8 02882000
BNE EXCODE7 ERROR. @V4085A8 02883000
* THIS VERY FIRST EXCP SHOULD BE A READ OF THE HEADER RECORD. 02884000
CLI CHPRW,CCWRDHDR PROPER COMMAND FOR HEADER READ? @V4085A8 02885000
BNE EXCODE6 ERROR @V4085A8 02886000
SPACE 02887000
* ISSUE DIAGNOSE '2C' TO RETRIEVE THE DASD START (CCPD) 02888000
* OF THE ERROR RECORDING AREA. THEN ISSUE 02889000
* DIAGNOSE '2C' TO RETRIEVE THE CCPD ADDRESS OF THE 02890000
* FIRST ERROR RECORD (TO STORE IN HDRSTART FIELD), AND 02891000
* INDICATION OF WHETHER FRAME RECORDS ARE PRESENT ON 02892000
* ERROR RECORDING CYLINDERS. 02893000
SPACE 02894000
LA R2,LOGSTART INDICATE WANT ERROR RECORDING @V5088AA 02895000
* START ADDRESS 02896000
DC X'8321002C' DIAGNOSE '2C' -- WILL RETURN CCPD@V5088AA 02897000
* AND COUNT OF RECORDING CYLS, BUT 02898000
* WE WANT ONLY THE CCPD. 02899000
SRL R2,16 SHIFT OUT THE 'PD' PORTION @V5088AA 02900000
SLL R2,16 SHIFT THE 'CC' BACK @V5088AA 02901000
LA R1,ERRECST+FRAMEIND CODE FOR DIAGNOSE '2C' @V5088AA 02902000
DC X'8313002C' RETRIEVE HDRSTART AND HDRWFLG @V5088AA 02903000
* VALUES 02904000
LA R4,SIMHDR @ OF SIMULATED LOGREC HEADER @V5088AA 02905000
USING HDRLOGRC,R4 DESCRIBES HEADER RECORD @V5088AA 02906000
STC R3,HDRWFLG SAVE FRAME RECORD INDICATOR @V5088AA 02907000
TM HDRWFLG,HDRFRAME ARE THERE FRAME RECS ON CYLS? @VA07900 02908000
BNO ECPHDRL NO FRAME RECS...HDRSTART REMAINS @VA07900 02909000
* EQUAL TO CB0R OF TIMESTAMP RECORD 02910000
SR R1,R2 SUBTRACT STARTING 'CC' FROM THE @V5088AA 02911000
* 'CCPD' OF THE REC PRIOR TO 1ST ERROR REC. 02912000
* TO GET THE RELATIVE CYL NUMBER 02913000
SRL R1,8 SHIFT OUT THE 'D' PORTION @V5088AA 02914000
SLL R1,16 POSITION THE 'CB0' PART OF CB0R @V5088AA 02915000
ICM R1,1,=X'FE' MAKE 'R' VERY LARGE RECORD @VA09295 02916000
* NO. TO INDICATE LAST FRAME RECORD 02917000
ST R1,NXTCB0R SAVE 'CB0R' OF FIRST ERROR REC. @V5088AA 02918000
* FOR START OF SEQUENTIAL READING. 02919000
MVC HDRCB0R(4),NXTCB0R SAVE CB0R OF 1ST ERROR RECORD@V5088AA 02920000
* IN HDRSTART. THIS VALUE WILL BE 02921000
* PASSED BACK BY EREP WHEN READING 02922000
* THE FIRST OF THE ERROR RECORDS. 02923000
AH R1,=H'1' INCR R OF CBCR BY ONE TO @VA08353 02925000
* POINT TO FIRST ERROR RCD 02926000
ST R1,NXTCB0R SAVE UPDATES DISK ADDRESS @VA08353 02927000
ECPHDRL DS 0H @V5088AA 02928000
* WE HAVE TO INITIALIZE THE 'HDRLAST' FIELD OF THE 02929000
* SIMULATED SYS1.LOGREC HEADER RECORD, AND TO DO THAT WE 02930000
* HAVE TO KNOW WHETHER THERE ARE ANY ERROR RECORDS. SO 02931000
* ATTEMPT TO READ FIRST ERROR RECORD NOW. 02932000
LA R1,NXTCCB0R ADDRESS OF FIRST ERROR REC @VA08806 02933000
* IF THERE IS ONE @VA08806 02934000
L R15,DMSREAAD ADDRESS OF DMSREA. @V4085A8 02935000
BALR R14,R15 CALL DMSREA TO READ 1ST RECORD. @V4085A8 02936000
ST R0,NXTRECAD ASSUMING A RECORD WAS FOUND AND @V4085A8 02937000
* READ INTO DMSREA'S BUFFER, SAVE ITS STORAGE 02938000
* ADDRESS. 02939000
MVC NXTCCB0R(LENCCB0R),0(R1) AND SAVE ITS (POSSIBLY@V4085A8 02940000
* CORRECTED) DISK ADDRESS. 02941000
LTR R0,R0 TEST WAS A RECORD REALLY FOUND. @V4085A8 02942000
BNZ ECPLBL52 BRANCH IF A RECORD WAS FOUND. @V4085A8 02943000
* FALL THRU INDICATES THERE ARE NO ERROR RECORDS IN THE 02944000
* VM/370 ERROR RECORDING CYLINDERS. 02945000
MVC HDRLAST,HDRSTART SINCE THERE ARE NO ERROR @V4085A8 02946000
* RECORDS, THE HEADER'S PTR TO LAST 02947000
* RECORD WILL BE SAME AS PTR TO 02948000
* FIRST RECORD. 02949000
TM HDRWFLG,HDRFRAME ARE THERE FRAME RECORDS @VA08378 02950000
BZ ECPLBL52 NO, CONTINUE @VA08378 02951000
* IF SO, READ AHEAD THE FIRST FRAME RECORD.SINCE THERE 02952000
* ARE NO ERROR RECORDS,EREP'S FIRST GENERAL READ 02953000
* WILL BE FOR THE FIRST FRAME RECORD. 02954000
OI ECPLBL94+1,X'F0' BR ON FIRST SEQUENTIAL READ @VA08378 02955000
* OF FRAME RECORD. 02956000
OI ECPRD1SW+1,X'F0' NOT FIRST SEQ READ OF ERR RCD @VA08378 02957000
MVC NXTCCB0R(LENCCB0R),=X'0000010001' SET UP TO @VA08378 02958000
* READ FIRST RECORD ON ERR CYL 02959000
LA R1,NXTCCB0R FULL AMT OF RCD TO READ AHEAD @VA08378 02960000
L R15,DMSREAAD ADDRESS OF DMSREA @VA08378 02961000
BALR R14,R15 CALL DMSREA TO READ NEXT REC @VA08378 02962000
ST R0,NXTRECAD MAIN STOR ADDR OF THE FRAME @VA08378 02963000
* REC READ INTO DMSREA BUFFER 02964000
MVC NXTCCB0R(LENCCB0R),0(R1) SAVE ITS DISK ADDR @VA08378 02965000
DROP R4 @V5088AA 02966000
ECPLBL52 DS 0H @V4085A8 02967000
* (NOTE: FIRST-CALL-GENERAL-INITIALIZATION IS NOW COMPLETE.) 02968000
SPACE 3 02969000
ECPNOT1 DS 0H BEGIN GENERAL ERROR CHECKING. @V4085A8 02970000
CLM R9,B'0111',ADIOB+1 COMPARE PRESENT IOB ADDR @V4085A8 02971000
* WITH IOB ADDR SAVED FROM 1ST CALL. 02972000
* IT SHOULD BE THE SAME. 02973000
BNE EXCODE2 ERROR: MORE THAN ONE IOB. @V4085A8 02974000
CLC IOBDCB+1(L3),ADDCB+1 COMPARE PRESENT DCB ADDR @V4085A8 02975000
* WITH DCB ADDR OF 1ST CALL. 02976000
BNE EXCODE1 ERROR: EXCP USED BY MORE THAN ONE DCB. @V4085A8 02977000
CLM R8,B'0111',ADCHNPRG+1 COMPARE PRESENT CHANNEL @V4085A8 02978000
* PROGRAM ADDR WITH 1ST CH PRG ADDR 02979000
BNE EXCODE2 ERROR: MORE THAN ONE CHANNEL PROGRAM. @V4085A8 02980000
SPACE 02981000
* FIND THE OS ECB AND POST IT COMPLETE. (IF WE DETECT AN ERROR 02982000
* FURTHER ALONG WE WILL RE-POST IT WITH AN ERROR COMPLETION.) 02983000
L R1,IOBECB GET ECB ADDR FROM THE IOB. @V4085A8 02984000
MVI 0(R1),POSTNORM @V4085A8 02985000
SPACE 02986000
* DECIDE WHICH FUNCTION THE EXCP WANTS: READ HEADER, WRITE 02987000
* HEADER, OR READ A RECORD. 02988000
CLI CHPRW,CCWRDREC TEST CHANNEL COMMAND OPCODE. @V4085A8 02989000
BE ECPREAD EXCP WANTS TO DO A GENERAL READ. @V4085A8 02990000
CLI CHPRW,CCWWRHDR WANT TO WRITE THE HEADER? @V4085A8 02991000
BE ECPWRHDR YES. GO SIMULATE. @V4085A8 02992000
CLI CHPRW,CCWRDHDR WANT TO READ THE HEADER? @V4085A8 02993000
BNE EXCODE3 NO. ERROR, UNRECOGNIZED OPCODE. @V4085A8 02994000
* FALL THRU IF EXCP IS TRYING TO READ THE HEADER RECORD. 02995000
EJECT 02996000
*********************************************************************** 02997000
* 02998000
* SIMULATE A READ OF THE SYS1.LOGREC HEADER RECORD. 02999000
* 03000000
*********************************************************************** 03001000
LA R3,HDRLEN LENGTH OF THE HEADER. @V4085A8 03002000
CH R3,CHPRWCNT IS HEADER LONGER THAN BUFFER? @V4085A8 03003000
BH EXCODE7 YES, CHANNEL PROGRAM IS BAD. @V4085A8 03004000
L R1,CHPIDAD ADDRESS OF CCHHR ADDRESS THAT EREP @VA07900 03005000
* IS USING TO READ HEADER RECORD. EREP 03006000
* GETS THIS ADDRESS FROM THE LOGREC DEB, 03007000
* AND IT IS GARBAGE AS FAR AS WE ARE 03008000
* CONCERNED. BUT WE MUST REMEMBER IT 03009000
* BECAUSE EREP WILL USE THE SAME CCHH 03010000
* (WITH RECORD 2) WHEN HE ATTEMPTS TO 03011000
* START THE SEQUENTIAL READ OF FRAMES. 03012000
MVC SAVCCHH(LENCCHH),0(R1) REMEMBER THIS CCHH @VA07900 03013000
L R1,CHPBUFF ADDRESS OF THE READ BUFFER. @V4085A8 03014000
MVC 0(HDRLEN,R1),SIMHDR MOVE SIMULATED HEADER INTO @V4085A8 03015000
* READ BUFFER. 03016000
B ECPEXIT @V4085A8 03017000
SPACE 3 03018000
*********************************************************************** 03019000
* 03020000
* SIMULATE A WRITE OF THE SYS1.LOGREC HEADER RECORD. 03021000
* 03022000
*********************************************************************** 03023000
ECPWRHDR LA R1,HDRLEN LENGTH OF A HEADER RECORD. @V4085A8 03024000
CH R1,CHPRWCNT CHECK COUNT FIELD IN THE WRITE CMD.@V4085A8 03025000
BNE EXCODE7 ERROR, COUNT NOT EQUAL HEADER LENGTH. @V4085A8 03026000
LA R2,SIMHDR ADDR OF OLD SIMULATED HEADER RECORD. @V4085A8 03027000
L R3,CHPBUFF ADDR OF NEW SIMULATED HEADER RECORD @V4085A8 03028000
* IN THE CHANNEL PROG'S WRITE BUFFER. 03029000
* DETERMINE WHETHER OR NOT THE PRESENT RE-WRITING OF THE HEADER 03030000
* IS ATTEMPTING THE 'ZERO' FUNCTION. IT IS A 'ZERO' FUNCTION 03031000
* IF 'HDRLAST' IS BEING SET TO THE SAME VALUE AS 'HDRSTART'. 03032000
USING HDRLOGRC,R3 @V4085A8 03033000
CLC HDRLAST,HDRSTART COMPARE FIELDS IN NEW HEADER. @V4085A8 03034000
BNE ECPLBL78 IT IS DEFINITELY NOT A 'ZERO'. @V4085A8 03035000
DROP R3 @V4085A8 03036000
* FALL THRU INDICATES IT IS A 'ZERO', PROVIDED THAT 'HDRLAST' 03037000
* HAS JUST NOW BEEN RESET, I.E., PROVIDED THAT IT HAS NOT 03038000
* BEEN RESET ALL ALONG. 03039000
USING HDRLOGRC,R2 @V4085A8 03040000
CLC HDRLAST,HDRSTART COMPARE FIELDS IN OLD HEADER. @V4085A8 03041000
BE ECPLBL78 IT IS NOT A 'ZERO' FUNCTION. @V4085A8 03042000
* 'HDRLAST' WAS NOT RESET JUST NOW; IT HAS BEEN 03043000
* RESET ALL ALONG. 03044000
DROP R2 @V4085A8 03045000
* FALL THRU INDICATES IT IS A 'ZERO' FUNCTION. 03046000
LA R1,ERRFLG FLAGS PASSED TO 'CLEARRTN' REQUEST@V5088AA 03047000
* ERASE OF ALL OF THE VM/370 ERROR REC. CYLS. 03048000
L R15,=A(CLEARRTN) @V4085A8 03049000
BALR R14,R15 CALL ROUTINE TO CLEAR ERROR CYLINDERS. 03050000
* AN ERROR RETURN CODE COMES BACK IN R15 IF CLEAR FAILED 03051000
* BECAUSE USER DID NOT HAVE PRIVILEGE CLASS F. WE IGNORE IT 03052000
* AND DO NOT STORE IT IN 'RETCDE' BECAUSE: (1) IT IS NOT 03053000
* AN ERROR, ZERO IS OFTEN REQUESTED BY EREP IN SPITE OF 03054000
* THE USER'S WISHES, AND THE NON-CLASS F USERS MAY BE 03055000
* BOTHERED OR CONFUSED BY SEEING AN ERROR RETURN CODE FROM 03056000
* IT. FURTHERMORE, THE USER ALREADY HAS BEEN WARNED BY A 03057000
* MESSAGE FROM 'CLEARRTN'; (2) IF WE STORED AN ERROR CODE 03058000
* IN 'RETCDE' NOW, IT WOULD PREVENT ANY (GENERALLY MORE 03059000
* SEVERE) ERROR CODE FROM BEING STORED WHEN OS/VS EREP 03060000
* RETURNS CONTROL TO DMSIFC AT THE END OF THE RUN. 03061000
ECPLBL78 MVC 0(HDRLEN,R2),0(R3) COPY NEW HEADER RECORD FROM @V4085A8 03062000
* WRITE BUFFER INTO SIMULATED HEADER 03063000
* AREA. IT NOW BECOMES CURRENT HDR. 03064000
B ECPEXIT @V4085A8 03065000
EJECT 03066000
ECPREAD DS 0H @V4085A8 03067000
*********************************************************************** 03068000
* 03069000
* SIMULATE THE READING OF A (NON-HEADER) RECORD FROM SYS1.LOGREC. 03070000
* 03071000
*********************************************************************** 03072000
ECPRNDSW BC *-*,ECPRAND SWITCH WILL BE SET TO BRANCH AFTER @V4085A8 03073000
* END OF FILE IS DETECTED DURING THE 03074000
* SEQUENTIAL READING. SUBSEQUENT READING IS 03075000
* RANDOM. 03076000
*********************************************************************** 03077000
* 03078000
* FALLING THRU HERE MEANS WE ARE STILL IN THE SEQUENTIAL PHASE. 03079000
* 03080000
*********************************************************************** 03081000
ECPRD1SW BC *-*,ECPLBL94 BRANCH IF NOT 1ST SEQ. READ. @V4085A8 03082000
* FALL THRU ON THE FIRST SEQUENTIAL READ FOR SPECIAL CHECKING. 03083000
OI ECPRD1SW+1,X'F0' THROW THE ONE TIME SWITCH. @V4085A8 03084000
MVI SEQRDFRM,X'00' INIIALIZE FLAG @VA07861 03085000
L R3,CHPIDAD ADDR OF CCHHR DISK ADDR THAT EXCP @V4085A8 03086000
* IS USING WITH THE FIRST SEQUENTIAL READ. 03087000
LA R2,SIMHDR ADDR OF SIMULATED HEADER. @V4085A8 03088000
USING HDRLOGRC,R2 @V4085A8 03089000
CLC 0(LENCCHHR,R3),HDRSTART+2 COMPARE HDRSTART @V4085A8 03090000
* ADDR AND THE DISK ADDR THAT 03091000
* OS/VS EREP IS ACTUALLY TRYING 03092000
* TO USE TO READ THE FIRST RECORD. 03093000
* THEY SHOULD BOTH BE THE SAME 03094000
* SINCE EREP GOT HDRSTART WHEN IT 03095000
* READ THE HEADER RECORD. 03096000
DROP R2 @V4085A8 03097000
BL EXCODE5 ERROR, ACTUAL ADDRESS IS LESS. IT IS @V4085A8 03098000
* POSSIBLY TRYING TO READ THE TIME STAMP RECORD 03099000
* (RECORD 2, FOLLOWS HEADER) WHICH WE DO NOT 03100000
* SIMULATE. 03101000
BH EXCODE4 ERROR, ACTUAL ADDRESS IS HIGH. IT @V4085A8 03102000
* APPEARS TO BE TRYING TO READ NON-SEQUENTIALLY. 03103000
ICM R1,B'1111',NXTRECAD LOAD ADDR OF RECORD THAT @V4085A8 03104000
* WAS READ-AHEAD INITIALLY (WHEN EXCP 03105000
* READ THE HEADER, WE READ THE FIRST 03106000
* ERROR RECORD). 03107000
BZ EXCODE9 ERROR. NO RECORD WAS READ-AHEAD @V4085A8 03108000
* BECAUSE ERROR RECORDING CYLINDERS ARE EMPTY OF 03109000
* ERROR RECORDS. SO OS/VS EREP SHOULD NEVER 03110000
* HAVE ATTEMPTED THE SEQUENTIAL READING. 03111000
B ECPLBL97 ALL 'FIRST-READ' CHECKS WERE PASSED @V4085A8 03112000
* SUCCESSFULLY. GO SIMULATE. 03113000
SPACE 3 03114000
ECPLBL94 BC *-*,ECPLBL95 BEGIN HERE FOR ALL SEQUENTIAL @VA07900 03115000
* READS EXCEPT THE FIRST. SWITCH 03116000
* WILL BE SET TO BRANCH FOR THE FIRST 03117000
* SEQUENTIAL READ OF FRAME RECORDS. 03118000
L R2,CHPIDAD PTR TO CCB0R THAT EXCP IS USING TO @V4085A8 03119000
* READ WITH. 03120000
CLC 0(LENCCB0R,R2),LSTCCB0R SHOULD EQUAL THE CCB0R @V4085A8 03121000
* DISK ADDR THAT WE GAVE EREP 03122000
* WITH THE PREVIOUS RECORD. 03123000
BE ECPLBL97 O.K., MOVE RECORD TO EREP BUFFER @VA13316 03124000
* IF NOT , EREP WANTS TO READ RECORDS@VA13316 03124200
* RANDOMLY. IF RECORD IS WITHIN LIMIT@VA13316 03124400
* OF THE LAST RECORD, ALLOW IT. @VA13316 03124600
BH EXCODE4 ERROR. EREP APPEARS TO BE TRYING TO @VA13316 03124800
* READ NON-SEQUENTIALLY BEYOND LIMITS. @VA13316 03125000
L R2,CHPBUFF ADDRESS OF READ BUFFER @VA13316 03125200
MVC 0(LENCCB0R,R2),=XL5'00FFFFFFFF' EOF IN BUFFER @VA13316 03125400
MVC SAVELAST,LSTCCB0R CCB0R OF LAST ERROR RECORD @VA13316 03125600
OI ECPRNDSW+1,X'F0' SET RANDOM READ SWITCH @VA13316 03125800
B ECPRAND EOF SET AND DIRECT RCORD READ @VA13316 03126000
ECPLBL95 L R2,CHPIDAD ADDRESS OF CCHH EREP IS USING TO @VA07900 03127000
* READ THE FIRST FRAME RECORD. THIS CCHH 03128000
* SHOULD BE THE SAME AS THE CCHH USED TO 03129000
* READ THE HEADER RECORD, BUT THE RECORD 03130000
* WILL BE 2 (TIMESTAMP RECORD NO.). 03131000
CLC 0(LENCCHH,R2),SAVCCHH SEE IF CORRECT CCHH FOR @VA07900 03132000
* FIRST FRAME RECORD 03133000
BNE EXCODE4 EREP APPEARS TO BE TRYING TO READ@VA07900 03134000
* NON-SEQUENTIALLY 03135000
CLI 4(R2),RECORD2 IS THE RECORD NO. = 2? @VA07900 03136000
BNE EXCODE4 ERROR IF NOT @VA07900 03137000
MVI ECPLBL94+1,X'00' FIRST TIME CHECKS FOR THE @VA07900 03138000
* SEQUENTIAL READING OF FRAMES ARE COMPLETE 03139000
* SET SWITCH TO REVERT TO NORMAL SEQUENTIAL 03140000
* PROCESSING. 03141000
MVI SEQRDFRM,X'FF' SET FLAG TO INDICATE NOW READING @VA07861 03142000
* FRAME RECORDS SEQUENTIALLY 03143000
ECPLBL97 DS 0H MOVE THE READ-AHEAD RECORD (COUNT FIELD AND @V4085A8 03144000
* DATA) INTO EXCP'S READ BUFFER. 03145000
L R2,NXTRECAD ADDR OF RECORD READ-AHEAD. @V4085A8 03146000
LH R3,D2(0,R2) LENGTH OF RECORD LOADED FROM @V4085A8 03147000
* RECORD DESCRIPTOR WORD. 03148000
LA R2,D4(0,R2) SKIP PTR PAST DESCRIPTOR WORD. @V4085A8 03149000
* ARGS FOR ECPBFILL: R2 POINTS TO DATA AND R3 SPECIFIES LENGTH. 03150000
BAL R14,ECPBFILL ROUTINE MOVES DATA INTO BUFFER, @V4085A8 03151000
* ALSO PUTS KEY LENGTH 0 AND DATA LENGTH 03152000
* INTO COUNT FIELD AT START OF BUFFER. 03153000
L R2,CHPBUFF ADDR OF READ BUFFER. @V4085A8 03154000
MVC 0(LENCCB0R,R2),NXTCCB0R COMPLETE COUNT FIELD IN@V4085A8 03155000
* READ BUFFER BY SUPPLYING THE 03156000
* RECORD'S CCB0R ADDRESS. 03157000
L R1,NXTCB0R GET RECORD'S DISK ADDRESS... @V4085A8 03158000
ST R1,LSTCB0R AND SAVE FOR ERR CHECK NEXT TIME... @V4085A8 03159000
AH R1,=H'1' AND INCREMENT R OF CB0R BY ONE TO@VA07861 03160000
* ADDRESS NEXT RECORD. NOTE THAT LA CANNOT 03161000
* BE USED TO ADD HERE AS IT WILL WIPE OUT 03162000
* THE HIGH ORDER BYTE. 03163000
ST R1,NXTCB0R SAVE AS TENTATIVE ADDR OF NEW @V4085A8 03164000
* RECORD TO BE READ AHEAD. 03165000
LA R1,NXTCCB0R FULL (5 BYTE) ADDR OF RECORD TO BE @V4085A8 03166000
* READ AHEAD. 03167000
L R15,DMSREAAD ADDRESS OF DMSREA. @V4085A8 03168000
BALR R14,R15 CALL DMSREA TO READ NEXT RECORD AHEAD. @V4085A8 03169000
* R0 = PTR TO RECORD IN BUFFER. 03170000
* R1 = PTR TO (POSSIBLY REVISED) CCB0R DISK ADDRESS. 03171000
* R15 CONTAINS A POSSIBLE ERROR RETURN CODE. IF R15=60 (I/O 03172000
* ERROR) SAVE IT; OTHER CODES ARE OF NO CONSEQUENCE DURING 03173000
* SEQUENTIAL READING. 03174000
L R3,=A(RETCDE) @V4085A8 03175000
CLI D1(R3),0 TEST FOR CODE STORED PREVIOUSLY. @V4085A8 03176000
BNZ ECPLB105 THERE IS A PREVIOUS CODE, KEEP IT. @V4085A8 03177000
CH R15,=Y(RC60) IS PRESENT CODE RC60? @V4085A8 03178000
BNE ECPLB105 PRESENT CODE WILL BE DISCARDED. @V4085A8 03179000
STH R15,0(0,R3) SAVE RC60. @V4085A8 03180000
ECPLB105 ST R0,NXTRECAD ASSUMING A RECORD WAS FOUND AND @V4085A8 03181000
* READ INTO DMSREA'S BUFFER, SAVE ITS 03182000
* MAIN STORAGE ADDRESS. 03183000
MVC NXTCCB0R(LENCCB0R),0(R1) AND SAVE ITS (POSSIBLY@V4085A8 03184000
* CORRECTED) DISK ADDRESS. 03185000
TM SEQRDFRM,X'FF' SEQUENTIAL READ OF FRAMES @VA08378 03186000
BO ECPLB106 YES @VA08378 03187000
LTR R0,R0 END OF FILE @VA08378 03188000
BZ ECPLB107 YES @VA08378 03189000
B ECPEXIT READ COMPLETED OK @VA08378 03190000
ECPLB106 DS 0H @VA08378 03191000
LA R2,SIMHDR ADDR OF SIMULATED LOGREC HDR @VA08378 03192000
USING HDRLOGRC,R2 03193000
LTR R0,R0 END FILE READING FRAME RCDS @VA08378 03194000
BZ ECPL106A YES, HANDLE EOF @VA08378 03195000
CLC NXTCCB0R(LENCCB0R),HDRSTART+2 IF WE ARE NOW @VA07900 03196000
* READING THE FRAME RECORDS SEQUENTIALLY, 03197000
* CHECK TO SEE IF THE RECORD READ AHEAD IS 03198000
* THE FIRST ERROR RECORD. IF SO, THEN 03199000
* EREP SHOULD STOP READING FRAME RECORDS 03200000
* AND BEGIN HIS RANDOM READS. 03201000
BNH ECPEXIT A RECORD-AHEAD WAS FOUND OK @VA07861 03202000
ECPL106A DS 0H @VA08378 03203000
OI ECPRNDSW+1,X'F0' BRANCH FOR EOF @VA08378 03204000
* READS AS RANDOM RATHER THAN SEQUENTIAL 03205000
L R15,CHPBUFF ADDRESS OF READ BUFFER @VA07861 03206000
MVC LASTFRAM(LENCCB0R),0(R15) SAVE THE ACTUAL CCB0R @VA07861 03207000
* OF THE LAST FRAME RECORD 03208000
MVC 0(LENCCB0R,R15),HDRSTART+2 MOVE THE HDRSTART @VA07861 03209000
* VALUE INTO THE RECORD TO BE PASSED BACK 03210000
* TO EREP. THIS IS SO EREP WILL RECOGNIZE 03211000
* THAT THE LAST FRAME RECORD HAS BEEN READ. 03212000
B ECPEXIT PRESENT READ COMPLETED OK @VA07900 03213000
DROP R2 03214000
* THE SIMULATION OF THE PRESENT SEQUENTIAL READ 03215000
* HAS NOW BEEN COMPLETED SUCCESSFULLY. 03216000
* 03217000
* HERE IF END-OF-FILE WHILE READING ERROR RECORDS SEQUENTIALLY. 03218000
* WE MUST REVISE THE CCB0R ADDRESS IN THE COUNT FIELD OF THE 03219000
* RECORD JUST SIMULATED TO A CCB0R ADDRESS OF ALL X'FF'S TO 03220000
* INDICATE TO EREP THAT THIS RECORD IS THE LAST. 03221000
* NOTE: R2 STILL HAS ADDR OF READ BUFFER. 03222000
ECPLB107 MVC 0(LENCCB0R,R2),=XL5'00FFFFFFFF' @VA07900 03223000
MVC SAVELAST,LSTCCB0R SAVE CCB0R OF LAST ERROR REC. @VA07900 03224000
LA R2,SIMHDR ADDRESS OF SIMULATED LOGREC HDR. @VA07900 03225000
USING HDRLOGRC,R2 03226000
TM HDRWFLG,HDRFRAME ARE THERE FRAME RECS ON CYLS? @VA07900 03227000
BO SEQREADF IF SO, SET UP FOR SEQUENTIAL READ@VA07900 03228000
* OF FRAME RECORDS. 03229000
DROP R2 03230000
OI ECPRNDSW+1,X'F0' THROW SWITCH SO FUTURE READS @VA07900 03231000
* WILL BE HANDLED AS RANDOM READS RATHER 03232000
* THAN SEQUENTIAL. 03233000
B ECPEXIT SIMULATION OF PRESENT READ HAS BEEN @V4085A8 03234000
* COMPLETED SUCCESSFULLY. 03235000
SEQREADF DS 0H @VA07900 03236000
* FRAMES ARE ON THE ERROR CYLINDERS, SO EREP WILL NEXT DO A 03237000
* SEQUENTIAL READ OF FRAME RECORDS. WE MUST DO A READ-AHEAD 03238000
* OF THE FIRST FRAME RECORD NOW, SO THAT WE CAN KEEP ONE 03239000
* AHEAD OF EREP'S REQUESTS. 03240000
OI ECPLBL94+1,X'F0' SET SWITCH TO BRANCH ON FIRST @VA07900 03241000
* SEQUENTIAL READ OF A FRAME RECORD. 03242000
MVC NXTCCB0R(LENCCB0R),=X'0000010001' SET UP TO READ@VA07900 03243000
* THE 1ST REC. ON THE ERROR CYLS. 03244000
LA R1,NXTCCB0R FULL @ OF RECORD TO BE READ AHEAD@VA07900 03245000
L R15,DMSREAAD ADDRESS OF DMSREA @VA07900 03246000
BALR R14,R15 CALL DMSREA TO READ NEXT RECORD @VA07900 03247000
* 03248000
* R0 = PTR TO RECORD IN BUFFER 03249000
* R1 = PTR TO (POSSIBLY REVISED) CCB0R DISK ADDRESS 03250000
* R15 = POSSIBLE ERROR RETURN CODE 03251000
L R3,=A(RETCDE) @VA07900 03252000
CLI D1(R3),0 TEST FOR CODE STORED PREVIOUSLY @VA07900 03253000
BNE ECPLB110 THERE IS A PREVIOUS CODE;KEEP IT @VA07900 03254000
CH R15,=Y(RC60) IS PRESENT CODE RC60 (I/O ERROR)?@VA07900 03255000
BNE ECPLB110 PRESENT CODE WILL BE DISCARDED @VA07900 03256000
STH R15,0(0,R3) SAVE RC60 @VA07900 03257000
ECPLB110 ST R0,NXTRECAD SAVE MAIN STORAGE ADDRESS OF THE @VA07900 03258000
* FRAME REC. READ INTO REA'S BUFFER. 03259000
MVC NXTCCB0R(LENCCB0R),0(R1) SAVE ITS (POSSIBLY @VA07900 03260000
* CORRECTED) DISK ADDRESS. 03261000
B ECPEXIT PRESENT READ COMPLETED OK @VA07900 03262000
EJECT 03263000
*********************************************************************** 03264000
* 03265000
* SIMULATE THE (RANDOM) READING OF A (NON-HEADER) RECORD FROM THE 03266000
* SYS1.LOGREC DATA SET. 03267000
* 03268000
*********************************************************************** 03269000
ECPRAND L R1,CHPIDAD ADDR OF CCB0R DISK ADDRESS THAT @V4085A8 03270000
* EXCP SPECIFIED. 03271000
MVC NXTCCB0R(LENCCB0R),0(R1) MOVE CCB0R TO MORE @V4085A8 03272000
* ACCESSIBLE AREA. 03273000
CLI NXTCCB0R+2,0 CHECK B FIELD; SHOULD BE 1 OR MORE@V4085A8 03274000
BE EXCODE8 ERROR, EREP USED INVALID CCB0R. @V4085A8 03275000
* NOTE: IF CC FIELD IS INVALID, DMSREA WILL CATCH IT LATER. 03276000
L R1,NXTCB0R LOAD CB0R PORTION. @V4085A8 03277000
AH R1,=H'1' SINCE EREP DECREMENTED THE R FIELD, WE@V4085A8 03278000
* INCREMENT BY 1 TO GET ADDRESS OF DESIRED 03279000
* RECORD. (CANNOT USE LA TO ADD HERE, IT WOULD 03280000
* DESTROY HIGH ORDER BYTE.) 03281000
ST R1,NXTCB0R @V4085A8 03282000
C R1,=F'-1' IS THIS CB0R THE ALL X'FF'S DISK @V4085A8 03283000
* ADDRESS THAT EREP THINKS IS THE ADDRESS OF 03284000
* THE FINAL RECORD? 03285000
BE ECPLB116 BRANCH IF THE ALL X'FF'S ADDRESS @VA07861 03286000
LA R15,SIMHDR ADDRESS OF SIMULATED LOGREC HDR @VA07861 03287000
USING HDRLOGRC,R15 03288000
CLM R1,B'1111',HDRSTART+3 SEE IF EREP IS ASKING FOR@VA07861 03289000
* THE LAST FRAME RECORD 03290000
DROP R15 03291000
LA R1,NXTCCB0R PREPARE CCB0R ARG FOR DMSREA @VA07861 03292000
BNE ECPLB117 BRANCH IF NOT REQUESTING LAST @VA07861 03293000
* FRAME RECORD 03294000
LA R1,LASTFRAM RETRIEVE CCB0R OF LAST FRAME REC.@VA07861 03295000
* USE TRUE VALUE RATHER THAN HDRSTART VALUE 03296000
B ECPLB117 @VA07861 03297000
ECPLB116 LA R1,SAVELAST RETRIEVE CCB0R ARG FOR DMSREA.USE@VA07861 03298000
* TRUE VALUE RATHER THAN ALL X'FF'S. 03299000
ECPLB117 L R15,DMSREAAD ADDRESS OF DMSREA. @V4085A8 03300000
BALR R14,R15 CALL DMSREA TO READ THE RECORD EXCP @V4085A8 03301000
* REQUESTED. 03302000
* R0 = PTR TO RECORD IN DMSREA'S BUFFER. 03303000
* R1 = PTR TO CCB0R OF RECORD ACTUALLY GOTTEN (WHICH IN THE 03304000
* CASE OF RANDOM READING HERE, SHOULD BE THE SAME VALUE 03305000
* AS THE INPUTTED CCB0R). 03306000
* R15 = A POSSIBLE ERROR RETURN CODE. 03307000
LTR R15,R15 ANY ERROR? @V4085A8 03308000
BZ ECPLB126 BRANCH IF NO ERROR. @V4085A8 03309000
CH R15,=Y(RC60) TEST FOR I/O ERROR CODE. @V4085A8 03310000
BNE EXCODE8 BRANCH IF SOME OTHER ERROR: EXCP @V4085A8 03311000
* SPECIFIED INVALID CCB0R. 03312000
* FALL THRU FOR I/O ERROR. WE CANNOT BYPASS A BAD RECORD AS WE 03313000
* DID DURING THE SEQUENTIAL READING BECAUSE EREP SAW THE PRESENT 03314000
* RECORD THEN (OTHERWISE IT WOULD NOT BE ASKING FOR IT NOW). 03315000
L R3,=A(RETCDE) RETURN CODE GETS SAVED HERE. @V4085A8 03316000
CLI D1(R3),0 WAS ANY CODE SAVED PREVIOUSLY? @V4085A8 03317000
BNZ ECPLB123 YES, KEEP EARLIER CODE. @V4085A8 03318000
STH R15,0(0,R3) NO, KEEP PRESENT CODE. @V4085A8 03319000
* SINCE I/O ERROR CANNOT BE BYPASSED, WE POST THE EXCP'S ECB 03320000
* WITH AN ERROR CODE. 03321000
ECPLB123 L R3,IOBECB ADDR OF ECB. @V4085A8 03322000
MVI 0(R3),POSTERR POST ECB WITH ERROR CODE. @V4085A8 03323000
B ECPEXIT SIMULATION OF THE PRESENT READ EXCP IS @V4085A8 03324000
* COMPLETE. 03325000
SPACE 03326000
* R0 IS STILL PTR TO RECORD IN DMSREA'S BUFFER. 03327000
ECPLB126 L R3,CHPBUFF ADDR OF EXCP'S READ BUFFER. @V4085A8 03328000
MVC 0(LENCCB0R,R3),NXTCCB0R MOVE CCB0R RECORD ADDR @V4085A8 03329000
* INTO THE COUNT FIELD AT THE 03330000
* BEGINNING OF EXCP'S BUFFER. 03331000
* NOTE THAT THIS CCB0R MAY BE THE 03332000
* ALL X'FF'S (WHICH IS OKAY, THAT 03333000
* IS STILL WHAT EREP SHOULD SEE). 03334000
LR R2,R0 PTR TO RECORD IN DMSREA'S BUFFER. @V4085A8 03335000
LH R3,D2(0,R2) LENGTH OF RECORD, LOADED FROM THE @V4085A8 03336000
* RECORD DESCRIPTOR WORD. 03337000
LA R2,D4(0,R2) SKIP PTR PAST DESCRIPTOR WORD. @V4085A8 03338000
* ARGS FOR ECPBFILL: R2 POINTS TO DATA AND R3 SPECIFIES LENGTH. 03339000
BAL R14,ECPBFILL ROUTINE MOVES DATA INTO EXCP @V4085A8 03340000
* BUFFER, ALSO COMPLETES COUNT FIELD AT 03341000
* BEGINNING OF BUFFER BY STORING KEY LENGTH 03342000
* ZERO AND DATA LENGTH. 03343000
* SIMULATION OF THE PRESENT READ IS COMPLETE. 03344000
SPACE 03345000
ECPEXIT L R13,SAVER13B(0,R13) ADDRESS OF OLD SAVE AREA. @V4085A8 03346000
LM R14,R12,SAVER14(R13) @V4085A8 03347000
BR R14 @V4085A8 03348000
EJECT 03349000
*********************************************************************** 03350000
* 03351000
* ECPBFILL: THIS ROUTINE MOVES DATA INTO THE CHANNEL PROGRAM'S 03352000
* READ BUFFER. THE DATA IS PRECEEDED BY AN 8 BYTE COUNT 03353000
* FIELD AND THIS ROUTINE STORES KEY LENGTH (ZERO) AND 03354000
* DATA LENGTH IN THIS COUNT FIELD. 03355000
* 03356000
*********************************************************************** 03357000
* 03358000
* INPUTS: 03359000
* R8 - ADDRESS OF THE CHANNEL PROGRAM, PROVIDING ADDRESSABILITY 03360000
* VIA THE CHPD DSECT. 03361000
* CHPBUFF - ADDRESS OF THE READ BUFFER. 03362000
* R2 - ADDRESS OF DATA TO BE MOVED. 03363000
* R3 - LENGTH OF DATA TO BE MOVED. (WILL BE OVERRIDDEN IF 03364000
* COUNT FIELD OF THE READ COMMAND SPECIFIES LESS.) 03365000
* CHPRWCNT - COUNT FIELD OF THE READ COMMAND. 03366000
* R14 - RETURN ADDRESS. 03367000
* R13 - SAVE AREA. 03368000
* R12 - ADDRESSABILITY ALREADY PROVIDED VIA R12. 03369000
* 03370000
* OUTPUTS: 03371000
* DATA IS LOADED INTO THE READ BUFFER. THE KEY LENGTH AND DATA 03372000
* LENGTH PORTIONS OF THE COUNT FIELD WILL BE FILLED IN ALSO. 03373000
* 03374000
*********************************************************************** 03375000
ECPBFILL STM R14,R12,SAVER14(R13) @V4085A8 03376000
L R4,CHPBUFF BUFFER ADDRESS. @V4085A8 03377000
LH R5,CHPRWCNT READ COMMAND COUNT. @V4085A8 03378000
* WE MUST SIMULATE THE READING OF A COUNT FIELD INTO THE 03379000
* BUFFER ALONG WITH THE DATA. 03380000
LA R6,CNTFLDL LENGTH OF A STANDARD COUNT FIELD. @V4085A8 03381000
CH R6,CHPRWCNT IF THE READ COMMAND SAYS THE BUFFER@V4085A8 03382000
* IS TOO SMALL TO CONTAIN EVEN A COUNT 03383000
* FIELD, SOMETHING IS WRONG. 03384000
BH EXCODE7 ERROR, UNEXPECTED CHANNEL PROG FORMAT. @V4085A8 03385000
LTR R3,R3 VALID DATA LENGTH @VA09237 03385250
BM EXCODEA NO,INVALID INPUT RECORD @VA09237 03385500
USING CNTFLD,R4 DESCRIBE COUNT FIELD AT FRONT OF BUF.@V4085A8 03386000
MVI CNTFLDK,0 KEY LENGTH ALWAYS 0. @V4085A8 03387000
STH R3,CNTFLDLL PUT DATA LENGTH INTO COUNT FIELD. @V4085A8 03388000
DROP R4 @V4085A8 03389000
AR R4,R6 SKIP OVER COUNT FIELD, GET TO DATA AREA. @V4085A8 03390000
SR R5,R6 COMPUTE LENGTH OF DATA PORTION OF BUFFER.@V4085A8 03391000
CR R5,R3 IS BUFFER LONGER THAN DATA? @V4085A8 03392000
BNH ECPBF007 NO. @V4085A8 03393000
LR R5,R3 R5=R3 SO MVCL WILL NOT PAD THE BUFFER. @V4085A8 03394000
ECPBF007 MVCL R4,R2 MOVE DATA INTO BUFFER. @V4085A8 03395000
LM R14,R12,SAVER14(R13) @V4085A8 03396000
BR R14 @V4085A8 03397000
EJECT 03398000
*********************************************************************** 03399000
* 03400000
* THE FOLLOWING BLOCK OF CODE IS REACHED VIA BRANCH INSTRUCTIONS, 03401000
* NOT BALR'S. THE CODE SETS UP AN ERROR CODE NUMBER TO BE USED IN 03402000
* ERROR MESSAGE DMSIFC832S, THEN IT ISSUES THE MESSAGE, THEN IT EXITS. 03403000
* 03405000
*********************************************************************** 03406000
EXCODE1 MVI MSGCODE,1 @V4085A8 03407000
B EXGENERR @V4085A8 03408000
EXCODE2 MVI MSGCODE,2 @V4085A8 03409000
B EXGENERR @V4085A8 03410000
EXCODE3 MVI MSGCODE,3 @V4085A8 03411000
B EXGENERR @V4085A8 03412000
EXCODE4 MVI MSGCODE,4 @V4085A8 03413000
B EXGENERR @V4085A8 03414000
EXCODE5 MVI MSGCODE,5 @V4085A8 03415000
B EXGENERR @V4085A8 03416000
EXCODE6 MVI MSGCODE,6 @V4085A8 03417000
B EXGENERR @V4085A8 03418000
EXCODE7 MVI MSGCODE,7 @V4085A8 03419000
B EXGENERR @V4085A8 03420000
EXCODE8 MVI MSGCODE,8 @V4085A8 03421000
B EXGENERR @V4085A8 03422000
EXCODE9 MVI MSGCODE,9 @V4085A8 03423000
B EXGENERR ISSUE MESSAGE @VA09237 03423250
EXCODEA MVI MSGCODE,10 ERROR ON INPUT RECORD @VA09237 03423500
SPACE 3 03424000
EXGENERR DMSERR NUM=832,LET=S,TEXT='SOFTWARE INCOMPATIBILITY AT THE CPEX03425000
REP-EREP INTERFACE. CODE=...', @V4085A8X03426000
SUB=(DECA,MSGCODEF),RENT=NO @V4085A8 03427000
WAITT @V4085A8 03428000
LA R15,RC104 PUT ERROR RETURN CODE IN R15. @V4085A8 03429000
L R3,=A(RETCDE) ADDRESS OF RETURN CODE @VA09237 03429300
CLI D1(R3),0 PREVIOUS ERROR CODE @VA09237 03429600
BNE EXPOST YES, LEAVE ALONE @VA09237 03429900
STH R15,0(0,R3) SAVE CMS RETURN CODE @VA09237 03430200
EXPOST EQU * @VA09237 03430500
L R3,IOBECB ECB ADDRESS @VA09237 03430800
MVI 0(R3),POSTERR POST ECB WITH I/O ERROR @VA09237 03431100
B ECPEXIT RETURN TO CALLER @VA09237 03431400
DROP 0,R8,R9,R12 @V4085A8 03432000
EJECT 03433000
*********************************************************************** 03434000
* 03435000
* DATA AREAS (SECOND SECTION) 03436000
* 03437000
*********************************************************************** 03438000
DATAREA2 DS 0F @V4085A8 03439000
SPACE 03440000
MSGCODEF DC F'0' CONTAINS CODE NUMBER TO BE INSERTED IN @V4085A8 03441000
* ERROR MESSAGE. 03442000
MSGCODE EQU MSGCODEF+3 CODE NUMBER IS PUT IN THIS BYTE. @V4085A8 03443000
SPACE 3 03444000
DS 0F PROVIDE FULLWORD ALIGNMENT AT NXTCB0R. @V4085A8 03445000
DC XL3'000000' UNUSED FILL TO ALIGN NXTCB0R. @V4085A8 03446000
NXTCCB0R DC XL1'00' START OF THE CCB0R DISK ADDRESS OF THE @V4085A8 03447000
* RECORD CURRENTLY READ AHEAD DURING THE 03448000
* SEQUENTIAL READING PHASE. 03449000
NXTCB0R DC XL4'00010001' CONTINUATION OF THE CCB0R ADDRESS@V4085A8 03450000
* OF THE RECORD CURRENTLY READ AHEAD 03451000
* DURING THE SEQUENTIAL READING PHASE. 03452000
* THIS IS THE SIGNIFICANT PORTION OF CCB0R 03453000
* SINCE THE HIGH ORDER C IS ALWAYS 0. IT 03454000
* IS FULLWORD ALIGNED FOR EFFICIENT 03455000
* ACCESSING. INITIAL VALUE HERE IS THE 03456000
* ADDR. OF THE 1ST ERROR REC. AFTER 03457000
* ANY FRAME RECS. ON REC. CYLS. 03458000
SPACE 3 03459000
DS 0F PROVIDE FULLWORD ALIGNMENT OF LSTCB0R. @V4085A8 03460000
DC XL3'0' UNUSED FILL TO ALIGN LSTCB0R. @V4085A8 03461000
LSTCCB0R DC XL5'0' DURING SEQUENTIAL READING, CONTAINS @V4085A8 03462000
* CCB0R DISK ADDRESS THAT WAS PASSED BACK TO EREP 03463000
* IN THE BUFFER (IN COUNT FIELD) AS THE ADDRESS 03464000
* OF THE LAST RECORD THAT EREP READ SEQUENTIALLY. 03465000
* DURING RANDOM READING, THIS CONTAINS THE CCB0R 03466000
* DISK ADDRESS OF THE VERY LAST RECORD, I.E., THE 03467000
* RECORD THAT WE SHOWED TO EREP AS HAVING THE 03468000
* ALL X'FF'S ADDRESS TO INDICATE END OF FILE. 03469000
* SO IF EREP SENDS THE ALL X'FF'S ADDRESS BACK TO 03470000
* US WHILE READING RANDOMLY, WE WILL COME HERE 03471000
* FOR THE TRUE CCB0R ADDRESS TO GO TO DMSREA WITH. 03472000
LSTCB0R EQU LSTCCB0R+1 @V4085A8 03473000
SPACE 3 03474000
* THE FOLLOWING CONTIGUOUS FIELDS MAKE UP THE SIMULATED 03475000
* SYS1.LOGREC HEADER RECORD. THE HDRLOGRC DSECT DESCRIBES IT. 03476000
SIMHDR DS 0F @V4085A8 03477000
DC XL2'FFFF' @V4085A8 03478000
DC XL4'0' @V4085A8 03479000
DC XL4'FFFFFFFF' @V4085A8 03480000
DC XL1'0' @V4085A8 03481000
DC XL7'00000000000002' @V4085A8 03482000
DC HL2'12960' @V4085A8 03483000
DC HL2'12960' @V4085A8 03484000
DC XL7'000000FFFFFFFF' @V4085A8 03485000
DC XL2'0012' @V4085A8 03486000
DC XL2'0' @V4085A8 03487000
DC X'09' @V4085A8 03488000
DC XL4'FFFFFFFF' @V4085A8 03489000
DC X'00' @V4085A8 03490000
DC X'FF' @V4085A8 03491000
SPACE 3 03492000
* TABSKIP2 IS A TRT TABLE USED FOR SKIPPING PAST COMMAS AND BLANKS. 03493000
TABSKIP2 DS 0D @V4085A8 03494000
DC (C' ')X'01' @V4085A8 03495000
DC X'00' @V4085A8 03496000
DC (C','-C' '-1)X'01' @V4085A8 03497000
DC X'00' @V4085A8 03498000
DC (255-C',')X'01' @V4085A8 03499000
SPACE 03500000
* TABDLIM IS A TRT TABLE USED FOR SCANNING TO FIND ONE OF THE 03501000
* FOLLOWING DELIMITERS: BLANK, COMMA, LEFT PAREN., RIGHT PAREN. 03502000
TABDLIM DS 0D @V4085A8 03503000
DC (C' ')X'00',AL1(4) BLANK @V4085A8 03504000
DC (C'('-C' '-1)X'00',AL1(12) LEFT PARENTHESIS @V4085A8 03505000
DC (C')'-C'('-1)X'00',AL1(16) RIGHT PARENTHESIS @V4085A8 03506000
DC (C','-C')'-1)X'00',AL1(8) COMMA @V4085A8 03507000
DC (255-C',')X'00' FILL TABLE TO END.@V4085A8 03508000
SPACE 3 03509000
LOADLIST DS 0D 03510000
DC CL8'INCLUDE' @V4085A8 03511000
DC CL8'IFCEREP1' @V4085A8 03512000
DC CL8'IFCMSG01' @V4085A8 03513000
DC CL8'IFCIOHND' @V4085A8 03514000
DC CL8'IFCEDSUM' @V4085A8 03515000
DC CL8'IFCEEDIT' @V4085A8 03516000
DC CL8'IFCESUMS' @V4085A8 03517000
DC CL8'IFCMES01' @V4085A8 03518000
DC CL8'IFCPARM1' @V4085A8 03519000
DC CL8'IFCPARM2' @V4085A8 03520000
DC CL8'(' @V4085A8 03521000
DC CL8'NOAUTO' @V4085A8 03522000
DC CL8'NOMAP' @V4085A8 03523000
DC 8X'FF' @V4085A8 03524000
SPACE 3 03525000
FDEFPRT DS 0D @V4085A8 03526000
DC CL8'FILEDEF' @V4085A8 03527000
DC CL8'EREPPT' @V4085A8 03528000
DC CL8'PRINTER' @V4085A8 03529000
DC CL8'(' @V4085A8 03530000
DC CL8'NOCHANGE' LETS THE USER OVERRIDE THIS @V4085A8 03531000
* FILEDEF IF HE SUPPLIES ONE OF HIS OWN 03532000
* AHEAD OF TIME. 03533000
DC CL8'BLKSIZE' @V4085A8 03534000
DC CL8'133' @V4085A8 03535000
DC 8X'FF' @V4085A8 03536000
SPACE 03537000
FDEFSYSI DS 0D @V4085A8 03538000
DC CL8'FILEDEF' @V4085A8 03539000
DC CL8'SYSIN' @V4085A8 03540000
DC CL8'DISK' @V4085A8 03541000
DC CL8'SYSIN' @V4085A8 03542000
DC CL8'EREPWORK' @V4085A8 03543000
MODPLUG1 DC CL8' ' FMODE GETS FILLED IN PRIOR TO INVOKING. @V4085A8 03544000
DC 8X'FF' @V4085A8 03545000
SPACE 03546000
FDEFSYS2 DS 0D @V4085A8 03547000
DC CL8'FILEDEF' @V4085A8 03548000
DC CL8'SYSIN' @V4085A8 03549000
DC CL8'DUMMY' @V4085A8 03550000
DC 8X'FF' @V4085A8 03551000
SPACE 03552000
FDEFSERL DS 0D THIS DEFINITION IS IN LIEU OF A DUMMY @V4085A8 03553000
* FILEDEF WHICH IS LOGICALLY WHAT WE WANT HERE SINCE 03554000
* NO READS OR WRITES WILL EVER GET THRU TO THIS FILE, 03555000
* ONLY THE OPEN AND CLOSE ARE ACTUALLY ALLOWED TO 03556000
* EXECUTE. BUT BECAUSE THE FILE IS DEFINED IN EREP'S 03557000
* DCB AS 'DSORG=DA', A DUMMY FILEDEF FAILS, 03558000
* APPARENTLY BECAUSE IT MAKES NO SENSE TO HAVE A 03559000
* DUMMY DATA SET THAT IS RANDOMLY ACCESSED. THE 03560000
* SOLUTION IS TO HAVE A MINIMAL NON-DUMMY FILEDEF, 03561000
* AS BELOW, TO GET THRU THE OPEN AND CLOSE. 03562000
DC CL8'FILEDEF' @V4085A8 03563000
DC CL8'SERLOG' @V4085A8 03564000
DC CL8'DISK' @V4085A8 03565000
DC CL8'SERLOG' @V4085A8 03566000
DC CL8'EREPWORK' @V4085A8 03567000
DC CL8'(' @V4085A8 03568000
DC CL8'BLOCK' @V4085A8 03569000
DC CL8'4096' @V4085A8 03570000
DC 8X'FF' @V4085A8 03571000
SPACE 03572000
FDEFTOUR DS 0D @V4085A8 03573000
DC CL8'FILEDEF' @V4085A8 03574000
DC CL8'TOURIST' @V4085A8 03575000
DC CL8'TERMINAL' @V4085A8 03576000
DC CL8'(' @V4085A8 03577000
DC CL8'BLKSIZE' @V4085A8 03578000
DC CL8'133' @V4085A8 03579000
DC 8X'FF' @V4085A8 03580000
SPACE 03581000
FDEFDIRE DS 0D @V4085A8 03582000
DC CL8'FILEDEF' @V4085A8 03583000
DC CL8'DIRECTWK' @V4085A8 03584000
DC CL8'DISK' @V4085A8 03585000
DC CL8'DIRECTWK' @V4085A8 03586000
DC CL8'EREPWORK' @V4085A8 03587000
MODPLUG2 DC CL8' ' FMODE GETS FILLED IN PRIOR TO INVOKING. @V4085A8 03588000
DC 8X'FF' @V4085A8 03589000
SPACE 03590000
FDEFACCI DS 0D @V4085A8 03591000
DC CL8'FILEDEF' @V4085A8 03592000
DC CL8'ACCIN' @V4085A8 03593000
DC CL8'TAP2' @V4085A8 03594000
DC CL8'(' @V4085A8 03595000
DC CL8'NOCHANGE' LETS THE USER OVERRIDE THIS @V4085A8 03596000
* FILEDEF IF HE SUPPLIES ONE OF HIS OWN 03597000
* AHEAD OF TIME. 03598000
DC CL8'RECFM' @V4085A8 03599000
DC CL8'VB' @V4085A8 03600000
DC CL8'BLKSIZE' @V4085A8 03601000
DC CL8'12000' @V4085A8 03602000
DC 8X'FF' @V4085A8 03603000
SPACE 03604000
FDEFACCD DS 0D @V4085A8 03605000
DC CL8'FILEDEF' @V4085A8 03606000
DC CL8'ACCDEV' @V4085A8 03607000
DC CL8'TAP1' @V4085A8 03608000
DC CL8'(' @V4085A8 03609000
DC CL8'NOCHANGE' LETS THE USER OVERRIDE THIS @V4085A8 03610000
* FILEDEF IF HE SUPPLIES ONE OF HIS OWN 03611000
* AHEAD OF TIME. 03612000
DC CL8'RECFM' @V4085A8 03613000
DC CL8'VB' @V4085A8 03614000
DC CL8'BLKSIZE' @V4085A8 03615000
DC CL8'12000' @V4085A8 03616000
DC 8X'FF' @V4085A8 03617000
SPACE 03618000
FDEFCLR DS 0D @V4085A8 03619000
DC CL8'FILEDEF' @V4085A8 03620000
FDEFCLRN DC CL8'SYSIN' @V4085A8 03621000
DC CL8'CLEAR' @V4085A8 03622000
DC 8X'FF' @V4085A8 03623000
SPACE 3 03624000
CLRLIST DS 0D LIST OF FILEDEF'S TO BE CLEARED. @V4085A8 03625000
DC CL8'SERLOG' @V4085A8 03626000
DC CL8'TOURIST' @V4085A8 03627000
DC CL8'DIRECTWK' @V4085A8 03628000
CLRLISTZ EQU * MARKS END OF CLRLIST. @V4085A8 03629000
SPACE 3 03630000
LTORG @V4085A8 03631000
SPACE 3 03632000
NXTRECAD DS A STORAGE ADDRESS OF THE RECORD READ AHEAD AND @V4085A8 03633000
* KEPT IN DMSREA'S BUFFER DURING SEQUENTIAL READING. 03634000
ADIOB DS A ADDRESS OF THE IOB, RETAINED FROM ONE EXCP @V4085A8 03635000
* TO THE NEXT. 03636000
ADDCB DS A ADDRESS OF THE DCB, RETAINED FROM ONE EXCP @V4085A8 03637000
* TO THE NEXT. 03638000
ADCHNPRG DS A ADDRESS OF THE CHANNEL PROGRAM, RETAINED @V4085A8 03639000
* FROM ONE EXCP TO THE NEXT. 03640000
DMSREAAD DS A CONTAINS ADDRESS OF THE DMSREA ROUTINE AFTER @V4085A8 03641000
* THAT PROGRAM IS BROUGHT INTO MAIN STORAGE BY OS LOAD. 03642000
SAVEEXCP DS 9D A STANDARD 72 BYTE SAVE AREA. @V4085A8 03643000
SAVCCHH DC XL4'0' SAVE AREA FOR 'CCHH' (GARBAGE TO @VA07900 03644000
* US) THAT EREP USES TO READ THE HEADER 03645000
* RECORD. 03646000
SAVELAST DC XL5'0' SAVE AREA FOR THE CCB0R OF THE @VA07900 03647000
* LAST RECORD ON ERROR CYLINDERS. 03648000
LASTFRAM DC XL5'0' SAVE AREA FOR THE CCB0R OF THE @VA07861 03649000
* LAST FRAME REC. ON THE ERROR CYLINDERS 03650000
SEQRDFRM DC X'00' FLAG TO INDICATE SEQUENTIAL READ @VA07861 03651000
* OF FRAME RECORDS 03652000
EJECT 03653000
SAVER13B EQU 4 DISPLACEMENT FOR SAVING (IN A NEW SAVE @V4085A8 03654000
* AREA) THE BACKWARD POINTER TO THE OLD SAVE AREA. 03655000
SAVER14 EQU 12 DISPLACEMENT FOR SAVING R14 IN A STANDARD @V4085A8 03656000
* 72 BYTE SAVE AREA. 03657000
SAVER15 EQU SAVER14+4 DISP. FOR SAVING R15 IN A SAVE AREA. @V4085A8 03658000
SAVER0 EQU SAVER15+4 DISP. FOR SAVING R0 IN A SAVE AREA. @V4085A8 03659000
SAVER1 EQU SAVER0+4 DISP. FOR SAVING R1 IN A SAVE AREA. @V4085A8 03660000
SAVER2 EQU SAVER1+4 DISP. FOR SAVING R2 IN A SAVE AREA. @V4085A8 03661000
SAVER3 EQU SAVER2+4 DISP. FOR SAVING R3 IN A SAVE AREA. @V4085A8 03662000
SAVER9 EQU SAVER0+9*4 DISP. FOR SAVING R9 IN A SAVE AREA. @V4085A8 03663000
SPACE 03664000
D1 EQU 1 SYMBOLIC DISPLACEMENT. @V4085A8 03665000
D2 EQU 2 SYMBOLIC DISPLACEMENT. @V4085A8 03666000
D4 EQU 4 SYMBOLIC DISPLACEMENT. @V4085A8 03667000
D8 EQU 8 SYMBOLIC DISPLACEMENT. @V4085A8 03668000
D16 EQU 16 SYMBOLIC DISPLACEMENT. @V4085A8 03669000
D24 EQU 24 SYMBOLIC DISPLACEMENT. @V4085A8 03670000
D28 EQU 28 SYMBOLIC DISPLACEMENT. @V4085A8 03671000
L1 EQU 1 SYMBOLIC LENGTH. @V4085A8 03672000
L2 EQU 2 SYMBOLIC LENGTH. @V4085A8 03673000
L3 EQU 3 SYMBOLIC LENGTH. @V4085A8 03674000
L8 EQU 8 SYMBOLIC LENGTH. @V4085A8 03675000
L10 EQU 10 SYMBOLIC LENGTH. @V4085A8 03676000
L12 EQU 12 SYMBOLIC LENGTH. @V4085A8 03677000
L16 EQU 16 SYMBOLIC LENGTH. @V4085A8 03678000
SPACE 03679000
RC1 EQU 1 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03680000
RC2 EQU 2 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03681000
RC4 EQU 4 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03682000
RC5 EQU 5 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03683000
RC6 EQU 6 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03684000
RC12 EQU 12 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03685000
RC24 EQU 24 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03686000
RC28 EQU 28 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03687000
RC32 EQU 32 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03688000
RC56 EQU 56 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03689000
RC60 EQU 60 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03690000
RC62 EQU 62 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03691000
RC88 EQU 88 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03692000
RC100 EQU 100 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03693000
RC104 EQU 104 FOR USE AS AN ERROR RETURN CODE. @V4085A8 03694000
SPACE 03695000
TRUNCLEN EQU 71 LAST DATA COLUMN OF RECORDS IN CONTROL @V4085A8 03696000
* PARAMETER INPUT FILE. 03697000
PARMBUFL EQU 102 LENGTH OF THE OS PARM BUFFER, ALLOCATED @V4085A8 03698000
* FROM FREE STORAGE. INCLUDES DATA AREA PLUS 2 BYTES 03699000
* FOR LENGTH FIELD IN FRONT OF DATA AREA. 03700000
FENLEN EQU 8 LENGTH OF A FENCE OF FF'S (8X'FF'). @V4085A8 03701000
PROGOPSW EQU 40 ADDRESS OF PROG CHECK OLD PSW IN LOW CORE. @V4085A8 03702000
PROGNPSW EQU 104 ADDRESS OF PROG CHECK NEW PSW IN LOW CORE. @V4085A8 03703000
POSTNORM EQU X'7F' NORMAL COMPLETION CODE FOR 'POST'ING @V4085A8 03704000
* ECB OF EXCP. 03705000
POSTERR EQU X'70' ERROR COMPLETION CODE FOR 'POST'ING @V4085A8 03706000
* ECB OF EXCP. 03707000
CCWRDHDR EQU X'06' THIS OPCODE IN CCW SIGNALS US THAT EREP @V4085A8 03708000
* WANTS TO READ THE SYS1.LOGREC HEADER RECORD. 03709000
CCWWRHDR EQU X'05' THIS OPCODE IN CCW SIGNALS US THAT EREP @V4085A8 03710000
* WANTS TO WRITE THE SYS1.LOGREC HEADER RECORD. 03711000
CCWRDREC EQU X'9E' THIS OPCODE IN CCW SIGNALS US THAT EREP @V4085A8 03712000
* WANTS TO READ A NON-HEADER RECORD FROM SYS1.LOGR. 03713000
ERRECST EQU X'02' SUBCODE FOR DIAGNOSE '2C'. @V5088AA 03714000
* WANT HDRSTART VALUE 03715000
FRAMEIND EQU X'04' SUBCODE FOR DIAGNOSE '2C' @V5088AA 03716000
* WANT HDRWFLG VALUE 03717000
LOGSTART EQU X'01' SUBCODE FOR DIAGNOSE '2C' @V5088AA 03718000
* WANT 'CCPD' OF RECORDING AREA 03719000
LENCCHHR EQU 5 SYMBOLIC LENGTH OF CCHHR DATA. @V4085A8 03720000
LENCCHH EQU 4 SYMBOLIC LENGTH OF CCHH DATA @VA07900 03721000
LENCCB0R EQU 5 SYMBOLIC LENGTH OF CCB0R DATA. @V4085A8 03722000
PARMHDRL EQU 2 LENGTH OF HALFWD HEADER OF OS PARM LIST. @V4085A8 03723000
RECORD2 EQU 2 RECORD NUMBER OF TIMESTAMP REC. @VA07900 03724000
HDRFRAME EQU X'20' FRAME INDICATOR IN HDRWFLG - ON @VA07900 03725000
* INDICATES FRAME RECS. ON CYLINDERS. 03726000
REGEQU @V4085A8 03727000
EJECT 03728000
INPLIST DSECT DESCRIBES CMS PARM LIST OF THE CPEREP COMMAND.@V4085A8 03729000
INPCOM DC CL8'CPEREP' @V4085A8 03730000
INPFN DC CL8'FILENAME' @V4085A8 03731000
INPFT DC CL8'FILETYPE' @V4085A8 03732000
INPFM DC CL8'FILEMODE' @V4085A8 03733000
INPFENCE DC 8X'FF' @V4085A8 03734000
SPACE 3 03735000
CTLCRD DSECT FORMAT OF CTLCRD INPUTTED TO OS/VS EREP. @V4085A8 03736000
CTLCRDID DS CL6 CONTAINS THE WORD 'CTLCRD'. @V4085A8 03737000
DS CL4 BLANK AREA. @V4085A8 03738000
CTLCRDD1 DS CL5 DATE1 AS YYDDD. @V4085A8 03739000
DS CL1 BLANK. @V4085A8 03740000
CTLCRDD2 DS CL5 DATE2 AS YYDDD. @V4085A8 03741000
DS CL1 BLANK. @V4085A8 03742000
CTLCRDCI DS CL2 IPL CLUSTERING INTERVAL. @V4085A8 03743000
DS CL1 BLANK. @V4085A8 03744000
CTLCRDTI DS CL55 TITLE (OR COMPANY NAME). @V4085A8 03745000
SPACE 3 03746000
BLDLIST DSECT FORMAT OF INITIAL ENTRY OF A BLDL LIST. @V4085A8 03747000
DS (2)CL2 N/A @V4085A8 03748000
BLDLNAM DS CL8 NAME OF MEMBER. @V4085A8 03749000
BLDLTTR DS CL3 TTR DISK ADDRESS (RELATIVE TRACK & RECORD).@V4085A8 03750000
DS (3)CL1 N/A @V4085A8 03751000
SPACE 3 03752000
CNTFLD DSECT DESCRIBES THE COUNT FIELD OF A DISK RECORD. @V4085A8 03753000
CNTFLDAD DS XL5 CONTAINS CCHHR RECORD ADDRESS. @V4085A8 03754000
CNTFLDK DS XL1 CONTAINS KEY LENGTH. @V4085A8 03755000
CNTFLDLL DS XL2 CONTAINS DATA LENGTH. @V4085A8 03756000
CNTFLDL EQU *-CNTFLD LENGTH OF A DISK COUNT FIELD. @V4085A8 03757000
SPACE 3 03758000
IOBD DSECT SELECTED FIELDS OF AN OS IOB. @V4085A8 03759000
DS F N/A @V4085A8 03760000
IOBECB DS A ADDRESS OF ECB. @V4085A8 03761000
DS 2F N/A @V4085A8 03762000
IOBCCW DS A ADDRESS OF 1ST COMMAND OF CHANNEL PROG. @V4085A8 03763000
IOBDCB DS A ADDRESS OF DCB. @V4085A8 03764000
DS 4F N/A @V4085A8 03765000
SPACE 3 03766000
CHPD DSECT EXPECTED LAYOUT OF SYS1.LOGREC CHANNEL PROG.@V4085A8 03767000
CHPSRCH DS 0D COMMAND: SEARCH ID EQUAL. @V4085A8 03768000
CHPIDAD DS A LOW ORDER 3 BYTES ARE ADDR OF CCHHR. @V4085A8 03769000
DS XL2 COMMAND FLAGS. @V4085A8 03770000
CHPSRCNT DS H COUNT. @V4085A8 03771000
CHPTIC DS 0D COMMAND: TIC *-8 @V4085A8 03772000
CHPTICAD DS A LOW ORDER 3 BYTES ARE TARGET ADDRESS. @V4085A8 03773000
DS XL2 COMMAND FLAGS. @V4085A8 03774000
DS H COUNT. @V4085A8 03775000
CHPRW DS 0D COMMAND: READ, WRITE; OPCODE VARIES. @V4085A8 03776000
CHPBUFF DS A LOW ORDER 3 BYTES ARE READ OR WRITE BUFFER. @V4085A8 03777000
DS XL2 COMMAND FLAGS. @V4085A8 03778000
CHPRWCNT DS H DATA COUNT. @V4085A8 03779000
SPACE 3 03780000
TXTDSECT DSECT TXTLIB STRUCTURE @V4085A8 03781000
LIBNAME DS CL8 TXTLIB NAME @V4085A8 03782000
DS F N/A @V4085A8 03783000
NXTLIB DS F POINTER TO NEXT TXTLIB @V4085A8 03784000
DS F N/A @V4085A8 03785000
ENTRY1 DS F ADDRESS OF 1ST ENTRY @V4085A8 03786000
LENTRY DS F LENGTH OF EACH ENTRY @V4085A8 03787000
NXTAVAIL DS F NEXT AVAILABLE ENTRY ADDRESS @V4085A8 03788000
SPACE 3 03789000
MODNAME DSECT ENTRY STRUCTURE @V4085A8 03790000
NME1ST4 DS CL4 FIRST 4 CHARS OF MODULE NAME @V4085A8 03791000
NMELST4 DS CL4 LAST 4 CHARS OF MODULE NAME @V4085A8 03792000
DS CL4 N/A @V4085A8 03793000
SPACE 3 03794000
HDRLOGRC DSECT @V4085A8 03795000
HDRCLASS DC XL2'FFFF' HEADER RECORD IDENTIFIER. @V4085A8 03796000
* FFFF INDICATES A VALID HEADER. EREP MAY 03797000
* CHECK IT FOR VALIDITY. 03798000
HDRLOEXT DC XL4'0' ADDRESS OF LOW EXTENT. TRACK ADDRESS @V4085A8 03799000
* (IN CCHH FORMAT) OF FIRST EXTENT OF 03800000
* SYS1.LOGREC. VALUE SHOULD NOT AFFECT EREP. 03801000
HDRHIEXT DC XL4'FFFFFFFF' ADDRESS OF HIGH EXTENT. TRACK @V4085A8 03802000
* ADDRESS (IN CCHH FORMAT) OF LAST EXTENT OF 03803000
* SYS1.LOGREC. VALUE SHOULD NOT AFFECT EREP. 03804000
HDRFULL DC XL1'0' COUNT OF FULL MESSAGE. EREP RESETS @V4085A8 03805000
* THIS TO 0, BUT NEVER READS IT. 03806000
HDRSTART DC XL7'00000000000000' ADDR. TO BE USED FOR FIRST @V5088AA 03807000
* ERROR RECORD PUT INTO SYS1.LOGREC 03808000
* (IN BBCCHHR FORMAT). FOR PURPOSES 03809000
* OF SIMULATION, THE 'HDRLAST' 03810000
* FIELD MUST USE THE SAME 03811000
* CONVENTION; WHEN 'HDRLAST' AND 03812000
* 'HDRSTART' MATCH, SYS1.LOGREC IS 03813000
* EMPTY OF ERROR RECORDS. 03814000
ORG *-4 BACK UP TO CB0R PART OF ADDRESS @V5088AA 03815000
HDRCB0R DS XL4 CB0R PORTION OF HDRSTART ADDRESS @V5088AA 03816000
* VALUE IS FILLED IN FROM ADDRESS 03817000
* SAVED IN DMKIOEHS DURING INIT. 03818000
* OF THE ERROR RECORDING CYLINDERS. 03819000
HDRREM DC HL2'12960' NUMBER OF BYTES REMAINING ON TRACK @V4085A8 03820000
* UPON WHICH LAST RECORD ENTRY WAS WRITTEN. 03821000
* VALUE USED HERE IS ARBITRARY, BUT 03822000
* REASONABLE. EREP RESETS THIS WITHOUT 03823000
* LOOKING AT IT. 03824000
HDRTRKCP DC HL2'12960' TRACK CAPACITY OF VOLUME CONTAINING @V4085A8 03825000
* SYS1.LOGREC. SIMULATE IT AS A 3330. 03826000
* EREP CURRENTLY NEVER LOOKS AT THIS, BUT 03827000
* PERHAPS IT SHOULD RATHER THAN USING ITS OWN 03828000
* TRACK CAPACITY TABLE. 03829000
HDRLAST DC XL7'000000FFFFFFFF' ADDRESS (IN BBCCHHR FORMAT)@V4085A8 03830000
* OF LAST ERROR RECORD WRITTEN ON 03831000
* SYS1.LOGREC. FOR SIMULATION, VALUE 03832000
* OF BBCCHHR DOESN'T MATTER, BUT WHEN 03833000
* IT IS THE SAME AS THE VALUE IN THE 03834000
* 'HDRSTART' FIELD, IT MEANS 03835000
* SYS1.LOGREC IS EMPTY. 03836000
HDRTRKS DC XL2'0012' HIGHEST ADDRESSABLE TRACK FOR EACH @V4085A8 03837000
* CYLINDER ON VOLUME. EREP DOES NOT USE THIS, 03838000
* BUT SIMULATE IT AS A 3330 ANYWAY. 03839000
DC XL2'0' THIS FIELD IS NOT USED BY EREP. @V4085A8 03840000
HDRDEV DC X'09' CODE INDICATING DEVICE TYPE OF @V4085A8 03841000
* SYS1.LOGREC VOLUME. CODE X'09' IS 3330. 3330 IS 03842000
* PURELY ARBITRARY FOR PURPOSES OF SIMULATION. 03843000
* EREP WILL USE THIS, SO CODE MUST BE A VALID ONE. 03844000
HDRWTRK DC XL4'FFFFFFFF' EARLY WARNING MESSAGE TRACK. @V4085A8 03845000
* TRACK (IN CCHH FORMAT) ON WHICH 90 03846000
* PERCENT FULL POINT FOR DATA SET EXISTS. 03847000
* A PURELY ARBITRARY VALUE IS USED HERE FOR 03848000
* SIMULATION; EREP WILL NOT LOOK AT IT. 03849000
HDRWFLG DC X'00' FLAG VALUE X'80' INDICATES 90 PERCENT @V4085A8 03850000
* FULL MESSAGE HAS ALREADY BEEN 03851000
* ISSUED. X'20' INDICATES FRAME 03852000
* RECORDS ARE PRESENT ON THE ERROR 03853000
* RECORDING CYLINDERS. 03854000
HDRSAFE DC X'FF' CHECK BYTE. FF INDICATES VALID HEADER @V4085A8 03855000
* RECORD. EREP WILL CHECK THAT IT IS REALLY FF. 03856000
HDRLEN EQU *-HDRLOGRC LENGTH OF THE HEADER RECORD. @V4085A8 03857000
SPACE 3 03858000
SVCSAVE @V4085A8 03859000
SPACE 3 03860000
ADT @V4085A8 03861000
SPACE 3 03862000
FSCBD @V4085A8 03863000
SPACE 3 03864000
FSTB @V4085A8 03865000
SPACE 3 03866000
NUCON @V4085A8 03867000
END DMSIFC 03868000