INM TITLE 'DMSINM (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. P8024 00005000
* P8024 00006000
* MODULE NAME - DMSINM P8024 00007000
* P8024 00008000
* FUNCTION - OBTAIN THE TIME FROM THE CP TIMER P8024 00009000
* P8024 00010000
* ATTRIBUTES - NUCLEUS RESIDENT, REENTRANT P8024 00011000
* P8024 00012000
* ENTRY POINTS - DMSINM, GETCLK,CMSTIMER P8024 00013000
* P8024 00014000
* ENTRY CONDITIONS P8024 00015000
* REGISTER 15 - ADDRESS OF MODULE FOR ADDRESSABILITY P8024 00016000
* REGISTER 1 - POINTS TO PLIST P8024 00017000
* PLIST FORM P8024 00018000
* DS 0F P8024 00019000
* DC CL8'CMSTIME' P8024 00020000
* DC F' ' PREVIOUS VALUE OF VIRUAL TIME P8024 00021000
* DC F' ' PREVIOUS VALUE OF TOTAL TIME P8024 00022000
* DC A(BUFFER) CALLER'S 26 BYTE BUFFER P8024 00023000
* DS F LENGTH OF BUFFER USED BY DMSINM P8024 00024000
* P8024 00025000
* THE LAST 2 ENTRIES IN THE PLIST ARE OPTIONAL, AND P8024 00026000
* NEITHER OF THEM IS USED IF THE GIVEN BUFFER P8024 00027000
* ADDRESS IS ZERO, OR IF THE FIRST BYTE OF THE P8024 00028000
* ADDRESS CONTAINS A FENCE (X'FF'). P8024 00029000
* P8024 00030000
* P8024 00031000
* EXIT CONDITIONS P8024 00032000
* REGISTER 15 IS SET TO ZERO P8024 00033000
* WHEN RUNNING UNDER CP, THE VALUES OF VIRTUAL P8024 00034000
* TIME AND TOTAL TIME ARE REPLACED BY THE NEW P8024 00035000
* VALUES; THE BUFFER, IF GIVEN, IS FILLED WITH P8024 00036000
* TIME DATA IN THE FORM: P8024 00037000
* P8024 00038000
* X.XX/Y.YY HH.MM.SS P8024 00039000
* P8024 00040000
* WHERE P8024 00041000
* P8024 00042000
* X.XX IS THE DIFFERENCE BETWEEN THE PRESENT VIRTUAL P8024 00043000
* CPU TIME AND THE OLD VALUE, IN SECONDS. P8024 00044000
* P8024 00045000
* Y.YY IS THE DIFFERENCE BETWEEN THE PRESENT TOTAL P8024 00046000
* CPU TIME AND THE OLD VALUE, IN SECONDS. P8024 00047000
* P8024 00048000
* H.MM.SS IS THE TIME-OF-DAY P8024 00049000
* P8024 00050000
* CALLS TO OTHER ROUTINES P8024 00051000
* NONE P8024 00052000
* P8024 00053000
* EXTERNAL REFERENCES P8024 00054000
* NUCON P8024 00055000
* P8024 00056000
* TABLES/WORKAREAS P8024 00057000
* NONE P8024 00058000
* P8024 00059000
* REGISTER USAGE P8024 00060000
* REG15 - BASE P8024 00061000
* REG2-9 - WORK REGISTERS P8024 00062000
* REG10-13 - NOT USED P8024 00063000
* REG14 - RETURN REGISTER P8024 00064000
* P8024 00065000
* OPERATION P8024 00066000
* P8024 00067000
* IF THE CALLER HAS SUPPLIED A BUFFER IT IS CLEARED. THEN THE P8024 00068000
* CP CLOCK IS READ. IF A BUFFER IS PROVIDED THE ELAPSED P8024 00069000
* VIRTUAL AND TOTAL ELAPSED CPU TIMES ARE EDITED AND P8024 00070000
* MOVED INTO THE BUFFER FOLLOWED BY THE TIME-OF-DAY. THE P8024 00071000
* NUMBER OF BYTES OF BUFFER USED IS STORED INTO THE CALLER'S P8024 00072000
* PLIST. THEN THE CURRENT VIRTUAL CPU AND TOTAL CPU TIMES P8024 00073000
* ARE SET INTO THE PLIST. REGISTER 15 IS SET TO ZERO P8024 00074000
* AND A RETURN IS MADE TO THE CALLER. IF NO BUFFER IS P8024 00075000
* PROVIDED, THE VIRTUAL CPU AND TOTAL CPU FIELDS IN P8024 00076000
* THE PLIST ARE FILLED WITH THE CURRENT ELAPSED TIMES, REGISTER P8024 00077000
* 15 IS SET TO ZERO AND A RETURN IS MADE TO THE CALLER. P8024 00078000
* P8024 00079000
*. P8024 00080000
* P8024 00081000
EJECT 00082000
CMSTIMER START 00083000
ENTRY GETCLK,DMSINM P3031 00084000
DMSINM EQU * P3031 00085000
GETCLK EQU * NOW THE SAME THING AS 'CMSTIME' 00086000
SPACE 00087000
USING NUCON,R0 00088000
USING CMSTIMER,R15 00089000
USING SUBSECT,R10 P8024 00090000
STM R1,R10,BALRSAVE SAVE REGS IN NUCON P8024 00091000
L R10,ASUBSECT ADDRESS OF WORK AREA P8024 00092000
L R5,16(,R1) ADDRESS OF CALLER'S BUFFER 00093000
LTR R5,R5 IS THERE ONE? 00094000
BNP NOCLEAR BRANCH IF NOT 00095000
MVI 0(R5),C' ' CLEAR IT... 00096000
MVC 1(25,R5),0(R5) ALL THE WAY WITH BLANKS. 00097000
SPACE 00098000
NOCLEAR LA R1,TIMBUF PREPARE TO READ CP CLOCK P8024 00099000
DC X'8310000C' 'DIAGNOSE' TO READ CLOCK P8024 00100000
LTR R5,R5 DID CALLER GIVE US A BUFFER? 00101000
BNP CPRET BRANCH IF NOT 00102000
L R2,CPDIV DIVIDER FOR RUNNING UNDER CP 00103000
L R3,TIMBUF+20 PICK UP PRESENT VAL OF VIRCPU P8024 00104000
L R1,BALRSAVE RESTORE POINTER P8024 00105000
S R3,8(,R1) AND SUBTRACT OLD VALUE GIVEN BY CALLER 00106000
BAL R4,EDITSUB LAY OUT THE ANSWER IN BUFFER 00107000
MVI 0(R5),C'/' MOVE IN A SLASH 00108000
L R2,CPDIV SET THE DIVIDER AGAIN 00109000
LA R5,1(,R5) AND INCREMENT BUFFER POINTER 00110000
L R3,TIMBUF+28 GET PRESENT VAL OF TOTCPU P8024 00111000
S R3,12(,R1) AND SUBTRACT OLD VALUE SUPPLIED BY CALLER 00112000
BAL R4,EDITSUB LAY OUT THE ANSWER IN BUFFER 00113000
MVC 1(8,R5),TIMBUF+8 SET CURRENT TIME-OF-DAY V0040 00114100
LA R5,9(,R5) AND ADJUST BUFFER POINTER 00115000
S R5,16(,R1) OCCUPIED LENGTH OF CALLER'S BUFFER 00116000
ST R5,20(,R1) STORE IN CALLER'S PLIST 00117000
SPACE 00118000
CPRET EQU * FINISH UP AND RETURN 00119000
MVC CURRDATE(16),TIMBUF MOVE DATE & TIME P8024 00120000
MVC CURRVIRT(4),TIMBUF+20 MOVE CURR ELAPSED VIRT P8024 00121000
MVC CURRCPUT(4),TIMBUF+28 MOVE CURR ELAPSED CPU P8024 00122000
L R1,BALRSAVE POINT TO BUFFER P8024 00123000
MVC 8(8,R1),CURRVIRT UPDATE TIMES IN CALLER'S PLIST 00124000
LM R1,R10,BALRSAVE RESTORE REGS P8024 00125000
SR R15,R15 CLEAR RETURN CODE (FOR CP) 00126000
BR R14 RETURN 00127000
EJECT 00128000
* 00129000
************** 00130000
* 00131000
* SUBROUTINE TO LAY OUT VIRCPU AND TOTCPU IN CALLER'S BUFFER 00132000
* 00133000
************** 00134000
SPACE 00135000
USING CMSTIMER,R15 00136000
EDITSUB EQU * 00137000
MVC 5(4,R5),=CL4'*.**' MOVE IN STARS IN CASE... 00138000
LTR R3,R3 WE DO NOT HAVE A VALID TIME. 00139000
BL EDSHIFT BRANCH IF THAT IS IN FACT THE CASE 00140000
LR R8,R2 LOAD DIVIDER P8024 00141000
SR R2,R2 CLEAR P8024 00142000
DR R2,R8 DIVIDE P8024 00143000
SRL R8,1(0) GENERATE THE ROUNDER LIMIT P8024 00144000
LTR R3,R3 IS RESULT ZERO P8024 00145000
BZ EDITSUB1 IF SO MAKE IT ONE P8024 00146000
CLR R2,R8 IS REMAINER LESS THAN HALF P8024 00147000
BL EDITSUB2 IF NOT DON'T ROUND UP P8024 00148000
EDITSUB1 LA R3,1(R3) ROUND UP P8024 00149000
EDITSUB2 EQU * P8024 00150000
CVD R3,BALRSAVE+40 CONVERT TO PACKED DECIMAL P8024 00151000
MVC 0(9,R5),MASK MOVE EDIT MASK INTO CALLER'S BUFFER 00152000
ED 0(9,R5),BALRSAVE+44 EDIT DATA P8024 00153000
EDSHIFT EQU * SHIFT THE RESULT TO THE LEFT 00154000
LA R3,4(,R5) ADDRESS OF LAST POSSIBLE LEADING BLANK 00155000
CLI 0(R3),C' ' IS IT A BLANK? 00156000
BE *+8 SKIP IF SO 00157000
BCT R3,*-8 DECREMENT POINTER AND LOOP BACK 00158000
MVC 0(9,R5),1(R3) MOVE THE ANSWER OVER TO THE RIGHT PLACE 00159000
SR R3,R5 NO. OF LEADING BLANKS WE HAD - 1 00160000
LA R5,8(,R5) ADDRESS OF NEXT FREE BYTE... 00161000
SR R5,R3 WITH CORRECTION FOR LEADING BLANKS 00162000
BR R4 RETURN 00163000
EJECT 00164000
************** 00165000
* 00166000
* EQUS AND READ-ONLY STORAGE 00167000
* 00168000
************** 00169000
SPACE 00170000
SPACE 00171000
CPDIV DC F'10000' DIVIDER FOR CP (CONVT TO HUNDREDTHS) P8024 00173000
MASK DC X'4020202021204B2020' MASK FOR EDITING JOB 00174000
SPACE 00175000
* 00176000
LTORG 00177000
SPACE 2 00178000
* 00179000
************** 00180000
* 00181000
* WRITABLE DATA 00182000
* 00183000
************** 00184000
SPACE 00185000
EJECT 00186000
NUCON 00187000
SUBSECT P8024 00188000
SPACE 2 00189000
REGEQU 00190000
SPACE 2 00191000
END 00192000