Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP5_EMS.ZIP/EMSTEST.PAS

Pascal/Delphi Source File | 1990-03-15 | 6.2 KB | 234 lines

Program EMSTest;

{Demonstrate Expanded Memory Specification (LIM 3.2 and 4.0) Use in TP 5.5}

{This is a very simple EMS test program.  It checks for a valid EMS driver,
 checks for a hardware/driver error, allocates the number of free EMS pages
 unused, then runs through four phases of writing bit maps to the EMS pages
 and reading them to see if there were any errors.  This program wouldn't
 be extensive enough for a thorough EMS test, but it gives you the idea of
 how to program EMS access in Turbo Pascal version 5.x.}

Uses
   DOS,
   CRT;

Var
   Regs      : Registers;
   EMS_Error : boolean;

Function EMS_Installed : boolean;
{Return TRUE if an EMS driver is installed, FALSE otherwise}
Var
   S : string[8];
Begin
   With Regs Do
   Begin
      AH := $35;
      AL := $67;
      MSDos(Regs);
      Move(Mem[ES:$0A],S[1],8);
      S[0] := #8;
      EMS_Error := False;
      EMS_Installed := (S = 'EMMXXXX0');
   End;
End;

Function EMS_OK : boolean;
{Return TRUE if EMS hardware/driver functioning properly, FALSE otherwise}
Begin
   With Regs Do
   Begin
      AH := $40;
      Intr($67,Regs);
      EMS_Error := False;
      EMS_OK := (AH = 0);
   End;
End;

Procedure EMS_GetPageSegment (Var PageSegment : word);
{Return the EMS page mapping segment address}
Begin
   With Regs Do
   Begin
      AH := $41;
      Intr($67,Regs);
      PageSegment := BX;
      EMS_Error := (AH <> 0);
   End;
End;

Procedure EMS_PageInfo (Var TotalPages, PagesAvailable : integer);
{Return the total number of EMS pages, and the number of pages available}
Begin
   With Regs Do
   Begin
      AH := $42;
      Intr($67,Regs);
      TotalPages := DX;
      PagesAvailable := BX;
      EMS_Error := (AH <> 0);
   End;
End;

Procedure EMS_AllocatePages (PagesNeeded : word;  Var Handle : word);
{Allocate the specified number of EMS pages}
Begin
   With Regs Do
   Begin
      AH := $43;
      BX := PagesNeeded;
      Intr($67,Regs);
      Handle := DX;
      EMS_Error := (AH <> 0);
   End;
End;

Procedure EMS_MapPage (Handle, LogicalPage : word);
{Map the specified logical EMS page into the page segment}
Begin
   With Regs Do
   Begin
      AH := $44;
      AL := $00;
      BX := LogicalPage;
      DX := Handle;
      Intr($67,Regs);
      EMS_Error := (AH <> 0);
   End;
End;

Procedure EMS_DeallocatePages (Handle : word);
{Return the EMS pages allocated to this process}
Begin
   With Regs Do
   Begin
      AH := $45;
      DX := Handle;
      Intr($67,Regs);
      EMS_Error := (AH <> 0);
   End;
End;

Procedure EMS_Version (Var V : string);
{Return the EMS driver version (x.y)}
Begin
   With Regs Do
   Begin
      AH := $46;
      Intr($67,Regs);
      V := Chr((AL shr 4) + 48) + '.' + Chr((AL and $0F) + 48);
      EMS_Error := (AH <> 0);
   End;
End;

Const
   B                : array[0..3] of byte = ($00, $0F, $F0, $FF);

Var
   I                ,
   J                ,
   K                ,
   L                ,
   Handle           ,
   LogicalPage      ,
   PageSegment      : word;
   TotalPages       ,
   PagesAvailable   : integer;
   Version          : string[3];

Label
   Exit_Proc;

Begin
   ClrScr;
   If EMS_Installed Then
   Begin
      WriteLn ('EMS installed.');
      If EMS_OK Then
      Begin
         WriteLn ('EMS hardware working OK.');
         EMS_PageInfo(TotalPages,PagesAvailable);
         If EMS_Error Then
         Begin
            WriteLn('Error getting number of EMS pages.');
            Goto Exit_Proc;
         End;
         WriteLn('Total EMS pages = ',TotalPages:3);
         WriteLn(' Free EMS pages = ',PagesAvailable:3);
         EMS_Version(Version);
         If EMS_Error Then
         Begin
            WriteLn('Error getting EMS version.');
            Goto Exit_Proc;
         End;
         WriteLn('EMS version is ',Version);
         If PagesAvailable < 1 Then
         Begin
            WriteLn('Insufficient EMS pages free to run test');
            Goto Exit_Proc;
         End;
         WriteLn('Allocating ',PagesAvailable,' pages...');
         EMS_AllocatePages(PagesAvailable,Handle);
         If EMS_Error Then
         Begin
            WriteLn('Error allocating ',PagesAvailable,' EMS pages.');
            Goto Exit_Proc;
         End;
         EMS_GetPageSegment(PageSegment);
         If EMS_Error Then
         Begin
            WriteLn('Error getting EMS page segment address.');
            Goto Exit_Proc;
         End;
         For L := 1 to 4 Do
         Begin
            WriteLn;
            WriteLn('EMS RAM test pass ',L);
            For I := 0 to (PagesAvailable - 1) Do
            Begin
               EMS_MapPage(Handle,I);
               If EMS_Error Then
               Begin
                  WriteLn('Error mapping handle ',Handle,' page ',I);
                  Goto Exit_Proc;
               End;
               GotoXY(1,WhereY);
               Write('Filling page ',I,' ...');
               FillChar(Mem[PageSegment:0],$4000,B[(I + L) mod 4]);
            End;
            GotoXY(1,WhereY);  ClrEol;
            WriteLn('Page filling completed.  Starting page test...');
            For I := 0 to (PagesAvailable - 1) Do
            Begin
               EMS_MapPage(Handle,I);
               If EMS_Error Then
               Begin
                  WriteLn('Error mapping handle ',Handle,' page ',I);
                  Goto Exit_Proc;
               End;
               GotoXY(1,WhereY);
               Write('Checking page ',I,' ...');
               For K := 0 to $3FFF Do
                  If Mem[PageSegment:K] <> B[(I + L) mod 4] Then
                  Begin
                     WriteLn('Error in EMS page ',I,' offset ',K);
                     Goto Exit_Proc;
                  End;
            End;
            GotoXY(1,WhereY);  ClrEol;
            WriteLn('Page testing completed.');
         End;
         WriteLn('Freeing ',PagesAvailable,' pages...');
         EMS_DeallocatePages(Handle);
         If EMS_Error Then
            WriteLn('Error deallocating EMS pages.');
      End
      Else
         WriteLn('EMS hardware error.');
   End
   Else
      WriteLn ('EMS not installed.');
Exit_Proc:
   WriteLn('EMS test completed.');
End.