home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol079 / copy.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  8.7 KB  |  369 lines
  1. /* copy - conditional file copy program (with query)
  2.         Must be linked with 'PLIDIO.REL'.
  3.     syntax:  COPY <destination> <source>
  4.     destination may be drive name only (source drive ~= destination)
  5.     source may be a wild card specification  */
  6.  
  7.  
  8.     copy:     procedure options(main);
  9.     %replace
  10.        TRUE           by '1'b,
  11.        FALSE          by '0'b,
  12.        VERSION        by 'COPY 1.0',
  13.        VERDATE        by '02/05/81',
  14.        HELP_CMD       by 'HELP    ',
  15.        EOF            by '^Z',
  16.        INTRRPT        by '^C',
  17.        BUFWDS         by 64,   /* words per buffer */
  18.        LISTDIM        by 20,   /* files per copy list allocation */
  19.        LISTBLKS       by 5,    /* number of allocations */
  20.        LISTLNGTH      by 100,  /* LISTDIM * LISTBLKS */
  21.        ALLOCWDS       by 112,  /* ((LISTDIM * 11) + 5) / 2  */
  22.            ALLOCBYTES     by 224;  /* ALLOCWDS * 2 */
  23.  
  24. %include 'diomod.dcl';
  25.  
  26.     dcl
  27.        version_date   char(8) external static init(VERDATE);
  28.  
  29.  
  30.     declare
  31.        1 default1      based(dfcb0()),
  32.          3 space       fixed(7),
  33.          3 command     char(8);
  34.  
  35.  
  36.     dcl
  37.         1 dest based(dfcb0()),
  38. %include 'fcb.dcl';
  39.  
  40.     dcl
  41.         1 source based(dfcb1()),
  42. %include 'fcb.dcl';
  43.  
  44.  
  45.     dcl
  46.         1 sourcefile,
  47. %include 'fcb.dcl';
  48.  
  49.  
  50.     dcl
  51.         1 renfile,
  52. %include 'fcb.dcl';
  53.  
  54.  
  55.     declare
  56.        fcbp            pointer,
  57.        1 dir_fcb       based(fcbp),
  58. %include 'fcb.dcl';
  59.     
  60.  
  61.     declare
  62.         1 copy_fcb(LISTDIM) based,
  63.           3 fname    char(8),
  64.           3 ftype    char(3);
  65.  
  66.  
  67.     declare
  68.        save_drive       bin fixed(7),
  69.        maxwords         bin fixed(15),
  70.        nbuffs           bin fixed(15),
  71.        bufptr           pointer,
  72.        cptr(LISTBLKS)   pointer,
  73.        dir_mask(0:127)  bit(8) based(dbuff()),
  74.        (i,j,n)          bin fixed(15) static init(0),
  75.        msg              char(47) varying static init(
  76.                      '^I^Isyntax: COPY <destination file> <source file>');
  77.  
  78.     on error(70) begin;
  79.        put list('No Source File',msg);
  80.        call reboot();
  81.        end;
  82.  
  83.  
  84.     on error(7) begin;
  85.        n = n - 1;
  86.        put skip list('List Space Exhausted');
  87.        call copy_list;
  88.        put skip list('Rebooting');
  89.        call reboot();
  90.        end;
  91.  
  92.     put list(VERSION);
  93.     put skip;
  94.     if command = HELP_CMD then do;
  95.         put skip list('COPY - Copy with Query');
  96.         put skip(2) list('Command line');
  97.         put skip list(msg);
  98.         put skip list('where:');
  99.         put edit('<destination> is an unambiguous filename or drive',
  100.                  '<source> is unambiguous unless destination is a different drive')
  101.                 (skip(2),a);
  102.         put skip(2);
  103.         call reboot();
  104.         end;
  105.  
  106. redo:    maxwords = memwds();
  107.     bufptr = memptr();
  108.     call get_nbuffs;
  109.  
  110.     /* get actual drives */
  111.     if source.drive = 0 then
  112.        source.drive = curdsk() + 1;
  113.     if dest.drive = 0 then
  114.        dest.drive = curdsk() + 1;
  115.  
  116.     /* test for wild card in destination */
  117.     if wildcard(dfcb0()) then do;
  118.        put skip list('Invalid destination');
  119.        call reboot();
  120.        end;
  121.  
  122.     /* process copy command */
  123.     if dest.drive = source.drive & dest ~= source
  124.        & ~wildcard(dfcb1()) then do;
  125.           sourcefile = source;
  126.           call diocopy;
  127.           end;
  128.     else if dest.drive ~= source.drive then
  129.        if wildcard(dfcb1()) then do;
  130.           save_drive = source.drive;
  131.           call setdma(dbuff());
  132.           call alloc;
  133.           i = sear(dfcb1());
  134.           if i > -1 then do;
  135.                 do while(i > -1);
  136.                 unspec(i) = unspec(i) & '00000011'b;  /* for CP/M 1.4 */
  137.                 fcbp = addr(dir_mask(i * 32));
  138.                 if dir_fcb.drive = user() then do;
  139.                    if query() then
  140.                       call add_to_list;
  141.                    end;
  142.                    i = searn();
  143.                 end;
  144.              call copy_list;
  145.              end;
  146.           else
  147.              signal error(70);
  148.           end;
  149.        else do;
  150.           sourcefile = source;
  151.           if dest.fname = '' & dest.ftype = '' then do;
  152.              save_drive = dest.drive;
  153.              dest = sourcefile;
  154.              dest.drive = save_drive;
  155.              end;
  156.           call diocopy;
  157.           end;
  158.     else
  159.        put list('Invalid Format',msg);
  160.     call reboot();
  161.  
  162. /* user - procedure to get user number if version > = cp/m 2.0 */
  163.     user: procedure returns(fixed(7));
  164.  
  165.     if vers() = '0000'b4 then
  166.        return(0);
  167.     else
  168.        return(getusr());
  169.     end user;
  170.  
  171. /* wildcard - returns true if fcb based at ptr has question marks */
  172.     wildcard: procedure(p) returns(bit(1));
  173.     declare
  174.        p pointer,
  175.        1 wild_fcb based(p),
  176.          3 drive  bin fixed(7),
  177.          3 name   char(12);
  178.  
  179.     if index(wild_fcb.name,'?') > 0 then
  180.        return(TRUE);
  181.     else
  182.        return(FALSE);
  183.     end wildcard;
  184.  
  185. /* add_to_list - add fcb to copy list */
  186.     add_to_list: procedure;
  187.  
  188.     j = j + 1;
  189.     if j > LISTDIM then do;
  190.         call alloc;
  191.         j = 1;
  192.         end;
  193.     call get_nbuffs;
  194.     cptr(n)->copy_fcb(j).fname = dir_fcb.fname;
  195.     cptr(n)->copy_fcb(j).ftype = dir_fcb.ftype;
  196.     end add_to_list;
  197.  
  198. /* alloc - allocate another block of copy list */
  199.     alloc: procedure;
  200.     declare
  201.        fixed15    fixed based;
  202.  
  203.     n = n + 1;
  204.     if n > LISTBLKS then
  205.         signal error(7);
  206.     maxwords = maxwords - ALLOCWDS;
  207.     addr(bufptr)->fixed15 = addr(bufptr)->fixed15 + ALLOCBYTES;
  208.     allocate copy_fcb set(cptr(n));
  209.     end alloc;
  210.  
  211.  
  212. /* copy_list - copy files in copy list */
  213.     copy_list: procedure;
  214.     declare
  215.        k    fixed,
  216.        l    fixed(7);
  217.  
  218.     call get_nbuffs;
  219.     put skip list('Copying: ');
  220.     k = 0;
  221.        do i = 1 to n;
  222.           do l = 1 to LISTDIM while( i < n | l <= j);
  223.           sourcefile.drive = save_drive;
  224.           sourcefile.fname = cptr(i)->copy_fcb(l).fname;
  225.           sourcefile.ftype = cptr(i)->copy_fcb(l).ftype;
  226.           dest.fname = cptr(i)->copy_fcb(l).fname;
  227.           dest.ftype = cptr(i)->copy_fcb(l).ftype;
  228.           call diocopy;
  229.           put list('.');
  230.           k = k + 1;
  231.           end;
  232.        end;
  233.     put skip list(k,'file(s) copied to',ascii(64+dest.drive)||':');
  234.     end copy_list;
  235.  
  236.  
  237. /* query - query and delete if response is 'y'es */
  238.     query: procedure returns(bit(1));
  239.     declare
  240.        c              char(1);
  241.  
  242.     put skip list(ascii(64+source.drive)||':',
  243.        dir_fcb.fname||'.'||dir_fcb.ftype,'?');
  244.     c = rdcon();
  245.     if c = INTRRPT then
  246.        call reboot();
  247.     else if c = EOF then do;
  248.        call copy_list;
  249.        call reboot();
  250.        end;
  251.     else if translate(c,'Y','y') = 'Y' then
  252.        return(TRUE);
  253.     else
  254.        return(FALSE);
  255.     end query;
  256.  
  257. /* get_nbuffs - calculate number of buffers available for copy */
  258.     get_nbuffs: procedure;
  259.  
  260.     nbuffs = divide(maxwords,BUFWDS,15);
  261.     if nbuffs = 0 then
  262.         do;
  263.         put skip list('No Buffer Space - Rebooting');
  264.         call reboot();
  265.         end;
  266.  
  267.     end get_nbuffs;
  268.  
  269.  
  270. /* diocopy - direct io copy from source to dest */
  271.     diocopy: procedure;
  272.     declare
  273.         /* buffer management */
  274.         eofile bit(8),
  275.         i      fixed(15),
  276.         m      fixed(15),
  277.         memory (0:0) bit(16) based(bufptr),
  278.         buffs fixed(15);
  279.  
  280.  
  281.     /* copy fcb to rename file, count extents */
  282.     renfile = dest;
  283.  
  284.     /* destination file will be deleted later */
  285.     dest.ftype = '$$$';
  286.  
  287.     /* delete any existing x.$$$ file */
  288.     call delete(addr(dest));
  289.     sourcefile.fext = 0;
  290.  
  291.     /* open the source file, if possible */
  292.     if open(addr(sourcefile)) = -1 then
  293.        signal error(70);
  294.  
  295.     /* source file opened, create $$$ file */
  296.     dest.fext = 0;
  297.     dest.crec = 0;
  298.     if make(addr(dest)) = -1 then
  299.         do;
  300.         put skip list('No Directory Space on',
  301.                ascii(64+dest.drive)||':');
  302.         call reboot();
  303.         end;
  304.  
  305.     /* $$$ temp file created, now copy from source */
  306.     eofile = FALSE;
  307.     buffs  = nbuffs;
  308.     sourcefile.crec = 0;
  309.         do while (^eofile);
  310.         m = 0;
  311.             /* fill buffers */
  312.             do i = 0 repeat (i+1) while (i<buffs);
  313.                         call abort_test;
  314.             call setdma(addr(memory(m)));
  315.             m = m + BUFWDS;
  316.             if rdseq(addr(sourcefile)) ^= 0 then
  317.                 do;
  318.                 eofile = TRUE;
  319.                 /* truncate buffer */
  320.                 buffs = i;
  321.                 end;
  322.             end;
  323.  
  324.         m = 0;
  325.             /* write buffers */
  326.             do i = 0 to buffs-1;
  327.                         call abort_test;
  328.             call setdma(addr(memory(m)));
  329.             m = m + BUFWDS;
  330.             if wrseq(addr(dest)) ^= 0 then
  331.                 do;
  332.                 put skip list(ascii(64+dest.drive)||
  333.                                ': Disk Full');
  334.                 call reboot();
  335.                 end;
  336.             end;
  337.         end;
  338.  
  339.     /* close destination file and rename */
  340.     dest.space(1) = sourcefile.space(1);
  341.  
  342.     if close(addr(dest)) = -1 then
  343.        call reboot();
  344.  
  345.     /* destination file closed, erase old file */
  346.     call delete(addr(renfile));
  347.  
  348.     /* now rename $$$ file to old file name */
  349.     dest.name2 = renfile.name1;
  350.     call rename(addr(dest));
  351.     end diocopy;
  352.  
  353. /* abort_test - abort if console character */
  354.     abort_test: procedure;
  355.     dcl c char(1);
  356.  
  357.                 if break() then do;
  358.            c = rdcon();
  359.            put skip list('Abort (Y/N)? ');
  360.            c = rdcon();
  361.            if c = 'Y' | c ='y' then do;
  362.                        put skip list('Copy Aborted');
  363.                        call reboot();
  364.                end;    
  365.                    end;
  366.     end abort_test;
  367.         
  368.     end copy;
  369.