Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/07/eraq.plm

$title ('MP/M 1.1  Erase File')
erase:
do;

$include (copyrt.lit)
/*
  Revised:
    19 Jan 80  by Thomas Rolander
*/

  declare start label;
  declare jmp$to$start structure (
    jmp$instr byte,
    jmp$location address ) data  (
    0C3H,
    .start-3);

  mon1:
    procedure (func,info) external;
      declare func byte;
      declare info address;
    end mon1;

  mon2:
    procedure (func,info) byte external;
      declare func byte;
      declare info address;
    end mon2;

  declare fcb (1) byte external;
  declare fcb16 (1) byte external;
  declare tbuff (1) byte external;

  /**************************************
   *                                    *
   *       B D O S   Externals          *
   *                                    *
   **************************************/

  read$console:
    procedure byte;
      return mon2 (1,0);
    end read$console;

  write$console:
    procedure (char);
      declare char byte;
      call mon1 (2,char);
    end write$console;

  print$console$buffer:
    procedure (buffer$address);
      declare buffer$address address;
      call mon1 (9,buffer$address);
    end print$console$buffer;

  search$first:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (17,fcb$address);
    end search$first;

  search$next:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (18,fcb$address);
    end search$next;

  delete$file:
    procedure (fcb$address);
      declare fcb$address address;
      call mon1 (19,fcb$address);
    end delete$file;

  get$user$code:
    procedure byte;
      return mon2 (32,0ffh);
    end get$user$code;

  terminate:
    procedure;
      call mon1 (143,0);
    end terminate;

  /*
    Main Program
  */

declare (i,j,k,response,user,dcnt) byte;

declare dir$entries (128) structure (
  file (12) byte );

declare dir$entry$adr address;
declare dir$entry based dir$entry$adr (1) byte;

declare last$dseg$byte byte
  initial (0);

start:
  do;
    if fcb(0) = 0 then
      fcb(0) = low (mon2 (25,0)) + 1;
    i = -1;
    user = get$user$code;
    dcnt = search$first (.fcb);
    do while dcnt <> 0ffh;
      dir$entry$adr = .tbuff(ror(dcnt,3) and 110$0000b);
      if dir$entry(0) = user then
      do;
        if (i:=i+1) = 128 then
        do;
          call print$console$buffer (.(
            'Too many directory entries for query.','$'));
          call terminate;
        end;
        call move (12,.dir$entry(1),.dir$entries(i));
      end;
      dcnt = search$next (.fcb);
    end;
    if i = -1 then
    do;
      call print$console$buffer (.(
        'No file.','$'));
    end;
    else
    do j = 0 to i;
      call write$console ('A'+fcb(0)-1);
      call write$console (':');
      call write$console (' ');
      do k = 0 to 10;
        if k = 8
          then call write$console (' ');
        call write$console (dir$entries(j).file(k));
      end;
      call write$console (' ');
      call write$console ('?');
      response = read$console;
      call write$console (0dh);
      call write$console (0ah);
      if (response = 'y') or
         (response = 'Y') then
      do;
        call move (12,.dir$entries(j),.fcb(1));
        call delete$file (.fcb);
      end;
    end;
    call terminate;
  end;

end erase;