Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/today.mac
There are 16 other files named today.mac in the archive. Click here to see a list.
; UPD ID= 1597 on 5/14/84 at 3:55 PM by HOFFMAN                         
TITLE	TODAY - DAY, DATE, TIME, and DAY-OF-WEEK for COBOL
SUBTTL	D. M. NIXON/DMN

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1978, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

;REVISION HISTORY
;
;NAME	EDIT		COMMENTS

;V13***************
;RLF	1123	Don't nativise the TODAY fields, the results are not
;			quite the same as in 12B

SEARCH	INTERM
IFN TOPS20,<SEARCH MONSYM>
IFE TOPS20,<SEARCH UUOSYM>
SALL

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000


AC0=0				;YYMMDD
AC1=1				;HHMMSS
AC2=2
AC3=3
AC4=4				;TEMP
AC5=AC4+1			;TEMP
AC6=AC5+1			;TEMP
PP=17				;
SUBTTL	TODAY.


ENTRY	TODAY.,TODA1.,TODA2.

;Called by PUSHJ PP,TODAY.
;Exit with DATE in AC0 YYMMDD
;	   TIME in AC1 HHMMSS

IFN MCS,<
	ENTRY	MCSTIM		;CMCS (LCM) USES THIS ROUTINE
>
TODAY.:	CALLI	AC4,14		;DATE UUO ((Y-64)*12+(M-1))*31+D-1
TODA1.:	IDIVI	AC4,^D31	;PICK OFF THE DAY
	ADDI	AC5,1		;MAKE IT RIGHT
	PUSHJ	PP,TODA4.	;RETURNS TWO SIXBIT NUMBERS
	DPB	AC5,DAY		;XXXXDD
	IDIVI	AC4,^D12	;PICK OFF THE MONTH
	ADDI	AC5,1		;MAKE IT RIGHT
	PUSHJ	PP,TODA4.	;RETURNS TWO SIXBIT NUMBERS
	DPB	AC5,MONTH	;XXMMDD
	MOVEI	AC5,^D64	;GET THE BASE YEAR
	ADD	AC5,AC4		;PLUS YEARS SINCE THEN
	CAIL	AC5,^D100	;CK FOR YEAR 2000+
	SUBI	AC5,^D100	;IF SO, CONVERT TO 00+
	PUSHJ	PP,TODA4.	;SIXBIT
	DPB	AC5,YEAR	;YYMMDD-DATE FINISHED

	CALLI	AC4,23		;TIME UUO GETS TIME IN MILLISECONDS
	IDIVI	AC4,^D1000	;CONVERT TO SECONDS
MCSTIM:	PUSHJ	PP,TODA3.	;PICK OFF SECONDS IN SIXBIT
	DPB	AC5,SECOND	;XXXXSS
TODA2.:	PUSHJ	PP,TODA3.	;PICK OFF MINUTES IN SIXBIT
	DPB	AC5,MINUTE	;XXMMSS
	MOVE	AC5,AC4		;WHAT'S LEFT IS HOURS
	PUSHJ	PP,TODA4.	;TO SIXBIT
	DPB	AC5,HOUR	;HHMMSS-TIME FINISHED
	POPJ	PP,		;RETURN

TODA3.:	IDIVI	AC4,^D60	;DIVIDE BY 60 FOR TIME
TODA4.:	IDIVI	AC5,^D10	;DIVIDE OUT A DECIMAL NUMBER
	LSH	AC5,6		;MAKE ROOM FOR THE REMIANDER
	ADDI	AC5,2020(AC6)	;CONVERT TO SIXBIT
	POPJ	PP,		;RETURN
SUBTTL	DATE

ENTRY	DATE.,DATE1.

;Called by PUSHJ PP,DATE.
;Exit with DATE in AC0 YYMMDD

IFN TOPS20,<

