;-*- Mode: MIDAS -*-
TITLE DATSRV	; Net daytime server -- install as DEVICE;TCP SYN015

PORT==13.			; Official TCP port for Daytime Server.

A=1				; General use reguster
B=2				; "
C=3				; "		
D=4				; "
DATE=5				; SIXBIT YYMMDD

SEND=<001000,,>
T=7				; For use by SEND UUO only
E=40				; "

NETO==1				; Output socket
NETI==2				; Input socket


LOC 41
	JSR UUOH
LOC 42
	JSR TSINT

LOC 100				; One page of impure code is all we need

DEBUG:	0

TSINT:	0			; Interrupt handler - for fatal conditions
	0
	JSR AUTPSY		; Any interrupt is cause for death.

UUOH:	0			; UUO handler -- send SIXBIT terminated by '@
	MOVEI T,440600		; SIXBIT byte pointer
	HRLM T,E
	ILDB T,E
	ADDI T,40		; Convert to ASCII
	.IOT NETO,T		; First uppercase
.SEND:	ILDB T,E
	CAIN T,'@
	 JRST 2,@UUOH
	ADDI T,40		; Convert to ASCII
	CAIL T,"A		; If greater than than A
	 ADDI T,40		;  convert to lowercase
	.IOT NETO,T
	JRST .SEND
	
GO:	.CALL [	SETZ
		SIXBIT /TCPOPN/
		MOVEI NETI
		MOVEI NETO
		MOVEI PORT
		[-1]
		[-1] ((SETZ))]
	 JSR AUTPSY		; Failed (should timeout!)
	MOVEI B,3*30.		; Try for 30 sec
RETRY:	MOVEI A,10.
	.SLEEP A,
	.CALL [	SETZ
		SIXBIT /WHYINT/
		MOVEI NETO
		MOVEM A
		MOVEM A ((SETZ))]
	 .LOSE %LSSYS
	CAIE A,%NSOPN
	 CAIN A,%NSRFN
	 CAIA
	 SOJG B,RETRY
	CAIG B,
	 JSR AUTPSY		; Timed out...
SERVE:	.RDATE DATE,
	LDB A,[360400,,DATE]	; First digit of year
	IMULI A,10.
	LDB B,[300400,,DATE]	; Second digit of year
	ADD A,B
	IDIVI A,4
	IMULI A,5
	ADD A,B
	LDB C,[140600,,DATE]	; Month
	TLNE DATE,A
	 ADDI C,10.
	JUMPN B,.+3
	CAIG C,22
	 SOJ A,
	ADD A,MONTAB-1-'0 (C)
	LDB B,[060400,,DATE]	; First digit of day
	IMULI B,10.
	LDB D,[000400,,DATE]	; Second digit of day
	ADD A,D
	ADD A,B
CAL2:	ADDI A,5		; Century starts on a Saturday
	IDIVI A,7
	SEND WKDAY(B)
	SEND MONTH-1-'0 (C)
	LDB B,[001400,,T]
	ROT B,-14
	TLNN B,170000		; If date has a leading zero
	 TLZ B,600000		; make it a blank
	IORI B,(SIXBIT /@/)
	SEND B
	.RTIME B,
	LSHC A,2*6
	LSH A,6
	IORI A,':
	LSHC A,2*6
	LSH A,6
	IORI A,':
	HRRI B,(SIXBIT /20@/)	; Century
	SEND A
	HRLZI B,777700		; Mask YY
	AND B,DATE
	TLO B,'@
	SEND B
	.IOT NETO,[15]		; CR
	.IOT NETO,[12]		; LF
	.NETS NETO,		; Force the output.
	.CLOSE NETO,		; Disconnect.
	.CLOSE NETI,		; Disconnect.
	CAIA
AUTPSY:	 0
	SKIPE DEBUG
	 .VALUE
	.LOGOUT			; All done

CONST:
CONSTANTS

MONTH:	SIXBIT/JAN @/
	SIXBIT/FEB @/
	SIXBIT/MAR @/
	SIXBIT/APR @/
	SIXBIT/MAY @/
	SIXBIT/JUN @/
	SIXBIT/JUL @/
	SIXBIT/AUG @/
	SIXBIT/SEP @/
	SIXBIT/OCT @/
	SIXBIT/NOV @/
	SIXBIT/DEC @/

MONTAB:	0
	3
	3
	6
	1
	4
	6
	2
	5
	0
	3
	5

WKDAY:	SIXBIT/MON @/
	SIXBIT/TUE @/
	SIXBIT/WED @/
	SIXBIT/THU @/
	SIXBIT/FRI @/
	SIXBIT/SAT @/
	SIXBIT/SUN @/

END GO