{ OS-MSDOS.PAS }
  { put all MS-DOS specific code in this file }


  procedure listcat;
    { list MS-DOS directory filenames on current (logged) drive.       }
    { Derived from DIRECTRY.PAS and QDL.PAS  in "Turbo Tutor", 1984.   }
    { Mods by W. Kempton, Jan 1985--  Fix three bugs:  1) never found
     first filename, 2) overflowed NamR, 3) added a null at end of name.
     (For a textbook, that's mighty buggy.)  Save file names in buffer
     before writing them.  Adapt to K&R Software Tools STDIO. Clean up
     code.
     }
    { works under MS-DOS 2.0, but not 1.0 }

  const
    SizeOfDTA = 43;
    SizeOfMask= 12;
    NameSize = 13;  { must be > longest filename }
    MaxFiles = 255;

  type
    RegRec =
    record
      AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
    end;
    Name = packed array [1..NameSize] of char;

  var
    Regs       : RegRec;
    DTA        : array [ 1..SizeOfDTA ] of Byte;
    Mask       : array [1..SizeOfMask] of Char;
    DirBuf     : array [1..MaxFiles] of Name;
    OutName    : XSTRING;
    SaveDTASeg,
    SaveDTAOfs,
    NameCount,
    ErrorNum, I,j : Integer;


    procedure ErrorCheck;
     begin
      if ErrorNum <> 0 then  error('List: system call error');
     end;

    procedure SetDTA( Segment, Offset : Integer; var Error : Integer );
     begin
      Regs.AX := $1A00;         { Function used to set the DTA }
      Regs.DS := Segment;       { store the parameter Segment in DS }
      Regs.DX := Offset;        {   "    "      "     Offset in DX }
      MSDos( Regs );            { Set DTA location }
      Error := Regs.AX and $FF; { get Error return }
     end; { of proc SetDTA }


    procedure GetCurrentDTA( var Segment, Offset : Integer;
                            var Error : Integer );
     begin
      Regs.AX := $2F00;    { Function used to get current DTA address }
      MSDos( Regs );       { Exicute MSDos function request }
      Segment := Regs.ES;  { Segment of DTA returned by DOS }
      Offset := Regs.BX;   { Offset of DTA returned }
      Error := Regs.AX and $FF;
     end; { GetCurrentDTA }


    procedure GetName(var NameCount: integer);
      { use MS-DOS call to get one name from system table--highly Turbo-specific }
    var
      I: integer; { char count }
     begin
      if NameCount = 0
       then Regs.AX := $4e00    { get first directory entry }
       else Regs.AX := $4f00;   { get next directory entry }
      Regs.CX := 22;             { Store the option }
      MSDos(Regs);               { Execute MSDos call }
      ErrorNum := Regs.AX and $FF;  { Get Error return }
      if (ErrorNum = 0) then
         begin                     { valid filename; store in NamR }
          I := 1;
          NameCount := NameCount+1;
          repeat
            DirBuf[NameCount,I] := CHR(DTA[30+I]);
            I := I + 1;
          until not (DirBuf[NameCount,I-1] in [' '..'~']) or (I>=NameSize);
          DirBuf[NameCount,I] := CHR(ENDSTR);   { mark end of name string }
         end;
     end { GetName };


   begin { listcat }
    GetCurrentDTA(SaveDTASeg,SaveDTAOfs, ErrorNum); { save DTA address }
    ErrorCheck;
    for i:= 1 to SizeOfDTA do DTA[i]:= 0;           { zero local DTA   }
    SetDTA(Seg(DTA),Ofs(DTA),ErrorNum);  ErrorCheck;
    ErrorNum := 0;
    { FillChar(Mask,SizeOfMask,0);}          { Initialize mask }
    Mask := '????????.???';                  { global search }
    Regs.DX := Ofs(Mask);
    Regs.DS := Seg(Mask);

    NameCount := 0;                          { get file names from system }
    repeat
      GetName(NameCount);
    until ErrorNum <> 0;

    SetDTA(SaveDTASeg,SaveDTAOfs, ErrorNum); { restore original DTA  }
    ErrorCheck;
    for I := 1 to NameCount do               { write names from DirBuf }
      begin
       j := 1;
       repeat
         OutName[j] := ord(DirBuf[I,j]);  j := j+1;
       until ord(DirBuf[I,(j-1)]) = ENDSTR;
       PUTSTR(OutName,STDOUT);              { K&R output to STDOUT }
       PUTC(NEWLINE);
      end;
   end { listcat };