mORMot Open Source

  private
    class procedure GetLog(aAddressAbsolute: PtrUInt; out ounitname,
      osymname: rawutf8; out oline: integer); static;

const self = nil;

class procedure TSynMapFile.GetLog(aAddressAbsolute: PtrUInt; out ounitname, osymname : rawutf8;out oline : integer);
var u, s, Line, offset: integer;
begin
  ounitname := '';
  osymname := '';
  oline := -1;
  if (aAddressAbsolute=0) or (InstanceMapFile=nil) then
    exit;
  with InstanceMapFile do
    begin
      if not HasDebugInfo then exit;
      offset := AbsoluteToOffset(aAddressAbsolute);
      s := FindSymbol(offset);
      u := FindUnit(offset,Line);
      if s<0 then begin
        if u<0 then begin
          exit;
        end;
      end else
        if (u>=0) and (s>=0) then
          if u=fUnitSynLogIndex  then
            exit else // don't log stack trace internal to SynLog.pas :)
          if (u=fUnitSystemIndex) and (PosEx('Except',Symbols[s].Name)>0) then
            exit; // do not log stack trace of System.SysRaiseException
      if u>=0 then begin
        ounitname := Units[u].Symbol.Name;
        if s>=0 then
          if Symbols[s].Name=Units[u].Symbol.Name then
            s := -1;
      end;
      if s>=0 then
        osymname := Symbols[s].Name;
      if Line>0 then
        oline := Line;
    end;
end;

procedure TSynLog.AddRecursion(aIndex: integer; aLevel: TSynLogInfo);
type
  {$ifdef FPC}{$PACKRECORDS 1}{$endif}
  TTypeInfo = {$ifndef FPC}packed{$endif} record
    Kind: byte;
    Name: ShortString;
  end;
  {$ifdef FPC}{$PACKRECORDS C}{$endif}
  TClassType =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
     ClassType: TClass;
     ParentInfo: pointer;
     PropCount: SmallInt;
     UnitName: ShortString;
  end;
  PTypeInfo = ^TTypeInfo;
  PClassType = ^TClassType;
var Info: PTypeInfo;
    MS: cardinal;
    cunitname,csymname:string;
    ounitname,osymname:rawutf8;
    dotpos,oline : integer;
label DoEnt;
// normal procedure or function:
// Details: code address,                          {' ', [ounitname, '.',]                             osymname, ' (', oline, ')',} ['  ', extra text].
// method:
// Details: code address, ['-', instance address,] {' ', [ounitname, '.',] [instance class name, '@',] osymname, ' (', oline, ')',} ['  ', extra text].
begin
  with fThreadContext^ do
  if cardinal(aIndex)<cardinal(RecursionCount) then
  with Recursion[aIndex] do begin
    if aLevel<>sllLeave then begin
      TSynMapFile.GetLog(Caller,ounitname,osymname,oline);
      fWriter.AddPointer(Caller);
      if Instance<>nil then begin
        fWriter.Add('-');
        fWriter.AddPointer(PtrUInt(Instance));
      end;
      if ClassType<>nil then begin
        if fFamily.WithUnitName then begin
          Info := PPointer(PtrInt(ClassType)+vmtTypeInfo)^;
          if Info<>nil then begin
            {$ifdef FPC}
            cunitname := PClassType(GetFPCTypeData(pointer(Info)))^.UnitName;
            {$else}
            cunitname := PClassType(@Info^.Name[ord(Info^.Name[0])+1])^.UnitName;
            {$endif}
            if cunitname = '' then
            else
              if (ounitname <> cunitname) and (ounitname <> '') then
                ounitname := cunitname + '/' + ounitname;
          end;
        end;
        // classname:
        csymname := PShortString(PPointer(PtrInt(ClassType)+vmtClassName)^)^;
        if (osymname = '') then begin
          if (csymname <> '') then
            osymname := csymname + '@';
        end else begin
          if (csymname <> '') then
            if (csymname <> osymname) then begin
              dotpos := pos('.',osymname);
              if dotpos <> 0 then
                if csymname <> copy(osymname,1,dotpos-1) then
                  osymname := csymname + '@' + osymname
            end;
        end;
      end;
      if (fFamily.WithUnitName and (ounitname <> ''))
      or (osymname <> '') then begin
        fWriter.Add(' ');
        if (fFamily.WithUnitName and (ounitname <> '')) then begin
          fWriter.AddShort(ounitname);
          fWriter.Add('.');
        end;
        if (osymname <> '') then
          fWriter.AddShort(osymname);
        if (oline <> -1) then begin
          fWriter.Add(' ');
          fWriter.Add('(');
          fWriter.Add(oline);
          fWriter.Add(')');
        end;
      end;
      if MethodName<>nil then begin // extra text!
        fWriter.Add(' ');
        fWriter.Add(' ');
//        if MethodNameLocal<>mnLeave then begin
          fWriter.AddNoJSONEscape(MethodName);
//          if MethodNameLocal=mnEnter then
//            MethodNameLocal := mnLeave;
//        end;
      end;
    end;
    // Timestamp - start and stop.
    if fFamily.HighResolutionTimeStamp and (fFrequencyTimeStamp<>0) then
DoEnt:case aLevel of
        sllEnter: EnterTimeStamp := fCurrentTimeStamp;
        sllLeave: begin
                    if fFrequencyTimeStamp=0 then
                      MS := 0 else // avoid div per 0 exception
                      MS := ((fCurrentTimeStamp-EnterTimeStamp)*(1000*1000))div fFrequencyTimeStamp;
                    fWriter.AddMicroSec(MS);
                  end;
      end
    else
      if aLevel in [sllEnter,sllLeave] then
        begin
          QueryPerformanceCounter(fCurrentTimeStamp);
          dec(fCurrentTimeStamp,fStartTimeStamp);
          goto DoEnt;
        end;
  end;
  fWriter.AddEndOfLine(aLevel);
end;

var ILog: ISynLog;
begin
  ILog := TSynLog.Enter;

  ILog := TSynLog.Enter(self,'something');

  ILog := TSynLog.Enter(self);