I found a bug in Linux signal handling which effects both the 1.0.10 and 1.9.0 versions of FreePascal. The SigSet type is too small. This results in some signal calls overwriting other memory locations.
I have an example program which can use the new 1.9.0 BaseUnix calls or libc and my definitions of the signal parameter types. The code is supposed to generate a SIGALRM every second and set a boolean every time it does. Depending on other unrelated code added to the program, it will not respond to SIGALRM at all, or it will respond too often as if the signal was sent to the program over and over in a tight loop.
And of course, since this is my first post, I would like to thank all the developers for their fine work! I have been slowly replacing libraries and applications I had written in Java with FreePascal versions. Other than this signal issue, I haven't had a single problem with the compiler or libraries. Everything seems rock solid! Thanks again.
program SigTest;
{$LINKLIB libc}
uses
BaseUnix;
// systhrds;
// Ordinal types
type
int8 = shortint;
int16 = smallint;
int32 = longint;
word8 = byte;
word16 = word;
word32 = cardinal;
word64 = qword;
size_t = int32; // Used by many standard C calls
// *************************************************************************
// * Structurs and variables used for Linux signal handling calls.
// *************************************************************************
const
SI_PAD_SIZE = 128; // Only works for 32 bit architecture!
type
sigset_t_ptr = ^sigset_t;
sigset_t = array[ 0..127] of byte;
sigval_t = record
case word8 of
0: ( ival_int: word32);
1: ( sival_ptr: pointer);
end; // sigval_t record
siginfo_t = record
case word8 of
0: (_pad: array[ 0..SI_PAD_SIZE - 1] of word8);
1: ( si_pid: int32;
si_uid: word32;
case word8 of
1: ( si_sigval: sigval_t);
2: ( si_status: int32;
si_utime: int32;
si_stime: int32); // SIGCHILD
); // case
2: ( _timer1: word32;
_timer2: word32); // timer (SIGALRM?)
3: ( si_addr: pointer); // faults
4: ( si_band: int32;
si_fd: int32); // SIGPOLL
end; // siginfo_t
// A signal handler which just recieves the signal number
SignalHandlerProc = procedure( SignalNumber: int32);
// A signal handler which recieves more information about the signal
SignalActionProc = procedure( SignalNumber: int32;
var SigInfo: siginfo_t;
var Unknown);
// Used to set signal behaviour using the sigaction() call
sa_procType = record
case word8 of
0: (sa_handler: SignalHandlerProc);
1: (sa_sigaction: SignalActionProc);
end; // sa_procType
SignalActionRecPtr = ^SignalActionRec;
SignalActionRec = record
sa_proc: sa_procType;
sa_mask: sigset_t;
sa_flags: int32;
sa_restorer: pointer;
end; // SignalActionRec
// *************************************************************************
// * External GLIBC Functions
// *************************************************************************
function sigemptyset( var SignalSet: sigset_t): int32; cdecl; external;
function sigfillset( var SignalSet: sigset_t): int32; cdecl; external;
function sigaddset( var SignalSet: sigset_t; SignalNumber: int32): int32;
cdecl; external;
function sigdelset( var SignalSet: sigset_t; SignalNumber: int32): int32;
cdecl; external;
function sigismember( var SignalSet: sigset_t; SignalNumber: int32): int32;
cdecl; external;
function sigaction( SignalNumber: word32;
NewAction: SignalActionRecPtr;
OldAction: SignalActionRecPtr): int32; cdecl; external;
function sigprocmask( How: int32;
OldSet: sigset_t_ptr;
NewSet: sigset_t_ptr): int32; cdecl; external;
function sigpending( var Mask: sigset_t): int32; cdecl; external;
function sigsuspend( var Mask: sigset_t): int32; cdecl; external;
// *************************************************************************
// * AlrmSigHandler() - Handle Alrm signals
// *************************************************************************
var
AlarmRecieved: boolean;
procedure AlrmSigHandler( Sig: LongInt); cdecl;
begin
AlarmRecieved:= true;
writeln( 'AlrmSigHandler(): Alarm recieved');
end; // AlrmSigHandler()
// *************************************************************************
// * MyInstallAlrmSignalHandler() - Install our signal handler
// *************************************************************************
procedure MyInstallAlrmSignalHandler();
var
NewAction: SignalActionRec;
OldAction: SignalActionRec;
NewSigSet: sigset_t;
begin
SigAction( SIGALRM, nil, @OldAction);
NewAction:= OldAction;
NewAction.sa_proc.sa_handler:= @AlrmSigHandler;
// Install the signal handler
SigAction( SIGALRM, @NewAction, nil);
// Make sure the signal is not blocked
SigEmptySet( NewSigSet);
SigAddSet( NewSigSet, SIGALRM);
SigProcMask( SIG_UNBLOCK, @NewSigSet, nil);
end; // MyInstallAlrmSignalHandler()
// *************************************************************************
// * MySignalLoop()
// *************************************************************************
procedure MySignalLoop();
var
MySigMask: SigSet_t;
i: integer;
begin
AlarmRecieved:= false;
fpAlarm( 1);
// Create a zeroed signal mask so we can recieve all signals
for i:= 0 to 127 do begin
MySigMask[ i]:= 0;
end;
// sigemptyset( MySigMask);
while( true) do begin
SigSuspend( MySigMask);
if( AlarmRecieved) then begin
fpAlarm( 1);
AlarmRecieved:= false;
writeln( 'Recieved a SIGALRM!');
end; // if AlarmRecieved
end;
end; // MySignalLoop()
// *************************************************************************
// * NewInstallAlrmSignalHandler() - Install our signal handler
// *************************************************************************
procedure NewInstallAlrmSignalHandler();
var
NewAction: SigActionRec;
OldAction: SigActionRec;
NewSigSet: SigSet;
begin
fpSigAction( SIGALRM, nil, @OldAction);
NewAction:= OldAction;
NewAction.sa_handler:= @AlrmSigHandler;
// Install the signal handler
fpSigAction( SIGALRM, @NewAction, nil);
// Make sure the signal is not blocked
fpSigEmptySet( NewSigSet);
fpSigAddSet( NewSigSet, SIGALRM);
fpSigProcMask( SIG_UNBLOCK, @NewSigSet, nil);
end; // NewInstallAlrmSignalHandler()
// *************************************************************************
// * NewSignalLoop()
// *************************************************************************
procedure NewSignalLoop();
var
MySigMask: SigSet;
i: integer;
begin
AlarmRecieved:= false;
fpAlarm( 1);
// Create a zeroed signal mask so we can recieve all signals
for i:= 0 to wordsinsigset - 1 do begin
MySigMask[ i]:= 0;
end;
while( true) do begin
fpSigSuspend( MySigMask);
if( AlarmRecieved) then begin
fpAlarm( 1);
AlarmRecieved:= false;
writeln( 'Recieved a SIGALRM!');
end; // if AlarmRecieved
end;
end; // NewSignalLoop()
// *************************************************************************
// * main()
// *************************************************************************
const
UseNew = true;
begin
if( UseNew) then begin
NewInstallAlrmSignalHandler();
NewSignalLoop();
end else begin
MyInstallAlrmSignalHandler();
MySignalLoop();
end;
end.