unit PortLog;
{$I define.pas}
{ $I nodebug.pas}
{$O-}
{$F+}
{loging of port events}
interface
uses
  {$IFNDEF WINDOWS}
  dos,
  {$ENDIF}
  TVType, MyType, LogType,
  mylib, binhex,
  timer, confu, stru, logu;

procedure PortLogAddRecord(APort: byte; ATyp: char; AValue:byte);{$IFDEF PMODE}export;{$ENDIF}
function PortLogInit:boolean;{$IFDEF PMODE}export;{$ENDIF}
procedure PortLogDone;{$IFDEF PMODE}export;{$ENDIF}

function PortLogIsOn:boolean;{$IFDEF PMODE}{export;}{$ENDIF}
procedure PortLogFlush;{$IFDEF PMODE}{export;}{$ENDIF}

procedure PortLogRegister;{logu}

implementation

const
  PortLogging: byte = 0;
  AllocPortLogSize: longint = 4000;{how many bytes alloc for portlog buffer}
  ShowPortLogProgress: boolean = false;

const
  MaxLogTypes = 4;
  TypTable:array[0..pred(MaxLogTypes)] of char
    = ('p','i','g','d');

type
  {record for data going through port}
  TPortLogRecord = record
    time : longint; {in 55ms units}
    typ: char;   { 0 :'p' - put, 1:'i' - got by intr proc, 2:'g' - got by get,
                  higher 4 bits - number of port 1-4}
    value: byte; {value}
  end;

const
  MaxPortLogSize = (64000 div sizeof(TPortLogRecord));

  ltPut = 0;
  ltInterrupt = 1;
  ltGet = 2;
  ltDebug = 3;

type
  TPortLogData = array [0..pred(MaxPortLogSize)] of TPortLogRecord;
  PPortLogData = ^TPortLogData;


  TPortLog = class {(TPortLogger);}
    FileName:PathStr;
    Data : PPortLogData;
    Count, {how many records present}
    Size : word; {number of allocated records}
    constructor Create(AFileName:PathStr; ASize:word);
    procedure WriteData(AFileName:PathStr);
    procedure AddRecord(aport:byte;atyp:char;avalue:byte);
    destructor Destroy;override;
  end;
  PPortLog = TPortLog;{old one}


  TStreamPortLog = class(TLogger)
    lasttyp:char;
    lastport:byte;
    constructor Create(AFileName:PathStr);
    procedure AddRecord(aport:byte;atyp:char;avalue:byte);
    {procedure Log(s:string);}
  end;
  PStreamPortLog = TStreamPortLog;{new one}

  (*
  TMemPortLogCounts = array [1..MaxMaxComPorts, 0..pred(MaxLogTypes)] of LongInt;

  PMemPortLog = ^TMemPortLog;
  TMemPortLog = object(TMemPages)
    FileName:PathStr;
    AllCount:TMemPortLogCounts;
    StartTime,EndTime:Longint;
    constructor Create(AFileName:PathStr; ASize:Longint);
    procedure WriteData(AFileName:PathStr);
    procedure AddLogRecord(aport:byte;atyp:char;avalue:byte);
    function GetLTNumber(atyp:char):byte;
{   function GetLTChar(atypno:byte):char;}
    destructor Destroy;virtual;
  end;
  *)
const
  PortLogLineLen = 28;

function MakeLogLine(aport:byte; atyp:char; avalue:byte):string;
var
  ch:char;
  s:string[3];
begin
  ch := chr(avalue);
  if ord(ch) < 32 then ch := '.';
  str(avalue:3, s);
{$IFDEF MONITOR}
  if atyp = 'd' then begin
    if avalue = 1 then
      portisonChar[aport] := ' '
    else
      portisonChar[aport] := 'x'
  end;

  MakeLogLine :=
    ' ' + itos(aport,1) + ' ' +              {3 chars port}
    portisonchar[aport] + atyp + ' ' +       {3 chars id (put/get..)}
    s + ' ' +                                {4 chars dec}
    ' '+ ch + ' '+                           {3 chars chr}
     ' $' + bytetohex(avalue);               {4 chars hex}

{$ELSE}

  MakeLogLine :=
    ' ' + itos(aport,1) + ' ' +              {3 chars port}
    ' ' + atyp + ' ' +                       {3 chars id (put/get..)}
    s + ' ' +                                {4 chars dec}
    ' '+ ch + ' '+                           {3 chars chr}
     ' $' + bytetohex(avalue);               {4 chars hex}

{$ENDIF}
end;

const
  OPortLog : PPortLog = nil;
  SPortLog : PStreamPortLog = nil;
{  MemPortLog : PMemPortLog = nil;}

