procedure adjust_fn(fileref : string15; var drive : string1;
                        var filename : string15; var filetype : string3);

      (* This procedure converts a string into the standard CP/M format
         for processing. This format is all upper case, and inserts ?'s
         into the string if the wildcards ? or * are found in the string.
         Finally, the string is expanded so spaces are placed in any
         unfilled positions in the name.  these are placed in the middle of
         the filename, i.e.  abc.de is converted to 'abc     . de'.
      *)

      var
        insert_pos, count : integer;

      begin
        for count := 1 to length(fileref) do (* convert to upper case *)
          if (fileref[count] in ['a'..'z']) then
            fileref[count] := chr(ord(fileref[count]) and $df);
        if pos('.', fileref) <> 0 then (* separate the file name and type *)
          begin
            filename := copy(fileref, 1, pos('.', fileref) - 1);
            filetype := copy(fileref, pos('.', fileref) + 1, 3);
          end
        else
          begin
            filename := fileref;
            filetype := ''; (* no file type in this case *)
          end;
        if pos(':', filename) <> 0 then (* check for drive spec *)
          begin
            drive := copy(filename, 1, pos(':', filename) - 1);
            delete(filename, 1, pos(':', filename));
            if filename = '' then
              begin
                filename := '*';
                filetype := '*';
              end;
          end
        else
          drive := '!'; (* dummy value for param *)

        while (pos('*',filename) <> 0) do (* find any '*' wildcards *)
          begin
          insert_pos := pos('*', filename); (* find the spot *)
          delete(filename, insert_pos, 1);  (* get rid of * *)
          while (length(filename) < 8) do
            (* insert ?'s until filename is filled. Note that the first '*'
               will fill the string, so any other *'s in the name will be
               deleted and replaced with a single '?'.  '*k*' will be
               converted to '??????k?'
            *)
            insert('?', filename, insert_pos);
        end;
        while pos('*',filetype) <> 0 do (* do the same for the filetype *)
          begin
            insert_pos := pos('*', filetype);
            delete(filetype, insert_pos, 1);
            while (length(filetype) < 3) do
              insert('?', filetype, insert_pos);
          end;
        while length(filename) < 8 do (* fill out the filename with spaces *)
          filename := filename + ' ';
        while length(filetype) < 3 do (* do the same for the filetype *)
          filetype := filetype + ' ';
      end; (* adjust_fn *)

    procedure init_fcb(infile : string15);

      (* initialize an fcb with a filename and filetype for use with BDOS
         calls
      *)

      var
        count : integer;
        drive : string1;
        filename : string[15];
        filetype : string[3];

      begin

        adjust_fn(infile, drive, filename, filetype); (* put filespec in proper form *)
        if drive in ['A'..'P'] then
          fcb[1] := ord(drive) - 64 (* store the drive spec *)
        else
          fcb[1] := 0; (* use default drive *)
        for count := 1 to 8 do (* put in the filename. Array operation, not string *)
          fcb[1 + count] := ord(filename[count]);
        for count := 1 to 3 do (* same for filetype. Must be integers here *)
          fcb[9 + count] := ord(filetype[count]);
        for count := 13 to 36 do (* rest of FCB is 0's *)
          fcb[count] := 0;
      end;

    procedure searchfirst(var result : integer);

      (* search for first BDOS call.  Result is position in DMA buffer of
         filespec, or 255 if no file is found *)

      begin
        result := bdos($11, addr(fcb));
      end;

    procedure searchnext(var result : integer);

      (* search for next BDOS call. Result is same as above *)

      begin
        result := bdos($12, addr(fcb));
      end;

  procedure dir; (* generate directory listing *)

    (* generate a directory listing.  This is a CP/M dependent procedure and
       would have to be changed for other operating systems.  No size
       information is printed
    *)

    var
      filename : string[15];
      filetype : string[3];
      index, count, result : integer;

  begin
    if arg1 = '' then
      arg1 := '*.*'; (* we'll read all the filenames *)
    init_fcb(arg1);  (* set up the FCB *)
    bdos($1a, addr(dma)); (* set up the dma address *)
    searchfirst(result);  (* look for the first directory entry *)
    count := 0; (* cont for formatting output into 4 per line *)
    if result <> 255 then (* write the first filename *)
      begin
        writeln;
        writeln('Directory listing for ', arg1);
        writeln;
        for index := ((result * 32) + 1) to ((result * 32) + 9) do
          write(chr(dma[index]));
        write('.');
        for index := ((result * 32) + 10) to ((result * 32) + 12) do
            write(chr(dma[index]));
        write(' : ');
        count := count + 1;
      end
    else
      writeln('no file'); (* guess it doen't exist *)
    while (result <> 255) do
      begin
        searchnext(result); (* keep looking *)
        if result <> 255 then
          begin
            count := count + 1; (* bump the display counter *)
            for index := (result * 32) + 1 to ((result * 32) + 9) do
              write(chr(dma[index]));
            write('.');
            for index := ((result * 32) + 10) to ((result * 32) + 12) do
              write(chr(dma[index]));
            if ((count mod 5) = 0) then
              writeln
            else
              write(' : ');
        end;
    end;
    writeln;
  end;

  procedure delfile; (* delete the selected files *)

    var
      result : integer;
      fileref : string15;

    procedure deletefile(var result : integer);

      begin
        result := bdos($13, addr(fcb));
      end;

    begin (* delfile *)
      if arg1 = '' then
        begin
          writeln;
          write('Enter file(s) to erase: ');
          readln(arg1);
        end;
      init_fcb(arg1);
      deletefile(result);
      if result in [0..3] then
        writeln('File(s) deleted.')
      else
        writeln('File(s) not found.');
      writeln;
    end; (* delfile *)