Category : Pascal Source Code
Archive   : INFOS155.ZIP
Filename : PAGE_03.PAS

unit page_03;

interface

uses crt, Dos, ifpglobl, ifpcomon, ifpextrn;

procedure page03;

implementation

procedure page03;

const
EMMint = $67;
qEMMdrvr = 'EMMXXXX0';
EMMerrs : array [$80..$A4] of string[55] = (
{80} 'internal error in EMM software',
'malfunction in expanded memory hardware',
'memory manager busy',
'invalid handle',
'undefined function',
'no more handles available',
'error in save or restore of mapping context',
'not enough physical pages available',
{88} 'not enough free pages available',
'no pages requested',
'logical page outside range assigned to handle',
'invalid physical page number',
'page map hardware state save area full',
'mapping context already in save area',
'mapping context not in save area',
'undefined subfunction parameter',
{90} 'attribute type not defined',
'feature not supported',
'src & dest overlap;move done, but source overwritten',
'length for src or dest longer than allocated',
'conventional and EMS memory overlap',
'offset outside logical page',
'region length >1M',
'src & dest overlap;not moved',
{98} 'src & dest types undefined',
'unused erro code',
'Alt map or DMA supported, but specified set isn''t',
'Alt map or DMA supported, but all allocated',
'Alt map or DMA not suported, specified set <> 0',
'Alt map or DMA suported, specified set <> 0',
'Dedicated DMA channels not supported',
'Dedicated DMA channels supported, but not specified one',
{A0} 'No handle found for specified name',
'handle with same name already exists',
'???',
'invalid pointer passed, or contents of source corrupted',
'access to function denied');

var
EMMarray : array[$000..$3FF] of word;
xlong : longint;
xword1 : word;
xword2 : word;
numhandles: word;
xstring : string;
EMMver, j: byte;
EMMname: array[1..8] of char;
isdpmi: boolean;
direc: directions;
ch2: char2;

procedure EMMerr(a : byte);
begin
if (a >= $80) and (a <= $8F) then
Writeln(EMMerrs[a])
else
unknown('expanded memory error', a, 2)
end; {EMMerr}

procedure showbcd(x: word);
var
c: char;

begin
c:=Chr((x shr 12) + 48);
if c <> '0' then
Write(c);
Write(Chr(((x and $0F00) shr 8) + 48), decimal,
Chr(((x and $00F0) shr 4) + 48), Chr((x and $000F) + 48))
end; {showbcd}

