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