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

$title ('MP/M 1.1  File Directory')
dir:
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;

  check$console$status:
    procedure byte;
      return mon2 (11,0);
    end check$console$status;

  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;

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

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

  crlf:
    procedure;
      call write$console (0dh);
      call write$console (0ah);
    end crlf;

  declare (dcnt,i,cnt,user) byte;
  declare incl$sys byte initial (0);


  /*
    Main Program
  */

declare dir$title (*) byte initial
  ('Directory for User  x:','$');

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

start:
  do;
    user = get$user$code;
    if user > 9 then
    do;
      dir$title(19) = '1';
      dir$title(20) = user - 10 + '0';
    end;
    else
    do;
      dir$title(20) = user + '0';
    end;
    call print$console$buffer (.dir$title);
    incl$sys = (fcb16(1) = 'S');
    cnt = -1;
    if fcb(0) = 0
      then fcb(0) = mon2 (25,0) + 1;
    if fcb(1) = ' ' then
    do i = 1 to 11;
      fcb(i) = '?';
    end;
    if (dcnt := search$first (.fcb)) <> 0ffh then
    do while dcnt <> 0ffh;
      temp = ror(dcnt,3) and 0110$0000b;
      if (tbuff(temp) = user) and
         (incl$sys or ((tbuff(temp+10) and 80h) = 0)) then
      do;
        if ((cnt:=cnt+1) mod 4) = 0 then
        do;
          call crlf;
          call write$console ('A'+fcb(0)-1);
        end;
        else
        do;
          call write$console (' ');
        end;
        call write$console (':');
        call write$console (' ');
        do i = 1 to 11;
          if i = 9 then call write$console (' ');
          call write$console
            (tbuff(temp+i) and 7fh);
          if check$console$status then
          do;
            dcnt = read$console;
            call terminate;
          end;
        end;
      end;
      dcnt = search$next (.fcb);
    end;
    if cnt = -1 then
    do;
      call print$console$buffer (.(0dh,0ah,
        'File not found.','$'));
    end;
    call terminate;
  end;

end dir;