**** START OF SPECIFICATIONS ***************************************** 00010000 * * 00020000 * * 00030000 * MODULE NAME = APSUTIMC * 00040000 * * 00050000 * $MOD(APSUTIMC) COMP(APS) PROD(PSF) : VERSION 3.3.0 * 00060000 * * 00070000 * DESCRIPTIVE NAME = Issue TIME SVC for C exits * 00080000 * * 00090000 * STATUS = VERSION 3, RELEASE 3, LEVEL 0 * 00100000 * * 00110000 * FUNCTION = * 00120000 * Issues TIME SVC for an exit written in C, unpacks and formats * 00130000 * the time and date, and returns them to the exit. * 00140000 * * 00150000 * OPERATION = * 00160000 * 1. Issue TIME SVC * 00170000 * * 00180000 * NOTES = * 00190000 * DEPENDENCIES = * 00200000 * RESTRICTIONS = None * 00210000 * REGISTER CONVENTIONS = * 00220000 * See assembler equates * 00230000 * PATCH LABEL = PSPACE * 00240000 * * 00250000 * MODULE TYPE = Procedure * 00260000 * PROCESSOR = Assembler * 00270000 * ATTRIBUTES = * 00280000 * Reentrant, supervisor state, caller's key, pageable, * 00290000 * amode 31, rmode any * 00300000 * * 00310000 * ENTRY POINT = APSUTIMC * 00320000 * LINKAGE = * 00330000 * R1 = Address of a 4 byte field which contains the * 00340000 * address of APSGEXTP * 00350000 * Address of a 4 byte field which contains the * 00360000 * address of date and time fields. * 00370000 * R13 = Save area address * 00380000 * R15 = Entry point address * 00390000 * * 00400000 * INPUT = * 00410000 * * 00420000 * OUTPUT = Formatted TIME and DATE * 00430000 * * 00440000 * EXIT NORMAL = Return to caller * 00450000 * * 00460000 * EXIT ERROR = None * 00470000 * * 00480000 * EXTERNAL REFERENCES = * 00490000 * ROUTINES = None * 00500000 * DATA AREAS = * 00510000 * APSGEXTP - PSF installation exit parameter area * 00520000 * APSUECA - PSF exit communications area * 00530000 * INCLUDES = None * 00540000 * * 00550000 * MACROS = None * 00560000 * * 00570000 * MESSAGES = None * 00580000 * * 00590000 * 01* CHANGE ACTIVITY = * 00600000 * $B0=OW45952, HPRF320, 000829, BDKUEAS: Initial Version @B0A* 00610000 * $EV=LAPS0009,HPRF330,010530,BUQ4RLB: Version 3.3.0 @EVA* 00620000 * * 00630000 **** END OF SPECIFICATIONS ******************************************* 00640000 ********************************************************************** 00650000 * 00660000 APSUTIMC START 0 00670000 TITLE 'DSECT - XTP' 00680000 APSGEXTP LIST=YES 00690000 TITLE 'DSECT - ECA' 00700000 APSUECA LIST=YES 00710000 TITLE 'APSUTIMC - ISSUE TIME SVC FOR C EXIT' 00720000 APSUTIMC CSECT , 00730000 APSUTIMC AMODE 31 00740000 APSUTIMC RMODE ANY 00750000 USING *,15 00760000 B START 00770000 DC AL1(17) Length of the following fields 00780000 DC CL8'APSUTIMC' Name of this routine 00790000 DC CL8'&SYSDATE' Date of this assembly 00800000 DROP 15 00810000 START DS 0H 00820000 STM 14,12,12(13) Save caller's regs 00830000 LR BASEREG,15 Switch base register 00840000 USING APSUTIMC,BASEREG Establish base register 00850000 00860000 USING APSGEXTP,XTPPTR 00870000 USING APSUECA,ECAPTR 00880000 L XTPPTR,0(,1) Load address of APSGEXTP 00890000 L DTTMPTR,4(,1) Load address of time and date 00900000 * fields 00910000 L ECAPTR,XTPECAP Load address of APSUECA 00920000 * 00930000 LR 2,13 Load address of caller's save 00940000 LA 13,ECACSAVE Load address of TIMC save area 00950000 ST 2,4(,13) Save caller's save area address 00960000 ST 13,8(,2) Save TIMC save area address 00970000 * 00980000 LA ECAWKPTR,ECAWKBUF 00990000 USING WRKDSECT,ECAWKPTR 01000000 USING DTTMSECT,DTTMPTR 01010000 ********************************************************************** 01020000 ********************************************************************** 01030000 * OBTAIN TIME AND DATE 01040000 * 01050000 * The date is returned in register 1 as packed decimal 01060000 * digits of the form: 01070000 * 01080000 * 0CYYDDDF where 01090000 * 01100000 * C is a digit representing centuries beyond the twentieth. 01110000 * In the years 1900 through 1999, C = 0. In the years 01120000 * 2000 through 2099, C = 1. 01130000 * YY is the last 2 digits of the year. 01140000 * DDD is the day of the year. 01150000 * F is a 4-bit sign character that allows the data to be 01160000 * unpacked and printed. 01170000 * 01180000 ********************************************************************** 01190000 * 01200000 LA @01,2 Set R1 01210000 SLR @00,@00 Reset R0 01220000 SVC 11 Issue TIME SVC 01230000 ST @01,WRKDATE Save the date (packed dec) 01240000 * 01250000 ********************************************************************** 01260000 * Adjust time for AM/PM 01270000 ********************************************************************** 01280000 * 01290000 LA WRKPTR,WRKTIME Get address of work area 01300000 LA AMPMPTR,WRKAMPM Get address of AM/PM work 01310000 * area 01320000 MVC WRKAMPM(2),AM Set AM/PM to AM 01330000 CL @00,=X'12000000' Test for zero hours 01340000 BL PMORNING Branch if AM 01350000 MVI 0(@03),C'P' Change from AM to PM 01360000 SL @00,=X'12000000' Subtract twelve hours 01370000 PMORNING ST @00,0(,@02) Store adjusted time 01380000 CLI 0(@02),X'00' Test for zero hours 01390000 BNE PADJERR Br if not to test adj err 01400000 MVI 0(@02),X'12' Convert zero to twelve 01410000 PADJERR TM 0(@02),X'08' Test for adjustment errors 01420000 BZ PEDTIME Branch if no error 01430000 NI 0(@02),X'09' Correct for binary 01440000 * Subtract error 01450000 PEDTIME DS 0H 01460000 * 01470000 ********************************************************************** 01480000 * Unpack hours minutes seconds 01490000 ********************************************************************** 01500000 * 01510000 MVI WRKTH,X'0C' Reset low order 2 bytes 01520000 * with sign for packed dec 01530000 UNPK WRKUTIME(7),WRKTIME(4) Unpack time 01540000 * 01550000 ********************************************************************** 01560000 * Obtain month, day and year 01570000 ********************************************************************** 01580000 * 01590000 NEXT LA @01,4 Addressability to 01600000 AL @01,ECAUCOMP Julian table 01610000 MVC WRKJTBL(48),DAYTBL(@01) Copy table for leap year 01620000 * adjustment 01630000 MVC WRKWORK+4(4),WRKDATE Obtain date from saved area 01640000 TM WRKWORK+5,X'01' Test 01650000 BO NOLEAPYR for 01660000 TM WRKWORK+5,X'12' leap 01670000 BM NOLEAPYR year 01680000 MVI WRKJTBL+4,29 Adjust Feb for leap year 01690000 NOLEAPYR MVC WRKED(3),=X'F02120' Place pattern for edit 01700000 ED WRKED(3),WRKWORK+5 Edit the year 01710000 MVC WRKYY(2),WRKED+1 Store the year 01720000 MVC WRKWORK(6),ZEROES Reset all but Julian date 01730000 SLR @00,@00 Clear for IC 01740000 CVB 1,WRKWORK Convert to binary day 01750000 LA 2,WRKJTBL-4 Address of date conversion 01760000 * Table 01770000 SEARCH SLR @01,@00 Convert 01780000 LA @02,4(,@02) Julian day 01790000 IC @00,0(,@02) to 01800000 CLR @00,@01 standard day 01810000 BL SEARCH 01820000 CVD 1,WRKWORK Convert to decimal day 01830000 UNPK WRKDD(2),WRKWORK+6(2) Unpack the day 01840000 OI WRKDD+1,X'F0' Ensure sign nibble 01850000 MVC WRKMMM(3),1(@02) Set EBCDIC alpha month 01860000 * 01870000 MVC WCEN(4),XZERO Clear century field 01880000 MVC WCEN+3(1),WRKDATE Obtain century from 01890000 * saved area 01900000 L @02,WCEN Load century 01910000 A @02,NINETEEN Bump century by 19 01920000 CVD @02,WRKWORK Convert to decimal 01930000 UNPK WRKCEN(2),WRKWORK+6(2) Unpack the century 01940000 OI WRKCEN+1,X'F0' Ensure sign nibble 01950000 * 01960000 * 01970000 ********************************************************************** 01980000 * EPILOG 01990000 ********************************************************************** 02000000 * 02010000 DS 0H 02020000 L 13,4(,13) Restore caller's save area addr 02030000 L 14,12(,13) Restore caller's return address 02040000 LM 0,12,20(13) Restore caller's registers 02050000 BR 14 Return to caller 02060000 * 02070000 ********************************************************************** 02080000 * Miscellaneous constants 02090000 ********************************************************************** 02100000 XZERO DC F'0' 02110000 NINETEEN DC F'19' 02120000 ZEROES DC X'000000000000' 02130000 BLANK DC X'40' 02140000 AM DC CL2'AM' 02150000 * 02160000 ********************************************************************** 02170000 * Equates for registers 0-15 02180000 ********************************************************************** 02190000 * 02200000 @00 EQU 00 02210000 @01 EQU 01 02220000 @02 EQU 02 02230000 @03 EQU 03 02240000 @04 EQU 04 02250000 @05 EQU 05 02260000 @06 EQU 06 02270000 @07 EQU 07 02280000 @08 EQU 08 02290000 @09 EQU 09 02300000 @10 EQU 10 02310000 @11 EQU 11 02320000 @12 EQU 12 02330000 @13 EQU 13 02340000 @14 EQU 14 02350000 @15 EQU 15 02360000 ********************************************************************** 02370000 * Pointer registers and routines 02380000 ********************************************************************** 02390000 DTTMPTR EQU @04 Points to time and date 02400000 AMPMPTR EQU @03 Pointer to AM/PM print area 02410000 ECAPTR EQU @05 APSUECA pointer 02420000 XTPPTR EQU @07 XTP pointer 02430000 ECAWKPTR EQU @08 ECAWKBUF pointer 02440000 SAVREG01 EQU @09 Saved register 01 02450000 BASEREG EQU @12 Base register 02460000 DAYTBL EQU @00 02470000 WRKPTR EQU @02 Work area pointer 02480000 02490000 ********************************************************************** 02500000 * Declarations 02510000 ********************************************************************** 02520000 DTTMSECT DSECT 02530000 WRKUDATE DS CL10 Current date-unpacked 02540000 ORG WRKUDATE 02550000 WRKMMM DS CL3 Month 02560000 WRKDD DS CL2 Day 02570000 WRKCEN DS CL2 Century 02580000 WRKYY DS CL2 Year 02590000 DS CL1 Reserved 02600000 WRKUTIME DS CL9 Current time - unpacked 02610000 ORG WRKUTIME 02620000 WRKHR DS CL2 Hour 02630000 WRKMIN DS CL2 Minute 02640000 WRKSEC DS CL2 Second 02650000 DS CL1 Sign byte 02660000 WRKAMPM DS CL2 AM/PM 02670000 * 02680000 WRKDSECT DSECT 02690000 WRKDATE DS CL4 Current date - packed 02700000 WRKTIME DS CL4 Current time - packed 02710000 ORG WRKTIME 02720000 DS CL3 Hours Minutes Seconds 02730000 WRKTH DS CL1 Tenths and hundredths 02740000 DS CL1 Reserved 02750000 WRKED DS CL3 Edit pattern 02760000 DS CL1 Reserved 02770000 WCEN DS F Work area for century 02780000 DS 0D Alignment 02790000 WRKWORK DS CL8 Work area for conversion 02800000 WRKJTBL DS CL48 Julian conversion table 02810000 * 02820000 WRKPLPTR DS F Address of SWBTUREQ parm 02830000 * 02840000 END APSUTIMC 02850000