/CAL.SB
/	CALL CAL(MONTH,IDAY,IYEAR,DAY)

/	RETURNS MONTH, DAY, YEAR, AND DAY (MON..SUN)

/	FIXED FOR YEAR BITS IN BATCH 25-JUN-81

	ENTRY	CAL

ABSYM	TMP	7
OPDEF	TADI	1400
OPDEF	DCAI	3400
OPDEF CDF00	6201
OPDEF	CDF10	6211
	LAP	/PAGE IT OURSELVES


DATEM,	0
DAYTE,	-1
WEEKPT,	WEEKLS
MUNPT,	MONPTR
JANM1,	BEFJAN
MUNTH,
TM1,	0
TM2,	0
STRPTR,	0
DATWRD,	7666
BATWRD,	7777

CAL,	0	/ENTRY POINT
D,	0
	CDF10
	TADI	DATWRD	/GET DATE WORD
	DCA	DATEM


	TAD	DATEM	/EXTRACT MONTH
	CLL RTL
	RTL
	RAL
	AND	(17
	DCA	TM1	/MONTH
	TAD	MUNTH
	CLL RTL
	TAD	MUNTH	/*5
	TAD	MUNPT
	JMS	STROUT	/COPY STRING

	TAD	DATEM	/EXTRACT DAY OF MONTH
	CLL RTR
	RAR
	AND	(37
	DCA	DAYTE
	TAD	DAYTE
	JMS	ARGOUT	/OUTPUT DATE

	TAD	DATEM	/EXTRACT YEAR
	AND	(7
	DCA	TM2
	CDF00
	TAD I	BATWRD
	AND	(600
	CLL RTR;RTR
	TAD	TM2
	DCA	TM2
	TAD	TM2
	TAD	(D1970
	JMS	ARGOUT

	DCA	JAN	/COMPUTE DAY OF WEEK
	CLA CLL CML IAC RAL	/=3
	DCA	FEB
	STL CLA RTL	/=2
	TAD	TM2
	CLL RTR
	SNL SMA
	JMP	LEAP
	ISZ	JAN
	ISZ	FEB

LEAP,	AND	(37
	TAD	TM2
	TAD	(3
	TAD	DAYTE
	DCA	DATEM
	TAD	TM1
	TAD	JANM1	/JAN-1
	DCA	TM1
	TAD I	TM1
	TAD	DATEM

DIV7,	CLL
	TAD	(-7
	SZL
	JMP	DIV7
	TAD	(7
	DCA	TMP
	TAD	TMP
	CLL RTL
	TAD	TMP	/*5
NODATE,	TAD	WEEKPT
	JMS	STROUT	/OUTPUT DAY OF WEEK STRING
	RETRN	CAL

STROUT,	0	/OUTPUT STRING
	DCA	STRPTR	/SSTRING POINTER
	TAD	(-5
	DCA	TMP	/WORD COUNTER
	JMS	ARGOUT	/PUT DUMMY WORD
	TAD	OUTFLD	/GET ARG FIELD
	DCA	STRFLD

LITLOP,	TAD I	STRPTR	/GET A WORD
STRFLD,	HLT	/PARAM FIELD
	DCAI	PP1	/PARAM ADDRESS
	INC	PP1
	INC	STRPTR
	ISZ	TMP
	JMP	LITLOP	/LOOP UNTIL END OF STRING
	JMP I	STROUT

ARGT,	0
ARGOUT,	0
	DCA	ARGT
	TAD	CAL
	DCA	PP1
PP1,	HLT	/GO TO CALL FIELD
	TADI	D	/GET FIELD TO GO TO
	DCA	OUTFLD
	INC	D
	TADI	D
	DCA	PP1	/GET ADDRESS TO PUT TO
OUTFLD,	HLT		/GO TO THAT FIELD
	TAD	ARGT
	DCAI	PP1	/PUT A WORD
	INC	D
	JMP I	ARGOUT	/RETURN

	CPAGE	200
BEFJAN,	0
JAN,	0
FEB,	3
	4;0;2;5;0;3;6;1;4;6
MONPTR,
NODAYT,TEXT	'?NO DATE!?'

	TEXT	'JANUARY   '
	TEXT	'FEBRUARY  '
	TEXT	'MARCH     '
	TEXT	'APRIL     '
	TEXT	'MAY       '
	TEXT	'JUNE      '
	TEXT	'JULY      '
	TEXT	'AUGUST    '
	TEXT	'SEPTEMBER '
	TEXT	'OCTOBER   '
	TEXT	'NOVEMBER  '
	TEXT	'DECEMBER  '

WEEKLS,	TEXT	'SATURDAY  '
	TEXT	'SUNDAY    '
	TEXT	'MONDAY    '
	TEXT	'TUESDAY   '
	TEXT	'WEDNESDAY '
	TEXT	'THURSDAY  '
	TEXT	'FRIDAY    '
	END