DATE.:	SETO	AC2,		;Get current time
	SETZ	AC4,		;Nothing special
	ODCNV%			;Time
	HLRZ	AC0,AC3		;Get day of month
	ADDI	AC0,1		;Start at 1
	IDIVI	AC0,^D10	;Get two digits
	LSH	AC0,6		;Make room
	ADDI	AC0,'00'(AC1)	;Convert both to sixbit
	HRRZI	AC5,1(AC2)	;Get month starts at zero
	PUSHJ	PP,TODA4.	;Return two sixbit numbers
	DPB	AC5,MONTH	;Accumulate result
	HLRZ	AC4,AC2		;Get year
	IDIVI	AC4,^D100	;Just get last two digits of year
	PUSHJ	PP,TODA4.	;Return two sixbit numbers
	DPB	AC5,YEAR	;Full result now
	POPJ	PP,
>

IFE TOPS20,<

DATE.:	CALLI	AC4,14		;DATE UUO ((Y-64)*12+(M-1))*31+D-1
>
DATE1.:	IDIVI	AC4,^D31	;PICK OFF THE DAY
	ADDI	AC5,1		;MAKE IT RIGHT
	PUSHJ	PP,TODA4.	;RETURNS TWO SIXBIT NUMBERS
	DPB	AC5,DAY		;XXXXDD
	IDIVI	AC4,^D12	;PICK OFF THE MONTH
	ADDI	AC5,1		;MAKE IT RIGHT
	PUSHJ	PP,TODA4.	;RETURNS TWO SIXBIT NUMBERS
	DPB	AC5,MONTH	;XXMMDD
	MOVEI	AC5,^D64	;GET THE BASE YEAR
	ADD	AC5,AC4		;PLUS YEARS SINCE THEN
	CAIL	AC5,^D100	;CK FOR YEAR 2000+
	SUBI	AC5,^D100	;IF SO, CONVERT TO 00+
	PUSHJ	PP,TODA4.	;SIXBIT
	DPB	AC5,YEAR	;YYMMDD-DATE FINISHED
	POPJ	PP,
SUBTTL	TIME

ENTRY	TIME.

;Called by PUSHJ PP,TIME.
;Exit with TIME in AC0 HHMMSS
;		   AC1 CC


ENTRY	TIME1.

TIME.:	CALLI	AC4,23		;TIME UUO GETS TIME IN MILLISECONDS
TIME1.:	IDIVI	AC4,^D10	;CONVERT TO HUNDREDTHS OF SECONDS
	IDIVI	AC4,^D100	;GET HUNDREDTHS
	PUSHJ	PP,TODA4.	;RETURN TWO SIXBIT NUMBERS
	DPB	AC5,HSECS	;CCXXXX
	PUSHJ	PP,TODA3.	;PICK OFF SECONDS IN SIXBIT
	DPB	AC5,SECS	;XXXXSS
	PUSHJ	PP,TODA3.	;PICK OFF MINUTES IN SIXBIT
	DPB	AC5,MINS	;XXMMSS
	MOVE	AC5,AC4		;WHAT'S LEFT IS HOURS
	PUSHJ	PP,TODA4.	;TO SIXBIT
	DPB	AC5,HOURS	;HHMMSS-TIME FINISHED
	POPJ	PP,		;RETURN
SUBTTL	DAY

ENTRY	DAY.

;CALLED BY PUSHJ PP,DAY.
;RETURNS WITH DATE IN AC0
;AS SIXBIT   YYDDD

IFN TOPS20,<

DAY.:	SETO	AC2,		;GET CURRENT TIME
	MOVSI	AC4,(IC%JUD)	;IN JULIAN FORMAT
	ODCNV%			;TIME
	HLRZ	AC3,AC2		;GET YEAR
	IDIVI	AC3,^D100	;GET RID OF 1900
	IDIVI	AC4,^D10	;INTO TENS AND UNITS
	LSH	AC4,6		;MAKE SPACE
	ADDI	AC4,' 00'(AC5)	;SIXBITIZE YEAR
	HRLZ	AC0,AC4		;PUT YEAR IN LHS OF AC0
	HRRZ	AC2,AC2		;DAY ONLY
	IDIVI	AC2,^D100	;HUNDREDS, REMAINDER IN AC3
	IDIVI	AC3,^D10	;TENS AND UNITS
	LSH	AC2,^D12	;MAKE SPACE
	LSH	AC3,6		;...
	ADD	AC3,AC4		;TENS AND UNITS
	ADDI	AC2,'000'(AC3)	;SIXBITIZE DAY
	HRR	AC0,AC2		;DAY IN RHS
	LSH	AC0,6		;LEFT JUSTIFY
	POPJ	PP,
