/* copy - conditional file copy program (with query) Must be linked with 'PLIDIO.REL'. syntax: COPY destination may be drive name only (source drive ~= destination) source may be a wild card specification */ copy: procedure options(main); %replace TRUE by '1'b, FALSE by '0'b, VERSION by 'COPY 1.0', VERDATE by '02/05/81', HELP_CMD by 'HELP ', EOF by '^Z', INTRRPT by '^C', BUFWDS by 64, /* words per buffer */ LISTDIM by 20, /* files per copy list allocation */ LISTBLKS by 5, /* number of allocations */ LISTLNGTH by 100, /* LISTDIM * LISTBLKS */ ALLOCWDS by 112, /* ((LISTDIM * 11) + 5) / 2 */ ALLOCBYTES by 224; /* ALLOCWDS * 2 */ %include 'diomod.dcl'; dcl version_date char(8) external static init(VERDATE); declare 1 default1 based(dfcb0()), 3 space fixed(7), 3 command char(8); dcl 1 dest based(dfcb0()), %include 'fcb.dcl'; dcl 1 source based(dfcb1()), %include 'fcb.dcl'; dcl 1 sourcefile, %include 'fcb.dcl'; dcl 1 renfile, %include 'fcb.dcl'; declare fcbp pointer, 1 dir_fcb based(fcbp), %include 'fcb.dcl'; declare 1 copy_fcb(LISTDIM) based, 3 fname char(8), 3 ftype char(3); declare save_drive bin fixed(7), maxwords bin fixed(15), nbuffs bin fixed(15), bufptr pointer, cptr(LISTBLKS) pointer, dir_mask(0:127) bit(8) based(dbuff()), (i,j,n) bin fixed(15) static init(0), msg char(47) varying static init( '^I^Isyntax: COPY '); on error(70) begin; put list('No Source File',msg); call reboot(); end; on error(7) begin; n = n - 1; put skip list('List Space Exhausted'); call copy_list; put skip list('Rebooting'); call reboot(); end; put list(VERSION); put skip; if command = HELP_CMD then do; put skip list('COPY - Copy with Query'); put skip(2) list('Command line'); put skip list(msg); put skip list('where:'); put edit(' is an unambiguous filename or drive', ' is unambiguous unless destination is a different drive') (skip(2),a); put skip(2); call reboot(); end; redo: maxwords = memwds(); bufptr = memptr(); call get_nbuffs; /* get actual drives */ if source.drive = 0 then source.drive = curdsk() + 1; if dest.drive = 0 then dest.drive = curdsk() + 1; /* test for wild card in destination */ if wildcard(dfcb0()) then do; put skip list('Invalid destination'); call reboot(); end; /* process copy command */ if dest.drive = source.drive & dest ~= source & ~wildcard(dfcb1()) then do; sourcefile = source; call diocopy; end; else if dest.drive ~= source.drive then if wildcard(dfcb1()) then do; save_drive = source.drive; call setdma(dbuff()); call alloc; i = sear(dfcb1()); if i > -1 then do; do while(i > -1); unspec(i) = unspec(i) & '00000011'b; /* for CP/M 1.4 */ fcbp = addr(dir_mask(i * 32)); if dir_fcb.drive = user() then do; if query() then call add_to_list; end; i = searn(); end; call copy_list; end; else signal error(70); end; else do; sourcefile = source; if dest.fname = '' & dest.ftype = '' then do; save_drive = dest.drive; dest = sourcefile; dest.drive = save_drive; end; call diocopy; end; else put list('Invalid Format',msg); call reboot(); /* user - procedure to get user number if version > = cp/m 2.0 */ user: procedure returns(fixed(7)); if vers() = '0000'b4 then return(0); else return(getusr()); end user; /* wildcard - returns true if fcb based at ptr has question marks */ wildcard: procedure(p) returns(bit(1)); declare p pointer, 1 wild_fcb based(p), 3 drive bin fixed(7), 3 name char(12); if index(wild_fcb.name,'?') > 0 then return(TRUE); else return(FALSE); end wildcard; /* add_to_list - add fcb to copy list */ add_to_list: procedure; j = j + 1; if j > LISTDIM then do; call alloc; j = 1; end; call get_nbuffs; cptr(n)->copy_fcb(j).fname = dir_fcb.fname; cptr(n)->copy_fcb(j).ftype = dir_fcb.ftype; end add_to_list; /* alloc - allocate another block of copy list */ alloc: procedure; declare fixed15 fixed based; n = n + 1; if n > LISTBLKS then signal error(7); maxwords = maxwords - ALLOCWDS; addr(bufptr)->fixed15 = addr(bufptr)->fixed15 + ALLOCBYTES; allocate copy_fcb set(cptr(n)); end alloc; /* copy_list - copy files in copy list */ copy_list: procedure; declare k fixed, l fixed(7); call get_nbuffs; put skip list('Copying: '); k = 0; do i = 1 to n; do l = 1 to LISTDIM while( i < n | l <= j); sourcefile.drive = save_drive; sourcefile.fname = cptr(i)->copy_fcb(l).fname; sourcefile.ftype = cptr(i)->copy_fcb(l).ftype; dest.fname = cptr(i)->copy_fcb(l).fname; dest.ftype = cptr(i)->copy_fcb(l).ftype; call diocopy; put list('.'); k = k + 1; end; end; put skip list(k,'file(s) copied to',ascii(64+dest.drive)||':'); end copy_list; /* query - query and delete if response is 'y'es */ query: procedure returns(bit(1)); declare c char(1); put skip list(ascii(64+source.drive)||':', dir_fcb.fname||'.'||dir_fcb.ftype,'?'); c = rdcon(); if c = INTRRPT then call reboot(); else if c = EOF then do; call copy_list; call reboot(); end; else if translate(c,'Y','y') = 'Y' then return(TRUE); else return(FALSE); end query; /* get_nbuffs - calculate number of buffers available for copy */ get_nbuffs: procedure; nbuffs = divide(maxwords,BUFWDS,15); if nbuffs = 0 then do; put skip list('No Buffer Space - Rebooting'); call reboot(); end; end get_nbuffs; /* diocopy - direct io copy from source to dest */ diocopy: procedure; declare /* buffer management */ eofile bit(8), i fixed(15), m fixed(15), memory (0:0) bit(16) based(bufptr), buffs fixed(15); /* copy fcb to rename file, count extents */ renfile = dest; /* destination file will be deleted later */ dest.ftype = '$$$'; /* delete any existing x.$$$ file */ call delete(addr(dest)); sourcefile.fext = 0; /* open the source file, if possible */ if open(addr(sourcefile)) = -1 then signal error(70); /* source file opened, create $$$ file */ dest.fext = 0; dest.crec = 0; if make(addr(dest)) = -1 then do; put skip list('No Directory Space on', ascii(64+dest.drive)||':'); call reboot(); end; /* $$$ temp file created, now copy from source */ eofile = FALSE; buffs = nbuffs; sourcefile.crec = 0; do while (^eofile); m = 0; /* fill buffers */ do i = 0 repeat (i+1) while (i