{$I-,S-}
{$IFNDEF OS2}
{$R-,V-,B-,F+,O+,A-}
{$ENDIF}

{Conditional defines that may affect this unit}
{$I APDEFINE.INC}

{*********************************************************}
{*                   APMISC.PAS 2.03                     *}
{*        Copyright (c) TurboPower Software 1991.        *}
{*                 All rights reserved.                  *}
{*********************************************************}

Unit ApMisc;
  {-Error codes, checksuming, date and other miscellaneous routines}

Interface

Uses
  DOS,
  tMisc,
  ApSame,
  Crc32;

{$I APMISC.PA0}

Implementation

Const
  DosDelimSet : Set Of Char = ['\', ':', #0];
  Digits : Array [0..$F] Of Char = '0123456789ABCDEF';

{$IFDEF Tracing}
Const
  {Tracing constants}
  MaxTraceCol = 78;                 {Wrap trace reports at this column}
  {$IFDEF Win32}
  HighestTrace = 4000000;           {Largest acceptable trace buffer size}
  {$ELSE}
  HighestTrace = 32760;             {Largest acceptable trace buffer size}
  {$ENDIF}

Type
  {For holding trace entries}
  TTraceRecord = record
    EventType : Char;
    C : Char;
  end;
  PTraceQueue = ^TTraceQueue;
  TTraceQueue = array[0..HighestTrace] of TTraceRecord;

Var
      {Tracing stuff}
      LastEventType : Char;
      TraceQueue    : PTraceQueue;       {Circular trace buffer}
      TraceIndex    : LongInt;          {Head of trace queue}
      TraceMax      : LongInt;          {Number of trace entries}
      TraceWrapped  : Boolean;           {True if trace wrapped}

  procedure StartTracing;
    {-Restarts tracing after a StopTracing}
  begin
    {$IFDEF Win32}
    EnterCriticalSection(DataSection);
    try
    {$ENDIF}

      if TraceQueue <> nil then
        TracingOn := True;

    {$IFDEF Win32}
    finally
      LeaveCriticalSection(DataSection);
    end;
    {$ENDIF}
  end;

  procedure ClearTracing;
    {-Clears the trace buffer}
  begin
    SetAsyncStatus (ecOk);
{    Result := ecOK;}
    {$IFDEF Win32}
    EnterCriticalSection(DataSection);
    try
    {$ENDIF}

      TraceIndex := 0;
      TraceWrapped := False;

    {$IFDEF Win32}
    finally
      LeaveCriticalSection(DataSection);
    end;
    {$ENDIF}
  end;

  procedure AbortTracing;
    {-Stops tracing and destroys the tracebuffer}
  begin
    {$IFDEF Win32}
    EnterCriticalSection(DataSection);
    try
    {$ENDIF}

      TracingOn := False;
      if TraceQueue <> nil then begin
        FreeMem(TraceQueue, TraceMax*2);
        TraceQueue := nil;
      end;

    {$IFDEF Win32}
    finally
      LeaveCriticalSection(DataSection);
    end;
    {$ENDIF}
  end;

  procedure InitTracing(NumEntries : LongInt);
    {-Prepare a circular tracing queue}
  begin
    {$IFDEF Win32}
    EnterCriticalSection(DataSection);
    try
    {$ENDIF}

      if TraceQueue <> nil then
        {Just clear buffer if already on}
        ClearTracing
      else begin
        {Limit check size of trace buffer}
        if NumEntries > HighestTrace then begin
          SetAsyncStatus (ecInvalidArgument);
          exit;
        end;

        {Allocate trace buffer and start tracing}
        TraceMax := NumEntries;
        TraceIndex := 0;
        TraceWrapped := False;
{        TraceQueue := AllocMem(NumEntries*2);}
        GetMem(TraceQueue, NumEntries*2);
      end;
      TracingOn := True;
      SetAsyncStatus (ecOk);

    {$IFDEF Win32}
    finally
      LeaveCriticalSection(DataSection);
    end;
    {$ENDIF}
  end;

procedure AddTraceEntry(CurEntry : Char; CurCh : Char);
  {-Add a trace event to the global TraceQueue}
begin
  {$IFDEF Win32}
  EnterCriticalSection(DataSection);
  try
  {$ENDIF}

     if TraceQueue <> nil then begin
      TraceQueue^[TraceIndex].EventType := CurEntry;
      TraceQueue^[TraceIndex].C := CurCh;
      Inc(TraceIndex);
      if TraceIndex = TraceMax then begin
        TraceIndex := 0;
        TraceWrapped := True;
      end;
    end;
   {$IFDEF Win32}
  finally
    LeaveCriticalSection(DataSection);
  end;
  {$ENDIF}
end;

  procedure DumpTracePrim(FName : String; AppendFile, InHex, AllHex : Boolean);
    {-Write the TraceQueue to FName}
  const
    Digits : array[0..$F] of Char = '0123456789ABCDEF';
    LowChar : array[Boolean] of Byte = (32, 33);
  var
    Start, Len : LongInt;
    TraceFile : Text;
    TraceFileBuffer : array[1..512] of Char;
    First : Boolean;
    Col, I, Res : LongInt;

    procedure CheckCol(N : LongInt);
      {-Wrap if N bytes would exceed column limit}
    begin
      Inc(Col, N);
      if Col > MaxTraceCol then begin
        WriteLn(TraceFile);
        Col := N;
      end;
    end;

    function HexB(B : Byte) : string;
      {-Return hex string for byte}
    begin
      {$IFDEF HugeStr}
      SetLength(Result, 2);
      {$ELSE}
      HexB[0] := #2;
      {$ENDIF}
      HexB[1] := Digits[B shr 4];
      HexB[2] := Digits[B and $F];
    end;

  begin
    SetAsyncStatus (ecOk);

    {Make sure we have something to do}
    if TraceQueue = nil then
      Exit;

    {Turn tracing off now}
    {TracingOn := False;}

    {$IFDEF Win32}
    EnterCriticalSection(DataSection);
    try
    {$ENDIF}

      {Set the Start and Len markers}
      Len := TraceIndex;
      if TraceWrapped then
        Start := TraceIndex
      else if TraceIndex <> 0 then
        Start := 0
      else begin
        {No events, just exit}
        {AbortTracing;}
        Exit;
      end;

      Assign(TraceFile, FName);
      SetTextBuf(TraceFile, TraceFileBuffer, SizeOf(TraceFileBuffer));
      if AppendFile and FileExists(FName) then begin
        {Open an existing file}
        Append(TraceFile);
        Res := IoResult;
      end else begin
        {Open new file}
        ReWrite(TraceFile);
        Res := IoResult;
      end;
      if Res <> ecOK then begin
        SetAsyncStatus (-Res);
        AbortTracing;
        Exit;
      end;

    {$IFDEF Win32}
      try
    {$ENDIF}
        {Write the trace queue}
        First := True;
        Col := 0;
        repeat
          {Some formattting}
          with TraceQueue^[Start] do begin
            if EventType <> LastEventType then begin
{              if not First then begin}
{                WriteLn(TraceFile,^M^J);}
                WriteLn(TraceFile,'');
                Col := 0;
{              end;}
              {First := False;}
              case EventType of
                'T' : WriteLn(TraceFile, 'Transmit: ');
                'R' : WriteLn(TraceFile, 'Receive: ');
                else  WriteLn(TraceFile, 'Special-'+EventType+': ');
              end;
              LastEventType := EventType;
            end;

            {Write the current char}
            if AllHex then begin
              CheckCol(4);
              Write(TraceFile, '[',HexB(Ord(C)),']');
            end else
            if (Ord(C) < LowChar[InHex]) {or (Ord(C) > 126)} then begin
              if InHex then begin
                CheckCol(4);
                Write(TraceFile, '[',HexB(Ord(C)),']')
              end else begin
                if Ord(C) > 99 then
                  I := 5
                else if Ord(C) > 9 then
                  I := 4
                else
                  I := 3;
                CheckCol(I);
                Write(TraceFile, '[',Ord(C),']')
              end;
            end else begin
              CheckCol(1);
              Write(TraceFile, C);
            end;

            {Get the next char}
            Inc(Start);
            if Start = TraceMax then
              Start := 0;
          end;
          First := False;
        until Start = Len;

        InitTracing (HighestTrace);

    {$IFDEF Win32}
      finally
    {$ENDIF}
        Close(TraceFile);
        SetAsyncStatus (-IoResult);
    {$IFDEF Win32}
        AbortTracing;
      end;
    {$ENDIF}
    {$IFDEF Win32}
    finally
      LeaveCriticalSection(DataSection);
    end;
    {$ENDIF}
  end;
{$ENDIF}

Begin
  Crc32TableOfs := Ofs (Crc32Table);
{$IFDEF Tracing}
  TracingOn := False;
  TraceQueue := nil;
  TraceIndex := 0;
  TraceMax := 0;
  TraceWrapped := False;
  LastEventType := #0;
  InitTracing (HighestTrace);
{$ENDIF}
End.
