Power-Programmierung/CD1.mdf/pascal/library/dos/overlay/swaplog.pas

Pascal/Delphi Source File | 1994-03-04 | 31.0 KB | 855 lines

unit swaplog;
{ original unit SWAPLOG, written by Tom Field - 76247,3024 as of 30 Aug 91 }
{ current unit SWAPLOG, written by Mark Reichert - 72763,2417 as of 13 Dec 93 }
{ if you have any questions, PLEASE send me a e-mail letter or leave a
  message directed to me in the Borland Pascal forum }

{ This unit intercepts overlay load operations and prints a log of each
  overlay load.  It is useful in studying the overlay loading in a
  program when trying to eliminate thrashing.

  The unit must find a _current_ .MAP file (produced by TPC /GS) in the
  executable directory. If during swapping, a segment is requested that
  was not in the map file, the segment address is returned, preceded by
  a question mark.

  The unit is not as self initializing as the one written by Tom Field.
  You should put it in your mainline's uses list after the "overlay"
  unit is used.  Actually, the saving of the BP OverReadFunc and its
  replacement with the one here must be done after the OvrInit and if
  necessary, the OvrInitEMS, wherever they are called.  This is
  necessary because the filling of the OverReadFunc address location
  with the address of the native function is done in OvrInit and
  redone in OvrInitEMS.  Now, the call of the InitSwap function MUST
  be done after any OvrSetBuf because OvrSetBuf needs the heap to be
  EMPTY when it tries to setup the conventional memory overlay buffer.

  (* <<<<< SIMPLE EXAMPLE >>>>> *)
  (* The following is the simplest example of the use of the unit, it uses
  default information and does no error checking, no EMS, no increase in
  overlay buffer size: *)
  Uses Swaplog, Overlay;

  (* try to initialize the overlay manager and units where the executable
     is named TOVERLAY.EXE and the overlay file TOVERLAY.OVR *)
  OvrInit('TOVERLAY.OVR');

  (* Use InitSwap function to set up the TCollection Object and store
     all the information from the MAP file into it..  Here it is doing
     the initialization with 40 units to start and a 10 unit increase
     whenever the new limit is reached (i.e. 40, 50, 60).  If InitSwap
     was successful, we will save the BP OverReadFunc and substitute
     our own.  The saved procedure will be called by ours to do the
     actual overlay work. *)
  If InitSwap(40, 10) Then
    begin
      SwapLog.SaveOvrRead := OverLay.OvrReadBuf;
      OVERLAY.OvrReadBuf  := SwapLog.SwapOverRead;
    End;

  (* <<<<< Main body or loop of program goes here >>>>> *)

  (* Write out the overlayed segments sorted by LoadCount.  This can
     be left off if no sorted listing is needed. *)
  WriteSortedSegmentsToLog(OvrSegLoadCount);


  (* <<<<< ANOTHER EXAMPLE >>>>> *)
  The following is a more complete example of how the setup was done when
  the unit was tested in the TVDEMO program in \BP\EXAMPLES\DOS\TVDEMO.
  I wanted to test a the unit in a full program.  I made an overlayed
  version of this program first, rather than using the program written to
  demo the use of overlays and resources, TVRDEMO, because I didn't want
  the complication of resources.  By the way, use of this unit has taught
  me something about TV programs at least and probably event driven programs
  in general.  The lesson is that, EMS memory or not, the overlay buffer
  needs to be large enough to hold the three or four largest and/or
  frequently called units or the enormous amount of thrashing will really
  slow down the program.
  The code below can be replace the equivalent code in a copy of TVDEMO.

  Uses Swaplog, Overlay;

(* This procedure allows the switch to be done and redone more easily *)
Procedure SaveAReadBuf;
Begin
  (* If GoodInitSwap is true, then the initialization and filling of
     the TCollection storage object was successful and we can save the
     BP OverReadFunc and substitute our own.  The saved procedure will
     be called by ours to do the actual overlay work. *)
  If SwapLog.GoodInitSwap Then
    begin
      SwapLog.SaveOvrRead := OverLay.OvrReadBuf;
      OVERLAY.OvrReadBuf  := SwapLog.SwapOverRead;
    end;
End;

(* If an EMPTY string is fed to this procedure, and is returned still
   empty, then OvrResult needs to be reexamined *)
Procedure SetErrorStr(Var ErrorStr : String);
Begin
   Case OvrResult Of
     ovrError       : ErrorStr := 'General Overlay Manager error.';
     ovrNotFound    : ErrorStr := 'No OVR file not found in EXE dir.';
     ovrNoMemory    : ErrorStr := 'Not enough memory for overlay buffer.';
     ovrIOError     : ErrorStr := 'General Overlay file I/O Error.';
     ovrNoEMSDriver : ErrorStr := 'No EMS Driver (EMM386, QEMM, etc) installed.';
     ovrNoEMSMemory : ErrorStr := 'Insufficient EMS memory available';
     Else             ErrorStr := '';
   End;
End;

var
  (* original program variables *)
  Demo: TTVDemo;
  EXEName: PathStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;

  UsingEMS : Boolean;
  TempStr  : String;

begin
  (* try to find the correct path and name for the overlay file *)
  (* the TVDEMO here should be a copy of the one in the example
     code unless you want to make the change permanent *)
  if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
  else EXEName := FSearch('TVDEMO.EXE', GetEnv('PATH'));
  FSplit(EXEName, Dir, Name, Ext);
  if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  EXENAME := FSearch('TVDEMO.OVR', Dir);

  (* try to initialize the overlay manager and units *)
  OvrInit(EXEName);
  if OvrResult <> ovrOk then
  begin
    SetErrorStr(TempStr);
    If TempStr <> '' Then
      PrintStr(TempStr+#13#10);
    Halt(1);
  end
  Else
    Begin
      (* Since OvrSetBuf only affects the conventional memory overlay
         buffer, it can be done before OverInitEMS *)
      OvrSetBuf(48 * 1024);

      (* open the overlay log file *)
      OpenOverLogFile('OVERLOG.FIL');

      (* Set when you want the procedure FlushLog to act -
           NoFlush - has no effect, write to file done when buffer fills
           FlushToDos - flushes OverLog file variable buffer to DOS buffers
           FlushToDisk - flushes OverLog file variable buffer to disk file *)
      SetTypeOfFlush(FlushToDisk);

     (* Use InitSwap function to set up the TCollection Object and store
        all the information from the MAP file into it..  Here it is doing
        the initialization with 40 units to start and a 10 unit increase
        whenever the new limit is reached (i.e. 40, 50, 60).  We then
        store whether InitSwap was successful for use in SaveAReadBuf. *)
      GoodInitSwap := InitSwap(40, 10);

      SwapLogWrite('Did OvrInit and OvrSetBuf');
      Str(OvrGetBuf:0, TempStr);
      SwapLogWrite('BuffSize = ' + TempStr );

      (* Save the BP OverReadFunc and substitute our own *)
      SaveAReadBuf;
    End;
  UsingEMS := False;
  SwapLogWrite('Doing OvrInitEMS');
  (* try to overlay units to EMS memory and redirect manager there
     when units need to be swapped into and out of the overlay buffer *)
  OvrInitEMS;
  If OvrResult = OvrOk Then
    UsingEMS := True
  Else
    Begin
     (* if there is an error, just report it.  Conventional overlay
        management will still go on, so don't Halt the program *)
      SetErrorStr(TempStr);
      If TempStr <> '' Then
        SwapLogWrite(TempStr);
    End;

  If UsingEMS Then
    Begin
      SaveAReadBuf;
      SwapLogWrite('Using Expanded')
    End
  Else
    SwapLogWrite('Using Conventional');

  Demo.Init;
  Demo.Run;
  Demo.Done;

  (* Write out the overlayed segments sorted by LoadCount *)
  WriteSortedSegmentsToLog(OvrSegLoadCount);
}

interface
Uses
   Dos,
   Overlay;

Type
  { For TSegmentItem Record }
  string8      = string[8];

  { Flags for controlling how the text log file will be written }
  FlushType    = (NoFlush, FlushToDos, FlushToDisk);

  { Flags for controlling what sort is done in WriteSortedSegmentsToLog }
  SortType      = (OvrSegNo, OvrSegName, OvrSegLoadCount);

  { Record that will be the item controlled by TSegmentCollection Object }
  { made global in hopes that will aid typecasts for debugging purposes }
  PSegmentItem = ^TSegmentItem;
  TSegmentItem = record
    SegNo : Word;
    SegName   : String8;
    LoadCount : LongInt;
  end;

Var
  { store the BP OvrReadFunc here }
  SaveOvrRead  : OVERLAY.OvrReadFunc;

  { tells the calling program that a successful initialization of the
    TCollection object that will store the unit names has occured }
  GoodInitSwap : Boolean;

  { Function to be called after a OvrSetBuf is done because OvrSetBuf needs the
    heap to be empty before it runs }
  Function InitSwap(ALimit, ADelta: Integer) : boolean;

  { function to replace BP's OvrReadFunc }
  Function SwapOverRead( OvrSeg : Word): integer; far;

  { Procedure to allow user to write messages to the log file }
  Procedure SwapLogWrite(InStr : String);

{ Procedure to allow user to set when the log disk file is actually written to }
  Procedure SetTypeOfFlush(InFlushType : FlushType);

{ Seperating Log File Opening out of InitSwap allows a SwapLogWrite before OvrSetBuf }
  Procedure OpenOverLogFile(InName : PathStr);

{ Procedure to allow Writing Sorted List of Segments and Counts at any point of
  program;  Order is reset to SegNo at end of this procedure so that later lookups
  will work. }
Procedure WriteSortedSegmentsToLog(SortChoice : SortType);

implementation

uses
     Objects,     { To inherit from TSortedCollection Object }
     IOChek;      { has functions with internal I/O Checking, also in Library }
                  { This unit is in Dos Programming in the BP CompuServe Library }
type
  string4       = string[4];
  string19      = String[19];

  TSortFunc = function(P1, P2: PSegmentItem): Integer;

  PSegmentCollection = ^TSegmentCollection;
  TSegmentCollection = object(TSortedCollection)
    Procedure SetLimit(ALimit: Integer); virtual;
    Function Compare(Key1, Key2: Pointer): Integer; virtual;
    Procedure FreeItem(Item : Pointer); virtual;
    Procedure ReOrder;
  end;

Function SortBySegNo(P1, P2: PSegmentItem): Integer; far; assembler;
asm
  les di, P1      { load first pointer }
  mov ax, es:[di] { Put word value at ES:DI (SegNo) into AX }
  les di, P2      { load second pointer }
  sub ax, es:[di] { compare SegNo values }
  jz @end         { 0 is the return value for P1^.SegNo = P2^.SegNo }
  rcr al, 1       { rotate CF=>sign bit for AL, CF=1 =>Neg AL, CF=0 =>Pos AL }
  or al, 1        { make sure that AL <> 0 }
  cbw             { Convert Byte to Word => make signed AX = signed AL }
@end:
End;

{ Most of the code here was borrowed from the StrCollection Compare
  in the Objects unit }
Function SortBySegName(P1, P2: PSegmentItem): Integer; far; assembler;
asm
   PUSH    DS
   CLD                   { string operations in forward mode }
   LDS     SI,P1
   ADD     SI,OFFSET TSEGMENTITEM.SEGNAME  { point DS:SI to P1^.SegName }
   LES     DI,P2
   ADD     DI,OFFSET TSEGMENTITEM.SEGNAME  { point ES:DI to P2^.SegName }
   LODSB               { put P1^.SegName length byte in AL and inc SI past it }
   MOV     AH,ES:[DI]
   INC     DI          { put P2^.SegName length byte in AH and inc DI past it }
   MOV     CL,AL       { this and the next 3 lines do the following }
   CMP     CL,AH
   JBE     @@1         { CL = Min(Length(P1^.SegName), Length(P2^.SegName) }
   MOV     CL,AH
@@1:    XOR     CH,CH  { make CX = CL }
   REP     CMPSB       { compare until unequal chars found or end of shorter }
   JE      @@2          { if one is substring of other, compare lengths }
   MOV     AL,DS:[SI-1] { otherwise REP inc'd past unequal chars so put }
   MOV     AH,ES:[DI-1] { them in AL and AH, so that subtraction will make }
@@2:    SUB     AL,AH   { AX < 0 if P1^.SegName < P2^.SegName }
   SBB     AH,AH        { and AX > 0 if P1^.SegName > P2^.SegName }
   POP     DS
end;

Function SortByLoadCount(P1, P2: PSegmentItem): Integer; far; assembler;
asm
  push ds
  lds si, P1      { load first pointer }
  add si, offset TSEGMENTITEM.LOADCOUNT { point DS:SI to P1^.LOADCOUNT }
  les di, P2      { load second pointer }
  add di, offset TSEGMENTITEM.LOADCOUNT { point ES:DI to P2^.LOADCOUNT }
  mov ax, [si+2]    { Put high word value at DS:SI into AX }
  sub ax, es:[di+2] { compare high word values of P1^ and P2^ LoadCount }
  jnz @end          { If high words not equal, AX properly <0 or >0 }
                    { 0 < Hi word < MaxInt, so no RCR needed as it is below }
  mov ax, [si]      { Put low word value at DS:SI into AX }
  sub ax, es:[di]   { compare low word values of P1^ and P2^ LoadCount }
  jz @end         { 0 is the return value for P1^.LoadCount = P2^.LoadCount }
  rcr al, 1       { rotate CF=>sign bit for AL, CF=1 =>Neg AL, CF=0 =>Pos AL }
  or al, 1        { make sure that AL <> 0 }
  cbw             { Convert Byte to Word => make signed AX = signed AL }
@end:
  pop ds
End;

var
  { When the object is relatively small and will stay within the unit, no need
    to add another layer of redirection by using the Pointer to the object }
  SegmentDB: TSegmentCollection;

  { holds the sort requested by the WriteSortedSegmentsToLog Procedure }
  SortUsed : SortType;

const Sorts : array[SortType] of TSortFunc =
                           (SortBySegNo, SortBySegName, SortByLoadCount);
      SortsStr : array[SortType] of String19 =
                           ('Segment Number', 'Segment Name', 'Segment Load Count');

procedure TSegmentCollection.SetLimit(ALimit: Integer);
begin
  inherited SetLimit(ALimit);
  { NIL all pointers after the active ones - with a zero-indexed array,
    the COUNTth item is the one after the last active element }
  { good for debugging and using Assigned to avoid using invalid pointers }
  { If Starting and Count = 0, then the whole array is initialized }
   If Limit > Count Then
     FillChar(Items^[Count], (Limit - Count) * SizeOf(Pointer), 0);
end;

{ Build of Collection and Lookups are done by Segment Number }
function TSegmentCollection.Compare(Key1, Key2: Pointer): Integer;
begin
  Compare := SortBySegNo(Key1, Key2);
end;

{ Due to the FillChar in Descendant SetLimit, the Assigned should prevent
  the Disposing of any Invalid pointers }
procedure TSegmentCollection.FreeItem(Item : Pointer);
begin
  If Assigned(Item) Then
    Dispose(PSegmentItem(Item));
end;

{ In the example program off of which I patterned this sort, Compare was used
  directly, but that overburdened it so that the Lookups would have taken much
  longer, maybe slowing the program down }

Function SortCompare(Key1, Key2: Pointer): Integer;
var Result   : Integer;
    SortIndx : SortType;
Begin
  { at the top of the array Key2 would be nil }
  if Key2 = nil then
    begin
      SortCompare := 0;
      Exit;
    end;
  { Do the Selected Sort }
  Result := Sorts[SortUsed](Key1, Key2);

  { if the sort is by LoadCount then it should be descending to
    ease the sighting of the most frequently used units,
    so reverse the Result variable to make a descending sort }
  if SortUsed = OvrSegLoadCount Then
    If Result <> 0 then
      Result := Result * -1
    Else
      { units CANNOT have the same name or segment mapping number so the
        Result will NOT be 0;  LoadCounts can be the same so get
        alphabetical name order in that case }
      Result := Sorts[OvrSegName](Key1, Key2);

  SortCompare := Result;
End;

procedure TSegmentCollection.ReOrder;

  { This does a Quicksort, which divides the items into those lesser and
    greater to "x", and then uses recursion to do the same with to each
    subsequently smaller divided area until reaching indivisible single items}
  procedure Sort(l, r: Integer);
  var
    i, j: Integer;
    x, p: Pointer;
  begin
    repeat
      i := l; j := r;
      x := KeyOf(Items^[(l + r) div 2]);
      repeat
        while SortCompare(KeyOf(Items^[i]), x) < 0 do Inc(i);
        while SortCompare(x, KeyOf(Items^[j])) < 0 do Dec(j);
        if i <= j then
        begin
            if i < j then
              begin
                p := Items^[i];
                Items^[i] := Items^[j];
                Items^[j] := p;
              end;
            Inc(i); Dec(j);
        end;
      until i > j;
      if l < j then Sort(l, j);
      l := i;
    until l >= r;
  end;

begin
  if Count > 1 then Sort(0, Count - 1);
end;

Procedure WriteSortedSegmentsToLog(SortChoice : SortType);
Var I : Integer;
    P : PSegmentItem;
    LCStr : String8;
Begin
  { ReOrder uses this Unit Variable SortUsed }
  SortUsed := SortChoice;
  { The normal order is by SegNo }
  If SortUsed <> OvrSegNo Then
    SegmentDB.Reorder;
  SwapLogWrite('');
  SwapLogWrite('Overlay Segments And LoadCounts Sorted With Primary Key = ' +
                        SortsStr[SortUsed]);
  { the Items Array accessed by At is zero based, from 0 to Count - 1 }
  For I := 0 to Pred(SegmentDB.Count) do
    Begin
      { Get the Ith PSegmentItem Pointer }
      P := SegmentDB.At(I);
      { We only want to list the units that are overlayed;
        The initialization of the Collection does a Lookup immediately after
        inserting a PSegmentItem in to make sure it was a valid Insert,
        which makes LoadCount = 1 before the actual work begins }
      With P^ do
        Begin
          If LoadCount > 1 Then
            Begin
              Str(LoadCount:0, LCStr);
              SwapLogWrite(SegName + ' : ' + LCStr);
            End;
        End;
    End;
  If SortUsed <> OvrSegNo Then
    Begin
      { Reorder by SegNo so that further overlay logging can be done }
      SortUsed := OvrSegNo;
      SegmentDB.Reorder;
    End;
End;

function NameSegment(Const SegRec : TSegmentItem) : Boolean;
var
  P: PSegmentItem;
begin
  NameSegment := False;
  New(P);
  If Assigned(P) Then
    Begin
      NameSegment := True;
      P^ := SegRec;
      SegmentDB.Insert(P);
    End;
end;

Type
  FlushLogFunc = Function(Var TextFile : Text) : Integer;

Var
  OpenedLogFile    : Boolean;
  OverLogName      : PathStr;
  OverLog          : text; { text file, not printer }
  OldExitProc      : Pointer;
  OverLogFlushFunc : FlushLogFunc;
  EXEname          : NameStr;
  EXEDir           : DirStr;

Function FlushLog : Integer;
Begin
  FlushLog := 0;
  { If no forced flushes are to be done, OverLogFlushFunc = Nil }
  If Assigned(OverLogFlushFunc) Then
    FlushLog := OverLogFlushFunc(OverLog);
End;


{ This 58 byte function for getting string with current system date, is
  only incrementally faster than an equivalent Pascal Function but it
  is much smaller }
Function Date : Strg12;  assembler;
asm
   cld
   les di, @Result    { get address of output string }
   mov ah, 2Ah
   int 21h            { get system time thru DOS function }

   mov ax, cx         { get YEAR result in CX }

   mov bx, (100 shl 8) + '/'     { set BH = 100, BL = '/' }
   div bh             { divide AX by 100, get quotient and remainder }

   mov bh, al         { save quotient (century) in BL }
   mov al, 0          { set AL to no seperator, remainder already in AH }
   push ax
   push bx            { BX already set }
   mov bh, dl         { get DAY result in DL }
   push bx
   mov dl, 10         { put length byte = 10 in DL, MONTH already in DH }
   push dx

   mov si, 3030h      { set up SI for ADDs }
   mov bl, 10         { set up BL for DIVs and MODs }
   mov cx, 4          { four trips thru loop }
@TopOfLoop:
   pop ax             { pop something to work on off the stack }
   xor dx, dx         { setup to make AX = AL, DX = AH }
   xchg ah, dl        { makes DX = AH = days, months, years, or century }
   cmp al, 0          { there will be no seperator between yrs and century }
   jz @nosep
   stosb              { store length byte or seperator }
@nosep :
   xchg ax, dx        { get days, months, years, or century }
   div bl             { divide AX by 10, get quotient and remainder }
   add ax, si         { add 3030h to quotient, remainder into char equivalent }
   stosw              { store quotient and remainder in output }
   loop @TopOfLoop
end;

{ This 49 byte function for getting string with current system time, is
  only incrementally faster than an equivalent Pascal Function but it
  is much smaller }
Function Time : Strg12;  assembler;
asm
   cld
   mov ah, 2Ch
   int 21h            { get system time thru DOS function }
   les di, @Result    { get address of output string }

   mov al, '.'        { set AL to '.' seperator }
   mov ah, dl         { get HUNDREDTHS of SECOND result in DL }
   push ax
   mov dl, ':'        { set DL to ':' seperator, SECOND result in DH }
   push dx
   mov dh, cl         { get MINUTE result in CL }
   push dx
   mov cl, 11         { put fixed length byte of 11 in CL, HOUR is in CH }
   push cx
   mov si, 3030h      { set up SI for ADD }
   mov bl, 10         { set up BL to make DIV do a decimal partitioning }
   mov cx, 4          { four trips thru loop }
@TopOfLoop:
   pop ax             { pop something to work on off the stack }
   xor dx, dx         { setup to make AX = AL, DX = AH }
   xchg ah, dl        { makes DX = AH = 100ths, secs, mins or hours }
   stosb              { store length byte or seperator }
   xchg ax, dx        { get hundredths, seconds, minutes or hours }
   div bl             { divide AX by 10, get quotient and remainder }
   add ax, si         { add 3030h to quotient, remainder into char equivalent }
   stosw              { store quotient and remainder in output }
   loop @TopOfLoop
end;

function ByteToHex(BB : byte) : string ; assembler ;
asm
  les di, @Result     { get address of output string }
  mov al, 2
  cld
  stosb               { this string will always be 2 chars long }
  mov al, BB          { get number }
  mov dl, al          { save it in DL for later use }
  shr al, 1
  shr al, 1
  shr al, 1
  shr al, 1           { divide AL by 16 to get value of high char }
  add al, 55          { translate to ord of equivalent char }
  cmp al, 64
  ja @1               { if AL was 10 to 15, skip additional step }
  sub al, 7           { if AL was  0 to  9, must sub 7 to get '0' to '9' }
 @1:
  stosb               { store in first char spot }
  mov al, dl          { restore AL to original value }
  and al, 15          { wipe out high char }
  add al, 55          { translate to ord of equivalent char }
  cmp al, 64
  ja @2               { if AL was 10 to 15, skip additional step }
  sub al, 7           { if AL was  0 to  9, must sub 7 to get '0' to '9' }
 @2:
  stosb               { store in second char spot }
end ; { ByteToHex }

Procedure OverExitProc; far;
Begin
  ExitProc := OldExitProc;
  { Since after initialization, the Log File can be written to at any overlay
    swap, we must keep the file open, and force it to be closed only on exit }
  If OpenedLogFile Then
    Begin
      writeln(OverLog, 'Closed ' + OverLogName);
      IO_CloseText(OverLog);
    End;
End;

{ Returns the name of the segment at SegRec.SegNo in SegRec.SegName, or false }
Function LookUp(Var SegRec : TSegmentItem) : boolean;
var PSegItem : PSegmentItem;
    I : Integer;
begin
  Lookup := False;
  { Search in Items Array for Item with SegRec.SegNo, Return I, the index }
  if SegmentDB.Search(@SegRec, I) then
    Begin
      { Get the Pointer to the Ith item in Items }
      PSegItem := SegmentDB.At(I);
      { Increment LoadCount to track how many times this unit is loaded }
      Inc(PSegItem^.LoadCount);
      { Return the info in SegRec to be printed }
      SegRec := PSegItem^;
      Lookup := True;
    End
  else
  begin
    { If the Search was unsuccessful, return the Segment Number as the name }
    With SegRec do
      Begin
        SegName := '?' + ByteToHex(Hi(SegNo)) + ByteToHex(Lo(SegNo));
        LoadCount := 0;
      End;
  end;
end; { LookUp }

Procedure SwapLogWrite(InStr : String);
Begin
  { If the Write was Successful, attempt a Flush from the Overlog Buffer }
  If IO_WritelnTextStr(OverLog, InStr) = 0 Then
    FlushLog;
End;

Function InitSwap(ALimit, ADelta: Integer) : boolean;
{ reads the program's map into a StringDict }
var
  hex_addr      : string4;    { eg 4C97     }
  SegRec        : TSegmentItem;   { eg 0, OPSTRING, 0 }
  InSeg, SegLine,
  Stop, NotEmpty : Boolean;
  ErrCode       : Integer;
  mem           : longint;
  map_file      : text;      { progname.map }
  fname         : Dos.PathStr;  { filename }
  fext          : Dos.ExtStr;
  map_file_line : string;
begin
  InitSwap := False;
  { This procedure will report the heap memory taken by the Collection }
  mem := memavail;
  { We need an open Log File to have place to which to write messages.
    Since the programmer may just not have called the procedure, we will
    try to force a default open. If still unsuccessful (due to some I/O
    error, we must stop.}
  If Not OpenedLogFile Then
    Begin
      OpenOverLogFile('');
      If Not OpenedLogFile Then
        Begin
          Writeln('Could not open log file ' + OverLogName + '.');
          Writeln('No logging will be done.');
          Exit;
        End;
    End;
  { report when this log was done }
  SwapLogWrite('Opened ' + OverLogName + ' on ' + Date + ' at ' + Time);

  { do the actual init of the TCollection object which will store the segment
    numbers of the units and the associated names. If unsuccessful, this will
    leaves us with no way of accomplishing our task. }
  If Not segmentDB.Init(ALimit, ADelta) then
    Begin
      SwapLogWrite('Unable to initialize object to do segment mapping.');
      Exit;
    End;

  { EXEDir and EXEName are set in the LogFile Open; If we can't open the
    map, we have no way of associating Segment numbers to unit names }
  fname := EXEDir + EXEName + '.MAP';
  ErrCode := IO_OpenText(fname, map_file, resetfile);
  if ErrCode <> 0 then
    Begin
      SwapLogWrite('Unable to open map file: ' + fname);
      Exit;
    End;

  SwapLogWrite('Loading: ' + fname);
  InSeg := False;
  Stop := False;
  SegLine := False;
  NotEmpty := False;
  while (not eof(map_file)) and (ErrCode = 0) and (Not Stop) do
    begin
      ErrCode := IO_ReadlnTextStr(map_file, map_file_line);
      If ErrCode = 0 then
        Begin
          { Is the line a Valid Segment Map area line? }
          SegLine := (length(map_file_line) >= 40) and (map_file_line[7] = 'H');
          { Is code, or just types and constants, from the unit used? }
          NotEmpty := copy(map_file_line,16,5) <> '00000';
          { Until we hit a SegLine, we are not in the SegArea }
          If Not InSeg Then
            Begin
              If SegLine Then
                InSeg := True;
            End;

          If InSeg Then
            If SegLine Then
              Begin
                if NotEmpty Then
                  begin
                    { get the Hex Address String of the Unit }
                    hex_addr := copy(map_file_line, 2,  4); { eg '4C97'     }
                    With SegRec do
                      Begin
                        { Hex numbers need to be flagged by use of the '$' }
                        Val('$' + Hex_Addr, SegNo, ErrCode);
                        { get the unit name }
                        SegName := copy(map_file_line, 23, 8); { eg 'OPSTRING' }
                        { Setting up a string for latter use }
                        fname := 'Lookup tested Okay for ' + SegName + ': LC = ';
                        LoadCount := 0;
                        SwapLogWrite('Adding ' + hex_addr +  ' ' + SegName);
                      End;

                    { put the information in SegRec into the Collection }
                    If Not NameSegment(SegRec) then
                      Begin
                        SwapLogWrite('Failed in Add when adding ' + SegRec.SegName);
                        IO_CloseText(map_file);
                        Exit;
                      End
                    Else
                      { If NameSegment successful, do a lookup to make sure it
                        was completely successful }
                      If LookUp(SegRec) then
                        begin
                          Str(SegRec.LoadCount:0, EXEname);
                          SwapLogWrite(fname + EXEName);
                        End
                      Else
                        SwapLogWrite('Lookup did not test Okay for ' + SegRec.SegName);
                  end;
              End
            Else
              { allowing blank lines to get in but anything else will stop the read }
              If map_file_line <> '' Then
                Stop := True;
        End;
  End;

  { This will show how much heap is being used by the Collection }
  Str(mem - memavail:0, EXEname);
  SwapLogWrite('Memory used by load= ' + EXEName);

  If ErrCode = 0 Then
    ErrCode := IO_CloseText(map_file);
  If ErrCode = 0 Then
    InitSwap := True;
end; { LoadList }

{ The address of this replaces that of the native BP function, so that
  the lookup and write to the log can take place before SaveOvrRead calls
  the native function to do that actual overlay swap }
Function SwapOverRead( OvrSeg : Word): integer;
var
  tempseg  : word;
  hex_seg  : string4;
  CountStr : String8;
  SegRec   : TSegmentItem;
begin
(* In a program, the PrefixSeg variable contains the selector
   (segment address) of the Program Segment Prefix (PSP)
   created by DOS and Windows when the application was
   executed. *)
  SegRec.SegNo := OvrSeg - PrefixSeg - $10;
  { If Lookup successful, write the unit SegName and the LoadCount }
  if LookUp(SegRec) then
    begin
      With SegRec do
        Begin
          Str(LoadCount:0, CountStr);
          SwapLogWrite(SegName + ' : ' + CountStr);
        end;
    End
  Else
    { If Lookup unsuccessful, write SegName which now contains the
      Address as a HexStr }
    SwapLogWrite(SegRec.SegName);
  { Call SaveOvrRead to do the overlay swap }
  SwapOverRead := SaveOvrRead(OvrSeg);
end; { MyOverRead }

Procedure SetTypeOfFlush(InFlushType : FlushType);
Begin
  { If InFlushType = NoFlush, OverLogFlushFunc = Nil }
  OverLogFlushFunc := Nil;
  Case InFlushType Of
    FlushToDos  : OverLogFlushFunc := IO_FlushToDos;
    FlushToDisk : OverLogFlushFunc := IO_FlushToDisk;
  End;
End;

Procedure OpenOverLogFile(InName : PathStr);
Var FEXT : EXTStr;
    FDir : DirStr;
Begin
  { Parse to get the log file directory and name }
  fsplit(InName, FDir, EXEName, FEXT);
  { If no name given, default to OVERLOG.FIL }
  If EXEName = '' Then
    InName := 'OVERLOG.FIL';
  { Parse to get the executable directory and log name }
  fsplit(ParamStr(0), EXEDir, EXEName, FEXT);
  { If no log directory given, default to executable directory }
  If FDir = '' Then
    FDir := EXEDir;
  { Set the unit variable to allow writing the file name to the file }
  OverLogName := FDir + InName;
  { open the file and set the boolean flag accordingly }
  OpenedLogFile := IO_OpenText(OverLogName, OverLog, RewriteFile) = 0;
End;

begin
  OldExitProc := ExitProc;
  ExitProc := @OverExitProc;
  GoodInitSwap := False;
  OverLogFlushFunc := IO_FlushToDisk;
end.