;;;-*-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