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