{**************************** TPortLog (old, memory based one) ***********}

var
  {global mirrors of objects fields for interrupt proc}
  PortLogData : PPortLogData;
  PortLogCount:word;
  PortLogSize:word;
  OverFlow:boolean;
  AllGetCount, AllPutCount, StartTime,
  EndTime:Longint;

constructor TPortLog.Create(AFileName:PathStr; ASize:word);
begin
  FileName := AFileName;
  if ASize > MaxPortlogSize then
    ASize := MaxPortLogSize;
  GetMem(Data, ASize * sizeof(TPortLogRecord));
  if Data = nil then
    Fail;
  PortLogData := Data;
  Count := 0;
  PortLogCount := 0;
  Size := ASize;
  PortLogSize := Size;
  AllGetCount := 0;
  AllPutCount := 0;
  StartTime := 0;
  EndTime := 0;
  OverFlow := false;
end;

{reverse definition in addlog}

procedure TPortLog.WriteData(AFileName:PathStr);
var
  f:text;
  i:word;
  time0:longint;
  lastc, c{, ch}:char;
  p:byte;
  cnt, put, get, other:longint;
  head:longint;
  allcount:longint;

begin
  if count = 0 then
    exit;
  if AFileName = '' then
    AFileName := FileName;

  AllCount := Count;
  Head := 0;
  if OverFlow then begin
    Head := Count;
    if Head = PortLogSize then
      Head := 0;
    AllCount := PortLogSize;
  end;
  EndTime := Data^[Head].time;

  assign(f, AFileName);
  {$I-}
  rewrite(f);
  {$I+}
  put := 0;
  get := 0;
  other := 0;
  lastc := ' ';
  if (ioresult <> 0) then
    exit;
  writeln(f, ' Received : ', AllGetCount,
    '  Sent : ', AllPutCount,'  ',
    '  Duration: ', EndTime - StartTime);
  writeln(f, ' Time  ' +   {7}
             'Count ' +    {6}
             'COM',        {3}
             ' ? ',        {3}
             'Dec ',       {4}
             'Chr',        {3}
             ' Hex');       {4}
  time0 := StartTime;{Data^[0].time};


  for i := 0 to pred(AllCount) do begin
    if Head = AllCount then
      Head := 0;
    p := (ord(Data^[Head].typ) and $F0) shr 4;
    {
    case (ord(Data^[Head].typ) and $F) of
      0:c:='p';
      1:c:='Head';
      2:c:='g';
    end;
    }
    c := typtable[ord(Data^[Head].typ) and $F];
    case c of
      'p' : begin
        inc(put);
        cnt := put;
      end;
      'g' : begin
        inc(get);
        cnt := get;
      end
      else begin
        inc(other);
        cnt := other;
      end;
    end;

    if (c <> lastc) and ((lastc <> 'i') or (c <> 'g')) then
      writeln(f);
    lastc := c;

    {ch := chr(Data^[Head].value);
    if ord(ch) < 32 then
      ch := '.';}
    writeln(f, (Data^[Head].time - time0):6, ' ',{7 chars time}
      cnt:5, ' ',                             {6 chars count}
      MakeLogLine(p, c, Data^[Head].value)
);
    inc(Head);
  end;
  close(f);
end;

procedure TPortLog.AddRecord(aport:byte;atyp:char;avalue:byte);
begin
  PortLogAddRecord(aport,atyp, avalue);
{  Count := PortLogCount;}
end;

destructor TPortLog.Destroy;
begin
  if Data <> nil then begin
    WriteData(FileName);
    FreeMem(Data, Size * sizeof(TPortLogRecord));
    Data := nil;
    PortLogData := nil;
  end;
end;
{******************** TPortLog end (old, memory based one) *************}


