diocopy: procedure options(main);

******************************************************************************
*                                                                            *
* This program tests many of the IBM DOS direct function calls.  The tests   *
* are not particularly complicated, but they do serve as examples for using  *
* direct DOS function calls from PL/I-86.                                    *
*                                                                            *
******************************************************************************
*                                                                            *
*  NOTE!  YOU SHOULD STUDY THE IBM DOS DOCUMENTATION FOR MORE COMPLETE       *
*         INFORMATION BEFORE USING ANY OF THESE FUNCTIONS IN YOUR PROGRAMS.  *
*                                                                            *
*                                                                            *
******************************************************************************
*   To use this program, enter the command:                                  *
*                                                                            *
*      A>seqcopy filename.typ newname.typ                                    *
*****************************************************************************/

/* DIOMOD.DCL contains the declarations for the DOS functions */
%include 'diomod.dcl';

%replace
	true   by '1'b,
	false  by '0'b,
	buffer_size by 64;   /* word size of 128 byte buffer */

declare
	(tempsrc,tempdest) char(14) var,
	eofile             bit(1),
	(i,m,num_buffs)    fixed(15),
	memory (0:0)       bit(16) based(memptr());

declare   /* source file FCB */
	srcfcb_ptr ptr,
	1 source_file based(srcfcb_ptr),
		2 drive           fixed(7),
		2 name            character(8),
		2 type            character(3),
		2 current_block   bit(16),
		2 record_size     bit(16),
		2 file_size(2)    bit(16),
		2 date            bit(16),
		2 reserved(10)    bit(8),
		2 current_rec     bit(8),
		2 rand_rec_no(2)  bit(16);

declare  /* destination file FCB */
	1 dest_file,
		2 drive           fixed(7),
		2 name            character(8),
		2 type            character(3),
		2 current_block   bit(16),
		2 record_size     bit(16),
		2 file_size(2)    bit(16),
		2 date            bit(16),
		2 reserved(10)    bit(8),
		2 current_rec     bit(8),
		2 rand_rec_no(2)  bit(16);

/******************************************************************************
*                             M a i n   P r o g r a m                         *
******************************************************************************/

/* initialize FCB's */
srcfcb_ptr = dfcb0();
source_file.drive = 0;
dest_file.drive = 0;

/* get the filenames */
call get_names(tempsrc,tempdest);

/* split up name & type; make sure they're the right length, padded with
   trailing blanks if necessary */
i = index(tempsrc,'.');
source_file.name = substr(tempsrc,1,i-1) || '        ';
source_file.name = substr(source_file.name,1,8);
source_file.type = substr(tempsrc,i+1) || '   ';
source_file.type = substr(source_file.type,1,3);

/* do the same for the destination name */
i = index(tempdest,'.');
dest_file.name = substr(tempdest,1,i-1) || '        ';
dest_file.name = substr(dest_file.name,1,8);
dest_file.type = substr(tempdest,i+1,3) || '   ';
dest_file.type = substr(dest_file.type,1,3);

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

/* create the destination file */
if make(addr(dest_file)) = -1 then do;
	put skip list('No Directory Space');
	call reboot();
end;

/* figure out how many buffers to use */
num_buffs = divide(memwds(),buffer_size,15);
if num_buffs = 0 then do;
	put skip list('No Memory Available for Buffer Space');
	call reboot();
end;

/* Copy the file. Read sequentially until the buffers are full, then write
   sequentially until the buffers are empty, then read... until the file
   is copied. */

eofile = false;
do while (^eofile);
	m = 0;
	/* fill buffers */
	do i = 0 repeat (i+1) while(i < num_buffs);
		call setdma(addr(memory(m)));
		m = m + buffer_size;
		if rdseq(addr(source_file)) ^= 0 then do;
			eofile = true;
			/* truncate buffer */
			num_buffs = i;
		end;
	end;
	m = 0;
	/* write buffers */
	do i = 0 to num_buffs - 1;
		call setdma(addr(memory(m)));
		m = m + buffer_size;
		if wrseq(addr(dest_file)) ^= 0 then do;
			put skip list('Disk Full');
			call reboot();
		end;
	end;
end;

/* close destination file */
if close(addr(dest_file)) = -1 then do;
	put skip list('Disk is Read Only');
	call reboot();
end;

/* all done! */
put skip list('File Copied');
call reboot();

/******************************************************************************
*                              P r o c e d u r e s                            *
******************************************************************************/
get_names: procedure(src,dest);
/* get the filenames from the command line */
	declare
		(src,dest) char(14) var,  /* file names */
		buffptr pointer,
		cmdline char(127) var based(buffptr),
		indx fixed;
	buffptr = dbuff();
	/* delete any leading blanks */
	do while(substr(cmdline,1,1) = ' ');
		cmdline = substr(cmdline,2);
	end;
	/* find the break between the two filenames */
	indx = index(cmdline,' ');

/* the following statement is needed to make the register allocator work 
   right  */

PUT SKIP LIST('INDX=',INDX);
	/* get the source filename */
	src = substr(cmdline,1,indx-1);
	cmdline = substr(cmdline,indx+1);
	/* delete any intervening blanks */
	do while(substr(cmdline,1,1) = ' ');
		cmdline = substr(cmdline,2);
	end;
	/* put the rest of the command line in destination filename */
	dest = substr(cmdline,1,14);
end get_names;

end diocopy;