File: CCLDAT.MA of Disk: V50/Source/Source-Listing-MAC-1

(Source file text) 

---

/CCL DATE+TIME FOR KBM V50
/
/
/
/
/
/	CCL DATE COMMAND
/	VERSION=5A

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

	.NOLIST
	.INCLUDE IN: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 I	(JAN	/INIT JANUARY,FEBRUARY
	CLA STL IAC RAL	/AC0003
	DCA I	(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 (70
	TAD TM2
	DCA TM2		/FROM 1970 YEAR
	TAD TM2
	TAD (70.
	JMS I (OTOD
	DCA YEAR	/YEAR STRING
	SZL CLA		/LINK HAS HUNDREDS
	TAD ('20-'19
	TAD ('19
	DCA CNTURY
	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 I	(JAN	/FOR NORMAL YEARS
	ISZ I	(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	CNTURY	/PRINT ", 19" OR ", 20"
	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.
CNTURY,	'19
TM1,	0
TM2,	0
DATEM,	0
DAY,	0
YEAR,	0


	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
JAN,	0
FEB,	3
	4;0;2;5;0;3;6;1;4;6
	PAGE

---