home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / ifp1s157 / page_08.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-25  |  11.1 KB  |  464 lines
  1. unit page_08;
  2.  
  3. interface
  4.  
  5. uses crt, ifpglobl, ifpcomon;
  6.  
  7. procedure page08;
  8.  
  9. implementation
  10.  
  11. procedure page08;
  12.   const
  13.     tick2 = 115200;
  14.  
  15.   var
  16.     i : byte;
  17.     xbyte1 : byte;
  18.     xbyte2 : byte;
  19.     xbyte3: byte;
  20.     xbyte4: byte;
  21.     xbyte5: byte;
  22.     xbyte6: byte;
  23.     xbyte7: byte;
  24.     xword : word;
  25.     xword1: word;
  26.     xword2: word;
  27.     temp: word;
  28.     sbport: word;
  29.     sbfound: boolean;
  30.     portok: boolean;
  31.     midifound: boolean;
  32.     soundvect: pointer;
  33.     GusFound: boolean;
  34.     GusPort: word;
  35.     foundit: boolean;
  36.     s: string;
  37.  
  38. procedure GusDelay;
  39.   begin
  40.   asm
  41.     mov dx,$300
  42.     in al,dx
  43.     in al,dx
  44.     in al,dx
  45.     in al,dx
  46.     in al,dx
  47.     in al,dx
  48.     in al,dx
  49.   end;
  50.   end;
  51.  
  52. procedure GusPoke(high: byte; low: word; value: byte);
  53.   begin
  54.   Port[GusPort + $103]:=$43;
  55.   PortW[GusPort + $104]:=low;
  56.   Port[GusPort + $103]:=$44;
  57.   Port[GusPort + $105]:=high;
  58.   Port[GusPort + $107]:=value;
  59.   end;
  60.  
  61. function GusPeek(high: byte; low: word): byte;
  62.   begin
  63.   Port[GusPort + $103]:=$43;
  64.   PortW[GusPort + $104]:=low;
  65.   Port[GusPort + $103]:=$44;
  66.   Port[GusPort + $105]:=high;
  67.   GusPeek:=Port[GusPort + $107];
  68.   end;
  69.  
  70.   begin
  71.   window(1, 3, 30, tlength - 2);
  72.   caption2('Printers');
  73.   xbyte1:=equip and $C000 shr 14;
  74.   Writeln(xbyte1);
  75.   if xbyte1 > 0 then
  76.     begin
  77.     caption3('Device');
  78.     Writeln;
  79.     caption3('Base Port');
  80.     Writeln;
  81.     caption3('Timeout');
  82.     Writeln;
  83.     caption3('Busy');
  84.     Writeln;
  85.     caption3('ACK');
  86.     Writeln;
  87.     caption3('Paper out');
  88.     Writeln;
  89.     caption3('Selected');
  90.     Writeln;
  91.     caption3('I/O error');
  92.     Writeln;
  93.     caption3('Timed out');
  94.     for i:=1 to xbyte1 do
  95.       begin
  96.       Window(9 + 6 * i, 4, 15 + 6 * i, tlength - 2);
  97.       Writeln('LPT', i);
  98.       Writeln('$', hex(MemW[BIOSdseg : 2 * i + 6], 4));
  99.       Writeln(Mem[BIOSdseg : $0077 + i]);
  100.       with regs do
  101.         begin
  102.         AH:=$02;
  103.         DX:=i;
  104.         Intr($17, regs);
  105.         yesorno(AH and $80 = $00);
  106.         yesorno(AH and $40 = $40);
  107.         yesorno(AH and $20 = $20);
  108.         yesorno(AH and $10 = $10);
  109.         yesorno(AH and $08 = $08);
  110.         yesorno(AH and $01 = $01)
  111.         end
  112.       end
  113.     end;
  114.   Window(twidth - 42, 3, twidth, tlength - 2);
  115.   caption2('Serial ports');
  116.   xbyte1:=equip and $0E00 shr 9;
  117.   Writeln(xbyte1);
  118.   if xbyte1 > 0 then
  119.     begin
  120.     if xbyte1 > 4 then
  121.       xbyte1:=4;
  122.     caption3('Device');
  123.     Writeln;
  124.     caption3('Base port');
  125.     Writeln;
  126.     caption3('UART');
  127.     Writeln;
  128.     caption3('Timeout');
  129.     Writeln;
  130.     caption3('Baud rate');
  131.     Writeln;
  132.     caption3('Data bits');
  133.     Writeln;
  134.     caption3('Parity');
  135.     Writeln;
  136.     caption3('Stop bits');
  137.     Writeln;
  138.     caption3('Break');
  139.     Writeln;
  140.     caption3('RLSD');
  141.     Writeln;
  142.     caption3('RI');
  143.     Writeln;
  144.     caption3('DSR');
  145.     Writeln;
  146.     caption3('CTS');
  147.     Writeln;
  148.     caption3('dRLSD');
  149.     Writeln;
  150.     caption3('-dRI');
  151.     Writeln;
  152.     caption3('dDSR');
  153.     Writeln;
  154.     caption3('dCTS');
  155.     for i:=1 to xbyte1 do
  156.       begin
  157.       window(twidth - 35 + 7 * i, 4, twidth - 28 + 7 * i, tlength - 2);
  158.       Writeln('COM', i);
  159.       xword:=MemW[BIOSdseg : 2 * i - 2];
  160.       if xword = 0 then
  161.         Writeln('N/A')
  162.       else
  163.         begin
  164.         Writeln('$', hex(xword, 4));
  165.         xbyte2:=Port[xword + 7];
  166.         Port[xword + 7]:=$5A;
  167.         if Port[xword + 7] <> $5A then
  168.           Write('8250')
  169.         else
  170.           begin
  171.           Port[xword + 7]:=$A5;
  172.           if Port[xword + 7] <> $A5 then
  173.             Write('8250')
  174.           else
  175.             begin
  176.             Port[xword + 7]:=xbyte2;
  177.             xbyte2:=Port[xword + 2];
  178.             Port[xword + 2]:=1;
  179.             xbyte3:=Port[xword + 2];
  180.             if xbyte3 and $C0 = $C0 then
  181.               Write('16550A')
  182.             else
  183.               if xbyte3 and $80 = $80 then
  184.                 Write('16550')
  185.               else
  186.                 Write('16450');
  187.             end;
  188.           end;
  189.           if not FifoOn then
  190.             Port[xword + 2]:=0;
  191. {        xbyte2:=Port[xword + 2];
  192.         Port[xword + 2]:=$C1;
  193.         xbyte3:=Port[xword + 2];
  194.         Port[xword + 2]:=xbyte2;
  195.         case ((xbyte3 and $C0) shr 6) of
  196.           0: begin
  197.              xbyte2:=Port[xword + 7];
  198.              Port[xword + 7]:=$FA;
  199.              for temp:=1 to 2 do;
  200.              if Port[xword + 7] = $FA then
  201.                begin
  202.                Port[xword + 7]:=$AF;
  203.                for temp:=1 to 2 do;
  204.                if Port[xword + 7] = $AF then
  205.                  begin
  206.                  Port[xword + 7]:=xbyte2;
  207.                  Write('16450')
  208.                  end
  209.                else
  210.                  Write('8250')
  211.                end
  212.              else
  213.                Write('8250')
  214.              end;
  215.           1: Write('???');
  216.           2: Write('16550');
  217.           3: Write('16550A')
  218.         end;
  219.  }       Writeln;
  220.         Writeln(Mem[BIOSdseg : $007B + i]);
  221.         xbyte2:=Port[xword + 3];
  222.         Port[xword + 3]:=xbyte2 or $80;
  223.         xword2:=cbw(Port[xword], Port[xword + 1]);
  224.         if xword2 = 0 then
  225.           Writeln('N/A')
  226.         else
  227.           Writeln(tick2 / xword2:0:0);
  228.         Port[xword + 3]:=xbyte2;
  229.         Writeln((xbyte2 and $03) + 5);
  230.         case xbyte2 and $38 of
  231.           $00, $10, $20, $30 : Writeln('none');
  232.           $08 : Writeln('odd');
  233.           $18 : Writeln('even');
  234.           $28 : Writeln('mark');
  235.           $38 : Writeln('space')
  236.         end;
  237.         case xbyte2 and $07 of
  238.           $00..$03 : Writeln('1');
  239.           $04 : Writeln('1.5');
  240.           $05..$07 : Writeln('2')
  241.         end;
  242.         yesorno(xbyte2 and $40 = $40);
  243.         with regs do
  244.           begin
  245.           AH:=$03;
  246.           DX:=i - 1;
  247.           Intr($14, regs);
  248.           yesorno(AL and $80 = $80);
  249.           yesorno(AL and $40 = $40);
  250.           yesorno(AL and $20 = $20);
  251.           yesorno(AL and $10 = $10);
  252.           yesorno(AL and $08 = $08);
  253.           yesorno(AL and $04 = $04);
  254.           yesorno(AL and $02 = $02);
  255.           yesorno(AL and $01 = $01)
  256.           end;
  257.         end
  258.       end
  259.     end;
  260.   Window(1, 14, twidth - 43, tlength - 2);
  261.   caption2('Sound cards');
  262.   Writeln;
  263.   caption3('Ad Lib (or compatible)');
  264.   xbyte2:=Port[$388];
  265.   Port[$388]:=$BD;
  266.   xbyte1:=Port[$388];
  267.   xbyte1:=Port[$388];
  268.   xbyte1:=Port[$388];
  269.   xbyte1:=Port[$388];
  270.   xbyte3:=Port[$389];
  271.   Port[$389]:=0;
  272.   for xbyte4:=1 to 36 do
  273.     xbyte1:=Port[$388];
  274.   xbyte1:=xbyte1 and 7;
  275.   Port[$388]:=xbyte2;
  276.   Port[$389]:=xbyte3;
  277.   yesorno(xbyte1 = 6);
  278.   if xbyte1 = 6 then
  279.     begin
  280.     caption3('  driver');
  281.     with regs do
  282.       begin
  283.       AX:=$3565;
  284.       MsDos(regs);
  285.       s:='';
  286.       for xword:=(BX - $16) to (BX - 4) do
  287.         s:=s + Chr(Mem[ES:xword]);
  288.       if s = 'SOUND-DRIVER-AD-LIB' then
  289.         begin
  290.         Write('yes');
  291.         caption3('version');
  292.         Writeln(unBCD(Mem[ES:BX - $17]), decimal, addzero(unBCD(Mem[ES:BX - $18])));
  293.         caption3('  address');
  294.         Writeln(hex(ES, 4), ':', hex(BX, 4));
  295.         end
  296.       else
  297.         Writeln('no');
  298.       end
  299.     end;
  300.   caption3('Sound Blaster');
  301.   sbfound:=false;
  302.   xbyte1:=1;
  303.   while (xbyte1 < 7) and (not sbfound) do
  304.     begin
  305.     sbport:=$200 + ($10 * xbyte1);
  306.     xword1:=0;
  307.     portok:=false;
  308. {    xword2:=sbport + $0C;}
  309.     while (xword1 < $201) and (not portok) do
  310.       begin
  311.       if (Port[sbport + $0C] and $80) = 0 then
  312.         portok:=true;
  313.       Inc(xword1)
  314.       end;
  315.     if portok then
  316.       begin
  317.       xbyte3:=Port[sbport + $0C];
  318.       Port[sbport + $0C]:=$D3;
  319.       for xword2:=1 to $1000 do {nothing};
  320. {      xword2:=sbport + 6;}
  321.       xbyte4:=Port[sbport + 6];
  322.       Port[sbport + 6]:=1;
  323.       xbyte2:=Port[sbport + 6];
  324.       xbyte2:=Port[sbport + 6];
  325.       xbyte2:=Port[sbport + 6];
  326.       xbyte2:=Port[sbport + 6];
  327.       Port[sbport + 6]:=0;
  328. {      xword2:=sbport + $0E;}
  329.       xbyte2:=0;
  330.       repeat
  331.         xword1:=0;
  332.         portok:=false;
  333.         while (xword1 < $201) and (not portok) do
  334.           begin
  335.           if (Port[sbport + $0E] and $80) = $80 then
  336.             portok:=true;
  337.           Inc(xword1)
  338.           end;
  339.         if portok then
  340.           if Port[sbport + $0A] = $AA then
  341.             sbfound:=true;
  342.         Inc(xbyte2);
  343.       until (xbyte2 = $10) or (portok);
  344.       if not portok then
  345.         begin
  346.         Port[sbport + $0C]:=xbyte3;
  347.         Port[sbport + 6]:=xbyte4;
  348.         end;
  349.       end;
  350.     if sbfound then
  351.       begin
  352.       Write('yes');
  353.       Caption3('port');
  354.       Writeln('$', Hex(sbport, 3));
  355.       end
  356.     else
  357.       Inc(xbyte1);
  358.     end;
  359.   if not sbfound then
  360.     Writeln('no');
  361.   caption3('Roland MPU-401');
  362.   portok:=false;
  363.   midifound:=false;
  364.   xbyte1:=0;
  365.   repeat
  366.     if (Port[$331] and $40) = 0 then
  367.       portok:=true;
  368.     Inc(xbyte1);
  369.   until (xbyte1 = 255) or portok;
  370.   if portok then
  371.     begin
  372.     inline($FA); {CLI}
  373.     xbyte2:=Port[$331];
  374.     Port[$331]:=$FF;
  375.     portok:=false;
  376.     xbyte1:=0;
  377.     repeat
  378.       if (Port[$331] and $80) = 0 then
  379.         portok:=true;
  380.       Inc(xbyte1);
  381.     until (xbyte1 = 255) or portok;
  382.     xbyte1:=Port[$330];
  383.     inline($FB); {STI}
  384.     if portok and (xbyte1 = $FE) then
  385.       midifound:=true
  386.     else
  387.       Port[$331]:=xbyte2;
  388.     end;
  389.   yesorno(midifound);
  390. {
  391.   caption3('Tandy digital');
  392.   with regs do
  393.     begin
  394.     AX:=$8100;
  395.     Intr($1A, regs);
  396.     yesorno(AH > $80);
  397.     end;
  398. }
  399.   caption3('Gravis Ultrasound');
  400.   GusFound:=false;
  401.   xbyte1:=1;
  402.   while (xbyte1 < 7) and (not GusFound) do
  403.     begin
  404.     GusPort:=$200 + ($10 * xbyte1);
  405.     xbyte3:=Port[GusPort + $103];
  406.     xbyte4:=Port[GusPort + $104];
  407.     xbyte5:=Port[GusPort + $105];
  408.     xbyte6:=Port[GusPort + $106];
  409.     xbyte7:=Port[GusPort + $107];
  410.     Port[GusPort + $103]:=$4C;
  411.     Port[GusPort + $105]:=0;
  412.     GusDelay;
  413.     GusDelay;
  414.     Port[GusPort + $103]:=$4C;
  415.     Port[GusPort + $105]:=1;
  416.     GusPoke(0, 0, $AA);
  417.     GusPoke(1, 0, $55);
  418.     xbyte2:=GusPeek(0, 0);
  419.     GusPoke(0, 0, 0);
  420.     Port[GusPort + $103]:=$4C;
  421.     Port[GusPort + $105]:=0;
  422.     if xbyte2 = $AA then
  423.       begin
  424.       gusfound:=true;
  425.       Writeln('yes');
  426.       Caption3('  port');
  427.       Write('$', Hex(GusPort, 3));
  428.       Caption3('memory');
  429.       xbyte3:=0;
  430.       foundit:=false;
  431.       while (xbyte3 <= 4) and (not foundit) do
  432.         begin
  433.         if xbyte3 <> 4 then
  434.           begin
  435.           GusPoke(xbyte3 * 4, 0, $AA);
  436.           xbyte2:=GusPeek(xbyte3 * 4, 0);
  437.           end
  438.         else
  439.           begin
  440.           GusPoke($F, $FFFF, $AA);
  441.           xbyte2:=GusPeek($F, $FFFF);
  442.           end;
  443.         if xbyte2 <> $AA then
  444.           begin
  445.           foundit:=true;
  446.           Writeln(xbyte3 * 256, 'K');
  447.           end;
  448.         end;
  449.       end
  450.     else
  451.       begin
  452.       Port[GusPort + $103]:=xbyte3;
  453.       Port[GusPort + $104]:=xbyte4;
  454.       Port[GusPort + $105]:=xbyte5;
  455.       Port[GusPort + $106]:=xbyte6;
  456.       Port[GusPort + $107]:=xbyte7;
  457.       Inc(xbyte1);
  458.       end;
  459.     end;
  460.   if not gusfound then
  461.     Writeln('no');
  462.   end;
  463. end.
  464.