program portest_code (input,output);

function inport (x : word) : byte; external;
procedure cls; external;
procedure locate (row, column : integer); external;

var
   count   :   word;
   b       :   byte;
   w       :   word;
   c       :   array [wrd(0)..255] of word;   { save the profile }
   headc   :   word;
   skipchar:   char;      {  an inkey$ function-like var waste   }

procedure header_1;

var
   i : integer;

begin
   writeln ;
   for i := 1 to 8 do
       write ('  Port Val');
   writeln
end;  { procedure }

procedure header_2;

var
   i : integer;

begin
   writeln ;
   for i := 1 to 8 do
       write (' Val Count');
   writeln
end;   { procedure }

procedure initialize;

begin   { initialization }
   count := 0;
   headc := 0;
   for b := 0 to 255 do
       c [b] := 0;         { profile count cleared  }
   cls;                    { cleanup screen         }
   locate (1,1);
   writeln;
   writeln;
   writeln ('Following ports may be active:');
   header_1
end;

procedure scan_all_ports;

begin
   for w := 0 to maxword do     { predeclared ; like maxint  }
       begin
           b := inport (w);     { get value from asm routine }
           c [b] := c [b] + 1;  { add to the profile value   }
           if not (b in [wrd(0),78,110,188,202,203,207,254,255]) then
               begin
                   write (w : 6, b : 4);   { show port and number  }
                   count := count  + 1;
                   headc := headc  + 1;
                   if headc > 159 then
                       begin
                           writeln;
                           locate (25,70);
                           write ('More...');
                           read (skipchar);
                           headc := 0;
                           cls;      {  refresh screen   }
                           locate (1,1);
                           header_1
                       end
               end
   end;
   header_1
end;   { procedure  }

procedure cleanup;

begin
   locate (25,1);
   write ('Strike any key for profile');
   read (skipchar);
   cls;
   writeln;
   writeln;
   writeln ('The most common false input values have been omitted');
   writeln;
   writeln ('Profile of values returned for all ports:');
   header_2;
   for b := 0 to 255 do
       write (b : 4, c[b] : 6);
   header_2;
   writeln ;
   writeln (count : 5, ' Port(s) may possibly be active');
   writeln;
   writeln;
   writeln ('Finished.')
end;   { procedure }

begin
   initialize;
   scan_all_ports;
   cleanup
end.
º RºŠøRºÿRRš5#ºBñRº:ñR3ÒRºÿ Ršë #Ç8ñ  š  G º RR