SRDATE - set file reference date.

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
+