TITLE 'ICATS TIME ROUTINE' TIM00010
*********************************************************************** TIM00020
* * TIM00030
* MODULE NAME = TIME * TIM00040
* * TIM00050
* FUNCTION = GET THE TIME FROM CMS, CONVERT IT INTO EVERY * TIM00060
* CONCEIVABLE FORMAT, AND GIVE IT TO THE UTS MACHINE. * TIM00070
* * TIM00080
* ENTRY POINTS = TIME * TIM00090
* * TIM00100
* LINKAGE = BALR R14,R15 FROM ICATS DISPATCHER. * TIM00110
* * TIM00120
* REGISTER CONTENTS UPON ENTRY = * TIM00130
* R2 = POINTS TO THE ICATS COMMON DATA AREA, AS ALWAYS. * TIM00140
* R14 = RETURN ADDRESS BACK TO ICATS MAINLINE * TIM00150
* R15 = ENTRY POINT TO THIS MODULE * TIM00160
* * TIM00170
* REGISTER USAGE = * TIM00180
* R0-R1 = USED TO PASS PARAMETERS TO SUBROUTINES. * TIM00190
* R2 = USED TO ADDRESS THE ICATS COMMON DATA AREA. * TIM00200
* R3 = POINTS TO THE REPLY CONTROL BLOCK (X'30000') * TIM00210
* R4-R10 = FREE * TIM00220
* R11 = MY BASE REGISTER * TIM00230
* R12-R13 = FREE * TIM00240
* R14 = MY RETURN ADDRESS WHEN I CALL SOMEBODY * TIM00250
* R15 = SUBROUTINE ADDRESS * TIM00260
* * TIM00270
* MODULE LOGIC = * TIM00280
* 1) GET THE TIME FROM CP VIA A DIAGNOSE X'0C'. * TIM00290
* 2) CONVERT THE TIME INTO THE FORMATS EXPECTED BY THE UTS. * TIM00300
* A) SCRIPT FORMAT. MIN = 'MONDAY, MAY 1, 1983' * TIM00310
* MAX LENGTH = 'WEDNESDAY, SEPTEMBER 22, 1983' * TIM00320
* B) JULIAN DATE = YY.DDD IN EBCDIC * TIM00330
* C) MM/DD/YY FORMAT (ALSO IN EBCDIC) * TIM00340
* D) HH:MM:SS FORMAT (AGAIN IN EBCDIC) * TIM00350
* E) BINARY COUNTER. GOTTEN FROM THE STORE CLOCK * TIM00360
* INSTRUCTION. * TIM00370
* 3) SET RETURN CODE = 0, BYTE COUNT = 0, AND GIVE THE DATA * TIM00380
* TO THE UTS MACHINE. * TIM00390
* * TIM00400
* NORMAL EXIT = * TIM00410
* R15 = 0 * TIM00420
* * TIM00430
* EXTERNAL REFERENCES = NONE * TIM00440
* * TIM00450
* CONTROL BLOCKS = ICDATA (ICATS COMMON DATA AREA) * TIM00460
* * TIM00470
* NON-STANDARD MACROS (FOUND IN ICATS MACLIB) * TIM00480
* ICDATA = ICATS COMMON DATA AREA DSECT. * TIM00490
* ETTE = ENTER TRACE TABLE ENTRY SUBROUTINE * TIM00500
* * TIM00510
* CHANGE ACTIVITY * TIM00520
* DATE NAME REASON FOR CHANGE * TIM00530
* 03/03/83 RICK JASPER INITIAL PROGRAM CREATION * TIM00540
* * TIM00550
*********************************************************************** TIM00560
PRINT GEN,NODATA TIM00570
TIME CSECT TIM00580
USING ICDATA,R2 ADDRESS ICATS COMMON DATA AREA TIM00590
USING *,R15 USE R15 FOR BASE REG NEXT INSTRUCTION ONLY TIM00600
STM R0,R14,REGSAVE SAVE CALLER'S REGISTERS TIM00610
DROP R15 TIM00620
USING TIME,R11 R11 WILL BE BASE REGISTER TIM00630
LR R11,R15 ESTABLISH BASE REGISTER TIM00640
L R3,ABUFFER PUT REPLY CONTROL BLOCK IN OUTPUT BUFFER TIM00650
STCK 112(R3) STORE 370 CLOCK VALUE FIRST THING TIM00660
*-------------------------------------------------------------* TIM00670
* GET THE TIME AND DATE FROM CP * TIM00680
*-------------------------------------------------------------* TIM00690
LA R1,CPDATA ADDRESS OF DATA FROM DIAG TIM00700
DIAG R1,R0,X'000C' REQUEST DATE AND TIME FROM CP TIM00710
*-------------------------------------------------------------* TIM00720
* CPDATA IS NOW IN THE FORMAT OF * TIM00730
* DC CL8'MM/DD/YY' * TIM00740
* DC CL8'HH:MM:SS' * TIM00750
* DS 2D THE REST IS JUNK * TIM00760
*-------------------------------------------------------------* TIM00770
LOOPUP EQU * TIM00780
MVC 0(56,R3),PARM0 USE FIRST 7 PARMS OF REQUEST CB TIM00790
MVC 56(56,R3),=CL56' ' PAD THE REST WITH BLANKS TIM00800
* THE FIRST THING TO DO IS TO FIGURE OUT THE JULIAN DAY (1-366) TIM00810
* GET THE MONTH IN HEX IN R9 TIM00820
PACK TEMPA,CPDATA(2) TIM00830
CVB R9,TEMPA R9 = MONTH (1-12) TIM00840
SLL R9,1 USE AS INDEX INTO MONTH TABLE TIM00850
LH R4,MONTABLE-2(R9) GET JULIAN DATE OF START OF MONTH-1 TIM00860
* GET THE YEAR IN HEX IN R5 TIM00870
PACK TEMPA,CPDATA+6(2) TIM00880
CVB R5,TEMPA R5 = LAST 2 DIGITS OF YEAR TIM00890
* IS IT PAST FEBRUARY ?? TIM00900
C R9,=F'4' IF R9 = 4, THIS IS FEBRUARY TIM00910
BNH NOTALEAP IF NOT PAST FEBRUARY, THEN IT TIM00920
* MIGHT AS WELL NOT BE A LEAP YEAR TIM00930
* NOW THE $100,000 QUESTION. IS THIS A LEAP YEAR ?? TIM00940
SR R8,R8 TIM00950
LR R9,R5 DIVIDE YEAR BY 4 TIM00960
D R8,=F'4' R8 = REMAINDER, R9 = QUOTIENT TIM00970
LTR R8,R8 WELL, WAS IS IT A LEAP YEAR ?? TIM00980
BNZ NOTALEAP NO, IT'S NOT TIM00990
LA R4,1(R4) ELSE, ADD A DAY FOR FEBRUARY 29TH TIM01000
NOTALEAP EQU * TIM01010
* NOW ADD THE DAY OF THIS MONTH TO GET THE JULIAN DAY TIM01020
PACK TEMPA,CPDATA+3(2) TIM01030
CVB R9,TEMPA R9 = DAY (1-31) TIM01040
AR R4,R9 TIM01050
* R4 = THE JULIAN DAY OF THE YEAR CORRECTED FOR LEAP YEARS (1-366) TIM01060
* CONVERT TO EBCDIC AND PUT IN THE REPLY CONTROL BLOCK. TIM01070
CVD R4,TEMPA TIM01080
OI TEMPA+7,X'0F' TIM01090
UNPK TEMPB,TEMPA TIM01100
MVC 88(2,R3),CPDATA+6 MOVE THE EBCDIC YEAR TIM01110
MVI 90(R3),C'.' NOW THE PERIOD TIM01120
MVC 91(3,R3),TEMPB+5 MOVE THE EBCDIC DAY OF YEAR TIM01130
* R4 = STILL THE JULIAN DAY OF THE YEAR IN HEX (1-366) TIM01140
* R5 = THE LAST 2 DIGITS OF THE YEAR IN HEX TIM01150
* NOW ANSWER THE QUESTION, WHAT DAY OF THE WEEK IS THIS TIM01160
* USING 1980 AS A BASE YEAR, JANUARY 0, 1980 WAS A MONDAY = 0 TIM01170
* 0 = MONDAY 1 = TUESDAY 2 = WEDNESDAY TIM01180
* 3 = THURSDAY 4 = FRIDAY 5 = SATURDAY 6 = SUNDAY TIM01190
* EACH YEAR STARTS ONE DAY LATER THAN THE PREVIOUS YEAR, NOT TIM01200
* INCLUDING LEAP YEARS, SO THE FORMULA TO USE IS TIM01210
* DAY OF WEEK = MOD 7( (NUMBER OF YEARS SINCE 1980) TIM01220
* + (NUMBER OF LEAP YEARS SINCE 1980) TIM01230
* + 1 ) (SINCE 1980 WAS A LEAP YEAR) TIM01240
CH R5,=H'83' IS IT 1983 - 1999 ?? TIM01250
BNL CON100 YEP TIM01260
LA R5,100(R5) MUST BE 2000 - 2082 THEN TIM01270
CON100 EQU * R5 = 83-182 TO CORRESPOND TO 1983-2082 TIM01280
SH R5,=H'80' R5 = # YEARS SINCE 1980 TIM01290
SR R8,R8 TIM01300
LR R9,R5 TIM01310
BCTR R9,R0 THIS YEAR ISN'T OVER YET, SO DON'T TIM01320
* COUNT IT IN CASE IT'S A LEAP YEAR TIM01330
D R8,=F'4' R9 = # OF LEAP YEARS SINCE 1980 TIM01340
LA R5,1(R5,R9) INCLUDE 1980 AS A LEAP YEAR TIM01350
AR R5,R4 TIM01360
SR R4,R4 TIM01370
D R4,=F'7' R4 = DAY OF THE WEEK (0-6) = (MON-SUN) TIM01380
SLL R4,2 TIM01390
LA R3,56(R3) POINT TO WHERE THE SCRIPTED DATE GOES TIM01400
B *+4(R4) TIM01410
B DOMON TIM01420
B DOTUE TIM01430
B DOWED TIM01440
B DOTHU TIM01450
B DOFRI TIM01460
B DOSAT TIM01470
* TODAY IS SUNDAY TIM01480
MVC 0(8,R3),=C'SUNDAY, ' TIM01490
LA R3,8(R3) TIM01500
B CON200 TIM01510
DOMON EQU * TIM01520
MVC 0(8,R3),=C'MONDAY, ' TIM01530
LA R3,8(R3) TIM01540
B CON200 TIM01550
DOTUE EQU * TIM01560
MVC 0(9,R3),=C'TUESDAY, ' TIM01570
LA R3,9(R3) TIM01580
B CON200 TIM01590
DOWED EQU * TIM01600
MVC 0(11,R3),=C'WEDNESDAY, ' TIM01610
LA R3,11(R3) TIM01620
B CON200 TIM01630
DOTHU EQU * TIM01640
MVC 0(10,R3),=C'THURSDAY, ' TIM01650
LA R3,10(R3) TIM01660
B CON200 TIM01670
DOFRI EQU * TIM01680
MVC 0(8,R3),=C'FRIDAY, ' TIM01690
LA R3,8(R3) TIM01700
B CON200 TIM01710
DOSAT EQU * TIM01720
MVC 0(10,R3),=C'SATURDAY, ' TIM01730
LA R3,10(R3) TIM01740
CON200 EQU * TIM01750
* NOW FOR THE MONTH TIM01760
CLC CPDATA(2),=CL2'01' IS IT JANUARY ?? TIM01770
BNE CON301 NOPE TIM01780
MVC 0(8,R3),=CL8'JANUARY ' TIM01790
LA R3,8(R3) TIM01800
B CON400 TIM01810
CON301 EQU * TIM01820
CLC CPDATA(2),=CL2'02' IS IT FEBRUARY ?? TIM01830
BNE CON302 NOPE TIM01840
MVC 0(9,R3),=CL9'FEBRUARY ' TIM01850
LA R3,9(R3) TIM01860
B CON400 TIM01870
CON302 EQU * TIM01880
CLC CPDATA(2),=CL2'03' IS IT MARCH ?? TIM01890
BNE CON303 NOPE TIM01900
MVC 0(6,R3),=CL6'MARCH ' TIM01910
LA R3,6(R3) TIM01920
B CON400 TIM01930
CON303 EQU * TIM01940
CLC CPDATA(2),=CL2'04' IS IT APRIL ?? TIM01950
BNE CON304 NOPE TIM01960
MVC 0(6,R3),=CL6'APRIL ' TIM01970
LA R3,6(R3) TIM01980
B CON400 TIM01990
CON304 EQU * TIM02000
CLC CPDATA(2),=CL2'05' IS IT MAY ?? TIM02010
BNE CON305 NOPE TIM02020
MVC 0(4,R3),=CL4'MAY ' TIM02030
LA R3,4(R3) TIM02040
B CON400 TIM02050
CON305 EQU * TIM02060
CLC CPDATA(2),=CL2'06' IS IT JUNE ?? TIM02070
BNE CON306 NOPE TIM02080
MVC 0(5,R3),=CL5'JUNE ' TIM02090
LA R3,5(R3) TIM02100
B CON400 TIM02110
CON306 EQU * TIM02120
CLC CPDATA(2),=CL2'07' IS IT JULY ?? TIM02130
BNE CON307 NOPE TIM02140
MVC 0(5,R3),=CL5'JULY ' TIM02150
LA R3,5(R3) TIM02160
B CON400 TIM02170
CON307 EQU * TIM02180
CLC CPDATA(2),=CL2'08' IS IT AUGUST ?? TIM02190
BNE CON308 NOPE TIM02200
MVC 0(7,R3),=CL7'AUGUST ' TIM02210
LA R3,7(R3) TIM02220
B CON400 TIM02230
CON308 EQU * TIM02240
CLC CPDATA(2),=CL2'09' IS IT SEPTEMBER ?? TIM02250
BNE CON309 NOPE TIM02260
MVC 0(10,R3),=CL10'SEPTEMBER ' TIM02270
LA R3,10(R3) TIM02280
B CON400 TIM02290
CON309 EQU * TIM02300
CLC CPDATA(2),=CL2'10' IS IT OCTOBER ?? TIM02310
BNE CON310 NOPE TIM02320
MVC 0(8,R3),=CL8'OCTOBER ' TIM02330
LA R3,8(R3) TIM02340
B CON400 TIM02350
CON310 EQU * TIM02360
CLC CPDATA(2),=CL2'11' IS IT NOVEMBER ?? TIM02370
BNE CON311 NOPE TIM02380
MVC 0(9,R3),=CL9'NOVEMBER ' TIM02390
LA R3,9(R3) TIM02400
B CON400 TIM02410
CON311 EQU * MUST BE DECEMBER THEN. LET IT DEFAULT TO TIM02420
* DECEMBER IF IT'S SOMETHING I DON'T UNDERSTAND TIM02430
MVC 0(9,R3),=CL9'DECEMBER ' TIM02440
LA R3,9(R3) TIM02450
CON400 EQU * TIM02460
CLI CPDATA+3,C'0' IS THE DAY OF THE MONTH < 10 ?? TIM02470
BE CON410 IF SO, IT'S ONLY 1 CHARACTER LONG, NOT 2 TIM02480
MVC 0(2,R3),CPDATA+3 MOVE IN THE EBCDIC DAY OF MONTH TIM02490
LA R3,2(R3) TIM02500
B CON420 TIM02510
CON410 EQU * TIM02520
MVC 0(1,R3),CPDATA+4 MOVE IN THE EBCDIC DAY OF MONTH TIM02530
LA R3,1(R3) TIM02540
CON420 EQU * TIM02550
MVC 0(4,R3),=CL4', 19' ASSUME TWENTIETH CENTURY TIM02560
CLC CPDATA+6(2),=CL2'83' IF YEAR IS UNDER 83, THEN THE TIM02570
BNL CON430 YEAR MUST BE 20XX, NOT 19XX TIM02580
MVC 0(4,R3),=CL4', 20' OK, SO I WAS WRONG TIM02590
CON430 EQU * TIM02600
MVC 4(2,R3),CPDATA+6 GET THE OTHER TWO YEAR DIGITS TIM02610
L R3,ABUFFER RESET TO START OF REPLY CB TIM02620
* NOW THE REST OF IT TIM02630
MVC 96(8,R3),CPDATA MM/DD/YY TIM02640
MVC 104(8,R3),CPDATA+8 HH:MM:SS TIM02650
XC 120(8,R3),120(R3) ZERO RETURN CODE AND DATA LENGTH TIM02660
* NOW GIVE THIS TIME AND DATA INFO TO THE REQUESTOR, WHOEVER THAT TIM02670
* MAY BE. COULD HAVE COME FROM A UTS, THE CONSOLE, OR A SMSG. TIM02680
TM FLAGB,UTSCMD DID THIS COMMAND COME FROM A UTS ?? TIM02690
BNO NOTAUTS MUST HAVE BEEN FROM CONSOLE OR SMSG TIM02700
LA R0,128 REPLY CONTROL BLOCK = 128 BYTES BIG TIM02710
L R1,ABUFFER POINT TO START OF REPLY CONTROL BLOCK TIM02720
L R15,AWRITUTS TIM02730
BALR R14,R15 GO GIVE THE REPLY TO THE UTS MACHINE TIM02740
B TIMEBYE IGNORE ANY ERRORS TIM02750
NOTAUTS DS 0H TIM02760
LA R8,56(R3) GIVE DATE IN EBCDIC SCRIPT FORMAT TIM02770
LA R9,104(R3) GIVE TIME IN EBCDIC TIM02780
LINEDIT TEXT='TODAY IS ................................ - THE -TIM02790
TIME IS ........',SUB=(CHARA,(R8),CHARA,(R9)),DISP=NONE,-TIM02800
BUFFA=MYBUFR,RENT=NO TIM02810
LA R1,MYBUFR PREPARE FOR MESSAGE ROUTINE TIM02820
L R15,AMESSAGE TIM02830
BALR R14,R15 TIM02840
* TIM02850
TIMEBYE EQU * TIM02860
LM R0,R14,REGSAVE RESTORE CALLER'S REGISTERS TIM02870
BR R14 I'M DONE HERE TIM02880
REGSAVE DS 15F READ ROUTINE SAVE AREA TIM02890
CPDATA DS 4D TIME DATA AREA FROM CP TIM02900
TEMPA DS D PACK AND UNPACK WORK AREA TIM02910
TEMPB DS D PACK AND UNPACK WORK AREA TIM02920
MONTABLE DC H'0' JANUARY - DAY OF WEEK OFFSET TIM02930
DC H'31' FEBRUARY TIM02940
DC H'59' MARCH (ASSUMING A NON-LEAP YEAR) TIM02950
DC H'90' APRIL TIM02960
DC H'120' MAY TIM02970
DC H'151' JUNE TIM02980
DC H'181' JULY TIM02990
DC H'212' AUGUST TIM03000
DC H'243' SEPTEMBER TIM03010
DC H'273' OCTOBER TIM03020
DC H'304' NOVEMBER TIM03030
DC H'334' DECEMBER TIM03040
MYBUFR DS CL80 TIM03050
LTORG TIM03060
* TIM03070
TIME CSECT RETURN TO NORMAL CSECT TIM03080
ICDATA TIM03090
END TIM03100