procedure PortLogAddRecord(aport:byte;atyp:char;avalue:byte);
const head:byte = 0;
{var ofse:byte;}
begin
{ $IFDEF DEBUG}
{$IFNDEF WINDOWS}
  if ShowPortLogProgress then begin
    ofse := 0;
    case atyp of
      'p': ofse := 2;{must be even, otherwise it's screen attribute position}
      'g': ofse := 4;
    end;
    if aport = 0 then begin
      {debug, timeout}
      inc(Mem[SegB800:3920 + aport * 8 + ofse])
    end else begin
      Mem[SegB800:3920 + aport * 8 + ofse] := ord(ProgressChars[Head mod MaxProgressChars]);
      inc(head);if head = 255 then head := 0;
    end;
  end;
{$ENDIF}
{  Mem[$B800:3920+aport*4] := ord(ProgressChars[Head mod MaxProgressChars]);}

{ $ENDIF}
{  if MemPortLog <> nil then
    MemPortLog^.AddLogRecord(aport, atyp, avalue)
}
  if SPortLog <> nil then
    SPortLog.AddRecord(aport, atyp, avalue);

  if OPortLog = nil then
    exit;

  if PortLogData = nil then
    exit;
  if PortLogCount = PortLogSize then begin
    OverFlow := true;
    PortLogCount := 0;
  end;
  with PortLogData^[PortLogCount] do begin
    time :=
{$IFNDEF WINDOWS}
{$IFDEF TIMER}timer.{$ENDIF}mstime;
{$ELSE}
     mstime;
{$ENDIF}
    if StartTime = 0 then
      StartTime := time;
    case atyp of
      'p': begin
         atyp := #0;
         inc(AllPutCount);
      end;
      'i': atyp := #1;
      'g': begin
        inc(AllGetCount);
        atyp := #2;
      end;
      'd': atyp := #3;
    end;
    typ := chr(ord(atyp) + (aport shl 4));
    value := avalue;
  end;
  inc(PortLogCount);
  if OPortLog <> nil then
    OPortLog.Count := PortLogCount;
end;


{**************************** TStreamPortlog begin ************************}

constructor TStreamPortLog.Create(AFileName:PathStr);
{var lpar:TLogParams;{logtype logu}
begin
  Inherited Create(AFileName, ltSyslog);
  lasttyp := ' ';
  lastport := 0;
end;

procedure TStreamPortLog.AddRecord(aport: byte; atyp: char; avalue: byte);
begin
  if (atyp <> lasttyp)
{ $IFDEF MONITOR}
    or (aport <> lastport)
{ $ENDIF}
  then
    Log('');
  lasttyp := atyp;
  lastport := aport;
  LogEvent(leProgramAction + leCOM, mstime, MakeLogLine(aport, atyp, avalue));
end;

{**************************** TStreamPortlog end **************************}

{************************************************************}
{in mylib
  MaxProgressChars = 5;
  ProgressChars : array[0..pred(MaxProgressChars)] of char = ('-','\','|','-','/');
}
(*
constructor TMemPortLog.Create(AFileName:PathStr; ASize:Longint);
var i,j:byte;
begin
  if not inherited Create(0, Sizeof(TMemPortLogRecord), 0, pred(ASize),
   80000, '') then
     Fail;
  FileName := AFileName;
  for i := 1 to MaxComPorts do begin
    for j := 0 to pred(MaxLogTypes) do
      AllCount[i,j] := 0;
  end;
  StartTime := 0;
  EndTime := 0;
end;


procedure TMemPortLog.WriteData(AFileName:PathStr);
var
  f:text;
  i,j:word;
  time0:longint;
  lastc, c, ch:char;
  p:byte;
  index, cnt:longint;
  counts:array[0..pred(MaxLogTypes)] of longint;
  typno:byte;

  LR:TMemPortLogRecord;
begin
  if RecordsCount = 0 then
    exit;
  if AFileName = '' then
    AFileName := FileName;

  Index := pred(Head);
  if Index < 0 then
    Index := LastRecordNumber;
  GetRecord(Index, LR);
  EndTime := LR.time;

  if Full then begin
    Index := Head;
    if Index > LastRecordNumber then
      Index := 0;
  end else
    Index := 0;
  GetRecord(Index, LR);
  StartTime := LR.Time;

  assign(f, AFileName);
  {$I-}
  rewrite(f);
  {$I+}
  for i:= 0 to pred(MaxLogTypes) do
    Counts[i] := 0;

  for j := 0 to pred(MaxLogTypes) do begin
    for i := 1 to MaxComPorts do
      Counts[j] := Counts[j] + AllCount[i, j];
  end;
  lastc := ' ';
  if (ioresult <> 0) then
    exit;
  writeln(f, ' Received : ', Counts[ltGet],
    '  Sent : ', Counts[ltPut],'  ',
    '  Duration: ', EndTime - StartTime);
  writeln(f, ' Time  ' +   {7}
             'Count ' +    {6}
             'COM',        {3}
             ' ? ',        {3}
             'Dec ',       {4}
             'Chr',        {3}
             ' Hex');       {4}
  time0 := StartTime;{Data^[0].time};

  for i:= 0 to pred(MaxLogTypes) do
    Counts[i] := 0;

  for i := 0 to pred(RecordsCount) do begin
    GetRecord(Index, LR);
    p := (ord(LR.typ) and $F0) shr 4;
    {
    case (ord(Data^[Head].typ) and $F) of
      0:c:='p';
      1:c:='Head';
      2:c:='g';
    end;
    }

    typno := ord(LR.typ) and $F;
    c := typtable[typno];
    inc(Counts[typno]);
    cnt := Counts[typno];

{
    case c of
      'p' : begin
        inc(Counts[ltPut]);
        cnt := Counts[ltPut];
      end;
      'g' : begin
        inc(Counts[ltGet]);
        cnt := Counts[ltPut];
      end;
      'i' : begin
        inc(Counts[ltInterrupt]);
        cnt := Counts[ltInterrupt];
      end
      else begin
        inc(Counts[ltDebug]);
        cnt := Counts[ltDebug];
      end;
    end;
}
    if (c <> lastc) and ((lastc <> 'i') or (c <> 'g')) then
      writeln(f);
    lastc := c;

    ch := chr(LR.value);
    if ord(ch) < 32 then ch := '.';
    writeln(f, (LR.time - time0):6, ' ',{7 chars time}
      cnt:5, ' ',                             {6 chars count}
     ' ', p,' ',                              {3 chars port}
     ' ', c,' ',                              {3 chars id (put/get..)}
     LR.value:3,' ',                    {4 chars dec}
     ' ', ch, ' ',                            {3 chars chr}
     ' $', bytetohex(LR.Value));        {4 chars hex}

    if not NextIndex(Index) then
      break;
  end;
  close(f);
end;

procedure TMemPortLog.AddLogRecord(aport:byte;atyp:char;avalue:byte);
var LR:TMemPortLogRecord;
begin
  LR.time := mstime;
  if StartTime = 0 then
    StartTime := LR.time;
  atyp := chr(GetLTNumber(atyp));
  if (aport > 0) and (aport <= MaxComPorts) then
    inc(AllCount[aport, ord(atyp)]);
  LR.typ := chr(ord(atyp) + (aport shl 4));
  LR.value := avalue;
  AddRecord(LR);
{added to portlogu.PortlogAddRecord, this way it's visible even if logging is off}
end;

function TMemPortLog.GetLTNumber(atyp:char):byte;
var b:byte;
begin
  case atyp of
    'p': b := ltPut;
    'i': b := ltInterrupt;
    'g': b := ltGet
    else
     b := ltDebug;
  end;
  GetLTNumber := b;
end;

destructor TMemPortLog.Destroy;
begin
  WriteData(FileName);
  MemPortLog := nil;
  inherited Destroy;
end;
*)
{*************************************************************}
const
  SavedExitProc : pointer = nil;

procedure PortLogExitProc;far;
begin
  ExitProc := SavedExitProc;
  PortLogDone;
end;

procedure PortLogDone;
begin
  if OPortLog <> nil then begin
    OPortLog.Free;
    OPortLog := nil;
  end;

  if SPortLog <> nil then begin
    SPortLog.Free;
    SPortLog := nil;
  end;

{  if MemPortLog <> nil then begin
    Dispose(MemPortLog, Destroy);
    MemPortLog := nil;
  end;
}
end;

procedure PortLogFlush;
begin
  if (OPortLog <> nil) or (SPortLog <> nil) {or (MemPortLog <> nil)} then
    PortLogDone;
  PortLogInit;
{ OPortLog^.Flush;}
end;

function PortLogIsOn:boolean;
begin
  PortLogIsOn := (OPortLog <> nil) or (SPortLog <> nil);
end;

function PortLogInit:boolean;
begin
{
}
  PortLogInit := false;
  if PortLogging = 0 then
    exit;

  if (PortLogging and 1) = 1 then
    OPortLog := TPortLog.Create(LogDir + 'PORTMEM.LOG', AllocPortLogSize div sizeof(TPortLogRecord));

  if (PortLogging and 2) = 2 then
    SPortLog := TStreamPortLog.Create({v0.19}LogDir + {/v0.19}'PORT.LOG');

{  if PortLogging = 4 then
    MemPortLog := New(PMemPortLog, Create(LogDir + 'PORT.LOG', AllocPortLogSize));}

  PortLogInit := (OPortLog <> nil) or (SPortLog <> nil);
end;

procedure PortLogRegister;
begin
  AddGlobalVar(LogSec, 'PortLogging', @PortLogging, ptByte);
  AddGlobalVar(LogSec, 'AllocPortlogSize', @AllocPortLogSize, ptLongint);
  AddGlobalVar(LogSec, 'ShowPortLogProgress', @ShowPortLogProgress, ptByte);
end;

begin
  SavedExitProc := ExitProc;
  ExitProc := @PortLogExitProc;
end.