[fpc-devel] Delphi replacement for get_caller_addr

Skybuck Flying skybuck2000 at hotmail.com
Thu Apr 14 08:20:16 CEST 2011


Hello,

These two functions are being used for i386:

// *** Skybuck: Fix Needed (porting issue 582)
function get_frame:pointer;assembler;nostackframe;{$ifdef 
SYSTEMINLINE}inline;{$endif}
asm
  movl    %ebp,%eax
end;

// *** Skybuck: Fix Needed (porting issue 583)
function get_caller_addr(framebp:pointer):pointer; nostackframe;assembler;
asm
{$ifndef REGCALL}
  movl    framebp,%eax
{$endif}
  orl     %eax,%eax
  jz      .Lg_a_null
  movl    4(%eax),%eax
.Lg_a_null:
end;

for the following code in cclasses.pas:

 Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);


I'm not sure what kind of address is being returned here...

So I am taking a guess, would it be ok to replace the functions in Delphi as 
follows:

function get_caller_addr(framebp:pointer):pointer;
begin
    result := ErrorAddr;
end;

This calls ErrorAddr which is a function in Delphi's system.pas unit which 
looks as follows:

{ Return current exception address }
function ExceptAddr: Pointer;
begin
  if RaiseListPtr <> nil then
    Result := PRaiseFrame(RaiseListPtr)^.ExceptAddr
  else
    Result := nil;
end;

It seems to return the exception address that way.

Here is more information for the raise frame type:

  PRaiseFrame = ^TRaiseFrame;
  TRaiseFrame = packed record
    NextRaise: PRaiseFrame;
    ExceptAddr: Pointer;
    ExceptObject: TObject;
    ExceptionRecord: PExceptionRecord;
  end;

It also seems to have an exception record field, which again contains 
another ExceptionAddress inside it... not sure what that is ? Perhaps a 
nested thing ? or perhaps the same ?


{$IFDEF MSWINDOWS}
type
  PExceptionRecord = ^TExceptionRecord;
  TExceptionRecord = record
    ExceptionCode: Cardinal;
    ExceptionFlags: Cardinal;
    ExceptionRecord: PExceptionRecord;
    ExceptionAddress: Pointer;
    NumberParameters: Cardinal;
    case {IsOsException:} Boolean of
      True:  (ExceptionInformation : array [0..14] of NativeUInt);
      False: (ExceptAddr: Pointer; ExceptObject: Pointer);
  end;
  TExceptClsProc = function(P: PExceptionRecord): Pointer{ExceptClass};
  TExceptObjProc = function(P: PExceptionRecord): Pointer{Exception};
  TRaiseExceptObjProc = procedure(P: PExceptionRecord);

{$IF not defined(CPU386)}
  PContext = Pointer{^TContext};
  PExceptionPointers = ^TExceptionPointers;
  TExceptionPointers = record
    ExceptionRecord: PExceptionRecord;
    ContextRecord: PContext;
  end;
  _TDelphiFinallyHandlerProc = function(ExceptionPointers: 
PExceptionPointers;
                                        EstablisherFrame: NativeUInt): 
Integer;
  _TExceptionHandlerProc = function(ExceptionPointers: PExceptionPointers;
                                    EstablisherFrame: NativeUInt): Integer;
  _TDelphiCatchHandlerProc = function(ExceptionPointers: PExceptionPointers;
                                 EstablisherFrame: NativeUInt; 
ExceptionObject: Pointer): NativeUInt;
{$IFEND}
{$ENDIF}
{$IFDEF PC_MAPPED_EXCEPTIONS}
type
  PRaisedException = ^TRaisedException;
  TRaisedException = packed record
    RefCount: Integer;
    ExceptObject: TObject;
    ExceptionAddr: Pointer;
    HandlerEBP: LongWord;
    Flags: LongWord;
    Cleanup: Pointer;
    Prev: PRaisedException;
    ReleaseProc: Pointer;
  end;
  PExceptionRecord = PRaisedException;
  TExceptionRecord = TRaisedException;
{$ENDIF}

?

Bye,
  Skybuck. 




More information about the fpc-devel mailing list