[fpc-pascal]Problems with setitimer....

[Anton Tichawa]

hi, judison!

i enclose some procedures i currently use for setitimer / getitimer. they do 
work.

i briefly looked at your code and found 2 possible problems:

1) maybe it's better to use 'sigaction' instead of 'signal'

2) i don't know if it's allowed to do file i/o (WriteLn) within the signal 
handler.

hth,

anton.

On Thursday 21 November 2002 02:07, you wrote:
> Hi all
>
> First excuse my poor english,
>
> I'm trying to use setitimer (man setitimer) to get "alarmed" every X ms
> under linux... and since we don't have the setitimer and getitimer in RTL
> yet (Marco van de Voort will include it), I tried to use SysCall, but, it
> seens that I'm doing something wrong....
>
> I attached the pascal source (test.pas) and a C source that works (ctest.c)
> (gcc -o ctest ctest.c)
>
> The C test, recieves a signal (SIGALRM) every 50ms, and the Pascal one,
> does not recieve anything... but, if I:
>
> # killall -ALRM test
>
> the Test recieves it, but, the next time I do this, it prints "Alarm clock"
> and the program is terminated.
>
> (it all, even with FPC 1.0.6 and 1.1 compiled today from cvs)
>
> TIA
> Your friend,
> Judison
-------------- next part --------------
unit Times;

interface

uses
  Linux, Str2, Global;

const
  ITIMER_REAL = 0;

type
  TITimerVal = record
    it_interval: timeval;
    it_value: timeval;
  end;

procedure HandleAlarm(Sig: Longint); cdecl;
procedure InitTimes;
procedure DoneTimes;
function GetTicks: Longint;  // ms since io started

type

const
  InitialTimerValue: TimeVal = (sec: 0; usec: 10000);

var
  OldAlarmAction: SigActionRec;
  NewAlarmAction: SigActionRec;

procedure SetRealIntervalTimer(const tv: timeval);
procedure GetRealIntervalTimer(var tv: timeval);

implementation

procedure SetRealIntervalTimer(const tv: timeval);
var
  TimerVal: TITimerVal;
  Regs: SysCallRegs;
begin
  TimerVal.it_interval := tv;
  TimerVal.it_value := tv;
  Regs.Reg2 := ITIMER_REAL;
  Regs.Reg3 := Longint(@TimerVal);
  Regs.Reg4 := 0;
  SysCall(SysCall_Nr_SetITimer, Regs);
  if ErrNo <> 0 then Halt;
  // -tbd- check Errno;
end;

procedure GetRealIntervalTimer(var tv: timeval);
var
  Regs: SysCallRegs;
begin
  Regs.Reg2 := ITIMER_REAL;
  Regs.Reg3 := Longint(@tv);
  SysCall(SysCall_Nr_GetITimer, Regs);
  if ErrNo <> 0 then Halt;
  // -tbd- check Errno;
end;

procedure HandleAlarm(Sig: Longint); cdecl;
begin
  Inc(Alarms);
end;

function GetTicks: Longint;  // ms since io started
var
  MyTimeVal: TTimeVal;
begin
  GetTimeOfDay(MyTimeVal);
  Result := 1000 * (MyTimeVal.sec - StartedTimeVal.sec) + 
    (MyTimeVal.usec - StartedTimeVal.usec) div 1000;
end;

procedure InitTimes;
begin
  Alarms := 0;
  NewAlarmAction.Handler.Sh := @HandleAlarm;
  NewAlarmAction.Sa_Mask := 0;
  NewAlarmAction.Sa_Flags := 0;  // -tbd-
  NewAlarmAction.Sa_Restorer := nil;
  SigAction(SIGALRM, @NewAlarmAction, @OldAlarmAction);
  if ErrNo <> 0 then Halt;
  SetRealIntervalTimer(InitialTimerValue);
  if ErrNo <> 0 then Halt;
end;

procedure DoneTimes;
begin
  SigAction(SIGALRM, @OldAlarmAction, nil);
end;

end.