home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / IFP1S155.ZIP / PAGE_03.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-21  |  10.1 KB  |  368 lines
  1. unit page_03;
  2.  
  3. interface
  4.  
  5. uses crt, Dos, ifpglobl, ifpcomon, ifpextrn;
  6.  
  7. procedure page03;
  8.  
  9. implementation
  10.  
  11. procedure page03;
  12.  
  13. const
  14.   EMMint = $67;
  15.   qEMMdrvr = 'EMMXXXX0';
  16.   EMMerrs : array [$80..$A4] of string[55] = (
  17.         {80} 'internal error in EMM software',
  18.              'malfunction in expanded memory hardware',
  19.              'memory manager busy',
  20.              'invalid handle',
  21.              'undefined function',
  22.              'no more handles available',
  23.              'error in save or restore of mapping context',
  24.              'not enough physical pages available',
  25.         {88} 'not enough free pages available',
  26.              'no pages requested',
  27.              'logical page outside range assigned to handle',
  28.              'invalid physical page number',
  29.              'page map hardware state save area full',
  30.              'mapping context already in save area',
  31.              'mapping context not in save area',
  32.              'undefined subfunction parameter',
  33.         {90} 'attribute type not defined',
  34.              'feature not supported',
  35.              'src & dest overlap;move done, but source overwritten',
  36.              'length for src or dest longer than allocated',
  37.              'conventional and EMS memory overlap',
  38.              'offset outside logical page',
  39.              'region length >1M',
  40.              'src & dest overlap;not moved',
  41.         {98} 'src & dest types undefined',
  42.              'unused erro code',
  43.              'Alt map or DMA supported, but specified set isn''t',
  44.              'Alt map or DMA supported, but all allocated',
  45.              'Alt map or DMA not suported, specified set <> 0',
  46.              'Alt map or DMA suported, specified set <> 0',
  47.              'Dedicated DMA channels not supported',
  48.              'Dedicated DMA channels supported, but not specified one',
  49.         {A0} 'No handle found for specified name',
  50.              'handle with same name already exists',
  51.              '???',
  52.              'invalid pointer passed, or contents of source corrupted',
  53.              'access to function denied');
  54.  
  55. var
  56.   EMMarray : array[$000..$3FF] of word;
  57.   xlong : longint;
  58.   xword1 : word;
  59.   xword2 : word;
  60.   numhandles: word;
  61.   xstring : string;
  62.   EMMver, j: byte;
  63.   EMMname: array[1..8] of char;
  64.   isdpmi: boolean;
  65.   direc: directions;
  66.   ch2: char2;
  67.  
  68.   procedure EMMerr(a : byte);
  69.     begin
  70.     if (a >= $80) and (a <= $8F) then
  71.       Writeln(EMMerrs[a])
  72.     else
  73.       unknown('expanded memory error', a, 2)
  74.     end; {EMMerr}
  75.  
  76.   procedure showbcd(x: word);
  77.     var
  78.       c: char;
  79.  
  80.     begin
  81.     c:=Chr((x shr 12) + 48);
  82.     if c <> '0' then
  83.       Write(c);
  84.     Write(Chr(((x and $0F00) shr 8) + 48), decimal,
  85.       Chr(((x and $00F0) shr 4) + 48), Chr((x and $000F) + 48))
  86.     end; {showbcd}
  87.  
  88.   begin (* procedure page_03 *)
  89.   caption2('Total conventional memory (bytes)  ');
  90.   Writeln(DOSmem: 6, ' (', DOSmem div 1024, 'K)');
  91.   caption2('Free conventional memory (bytes)   ');
  92.   xlong:=DOSmem - (longint(PrefixSeg) shl 4);
  93.   Writeln(xlong: 6, ' (', xlong div 1024, 'K)');
  94.   caption2('Extended memory (from BIOS call) ');
  95.   with regs do begin
  96.     AH:=$88;
  97.     Flags:=Flags and FCarry;
  98.     Intr($15, regs);
  99.     if nocarry(regs) then
  100.       Writeln(longint(AX) shl 10: 8, ' (', (longint(AX) shl 10) div 1024, 'K)')
  101.     else
  102.       Writeln('     N/A')
  103.   end;
  104.   caption2('XMS driver present ');
  105.   with regs do
  106.     begin
  107.     AX:=$4300;
  108.     Intr($2F, regs);
  109.     if AL <> $80 then
  110.       Writeln('no')
  111.     else
  112.       begin
  113.       Writeln('yes');
  114.       AX:=$4310;
  115.       Intr($2F, regs);
  116.       xlong:=longint(ES) shl 16 + BX;
  117.       caption3('XMS version');
  118.       AX:=0;
  119.       longcall(xlong, regs);
  120.       if AX <> 0 then
  121.         begin
  122.         showbcd(AX);
  123.         caption3('XMM version');
  124.         showbcd(BX);
  125.         end
  126.       else
  127.         Write('ERROR');
  128.       caption3('A20 is');
  129.       AX:=$0700;
  130.       longcall(xlong, regs);
  131.       if (AX <> 0) or ((AX = 0) and (BL = 0)) then
  132.         case AX of
  133.           0: Writeln('disabled');
  134.           1: Writeln('enabled');
  135.         else
  136.           Writeln('unknown');
  137.         end
  138.       else
  139.         Write('ERROR');
  140.       caption3('Total free XMS memory');
  141.       AX:=$0800;
  142.       longcall(xlong, regs);
  143.       if (AX <> 0) or ((AX = 0) and ((BL = 0) or (BL = $A0))) then
  144.         begin
  145.         Write(DX, 'K');
  146.         caption3('Largest available block');
  147.         Writeln(AX, 'K');
  148.         end
  149.       else
  150.         Writeln('ERROR');
  151.       caption3('Upper memory Blocks');
  152.       AX:=$1000;
  153.       DX:=1;
  154.       longcall(xlong, regs);
  155.       if (AX = 0) and (BL <> $B1) then
  156.         Writeln('no')
  157.       else
  158.         if (AX = 0) and (BL = $B1) then
  159.           Writeln('supported, but none available')
  160.         else
  161.           begin
  162.           Write('yes');
  163.           caption3('Largest available size');
  164.           AX:=$1100;
  165.           DX:=BX;
  166.           longcall(xlong, regs);
  167.           AX:=$1000;
  168.           DX:=$FFFF;
  169.           longcall(xlong, regs);
  170.           Writeln(DX * longint(16), ' (', ((DX * 16.0) / 1024):1:1, 'K)');
  171.           end;
  172.       AX:=0;
  173.       longcall(xlong, regs);
  174.       caption3('HMA');
  175.       yesorno2(DX = 1);
  176.       AX:=$0100;
  177.       DX:=$FFFF;
  178.       longcall(xlong, regs);
  179.       if AX = 0 then
  180.         Write(' (in use)')
  181.       else
  182.         Write(' (free)');
  183.       if osmajor = 5 then
  184.         begin
  185.         caption3('Used by DOS 5');
  186.         AX:=$4A01;
  187.         Intr($2F, regs);
  188.         yesorno2(BX <> 0);
  189.         if BX <> 0 then
  190.           begin
  191.           caption3('bytes free');
  192.           Write(BX);
  193.           caption3('at');
  194.           segofs(ES, DI);
  195.           end;
  196.         end;
  197.       Writeln;
  198.       end;
  199.     end;
  200.   isdpmi:=false;
  201.   caption2('DPMI driver present');
  202.   with regs do
  203.     begin
  204.     AX:=$1687;
  205.     Intr($2F, regs);
  206.     if AX <> 0 then
  207.       Writeln('no')
  208.     else
  209.       begin
  210.       Writeln('yes');
  211.       isdpmi:=true;
  212.       caption3('version');
  213.       Write(DH, decimal, DL);
  214.       caption3('CPU');
  215.       case CL of
  216.         2: Write('286');
  217.         3: Write('386');
  218.         4: Write('486')
  219.       else
  220.         Write('???')
  221.       end;
  222.       caption3('switch mode entry');
  223.       segofs(ES, DI);
  224.       Writeln
  225.       end
  226.     end;
  227.   caption2('Expanded memory');
  228.   if longint(intvec[EMMint]) <> $00000000 then
  229.     begin
  230.     Writeln;
  231.     caption3('Interrupt vector');
  232.     xlong:=longint(intvec[EMMint]);
  233.     xword1:=xlong shr 16;
  234.     xword2:=xlong and $0000FFFF;
  235.     segofs(xword1, xword2);
  236.     Writeln;
  237.     caption3('Driver');
  238.     xstring:='';
  239.     for i:=$000A to $0011 do
  240.       xstring:=xstring + showchar(Chr(Mem[xword1 : i]));
  241.     Write(xstring);
  242.     if xstring = qEMMdrvr then
  243.       begin
  244.       caption3('status');
  245.       with regs do
  246.         begin
  247.         AH:=$40;
  248.         Intr(EMMint, regs);
  249.         if AH = $00 then
  250.           Write('available')
  251.         else
  252.           EMMerr(AH);
  253.         caption3('version');
  254.         AH:=$46;
  255.         Intr(EMMint, regs);
  256.         if AH = $00 then
  257.           Writeln(AL shr 4, decimal, AL and $0F)
  258.         else
  259.           EMMerr(AH);
  260.         EMMver:=AL shr 4;
  261.         caption3('Page frame segment');
  262.         AH:=$41;
  263.         Intr(EMMint, regs);
  264.         if AH = $00 then
  265.           Writeln(hex(BX, 4))
  266.         else
  267.           EMMerr(AH);
  268.         caption3('Total EMS memory');
  269.         AH:=$42;
  270.         Intr(EMMint, regs);
  271.         if AH = $00 then
  272.           begin
  273.           Write(longint(16) * DX, 'K');
  274.           caption3('available');
  275.           if AH = $00 then
  276.             Writeln(longint(16) * BX, 'K')
  277.           else
  278.             EMMerr(AH)
  279.           end
  280.         else
  281.           EMMerr(AH);
  282.         if EMMver >= 4 then
  283.           begin
  284.           caption3('VCPI capable');
  285.           {skip VCPI if DPMI found, DPMI takes precedence over VCPI}
  286.           if not isdpmi then
  287.             begin
  288.             {must make sure 1 page is allocated to be sure that EMS}
  289.             {driver is ON. VCPI is not detectable if EMS driver is OFF}
  290.             {16K of EMS needed for this test to work properly}
  291.             AH:=$43;
  292.             BX:=1;
  293.             Intr(EMMint, regs);
  294.             if AH <> 0 then
  295.               Writeln('error: need 16K available EMS to detect')
  296.             else
  297.               begin
  298.               xword1:=DX; {handle}
  299.               AX:=$DE00;
  300.               Intr(EMMint, regs);
  301.               if AH <> 0 then
  302.                 Writeln('no')
  303.               else
  304.                 begin
  305.                 Write('yes');
  306.                 caption3('VCPI version');
  307.                 Writeln(BH, decimal, BL);
  308.                 end;
  309.               AH:=$45; {release our handle}
  310.               DX:=xword1;
  311.               Intr(EMMint, regs)
  312.               end
  313.             end
  314.           else
  315.             Writeln('no');
  316.           end;
  317.         caption1('  Handle   Size  Name');
  318.         Writeln;
  319.         AH:=$4D;
  320.         ES:=seg(EMMarray);
  321.         DI:=ofs(EMMarray);
  322.         Intr(EMMint, regs);
  323.         if AH = $00 then
  324.           if BX > $0000 then
  325.             begin
  326.             Window(3, WhereY + Hi(WindMin), twidth, tlength - 2);
  327.             numhandles:=BX;
  328.             for i:=1 to numhandles do
  329.               begin
  330.               pause2;
  331.               if endit then
  332.                 Exit;
  333.               xlong:=longint(16) * EMMarray[2 * i - 1];
  334.               if xlong > 0 then
  335.                 begin
  336.                 Write(hex(EMMarray[2 * i - 2], 4), '   ', xlong:5, 'K  ');
  337.                 if EMMver >= 4 then
  338.                   begin
  339.                   AX:=$5300;
  340.                   DX:=EMMarray[2 * i - 2];
  341.                   ES:=Seg(EMMname);
  342.                   DI:=Ofs(EMMname);
  343.                   Intr(EMMint, regs);
  344.                   if AH = 0 then
  345.                     for j:=1 to 8 do
  346.                       if EMMname[j] <> #0 then
  347.                         Write(EMMname[j]);
  348.                   end;
  349.                 Writeln;
  350.                 end;
  351.               end;
  352.             end
  353.           else
  354.             Writeln('  (no active handles)')
  355.         else
  356.           EMMerr(AH)
  357.         end
  358.       end
  359.     else
  360.       begin
  361.       Writeln;
  362.       dontknow
  363.       end
  364.     end
  365.   else
  366.     Writeln('(none)')
  367.   end;
  368. end.