;-*-midas-*-

title arccpy

a=1
b=2
c=3
d=4
e=5
g=6
h=7
i=10
j=11
k=12
l=13
m=14
n=15
o=16
p=17

define syscal name,args
    .call [ setz ? sixbit /name/ ? args ((setz))]
termin

define error line
    .value [asciz / :line

:kill /]
termin

ch==,,-1
choarc==1			;Channel for referring to old archive.
chnarc==2			;Channel for referring to new archive.

;something about old archive directory formats:
udnamp==1

unfn1==0
unfn2==1
unrndm==2
undate==3
unref==4
lunblk==5

debug:	-1

dev:	0			;Filename block for reading the archive device name.
fn1:	0
fn2:	0
snm:	0
arcfn2:	0			;Real FN2 of the old archive device file.

lpdl==40
pdl:	block lpdl

olddir:	block 2000		;The old archive's directory goes here.

cpybuf:	block 2000

jclbuf:	block 40
jclbfe:	-1

go:	move p,[-lpdl,,pdl]
	.suset [.roptio,,a]
	tlnn a,%opcmd
	 jrst nojcl
	tlo a,%opopc
	.suset [.soptio,,a]
	setzm jclbuf
	move a,[jclbuf,,jclbuf+1]
	blt a,jclbfe-1		;Read in our JCL line.
	.break 12,[..rjcl,,jclbuf]
	.suset [.rsname,,snm]
	movei b,dev
	move d,[440700,,jclbuf]	;Process the JCL to learn the archive device name.
	pushj p,rfn"rfn
	skipn dev		;An argument of FOO;AR7: means the file is DSK:AR7 > FOO;.
	 jrst nojcl
	syscal open,[[.bii,,choarc] ? dev ? ['.file.] ? [sixbit /(dir)/] ? snm]
	 jrst noarc
	move a,[-2000,,olddir]
	.iot choarc,a		;Read the image directory of the old archive.
	.close choarc,
	syscal open,[[.uai,,choarc] ? ['dsk,,] ? dev ? [sixbit />/] ? snm]
	 .lose %lsfil
	syscal rfname,[%climm,,choarc repeat 3,[ ? %clout,,arcfn2 ]]
	 .lose %lsfil
	move a,olddir
	camn a,[sixbit /ARC1!!/]
	 jrst noold		;Barf if the archive is a new one.
	syscal delete,[['dsk,,] ? ['_arccp] ? [sixbit />/] ? snm]
	 caia			;get rid of anything left over if a previous :ARCCPY
	  jrst .-2		;was killed.
	move b,olddir+udnamp	;Get index of first name entry in old archive.
file:	cain b,2000
	 jrst done
	syscal open,[[.bii,,choarc] ? dev ? unfn1+olddir(b)
			unfn2+olddir(b) ? snm ? %clerr,,a]
	 pushj p,arcopf
	syscal open,[[.bio,,chnarc] ? ['_ARCCP] ? unfn1+olddir(b)
			unfn2+olddir(b) ? snm ? %clerr,,a]
	 pushj p,arcopf
;Copy the file from the old archive to the new.
cpylup:	move a,[-2000,,cpybuf]
	.iot choarc,a
	movni c,-cpybuf(a)
	hrlzs c
	hrri c,cpybuf
	skipge c
	 .iot chnarc,c
	jumpge a,cpylup
;Copy the last write and last read dates.
	syscal sfdate,[%climm,,chnarc ? undate+olddir(b)]
	 .lose %lsfil
	syscal srdate,[%climm,,chnarc ? unref+olddir(b)]
	 .lose %lsfil
	syscal finish,[%climm,,chnarc]
	 .lose %lsfil
	.close choarc,
	.close chnarc,
next:	addi b,lunblk
	jrst file

;Here if an open on the old or new archive fails.
arcopf:	cain a,%efldv		;If it's device full (no jobdev slots),
	 jrst wait		;just wait a little while for one to appear.
	pop p,a			;Otherwise, pretend the pushj p,arcopf was .lose %lsfil.
	syscal lose,[%climm,,%lsfil ? %climm,,-2(a)]

;Pause one second and retry the instruction preceding the pushj p,wait.
wait:	movei a,30.
	.sleep a,
	sos (p)
	sos (p)
	popj p,

;Now that the new archive is built, replace the old one with it.
done:	skipe debug
	 .value
	syscal delete,[['dsk,,] ? dev ? arcfn2 ? snm]
	 .lose %lsfil
	movei a,5*30.
	.sleep a,
	syscal rename,[['DSK,,] ? ['_ARCCP] ? [SIXBIT /1/] ? snm
			dev ? arcfn2]
	 pushj p,wait
	.break 16,140000


;Get the filename reader.

rfn"$$rfn==1
rfn"rsixtp:	popj p,
.insrt syseng;rfn

nojcl:	error [JCL in the form <dir>;<archive>: must be specified.]

noarc:	error The specified archive device does not exist.

noold:	error The specified archive device is already in the new format.

patch: pat:
	block 40
patche:	-1

end go