ibm:vm370-lib:rscs:dmtaxs.assemble_src
Table of Contents
DMTAXS Source
References
- Fixes Applied : 1
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [R09075DT]
Source Listing
- DMTAXS.ASSEMBLE.txt
- 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
ibm/vm370-lib/rscs/dmtaxs.assemble_src.txt · Last modified: 2023/08/06 13:38 by Site Administrator