DATSRV - server for RFC 867 Daytime Protocol.

README.md

@@ -121,6 +121,7 @@ A list of [known ITS machines](doc/machines.md).
    - CROCK, analog watch.
    - CROSS, cross assembler for micros.
    - CTIMES, Chaosnet time server.
+   - DATSRV, server for RFC 867 Daytime protocol.
    - DCROCK, digital watch.
    - DDTDOC, interactive DDT documentation.
    - DECUUO, TOPS-10 and WAITS emulator.

build/build.tcl

@@ -976,6 +976,11 @@ respond "*" ":midas sysbin;timsrv bin_sysnet;timsrv\r"
 expect ":KILL"
 respond "*" ":link device;tcp syn045,sysbin;timsrv bin\r"
 
+# datsrv
+respond "*" ":midas sysbin;_sysnet;datsrv\r"
+expect ":KILL"
+respond "*" ":link device;tcp syn015,sysbin;datsrv bin\r"
+
 # mailt
 respond "*" ":link sys;ts mailt,sys2;ts emacs\r"
 

src/sysnet/datsrv.3

@@ -0,0 +1,162 @@
+;-*- 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