BTP TITLE 'DMSBTP (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
* MODULE NAME: 00003000
* 00004000
* DMSBTP - CMS BATCH MONITOR PROCESSOR 00005000
* 00006000
* FUNCTION: 00007000
* 00008000
* TO EXECUTE READS FROM THE VIRTUAL CARD READER 00009000
* EACH TIME CMS TRIES TO EXECUTE A CONSOLE READ, THEREBY 00010000
* EFFECTING A CMS BATCH VIRTUAL MACHINE. 00011000
* 00012000
* ATTRIBUTES: 00013000
* 00014000
* DISK RESIDENT IN RELOCATABLE (TEXT) FORM; LOADED INTO 00015000
* NUCLEUS FREE STORAGE BY DMSBTB. 00016000
* 00017000
* ENTRY POINTS: 00018000
* 00019000
* DMSBTP - MAIN ENTRY CALLED FROM DMSCRD (CMS CONSOLE READ) 00020000
* 00021000
* DMSBTPAB - ENTRY FOR ABNORMAL CONDITIONS DURING USER JOB; 00022000
* (1) JOB EXECUTION ABEND (FROM DMSABN) 00023000
* (2) JOB LIMIT EXCEEDED (FROM DMSITE,DMSCIO,DMSPIO) 00024000
* (3) DISABLED CMS COMMAND (FROM THE COMMAND) 00025000
* 00026000
* DMSBTPLM - NON-EXECUTABLE USER JOB LIMIT TABLE REFERENCED BY 00027000
* DMSITE, DMSPIO AND DMSCIO 00028000
* 00029000
* ENTRY CONDITIONS: 00030000
* 00031000
* DMSBTP - GPR1 POINTS TO DMSCRD (ENTRY) PLIST 00032000
* 00033000
* DMSBTPAB - GPR14 POINTS TO CMS RETURN ADDRESS WHEN CALLED 00034000
* FROM DISABLED CMS COMMAND 00035000
* 00036000
* EXIT CONDITIONS: 00037000
* 00038000
* N/A 00039000
* 00040000
* CALLS TO OTHER ROUTINES: 00041000
* 00042000
* DMSCWT (CONWAIT) - DRAIN ALL CONSOLE I/O 00043000
* DMSSCNN (NEW SCAN) - SCAN A RAW INPUT LINE 00044000
* DMSCRD (CONREAD) - EXECUTE AN ACTUAL CONSOLE READ 00045000
* BATEXIT1 - GIVE CONTROL TO USER 'READ' ROUTINE, IF IT EXISTS 00046000
* BATEXIT2 - GIVE CONTROL TO USER JOB CARD ROUTINE '' 00047000
* 00048000
* EXTERNAL REFERENCES: 00049000
* 00050000
* WAITD - FOR DEVICE END INTERRUPT ON THE READER 00051000
* DMSERR - FOR CMS ERROR MESSAGES 00052000
* FVS - FOR FILE MANAGEMENT INFO. DSECT 00053000
* LINEDIT - FOR CONSOLE MESSAGES AND CP CALLS 00054000
* NUCON - FOR NUCLEUS STORAGE AREA DSECT 00055000
* REGEQU - FOR SYMBOLIC REGISTER NAMES 00056000
* RDCARD - FOR CARD READER READS 00057000
* 00058000
* TABLES/WORKAREAS: 00059000
* 00060000
* CARD - CARD READ BUFFER 00061000
* CPTAB - TABLE OF ALLOWABLE CP COMMANDS 00062000
* RDRTAB - TABLE OF VALID SYMBOLIC NAMES AND DEVICE ADDRS. FOR 00063000
* SPOOL DEVICES 00064000
* KEYS - TABLE OF /SET CARD KEYWORDS 00065000
* DMSBTPLM - USER JOB LIMITS TABLE (BATLIMIT MACRO) 00066000
* 00067000
* REGISTER USAGE: 00068000
* 00069000
* R3 - ADDRESS OF CONSOLE READ BUFFER 00070000
* R5 DMSBTP SECOND BASE REGISTER @VA09951 00070100
* R11 - ADDRESS OF DMSCRD (ENTRY) PLIST 00071000
* R12 - DMSBTP ADDRESSABILITY 00072000
* 00073000
* NOTES: 00074000
* 00075000
* NONE 00076000
* 00077000
* OPERATION: 00078000
* 00079000
* UPON RECEIVING CONTROL, DMSBTP CHECKS THE BATCPEX 00080000
* FLAG IN CASE DMSCPF IS CALLING TO VALIDATE A CP COMMAND 00081000
* ISSUED VIA EXEC OR SVC. IF THE FLAG IS SET ON, BTP BRANCHES 00082000
* DIRECTLY TO CP TRAP ROUTINE DESCRIBED BELOW. OTHERWISE, 00083000
* DMSBTP HAS RECEIVED CONTROL FROM DMSCRD AND SO IT CLEARS 00084000
* THE ACTUAL CMS CONSOLE READ BUFFER AND CHECKS FOR ANY 00085000
* FINISHED READS FOR THE REAL BATCH CONSOLE. IF THE NUMBER OF 00086000
* FINISHED READS IS NOT ZERO, CONTROL IS RETURNED TO DMSCRD TO 00087000
* PROCESS THE REAL CONSOLE READ. IF THERE ARE NO FINISHED 00088000
* READS, A RECORD IS READ FROM THE BM VIRTUAL CARD READER INTO 00089000
* THE CARD BUFFER VIA AN SVC CALL TO CARDRD (DMSCIO). IF THE 00090000
* READER RECORD IS NOT CARD-IMAGE (80), IT IS FLUSHED. 00091000
* 00092000
* THE RECORD IN THE READER BUFFER (CARD) IS SCANNED 00093000
* TO COMPUTE ITS LENGTH WITH TRAILING BLANKS DELETED. THE 00094000
* RECORD IS THEN MOVED TO THE CMS CONSOLE READ BUFFER AND THE 00095000
* COMPUTED LENGTH STORED IN THE ORIGINAL DMSCRD PARAMETER 00096000
* LIST, THE ADDRESS OF WHICH IS PASSED BY DMSCRD WHEN IT 00097000
* INITIALLY PASSES CONTROL TO DMSBTP. 00098000
* 00099000
* IF THE FIRST USER RECORD IS NOT A /JOB CARD AN 00100000
* ERROR MESSAGE (DMSBTP105E) IS ISSUED AND NORMAL CLEAN-UP 00101000
* PERFORMED WITH NO RE-IPL (BATTERM FLAG SET ON). READS TO THE 00102000
* CARD READER ARE THEN ISSUED UNTIL THE NEXT /JOB CARD IS 00103000
* FOUND. 00104000
* 00105000
* OTHERWISE, DMSBTP BRANCHES TO ITS /JOB CARD 00106000
* PROCESSING ROUTINE WHICH FIRST CALLS DMSSCNN VIA BALR IN 00107000
* ORDER THAT THE /JOB CARD BE SCANNED AND TOKENIZED BY CMS. A 00108000
* CHECK IS MADE FOR THE EXISTENCE OF THE USERID AND ACCOUNT 00109000
* NUMBER ON THE CARD. IF THE FIELDS EXIST, A CP DIAGNOSE '4C' 00110000
* IS ISSUED TO START ACCOUNTING RECORDING FOR THAT USERID AND 00111000
* ACCOUNT NUMBER. IF AN ERROR IS RETURNED FROM CP DENOTING AN 00112000
* INVALID USERID, OR IF THE USERID OR ACCOUNT NO. FIELDS WERE 00113000
* MISSING ON THE /JOB CARD, AN ERROR MESSAGE (DMSBTP106E) IS 00114000
* ISSUED AND NORMAL CLEANUP PERFORMED WITH NO RE-IPL (BATTERM 00115000
* FLAG SET ON). 00116000
* 00117000
* THE JOBNAME, IF PROVIDED ON THE JOB CARD, IS SAVED 00118000
* AND A CP MSG IS ISSUED VIA SVC TO INFORM THE SOURCE USERID 00119000
* THAT THEJOB HAS STARTED. NEXT, THE SPOOLING DEVICES ARE 00120000
* CLOSED AND RE-SPOOLED FOR CONTINUOUS OUTPUT, A CP QUERY 00121000
* FILES IS ISSUED FOR INFORMATION PURPOSES AND THE IMPLIED-CP 00122000
* FUNCTION UNDER CMS IS DISABLED VIA AN SVC CALL TO SET 00123000
* (DMSSET) AND THE BATPROF EXEC IS EXECUTED VIA SVC CALL TO 00124000
* EXEC. THE BATNOEX FLAG SET BY DMSBTB TO SUPPRESS USER JOB 00125000
* EXECUTION UNTIL THE /JOB CARD IS DETECTED, IS SET OFF AND 00126000
* FINALLY, A BRANCH IS TAKEN TO READ THE NEXT CARD FROM THE 00127000
* READER FILE (USER JOB). 00128000
* 00129000
* HAVING READ THE /JOB CARD, DMSBTP CONTINUES 00130000
* READING AND CHECKS FOR A */ CARD, A /SET CARD AND A CP 00131000
* COMMAND. IF A CARD IS NONE OF THESE, DMSBTP PASSES CONTROL 00132000
* BACK TO CMS (DMSINT) FOR PROCESSING OF THE COMMAND (OR 00133000
* DATA). 00134000
* 00135000
* IF A /* IS READ AND IT IS THE FIRST CARD OF THE 00136000
* NEW JOB, IT IS ASSUMED TO BE A PRECAUTIONARY MEASURE AND 00137000
* THUS IGNORED BY DMSBTP WHICH THEN READS THE NEXT CARD. IF IT 00138000
* IS NOT THE FIRST CARD A CHECK IS MADE FOR THE BATMOVE FLAG. 00139000
* IF THE FLAG IS ON, THE /* SIGNIFIES AN END-OF-FILE FOR THE 00140000
* MOVEFILE OPERATION FROM THE CONSOLE (READER) AND IS 00141000
* CONSEQUENTLY TRANSLATED TO A NULL LINE FOR MOVEFILE COMMAND. 00142000
* IF THE BATMOVE FLAG IS NOT ON, THE /* IS AN END-OF-JOB 00143000
* INDICATOR AND AN IMMEDIATE BRANCH IS TAKEN TO THE END-OF-JOB 00144000
* ROUTINE FOR CLEAN-UP AND RE-IPL. 00145000
* 00146000
* WHEN ENCOUNTERING A CP COMMAND DMSBTP BRANCHES TO 00147000
* A ROUTINE WHICH FIRST CHECKS A TABLE OF ALLOWABLE CP 00148000
* COMMANDS UNDER BM. IF THE COMMAND IS ALLOWED, A CHECK IS 00149000
* MADE FOR A READER OR OTHER SPOOL DEVICE IN THE COMMAND LINE. 00150000
* IF THE CP COMMAND IS ALLOWED BUT ALTERS THE STATUS OF THE BM 00151000
* READER (OR OTHER SPOOL DEVICE, IN ONE CASE) OR IF THE 00152000
* COMMAND IS NOT ALLOWED AT ALL, AN ERROR MESSAGE (DMSBTP107E) 00153000
* IS ISSUED AND THE NEXT CARD IS READ. 00154000
* 00155000
* IF THE CP COMMAND IS A LINK, THE DEVICE ADDRESS IS 00156000
* STORED IN A TABLE SO THAT DMSBTP CAN DETACH ALL USER DISK 00157000
* DEVICES AT THE END OF THE JOB. 00158000
* 00159000
* A CP DETACH COMMAND IS EXAMINED FOR A DEVICE 00160000
* ADDRESS CORRESPONDING TO THE SYSTEM DISK, THE IPL DISK, THE 00161000
* BM 195 WORK DISK OR ANY SPOOL DEVICE. IF THE DEVICE TO BE 00162000
* DETACHED IS SUCH, THEN AN ERROR MESSAGE (DMSBTP107E) ISSUED 00163000
* AND THE NEXT CARD IS READ. 00164000
* OTHERWISE, DMSBTP RETURNS CONTROL TO CMS (DMSINT) 00165000
* FOR PROCESSING OF THE COMMAND. 00166000
* 00167000
* WHEN A /SET CONTROL CARD IS ENCOUNTERED, THE CARD 00168000
* IS CHECKED FOR VALID KEYWORDS, VALID INTEGER VALUES (LESS 00169000
* THAN OR EQUAL TO THE INSTALLATION DEFAULT VALUES) AND IF AN 00170000
* ERROR IS DETECTED, AN ERROR MESSAGE (DMSBTP108E) IS ISSUED, 00171000
* AN ABEND MESSAGE IS SENT TO THE SOURCE USERID AND THE JOB IS 00172000
* TERMINATED WITH NORMAL CLEAN-UP PERFORMED. IF THE CONTROL 00173000
* CARDVALUES ARE VALID, THE APPROPRIATE FIELDS ARE UPDATED IN 00174000
* THE USER JOB LIMIT TABLE DMSBTPLM AND THE NEXT CARD IS READ. 00175000
* 00176000
* WHEN DMSBTP DETECTS A 'NOT READY' CONDITION AT THE 00177000
* READER A MESSAGE IS TYPED AT THE BM CONSOLE STATING THAT BM 00178000
* IS WAITING FOR READER INPUT. DMSBTP THEN ISSUES THE WAITD 00179000
* MACRO TO LISTEN FOR A READER INTERRUPT. WHEN FIRST DETECTING 00180000
* THE EMPTY READER DMSBTP CALLS THE CP ACCOUNTING ROUTINES VIA 00181000
* A CP DIAGNOSE '4C' TO CHARGE THE WAIT TIME TO THE BM USERID. 00182000
* 00183000
* UPON DETECTING A HARD ERROR AT THE READER DMSBTP 00184000
* SENDS 'INTERVENTION REQUIRED' CP MSG TO THE SYSTEM CONSOLE 00185000
* AND BRANCHES TO ITS ABEND ROUTINE AND THEN WAITS FOR AN 00186000
* INTERRUPT FROM THE READER BY ISSUING THE WAITD MACRO. 00187000
* 00188000
* WHEN A /* CARD IS READ (WITH BATMOVE FLAG OFF) OR 00189000
* WHEN THE END-OF-FILE CONDITION OCCURS AT THE READER, DMSBTP 00190000
* BRANCHES TO THE CLEANUP ROUTINE WHICH SENDS THE SOURCE 00191000
* USERID A CP MSG STATING THAT THE JOB ENDED NORMALLY OR 00192000
* ABNORMALLY (IF CLEANING UP AFTER AN ABEND). CONWAIT (DMSCWT) 00193000
* IS THEN CALLED VIA SVC TO ALLOW ALL CONSOLE I/O TO FINISH, 00194000
* THE SPOOLING DEVICES ARE CLOSED (INCLUDING CONSOLE) AND ALL 00195000
* DISKS LINKED TO DURING THE USER JOB ARE CP DETACHED VIA SVC. 00196000
* 00197000
* AT THIS POINT DMSBTP RELINQUISHES CONTROL BY 00198000
* ISSUING THE CP IPL COMMAND WITH THE 'PARM BATCH' OPTION 00199000
* WHICH LOADS A NEW CMS NUCLEUS EITHER FROM THE 00200000
* IPL DEVICE OR FROM A SHARED SEGMENT. THE NEXT 00201000
* JOB IS STARTED WHEN CMS ATTEMPTS ITS FIRST READ 00202000
* TO THE CONSOLE. 00203000
* 00204000
* THE ABEND ROUTINE IN DMSBTP IS BRANCHED TO (AS 00205000
* DESCRIBED ABOVE) WHEN DMSBTP ITSELF DETECTS AN I/O ERROR AT 00206000
* THE READER. HOWEVER, THE PRIMARY PURPOSE OF THE ROUTINE IS 00207000
* TO RECEIVE CONTROL NOT ONLY FROM DMSABN WHEN THERE IS A CMS 00208000
* ABEND DURING THE USER JOB, BUT ALSO FROM DMSITE, DMSPIO AND 00209000
* DMSCIO WHEN A USER JOB EXCEEDS ONE OF THE BATCH JOB LIMITS 00210000
* (BATXLIM FLAG IS ON). THIS ROUTINE, ENTRY POINT DMSBTPAB, 00211000
* CALLS THE CP DUMP ROUTINE VIA SVC AND THEN BRANCHES TO THE 00212000
* CLEANUP ROUTINE DESCRIBED ABOVE WHICH WILL RE-IPL AND TREAT 00213000
* THE REMAINDER OF THE CURRENT JOB AS A NEW JOB WITH NO /JOB 00214000
* CARD. THIS HAS THE EFFECT OF FLUSHING THE REMAINDER OF THE 00215000
* JOB. 00216000
* THIS ENTRY POINT IS ALSO USED BY THE CMS COMMANDS 00217000
* WHICH ARE DISABLED UNDER BM. IN THIS CASE (BATDCMS FLAG SET 00218000
* ON) AN ERROR MESSAGE IS ISSUED AND CONTROL RETURNED TO CMS. 00219000
* 00220000
* 00221000
* _N_O_T_E: WHEN A CP COMMAND IS 'CALLED VIA SVC' IN 00222000
* DMSBTP, EITHER THE CMS 'CP' MODULE (DMSCPF) IS ACTUALLY 00223000
* CALLED TO ISSUE THE DIAGNOSE INSTRUCTION TO INVOKE THE CP 00224000
* COMMAND OR THE LINEDIT MACRO IS ISSUED WITH THE 'CPCOMM' 00225000
* OPTION WHICH ALSO GENERATES A DIAGNOSE. 00226000
* 00227000
EJECT 00228000
MACRO 00229000
CPF &LINE 00230000
LINEDIT DOT=NO,TYPCALL=SVC,DISP=CPCOMM,TEXT=&LINE 00231000
MEND 00232000
EJECT 00233000
DMSBTP CSECT 00234000
USING DMSBTP,R12,R5 SET ADDRESSABILITY @VA09951 00235000
USING NUCON,R0 00236000
LR R10,R12 SAVE, IN CASE CPF CALLING 00237000
LR R12,R15 00238000
LA R5,4095(0,R15) SET R5 4K HIGHER THAN R12 @VA09951 00238100
LA R5,1(0,R5) MAKES R5 X'1000' EVEN @VA09951 00238200
ST R5,BASE2 FOR SAFTY - WE SOMETIME LOSE THE BASE @VA10476 00238600
ST R10,SAVCPF+48 00239000
TM BATFLAGS,BATCPEX IS THIS 'CP' COMMAND 00240000
BO CPTRAP IF SO, DMSCPF CALLING... 00241000
LR R11,R1 R11 -> DMSCRD PLIST 00242000
L R3,8(,R1) R3 -> ADDRESS OF CONSOLE READ BUFFER 00243000
ST R14,SAVE14 SAVE REG 14 00244000
SPACE 00245000
*********************************************************************** 00246000
* 00247000
* MAIN ROUTINE TO READ FROM THE BATCH CARD READER 00248000
* 00249000
*********************************************************************** 00250000
RDCARD EQU * 00251000
L R1,AFVS 00252000
USING FVSECT,R1 00253000
TM UFDBUSY,ABNBIT ARE WE ABENDING? 00254000
BO ABEND 00255000
MVI 0(R3),C' ' ASSUME BLANK-FILL FOR CLEARING BUFFR 00256000
TM 12(R11),X'01' IS IT BLANK-FILL CODE IN PLIST? 00257000
BZ *+8 SKIP IF SO 00258000
MVI 0(R3),X'00' FILE WITH ZEROES 00259000
MVC 1(129,R3),0(R3) PROPOGATE THE CHARACTER TO CLEAR 00260000
CLC NUMFINRD,ZERO IS THE CONSOLE STACK EMPTY? 00261000
BNE RDSTACK GO READ CONSOLE IF IT IS NOT 00262000
RDCARD CARD,ERROR=NONZERO 00263000
B READOK NO PROBLEMS READING CARD 00264000
NONZERO CH R15,H5 READER RECORD = 80? 00265000
BNE ERR IF SO, FIND THE REAL PROBLEM 00266000
B RDCARD IF NOT= 80, FLUSH IT... 00267000
READOK EQU * 00268000
TM BATFLAGS,BATMOVE+BATNOEX IF 'MOVE' EXECUTING OR '/JOB' 00269000
BNZ NOSHOW DON'T BOTHER SHOWING ON CONSOLE 00270000
WRTERM CARD,80,EDIT=NO 00271000
SPACE 00272000
NOSHOW EQU * 00273000
TM BATFLAGS,BATTERM FLUSHING BECAUSE NO '/JOB' CARD? 00274000
BZ DELMCHK NO 00275000
CLC CARD(5),LJOB IF SO, IS THIS NEW JOB CARD? 00276000
BNE RDCARD NO, CONTINUE FLUSHING JOB... 00277000
DMSKEY NUCLEUS @VA05160 00278000
NI BATFLAGS,255-BATTERM IF SO, START THE NEW JOB 00279000
DMSKEY RESET @VA05160 00280000
B COPY 00281000
SPACE 00282000
H5 DC H'5' 00283000
CARD DC CL80' ' 00284000
LSLSTAR DC CL80'/*' 00285000
LNULLINE DC CL80' ' 00286000
ZERO DC F'0' 00287000
ACARD DC A(CARD) 00288000
BASE2 DC F'0' @VA10476 00288500
SPACE 00289000
DELMCHK EQU * 00290000
CLC CARD(80),LSLSTAR IS THIS THE SPECIAL DELIMITER? 00291000
BNE COPY IF NOT, CONTINUE... 00292000
TM BATFLAGS,BATNOEX IF SO, IS IT 1ST CARD? 00293000
BO RDCARD YES, READ ANOTHER 00294000
TM BATFLAGS,BATMOVE COULD BE 'MOVEFILE' DELIMITER 00295000
BZ EOJ IF NOT, END-OF-JOB INDICATOR 00296000
XR R1,R1 IF SO,SIMULATE NULL LINE FOR DMSMVE 00297000
B COPY1 00298000
SPACE 00299000
COPY EQU * 00300000
SR R1,R1 ZERO LENGTH FOR NULL CARD 00301000
CLC LNULLINE,CARD IS IT A NULL CARD? 00302000
BNE NOTBLANK 00303000
TM BATFLAGS,BATMOVE IS 'MOVE' FROM CONSOLE ACTIVE? 00304000
BZ COPY1 IF NOT, TRANSL. TO NULL LINE 00305000
LA R1,CARD+79 OTHERWISE, ACCEPT THE BLANK RECORD 00306000
B COPYIT 00307000
NOTBLANK EQU * 00308000
LA R1,CARD+79 POINT TO LAST BYTE IN CARD 00309000
SPACE 00310000
* TRUNCATE BLANKS OFF THE END OF THE CARD 00311000
COPYL EQU * 00312000
CLI 0(R1),C' ' BLANK CHAR? 00313000
BNE COPYIT FINISHED TRUNCATING IF NOT 00314000
BCT R1,COPYL LOOP IF SO 00315000
COPYIT EQU * 00316000
S R1,ACARD COMPUTE (LINE LENGTH) - 1 00317000
EX R1,MOVE MOVE IT INTO THE CALLER'S BUFFER 00318000
LA R1,1(,R1) INCREMENT TO GET REAL LENGTH 00319000
SPACE 00320000
COPY1 EQU * 00321000
STCM R1,B'0111',13(R11) STORE LENGTH INTO DMSCRD PLIST 00322000
TM BATFLAGS,BATMOVE @VM28811 00323000
BO EX1CHEK GIVE WHOLE RECORD TO 'MOVE' @VM28811 00324000
TM BATFLAGS,BATNOEX '/JOB' CARD ALREADY READ? 00325000
BZ CHEKCP YES, SKIP THRU 00326000
CLC CARD(5),LJOB START OF JOB? 00327000
BE NEWJOB YES: SPECIAL CLEANUP 00328000
B ERR105E ERROR IF NOT 00329000
SPACE 00330000
MOVE MVC 0(*-*,R3),CARD LENGTH FILLED BY EX 00331000
LJOB DC CL5'/JOB' 00332000
LSET DC CL5'/SET' 00333000
ABATEX1 DC V(BATEXIT1) 00334000
SPACE 00335000
CHEKCP EQU * 00336000
LA R2,CARD GET ADDRESS OF CARD @VA03572 00337000
BLK CLI 0(R2),C' ' BLANK CHARACTER? @VA03572 00338000
BNE CHEKCP1 NO, SEE IF CP COMMAND @VA03572 00339000
LA R2,1(,R2) GET NEXT POSITION @VA03572 00340000
B BLK CHECK NEXT POSITION @VA03572 00341000
CHEKCP1 CLC 0(3,R2),CPLIST CP COMMAND? @VA03572 00342000
BE NEWJOB IF SO, GO TO DMSSCN CALL 00343000
CLC CARD(5),LSET /SET CONTROL CARD? 00344000
BE NEWJOB YES, GO SCAN IT... 00345000
CLC 0(8,R2),BATCK WAS CMSBATCH ISSUED? @VA09951 00345100
BNE NOOOPS NO - SO LETS KEEP ON TRUCKING @VA09951 00345200
LINEDIT DISP=CPCOMM,SUB=(CHARA,ID),RENT=NO,TEXTA=BATMSG 00345300
SR R15,R15 BETTER DO A LITTLE HOUSE KEEPING @VA09951 00345400
B RDCARD FLUSH IT @VA09951 00345500
NOOOPS EQU * @VA09951 00345600
EX1CHEK EQU * 00346000
L R15,ABATEX1 CHECK FOR CONTROL EXIT 00347000
LTR R15,R15 IF 'BATEXIT1 TEXT' NOT LOADED, 00348000
BZ RETURN NO EXIT TAKEN 00349000
LA R1,CARD IF LOADED, POINT TO READ BUFFER... 00350000
BALR R14,R15 AND PASS CONTROL 00351000
LTR R15,R15 IF RC ¬= 0,... 00352000
BNZ RDCARD IGNORE THE RECORD AND GET NEXT. 00353000
* OTHERWISE, CONTINUE AS USUAL... 00354000
RETURN EQU * 00355000
L R14,SAVE14 RESTORE REG 14 00356000
BR R14 RETURN TO CMS (DMSINT) 00357000
SAVE14 DS F SAVE REGISTER 14 HERE 00358000
EJECT 00359000
*********************************************************************** 00360000
* 00361000
* HANDLE ALL 'CP' REQUESTS HERE 00362000
* 00363000
*********************************************************************** 00364000
CPTRAP EQU * 00365000
* 00366000
* FIRST CHEK FOR ALLOWABLE CP COMMAND WHICH 00367000
* DOES NOT CHANGE THE READER(00C) STATUS... 00368000
* 00369000
STM R13,R14,SAVCPF+52 SAVE DMSCPF ENVIRONMENT 00370000
STM R0,R11,SAVCPF 00371000
TM BATFLAG3,BATCPFNG IS THIS AN ERR RET? @VA12384 00371050
BNO CPVALID NO - OK CHECK THE LINK @VA12384 00371100
LR R1,R2 GET LINK CMD PASSED TO CP @VA12384 00371150
CLC 0(4,R1),LINK IS THIS LINK CMD? @VA12384 00371200
BNE RETCPERR NO-RETURN IMMED. TO CPF @VA12384 00371250
LA R1,4(R1) ADJUST ADD FOR DETACH @VA12384 00371300
SR R8,R8 SET UP WORK REGS @VA12384 00371350
LA R9,2 DITTO @VA12384 00371400
CPFTST EQU * @VA12384 00371450
LA R1,1(R1) PASS FIRST BLANK AFTER LINK @VA12384 00371500
CLI 0(R1),X'40' CHARACTER EQUAL BLANK? @VA12384 00371550
BNE CPFTST NO - TRY NEXT ONE @VA12384 00371600
LA R8,1(R8) ADD BLANK COUNT AND CHECK.. @VA12384 00371650
CR R8,R9 IF WE HAVE 2 BLANKS @VA12384 00371700
BNE CPFTST NO - GO CHECK FOR 1 MORE @VA12384 00371750
LA R1,1(R1) BUMP PASS TO DEVICE ADD @VA12384 00371800
LA R8,16 CHECKDET WILL NEED R1 EQUAL @VA12384 00371850
SR R1,R8 .....TO R1-X'10' @VA12384 00371900
B CHECKDET NOW REMOVE IT FROM TABLE @VA12384 00371950
CPVALID EQU * ENTER HERE IF READER COMMAND 00372000
TM 8(R1),X'FF' IF 'CP' ALONE, DON'T ALLOW IT 00373000
BO ERR107EA @VM01530 00374000
LA R7,CPTAB PREPARE TO BXLE THRU ALLOW. CMNDS 00375000
LA R9,ENDCPTAB 00376000
LA R8,10 00377000
CPCHEK LA R2,8(,R1) POINT TO NAMED COMMAND 00378000
LA R10,8 MAX. CHARACTERS 00379000
XR R6,R6 00380000
IC R6,9(R7) PICK UP MINIMUM NO.CHARS 00381000
AR R2,R6 SET MINIMUM ABBREVIATION 00382000
BCTR R6,0 SUB 1 FOR 'EXECUTE' 00383000
SR R10,R6 SET MAX ITERATION @VA11258 00383500
MINCHEK EQU * 00384000
EX R6,COMPCP COMPARE ABBREVIATION 00385000
BNE CPBXLE IF NOT=, GO TO NEXT COMMAND 00386000
CLI 0(R2),C' ' END OF NAMED COMMAND? 00387000
BE FLAGCHK THAT'S GOOD ENOUGH... 00388000
LA R2,1(,R2) BUMP BOTH POINTERS 00389000
LA R6,1(,R6) 00390000
BCT R10,MINCHEK GO BACK AND COMP ONE MORE CHAR. 00391000
B FLAGCHK ALL 8 CHARS MATCHED @VA11258 00391500
CPBXLE BXLE R7,R8,CPCHEK 00392000
B ERR107E TELL USER IF NOT ALLOWED 00393000
SPACE 1 00394000
FLAGCHK TM 8(R7),X'FF' CAN THIS CP CMD CHANGE RDR STATUS? 00395000
BZ LINKCHK IF NOT, GO TO NEXT CHEK... 00396000
BM ALLSPOOL RESTRICT ALL SPOOL DEVICES 00397000
LA R9,RDR RESTRICT ONLY READER 00398000
BAL R14,DEVCHEK CHEK POSSIBLE ABBREVIATION 00399000
LA R9,ENDRTAB NOW PREP FOR DEV ADDR SCAN 00400000
B SCANDEV 00401000
ALLSPOOL EQU * 00402000
LA R9,PUN RESTRICT ALL SPOOL DEVICES 00403000
BAL R14,DEVCHEK CHEK THE ABBREV'S. 00404000
LA R9,ENDSTAB PREP FOR DEV ADDR SCAN 00405000
SCANDEV EQU * 00406000
LA R7,RDRTAB PREPARE TO BXLE THRU DEVICE NAMES 00407000
LA R8,8 00408000
RDRCHK CLC 16(8,R1),0(R7) IS DEVICE ILLEGAL UNDER BATCH? 00409000
BE ERR107E IF SO, TELL USER IT'S A NO NO 00410000
BXLE R7,R8,RDRCHK 00411000
B DETCHK IF NOT FOUND, CONTINUE CHECKS 00412000
EJECT 00413000
RDR DC CL8'READER',AL1(1) 00414000
PRT DC CL8'PRINTER',AL1(1) 00415000
PUN DC CL8'PUNCH',AL1(2) 00416000
SPACE 00417000
COMPDEV CLC 0(*-*,R7),16(R1) BATCH DEV TABLE VS. USER DEVICE 00418000
RDRTAB EQU * POSSIBLE NAMES FOR SPOOL DEVICES 00419000
DC CL8'RDR' 00420000
DC CL8'00C' 00421000
ENDRTAB DC CL8'C' 00422000
DC CL8'PRT' 00423000
DC CL8'00E' 00424000
DC CL8'E' 00425000
DC CL8'PCH' 00426000
DC CL8'00D' 00427000
ENDSTAB DC CL8'D' 00428000
SPACE 2 00429000
CPTAB EQU * TABLE OF ALLOWABLE CP COMMANDS 00430000
* 00431000
* FLAG BYTE = X'FF' INDICATES COMMAND COULD CHANGE STATUS OF RDR 00432000
* FLAG BYTE = X'F0' INDICATES RESTRICTION OF ALL SPOOL DEVICES 00433000
* NUMBER BYTE IS MINIMUM CP ABBREVIATION 00434000
* 00435000
DC CL8'CHANGE',X'FF',AL1(2) 00436000
DC CL8'CLOSE',X'FF',AL1(1) 00437000
DC CL8'DETACH',X'F0',AL1(3) 00438000
DC CL8'DUMP',X'00',AL1(2) @VA12722 00439000
DC CL8'DISPLAY',X'00',AL1(1) 00440000
DC CL8'LINK',X'00',AL1(4) 00441000
DC CL8'MSG',X'00',AL1(1) 00442000
DC CL8'QUERY',X'00',AL1(1) 00443000
DC CL8'REWIND',X'00',AL1(3) 00444000
DC CL8'SMSG',X'00',AL1(2) @VA10749 00444500
DC CL8'SPOOL',X'FF',AL1(2) 00445000
DC CL8'STORE',X'00',AL1(2) 00446000
DC CL8'TAG',X'00',AL1(2) @VA12722 00447000
ENDCPTAB EQU *-10 00448000
EJECT 00449000
DEVCHEK DS 0H SAME AS 'CPCHEK' IN FUNCTION 00450000
LA R7,RDR START OF SYMBOLIC DEVICE NAMES 00451000
LA R8,9 SIZE OF NAME + ABBREV 00452000
DEVNEXT LA R2,16(,R1) POINT TO DEVICE ENTERED 00453000
LA R10,8 MAX. CHARACTERS 00454000
XR R6,R6 00455000
IC R6,8(R7) PICK UP MINIMUM NO. CHARS 00456000
AR R2,R6 SET MIN ABBREVIATION 00457000
BCTR R6,0 SUB 1 FOR 'EXECUTE' 00458000
MINCHEK2 EQU * 00459000
EX R6,COMPDEV COMPARE ABBREVIATION 00460000
BNE DEVBXLE IF NOT=, GO TO NEXT DEVICE 00461000
CLI 0(R2),C' ' END OF NAMED DEVICE? 00462000
BE ERR107E THAT'S BAD ENOUGH... 00463000
LA R2,1(,R2) BUMP BOTH POINTERS 00464000
LA R6,1(,R6) 00465000
BCT R10,MINCHEK2 GO BACK AND COMP ONE MORE CHARACTER 00466000
DEVBXLE BXLE R7,R8,DEVNEXT 00467000
BR R14 RETURN TO 'NOT FOUND' INSTRUCTIONS 00468000
SPACE 00469000
COMPCP CLC 0(*-*,R7),8(R1) BATCH CP TABLE VS. USER COMMAND 00470000
LINK DC CL8'LINK' 00471000
H3 DC H'3' 00472000
SPACE 2 00473000
LINKCHK CLC 8(8,R1),LINK CP 'LINK' COMMAND? 00474000
BNE DETCHK IF NOT, GO TO NEXT CHEK... 00475000
LA R7,8(,R1) POINT TO 1ST DEVICE ADDR (ALMOST) 00476000
L R8,FENCE 00477000
LA R9,56(,R1) POINT TO POSITION FENCE SHOULD BE IN 00478000
LINKFORM LA R7,8(,R7) POINT TO NEXT ENTRY 00479000
LA R4,LINKPARM POINT TO INVALID (FOR BATCH) PARMS 00480000
LA R6,LINKEND END OF SAME @VA09951 00481000
CHKPARM CLC 0(6,R7),0(R4) INVALID LINK PARM? 00482000
BE ERR107E ERROR IF SO... 00483000
LA R4,6(,R4) LOOK AT NEXT ONE IN TABLE 00484000
CR R4,R6 END OF TABLE @VA09951 00485000
BNH CHKPARM CONTINUE TO CHEK IF NOT 00486000
C R8,0(,R7) END OF 'LINK' COMMAND? 00487000
BNE LINKFORM NOT YET, KEEP LOOKING... 00488000
CR R7,R9 IF SO, ARE THERE CORRECT NO.ENTRIES 00489000
BNE ERR107E IF NOT, DON'T ALLOW IT. 00490000
LA R9,ENDSTAB PREP FOR DEV ADDR SCAN @VA11947 00490100
LA R7,RDRTAB PREPARE TO BXLE THRU DEVICE @VA11947 00490200
LA R8,8 SET ENTRY SIZE @VA11947 00490300
LNKCHK CLC 32(8,R1),0(R7) IS DEVICE ILLEGAL UNDER BATCH @VA11947 00490400
BE ERR107E IF SO, TELL USER IT'S A NO NO @VA11947 00490500
BXLE R7,R8,LNKCHK @VA11947 00490600
* 00491000
* KEEP A TABLE OF ALL DEVICES LINKED TO DURING USER 00492000
* JOB SO THAT ALL CAN BE DETACHED AT COMPLETION OF JOB 00493000
* 00494000
LR R2,R1 SAVE R1 POINTER @VM28811 00495000
LA R1,16(,R1) BUMP TO 'LINK' DEVICE @VM28811 00496000
BAL R8,DISKCHEK CHEK FOR ILLEGAL LINKS @VM28811 00497000
LR R1,R2 RESTORE R1 POINTER @VM28811 00498000
LH R8,LINKPTR IF SO, GET NO. LINKS AND 00499000
LA R8,1(,R8) ADD ONE MORE 00500000
LA R9,LINKMAX MAX NO. ENTRIES ALLOWED @VA02329 00501000
CR R8,R9 HAVE WE TOO MANY? @VA02329 00502000
BH ERR107E YES-ERROR EXIT @VA02329 00503000
STH R8,LINKPTR SAVE NEW NO. ENTRIES 00504000
BCTR R8,0 SUB 1 FOR TABLE STORE 00505000
MH R8,H3 EACH ENTRY IS 3 BYTES 00506000
LA R9,LINKTAB 00507000
AR R8,R9 POINT TO NEXT AVAIL. SPACE 00508000
MVC 0(3,R8),32(R1) INSERT 'LINK' DEVICE ADDR IN TAB 00509000
B RETCP GO PROCESS COMMAND 00510000
SPACE 1 00511000
LINKPARM DC CL6'AS' TABLE OF 'LINK' OPTIONAL PARMS 00512000
DC CL6'TO' NOT ALLOWED UNDER BATCH 00513000
DC CL6'PASS=' 00514000
DC CL6'A' 00515000
LINKEND DC CL6'T' 00516000
SPACE 1 00517000
DETCHK CLC 8(3,R1),DETLIST CP 'DETACH' COMMAND? 00518000
BNE RETCP IF NOT, ALL THRU...GO PROCESS 00519000
LA R8,CHECKDET DROP THRU IF VALID @VA02329 00520000
* 00521000
* DON'T ALLOW USER TO DETACH SYSTEM OR IPL DISKS 00522000
* 00523000
DISKCHEK EQU * @VM28811 00524000
UNPK UNIPLD(9),IPLADDR(5) GET BOTH DEV ADDRESSES FROM NUCON 00525000
TR UNIPLD(8),CVTAB TRANSLATE TO EBCDIC 00526000
CLC UNIPLD+1(3),16(R1) FOR COMPARISON 00527000
BE ERR107E TELL USER HE CAN'T 00528000
CLC UNIPLD+5(3),16(R1) 00529000
BE ERR107E 00530000
CLC ADISK(4),16(R1) DON'T ALLOW BATCH WORK DISK EITHER.. 00531000
BE ERR107E @VM03203 00532000
BR R8 RETURN TO CALLER (OR DROP THRU) @VM03203 00533000
* NOW WE MUST REMOVE DISK HE IS DETACHING FROM LIST 00534000
* OF THOSE WE MUST DETACH 00535000
* 00536000
CHECKDET LH R8,LINKPTR GET NO. OF ENTRIES @VM03203 00537000
LA R9,LINKTAB START OF TABLE @VM03203 00538000
MH R8,H3 POINT BEYOND LAST ENTRY @VM03203 00539000
AR R8,R9 ENTRY AFTER LAST @VM03203 00540000
TRYNEXT CLC 0(3,R9),16(R1) LOOK FOR DISK ADDRESS @VM03203 00541000
BE GOTIT @VM03203 00542000
LA R9,3(R9) BUMP THRU TABLE @VM03203 00543000
CR R9,R8 PAST LAST ENTRY? @VM03203 00544000
BL TRYNEXT @VM03203 00545000
B RETCP YES- DROP THRU @VM03203 00546000
GOTIT MVC 0(27,R9),3(R9) MOVE SUBSEQUENT ENTRIES BACK @VM03203 00547000
LH R9,LINKPTR PICK UP ENTRY COUNT AGAIN @VM03203 00548000
BCTR R9,0 REDUCE BY ONE @VM03203 00549000
STH R9,LINKPTR AND PUT BACK @VM03203 00550000
RETCP EQU * @VM03203 00551000
TM BATFLAGS,BATCPEX COMMAND ENTERED THRU READER? 00552000
BZ EX1CHEK IF SO, PASS IT TO CMS... 00553000
XR R15,R15 ZERO RET CODE 00554000
RETCPERR EQU * COME HERE IF CP CMND NOT ALLOWED 00555000
LR R3,R15 SAVE RETURN CODE ACROSS SVC203 @VA07507 00555100
DMSKEY NUCLEUS @VA05160 00556000
NI BATFLAGS,255-BATCPEX RESET 00557000
NI BATFLAG3,255-BATCPFNG RESET ERROR FLAG @VA12384 00557500
DMSKEY RESET @VA05160 00558000
LR R15,R3 RESTORE RETURN CODE @VA07507 00558100
LM R0,R14,SAVCPF RESTORE DMSCPF ENVIRONMENT 00559000
BR R14 AND RETURN TO DMSCPF 00560000
SPACE 00561000
SAVCPF DC 15F'0' SAVE AREA FOR DMSCPF REGS 00562000
SPACE 00563000
ADISK DC CL4'195' 00564000
LINKPTR DC H'0' NO. ENTRIES IN LINK TABLE 00565000
LINKTAB DC CL30' ' LINK DEVICE TABLE (10 ENTRIES MAX.) 00566000
GARB DC CL30' ' BUFFER AREA @VA02329 00567000
LINKMAX EQU (*-GARB)/3 MAX ENTRIES ALLOWED @VA02329 00568000
ABATEX2 DC V(BATEXIT2) EXIT FOR USER 'JOB' CARD CHECK 00569000
EJECT 00570000
*********************************************************************** 00571000
* 00572000
* VALIDATE THE '/JOB' CARD AND INITIALIZE JOB IF VALID 00573000
* 00574000
*********************************************************************** 00575000
NEWJOB EQU * 00576000
LA R1,CARD SCAN THE JOB CARD 00577000
L R10,12(R11) PROVIDE LINE COUNT 00578000
LA R0,0(,R10) CLEAR HIGH ORDER BYTE 00579000
L R15,ASCANN 00580000
BALR R14,R15 CALL DMSSCNN 00581000
CLC 0(3,R1),CPLIST PROCESSING A 'CP' COMMAND? 00582000
BE CPVALID IF SO, VALIDATE CP COMMAND 00583000
CLC 0(5,R1),LSET 00584000
BE SETCARD 00585000
SPACE 1 00586000
L R15,ABATEX2 CHECK FOR 'JOB' CARD EXIT 00587000
LTR R15,R15 IF 'BATEXIT2 TEXT' NOT LOADED 00588000
BZ JOBCHEK NO EXIT TAKEN 00589000
BALR R14,R15 IF LOADED, PASS CONTROL 00590000
LTR R15,R15 IF RC ¬= 0, 00591000
BNZ ERR106E PROVIDE ERR MSG FOR HIM 00592000
SPACE 1 00593000
JOBCHEK EQU * NORMAL BATCH 'JOB' CARD CHECK 00594000
TM 8(R1),X'FF' USERID? 00595000
BO ERR106E ERROR IF NOT 00596000
TM 16(R1),X'FF' 00597000
BO ERR106E ERROR IF NO ACCOUNT NO. 00598000
MVC CPACNT(16),8(R1) PROVIDE ACCT. INFO TO CP 00599000
LA R2,CPACNT POINT TO IT... 00600000
LA R4,4 TELL CP IT'S USERID AND NO. 00601000
DC X'8324004C' PUNCH LAST JOB INFO & START NEW JOB 00602000
BC 2,ERR106E INVALID USERID 00603000
MVC ID(8),8(R1) OTHERWISE, SPREAD THE USERID 00604000
TM 24(R1),X'FF' JOB NAME? 00605000
BO STARTMSG NO, USE DEFAULT 00606000
MVC JNAME(8),24(R1) YES, USE IT. 00607000
* 00608000
STARTMSG EQU * 00609000
LINEDIT DISP=CPCOMM,SUB=(CHARA,ID,CHARA,JNAME),RENT=NO, *00610000
TEXT='MSG ........ JOB ''........'' STARTED' 00611000
CPF 'QUERY FILES' 00612000
B INIT 00613000
SPACE 2 00614000
CPACNT DS 0D ACCOUNT. INFO FOR CP DIAGNOSE 00615000
DC CL8'USERID' 00616000
DC CL8'ACCT.NO.' 00617000
SPACE 2 00618000
*********************************************************************** 00619000
* RESET SPOOLING DEVICES INCLUDING TAG RECORDS 00620000
*********************************************************************** 00621000
INIT EQU * 00622000
CPF 'TAG DEV CONSOLE' 00623000
CPF 'READY 00D' @VA05468 00624000
CPF 'READY 00E' @VA05468 00625000
CPF 'SP CON START OFF NOTERM CLASS T FLASH NULL 0 *00626000
MODIFY NULL CHARS NULL FCB NULL' @VA12624 00626500
CPF 'SPOOL RDR CLASS * CONT NOHOLD' @VA02757 00627000
CPF 'SPOOL PRT CLASS A CONT COPY 1 OFF CLOSE FLASH NULL 0 *00628000
MODIFY NULL CHARS NULL FCB NULL' @VA12624 00629000
CPF 'SPOOL PUN CLASS A CONT COPY 1 OFF CLOSE' @VA12624 00630000
CPF 'TAG DEV PRT' 00633000
CPF 'TAG DEV PUN' 00634000
EJECT @VA12624 00634500
LA R1,SETLIST SET IMPLIED-CP OFF 00635000
SVC 202 00636000
LA R1,PROFLIST 'BATPROF' EXEC 00637000
SVC 202 00638000
DC AL4(*+4) 00639000
SPACE 00640000
DMSKEY NUCLEUS @VA05160 00641000
NI BATFLAGS,255-BATTERM-BATNOEX (IN CASE NO IPL) 00642000
OI BATFLAGS,BATUSEX SIGNAL USER JOB START 00643000
DMSKEY RESET @VA05160 00644000
B RDCARD GET NEXT CARD 00645000
SPACE 00646000
PROFLIST DS 0F 00647000
DC CL8'EXEC' 00648000
DC CL8'BATPROF' 00649000
FENCE DC 8X'FF' 00650000
SPACE 00651000
SETLIST DC CL8'SET' 00652000
DC CL8'IMPCP' 00653000
DC CL8'OFF' 00654000
DC 8X'FF' 00655000
EJECT 00656000
*********************************************************************** 00657000
* 00658000
* COME HERE FROM DMSABN OR DMSERR WITH 'DIE' OPTION. 00659000
* ALSO FROM DMSITE, DMSPIO AND DMSCIO WHEN JOB LIMIT EXCEEDED 00660000
* AND FROM CMS COMMANDS WHICH ARE DISABLED UNDER BATCH 00661000
* 00662000
*********************************************************************** 00663000
SPACE 00664000
ENTRY DMSBTPAB 00665000
DMSBTPAB EQU * 00666000
BALR R15,0 00667000
USING *,R15 00668000
L R12,ADMSBTP SET BASE REG 00669000
L R5,BASE2 SET SECOND BASE REG @VA10476 00669500
DROP R15 00670000
TM BATFLAG2,BATDCMS+BATXLIM SPECIAL ABEND? 00671000
BZ ABEND NO 00672000
TM BATFLAG2,BATXLIM YES, USER JOB LIMIT? 00673000
BO ERR109E YES 00674000
ST R14,SAVE14 SAVE CMS RETURN ADDR 00675000
B ERR107EA DISABLED CMS COMMAND @VM01530 00676000
SPACE 00677000
ABEND EQU * 00678000
MVC ID+8(8),JNAME COMPLETE DUMP ID 00679000
LA R1,CPDUMP 00680000
SVC 202 DUMP THE MACHINE 00681000
DC AL4(*+4) @VM28811 00682000
ABENDMSG EQU * COME HERE WHEN NO DUMP REQUIRED 00683000
LA R2,LABEND 00684000
B FINISH 00685000
SPACE 00686000
ADMSBTP DC A(DMSBTP) 00687000
LABEND DC CL8'ABEND' 00688000
LENDED DC CL8'ENDED' 00689000
SPACE 00690000
CPDUMP DC CL8'CP' 00691000
DC CL8'DUMP' 00692000
DC CL8'0-END' 00693000
DC CL8'*' @VM28811 00694000
ID DC CL8'CMSBATCH' USER ID (DEFAULT) 00695000
DC CL8' ' 00696000
DC 8X'FF' 00697000
SPACE 00698000
CONWAIT DC CL8'CONWAIT' 00699000
EJECT 00700000
*********************************************************************** 00701000
* 00702000
* COME HERE WHEN END-OF-JOB DETECTED 00703000
* 00704000
*********************************************************************** 00705000
EOJ EQU * 00706000
LA R2,LENDED 00707000
SPACE 2 00708000
FINISH EQU * 00709000
LINEDIT DISP=CPCOMM,RENT=NO, *00710000
SUB=(CHARA,ID,CHARA,JNAME,CHARA,(R2)), *00711000
TEXT='MSG ........ JOB ''........'' ........' 00712000
SPACE 00713000
FIN1 EQU * 00714000
DMSKEY NUCLEUS @VA05160 00715000
NI BATFLAGS,255-BATUSEX SIGNAL USER JOB END 00716000
DMSKEY RESET @VA05160 00717000
LINEDIT SUB=(CHARA,(R2)), *00718000
TEXT='CMSBATCH ........' 00719000
LA R1,CONWAIT WAIT FOR CONSOLE TO RELAX 00720000
SVC 202 00721000
CPF 'SPOOL PRT NOCONT NOHOLD' 00722000
CPF 'SPOOL PUN NOCONT NOHOLD' 00723000
MVC CLOSDEV(8),PRT BUILD 'CLOSE' PLIST 00724000
LA R1,CPLIST 00725000
SVC 202 CLOSE THE PRINTER 00726000
DC AL4(*+4) IGNORE THE ERRORS @VA14291 00726500
MVC CLOSDEV(8),PUN BUILD 'CLOSE' PLIST 00727000
LA R1,CPLIST 00728000
SVC 202 CLOSE THE PUNCH 00729000
DC AL4(*+4) IGNORE THE ERRORS @VA14291 00729500
CPF 'SPOOL RDR CLASS * CONT' @VA02757 00730000
CPF 'SPOOL PRT CLASS A NOCONT COPY 1 OFF' 00731000
CPF 'SPOOL PUN CLASS A NOCONT COPY 1 OFF' 00732000
EJECT 00733000
*********************************************************************** 00734000
* CLEAR THE SPOOL DEVICE TAG RECORDS 00735000
*********************************************************************** 00736000
CPF 'TAG DEV PRT' 00737000
CPF 'TAG DEV PUN' 00738000
SPACE 1 00739000
EJECT 00740000
*********************************************************************** 00741000
* NOW DETACH ALL DISKS THAT USER JOB LINKED TO 00742000
* BUT FIRST CLOSE ANY OPEN FILES 00742500
*********************************************************************** 00743000
LA R1,FINISPL CLOSE ALL FILES @VA10476 00743200
SVC 202 @VA10476 00743400
DC AL4(*+4) IGNORE ERRORS @VA10476 00743600
LH R7,LINKPTR NO. ENTRIES IN LINK TABLE 00744000
LTR R7,R7 00745000
BZ NOLINKS SKIP THRU IF NO LINKS WERE MADE 00746000
LA R8,LINKTAB 00747000
MVC CPCMD(24),DETLIST 00748000
DETPROC MVC CPCMD+8(3),0(R8) PREPARE 'DETACH' PLIST 00749000
LA R1,CPLIST 00750000
SVC 202 DETACH THE DISK 00751000
DC AL4(*+4) O.K. IF USER DETACHED IT 00752000
LA R8,3(,R8) POINT TO NEXT LINK ENTRY 00753000
BCT R7,DETPROC LOOP UNTIL ALL ENTRIES DETACHED 00754000
NOLINKS EQU * 00755000
*********************************************************************** 00756000
* RESET THE SPOOLED CONSOLE INCLUDING TAG RECORD 00757000
CPF 'SPOOL CONS STOP NOCONT' @VA05657 00758000
CPF 'CLOSE CONS NAME BATCH CONSOLE' 00759000
CPF 'TAG DEV CONSOLE' 00760000
CPF 'SPOOL CONSOLE NOHOLD CLASS T COPY 1' @VA05657 00761000
TM BATFLAGS,BATRERR TROUBLE AT READER? 00762000
BZ REIPL 00763000
DMSKEY NUCLEUS @VA05160 00764000
NI BATFLAGS,255-BATRERR IF SO,GO BACK AND WAIT FOR OPERATOR 00765000
DMSKEY RESET @VA05160 00766000
B WAITMSG 00767000
EJECT 00768000
REIPL EQU * 00769000
TM BATFLAG2,BATSTOP WAS 'HB' ENTERED TO STOP ME?@V2D2721 00770000
BZ NEXTJOB IF NOT, REIPL FOR NEXT JOB @V2D2721 00771000
XR R1,R1 IF SO, GENERATE LAST JOB ACCTG @V2D2721 00772000
DC X'8310004C' BEFORE LOGOUT... @V2D2721 00773000
CPF 'LOGOUT' LOGOUT THE BATCH MACHINE @V2D2721 00774000
NEXTJOB EQU * @V2D2721 00775000
TM BATFLAGS,BATTERM FLUSHING THE JOB? 00776000
BO RDCARD 00777000
CLI SYSNAME,OFF SAVED SYSTEM IN USE ? @V305066 00778000
BE DEVIPL NO, USE DEVICE IPL @V305614 00779000
MVC IPLDEV(8),SYSNAME USE SAVED SYSTEM NAME @V305614 00780000
SETSEG L R4,ASYSNAMS POINT TO SYSNAMES TABLE @V305614 00781000
USING SYSNAMES,R4 ..... @V305614 00782000
MVC IPLSEG(8),CMSSEG PASS ALONG CMSSEG ENTRY @V305614 00783000
B IPLIT NOW IPL, EVERYBODY... @V2D2721 00784000
DEVIPL EQU * @V2D2721 00785000
UNPK UNIPLD(5),IPLADDR(3) GET IPL DEVICE ADDR 00786000
TR UNIPLD(4),CVTAB AND CONVERT TO EBCDIC 00787000
MVC IPLDEV(3),UNIPLD+1 AND IPL IT AGAIN 00788000
B SETSEG GO GET CMSSEG ENTRY @V305614 00789000
IPLIT EQU * @V2D2721 00790000
LA R1,IPLIST 00791000
LA R4,IPLENGTH @V2D2721 00792000
DC X'83140008' DIAGNOSE THE IPL @V2D2721 00793000
SPACE 00794000
UNIPLD DS CL9 00795000
DC C'0123456789ABCDEF' TRANSLATE TABLE 00796000
CVTAB EQU *-X'FF'-1 00797000
SPACE 1 00798000
IPLIST DS 0F 00799000
DC CL4'IPL' @V2D2721 00800000
IPLDEV DC CL9' ' @V2D2721 00801000
DC CL7'PARM' @V2D2721 00802000
IPLCODE DC CL8'BATCH' @V2D2721 00803000
DC CL4'SEG=' @V305614 00804000
IPLSEG DC CL8'CMSSEG' @V305614 00805000
IPLENGTH EQU *-IPLIST @V2D2721 00806000
SPACE 00807000
CPLIST DS 0D FOR CP CALLS WITH SUBSTITUTION 00808000
DC CL8'CP' 00809000
CPCMD DC CL8'CLOSE' 00810000
CLOSDEV DC CL8' ' 00811000
DC CL8'NAME' 00812000
DC CL8'CMSBATCH' 00813000
JNAME DC CL8'JOB' 00814000
DC 8X'FF' 00815000
SPACE 1 00816000
FINISPL DC CL8'FINIS' PLIST TO CLOSE FILES @VA10476 00816200
DC 3CL8'*' @VA10476 00816400
DC 8X'FF' @VA10476 00816600
SPACE 1 @VA10476 00816800
DETLIST DC CL8'DETACH' 00817000
DC CL8' ' 00818000
DC 8X'FF' 00819000
SPACE 1 00820000
H1 DC H'1' 00821000
H2 DC H'2' 00822000
OFF EQU X'00' @V305066 00823000
EJECT 00824000
*********************************************************************** 00825000
* 00826000
* COME HERE WHEN NON-ZERO (OTHER THAN '5') RETURN FROM CARDIO 00827000
* 00828000
*********************************************************************** 00829000
ERR EQU * 00830000
CH R15,H1 END OF FILE? 00831000
BNE UNITCHEK 00832000
TM BATFLAGS,BATNOEX COULD BE AN EMPTY READER 00833000
BO WAITMSG IT IS... 00834000
B EOJ OTHERWISE, END OF FILE 00835000
UNITCHEK EQU * 00836000
CH R15,H2 NOT READY? 00837000
BE WAITMSG READER EMPTY 00838000
DMSKEY NUCLEUS @VA05160 00839000
OI BATFLAGS,BATRERR SOMETHING WRONG WITH READER... 00840000
DMSKEY RESET @VA05160 00841000
CPF 'MSG OP HARD RDR ERROR ..INTERVENTION REQUIRED X00842000
ON BATCH MACHINE' @VA02633 00843000
B ABEND DUMP, CLEAN UP, AND RETURN BELOW 00844000
WAITMSG EQU * 00845000
XR R1,R1 RX = 0 MEANS USE CALLING USERID 00846000
DC X'8310004C' CHARGE BATCH FOR WAIT TIME 00847000
LINEDIT TEXT='WAITING FOR READER' 00848000
WAITD RDR1 00849000
B RDCARD 00850000
EJECT 00851000
*********************************************************************** 00852000
* 00853000
* VALIDATE THE /SET CARD AND UPDATE JOB LIMIT TABLE IF VALID 00854000
* 00855000
*********************************************************************** 00856000
SETCARD EQU * PROCESS THE /SET CONTROL CARD 00857000
LA R6,8 KEYWORD TABLE ENTRY SIZE 00858000
LA R7,ENDKEYS 00859000
SPACE 00860000
CARDSCAN EQU * 00861000
LA R1,8(,R1) POINT TO NEXT KEYWORD 00862000
TM 0(R1),X'FF' 00863000
BO RDCARD ALL DONE, GET NEXT CARD 00864000
LA R14,KEYS POINT TO ALLOWABLE KEYWORDS @VA09951 00865000
XR R4,R4 USE R4 FOR TABLE INDEX 00866000
TABLOOP EQU * LOOP THRU KEYWORD TABLE 00867000
CLC 0(8,R14),0(R1) TABEL ENTRY = CARD PARM? @VA09951 00868000
BE NUMCHEK HIT, GO VALIDATE 00869000
LA R4,1(,R4) KEEP TRACK OF KEYWORD 00870000
BXLE R14,R6,TABLOOP AND KEEP LOOKING..... @VA09951 00871000
B ERR108E STRANGE KEYWORD 00872000
SPACE 00873000
NUMCHEK EQU * 00874000
LA R1,8(,R1) POINT TO INTEGER VALUE 00875000
TM 0(R1),X'FF' 00876000
BO ERR108E NO-NO IF NOT THERE 00877000
BAL R14,CONVERT OTHERWISE, CHEK THE INTEGER 00878000
LA R10,DMSBTPLM VALID INTEGER...PUT IT IN LIMIT TABL 00879000
SLL R4,2 R4 * 4 = LIMIT TABLE DISPLACMT. 00880000
LH R9,0(R4,R10) R9 -> DEFAULT LIMIT 00881000
CR R8,R9 USER LIMIT > DEFAULT LIMIT? 00882000
BH ERR108E ERROR IF SO 00883000
STH R8,0(R4,R10) STORE THE NEW USER LIMIT 00884000
B CARDSCAN O.K., GET NEXT PARM ON CARD 00885000
SPACE 00886000
KEYS EQU * /SET CARD KEYWORD TABLE 00887000
DC CL8'TIME' ORDER OF KEYWORDS MUST CORRESPOND 00888000
DC CL8'PRINT' TO THE ORDER IN DMSBTPLM ('BATLIMIT' 00889000
DC CL8'PUNCH' 00890000
ENDKEYS EQU * 00891000
SPACE 00892000
CONVERT EQU * 00893000
LA R8,CHARMAX+1 SET R8 WITH MAX CHAR COUNT + 1 00894000
LA R9,CHARMAX SET R9 TO MAX CHAR COUNT 00895000
LR R10,R1 SAVE PLIST POINTER 00896000
* 00897000
* SEARCH FOR THE FIRST BLANK IN THE STRING TO GET THE COUNT. 00898000
* 00899000
CONV1 CLI 1(R10),BLANK ? FIND 1ST BLANK ? 00900000
BE CONV2 YES, CONTINUE PROCESSING 00901000
LA R10,1(,R10) UPDATE TO NEXT CHARACTER 00902000
BCT R9,CONV1 DO THIS MAX-1 TIMES, I.E., 00903000
* THE 1ST CHAR COULD NOT HAVE BEEN BLANK. 00904000
B ERR108E TOO MANY CHARACTERS, ERROR EXIT. 00905000
* 00906000
* NOW CHECK TO MAKE SURE ALL CHARACTERS ENTERED ARE NUMERICS. 00907000
* PLIST NOW POINTS TO THE LAST CHARACTER (DIGIT). 00908000
* 00909000
CONV2 SR R8,R9 GET COUNT OF CHAR IN R8 00910000
LR R2,R8 IN R2 ALSO 00911000
CONV3 CLI 0(R10),C'0' ? IS IT NUMERIC ? 00912000
BL ERR108E NO, ERROR EXIT 00913000
CLI 0(R10),C'9' 00914000
BH ERR108E DITTO 00915000
BCTR R10,R0 BACK UP TO PREVIOUS CHAR 00916000
BCT R2,CONV3 DO THIS FOR EACH CHARACTER 00917000
* 00918000
* NOW PUT IN THE DECIMAL SIGN AND PACK THE NUMERICS. 00919000
* PLIST NOW POINTS TO THE CHARACTER BEFORE THE FIRST ONE. 00920000
* 00921000
AR R10,R8 POINT PLIST TO LAST CHARACTER 00922000
NI 0(R10),X'CF' PUT IN DECIMAL + SIGN 00923000
BCTR R8,R0 DECREMENT CHARACTER COUNT TO: 00924000
SR R10,R8 1. POINT PLIST TO 1ST CHARACTER, AND 00925000
* 2. REDUCE PACK COUNT FOR EXECUTE 00926000
EX R8,EXPACK PACK THE NUMERICS IN THE PLIST 00927000
CVB R8,PACK CONVERT THIS TO BINARY 00928000
C R8,NUMAX COMPARE IT TO THE MAX ALLOWED 00929000
BH ERR108E TOO BIG FOR HALFWORD 00930000
BR R14 RETURN TO INVOKER 00931000
SPACE 00932000
EXPACK PACK PACK(8),0(0,R10) 00933000
PACK DC D'0' 00934000
NUMAX DC F'32767' 00935000
CHARMAX EQU 5 00936000
BLANK EQU X'40' 00937000
SPACE 2 00938000
BATLIMIT CSECT 00939000
EJECT 00940000
*********************************************************************** 00941000
* 00942000
* VARIOUS ERROR MESSAGES 00943000
* 00944000
*********************************************************************** 00945000
ERR107EA EQU * @VM01530 00946000
LR R2,R1 R1 -> INVALID PLIST @VM01530 00947000
B ERR107EB PRINT THE MSG @VM01530 00948000
ERR107E EQU * 00949000
LA R2,8(,R1) POINT TO CP/CMS COMMAND 00950000
ERR107EB EQU * @VM01530 00951000
DMSERR NUM=107,LET=E,SUB=(CHAR8A,(R2)), *00952000
TEXT='CP/CMS COMMAND ''................'' NOT ALLOWED' 00953000
TM BATFLAG2,BATDCMS IS IT CMS COMMAND 00954000
BNZ RETCMS YES, DROP THRU 00955000
TM BATFLAGS,BATCPEX COMMAND ENTERED THRU READER? 00956000
BZ RDCARD IF SO, CANCEL IT AND READ NEXT ONE 00957000
LA R15,88 IF NOT, LOAD ERROR CODE 00958000
B RETCPERR AND RETURN 00959000
RETCMS EQU * 00960000
DMSKEY NUCLEUS @VA05160 00961000
NI BATFLAG2,255-BATDCMS RESET 00962000
DMSKEY RESET @VA05160 00963000
LA R15,88 SET CMS RETURN CODE 00964000
B RETURN RETURN TO CMS... 00965000
SPACE 1 00966000
ERR105E EQU * 00967000
DMSERR NUM=105,LET=E,TEXT='NO JOB CARD PROVIDED' 00968000
B FLUSHFLG BETTER FLUSH THE JOB 00969000
EJECT 00970000
ERR106E EQU * 00971000
DMSERR NUM=106,LET=E,TEXT='/JOB CARD FORMAT INVALID' 00972000
FLUSHFLG EQU * COME HERE TO FLUSH REMAINDER OF JOB 00973000
DMSKEY NUCLEUS @VA05160 00974000
OI BATFLAGS,BATTERM 00975000
DMSKEY RESET @VA05160 00976000
LA R2,LENDED INSURE PROPER MSG 00977000
B FIN1 CLEAN-UP AND FLUSH 00978000
SPACE 00979000
ERR108E EQU * 00980000
DMSERR NUM=108,LET=E,TEXT='/SET CARD FORMAT INVALID' 00981000
B ABENDMSG 00982000
SPACE 00983000
ERR109E EQU * 00984000
TM BATFLAG2,BATXCPU 00985000
BZ PRTX 00986000
LA R2,CPU USER CPU LIMIT EXCEEDED 00987000
B XMSG 00988000
CPU DC CL8'CPU' 00989000
PRTX TM BATFLAG2,BATXPRT 00990000
BZ PUNX 00991000
LA R2,PRT PRINTED LINES LIMIT EXCEEDED 00992000
B XMSG 00993000
PUNX LA R2,PUN PUNCHED CARD LIMIT EXCEDED 00994000
EJECT 00995000
XMSG DMSERR NUM=109,LET=E,SUB=(CHARA,(R2)), *00996000
TEXT='........ LIMIT EXCEEDED' 00997000
B ABENDMSG 00998000
EJECT 00999000
*********************************************************************** 01000000
* 01001000
* IF THE CONSOLE STACK IS NON-EMPTY, THEN WE CALL WAITRD FOR REAL. 01002000
* 01003000
*********************************************************************** 01004000
RDSTACK EQU * 01005000
LR R1,R11 RESTORE DMSCRD PLIST POINTER 01006000
L R15,ADMSCRD 01007000
L R14,SAVE14 RESTORE REG 14 01008000
LR R12,R15 ALTERNATE BASE REG, IF NEEDED 01009000
BR R15 GO READ FROM CONSOLE STACK 01010000
BATCK DC CL8'CMSBATCH' @VA09951 01010100
BATMSG DC X'44' @VA09951 01010110
DC CL13'MSG ........ ' @VA09951 01010120
DC CL37'''CMSBATCH'' NOT ALLOWED IN JOB STREAM.' @VA09951 01010130
DC CL18' STATEMENT IGNORED' @VA09951 01010140
EJECT 01011000
LTORG 01012000
REGEQU 01013000
NUCON 01014000
SYSNAMES , @V305614 01015000
FVS 01016000
END 01017000