AXS TITLE 'DMTAXS (RSCS) VM/370 - RELEASE 6' 00001000
*. 00002000
* MODULE NAME - 00003000
* 00004000
* DMTAXS 00005000
* 00006000
* FUNCTION - 00007000
* 00008000
* THIS RSCS TASK CONTROL THE INTERFACE OF THE LINE DRIVERS 00009000
* TO THE VM/370 SPOOL FILE SYSTEM, ENQUEUES FILES FOR 00010000
* TRANSMISSION AND PROCESSES COMMANDS ORIENTED TOWARDS 00011000
* SPOOL FILE MANIPULATION. 00012000
* 00013000
* ATTRIBUTES - 00014000
* 00015000
* REUSABLE 00016000
* 00017000
* ENTRY POINTS - 00018000
* 00019000
* DMTAXS - AT TASK INITIATION TIME 00020000
* 00021000
* ENTRY CONDITIONS - 00022000
* 00023000
* R15 = ENTRY ADDRESS 00024000
* 00025000
* EXIT CONDITIONS - 00026000
* 00027000
* NORMAL - THIS TASK IS ALWAYS ACTIVE 00028000
* ERROR - THIS TASK IS ALWAYS ACTIVE 00029000
* 00030000
EJECT 00031000
* 00032000
* CALLS TO OTHER ROUTINES - 00033000
* 00034000
* SEE ENTRY TO EACH SUBROUTINE 00035000
* 00036000
* EXTERNAL REFERENCES - 00037000
* 00038000
* SEE ENTRY TO EACH SUBROUTINE 00039000
* 00040000
* TABLES / WORKAREAS - 00041000
* 00042000
* TAGAREA - EXTERNAL REFERENCE TO TAG CHAIN 00043000
* 00044000
* 00045000
* REGISTER USAGE - 00046000
* 00047000
* ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00048000
* ANY INDIVIDUAL DEVIATIONS OR EXTENSIONS ARE LISTED WITH THE 00049000
* COMMAND DESCRIPTION 00050000
* 00051000
* GPR0 = PARAMETER REGISTER 00052000
* GPR1 = PARAMETER REGISTER 00053000
* GPR2 = TAG ADDRESSABILTIY 00054000
* GPR3 = WORK 00055000
* GPR4 = WORK 00056000
* GPR5 = WORK 00057000
* GPR6 = WORK 00058000
* GPR7 = IOTABLE ADDRESSABILITY 00059000
* GPR8 = LINK TABLE ADDRESSABILITY 00060000
* GPR9 = TAGAREA ADDRESSABILITY 00061000
* GPR10 = BASE 00062000
* GPR11 = BASE 00063000
* GPR12 = BASE 00064000
* GPR13 = TASK SAVE AREA ADDRESSING 00065000
* GPR14 = RETURN REGISTER 00066000
* GPR15 = COMMON ROUTINE VECTOR ADDRESSABILITY 00067000
* 00068000
* NOTES - 00069000
* 00070000
* NONE 00071000
* 00072000
* OPERATION - 00073000
* 00074000
* SEE EACH SUBROUTINE 00075000
* 00076000
*. 00077000
EJECT 00078000
DMTAXS CSECT 00079000
AXSSAVE DC 0D'0' BEGINNING OF MONITOR SAVE AREA 00080000
SPACE 00081000
AXSPSW DC X'FF04',AL2(0),A(AXSINIT) INITIAL PSW FOR DISPATCH 00082000
SPACE 00083000
AXSREG0 DC F'0' INITIAL REGISTER CONTENTS 00084000
AXSREG1 DC F'0' 00085000
AXSREG2 DC F'0' 00086000
AXSREG3 DC F'0' 00087000
AXSREG4 DC F'0' 00088000
AXSREG5 DC F'0' 00089000
AXSREG6 DC F'0' 00090000
AXSREG7 DC F'0' 00091000
AXSREG8 DC F'0' 00092000
AXSREG9 DC F'0' TAG CONTROL AREA BASE REG 00093000
AXSREG10 DC A(DMTAXS+X'2000') THIRD PAGE BASE REG 00094000
AXSREG11 DC A(DMTAXS+X'1000') SECOND PAGE BASE REG 00095000
AXSREG12 DC A(DMTAXS) FIRST PAGE BASE REG 00096000
AXSREG13 DC F'0' 00097000
AXSREG14 DC F'0' 00098000
AXSREG15 DC A(AXSINIT) ENTRY ADDRESS AT INITIATION 00099000
SPACE 00100000
REQLOCK DC F'0' SYNCH LOCK FOR REQUEST ARRIVAL 00101000
SPACE 3 00102000
F3 DC F'3' 00103000
F4 DC F'4' 00104000
F7 DC F'7' 00105000
F8 DC F'8' 00106000
F60 DC F'60' 00107000
F100 DC F'100' 00108000
F300 DC F'300' 00109000
F86400 DC F'86400' NUMBER OF SECONDS IN A DAY (60*60*24) 00110000
F500000 DC F'500000' NUMBER OF MICROSECONDS IN A HALF-SECOND 00111000
F1000000 DC F'1000000' NUMBER OF MICROSECONDS IN A SECOND 00112000
SPACE 00113000
PL8ZERO DC PL8'0' 00114000
EJECT 00115000
*. 00116000
* 00117000
* ENTRY NAME - 00118000
* 00119000
* AXSINIT 00120000
* 00121000
* FUNCTION - 00122000
* 00123000
* THIS PERFORMS THE INITIALIZATION THE AXS 00124000
* TASK. 00125000
* 00126000
* CALLS TO OTHER ROUTINES - 00127000
* 00128000
* DMTASY - TO SET AN ASYNCH EXIT FOR THE ALL CLASS RDR 00129000
* 00130000
* OPERATION - 00131000
* 00132000
* 1. INITIALLY SCANS THE TAG QUEUE AND COUNTS THE NUMBER 00133000
* RESERVED SLOTS AND FREE SLOTS. 00134000
* 00135000
* 2. SET THE ASYNCHRONOUS EXIT FOR THE ALL CLASS RDR 00136000
* 00137000
* 00138000
* RESPONSES - 00139000
* 00140000
* NONE 00141000
* 00142000
* ERROR MESSAGES - 00143000
* 00144000
* NONE 00145000
* 00146000
*. 00147000
SPACE 2 00148000
AXSINIT DC 0H'0' SET ALIGNMENT FOR START OF CODE 00149000
SPACE 00150000
USING SVECTORS,0 GET SVECTORS ADDRESSABILITY 00151000
USING DMTAXS,R12 DEFINE FIRST PAGE ADDRESSABILITY 00152000
USING DMTAXS+X'1000',R11 DEFINE SECOND PAGE ADDRESSABILITY 00153000
USING DMTAXS+X'2000',R10 DEFINE THIRD PAGE ADDRESSABILITY 00154000
USING TAGAREA,R9 DEFINE TAG AREA ADDRESSABILITY 00155000
USING TAG,R2 GET TAG ADDRESSABILITY 00156000
USING IOTABLE,R7 GET IOTABLE ADDRESSABILITY 00157000
USING LINKTABL,R8 GET LINKTABL ADDRESSABILITY 00158000
USING COMDSECT,R15 GET COMMON ROUTINE ADDRESSABILTIY 00159000
SPACE 00160000
L R9,TTAGQ INITIALIZE TAG CONTROL BASE 00161000
SPACE 00162000
SR R0,R0 CLEAR HOLD COUNT ACCUMULATION REG 00163000
L R15,TLINKS GET START OF LINKTABLE CHAIN 00164000
LA R8,8(R15) AND THE START OF THE LINK TABLE ENTR 00165000
L R15,0(R15) AND THE NUMBER OF ENTRIES 00166000
EJECT 00167000
AXSIHOLD EQU * 00168000
AH R0,LRESERVD ADD IN THE HOLD COUNT FOR THIS ENTRY 00169000
LA R8,LINKLEN(R8) POINT TO THE NEXT ENTRY 00170000
BCT R15,AXSIHOLD AND PROCESS IT 00171000
AXSIHSET EQU * 00172000
STH R0,TAGAHOLD SET THE TOTAL SLOTS TO BE HELD 00173000
SPACE 00174000
SR R1,R1 CLEAR THE FREE TAG COUNTER REGISTER 00175000
L R2,TAGAFREE INIT THE TAG SLOT QUEUE SCANNING REG 00176000
AXSIGOT EQU * 00177000
LTR R2,R2 END OF THE FREE TAG QUEUE? 00178000
BZ AXSIGSET YEP-STORE THE FREE TAG COUNT AND CON 00179000
LA R1,1(R1) BUMP THE COUNT UP ONE FOR THIS TAG 00180000
L R2,TAGNEXT R2=ADDR OF THE NEXT FREE TAG SLOT 00181000
B AXSIGOT AND KEEP SEARCHING FOR THE END 00182000
AXSIGSET EQU * 00183000
STH R1,TAGAGOT INITIALIZE THE FREE TAG SLOT COUNT 00184000
SPACE 00185000
SR R0,R0 CLEAR R0 TO IND TASK ASYN EXIT REQ 00186000
LA R1,AXSALERT R1=TASK ASYNCH ALERT EXIT ADDRESS 00187000
L R15,ASYNREQ R15=ENTRY ADDRESS FOR ASYN EXIT SET 00188000
BALR R14,R15 REQUEST EXIT FOR TASK ASYNCH ALERTS 00189000
SPACE 00190000
LA R1,X'001' R1=ADDR FOR READER TO RECEIVE IRRPTS 00191000
BAL R14,DETACH DETACH IF ALREADY DEFINED @VM01155 00192010
XC DEFICUU(2),DEFICUU FORCE DEVICE ADDR X'001' @VM01155 00193010
SR R1,R1 CLEAR R1 TO REQ RDR DEFINE @VM01155 00194010
BAL R14,DEFINE DEFINE DEV X'001' SPOOL RDR @VM01155 00195010
BAL R14,VSPOOLR SET CLASS AS ALL-CLASS @VM01155 00196010
LA R14,X'1F' SET INITIAL RDR DEF @VA03304 00196020
STH R14,DEFICUU AND SET SO NEXT IS X'020' @VA03304 00196030
STH R1,AXSRDR ADDR OF CONTROL READER 00197000
LR R0,R1 R0=ADDR FOR RDR TO RECEIVE IRRPTS 00198000
LA R1,AXSASYIO R1=ADDR OF ROUTINE FOR ASYNCH DEVEND 00199000
L R15,ASYNREQ R15=ENTRY ADDRESS FOR ASYNCH HANDLER 00200000
BALR R14,R15 REQ ASYNCH EXITS ON RDR X'001' 00201000
SPACE 00202000
SR R1,R1 CLEAR DEV ADDR REG 00203000
BCTR R1,0 AND SET NEGATIVE 00204000
BAL R14,VCLOSEH TO VM/370: CLOSE RDR HOLD 00205000
MVI ARRLOCK,X'80' FORCE TAG ACCEPT TO START 00206000
SPACE 00207000
B AXSCYCLE START UP 00208000
EJECT 00209000
*---------------------------------------------------------------------* 00210000
* * 00211000
* AXS MONITOR CONTROL AREA * 00212000
* * 00213000
*---------------------------------------------------------------------* 00214000
SPACE 00215000
AXSNAME DC 0F'0',CL4'AXS ' TASK NAME FOR AXS ROUTINE 00216000
REXNAME DC 0F'0',CL4'REX ' TASK NAME FOR CONTROL MONITOR 00217000
SPACE 00218000
AXSLOCKS DC A(ARRLOCK) FILE TAG ARRIVAL SYNCH LOCK ADDRESS 00219000
DC A(REQLOCK) REQUEST ARRIVAL SYNCH LOCK ADDRESS 00220000
DC X'80',AL3(CMDLOCK) COMMAND SYNCH LOCK ADDR 00221000
SPACE 00222000
ARRLOCK DC F'0' FILE TAG ARRIVAL SYNCH LOCK 00223000
CMDLOCK DC F'0' COMMAND SYNCH LOCK 00224000
SPACE 00225000
AXSTAKE DC 0F'0' TAKE REQUEST TABLE 00226000
DC CL4' ' GIVER'S TASK NAME 00227000
DC AL1(L'AXSREQ),AL3(AXSREQ) PTR TO REQUEST BUFFER (INPUT) 00228000
DC A(AXSRESP) PTR TO RESPONSE BUFFER (OUTPUT) 00229000
SPACE 00230000
AXSREQ DC XL140'00' TAKE REQUEST BUFFER 00231000
AXSRESP DC XL136'00' TAKE RESPONSE BUFFER 00232000
SPACE 00233000
CMDIN DC CL122' ' INPUT BUFFER FOR COMMAND ELEMENT 00234000
CMDINPGS DC X'00' COMMAND IN PROGRESS SWITCH 00235000
SPACE 00236000
AXSCSAVE DC 18F'0' COMMON ROUTINE SAVE AREA 00237000
EJECT 00238000
*. 00239000
* 00240000
* ENTRY NAME - 00241000
* 00242000
* AXSCYCLE 00243000
* 00244000
* FUNCTION - 00245000
* 00246000
* 00247000
* THIS ROUTINE LOOKS FOR WORK TO DO BY EXAMINING THE SYNCH 00248000
* LOCKS ASSOCIATED WITH THE AXS TASK. 00249000
* 00250000
* CALLS TO OTHER ROUTINES - 00251000
* 00252000
* DMTWAT - SUPERVISOR WAIT ROUTINE 00253000
* DMTAKE - SUPERVISOR TAKE ROUTINE 00254000
* DMTPST - SUPERVISOR POST ROUTINE 00255000
* 00256000
* OPERATION - 00257000
* 00258000
* 1. EXAMINE THE FILE ARRIVAL, REQUEST ARRIVAL, AND COMMAND 00259000
* SYNCH LOCKS. 00260000
* 00261000
* 2. IF FILE ARRIVAL BAL TO ACCEPT TO ACCEPT IT. 00262000
* 00263000
* 3. IF REQUEST ARRIVAL BAL TO REQXEQ TO EXECUTE IT. 00264000
* 00265000
* 4. IF COMMAND BAL TO CMDPROC TO EXECUTE IT. 00266000
* 00267000
* 5. WAIT ON THE SYNCH LOCK LIST FOR THE NEXT REQUEST. 00268000
* 00269000
* RESPONSES - 00270000
* 00271000
* NONE 00272000
* 00273000
* ERROR MESSAGES - 00274000
* 00275000
* NONE 00276000
* 00277000
*. 00278000
SPACE 2 00279000
AXSCYCLE DC 0H'0' 00280000
MVC AXSMSGLK(8),AXSBLANK INITIALIZE LINK ID 00281000
MVC AXSMSGVM(8),AXSBLANK INITIALIZE VM ID 00282000
SPACE 00283000
CLI ARRLOCK,X'00' IS THE FILE TAG ARRIVAL LOCK POSTED 00284000
BNE AXSGLOM YEP - GO READ IN SOME TAGS 00285000
CLI REQLOCK,X'00' DO WE HAVE A PENDING REQUEST? 00286000
BNE AXSACCPT YEP - GO SEE WHAT IT'S ALL ABOUT 00287000
CLI CMDLOCK,X'00' HAS THERE BEEN A REQ FOR COMMAND? 00288000
BNE AXSCMD YEP - GO START A COMMAND REQUEST 00289000
SPACE 00290000
LA R1,AXSLOCKS R1=ADDR OF LIST OF SYNCH LOCK ADDR 00291000
L R15,WAITREQ R15=ADDR OF WAIT ROUTINE ENTRY POINT 00292000
BALR R14,R15 WAIT FOR SOMETHING TO HAPPEN 00293000
B AXSCYCLE INSPECT SYNCH LOCKS 00294000
SPACE 00295000
AXSGLOM EQU * 00296000
XC ARRLOCK(4),ARRLOCK CLEAR THE TAG ARRIVAL SYNCH LOCK 00297000
BAL R14,ACCEPT READ IN ANY NEW TAGS 00298000
B AXSCYCLE AND CHECK FOR SOMETHING ELSE TO DO 00299000
SPACE 00300000
AXSCMD EQU * 00301000
XC CMDLOCK(4),CMDLOCK CLEAR THE COMMAND ARRIVAL SYNCH LOCK 00302000
BAL R14,CMDPROC GO PROCESS THE COMMAND 00303000
B AXSCYCLE AND CHECK FOR SOMETHING ELSE TO DO 00304000
SPACE 3 00305000
AXSACCPT EQU * 00306000
LA R1,AXSTAKE R1=TAKE TABLE ADDRESS 00307000
L R15,TAKEREQ R15=ENTRY FOR REQUEST TAKE SERVICE 00308000
BALR R14,R15 RESP TO LAST REQUEST, TAKE ANOTHER 00309000
SRA R15,3 CHK RET CODE FOR PRES OF A NEW REQ 00310000
BNZ AXSCYCLE NO MORE LEFT-LOOK FOR SOMETHING ELSE 00311000
BAL R14,REQXEQ GO DIRECTLY TO EXEC THE GOTTEN REQ 00312000
* R0 POST CODE AND RESPONSE BUFFER HAVE BEEN SET BY EXECUTOR 00313000
B AXSACCPT RESP AND TRY TO TAKE ANOTHER REQ 00314000
SPACE 3 00315000
AXSALERT EQU * ASYNCHRONOUS TASK ALERT ROUTINE 00316000
L R12,TASKSAVE-TASKE(R13) RESET AXS BASE REGISTER 00317000
LM R10,R11,AXSREG10 RESTORE OTHER BASE REGISTERS 00318000
CL R0,REXNAME IS CALLING TASK THE CONTROL MONITOR? 00319000
BCR 7,R14 (BNE) FORGET IT IF IT ISN'T 00320000
CLI CMDINPGS,X'FF' IS THERE A CMD IN PROGRESS? 00321000
BNE AXSALRT1 NO CONTINUE 00322000
MVI 2(R1),X'80' SHOW REFUSAL 00323000
BR R14 AND RETURN 00324000
SPACE 1 00325000
AXSALRT1 EQU * 00326000
MVI 2(R1),X'00' INDICATE COMMAND ACCEPTANCE 00327000
OI CMDINPGS,X'FF' SHOW PROCESSING @VA08094 00327100
SR R2,R2 CLEAR FOR IC 00328000
IC R2,0(R1) GET COUNT OF ELEMENT 00329000
EX R2,CMDMVC AND MOVE TO OUR BUFFER 00330000
SR R0,R0 CLEAR CODE REGISTER FOR POST 00331000
LA R1,CMDLOCK R1=ADDRESS OF COMMAND SYNCH LOCK 00332000
L R15,POSTREQ R15=ENTRY ADDRESS FOR POST ROUTINE 00333000
BR R15 POST THE ATTN SYN LOCK AND RET DIR 00334000
EJECT 00335000
AXSASYIO EQU * ASYNCH READER I/O INTERRUPT ROUTINE 00336000
CLI CSW+4,DE IS IT A STAND-ALONE DEVICE END? 00337000
BCR 7,R14 (BNE) FORGET IT IF IT IS NOT 00338000
L R12,TASKSAVE-TASKE(R13) RESET AXS BASE REGISTER 00339000
LM R10,R11,AXSREG10 RESTORE OTHER BASE REGISTERS 00340000
SR R0,R0 CLEAR CODE REGISTER FOR POST 00341000
LA R1,ARRLOCK R1=ADDRESS OF ARRIVAL SYNCH LOCK 00342000
L R15,POSTREQ R15=ENTRY ADDR FOR SUP POST ROUTINE 00343000
BR R15 POST THE ARRIVAL SYNCH LOCK, RETURN DIRECTLY TO SUP 00344000
SPACE 00345000
CMDMVC MVC CMDIN(0),0(R1) TO BE EXECUTED FROM ABOVE 00346000
SPACE 00347000
AXSMOVE MVC 0(0,R15),0(R3) MOVE FROM LINE 00348000
EJECT 00349000
*---------------------------------------------------------------------* 00350000
* * 00351000
* REQUEST EXECUTION CONTROL AREA * 00352000
* * 00353000
*---------------------------------------------------------------------* 00354000
SPACE 00355000
IOPCODE EQU X'01' OPEN INPUT FILE REQUEST CODE 00356000
ICLCODE EQU X'02' CLOSE INPUT FILE REQUEST CODE 00357000
OOPCODE EQU X'11' OPEN OUTPUT FILE REQUEST CODE 00358000
OCLCODE EQU X'12' CLOSE OUTPUT FILE REQUEST CODE 00359000
SPACE 2 00360000
REQSETUP DC A(REQTABLE) 00361000
DC A(REQINC) 00362000
DC A(REQEND-REQINC) 00363000
SPACE 00364000
REQINC EQU 4 LENGTH OF A TABLE ENTRY 00365000
SPACE 00366000
REQTABLE DC 0F'0' 00367000
DC AL1(IOPCODE),AL3(OPENIN) => OPEN INPUT FILE 00368000
DC AL1(ICLCODE),AL3(CLOSEIN) => CLOSE INPUT FILE 00369000
DC AL1(OOPCODE),AL3(OPENOUT) => OPEN OUTPUT FILE 00370000
DC AL1(OCLCODE),AL3(CLOSEOUT) => CLOSE OUTPUT FILE 00371000
REQEND EQU * 00372000
SPACE 00373000
REQSHRUG EQU X'10' ERROR POST CODE FOR REQ CODE NOT IDENTIFIABLE 00374000
EJECT 00375000
*. 00376000
* 00377000
* ENTRY NAME - 00378000
* 00379000
* REQXEQ 00380000
* 00381000
* FUNCTION - 00382000
* 00383000
* THIS ROUTINE SCANS THE REQUEST TABLE FOR A MATCH AND 00384000
* BRANCHES TO THE APPROPRIATE SUBROUTINE DEPENDING ON THE 00385000
* REQUEST CODE. 00386000
* 00387000
* CALLS TO OTHER ROUTINES - 00388000
* 00389000
* NONE 00390000
* 00391000
* OPERATION - 00392000
* 00393000
* 1. SCAN THE REQUEST TABLE FOR A MATCH. 00394000
* 00395000
* 2. IF FOUND BRANCH TO THE APPROPRIATE SUB- 00396000
* ROUTINE. 00397000
* 00398000
* 3. IF NOT RETURN WITH AN ERROR. 00399000
* 00400000
* RESPONSES - 00401000
* 00402000
* NONE 00403000
* 00404000
* ERROR MESSAGES - 00405000
* 00406000
* NONE 00407000
* 00408000
*. 00409000
SPACE 2 00410000
REQXEQ DC 0H'0' 00411000
LM R3,R5,REQSETUP SET REGS FOR REQUEST TABLE SCAN 00412000
REQSCAN EQU * 00413000
CLC 0(1,R3),AXSREQ+1 DOES THIS ENTRY MATCH THE REQ CODE? 00414000
BE REQCALL YEP-GO EXIT TO THE IND EXECUTOR ROU 00415000
BXLE R3,R4,REQSCAN SCAN TO THE END OF THE TABLE 00416000
SPACE 00417000
LA R0,REQSHRUG R0=ERROR CODE FOR NO CODE MATCH 00418000
BR R14 RETURN TO CALLER 00419000
SPACE 00420000
REQCALL EQU * 00421000
MVI AXSRESP,X'00' INIT THE RESPONSE COUNT TO ZERO 00422000
L R15,0(R3) R15=ENT ADDR FOR INDICATED EXEC 00423000
BR R15 GO TO EXEC WITH R14 AS SET BY CALLER 00424000
EJECT 00425000
*---------------------------------------------------------------------* 00426000
* * 00427000
* COMMAND CONTROL AREA * 00428000
* * 00429000
*---------------------------------------------------------------------* 00430000
SPACE 00431000
ORDERCMD EQU X'10' ORDER COMMAND 00432000
PURGECMD EQU X'11' PURGE COMMAND 00433000
CHANGCMD EQU X'20' CHANGE COMMAND 00434000
SPACE 00435000
CMDSETUP DC A(CMDTABLE) 00436000
DC A(CMDINC) 00437000
DC A(CMDEND-CMDINC) 00438000
SPACE 00439000
CMDINC EQU 4 LENGTH OF TABLE ENTRY 00440000
SPACE 00441000
CMDTABLE DC 0F'0' 00442000
DC AL1(ORDERCMD),AL3(ORDER) ORDER COMMAND 00443000
DC AL1(PURGECMD),AL3(PURGE) PURGE COMMAND 00444000
DC AL1(CHANGCMD),AL3(CHANGE) CHANGE COMMAND 00445000
CMDEND EQU * 00446000
SPACE 00447000
CMDSAVE DC F'0' 00448000
CMDCSAVE DC 11F'0' 00449000
EJECT 00450000
*. 00451000
* 00452000
* ENTRY NAME - 00453000
* 00454000
* CMDPROC 00455000
* 00456000
* FUNCTION - 00457000
* 00458000
* EXECUTE AXS COMMANDS FROM THE COMMAND BUFFER PASSED ON 00459000
* AN ALERT EXIT FROM DMTREX. 00460000
* 00461000
* CALLS TO OTHER ROUTINES - 00462000
* 00463000
* NONE 00464000
* 00465000
* OPERATION - 00466000
* 00467000
* 1. SCAN THE COMMAND TABLE FOR A MATCH. 00468000
* 00469000
* 2. IF FOUND BRANCH TO THE APPROPRIATE SUBROUTINE. 00470000
* 00471000
* 3. RESET THE COMMAND IN PROGRESS SWITCH 00472000
* 00473000
* 4. EXIT 00474000
* 00475000
* RESPONSES - 00476000
* 00477000
* SEE EACH COMMAND SUBROUTINE 00478000
* 00479000
* ERROR MESSAGES - 00480000
* 00481000
* SEE EACH COMMAND SUBROUTINE 00482000
* 00483000
*. 00484000
SPACE 2 00485000
CMDPROC DC 0H'0' 00486000
ST R14,CMDSAVE SAVE RETURN REG 00487000
LM R3,R5,CMDSETUP SET UP FOR TABLE SCAN 00488000
CMDSCAN EQU * 00489000
CLC 0(1,R3),CMDIN+1 IS THIS THE RIGHT COMMAND? 00490000
BE CMDCALL YES 00491000
BXLE R3,R4,CMDSCAN BUMP TO NEXT ENTRY 00492000
BR R14 COMMAND NOT FOUND, RETURN 00493000
SPACE 1 00494000
CMDCALL EQU * 00495000
MVC AXSMSGLK(8),CMDIN+4 SET OBJECT LINK ID 00496000
TM CMDIN+3,X'80' RESPONSE TO OBJECT OR LOCAL? 00497000
BNO CMDOIT RESPONSE TO OBJECT 00498000
L R8,TLINKS LINK TABLE START 00499000
LA R8,8(R8) LOCAL LINK TABLE ENTRY 00500000
MVC AXSMSGLK(8),LINKID RESPONSE TO LOCAL 00501000
EJECT 00502000
CMDOIT EQU * 00503000
L R15,0(R3) GET THE ROUTINE ADDR 00504000
BALR R14,R15 GO EXECUTE THE COMMAND 00505000
MVI CMDINPGS,X'00' INDICATE COMMAND DONE 00506000
L R14,CMDSAVE RESTORE RETURN 00507000
BR R14 AND RETURN 00508000
EJECT 00509000
*. 00510000
*---------------------------------------------------------------------* 00511000
* ORDER COMMAND * 00512000
*---------------------------------------------------------------------* 00513000
* 00514000
* RESPONSES - 00515000
* 00516000
* DMTAXS523I LINK 'LINKID' QUEUE REORDERED 00517000
* 00518000
* ERROR MESSAGES - 00519000
* 00520000
* DMTAXS524E FILE 'SPOOLID' ACTIVE -- NO ACTION TAKEN 00521000
* DMTAXS525E FILE 'SPOOLID' IS FOR LINK 'LINKID' -- 00522000
* NO ACTION TAKEN 00523000
* DMTAXS526E FILE 'SPOOLID' NOT FOUND -- NO ACTION TAKEN 00524000
* 00525000
*. 00526000
SPACE 1 00527000
ORDER DC 0H'0' 00528000
STM R14,R8,CMDCSAVE SAVE ENTRY REGS 00529000
SPACE 00530000
LH R5,CMDIN+12 TOTAL SPOOL ID'S HERE 00531000
LA R4,CMDIN+14 ADDR OF FIRST ID 00532000
ORDECHEK EQU * 00533000
LH R1,0(R4) NEXT SPOOL ID TO CHECK 00534000
BAL R14,TAGFIND SEE IF IT'S AROUND 00535000
BC 7,CMDM526 NOT ENQUEUED 00536000
CLC TAGLINK(8),CMDIN+4 BELONG TO OBJECT LINK ID? 00537000
BNE CMDM525 NO FAIR IF NOT 00538000
OC TAGBLOCK(4),TAGBLOCK INACTIVE? 00539000
BNZ CMDM524 ACTIVE - NO ORDER 00540000
LA R4,2(R4) BUMP SPOOL ID POINTER 00541000
BCT R5,ORDECHEK DO NEXT IF ANY 00542000
SPACE 00543000
LA R3,CMDIN+4 ADDR OF OBJECT LINK ID 00544000
LA R4,8 FULL COUNT 00545000
BAL R14,GETLINK FIND HIS LINK TABLE 00546000
BC 7,ORDEEXIT NO LINK - FORGET IT 00547000
EJECT 00548000
* 00549000
* ALL FILES O.K. - DO ORDER 00550000
* 00551000
LH R5,CMDIN+12 TOTAL ID COUNT 00552000
LA R4,CMDIN+12(R5) GET READY TO ... 00553000
ALR R4,R5 POINT TO LAST SPOOLID 00554000
ORDERDO EQU * 00555000
LA R2,LPOINTER-(TAGNEXT-TAG) INITIALIZE SCAN 00556000
ORDESCAN EQU * 00557000
LR R3,R2 MAKE CURRENT LAST 00558000
ICM R2,B'1111',TAGNEXT AND GET NEW CURRENT 00559000
BZ ORDEEXIT NOT FOUND - DISAPPEARED 00560000
CLC 0(2,R4),TAGID IS THIS THE ONE? 00561000
BNE ORDESCAN NO - TRY NEXT 00562000
SPACE 00563000
MVC TAGNEXT-TAG(4,R3),TAGNEXT DEQUEUE TAG 00564000
XC TAGPRIOR(2),TAGPRIOR ZERO ORDERED TAG PRIORITY 00565000
BAL R14,VTAGF SET NEW PRIORITY IN VM TAG 00566000
SPACE 00567000
MVC TAGNEXT(4),LPOINTER ENQUEUE LINK QUEUE ON IT 00568000
ST R2,LPOINTER AND PLACE AT HEAD OF QUEUE 00569000
ORDENEXT EQU * 00570000
BCTR R4,0 BUMP SPOOL ID POINTER 00571000
BCTR R4,0 BACK TO NEXT LEFTWARD 00572000
BCT R5,ORDERDO AND DO NEXT IF ANY 00573000
SPACE 00574000
CMDM253 EQU * 00575000
MVC AXSMSGV0(8),LINKID SET LINK ID IN MSG 00576000
LA R15,523 SET MSG CODE 00577000
LA R0,28+8 SET MSG ELEMENT COUNT 00578000
BAL R14,MSG AND ISSUE ORDER MSG 00579000
SPACE 00580000
ORDEEXIT EQU * 00581000
LM R14,R8,CMDCSAVE RESTORE ENTRY REGS 00582000
BR R14 AND RETURN 00583000
EJECT 00584000
*. 00585000
*---------------------------------------------------------------------* 00586000
* PURGE COMMAND * 00587000
*---------------------------------------------------------------------* 00588000
* 00589000
* RESPONSES - 00590000
* 00591000
* DMTAXS640I NN FILE(S) PURGED ON LINK 'LINKID' 00592000
* 00593000
* ERROR MESSAGES - 00594000
* 00595000
* DMTAXS524E FILE 'SPOOLID' ACTIVE -- NO ACTION TAKEN 00596000
* DMTAXS525E FILE 'SPOOLID' IS FOR LINK 'LINKID' -- 00597000
* NO ACTION TAKEN 00598000
* DMTAXS526E FILE 'SPOOLID' NOT FOUND -- NO ACTION TAKEN 00599000
* 00600000
*. 00601000
SPACE 1 00602000
PURGE DC 0H'0' 00603000
STM R14,R8,CMDCSAVE SAVE ENTRY REGS 00604000
SPACE 00605000
LA R3,CMDIN+4 ADDR OF LINK ID 00606000
LA R4,8 COUNT OF LINK ID 00607000
BAL R14,GETLINK GET THE OBJECT LINK TABLE 00608000
BC 7,PURGEXIT NOT FOUND - QUIT 00609000
SPACE 00610000
TM CMDIN+3,X'40' PURGE 'ALL' REQUESTED? 00611000
BO PURGEALL YES - DO 'EM 00612000
SPACE 00613000
LH R5,CMDIN+12 COUNT OF ID'S 00614000
LA R4,CMDIN+14 ADDR OF FIRST ID 00615000
PURGCHEK EQU * 00616000
LH R1,0(R4) NEXT SPOOL ID 00617000
BAL R14,TAGFIND DO WE HAVE IT? 00618000
BC 7,CMDM526 NO - ERROR 00619000
CLC TAGLINK(8),CMDIN+4 PROPER TAG LINK? 00620000
BNE CMDM525 NOPE - NO GOOD 00621000
OC TAGBLOCK(4),TAGBLOCK IS THE FILE ACTIVE? 00622000
BNZ CMDM524 YES - NO PURGE 00623000
LA R4,2(R4) BUMP SPOOL ID POINTER 00624000
BCT R5,PURGCHEK CHECK NEXT IF ANY 00625000
SPACE 00626000
LH R5,CMDIN+12 TOTAL TO BE PURGED 00627000
LR R6,R5 SAVE FOR MESSAGE 00628000
LA R4,CMDIN+14 ADDR OF FIRST ID 00629000
EJECT 00630000
PURGEDO EQU * 00631000
LA R2,LPOINTER-(TAGNEXT-TAG) INITIALIZE SCAN 00632000
PURGSCAN EQU * 00633000
LR R3,R2 MAKE CURRENT LAST 00634000
ICM R2,B'1111',TAGNEXT GET NEW CURRENT 00635000
BZ PURGEXIT FILE DISAPPEARED - QUIT 00636000
CLC 0(2,R4),TAGID IS THIS THE ONE? 00637000
BNE PURGSCAN NO - KEEP LOOKING 00638000
SPACE 00639000
MVC TAGNEXT-TAG(4,R3),TAGNEXT DEQUEUE TAG 00640000
LH R1,TAGID REG.1 = PURGE SPOOL ID 00641000
BAL R14,VPURGE PURGE FILE FROM VM/370 00642000
BAL R14,FREESLOT AND FROM RSCS 00643000
PURGNEXT EQU * 00644000
LA R4,2(R4) BUMP POINTER TO NEXT ID 00645000
BCT R5,PURGEDO DO NEXT IF ANY 00646000
SPACE 00647000
PURGDONE EQU * 00648000
LR R1,R6 PURGE FILE COUNT 00649000
BAL R14,CMDM640 ISSUE PURGE MSG 00650000
PURGEXIT EQU * 00651000
LM R14,R8,CMDCSAVE RESTORE ENTRY REGS 00652000
BR R14 AND RETURN 00653000
SPACE 2 00654000
PURGEALL EQU * 00655000
SR R6,R6 INITIALIZE PURGE COUNT 00656000
LA R2,LPOINTER POINT TO TOP OF QUEUE @VA05959 00657100
PURALNX1 DS 0H @VA05959 00657200
LR R3,R2 MAKE CURRENT TAG LAST ONE @VA05959 00657300
PURALNX2 DS 0H HERE TO CONTINUE PURGE @VA05959 00657400
ICM R2,15,TAGNEXT-TAG(R3) GET ADDR OF NEXT TAG @VA05959 00657500
BZ PURGDONE IF ZERO ALL DONE @VA05959 00657600
OC TAGBLOCK(4),TAGBLOCK IS TAG FOR ACTIVE FILE @VA05959 00657700
BNZ PURALNX1 YES.. DO NOT PURGE IT @VA05959 00657800
MVC TAGNEXT-TAG(4,R3),TAGNEXT DEQUEUE THIS ONE @VA05959 00657900
LH R1,TAGID PURGE SPOOL FILE ID 00661000
BAL R14,VPURGE PURGE IT FROM VM/370 00662000
BAL R14,FREESLOT AND FROM RSCS 00663000
LA R6,1(R6) INCREMENT PURGE COUNT 00664000
B PURALNX2 GO PURGE SOME MORE @VA05959 00665500
EJECT 00666000
*. 00667000
*---------------------------------------------------------------------* 00668000
* CHANGE COMMAND * 00669000
*---------------------------------------------------------------------* 00670000
* 00671000
* RESPONSES - 00672000
* 00673000
* DMTAXS520I FILE 'SPOOLID' CHANGED 00674000
* DMTAXS521I FILE 'SPOOLID' HELD FOR LINK 'LINKID' 00675000
* DMTAXS522I FILE 'SPOOLID' RELEASED FOR LINK 'LINKID' 00676000
* DMTAXS523I LINK 'LINKID' QUEUE REORDERED 00677000
* 00678000
* ERROR MESSAGES - 00679000
* 00680000
* DMTAXS524E FILE 'SPOOLID' ACTIVE -- NO ACTION TAKEN 00681000
* DMTAXS525E FILE 'SPOOLID' IS FOR LINK 'LINKID' -- 00682000
* NO ACTION TAKEN 00683000
* DMTAXS526E FILE 'SPOOLID' NOT FOUND -- NO ACTION TAKEN 00684000
* 00685000
*. 00686000
SPACE 1 00687000
CHANGE DC 0H'0' 00688000
STM R14,R8,CMDCSAVE SAVE ENTRY REGS 00689000
SPACE 00690000
LH R1,CMDIN+12 SPOOL ID COUNT 00691000
BAL R14,TAGFIND SEE IF IT IS ENQUEUED 00692000
BC 7,CMDM526 IT IS NOT - QUIT 00693000
CLC TAGLINK(8),CMDIN+4 IS IT ON OBJECT LINK? 00694000
BNE CMDM525 NO - QUIT 00695000
OC TAGBLOCK(4),TAGBLOCK IS IT INACTIVE? 00696000
BNZ CMDM524 NO - NO GOOD 00697000
SPACE 00698000
LA R3,CMDIN+4 LINK ID ADDRESS 00699000
LA R4,8 LINK ID LENGTH 00700000
BAL R14,GETLINK FIND THE LINK TABLE 00701000
BC 7,CHANEXIT LINK DISAPPEARED...? 00702000
SPACE 00703000
MVC VCHCNTRL(36),CMDIN+16 SET CHANGE CONTROL FIELDS 00704000
BAL R14,VCHANGE CHANGE THE FILE AS REQ 00705000
BAL R14,CMDM520 SAY IT HAS BEEN CHANGED 00706000
SPACE 00707000
SR R0,R0 INITIALIZE TASK NAME 00708000
CHANPR EQU * 00709000
CLI CMDIN+14,X'FF' CHANGE PRIORITY? 00710000
BE CHANHO NO - TRY HOLD 00711000
MVC TAGPRIOR(2),CMDIN+14 SET NEW PRIORITY 00712000
BAL R14,VTAGF SET PRIORITY IN VM TAG 00713000
LA R2,LPOINTER-(TAGNEXT-TAG) INITIALIZE SCAN 00714000
CHANSCAN EQU * 00715000
LR R3,R2 MAKE CURRENT LAST 00716000
ICM R2,B'1111',TAGNEXT GET NEXT TAG 00717000
BZ CHANHO FILE GONE - QUIT 00718000
CH R1,TAGID IS THIS THE ONE? 00719000
BNE CHANSCAN NOPE - KEEP LOOKING 00720000
MVC TAGNEXT-TAG(4,R3),TAGNEXT DEQUEUE IT 00721000
BAL R14,TAGPLACE PUT IT BACK 00722000
BAL R14,CMDM523 ISSUE REORDERED MSG 00723000
SPACE 00724000
CHANHO EQU * 00725000
CLI CMDIN+16,X'FF' CHANGE HOLD? 00726000
BE CHANCL NO - TRY CLASS 00727000
TM CMDIN+16,X'C0' CHANGE NOH? 00728000
BZ CHANNOH YES - DO IT 00729000
OI TAGFLAG,SFBUHOLD TURN ON USER HOLD 00730000
BAL R14,CMDM521 ISSUE HELD MSG 00731000
B CHANCL CHECK CLASS 00732000
SPACE 00733000
CHANNOH EQU * 00734000
NI TAGFLAG,X'FF'-SFBUHOLD-SFBSHOLD HOLD OFF 00735000
BAL R14,CMDM522 ISSUE RELEASED MSG 00736000
L R0,LACTTNME SET ALERT TASK NAME 00737000
SPACE 00738000
CHANCL EQU * 00739000
CLI CMDIN+17,X'FF' CHANGE CLASS? 00740000
BE CHANCO NO - TRY COPY 00741000
MVC TAGCLASS(1),CMDIN+17 MOVE IN NEW CLASS 00742000
L R0,LACTTNME SET ALERT TASK NAME 00743000
SPACE 00744000
CHANCO EQU * 00745000
CLI CMDIN+18,X'FF' CHANGE COPY? 00746000
BE CHANDI NOPE - TRY DIST 00747000
MVC TAGCOPY(2),CMDIN+18 SET NEW COPY COUNT 00748000
SPACE 00749000
CHANDI EQU * 00750000
CLI CMDIN+20,X'FF' CHANGE DIST? 00751000
BE CHANNA NO - TRY NAME 00752000
MVC TAGDIST(8),CMDIN+20 SET NEW DIST CODE 00753000
SPACE 00754000
CHANNA EQU * 00755000
CLI CMDIN+28,X'FF' CHANGE NAME? 00756000
BE CHANDONE NO - ALL DONE 00757000
MVC TAGNAME(24),CMDIN+28 SET NEW NAME 00758000
SPACE 00759000
CHANDONE EQU * 00760000
LTR R0,R0 ANY ALERTS TO BE DONE? 00761000
BZ CHANEXIT NO - LEAVE NOW 00762000
TM LFLAG,LALERT IS ALERT ARMED? 00763000
BNO CHANEXIT NO - FORGET IT 00764000
L R15,ALERTREQ ALERT ENTRY ADDR 00765000
BALR R14,R15 ALERT WAITING LINE DRIVER 00766000
SPACE 00767000
CHANEXIT EQU * 00768000
LM R14,R8,CMDCSAVE RESTORE ENTRY REGS 00769000
BR R14 AND RETURN 00770000
EJECT 00771000
*---------------------------------------------------------------------* 00772000
* COMMON COMMAND RESPONSE ROUTINES * 00773000
*---------------------------------------------------------------------* 00774000
SPACE 1 00775000
CMDM520 DC 0H'0' 00776000
STM R14,R1,MSGSAVE SAVE REGS 00777000
LA R15,520 SET MSG CODE 00778000
B MSGSPID FORMAT VARIABLE AREA 00779000
SPACE 00780000
CMDM521 EQU * 00781000
STM R14,R1,MSGSAVE SAVE REGS 00782000
LA R15,521 SET MSG CODE 00783000
B MSGLKID1 FORMAT VARIABLE AREA 00784000
SPACE 00785000
CMDM522 EQU * 00786000
STM R14,R1,MSGSAVE SAVE REGS 00787000
LA R15,522 SET MSG CODE 00788000
B MSGLKID1 FORMAT VARIABLE AREA 00789000
SPACE 00790000
CMDM523 EQU * 00791000
STM R14,R1,MSGSAVE SAVE REGS 00792000
MVC AXSMSGV0(8),LINKID SET LINK ID IN MSG 00793000
LA R15,523 SET MSG CODE 00794000
LA R0,28+8 SET MSG ELEMENT LEN 00795000
B MSGDO CALL DMTMGX 00796000
SPACE 00797000
CMDM524 EQU * 00798000
LA R14,CMDEXIT SET TO EXIT WHEN DONE 00799000
STM R14,R1,MSGSAVE SAVE REGISTERS 00800000
LA R15,524 SET MSG CODE 00801000
B MSGSPID FORMAT VARIABLE AREA 00802000
SPACE 00803000
CMDM525 EQU * 00804000
LA R14,CMDEXIT SET TO EXIT WHEN DONE 00805000
STM R14,R1,MSGSAVE SAVE REGISTERS 00806000
MVC AXSMSGV1(8),TAGLINK SET TAG LINK ID 00807000
LA R15,525 SET MSG CODE 00808000
LA R0,28+2*8 SET MSG REQ ELEMENT LEN 00809000
B MSGSPID0 FORMAT VARIABLE AREA 00810000
SPACE 00811000
CMDM526 EQU * 00812000
LA R14,CMDEXIT SET TO EXIT WHEN DONE 00813000
STM R14,R1,MSGSAVE SAVE REGISTERS 00814000
LA R15,526 SET MSG CODE 00815000
B MSGSPID FORMAT VARIABLE AREA 00816000
SPACE 00817000
CMDM640 EQU * 00818000
STM R14,R1,MSGSAVE SAVE REGS 00819000
LA R15,640 SET MSG CODE 00820000
B MSGNN FORMAT VARIABLE AREA 00821000
SPACE 2 00822000
CMDEXIT EQU * 00823000
LM R14,R8,CMDCSAVE RESTORE ENTRY REGS 00824000
BR R14 AND RETURN 00825000
EJECT 00826000
*. 00827000
* 00828000
* ENTRY NAME - 00829000
* 00830000
* OPENIN 00831000
* 00832000
* FUNCTION - 00833000
* 00834000
* INITIALIZE SPOOL FILE PROCESSING 00835000
* 00836000
* CALLS TO OTHER ROUTINES - 00837000
* 00838000
* DMKDRD - THROUGH DIAG 14 00839000
* 00840000
* OPERATION - 00841000
* 00842000
* 1. CHECK FOR ACTIVE FILE ON LINK 00843000
* 00844000
* 2. BRING PENDING FILES INTO STORAGE 00845000
* 00846000
* 3. SELECT A FILE FOR PROCESSING 00847000
* NO FILE FOUND, ARM AN ALERT 00848000
* 00849000
* 4. DEFINE A SPOOL READER AND PLACE SELECTED FILE IN THAT 00850000
* READER 00851000
* 00852000
* 5. FILL IN THE RESPONSE BUFFER 00853000
* 00854000
* 6. RETURN TO CALLER 00855000
* 00856000
* RESPONSES - 00857000
* 00858000
* NONE 00859000
* 00860000
* ERROR MESSAGES - 00861000
* 00862000
* NONE 00863000
* 00864000
*. 00865000
SPACE 2 00866000
OPENSAVE DC F'0' 00867000
SPACE 00868000
OPENTABL DC F'0' PROTOTYPE I/O TABLE FOR OUTPUT 00869000
DC H'0',AL1(1),AL1(0) DEVICE ADDR, SENSE REQ, DEVICE TYPE 00870000
DC A(0) CHANNEL PROGRAM START ADDRESS 00871000
DC 3F'0' SIO COND CODE, COMPOSITE CSW, SENSE INFO 00872000
DC X'01',AL3(0),X'0000',AL2(132) WRITE CCW 00873000
SPACE 00874000
OPENCODE DC 2X'00' OPEN POST CODE CONSTRUCTION FIELD 00875000
NOLUCK EQU X'08' BIT FOR TERMINAL SYSTEM ERROR 00876000
NOFILE EQU X'04' BIT FOR NO TAG ADDRESS RETURNED 00877000
NOLINK EQU X'02' BIT FOR LINK TABEL ENTRY FOUND 00878000
OLDFILE EQU X'01' FIT FOR ACTIVE INPUT FILE RETURNED 00879000
SPACE 00880000
HOLD EQU X'80' INPUT CLOSE & HOLD SUB OPT 00881000
ALL EQU X'40' INPUT CLOSE ALL COPIES 00882000
SPACE 00883000
MULTOPEN EQU X'80' OUTPUT OPEN MULTIPLE FILE 00884000
SPACE 00885000
OPENIN DC 0H'0' 00886000
ST R14,OPENSAVE SAVE CALLER'S RETURN ADDRESS 00887000
MVI OPENCODE,X'00' START WITH ZERO POST CODE 00888000
MVC AXSRESP(20),AXSREQ AND START WITH RESP=REQ 00889000
CLI AXSREQ,X'13' IS THE REQUEST LONG ENOUGH? 00890000
BL OPENWHO NOPE - INVALID LINK ID 00891000
LA R2,TAGACIN-(TAGNEXT-TAG) INITIALIZE ACTIVE INPUT SCAN PO 00892000
OPENIACT EQU * 00893000
ICM R2,B'1111',TAGNEXT BUMP POINTER TO THE NEXT TAG 00894000
BZ OPENILNK YES - NO ACTIVE FILE FOUND 00895000
CLC AXSREQ+12(8),TAGLINK IS FILE ACTIVE ON THIS LINK? 00896000
BNE OPENIACT NOPE - CHECK THE NEXT ONE OUT 00897000
ST R2,AXSRESP+4 OTHERWISE, SET THE ACTIVE TAG ADDRESS RESP 00898000
MVC AXSRESP+8(4),TAGBLOCK AND THE ACTIVE I/O AREA 00899000
OI OPENCODE,OLDFILE FLAG RETURN OF OLD ACTIVE FILE 00900000
B OPENEXIT AND RETURN TO THE CALLER 00901000
SPACE 00902000
OPENILNK EQU * 00903000
LA R3,AXSREQ+12 R3=ADDRESS OF LINK ID OF CALLER 00904000
LA R4,8 R4=LINK ID LENGTH 00905000
BAL R14,GETLINK TRY TO GET THE LINK TABLE ENTRY FOR CALLER 00906000
BNZ OPENWHO NO GOT - RETURN AN ERROR 00907000
NI LFLAG,X'FF'-LALERT RESET ALERT FLAG 00908000
OPENIRTY EQU * 00909000
BAL R14,UNPEND MAKE SURE ALL HIS FILES ARE IN OUR STORAGE QU 00910000
BAL R14,FILSELEC PICK NEXT FILE IN QUEUE 00911000
BC 7,OPENARM NONE - SET ALERT 00912000
L R15,TCOM GET COMMON ROUTINE ADDR 00913000
L R15,GPAGEREQ GET PAGE ROUTINE 00914000
LA R13,AXSCSAVE LOAD SAVE ADDR 00915000
BALR R14,R15 GO GET A PAGE 00916000
LTR R1,R1 GET ONE? 00917000
BZ OPENNONE NO GOT - RETURN AN ERROR 00918000
LR R7,R1 R7=ADDRESS OF NEW I/O AREA 00919000
SR R1,R1 CLEAR R1 TO REQUEST VIRTUAL READER 00920000
BAL R14,DEFINE GET A VIRTUAL READER 00921000
BAL R14,VSPOOLR SET CLASS * 00922000
OPENRET LH R3,TAGID SPOOL ID FOR SELECT @VA05479 00923000
LR R4,R1 SET RDR ADDR 00924000
LA R5,X'00C' SELECT SFB SUBCODE 00925000
DIAG R3,R4,X'14' MAKE FILE NEXT IN RDR 00926000
BC 5,OPENRDER SYSTEM READ ERROR 00927000
BC 2,OPENPOOF FILE GONE - FOOEY 00928000
LR R3,R7 I/O AREA ADDRESS 00929000
SR R5,R5 X'000' - READ SFB SUBCODE 00930000
DIAG R3,R4,X'14' READ FIRST SP BUFFER 00931000
BC 5,OPENRDER SYSTEM READ ERROR 00932000
BC 2,OPENPOOF FILE GONE - TRY AGAIN 00933000
STH R1,TAGDEV SET ACTIVE FILE VIRT DEV ADDR 00934000
ST R7,TAGBLOCK ACTIVE FILE I/O AREA ADDR TO TAG 00935000
ST R7,AXSRESP+8 AND TO THE RESPONSE 00936000
MVC TAGNEXT(4),TAGACIN ENQUEUE THE ACTIVE QUEUE ON IT 00937000
ST R2,TAGACIN PLACE IT AT THE START OF THE ACTIVE QUEUE 00938000
ST R2,AXSRESP+4 SET THE TAG ADDRESS IN THE RESPONSE 00939000
B OPENEXIT RETURN FOR MORE ACTION 00940000
SPACE 00941000
OPENARM EQU * 00942000
OI LFLAG,LALERT SET CALLING TASK'S NAME 00943000
B OPENNONE AND INDICATE NO FILE RETURNED 00944000
SPACE 00945000
OPENRDER EQU * 00946000
OI TAGFLAG,SFBSHOLD HOLD THE BAD FILE 00947000
BAL R14,DETACH DETACH THE DEVICE 00948000
LH R1,TAGID SET THE SPOOL FILE ID 00949000
BAL R14,AXSM108 ISSUE ERROR MESSAGE 00950000
OI OPENCODE,NOLUCK SET SYSTEM ERROR POST CODE BIT 00951000
LTR R7,R7 DO WE HAVE A PAGE CHECKED OUT? 00952000
BZ OPENNONE NOPE - LEAVE NOW 00953000
L R1,MAINMAP R1=START OF MAIN STORAGE MAP 00954000
SRL R7,12 R7=PAGE NUMBER OF RESERVED PAGE 00955000
LA R1,0(R7,R1) R7=BYTE ADDR IN MAIN STORAGE MAP 00956000
MVI 0(R1),X'00' FREE THE GOTTEN PAGE 00957000
B OPENNONE AND LEAVE WITH NO FILE INDICATION 00958000
SPACE 00959000
OPENPOOF EQU * 00960000
BAL R14,DETACH DETACH THE DEVICE 00961000
LH R1,TAGID SET THE SPOOL FILE ID 00962000
BAL R14,AXSM106 ISSUE DISAPPEAR MSG 00963000
BAL R14,FREESLOT FREE THE FILE'S TAG SLOT 00964000
B OPENIRTY AND TRY FOR ANOTHER 00965000
EJECT 00966000
OPENOUT DC 0H'0' 00967000
ST R14,OPENSAVE SAVE CALLER'S RETURN ADDRESS 00968000
MVI OPENCODE,X'00' START WITH ZERO POST CODE 00969000
MVC AXSRESP(20),AXSREQ SET THE RESP=REQ FOR NOW 00970000
CLI AXSREQ,X'13' IS THE REQUEST LONG ENOUGH? 00971000
BL OPENWHO NOPE - INVALID LINK ID 00972000
TM AXSREQ+3,MULTOPEN SUPPRESS ACTIVE OUTPUT SCAN? 00973000
BO OPENOLNK YES - TRUST HIM 00974000
L R3,AXSREQ+4 R3=CALLER'S FILE TAG 00975000
LA R2,TAGACOUT-(TAGNEXT-TAG) R2=START ADDR FOR QUEUE SCAN 00976000
OPENOACT EQU * 00977000
ICM R2,B'1111',TAGNEXT R2=NEXT TAG IN ACTIVE QUEUE 00978000
BZ OPENOLNK NO ACTIVE TAG FOUND 00979000
CLC AXSREQ+12(8),TAGLINK ACTIVE FILE FOR SAME LINK 00980000
BNE OPENOACT NOPE - KEEP LOOKING 00981000
MVC AXSRESP+8(4),TAGBLOCK OTHERWISE, GIVE BACK I/O AREA 00982000
OI OPENCODE,OLDFILE INDICATE OLD FILE FOUND 00983000
B OPENEXIT AND RETURN FOR MORE REQUESTS 00984000
SPACE 00985000
OPENOLNK EQU * 00986000
LA R3,AXSREQ+12 R3=CALLER'S LINK ID 00987000
LA R4,8 R4=LENGTH OF LINK ID 00988000
BAL R14,GETLINK FIND HIS LINK TABLE ENTRY 00989000
BNZ OPENWHO NOT FOUND - BOOT HIM 00990000
BAL R14,GETSLOT TRY TO GET A SLOT FOR HIS TAG 00991000
BZ OPENNONE NO SLOT AVAILABLE - QUIT 00992000
L R15,TCOM GET COMMON ROUTINE ADDR 00993000
L R15,GPAGEREQ GET THE ROUTINE ADDR 00994000
LA R13,AXSCSAVE GET THE SAVEAREA ADDR 00995000
BALR R14,R15 GO GET A PAGE 00996000
LTR R1,R1 GET ONE? 00997000
BNZ OPENOOK GOT ONE - ALL SET 00998000
BAL R14,FREESLOT OTHERWISE, GIVE BACK THE TAG SLOT 00999000
B OPENNONE AND QUIT 01000000
OPENOOK EQU * 01001000
L R3,AXSREQ+4 R3=CALLER'S TAG ADDRESS 01002000
MVC 8(TAGLEN-8,R2),8(R3) MOVE IN CALLER'S TAG DATA 01003000
MVC TAGLINK(8),LINKID FORCE CORRECT LINK ID 01004000
CLC TAGINTOD(8),AXSBLANK ORIGIN TOD SPECIFIED? 01005000
BNE OPENOTOK YES - LEAVE AS IS 01006000
STCK TAGINTOD SET CURRENT TIME AS DEFAULT 01007000
OPENOTOK EQU * 01008000
LR R7,R1 R7=NEW I/O AREA ADDRESS 01009000
SR R1,R1 CLEAR R1 FOR INSERT 01010000
IC R1,TAGINDEV R1=DEVICE TYPE CODE 01011000
STC R1,DEVCODE DEV TYPE TO I/O TABLE 01012000
BAL R14,DEFINE REQUEST A DEVICE 01013000
BAL R14,VSPOOLP AND SET IT UP FOR OUTPUT 01014000
STH R1,TAGDEV SET OUTPUT DEV ADDR IN TAG 01015000
MVC 0(32,R7),OPENTABL INITIALIZE THE I/O AREA 01016000
STH R1,DEVCUU SET THE DEVICE ADDRESS IN THE I/O TABLE 01017000
LA R6,24(R7) R6=WRITE CCW ADDRESS 01018000
ST R6,PROGADDR SET THE PROGRAM ADDRESS IN THE I/O TABLE 01019000
LA R6,32(R7) R6=BUFFER ADDRESS 01020000
ST R6,24(R7) SET THE DATA ADDRESS IN THE WRITE CCW 01021000
MVI 24(R7),X'01' RESTORE THE WRITE COMMAND CODE 01022000
MVC TAGNEXT(4),TAGACOUT CHAIN THE ACTIVE OUTPUT QUEUE 01023000
ST R2,TAGACOUT AND PUT THE NEW TAG FIRST ON THE CHAIN 01024000
ST R7,TAGBLOCK SET THE NEW I/O AREA ADDRESS IN THE TAG 01025000
ST R7,AXSRESP+8 AND IN THE RESPONSE 01026000
B OPENEXIT RETURN FOR MORE REQUEST HANDLING 01027000
SPACE 3 01028000
OPENWHO EQU * 01029000
OI OPENCODE,NOLINK+NOFILE TELL CALLER ABOUT BAD LINK ID 01030000
B OPENEXIT 01031000
SPACE 01032000
OPENNONE EQU * 01033000
OI OPENCODE,NOFILE INDICATE NO FILE RETURNED 01034000
LTR R2,R2 ANY TAG TO REPLACE? 01035000
BZ OPENEXIT NO - JUST LEAVE 01036000
BAL R14,TAGPLACE PUT IT BACK 01037000
SPACE 01038000
OPENEXIT EQU * 01039000
SR R0,R0 CLEAR FOR POST CODE INSERT 01040000
IC R0,OPENCODE R0=APPROPRIATE REQUEST POST CODE 01041000
L R14,OPENSAVE R14=RETURN ADDRESS 01042000
BR R14 RETURN TO THE CALLER 01043000
EJECT 01044000
*. 01045000
* 01046000
* ENTRY NAME - 01047000
* 01048000
* CLOSIN 01049000
* 01050000
* FUNCTION - 01051000
* 01052000
* TERMINATE SPOOL FILE PROCESSING 01053000
* 01054000
* CALLS TO OTHER ROUTINES - 01055000
* 01056000
* NONE 01057000
* 01058000
* OPERATION - 01059000
* 01060000
* 1. LOCATE TAG IN TAG QUEUE AND DEQUEUE IT 01061000
* 01062000
* 2. IDENTIFY SUB-OPTION AND PROCESS ACCORDINGLY 01063000
* 01064000
* 3. DETACH THE VIRTUAL DEVICE AND FREE THE SPOOL 01065000
* BUFFER 01066000
* 01067000
* 4. RETURN TO CALLER 01068000
* 01069000
* RESPONSES - 01070000
* 01071000
* NONE 01072000
* 01073000
* ERROR MESSAGES - 01074000
* 01075000
* NONE 01076000
* 01077000
*. 01078000
SPACE 2 01079000
CLOSEIN DC 0H'0' 01080000
STM R14,R8,CLOSSAVE SAVE ENTRY REGS 01081000
SPACE 01082000
MVI CLOSCODE,X'00' INITIALIZE POST CODE 01083000
MVC AXSRESP(20),AXSREQ START WITH RESP=REQ 01084000
CLI AXSREQ,X'0B' LONG ENOUGH? 01085000
BL CLOSABAD NO - ERROR RETURN 01086000
SPACE 01087000
LA R2,TAGACIN-(TAGNEXT-TAG) INITIALIZE SCAN 01088000
CLOISCAN EQU * 01089000
LR R3,R2 SET PREDECESSOR 01090000
ICM R2,B'1111',TAGNEXT GO TO NEXT 01091000
BZ CLOSABAD ADDR NOT FOUND 01092000
CL R2,AXSREQ+4 IS THIS THE ONE? 01093000
BNE CLOISCAN NO - TRY ANOTHER 01094000
SPACE 01095000
MVC TAGNEXT-TAG(4,R3),TAGNEXT DEQUEUE TAG 01096000
EJECT @VM01117 01096100
LA R3,TAGLINK ADDR OF TAG'S LINK ID @VM01117 01096200
LA R4,8 LENGTH OF A LINK ID @VM01117 01096300
BAL R14,GETLINK FIND THE LINK TABLE @VM01117 01096400
LTR R15,R15 DID WE GET ONE? @VM01117 01096500
BZ CLOIGOT YES - ALL IS WELL @VM01117 01096600
SR R8,R8 CLEAR LINK TABLE POINTER @VM01117 01096700
CLOIGOT EQU * @VM01117 01096800
L R3,TAGBLOCK ADDR OF I/O AREA 01097000
LH R1,TAGDEV VIRT RDR DEV ADDR 01098000
SPACE 01099000
TM AXSREQ+3,X'40' CLOSE 'ALL'? 01100000
BO CLOIPURG YES - DO PURGE 01101000
TM AXSREQ+3,X'80' CLOSE 'HOLD'? 01102000
BO CLOIHOLD YES - KEEP IT AROUND 01103000
CLC TAGCOPY(2),=XL2'1' ANY MORE TO GO? 01104000
BNH CLOIPURG NO - PURGE THE FILE 01105000
SPACE 01106000
CLOIHOLD EQU * 01107000
XC TAGBLOCK(4),TAGBLOCK CLEAR I/O AREA ADDR 01108000
XC TAGDEV(2),TAGDEV CLEAR VIRT DEV ADDR 01109000
BAL R14,TAGPLACE PUT IT BACK IN QUEUE 01110000
BAL R14,VCLOSEH VM/370 CLOSE HOLD 01111000
MVI VCHCNTRL,X'FF' SET UNSPECIFIED FLAG 01112000
MVC VCHCNTRL+1(VCHCLEN-1),VCHCNTRL SET WHOLE AREA 01113000
TM AXSREQ+3,X'80' AXS CLOSE 'HOLD' 01114000
BNO CLOICOPY NO - DECREMENT COPY COUNT 01115000
TM AXSREQ+3,X'01' HOLD THE FILE ? @VA05662 01115100
BO CLOICHAN NO, JUST PLACE BACK IN Q @VA05662 01115200
OI TAGFLAG,SFBUHOLD SET USER HOLD BIT 01116000
MVI VCHCHO,X'7F' AND SET CHANGE TO HOLD 01117000
B CLOICHAN CLOSE 'HOLD' 'ALL' INVALID 01118000
SPACE 01119000
CLOICOPY EQU * 01120000
LH R0,TAGCOPY CURRENT COPY COUNT 01121000
BCTR R0,0 DECREMENT ONE 01122000
STH R0,TAGCOPY SET NEW COPY COUNT 01123000
STH R0,VCHCCO AND SET VM/370 CHANGE COPY 01124000
CLOICHAN EQU * 01125000
LR R0,R1 SAVE VIRT DEV ADDR 01126000
LH R1,TAGID SPOOL ID FOR CHANGE 01127000
BAL R14,VCHANGE DECREMENT VM/370 COPY COUNT 01128000
LR R1,R0 RESTORE VIRT DEV ADDR 01129000
CLOIFINI EQU * 01130000
BAL R14,DETACH DETACH IT 01131000
SRL R3,12 I/O AREA PAGE NUMBER 01132000
L R1,MAINMAP START OF STORAGE MAP 01133000
ALR R1,R3 ADDR OF I/O AREA ENTRY 01134000
MVI 0(R1),X'00' RELEASE THE PAGE 01135000
SPACE 01136000
CLOIEXIT EQU * 01137000
LM R14,R8,CLOSSAVE RESTORE ENTRY REGS 01138000
SR R0,R0 CLEAR FOR POST CODE 01139000
IC R0,CLOSCODE SET RETURN POST CODE 01140000
BR R14 AND RETURN 01141000
EJECT 01142000
CLOIPURG EQU * 01143000
BAL R14,VCLOSEP VM/370 CLOSE NOHOLD 01144000
CLC TAGCOPY(2),=XL2'1' ANY COPIES @VA05958 01144100
BE CLOIPUR2 NO....DONE THEN @VA05958 01144200
LR R0,R1 SAVE REG ONE @VA05958 01144300
LH R1,TAGID LOAD FILEID TO PURGE @VA05958 01144400
BAL R14,VPURGE PURGE ALL COPIES OF FILE @VA05958 01144500
LR R1,R0 RESTORE REG ONE @VA05958 01144600
CLOIPUR2 DS 0H @VA05958 01144700
BAL R14,AXSM105 ISSUE PURGED MSG 01145000
LTR R8,R8 ANY LINK TABLE ADDRESS? @VM01117 01146010
BZ CLOIFINI NO - FORGET TAG SLOT RETURN @VM01117 01147010
BAL R14,FREESLOT RETURN THE TAG SLOT @VM01117 01148010
B CLOIFINI DETACH AND FREE 01163000
EJECT 01164000
*. 01165000
* 01166000
* ENTRY NAME - 01167000
* 01168000
* CLOSEOUT 01169000
* 01170000
* FUNCTION - 01171000
* 01172000
* TERMINATE PROCESSING FOR OUTPUT FILES. 01173000
* 01174000
* CALLS TO OTHER ROUTINES - 01175000
* 01176000
* NONE 01177000
* 01178000
* OPERATION - 01179000
* 01180000
* 1. LOCATE THE OUTPUT TAG AND DEQUEUE IT. 01181000
* 01182000
* 2. UPDATE TAG INFO FROM CALLERS TAG 01183000
* 01184000
* 3. DETACH THE VIRTUAL DEVICE AND FREE THE SPOOL 01185000
* PAGE BUFFER 01186000
* 01187000
* 4. FREE THE TAG SLOT 01188000
* 01189000
* 5. RETURN TO CALLER 01190000
* 01191000
* RESPONSES - 01192000
* 01193000
* DMTAXS104I FILE SPOOLED TO 'USERID2' -- ORG 'LOCID1' 01194000
* ('USERID1') MM/DD/YY HH:MM:SS 01195000
* 01196000
* ERROR MESSAGES - 01197000
* 01198000
* NONE 01199000
* 01200000
*. 01201000
SPACE 2 01202000
CLOSEOUT DC 0H'0' 01203000
STM R14,R8,CLOSSAVE SAVE ENTRY REGS 01204000
SPACE 01205000
MVC CLOSCODE,X'00' INITIALIZE POST CODE 01206000
MVC AXSRESP(20),AXSREQ START WITH RESP=REQ 01207000
CLI AXSREQ,X'0B' LONG ENOUGH? 01208000
BL CLOSABAD NO - ERROR RETURN 01209000
SPACE 01210000
LA R2,TAGACOUT-(TAGNEXT-TAG) INITIALIZE SCAN 01211000
CLOOSCAN EQU * 01212000
LR R3,R2 SET PREDECESSOR TAG ADDR 01213000
ICM R2,B'1111',TAGNEXT GO TO NEXT TAG 01214000
BZ CLOSABAD NOT FOUND 01215000
CLC AXSREQ+8(4),TAGBLOCK I/O AREA ADDR MATCH? 01216000
BNE CLOOSCAN NO - TRY NEXT 01217000
SPACE 01218000
MVC TAGNEXT-TAG(4,R3),TAGNEXT DEQUEUE TAG 01219000
SPACE 01220000
L R3,AXSREQ+4 CALLER'S TAG IMAGE ADDR 01221000
MVC TAGCLASS(1),TAGCLASS-TAG(R3) UPDATE CLASS 01222000
MVC TAGCOPY(2),TAGCOPY-TAG(R3) UPDATE COPY 01223000
MVC TAGNAME(24),TAGNAME-TAG(R3) UPDATE NAME 01224000
MVC TAGDIST(8),TAGDIST-TAG(R3) UPDATE DIST CODE 01225000
MVC TAGTOVM(8),TAGTOVM-TAG(R3) UPDATE XFER VM ID 01226000
SPACE 01227000
L R3,TAGBLOCK I/O AREA ADDR 01228000
LH R1,TAGDEV VIRTUAL OUTPUT DEV ADDR 01229000
BAL R14,VSPOOLP UPDATE SPOOL VARIABLES 01230000
BAL R14,VCLOSEO VM/370 CLOSE OUTPUT 01231000
BAL R14,DETACH DETACH THE OUTPUT DEV 01232000
SRL R3,12 I/O AREA PAGE NUMBER 01233000
L R1,MAINMAP ADDR OF MAIN STORAGE MAP 01234000
ALR R1,R3 ADDR OF I/O AREA PAGE ENTRY 01235000
MVI 0(R1),X'00' RELEASE THE I/O AREA PAGE 01236000
XC AXSRESP+8(4),AXSRESP+8 CLEAR I/O AREA ADDR 01237000
SPACE 01238000
MVC AXSMSGVM(8),TAGTOVM SET DEST VM ID 01239000
MVC AXSMSGV0(8),TAGTOVM AND IN MSG AS WELL 01240000
MVC AXSMSGV1(8),TAGINLOC SET ORIGIN LOCATION ID 01241000
MVC AXSMSGV2(8),TAGINVM SET ORIGIN VM ID 01242000
MVC AXSWORK(19),AXSTMASK SET TOD EDITING MASK 01243000
LM R0,R1,TAGINTOD ORIGIN TOD S/370 FORMAT 01244000
LR R3,R2 SAVE THE TAG ADDRESS 01245000
LA R2,AXSWORK ADDR OF OUTPUT AREA 01246000
BAL R14,TODEBCD CONVERT TO DATE TIME EBCDIC 01247000
LR R2,R3 RESTORE THE TAG ADDR 01248000
MVC AXSMSGV3(24),AXSWORK+1 MOVE TO MSG 01249000
BAL R14,AXSM104 ISSUE THE XFER MSG 01250000
SPACE 01251000
LA R3,TAGLINK R3 = ADDR OF LINK ID 01252000
LA R4,8 R4 = LINK ID LENGTH 01253000
BAL R14,GETLINK GET THE LINK TABLE 01254000
BNZ CLOSEXIT NO LINK TABLE - GIVE UP 01255000
BAL R14,FREESLOT RELEASE THE TAG SLOT 01256000
EJECT 01257000
CLOSEXIT EQU * 01258000
LM R14,R8,CLOSSAVE RESTORE ENTRY REGS 01259000
SR R0,R0 CLEAR R0 FOR POST CODE 01260000
IC R0,CLOSCODE SET THE CLOSE POST CODE 01261000
BR R14 AND RETURN FOR MORE 01262000
SPACE 2 01263000
CLOSABAD EQU * 01264000
OI CLOSCODE,X'04' INDICATE BAD TAG ADDR 01265000
B CLOSEXIT AND RETURN LIKE THAT 01266000
SPACE 3 01267000
CLOSSAVE DC 11F'0' CLOSE ROUTINE SAVE AREA 01268000
SPACE 01269000
CLOSCODE DC X'00',X'00' POST CODE ACCUMULATOR 01270000
EJECT 01271000
*. 01272000
* 01273000
* ENTRY NAME - 01274000
* 01275000
* MSG 01276000
* 01277000
* FUNCTION - 01278000
* 01279000
* SET THE MSG REQUEST ELEMENT, AND CALL GIVE PASS IT TO 01280000
* TO THE MESSAGE MANAGER. ENTRIES BELOW FORMAT THE 01281000
* MSG ELEMENT VARIABLE AREA IN VARIOUS WAYS AND EXIT 01282000
* FINALLY TO MSG. 01283000
* 01284000
* CALLS TO OTHER ROUTINES - 01285000
* 01286000
* DMTGIV - TO ISSUE MSG REQUEST TO DMTREX 01287000
* DMTWAT - TO WAIT FOR THE REQUEST TO BE TAKEN 01288000
* 01289000
* OPERATION - 01290000
* 01291000
* 1. SETUP THE APPROPRIATE TYPE OF MSG, BASED ON FORMAT 01292000
* 01293000
* 2. GIVE THE MSG ELEMENT TO DMTREX AND WAIT FOR COMPLETION 01294000
* 01295000
* 3. RETURN TO CALLER 01296000
* 01297000
* RESPONSES - 01298000
* 01299000
* NONE 01300000
* 01301000
* ERROR MESSAGES - 01302000
* 01303000
* NONE 01304000
* 01305000
*. 01306000
SPACE 3 01307000
MSG DC 0H'0' 01308000
STM R14,R1,MSGSAVE SAVE REGISTERS 01309000
MSGDO EQU * 01310000
BCTR R0,0 DECREMENT REQ LENGTH ONE 01311000
STC R0,AXSMSG SET MSG REQ ELEMENT LEN 01312000
STH R15,AXSMSGNM AND SET THE MSG NUMBER 01313000
LA R1,MSGREQ SET GIVE TABLE ADDR 01314000
XC 0(4,R1),0(R1) CLEAR POSTED SYNCH LOCK 01315000
L R15,GIVEREQ SYSTEM GIVE REQUEST EXECUTATOR 01316000
BALR R14,R15 GO GIVE THE BUFFER TO REX 01317000
L R15,WAITREQ ENTRY FOR WAIT SERVICE 01318000
BALR R14,R15 WAIT FOR LAST TO FINISH 01319000
SPACE 01320000
LM R14,R1,MSGSAVE RESTORE REGS 01321000
BR R14 AND RETURN 01322000
SPACE 3 01323000
MSGSPID EQU * 01324000
LA R0,28+8 SET ONE VARIABLE MSG LEN 01325000
MSGSPID0 EQU * 01326000
MVC AXSMSGV0(8),AXSBLANK CLEAR FIRST VAR FIELD 01327000
STM R15,R0,MSGXSAVE SAVE DECPUT REGS 01328000
LA R15,AXSMSGV0 SET DECPUT TARGET 01329000
LA R0,4 SET MIN TRUNC 01330000
BAL R14,DECPUT CONVERT THE SPOOL ID 01331000
LM R15,R0,MSGXSAVE RESTORE DECPUT REGS 01332000
B MSGDO GIVE IT TO REX 01333000
SPACE 01334000
MSGNN EQU * 01335000
MVC AXSMSGV0(8),AXSBLANK CLEAR FIRST VAR FIELD 01336000
STM R15,R0,MSGXSAVE SAVE DECPUT REGS 01337000
LA R15,AXSMSGV0 SET DECPUT NUMBER TARGET 01338000
SLR R0,R0 NO MIN TRUNC 01339000
BAL R14,DECPUT CONVERT THE NUMBER 01340000
LM R15,R0,MSGXSAVE RESTORE DECPUT REGS 01341000
MVC AXSMSGV1(8),LINKID SET LINKID SECOND VAR 01342000
LA R0,28+2*8 SET MSG REQ LEN 01343000
B MSGDO GIVE THE MSG TO REX 01344000
SPACE 01345000
MSGLKID1 EQU * 01346000
MVC AXSMSGV1(8),LINKID SET LINK ID SECOND VAR 01347000
LA R0,28+2*8 SET MSG REQ LENGTH FOR TWO 01348000
B MSGSPID0 PUT THE SPOOL ID IN FIRST 01349000
SPACE 01350000
AXSM101 EQU * 01351000
STM R14,R1,MSGSAVE SAVE REGS 01352000
LA R15,101 SET MSG NUMBER 01353000
B MSGLKID1 FORMAT VARIABLES 01354000
SPACE 01355000
AXSM102 EQU * 01356000
STM R14,R1,MSGSAVE SAVE REGS 01357000
LA R15,102 SET MSG NUMBER 01358000
B MSGLKID1 FORMAT VARIABLES 01359000
SPACE 01360000
AXSM103 EQU * 01361000
STM R14,R1,MSGSAVE SAVE REGS 01362000
LA R15,103 SET MSG NUMBER 01363000
B MSGSPID FORMAT SPOOL ID 01364000
SPACE 01365000
AXSM104 EQU * 01366000
STM R14,R1,MSGSAVE SAVE REGS 01367000
LA R15,104 SET MSG NUMBER 01368000
LA R0,28+6*8 SET MSG REQ LEN FOR SIX 01369000
B MSGDO VARIABLES PREFORMATTED 01370000
SPACE 01371000
AXSM105 EQU * 01372000
STM R14,R1,MSGSAVE SAVE REGS 01373000
LH R1,TAGID SET THE PURGED TAG ID 01374000
LA R15,105 SET MSG NUMBER 01375000
B MSGSPID FORMAT SPOOL ID 01376000
EJECT 01377000
AXSM106 EQU * 01378000
STM R14,R1,MSGSAVE SAVE REGS 01379000
LA R15,106 SET MSG NUMBER 01380000
B MSGLKID1 FORMAT VARIABLES 01381000
SPACE 01382000
AXSM107 EQU * 01383000
STM R14,R1,MSGSAVE SAVE REGS 01384000
LA R15,107 SET MSG NUMBER 01385000
B MSGNN FORMAT NUMBER 01386000
SPACE 01387000
AXSM108 EQU * 01388000
STM R14,R1,MSGSAVE SAVE REGS 01389000
LA R15,108 SET MSG NUMBER 01390000
B MSGSPID FORMAT SPOOL ID 01391000
SPACE 01392000
MSGREQ DC 0F'0',X'80',AL3(0) SYNCH LOCK STARTS POSTED 01398000
DC CL4'REX ' MSG MGR TASK NAME 01399000
DC A(AXSMSG) MSG REQ ELEMENT ADDR 01400000
DC A(0) NO RESP BUFFER 01401000
SPACE 2 01402000
MSGSAVE DC 4F'0' MAIN SAVE AREA 01403000
MSGXSAVE DC 2F'0' PROLOG SAVE AREA 01404000
EJECT 01405000
*. 01406000
*---------------------------------------------------------------------* 01407000
* PARMGET -- LINE SCANNING SUBROUTINE * 01408000
*---------------------------------------------------------------------* 01409000
* 01410000
* ON ENTRY: R3=ADDRESS OF START OF STRING 01411000
* R5=ADDRESS OF END OF STRING 01412000
* 01413000
* ON EXIT: R3=FIRST NONDELIMETER CHARACTER SCANNED; 01414000
* IF NONE FOUND, END OF STRING 01415000
* R4=UNMODIFIED IF NO NONDELIMETER CHAR SCANNED; 01416000
* OTHERWISE, ADDRESS OF FIRST DELIMETER CHAR 01417000
* AFTER FIRST NONDELIMETER CHAR SCANNED; 01418000
* IF NONE, END OF STRING. 01419000
* R5=UNMODIFIED 01420000
* 01421000
* A DELIMETER CHAR IS ANY CHARACTER OF THE FORM B'0X000000' 01422000
*. 01423000
SPACE 01424000
PARMGET DC 0H'0' 01425000
LA R5,0(R5) CLEAR HIGH ORDER BYTE JUST IN CASE 01426000
BCTR R3,0 BUMP START OF STRING POINTER BACK FOR CONVENIENCE 01427000
PARMFIND EQU * 01428000
LA R3,1(R3) LOOK AT THE NEXT CHARACTER 01429000
CLR R3,R5 HAVE WE HIT THE END OF THE STRING? 01430000
BCR 11,R14 (BNL) YEP - LOOK NO MORE 01431000
TM 0(R3),X'BF' IS THIS CHARACTER A DELIMETER? 01432000
BZ PARMFIND YEP - KEEP LOOKING FOR A NONDELIMETER 01433000
LR R4,R3 OTHERWISE SET UP FOR NEXT PHASE OF SCAN 01434000
PARMSCAN EQU * 01435000
LA R4,1(R4) LOOK AT THE NEXT CHARACTER 01436000
CLR R4,R5 ARE WE AT THE END OF THE STRING YET? 01437000
BCR 11,R14 (BNL) RETURN IMMEDIATELY IF SO 01438000
TM 0(R4),X'BF' IS THIS CHARACTER A DELIMETER? 01439000
BNZ PARMSCAN KEEP SCANNING FOR A DELIMETER IF NOT 01440000
BR R14 OTHERWISE ALL DONE - RETURN 01441000
SPACE 3 01442000
*---------------------------------------------------------------------* 01443000
* TAGSETUP -- SET UP FOR SCAN OF FIRST TAG PARAMETER * 01444000
*---------------------------------------------------------------------* 01445000
SPACE 01446000
TAGSETUP DC 0H'0' 01447000
LA R3,AXSSPTAG+12 R3=ADDRESS OF ORDINARY START OF TAG 01448000
LR R5,R3 R5=START OF TAG DATA, TOO 01449000
AH R5,AXSSPTAG+6 OTHERWISE, R5=ADDR OF END TAG DATA 01452000
CLR R0,R0 SET CC = 0 01453000
BR R14 AND RETURN TO THE CALLER 01454000
EJECT 01455000
*. 01456000
* 01457000
* ENTRY NAME - 01458000
* 01459000
* HEXGET 01460000
* 01461000
* FUNCTION - 01462000
* 01463000
* CONVERT AND VALIDATE A HEX STRING 01464000
* 01465000
* CALLS TO OTHER ROUTINES - 01466000
* 01467000
* NONE 01468000
* 01469000
* ENTRY: 01470000
* 01471000
* R3,R4 = START AND END ADDR OF PARM 01472000
* R5 = END ADDR OF LINE 01473000
* R8 = (UNSIGNED) LOWER RANGE LIMIT 01474000
* R9 = (UNSIGNED) UPPER RANGE LIMIT 01475000
* 01476000
* EXIT: 01477000
* 01478000
* CC=0 => HEX NUMBER VALID (IN R0) WITHIN RANGE 01479000
* CC=1 => HEX NUMBER VALID (IN R0) OUT OF RANGE 01480000
* CC=2 => COUNT GREATER THAN 8, OR INVALID CHARS IN PARM 01481000
* CC=3 => COUNT 0 OR NEGATIVE 01482000
* 01483000
* CC=0: 01484000
* R0 = VALID HEX NUMBER 01485000
* R4 = COUNT -1 OF (VALID) PARM 01486000
* 01487000
* CC=1: 01488000
* R0 = VALID (OUT OF RANGE) HEX NUMBER 01489000
* R4 = COUNT-1 OF (OUT OF RANGE) PARM 01490000
* 01491000
* CC=2: 01492000
* R4 = COUNT -1 OF (INVALID) PARM 01493000
* 01494000
* CC=3: 01495000
* R4 = SAME AS ON ENTRY 01496000
* 01497000
* 01498000
* OPERATION - 01499000
* 01500000
* 1. VALIDATE PARAMETER 01501000
* 01502000
* 2. MOVE TO WORK AREA 01503000
* 01504000
* 3. CONVERT TO HEX 01505000
* 01506000
* 4. SET RETURN CODE AND RETURN 01507000
* 01508000
EJECT 01509000
* 01510000
* RESPONSES - 01511000
* 01512000
* NONE 01513000
* 01514000
* ERROR MESSAGES - 01515000
* 01516000
* NONE 01517000
* 01518000
*. 01519000
SPACE 2 01520000
HEXGET DC 0H'0' 01521000
SR R4,R3 GET LENGTH OF PARM 01522000
BNP HEXGETC3 ERROR 01523000
CLR R3,R5 END OF LINE? 01524000
BNL HEXGETC3 WENT TOO FAR 01525000
CL R4,AXSLIMIT TOO LONG? 01526000
BCTR R4,0 REDUCE BY ONE FOR CHAR OP 01527000
BH HEXGETC2 TOO LONG 01528000
XC AXSWORK(8),AXSWORK CLEAR WORK AREA 01529000
ST R15,AXSWORK+8 SAVE REG.15 CONTENTS 01530000
LA R15,AXSWORK+7 LAST CHAR OF TARGET 01531000
SLR R15,R4 FIRST CHAR OF TARGET 01532000
EX R4,AXSMOVE MOVE EBCDIC NUMBER TO WORK 01533000
L R15,AXSWORK+8 RESTORE REG.15 01534000
TR AXSWORK(8),AXSTOHEX TRANSLATE TO HEX 01535000
MVI AXSWORK+8,X'80' MOVE IN FIRST COMPARE 01536000
MVC AXSWORK+9(7),AXSWORK+8 AND PROPAGATE 01537000
NC AXSWORK+8(8),AXSWORK TEST FOR ILLEGAL CHAR 01538000
BNZ HEXGETC2 INVALID 01539000
PACK AXSWORK+16(5),AXSWORK(9) MOVE IN 01540000
L R0,AXSWORK+16 GET GENERATED NUMBER 01541000
CLR R0,R8 TOO LOW FOR RANGE 01542000
BL HEXGETC1 YES 01543000
CLR R0,R9 TOO HIGH FOR RANGE 01544000
BH HEXGETC1 YES 01545000
HEXGETC0 EQU * 01546000
CLR R0,R0 SET CC=0 01547000
BR R14 AND RETURN 01548000
SPACE 1 01549000
HEXGETC1 EQU * 01550000
OI AXSWORK+9,X'80' SET CC=1 01551000
BR R14 AND RETURN 01552000
SPACE 1 01553000
HEXGETC2 EQU * 01554000
LA R14,0(R14) CLEAR SIGN BIT 01555000
LTR R14,R14 SET CC=2 01556000
BR R14 AND RETURN 01557000
SPACE 1 01558000
HEXGETC3 EQU * 01559000
ALR R4,R3 PUT R4 BACK WHERE IT WAS 01560000
TM *+1,X'80' SET CC=3 01561000
BR R14 AND RETURN 01562000
EJECT 01563000
*. 01564000
* 01565000
* ENTRY NAME - 01566000
* 01567000
* DECGET 01568000
* 01569000
* FUNCTION - 01570000
* 01571000
* CONVERT AND VALIDATE A DECIMAL STRING 01572000
* 01573000
* CALLS TO OTHER ROUTINES - 01574000
* 01575000
* NONE 01576000
* 01577000
* ENTRY: 01578000
* 01579000
* R3,R4 = START AND END ADDR OF PARM 01580000
* R5 = END ADDR OF LINE 01581000
* R8 = (UNSIGNED) LOWER RANGE LIMIT 01582000
* R9 = (UNSIGNED) UPPER RANGE LIMIT 01583000
* 01584000
* EXIT: 01585000
* 01586000
* CC=0 => HEX NUMBER VALID (IN R0) WITHIN RANGE 01587000
* CC=1 => HEX NUMBER VALID (IN R0) OUT OF RANGE 01588000
* CC=2 => COUNT GREATER THAN 8, OR INVALID CHARS IN PARM 01589000
* CC=3 => COUNT 0 OR NEGATIVE 01590000
* 01591000
* CC=0: 01592000
* R0 = VALID HEX NUMBER 01593000
* R4 = COUNT -1 OF (VALID) PARM 01594000
* 01595000
* CC=1: 01596000
* R0 = VALID (OUT OF RANGE) HEX NUMBER 01597000
* R4 = COUNT-1 OF (OUT OF RANGE) PARM 01598000
* 01599000
* CC=2: 01600000
* R4 = COUNT -1 OF (INVALID) PARM 01601000
* 01602000
* CC=3: 01603000
* R4 = SAME AS ON ENTRY 01604000
* 01605000
* 01606000
* OPERATION - 01607000
* 01608000
* 1. VALIDATE PARAMETER 01609000
* 01610000
* 2. MOVE TO WORK AREA 01611000
* 01612000
* 3. CONVERT TO HEX 01613000
* 01614000
* 4. SET RETURN CODE AND RETURN 01615000
* 01616000
EJECT 01617000
* 01618000
* RESPONSES - 01619000
* 01620000
* NONE 01621000
* 01622000
* ERROR MESSAGES - 01623000
* 01624000
* NONE 01625000
* 01626000
*. 01627000
SPACE 2 01628000
DECGET EQU * 01629000
SR R4,R3 LENGTH OF PARM 01630000
BNP DECGETC3 NO GOOD 01631000
CLR R3,R5 ANY AT ALL? 01632000
BNL DECGETC3 NOPE - ERROR 01633000
CL R4,DECLIMIT TOO MUCH 01634000
BCTR R4,0 DOWN ONE IN CASE 01635000
BH DECGETC2 YEP 01636000
XC AXSWORK(16),AXSWORK CLEAR WORK AREA 01637000
ST R15,AXSWORK+16 SAVE CALLER'S REG.15 01638000
LA R15,AXSWORK+12 LAST CHAR ADDRESS 01639000
SLR R15,R4 FIRST CHAR ADDRESS 01640000
EX R4,AXSMOVE MOVE TO WORK AREA 01641000
L R15,AXSWORK+16 RESTORE CALLER'S REG.15 01642000
TR AXSWORK(13),AXSTOHEX TRANSLATE TO PACKABLE HEX 01643000
TR AXSWORK(13),AXSTODEC CLEAR INVALID DECIMAL 01644000
MVI AXSWORK+16,X'80' SET CHECKING FIELD 01645000
MVC AXSWORK+17(12),AXSWORK+16 SET WHOLE FILED 01646000
NC AXSWORK+16(13),AXSWORK CHECK FOR INVALID CHARS 01647000
BNZ DECGETC2 BAD NEWS - ERROR 01648000
OI AXSWORK+12,X'C0' SET SIGN FIELD 01649000
PACK AXSWORK+17(7),AXSWORK(13) CONVERT TO PACKED DEC 01650000
MVI AXSWORK+16,X'00' SET TOP BYTE TO ZERO 01651000
CLC AXSWORK+16(8),DECMAX TOO BIG? 01652000
BH DECGETC2 YEP - ERROR 01653000
CVB R0,AXSWORK+16 GET BINARY COUNT 01654000
CLR R0,R8 TOO LOW FOR RANGE? 01655000
BL DECGETC1 YES 01656000
CLR R0,R9 TOO HIGH FOR RANGE? 01657000
BH DECGETC1 YES 01658000
DECGETC0 EQU * 01659000
CLR R0,R0 SET CC=0 01660000
BR R14 AND RETURN 01661000
SPACE 01662000
DECGETC1 EQU * 01663000
OI AXSWORK+15,X'80' SET CC=1 01664000
BR R14 AND RETURN 01665000
SPACE 01666000
DECGETC2 EQU * 01667000
LA R14,0(R14) CLEAR SIGN 01668000
LTR R14,R14 SET CC=2 01669000
BR R14 AND RETURN 01670000
SPACE 01671000
DECGETC3 EQU * 01672000
ALR R4,R3 RESTORE R4 01673000
TM *+1,X'80' SET CC=3 01674000
BR R14 AND RETURN 01675000
SPACE 01676000
DECLIMIT DC F'10' MAX CHARS FOR INPUT 01677000
DECMAX DC PL8'2147483647' MAX POSITIVE FULLWORD 01678000
EJECT 01679000
*. 01680000
* 01681000
* ENTRY NAME - 01682000
* 01683000
* DECPUT 01684000
* 01685000
* FUNCTION - 01686000
* 01687000
* CONVERTS A HEX FULLWORD TO DECIMAL AND GENERATES AN 01688000
* EBCDIC REPRESENTATION OF IT, SUPPRESSING LEADING ZEROES 01689000
* TO A MINIMUM COUNT, OPTIONALLY SUPPLIED BY THE CALLER. 01690000
* 01691000
* CALLS TO OTHER ROUTINES - 01692000
* 01693000
* NONE 01694000
* 01695000
* OPERATION - 01696000
* 01697000
* 1. CONVERT TO DECIMAL AND UNPACK THE NUMBER 01698000
* 01699000
* 2. SUPRESS LEADING ZEROS 01700000
* 01701000
* 3. RETURN TO CALLER 01702000
* 01703000
* ENTRY: 01704000
* 01705000
* R0 = MINIMUM EBCDIC CHARACTER COUNT 01706000
* R1 = NUMBER TO BE CONVERTED TO DECIMAL EBCDIC 01707000
* R15 = OUTPUT (TARGET) FIELD 01708000
* 01709000
* EXIT: 01710000
* 01711000
* R0 = NUMBER OF CHARACTERS MOVED, AFTER 01712000
* SUPPRESSION OF LEADING ZEROS 01713000
* 01714000
* RESPONSES - 01715000
* 01716000
* NONE 01717000
* 01718000
* ERROR MESSAGES - 01719000
* 01720000
* NONE 01721000
* 01722000
*. 01723000
SPACE 2 01724000
DECPUT EQU * 01725000
STM R0,R4,DECPSAVE SAVE CALLER'S REGISTERS TO BE USED 01726000
CVD R1,AXSWORK SET PACKED DECIMAL IN STORAGE 01727000
UNPK AXSWORK+8(11),AXSWORK+2(6) CONVERT TO UNPACKED DEC 01728000
OI AXSWORK+18,X'F0' FORCE PROPER ZONE FOR EBCDIC 01729000
LA R3,AXSWORK+9 INITIALIZE SOURCE FIELD 01730000
LA R4,AXSWORK+18 INITIALIZE END OF SOURCE FIELD 01731000
LA R1,10 SET MAX DIGIT CHAR COUNT 01732000
S R1,DECPSAVE SET MAX SUPPRESSION LAPS 01733000
BNP DECPHIT NO SUPPRESSION AT ALL 01734000
DECPNEXT EQU * 01735000
CLI 0(R3),C'0' IS IT ZERO? 01736000
BNE DECPHIT NOPE - USE IT 01737000
CLR R3,R4 PAST THE LIMIT? 01738000
BNL DECPHIT YES - DO IT 01739000
LA R3,1(R3) BUMP TO NEXT CHAR 01740000
BCT R1,DECPNEXT AND CHECK IT 01741000
DECPHIT EQU * 01742000
SLR R4,R3 COUNT TO MOVE -1 01743000
EX R4,AXSMOVE MOVE NUMBER TO TARGET 01744000
LA R0,1(R4) RETURN COUNT 01745000
LM R1,R4,DECPSAVE+4 RESTORE CALLER'S REGS 01746000
BR R14 AND RETURN TO CALLER 01747000
SPACE 2 01748000
DECPSAVE DC 5F'0' DECPUT SAVE AREA 01749000
EJECT 01750000
*. 01751000
* 01752000
* ENTRY NAME - 01753000
* 01754000
* TODS370 01755000
* 01756000
* FUNCTION - 01757000
* 01758000
* CONVERT EBCDIC TO S/370 TOD 01759000
* 01760000
* CALLS TO OTHER ROUTINES - 01761000
* 01762000
* NONE 01763000
* 01764000
* ENTRY: 01765000
* 01766000
* R1=ADDRESS OF EBCDIC MM/DD/YYHH:MM:SS 01767000
* 01768000
* EXIT: 01769000
* 01770000
* REGS.0,1=S/370 FORMAT TIME OF DAY 01771000
* 01772000
* THIS ROUTINE ASSUMES THAT ALL EBCDIC DATES WITH TWO BYTE 01773000
* YEAR SPECIFICATIONS LESS THAN DECIMAL 42 REFER TO THE 01774000
* 21ST CENTURY, AND ALL OTHERS REFER TO THE 20TH CENTURY. 01775000
* 01776000
* OPERATION - 01777000
* 01778000
* 1. CONVERT TIME AND DATE TO DECIMAL 01779000
* 01780000
* 2. ACCUMLATE S/370 TOD 01781000
* 01782000
* RESPONSES - 01783000
* 01784000
* NONE 01785000
* 01786000
* ERROR MESSAGES - 01787000
* 01788000
* NONE 01789000
* 01790000
*. 01791000
SPACE 2 01792000
TODS370 DC 0H'0' 01793000
STM R2,R9,TODSSAVE SAVE CALLER'S REGISTER CONTENTS 01794000
MVC TODSDWD(2),0(R1) MOVE EBCDIC MONTHS TO WORK AREA 01795000
MVC TODSDWD+2(2),3(R1) MOVE EBCDIC DAYS TO WORK AREA 01796000
MVC TODSDWD+4(2),6(R1) MOVE EBCDIC YEARS TO WORK AREA 01797000
TR TODSDWD(3),DECDIGIT FORCE LEGAL EBCDIC DECIMAL DIGITS 01798000
PACK MMDDYY(4),TODSDWD(7) PACK THE DECIMAL DATE TO SAVE AREA 01799000
MVC TODSDWD(2),8(R1) MOVE EBCDIC HOURS TO WORK AREA 01800000
MVC TODSDWD+2(2),11(R1) MOVE EBCDIC MINUTES TO WORK AREA 01801000
MVC TODSDWD+4(2),14(R1) MOVE EBCDIC SECONDS TO WORK AREA 01802000
TR TODSDWD(6),DECDIGIT FORCE LEGAL EBCDIC DECIMAL DIGITS 01803000
PACK HHMMSS(4),TODSDWD(7) PACK THE DECIMAL TIME TO SAVE AREA 01804000
MVC TODSDWD(8),PL8ZERO SET EIGHT BYTE PACKED DECIMAL ZERO 01805000
MVO TODSDWD(8),MMDDYY(3) MAKE DATE GENUINE PACKED DECIMAL 01806000
CVB R5,TODSDWD R5=HEX REPRESENTATION OF DEC MMDDYY 01807000
SR R4,R4 CLEAR TOP HALF OF DIV FOR IMPENDING 01808000
D R4,F100 R4=YY PART, R5=MMDD PART 01809000
CLI MMDDYY+2,X'42' IS THE SPECIFIED DATE PAST YY 41? 01810000
BNL TODS20TH YEP-ASSUME TWENTIETH CENTURY (19XX) 01811000
AL R4,F100 BUMP THINGS UP TO THE NEXT CENTURY 01812000
TODS20TH EQU * 01813000
LA R7,365 R7=NUMBER OF DAYS IN A NON-LEAP YEAR 01814000
MR R6,R4 R7=NON-LEAP DYS TO START OF THIS YEA 01815000
LR R9,R4 R9=NUMBER OF FULL YEARS SINCE 1/1/00 01816000
BCTR R9,0 R9=NUMBER OF FULL YEARS SINCE 1/1/01 01817000
* N.B. - THE ABOVE WOULD NEVER DO FOR THE YEAR 1900. 01818000
SR R8,R8 CLEAR TOP HALF OF DIV FOR IMPENDING 01819000
D R8,F4 R9=LEAP DYS SINCE 1/1/00 IN PAST YRS 01820000
ALR R7,R9 R9=TOTAL DAYS TO START OF THIS YEAR 01821000
CL R8,F3 IS THIS YEAR A LEAP YEAR? 01822000
BNE TODSNORM NOPE-DON'T MESS WITH ANOTHER LEAP DA 01823000
CL R5,F300 IS MMDD PAST FEBRUARY? 01824000
BNH TODSNORM NOPE - DON'T ADD THE LEAP DAY 01825000
LA R7,1(R7) INCLUDE THIS YEAR'S LEAP DAY NOW 01826000
TODSNORM EQU * 01827000
SR R4,R4 CLEAR TOP HALF OF DIV FOR IMPENDING 01828000
D R4,F100 R4=DD PART, R5=MM PART 01829000
ALR R5,R5 DOUBLE MON NUM AS INDEX TO HW TABLE 01830000
LH R8,PERMONTH-2(R5) R8=DAYS IN THIS YEAR'S PAST MONTHS 01831000
BCTR R4,0 R4=NUM OF FULL DYS PAST IN THIS MON 01832000
ALR R8,R4 R8=TOTAL DAY COUNT INCLUD THIS MONTH 01833000
ALR R7,R8 R7=TOTAL DAYS SINCE 1/1/00 01834000
LA R3,FIRSTDAY(R7) NORMALIZE DAY COUNT FOR WEEKDAY COMP 01835000
SPACE 01836000
FIRSTDAY EQU 1 - JANUARY 1, 1900, WAS A MONDAY 01837000
SPACE 01838000
SR R2,R2 CLEAR TOP HALF OF DIV FOR IMPENDING 01839000
D R2,F7 R2=DAY OF WEEK (0-6) 01840000
LA R9,4 R9=HALF LEN OF ENTRY IN TIMEZONE TAB 01841000
LCR R9,R9 R9=STANDARD (-) VS. DAYLIGHT (+) IND 01842000
LA R4,2*4 R4=DISP TO APRIL IN PERMONTH TABLE 01843000
CLR R5,R4 FIND THIS MONTH'S RELATIONSHP TO APR 01844000
BL TODSTIME BEFORE - STANDARD TIME IND SET O.K. 01845000
BE TODSLOOK EQUAL - MUST LOOK CLOSELY 01846000
LA R4,2*10 R4=DISP TO OCTOBER IN PERMONTH TAB 01847000
CLR R5,R4 FINDTHIS MONTH'S RELATIONSHIP TO OCT 01848000
BH TODSTIME AFTER - STAN TIME INDICATOR SET O.K 01849000
BL TODSFLIP BEFORE - DAYLIGHT TIME - REVERSE IND 01850000
LCR R9,R9 REV IND TO ASUME DAYLITE FOR NOW 01851000
TODSLOOK EQU * 01852000
LH R4,PERMONTH(R5) R4=DAYS IN YEAR THROUGH END OF MONTH 01853000
SLR R4,8 R4=NUM OF DAYS REMNING IN THIS MON 01854000
S R4,F7 IS THIS THE LAST WEEK OF THE MONTH? 01855000
BNM TODSTIME NOPE - INDICATOR PROPERLY SET AS IS 01856000
LPR R4,R4 R4=NUM OF DYS SHORT OF A WEEK IN MON 01857000
CLR R2,R4 HAS THE LAST SUN OF THE MON GONE BY? 01858000
BNL TODSTIME NOPE - INDICATOR PROPERLY SET AS IS 01859000
LTR R2,R2 WELL, IS THIS SUNDAY? 01860000
BNZ TODSFLIP NOPE - LAST SUNDAY PASSED - REV IND 01861000
CLI HHMMSS,X'02' ARE WE ON NEW OR OLD TIME? 01862000
* THIS ASSUMES THAT ALL SPECIFICATIONS OF TIMES BETWEEN 01863000
* 1:00:00 A.M. AND 1:59:59 A.M. ON THE LAST SUNDAY OF 01864000
* OCTOBER WILL BE DAYLIGHT TIMES. 01865000
BL TODSTIME STILL ON OLD TIME - LEAVE IND AS IS 01866000
TODSFLIP EQU * 01867000
LCR R9,R9 REV THE STANDARD-DAYLIGHT TIME IND 01868000
TODSTIME EQU * 01869000
MVC TODSDWD(8),PL8ZERO SET EIGHT BYTE PACKED DECIMAL ZERO 01870000
MVO TODSDWD(8),HHMMSS(3) MAKE TIME GENUINE PACKED DECIMAL 01871000
CVB R5,TODSDWD R5=HEX REPRESENTATION OF HHMMSS 01872000
SR R4,R4 CLEAR TOP HALF OF DIV FOR IMPENDING 01873000
D R4,F100 R4=SS PART, R5=HHMM PART 01874000
LR R8,R4 SAVE NUM OF SECONDS PAST MIN IN R8 01875000
SR R4,R4 CLEAR RR4 AGAIN FOR IMPENDING DIVIDE 01876000
D R4,F100 R4=MM PART, R5=HH PART 01877000
LA R6,AXSZONE+4 R4=ADDR OF MIDDLE OF STANDARD ENTRY 01878000
ALR R9,R6 R9=ADDR OF PROP ENT (DAYLIGHT OR STA 01879000
SH R4,0(R9) R4=MINUTES ADJUSTED TO G.M.T. 01880000
LR R3,R4 SAVE ADJUSTED MIN IN R3 THROUGH MULT 01881000
M R4,F60 R5=NUM OF MINUTES IN THE FULL HOURS 01882000
ALR R5,R3 R5=TOTAL NUMBER OF FULL MINUTES 01883000
M R4,F60 R4,5=NUM OF SECONDS IN FULL MIN 01884000
ALR R5,R8 R5=LOW HALF OF TOTAL SEC SIN STA OF 01885000
* THE ABOVE QUANTITY REFERS TO THE START OF DAY AT THE G.M.T. 01886000
* ZONE, AND SO IT MAY BE NEGATIVE IF LOCAL TIME ZONE IS EAST 01887000
* OF THE INTERNATIONAL DATE LINE AND WEST OF THE G.M.T. ZONE. 01888000
BC 12,TODSFIT1 (NO CARRY) SKIP ADDITION OF THE CARRY 01889000
LA R4,1(R4) ADD IN THE CARRY TO THE 6R4 BIT ACCU 01890000
TODSFIT1 EQU * 01891000
M R6,F86400 R6,7=SEC IN FULL DAYS SINCE 1/1/00 01892000
ALR R6,R4 ADD IN TOP HALF OF SEC IN THIS DAY 01893000
ALR R7,R5 ADD IN BOT HALF OF SEC IN THIS DAY 01894000
BC 12,TODSFIT2 (NO CARRY) SKIP ADDITION OF THE CARR 01895000
LA R6,1(R6) ADD IN THE CARRY WHEN APPROPRIATE 01896000
TODSFIT2 EQU * REGS.6,7=TOTAL SECONDS SINCE 1/1/00 01897000
SLDL R6,1 MOVE BIT 32 OF TOTAL TO TOP REGISTER 01898000
SRL R7,1 MAKE LOW-ORDER 31 BITS POSITIVE 01899000
LR R5,R6 R5=HIGH ORDER PART OF ACCUMULATION 01900000
M R4,F500000 R5=MICROSECONDS IN HIGH HALF 01901000
M R6,F1000000 REGS.6,7=MICROSECONDS IN LOW HALF 01902000
ALR R6,R5 R6=TRUE HIGH HALF OF MICROSECONDS 01903000
SLDL R6,12 SHIFT TO GENERATE TRUE S/370 TOD 01904000
LR R0,R6 SET RETURN R0 TO HIGH ORDER HALF 01905000
LR R1,R7 SET RETURN R1 TO LOW ORDER HALF 01906000
LM R2,R9,TODSSAVE RESTORE CALLER'S REGISTERS 01907000
BR R14 AND RETURN WITH THE CONVERTED TIME 01908000
EJECT 01909000
PERMONTH DC Y(0*31+0*28+0*30,1*31+0*28+0*30,1*31+1*28+0*30) J,F,M 01910000
DC Y(2*31+1*28+0*30,2*31+1*28+1*30,3*31+1*28+1*30) A,M,J 01911000
DC Y(3*31+1*28+2*30,4*31+1*28+2*30,5*31+1*28+2*30) J,A,S 01912000
DC Y(5*31+1*28+3*30,6*31+1*28+3*30,6*31+1*28+4*30) O,N,D. 01913000
SPACE 01914000
DECDIGIT DC 240C'0',C'0123456789000000' 01915000
SPACE 01916000
TODSDWD DC D'0' DOUBLEWORD UTILITY WORK AREA 01917000
MMDDYY DC F'0' SAVE AREA FOR DECIMAL DATE 01918000
HHMMSS DC F'0' SAVE AREA FOR DECIMAL TIME 01919000
TODSSAVE DC 8F'0' SAVE AREA FOR CALL GENERAL REG 01920000
EJECT 01921000
*. 01922000
* 01923000
* ENTRY NAME - 01924000
* 01925000
* TODEBCD 01926000
* 01927000
* FUNCTION - 01928000
* 01929000
* CONVERT S/370 TOD TO EBCDIC DATE AND TIME 01930000
* 01931000
* CALLS TO OTHER ROUTINES - 01932000
* 01933000
* GTODEBCD - TO CONVERT THE TIME AND DATE 01934000
* 01935000
* OPERATION - 01936000
* 01937000
* 1. SAVE REGISTERS 01938000
* 01939000
* 2. ISSUE CALL TO SUPERVISOR ROUTINE FOR TIME CONVERSION 01940000
* 01941000
* 3. RESTORE REGISTERS AND RETURN. 01942000
* 01943000
* RESPONSES - 01944000
* 01945000
* NONE 01946000
* 01947000
* ERROR MESSAGES - 01948000
* 01949000
* NONE 01950000
* 01951000
*. 01952000
SPACE 01953000
TODEBCD DC 0H'0' 01954000
STM R13,R14,TODSAVE1 SAVE RETURN 01955000
LA R13,MMDDYYHH GET WORK ADDR ADDR FOR CALL 01956000
L R15,TCOM GET COMMON ROUTINE ADDR 01957000
L R15,GTODEBCD AND THE TIME CONVERT ADDR 01958000
BALR R14,R15 AND DO IT 01959000
LM R13,R14,TODSAVE1 RESTORE REGS 01960000
BR R14 AND RETURN 01961000
SPACE 01962000
MMDDYYHH DC D'0' HOLD NEW HOUR CALCULATION IN DEC 01963000
DC D'0' APPENDING MMDDYYHH TO MMSSMMMM 01964000
MMSSMMMM DC D'0' RECEIVE DEC MIN AND SEC 01965000
DAYNUMBR DC A(0) RECEIVE COMPUTED DAY OF WEEK 0->6 01966000
TODEBCON DC F'-1',A(0+4,AXSZONE+4) SEE BELOW 01967000
* DC F'-1' TO HOLD LAST CALCULATION ELAPSED HOURS 01968000
* DC A(0+4) SWITCH, USED AS AN INDEX, FOR STD VS. DLT TIME 01969000
* DC A(AXSZONE+4) EXTERNAL ADDRESS OF TIMEZONE DISP TABLE 01970000
TODSAVE DC 11F'0' TODEBCD ROUTINE SAVE AREA 01971000
SPACE 01972000
TODSAVE1 DC 2F'0' SAVE AREA 01973000
EJECT 01974000
*. 01975000
* 01976000
* ENTRY NAME - 01977000
* 01978000
* GSUCCESS 01979000
* 01980000
* FUNCTION - 01981000
* 01982000
* GET INACTIVE SUCCESSOR SPOOL FILE 01983000
* 01984000
* CALLS TO OTHER ROUTINES - 01985000
* 01986000
* DMTDRD - VIA DIAG 14 TO ISSUE SUCCESSOR SUBCODE 01987000
* 01988000
* ENTRY: 01989000
* 01990000
* R1=FILE ID OF PREDECESSOR FILE 01991000
* 01992000
* EXIT: 01993000
* 01994000
* COND CODE SET AS VM/370 SUCCESSOR FUNCTION 01995000
* 01996000
* OPERATION - 01997000
* 01998000
* 1. SAVE PREDESSOR FILE ID 01999000
* 02000000
* 2. ISSUE SUCCESSOR DIAG 02001000
* 02002000
* 3. IF NON OPEN FILE FOUND EXIT 02003000
* 02004000
* RESPONSES - 02005000
* 02006000
* NONE 02007000
* 02008000
* ERROR MESSAGES - 02009000
* 02010000
* NONE 02011000
* 02012000
*. 02013000
SPACE 2 02014000
GSUCCESS DC 0H'0' 02015000
USING SFBLOK,R1 GET SFBLOK ADDRESSABILITY 02016000
STM R1,R3,GSUCSAVE SAVE CALLER'S REGISTER CONTENTS 02017000
STH R1,AXSPREDC SAVE ID OF PREDECESSOR 02018000
LR R2,R1 R2=PREDECESSOR FILE ID NUMBER 02019000
LA R1,AXSSFB R1=BUFF ADDR FOR READ OF SFB AND TAG 02020000
LA R3,X'FFF' R3=SUBCODE FOR SUCCESSOR FUNCTION 02021000
GSUCNEXT EQU * 02022000
DIAG R1,R2,X'14' REQUEST FILE SUCCESSOR DESCRIPTOR 02023000
BC 7,GSUCEXIT QUIT IF NOTHING GOTTEN 02024000
TM SFBFLAG,SFBINUSE IS THIS FILE OPEN? 02025000
BZ GSUCEXIT NOPE - ALL DONE - EXIT 02026000
LH R2,SFBFILID R2=NEW PREDECESSOR ID 02027000
B GSUCNEXT AND GO TRY FOR ANOTHER 02028000
SPACE 02029000
GSUCEXIT EQU * 02030000
LM R1,R3,GSUCSAVE RESTORE CALLER'S REGISTER CONTENTS 02031000
BR R14 AND RETURN TO THE CALLER 02032000
SPACE 02033000
GSUCSAVE DC 3F'0' 02034000
SPACE 02035000
DROP R1 02036000
EJECT 02037000
*. 02038000
* 02039000
* ENTRY NAME - 02040000
* 02041000
* ACCEPT 02042000
* 02043000
* FUNCTION - 02044000
* 02045000
* INSPECT NEWLY ARRIVED FILES 02046000
* 02047000
* CALLS TO OTHER ROUTINES - 02048000
* 02049000
* NONE 02050000
* 02051000
* OPERATION - 02052000
* 02053000
* 1. SAVE PENDING COUNT FOR EACH LINK 02054000
* 02055000
* 2. SCAN FILE QUEUE 02056000
* 02057000
* 3. ENQUEUE THE FILES 02058000
* 02059000
* 4. COUNT FILES AS PENDING IF NO SLOTS ARE LEFT 02060000
* 02061000
* RESPONSES - 02062000
* 02063000
* DMTAXS101I FILE 'SPOOLID' ENQUEUED ON LINK 'LINKID' 02064000
* DMTAXS102I FILE 'SPOOLID' PENDING FOR LINK 'LINKID' 02065000
* 02066000
* ERROR MESSAGES - 02067000
* 02068000
* DMTAXS103E FILE 'SPOOLID' REJECTED -- INVALID DESTINATION 02069000
* ADDRESS 02070000
* 02071000
*. 02072000
SPACE 2 02073000
ACCEPT DC 0H'0' 02074000
USING SFBLOK,R6 GET SFBLOK ADDRESSABILITY 02075000
USING ROUTE,R1 GET ROUTABLE ADDRESSABILITY 02076000
STM R14,R6,ACCESAVE SAVE CALLER'S REGISTER CONTENTS 02077000
LH R1,AXSRDR AXS CONTROL RDR ADDR 02078000
BAL R14,VCLOSEH CLOSE TO CLEAR FLAGS IN VM 02079000
LA R6,AXSSFB GET OUR SFBLOCK ADDR 02080000
SPACE 02081000
L R8,TLINKS START OF LINK TABLE SECTION 02082000
L R1,0(R8) COUNT OF LINK TABLE ENTRIES 02083000
BCTR R1,0 DON'T COUNT LOCAL ENTRY 02084000
LTR R1,R1 ANY OTHERS LEFT? 02085000
BNP ACCEEXIT NO - CAN'T DO ANY ACCEPTING 02086000
LA R8,8(R8) ADDR OF LOCAL LINK TABLE 02087000
ACCESCAN EQU * 02088000
LA R8,LINKLEN(R8) ADDR OF NEXT LINK TABLE ENTRY 02089000
MVC LSPARE(2),LPENDING SAVE OLD PENDING COUNT 02090000
XC LPENDING(2),LPENDING CLEAR PENDING COUNT 02091000
BCT R1,ACCESCAN DO ALL LINK TABLE ENTRIES 02092000
SR R1,R1 START AT HEAD OF INPUT QUEUE 02093000
ACCEBUMP EQU * 02094000
BAL R14,GSUCCESS GET THE NEXT SFB+TAG IN THE SPOOL Q 02095000
BC 5,ACCEEXIT END OF QUEUE - DONE 02096000
BC 2,ACCEREDO FILE DISAPPEARED - NUTS 02097000
LH R1,SFBFILID GET THE FILID ADDRESS 02098000
BAL R14,TAGFIND ALREADY HAVE IT? 02099000
BC 8,ACCEBUMP YES - LOOK MORE 02100000
MVC AXSMSGVM(8),SFBORIG MOVE USERID INTO MSG 02101000
BAL R14,TAGSETUP SET REGS 3 AND 5 FOR PARM SCAN 02102000
BC 7,ACCEPURG NO TAG - GET RID OF IT 02103000
BAL R14,PARMGET GET THE FIRST TAG DATA PARAMETER 02104000
CLR R3,R5 WAS THERE ONE SPECIFIED? 02105000
BNL ACCEPURG NO - PURGE FILE AND TRY ANOTHER 02106000
SLR R4,R3 R4=CHAR COUNT OF FIRST PARAMETER 02107000
CL R4,AXSLIMIT IS IT TOO LONG? 02108000
BH ACCEPURG YES - DISCARD IT 02109000
BAL R14,GETROUTE SEE IF THERE IS AN INDIRECT ROUTE INDICATED 02110000
BZ ACCENORT THERE IS NOT - USE DEST AS LINK 02111000
MVC ACCELINK(8),ROUTNEXT MOVE IN THE APPROPRIATE LINK ID 02112000
B ACCEFIND AND GO GET A LINK TABLE ENTRY 02113000
SPACE 02114000
ACCENORT EQU * 02115000
MVC ACCELINK(8),AXSBLANK BLANK WORK FIELD 02116000
BCTR R4,0 DECREMENT FOR EX MVC 02117000
EX R4,ACCEMOVE MOVE IN THE DESTINATION AS THE LINK 02118000
ACCEFIND EQU * 02119000
LA R3,ACCELINK R3=ADDR OF START OF LINK ID FIELD 02120000
LA R4,8 R4=CHAR COUNT OF THE LINK ID 02121000
BAL R14,GETLINK GET A LINK TABLE ENTRY 02122000
BC 7,ACCEPURG NO LINK - PURGE THE FILE 02123000
BAL R14,GETSLOT TRY FOR A SLOT FOR THE NEW TAG 02124000
BZ ACCEPEND NO SLOT AVAILABLE-SET FILE AS PEND 02125000
BAL R14,TAGGEN OTHERWISE, GEN A TAG IN THE SLOT 02126000
BAL R14,TAGPLACE PUT THE NEW TAG IN THE LINK QUEUE 02127000
TM LFLAG,LACTIVE+LALERT GIVE DRIVER AN ALERT? 02128000
BNO ACCENEXT NOPE - DO NEXT 02129000
NI LFLAG,X'FF'-LALERT RESET ASYNCH FLAG 02130000
L R0,LACTTNME GET TASK NAME 02131000
L R15,ALERTREQ R15=ALERT SERVICE ENTRY 02132000
BALR R14,R15 REQUEST AN ALERT FOR WAITING TASK 02133000
ACCENEXT EQU * 02134000
LH R1,SFBFILID R1=FILE ID FOR LAST FILE 02135000
B ACCEBUMP LOOK AT NEXT FILE IF ANY 02136000
SPACE 02137000
ACCEEXIT EQU * 02138000
LM R14,R6,ACCESAVE RESTORE CALLER'S REGISTER CONTENTS 02139000
BR R14 AND RETURN TO THE CALLER 02140000
EJECT 02141000
ACCEPEND EQU * 02142000
LH R1,LPENDING R1=COUNT OF PREVIOUSLY PENDING FILES 02143000
LA R1,1(R1) BMP UP ONE FOR THE NEW ONE JUST SEEN 02144000
STH R1,LPENDING AND STORE THE NEW COUNT BACK 02145000
CLC LPENDING(2),LSPARE DOES THIS LOOK LIKE A NEW ONE? 02146000
BNH ACCENEXT NO MSG IF NOT 02147000
LH R1,SFBFILID SPOOL FILE ID FOR MSG 02148000
BAL R14,AXSM102 ISSUE PENDING MSG 02149000
B ACCENEXT GO GET ANOTHER NEW FILE 02150000
SPACE 02151000
ACCEPURG EQU * 02152000
LH R1,SFBFILID LAST FILE ID 02153000
BAL R14,VPURGE PURGE IT FROM VM/370 02154000
BAL R14,AXSM103 ISSUE PURGED MSG 02155000
LH R1,AXSPREDC BACK TO PREVIOUS ID 02156000
B ACCENEXT AND DO ANOTHER FILE 02157000
SPACE 02158000
ACCEREDO EQU * 02159000
L R8,TLINKS START OF LINK TABLE SECTION 02160000
L R1,0(R8) COUNT OF LINK TABLE ENTRIES 02161000
BCTR R1,0 DON'T COUNT FIRST 02162000
LA R8,8(R8) POINT AT FIRST (LOCAL) ENTRY 02163000
ACCERESC EQU * 02164000
LA R8,LINKLEN(R8) ADDR OF NEXT LINK TABLE ENTRY 02165000
XC LPENDING(2),LPENDING CLEAR PARTIAL PENDING COUNT 02166000
BCT R1,ACCERESC DO ALL TABLE ENTRIES 02167000
SR R1,R1 SET TO START AT BEGINNING OF QUEUE 02168000
B ACCEBUMP LOOK AT THE FIRST FILE 02169000
SPACE 02170000
ACCEMOVE MVC ACCELINK(0),0(R3) DEST TO LINK ID - TO BE EXECUTED 02171000
SPACE 2 02172000
ACCESAVE DC 9F'0' ACCEPT ROUTINE SAVE AREA 02173000
SPACE 02174000
ACCELINK DC CL8' ' FIELD FOR ACCEPT LINK ID 02175000
EJECT 02176000
*. 02177000
* 02178000
* ENTRY NAME - 02179000
* 02180000
* UNPEND 02181000
* 02182000
* FUNCTION - 02183000
* 02184000
* BRING IN A LINK'S PENDING TAGS 02185000
* 02186000
* CALLS TO OTHER ROUTINES - 02187000
* 02188000
* NONE 02189000
* 02190000
* ENTRY: 02191000
* 02192000
* R8=LINK TABLE ENTRY ADDRESS 02193000
* 02194000
* OPERATION - 02195000
* 02196000
* 1. SCAN THROUGH THE FILE QUEUE BRINGING IN THE 02197000
* SPECIFIED LINKS FILE TAGS 02198000
* 02199000
* 2. PLACE THE TAG ON THE TAQ QUEUE 02200000
* 02201000
* 3. UPDATE THE PENDING COUNT 02202000
* 02203000
* RESPONSES - 02204000
* 02205000
* DMTAXS107I NN PENDING FILES FOR LINK 'LINKID' MISSING 02206000
* 02207000
* ERROR MESSAGES - 02208000
* 02209000
* NONE 02210000
* 02211000
*. 02212000
SPACE 2 02213000
UNPEND DC 0H'0' 02214000
OC LPENDING(2),LPENDING ARE ANY FILES PENDING? 02215000
BCR 8,R14 (BZ) NOTH PEND - EASY COMPLETION 02216000
STM R14,R7,UNPESAVE OTHERWISE, SAVE CALLER'S REG CONTEN 02217000
LA R6,AXSSFB GET OUR SFB ADDRESS 02218000
SR R7,R7 INITIALIZE UNPEND COUNT 02219000
UNPEREDO EQU * 02220000
XC SFBFILID(2),SFBFILID CLEAR FILE ID 02221000
UNPESFB EQU * 02222000
LH R1,SFBFILID R1=ID OF LAST GOTTEN SFB 02223000
BAL R14,GSUCCESS GET THE NEXT INACTIVE FILE IN THE Q 02224000
BC 5,UNPECHEK THAT'S THE END OF THE LINE 02225000
BC 2,UNPEREDO FILE DISAPPEARED - RESTART 02226000
MVI UNPEDEST,C' ' BLANK THE FIRST DEST ID CHARACTER 02227000
MVC UNPEDEST+1(7),UNPEDEST BLANK THE ENTIRE FIELD 02228000
BAL R14,TAGSETUP SET REGS 3 AND 5 FOR TAG PARM SCAN 02229000
BAL R14,PARMGET LOCATE THE FIRST TAG DATA PARAMETER 02230000
CLR R3,R5 WAS THERE A PARAMETER THERE? 02231000
BNL UNPENOID NOPE - DON'T MESS WITH IT 02232000
SLR R4,R3 R4=PARAMETER CHARACTER COUNT 02233000
CL R4,F8 IS THE LENGTH ACCEPTABLE? 02234000
BNH UNPEOK YEP - LEAVE IT ALONE AS IT STANDS 02235000
LA R4,8 OTHERWISE, TRUNCATE IT AT MAX COUNT 02236000
UNPEOK EQU * 02237000
BCTR R4,0 BUMP CNT DOWN ONE FOR CHARACTER OP 02238000
EX R4,UNPEMOVE MOVE THE DEST ID INTO OUR FIELD 02239000
UNPENOID EQU * 02240000
CLC LINKID(8),UNPEDEST IS THIS DEFINITELY ONE OF OURS? 02241000
BE UNPESCAN YEP - GO SEE IF IT IS ALREADY IN 02242000
LA R4,1(R4) RESTORE DEST ID COUNT TO EXACTITUDE 02243000
BAL R14,GETROUTE SEE IF FILE IS ROUTED ON THIS LINK 02244000
BZ UNPESFB THIS IS DEFINITELY NOT OURS 02245000
CLC LINKID(8),ROUTNEXT IS IT FOR THIS LINK? 02246000
BNE UNPESFB NOPE - NOT OURS - GO GET ANOTHER ONE 02247000
B UNPESFB IGNORE THE FILE AND TRY ANOTHER 02248000
UNPESCAN EQU * 02249000
LH R1,SFBFILID GET NEW FILE ID 02250000
BAL R14,TAGFIND DO WE HAVE IT ALREADY? 02251000
BC 8,UNPESFB YEP - GET THE NEXT 02252000
BAL R14,GETSLOT TRY TO GET A FREE TAG SLOT 02253000
BZ UNPEFINI NONE AVAILABLE - ALL DONE 02254000
* R2 NOW HOLDS THE NEW TAG SLOT ADDRESS 02255000
BAL R14,TAGGEN BUILD A NEW TAG IN THE GOTTEN SLOT 02256000
BAL R14,TAGPLACE ENQUEUE THE TAG ON ITS LINK 02257000
LA R7,1(R7) INCREMENT ACCEPT COUNT 02258000
B UNPESFB AND GET NEXT FILE 02259000
SPACE 02260000
UNPECHEK EQU * 02261000
LH R1,LPENDING OLD PENDING COUNT 02262000
XC LPENDING(2),LPENDING CLEAR PENDING COUNT 02263000
SR R1,R7 REMAINING PENDING 02264000
BZ UNPEEXIT NONE - ALL SET 02265000
BAL R14,AXSM107 ISSUE NN PENDING MSG 02266000
B UNPEEXIT AND RETURN 02267000
UNPEFINI EQU * 02268000
LH R1,LPENDING OLD PENDING FILE COUNT 02269000
SR R1,R7 NEW PENDING FILE COUNT 02270000
STH R1,LPENDING SET NEW PEND COUNT IN LINK 02271000
UNPEEXIT EQU * 02272000
LM R14,R7,UNPESAVE RESTORE CALLER'S REGISTER CONTENTS 02273000
BR R14 AND RETURN TO THE CALLER 02274000
SPACE 02275000
UNPEMOVE MVC UNPEDEST(0),0(R3) JUSTIFY THE DEST ID - TO BE EXECUTED 02276000
SPACE 02277000
UNPESAVE DC 10F'0' UNPEND ROUTINE SAVE AREA 02278000
SPACE 02279000
UNPEDEST DC CL8' ' WORK AREA FOR DEST ID 02280000
EJECT 02281000
*. 02282000
* 02283000
* ENTRY NAME - 02284000
* 02285000
* GETROUTE 02286000
* 02287000
* FUNCTION - 02288000
* 02289000
* GET A ROUTING TABLE ENTRY 02290000
* 02291000
* CALLS TO OTHER ROUTINES - 02292000
* 02293000
* NONE 02294000
* 02295000
* OPERATION - 02296000
* 02297000
* 1. SCAN THE ROUTING TABLE TO A MATCH ON THE 02298000
* SUPPLIED LINKID. 02299000
* 02300000
* 2. IF FOUND RETURN WITH THE NEXT LOGICAL 02301000
* DESTINATION LINKID. 02302000
* 02303000
* RESPONSES - 02304000
* 02305000
* NONE 02306000
* 02307000
* ERROR MESSAGES - 02308000
* 02309000
* NONE 02310000
* 02311000
*. 02312000
SPACE 2 02313000
GETROUTE DC 0H'0' 02314000
LTR R4,R4 IS THE COUNT GREATER THAN ZERO? 02315000
BZ GETRMISS NOPE-CAN'T FIND ANY ENTRY LIKE THAT 02316000
MVI ROUTWANT+1,C' ' BLANK SEC CHAR OF THE GET ID FIELD 02317000
MVC ROUTWANT+2(6),ROUTWANT+1 BLANK REMAINDER OF THE FIELD 02318000
BCTR R4,0 DECREMENT THE COUNT FOR A CHAR OP 02319000
EX R4,GETRMOVE MOVE THE REQ ID TO THE GET ID FIELD 02320000
LA R4,1(R4) AND PUT THE CNT BACK THE WAY IT WAS 02321000
SPACE 02322000
L R15,TROUTE GET ROUTABLE ADDR 02323000
LA R1,ROUTSIZE-8(R15) AND ONE LESS THAN THE START 02324000
L R15,0(R15) AND THE NUMBER OF ENTRIES 02325000
GETRNEXT EQU * 02326000
LA R1,ROUTSIZE(R1) BUMP TO THE NEXT ENTRY 02327000
CLC ROUTWANT(8),ROUTDEST IS THIS THE DESIRED ENTRY? 02328000
BE GETRHIT YEP - GIVE IT BACK TO THE CALLER 02329000
BCT R15,GETRNEXT AND TRY THE NEXT 02330000
GETRMISS EQU * 02331000
SR R1,R1 CLEAR RET ROUTING TABLE ENTRY ADDRES 02332000
GETRHIT EQU * 02333000
LTR R1,R1 SET THE RETURN CONDITION CODE 02334000
BR R14 AND RETURN TO THE CALLER 02335000
SPACE 02336000
GETRMOVE MVC ROUTWANT(0),0(R3) MOVE IN REQ ID - EXECUTED ABOVE 02337000
EJECT 02338000
*. 02339000
* 02340000
* ENTRY NAME - 02341000
* 02342000
* GETLINK 02343000
* 02344000
* FUNCTION - 02345000
* 02346000
* GET LINK TABLE ENTRY 02347000
* 02348000
* CALLS TO OTHER ROUTINES - 02349000
* 02350000
* GLINKREQ - SUPERVISOR LINK TABLE SCAN ROUTINE 02351000
* 02352000
* OPERATION - 02353000
* 02354000
* 1. SETUP REGISTERS FOR GLINKREQ 02355000
* 02356000
* 2. BALR TO GLINKREQ 02357000
* 02358000
* 3. RESTORE REGS AND RETURN 02359000
* 02360000
* RESPONSES - 02361000
* 02362000
* NONE 02363000
* 02364000
* ERROR MESSAGES - 02365000
* 02366000
* NONE 02367000
* 02368000
*. 02369000
SPACE 2 02370000
GETLSAVE DC 7F'0' SAVE AREA 02371000
SPACE 2 02372000
GETLINK DC 0H'0' 02373000
STM R14,R4,GETLSAVE SAVE REGISTERS 02374000
LR R0,R4 GET THE LENGTH 02375000
LR R1,R3 AND THE PTR 02376000
LA R13,AXSCSAVE GET SAVE AREA ADDR 02377000
L R15,TCOM GET COMMON ROUTINE VECTOR 02378000
L R15,GLINKREQ AND THE GETLINK ENTRY 02379000
BALR R14,R15 GO TRY FIND IT 02380000
L R14,TLINKS GET START OF LINK TABLE CHAI @VA03308 02380010
LA R14,8(R14) POINT TO LOCAL LINK TABLE @VA03308 02380020
CLR R14,R1 DO WE POINT TO LOCAL @VA03308 02380030
BNE GETLINK1 NO-EVERYTHING OKAY @VA03308 02380040
LA R15,X'10' INDICATE ERROR @VA03308 02380050
GETLINK1 EQU * @VA03308 02380060
L R14,GETLSAVE RESTORE THE RETURN REG 02381000
LR R8,R1 SET LINK ADDR 02382000
LM R0,R4,GETLSAVE+8 RESTORE THE REST 02383000
LTR R15,R15 SET RETURN CONDITION CODE 02384000
BR R14 AND RETURN 02385000
EJECT 02386000
*. 02387000
* 02388000
* ENTRY NAME - 02389000
* 02390000
* GETSLOT 02391000
* 02392000
* FUNCTION - 02393000
* 02394000
* GET A FREE TAG QUEUE ELEMENT 02395000
* 02396000
* CALLS TO OTHER ROUTINES - 02397000
* 02398000
* NONE 02399000
* 02400000
* OPERATION - 02401000
* 02402000
* 1. CHECK TO SEE IF THIS LINK IS OVER HIS ALLOTED 02403000
* SLOTS OR ANY FREE SLOTS LEFT 02404000
* 02405000
* 2. IF SLOT IS AVAILABLE DEQUEUE IT AND RETURN 02406000
* ITS ADDRESS 02407000
* 02408000
* RESPONSES - 02409000
* 02410000
* NONE 02411000
* 02412000
* ERROR MESSAGES - 02413000
* 02414000
* NONE 02415000
* 02416000
*. 02417000
SPACE 2 02418000
GETSLOT DC 0H'0' 02419000
CLC LRESERVD(2),LTAKEN IS LINK BEYOND RESERVED SLOTS? 02420000
BNH GETSTEST YES-DON'T DECREMENT OVERALL HOLD CNT 02421000
LH R2,TAGAHOLD R2=CURRENT OVERALL HOLD COUNT 02422000
BCTR R2,0 BUMP DOWN 1 FOR RESV SLOT TO BE GOT 02423000
STH R2,TAGAHOLD AND STORE IT BACK FOR FUTURE REF 02424000
GETSGET EQU * 02425000
LH R2,LTAKEN R2=CNT OF TAKEN SLOTS FOR THIS LINK 02426000
LA R2,1(R2) ADD ONE FOR THIS ONE TO BE GOTTEN 02427000
STH R2,LTAKEN STORE THE CNT BACK FOR FUTURE REF 02428000
LH R2,TAGAGOT R2=OLD FREE SLOT COUNT 02429000
BCTR R2,0 DEC THE COUNT 1 FOR THE GOTTEN SLOT 02430000
STH R2,TAGAGOT AND STORE THE UPDATED COUNT BACK 02431000
L R2,TAGAFREE R2=ADDRESS OF A FREE LINK Q ELEMENT 02432000
MVC TAGAFREE(4),TAGNEXT DEQUEUE THE FREE QUEUE ELEMENT 02433000
GETSEXIT EQU * 02434000
LTR R2,R2 SET THE RETURN CONDITION CODE 02435000
BR R14 AND RETURN TO THE CALLER 02436000
EJECT 02437000
GETSTEST EQU * 02438000
SR R2,R2 CLEAR THE RET ELEM ADDR JUST IN CASE 02439000
CLC TAGAGOT(2),TAGAHOLD CAN WE GIVE THE LINK A FREE SLOT? 02440000
BH GETSGET YEP-STILL HAVE SOME SPARES-GIVE ON 02441000
B GETSEXIT OTHERWISE WE MUST DECLINE 02442000
EJECT 02443000
*. 02444000
* 02445000
* ENTRY NAME - 02446000
* 02447000
* FREESLOT 02448000
* 02449000
* FUNCTION - 02450000
* 02451000
* RETURN A TAQ QUEUE ELEMENT 02452000
* 02453000
* CALLS TO OTHER ROUTINES - 02454000
* 02455000
* NONE 02456000
* 02457000
* OPERATION - 02458000
* 02459000
* 1. QUEUE THE SLOT TO THE FREE CHAIN 02460000
* 02461000
* 2. UPDATE SLOT TAKEN AND HELD COUNTS 02462000
* 02463000
* 3. UPDATE PENDING FILE STATUS 02464000
* 02465000
* RESPONSES - 02466000
* 02467000
* NONE 02468000
* 02469000
* ERROR MESSAGES - 02470000
* 02471000
* NONE 02472000
* 02473000
*. 02474000
SPACE 2 02475000
FREESLOT DC 0H'0' 02476000
MVC TAGNEXT(4),TAGAFREE CHAIN THE FREE QUEUE TO ELEMENT 02477000
ST R2,TAGAFREE MAKE THE ELEM FIRST ON THE FREE Q 02478000
LH R2,TAGAGOT R2=OLD COUNT OF AVAILABLE SLOTS 02479000
LA R2,1(R2) ADD ONE FOR THE NEWLY FREED Q ELEM 02480000
STH R2,TAGAGOT STORE THE COUNT BACK FOR FUTURE REF 02481000
LH R2,LTAKEN R2=COUNT OF SLOTS ALLOCATED TO LINK 02482000
BCTR R2,0 DEC THE CNT FOR THE NEWLY FREED ELEM 02483000
STH R2,LTAKEN AND SET THE COUNT BACK AGAIN 02484000
CH R2,LRESERVD DID WE GET BACK A RESERVED SLOT? 02485000
BNL FREEEXIT NOPE-NO NEED TO DIDDLE THE HOLD COUN 02486000
LH R2,TAGAHOLD R2=OLD COUNT OF ELEMENTS TO BE HELD 02487000
LA R2,1(R2) ADD THIS ONE TO THE TOTAL HOLD COUNT 02488000
STH R2,TAGAHOLD STORE THE NEW CNT FOR FUTURE REF 02489000
FREEEXIT EQU * 02490000
LR R2,R14 SAVE RETURN ADDRESS 02491000
BAL R14,UNPEND MAKE SURE ALL LINKS FILES ARE IN 02492000
LR R14,R2 RESTORE RETURN ADDRESS 02493000
SR R2,R2 CLEAR TAG POINTER REG 02494000
BR R14 AND RETURN TO THE CALLER 02495000
EJECT 02496000
*. 02497000
* 02498000
* ENTRY NAME - 02499000
* 02500000
* TAGGEN 02501000
* 02502000
* FUNCTION - 02503000
* 02504000
* BUILD A FILE TAG FROM HYPERVISOR INFO 02505000
* 02506000
* CALLS TO OTHER ROUTINES - 02507000
* 02508000
* NONE 02509000
* 02510000
* OPERATION - 02511000
* 02512000
* 1. MOVE SFBLOK FIELDS TO TAG ELEMENT 02513000
* 02514000
* 2. SCAN THE TAG AND MOVE FIELDS INTO TAG ELEMENT 02515000
* 02516000
* 3. RETURN TO CALLER 02517000
* 02518000
* RESPONSES - 02519000
* 02520000
* NONE 02521000
* 02522000
* ERROR MESSAGES - 02523000
* 02524000
* NONE 02525000
* 02526000
*. 02527000
SPACE 2 02528000
TAGGEN DC 0H'0' 02529000
STM R14,R9,TAGGSAVE SAVE CALLER'S REGISTER CONTENTS 02530000
LA R6,AXSSFB GET OUR SFB ADDR 02531000
XC TAGBLOCK(4),TAGBLOCK CLEAR THE I/O AREA POINTER 02532000
XC TAGDEV(2),TAGDEV CLEAR VIRT DEV ADDR 02533000
L R15,TLINKS GET LINK TABLE CHAIN 02534000
LA R15,8(R15) AND THE HOST ENTRY 02535000
MVC TAGINLOC(8),LINKID-LINKTABL(R15) SET THIS LOCATION ID 02536000
MVC TAGLINK(8),LINKID SET LINK IDENTIFIER 02537000
LA R1,SFBDATE SET R1 TO POINT TO EBCDIC DATE,TIME 02538000
BAL R14,TODS370 CONV THE DATE,TIME TO S/370 FORMAT 02539000
STM R0,R1,TAGINTOD AND SET THE CREATION TIME IN THE TAG 02540000
MVC TAGINVM(8),SFBORIG SET ORIGINATING VIRT MACHINE 02541000
MVC TAGRECNM(4),SFBRECNO NUMBER OF RECORDS IN FILE 02542000
MVC TAGRECLN(2),SFBRECSZ MAX RECORD DATA LENGTH 02543000
MVC TAGINDEV(1),SFBTYPE ORIGINATING DEVICE TYPE 02544000
MVC TAGCLASS(1),SFBCLAS FILE OUTPUT CLASS 02545000
MVC TAGID(2),SFBFILID FILE ID NUMBER 02546000
MVC TAGCOPY(2),SFBCOPY NUMBER OF COPIES REQUESTED 02547000
MVC TAGNAME(12),SFBFNAME FILE NAME 02548000
MVC TAGTYPE(12),SFBFTYPE FILE TYPE 02549000
MVC TAGDIST(8),SFBDIST DISTRIBUTION CODE 02550000
MVC TAGFLAG(1),SFBFLAG SFB FIRST STATUS FIELD 02551000
MVC TAGFLAG2(1),SFBFLAG2 SFB SECOND STATUS FIELD 02552000
NI TAGFLAG2,X'FF'-SFBREQUE INITIALIZE QUEUEING BIT 02553000
MVC TAGPRIOR(2),=AL2(99) DEFAULT TO LOWEST PRIOR 02554000
SPACE 02555000
MVC TAGTOLOC(8),TAGINLOC DEFAULT TO LOCAL DEST 02556000
MVC TAGTOVM(8),=CL8'SYSTEM' DEFAULT TO 'SYSTEM' VM ID 02557000
SPACE 02558000
LA R3,AXSSPTAG+12 R3=START OF TAG DATA FIELD 02561000
LR R5,R3 R5=ADDR OF START ... 02562000
AH R5,AXSSPTAG+6 R5=ADDR OF END OF TAG DATA FIELD 02563000
BAL R14,PARMGET LOCATE THE FIRST PARAMETER 02564000
CLR R3,R5 WAS THERE ONE SPECIFIED? 02565000
BNL TAGGEXIT NOPE - ALL DONE 02566000
MVC TAGTOLOC(8),AXSBLANK CLEAR FIELD PRIOR TO MVC 02567000
SLR R4,R3 R4=LENGTH OF THE PARAMETER 02568000
CL R4,F8 IS THE LENGTH SUITABLE 02569000
BNH TAGGOK1 YEP - LEAVE IT ALONE 02570000
LA R4,8 OTHERWISE TRUNCATE IT AT MAX LENGTH 02571000
TAGGOK1 EQU * 02572000
BCTR 4,0 BUMP COUNT DOWN ONE FOR CHAR OP 02573000
LA R15,TAGTOLOC SET ADDR OF FIELD TO RECEIVE THE ID 02574000
EX R4,AXSMOVE MOVE THE SPECIFIED DEST ID TO THE TAG 02575000
SPACE 02576000
LA R3,1(R4,R3) R3=ADDR OF STA OF SCAN FOR NEXT PARM 02577000
BAL R14,PARMGET LOCATE THE NEXT PARAMETER IN THE TAG 02578000
CLR R3,R5 WAS THERE ONE MORE? 02579000
BNL TAGGEXIT NOPE - QUIT NOW 02580000
MVC TAGTOVM(8),AXSBLANK CLEAR FIELD PRIOR TO MVC 02581000
SLR R4,R3 R4=PARAMETER BYTE COUNT 02582000
CL R4,F8 IS THIS ONE'S LENGTH OK? 02583000
BNH TAGGOK2 YEP - USE IT AS IT STANDS 02584000
LA R4,8 SET THE CNT TO THE MAX ALLOWABLE 02585000
TAGGOK2 EQU * 02586000
BCTR R4,0 BUMP COUNT DOWN ONE FOR CHAR OP 02587000
LA R15,TAGTOVM SET THE RECEIVING FIELD ADDRESS 02588000
EX R4,AXSMOVE MOVE IN THE SPECIFIED DEST VMID 02589000
LM R8,R9,AXSPRRNG RANGE OF VALID PRIORITY 02590000
STH R9,TAGPRIOR SET DEFAULT AT TOP RANGE 02591000
LA R3,1(R4,R3) END OF CURRENT PARM 02592000
BAL R14,PARMGET TO START OF NEXT 02593000
CLR R3,R5 ANY MORE TO GO? 02594000
BNL TAGGEXIT NOPE - LET PRI DEFAULT 02595000
BAL R14,DECGET LOAD THE PRIORITY 02596000
BC 7,TAGGEXIT NO GOOD - SKIP IT 02597000
STH R0,TAGPRIOR SET REQUESTED PRIORITY 02598000
EJECT 02599000
TAGGEXIT EQU * 02600000
LM R14,R9,TAGGSAVE RESTORE CALLER'S REGISTER CONTENTS 02601000
BR R14 AND RETURN 02602000
SPACE 2 02603000
TAGGSAVE DC 12F'0' 02604000
EJECT 02605000
*. 02606000
* 02607000
* ENTRY NAME - 02608000
* 02609000
* TAGPLACE 02610000
* 02611000
* FUNCTION - 02612000
* 02613000
* SET A FILE TAG INTO A LINK QUEUE, IMMEDIATELY BEFORE 02614000
* THE FIRST TAG OF HIGHER NUMERICAL (LESSER) PRIORITY. 02615000
* 02616000
* CALLS TO OTHER ROUTINES - 02617000
* 02618000
* NONE 02619000
* 02620000
* OPERATION - 02621000
* 02622000
* 1. SCAN THE LINK'S INACTIVE FILE TAG QUEUE FOR 02623000
* A SPOT TO ENQUEUE THE TAG, SUCH THAT THE 02624000
* QUEUE WILL BE IN ORDER OF PRIORITY (THE FIRST 02625000
* TIME A TAG IS ENQUEUED IT IS PLACED AFTER ALL 02626000
* OTHER TAGS OF EQUAL PRIORITY; IF THE TAG IS 02627000
* SUBSEQUENTLY RE-ENQUEUED, IT IS PLACED BEFORE 02628000
* OTHER TAGS OF EQUAL PRIORITY). 02629000
* 02630000
* 2. ENQUEUE THE TAG, AND MARK IT AS HAVING BEEN ENQUEUED 02631000
* 02632000
* 3. IF THE TAG HADN'T BEEN PREVIOUSLY ENQUEUED, ISSUE 02633000
* MESSAGE 101. 02634000
* 02635000
* 4. RETURN TO CALLER 02636000
* 02637000
* RESPONSES - 02638000
* 02639000
* DMTAXS101I FILE 'SPOOLID' ENQUEUED ON LINK 'LINKID' 02640000
* 02641000
* ERROR MESSAGES - 02642000
* 02643000
* NONE 02644000
* 02645000
*. 02646000
SPACE 2 02647000
TAGPLACE DC 0H'0' 02648000
STM R14,R4,TAGPSAVE SAVE CALLER'S REGISTER CONTENTS 02649000
LA R3,LPOINTER-(TAGNEXT-TAG) INITIALIZE TAG POINTER 02650000
TAGPDIVE EQU * 02651000
LR R4,R3 SAVE ADDRESS OF LAST TAG SCANNED 02652000
ICM R3,B'1111',TAGNEXT-TAG(R4) ADDR OF NEXT TAG 02653000
BZ TAGPEND NONE - PUT AT END 02654000
CLC TAGPRIOR(2),TAGPRIOR-TAG(R3) BEFORE THIS? 02655000
BH TAGPDIVE NOT YET 02656000
BL TAGPEND DEFINITELY 02657000
TM TAGFLAG2,SFBREQUE BRAND NEW FILE @VA09075 02658100
BNO TAGPDIVE YES - PUT AT END OF EQ PRIOR 02659000
TAGPEND EQU * 02660000
ST R2,TAGNEXT-TAG(R4) CHAIN THE TAG TO THE PREVIOUS END 02661000
ST R3,TAGNEXT SET NEW TAG'S CHAINING FIELD 02662000
SPACE 02663000
TM TAGFLAG2,SFBREQUE HAVE WE ENQUEUED IT ALREADY? 02664000
BO TAGPEXIT YES - FORGET IT 02665000
OI TAGFLAG2,SFBREQUE NOW WE HAVE SEEN IT 02666000
LH R1,TAGID NEW SPOOL FILE ID 02667000
BAL R14,AXSM101 ISSUE ACCEPT MESSAGE 02668000
SPACE 2 02669000
TAGPEXIT EQU * 02670000
LM R14,R4,TAGPSAVE RESOTRE CALLER'S REGISTER CONTENTS 02671000
BR R14 AND RETURN 02672000
SPACE 02673000
TAGPSAVE DC 7F'0' TAGPLACE SAVE AREA 02674000
EJECT 02675000
*. 02676000
* 02677000
* ENTRY NAME - 02678000
* 02679000
* FILSELEC 02680000
* 02681000
* FUNCTION - 02682000
* 02683000
* SELECT A FILE TO BE READ FROM A LINK QUEUE 02684000
* 02685000
* CALLS TO OTHER ROUTINES - 02686000
* 02687000
* DMKDRD - VIA DIAG X'14' 02688000
* 02689000
* OPERATION - 02690000
* 02691000
* 1. SCAN THIS LINK'S TAQ QUEUE 02692000
* 02693000
* 2. DEQUEUE THE FIRST FILE FILE 02694000
* FOUND NOT IN HOLD WITH A MATCHING CLASS 02695000
* SPECIFICATION. 02696000
* 02697000
* 3. PLACE THE FILE IN THE SPECIFIED RDR 02698000
* 02699000
* RESPONSES - 02700000
* 02701000
* NONE 02702000
* 02703000
* ERROR MESSAGES - 02704000
* 02705000
* DMTAXS106E FILE 'SPOOLID' MISSING -- DEQUEUED 02706000
* FROM LINK 'LINKID' 02707000
* 02708000
*. 02709000
SPACE 2 02710000
FILSELEC DC 0H'0' 02711000
STM R14,R7,FILSSAVE SAVE CALLER'S REGS 02712000
SR R4,R4 INITIALIZE CLASS INDEX 02713000
SPACE 02714000
FILSLAP EQU * 02715000
LA R1,LPOINTER INITIALIZE PREDECESSOR 02716000
ICM R2,B'1111',LPOINTER FIRST FILE 02717000
BZ FILSNOGO NO FILES AT ALL 02718000
LA R3,LACTCLS1(R4) NEXT CLASS TO CHECK FOR 02719000
CLI 0(R3),C' ' ANY MORE TO LOOK FOR? 02720000
BE FILSNOGO NO FILE TO BE HAD 02721000
SR R0,R0 INITIALIZE CLASS REG 02722000
CLI 0(R3),C'*' ALL CLASS O.K.? 02723000
BE FILSCAN YES - SCAN FOR ANY 02724000
IC R0,0(R3) OTHERWISE SET PARTICULAR CLASS 02725000
EJECT 02726000
FILSCAN EQU * 02727000
LTR R0,R0 ALL CLASS SPECIFIED? 02728000
BZ FILSALL YEP - SKIP CLASS CHECK 02729000
CLM R0,B'0001',TAGCLASS THIS ONE MATCH? 02730000
BNE FILSKIP NO - TRY ANOTHER 02731000
FILSALL EQU * 02732000
TM TAGFLAG,SFBUHOLD+SFBSHOLD IN HOLD STATUS? 02733000
BZ FILSTRY NO - TRY TO GET IT 02734000
FILSKIP EQU * 02735000
LR R1,R2 MAKE NEW PREDECESSOR 02736000
ICM R2,B'1111',TAGNEXT GET NEXT TAG 02737000
BNZ FILSCAN INSPECT IT IF ONE IS THERE 02738000
SPACE 02739000
LA R4,1(R4) INCREMENT CLASS INDEX 02740000
LA R0,4 MAX INDEX 02741000
CLR R4,R0 HAVE WE LOOKED AT ALL? 02742000
BL FILSLAP NO - TRY ANOTHER CLASS 02743000
SPACE 02744000
FILSNOGO EQU * 02745000
SR R2,R2 CLEAR TAG RETURN REG 02746000
ST R2,FILSSAVE+16 SET IT TO BE RETURNED 02747000
LM R14,R7,FILSSAVE RESTORE CALLER'S REGS 02748000
TM *+1,X'80' SET CC=3 02749000
BR R14 AND RETURN 02750000
SPACE 02751000
FILSTRY EQU * 02752000
MVC TAGNEXT-TAG(4,R1),TAGNEXT DEQUEUE TAG 02753000
LH R5,TAGID DEQUEUED TAG'S SPOOL ID 02754000
LH R6,AXSRDR AXS CONTROL READER ADDR 02755000
LA R7,X'00C' SELECT SFB SUBCODE 02756000
DIAG R5,R6,X'14' DOES THE FILE STILL EXIST? 02757000
BC 8,FILSGOT YES - USE IT 02758000
BC 5,FILSKIP SYSTEM ERROR ON DIAG 02759000
BAL R14,FREESLOT FILE DISAPPEARED - FREE SLOT 02760000
LR R2,R1 BACK UP TO PREDECESSOR 02761000
LR R1,R5 SPOOL FILE ID FOR MSG 02762000
BAL R14,AXSM106 ISSUE DISAPPEARANCE MSG 02763000
B FILSKIP AND TRY ANOTHER FILE 02764000
SPACE 02765000
FILSGOT EQU * 02766000
LH R1,AXSRDR VIRT ADDR OF AXS CONTROL RDR 02767000
BAL R14,VCLOSEH RESET VM/370 STATUS FLAGS 02768000
ST R2,FILSSAVE+16 SET RETURN REG.2 02769000
LM R14,R7,FILSSAVE RESTORE CALLER'S REGS 02770000
CLR R2,R2 SET CC=0 02771000
BR R14 AND RETURN 02772000
SPACE 02773000
FILSSAVE DC 10F'0' FILSELEC ROUTINE SAVE AREA 02774000
EJECT 02775000
*. 02776000
* 02777000
* ENTRY NAME - 02778000
* 02779000
* TAGFIND 02780000
* 02781000
* FUNCTION - 02782000
* 02783000
* LOCATE A FILE WITH SPOOLID MATCHING THAT SUPPLIED BY 02784000
* THE CALLER, WITHIN THE INTERNAL FILE TAG QUEUES. 02785000
* 02786000
* CALLS TO OTHER ROUTINES - 02787000
* 02788000
* NONE 02789000
* 02790000
* ENTRY: 02791000
* R1 = SPOOL ID TO BE LOCATED 02792000
* 02793000
* EXIT: 02794000
* 02795000
* R2 = TAG ADDRESS IF FOUND (CC=0) 02796000
* R2 = SAME AS ENTRY IF NOT FOUND (CC=3) 02797000
* 02798000
* OPERATION - 02799000
* 02800000
* 1. SCAN THE FILE TAG QUEUE FOR EACH 02801000
* LINK. 02802000
* 02803000
* 2. CHECK FOR MATCH AGAINST SUPPLIED SPOOLID 02804000
* 02805000
* 3. IF NOT FOUND, RETURN WITH ERROR 02806000
* 02807000
* RESPONSES - 02808000
* 02809000
* NONE 02810000
* 02811000
* ERROR MESSAGES - 02812000
* 02813000
* NONE 02814000
* 02815000
*. 02816000
SPACE 1 02817000
TAGFIND EQU * 02818000
ST R2,TAGFSAVE SAVE CALLER'S TAG REG 02819000
STM R7,R8,TAGFSAVE+4 AND TWO MORE 02820000
L R8,TLINKS ADDR OF START OF LINK TABLE 02821000
L R7,0(R8) COUNT OF LINK TABLE ENTRIES 02822000
BCTR R7,0 SKIP LOCAL LINK 02823000
LTR R7,R7 ANY LEFT 02824000
BNP TAGFASCN NO LINKS AT ALL 02825000
LA R8,8+LINKLEN(R8) ADDR OF FIRST LINK TABLE 02826000
EJECT 02827000
TAGFLINK EQU * 02828000
SPACE 02829000
LA R2,LPOINTER INITIALIZE FILE TAG POINTER 02830000
TAGFFILE EQU * 02831000
ICM R2,B'1111',TAGNEXT POINT TO NEXT FILE TAG 02832000
BZ TAGFNEXT ALL DONE - NEXT LINK 02833000
CH R1,TAGID IS THIS THE ONE? 02834000
BNE TAGFFILE NO - TRY NEXT 02835000
SPACE 02836000
* FOUND THE SOUGHT FILE 02837000
TAGFHIT EQU * 02838000
CLR R1,R1 SET CC=0 02839000
LM R7,R8,TAGFSAVE+4 RESTORE CALLER'S REGS.7,8 02840000
BR R14 AND RETURN TO THE CALLER 02841000
SPACE 02842000
TAGFNEXT EQU * 02843000
LA R8,LINKLEN(R8) POINT TO NEXT LINK TABLE 02844000
BCT R7,TAGFLINK BACK FOR EACH LINK TABLE 02845000
SPACE 02846000
TAGFASCN EQU * 02847000
LA R2,TAGACIN START OF ACTIVE INPUT QUEUE 02848000
TAGFANXT EQU * 02849000
ICM R2,B'1111',TAGNEXT TO NEXT TAG 02850000
BZ TAGFMISS NONE FOUND 02851000
CH R1,TAGID IS THIS THE ONE WE WANT? 02852000
BNE TAGFANXT NOPE - TRY ANOTHER 02853000
B TAGFHIT YES - RETURN IT 02854000
SPACE 02855000
TAGFMISS EQU * 02856000
* FILE NOT FOUND 02857000
TM *+1,X'80' SET CC=3 02858000
L R2,TAGFSAVE RESTORE CALLER'S REG.2 02859000
LM R7,R8,TAGFSAVE+4 RESTORE CALLER'S REGS.7,8 02860000
BR R14 AND RETURN 02861000
SPACE 02862000
TAGFSAVE DC 3F'0' TAGFIND ROUTINE SAVE AREA 02863000
EJECT 02864000
*. 02865000
* 02866000
* ENTRY NAME - 02867000
* 02868000
* DEFINE 02869000
* 02870000
* FUNCTION - 02871000
* 02872000
* GET A VIRTUAL SPOOL DEVICE 02873000
* 02874000
* CALLS TO OTHER ROUTINES - 02875000
* 02876000
* DMKCFM - VIA DIAG X'08' 02877000
* 02878000
* ENTRY: 02879000
* 02880000
* R1=0 FOR READER DEVICE DEFINE 02881000
* DEVICE TYPE CODE FOR OUTPUT DEVICE 02882000
* 02883000
* EXIT: 02884000
* 02885000
* R1=HEXADECIMAL ADDRESS OF NEW DEVICE 02886000
* R15=RETURN CODE 0 IF SUCCESSFUL 02887000
* RETURN CODE 16 IF TYPE CODE NOT RECOGNIZED 02888000
* 02889000
* DEVICE ADDRESSES X'20' - X'BF' ARE ASSIGNED 02890000
* 02891000
* 02892000
* OPERATION - 02893000
* 02894000
* 1. SCAN THE DEVICE TABLE FOR A MATCH ON THE CODE 02895000
* SUPPLIED BY THE USER. 02896000
* IF FOUND, MOVE EBCDIC NAME TO COMMAND LINE 02897000
* 02898000
* 2. SCAN TO SEE IF THE DEVICE ALREADY IN USE. IF IT 02899000
* IS UP THE DEVADDR BY ONE AND TRY AGAIN. 02900000
* 02901000
* 3. CONTRUCT THE COMMAND LINE AND ISSUE DIAG 02902000
* 02903000
* RESPONSES - 02904000
* 02905000
* NONE 02906000
* 02907000
* ERROR MESSAGES - 02908000
* 02909000
* NONE 02910000
* 02911000
*. 02912000
SPACE 2 02913000
DEFINE DC 0H'0' 02914000
SR R15,R15 CLEAR RETURN CODE TO START 02915000
STM R2,R5,DEFISAVE SAVE CALLER'S REGISTER CONTENTS 02916000
LA R3,DEFITYPS R3=ADDRESS OF START OF TYPE TABLE 02917000
LA R4,8 R4=LENGTH OF A TYPE TABLE ENTRY 02918000
LA R5,DEFITEND R5=ADDR OF END OF TYPE TABLE 02919000
DEFITTRY EQU * 02920000
EX R1,DEFITCLI IS THIS A MATCHING TABLE ENTRY? 02921000
BE DEFITGOT YEP - USE IT 02922000
BXLE R3,R4,DEFITTRY KEEP LOOKING THROUGH THE TABLE 02923000
LA R15,X'10' SET RET CODE TO UNRECOGN DEV TYPE 02924000
B DEFIEXIT AND RETURN TO THE CALLER 02925000
SPACE 02926000
DEFITGOT EQU * 02927000
MVC DEFILINE+4(7),1(R3) MOVE TYPE DESCRIPTOR TO COMMAND LINE 02928000
SPACE 02929000
DEFIREDO EQU * 02930000
LH R1,DEFICUU R1=LAST HEX DEVICE ADDRESS USED 02931000
LA R1,1(R1) BUMP UP TO NEXT SEQ ADDR 02932000
CH R1,DEFIULIM DID THAT GO PAST THE UPPER LIMIT? 02933000
BL DEFISCAN NOPE - USE IT AS IT STANDS 02934000
LH R1,DEFILLIM OTHERWISE, BACK TO BOTTOM LIMIT 02935000
DEFISCAN EQU * 02936000
STH R1,DEFICUU STORE NEXT ADDRESS TO USE @VA03274 02936010
LA R2,TAGACIN SET TO SCAN ACTIVE INPUT 02937000
DEFIINXT EQU * 02938000
ICM R2,B'1111',TAGNEXT TO THE NEXT TAG 02939000
BZ DEFIIOK NOT IN ACTIVE INPUT QUEUE 02940000
CH R1,TAGDEV DEV ADDR IN USE HERE? 02941000
BNE DEFIINXT TRY THE NEXT TAG IF NOT 02942000
B DEFIREDO TRY ANOTHER ADDR IF SO 02943000
DEFIIOK EQU * 02944000
LA R2,TAGACOUT SET TO SCAN ACTIVE OUTPUT 02945000
DEFIONXT EQU * 02946000
ICM R2,B'1111',TAGNEXT TO THE NEXT TAG 02947000
BZ DEFIADOK NOT IN EITHER ACTIVE QUEUE 02948000
CH R1,TAGDEV DEV ADDR IN USE HERE? 02949000
BNE DEFIONXT TRY THE NEXT TAG IF NOT 02950000
B DEFIREDO TRY ANOTHER ADDR IF SO 02951000
DEFIADOK EQU * 02952000
UNPK DEFILINE+13(3),DEFICUU+1(2) UNPACK ADDRESS TO COMMAND 02954000
TR DEFILINE+13(2),AXSTOEBC-240 AND TRANSLATE TO LEGAL EBCD 02955000
LA R3,DEFILINE R3=ADDRESS OF DEFINE COMMAND LINE 02956000
LA R4,L'DEFILINE R4=LENGTH OF COMMAND LINE 02957000
DIAG R3,R4,X'08' ISSUE DEFINE COMMAND TO VM/370 02958000
LTR R4,R4 WAS THAT DEV ALREADY DEFINED, MAYBE? 02959000
BNZ DEFIREDO YEP - TRY THE NEXT ADDRESS 02960000
DEFIEXIT EQU * 02961000
LM R2,R5,DEFISAVE RESTORE CALLER'S REGISTER CONTENTS 02962000
BR R14 AND RETURN TO THE CALLER 02963000
SPACE 02964000
DEFITCLI CLI 0(R3),X'00' TEST DEVICE TYPE - TO BE EXECUTED 02965000
EJECT 02966000
DEFITYPS DC 0F'0' 02967000
DC AL1(0),CL7'RDR' 02968000
DC AL1(TYPPRT),CL7'PRT' 02969000
DC AL1(TYP1403),CL7'1403' 02970000
DC AL1(TYP3203),CL7'3203' @V386298 02970500
DC AL1(TYP3211),CL7'3211' 02971000
DC AL1(TYPPUN),CL7'PUN' 02972000
DEFITEND DC AL1(TYP2540P),CL7'PUN' 02973000
SPACE 02974000
DEFICUU DC 0H'0',X'001F' MAKE FIRST DEFINED ADDRESS X'020' 02975000
DEFILLIM DC 0H'0',X'0020' LOWEST DEFINABLE DEV ADDR 02976000
DEFIULIM DC 0H'0',X'00C0' MAKE LAST DEFINED ADDRESS X'0BF' 02977000
SPACE 02978000
DEFISAVE DC 4F'0' DEFINE ROUTINE SAVE AREA 02979000
SPACE 02980000
DEFILINE DC C'DEF TYP 0UU',X'00' 02981000
EJECT 02982000
*. 02983000
* 02984000
* ENTRY NAME - 02985000
* 02986000
* DETACH 02987000
* 02988000
* FUNCTION - 02989000
* 02990000
* UNDEFINE A VIRTUAL SPOOL DEVICE 02991000
* 02992000
* CALLS TO OTHER ROUTINES - 02993000
* 02994000
* DMKCFM - VIA DIAG X'08' 02995000
* 02996000
* ENTRY: 02997000
* 02998000
* R1=CUU DEVICE ADDRESS OF DEVICE TO BE DETACHED 02999000
* 03000000
* 03001000
* OPERATION - 03002000
* 03003000
* 1. CONVERT THE DEVICE ADDRESS TO EBCDIC 03004000
* 03005000
* 2. MOVE INTO COMMAND AND ISSUE DIAG 03006000
* 03007000
* RESPONSES - 03008000
* 03009000
* NONE 03010000
* 03011000
* ERROR MESSAGES - 03012000
* 03013000
* NONE 03014000
* 03015000
*. 03016000
SPACE 2 03017000
DETACH DC 0H'0' 03018000
STM R1,R2,DETASAVE SAVE CALLER'S REGISTER CONTENTS 03019000
UNPK DETALINE+3(5),DETASAVE+2(3) UNPACK DEVICE ADDRESS 03020000
MVI DETALINE+3,C' ' RESTORE CLOBBERED BLANK 03021000
TR DETALINE+4(3),AXSTOEBC-240 TRANSLATE TO LEGAL EBCDIC 03022000
LA R1,DETALINE R1=ADDRESS OF CLOSE COMMAND LINE 03023000
LA R2,L'DETALINE R2=CHAR COUNT FOR CLOSE COMMAND LINE 03024000
DIAG R1,R2,X'08' ISSUE CLOSE COMMAND TO VM/370 03025000
DETAEXIT EQU * 03026000
LM R1,R2,DETASAVE RESTORE CALLER'S REGISTER CONTENTS 03027000
BR R14 AND RETURN TO THE CALLER 03028000
SPACE 03029000
DETASAVE DC 2F'0' 03030000
SPACE 03031000
DETALINE DC C'DET CUU',X'00' COMMAND LINE FOR CLOSE AND DETACH 03032000
EJECT 03033000
*. 03034000
* 03035000
* ENTRY NAME - 03036000
* 03037000
* VCHANGE 03038000
* 03039000
* FUNCTION - 03040000
* 03041000
* CHANGE VM/370 FILE ATTRUBUTES 03042000
* 03043000
* CALLS TO OTHER ROUTINES - 03044000
* 03045000
* DMKCFM - VIA DIAG X'08' 03046000
* 03047000
* ENTRY: 03048000
* 03049000
* R1 = SPOOL ID FOR FILE TO BE CHANGED 03050000
* 03051000
* CALLER MUST SET VCHCNTRL OPTION AREAS PRIOR 03052000
* TO CALL 03053000
* 03054000
* 03055000
* OPERATION - 03056000
* 03057000
* 1. PROCESS VARIOUS CHANGE OPTIONS 03058000
* 03059000
* 2. CONTRUCT COMMAND LINE AND ISSUE DIAG 03060000
* 03061000
* RESPONSES - 03062000
* 03063000
* NONE 03064000
* 03065000
* ERROR MESSAGES - 03066000
* 03067000
* NONE 03068000
* 03069000
*. 03070000
SPACE 2 03071000
VCHANGE DC 0H'0' 03072000
STM R14,R2,VCHASAVE SAVE CALLER'S REGS 03073000
SPACE 03074000
LA R0,4 SET MINIMUM TRUNCATION 03075000
LA R15,VCHALINE+5 SET DECIMAL EBCDIC TARGET 03076000
BAL R14,DECPUT CONVERT AND STOW SPOOL ID 03077000
SPACE 03078000
MVI VCHALVAR,C' ' BLANK FIRST VARIABLE CHAR 03079000
MVC VCHALVAR+1(L'VCHALVAR-1),VCHALVAR BLANK ENTIRE LINE 03080000
LA R2,VCHALVAR INITIALIZE LOAD POINTER 03081000
VCHAHO EQU * 03082000
CLI VCHCHO,X'FF' CHANGE HOLD STATUS? 03083000
BE VCHACL NO - TRY CLASS 03084000
MVC 0(3,R2),=CL3'NOH' ASSUME NOHOLD 03085000
TM VCHCHO,X'C0' CORRECT ASSUMPTION? 03086000
BZ VCHAHONX YES - PROCEED 03087000
MVC 0(3,R2),=CL3'HO' RESET TO HOLD 03088000
VCHAHONX EQU * 03089000
LA R2,4(R2) MOVE LOAD POINTER AHEAD 03090000
SPACE 03091000
VCHACL EQU * 03092000
CLI VCHCCL,X'FF' CHANGE CLASS? 03093000
BE VCHACO NO - TRY COPY 03094000
MVC 0(2,R2),=CL2'CL' SET CLASS KEYWORD 03095000
MVC 3(1,R2),VCHCCL AND NEW CLASS 03096000
LA R2,5(R2) MOVE LOAD POINTER AHEAD 03097000
SPACE 03098000
VCHACO EQU * 03099000
CLI VCHCCO,X'FF' CHANGE COPIES? 03100000
BE VCHADI NO - TRY DIST CODE 03101000
MVC 0(2,R2),=CL2'CO' SET COPY KEYWORD 03102000
LA R15,3(R2) COPY NUMBER TARGET 03103000
LH R1,VCHCCO BINARY COPY NUMBER 03104000
LA R0,2 SET MIN TRUNC = 2 03105000
BAL R14,DECPUT CONVERT TO DECIMAL EBCDIC 03106000
LA R2,6(R2) MOVE LOAD POINTER AHEAD 03107000
SPACE 03108000
VCHADI EQU * 03109000
CLI VCHCDI,X'FF' CHANGE DIST CODE? 03110000
BE VCHANA NO - TRY NAME 03111000
MVC 0(2,R2),=CL2'DI' SET DIST KEYWORD 03112000
MVC 3(8,R2),VCHCDI MOVE IN NEW DIST CODE 03113000
LA R2,12(R2) MOVE LOAD POINTER AHEAD 03114000
SPACE 03115000
VCHANA EQU * 03116000
CLI VCHCNA,X'FF' CHANGE NAME? 03117000
BE VCHADOIT NO - EXECUTE CONSTRUCTED COMMAND 03118000
MVC 0(2,R2),=CL2'NA' SET NAME KEYWORD 03119000
MVC 3(24,R2),VCHCNA MOVE IN NEW NAME 03120000
LA R2,28(R2) MOVE LOAD POINTER AHEAD 03121000
SPACE 03122000
VCHADOIT EQU * 03123000
LA R1,VCHALVAR REG.1 = START OF VARIABLE LINE 03124000
SR R2,R1 TOTAL VARIABLE LINE CHAR COUNT 03125000
BNP VCHAEXIT NO CHANGE TO BE MADE 03126000
BCTR R2,0 BUMP BACK PAST FINAL BLANK 03127000
LA R2,L'VCHALINE(R2) TOTAL COMMAND LINE LEN 03128000
LA R1,VCHALINE START OF COMMAND LINE 03129000
DIAG R1,R2,X'08' EXECUTE VM/370 CHANGE COMMAND 03130000
SPACE 03131000
VCHAEXIT EQU * 03132000
LM R14,R2,VCHASAVE RESTORE CALLER'S REGS 03133000
BR R14 AND RETURN 03134000
SPACE 03135000
VCHASAVE DC 5F'0' VCHANGE SAVE AREA 03136000
SPACE 03137000
VCHALINE DC C'CH R NNNN ' VM/370 CHANGE COMMAND 03138000
VCHALVAR DC CL54' ' VARIABLE LINE AREA 03139000
EJECT 03140000
*. 03141000
* 03142000
* ENTRY NAME - 03143000
* 03144000
* VCLOSE 03145000
* 03146000
* FUNCTION - 03147000
* 03148000
* ISSUE VM/370 CLOSE COMMAND FOR A DEVICE 03149000
* 03150000
* CALLS TO OTHER ROUTINES - 03151000
* 03152000
* DMKCFM - VIA DIAG X'08' 03153000
* 03154000
* ENTRY: 03155000
* 03156000
* R1 = VIRTUAL ADDR OF DEVICE TO BE CLOSED 03157000
* (ON CALL TO VCLOSEH, NEGATIVE VALUE IN R1 03158000
* REQUESTS 'CLOSE RDR HOLD') 03159000
* R2 = ADDR OF TAG FOR FILE OCCUPYING DEVICE 03160000
* 03161000
* OPERATION - 03162000
* 03163000
* 1. PROCESS CLOSE HOLD, CLOSE PURGE DEPENDING ON 03164000
* R1 AT ENTRY. 03165000
* 03166000
* 2. CONTRUCT COMMAND LINE 03167000
* 03168000
* 3. ISSUE DIAG 03169000
* 03170000
* RESPONSES - 03171000
* 03172000
* NONE 03173000
* 03174000
* ERROR MESSAGES - 03175000
* 03176000
* NONE 03177000
* 03178000
*. 03179000
SPACE 2 03180000
VCLOSEP DC 0H'0' 03181000
STM R1,R3,VCLOSAVE SAVE CALLER'S REGS 03182000
MVC VCLOLVAR(3),=CL3'NOH' @VA05479 03182500
LA R2,L'VCLOLINE+3 @VA05479 03183000
B VCLOSE AND ISSUE THE VM/370 COMMAND 03184000
SPACE 2 03185000
VCLOSEH EQU * 03186000
STM R1,R3,VCLOSAVE SAVE CALLER'S REGS 03187000
MVC VCLOLVAR(3),=CL3'HO' SET HOLD KEYWORD IN LINE 03188000
LA R2,L'VCLOLINE+2 SET TO 'CLOSE CUU HO' 03189000
LTR R1,R1 CLOSE 'RDR' REQUESTED? 03190000
BNM VCLOSE NO - DO CLOSE DEVICE ADDR 03191000
MVC VCLOLINE+2(3),=CL3'RDR' SET 'RDR' IN COMMAND 03192000
B VCLOSEDO AND CLOSE ALL READERS 03193000
SPACE 2 03194000
VCLOSEO EQU * 03195000
STM R1,R3,VCLOSAVE SAVE CALLER'S REGS 03196000
LA R3,VCLOLVAR INITIALIZE LOAD POINTER 03197000
MVI VCLOLVAR,C' ' BLANK FIRST VARIABLE CHAR 03198000
MVC VCLOLVAR+1(L'VCLOLVAR-1),VCLOLVAR BLANK ALL 03199000
SPACE 03200000
VCLODI EQU * 03201000
CLC TAGDIST(8),AXSBLANK ANY DIST SPECIFIED? 03202000
BE VCLONA NO - TRY NAME 03203000
MVC 0(2,R3),=CL2'DI' SET DIST KEYWORD 03204000
MVC 3(8,R3),TAGDIST MOVE IN NEW DIST 03205000
LA R3,12(R3) MOVE LOAD POINTER AHEAD 03206000
SPACE 03207000
VCLONA EQU * 03208000
CLI TAGNAME,C' ' ANY NAME SPECIFIED? 03209000
BE VCLODOIT NO - SET COUNT AND GO 03210000
MVC 0(2,R3),=CL2'NA' SET NAME KEYWORD 03211000
MVC 3(24,R3),TAGNAME SET NEW NAME 03212000
LA R3,28(R3) MOVE LOAD POINTER AHEAD 03213000
SPACE 03214000
VCLODOIT EQU * 03215000
LA R1,VCLOLVAR ADDR OF START OF VARIABLE 03216000
SR R3,R1 TOTAL VARIABLE COUNT 03217000
BCTR R3,0 BUMP BACK PAST FINAL BLANK @VA03302 03217010
LA R2,L'VCLOLINE(R3) TOTAL COMMAND LINE COUNT 03218000
SPACE 2 03219000
VCLOSE EQU * 03220000
UNPK VCLOLINE+1(5),VCLOSAVE+2(3) SPREAD DEV ADDR 03221000
MVI VCLOLINE+1,C' ' FIX CLOBBERED CHAR 03222000
MVI VCLOLINE+5,C' ' AND FIX OTHER CHAR 03223000
TR VCLOLINE+2(3),AXSTOEBC-240 TRANSLATE ABCDEF 03224000
SPACE 03225000
VCLOSEDO EQU * 03226000
LA R1,VCLOLINE ADDR OF CLOSE COMMAND LINE 03227000
DIAG R1,R2,X'08' ISSUE VM/370 CLOSE COMMAND 03228000
SPACE 03229000
VCLOEXIT EQU * 03230000
LM R1,R3,VCLOSAVE RESTORE CALLER'S REGS @VM01166 03231010
BR R14 AND RETURN 03232000
SPACE 2 03233000
VCLOSAVE DC 3F'0' VCLOSE SAVE AREA 03234000
SPACE 03235000
VCLOLINE DC C'C CUU ' CLOSE COMMAND 03236000
VCLOLVAR DC CL39' ' VARIABLE LINE AREA 03237000
EJECT 03238000
*. 03239000
* 03240000
* ENTRY NAME - 03241000
* 03242000
* VPURGE 03243000
* 03244000
* FUNCTION - 03245000
* 03246000
* PURGE AN INACTIVE READER FILE FROM VM/370 SPOOL 03247000
* 03248000
* CALLS TO OTHER ROUTINES - 03249000
* 03250000
* DMKCFM - VIA DIAG X'08' 03251000
* 03252000
* ENTRY: 03253000
* 03254000
* R1 = SPOOL FILE ID OF FILE TO BE PURGED 03255000
* 03256000
* OPERATION - 03257000
* 03258000
* 1. CONSTRUCT COMMAND LINE 03259000
* 03260000
* 2. ISSUE DIAG 03261000
* 03262000
* RESPONSES - 03263000
* 03264000
* NONE 03265000
* 03266000
* ERROR MESSAGES - 03267000
* 03268000
* NONE 03269000
* 03270000
*. 03271000
SPACE 2 03272000
VPURGE DC 0H'0' 03273000
STM R14,R2,VPURSAVE SAVE CALLER'S REGS 03274000
SPACE 03275000
LA R0,4 SET MINIMUM TRUNCATION 03276000
LA R15,VPURLINE+6 SET DECIMAL EBCDIC TARGET 03277000
BAL R14,DECPUT CONVERT AND STOW SPOOL ID 03278000
SPACE 03279000
LA R1,VPURLINE VM/370 PURGE COMMAND LINE 03280000
LA R2,L'VPURLINE LENGTH OF PURGE COMMAND LINE 03281000
DIAG R1,R2,X'08' ISSUE VM/370 PURGE SPOOLID 03282000
SPACE 03283000
VPUREXIT EQU * 03284000
LM R14,R2,VPURSAVE RESTORE CALLER'S REGS 03285000
BR R14 AND RETURN 03286000
SPACE 2 03287000
VPURSAVE DC 5F'0' VPURGE ROUTINE SAVE AREA 03288000
SPACE 03289000
VPURLINE DC C'PUR R NNNN' VM/370 PURGE SPOOLID COMMAND 03290000
EJECT 03291000
*. 03292000
* 03293000
* ENTRY NAME - 03294000
* 03295000
* VSPOOL 03296000
* 03297000
* FUNCTION - 03298000
* 03299000
* SET VM/370 VIRTUAL SPOOL DEVICE OPTIONS 03300000
* 03301000
* CALLS TO OTHER ROUTINES - 03302000
* 03303000
* DMKCFM - VIA DIAG X'08' 03304000
* 03305000
* ENTRY: 03306000
* 03307000
* R1 = VIRTUAL SPOOL DEVICE ADDRESS 03308000
* R2 = FILE TAG FOR ASSOCIATED SPOOL FILE 03309000
* 03310000
* OPERATION - 03311000
* 03312000
* 1. MOVE THE SUPPLIED SPOOL FILE ATTRIBUTES INTO 03313000
* THE COMMAND LINE 03314000
* 03315000
* 2. ISSUE THE DIAG 03316000
* 03317000
* RESPONSES - 03318000
* 03319000
* NONE 03320000
* 03321000
* ERROR MESSAGES - 03322000
* 03323000
* NONE 03324000
* 03325000
*. 03326000
SPACE 2 03327000
VSPOOLR DC 0H'0' 03328000
STM R14,R3,VSPOSAVE SAVE CALLER'S REGS 03329000
SPACE 03330000
MVC VSPOLVAR(2),=CL2'CL' SET CLASS KEYWORD 03331000
MVI VSPOLVAR+2,C' ' SET BLANK DELIMETER 03332000
MVI VSPOLVAR+3,C'*' SET TO ALL CLASS CODE 03333000
CLM R14,B'0111',=AL3(OPENRET) CALL FROM OPEN? @VA05479 03333200
BE VSPHO PUT A HOLD ON IT @VA05479 03333500
LA R2,L'VSPOLINE+4 LENGTH OF 'SP CUU CL *' 03334000
B VSPOOL EXECUTE THE COMMAND 03335000
VSPHO MVC VSPOLVAR+4(3),=CL3' HO' @VA05479 03335100
LA R2,L'VSPOLINE+7 @VA05479 03335300
B VSPOOL @VA05479 03335500
SPACE 2 03336000
VSPOOLP EQU * 03337000
STM R14,R3,VSPOSAVE SAVE CALLER'S REGS 03338000
SPACE 03339000
LA R3,VSPOLVAR INITIALIZE LOAD POINTER 03340000
MVI VSPOLVAR,C' ' BLANK FIRST VARIABLE CHAR 03341000
MVC VSPOLVAR+1(L'VSPOLVAR-1),VSPOLVAR BLANK ALL 03342000
SPACE 03343000
CLI TAGTOVM,C' ' ANY DESTINATION VM ID GIVEN? 03344000
BE VSPPCL NO - TRY CLASS 03345000
MVC 0(2,R3),=CL2'TO' SET TO KEYWORD 03346000
MVC 3(8,R3),TAGTOVM MOVE THE VM ID TO THE LINE 03347000
LA R3,12(R3) MOVE THE LOAD POINTER AHEAD 03348000
SPACE 03349000
VSPPCL EQU * 03350000
CLI TAGCLASS,C' ' ANY CLASS GIVEN? 03351000
BE VSPPCO NOPE - TRY COPY 03352000
MVC 0(2,R3),=CL2'CL' MOVE IN CLASS KEYWORD 03353000
MVC 3(1,R3),TAGCLASS MOVE IN THE CLASS 03354000
LA R3,5(R3) MOVE LOAD POINTER AHEAD 03355000
SPACE 03356000
VSPPCO EQU * 03357000
CLC TAGCOPY(2),AXSBLANK ANY COPY SPECIFIED? 03358000
BE VSPPDOIT NO - GO EXECUTE AS IS 03359000
MVC 0(2,R3),=CL2'CO' MOVE IN COPY KEYWORD 03360000
LA R15,3(R3) SET DECIMAL EBCDIC TARGET 03361000
LA R0,2 SET MINIMUM TRUNCATION @VM01135 03362010
LH R1,TAGCOPY REQUESTED COPY COUNT @VM01135 03362510
BAL R14,DECPUT CONVERT AND STOW NUMBER 03363000
LA R3,4(R3) UNDATE LOAD POINTER 03364000
ALR R3,R0 ADD DECIMAL CHAR COUNT 03365000
SPACE 03366000
VSPPDOIT EQU * 03367000
LA R1,VSPOLVAR SET COMMAND LINE ADDR 03368000
SR R3,R1 TOTAL VAR CHAR COUNT 03369000
BNP VSPOEXIT QUIT IF NONE 03370000
BCTR R3,0 BACK ONE FOR A BLANK 03371000
LA R2,L'VSPOLINE(R3) SET TOTAL SPOOL COMMAND COUNT 03372000
SPACE 2 03373000
VSPOOL EQU * 03374000
UNPK VSPOLINE+2(5),VSPOSAVE+14(3) SPREAD HEX CUU 03375000
MVI VSPOLINE+2,C' ' FIX LEFT BAD CHAR 03376000
MVI VSPOLINE+6,C' ' AND FIX RIGHT BAD CHAR 03377000
TR VSPOLINE+3(3),AXSTOEBC-240 TRANSLATE ABCDEF 03378000
SPACE 03379000
LA R1,VSPOLINE SET SPOOL COMMAND LINE ADDR 03380000
DIAG R1,R2,X'08' ISSUE SPOOL COMMAND 03381000
SPACE 03382000
VSPOEXIT EQU * 03383000
LM R14,R3,VSPOSAVE RESTORE CALLER'S REGS 03384000
BR R14 AND RETURN 03385000
SPACE 2 03386000
VSPOSAVE DC 6F'0' VSPOOL ROUTINE SAVE AREA 03387000
SPACE 03388000
VSPOLINE DC CL7'SP CUU ' VM/370 SPOOL COMMAND 03389000
VSPOLVAR DC CL25' ' COMMAND VARIABLE AREA 03390000
EJECT 03391000
*. 03392000
* 03393000
* ENTRY NAME - 03394000
* 03395000
* VTAGD 03396000
* 03397000
* FUNCTION - 03398000
* 03399000
* SET A VM/370 TAG FOR A VIRTUAL SPOOL DEVICE 03400000
* 03401000
* CALLS TO OTHER ROUTINES - 03402000
* 03403000
* DMKCFM - VIA DIAG X'08' 03404000
* 03405000
* ENTRY: 03406000
* 03407000
* R1 = VIRTUAL ADDR OF A SPOOL OUTPUT DEVICE 03408000
* R2 = ADDR OF ASSOCIATED FILE TAG 03409000
* 03410000
* OPERATION - 03411000
* 03412000
* 1. MOVE SUPPLIED TAG INFO FROM THE INTERNAL TAG 03413000
* ELEMENT. 03414000
* 03415000
* 2. ISSUE THE DIAG 03416000
* 03417000
* RESPONSES - 03418000
* 03419000
* NONE 03420000
* 03421000
* ERROR MESSAGES - 03422000
* 03423000
* NONE 03424000
* 03425000
*. 03426000
SPACE 2 03427000
VTAGD DC 0H'0' 03428000
STM R14,R2,VTADSAVE SAVE CALLER'S REGS 03429000
SPACE 03430000
UNPK VTADLINE+7(5),VTADSAVE+14(3) SPREAD HEX CUU 03431000
MVI VTADLINE+7,C' ' FIX ONE CLOBBERED BLANK 03432000
MVI VTADLINE+11,C' ' AND FIX ANOTHER 03433000
TR VTADLINE+8(3),AXSTOEBC-240 TRANSLATE ABCDEF 03434000
SPACE 03435000
MVC VTADLINE+12(8),TAGTOLOC MOVE IN DEST LOC ID 03436000
MVC VTADLINE+21(8),TAGTOVM MOVE IN DEST VM ID 03437000
SPACE 03438000
LH R1,TAGPRIOR REG.1 = FILE PRIORITY 03439000
LA R0,2 SET MIN TRUNC TO 2 03440000
LA R15,VTADLINE+30 SET DECIMAL EBCDIC TARGET 03441000
BAL R14,DECPUT STOW DECIMAL EBCDIC PRIORITY 03442000
SPACE 03443000
LA R2,L'VTADLINE-5 SET MIN TAG LINE LEN 03444000
ALR R2,R0 UP FOR STOWED CHARS 03445000
LA R1,VTADLINE ADDR OF TAG COMMAND LINE 03446000
DIAG R1,R2,X'08' VM/370 'TAG DEV CUU ...' 03447000
SPACE 03448000
VTADEXIT EQU * 03449000
LM R14,R2,VTADSAVE RESTORE CALLER'S REGS 03450000
BR R14 AND RETURN 03451000
SPACE 2 03452000
VTADSAVE DC 5F'0' VTAGD ROUTINE SAVE AREA 03453000
SPACE 03454000
VTADLINE DC CL35'TAG DEV NNNN XXXXXXXX XXXXXXXX NNNNN' TAG CMD 03455000
EJECT 03456000
*. 03457000
* 03458000
* ENTRY NAME - 03459000
* 03460000
* VTAGF 03461000
* 03462000
* FUNCTION - 03463000
* 03464000
* SET A VM/370 TAG FOR AN INACTIVE SPOOL FILE 03465000
* 03466000
* CALLS TO OTHER ROUTINES - 03467000
* 03468000
* DMKCFM - VIA DIAG X'08' 03469000
* 03470000
* ENTRY: 03471000
* 03472000
* R2 = ADDR OF SPOOL FILE'S RSCS TAG 03473000
* 03474000
* OPERATION - 03475000
* 03476000
* 1. MOVE SUPPLIED TAG INFO FROM THE INTERNAL TAG 03477000
* ELEMENT. 03478000
* 03479000
* 2. ISSUE THE DIAG. 03480000
* 03481000
* RESPONSES - 03482000
* 03483000
* NONE 03484000
* 03485000
* ERROR MESSAGES - 03486000
* 03487000
* NONE 03488000
* 03489000
*. 03490000
SPACE 2 03491000
VTAGF DC 0H'0' 03492000
STM R14,R2,VTAFSAVE SAVE CALLER'S REGS 03493000
SPACE 03494000
LH R1,TAGID TAGABLE FILE'S SPOOL ID 03495000
LA R0,4 SET MIN TRUNC 4 03496000
LA R15,VTAFLINE+9 SET DECMIAL EBCDIC TARGET 03497000
BAL R14,DECPUT CONVERT AND STOW THE ID 03498000
SPACE 03499000
MVC VTAFLINE+14(8),TAGTOLOC SET THE DEST LOC ID 03500000
MVC VTAFLINE+23(8),TAGTOVM SET THE DEST VM ID 03501000
SPACE 03502000
LH R1,TAGPRIOR SPOOL FILE'S PRIORITY 03503000
LA R0,2 SET MIN TRUNC 2 03504000
LA R15,VTAFLINE+32 SET DECIMAL EBCDIC TARGET 03505000
BAL R14,DECPUT CONVERT AND STOW THE ID 03506000
SPACE 03507000
LA R2,L'VTAFLINE-5 SET MIN TAG LINE LEN 03508000
ALR R2,R0 UP FOR STOWED CHARS 03509000
LA R1,VTAFLINE ADDR OF TAG COMMAND LINE 03510000
DIAG R1,R2,X'08' VM/370 'TAG FILE NNNN ...' 03511000
SPACE 03512000
VTAFEXIT EQU * 03513000
LM R14,R2,VTAFSAVE RESTORE CALLER'S REGS 03514000
BR R14 AND RETURN 03515000
SPACE 2 03516000
VTAFSAVE DC 5F'0' VTAGF ROUTINE SAVE AREA 03517000
SPACE 03518000
VTAFLINE DC CL37'TAG FILE NNNN XXXXXXXX XXXXXXXX NNNNN' TAG CMD 03519000
EJECT 03520000
*---------------------------------------------------------------------* 03521000
* * 03522000
* CONSTANTS * 03523000
* * 03524000
*---------------------------------------------------------------------* 03525000
SPACE 03526000
AXSMSG DC 0F'0' 03527000
DC AL1(28),X'02' REQ ELMNT LEN, FUNC CODE 03528000
AXSMSGRC DC X'00' MSG ROUTING CODE 03529000
AXSMSGSC DC X'00' MSG SEVERITY CODE 03530000
AXSMSGLK DC CL8' ' OBJECT LINKID 03531000
AXSMSGVM DC CL8' ' OBJECT VMID 03532000
DC CL3'AXS' MODULE ID 03533000
AXSMSGAC DC CL1' ' MSG ACTION CODE 03534000
AXSMSGNM DC H'0',AL2(0) MSG NUMBER, SPARE 03535000
AXSMSGV0 DC CL8' ' FIRST VARIABLE FIELD 03536000
AXSMSGV1 DC CL8' ' SECOND VARIABLE FIELD 03537000
AXSMSGV2 DC CL8' ' THIRD VARIABLE FIELD 03538000
AXSMSGV3 DC CL8' ' FOURTH VARIABLE FIELD 03539000
AXSMSGV4 DC CL8' ' FIFTH VARIABLE FIELD 03540000
AXSMSGV5 DC CL8' ' SIXTH VARIABLE FIELD 03541000
AXSMSGVL EQU *-AXSMSGV0 TOTAL VAR AREA LEN 03542000
SPACE 3 03543000
AXSTOHEX DC X'00808080808080808080808080808080' X'00' SAME AS C'0' 03544000
DC (7*16)X'80' 03545000
DC X'800A0B0C0D0E0F808080808080808080' ABCDEF 03546000
DC (3*16)X'80' 03547000
DC X'800A0B0C0D0E0F808080808080808080' ABCDEF AGAIN 03548000
DC (2*16)X'80' 03549000
DC X'00010203040506070809808080808080' 0123456789 03550000
SPACE 03551000
AXSTODEC DC X'00010203040506070809808080808080' 03552000
SPACE 03553000
AXSTOEBC DC C'0123456789ABCDEF' TRANSLATE TABLE 03554000
SPACE 03555000
AXSALPHA DC (8*16)X'80' 03556000
DC X'80000000000000000000808080808080' ABCDEFGHI 03557000
DC X'80000000000000000000808080808080' JKLMNOPQR 03558000
DC X'80800000000000000000808080808080' STUVWXZY 03559000
DC 16X'80' 03560000
DC X'80000000000000000000808080808080' ABCDEFGHI 03561000
DC X'80000000000000000000808080808080' JKLMNOPQR 03562000
DC X'80800000000000000000808080808080' STUVWXYZ 03563000
DC X'00000000000000000000808080808080' 0123456789 03564000
SPACE 2 03565000
AXSZONE DC Y(0),CL6' ' DONT CONVERT TIME ZONE @VA03113 03566400
DC Y(0),CL6' ' ITS CORRECT AS IT IS @VA03113 03566800
SPACE 03568000
AXSTMASK DC AL1(AXSTMEND-*-1) LENGTH OF MASK 03569000
DC X'2120',C'/',X'2020',C'/',X'2020' EDIT MASK 03570000
DC X'22' FIELD SEPARATOR 03571000
DC X'2120',C':',X'2020',C':',X'2020' 03572000
DC C'0' BLANK @VA03113 03573500
AXSTMEND EQU * 03574000
SPACE 2 03575000
AXSLIMIT DC F'8' MAX PARM LENGTH 03576000
SPACE 03577000
AXSPRRNG DC F'00',F'99' RANGE OF VALID PRIORITIES 03578000
SPACE 03579000
AXSBLANK DC CL8' ' GENERAL PURPOSE BLANK FIELD 03580000
SPACE 2 03581000
AXSWORK DC 4D'0' NUMBER MAINPULATION WORK AREA 03582000
SPACE 03583000
AXSSFB DC 13D'0' 'SFBSIZE' BUF FOR VM/370 SFB READ @VMI0049 03584100
AXSSPTAG DC XL148'00' BUFFER FOR HYPERVISOR TAG READ 03585000
SPACE 2 03586000
VCHCNTRL DC 0F'0' CHANGE ROUTINE CONTROL TABLE 03587000
VCHCHO DC X'FF' HOLD FLAGS SPECIFICATION 03588000
VCHCCL DC X'FF' CLASS SPECIFICATION 03589000
VCHCCO DC 2X'FF' COPY COUNT SPECIFICATION 03590000
VCHCDI DC 8X'FF' DIST CODE SPECIFICATION 03591000
VCHCNA DC 24X'FF' FILE NAME (TYPE) SPECIFICATION 03592000
VCHCLEN EQU *-VCHCNTRL LENGTH OF CHANGE CONTROL TABLE 03593000
SPACE 2 03594000
AXSPREDC DC H'0' PREDECESSOR SPOOL FILE ID 03595000
SPACE 03596000
AXSRDR DC H'0' AXS CONTROL READER ADDR 03597000
SPACE 03598000
ROUTWANT DC 0D'0',CL8' ' PADDING FIELD FOR REQUESTED ROUTE ID 03599000
LINKWANT DC 0D'0',CL8' ' PADDING FIELD FOR REQUESTED LINK ID 03600000
EJECT 03601000
TAGAREA DSECT 03602000
SPACE 1 03603000
*** TAGAREA - RSCS TAG AREA 03604000
* 03605000
* 0 +-----------------------------------------------+ 03606000
* | TAGAFREE | TAGACIN | 03607000
* 8 +-----------------------------------------------+ 03608000
* | TAGACOUT | TAGAGOT | TAGAHOLD | 03609000
* 10 +-----------------------------------------------+ 03610000
* 03611000
*** TAGAREA - RSCS TAG AREA 03612000
SPACE 1 03613000
TAGAFREE DC A(0) FREE SLOT QUEUE 03614000
TAGACIN DC A(0) ACTIVE INPUT QUEUE 03615000
TAGACOUT DC A(0) ACTIVE OUTPUT QUEUE 03616000
SPACE 03617000
TAGAGOT DC H'0' NUMBER FREE SLOTS LEFT 03618000
TAGAHOLD DC H'0' NUMBER SLOTS TO BE HELD 03619000
EJECT 03620000
COPY RSSEQU 03621000
EJECT 03622000
COPY SVECTORS 03623000
EJECT 03624000
COPY LINKTABL 03625000
EJECT 03626000
COPY ROUTE 03627000
EJECT 03628000
COPY TAG 03629000
EJECT 03630000
COPY IOTABLE 03631000
EJECT 03632000
COPY TASKE 03633000
EJECT 03634000
COPY SPOOL 03635000
EJECT 03636000
COPY DEVTYPES 03637000
END 03638000