CMX TITLE 'DMTCMX (RSCS) VM/370 - RELEASE 6' 00001000 MACRO 00002000 &LABEL CDEF &CVERB,&CVMIN,&CCOD,&CCLA,&CPROC 00003000 LCLC &PROCAD 00004000 &PROCAD SETC '&CVERB' 00005000 AIF (T'&CPROC EQ 'O').PROCOK 00006000 &PROCAD SETC '&CPROC' 00007000 .PROCOK ANOP 00008000 &LABEL DC 0F'0',CL8'&CVERB' 00009000 DC AL2(&CVMIN-1),XL1'&CCOD',XL1'&CCLA' 00010000 DC A(&PROCAD) 00011000 SPACE 00012000 MEND 00013000 EJECT 00014000 *. 00015000 * MODULE NAME - 00016000 * 00017000 * DMTCMX 00018000 * 00019000 * FUNCTION - 00020000 * 00021000 * THIS MODULE IS INCLUDED AS PART OF THE REX SYSTEM CONTROL 00022000 * TASK. DMTCMX IS CALLED IS SEVERAL PLACES IN DMTREX, THE 00023000 * MAIN REX CONTROL ROUTINE. DMTCMX ACCEPTS AN EBCDIC 00024000 * STRING, AND EXECUTES THE RSCS COMMAND THAT IS REPRESENTED 00025000 * BY THE STRING. 00026000 * 00027000 * ATTRIBUTES - 00028000 * 00029000 * REUSABLE 00030000 * 00031000 * ENTRY POINTS - 00032000 * 00033000 * DMTCMX - EXECUTE AN RSCS COMMAND 00034000 * 00035000 * ENTRY CONDITIONS - 00036000 * 00037000 * DMTCMX MAY BE CALLED FROM ROUTINES WTHIN THE REX TASK 00038000 * 00039000 * REG.0 = 0 IF COMMAND ORIGINATED FROM THE LOCAL OPERATOR, 00040000 * OTHERWISE TASK NAME OF COMMAND ORIGINATOR 00041000 * REG.1 = ADDR OF COMMAND EXECUTION REQUEST BUFFER 00042000 * REG.14 = RETURN ADDRESS 00043000 * REG.15 = ENTRY ADDRESS 00044000 * 00045000 * EXIT CONDITIONS - 00046000 * 00047000 * NORMAL - 00048000 * 00049000 * REG.15 = NUMBER OF LAST RESPONSE MSG ISSUED (BINARY) 00050000 * 00051000 * ERROR - 00052000 * 00053000 * REG.15 = NUMBER OF LAST RESPONSE MSG ISSUED (BINARY) 00054000 EJECT 00055000 * 00056000 * CALLS TO OTHER ROUTINES - 00057000 * 00058000 * DMTMGX - TO ISSUE RESPONSE MESSAGES 00059000 * DMTCRE - TO CREATE LINE DRIVER TASKS 00060000 * 00061000 * EXTERNAL REFERENCES - 00062000 * 00063000 * DMTCREDA - RSCS SYSTEM DISK I/O TABLE 00064000 * DMTREXID - DISCONN MSG USER ID FOR RSCS MSGS 00065000 * DMTREXCN - RECS CONSOLE I/O TABLE 00066000 * 00067000 * TABLES / WORKAREAS - 00068000 * 00069000 * DMTVEC - COMMON SUPERVISOR AREA 00070000 * DMTSYS - RSCS SYSTEM CONTROL COMMON AREA 00071000 * LINK TABLES 00072000 * FILE TAGS 00073000 * 00074000 * SEE INDIVIDUAL ROUTINES 00075000 * 00076000 * 00077000 * REGISTER USAGE - 00078000 * 00079000 * ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00080000 * ANY INDIVIDUAL DEVIATIONS OR EXTENSIONS ARE LISTED WITH THE 00081000 * COMMAND DESCRIPTION 00082000 * 00083000 * GPR0 = 0 IF LOCAL ORIGIN, ELSE ORIGIN TASK NAME 00084000 * GPR1 = COMMAND REQUEST BUFFER ADDR 00085000 * GPR2 = LINK TABLE ENTRY POINTER 00086000 * GPR3 = FILE TAG POINTER 00087000 * GPR4 = SCRATCH 00088000 * GPR5 = SCRATCH 00089000 * GPR6 = SCRATCH (GENERALLY, EBCDIC STRING TARGET POINTER) 00090000 * GPR7 = SCRATCH 00091000 * GPR8 = SCRATCH 00092000 * GPR9 = SCRATCH 00093000 * GPR10 = THIRD BASE REG 00094000 * GPR11 = SECOND BASE REG 00095000 * GPR12 = FIRST BASE REG 00096000 * GPR13 = SCRATCH (ALMOST UNUSED) 00097000 * GPR14 = RETURN ADDRESS 00098000 * GPR15 = ENTRY ADDRESS 00099000 * 00100000 * NOTES - 00101000 * 00102000 * COMMAND RESPONSE MESSAGES ARE TREATED AS NORMAL RSCS 00103000 * MESSAGES, AND ARE HANDLED THROUGH DMTMGX. THE DEFAULT 00104000 * MESSAGE SEVERITY AND ROUTING (AS DEFINED IN DMTMSG) ARE 00105000 * USED EXCEPT IN THE CASE OF DMTCMX170I (RESPONSE TO THE 00106000 * MSG COMMAND), IN WHICH THE MESSAGE ROUTING VARIES 00107000 * DEPENDING ON THE SEMANTIC CONTEXT. 00108000 * 00109000 * OPERATION - 00110000 * 00111000 * THE BASE REGISTERS ARE ESTABLISHED, THE COMMAND ORIGIN 00112000 * LINK TABLE ENTRY IS LOCATED, THE BASE COMMAND ELEMENT TABLE 00113000 * AND MESSAGE REQUEST BUFFER ARE INITIALIZED, DMTCMX003 00114000 * MESSAGE IS ISSUED FOR REMOTE ORIGIN COMMANDS, AND THE 00115000 * COMMAND VERB IS DECODED. IF THE COMMAND VERB IS UNDE- 00116000 * FINED, DMTCMX201E IS ISSUED; OTHERWISE THE INDIVIDUAL 00117000 * COMMAND PROCESSOR IS CALLED, WITH GREGS 3,4,&5 (ENTRY 00118000 * REGS TO PARMGET) SET TO SPECIFY THECOMMAND LINE TO 00119000 * THE RIGHT OF THE COMMAND VERB. ON RETURN, THE FREE 00120000 * PAGES IN VIRTUAL STORAGE ARE COUNTED, AND IF THE 00121000 * NUMBER HAS DECREASED SUFFICIENTLY FROM THE PREVIOUS 00122000 * COMPUTATION, MESSAGE DMTCMX001I IS ISSUED. THE CALLING 00123000 * REGISTERS ARE RESTORED, AND RETURN IS MADE TO THE ADDRESS 00124000 * CONTAINED IN GREG 14 ON ENTRY. 00125000 * 00126000 *. 00127000 EJECT 00128000 DMTCMX CSECT 00129000 SPACE 2 00130000 * MESSAGE ROUTING CODE EQUATES 00131000 SPACE 00132000 RSS EQU X'80' RSS OPERATOR CONSOLE 00133000 ORIG EQU X'40' 'ORIGINATING' LINK ID 00134000 VMID EQU X'20' VIRTUAL MACHINE USER ID 00135000 CP EQU X'10' LOCAL CP OPERATOR 00136000 SPACE 00137000 USING DMTCMX,R15 GET TEMPORARY ADDRESSABILITY 00138000 STM R0,R15,CMXSAVE SAVE REGISTERS 00139000 LA R12,0(R15) SET FIRST BASE REG 00140000 DROP R15 00141000 USING DMTCMX,R12 DEFINE ITS ADDRESSABILITY 00142000 LA R15,2048 HALF AN ADDRESSING RANGE 00143000 LA R11,2048(R15,R12) SET SECOND BASE REG 00144000 USING DMTCMX+4096,R11 DEFINE ITS ADDRESSABILITY 00145000 LA R10,2048(R15,R11) SET THIRD BASE REG 00146000 USING DMTCMX+8192,R10 DEFINE ITS ADDRESSABILITY 00147000 SPACE 00148000 USING SVECTORS,0 SET SVECTORS ADDRESSABILITY 00149000 USING LINKTABL,R2 SET LINKTABL ADDRESSABILITY 00150000 USING TAG,R3 SET FILE TAG ADDRESSABILITY 00151000 USING COMDSECT,R15 SET COMMON ROUTINE VECTOR TABLE 00152000 * LOCATE COMMAND ORIGIN LINK TABLE 00153000 SR R15,R15 CLEAR RETURN REGISTER 00154000 L R6,TLINKS GET START OF LINK TABLE CHAIN 00155000 LA R2,8(R6) AND THE START OF LINK TABLE ENTRIES 00156000 LTR R0,R0 DID COMMAND ORIGINATE FROM CONSOLE? 00157000 BZ CMXLGOT YES 00158000 L R6,0(R6) GET THE NUMBER OF LINK TABLE ENTRIES 00159000 CMXLSCAN EQU * 00160000 TM LFLAG,LACTIVE IS THE LINK ACTIVE? 00161000 BNO CMXINACT NO 00162000 CL R0,LACTTNME IS THIS THE ONE? 00163000 BE CMXLGOT YES 00164000 CMXINACT EQU * 00165000 LA R2,LINKLEN(R2) GET THE NEXT TABLE ENTRY 00166000 BCT R6,CMXLSCAN AND CONTINUE 00167000 B CMXPUNT NO LINK FOUND FOR COMMAND ORIGIN 00168000 SPACE 1 00169000 CMXLGOT EQU * 00170000 * 00171000 * INITIALIZE COMMAND ELEMENT 00172000 * 00173000 LA R3,CMXELVAR-CMXELMNT HDR LENGTH 00174000 STC R3,CMXELLEN STORE LENGTH 00175000 MVI CMXELRET,X'00' CLEAR RETURN RESPONSE 00176000 MVI CMXELMOD,X'00' AND MODIFIERS 00177000 MVC CMXELORG(8),LINKID ORIGIN LINK ID 00178000 MVI CMXELVAR,X'00' CLEAR VARIABLE FIELDS 00179000 MVC CMXELVAR+1(L'CMXELVAR-1),CMXELVAR CLEAR 00180000 * 00181000 * INITIALIZE MESSAGE REQUEST 00182000 * 00183000 MVI CMXMSGAC,C' ' CLEAR ACTION CODE 00184000 MVI CMXMSGRC,X'00' CLEAR ROUTING CODE 00185000 MVI CMXMSGSC,X'00' CLEAR SEVERITY CODE 00186000 MVC CMXMSGLK(8),LINKID RESPONSE TO ORIG 00187000 MVC CMXMSGVM(8),=CL8'*' DEFAULT VM USER ID 00188000 MVI CMXMSGV0,C' ' CLEAR FIRST BYTE 00189000 MVC CMXMSGV0+1(CMXMSGVL-1),CMXMSGV0 ENTIRE AREA 00190000 SPACE 00191000 LA R3,4(R1) COMMAND LINE ADDRESS 00192000 SR R5,R5 CLEAR R5 FOR INSERT 00193000 IC R5,0(R1) GET LINE LENGTH 00194000 LA R5,1(R5,R1) GET ADDR OF END OF COMMAND LINE 00195000 BAL R14,PARMGET FRAME THE COMMAND 00196000 SPACE 00197000 LTR R0,R0 REMOTE ORIGIN? 00198000 BZ CMXLOCAL NO - SKIP MSG 003 00199000 CMXM003 EQU * 00200000 MVC CMXMSGV0(8),LINKID SET CMD ORIGIN LINK ID 00201000 MVI CMXMSG,28+8-1 INITIALIZE MSG LEN 00202000 LR R8,R5 ADDR OF LINE END 00203000 SR R8,R3 TOTAL LINE LEN 00204000 BCTR R8,0 -1 FOR MVC 00205000 BNP CMXM003B NULL COMMAND - NO MOVE 00206000 LA R7,CMXMSGVL-8-1 MAX TEXT LEN FOR MSG 00207000 CLR R8,R7 TOO BIG? 00208000 BNH CMXM003A NO - USE AS IS 00209000 LR R8,R7 TRUNCATE MSG TEXT AT MAX 00210000 CMXM003A EQU * 00211000 LA R6,CMXMSGV1 TEXT LINE TARGET 00212000 EX R8,CMXMOVE MOVE COMMAND TEXT TO MSG 00213000 LA R7,28+8(R8) TOTAL MSG ELEMENT LEN 00214000 STC R7,CMXMSG SET LEN IN MSG ELEMENT 00215000 CMXM003B EQU * 00216000 LA R7,003 MESSAGE NUMBER 003 00217000 STH R7,CMXMSGNM SET MSG NUM IN REQ ELEMENT 00218000 LA R1,CMXMSG ADDR OF MSG REQ ELEMENT 00219000 L R15,=V(DMTMGX) ENTRY TO MSG MANAGER 00220000 BALR R14,R15 ISSUE THE MESSAGE 00221000 MVI CMXMSGV0,C' ' CLEAR THE MSG VARIABLE AREA 00222000 MVC CMXMSGV0+1(CMXMSGVL-1),CMXMSGV0 WHOLE THING 00223000 CMXLOCAL EQU * 00224000 CR R3,R5 ANYTHING FOUND? 00225000 BNL CMXM200 NOTHING ON LINE 00226000 SR R4,R3 NO CHARS 00227000 CL R4,CMXLIMIT TOO LONG? 00228000 BCTR R4,0 REDUCE BY ONE FOR LATER 00229000 BH CMXM201 ERROR EXIT 00230000 SPACE 1 00231000 LM R7,R9,CMXSETUP SET UP FOR SCAN 00232000 CMXSCAN EQU * 00233000 EX R4,CMXTRY MATCH? 00234000 BNE CMXMISS NO 00235000 CH R4,8(R7) ENOUGH TYPED? 00236000 BNL CMXHIT YEP - DO IT 00237000 CMXMISS EQU * 00238000 BXLE R7,R8,CMXSCAN TRY THE NEXT 00239000 B CMXM201 NONE FOUND - ERROR 00240000 SPACE 2 00241000 CMXFINIS EQU * 00242000 L R7,MAINMAP START OF STORAGE MAP 00243000 L R8,MAINSIZE LENGTH OF STORAGE MAP 00244000 SR R9,R9 INITIALIZE FREE COUNT 00245000 CMXFINPA EQU * 00246000 CLI 0(R7),X'00' IS PAGE FREE? 00247000 BNE CMXFINXT NO - DON'T COUNT IT 00248000 LA R9,1(R9) INCREMENT FREE PAGE COUNT 00249000 CMXFINXT EQU * 00250000 LA R7,1(R7) INCREMENT MAP ENTRY POINTER 00251000 BCT R8,CMXFINPA LOOK THROUGH ENTIRE MAP 00252000 * 00253000 * REG.9 CONTAINS CURRENT FREE PAGE COUNT 00254000 * 00255000 L R8,CMXCOUNT OLD FREE PAGE COUNT 00256000 S R8,CMXREDUC LESS MINIMUM DECREMENT 00257000 CLR R9,R8 BIG ENOUGH DECREASE? 00258000 BNH CMXM001 YES - ISSUE THE MESSAGE 00259000 CL R9,CMXCOUNT DID WE GET SOME BACK? 00260000 BNH CMXRCODE NO - EXIT QUIETLY 00261000 CMXFRSET EQU * 00262000 ST R9,CMXCOUNT SET NEW FREE PAGE COUNT 00263000 CMXRCODE EQU * 00264000 LH R15,CMXMSGNM RETURN THE LAST MSG NUMBER 00265000 SPACE 00266000 CMXEXIT EQU * 00267000 LM R0,R14,CMXSAVE RESTORE REGS 00268000 BR R14 AND RETURN 00269000 SPACE 2 00270000 CMXM001 EQU * 00271000 LR R0,R9 FREE PAGES 00272000 LA R1,2 MIN TRUNCATION COUNT 00273000 MVC CMXMSGV0(8),CMXBLANK CLEAR FIRST VAR FIELD 00274000 LA R6,CMXMSGV0 DECIMAL DIGIT TARGET 00275000 BAL R14,DECPUT CONVERT AND STOW NUMBER 00276000 LH R8,CMXMSGNM SAVE LAST MSG NUMBER 00277000 LA R0,001 MESSAGE NUMBER 001 00278000 STH R0,CMXMSGNM SET FREE STORAGE MSG NUM 00279000 MVI CMXMSG,28+8-1 SET MSG ELEMENT LEN 00280000 LA R1,CMXMSG ADDR OF MSG REQ ELEMENT 00281000 L R15,=V(DMTMGX) MSG MANAGER ENTRY 00282000 BALR R14,R15 ISSUE FREE STORAGE MSG 00283000 STH R8,CMXMSGNM RESTORE LAST MSG NUM 00284000 B CMXFRSET SET RETURN CODE AND EXIT 00285000 SPACE 2 00286000 CMXPUNT EQU * 00287000 SR R15,R15 ZERO ... 00288000 BCTR R15,0 SET RETURN CODE -1 00289000 B CMXEXIT AND QUIT 00290000 EJECT 00291000 *. 00292000 * ENTRY NAME - 00293000 * 00294000 * CMXHIT 00295000 * 00296000 * FUNCTION - 00297000 * 00298000 * CALL THE APPROPRIATE INDIVIDUAL COMMAND PROCESSING 00299000 * ROUTINE 00300000 * 00301000 * RESPONSES - 00302000 * 00303000 * NONE 00304000 * 00305000 * ERROR MESSAGES - 00306000 * 00307000 * DMTCMX201E INVALID COMMAND 'COMMAND' 00308000 *. 00309000 CMXHIT EQU * 00310000 LTR R0,R0 LOCAL COMMAND ORIGIN? 00311000 BZ CMXNOTST YES - ALL COMMANDS PERMITTED 00312000 TM 11(R7),X'40' O.K. FOR REMOTE LINK? 00313000 BNO CMXM201 NO - ERR MSG 00314000 CMXNOTST EQU * COMMAND ELEMENT VALID 00315000 * 00316000 * CALL FIRST LEVEL PROCESSOR 00317000 * R0 STILL CONTAINS TASK NAME OF COMMAND 00318000 * ORIGINATOR, OR ZERO IF LOCAL 00319000 * 00320000 MVC CMXELCOD(1),10(R7) SET COMND ELMNT CODE 00321000 LA R3,1(R4,R3) UPDATE FOR NEXT PARM 00322000 BAL R14,PARMGET FRAME NEXT PARM 00323000 LA R1,CMXELMNT GET COMMAND ELEMENT ADDR 00324000 L R15,12(R7) LOCAL PROCESSOR ADDR 00325000 BR R15 DO IT 00326000 EJECT 00327000 *. 00328000 * ENTRY NAME - 00329000 * 00330000 * CMXALERT 00331000 * 00332000 * FUNCTION - 00333000 * 00334000 * PASS A COMMAND ELEMENT TO ANOTHER TASK VIA THE ALERT 00335000 * TASK TO TASK COMMUNICATIONS INTERFACE. 00336000 * 00337000 * RESPONSES - 00338000 * 00339000 * DMTCMX300I ACCEPTED BY TASK 'TASK' 00340000 * DMTCMX751I LINK 'LINKID' ALREADY ACTIVE -- 00341000 * NEW CLASS(ES) SET AS REQUESTED 00342000 * 00343000 * ERROR MESSAGES - 00344000 * 00345000 * DMTCMX301E REJECTED BY TASK 'TASK' -- 00346000 * PREVIOUS COMMAND ACTIVE 00347000 * DMTCMX304E REJECTED BY TASK 'TASK' -- NOT RECEIVING 00348000 *. 00349000 SPACE 00350000 CMXALERT EQU * 00351000 BCTR R0,0 DECREMENT COUNT FOR CMD ELEMENT 00352000 STC R0,CMXELLEN SET ELEMENT LENGTH 00353000 L R0,LACTTNME NAME OF TASK FOR ALERT 00354000 CMXALRDY EQU * 00355000 LA R1,CMXELMNT ADDR OF CMD ELEMENT 00356000 L R15,ALERTREQ ENTRY TO ALERT 00357000 BALR R14,R15 ALERT THE RECEIVER 00358000 LTR R15,R15 DID IT WORK? 00359000 BNZ CMXM304 NO ALERT EXIT 00360000 CLI CMXELRET,X'00' ACCEPTED? 00361000 BNE CMXM301 NO - BUFFERS BUSY 00362000 CLI CMXELCOD,X'80' WAS IT A START? 00363000 BNE CMXM300 NO - NORMAL MSG 00364000 LTR R3,R3 WERE CLASSES SPECIFIED? 00365000 BZ CMXM300 NO - NORMAL MSG 00366000 B STAM751 SAY CLASSES RESET 00367000 EJECT 00368000 CMXNOLNK EQU * 00369000 BC 13,CMXM202 CC=0,1,3 => INVALID LINK 00370000 B CMXM302 CC=2 => UNDEFINED LINK 00371000 SPACE 1 00372000 CMXM200 EQU * 00373000 LA R15,200 SET NUMBER 00374000 B CMXMV0 AND CONTINUE 00375000 SPACE 1 00376000 CMXM201 EQU * 00377000 LA R15,201 SET NUMBER 00378000 B CMXMV1 AND CONTINUE 00379000 SPACE 1 00380000 CMXM202 EQU * 00381000 LA R15,202 SET NUMBER 00382000 B CMXMV1 AND CONTINUE 00383000 SPACE 1 00384000 CMXM203 EQU * 00385000 LA R15,203 SET NUMBER 00386000 B CMXMV1 AND CONTINUE 00387000 SPACE 1 00388000 CMXM204 EQU * 00389000 LA R15,204 SET NUMBER 00390000 B CMXMV1 AND CONTINUE 00391000 SPACE 1 00392000 CMXM205 EQU * 00393000 LA R15,205 SET NUMBER 00394000 MVC CMXMSGV0(8),0(R7) CONFLICTING KEYWORD 00395000 LA R0,28+8 REQ LEN 00396000 B CMXDOIT AND CONTINUE 00397000 SPACE 1 00398000 CMXM206 EQU * 00399000 LA R15,206 SET MESSAGE NUMBER 00400000 B CMXMV2 AND CONTINUE 00401000 SPACE 1 00402000 CMXM207 EQU * 00403000 LA R15,207 SET MESSAGE NUMBER 00404000 B CMXMV2 AND CONTINUE 00405000 SPACE 1 00406000 CMXM208 EQU * 00407000 LA R15,208 SET MESSAGE NUMBER 00408000 B CMXMV1 MOVE ONE VAR FIELD 00409000 SPACE 00410000 CMXM300 EQU * 00411000 LA R15,300 SET MSG NUMBER 00412000 B CMXMTSK1 SET TASK NAME IN MSG 00413000 SPACE 1 00414000 CMXM301 EQU * 00415000 LA R15,301 SET MSG NUMBER 00416000 B CMXMTSK1 SET TASK NAME IN MSG 00417000 SPACE 1 00418000 CMXM302 EQU * 00419000 LA R15,302 GET MESSAGE NUMBER 00420000 B CMXMV1 AND CONTINUE 00421000 SPACE 1 00422000 CMXM303 EQU * 00423000 LA R15,303 SET MSG NUMBER 00424000 B CMXMLNK1 SET LINK ID IN MSG 00425000 SPACE 00426000 CMXM304 EQU * 00427000 LA R15,304 SET MSG NUMBER 00428000 B CMXMTSK1 SET TASK NAME IN MSG 00429000 SPACE 00430000 CMXMLNK2 EQU * 00431000 MVC CMXMSGV1(8),LINKID SET LINK ID 00432000 LA R0,28+2*8 SET MSG ELEMENT COUNT 00433000 B CMXDOIT PASS IT TO MSG MANAGER 00434000 SPACE 00435000 CMXMLNK1 EQU * 00436000 MVC CMXMSGV0(8),LINKID SET LINK ID 00437000 LA R0,28+8 SET MSG ELEMENT LENGTH 00438000 B CMXDOIT PASS IT TO MSG MANAGER 00439000 SPACE 00440000 CMXMTSK1 EQU * 00441000 ST R0,CMXMSGV0 SET TASK NAME IN MSG 00442000 LA R0,28+8 SET COUNT 00443000 B CMXDOIT PASS THE MESSAGE ELEMENT 00444000 SPACE 00445000 CMXMV2 EQU * 00446000 MVC CMXMSGV0(8),0(R7) MOVE IN VALID KEYWORD 00447000 LA R0,28+8 GET REQ COUNT 00448000 LTR R4,R4 ANY COUNT? 00449000 BM CMXDOIT NO..LEAVE SECOND PARM BLANK 00450000 CL R4,CMXLIMIT TOO LONG? 00451000 BL CMXMV2OK NO 00452000 L R4,CMXLIMIT USE ONE PARM 00453000 BCTR R4,0 REDUCE BY ONE 00454000 CMXMV2OK EQU * 00455000 LA R6,CMXMSGV1 PARM LOAD POINT 00456000 EX R4,CMXMOVE AND MOVE INTO MSG 00457000 LA R0,28+2*8 TWICE AS LONG 00458000 B CMXDOIT AND WRITE THE MSG 00459000 SPACE 1 00460000 CMXMV1 EQU * 00461000 LA R0,28+8 REQ LEN 00462000 LTR R4,R4 POSITIVE COUNT? 00463000 BM CMXDOIT NO - LEAVE EMPTY 00464000 CL R4,CMXLIMIT TRUNCATE? 00465000 BL CMXMVLOK NO 00466000 L R4,CMXLIMIT SET MAX COUNT 00467000 BCTR R4,0 AND DOWN BY ONE 00468000 CMXMVLOK EQU * 00469000 LA R6,CMXMSGV0 TARGET 00470000 EX R4,CMXMOVE MOVE IT 00471000 B CMXDOIT AND CONTINUE 00472000 SPACE 1 00473000 CMXMV0 EQU * 00474000 LA R0,28 LENGTH 00475000 CMXDOIT EQU * 00476000 BCTR R0,0 DOWN BY ONE 00477000 STC R0,CMXMSG LENGTH -1 00478000 STH R15,CMXMSGNM STORE THE NUMBER 00479000 LA R1,CMXMSG GET THE MSG REQ ADDR 00480000 L R15,=V(DMTMGX) GET THE MSG MANAGER ADDR 00481000 BALR R14,R15 AND WRITE IT 00482000 B CMXFINIS CHECK FREE STORAGE AND EXIT 00483000 SPACE 2 00484000 CMXMCUU EQU * 00485000 BCTR R9,0 REDUCE ADDR BY ONE 00486000 IC R0,0(R9) SAVE BYTE TO BE CLOBBERED 00487000 UNPK 0(5,R9),0(3,R8) SPREAD THE DIGITS 00488000 STC R0,0(R9) RESTORE THE CHARACTER 00489000 TR 1(3,R9),CMXTOEBC-240 TRANSLATE TO PRINTABLE EBCDIC 00490000 MVI 4(R9),C' ' BLANK GARBAGE FIELD 00491000 BR R14 AND RETURN 00492000 SPACE 2 00493000 * EXECUTED INSTRUCTIONS 00494000 SPACE 1 00495000 CMXTRY CLC 0(0,R7),0(R3) COMMAND NAME MATCH? 00496000 CMXMOVE MVC 0(0,R6),0(R3) MOVE FROM LINE 00497000 CMXATEST TRT 0(0,R3),CMXALPHA CHECK VALID ALPHANUM 00498000 CMXCFILE CLC 0(0,R3),=C'FILE' CHECK FOR KEYWORD 00499000 CMXCACT CLC 0(0,R3),=C'ACTIVE' CHECK FOR KEYWORD 00500000 SPACE 00501000 CMXSAVE DC 16F'0' SAVE AREA 00502000 EJECT 00503000 *. 00504000 *---------------------------------------------------------------------* 00505000 * QUERY COMMAND * 00506000 *---------------------------------------------------------------------* 00507000 * 00508000 * RESPONSES - 00509000 * 00510000 * DMTCMX651I LINK 'LINKID' INACTIVE 00511000 * DMTCMX652I LINK 'LINKID' ACTIVE 'TASK' 'TYPE' 'CLASS' 00512000 * (HO|NOH) (DR|NOD) (TRE|TRA|NOT) 00513000 * DMTCMX653I LINK 'LINKID' DEFAULT 'TASK' 'TYPE' 'VADDR' 00514000 * 'CLASS' R='M' 00515000 * DMTCMX654I LINK 'LINKID' Q='M' P='N' 00516000 * DMTCMX655I FILE 'SPOOLID' 'LOCID' 'USERID' CL 'A' 00517000 * PR 'MM' REC 'NNNNNN' (A|I) 00518000 * DMTCMX660I FILE 'SPOOLID' INACTIVE ON LINK 'LINKID' 00519000 * DMTCMX661I FILE 'SPOOLID' ACTIVE ON LINK 'LINKID' 00520000 * DMTCMX662I FILE 'SPOOLID' ORG 'LOCID' 'USERID' 'MM/DD/YY' 00521000 * 'HH:MM:SS' 'X.X.T.' TO 'LOCID' 'USERID' 00522000 * DMTCMX663I FILE 'SPOOLID' PR 'MM' CL 'CLASS' CO 'NN' 00523000 * (HO|NOH) DI 'DISTCODE' NA ('FN FT'|'DSNAME') 00524000 * DMTCMX670I LINK 'LINKID' ACTIVE -- LINE 'VADDR' (HO|NOH) 00525000 * DMTCMX671I LINK 'LINKID' INACTIVE 00526000 * DMTCMX672I NO LINK ACTIVE 00527000 * DMTCMX673I NO LINK DEFINED 00528000 * 00529000 * ERROR MESSAGES - 00530000 * 00531000 * DMTCMX202E INVALID LINK 'LINKID' 00531010 * DMTCMX203E INVALID SPOOL FILE ID 'SPOOLID' 00532000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 00533000 * DMTCMX206E INVALID OPTION 'KEYWORD' 'OPTION' 00534000 * DMTCMX664E FILE 'SPOOLID' NOT FOUND 00535000 *. 00536000 SPACE 00537000 QUERY DC 0H'0' 00538000 LR R6,R7 SAVE THE COMMAND ENTRY 00539000 LM R7,R9,QY0SETUP SET UP KEYWORD SCAN 00540000 BAL R14,KEYWDGET LOOK FOR A KEYWORD 00541000 BC 7,QY0LINK MORE ON LINE - TRY LINK ID 00542000 LR R7,R6 RESTORE QUERY COMMAND 00543000 SLR R4,R4 SET ZERO 00544000 BCTR R4,0 FORCE BLANK SECOND PARM 00545000 B CMXM206 NOTHING SPECIFIED 00546000 SPACE 00547000 QYTOOMCH EQU * 00548000 LM R7,R9,QY3SETUP SET FOR TOTAL SCAN 00549000 BAL R14,KEYWDGET INVALID OR CONFLICTING? 00550000 B CMXM204 INVALID KEYWORD MSG 00551000 SPACE 00552000 QY0LINK EQU * 00553000 CL R4,CMXLIMIT TOO MUCH TYPED? 00554000 BNL CMXM204 YEP - INVALID 00555000 LA R0,1(R4) RESTORE EXACT COUNT 00556000 LR R1,R3 ADDRESS OF PARM 00557000 LA R13,CMXCSAVE GET COMMON ROUTINE S.A. ADDR @VA03303 00557010 L R15,TCOM COMMON RTN VECTORS 00558000 L R15,GLINKREQ ENTRY TO GET LINK 00559000 BALR R14,R15 GET THE LINK TABLE 00560000 LTR R15,R15 ANY FOUND? 00561000 BNZ CMXM204 NO - NO GOOD 00562000 L R2,TLINKS GET START OF LINK TABLE CHAI @VA03308 00562010 LA R2,8(R2) POINT TO THE FIRST ENTRY @VA03308 00562110 CLR R2,R1 WAS THE LOCAL LINK SPECIFIED @VA03308 00562210 BE CMXM202 YES...INVALID LINK @VA03308 00562310 LR R2,R1 LINK TABLE ENTRY 00563000 LA R3,1(R4,R3) SET NEXT SCAN 00564000 BAL R14,PARMGET FRAME NEXT 00565000 LM R7,R9,QY1SETUP SET UP FOR NEXT SCAN 00566000 BAL R14,KEYWDGET GET ANOTHER 00567000 BC 8,QY1STAT DEFAULT TO LINKID STAT 00568000 B CMXM204 INVALID KEYWORD OPTION 00569000 SPACE 00570000 QY0FILE EQU * 00571000 BC 8,QY0FNULL NO MORE ON LINE 00572000 LM R8,R9,CMXSPRNG SET SPOOLID RANGE 00573000 BAL R14,DECGET CONVERT SPECIFIED NUMBER 00574000 BC 7,CMXM203 INVALID SPOOL ID 00575000 * REG.0 CONTAINS VALID SPOOL ID NUMBER 00576000 LA R3,1(R4,R3) SET TO SCAN AGAIN 00577000 BAL R14,PARMGET FRAME NEXT PARM 00578000 LM R7,R9,QY2SETUP SET UP FOR NEXT KEYWORD SCAN 00579000 BAL R14,KEYWDGET GET THE NEXT KEYWORD 00580000 BC 8,QY2STAT DEFAULT TO STAT 00581000 B CMXM204 INVALID KEYWORD 00582000 SPACE 00583000 QY0FNULL EQU * 00584000 SLR R4,R4 ZERO 00585000 BCTR R4,0 FORCE BLANK KEYWORD 00586000 B CMXM203 INVALID SPOOLID ... 00587000 SPACE 00588000 QY0SYSTM EQU * 00589000 LA R6,0 SAVE COND CODE 00590000 BC 8,QY0SYALL DEFAULT TO ALL 00591000 SR R4,R3 COUNT OF NEXT PARM 00592000 BCTR R4,0 DOWN ONE 00593000 LA R0,6 MAX COUNT FOR 'ACTIVE' 00594000 CLR R4,R0 TOO MUCH TYPED? 00595000 BNL CMXM204 YES - INVALID KEYWORD 00596000 EX R4,CMXCACT DOES IT SAY IT? 00597000 BNE CMXM204 NO - INVALID KEYWORD 00598000 LA R6,LACTIVE SET FLAG TO INDICATE ACTIVE ONLY 00599000 LA R3,1(R4,R3) SET UP FOR NEXT SCAN 00600000 BAL R14,PARMGET TRY TO GET ANOTHER 00601000 CLR R3,R5 ANY MORE TYPED? 00602000 BL QYTOOMCH YES - NO GOOD 00603000 QY0SYALL EQU * 00604000 SPACE 00605000 * QUERY SYSTEM - R6=0 => ALL; R6 NOT =0 => ACTIVE ONLY 00606000 SPACE 00607000 SLR R4,R4 INITIALIZE MSG COUNTER 00608000 L R2,TLINKS START OF LINK TABLES 00609000 L R3,0(R2) COUNT OF LINK TABLE ENTRIES 00610000 LA R2,8(R2) FIRST LINK TABLE ENTRY 00611000 BCT R3,QYSYLINK SKIP FIRST ENTRY (LOCAL) 00612000 QYM673 EQU * 00613000 LA R15,673 MESSAGE CODE 00614000 B CMXMV0 NO VARIABLE FIELDS 00615000 SPACE 00616000 QYSYLINK EQU * 00617000 LA R2,LINKLEN(R2) NEXT LINK TABLE ENTRY 00618000 MVC CMXMSGV0(8),LINKID SET LINK ID IN MSG 00619000 TM LFLAG,LACTIVE THIS ONE ACTIVE? 00620000 BO QYSYACT YES - DO IT UNCONDITIONALLY 00621000 LTR R6,R6 INACTIVE LINKS REQUESTED? 00622000 BNZ QYSYNEXT NOPE - SKIP THIS ONE 00623000 CLI LINKID,C' ' DEFINED? 00624000 BE QYSYNEXT NOPE - KEEP LOOKING 00625000 QYM671 EQU * 00626000 LA R15,671 SET MESSAGE CODE 00627000 LA R0,28+8 AND LENGTH 00628000 B QYSYMSG AND ISSUE IT 00629000 SPACE 00630000 QYSYACT EQU * 00631000 UNPK CMXWORK(5),LACTLINE(3) SPREAD DIGITS 00632000 TR CMXWORK+1(3),CMXTOEBC-240 TRANSLATE ABCDEF 00633000 MVC CMXMSGV1(3),CMXWORK+1 MOVE LINE TO MSG 00634000 MVC CMXMSGV2(3),=CL3'NOH' ASSUME NOHOLD 00635000 QYM670 EQU * 00636000 LA R15,670 SET MESSAGE CODE 00637000 LA R0,28+3*8 AND LENGTH 00638000 TM LFLAG,LHOLD HOLD SET? 00639000 BNO QYSYMSG NO - ISSUE MSG AS IS 00640000 MVC CMXMSGV2(3),=CL3'HO' OTHERWISE SAY HOLD 00641000 QYSYMSG EQU * 00642000 BCTR R0,0 DOWN ONE 00643000 STC R0,CMXMSG SET LENGTH 00644000 STH R15,CMXMSGNM SET THE MSG NUMBER 00645000 LA R1,CMXMSG SET MSG ELEMENT ADDR 00646000 L R15,=V(DMTMGX) MSG EXEC ENTRY 00647000 BALR R14,R15 ISSUE MESSAGE 00648000 SPACE 00649000 LA R4,1(R4) INCREMENT MSG COUNT 00650000 QYSYNEXT EQU * 00651000 * SKIP CLEARING VARIABLE FIELDS - NOT NECESSARY 00652000 BCT R3,QYSYLINK GET ANOTHER LINK TABLE 00653000 LTR R4,R4 ANY MSGS SO FAR? 00654000 BNZ CMXFINIS YEP - JUST QUIT 00655000 QYM672 EQU * 00656000 LA R15,672 SET MSG CODE 00657000 B CMXMV0 ISSUE 'NO LINK ACTIVE' 00658000 SPACE 00659000 QY1STAT EQU * 00660000 SPACE 00661000 * QUERY LINKID STAT 00662000 SPACE 00663000 BC 7,QYTOOMCH NOT END OF LINE 00664000 MVC CMXMSGV0(8),LINKID SET LINK ID 00665000 TM LFLAG,LACTIVE IS IT ACTIVE? 00666000 BNO QYM651 NOPE - GO SAY IT 00667000 MVC CMXMSGV1(4),LACTTNME SET 'TASK' 00668000 MVC CMXMSGV2(8),LACTDRVR SET 'TYPE' 00669000 UNPK CMXWORK(5),LACTLINE(3) SPREAD LINE NUMBER 00670000 TR CMXWORK+1(3),CMXTOEBC-240 TRANSLATE ABCDEF 00671000 MVC CMXMSGV3(3),CMXWORK+1 SET 'LINE' 00672000 MVC CMXMSGV4(4),LACTCLS1 SET 'CLASS' 00673000 MVC CMXMSGV5(3),=CL3'NOH' ASSUME NO HOLD 00674000 TM LFLAG,LHOLD CORRECT? 00675000 BNO QY1SNOH YES - LEAVE IT ALONE 00676000 MVC CMXMSGV5(3),=CL3'HO' FIX IT UP 00677000 QY1SNOH EQU * 00678000 MVC CMXMSGV6(3),=CL3'NOD' ASSUME NO DRAIN 00679000 TM LFLAG,LDRAIN CORRECT? 00680000 BNO QY1SNOD YES - LEAVE ALONE 00681000 MVC CMXMSGV6(3),=CL3'DR' ELSE FIX IT UP 00682000 QY1SNOD EQU * 00683000 MVC CMXMSGV7(3),=CL3'NOT' ASSUME NO TRACE 00684000 TM LFLAG,LTRALL+LTRERR CORRECT? 00685000 BZ QY1SNOT YES - LEAVE IT ALONE 00686000 MVC CMXMSGV7(3),=CL3'TRA' ASSUME TRACE ALL 00687000 TM LFLAG,LTRALL CORRECT? 00688000 BO QY1SALL YES - LET IT BE 00689000 MVC CMXMSGV7(3),=CL3'TRE' OTHERWISE TRACE ERR 00690000 QY1SALL EQU * 00691000 QY1SNOT EQU * 00692000 QYM652 EQU * 00693000 LA R15,652 SET MSG CODE 00694000 LA R0,28+8*8 AND LENGTH 00695000 B CMXDOIT RESPOND TO QUERY 00696000 SPACE 00697000 QYM651 EQU * 00698000 LA R15,651 SET MESSAGE CODE 00699000 LA R0,28+8 AND LENGTH 00700000 B CMXDOIT AND RESPOND 00701000 SPACE 00702000 QY1DEF EQU * 00703000 SPACE 00704000 * QUERY LINKID DEF 00705000 SPACE 00706000 BC 7,QYTOOMCH MORE ON LINE - INVALID 00707000 MVC CMXMSGV0(8),LINKID SET LINK ID 00708000 MVC CMXMSGV1(4),LDEFTNME SET 'TASK' 00709000 MVC CMXMSGV2(8),LDEFDRVR SET 'TYPE' 00710000 UNPK CMXWORK(5),LDEFLINE(3) SPREAD LINE ADDR 00711000 TR CMXWORK+1(3),CMXTOEBC-240 TRANSLATE ABCDEF 00712000 MVC CMXMSGV3(3),CMXWORK+1 SET 'LINE' 00713000 MVC CMXMSGV4(4),LDEFCLS1 SET 'CLASS' 00714000 LH R0,LRESERVD RESERVED SLOT COUNT 00715000 SLR R1,R1 NO MINIMUM DIGITS 00716000 LA R6,CMXMSGV5 TARGET FIELD POINTER 00717000 BAL R14,DECPUT PUT NUMBER IN MSG 00718000 QYM653 EQU * 00719000 LA R15,653 SET MESSAGE CODE 00720000 LA R0,28+6*8 AND LENGTH 00721000 B CMXDOIT RESPOND TO QUERY 00722000 SPACE 00723000 QY1QUEUE EQU * 00724000 SPACE 00725000 * QUERY LINKID QUEUE 00726000 SPACE 00727000 BC 7,QYTOOMCH MORE ON LINE - INVALID 00728000 MVC CMXMSGV0(8),LINKID SET LINK ID 00729000 LH R0,LTAKEN GET TAKEN SLOT COUNT 00730000 LTR R0,R0 ANY AT ALL? 00731000 BNP QY1QQSET NO - SKIP ACTIVE OUTPUT SCAN 00732000 L R3,TTAGQ FILE TAG CONTROL AREA 00733000 LA R3,8(R3) START OF ACTIVE OUTPUT QUEUE 00734000 QY1QACTO EQU * 00735000 ICM R3,B'1111',TAGNEXT POINT TO NEXT ACTIVE TAG 00736000 BZ QY1QQSET ALL DONE - DO MSG 00737000 CLC TAGLINK(8),LINKID TAG FOR THIS LINK? 00738000 BNE QY1QACTO NO - TRY THE NEXT 00739000 BCT R0,QY1QACTO DECREMENT AND KEEP LOOKING 00740000 QY1QQSET EQU * 00741000 SLR R1,R1 NO MINIMUM DIGITS 00742000 LA R6,CMXMSGV1 OUTPUT NUMBER TARGET 00743000 BAL R14,DECPUT CONVERT AND MOVE NUMBER 00744000 LH R0,LPENDING GET PENDING FILE COUNT 00745000 SLR R1,R1 NO MINIMUM DIGITS 00746000 LA R6,CMXMSGV2 OUTPUT NUMBER TARGET 00747000 BAL R14,DECPUT CONVERT AND MOVE NUMBER 00748000 QYM654 EQU * 00749000 LA R15,654 SET MSG NUMBER 00750000 STH R15,CMXMSGNM SET NUMBER IN MSG ELEMENT 00751000 MVI CMXMSG,28+3*8 SET LENGTH IN MSG ELEMENT 00752000 LA R1,CMXMSG ADDR OF MSG ELEMENT START 00753000 L R15,=V(DMTMGX) ENTRY TO MSG PROCESSOR 00754000 BALR R14,R15 ISSUE THE MESSAGE 00755000 SPACE 00756000 * NOW DO THE FILE QUEUE 00757000 SPACE 00758000 SR R4,R4 INDICATE INACTIVE QUEUE 00759000 LA R3,LPOINTER INITIALIZE FILE TAG POINTER 00760000 QY1QNEXT EQU * 00761000 ICM R3,B'1111',TAGNEXT POINT TO NEXT TAG 00762000 BZ QY1QEND NO MORE - ALL DONE 00763000 LTR R4,R4 INACTIVE QUEUE? 00764000 BZ QY1INACT YES - DON'T CHECK TAG LINK ID 00765000 CLC TAGLINK(8),LINKID TAG FOR THIS LINK? 00766000 BNE QY1QNEXT NO - TRY NEXT 00767000 QY1INACT EQU * 00768000 MVI CMXMSGV0,C' ' CEAR FIRST BYTE 00769000 MVC CMXMSGV0+1(CMXMSGVL-1),CMXMSGV0 ENTIRE AREA 00770000 LH R0,TAGID GET SPOOL ID 00771000 LA R1,4 MIN DIGIT COUNT 00772000 LA R6,CMXMSGV0 OUTPUT TARGET AREA 00773000 BAL R14,DECPUT PUT SPOOL ID IN MSG 00774000 MVC CMXMSGV1(8),TAGTOLOC SET DEST LOC 00775000 MVC CMXMSGV2(8),TAGTOVM SET DEST VM ID 00776000 MVC CMXMSGV3(1),TAGCLASS SET 'CLASS' 00777000 LH R0,TAGPRIOR FILE PRIORITY 00778000 SLR R1,R1 NO MIN DIGIT COUNT 00779000 LA R6,CMXMSGV4 TARGET FIELD 00780000 BAL R14,DECPUT CONVERT NUMBER TO LINE 00781000 L R0,TAGRECNM RECORD COUNT 00782000 LA R1,8 SET MIN DIGIT COUNT 00783000 LA R6,CMXMSGV5 SET TARGET FIELD 00784000 BAL R14,DECPUT CONVERT COUNT TO LINE 00785000 MVI CMXMSGV6,C'I' ASSUME INACTIVE 00786000 LTR R4,R4 CORRECT? 00787000 BZ QYM655 YES - ISSUE MESSAGE AS IS 00788000 MVI CMXMSGV6,C'A' OTHERWISE SAY ACTIVE 00789000 QYM655 EQU * 00790000 LA R15,655 SET MSG CODE 00791000 STH R15,CMXMSGNM MSG CODE TO MSG ELEMENT 00792000 MVI CMXMSG,28+7*8 LENGTH TO MSG ELEMENT 00793000 LA R1,CMXMSG ADDR OF MSG ELEMENT 00794000 L R15,=V(DMTMGX) ENTRY TO MSG PROCESSOR 00795000 BALR R14,R15 ISSUE MESSAGE 00796000 B QY1QNEXT DO NEXT TAG 00797000 SPACE 00798000 QY1QEND EQU * 00799000 LTR R4,R4 ACTIVE QUEUE? 00800000 BNZ CMXFINIS YES - ALL DONE 00801000 BCTR R4,0 INDICATE INACTIVE QUEUE SCAN 00802000 L R3,TTAGQ TAG QUEUE CONTROL AREA 00803000 LA R3,4(R3) START OF ACTIVE INPUT QUEUE 00804000 B QY1QNEXT SCAN FOR FILES OWNED 00805000 SPACE 00806000 QY2STAT EQU * 00807000 SPACE 00808000 * QUERY FILE STAT 00809000 SPACE 00810000 BC 7,QYTOOMCH MORE ON LINE - INVALID 00811000 * REG.0 = SPOOL ID ON ENTRY 00812000 LA R1,4 MIN DIGIT COUNT 00813000 LA R6,CMXMSGV0 OUTPUT NUMBER TARGET 00814000 BAL R14,DECPUT CONVERT SPOOL ID TO LINE 00815000 BAL R14,FILGET AND FIND THE TAG 00816000 BC 7,QYM664 FILE NOT FOUND 00817000 MVC CMXMSGV1(8),TAGLINK SET LINK ID 00818000 OC TAGBLOCK(4),TAGBLOCK IS THE FILE ACTIVE? 00819000 BZ QYM660 NO - INACTIVE 00820000 QYM661 EQU * 00821000 LA R15,661 SET MESSAGE NUMBER 00822000 LA R0,28+2*8 AND COUNT 00823000 B CMXDOIT ISSUE MESSAGE 00824000 SPACE 00825000 QYM660 EQU * 00826000 LA R15,660 SET MSG NUMBER 00827000 LA R0,28+2*8 AND COUNT 00828000 B CMXDOIT ISSUE RESPONSE 00829000 SPACE 00830000 QY2RSS EQU * 00831000 SPACE 00832000 * QUERY FILE RSS 00833000 SPACE 00834000 BC 7,QYTOOMCH MORE ON LINE - INVALID 00835000 * REG.0 CONTAINS SPOOL ID ON ENTRY 00836000 LA R1,4 MIN DIGIT COUNT 00837000 LA R6,CMXMSGV0 SPOOL ID TARGET FIELD 00838000 BAL R14,DECPUT CONVERT SPOOL ID TO LINE 00839000 BAL R14,FILGET FIND THE FILE TAG 00840000 BC 7,QYM664 FILE NOT FOUND 00841000 MVC CMXMSGV1(8),TAGINLOC FROM LOCATION ID 00842000 MVC CMXMSGV2(8),TAGINVM FROM VM ID 00843000 MVC CMXWORK(19),QY2RMASK SET EDITING MASK 00844000 LM R0,R1,TAGINTOD PICK UP S/370 TIME OF DAY 00845000 LA R2,CMXWORK OUTPUT FIELD 00846000 BAL R14,TODEBCD CONVERT TO PRINTABLE 00847000 MVC CMXMSGV3(24),CMXWORK+1 MOVE IN DATE, TIME, & ZONE 00848000 MVC CMXMSGV6(8),TAGTOLOC DEST LOCATION 00849000 MVC CMXMSGV7(8),TAGTOVM DEST VM ID 00850000 SPACE 00851000 QYM662 EQU * 00852000 LA R15,662 MSG NUMBER 00853000 LA R0,28+8*8 AND COUNT 00854000 B CMXDOIT ISSUE RESPONSE 00855000 SPACE 00856000 QY2VM EQU * 00857000 SPACE 00858000 * QUERY FILE VM 00859000 SPACE 00860000 BC 7,QYTOOMCH MORE ON LINE - INVALID 00861000 * REG.0 CONTAINS SPOOL ID ON ENTRY 00862000 LA R1,4 MIN DIGIT COUNT 00863000 LA R6,CMXMSGV0 SET TARGET FIELD 00864000 BAL R14,DECPUT CONVERT NUMBER TO LINE 00865000 BAL R14,FILGET FIND THE FILE TAG 00866000 BC 7,QYM664 NOT FOUND - SAY SO 00867000 LH R0,TAGPRIOR PICK UP PRIORITY 00868000 SLR R1,R1 NO MIN COUNT 00869000 LA R6,CMXMSGV1 SET TARGET FIELD 00870000 BAL R14,DECPUT SET PRIORITY 00871000 MVC CMXMSGV2(1),TAGCLASS SET 'CLASS' 00872000 LH R0,TAGCOPY PICK UP COPY COUNT 00873000 SLR R1,R1 NO MIN DIGIT COUNT 00874000 LA R6,CMXMSGV3 TARGET LINE ADDR 00875000 BAL R14,DECPUT SET COPY NUMBER 00876000 MVC CMXMSGV4(3),=CL3'NOH' ASSUME NO HOLD 00877000 TM TAGFLAG,SFBUHOLD+SFBSHOLD CORRECT? 00878000 BZ QY2VNOH YES - LEAVE ALONE 00879000 MVC CMXMSGV4(3),=CL3'HO' OTHERWISE FIX IT 00880000 QY2VNOH EQU * 00881000 MVC CMXMSGV5(8),TAGDIST SET DIST CODE 00882000 MVC CMXMSGV6(24),TAGNAME SET FILE NAME TYPE 00883000 QYM663 EQU * 00884000 LA R15,663 SET MSG NUMBER 00885000 LA R0,28+9*8 AND LENGTH 00886000 B CMXDOIT ISSUE RESPONSE 00887000 SPACE 00888000 QYM664 EQU * 00889000 LA R15,664 SET MSG NUMBER 00890000 LA R0,28+8 AND COUNT 00891000 B CMXDOIT ISSUE RESPONSE 00892000 EJECT 00893000 QY0SETUP DC A(QY0TABLE) PARM TABLE ADDRESS 00894000 DC A(QY0INC) LENGTH OF ENTRY 00895000 DC A(QY0END-QY0INC) END OF TABLE 00896000 SPACE 00897000 QY0TABLE DC 0F'0' 00898000 DC CL8'FILE',AL1(1-1),AL3(QY0FILE) 00899000 DC CL8'SYSTEM',AL1(2-1),AL3(QY0SYSTM) 00900000 QY0END EQU * 00901000 SPACE 00902000 QY0INC EQU 8+4 00903000 SPACE 3 00904000 QY1SETUP DC A(QY1TABLE) PARM TABLE ADDRESS 00905000 DC A(QY1INC) LENGTH OF ENTRY 00906000 DC A(QY1END-QY1INC) END OF TABLE 00907000 SPACE 00908000 QY1TABLE DC 0F'0' 00909000 DC CL8'STAT',AL1(1-1),AL3(QY1STAT) 00910000 DC CL8'DEF',AL1(1-1),AL3(QY1DEF) 00911000 DC CL8'QUEUE',AL1(1-1),AL3(QY1QUEUE) 00912000 QY1END EQU * 00913000 SPACE 00914000 QY1INC EQU 8+4 00915000 SPACE 3 00916000 QY2SETUP DC A(QY2TABLE) PARM TABLE ADDRESS 00917000 DC A(QY2INC) LENGTH OF ENTRY 00918000 DC A(QY2END-QY2INC) END OF TABLE 00919000 SPACE 00920000 QY2TABLE DC 0F'0' 00921000 DC CL8'STAT',AL1(1-1),AL3(QY2STAT) 00922000 DC CL8'RSCS',AL1(4-1),AL3(QY2RSS) 00923000 DC CL8'VM',AL1(2-1),AL3(QY2VM) 00924000 QY2END EQU * 00925000 SPACE 00926000 QY2INC EQU 8+4 00927000 SPACE 3 00928000 QY2RMASK DC AL1(QY2RMEND-*-1) LENGTH OF MASK 00929000 DC X'2120',C'/',X'2020',C'/',X'2020' EDIT MASK 00930000 DC X'22' FIELD SEPARATOR 00931000 DC X'2120',C':',X'2020',C':',X'2020' 00932000 DC C'0' BLANK @VA03113 00933450 QY2RMEND EQU * 00934000 EJECT 00935000 QY3SETUP DC A(QY3TABLE) PARM TABLE ADDRESS 00936000 DC A(QY3INC) LENGTH OF ENTRY 00937000 DC A(QY3END-QY3INC) END OF TABLE 00938000 SPACE 00939000 QY3TABLE DC 0F'0' SEARCH FOR CONFLICTING 00940000 DC CL8'STAT',AL1(1-1),AL3(CMXM205) EXTRA KEYWD 00941000 DC CL8'DEF',AL1(1-1),AL3(CMXM205) 00942000 DC CL8'QUEUE',AL1(1-1),AL3(CMXM205) 00943000 DC CL8'RSCS',AL1(4-1),AL3(CMXM205) 00944000 DC CL8'VM',AL1(2-1),AL3(CMXM205) 00945000 QY3END EQU * 00946000 SPACE 00947000 QY3INC EQU 8+4 00948000 EJECT 00949000 *. 00950000 *---------------------------------------------------------------------* 00951000 * START COMMAND * 00952000 *---------------------------------------------------------------------* 00953000 * 00954000 * OPERATION - 00955000 * 00956000 * DEFAULT PARAMETER VALUES ARE SET, AND ROUTINE 00957000 * R0FORMAT IS CALLED TO DECODE SPECIFIED VALUE OVERRIDES. 00958000 * IF THE LINK SPECIFIED IS ACTIVE, ONLY A 'CLASS' 00959000 * SPECIFICATION IS ACCEPTED; CLASSES ARE OPTIONALLY 00960000 * RESET, AND THE LINK'S LINE DRIVER IS GIVEN A START 00961000 * COMMAND ALERT TO RESET A POSSIBLE DRAIN STATUS. 00962000 * IF THE LINK SPECIFIED IS INACTIVE, THE LINE ADDR 00963000 * IS ALLOCATED IF NECESSARY AND VALIDATED, THE REQUESTED 00964000 * LINE DRIVER IS LOADED AS A NEW TASK, AND THE LINK IS 00965000 * ACTIVATED. 00966000 * 00967000 * RESPONSES - 00968000 * 00969000 * DMTCMX700I ACTIVATING LINK 'LINKID' 'TASK' 'TYPE' 00970000 * 'VADDR' 'CLASS' 00971000 * DMTCMX751I LINK 'LINKID' ALREADY ACTIVE -- 00972000 * NEW CLASSES SET AS REQUESTED 00973000 * 00976000 * ERROR MESSAGES - 00977000 * 00978000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 00979000 * DMTCMX205E CONFLICTING KEYWORD 'KEYWORD' 00980000 * DMTCMX206E INVALID OPTION 'KEYWORD' 'OPTION' 00981000 * DMTCMX701E NO SWITCHED LINE AVAILABLE -- 00982000 * LINK 'LINKID' NOT ACTIVATED 00983000 * DMTCMX702E LINE 'VADDR' IS IN USE BY LINK 'LINKID' -- 00984000 * LINK 'LINKID' NOT ACTIVATED 00985000 * DMTCMX703E DEV 'CUU' IS NOT A LINE PORT -- 00986000 * LINK 'LINKID' NOT ACTIVATED 00987000 * DMTCMX704E LINE 'VADDR' CC=3 NOT OPERATIONAL -- 00988000 * LINK 'LINKID' NOT ACTIVATED 00989000 * DMTCMX705E DRIVER 'TYPE' FILE FORMAT INVALID -- 00990000 * LINK 'LINKID' NOT ACTIVATED 00991000 * DMTCMX706E FATAL ERROR LOADING FROM 'VADDR' -- 00992000 * LINK 'LINKID' NOT ACTIVATED 00993000 * DMTCMX707E DRIVER 'TYPE' FILE FORMAT INVALID -- 00994000 * LINK 'LINKID' NOT ACTIVATED 00995000 * DMTCMX708E VIRTUAL STORAGE CAPACITY EXCEEDED -- 00996000 * LINK 'LINKID' NOT ACTIVATED 00997000 * DMTCMX709E TASK NAME 'TNAME' ALREADY IN USE -- 00998000 * LINK 'LINKID' NOT ACTIVATED 00999000 * DMTCMX710E MAX ('NN') ACTIVE -- LINK 'LINKID' 01000000 * NOT ACTIVATED 01001000 * DMTCMX750E LINK 'LINKID' ALREADY ACTIVE -- 01002000 * NO ACTION TAKEN 01003000 *. 01004000 SPACE 01005000 START DC 0H'0' 01006000 LTR R0,R0 WAS THE ORIGIN THE CONSOLE? 01007000 BNZ STALKGOT ORIGINATE FROM ANOTHER TASK 01008000 BAL R14,LTABGET GET THE LINKTABL ENTRY 01009000 B CMXNOLNK LINK NOT FOUND 01010000 STALKGOT EQU * 01011000 MVC R0TNME(4),LDEFTNME DEFAULT TASKNAME 01012000 MVC R0DRVR(8),LDEFDRVR DEFAULT DRIVER 01013000 MVC R0LADD(2),LDEFLINE DEFAULT LINE ADDR 01014000 MVC R0CLS1(4),LDEFCLS1 DEFAULT CLASSES 01015000 XC STARPARM(4),STARPARM CLEAR THE PARM FIELD 01016000 LA R1,STASETUP PREPARE FOR START SETUP 01017000 B R0FORMAT AND SCAN FOR OVERRIDES 01018000 SPACE 2 01019000 STADO EQU * 01020000 TM LFLAG,LACTIVE IS THE LINK ACTIVE ALREADY? 01021000 BNO STACREAT NO - ACTIVATE IT 01022000 LM R7,R9,STASETUP SET UP FOR KYWD TBL SCAN 01023000 SR R3,R3 CLEAR CLASS REG 01024000 STACTRY EQU * 01025000 CLC 0(8,R7),=CL8'CLASS' CLASS KYWD ENTRY? 01026000 BNE STANOTCL NO - SEE IF ENTERED 01027000 TM 12(R7),X'80' WAS CLASS SPECIFIED? 01028000 BZ STACBUMP NOPE - KEEP LOOKING 01029000 L R3,R0CLS1 PICK UP THE SPECD CLASSES 01030000 B STACBUMP AND KEEP LOOKING 01031000 SPACE 01032000 STANOTCL EQU * 01033000 TM 12(R7),X'80' WAS NON-CLASS SPECD? 01034000 BNZ STAM750 YES - NO GOOD 01035000 STACBUMP EQU * 01036000 BXLE R7,R8,STACTRY LOOK AGAIN 01037000 SPACE 01038000 * VALID START COMMAND FOR AN ACTIVE LINK 01039000 SPACE 01040000 LTR R3,R3 CLASSES SPECIFIED? 01041000 BZ L0FIRE NOPE - MUST BE TO RESET DRAIN 01042000 ST R3,LACTCLS1 YES - RESET CLASSES 01043000 OI CMXELMOD,X'80' SET COMMAND MODIFIER 01044000 B L0FIRE ISSUE COMMAND ELEMENT 01045000 EJECT 01046000 STACREAT EQU * 01047000 MVC STALAXRQ+4(2),R0LADD SET REQ'D LINE (OR 0) 01048000 LA R1,STALAXRQ ADDR OF ALERT REQ FOR LAX 01049000 L R0,CMXLAX NAME 0F'0',CL4'LAX' 01050000 L R15,ALERTREQ ALERT SERVICE ENTRY 01051000 BALR R14,R15 ALERT LAX 01052000 CLI STALAXRQ+2,X'00' O.K. TO USE LINE ADDR? 01053000 BE STALNGOT YEP - DO IT 01054000 OC R0LADD(2),R0LADD ANY SPECIFIED? 01055000 BZ STAM701 NO - SAY NONE AVAIL 01056000 CLI STALAXRQ+2,X'02' ALREADY IN USE? 01057000 BE STAM702 YEP - SAY SO 01058000 CLI STALAXRQ+2,X'04' WRONG DEVICE TYPE? 01059000 BE STAM703 YEP - SAY SO 01060000 B STAM704 ELSE DEVICE NOT ATTACHED 01061000 SPACE 01062000 STALNGOT EQU * 01063000 L R6,TLINKS LINK TABL ADDR 01064000 CLC 4(2,R6),6(R6) PAST LINK LIMIT? 01065000 BNH STAMAXER YEP - FREE PORT, ISSUE MSG 01066000 MVC LACTLINE(2),STALAXRQ+4 SET LINE ADDR 01067000 MVC LACTTNME(4),R0TNME SET THE NEW TASK NAME 01068000 MVC LACTDRVR(8),R0DRVR SET THE DRIVER ID 01069000 MVC LACTCLS1(4),R0CLS1 SET THE NEW CLASSES 01070000 LM R0,R1,STARPARM GET STARTUP PARMS 01071000 L R15,=V(DMTCRE) GO START THE TASK 01072000 BALR R14,R15 GO DO IT 01073000 LTR R15,R15 WORK OKAY? 01074000 BNZ STACRERR NO - ERROR 01075000 LH R7,6(R6) GET OLD ACTIVE COUNT 01076000 LA R7,1(R7) UP ONE 01077000 STH R7,6(R6) AND SET NEW ACTIVE 01078000 MVI LFLAG,LACTIVE INDICATE LINK IS NOW ACTIVE 01079000 MVC CMXMSGV0(8),LINKID MOVE IN LINKID 01080000 MVC CMXMSGV1(4),LACTTNME AND THE TASK NAME 01081000 UNPK CMXMSGV3-1(5),LACTLINE(3) UNPACK THE LINE 01082000 TR CMXMSGV3(3),CMXTOEBC-240 TRANSLATE TO LEGAL EBCDIC 01083000 MVI CMXMSGV3+3,C' ' RESTORE CLOBBERED BLANK 01084000 MVC CMXMSGV2(8),LACTDRVR MOVE IN THE DRIVERID 01085000 MVC CMXMSGV4(4),LACTCLS1 MOVE IN THE CLASSES 01086000 LA R15,700 MOVE IN THE MSG NUMBER 01087000 LA R0,28+5*8 LENGTH OF VARIABLE FIELD 01088000 B CMXDOIT AND WRITE THE MSG 01089000 SPACE 2 01090000 STAMAXER EQU * 01091000 BAL R14,STAFREPT FREE THE PORT 01092000 L R6,TLINKS ADDR OF START OF LINK TABLS @VM01110 01092500 LH R0,4(R6) MAX ACTIVE LINKS COUNT @VM01110 01092600 B STAM710 ISSUE MAX ACTIVE MSG 01093000 EJECT 01094000 * 01095000 * FREE A PORT FOR THE CALLER 01096000 * 01097000 STAFREPT DC 0H'0' 01098000 XC LACTLINE(2),LACTLINE CLEAR LINK TABLE ENTRY 01099000 SPACE 01100000 L R6,TPORTS START OF PORT TABLE 01101000 ICM R7,B'1111',0(R6) COUNT OF LINE PORTS 01102000 BCR 8,R14 (BZ) - NO TABLE 01103000 LA R6,8(R6) ADDR OF FIRST 01104000 OI STALAXRQ+4,X'F0' MARK AS BUSY ... 01105000 STAFRENX EQU * 01106000 CLC STALAXRQ+4(2),0(R6) IS THIS THE ONE? 01107000 BE STAFREGT FOUND IT 01108000 LA R6,2(R6) NEXT ENTRY 01109000 BCT R7,STAFRENX TRY IT 01110000 SPACE 01111000 * 01112000 * ENTRY NOT FOUND 01113000 * 01114000 BR R14 RETURN TO CALLER 01115000 SPACE 01116000 STAFREGT EQU * 01117000 NI 0(R6),X'0F' FREE IT 01118000 BR R14 01119000 EJECT 01120000 STACRERR EQU * 01121000 BAL R14,STAFREPT FREE THE PORT 01122000 SLL R15,2 RETURN CODE*4 01123000 B STAERVEC-4(R15) AND USE CORRECT MSG 01124000 SPACE 1 01125000 STAERVEC EQU * 01126000 B STAM707 INVALID LOAD DATA FORMAT 01127000 B STAM708 REQ'D STORAGE UNAVAILABLE 01128000 B STAM709 TASK NAME DUPLICATE 01129000 B STAM708 MAX NO TASKS ACTIVE 01130000 B STAM708 NO SUP QUEUE ELEMENT AVAILABLE 01131000 B STAM707 UNEXPECTED EOF 01132000 B STAM705 FILE NOT FOUND 01133000 B STAM706 FILE (CMS) FORMAT ERROR 01134000 B STAM706 I/O ERROR 01135000 SPACE 3 01136000 STAM701 EQU * 01137000 LA R15,701 SET MESSAGE NUMBER 01138000 B CMXMLNK1 AND CONTINUE 01139000 SPACE 1 01140000 STAM702 EQU * 01141000 LA R8,R0LADD GET LINE ADDR 01142000 LA R9,CMXMSGV0 FIRST MSG PARM 01143000 BAL R14,CMXMCUU AND CONVERT TO EBCDIC 01144000 MVC CMXMSGV1(8),STALAXRQ+8 MOVE IN THE LINKID 01145000 MVC CMXMSGV2(8),LINKID MOVE IN THE OTHER ID 01146000 LA R0,28+3*8 LENGTH OF MSG 01147000 LA R15,702 MSG NUMBER 01148000 B CMXDOIT AND WRITE IT 01149000 SPACE 1 01150000 STAM703 EQU * 01151000 LA R8,R0LADD GET THE LINE ADDR 01152000 LA R9,CMXMSGV0 AND MSG TARGET 01153000 BAL R14,CMXMCUU AND MOVE INTO MSG 01154000 LA R15,703 MSG NUMBER 01155000 B CMXMLNK2 AND CONTINUE 01156000 SPACE 1 01157000 STAM704 EQU * 01158000 LA R8,R0LADD GET LINE ADDR 01159000 LA R9,CMXMSGV0 AND MSG TARGET 01160000 BAL R14,CMXMCUU AND CONVERT AND MOVE INTO MSG 01161000 LA R15,704 SET MSG NUMBER 01162000 B CMXMLNK2 AND CONTINUE 01163000 SPACE 1 01164000 STAM705 EQU * 01165000 MVC CMXMSGV0(8),R0DRVR GET DRIVER ID 01166000 L R8,=V(DMTCREDA) GET SYS DISK I/O TABLE ADDR 01167000 LA R8,DEVCUU-IOTABLE(R8) SYS DISK CUU ADDR 01168000 LA R9,CMXMSGV1 MSG TARGET 01169000 BAL R14,CMXMCUU CONVERT AND MOVE TO MSG 01170000 MVC CMXMSGV2(8),LINKID AND MOVE IN THE LINKID 01171000 LA R0,28+3*8 MSG LENGTH 01172000 LA R15,705 MSG NUMBER 01173000 B CMXDOIT AND WRITE IT 01174000 SPACE 1 01175000 STAM706 EQU * 01176000 L R8,=V(DMTCREDA) GET SYS DISK I/O TABLE ADDR 01177000 LA R8,DEVCUU-IOTABLE(R8) SYS DISK CUU ADDR 01178000 LA R9,CMXMSGV0 MSG TARGET 01179000 BAL R14,CMXMCUU CONVERT AND MOVE TO MSG 01180000 LA R15,706 SET MSG NUMBER 01181000 B CMXMLNK2 AND CONTINUE 01182000 SPACE 1 01183000 STAM707 EQU * 01184000 MVC CMXMSGV0(8),R0DRVR MOVE DRIVERID 01185000 LA R15,707 MSG NUMBER 01186000 B CMXMLNK2 AND CONTINUE 01187000 SPACE 1 01188000 STAM708 EQU * 01189000 LA R15,708 SET MSG NUMBER 01190000 B CMXMLNK1 AND CONTINUE 01191000 SPACE 1 01192000 STAM709 EQU * 01193000 MVC CMXMSGV0(4),R0TNME TASK NAME 01194000 LA R15,709 SET MSG NUMBER 01195000 B CMXMLNK2 AND CONTINUE 01196000 SPACE 1 01197000 STAM710 EQU * 01198000 SLR R1,R1 NO MIN DIGIT COUNT 01200000 LA R6,CMXMSGV0 NUMBER TARGET 01201000 BAL R14,DECPUT STOW EBCDIC COUNT 01202000 LA R15,710 FULL MSG CODE 01203000 B CMXMLNK2 ISSUE MESSAGE 01204000 SPACE 1 01205000 STAM750 EQU * 01206000 LA R15,750 SET MSG NUMBER 01207000 B CMXMLNK1 AND CONTINUE 01208000 SPACE 1 01209000 STAM751 EQU * 01210000 LA R15,751 SET MSG NUMBER 01211000 B CMXMLNK1 AND CONTINUE 01212000 EJECT 01213000 *. 01214000 *---------------------------------------------------------------------* 01215000 * DEFINE COMMAND * 01216000 *---------------------------------------------------------------------* 01217000 * 01218000 * OPERATION - 01219000 * 01220000 * IF THE SPECIFIED LINK IS ALREADY DEFINED AND INACTIVE, 01221000 * DEFAULT PARAMETER VALUES ARE INITIALIZED, ROUTINE 01222000 * 'R0FORMAT' IS CALLED TO DECODE REMAINDER OF COMMAND 01223000 * LINE OVERRIDING PARAMETER SETTINGS, AND A REDEFINE 01224000 * IS PERFORMED. IF THE SPECIFIED LINK IS NOT DEFINED, 01225000 * DEFAULT PARAMETERS ARE INITIALIZED, ROUTINE 'R0FORMAT' 01226000 * IS CALLED TO DECODE OVERRIDING PARAMETER VALUE SPECI- 01227000 * FICATIONS, AND THE NEW LINK IS DEFINED. 01228000 * 01229000 * RESPONSES - 01230000 * 01231000 * DMTCMX540I NEW LINK 'LINKID' DEFINED 01232000 * DMTCMX541I LINK 'LINKID' REDEFINED 01233000 * 01234000 * ERROR MESSAGES - 01235000 * 01236000 * DMTCMX202E INVALID LINK 'LINKID' 01236100 * DMTCMX542E LINK 'LINKID' ACTIVE -- NOT REDEFINED 01237000 * DMTCMX543E LINK 'LINKID' NOT DEFINED -- LINK LIMIT REACHED 01238000 * DMTCMX544E LINK 'LINKID' NOT DEFINED -- TYPE NOT SPECIFIED 01239000 *. 01240000 SPACE 01241000 DEFINE DC 0H'0' 01242000 LA R1,DEFSETUP SET KYWD SCAN TABLE ADDR 01243000 BAL R14,LTABGET TRY FOR A DEFINED LINK 01244000 B DEFNOLNK NOPE - TRY SOMETHING ELSE 01245000 * 01246000 * GOT DEFINED LINK TABLE ENTRY 01247000 * 01248000 TM LFLAG,LACTIVE DEFINE COMMAND VALID? 01249000 BO DEFM542 NOT FOR ACTIVE LINK 01250000 MVC R0CLS1(4),LDEFCLS1 SET DEFAULT CLASSES 01251000 MVC DEFKEEP(2),LRESERVD DEFAULT KEEP SLOT 01252000 MVC R0LADD(2),LDEFLINE DEFAULT LINE ADDRESS 01253000 MVC R0TNME(4),LDEFTNME DEFAULT TASK NAME 01254000 MVC R0DRVR(8),LDEFDRVR DEFAULT DRIVER TYPE 01255000 B R0FORMAT DECODE THE KEYWORDS 01256000 SPACE 01257000 DEFNOLNK EQU * 01258000 BC 13,CMXM202 INVALID LINK ID 01259000 L R2,TLINKS START OF LINK TABLE 01260000 L R6,0(R2) COUNT OF ENTRIES 01261000 LA R2,8(R2) FIRST LINK TABLE ENTRY 01262000 BCTR R6,0 DON'T LOOK AT LOCAL 01263000 LTR R6,R6 ANY AT ALL? 01264000 BZ DEFM543 NO 01265000 DEFNEXT EQU * 01266000 LA R2,LINKLEN(R2) NEXT LINK TABLE 01267000 CLI 0(R2),C' ' IN USE? 01268000 BE DEFLKNEW NOPE - USE IT 01269000 BCT R6,DEFNEXT TRY NEXT 01270000 B DEFM543 NONE AVAILABLE 01271000 SPACE 01272000 DEFLKNEW EQU * 01273000 * 01274000 * SET STANDARD DEFAULTS 01275000 * 01276000 MVC DEFID(8),CMXBLANK BLANK ID TO START 01277000 LA R6,DEFID TARGET ID FIELD 01278000 EX R4,CMXMOVE MOVE ID TO ID FIELD 01279000 MVC R0CLS1(4),=CL8'*' STANDARD CLASS DEFAULT = * 01280000 LA R6,2 STANDARD HOLD COUNT 01281000 STH R6,DEFKEEP SET DEFAULT FIELD 01282000 XC R0LADD(2),R0LADD UNDEFINED STANDARD 01283000 MVC R0TNME(4),DEFID DEFAULT TO LINK ID 01284000 MVI R0DRVR,X'FF' DRIVER ID MUST BE STATED 01285000 LA R3,1(R4,R3) UP TO START OF NEXT PARM 01286000 BAL R14,PARMGET AND FRAME IT 01287000 B R0FORMAT DECODE KEYWORDS FROM LINE 01288000 SPACE 3 01289000 DEFDO EQU * 01290000 LA R15,541 SET REDEFINED MSG CODE 01291000 CLI LINKID,C' ' REDEFINE? 01292000 BNE DEFREDEF YEP 01293000 CLI R0DRVR,X'FF' DRIVER SPECIFIED? 01294000 BE DEFM544 NOPE - INVALID 01295000 LA R15,540 SET NEW DEFINE CODE 01296000 MVC LINKID(8),DEFID NEW LINK ID 01297000 DEFREDEF EQU * 01298000 MVC LDEFCLS1(4),R0CLS1 LINKS FOR DEFAULT 01299000 MVC LRESERVD(2),DEFKEEP KEEP SLOTS FOR DEFAULT 01300000 MVC LDEFLINE(2),R0LADD LINE FOR DEFAULT 01301000 MVC LDEFTNME(4),R0TNME TASK FOR DEFAULT 01302000 MVC LDEFDRVR(8),R0DRVR TYPE FOR DEFAULT 01303000 * 01304000 * NEW OR RE DEFINITION COMPLETE 01305000 * 01306000 B CMXMLNK1 ISSUE SUCCESS MSG 01307000 SPACE 3 01308000 DEFM542 EQU * 01309000 LA R15,542 MSG CODE 01310000 B CMXMLNK1 SET LINK ID 01311000 SPACE 01312000 DEFM543 EQU * 01313000 LA R15,543 MSG CODE 01314000 B CMXMV1 SET LINK ID FROM LINE 01315000 SPACE 01316000 DEFM544 EQU * 01317000 LA R15,544 MSG CODE 01318000 LA R3,DEFID SET ID POINTER 01319000 LA R4,7 AND LENGTH (-1) 01320000 B CMXMV1 AND DO THE MSG 01321000 EJECT 01322000 *. 01323000 *---------------------------------------------------------------------* 01324000 * R0FORMAT -- DECODE START AND DEFINE COMMAND LINES * 01325000 *---------------------------------------------------------------------* 01326000 * 01327000 * OPERATION - 01328000 * 01329000 * ON ENTRY, GREG1 POINTS TO A TABLE OF INITIAL REG VALUES 01330000 * FOR A CALL TO KEYWDGET, SPECIFYING A TABLE OF VALID 01331000 * KEYWORDS FOR THE CALLING COMMAND ROUTINE. THE ENTIRE 01332000 * COMMAND LINE IS DECODED THROUGH CALLS TO KEYWDGET, 01333000 * AND THE VARIABLE VALUES R0DRVR - R0LAD0 ARE FILLED IN 01334000 * AS SPECIFIED IN THE COMMAND LINE. 01335000 * 01336000 * RESPONSES - 01337000 * 01338000 * NONE 01339000 * 01340000 * ERROR MESSAGES - 01341000 * 01342000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 01343000 * DMTCMX205E CONFLICTING KEYWORD 'KEYWORD' 01344000 * DMTCMX206E INVALID OPTION 'KEYWORD' 'OPTION' 01345000 *. 01346000 SPACE 01347000 R0FORMAT EQU * 01348000 LM R7,R9,0(R1) LOAD SCAN REGISTERS 01349000 BAL R14,TBLCLEAR CLEAR THE TABLE 01350000 R0SCAN EQU * 01351000 LM R7,R9,0(R1) SETUP FOR SCAN 01352000 BAL R14,KEYWDGET GET A KEYWORD 01353000 BC 7,CMXM204 INVALID KEYWORD - ERROR 01354000 CLI CMXELCOD,X'80' END OF LINE - START COMMAND? 01355000 BE STADO YES - DO THE START 01356000 B DEFDO FINISH OFF DEFINE 01357000 SPACE 01358000 R0MORE EQU * 01359000 LA R3,1(R4,R3) UP TO START OF NEXT PARM 01360000 BAL R14,PARMGET FRAME IT 01361000 B R0SCAN SCAN FOR A KEYWORD 01362000 SPACE 1 01363000 R0CLASS EQU * 01364000 TM 12(R7),X'80' HAVE I SEEN IT BEFORE? 01365000 BO CMXM205 YES..CONFLICT 01366000 OI 12(R7),X'80' INDICATE THIS ONE FOUND 01367000 SR R4,R3 GET LENGTH OF PARM 01368000 BNP CMXM206 ERROR IF NOT POSITIVE 01369000 BCTR R4,0 DOWN BY ONE FOR CHAR OP 01370000 LTR R4,R4 COUNT OF ONE? 01371000 BNZ R0CLMULT NOPE - '*' IMPOSSIBLE 01372000 CLI 0(R3),C'*' IS IT ALL-CLASS? 01373000 BE R0CLASTK YEP - SKIP ALPHA TEST 01374000 R0CLMULT EQU * 01375000 LA R0,4 GET MAX 01376000 CLR R4,R0 TOO LONG 01377000 BNL CMXM206 ERROR 01378000 LR R6,R2 SAVE LINKTABL ADDRESS 01379000 EX R4,CMXATEST VALIDATE CLASS SPEC 01380000 LR R2,R6 RESTORE LINKTABL ADDR 01381000 BC 7,CMXM206 INVALID CHAR DETECTED 01382000 R0CLASTK EQU * 01383000 MVC R0CLS2(3),CMXBLANK BLANK RIGHT SIDE 01384000 LA R6,R0CLS1 GET FIRST FIELD ADDR 01385000 EX R4,CMXMOVE MOVE CLASSES TO LINKTABL 01386000 B R0MORE AND CONTINUE 01387000 SPACE 01388000 R0LINE EQU * 01389000 TM 12(R7),X'80' HAVE WE ALREADY SEEN THIS PARM? 01390000 BO CMXM205 YES..ERROR 01391000 OI 12(R7),X'80' INDICATE WE HAVE FOUND IT 01392000 LM R8,R9,CMXDVRNG GET THE RANGE FOR LINE ADDRS 01393000 BAL R14,HEXGET GO GET THE LINE ADDR 01394000 BC 7,CMXM206 ERROR 01395000 * VALID LINE ADDR IN IN REG.0 01396000 STH R0,R0LADD SAVE IN LINE FIELD 01397000 B R0MORE AND GO GET THE NEXT PARM 01398000 SPACE 1 01399000 R0TASK EQU * 01400000 TM 12(R7),X'80' ALREADY SEEN THIS ONE? 01401000 BO CMXM205 YES..ERROR 01402000 OI 12(R7),X'80' NOW WE HAVE SEEN IT 01403000 SR R4,R3 CALCULATE LENGTH 01404000 BCTR R4,0 REDUCE BY 1 FOR CHAR OP 01405000 LA R0,4 MAX LENGTH 01406000 CLR R4,R0 TOO LONG? 01407000 BNL CMXM206 YES 01408000 MVC R0TNME(4),CMXBLANK BLANK OUT 01409000 LA R6,R0TNME GET THE TASK NAME FIELD 01410000 EX R4,CMXMOVE AND SET TO SPECIFICATION 01411000 B R0MORE GET THE NEXT PARM 01412000 SPACE 1 01413000 R0TYPE EQU * 01414000 TM 12(R7),X'80' HAVE WE SEEN THIS ONE BEFORE? 01415000 BO CMXM205 YES..ERROR 01416000 OI 12(R7),X'80' NOW WE HAVE 01417000 SR R4,R3 GET LENGTH OF PARM 01418000 BNP CMXM206 ERROR 01419000 BCTR R4,0 REDUCE BY ONE FOR CHAR OP 01420000 CL R4,CMXLIMIT TOO LONG? 01421000 BNL CMXM206 YES 01422000 MVC R0DRVR(8),CMXBLANK BLANK OUT FIELD 01423000 LA R6,R0DRVR GET DRIVER FIELD 01424000 EX R4,CMXMOVE AND MOVE IT IN 01425000 B R0MORE GO GET THE NEXT PARM 01426000 SPACE 1 01427000 R0PARM EQU * 01428000 ST R3,STARPARM+4 STORE START START OF PARM FIELD 01429000 R0PSCAN EQU * 01430000 BCTR R5,0 REDUCE BY ONE FOR CHAR OP 01431000 CLR R3,R5 END? 01432000 BH STADO NULL PARM LINE 01433000 CLI 0(R5),C' ' BLANK YET? 01434000 BE R0PSCAN YES ..END 01435000 LA R5,1(R5) UP BY ONE 01436000 SR R5,R3 GET THE LENGTH 01437000 ST R5,STARPARM STORE PARM COUNT 01438000 B STADO DO IT 01439000 SPACE 01440000 R0KEEP EQU * 01441000 TM 12(R7),X'80' SEEN KEEP ALREADY? 01442000 BO CMXM205 YEP - CONFLICT 01443000 OI 12(R7),X'80' SET SEEN FLAG 01444000 LM R8,R9,CMXKPRNG SET VALID KEEP RANGE 01445000 BAL R14,DECGET LOAD THE SPECIFIED NUMBER 01446000 BC 7,CMXM206 NO GOOD 01447000 STH R0,DEFKEEP SAVE FOR LATER 01448000 B R0MORE AND GET ANOTHER KEYWORD 01449000 EJECT 01450000 DEFSETUP DC A(DEFTABLE) START OF DEFINE TABLE 01451000 DC A(R0INC) LENGTH OF ENTRY 01452000 DC A(DEFEND-R0INC) ADDR OF LAST ENTRY 01453000 SPACE 01454000 STASETUP DC A(STATABLE) START OF START TABLE 01455000 DC A(R0INC) LENGTH OF ENTRY 01456000 DC A(STAEND-R0INC) START OF LAST ENTRY 01457000 SPACE 1 01458000 R0INC EQU 8+4+4 LENGTH OF TABLE ENTRY 01459000 SPACE 01460000 DEFTABLE DC 0F'0' 01461000 DC CL8'KEEP',AL1(4-1),AL3(R0KEEP),XL4'0' 01462000 STATABLE EQU * 01463000 DC CL8'CLASS',AL1(2-1),AL3(R0CLASS),XL4'0' CLASS OPTION 01464000 DC CL8'LINE',AL1(4-1),AL3(R0LINE),XL4'0' LINE OPTION 01465000 DC CL8'TASK',AL1(4-1),AL3(R0TASK),XL4'0' TASK OPTION 01466000 DC CL8'TYPE',AL1(4-1),AL3(R0TYPE),XL4'0' TYPE OPTION 01467000 DEFEND EQU * 01468000 DC CL8'PARM',AL1(1-1),AL3(R0PARM),XL4'0' PARM OPTION 01469000 STAEND EQU * 01470000 SPACE 1 01471000 STARPARM DC 2F'0' PARM REGS TO PASS TO LINE DRIVERS 01472000 SPACE 1 01473000 R0DRVR DC CL8' ' DRIVER ID START FIELD 01474000 R0TNME DC CL4' ' TASK NAME START FIELD 01475000 R0CLS1 DC C' ' CLASS START FIELD 01476000 R0CLS2 DC CL3' ' 01477000 R0LADD DC H'0' LINE ADDR START FIELD 01478000 SPACE 1 01479000 DEFKEEP DC H'0' HOLD SLOT FIELD 01480000 DEFID DC CL8' ' LINK ID FIELD FOR DEFINE 01481000 SPACE 01482000 STALAXRQ DC 0F'0',AL1(16-1),X'01',X'0000' LAX ALERT REQ 01483000 DC X'0000',X'0000' LINE ADDR, UNUSED 01484000 DC CL8' ' LINKID RETURN FIELD 01485000 EJECT 01486000 *. 01487000 *--------------------------------------------------------------------* 01488000 * DELETE COMMAND * 01489000 *--------------------------------------------------------------------* 01490000 * 01491000 * RESPONSES - 01492000 * 01493000 * DMTCMX550I LINK 'LINKID' NOW DELETED 01494000 * 01495000 * ERROR MESSAGES - 01496000 * 01497000 * DMTCMX551E LINK 'LINKID' ACTIVE -- NOT DELETED 01498000 * DMTCMX552E LINK 'LINKID' HAS A FILE QUEUE - NOT DELETED 01499000 *. 01500000 SPACE 01501000 DELETE DC 0H'0' 01502000 BAL R14,LTABGET LOCATE DELETEE LINK TABLE 01503000 B CMXNOLNK NONE - FORGET IT 01504000 TM LFLAG,LACTIVE IS THE LINK ACTIVE NOW? 01505000 BNZ DELM551 YEP - FOUL 01506000 SPACE 01507000 OC LPOINTER(4),LPOINTER IS THERE A TAG QUEUE? 01508000 BNZ DELM552 YEP - NO DELETE 01509000 OC LPENDING(2),LPENDING OR PENDING FILES? 01510000 BNZ DELM552 SAME PROBLEM IF SO 01511000 SPACE 01512000 DELDELET EQU * 01513000 MVC CMXMSGV0(8),LINKID SET LINK ID IN MSG 01514000 MVI LINKID,C' ' UNDEFINE THE LINK 01515000 LA R0,28+8 SET MSG ELEMENT LENGTH 01516000 LA R15,550 SET NORMAL RESPONSE MSG 01517000 B CMXDOIT ISSUE RESPONSE MSG 01518000 SPACE 01519000 DELM551 EQU * 01520000 LA R15,551 SET ERROR MSG CODE 01521000 B CMXMLNK1 ISSUE RESPONSE 01522000 DELM552 EQU * 01523000 LA R15,552 SET ERROR MSG CODE 01524000 B CMXMLNK1 ISSUE RESPONSE 01525000 EJECT 01526000 *. 01527000 *---------------------------------------------------------------------* 01528000 * DISCONN COMMAND * 01529000 *---------------------------------------------------------------------* 01530000 * 01531000 * RESPONSES - 01532000 * 01533000 * DMTCMX560I RSCS DISCONNECTING 01534000 * 01535000 * ERROR MESSAGES - 01536000 * 01537000 * DMTCMX208E INVALID USER ID 'USERID' 01538000 * DMTCMX561E USER 'USERID' NOT RECEIVING 01539000 *. 01540000 SPACE 01541000 DISCONN DC 0H'0' 01542000 MVC DISMSGID(8),CMXBLANK INITIALIZE MSG ID 01543000 CLR R3,R5 END OF LINE? 01544000 BNL DISCHARG YES - DO IT AS IS 01545000 SR R4,R3 ID CHAR COUNT 01546000 BCTR R4,0 DECREMENT ONE 01547000 BNP CMXM208 BAD COUNT - ERROR 01548000 CL R4,CMXLIMIT TOO LONG? 01549000 BNL CMXM208 YEP - REJECT IT 01550000 LA R6,DISMSGID MSG ID TARGET 01551000 EX R4,CMXMOVE MOVE ID TO MSG LINE 01552000 SPACE 01553000 LA R1,DISMSG ADDR OF MSG LINE 01554000 LA R2,L'DISMSG LENGTH OF MSG LINE 01555000 L R15,=V(DMTREXHC) ENTRY FOR HYPERVISOR CALL 01556000 BALR R14,R15 ISSUE MSG REQUEST 01557000 LTR R2,R2 ANY GOOD? 01558000 BNZ DISM561 ID NO GOOD - ERROR 01559000 SPACE 01560000 DISCHARG EQU * 01561000 MVI CMXMSG,28-1 SET COUNT FOR MSG REQ 01562000 LA R15,560 SET MSG REQ CODE 01563000 STH R15,CMXMSGNM STORE CODE IN REQUEST 01564000 LA R1,CMXMSG ADDR OF MSG REQUEST 01565000 L R15,=V(DMTMGX) ENTRY FOR MESSAGE EXECUTOR 01566000 BALR R14,R15 CALL MESSAGE EXECUTION 01567000 SPACE 01568000 L R15,=V(DMTREXID) ADDR OF REX'S MSG ID 01569000 MVC 0(8,R15),DISMSGID MOVE ID TO REX'S FIELD 01570000 L R1,=V(DMTREXCN) ADDR OF CONSOLE I/O TABLE 01571000 MVI DEVCODE-IOTABLE(R1),X'FF' SET DISCONNECT 01572000 SPACE 01573000 LA R1,DISDISCN ADDR OF DISCONN COMMAND 01574000 LA R2,L'DISDISCN LENGTH OF DISCONN COMMAND 01575000 L R15,=V(DMTREXHC) ENTRY FOR HYPERVISOR CALL 01576000 BALR R14,R15 DISCONNECT FROM VM/370 01577000 B CMXFINIS CHECK STORAGE AND EXIT 01578000 SPACE 3 01579000 DISM561 EQU * 01580000 LA R15,561 SET MSG CODE 01581000 B CMXMV1 AND ISSUE MSG 01582000 SPACE 3 01583000 DISMSG DC C'M XXXXXXXX ' 01584000 DISMSGID EQU DISMSG+2 01585000 SPACE 01586000 DISDISCN DC C'DISCONN' 01587000 EJECT 01588000 *. 01589000 *---------------------------------------------------------------------* 01590000 * PURGE COMMAND * 01591000 *---------------------------------------------------------------------* 01592000 * 01593000 * OPERATION - 01594000 * 01595000 * PURGE PROCESSING SHARES ORDER PROCESSING, CODED BELOW. 01596000 *. 01597000 SPACE 01598000 PURGE DC 0H'0' 01599000 SPACE 2 01600000 *. 01601000 *---------------------------------------------------------------------* 01602000 * ORDER COMMAND * 01603000 *---------------------------------------------------------------------* 01604000 * 01605000 * OPERATION - 01606000 * 01607000 * FOR PURGE AND ORDER COMMANDS, A FORMAT A1 COMMAND ELEMENT 01608000 * IS BUILT AND PASSED TO AXS THROUGH THE ALERT INTERFACE. 01609000 * 01610000 * RESPONSES - 01611000 * 01612000 * NONE 01613000 * 01614000 * ERROR MESSAGES - 01615000 * 01616000 * DMTCMX203E INVALID SPOOL FILE ID 'SPOOLID' 01617000 *. 01618000 SPACE 01619000 ORDER EQU * 01620000 SPACE 2 01621000 A1FORMAT EQU * 01622000 LTR R0,R0 REMOTE ORIGIN? 01623000 BNZ A1FLKGOT YES - GOT LINK TABLE 01624000 BAL R14,LTABGET GET SPECIFIED LINK FROM LINE 01625000 B CMXNOLNK NO GOT - ERROR 01626000 MVI CMXELMOD,X'80' SET AXS TO RESPOND TO LOCAL 01627000 MVC CMXELORG(8),LINKID SET OBJECT LINK 01628000 A1FLKGOT EQU * 01629000 CLR R3,R5 ANY LINE TO GO? 01630000 BNL CMXM203 INVALID SPOOL FILE ID 01631000 LA R6,CMXELVAR+2 INITIALIZE LOAD POINTER 01632000 LA R7,CMXELVAR+L'CMXELVAR INITIALIZE LOAD LIMIT 01633000 LM R8,R9,CMXSPRNG GET VALID SPOOL ID RANGE 01634000 BAL R14,DECGET LOAD A SPOOL ID 01635000 BC 8,A1FSTOW GOT ONE - USE IT 01636000 BC 5,CMXM203 INVALID SPOOL FILE ID 01637000 CLI CMXELCOD,X'11' PURGE COMMAND? 01638000 BNE CMXM203 NO - 'ALL' INVALID 01639000 LA R0,2 LENGTH -1 OF 'ALL' 01640000 CLR R4,R0 RIGHT LENGTH? 01641000 BNE CMXM203 NO - INVALID SPOOL ID 01642000 CLC 0(3,R3),=C'ALL' DOES IT SAY 'ALL'? 01643000 BNE CMXM203 NO - INVALID SPOOL ID 01644000 OI CMXELMOD,X'40' SET TO PURGE ALL 01645000 LA R0,12 SET LENGTH OF CMD ELMNT 01646000 B A1FIRE GIVE IT TO AXS 01647000 SPACE 01648000 A1FSTOW EQU * 01649000 CLR R6,R7 ANY ROOM LEFT? 01650000 BNL A1FINIS NOPE - TRUNCATE LINE 01651000 STH R0,0(R6) SET SPOOL ID IN CMD 01652000 LA R6,2(R6) AND UPDATE LOAD POINT 01653000 LA R3,1(R4,R3) END OF CURRENT PARM 01654000 BAL R14,PARMGET TO START OF NEXT 01655000 CLR R3,R5 ANY? 01656000 BNL A1FINIS NOPE - ALL DONE WITH LINE 01657000 BAL R14,DECGET GET ANOTHER SPOOL ID 01658000 BC 7,CMXM203 INVALID - ERROR 01659000 B A1FSTOW PUT IT IN THE CMD ELMNT 01660000 SPACE 01661000 A1FINIS EQU * 01662000 LR R0,R6 SAVE ENDING LOAD POINT 01663000 LA R7,CMXELVAR+2 STARTING LOAD POINT 01664000 SLR R6,R7 TOTAL BYTE COUNT OF ID'S 01665000 SRL R6,1 DIVIDE BY TWO 01666000 STH R6,CMXELVAR STOW SPOOL ID COUNT IN CMD 01667000 LA R7,CMXELMNT ADDR OF START OF CMD ELMNT 01668000 SLR R0,R7 TOTAL CMD ELMNT BYTE COUNT 01669000 SPACE 01670000 A1FIRE EQU * 01671000 BCTR R0,0 DECREMENT BY ONE 01672000 STC R0,CMXELLEN AND SET IN CMD ELEMNT 01673000 L R0,CMXAXS NAME 'AXS' 01674000 B CMXALRDY ALERT AXS 01675000 EJECT 01676000 *. 01677000 *---------------------------------------------------------------------* 01678000 * CHANGE COMMAND * 01679000 *---------------------------------------------------------------------* 01680000 * 01681000 * OPERATION - 01682000 * 01683000 * A FORMAT A2 COMMAND ELEMENT IS BUILT AND PASSED TO AXS. 01684000 * 01685000 * RESPONSES - 01686000 * 01687000 * NONE 01688000 * 01689000 * ERROR MESSAGES - 01690000 * 01691000 * DMTCMX203E INVALID SPOOL FILE ID 'SPOOLID' 01692000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 01693000 * DMTCMX205E CONFLICTING KEYWORD 'KEYWORD' 01694000 * DMTCMX206E INVALID OPTION 'KEYWORD' 'OPTION' 01695000 *. 01696000 SPACE 01697000 CHANGE DC 0H'0' 01698000 LTR R0,R0 REMOTE ORIGIN? 01699000 BNZ CHALKGOT YES - ALREADY HAVE LINK 01700000 BAL R14,LTABGET GET THE NAMED LINK TABLE 01701000 B CMXNOLNK NO LINK NO CHANGE 01702000 MVI CMXELMOD,X'80' SET AXS TO RESPOND TO LOCAL 01703000 MVC CMXELORG(8),LINKID SET LINK ID FOR AXS 01704000 CHALKGOT EQU * 01705000 CLR R3,R5 END OF LINE ALREADY? 01706000 BNL CMXM203 YEP - INVALID SPOOL ID 01707000 LM R8,R9,CMXSPRNG SET SPOOL ID RANGE 01708000 BAL R14,DECGET LOAD THE SPOOL ID 01709000 BC 7,CMXM203 INVALID - ERROR 01710000 STH R0,CMXELVAR SET SPOOL ID IN CMD 01711000 LA R3,1(R4,R3) END OF CURRENT PARM 01712000 BAL R14,PARMGET START OF NEXT 01713000 CLR R3,R5 END YET? 01714000 BNL CMXM204 INVALID KEYWORD ... 01715000 LM R7,R9,CHASETUP SET UP CHANGE TABLE 01716000 BAL R14,TBLCLEAR CLEAR VARIABLE AREAS 01717000 MVI CMXELVAR+2,X'FF' INITIALIZE UNSPEC FIELD 01718000 MVC CMXELVAR+3(37),CMXELVAR+2 DO WHOLE THING 01719000 SPACE 01720000 CHASCAN EQU * 01721000 LM R7,R9,CHASETUP SET UP FOR KEYWD SCAN 01722000 BAL R14,KEYWDGET LOOK FOR A KEYWORD 01723000 BC 7,CMXM204 FOUND AN INVALID ONE 01724000 SPACE 01725000 CHAFIRE EQU * 01726000 MVI CMXELLEN,52-1 SET ELEMENT LENGTH 01727000 L R0,CMXAXS GET 'AXS' NAME 01728000 B CMXALRDY ALERT AXS FOR COMMAND 01729000 SPACE 01730000 CHAMORE EQU * 01731000 LA R3,1(R4,R3) END OF CURRENT PARM 01732000 BAL R14,PARMGET START OF NEXT 01733000 B CHASCAN TRY FOR ANOTHER KEYWD 01734000 SPACE 01735000 CHAPRIOR EQU * 01736000 TM 12(R7),X'80' ALREADY SEEN? 01737000 BO CMXM205 YEP - CONFLICT 01738000 OI 12(R7),X'80' SET SEEN FLAG 01739000 LM R8,R9,CMXPRRNG VALID PRIORITY RANGE 01740000 BAL R14,DECGET LOAD THE PRIORITY 01741000 BC 7,CMXM206 INVALID OPTION 01742000 STH R0,CMXELVAR+2 SET IN CMD ELEMNT 01743000 B CHAMORE AND TRY ANOTHER 01744000 SPACE 01745000 CHACLASS EQU * 01746000 TM 12(R7),X'80' BEEN HERE BEFORE? 01747000 BO CMXM205 YEP - CONFLICT 01748000 OI 12(R7),X'80' SET SEEN FLAG 01749000 SR R4,R3 OPTION CHAR COUNT 01750000 BCTR R4,0 DECREMENT COUNT ONE 01751000 LTR R4,R4 WAS COUNT ONE? 01752000 BNZ CMXM206 NOPE - INVALID OPTION 01753000 EX 0,CMXATEST CHECK FOR VALIDITY 01754000 BC 7,CMXM206 INVALID CLASS CHAR 01755000 MVC CMXELVAR+5(1),0(R3) MOVE TO CMD ELMNT 01756000 B CHAMORE AND TRY ANOTHER 01757000 SPACE 01758000 CHACOPY EQU * 01759000 TM 12(R7),X'80' SEEN KEYWD ALREADY? 01760000 BO CMXM205 YEP - CONFLICT 01761000 OI 12(R7),X'80' SET SEEN FLAG 01762000 LM R8,R9,CMXCORNG VALID COPIES RANGE 01763000 BAL R14,DECGET LOAD REQUESTED COPIES 01764000 BC 7,CMXM206 INVALID NUMBER 01765000 STH R0,CMXELVAR+6 STOW COUNT IN ELMNT 01766000 B CHAMORE AND GO FOR MORE 01767000 SPACE 01768000 CHAHOLD EQU * 01769000 TM 12(R7),X'80' SEEN HOLD OR NOHOLD? 01770000 BO CMXM205 YEP - CONFLICT 01771000 OI 12(R7),X'80' SET SEEN FLAG 01772000 ALR R7,R8 BUMP TO NEXT ENTRY 01773000 OI 12(R7),X'80' FLAG NOHOLD TOO 01774000 NI CMXELVAR+4,X'7F' SET HOLD MOD 01775000 B CHASCAN AND TRY ANOTHER 01776000 SPACE 01777000 CHANOHOL EQU * 01778000 TM 12(R7),X'80' SEEN HOLD OR NOHOLD? 01779000 BO CMXM205 YEP - CONFLICT 01780000 OI 12(R7),X'80' FLAG AS SEEN 01781000 SLR R7,R8 BUMP TO LAST ENTRY 01782000 OI 12(R7),X'80' FLAG HOLD TOO 01783000 NI CMXELVAR+4,X'3F' SET NOHOLD MOD 01784000 B CHASCAN TRY ANOTHER 01785000 SPACE 01786000 CHADIST EQU * 01787000 SR R4,R3 OPTION CHAR COUNT 01788000 BCTR R4,0 DOWN ONE 01789000 BNP CMXM206 INVALID OPTION 01790000 CL R4,CMXLIMIT OPTION TOO LONG? 01791000 BNL CMXM206 YES - INVALID 01792000 MVC CMXELVAR+8(8),CMXBLANK BLANK TO START 01793000 LA R6,CMXELVAR+8 DIST CODE TARGET 01794000 EX R4,CMXMOVE MOVE DIST CODE TO CMD 01795000 B CHAMORE TRY ANOTHER 01796000 SPACE 01797000 CHANAME EQU * 01798000 SR R4,R3 OPTION CHAR COUNT 01799000 BCTR R4,0 DOWN ONE 01800000 BNP CMXM206 INVALID OPTION 01801000 LA R0,24 MAX COUNT FOR DSNAME 01802000 CLR R4,R0 TOO BIG? 01803000 BNL CMXM206 YEP - ERROR 01804000 MVI CMXELVAR+16,C' ' BLANK FIRST DSNAME CHAR 01805000 MVC CMXELVAR+17(23),CMXELVAR+16 BLANK WHOLE THING 01806000 LA R6,CMXELVAR+16 SET DSNAME TARGET 01807000 EX R4,CMXMOVE MOVE DSNAME TO CMD 01808000 CL R4,CMXLIMIT LESS THAN 9? 01809000 BNL CHANTERM NOPE - DONE 01810000 LA R3,1(R4,R3) END OF FNAME 01811000 BAL R14,PARMGET START OF FTYPE 01812000 SR R4,R3 COUNT OF FTYPE 01813000 BNP CHAFIRE NO FTYPE - ALL DONE 01814000 BCTR R4,0 COUNT DOWN ONE 01815000 CL R4,CMXLIMIT TOO LONG? 01816000 BNL CMXM206 YEP - INVALID OPTION 01817000 LA R6,CMXELVAR+28 SET FTYPE TARGET 01818000 EX R4,CMXMOVE MOVE FTYPE TO CMD 01819000 CHANTERM EQU * 01820000 LA R3,1(R4,R3) END OF NAME OPTION 01821000 BAL R14,PARMGET SEE IF ANY MORE 01822000 SR R4,R3 COUNT OF NEXT PARM 01823000 BCTR R4,0 DOWN ONE IN CASE ... 01824000 BNP CHAFIRE ALL DONE - DO IT 01825000 B CMXM204 ELSE INVALID KEYWORD 01826000 EJECT 01827000 CHASETUP DC A(CHATABLE) KEYWORD TABLE 01828000 DC A(CHAINC) LENGTH OF ENTRY 01829000 DC A(CHAEND-CHAINC) LAST ENTRY ADDR 01830000 SPACE 01831000 CHATABLE DC 0F'0' 01832000 DC CL8'PRIORITY',AL1(3-1),AL3(CHAPRIOR),XL4'0' 01833000 DC CL8'CLASS',AL1(2-1),AL3(CHACLASS),XL4'0' 01834000 DC CL8'COPY',AL1(2-1),AL3(CHACOPY),XL4'0' 01835000 DC CL8'HOLD',AL1(2-1),AL3(CHAHOLD),XL4'0' 01836000 DC CL8'NOHOLD',AL1(3-1),AL3(CHANOHOL),XL4'0' 01837000 DC CL8'DIST',AL1(2-1),AL3(CHADIST),XL4'0' 01838000 DC CL8'NAME',AL1(2-1),AL3(CHANAME),XL4'0' 01839000 CHAEND EQU * 01840000 SPACE 01841000 CHAINC EQU 8+4+4 LENGTH OF TABLE ENTRY 01842000 EJECT 01843000 *. 01844000 *---------------------------------------------------------------------* 01845000 * DRAIN COMMAND * 01846000 *---------------------------------------------------------------------* 01847000 * 01848000 * DRAIN PROCESSING SHARES TRACE PROCESSING CODED BELOW. 01849000 *. 01850000 SPACE 01851000 DRAIN DC 0H'0' 01852000 SPACE 2 01853000 *. 01854000 *---------------------------------------------------------------------* 01855000 * FREE COMMAND * 01856000 *---------------------------------------------------------------------* 01857000 * 01858000 * FREE PROCESSING SHARES TRACE PROCESSING CODED BELOW. 01859000 *. 01860000 SPACE 01861000 FREE EQU * 01862000 SPACE 2 01863000 *. 01864000 *---------------------------------------------------------------------* 01865000 * HOLD COMMAND * 01866000 *---------------------------------------------------------------------* 01867000 * 01868000 * HOLD PROCESSING SHARES TRACE PROCESSING CODED BELOW. 01869000 *. 01870000 SPACE 01871000 HOLD EQU * 01872000 SPACE 2 01873000 *. 01874000 *---------------------------------------------------------------------* 01875000 * TRACE COMMAND * 01876000 *---------------------------------------------------------------------* 01877000 * 01878000 * OPERATION - 01879000 * 01880000 * A L0 FORMAT COMMAND ELEMENT IS BUILT AND PASSED TO THE 01881000 * APPROPRIATE LINK'S LINE DRIVER THROUGH THE ALERT 01882000 * INTERFACE. 01883000 * 01884000 * RESPONSES - 01885000 * 01886000 * NONE 01887000 * 01888000 * ERROR MESSAGES - 01889000 * 01890000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 01891000 * DMTCMX205E CONFLICTING KEYWORD 'KEYWORD' 01892000 * DMTCMX206E INVALID OPTION 'KEYWORD' 'OPTION' 01893000 * DMTCMX303E LINK 'LINKID' IS NOT ACTIVE 01894000 *. 01895000 SPACE 01896000 TRACE EQU * 01897000 SPACE 2 01898000 L0FORMAT EQU * 01899000 LTR R0,R0 WAS ORIGIN CONSOLE? 01900000 BNZ L0FLKGOT NO - GOT LINK TABLE ALREADY 01901000 BAL R14,LTABGET GET A LINK TABLE ADDR 01902000 B CMXNOLNK NONE SPECIFIED 01903000 L0FLKGOT EQU * 01904000 TM LFLAG,LACTIVE IS IT ACTIVE? 01905000 BNO CMXM303 NO - SAY SO 01906000 CLR R3,R5 END OF LINE? 01907000 BNL L0FIRE YES - ACCEPT DEFAULTS 01908000 CLI CMXELCOD,X'83' HOLD COMMAND? 01909000 BL L0FOUL NOPE - DRAIN OR FREE @VM01111 01910010 CLI CMXELCOD,X'83' HOLD COMMAND? 01911000 BE L0HOLD YEP - DO IT 01912000 SPACE 01913000 * TRACE COMMAND 01914000 SPACE 01915000 SLR R0,R0 INITIALIZE FLAG REG 01916000 L0TRACE EQU * 01917000 LM R7,R9,TRASETUP SET UP FOR KEYWD SCAN 01918000 BAL R14,KEYWDGET SEE IF ANY 01919000 BC 7,CMXM204 INVALID OR UNDEFINED @VM01112 01920010 B L0FIRE MISSING - DEFAULT OR DONE 01921000 SPACE 01922000 L0TKEYWD EQU * 01923000 LTR R0,R0 BEEN HERE BEFORE? 01924000 BNZ CMXM205 YEP - CONFLICTING KEYWORD 01925000 BCTR R0,0 FLAG FIRST PASS 01926000 MVC CMXELMOD(1),12(R7) SET MODIFIER BYTE 01927000 B L0TRACE AND TRY FOR MORE 01928000 SPACE 2 01929000 * HOLD COMMAND 01930000 SPACE 01931000 L0HOLD EQU * 01932000 SR R4,R3 KEYWD CHAR COUNT 01933000 BNP CMXM206 FUNNY KEYWORD 01934000 LA R0,5 REQD COUNT FOR IMMED 01935000 CLR R4,R0 CORRECT? 01936000 BNE CMXM206 NOPE - ERROR 01937000 CLC 0(5,R3),=C'IMMED' CORRECTLY SPELLED? 01938000 BNE CMXM206 NOPE - ERROR 01939000 MVI CMXELMOD,X'80' SET IMMED MODIFIER 01940000 LA R3,1(R4,R3) UPDATE PARM POINTER 01944000 BAL R14,PARMGET TRY FOR ANOTHER 01945000 CLR R3,R5 GET ONE? 01946000 BNL L0FIRE NOPE - GO TO IT 01947000 L0FOUL EQU * @VM01111 01947500 LR R4,R3 LENGTH OF PARM 01948000 BCTR R4,0 DOWN ONE 01949000 B CMXM204 AND ISSUE ERROR MSG 01950000 SPACE 01951000 L0FIRE EQU * 01952000 LA R0,CMXELVAR-CMXELMNT SET CMD ELEMENT LENGTH 01953000 B CMXALERT AND KICK A LINE DRIVER 01954000 SPACE 3 01955000 TRASETUP DC A(TRATABLE) START OF KEYWORD TABLE 01956000 DC A(TRAINC) LENGTH OF ENTRY 01957000 DC A(TRAEND-TRAINC) START OF LAST ENTRY 01958000 SPACE 01959000 TRATABLE DC 0F'0' 01960000 DC CL8'ALL',AL1(3-1),AL3(L0TKEYWD),X'00',AL3(0) 01961000 DC CL8'ERRORS',AL1(3-1),AL3(L0TKEYWD),X'80',AL3(0) 01962000 DC CL8'END',AL1(3-1),AL3(L0TKEYWD),X'C0',AL3(0) 01963000 TRAEND EQU * 01964000 SPACE 01965000 TRAINC EQU 8+4+4 01966000 EJECT 01967000 *. 01968000 *---------------------------------------------------------------------* 01969000 * BACKSPAC COMMAND * 01970000 *---------------------------------------------------------------------* 01971000 * 01972000 * BACKSPAC PROCESSION SHARES FWDSPACE PROCESSING CODED 01973000 * BELOW. 01974000 *. 01975000 SPACE 01976000 BACKSPAC DC 0H'0' 01977000 SPACE 2 01978000 *. 01979000 *---------------------------------------------------------------------* 01980000 * FWDSPACE COMMAND * 01981000 *---------------------------------------------------------------------* 01982000 * 01983000 * OPERATION - 01984000 * 01985000 * A L1 FORMAT COMMAND ELEMENT IS BUILT AND PASSED TO THE 01986000 * APPROPRIATE LINK'S LINE DRIVER THROUGH THE ALERT 01987000 * INTERFACE. 01988000 * 01989000 * RESPONSES - 01990000 * 01991000 * NONE 01992000 * 01993000 * ERROR MESSAGES - 01994000 * 01995000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 01996000 * DMTCMX206E INVALIC OPTION 'KEYWORD' 'OPTION' 01997000 * DMTCMX303E LINK 'LINKID' IS NOT ACTIVE 01998000 *. 01999000 SPACE 02000000 FWDSPACE EQU * 02001000 SPACE 2 02002000 L1FORMAT EQU * 02003000 LTR R0,R0 GET A LINK TABLE? 02004000 BNZ L1FLKGOT FROM DRIVER - ALREADY GOT 02005000 BAL R14,LTABGET GET THE SPECD LINK TABLE 02006000 B CMXNOLNK NO GOT - QUIT WITH ERROR 02007000 L1FLKGOT EQU * 02008000 TM LFLAG,LACTIVE IS IT ACTIVE? 02009000 BNO CMXM303 NOPE - NO GOOD 02010000 XC CMXELVAR(4),CMXELVAR CLEAR COUNT FIELD 02011000 CLR R3,R5 ANY PARM LEFT? 02012000 BL CKRNGE YES - CHECK COUNT @VA03487 02013100 CLI CMXELCOD,X'91' FWDSPACE? @VA03487 02013200 BE L1DEF YES - DEFAULT IS ONE @VA03487 02013300 B L1FIRE BACKSPACE - DEFAULT IS 'FILE' @VA03487 02013400 CKRNGE EQU * @VA03487 02013500 LM R8,R9,CMXNNRNG SET VALID COUNT RANGE 02014000 BAL R14,DECGET GET DECIMAL SPEC 02015000 BC 8,L1FNNGOT GOT ONE - USE IT 02016000 CLI CMXELCOD,X'91' FWDSPACE? 02017000 BE CMXM206 YEP - 'FILE' INVALID 02018000 LA R0,3 'FILE' CHAR COUNT - 1 02019000 CLR R4,R0 TOO MUCH? 02020000 BH CMXM206 YES - ERROR 02021000 EX R4,CMXCFILE DOES IT SAY FILE? 02022000 BNE CMXM206 NO - ERROR 02023000 MVI CMXELMOD,X'00' SET FILE MODIFIER 02024000 B L1TERM AND FINISH OFF 02025000 SPACE 02026000 L1FNNGOT EQU * 02027000 ST R0,CMXELVAR SET COUNT 02028000 MVI CMXELMOD,X'80' AND MODIFIER 02029000 * B L1TERM AND FINISH UP 02030000 SPACE 02031000 L1TERM EQU * 02032000 LA R3,1(R3,R4) UPDATE PARM POINTER 02033000 BAL R14,PARMGET TRY FOR ANOTHER PARM 02034000 CLR R3,R5 ANY? 02035000 BNL L1FIRE NOPE - GOOD COMMAND 02036000 SR R4,R3 EXTRA PARM COUNT 02037000 BCTR R4,0 MINUS ONE 02038000 B CMXM204 INVALID KEYWORD 02039000 SPACE 02040000 L1DEF EQU * @VA03487 02040100 MVI CMXELVAR+3,X'01' DEFAULT IS ONE @VA03487 02040200 L1FIRE EQU * 02041000 LA R0,CMXELVAR+4-CMXELMNT L1 FORMAT CMD ELM LEN 02042000 B CMXALERT AND KICK A DRIVER 02043000 EJECT 02044000 *. 02045000 *---------------------------------------------------------------------* 02046000 * FLUSH COMMAND * 02047000 *---------------------------------------------------------------------* 02048000 * 02049000 * OPERATION - 02050000 * 02051000 * A L2 FORMAT COMMAND ELEMENT IS BUILT AND PASSED TO THE 02052000 * APPROPRIATE LINK'S LINE DRIVER THROUGH THE ALERT 02053000 * INTERFACE. 02054000 * 02055000 * RESPONSES - 02056000 * 02057000 * NONE 02058000 * 02059000 * ERROR MESSAGES - 02060000 * 02061000 * DMTCMX203E INVALID SPOOL FILE ID 'SPOOLID' 02062000 * DMTCMX204E INVALID KEYWORD 'KEYWORD' 02063000 * DMTCMX205E CONFLICTING KEYWORD 'KEYWORD' 02064000 * DMTCMX303E LINK 'LINKID' IS NOT ACTIVE 02064100 *. 02065000 SPACE 02066000 FLUSH DC 0H'0' 02067000 SPACE 2 02068000 L2FORMAT EQU * 02069000 LTR R0,R0 ORIGIN REMOTE? 02070000 BNZ L2FLKGOT YES - HAVE LINK TABLE ALRDY 02071000 BAL R14,LTABGET FIND LINK TABLE 02072000 B CMXNOLNK NO GOOD - PUNT 02073000 L2FLKGOT EQU * 02074000 TM LFLAG,LACTIVE ACTIVE LINK? 02075000 BNO CMXM303 NOPE - REJECT 02076000 SPACE 02077000 LM R8,R9,CMXSPRNG VALID SPOOL ID NUMBER RANGE 02078000 BAL R14,DECGET GET THE SPOOL ID NUMBER 02079000 BC 5,CMXM203 INVALID SPOOL FILE ID 02080000 BC 8,FLUIDOK ID A VALID NUMBER 02081000 LTR R4,R4 COUNT OF 1? 02082000 BNZ CMXM203 NOPE - NOT '*' 02083000 CLI 0(R3),C'*' DEFAULT OPTION? 02084000 BNE CMXM203 NOPE - INVALID 02085000 LTR R0,R0 FROM A REMOTE STATION? 02086000 BZ CMXM203 NOPE - '*' INVALID 02087000 L R7,TTAGQ TAG QUEUE CONTROL AREA @VM01143 02088010 LA R7,4(R7) START OF ACTIVE INPUT QUEUE @VM01143 02088110 FLUASCAN EQU * @VM01143 02088210 ICM R7,B'1111',TAGNEXT-TAG(R7) POINT TO NEXT TAG @VM01143 02088310 BZ CMXM203 '*' INVALID IF NO FILE ACTIV@VM01143 02088410 CLC TAGLINK-TAG(8,R7),LINKID LINK'S ACTIVE INPUT? @VM01143 02088510 BNE FLUASCAN NO - KEEP LOOKING @VM01143 02088610 LH R0,TAGID-TAG(R7) SET ACTIVE FILE ID @VM01143 02088710 FLUIDOK EQU * 02089000 * 02090000 * LINE DRIVERS CHECK FOR MATCHING ACTIVE SPOOL FILE 02091000 * 02092000 STH R0,CMXELVAR SET THE SPOOL FILE ID 02093000 LA R0,CMXELVAR+2-CMXELMNT SET CMD ELMNT LENGTH 02094000 SPACE 02095000 LA R3,1(R4,R3) END OF CURRENT PARM 02096000 BAL R14,PARMGET TO NEXT PARM 02097000 SLR R6,R6 INITIALIZE FLAG REG 02098000 FLUMORE EQU * 02099000 LM R7,R9,FLUSETUP SET UP SCAN FOR KEYWORD 02100000 BAL R14,KEYWDGET TRY FOR ONE 02101000 BC 8,CMXALERT ALL DONE - KICK DRIVER 02102000 B CMXM204 INVALID KEYWORD 02103000 SPACE 02104000 FLUKEYWD EQU * 02105000 LTR R6,R6 ALREADY BEEN HERE? 02106000 BNZ CMXM205 YEP - CONFLICTING KEYWORD 02107000 BCTR R6,0 SET FIRST PASS FLAG 02108000 MVC CMXELMOD(1),12(R7) SET MODIFIER CODE 02109000 B FLUMORE SEE IF ANY MORE 02110000 EJECT 02111000 FLUSETUP DC A(FLUTABLE) START OF KEYWORD TABLE 02112000 DC A(FLUINC) LENGTH OF KEYWORD TABLE ENTRY 02113000 DC A(FLUEND-FLUINC) START OF LAST KEYWORD ENTRY 02114000 SPACE 02115000 FLUTABLE DC 0F'0' 02116000 DC CL8'ALL',AL1(3-1),AL3(FLUKEYWD),X'80',AL3(0) 02117000 DC CL8'HOLD',AL1(2-1),AL3(FLUKEYWD),X'40',AL3(0) 02118000 FLUEND EQU * 02119000 SPACE 02120000 FLUINC EQU 8+4+4 02121000 EJECT 02122000 *. 02123000 *---------------------------------------------------------------------* 02124000 * CMD COMMAND * 02125000 *---------------------------------------------------------------------* 02126000 * 02127000 * OPERATION - 02128000 * 02129000 * A L3 FORMAT COMMAND ELEMENT IS BUILT AND PASSED TO THE 02130000 * APPROPRIATE LINK'S LINE DRIVER THROUGH THE ALERT 02131000 * INTERFACE 02132000 * 02133000 * RESPONSES - 02134000 * 02135000 * NONE 02136000 * 02137000 * ERROR MESSAGES - 02138000 * 02139000 * DMTCMX303E LINK 'LINKID' IS NOT ACTIVE 02140000 *. 02141000 SPACE 02142000 CMD DC 0H'0' 02143000 BAL R14,LTABGET GET A LINK TABLE 02144000 B CMXNOLNK NO GOOD 02145000 TM LFLAG,LACTIVE IS IT ACTIVE? 02146000 BNO CMXM303 NOPE - NO GOOD 02147000 SPACE 02148000 SR R5,R3 LENGTH OF CMD TEXT 02149000 BCTR R5,0 DECREMENT 02150000 BZ CMDNULL NO TEXT ENTERED 02151000 LA R0,L'CMXELVAR CMD ELEMENT VAR AREA LEN 02152000 CLR R5,R0 LONG ENOUGH 02153000 BL CMDLENOK YES - DO WHOLE THING 02154000 LA R5,L'CMXELVAR-1 OTHERWISE TRUNCATE 02155000 CMDLENOK EQU * 02156000 LA R6,CMXELVAR TARGET FOR MOVE 02157000 EX R5,CMXMOVE MOVE CMD TEXT TO ELMNT 02158000 CMDNULL EQU * 02159000 LA R0,CMXELVAR-CMXELMNT+1(R5) TOTAL ELMNT LEN 02160000 B CMXALERT GIVE IT TO THE TASK 02161000 EJECT 02162000 *. 02163000 *---------------------------------------------------------------------* 02164000 * MSG COMMAND * 02165000 *---------------------------------------------------------------------* 02166000 * 02167000 * OPERATION - 02168000 * 02169000 * IF THE COMMAND ORIGINATED LOCALLY, A L3 FORMAT COMMAND 02170000 * ELEMENT IS BUILT AND PASSED TO THE APPROPRIATE LINK'S LINE 02171000 * DRIVER THROUGH THE ALERT INTERFACE. IF THE COMMAND 02172000 * ORIGINATED FROM A REMOTE LOCATION, AND IS ADDRESSED TO 02173000 * ANOTHER REMOTE LOCATION, THE SAME PROCESSING IS DONE. IF 02174000 * THE COMMAND ORIGINATED FROM A REMOTE LOCATION AND IS 02175000 * ADDRESSED TO THE LOCAL LOCATION, THE REQUESTED MESSAGE IS 02176000 * ISSUED LOCALLY. 02177000 * 02178000 * RESPONSES - 02179000 * 02180000 * DMTCMX170I FROM 'LINKID': (MSG MESSAGE TEXT) 02181000 * 02182000 * ERROR MESSAGES - 02183000 * 02184000 * DMTCMX202E INVALID LINK 'LINKID' 02185000 * DMTCMX208E INVALID USER ID 'USERID' 02186000 * DMTCMX302E LINK 'LINKID' IS NOT DEFINED 02187000 * DMTCMX303E LINK 'LINKID' IS NOT ACTIVE 02188000 *. 02189000 SPACE 02190000 MSG DC 0H'0' 02191000 BAL R14,LTABGET GET LINK ID FROM LINE 02192000 B MSGNOLNK MIGHT BE FOR LOCAL LOC 02193000 MVC CMXMSGV0(8),CMXELORG SET 'FROM' LINK ID 02194000 TM LFLAG,LACTIVE IS IT ACTIVE? 02195000 BNO CMXM303 NO GOOD IF NOT 02196000 MVI CMXMSGRC,ORIG SET MSG ROUTE FOR LINK 02197000 MVC CMXMSGLK(8),LINKID 'RESPONSE' TO ADDRESSEE 02198000 B MSGISSU1 AND DO THE MSG 02199000 SPACE 02200000 MSGNOLNK EQU * 02201000 BC 13,CMXM202 CC=0,1,3 => INVALID LINK 02202000 MVC CMXWORK(8),CMXBLANK CLEAR WORK AREA 02203000 LA R6,CMXWORK AND SET TARGET TO IT 02204000 EX R4,CMXMOVE JUSTIFY 'UNDEFINED' LINK ID 02205000 L R2,TLINKS START OF LINK TABLE 02206000 LA R2,8(R2) ADDR OF LOCAL LOC 'LINK TABLE' 02207000 CLC CMXWORK(8),LINKID FOR THE LOCAL LOC? 02208000 BNE CMXM302 TRULY UNDEFINED, INDEED 02209000 SPACE 02210000 * MSG REQUEST FOR LOCAL LOCATION 02211000 SPACE 02212000 LTR R0,R0 DID IT ORIGINATE HERE? 02213000 BZ CMXM202 FOUL 02214000 * (LOCAL LOC ID IS AN "INVALID" LINK ID) 02215000 SPACE 02216000 * WE MUST NOW HAVE A MSG FROM A REMOTE STATION 02217000 SPACE 02218000 MVC CMXMSGV0(8),CMXELORG SET 'FROM' LINK ID 02219000 LA R3,1(R4,R3) TO NEXT PARM 02220000 BAL R14,PARMGET GET NEXT PARM START 02221000 CLR R3,R5 ANY NEXT PARM? 02222000 BNL MSGNOUSR NO - INVALID USER ID ... 02223000 SR R4,R3 ID COUNT 02224000 BCTR R4,0 DECREMENT ONE 02225000 BNP CMXM208 WHA...? 02226000 CL R4,CMXLIMIT TOO LONG? 02227000 BNL CMXM208 YEP - ERROR 02228000 LA R0,3 CHAR COUNT -1 FOR 'RSCS' 02229000 CLR R4,R0 RIGHT NUMBER FOR 'RSCS'? 02230000 BNE MSGTOUSR NOPE - ASSUME LOCAL USER ID 02231000 CLC 0(4,R3),=C'RSCS' FOR RSCS OPERATOR? @VM01113 02231500 BNE MSGTOUSR NO - ASSUME TO LOCAL USER ID@VM01113 02231600 MVI CMXMSGRC,RSS ROUTE TO LOCAL RSS OPERTR 02232000 B MSGISSU0 BUILD & GIVE TO MGX 02233000 SPACE 02234000 MSGTOUSR EQU * 02235000 MVI CMXMSGRC,VMID TO LOCAL USER ID 02236000 LA R6,CMXMSGVM USER ID TARGET 02237000 EX R4,CMXMOVE MOVE USER ID TO MSG 02238000 SPACE 02239000 MSGISSU0 EQU * 02240000 LA R3,1(R4,R3) PASS CURRENT PARM 02241000 BAL R14,PARMGET AND ON TO NEXT 02242000 MSGISSU1 EQU * 02243000 SR R5,R3 TOTAL TEXT COUNT 02244000 BNP MSGNOTXT NO TEXT SUPPLIED 02245000 MSGBKSCN EQU * 02246000 BCTR R5,0 BUMP CHAR COUNT DOWN 02247000 LA R6,0(R5,R3) POINT AT CURRENT LAST CHAR 02248000 CLI 0(R6),C' ' IS IT A BLANK? 02249000 BNE MSGDOTXT NOPE - CHARGE 02250000 LTR R5,R5 ANY MORE COUNT? 02251000 BNZ MSGBKSCN YEP - DO SOME MORE 02252000 SPACE 02253000 MSGNOTXT EQU * 02254000 LA R0,28+8 NULL TEXT LENGTH 02255000 MSGM170 EQU * 02256000 LA R15,170 SET MSG MSG CODE 02257000 B CMXDOIT AND PASS TO MGX 02258000 SPACE 02259000 MSGDOTXT EQU * 02260000 LA R0,CMXMSGVL-8-1 MAX TEXT COUNT 02261000 CLR R5,R0 TOO MUCH SUPPLIED? 02262000 BNH MSGLENOK GOOD FIT AS IS 02263000 LR R5,R0 ELSE TRUNCATE 02264000 MSGLENOK EQU * 02265000 LA R6,CMXMSGV1 SET TEXT TARGET 02266000 EX R5,CMXMOVE MOVE THE TEXT TO MSG 02267000 LA R5,8(R5) EXACT COUNT +7 02268000 SRL R5,3 FORCE COUNT TO 02269000 SLL R5,3 NEXT HIGHER MULT OF EIGHT 02270000 LA R0,28+8(R5) TOT MSG ELEMENT LENGTH 02271000 B MSGM170 DO THE MESSAGE NOW 02272000 SPACE 02273000 MSGNOUSR EQU * 02274000 SLR R4,R4 NO INVALID ID CHAR COUNT 02275000 BCTR R4,0 DECREMENT ONE 02276000 B CMXM208 SAY INVALID USER ID ... 02277000 EJECT 02278000 *. 02279000 * 02280000 * ENTRY NAME - 02281000 * 02282000 * KEYWDGET 02283000 * 02284000 * FUNCTION - 02285000 * 02286000 * DECODE THE NEXT KEYWORD ON THE INPUT COMMAND LINE 02287000 * 02288000 * 02289000 * CALLS TO OTHER ROUTINES - 02290000 * 02291000 * 02292000 * 02293000 * ON ENTRY TO KEYWDGET: 02294000 * 02295000 * R7 = ADDRESS IF KEYWORD TABLE 02296000 * R8 = LENGTH OF EACH ENTRY 02297000 * R9 = ADDRESS OF START OF LAST ENTRY 02298000 * 02299000 * 02300000 * ENTRIES MUST BE OF THE FORM: 02301000 * +------------------------+---------+---------+ 02302000 * | 8 CHARACTER KEYWORD |MIN TRUNC|RET ADDR | 02303000 * | | LENGTH | ON MATCH| 02304000 * +------------------------+---------+---------+ 02305000 * 02306000 * 02307000 * FULLWORD ALIGNED 02308000 * 02309000 * R3 = ADDRESS OF START OF PARM 02310000 * R4 = ADDRESS OF END OF PARM 02311000 * R5 = ADDRESS OF END OF LINE 02312000 * R14= RETURN ADDRESS 02313000 * 02314000 * ON NORMAL EXIT: 02315000 * 02316000 * R7 = ADDRESS OF KEYWORD ENTRY 02317000 * R3 = ADDRESS OF START OF NEXT PARM, OR END OF LINE 02318000 * R4 = ADDRESS OF END OF NEXT PARM(CC=1), OR UNCHANG(CC=0) 02319000 * 02320000 * ON ERROR EXIT TO R14 ADDRESS: 02321000 * 02322000 * CC=0 => END OF LINE 02323000 * CC NOT 0 => NOT END OF LINE 02324000 * R4 = LENGTH(-1) OF INVALID OR UNDEFINED PARM 02325000 * R7 = ADDRESS OF END OF TABLE 02326000 EJECT 02327000 * OPERATION - 02328000 * 02329000 * THE TABLE DESCRIBED BY THE CONTENTS OF ENTRY REGS 6-8 02330000 * IS SCANNED FOR EACH POTENTIAL KEYWORD IN THE LINE 02331000 * DESCRIBED BY THE CONTENTS OF ENTRY REGS 3-5. WHEN THE 02332000 * FIRST MATCH IS FOUND, THE PROCESSOR EXIT SPECIFIED IN THE 02333000 * MATCHING KEYWORD TABLE ENTRY IS CALLED. 02334000 * 02335000 * RESPONSES - 02336000 * 02337000 * NONE 02338000 * 02339000 * ERROR MESSAGES - 02340000 * 02341000 * NONE 02342000 * 02343000 *. 02344000 SPACE 2 02345000 KEYWDGET DC 0H'0' 02346000 CLR R3,R5 END OF LINE? 02347000 BCR 8,R14 (BE) END OF LINE 02348000 SR R4,R3 COUNT SUPPLIED 02349000 BNP KEYWDBAD ERROR IF MINUS 02350000 CL R4,CMXLIMIT TOO LONG? 02351000 BCTR R4,0 REDUCE BY ONE FOR CHAR OP 02352000 BCR 2,R14 (BH) RETURN IF TOO LONG 02353000 KEYWDTRY EQU * 02354000 EX R4,KEYWMACH DOES THIS ONE MATCH 02355000 BNE KEYWSKIP NO 02356000 CLM R4,B'0001',8(R7) MINIMUM SUPPLIED? 02357000 BNL KEYWDHIT YES.. 02358000 KEYWSKIP EQU * 02359000 BXLE R7,R8,KEYWDTRY BUMP TO NEXT 02360000 OI *+1,X'80' SET CC=1 02361000 BR R14 UNDEFINED 02362000 SPACE 1 02363000 KEYWDHIT EQU * 02364000 LA R3,1(R4,R3) UP TO START OF NEXT PARM 02365000 BAL R14,PARMGET FRAME IT 02366000 CLR R3,R5 SET RETURN COND CODE 02367000 L R14,8(R7) ADDR OF KEYWORD PROCESSOR 02368000 BR R14 EXIT TO KEYWORD PROCESSOR 02369000 SPACE 1 02370000 KEYWDBAD EQU * 02371000 CLR R0,R0 SET CC=0 02372000 BR R14 AND RETURN 02373000 SPACE 1 02374000 KEYWMACH CLC 0(0,R7),0(R3) TO BE EXECUTED FROM ABOCE 02375000 EJECT 02376000 *. 02377000 *---------------------------------------------------------------------* 02378000 * TBLCLEAR - CLEAR THE VARIABLE AREA OF A KEYWORD TABLE * 02379000 *---------------------------------------------------------------------* 02380000 * 02381000 * ENTRY CONDITIONS - 02382000 * 02383000 * GREGS 7,8, &9 SET TO DESCRIBE A KEYWORD TABLE AS IN 02384000 * KEYWDGET 02385000 *. 02386000 SPACE 02387000 TBLCLEAR EQU * 02388000 XC 12(4,R7),12(R7) CLEAR KEYWORD TABLE 02389000 BXLE R7,R8,TBLCLEAR AND CONTINUE 02390000 BR R14 AND RETURN 02391000 EJECT 02392000 *. 02393000 * 02394000 * ENTRY NAME - 02395000 * 02396000 * LTABGET 02397000 * 02398000 * FUNCTION - 02399000 * 02400000 * FIND THE LINK TABLE ENTRY IMPLIED BY THE FIRST KEYWORD IN 02401000 * THE COMMAND LINE DESCRIBED BY THE CALLING REG PARAMTERS. 02402000 * 02403000 * CALLS TO OTHER ROUTINES - 02404000 * 02405000 * PARMGET 02406000 * 02407000 * ENTRY CONDITIONS - 02408000 * 02409000 * R3 = ADDRESS OF START OF PARM 02410000 * R4 = ADDRESS OF END OF PARM 02411000 * R5 = ADDRESS OF END OF LINE 02412000 * R14=RETURN ADDRESS: +0 ON ERROR 02413000 * +4 IF SUCCESSFUL 02414000 * 02415000 * 02416000 * EXIT CONDITIONS - 02417000 * 02418000 * 02419000 * TO 4(R14) - 02420000 * R3 = ADDR OF START OF NEXT PARM OR END OF LINE 02421000 * R4 = ADDR OF END OF NEXT PARM OR UNCHANGED 02422000 * R5 = UNCHANGED 02423000 * R2 = LINKTABL ADDRESS 02424000 * 02425000 * TO 0(R14) - 02426000 * R3 = UNCHANGED 02427000 * R4 = COUNT(-1) OF UNDEFINED LINK ID ON CC=2 02428000 * = COUNT(-1) OF INVALID LINK ID ON CC=1,3 02429000 * = -1 ON CC=0 (IMPLIES ZERO LENGTH PARM SPECIFIED 02430000 * R5 = UNCHANGED 02431000 * 02432000 * OPERATION - 02433000 * 02434000 * THE FIRST (LEFTMOST) PARAMETER ON THE INPUT COMMAND 02435000 * LINE IS FRAMED, THE LINK TABLE IS SCANNED FOR AN ENTRY 02436000 * WITH A MATCHING ID, AND THE ENTRY ADDRESS IS RETURNED TO 02437000 * TO THE CALLER. 02438000 * 02439000 * RESPONSES - 02440000 * 02441000 * NONE 02442000 * 02443000 * ERROR MESSAGES - 02444000 * 02445000 * NONE 02446000 * 02447000 *. 02448000 SPACE 2 02449000 LTABGET DC 0H'0' 02450000 CLR R3,R5 END OF LINE? 02451000 BE LTABEND YES 02452000 SR R4,R3 GET COUNT IN R4 02453000 BZ LTABEND ZERO LENGTH 02454000 BCR 5,R14 CC=1,3 => INVALID 02455000 CL R4,CMXLIMIT TOO LONG? 02456000 BCTR R4,0 DOWN BY ONE FOR CHAR OP 02457000 BH LTABLONG TOO LONG - ERROR 02458000 STM R6,R7,CMXWORK SAVE WORK REGS 02459000 L R2,TLINKS GET LINK TABLE CHAIN 02460000 L R7,0(R2) NUMBER OF ENTRIES 02461000 BCTR R7,0 DOWN ONE TO SKIP FIRST ENTRY 02462000 LTR R7,R7 ZERO? 02463000 BNP LTABMISS YES...ERROR 02464000 LA R2,8(R2) GET FIRST ENTRY ADDR 02465000 USING LINKTABL,R2 GET LINKTABL ADDRESSABILITY 02466000 MVC CMXWORK+8(8),CMXBLANK BLANK THE FRAMING FIELD 02467000 LA R6,CMXWORK+8 SET TARGET FRAMING FIELD 02468000 EX R4,CMXMOVE MOVE INTO FRAMING AREA 02469000 LTABTRY EQU * 02470000 LA R2,LINKLEN(R2) GET THE NEXT ENTRY 02471000 CLC LINKID(8),CMXWORK+8 IS THIS THE ONE? 02472000 BE LTABHIT YES 02473000 BCT R7,LTABTRY AND TRY THE NEXT 02474000 LTABMISS EQU * 02475000 LA R14,0(R14) CLEAR TOP BYTE 02476000 LTR R14,R14 SET CC=2 02477000 LM R6,R7,CMXWORK RESTORE WORK REGS 02478000 BR R14 AND RETURN TO CALLER 02479000 SPACE 1 02480000 LTABLONG EQU * 02481000 OR R4,R4 CC=1 INVALID ID 02482000 BR R14 AND RETURN 02483000 SPACE 1 02484000 LTABEND EQU * 02485000 SR R4,R4 CLEAR COUNT REG 02486000 BCTR R4,0 SET TO -1 AND CC 0 02487000 BR R14 AND RETURN 02488000 SPACE 1 02489000 LTABHIT EQU * 02490000 LA R3,1(R4,R3) SET END OF PARM 02491000 LR R6,R14 SAVE RETURN REGISTER 02492000 BAL R14,PARMGET GO FRAME NEXT PARAMETER 02493000 LR R14,R6 RESTORE RETURN REGISTER 02494000 LM R6,R7,CMXWORK RESTORE WORK REGS 02495000 B 4(R14) NORMAL RETURN 02496000 EJECT 02497000 *. 02498000 * 02499000 * ENTRY NAME - 02500000 * 02501000 * HEXGET 02502000 * 02503000 * FUNCTION - 02504000 * 02505000 * CONVERT AND VALIDATE A HEX STRING 02506000 * 02507000 * CALLS TO OTHER ROUTINES - 02508000 * 02509000 * 02510000 * 02511000 * 02512000 * ENTRY: 02513000 * 02514000 * R3,R4 = START AND END ADDR OF PARM 02515000 * R5 = END ADDR OF LINE 02516000 * R8 = (UNSIGNED) LOWER RANGE LIMIT 02517000 * R9 = (UNSIGNED) UPPER RANGE LIMIT 02518000 * 02519000 * EXIT: 02520000 * 02521000 * CC=0 => HEX NUMBER VALID (IN R0) WITHIN RANGE 02522000 * CC=1 => HEX NUMBER VALID (IN R0) OUT OF RANGE 02523000 * CC=2 => COUNT GREATER THAN 8, OR INVALID CHARS IN PARM 02524000 * CC=3 => COUNT 0 OR NEGATIVE 02525000 * 02526000 * CC=0: 02527000 * R0 = VALID HEX NUMBER 02528000 * R4 = COUNT -1 OF (VALID) PARM 02529000 * 02530000 * CC=1: 02531000 * R0 = VALID (OUT OF RANGE) HEX NUMBER 02532000 * R4 = COUNT-1 OF (OUT OF RANGE) PARM 02533000 * 02534000 * CC=2: 02535000 * R4 = COUNT -1 OF (INVALID) PARM 02536000 * 02537000 * CC=3: 02538000 * R4 = SAME AS ON ENTRY 02539000 * 02540000 * 02541000 * OPERATION - 02542000 * 02543000 * THE FIRST (LEFTMOST) PARAMETER ON THE INPUT COMMAND 02544000 * LINE IS FRAMED, THE PARAMETER IS CONVERTED FROM EBCDIC 02545000 * TO HEXADECIMAL (BINARY) AND VALIDATED, AND THE RESULTING 02546000 * VALUE IS RETURNED TO THE CALLER. 02547000 * 02548000 * RESPONSES - 02549000 * 02550000 * NONE 02551000 * 02552000 * ERROR MESSAGES - 02553000 * 02554000 * NONE 02555000 * 02556000 *. 02557000 SPACE 2 02558000 HEXGET DC 0H'0' 02559000 SR R4,R3 GET LENGTH OF PARM 02560000 BNP HEXGETC3 ERROR 02561000 CLR R3,R5 END OF LINE? 02562000 BNL HEXGETC3 WENT TOO FAR 02563000 CL R4,CMXLIMIT TOO LONG? 02564000 BCTR R4,0 REDUCE BY ONE FOR CHAR OP 02565000 BH HEXGETC2 TOO LONG 02566000 XC CMXWORK(8),CMXWORK CLEAR WORK AREA 02567000 ST R6,CMXWORK+8 SAVE REG.6 CONTENTS 02568000 LA R6,CMXWORK+7 LAST CHAR OF TARGET 02569000 SLR R6,R4 FIRST CHAR OF TARGET 02570000 EX R4,CMXMOVE MOVE EBCDIC NUMBER TO WORK 02571000 L R6,CMXWORK+8 RESTORE REG.6 02572000 TR CMXWORK(8),CMXTOHEX TRANSLATE TO HEX 02573000 MVI CMXWORK+8,X'80' MOVE IN FIRST COMPARE 02574000 MVC CMXWORK+9(7),CMXWORK+8 AND PROPAGATE 02575000 NC CMXWORK+8(8),CMXWORK TEST FOR ILLEGAL CHAR 02576000 BNZ HEXGETC2 INVALID 02577000 PACK CMXWORK+16(5),CMXWORK(9) MOVE IN 02578000 L R0,CMXWORK+16 GET GENERATED NUMBER 02579000 CLR R0,R8 TOO LOW FOR RANGE 02580000 BL HEXGETC1 YES 02581000 CLR R0,R9 TOO HIGH FOR RANGE 02582000 BH HEXGETC1 YES 02583000 HEXGETC0 EQU * 02584000 CLR R0,R0 SET CC=0 02585000 BR R14 AND RETURN 02586000 SPACE 1 02587000 HEXGETC1 EQU * 02588000 OI CMXWORK+9,X'80' SET CC=1 02589000 BR R14 AND RETURN 02590000 SPACE 1 02591000 HEXGETC2 EQU * 02592000 LA R14,0(R14) CLEAR SIGN BIT 02593000 LTR R14,R14 SET CC=2 02594000 BR R14 AND RETURN 02595000 SPACE 1 02596000 HEXGETC3 EQU * 02597000 ALR R4,R3 PUT R4 BACK WHERE IT WAS 02598000 TM *+1,X'80' SET CC=3 02599000 BR R14 AND RETURN 02600000 EJECT 02601000 DECGET EQU * 02602000 SR R4,R3 LENGTH OF PARM 02603000 BNP DECGETC3 NO GOOD 02604000 CLR R3,R5 ANY AT ALL? 02605000 BNL DECGETC3 NOPE - ERROR 02606000 CL R4,DECLIMIT TOO MUCH 02607000 BCTR R4,0 DOWN ONE IN CASE 02608000 BH DECGETC2 YEP 02609000 XC CMXWORK(16),CMXWORK CLEAR WORK AREA 02610000 ST R6,CMXWORK+16 SAVE CALLER'S REG.6 02611000 LA R6,CMXWORK+12 LAST CHAR ADDRESS 02612000 SLR R6,R4 FIRST CHAR ADDRESS 02613000 EX R4,CMXMOVE MOVE TO WORK AREA 02614000 L R6,CMXWORK+16 RESTORE CALLER'S REG.6 02615000 TR CMXWORK(13),CMXTOHEX TRANSLATE TO PACKABLE HEX 02616000 TR CMXWORK(13),CMXTODEC CLEAR INVALID DECIMAL 02617000 MVI CMXWORK+16,X'80' SET CHECKING FIELD 02618000 MVC CMXWORK+17(12),CMXWORK+16 SET WHOLE FILED 02619000 NC CMXWORK+16(13),CMXWORK CHECK FOR INVALID CHARS 02620000 BNZ DECGETC2 BAD NEWS - ERROR 02621000 OI CMXWORK+12,X'C0' SET SIGN FIELD 02622000 PACK CMXWORK+17(7),CMXWORK(13) CONVERT TO PACKED DEC 02623000 MVI CMXWORK+16,X'00' SET TOP BYTE TO ZERO 02624000 CLC CMXWORK+16(8),DECMAX TOO BIG? 02625000 BH DECGETC2 YEP - ERROR 02626000 CVB R0,CMXWORK+16 GET BINARY COUNT 02627000 CLR R0,R8 TOO LOW FOR RANGE? 02628000 BL DECGETC1 YES 02629000 CLR R0,R9 TOO HIGH FOR RANGE? 02630000 BH DECGETC1 YES @VA06444 02631000 DECGETC0 EQU * 02632000 CLR R0,R0 SET CC=0 02633000 BR R14 AND RETURN 02634000 SPACE 02635000 DECGETC1 EQU * 02636000 OI CMXWORK+15,X'80' SET CC=1 02637000 BR R14 AND RETURN 02638000 SPACE 02639000 DECGETC2 EQU * 02640000 LA R14,0(R14) CLEAR SIGN 02641000 LTR R14,R14 SET CC=2 02642000 BR R14 AND RETURN 02643000 SPACE 02644000 DECGETC3 EQU * 02645000 ALR R4,R3 RESTORE R4 02646000 TM *+1,X'80' SET CC=3 02647000 BR R14 AND RETURN 02648000 SPACE 02649000 DECLIMIT DC F'10' MAX CHARS FOR INPUT 02650000 DECMAX DC PL8'2147483647' MAX POSITIVE FULLWORD 02651000 EJECT 02652000 *. 02653000 * ENTRY NAME - 02654000 * 02655000 * DECPUT 02656000 * 02657000 * OPERATION - 02658000 * 02659000 * CONVERTS A HEX FULLWORD TO DECIMAL AND GENERATES AN EBCDIC 02660000 * REPRESENTATION OF IT, SUPPRESSING LEADING ZEROES TO A MINIMUM 02661000 * COUNT, OPTIONALLY SUPPLIED BY THE CALLER. 02662000 * 02663000 * ENTRY CONDITIONS - 02664000 * 02665000 * GREG0 = NUMBER TO BE CONVERTED TO DECIMAL EBCDIC 02666000 * GREG1 = MINIMUM EBCDIC CHARACTER COUNT 02667000 * GREG6 = OUTPUT (TARGET) FIELD 02668000 * 02669000 * EXIT CONDITIONS - 02670000 * 02671000 * R1 = NUMBER OF CHARACTERS MOVED, AFTER SUPPRESSION 02672000 * OF LEADING ZEROS 02673000 * 02674000 *. 02675000 SPACE 02676000 DECPUT EQU * 02677000 SPACE 02678000 STM R1,R4,CMXWORK SAVE CALLER'S REGISTERS TO BE USED 02679000 CVD R0,CMXWORK+16 SET PACKED DECIMAL IN STORAGE 02680000 UNPK CMXWORK+24(11),CMXWORK+18(6) CONVERT TO UNPACKED DEC 02681000 OI CMXWORK+34,X'F0' FORCE PROPER ZONE FOR EBCDIC 02682000 LA R3,CMXWORK+25 INITIALIZE SOURCE FIELD 02683000 LA R4,CMXWORK+34 INITIALIZE END OF SOURCE FIELD 02684000 LA R1,10 SET MAX DIGIT CHAR COUNT 02685000 S R1,CMXWORK SET MAX SUPPRESSION LAPS 02686000 BNP DECPHIT NO SUPPRESSION AT ALL 02687000 DECPNEXT EQU * 02688000 CLI 0(R3),C'0' IS IT ZERO? 02689000 BNE DECPHIT NOPE - USE IT 02690000 CLR R3,R4 PAST THE LIMIT? 02691000 BNL DECPHIT YES - DO IT 02692000 LA R3,1(R3) BUMP TO NEXT CHAR 02693000 BCT R1,DECPNEXT AND CHECK IT 02694000 DECPHIT EQU * 02695000 SLR R4,R3 COUNT TO MOVE -1 02696000 EX R4,CMXMOVE MOVE NUMBER TO TARGET 02697000 LA R1,1(R4) RETURN COUNT 02698000 LM R2,R4,CMXWORK+4 RESTORE CALLER'S REGS 02699000 BR R14 AND RETURN TO CALLER 02700000 EJECT 02701000 *. 02702000 * ENTRY NAME - 02703000 * 02704000 * FILGET 02705000 * 02706000 * FUNCTION - 02707000 * 02708000 * LOCATE A FILE WITH SPOOLID MATCHING THAT SUPPLIED BY 02709000 * THE CALLER, WITHIN THE INTERNAL FILE TAG QUEUES. 02710000 * 02711000 * ENTRY CONDITIONS - 02712000 * 02713000 * GREG0 = SPOOL ID TO BE LOCATED 02714000 * 02715000 * EXIT CONDITIONS - 02716000 * 02717000 * GREG3 = TAG ADDRESS IF FOUND (CC=0) 02718000 * SAME AS ENTRY IF NOT FOUND (CC=3) 02719000 *. 02720000 SPACE 02721000 FILGET EQU * 02722000 STM R2,R4,CMXWORK SAVE CALLER'S REGS 02723000 L R2,TLINKS ADDR OF START OF LINK TABLE 02724000 L R4,0(R2) COUNT OF LINK TABLE ENTRIES 02725000 BCTR R4,0 SKIP LOCAL LINK 02726000 LTR R4,R4 ANY LEFT 02727000 BNP FILGASCN NO LINKS AT ALL 02728000 LA R2,8+LINKLEN(R2) ADDR OF FIRST LINK TABLE 02729000 FILGLINK EQU * 02730000 SPACE 02731000 LA R3,LPOINTER INITIALIZE FILE TAG POINTER 02732000 FILGFILE EQU * 02733000 ICM R3,B'1111',TAGNEXT POINT TO NEXT FILE TAG 02734000 BZ FILGNEXT ALL DONE - NEXT LINK 02735000 CH R0,TAGID IS THIS THE ONE? 02736000 BNE FILGFILE NO - TRY NEXT 02737000 SPACE 02738000 * FOUND THE SOUGHT FILE 02739000 FILGHIT EQU * 02740000 CLR R0,R0 SET CC=0 02741000 L R2,CMXWORK RESTORE CALLER'S REG.2 02742000 L R4,CMXWORK+8 RESTORE CALLER'S REG.4 02743000 BR R14 AND RETURN TO THE CALLER 02744000 SPACE 02745000 FILGNEXT EQU * 02746000 LA R2,LINKLEN(R2) POINT TO NEXT LINK TABLE 02747000 BCT R4,FILGLINK BACK FOR EACH LINK TABLE 02748000 SPACE 02749000 FILGASCN EQU * 02750000 L R2,TTAGQ TAG QUEUE CONTROL AREA 02751000 LA R3,4(R2) START OF ACTIVE INPUT QUEUE 02752000 FILGANXT EQU * 02753000 ICM R3,B'1111',TAGNEXT TO NEXT TAG 02754000 BZ FILGMISS NONE FOUND 02755000 CH R0,TAGID IS THIS THE ONE WE WANT? 02756000 BNE FILGANXT NOPE - TRY ANOTHER 02757000 B FILGHIT YES - RETURN IT 02758000 SPACE 02759000 FILGMISS EQU * 02760000 * FILE NOT FOUND 02761000 TM *+1,X'80' SET CC=3 02762000 LM R2,R4,CMXWORK RESTORE CALLER'S REGS 02763000 BR R14 AND RETURN 02764000 EJECT 02765000 *. 02766000 * ENTRY NAME - 02767000 * 02768000 * TODEBCD 02769000 * 02770000 * FUNCTION - 02771000 * 02772000 * CONVERT A S/370 FORMAT TOD TO EBCDIC DATE AND TIME. 02773000 * 02774000 * EXTERNAL ROUTINE CALLED - 02775000 * 02776000 * TODEBCD IN DMTCOM TO DO DATE TIME CONVERSION 02777000 * 02778000 * ENTRY CONDITIONS - 02779000 * 02780000 * GREGS 0 & 1 = S/370 FORMAT TOD TO BE CONVERTED 02781000 * GREG2 = ADDRESS OF A FIELD INTO WHICH THE OUTPUT 02782000 * IS TO BE EDITED BY MEANS OF AN EDIT INSTR. 02783000 * (THIS FIELD MUST START WITH A BYTE SET TO 02784000 * ONE LESS THAN THE TOTAL LENGTH OF THE FIELD, 02785000 * WHICH SHOULD CONTAIN AN EDITING MASK, INTO 02786000 * WHICH THE RESULT IS TO BE PLACED. THE TIME 02787000 * ZONE SPECIFICATION IS MOVED INTO THE SIX BYTE 02788000 * FIELD IMMEDIATELY FOLLOWING THE SPECIFIED 02789000 * OUTPUT EDITING FIELD.) 02790000 * 02791000 * EXIT CONDITIONS - 02792000 * 02793000 * DATE, TIME, AND TIME ZONE HAVE BEEN GENERATED AND 02794000 * AND MOVED TO THE SPECIFIED OUTPUT AREA. 02795000 * 02796000 *. 02797000 SPACE 02798000 TODEBCD DC 0H'0' 02799000 STM R13,R14,TODSAVE1 SAVE RETURN 02800000 LA R13,MMDDYYHH GET WORK ADDR ADDR FOR CALL 02801000 L R15,TCOM GET COMMON ROUTINE ADDR 02802000 L R15,GTODEBCD AND THE TIME CONVERT ADDR 02803000 BALR R14,R15 AND DO IT 02804000 LM R13,R14,TODSAVE1 RESTORE REGS 02805000 BR R14 AND RETURN 02806000 SPACE 02807000 MMDDYYHH DC D'0' FIELD TO HOLD NEW HOUR CALCULATION IN DECIMAL 02808000 DC D'0' FIELD FOR APPENDING MMDDYYHH TO MMSSMMMM 02809000 MMSSMMMM DC D'0' FIELD TO RECEIVE DECIMAL MINUTE AND SECOND 02810000 DAYNUMBR DC A(0) FIELD TO RECEIVE COMPUTED DAY OF WEEK 0 -> 6 02811000 TODEBCON DC F'-1',A(0+4,TIMEZON+4) SEE BELOW 02812000 * DC F'-1' TO HOLD LAST CALCULATION ELAPSED HOURS 02813000 * DC A(0+4) SWITCH, USED AS AN INDEX, FOR STD VS. DLT TIME 02814000 * DC A(TIMEZON+4) EXTERNAL ADDRESS OF TIMEZONE DISP TABLE 02815000 TODSAVE DC 11F'0' TODEBCD ROUTINE SAVE AREA 02816000 SPACE 02817000 TODSAVE1 DC 2F'0' SAVE AREA 02818000 SPACE 02819000 TIMEZON DC Y(0),CL6' ' DONT CONVERT TIME ZONE @VA03113 02820400 DC Y(0),CL6' ' ITS CORRECT AS IT IS @VA03113 02820800 EJECT 02822000 *. 02823000 * ENTRY NAME - 02824000 * 02825000 * PARMGET 02826000 * 02827000 * FUNCTION - 02828000 * 02829000 * SCAN AN EBCDIC LINE, AND FRAME THE NEXT PARAMETER ON THE 02830000 * LINE. 02831000 * 02832000 * ENTRY CONDITIONS - 02833000 * 02834000 * GREG3 = ADDRESS OF START OF STRING 02835000 * GREG5 = ADDRESS OF END OF STRING 02836000 * 02837000 * EXIT CONDITIONS - 02838000 * 02839000 * GREG3 = FIRST NONDELIMETER CHARACTER SCANNED; 02840000 * IF NONE FOUND, END OF STRING 02841000 * GREG4 = UNMODIFIED IF NO NONDELIMETER CHAR SCANNED; 02842000 * OTHERWISE, ADDRESS OF FIRST DELIMETER CHAR 02843000 * AFTER FIRST NONDELIMETER CHAR SCANNED; 02844000 * IF NONE, END OF STRING. 02845000 * GREG5 = UNMODIFIED 02846000 * 02847000 * NOTES - 02848000 * 02849000 * A DELIMETER CHAR IS ANY CHARACTER OF THE FORM B'0X000000' 02850000 *. 02851000 SPACE 02852000 PARMGET DC 0H'0' 02853000 LA R5,0(R5) CLEAR HIGH ORDER BYTE JUST IN CASE 02854000 BCTR R3,0 BUMP START OF STRING POINTER BACK FOR CONVENIENCE 02855000 PARMFIND EQU * 02856000 LA R3,1(R3) LOOK AT THE NEXT CHARACTER 02857000 CLR R3,R5 HAVE WE HIT THE END OF THE STRING? 02858000 BCR 11,R14 (BNL) YEP - LOOK NO MORE 02859000 TM 0(R3),X'BF' IS THIS CHARACTER A DELIMETER? 02860000 BZ PARMFIND YEP - KEEP LOOKING FOR A NONDELIMETER 02861000 LR R4,R3 OTHERWISE SET UP FOR NEXT PHASE OF SCAN 02862000 PARMSCAN EQU * 02863000 LA R4,1(R4) LOOK AT THE NEXT CHARACTER 02864000 CLR R4,R5 ARE WE AT THE END OF THE STRING YET? 02865000 BCR 11,R14 (BNL) RETURN IMMEDIATELY IF SO 02866000 TM 0(R4),X'BF' IS THIS CHARACTER A DELIMETER? 02867000 BNZ PARMSCAN KEEP SCANNING FOR A DELIMETER IF NOT 02868000 BR R14 OTHERWISE ALL DONE - RETURN 02869000 EJECT 02870000 *---------------------------------------------------------------------* 02871000 * * 02872000 * COMMAND TABLE DATA AREA * 02873000 * * 02874000 *---------------------------------------------------------------------* 02875000 SPACE 02876000 CMXSETUP DC A(CMXTABLE) ADDR OF COMMAND TABLE 02877000 DC A(CMXINC) LENGTH OF ENTRY 02878000 DC A(CMXEND-CMXINC) START OF LAST ENTRY 02879000 SPACE 02880000 CMXMAX EQU 8 MAX LENGTH OF A COMMAND NAME 02881000 SPACE 02882000 CMXINC EQU CMXMAX+2+2+4 LENGTH OF A TABLE ENTRY 02883000 SPACE 02884000 CMXTABLE DC 0F'0' 02885000 CDEF BACKSPAC,2,90,C0 02886000 CDEF CHANGE,2,20,C0 02887000 CDEF CMD,3,B0,80 02888000 CDEF DEFINE,3,00,80 02889000 CDEF DELETE,3,00,80 02890000 CDEF DISCONN,4,00,80 02891000 CDEF DRAIN,2,81,C0 02892000 CDEF FLUSH,1,A0,C0 02893000 CDEF FREE,2,82,C0 02894000 CDEF FWDSPACE,2,91,C0 02895000 CDEF HOLD,2,83,C0 02896000 CDEF MSG,1,B1,C0 02897000 CDEF ORDER,3,10,C0 02898000 CDEF PURGE,3,11,C0 02899000 CDEF QUERY,1,00,C0 02900000 CDEF START,3,80,C0 02901000 CDEF TRACE,2,84,80 02902000 CMXEND EQU * 02903000 SPACE 02904000 EJECT 02905000 CMXELMNT DC 0F'0' 02906000 CMXELLEN DC AL1(0) LENGTH 02907000 CMXELCOD DC X'00' COMMAND CODE 02908000 CMXELRET DC X'00' RETURN RESPONSE 02909000 CMXELMOD DC X'00' MODIFIERS 02910000 CMXELORG DC CL8' ' ORIGIN LINKID 02911000 CMXELVAR DC XL130'0' 02912000 SPACE 3 02913000 CMXMSG DC 0F'0' 02914000 DC AL1(28),X'02' REQ ELMNT LEN, FUNC CODE 02915000 CMXMSGRC DC X'00' MSG ROUTING CODE 02916000 CMXMSGSC DC X'00' MSG SEVERITY CODE 02917000 CMXMSGLK DC CL8' ' OBJECT LINKID 02918000 CMXMSGVM DC CL8' ' OBJECT VMID 02919000 DC CL3'CMX' MODULE ID 02920000 CMXMSGAC DC CL1' ' MSG ACTION CODE 02921000 CMXMSGNM DC H'0',AL2(0) MSG NUMBER, SPARE 02922000 CMXMSGV0 DC CL8' ' FIRST VARIABLE FIELD 02923000 CMXMSGV1 DC CL8' ' SECOND VARIABLE FIELD 02924000 CMXMSGV2 DC CL8' ' THIRD VARIABLE FIELD 02925000 CMXMSGV3 DC CL8' ' FOURTH VARIABLE FIELD 02926000 CMXMSGV4 DC CL8' ' FIFTH VARIABLE FIELD 02927000 CMXMSGV5 DC CL8' ' SIXTH VARIABLE FIELD 02928000 CMXMSGV6 DC CL8' ' SEVENTH VARIABLE FIELD 02929000 CMXMSGV7 DC CL8' ' EIGHTH VARIABLE FIELD 02930000 CMXMSGV8 DC CL8' ' NINTH VARIABLE FIELD 02931000 DC 11CL8' ' BUFFER FOR MSG TEXT 02932000 CMXMSGVL EQU *-CMXMSGV0 TOTAL VAR AREA LEN 02933000 SPACE 3 02934000 CMXTOHEX DC X'00808080808080808080808080808080' X'00' SAME AS C'0' 02935000 DC (7*16)X'80' 02936000 DC X'800A0B0C0D0E0F808080808080808080' ABCDEF 02937000 DC (3*16)X'80' 02938000 DC X'800A0B0C0D0E0F808080808080808080' ABCDEF AGAIN 02939000 DC (2*16)X'80' 02940000 DC X'00010203040506070809808080808080' 0123456789 02941000 SPACE 02942000 CMXTODEC DC X'00010203040506070809808080808080' 02943000 SPACE 02944000 CMXTOEBC DC C'0123456789ABCDEF' TRANSLATE TABLE 02945000 SPACE 02946000 CMXALPHA DC (8*16)X'80' 02947000 DC X'80000000000000000000808080808080' ABCDEFGHI 02948000 DC X'80000000000000000000808080808080' JKLMNOPQR 02949000 DC X'80800000000000000000808080808080' STUVWXZY 02950000 DC 16X'80' 02951000 DC X'80000000000000000000808080808080' ABCDEFGHI 02952000 DC X'80000000000000000000808080808080' JKLMNOPQR 02953000 DC X'80800000000000000000808080808080' STUVWXYZ 02954000 DC X'00000000000000000000808080808080' 0123456789 02955000 SPACE 2 02956000 CMXLIMIT DC F'8' MAX PARM LENGTH 02957000 SPACE 02958000 CMXSPRNG DC F'1',F'9900' RANGE OF VALID SPOOL NUMS 02959000 CMXDVRNG DC F'0',A(X'6FF') RANGE OF VALID DEV ADDRS 02960000 CMXNNRNG DC F'1',F'2147483647' RANGE OF VALID REC COUNTS 02961000 CMXKPRNG DC F'0',F'16' RANGE VALID HOLD SLOT COUNTS 02962000 CMXPRRNG DC F'0',F'99' RANGE OF VALID PRIORITIES 02963000 CMXCORNG DC F'1',F'99' RANGE OF VALID COPIES 02964000 SPACE 02965000 CMXAXS DC 0F'0',CL4'AXS' SPOOL ACCESS MGR TASK NAME 02966000 CMXLAX DC 0F'0',CL4'LAX' LINE ACCESS MGR TASK NAME 02967000 SPACE 02968000 CMXBLANK DC CL8' ' GENERAL PURPOSE BLANK FIELD 02969000 SPACE 02970000 CMXCOUNT DC F'8192' FREE PAGE COUNT FOR MSG 001 02971000 CMXREDUC DC F'4' MIN FREE PAGE LOSS FOR MSG 001 02972000 CMXCSAVE DC 18F'0' COMMON ROUTINE SAVE AREA @VA03303 02972010 SPACE 02973000 CMXWORK DC 5D'0' NUMBER MANIPULATION WORK AREA 02974000 SPACE 02975000 LTORG 02976000 EJECT 02977000 COPY RSSEQU 02978000 EJECT 02979000 COPY DEVTYPES 02980000 EJECT 02981000 COPY SVECTORS 02982000 EJECT 02983000 COPY LINKTABL 02984000 EJECT 02985000 COPY TAG 02986000 EJECT 02987000 COPY SPOOL 02988000 EJECT 02989000 COPY IOTABLE 02990000 EJECT 02991000 END 02992000