From 26e77a831795edf5964ef0c6a705be9bbb726426 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Tue, 27 Mar 2018 13:38:21 +0200
Subject: [PATCH] SRDATE - set file reference date.

---
 build/build.tcl      |   4 +
 doc/programs.md      |   1 +
 src/sysen3/srdate.13 | 200 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 205 insertions(+)
 create mode 100644 src/sysen3/srdate.13

diff --git a/build/build.tcl b/build/build.tcl
index e9d5540c..21df7c24 100644
--- a/build/build.tcl
+++ b/build/build.tcl
@@ -675,6 +675,10 @@ expect ":KILL"
 respond "*" ":midas sys1;ts date_sysen3;date\r"
 expect ":KILL"
 
+# SRDATE
+respond "*" ":midas sys3;ts srdate_sysen3;srdate\r"
+expect ":KILL"
+
 # PWMAIL
 respond "*" ":midas sys;ts pwmail_ksc;qmail\r"
 respond "PWORD version (Y or N)? " "Y\r"
diff --git a/doc/programs.md b/doc/programs.md
index 0958ef25..b3d7d62f 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -142,6 +142,7 @@
 - SPCWAR, Spacewar game.
 - SPELL, ESPELL spell checker.
 - SRCCOM, Compares/merges source files, compares binary files.
+- SRDATE, set reference date on a file.
 - STINK, linker.
 - STINKR, new linker (binary only).
 - STTY, set terminal parameters.
diff --git a/src/sysen3/srdate.13 b/src/sysen3/srdate.13
new file mode 100644
index 00000000..1294988b
--- /dev/null
+++ b/src/sysen3/srdate.13
@@ -0,0 +1,200 @@
+;;;-*-Midas-*-
+
+title SRDATE - Set File Reference Date
+
+a=1
+b=2
+c=3
+d=4
+e=5
+
+dski=10
+erri=11
+ttyo=12
+
+x=15
+y=16
+p=17
+
+call=pushj p,
+return=popj p,
+tyo=.iot ttyo,
+
+define syscal op,args
+	.call [setz ? sixbit /op/ ? args(400000)]
+termin
+
+define princ &string&
+	movei y,.length string
+	move x,[440700,,[ascii string]]
+	.call sioto
+	 .lose %lsfil
+termin
+
+define terpri
+	tyo [^m]
+	tyo [^j]
+termin
+
+	loc 100
+
+$$rfn==1
+rsixtp:	cain a,",
+	 aos (p)
+	return
+.insrt dsk:syseng;rfn
+
+$$out==1
+$$in==1
+.insrt dsk:syseng;datime
+
+pdllen==100.
+.vector pdl(pdllen)
+
+buflen==100.
+.vector buf(buflen)
+
+.scalar ndate			;the new date goes here
+
+go:	move p,[-pdllen,,pdl-1]
+	syscal open,[[%tjdis+.uao,,ttyo] ? [sixbit /tty/]]
+	 .lose %lsfil
+	.suset [.roption,,a]
+	tlnn a,%opddt
+	 jrst noddt
+	.break 12,[..rpfi,,file]
+	move b,file+1
+	exch b,file+3
+	exch b,file+2
+	movem b,file+1
+	jrst getjcl
+
+noddt:	.suset [.rhsname,,file+3]
+	.suset [.rxuname,,file+1]
+getjcl:	setzm buf
+	move x,[buf,,buf+1]
+	blt x,buf+buflen-2
+	setom buf+buflen-1
+	setzm ndate
+	tlnn a,%opcmd
+	 jrst start
+	.break 12,[..rjcl,,buf]
+	movei b,file
+	move d,[440700,,buf]
+	call rfn"rfn
+	caie a,",
+	 jrst start
+	call datime"asctwd
+	movem a,ndate
+start:	movei a,file
+	syscal open,[[%donlk+.uai,,dski] ? %clerr,,ercode
+		file ? file+1 ? file+2 ? file+3]
+	 jrst ferr
+	skipe ndate
+	 jrst doit
+	syscal rfdate,[movei dski ? movem ndate]
+	 .lose %lssys
+doit:	move a,ndate
+	princ /ASetting reference date of /
+.vector truef(4)
+	syscal rfname,[movei dski ? movem truef ? movem truef+1
+		movem truef+2 ? movem truef+3]
+	 .lose %lssys
+	movei a,truef
+	call fntype
+	princ / to /
+	move a,ndate
+	call datype
+	tyo [".]
+	syscal srdate,[movei dski ? ndate]
+	 .lose %lssys
+	.suset [.roption,,a]
+	tlnn a,%opddt
+	 jrst die
+	move a,file+3
+	exch a,file+1
+	exch a,file+2
+	movem a,file+3
+	.break 12,[..spfi,,file]
+	jrst die
+
+.scalar ercode
+ferr:	princ /AError: /
+	call fntype
+	tyo [40]
+err:	syscal open,[[.uai,,erri] ? [sixbit /err/] ? movei 4 ? ercode]
+	 .lose %lssys
+errlp:	.iot erri,a
+	caige a,40
+	 jrst [	tyo [".]
+		jrst die]
+	cail a,"A
+	 caile a,"Z
+	  skipa
+	   addi a,"a-"A
+	tyo a
+	jrst errlp
+
+die:	skipe debug
+	 .value	
+	.logout 1,
+
+;;;Type out the date in A (clobbers the buffer and D)
+datype:	move d,[440700,,buf]
+	call datime"twdasc
+	sub d,[010700,,buf-1]
+	hrrz y,d
+	imuli y,5
+	lsh d,-30.
+	idivi d,7
+	sub y,d
+	move x,[440700,,buf]
+	.call sioto
+	 .lose %lssys	
+	return
+
+;;;Type out the filename in block pointed to by A:
+fntype:	push p,(a)+2
+	push p,(a)+1
+	push p,(a)+3
+	move a,(a)
+	call 6type
+	tyo [":]
+	pop p,a
+	call 6type
+	tyo [";]
+	pop p,a
+	call 6type
+	tyo [40]
+	pop p,a
+
+;falls through
+
+;;;Type out A as a word of sixbit:
+6type:	ldb x,[360600,,a]
+	addi x,40
+	tyo x
+	lsh a,6
+	jumpn a,6type
+	return
+
+sioto:	setz
+	sixbit /siot/
+	movei ttyo
+	move x
+	setz y
+
+cnstnts:
+constants
+
+debug:	0			;debuging?
+
+file:	sixbit /dsk/
+	-1
+	sixbit />/
+	-1
+
+variables
+
+	end go
+