>
IFE TOPS20,<

DAY.:	SETZ	AC0,		;
	CALLI	AC4,14		;GET DATE
	IDIVI	AC4,^D31	;PICK OFF DAY-1
	ADDI	AC5,1		;DAY OF THE MONTH
	MOVE	AC1,AC5		;SAVE THE DAY
	IDIVI	AC4,^D12	;PICK OFF MONTH - 1
	ADDI	AC4,^D64	;GET YEAR IN AC4
	PUSH	PP,AC4		;SAVE YEAR INCASE LEAP
	EXCH	AC4,AC5		;SWAP WITH MONTH INDEX
	PUSHJ	PP,TODA4.	;STORE THE SIXBIT YEAR
	DPB	AC5,YEAR	;  IN AC0
	ADD	AC1,DAYTAB(AC4)	;ADD PREVIOUS DAYS TO DAY OF MONTH
	POP	PP,AC5		;RECOVER YEAR
	CAIGE	AC4,2		;PAST FEBRUARY?
	JRST	DAY.A		;NO
	MOVE	AC4,AC5		;YES
	IDIVI	AC4,4		;CHECK FOR LEAP YEAR
	CAIG	AC5,0		;LEAP YEAR?
	ADDI	AC1,1		;YES
DAY.A:	MOVE	AC4,AC1		;
	IDIVI	AC4,^D10	;DIVIDE OUT THE
	MOVE	AC1,AC5		;  UNITS AND
	IDIVI	AC4,^D10	;  THE TENS
	LSH	AC4,6		;SHIFT OVER THE HUNDREDS
	ADD	AC5,AC4		;ADD IN THE TENS
	LSH	AC5,6		;MAKE ROOM FOR THE UNITS
	ADDI	AC5,'000'(AC1)	;ADDEM IN AND SIXBITIZE
	LSH	AC5,6		;GET THEM NEXT TO THE YEAR POSITION
	ADD	AC0,AC5		;   YYDDD
	POPJ	PP,

DAYTAB:	EXP	^D0	;JAN
	EXP	^D31	;FEB
	EXP	^D59	;MAR
	EXP	^D90	;APR
	EXP	^D120	;MAY
	EXP	^D151	;JUN
	EXP	^D181	;JUL
	EXP	^D212	;AUG
	EXP	^D243	;SEP
	EXP	^D273	;OCT
	EXP	^D304	;NOV
	EXP	^D334	;DEC
>
SUBTTL	DAY-OF-WEEK

ENTRY	D.O.W.

;Called by PUSHJ PP,D.O.W.
;Returns with DAY-OF-WEEK in AC0
;As 1=Monday, 2=Tuesday, ..., 7=Sunday

IFN TOPS20,<

D.O.W.:	SETO	AC2,		;Get current time
	SETZ	AC4,		;Nothing special
	ODCNV%			;Time
	HRRZ	AC0,AC3		;Get day of week
	AOJA	AC0,RET.1##	;In form COBOL expects
>

IFE TOPS20,<

D.O.W.:	MOVX	AC0,%CNDTM	;Universal Date/Time
	GETTAB	AC0,		;Get it
	  JFCL			;Never fails
	HLRZ	AC0,AC0		;Get the day part
	ADDI	AC0,2		;Change base from Wednesday=0 to Monday=0
	IDIVI	AC0,7		;Get day of week
	MOVEI	AC0,1(AC1)	;Monday = 1
	POPJ	PP,
>
SUBTTL	CONSTANTS AND POINTERS


YEAR:	POINT	12,AC0,11
MONTH:	POINT	12,AC0,23
DAY:	POINT	12,AC0,35
HOUR:	POINT	12,AC1,11
MINUTE:	POINT	12,AC1,23
SECOND:	POINT	12,AC1,35

HOURS==YEAR
MINS==MONTH
SECS==DAY
HSECS==HOUR

END