181 lines
6.0 KiB
Plaintext
181 lines
6.0 KiB
Plaintext
|
||
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;
|
||
|