diocopy:
	proc options(main);
	/* file to file copy program */
	/* (all source lines begin with tabs) */

	%replace
		bufwds by 64,   /* words per buffer */
		quest  by 63,   /* ASCII '?' */
		true   by '1'b,
		false  by '0'b;

%include 'diomod.dcl';

	dcl
		1 destfile,
%include 'fcb.dcl';

	dcl
		dfcb0p ptr,
		1 sourcefile based(dfcb0p),
%include 'fcb.dcl';

	dcl
		1 dfcb1file based(dfcb1()),
%include 'fcb.dcl';

	dcl
		1 renfile,
%include 'fcb.dcl';

	dcl
		answer char(1),
		extcnt fixed(7);

	dcl
		/* buffer management */
		eofile bit(8),
		i      fixed(15),
		m      fixed(15),
		nbuffs fixed(15),
		memory (0:0) bit(16) based(memptr());

	/* compute number of buffs, 64 words each */
	nbuffs = divide(memwds(),bufwds,15);
	if nbuffs = 0 then
		do;
		put skip list('No Buffer Space');
		call reboot();
		end;

	/* initialize fcb's */
	dfcb0p = dfcb0();
	destfile = dfcb1file;

	/* copy fcb to rename file, count extents */
	renfile = destfile;
	/* search all extents by inserting '?' */
	renfile.fext = quest;
	if sear(addr(renfile)) ^= -1 then
		do;
		extcnt = 1;
			do while(searn() ^= -1);
			extcnt = extcnt + 1;
			end;
		put edit
			('OK to Delete ',extcnt,' Extent(s)?(Y/N)')
			(skip,a,f(3),a);
		get list(answer);
		if ^ (answer = 'Y' ! answer = 'y') then
			call reboot();
		end;

	/* destination file will be deleted later */
	destfile.ftype = '$$$';
	/* delete any existing x.$$$ file */
	call delete(addr(destfile));

	/* open the source file, if possible */
	if open(addr(sourcefile)) = -1 then
		do;
		put skip list('No Source File');
		call reboot();
		end;

	/* source file opened, create $$$ file */
	destfile.fext = 0;
	destfile.crec = 0;
	if make(addr(destfile)) = -1 then
		do;
		put skip list('No Directory Space');
		call reboot();
		end;

	/* $$$ temp file created, now copy from source */
	eofile = false;
		do while (^eofile);
		m = 0;
			/* fill buffers */
			do i = 0 repeat (i+1) while (i<nbuffs);
			call setdma(addr(memory(m)));
			m = m + bufwds;
			if rdseq(addr(sourcefile)) ^= 0 then
				do;
				eofile = true;
				/* truncate buffer */
				nbuffs = i;
				end;
			end;
		m = 0;
			/* write buffers */
			do i = 0 to nbuffs-1;
			call setdma(addr(memory(m)));
			m = m + bufwds;
			if wrseq(addr(destfile)) ^= 0 then
				do;
				put skip list('Disk Full');
				call reboot();
				end;
			end;
		end;

	/* close destination file and rename */
	if close(addr(destfile)) = -1 then
		do;
		put skip list('Disk R/O');
		call reboot();
		end;

	/* destination file closed, erase old file */
	call delete(addr(renfile));

	/* now rename $$$ file to old file name */
	destfile.name2 = renfile.name1;
	call rename(addr(destfile));
	call reboot();
	end diocopy;
