From 7e4649e482aea3edc32a090c7049598e3b675025 Mon Sep 17 00:00:00 2001
From: Eric Swenson <eric@swenson.org>
Date: Mon, 13 Mar 2017 22:34:42 -0700
Subject: [PATCH] Added CTIMSR (DEVICE; CHAOS TIME). Resolves #488.

---
 README.md            |   1 +
 build/build.tcl      |   4 ++
 src/syseng/ctimsr.16 | 120 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 125 insertions(+)
 create mode 100755 src/syseng/ctimsr.16

diff --git a/README.md b/README.md
index f219f8ff..664e3d45 100644
--- a/README.md
+++ b/README.md
@@ -128,6 +128,7 @@ A list of [known ITS machines](doc/machines.md).
    - CROCK, analog watch.
    - CROSS, cross assembler for micros.
    - CTIMES, Chaosnet time server.
+   - CTIMSR, Chaosnet time server.
    - DATE, print date and time.
    - DATSRV, server for RFC 867 Daytime protocol.
    - DCROCK, digital watch.
diff --git a/build/build.tcl b/build/build.tcl
index bf2ede09..e8d4b2f6 100644
--- a/build/build.tcl
+++ b/build/build.tcl
@@ -1371,6 +1371,10 @@ expect ":KILL"
 respond "*" ":midas sys2;ts wholin_sysen2;wholin\r"
 expect ":KILL"
 
+# DEVICE; CHAOS TIME
+respond "*" ":midas device;chaos time_syseng;ctimsr\r"
+expect ":KILL"
+
 # OBS
 respond "*" ":midas sys;ts obs_bawden;obs\r"
 expect ":KILL"
diff --git a/src/syseng/ctimsr.16 b/src/syseng/ctimsr.16
new file mode 100755
index 00000000..f7bf2223
--- /dev/null
+++ b/src/syseng/ctimsr.16
@@ -0,0 +1,120 @@
+;; DLW 1/26/77 -*-Fundamental-*-
+
+	TITLE CHAOS NET TIME SERVER
+
+A=1
+B=2
+C=3
+P=17
+
+GMTDIF==5			; Difference between EST and GMT zones.
+
+NETI==1
+NETO==2
+
+.INSRT SYSTEM;CHSDEF >
+
+; The offical contact name is "TIME".  The server sends an ANS of 4 bytes.
+; The first word of data is the LOW order 16 bits, and the second word
+; the HIGH order 16 bits of the number of seconds since Jan 1,1900, midnight GMT.
+; Each 16-bit word is made up of two 8-bit bytes in pdp11 order, which is
+; wrong for pdp10's.  Beware.
+
+PKTBUF:	BLOCK %CPMXW		; Packet buffer.
+
+DEBUG:	0			; -1 => debugging.
+PDL:	-10,,.
+	BLOCK 10
+
+GO:	MOVE P,PDL
+	MOVE A,[JSR TSINT]	; Must handle IOC errors
+	MOVEM A,42
+	SKIPN DEBUG
+	 .SUSET [.SMASK,,[%PIIOC]]
+	.CALL [	SETZ
+		SIXBIT /CHAOSO/
+		MOVEI NETI
+		MOVEI NETO
+		SETZI 5 ] ;WINDOW SIZE = 5 (ha ha)
+	 JSR LOGOUT
+
+;; Construct and send the LSN packet.
+	MOVEI A,%COLSN
+	DPB A,[$CPKOP+PKTBUF]	; OPCODE = LSN
+	MOVE A,[.BYTE 8 ? "T ? "I ? "M ? "E]
+	MOVEM A,PKTBUF+%CPKDT
+	MOVEI A,4
+	DPB A,[$CPKNB+PKTBUF]
+	.CALL [SETZ ? 'PKTIOT ? MOVEI NETO ? SETZI PKTBUF]
+	 JSR LOGOUT
+
+;; Wait for the RFC to come.
+	MOVEI A,%CSLSN		; Listening state.
+	MOVEI B,30.*30.		; 30. second timeout.
+	SKIPE DEBUG
+	 MOVSI B,177777		; or infinite if in debug mode.
+	.CALL [	SETZ
+		SIXBIT /NETBLK/
+		MOVEI NETO
+		A
+		B
+		SETZM C]
+	 JSR LOGOUT
+	CAIE C,%CSRFC		; RFC received state
+	 JSR LOGOUT
+
+;; Construct and send the ANS.
+	MOVEI A,%COANS
+	DPB A,[$CPKOP+PKTBUF]
+	MOVEI A,4
+	DPB A,[$CPKNB+PKTBUF]
+	PUSHJ P,GETTIM		; Get time in A.
+	MOVE C,[440800,,B]
+	IDPB A,C
+	LSH A,-10
+	IDPB A,C
+	LSH A,-10
+	IDPB A,C
+	LSH A,-10
+	IDPB A,C
+	MOVEM B,%CPKDT+PKTBUF	; Data.
+	.CALL [ SETZ ? 'PKTIOT ? MOVEI NETO ? SETZI PKTBUF]
+	 JSR LOGOUT
+
+;; Wait for the ANS to get sent, and die.
+	.CALL [	SETZ
+		SIXBIT /FINISH/
+		SETZI NETO]
+	 JSR LOGOUT
+	JSR LOGOUT
+
+
+LOGOUT:	0
+	SKIPL DEBUG
+	 .LOGOUT
+	.VALUE
+
+
+GETTIM:	.RLPDTM A,		; Get in A, # secs since beg of year.
+	CAME A,[-1]
+	 CAMN B,[-1]
+	  JSR LOGOUT		; If either is -1, time not known.
+	CAIGE B,		; If 4.9 on,
+	 SUBI A,24.*3600.	; subtract 1 day - .RLPDTM misfeature!
+	TLNE B,100000		; Bit 4.7 = Daylight Savings time?
+	 SUBI A,3600.		; If on, subtract one hour to get Standard.
+	MOVEI B,-1900.(B)	; Get year, relative to 1900.
+	MOVEI C,-1(B)		; Adjust and
+	LSH C,-2		; Get # leap years since 1900 not including this year.
+	IMULI B,365.		; Find # days in years thus far
+	ADDI B,(C)		; Plus # LY's, to get total days in years past.
+	IMULI B,86400.		; Now get # seconds in all them days.
+	ADD A,B			; and produce total seconds since 1/1/00 !
+	ADD A,[GMTDIF*3600.]	; Adjust to GMT.
+	POPJ P,
+
+TSINT:	0 ? 0
+	JSR LOGOUT		; IOC error
+
+
+END GO
\ No newline at end of file