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