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