begin (* procedure page_03 *)
caption2('Total conventional memory (bytes) ');
Writeln(DOSmem: 6, ' (', DOSmem div 1024, 'K)');
caption2('Free conventional memory (bytes) ');
xlong:=DOSmem - (longint(PrefixSeg) shl 4);
Writeln(xlong: 6, ' (', xlong div 1024, 'K)');
caption2('Extended memory (from BIOS call) ');
with regs do begin
AH:=$88;
Flags:=Flags and FCarry;
Intr($15, regs);
if nocarry(regs) then
Writeln(longint(AX) shl 10: 8, ' (', (longint(AX) shl 10) div 1024, 'K)')
else
Writeln(' N/A')
end;
caption2('XMS driver present ');
with regs do
begin
AX:=$4300;
Intr($2F, regs);
if AL <> $80 then
Writeln('no')
else
begin
Writeln('yes');
AX:=$4310;
Intr($2F, regs);
xlong:=longint(ES) shl 16 + BX;
caption3('XMS version');
AX:=0;
longcall(xlong, regs);
if AX <> 0 then
begin
showbcd(AX);
caption3('XMM version');
showbcd(BX);
end
else
Write('ERROR');
caption3('A20 is');
AX:=$0700;
longcall(xlong, regs);
if (AX <> 0) or ((AX = 0) and (BL = 0)) then
case AX of
0: Writeln('disabled');
1: Writeln('enabled');
else
Writeln('unknown');
end
else
Write('ERROR');
caption3('Total free XMS memory');
AX:=$0800;
longcall(xlong, regs);
if (AX <> 0) or ((AX = 0) and ((BL = 0) or (BL = $A0))) then
begin
Write(DX, 'K');
caption3('Largest available block');
Writeln(AX, 'K');
end
else
Writeln('ERROR');
caption3('Upper memory Blocks');
AX:=$1000;
DX:=1;
longcall(xlong, regs);
if (AX = 0) and (BL <> $B1) then
Writeln('no')
else
if (AX = 0) and (BL = $B1) then
Writeln('supported, but none available')
else
begin
Write('yes');
caption3('Largest available size');
AX:=$1100;
DX:=BX;
longcall(xlong, regs);
AX:=$1000;
DX:=$FFFF;
longcall(xlong, regs);
Writeln(DX * longint(16), ' (', ((DX * 16.0) / 1024):1:1, 'K)');
end;
AX:=0;
longcall(xlong, regs);
caption3('HMA');
yesorno2(DX = 1);
AX:=$0100;
DX:=$FFFF;
longcall(xlong, regs);
if AX = 0 then
Write(' (in use)')
else
Write(' (free)');
if osmajor = 5 then
begin
caption3('Used by DOS 5');
AX:=$4A01;
Intr($2F, regs);
yesorno2(BX <> 0);
if BX <> 0 then
begin
caption3('bytes free');
Write(BX);
caption3('at');
segofs(ES, DI);
end;
end;
Writeln;
end;
end;
isdpmi:=false;
caption2('DPMI driver present');
with regs do
begin
AX:=$1687;
Intr($2F, regs);
if AX <> 0 then
Writeln('no')
else
begin
Writeln('yes');
isdpmi:=true;
caption3('version');
Write(DH, decimal, DL);
caption3('CPU');
case CL of
2: Write('286');
3: Write('386');
4: Write('486')
else
Write('???')
end;
caption3('switch mode entry');
segofs(ES, DI);
Writeln
end
end;
caption2('Expanded memory');
if longint(intvec[EMMint]) <> $00000000 then
begin
Writeln;
caption3('Interrupt vector');
xlong:=longint(intvec[EMMint]);
xword1:=xlong shr 16;
xword2:=xlong and $0000FFFF;
segofs(xword1, xword2);
Writeln;
caption3('Driver');
xstring:='';
for i:=$000A to $0011 do
xstring:=xstring + showchar(Chr(Mem[xword1 : i]));
Write(xstring);
if xstring = qEMMdrvr then
begin
caption3('status');
with regs do
begin
AH:=$40;
Intr(EMMint, regs);
if AH = $00 then
Write('available')
else
EMMerr(AH);
caption3('version');
AH:=$46;
Intr(EMMint, regs);
if AH = $00 then
Writeln(AL shr 4, decimal, AL and $0F)
else
EMMerr(AH);
EMMver:=AL shr 4;
caption3('Page frame segment');
AH:=$41;
Intr(EMMint, regs);
if AH = $00 then
Writeln(hex(BX, 4))
else
EMMerr(AH);
caption3('Total EMS memory');
AH:=$42;
Intr(EMMint, regs);
if AH = $00 then
begin
Write(longint(16) * DX, 'K');
caption3('available');
if AH = $00 then
Writeln(longint(16) * BX, 'K')
else
EMMerr(AH)
end
else
EMMerr(AH);
if EMMver >= 4 then
begin
caption3('VCPI capable');
{skip VCPI if DPMI found, DPMI takes precedence over VCPI}
if not isdpmi then
begin
{must make sure 1 page is allocated to be sure that EMS}
{driver is ON. VCPI is not detectable if EMS driver is OFF}
{16K of EMS needed for this test to work properly}
AH:=$43;
BX:=1;
Intr(EMMint, regs);
if AH <> 0 then
Writeln('error: need 16K available EMS to detect')
else
begin
xword1:=DX; {handle}
AX:=$DE00;
Intr(EMMint, regs);
if AH <> 0 then
Writeln('no')
else
begin
Write('yes');
caption3('VCPI version');
Writeln(BH, decimal, BL);
end;
AH:=$45; {release our handle}
DX:=xword1;
Intr(EMMint, regs)
end
end
else
Writeln('no');
end;
caption1(' Handle Size Name');
Writeln;
AH:=$4D;
ES:=seg(EMMarray);
DI:=ofs(EMMarray);
Intr(EMMint, regs);
if AH = $00 then
if BX > $0000 then
begin
Window(3, WhereY + Hi(WindMin), twidth, tlength - 2);
numhandles:=BX;
for i:=1 to numhandles do
begin
pause2;
if endit then
Exit;
xlong:=longint(16) * EMMarray[2 * i - 1];
if xlong > 0 then
begin
Write(hex(EMMarray[2 * i - 2], 4), ' ', xlong:5, 'K ');
if EMMver >= 4 then
begin
AX:=$5300;
DX:=EMMarray[2 * i - 2];
ES:=Seg(EMMname);
DI:=Ofs(EMMname);
Intr(EMMint, regs);
if AH = 0 then
for j:=1 to 8 do
if EMMname[j] <> #0 then
Write(EMMname[j]);
end;
Writeln;
end;
end;
end
else
Writeln(' (no active handles)')
else
EMMerr(AH)
end
end
else
begin
Writeln;
dontknow
end
end
else
Writeln('(none)')
end;
end.