COM TITLE 'DMTCOM (RSCS) VM/370 - RELEASE 6' 00001000 *. 00002000 * MODULE NAME - 00003000 * 00004000 * DMTCOM 00005000 * 00006000 * FUNCTION - 00007000 * 00008000 * THIS ROUTINE CONTAINS VARIOUS REENTRANT ROUTINES USED BY 00009000 * RSCS TASKS. 00010000 * 00011000 * ATTRIBUTES - 00012000 * 00013000 * REENTRANT 00014000 * 00015000 * ENTRY POINTS - 00016000 * 00017000 * DMTCOM - MODULE ENTRANCE 00018000 * DMTCOMVC - COMMON ROUTINE ADDRESS VECTOR 00019000 * 00020000 * ENTRY CONDITIONS - 00021000 * 00022000 * SEE ENTRY TO EACH SECTION 00023000 * 00024000 * EXIT CONDITIONS - 00025000 * 00026000 * SEE ENTRY TO EACH SECTION 00027000 * 00028000 EJECT 00029000 * 00030000 * CALLS TO OTHER ROUTINES - 00031000 * 00032000 * SEE ENTRY TO EACH SECTION 00033000 * 00034000 * EXTERNAL REFERENCES - 00035000 * 00036000 * TLINKS - LINK TABLE CHAIN 00037000 * MAINMAP - MAIN STORAGE MAP 00038000 * MAINSIZE - MAIN STORAGE SIZE 00039000 * 00040000 * TABLES / WORKAREAS - 00041000 * 00042000 * MSGSTACK - MESSAGE STACK BUFFER 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 REGISTERS 00052000 * GPR1 = PARAMETER REGISTERS 00053000 * GPR2 = LINK TABLE ADDRESSABILITY 00054000 * GPR3 = MESSAGE STACK ADDRESSABILITY 00055000 * GPR4 = WORK 00056000 * GPR5 = WORK 00057000 * GPR6 = TASK ELEMENT ADDRESSABILTIY 00058000 * GPR7 = WORK 00059000 * GPR8 = WORK 00060000 * GPR9 = WORK 00061000 * GPR10 = WORK 00062000 * GPR11 = WORK 00063000 * GPR12 = BASE 00064000 * GPR13 = TASK SAVE AREA ADDRESSABILITY 00065000 * GPR14 = RETURN 00066000 * GPR15 = ALTERNATE BASE 00067000 * 00068000 * NOTES - 00069000 * 00070000 * NONE 00071000 * 00072000 * OPERATION - 00073000 * 00074000 * SEE EACH SUBROUTINE 00075000 * 00076000 *. 00077000 EJECT 00078000 DMTCOM CSECT 00079000 ENTRY DMTCOMVC 00080000 SPACE 00081000 DMTCOMVC EQU * 00082000 DC A(GETLINK) GET LINK TABLE ENTRY ROUTINE 00083000 DC A(GETPAGE) GET PAGE OF MAIN STORAGE 00084000 DC A(FREEPAGE) FREE PAGE OF MAIN STORAGE 00085000 DC A(MFI) STACK A MESSAGE ELEMENT 00086000 DC A(MFO) UNSTACK A MESSAGE 00087000 DC A(TODEBCD) CONVERT TIME 00088000 SPACE 3 00089000 USING SVECTORS,0 GET SVECTORS ADDRESSABILITY 00090000 USING TAREA,R13 GET SAVEAREA ADDRESSABILTIY 00091000 USING LINKTABL,R2 GET LINKTABLE ADDRESSABILITY 00092000 USING TASKE,R6 GET TASK ELEMENT ADDRESSABILITY 00093000 USING MSGSTACK,R3 GET MESSAGE STACK ADDRESSABILITY 00094000 EJECT 00095000 *. 00096000 * 00097000 * ENTRY NAME - 00098000 * 00099000 * GETLINK 00100000 * 00101000 * FUNCTION - 00102000 * 00103000 * TO SCAN THE LINK TABLE CHAIN AND RETURN A LINK TABLE ADDRESS 00104000 * 00105000 * CALLS TO OTHER ROUTINES - 00106000 * 00107000 * NONE 00108000 * 00109000 * ENTRY CONDITIONS - 00110000 * 00111000 * R0 - NUMBER OF BYTES IN LINKID FIELD 00112000 * R1 - ADDR OF LINKID FIELD 00113000 * R13- ADDRESS OF AN 18 FW SAVEAREA 00114000 * R14- RETURN ADDRESS 00115000 * 00116000 * EXIT CONDITIONS - 00117000 * 00118000 * R1 = LINK TABLE ADDR IF FOUND 00119000 * R15= 0 IF LINK TABLE MATCH FOUND 00120000 * R15= X'10' IF LINK TABLE MATCH NOT FOUND 00121000 * 00122000 * OPERATION - 00123000 * 00124000 * 1. MOVE SUPPLIED LINK ID TO STAGING AREA. 00125000 * 00126000 * 2. SCAN LINK TABLE CHAIN FOR MATCH. 00127000 * 00128000 * 3. IF FOUND RETURN LINK TABLE ADDR IN R1. 00129000 * 00130000 * 4. IF NOT FOUND INDICATE ERROR AND RETURN. 00131000 * 00132000 * RESPONSES - 00133000 * 00134000 * NONE 00135000 * 00136000 * ERROR MESSAGES - 00137000 * 00138000 * NONE 00139000 * 00140000 *. 00141000 SPACE 2 00142000 GETLINK DS 0H'0' 00143000 STM R0,R15,TGREG0 SAVE REGISTERS 00144000 USING GETLINK,R12 GET ROUTINE ADDRESSABILITY 00145000 LA R12,0(R15) USE R12 FOR ADDRESSABILITY 00146000 LTR R0,R0 COUNT ZERO? 00147000 BZ GETLMISS NOTHING ELSE TO DO 00148000 LR R2,R0 LOAD DIFFERENT REGISTER 00149000 MVI TPSW+1,X'40' USER THIS FOR STAGING AREA 00150000 MVC TPSW+2(6),TPSW+1 SO CLEAR IT TO BLANKS 00151000 BCTR R2,0 REDUCE COUNT FOR EXECUTE 00152000 EX R2,GETLMOVE AND MOVE INTO STAGING AREA 00153000 L R2,TLINKS GET LINK TABLE CHAIN START 00154000 L R3,0(R2) GET NUMBER OF ENTRIES 00155000 LA R2,8(,R2) AND THE FIRST ENTRY 00156000 GETLNEXT EQU * 00157000 LR R1,R2 UPDATE R1 INCASE OF MATCH 00158000 CLC LINKID(8),TPSW AND SEE IF THIS ONE MATCHS 00159000 BE GETLHIT YES 00160000 LA R2,LINKLEN(,R2) AND BUMP TO NEXT ENTRY 00161000 BCT R3,GETLNEXT NO CHECK THE NEXT ONE 00162000 GETLMISS EQU * 00163000 LA R15,16 SET RETURN CODE 00164000 L R1,TGREG1 RESTORE R1 00165000 B GETLCXIT ENTER COMMON EXIT 00166000 SPACE 1 00167000 GETLHIT EQU * 00168000 SR R15,R15 SET RETURN CODE 00169000 GETLCXIT EQU * 00170000 LM R2,R14,TGREG2 RESTORE THE OTHER REGS 00171000 BR R14 AND RETURN 00172000 DROP R12 00173000 SPACE 1 00174000 GETLMOVE MVC TPSW(0),0(R1) TO BE EXECUTED FROM ABOVE 00175000 EJECT 00176000 *. 00177000 * 00178000 * ENTRY NAME - 00179000 * 00180000 * GETPAGE 00181000 * 00182000 * FUNCTION - 00183000 * 00184000 * TO GET A FREE PAGE OF MAIN STORAGE 00185000 * 00186000 * CALLS TO OTHER ROUTINES - 00187000 * 00188000 * DMTSTO - TO RETRIEVE A PAGE 00189000 * 00190000 * EXIT CONDITIONS - 00191000 * 00192000 * R1 = 0 IF PAGE NOT AVAILABLE 00193000 * R1 = PAGE ADDRESS IF AVAILABLE 00194000 * 00195000 * OPERATION - 00196000 * 00197000 * 1. SCAN THE MAIN STORAGE MAP FOR A FREE PAGE 00198000 * 00199000 * 2. IF FOUND MARK IT IN USE THE THE CALLING TASK 00200000 * 00201000 * 3. RETURN ITS ADDRESS IN R1 00202000 * 00203000 * RESPONSES - 00204000 * 00205000 * NONE 00206000 * 00207000 * ERROR MESSAGES - 00208000 * 00209000 * NONE 00210000 * 00211000 *. 00212000 SPACE 2 00213000 GETPAGE DC 0H'0' 00214000 USING *,R15 GET ADDRESSABILITY 00215000 SR R1,R1 CLEAR RETURN CODE TO START 00216000 STM R0,R15,TGREG0 SAVE CALLERS REGISTERS 00217000 LA R12,0(R15) GET THE RIGHT BASE 00218000 DROP R15 ALL DONE WITH THIS ONE 00219000 USING GETPAGE,R12 USE THIS FOR ADDRESSING 00220000 L R1,MAINSIZE R1=TOTAL PAGES IN VIRTUAL STORAGE 00221000 BCTR R1,0 BUMP BK 1 FOR DISP INTO MAIN TAB 00222000 L R2,MAINMAP R2=ADDRESS OF MAIN STORAGE MAP 00223000 GETPNEXT EQU * 00224000 LA R3,0(1,R2) R3=ADDRESS OF ENTRY TO BE INSPECTED 00225000 CLI 0(R3),X'00' IS THIS PAGE FREE NOW? 00226000 BE GETPTRY YEP - GO TRY TO CLAIM IT 00227000 GETPRTRY EQU * 00228000 BCT R1,GETPNEXT OTHERWISE,TRY NEXT PAGE DOWN IN STOR 00229000 EJECT 00230000 GETPEXIT EQU * 00231000 LM R2,R15,TGREG2 RESTORE REGISTERS 00232000 BR R14 AND RETURN TO THE CALLER 00233000 SPACE 1 00234000 GETPTRY EQU * 00235000 LA R0,1 ASK FOR ONLY ONE PAGE 00236000 L R15,MAINREQ R15=ENTRY ADDRESS FOR MAIN STOR REQ 00237000 BALR R14,R15 REQ THE LOCATED MAIN STORAGE PAGE 00238000 LTR R15,R15 DID WE GET IT O.K.? 00239000 BNZ GETPRTRY NOPE - TRY ANOTHER 00240000 SLL R1,12 OTHERWISE, R1=ADDRESS OF GOTTEN PAGE 00241000 B GETPEXIT AND GO REST AND RET TO THE CALLER 00242000 EJECT 00243000 *. 00244000 * 00245000 * ENTRY NAME - 00246000 * 00247000 * FREEPAGE 00248000 * 00249000 * FUNCTION - 00250000 * 00251000 * TO RETURN A PAGE OF MAIN STORAGE 00252000 * 00253000 * CALLS TO OTHER ROUTINES - 00254000 * 00255000 * NONE 00256000 * 00257000 * ENTRY CONDITIONS - 00258000 * 00259000 * R1 - ADDRESS OF PAGE OF MAIN STORAGE TO BE FREED 00260000 * 00261000 * OPERATION - 00262000 * 00263000 * 1. FREE THE REQUESTED PAGE IN THE MAIN STORAGE 00264000 * MAP 00265000 * 00266000 * RESPONSES - 00267000 * 00268000 * NONE 00269000 * 00270000 * ERROR MESSAGES - 00271000 * 00272000 * NONE 00273000 * 00274000 *. 00275000 SPACE 2 00276000 FREEPAGE DS 0H'0' 00277000 USING *,R15 GET ADDRESSABILITY 00278000 STM R0,R15,TGREG0 SAVE REGISTERS 00279000 LTR R1,R1 SEE OF ZERO? 00280000 BZ FREEDONE YEP NOTHING TO DO 00281000 SRL R1,12 CREATE PAGE TABLE ENTRY 00282000 L R2,MAINMAP GET MAP ADDRESS 00283000 ALR R2,R1 CREATE OFFSET IN TABLE 00284000 MVI 0(R2),X'00' CLEAR PAGE 00285000 FREEDONE EQU * 00286000 LM R0,R15,TGREG0 RESTORE REGISTERS 00287000 BR R14 AND RETURN 00288000 EJECT 00289000 *. 00290000 * 00291000 * ENTRY NAME - 00292000 * 00293000 * MFI 00294000 * 00295000 * FUNCTION - 00296000 * 00297000 * THIS ROUTINE WILL STACK MESSAGE ELEMENTS IN A LIFO 00298000 * FOR LATER PROCESSING. IF NO ROOM IS AVAILABLE IN 00299000 * THE CURRENT PAGE, A NEW PAGE WILL FETCHED IF THERE ARE 00300000 * AT LEAST 5 FREE PAGES REMAINING, IF NOT AN ERROR 00301000 * CONDITION IS RETURNED. 00302000 * ALL TASKS OTHER THAN REX ARE ALLOWED ONLY THREE PAGES OF 00303000 * STORAGE TO STACK MESSAGES. 00304000 * 00305000 * CALLS TO OTHER ROUTINES - 00306000 * 00307000 * NONE 00308000 * 00309000 * ENTRY CONDITIONS - 00310000 * 00311000 * R1 - ADDR OF MESSAGE ELEMENT TO STACK 00312000 * R2 - ADDR OF THIS TASKS LINK TABLE 00313000 * 00314000 * EXIT CONDITIONS - 00315000 * 00316000 * R15 - X'10' IF MESSAGE CANNOT BE QUEUED 00317000 * X'00' IF MESSAGE IS QUEUED 00318000 * 00319000 * OPERATION - 00320000 * 00321000 * 1. SKIP TO THE CURRENT MESSAGE BUFFER. 00322000 * 00323000 * 2. TRY TO FIT MSG IN THE CURRENT BUFFER 00324000 * 00325000 * 3. MIGRATE MSGS TO TOP OF BUFFER IF NECESSARY 00326000 * 00327000 * 4. GET NEW PAGE IF NECESSARY AND IF MAX PAGES 00328000 * FOR THIS TASK HAVE NOT BEEN EXCEEDED. 00329000 * 00330000 * 5. MOVE MESSAGE TO BUFFER 00331000 * 00332000 * RESPONSES - 00333000 * 00334000 * NONE 00335000 * 00336000 * ERROR MESSAGES - 00337000 * 00338000 * NONE 00339000 * 00340000 *. 00341000 EJECT 00342000 MFI DC 0H'0' 00343000 USING *,R15 GET ADDRESSABILITY 00344000 CLI ACTIVE,X'00' ARE WE RUNNING DISPATCHED? 00345000 BE MFINODSP YES 00346000 FREEZE STOP IT ALL 00347000 LA R10,16 INDICATE RUNNING DISPATCHED 00348000 B MFIPNT AND CONTINUE 00349000 SPACE 1 00350000 MFINODSP EQU * 00351000 STM R0,R11,MFSAVE SAVE REGISTERS 00352000 SR R10,R10 INDICATE RUNNING NON DISPATCHED 00353000 MFIPNT EQU * 00354000 SR R11,R11 CLEAR PAGE COUNT REGISTER 00355000 LA R3,LMSGQ-(MSTKPTR-MSGSTACK) LOAD INITIAL BACK ONE 00356000 ICM R4,B'1111',0(R3) ANYTHING IN QUEUE? 00357000 BNZ MFILOP MUST HAVE ALREADY BEEN HERE 00358000 SR R5,R5 CLEAR R5 FOR IC 00359000 IC R5,0(R1) GET THE ELEMENT LENGTH 00360000 S R5,F3 DOWN BY THREE 00361000 B MFIGPGE EMPTY GO GET A NEW PAGE 00362000 SPACE 00363000 MFILOP EQU * 00364000 LA R11,1(,R11) UP COUNT BY ONE 00365000 LR R4,R3 UPDATE POINTER 00366000 ICM R3,B'1111',MSTKPTR GET THE NEXT POINTER 00367000 BNZ MFILOP NO AT END CONTINUE 00368000 MFIFND EQU * 00369000 BCTR R11,0 REDUCE PAGE COUNTER 00370000 LR R3,R4 GET THE LAST ADDR 00371000 SR R5,R5 CLEAR R5 FOR IC 00372000 IC R5,0(R1) GET THE ELEMENT LENGTH 00373000 S R5,F3 DOWN BY THREE 00374000 LR R4,R3 GET READY TO COMPUTE THE NEXT PAGE 00375000 SRL R4,12 GET PAGE ADDR 00376000 LA R4,1(R4) UP BY ONE 00377000 SLL R4,12 AND RESET TO BEGINNING 00378000 L R6,MSTKLOAD GET THE LOAD POINT 00379000 SR R4,R6 ENOUGH ROOM HERE AT END? 00380000 LA R7,1(,R5) ALLOW FOR OVERHEAD CHARS @VA03744 00381100 CR R7,R4 ENOUGH ROOM LEFT? @VA03744 00381200 BL MFISTK YEP GO TO IT 00382000 L R7,MSTKUNLD GET THE UNLOAD POINT 00383000 LA R6,MSTKDATA AND THE START OF THE DATA AREA 00384000 SR R7,R6 FREE SPACE AT BEGINNING 00385000 BZ MFIGPGE NO SPACE GET A PAGE 00386000 AR R4,R7 TOTAL FREE SPACE IN THIS PAGE 00387000 CR R5,R4 ENOUGH ROOM? 00388000 BNL MFIGPGE NO GET A PAGE 00389000 MFIMIG EQU * 00390000 L R8,MSTKUNLD GET UNLOAD POINT IN R8 @VM01114 00391010 L R9,MSTKLOAD GET THE LOAD PNT 00392000 SR R9,R8 AMOUNT TO MOVE @VM01114 00393010 LR R7,R9 ALSO PUT IT HERE 00394000 LR R4,R7 GET LENGTH HERE ALSO @VM01114 00394500 MVCL R6,R8 FINALLY MOVE IT 00395000 LA R6,MSTKDATA GET NEW LOAD POINT ADDR @VM01114 00395500 ST R6,MSTKUNLD STORE NEW UNLOAD POINT 00396000 AR R6,R4 CALCULATE NEW LOAD POINT @VM01114 00397010 ST R6,MSTKLOAD AND SAVE IT 00398000 B MFISTK STACK THE MESSAGE 00399000 SPACE 00400000 MFIGPGE EQU * 00401000 L R6,TLINKS GET LINK TABLE ADDR 00402000 LA R6,8(R6) GET THE FIRST ENTRY 00403000 CLR R6,R2 REX CALLING US? 00404000 BE MFIGPGE1 YES ..NO RESTRICTION 00405000 CL R11,F3 HAVE WE REACHED THE MAX? 00406000 BNL MFIGERR YES..RETURN ERROR 00407000 MFIGPGE1 EQU * 00408000 LA R6,5 MUST HAVE FIVE LEFT 00409000 L R7,MAINSIZE NUMBER OF MAIN STOR PAGES 00410000 L R8,MAINMAP AND THE MAP START 00411000 MFIGLOOP EQU * 00412000 BCT R7,MFIGTEST DOWN BY ONE PAGE 00413000 B MFIGERR NOT ENOUGH LEFT 00414000 MFIGTEST EQU * 00415000 LA R9,0(R8,R7) COMPUTE TABLE OFFSET 00416000 CLI 0(R9),X'00' PAGE FREE? 00417000 BNE MFIGLOOP NO 00418000 BCT R6,MFIGLOOP COUNT IT AND CONTINUE 00419000 L R6,TASKQ GET TASK QUEUE START 00420000 MFIPFLOP EQU * 00421000 CLC TASKNAME(4),LACTTNME IS THIS THE CORRECT TASK NAME? 00422000 BE MFIPTAKE YES TAKE IT 00423000 L R6,TASKNEXT GET THE NEXT TASK ELEMENT 00424000 B MFIPFLOP AND COMPARE IT 00425000 SPACE 1 00426000 MFIPTAKE EQU * 00427000 MVC 0(1,R9),TASKID MOVE THIS TASKID TO TABLE 00428000 SLL R7,12 THIS IS THE PAGE 00429000 LA R6,MSTKDATA-MSGSTACK(R7) THIS IS THE LOAD AND UNLOAD PNT 00430000 ST R6,MSTKLOAD-MSGSTACK(R7) THIS IS THE LOAD POINT 00431000 ST R6,MSTKUNLD-MSGSTACK(R7) AND ALSO THE UNLOAD POINT 00432000 XC 0(4,R7),0(R7) CLEAR FORWARD POINTER 00433000 ST R7,MSTKPTR AND ADD TO CHAIN 00434000 LR R3,R7 AND UPDATE REGISTER POINTER 00435000 EJECT 00436000 MFISTK EQU * 00437000 L R4,MSTKLOAD GET LOAD POINT 00438000 STC R5,2(R1) STORE COUNT IN SAVED ELEMENT 00439000 LA R5,1(R5) UP ONE FOR SEV 00440000 EX R5,MFISTMVC AND MOVE IN STACK 00441000 LA R5,1(R5) ADD IN 1 FOR COUNT 00442000 AR R4,R5 CALCULATE NEW LOAD POINT 00443000 ST R4,MSTKLOAD AND STORE AWAY 00444000 SR R0,R0 CLEAR RETURN CODE 00445000 B MFIXIT AND ENTER COMMON EXIT 00446000 SPACE 1 00447000 MFIGERR EQU * 00448000 LA R0,16 INDICATE ERROR 00449000 MFIXIT EQU * 00450000 LTR R10,R10 RUNNING DISPATCHED? 00451000 BZ MFINDXIT NO CONTINUE 00452000 ST R0,TGREG15-TAREA(R14) STORE RETURN CODE 00453000 L R15,DISPATCH GET DISPATCHER ENTRY POINT 00454000 BALR R14,R15 AND EXIT 00455000 SPACE 1 00456000 MFINDXIT EQU * 00457000 LM R1,R11,MFSAVE+4 RESTORE REGS 00458000 LR R15,R0 SET RETURN CODE 00459000 BR R14 AND RETURN 00460000 SPACE 1 00461000 MFISTMVC MVC 0(0,R4),2(R1) TO BE EXECUTED FROM ABOVE 00462000 EJECT 00463000 *. 00464000 * 00465000 * ENTRY NAME - 00466000 * 00467000 * MFO 00468000 * 00469000 * FUNCTION - 00470000 * 00471000 * THIS ROUTINE WILL UNSTACK MESSAGE ELEMENTS FROM THE 00472000 * MESSAGE QUEUE FOR THIS TASK. IF NONE ARE QUEUED AN 00473000 * ERROR CONDITION IS RETURNED. 00474000 * 00475000 * CALLS TO OTHER ROUTINES - 00476000 * 00477000 * NONE 00478000 * 00479000 * ENTRY CONDITIONS - 00480000 * 00481000 * R1 - ADDR OF USERS MESSAGE BUFFER 00482000 * R2 - ADDR OF THIS TASKS LINK TABLE ENTRY 00483000 * 00484000 * EXIT CONDITIONS - 00485000 * 00486000 * R15 - X'00' MESSAGE IS IN BUFFER 00487000 * X'10' NO MESSAGES ARE QUEUED 00488000 * 00489000 * OPERATION - 00490000 * 00491000 * 1. IF MSGS ARE PRESENT MOVE TO USERS BUFFER. IF NOT 00492000 * RETURN WITH ERROR. 00493000 * 00494000 * 2. IF PAGE IS COMPLETELY EMPTY FREE THE PAGE 00495000 * 00496000 * RESPONSES - 00497000 * 00498000 * NONE 00499000 * 00500000 * ERROR MESSAGES - 00501000 * 00502000 * NONE 00503000 * 00504000 *. 00505000 SPACE 2 00506000 MFO DC 0H'0' 00507000 USING *,R15 GET ADDRESSABILITY 00508000 CLI ACTIVE,X'00' ARE WE RUNNING DISPATCHED? 00509000 BE MFONODSP YES 00510000 FREEZE STOP IT ALL 00511000 LA R10,16 INDICATE RUNNING DISPATCHED 00512000 B MFOPNT AND CONTINUE 00513000 SPACE 1 00514000 MFONODSP EQU * 00515000 STM R0,R10,MFSAVE SAVE REGISTERS 00516000 SR R10,R10 CLEAR INDICATING NON DISPATCHED 00517000 MFOPNT EQU * 00518000 ICM R3,B'1111',LMSGQ GET THE MSG BUFFER POINTER 00519000 BZ MFONOMSG NO MSGS TO BE HAD 00520000 L R4,MSTKUNLD GET THE UNLOAD POINT 00521000 SR R5,R5 CLEAR FOR IC 00522000 IC R5,0(R4) INSERT THE ELEMENT COUNT 00523000 LA R5,1(R5) UP BY ONE FOR SEVERITY 00524000 EX R5,MFOMVC MOVE TO USERS BUFFER 00525000 LA R5,1(R5) INCLUDE THE COUNT BYTE 00526000 AR R4,R5 CALCULATE NEW UNLOAD POINT 00527000 SR R0,R0 CLEAR RETURN BYTE 00528000 ST R4,MSTKUNLD UPDATE UNLOAD POINT 00529000 CL R4,MSTKLOAD NOTHING LEFT IN PAGE? 00530000 BL MFOXIT YES..EXIT 00531000 MVC LMSGQ(4),MSTKPTR DECHAIN PAGE 00532000 SRL R3,12 CALCULATE PAGE TABLE ENTRY 00533000 L R2,MAINMAP GET MAIN STORAGE MAP ADDR 00534000 ALR R2,R3 GET OFFSET INTO TABLE 00535000 MVI 0(R2),X'00' CLEAR IT 00536000 B MFOXIT AND ENTER COMMON EXIT 00537000 SPACE 1 00538000 MFONOMSG EQU * 00539000 LA R0,16 INDICATE NO MESSAGES 00540000 MFOXIT EQU * 00541000 LTR R10,R10 RUNNING DISPATCHED? 00542000 BZ MFONDXIT NO CONTINUE 00543000 ST R0,TGREG15-TAREA(R14) STORE RETURN CODE 00544000 L R15,DISPATCH GET DISPATCHER ENTRY POINT 00545000 BALR R14,R15 AND EXIT 00546000 SPACE 1 00547000 MFONDXIT EQU * 00548000 LM R1,R10,MFSAVE+4 RESTORE REGS 00549000 LR R15,R0 SET RETURN CODE 00550000 BR R14 AND RETURN 00551000 SPACE 1 00552000 MFOMVC MVC 0(0,R1),0(R4) TO BE EXECUTED FROM ABOVE 00553000 SPACE 1 00554000 MFSAVE DS 12F SAVE AREA FOR MFI AND MFO 00555000 EJECT 00556000 *. 00557000 * 00558000 * ENTRY NAME - 00559000 * 00560000 * GTODEBCD 00561000 * 00562000 * FUNCTION - 00563000 * 00564000 * CONVERT A S/370 FORMAT TOD TO EBCDIC DATE AND TIME. 00565000 * 00566000 * CALLS TO OTHER ROUTINES - 00567000 * 00568000 * NONE 00569000 * 00570000 * OPERATION - 00571000 * 00572000 * 1. CONVERT TIME AND DATE AND EDIT INTO USER 00573000 * SUPPLIED FIELD. 00574000 * 00575000 * 2. OBTAIN DAY OF THE WEEK AND TIME ZONE 00576000 * AND MOVE INTO USER SUPPLIED FIELD 00577000 * 00578000 * ENTRY - 00579000 * 00580000 * R0, R1=S/370 FORMAT TOD TO BE CONVERTED 00581000 * R2=ADDRESS OF A FIELD INTO WHICH THE OUTPUT 00582000 * IS TO BE EDITED BY MEANS OF AN EDIT INSTR. 00583000 * (THIS FIELD MUST START WITH A BYTE SET TO 00584000 * ONE LESS THAN THE TOTAL LENGTH OF THE FIELD, 00585000 * WHICH SHOLUD CONTAIN AN EDITING MASK, INTO 00586000 * WHICH THE RESULT IS TO BE PLACED. 00587400 * BLANKS ARE MOVED INTO THE SIX BYTE FIELD 00587800 * IMMEDIATELY FOLLOWING THE SPECIFIED 00588200 * OUTPUT EDITING FIELD.) 00590000 * 00591000 * R13= ADDRESS OF AN 21 FW FIELD OF THE FOLLOWING 00592000 * INITIAL FORMAT: 00593000 * 00594000 * DC 3D'0' FOR DATE AND TIME DECIMAL CONVERSION 00595000 * DC A(0) FIELD TO RECEIVE CONVERTED DAY OF THE WK 00596000 * DC F'-1' TO HOLD LAST CALCULATION ELAPSED HOURS 00597000 * DC A(0+4) SW USED AS AN INDEX, FOR STD VS DLT 00598000 * DC A(TIMEZON+4) ADDR OF TIMEZON TABLE IN CALLERS 00599000 * STORAGE 00600000 * DC 11F'0' SAVE AREA 00601000 * 00602000 * NOTE: THIS AREA SHOULD NOT BE MODIFIED AFTER THE INITIAL CALL 00603000 * 00604000 * EXIT - 00605000 * 00606000 * DATE, TIME, AND TIME ZONE HAVE BEEN GENERATED AND 00607000 * AND MOVED TO THE SPECIFIED OUTPUT AREA. 00608000 * 00609000 EJECT 00610000 * 00611000 * RESPONSES - 00612000 * 00613000 * NONE 00614000 * 00615000 * ERROR MESSAGES - 00616000 * 00617000 * NONE 00618000 * 00619000 *. 00620000 SPACE 2 00621000 TODEBCD DC 0H'0' 00622000 USING *,R15 GET ADDRESSABILITY 00623000 USING TODDSECT,R13 GET COMMON AREA ADDRESSABILITY 00624000 STM R0,R10,TODSAVE+4*R0 SAVE REGISTERS TO BE MODIFIED 00625000 TODRETRY EQU * 00626000 SRDL R0,12 RIGHT JUST TIME OF DAY MICROSECONDS 00627000 LM R3,R5,TODEBCON LOAD KEY VALUES FROM LAST COMP 00628000 LA R10,0(R4,R5) R10=ADDR OF APPROPRIATE TIMEZONE ENT 00629000 SLR R6,R6 CLEAR R6 FOR RETURN FIELD LENGTH 00630000 IC R6,0(R2) R6=LENGTH OF CALLER'S EDIT MASK 00631000 LA R2,1(R6,R2) R2=ADDR OF RETURN FIELD FOR TIMEZONE 00632000 MVC 0(6,R2),2(R10) GIVE CALLER TIMEZONE NAME IN EBCDIC 00633000 D R0,F60MEG 370 TOD BY 60,000,000(NO. USEC/MIN) 00634000 LR R10,R0 R10=ODD MICROSECONDS LESS THAN A MIN 00635000 SLR R0,R0 CLEAR R0 FOR MORE DIVIDING 00636000 AH R1,0(R4,R5) ADJUST TIMEZONE DIFFERENCE FROM GMT 00637000 D R0,F60 DIVIDE MINUTES BY 60 TO GET HOURS 00638000 LR R9,R0 R9=ODD MINUTES LESS THAN AN HOUR 00639000 CLR R1,R3 HOUR SAME AS FOR THE LAST CONV? 00640000 BNE NEWHOUR NOPE-GOTTA GO DO A COMPLETE COMP 00641000 TODFINIS EQU * 00642000 LR R1,R10 R1=ODD MICROSECONDS LESS THAN A MIN 00643000 SLR R0,R0 CLEAR R0 FOR DIVIDE 00644000 D R0,F10 R1=SECONDS TO FIVE DECIMAL PLACES 00645000 M R8,F10MEG SHIFT MINUTES LEFT SEVEN PLACES DEC 00646000 ALR R9,R1 SET SEC AND FRACTION TO RIGHT OF MIN 00647000 CVD R9,MMSSMMMM FIELD=DECIMAL '000000MMSSMMMMMZ' 00648000 IC R0,MMSSMMMM+3 SAVE DECIMAL MINUTES THROUGH MVO 00649000 MVO MMSSMMMM-2(6),MMDDYYHH+3(5) APPEND DATE AND HOUR 00650000 STC R0,MMSSMMMM+3 RESTORE MINUTES CLOBBERED BY ZONE 00651000 L R2,TODSAVE+4*R2 RESTORE CALLER'S R2 00652000 IC R1,0(R2) R1=LENGTH OF CALLER'S EDIT MASK 00653000 MVI 0(R2),C' ' SET FILL CHARACTER OF MASK TO A BLNK 00654000 EX R1,TODEDIT EDIT OUTPUT INTO CALLER'S FIELD 00655000 LM R0,R10,TODSAVE+4*R0 RESTORE MODIFIED CALLER'S REGS 00656000 L R15,DAYNUMBR SET RETURN DAY OF WEEK 0 -> 6 IN R15 00657000 BR R14 AND RETURN TO THE CALLER 00658000 SPACE 00659000 TODEDIT ED 0(0,R2),MMSSMMMM-1 EDIT TO BE EXECUTED BY ABOVE CODE 00660000 SPACE 00661000 NEWHOUR EQU * 00662000 ST R1,TODEBCON SAVE HOUR COMPUTATION FOR NEXT CALL 00663000 SLR R0,R0 CLEAR R0 FOR MORE DIVIDING 00664000 D R0,F24 DIV HRS BY 24 TO GET DAYS AND ODD HR 00665000 LR R8,R0 R8=ODD HOURS LESS THAN ONE DAY 00666000 SPACE 00667000 FIRSTDAY EQU 1 - JANUARY 1, 1900, WAS A MONDAY 00668000 SPACE 00669000 LA R3,FIRSTDAY(R1) R3=DAY COUNT SINCE SUNDAY LONG PAST 00670000 SLR R2,R2 CLEAR R2 FOR DIVIDE TO FOLLOW 00671000 D R2,F7 R2=CURRENT WEEKDAY NUMBER 0 -> 6 00672000 ST R2,DAYNUMBR SAVE WEEKDAY FOR LATER REF AND RET 00673000 SPACE 00674000 SLR R7,R7 ASSUME NO LEAPYEAR FOR NOW 00675000 S R1,F365 SUBTRACT THE DAYS IN 1900 00676000 BM YEAR1900 DEAL WITH SPEC PROB IF YEAR IS 1900 00677000 SLR R0,R0 CLEAR R0 FOR YET MORE DIVIDING 00678000 D R0,F1461 DIV DYS BY DYS IN 4 YEARS((4*365)+1) 00679000 SLL R1,2 MULT QUOTIENT BY FOUR TO GET YEARS 00680000 LA R5,1(R1) R5=YEARS LESS ODD YEARS NORM TO 1900 00681000 LR R3,R0 R3=REMAINING DAYS 00682000 SLR R2,R2 CLEAR R2 FOR IMPENDING DIVIDE 00683000 D R2,F365 GET NUM OF ODD YRS AND ODD DYS LEFT 00684000 CL R3,F3 CHECK FOR PRESENCE OF LEAPYEAR 00685000 BL YEARSET GO FIN YEAR NUMBER IF NOT LEAPYEAR 00686000 LA R7,1 ADJUST EXTRA DAY REG FOR LEAPYEAR 00687000 BE YEARSET COMP YEAR NUM IF NO SPECIAL PROB 00688000 BCTR R3,0 OTHERWISE SET ODD YEAR REG BACK TO 3 00689000 LA R2,365 SET DY OF YR TO LAST DAY OF LEAPYEAR 00690000 YEARSET EQU * 00691000 ALR R5,R3 ADD ODD YRS TO FORM EXACT YEAR IN R5 00692000 DATECALC EQU * 00693000 LA R2,1(R2) BUMP DATE TO STA AT ONE RATH THAN 0 00694000 LA R1,59(R7) R1=60 IF LEAPYEAR, 59 IF NOT 00695000 CLR R2,R1 IS THE DATE PAST FEBRUARY? 00696000 BNH WINTER NOPE - LET THE DATE STAND AS IT IS 00697000 LA R2,2(R2) SET FOR NON LEAPYEAR INITIALLY... 00698000 SLR R2,R7 DEC BY ONE IF DATE IS OF A LEAPYEAR 00699000 WINTER EQU * 00700000 LA R3,91(R2) R3=DATE OF YEAR + 91 00701000 LR R7,R3 R7=SAME THING 00702000 M R2,F2145 MAGIC NUMBER - NO INTUITIVE EXPL 00703000 SRL R3,16 DIV BY 65536 TO GET MONTH NUMBER + 2 00704000 LR R6,R3 R6=NUMBER OF MONTH + 2 00705000 BCTR R6,0 R6=NUMBER OF MONTH + 1 00706000 BCTR R6,0 R6=NUMBER OF MONTH EXACTLY 00707000 M R2,F1955 MULTIPLY BY ANOTHER MAGIC NUMBER 00708000 SRL R3,6 DIV BY 64 GET TOT DYS IN PAST MON+91 00709000 SLR R7,R3 R7=EXACT DATE OF MONTH 00710000 LA R0,4 SET TIME TYPE FLAG TO DIFF TABLE DIS 00711000 LCR R0,R0 SET FLAG TO STAN TIME (-4) INITIALLY 00712000 CL R6,F4 COMPARE MONTH NUMBER TO APRIL NUMBER 00713000 BL FLAGCHEK FLAG IS CORRECT GO LOOK AT CALC FLAG 00714000 LA R1,0 INIT MON INDICATOR INCASE OF BRANCH 00715000 BE DETAILS DO A CLOSE INSP IF DATE IS IN APRIL 00716000 CL R6,F10 AFTER APRIL-COMPARE MONTH TO OCT 00717000 BH FLAGCHEK DATE IS AFT OCT-STANDARD TIME SET OK 00718000 LA R0,4 OTHERWISE RESET FLAG TO DAYLITE TIME 00719000 BL FLAGCHEK FLAG SET PROP IF AFT APR BEFORE OCT 00720000 LA R1,1 MUST CHECK CLOSELY - SET OCT IND 00721000 DETAILS EQU * 00722000 LA R2,30(R1) R2=DAYS IN MONTH - APRIL OR OCTOBER 00723000 LA R4,7(R7) R4=COMPUTED DATE OF MONTH + 7 00724000 SR R4,R2 R4=NUM OF DAYS PAST IN LAST WK OF MO 00725000 BM FLAGCHEK DATE COMP IS PRIOR TO STA OF LAST WK 00726000 CL R4,DAYNUMBR WILL SUNDAY OCCUR BETWEEN 00727000 * TOMORROW AND THE END OF THE MONTH? 00728000 BNH FLAGCHEK YES - TIME FLAG IS SET PROPERLY 00729000 CLI DAYNUMBR+3,X'00' IS COMPUTED DATE SUNDAY, PERHAPS? 00730000 BNE INVERT NOPE-AFTER SUN-INVERT FLAG AND CONT 00731000 L R4,TODEBCON+4 R4=FLAG USED IN PRIOR COMPUTATION 00732000 SRA R4,4 R4=-1 IF STAN USD; 0 IF DAYLITE USD 00733000 LCR R1,R1 R1=0 IF MONTH APR; -1 IF MONTH OCT 00734000 LA R2,3(R1,R4) R2=HOUR CHANGE COMP: 1, 2, OR 3 00735000 CLR R8,R2 IS COMPUTED TIME BEFORE TIME CHANGE? 00736000 BNH FLAGCHEK YES - FLAG HAS BEEN PROPERLY SET @VA07031 00737100 INVERT EQU * 00738000 LCR R0,R0 INVERT TIME FLAG TO PROPER SETTING 00739000 FLAGCHEK EQU * 00740000 CL R0,TODEBCON+4 NOW - DID WE USE THE RIGHT TIME TYPE? 00741000 BNE SETRETRY NO-MUST DO THE WHOLE COMP OVER AGAIN 00742000 SPACE 00743000 LA R2,100 SET DIVISOR FOR DEC MANIPULATIONS 00744000 LR R1,R6 R1=HEXADECIMAL MONTH NUMBER 00745000 MR R0,R2 SHIFT MONTH LEFT TWO PLACES DECIMAL 00746000 ALR R1,R7 SET DAY NUMBER INTO ACCUMULATION 00747000 MR R0,R2 SHIFT MMDD LEFT TWO PLACES DECIMAL 00748000 SLR R4,R4 CLEAR R4 FOR R5 YEAR DIVIDE 00749000 DR R4,R2 R4=YEAR NUMBER MODULO CENTURY 00750000 ALR R1,R4 SET TRUNCATED YEAR NUM INTO ACCUM 00751000 MR R0,R2 SHIFT MMDDYY LEFT TWO PLACES DECIMAL 00752000 ALR R1,R8 SET HOUR NUMBER INTO ACCUMULATION 00753000 CVD R1,MMDDYYHH FIELD=DECIMAL '0000000MMDDYYHHZ' 00754000 B TODFINIS GO BACK TO MAINLINE CODE TO FIN UP 00755000 SPACE 00756000 YEAR1900 EQU * 00757000 LA R2,365(R1) UNDO DAMAGE TO DATE OF YEAR 00758000 SLR R5,R5 SET YEAR NUMBER TO ZERO 00759000 B DATECALC AND GO CALCULATE THE DATE OF YEAR 00760000 SPACE 00761000 SETRETRY EQU * 00762000 SLR R1,R1 SET R1 TO ZERO AND... 00763000 BCTR R1,0 DECREMENT TO SET R1 TO -1 00764000 ST R1,TODEBCON DUM UP LAST HR VAL TO FORCE RECAL 00765000 ST R0,TODEBCON+4 SET PROP TIME TYPE FLAG FOR NEXT TRY 00766000 LM R0,R2,TODSAVE+4*R0 RESTORE CALLER'S INPUT REGISTERS 00767000 B TODRETRY AND START FROM THE TOP AGAIN 00768000 SPACE 00769000 F60MEG DC F'60000000' 00770000 F60 DC F'60' 00771000 F10 DC F'10' 00772000 F10MEG DC F'10000000' 00773000 F24 DC F'24' 00774000 F7 DC F'7' 00775000 F365 DC F'365' 00776000 F1461 DC F'1461' 00777000 F3 DC F'3' 00778000 F2145 DC F'2145' 00779000 F1955 DC F'1955' 00780000 F4 DC F'4' 00781000 EJECT 00782000 TODDSECT DSECT 00783000 MMDDYYHH DS 1D TO HOLD NEW HOUR CALCULATION IN DEC 00784000 DS 1D FOR APPENDING MMDDYYHH TO MMSSMMMM 00785000 MMSSMMMM DS 1D TO RECEIVE DECIMAL MINUTE AND SECOND 00786000 DAYNUMBR DS 1A TO RECEIVE COMPUTED DAY OF WEEK 0->6 00787000 TODEBCON DS 1F,2A SEE BELOW 00788000 * DC F'-1' TO HOLD LAST CALC ELAPSED HRS 00789000 * DC A(0+4) SWITCH, USED AS AN INDEX, FOR STD VS. DLT TIME 00790000 * DC A(TIMEZON+4) EXT ADDR OF TIMEZONE DISP TAB 00791000 TODSAVE DC 11F'0' TODEBCD ROUTINE SAVE AREA 00792000 EJECT 00793000 MSGSTACK DSECT 00794000 SPACE 1 00795000 *** MSGSTACK - MESSAGE STACK BUFFER 00796000 * 00797000 * 0 +-----------------------+-----------------------+ 00798000 * | MSTKPTR | MSTKLOAD | 00799000 * 8 +-----------------------+-----------------------+ 00800000 * | MSTKUNLD | | 00801000 * 10 +-----------------------+ | 00802000 * | | 00803000 * | MSTKDATA | 00804000 * | | 00805000 * 1000 +-----------------------------------------------+ 00806000 * 00807000 *** MSGSTACK - MESSAGE STACK BUFFER 00808000 SPACE 1 00809000 MSTKPTR DS 1A ADDRESS OF NEXT MSG STACK PAGE 00810000 MSTKLOAD DS 1A THIS PAGE LOAD POINT ADDRESS 00811000 MSTKUNLD DS 1A THIS PAGE UNLOAD POINT ADDRESS 00812000 MSTKDATA EQU * THIS PAGE FIRST DATA ADDRESS 00813000 EJECT 00814000 COPY SVECTORS 00815000 EJECT 00816000 COPY TASKE 00817000 EJECT 00818000 COPY TAREA 00819000 EJECT 00820000 COPY LINKTABL 00821000 EJECT 00822000 COPY RSSEQU 00823000 END 00824000