File: CCLDAT.MA of Tape: OS8/OS8-Latest/new-9

(Source file text) 

---

/CCL DATE+TIME FOR KBM V40
/
/
/
/
/
/	CCL DATE COMMAND
/	VERSION=4B

	.ENTRY DATE
	.EXTERNAL WEEKLST,MONLST
	.EXTERNAL OTOD,PRWD,LISPRT
	.EXTERNAL CRLF,LOOK,CHAIN
	.EXTERNAL YDATE,ERROR

	.NOLIST
	.INCLUDE OUT:CCLDEF.MA
	.LIST

	.RSECT CCLDAT
	FIELD 1

	OVLSTR==.	/START OF OVERLAYS
			/*** DATE MUST BE LEVEL 1 OVERLAY 0 ***
			/AND FIRST SUBROUTINE IN THAT LEVEL
DATE,	0
	SM8		/SKIP ON MULTI8
	SKP CLA
	JMS I	(TIME
	DCA	JAN	/INIT JANUARY,FEBRUARY
	CLA STL IAC RAL	/AC0003
	DCA	FEB
	TAD I (MDATE
	SNA
	JMP NODATE
	DCA DATEM
	TAD DATEM
	BSW
	CLL RTR
	AND (17
	DCA	TM1	/MONTH
	TAD DATEM
	AND (7
	DCA TM2		/MOD 8 YEAR
	CDF 0
	TAD I (BATCCL
	CDF 10
	CLL RTR
	RTR
	AND (30
	TAD TM2
	DCA TM2		/FROM 1970 YEAR
	TAD TM2
	TAD (70.
	JMS I (OTOD
	DCA YEAR	/YEAR STRING
	TAD DATEM
	CLL RTR
	RAR
	AND (37
	DCA DATEM	/DAY IN MONTH
	TAD DATEM
	JMS I (OTOD
	DCA DAY		/DAY STRING
	STL CLA RTL	/2
	TAD TM2		/1972=4, 1976=8, ETC
	CLL RTR
	SNL SMA
	JMP 1$
	ISZ	JAN	/FOR NORMAL YEARS
	ISZ	FEB
1$:	AND (37		/1 DAY MORE FOR LEAPIES
	TAD TM2		/1 DAY PER NORMAL YEAR
	TAD (3		/OFFSET FOR 1970
	TAD DATEM
	DCA DATEM
	TAD TM1
	TAD (JAN-1
	DCA TM2
	TAD I TM2	/GET MONTH OFFSET
	TAD DATEM
2$:	CLL
	TAD (-7		/MODULO 7
	SZL
	JMP 2$
	TAD (7
	JMS I	(LISPRT	/PRINT WEEKDAY,
	WEEKLST
	TAD	(', 
	JMS I	(PRWD
.IF DF GERMAN <
	TAD	DAY	
	JMS I	(PRWD	/PRINT DATE.
	TAD	('. 
	JMS I	(PRWD>
	TAD	TM1
	JMS I	(LISPRT	/PRINT MONTH,
	MONLST
.IF NDF GERMAN <
	TAD	(' @
	JMS I (PRWD	/SPACE
	TAD DAY
	JMS I (PRWD>
	TAD	(', 
	JMS I	(PRWD
	TAD	('19	/PRINT ", 19"
	JMS I	(PRWD
	TAD YEAR
	JMS I (PRWD	/PRINT REST OF YEAR
	JMS I (CRLF
	JMS I (LOOK	/LOOKUP SYS:DATE.SV
	YDATE
	JMP I DATE	/DO NOTHING IF IT'S NOT THERE
	JMP I (CHAIN	/CHAIN TO IT, IF IT'S THERE
NODATE,	JMS I (ERROR
	20.
TM1,	0
TM2,	0
DATEM,	0
DAY,	0
YEAR,	0
JAN,	0
FEB,	3
	4;0;2;5;0;3;6;1;4;6

	PAGE
TIME,	0
	CLA
	GIOT		/GET TIME OF DAY
	DCA	T$
	TAD	T$
	BSW
	AND	(77
	TAD	(100.	/KLUDGE TO PREVENT SPACES
	JMS I	(OTOD
	JMS I	(PRWD
	TAD	(':@
	JMS I	(PRWD
	TAD	T$
	AND	(77
	TAD	(100.	/IDEM
	JMS I	(OTOD
	JMS I	(PRWD
	TAD	('  
	JMS I	(PRWD
	JMP I	TIME
T$:	0
	PAGE

---