IMPLEMENTATION MODULE VStorage;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/vstorage.mov   1.6   10 Mar 1991 15:32:48   coleb  $
 *
 *)


IMPORT ErrorManager;
IMPORT LowLevel;
IMPORT Numbers;
IMPORT StringIO;
IMPORT SYSTEM;
IMPORT FAPI;
IMPORT Storage;


VAR
  Initialized : BOOLEAN;


TYPE
  MemHandle = POINTER TO SYSTEM.ADDRESS;

VAR
  LockedHandles: CARDINAL;


  PROCEDURE MemAvail(within: CARDINAL) : CARDINAL;
    VAR
      lasttry, lowtry, try : CARDINAL;
    BEGIN
      lasttry := 65535;
      try := 65535;
      lowtry := 0;
      LOOP
        WHILE (NOT DosAvail(try)) AND (try>16) DO
          lasttry := try;
          try := lowtry + (try-lowtry) DIV 2;
        END;
        IF ((lasttry-try) > within) AND (try>16) THEN
          lowtry := try;
          try := try + (lasttry-try) DIV 2;
        ELSE
          EXIT;
        END;
      END;
      IF try<=16 THEN
        RETURN 0;
      ELSE
        RETURN try;
      END;
    END MemAvail;



PROCEDURE AvailDOS(): LONGINT;
(* Returns the # of bytes of DOS memory currently available; the
   standard Storage module doesn't have such a function.*)
  BEGIN
    RETURN Numbers.Lc( MemAvail( 50) );
  END AvailDOS;


PROCEDURE IsAvailDOS( NumOfBytes: CARDINAL ): BOOLEAN;
  BEGIN
    RETURN DosAvail( NumOfBytes );
  END IsAvailDOS;

PROCEDURE AllocDOS( VAR handle: MemHandle; size: CARDINAL): BOOLEAN;
  (* Allocate a block of DOS memory of given size in bytes, and
   return a handle to that memory. *)
  BEGIN
    IF NOT DosAvail( size) THEN
      RETURN FALSE;
    ELSE
      DosAlloc( handle, size);
      RETURN TRUE;
    END;
  END AllocDOS;

PROCEDURE DeallocDOS( handle: MemHandle; size: CARDINAL);
(* Deallocate the block of DOS memory of specified size
   associated with the given handle. *)
  BEGIN
    DosDealloc( handle, size);
  END DeallocDOS;

PROCEDURE LockDOS( handle: MemHandle): SYSTEM.ADDRESS;
(* Locks the DOS memory associated with the given handle into
   real memory and returns the real starting address. *)
  BEGIN
    INC( LockedHandles );
    IF LockedHandles > 4 THEN
      ErrorManager.WARN( "Danger. More than 4 handles locked");
    END;
    RETURN handle;
  END LockDOS;

PROCEDURE UnLockDOS( handle: MemHandle);
(* Unlock the DOS memory associated with the given handle. *)
  BEGIN
  (* we don't need to do anything to unlock DOS memory *)
    IF LockedHandles = 0 THEN
      ErrorManager.WARN( "Handle not locked");
    ELSE
      DEC( LockedHandles );
    END;
  END UnLockDOS;

PROCEDURE ReadDOS( handle: MemHandle; offset: CARDINAL;
   dest: SYSTEM.ADDRESS; size: CARDINAL);
(* Moves size bytes starting at offset bytes from the beginning
   of virtual memory for handle to real memory address dest. *)
  BEGIN
    LowLevel.Move( LowLevel.AddAddr(SYSTEM.ADDRESS( handle),
        offset), dest, size);
  END ReadDOS;

PROCEDURE WriteDOS( handle: MemHandle; offset: CARDINAL;
   source: SYSTEM.ADDRESS; size: CARDINAL);
(* Moves size bytes from real memory address source to offset
   bytes from the beginning of virtual memory for handle. *)
  BEGIN
    LowLevel.Move( source, LowLevel.AddAddr(SYSTEM.ADDRESS(
        handle), offset), size);
  END WriteDOS;

PROCEDURE NotInEms( TheHandle: MemHandle ): BOOLEAN;
  BEGIN
    RETURN FALSE;
  END NotInEms;

PROCEDURE NotUsing(): BOOLEAN;
  BEGIN
    RETURN FALSE;
  END NotUsing;

PROCEDURE NilHandle( VAR TheHandle: MemHandle );
  BEGIN
    TheHandle := NIL;
  END NilHandle;

PROCEDURE SameHandle( handle1, handle2: MemHandle ): BOOLEAN;
  BEGIN
    RETURN handle1 = handle2;
  END SameHandle;

PROCEDURE Reminder1( dumc: CARDINAL): BOOLEAN;
  BEGIN
    StringIO.WriteStr( StringIO.outp,
        "Please assign VStorage.DosAvail (IMPORT Init...;).");
    HALT;
    RETURN FALSE;
  END Reminder1;

PROCEDURE Reminder2( VAR dumadr: SYSTEM.ADDRESS; dumsize: CARDINAL );
  BEGIN
    StringIO.WriteStr( StringIO.outp,
"Please assign a DOS memory allocator to VStorage.DosAlloc (IMPORT Init...;).");
    HALT;
  END Reminder2;

PROCEDURE Reminder3( VAR dumadr: SYSTEM.ADDRESS; dumsize: CARDINAL );
  BEGIN
    StringIO.WriteStr( StringIO.outp, "Please assign VStorage.DosDealloc.");
    HALT;
  END Reminder3;

PROCEDURE AvailShell( dumc: CARDINAL): BOOLEAN;
  VAR
    errcode: CARDINAL;
    machineMode:CARDINAL;
  BEGIN
    machineMode:=0;
    errcode := FAPI.DOSGETMACHINEMODE(SYSTEM.ADR(machineMode));
    IF machineMode = FAPI.MODE_REAL THEN
      RETURN Storage.Available( dumc );
    ELSE
      RETURN TRUE;
    END;
  END AvailShell;

PROCEDURE AllocShell( VAR dumadr: SYSTEM.ADDRESS; dumsize: CARDINAL );
  BEGIN
    Storage.ALLOCATE( dumadr, dumsize );
  END AllocShell;

PROCEDURE DeallocShell( VAR dumadr: SYSTEM.ADDRESS; dumsize: CARDINAL );
  BEGIN
    Storage.DEALLOCATE( dumadr, dumsize );
  END DeallocShell;


  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;

      ErrorManager.Init();
      LowLevel.Init();
      Numbers.Init();
      StringIO.Init();
(*EntryDiag:
      StringIO.WriteEol( 1, 'Entering VStorage' );
:EntryDiag*)

      LockedHandles := 0;
      AvailMem := AvailDOS;
      InEms := NotInEms;
      IsAvailable := IsAvailDOS;
      AllocMem := AllocDOS;
      DeallocMem := DeallocDOS;
      LockMem := LockDOS;
      UnLockMem := UnLockDOS;
      ReadMem := ReadDOS;
      WriteMem := WriteDOS;
      UsingEms := NotUsing;
      DosAvail := AvailShell;
      DosAlloc := AllocShell;
      DosDealloc := DeallocShell;

(*EntryDiag:
      StringIO.WriteEol( 1, 'Exiting VStorage' );
:EntryDiag*)

    END Init;

BEGIN
  Initialized := FALSE;
  Init();
END VStorage.