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