home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / KRTOOL.ZIP / OS-CPM80.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-19  |  2.0 KB  |  58 lines
  1. { OS-CPM80.PAS }
  2. { put all operating-system specific code in this file }
  3.  
  4.  
  5.   procedure listcat;
  6.     { List file names on standard output; written by W. Kempton, loosely
  7.       based on program by Thomas Flemer in TUG Lines v1 n4 }
  8.     { version: January 1985 }
  9.     { CP/M-80 only }
  10.   const
  11.     maxfiles    = 256;
  12.     SearchFirst = 17;
  13.     SearchNext  = 18;
  14.     SetDma      = 26;
  15.     DfltFCB     = $80;
  16.  
  17.   var
  18.     i,j,k: integer;
  19.     dmabuf:  array [1..130] of byte;
  20.     DirBuf: array[1..maxfiles] of packed array [0..11] of char;
  21.     fcb : array[0..36] of byte;
  22.     name : XSTRING ;
  23.     kDB : integer;
  24.  
  25.    begin
  26.     fcb[0] := 0;                             { set up file control block }
  27.     for i:=1 to 11 do fcb[i]:= ord('?');
  28.     for i:= 12 to 36 do fcb[i] := 0;
  29.     bdos(SetDma, addr(dmabuf) );             { DMA set to local variable }
  30.     i := 0;
  31.     j := bdos(SearchFirst, addr(fcb));
  32.     while (j < 255) and (i < maxfiles) do
  33.       begin
  34.        i := i + 1;
  35.        move (dmabuf[j*32 +1], DirBuf[i], 12); { save name }
  36.        j := bdos(SearchNext, addr(fcb));      { search for next }
  37.       end;
  38.     bdos(SetDma, DfltFCB);                    { restore DMA address }
  39.     for j := 1 to i do                        { write names to STDOUT }
  40.       begin
  41.         k := 1;
  42.         while (k<9) and (DirBuf[j,k]<>' ') do
  43.            begin name[k]:=ord(DirBuf[j,k]);  k:=k+1; end;
  44.         if DirBuf[j,9] <> ' ' then
  45.           begin  { read from kDB, write to k }
  46.             kDB := 9;
  47.             name[k] := ord('.'); k := k+1;
  48.             repeat name[k] := ord(DirBuf[j,kDB]); k := k+1; kDB:=kDB+1;
  49.             until (kDB=12) or (DirBuf[j,kDB] = ' ');
  50.           end;
  51.         for i := 1 to (k-1) do
  52.            name[i] := name[i] mod 128; { clear attribute bits }
  53.         name[k] := ENDSTR;
  54.         PUTSTR(name,STDOUT);PUTC(NEWLINE);{ use K&R STDOUT, not WRITE/WRITELN }
  55.       end;
  56.    end;
  57.  
  58.