program pnp;{ look for "$PnP" signature}
  type str4 = string[4];
       str2 = string[2];

  function lstr(v: longint; l: integer): string; var temp: string; begin
     str(v:l,temp); lstr := temp end;


  FUNCTION HexW(i : word) : str4;
      CONST  hc : ARRAY[0..15] OF Char = '0123456789ABCDEF';
      VAR  l, h : Byte; BEGIN { Hex }

      l := Lo(i); h := Hi(i);
      HexW := hc[h SHR 4]+hc[h AND $F]+hc[l SHR 4]+hc[l AND $F] END {hex} ;

  FUNCTION HexB(i : byte) : str2;
      CONST  hc : ARRAY[0..15] OF Char = '0123456789ABCDEF';
      VAR  l, h : Byte; BEGIN { Hex }

      HexB := hc[i SHR 4]+hc[i AND $F] END {hex} ;

   procedure clear_page; var i: integer;

     function video_mode: integer;
     begin video_mode := 3 end;

     begin
       if video_mode = 3 then for i := 1 to 25 do writeln
        else writeln(#13,#10,#10,#10) end;

  procedure check_ROM_signature(start_segm, end_segm: word);
    type str128 = string[128];
          str25 = string[25];
          str75 = string[75];

    var
              ID: WORD;
               l: word;
        str_buff: str128;

    function info_str: str75;
     var default : str75;
               v : integer;
               k : char;
            temp : str75;

     begin
     v := 29;
     default := 'unidentified function';
     temp := '';
     repeat
     if chr(mem[start_segm:v])
       in [' ','A'..'Z','a'..'z','(',')','0'..'9','.','/']
       then temp := temp + chr(mem[start_segm:v]);
     inc(v)
     until v >= 30 + 74;
     if length(temp) > 0 then begin
       if pos('VGA',temp) > 0 then default := 'VGA'
       else default := temp;
       end;
     info_str := default;
    end;   {info_str}

    begin{ check_ROM_signature}
    l := 0;
    start_segm := start_segm - $100;
    writeln('Checking for Initialization (Boot) ROMs.');
    repeat
      start_segm := start_segm + $100;
      move(mem[start_segm:0],id,2);
      if ID = $AA55 then begin
        l := mem[start_segm:2]*512;
        write(hexW(start_segm)
          ,' ROM size (KB): '+lstr(l div 1024,3));
        write(' ',info_str);
        writeln   end
        else begin end;
    until start_segm >= end_segm;
    writeln('');{End of Option ROM list.');}
    end;{ check_ROM_signature}


 {F+}
  procedure check_PNP_signature(segment: word; v: str4);
    type str16 = string[16];

    var    info: array[0..$20] of byte;
             id: str4;
              l: byte;
              i: byte;
        PNP_ITCA: word;  {PNP inter task communication area, segment}
       Node_Size: word;
       Num_Nodes: word;
       PNP_Bios_Entry: pointer;

        procedure PNP_Function00; far;
        const zero: word = 0;
        var     seg_Node_Size: word;
             offset_Node_Size: word;
                seg_Num_Nodes: word;
             offset_Num_Nodes: word;
             success         : word;
             seg_PnP_Bios,
             ofs_PNP_Bios    : word;

              begin
          seg_Node_Size := seg(Node_size);
          offset_Node_Size := ofs(Node_Size);
          seg_Num_Nodes := seg(Num_Nodes);
          offset_Num_Nodes := ofs(Num_Nodes);
          success := $FFFF;
         asm
           push DS;
           push seg_Node_Size;
           push offset_Node_Size;
           push seg_Num_Nodes;
           push offset_Num_Nodes;
           push zero;
           call PnP_Bios_Entry;
           add sp,6;
           mov success, ax;
         end; {asm}
         success := success
        end;

       function ok: str2;
       begin if (l ) = 0 then ok := 'OK' else ok := '??' end;

       function DeviceStr: str16; begin
         if segment >= $F000 then
         DeviceStr := 'System BIOS'
         else DeviceStr := ' Option ROM' end;

     var temp : str16;

        begin { check_PNP_signature }

       l := 0;
       id := '    ';
       segment := segment - 1;
       writeln('Checking for PnP signature(s)');
       temp := '                ';
       repeat
         segment := segment + 1;
         move(mem[segment:0],id[1],4);
         move(mem[segment:0],temp[1],16);
         if pos(v,temp) > 0 then
          if pos(v,temp) > 1
            then writeln(DeviceStr,':',v,' @ ',hexW(segment),':',hexW(pos(v,temp)-1)
           ,' Ver: ',mem[segment:4+pos(v,temp)] shr 4
           ,'.',mem[segment:4+pos(v,temp)] mod 16
           ,' Len: ',hexB(mem[segment:5+pos(v,temp)]),'hex.');
         if id = v then begin
           move(mem[segment:0],info,$21);
           l:= 0;
           for i := 0 to $20 do l := l+ info[i];
         writeln(DeviceStr,':',v,' @ ',hexW(segment)
           ,' Ver: ',mem[segment:4] shr 4,'.',mem[segment:4] mod 16
           ,' Len: ',hexB(mem[segment:5]),'hex. Checksum: ',ok);
           if ok = 'OK' then begin
            move(mem[segment:$1B],PNP_ITCA,2);
            move(mem[segment:$0D],PNP_Bios_Entry,4);
            pnp_bios_entry := ptr(segment,$D);
           end;
         end
         else begin end;
       until segment >= $FFF0;
       writeln('');{End of PnP signature list.');}
     {  PnP_Function00; }
       end; { check_PNP_signature }
 {F+}
  procedure check_PCI_signature(segment: word; v: str4);
    type str128 = string[128];
         str12 = string[12];
    var
             id: str4;
              o: integer;
           temp: str128;

       function DeviceStr: str12;
       begin if segment >= $F000 then DeviceStr := 'System BIOS'
         else DeviceStr := ' Option ROM' end;
       function checksum_ok: str4;
         var i: integer; default: str4;  sum: byte;
         begin
         default :='BAD'; sum := 0;
         for i := 1 to 128 do sum := sum+byte(temp[i]);
         if sum = 0 then default := 'OK';
        checksum_ok := default; end;

        begin { check_PCI_signature }
       id := '    ';
       temp := '';
       segment := segment - 1;
       writeln('Checking for PCI signature(s)');
       repeat
         o := 0;
         segment := segment +1;
         move(mem[segment:o],temp[1],32);
         temp[0] := chr(32);
         if pos(v,temp) > 0 then begin
           o := pos(v,temp);
           if O < 2 then begin
             move(mem[segment:0],temp[1],128);
           writeln(DeviceStr,':',v,' @ ',hexW(segment));
           writeln('Ver: ',byte(temp[6]),':',byte(temp[5]));
           writeln('Tablesize: ',word(temp[7]),'  # of IRQs: ',(word(temp[7])-32)div 16);
           writeln('PCI Interrupt Router device number: ',byte(temp[9]));
           writeln('Dev#: ',byte(temp[10]) and $F8,'  Func: ',byte(temp[1])and $7);
           writeln('Checksum: ',checksum_ok) end end;
       until segment >= $FFF0;
       writeln('');{End of PCI signature list.');}
       end; { check_PCI_signature }



  begin
    clear_page;
    check_ROM_signature($C000,$F000);
    check_PNP_signature($C000,'$PnP');
    check_PCI_signature($C000,'PCIR');
    check_PCI_signature($F000,'$PIR');
  end.