File: NUDATE.PA of Tape: Various/System-Tapes/s5

(Source file text) 

---

/TWENTIETH CENTURY DATE.
/	W.V.D.MARK
/	HPF-ETHZ
/	8093 ZUERICH

	*200
START,	JMS I	(7607
	0201	/READ TWO PAGES
	1000	/IN LOC 1000
	  55	/FROM SAVE DATE BLOCK
	HLT
	TAD	(1177
	DCA	10
	TAD	(577
	DCA	11
	TAD	(-200
	DCA	20
	TAD I	11
	DCA I	10	/TRANSFER NEW DATE PROG
	ISZ	20	/OVER OLD SAVE DATE BLOCK
	JMP	.-3
	JMS I	(7607
	4200	/WRITE 2 PAGES
	1000
	  55	/BACK ON SAVE DATE BLOCK
	HLT
	JMP I	(7605

	PAGE
	TEMP=	21
	XR4=	14
	INAX=	13
	POINTR=	41
	DRSTRT=	33
	DMESAG=	100
	INDIR=	40
	KEYWRD=	25
	NAME=	34
	K77=	165
	KM240=	175
	K7=	120
	K7605=	53

	*600
DATE,	JMS	ZOCT	/CONVERT DAY OF MONTH
	-40		/.LT. 32
	CLL RTL
	RAL
	DCA	TEMP	/FORMAT: 0--34---89-11
			/      MONTH/ DAY /YEAR
	JMS I	KEYWRD	/USE ROUTINE FOR FILENAMES
	JMP	ERR	/NO ALPHA INPUT
	TAD	(MONTBL-1
	DCA	XR4
	TAD	NAME+1
	AND	K77
	SZA CLA
	JMP	ERR	/ONLY 3 LETTERS ALLOWED
NMON,	TAD I	XR4	/GET ITEM FROM MONTH LIST
	SNA
	JMP	ERR	/0 IS END: MEANS NONE FOUND
	CIA
	TAD	NAME	/COMPARE TO SUM OF 3 LETTERS
	TAD	NAME+1	/FIRST AND THIRD LETTERS NOT UNIQUE
	SZA CLA		/CHECK!
	JMP	NMON	/TRY ANOTHER
	TAD	XR4	/OK: POINTER POSITION IS MONTH
	TAD	(1-MONTBL
	CLL RAR
	RTR
	RTR
	TAD	TEMP
	DCA	TEMP	/ADD INTO DATE-WORD
	DCA	MMINUS	/SEPARATOR=0 IS EOL
	JMS	ZOCT	/GET YEAR
	-144		/.LT. 100
	TAD	(-106	/SUBTRACT 70
	SPA		/.GE. 70?
	JMP	ERR	/NO: BAD YEAR
	DCA	POINTR
	TAD	POINTR
	AND	K7	/FISH OUT MOD.8 PART
	TAD	TEMP	/FINAL DATE WORD
	CDF 10
	DCA I	(7666	/INTO RESIDENT PART
	CDF 0
	TAD	POINTR
	AND	(30	/GET OFFSET PART (2 BIT)
	CLL RTL		/SAVE INTO BATCH WORD
	RTL		/BITS 3 AND 4
	DCA	POINTR
	TAD	(7177
	AND I	(7777	/DON'T TOUCH OTHER BITS
	TAD	POINTR
	DCA I	(7777
	TSF
	JMP	.-1
	JMP I	K7605	/BACK TO KM!

ERR,	CLA CLL
	TAD	K7605
	DCA	DRSTRT
	JMS I	DMESAG
	TEXT "BAD DATE"

ZOCT,	0		/CONVERSION BCD DIGITS TO OCTAL
	DCA	INDIR	/TEMP FOR BUILDING OCTAL
	DCA	ZSWI	/SWITCH FOR 0 INPUT
MORE,	TAD I	INAX	/FROM INPUT BUFFER
	DCA	POINTR
	TAD	POINTR
	TAD	KM240	/IGNORE SPACES
	SNA CLA
	JMP	MORE
	TAD	POINTR
	TAD	MMINUS	/LOOK FOR SEPARATOR
	SNA CLA
	JMP	SEP	/OK: GOT EITHER "-" OR EOL
	TAD	POINTR
	TAD	(-"9-1
	CLL
	TAD	("9+1-"0
	SNL
	JMP	ERR	/NOT IN DIGIT RANGE
	SZA
	ISZ	ZSWI	/INC ZSWI IF NON-ZERO
	DCA	POINTR
	TAD	INDIR
	CLL RTL
	TAD	INDIR
	RAL
	TAD	POINTR	/BCD TO OCT
	DCA	INDIR
	JMP	MORE	/GET MORE DIGITS

MMINUS,	-"-
ZSWI,	0

SEP,	CLA CLL
	TAD	INDIR
	TAD I	ZOCT	/GET LIMIT
	CLA SZL
	JMP	ERR	/NUMBER TO BIG
	TAD	ZSWI
	SNA CLA
	JMP	ERR	/ZERO INPUT
	ISZ	ZOCT
	TAD	INDIR
	JMP I	ZOCT

MONTBL,	3001	/JAN
	1005	/FEB
	3701	/MAR
	2320	/APR
	4601	/MAY   GERMAN:	2601	/MAI
	3025	/JUN
	2625	/JUL
	1025	/AUG
	4305	/SEP
	4303	/OCT   GERMAN:	4313	/OKT
	4417	/NOV
	0705	/DEC   GERMAN:	3605	/DEZ
	0000	/END OF LIST

	PAGE

	$$$

---