Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - today.mac
There are 16 other files named today.mac in the archive. Click here to see a list.
; UPD ID= 2671 on 3/23/80 at 11:38 AM by NIXON                          
TITLE	TODAY. - DAY, DATE, AND TIME FOR COBOL
SUBTTL	D. M. NIXON/DMN	30-DEC-78



	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1978, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

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

TWOSEG
	.COPYRIGHT		;Put 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., TIME.

ENTRY	DATE., TIME.,TIME1.

;CALLED BY PUSHJ PP,DATE.
;EXIT WITH DATE IN AC0 YYMMDD

DATE.:	CALLI	AC4,14		;DATE UUO ((Y-64)*12+(M-1))*31+D-1
	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,


;CALLED BY PUSHJ PP,TIME.
;EXIT WITH TIME IN AC0 HHMMSS
;		   AC1 CC


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 EBCLBL,<
	ENTRY	DAY.SK
DAY.SK:	AOS	(PP)		;TAKE A SKIP EXIT
>
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
>
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,
>
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