lcore/trunk/lcore.pas

{lsocket.pas}

{io and timer code by plugwash}

{ Copyright (C) 2005 Bas Steendijk and Peter Green
  For conditions of distribution and use, see copyright notice in zlib_license.txt
  which is included in the package
  ----------------------------------------------------------------------------- }

{note: you must use the @ in the last param to tltask.create not doing so will
 compile without error but will cause an access violation -pg}

//note: events after release are normal and are the apps responsibility to deal with safely

unit lcore;
{$ifdef fpc}
  {$mode delphi}
{$endif}
{$ifdef mswindows}
  {$define nosignal}
{$endif}
interface
  uses
    sysutils,
    {$ifndef mswindows}
      {$ifdef VER1_0}
        linux,
      {$else}
        baseunix,unix,unixutil,sockets,
      {$endif}
      fd_utils,
    {$endif}
    classes,pgtypes,bfifo,ltimevalstuff;
  procedure processtasks;


  const
    {how this number is made up:
    - ethernet: MTU 1500
    - be safe for either "ethernet v1" or "PPPoE", both take 8 bytes
    - IPv6 header: 40 bytes (IPv4 is 20)
    - TCP/UDP header: 20 bytes
    }
    packetbasesize = 1432;
    receivebufsize=packetbasesize*8;

  var
    absolutemaxs:integer=0;

  type
    {$ifdef ver1_0}
      sigset= array[0..31] of longint;
    {$endif}

    ESocketException   = class(Exception);
    TBgExceptionEvent  = procedure (Sender : TObject;
                                  E : Exception;
                                  var CanClose : Boolean) of object;

    // note : tsocketstate is defined in the same way as it is in François PIETTE's twsocket
    // however tlsocket currently only uses wsClosed wsConnecting wsconnected and wsListening
    TSocketState       = (wsInvalidState,
                        wsOpened,     wsBound,
                        wsConnecting, wsConnected,
                        wsAccepting,  wsListening,
                        wsClosed);

    TWSocketOption       = (wsoNoReceiveLoop, wsoTcpNoDelay);
    TWSocketOptions      = set of TWSocketOption;

    TSocketevent     = procedure(Sender: TObject; Error: word) of object;
    //Tdataavailevent  = procedure(data : string);
    TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;

    tlcomponent = class(tcomponent)
    private
      procedure releasetaskhandler(wparam,lparam:longint);
    public
      procedure release; virtual;
      destructor destroy; override;
    end;

    tlasio = class(tlcomponent)
    public
      state              : tsocketstate      ;
      ComponentOptions   : TWSocketOptions;
      fdhandlein         : Longint           ;  {file descriptor}
      fdhandleout        : Longint           ;  {file descriptor}

      onsessionclosed    : tsocketevent      ;
      ondataAvailable    : tsocketevent      ;
      onsessionAvailable : tsocketevent      ;

      onsessionconnected : tsocketevent      ;
      onsenddata         : tsenddata      ;
      ondatasent         : tsocketevent      ;
      //connected          : boolean         ;

      recvq              : tfifo;
      OnBgException      : TBgExceptionEvent ;
      //connectread        : boolean           ;
      sendq              : tfifo;
      closehandles       : boolean           ;
      writtenthiscycle   : boolean           ;
      onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd
      lasterror:integer;
      destroying:boolean;
      recvbufsize:integer;
      datasentcalled:boolean;
      {$ifdef mswindows}
      sendflushlasterror:integer;
      {$endif}
      function receivestr:tbufferstring; virtual;
      procedure close;
      procedure abort;
      procedure internalclose(error:word); virtual;
      constructor Create(AOwner: TComponent); override;

      destructor destroy; override;
      procedure fdcleanup;
      procedure HandleBackGroundException(E: Exception);
      procedure handlefdtrigger(readtrigger,writetrigger:boolean); virtual;
      procedure dup(invalue:longint);

      function sendflush : integer;
      procedure sendstr(const str : tbufferstring);virtual;
      procedure putstringinsendbuffer(const newstring : tbufferstring);
      function send(data:pointer;len:integer):integer;virtual;
      procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
      procedure deletebuffereddata;

      //procedure messageloop;
      function Receive(Buf:Pointer;BufSize:integer):integer; virtual;
      procedure flush;virtual;
      procedure dodatasent(wparam,lparam:longint);
      procedure doreceiveloop(wparam,lparam:longint);
      procedure sinkdata(sender:tobject;error:word);

      procedure release; override; {test -beware}

      function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd

      procedure myfdclose(fd : integer); virtual;{$ifdef mswindows}abstract;{$endif}
      function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}
      function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}
    protected
      procedure dupnowatch(invalue:longint);
    end;
    ttimerwrapperinterface=class(tlcomponent)
    public
      function createwrappedtimer : tobject;virtual;abstract;
//      procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
      procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);virtual;abstract;
      procedure setenabled(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
      procedure setinterval(wrappedtimer : tobject;newvalue : integer);virtual;abstract;
    end;

  var
    timerwrapperinterface : ttimerwrapperinterface;
  type
    tltimer=class(tlcomponent)
    protected


      wrappedtimer : tobject;


//      finitialevent       : boolean           ;
      fontimer            : tnotifyevent      ;
      fenabled            : boolean           ;
      finterval           : integer          ; {milliseconds, default 1000}
      {$ifndef mswindows}
        procedure resettimes;
      {$endif}
//      procedure setinitialevent(newvalue : boolean);
      procedure setontimer(newvalue:tnotifyevent);
      procedure setenabled(newvalue : boolean);
      procedure setinterval(newvalue : integer);
    public
      //making these public for now, this code should probably be restructured later though
      prevtimer          : tltimer           ;
      nexttimer          : tltimer           ;
      nextts             : ttimeval          ;

      constructor create(aowner:tcomponent);override;
      destructor destroy;override;
//      property initialevent : boolean read finitialevent write setinitialevent;
      property ontimer : tnotifyevent read fontimer write setontimer;
      property enabled : boolean read fenabled write setenabled;
      property interval : integer read finterval write setinterval;

    end;

    ttaskevent=procedure(wparam,lparam:longint) of object;

    tltask=class(tobject)
    public
      handler  : ttaskevent;
      obj      : tobject;
      wparam   : longint;
      lparam   : longint;
      nexttask : tltask;
      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
    end;


    teventcore=class
    public
      procedure processmessages; virtual;abstract;
      procedure messageloop; virtual;abstract;
      procedure exitmessageloop; virtual;abstract;
      procedure setfdreverse(fd : integer;reverseto : tlasio);virtual;abstract;
      procedure rmasterset(fd : integer;islistensocket : boolean);  virtual;abstract;
      procedure rmasterclr(fd: integer);  virtual;abstract;
      procedure wmasterset(fd : integer); virtual;abstract;
      procedure wmasterclr(fd: integer);  virtual;abstract;
    end;
var
    eventcore : teventcore;

procedure processmessages;
procedure messageloop;
procedure exitmessageloop;

var
  firsttimer                            : tltimer    ;
  firsttask  , lasttask   , currenttask : tltask     ;

  numread                               : integer    ;
  mustrefreshfds                        : boolean    ;
{  lcoretestcount:integer;}

  asinreleaseflag:boolean;


procedure disconnecttasks(aobj:tobject);
procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
type
  tonaddtask = procedure(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
var
  onaddtask : tonaddtask;


procedure sleep(i:integer);
{$ifndef nosignal}
  procedure prepsigpipe;{$ifndef ver1_0}inline;{$endif}
{$endif}


implementation
{$ifndef nosignal}
  uses {sockets,}lloopback,lsignal;
{$endif}
{$ifdef mswindows}
  uses windows,winsock;
{$endif}
{$ifndef mswindows}
  {$include unixstuff.inc}
{$endif}


{!!! added sleep call -beware}
procedure sleep(i:integer);
{$ifdef mswindows}
begin
  windows.sleep(i);
{$else}
var
  tv:ttimeval;
begin
  tv.tv_sec := i div 1000;
  tv.tv_usec := (i mod 1000) * 1000;
  select(0,nil,nil,nil,@tv);
{$endif}
end;


destructor tlcomponent.destroy;
begin
  disconnecttasks(self);
  inherited destroy;
end;

procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
begin
  free;
end;


procedure tlcomponent.release;
begin
  addtask(releasetaskhandler,self,0,0);
end;

procedure tlasio.release;
begin
  asinreleaseflag := true;
  inherited release;
end;

procedure tlasio.doreceiveloop;
begin
  if recvq.size = 0 then exit;
  if assigned(ondataavailable) then ondataavailable(self,0);
  if not (wsonoreceiveloop in componentoptions) then
  if recvq.size > 0 then tltask.create(self.doreceiveloop,self,0,0);
end;

function tlasio.receivestr;
begin
  setlength(result,recvq.size);
  receive(@result[1],length(result));
end;

function tlasio.receive(Buf:Pointer;BufSize:integer):integer;
var
  i,a,b:integer;
  p:pointer;
begin
  i := bufsize;
  if recvq.size < i then i := recvq.size;
  a := 0;
  while (a < i) do begin
    b := recvq.get(p,i-a);
    move(p^,buf^,b);
    inc(taddrint(buf),b);
    recvq.del(b);
    inc(a,b);
  end;
  result := i;
  if wsonoreceiveloop in componentoptions then begin
    if recvq.size = 0 then eventcore.rmasterset(fdhandlein,false);
  end;
end;

constructor tlasio.create;
begin
  inherited create(AOwner);
  if not assigned(eventcore) then raise exception.create('no event core');
  sendq := tfifo.create;
  recvq := tfifo.create;
  state := wsclosed;
  fdhandlein := -1;
  fdhandleout := -1;
end;

destructor tlasio.destroy;
begin
  destroying := true;
  if state <> wsclosed then close;
  recvq.free;
  sendq.free;
  inherited destroy;
end;

procedure tlasio.close;
begin
  internalclose(0);
end;

procedure tlasio.abort;
begin
  close;
end;

procedure tlasio.fdcleanup;
begin
  if fdhandlein <> -1 then begin
    eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster)
  end;
  if fdhandleout <> -1 then begin
    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster)
  end;
  if fdhandlein=fdhandleout then begin
    if fdhandlein <> -1 then begin
      myfdclose(fdhandlein);
    end;
  end else begin
    if fdhandlein <> -1 then begin
      myfdclose(fdhandlein);
    end;
    if fdhandleout <> -1 then begin
      myfdclose(fdhandleout);
    end;
  end;
  fdhandlein := -1;
  fdhandleout := -1;
end;

procedure tlasio.internalclose(error:word);
begin
  if (state<>wsclosed) and (state<>wsinvalidstate) then begin
    // -2 is a special indication that we should just exist silently
    // (used for connect failure handling when socket creation fails)
    if (fdhandlein = -2) and (fdhandleout = -2) then exit;
    if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
    eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);

    if closehandles then begin
      {$ifndef mswindows}
        //anyone remember why this is here? --plugwash
        fcntl(fdhandlein,F_SETFL,0);
      {$endif}
      myfdclose(fdhandlein);
      if fdhandleout <> fdhandlein then begin
        {$ifndef mswindows}
          fcntl(fdhandleout,F_SETFL,0);
        {$endif}
        myfdclose(fdhandleout);
      end;
      eventcore.setfdreverse(fdhandlein,nil);
      eventcore.setfdreverse(fdhandleout,nil);

      fdhandlein := -1;
      fdhandleout := -1;
    end;
    state := wsclosed;

    if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error);
  end;
  if assigned(sendq) then sendq.del(maxlongint);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ All exceptions *MUST* be handled. If an exception is not handled, the     }
{ application will most likely be shut down !                               }
procedure tlasio.HandleBackGroundException(E: Exception);
var
  CanAbort : Boolean;
begin
  CanAbort := TRUE;
  { First call the error event handler, if any }
  if Assigned(OnBgException) then begin
    try
      OnBgException(Self, E, CanAbort);
    except
    end;
  end;
  { Then abort the socket }
  if CanAbort then begin
    try
      close;
    except
    end;
  end;
end;

procedure tlasio.sendstr(const str : tbufferstring);
begin
  putstringinsendbuffer(str);
  sendflush;
end;

procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);
begin
  if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
end;

function tlasio.send(data:pointer;len:integer):integer;
begin
  if state <> wsconnected then begin
    result := -1;
    exit;
  end;
  if len < 0 then len := 0;
  result := len;
  putdatainsendbuffer(data,len);
  sendflush;
end;


procedure tlasio.putdatainsendbuffer(data:pointer;len:integer);
begin
  sendq.add(data,len);
end;

function tlasio.sendflush : integer;
var
  lensent : integer;
  data:pointer;
//  fdstestr : fdset;
//  fdstestw : fdset;
begin
  if state <> wsconnected then begin
    result := -1;
    exit;
  end;
  datasentcalled := false;

  lensent := sendq.get(data,packetbasesize*2);
  if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;

  if result = -1 then lensent := 0 else lensent := result;

  {$ifdef mswindows}
  if (result = -1) then sendflushlasterror := getlasterror else sendflushlasterror := 0;
  {$endif}

  //sendq := copy(sendq,lensent+1,length(sendq)-lensent);
  sendq.del(lensent);

  //fd_clr(fdhandleout,fdsw); // this prevents the socket being closed by a write
                            // that sends nothing because a previous socket has
                            // slready flushed this socket when the message loop
                            // reaches it
//  if sendq.size > 0 then begin
    eventcore.wmasterset(fdhandleout);//fd_set(fdhandleout,fdswmaster);
//  end else begin
//    wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
//  end;
  if result > 0 then begin
    if assigned(onsenddata) then onsenddata(self,result);
//    if sendq.size=0 then if assigned(ondatasent) then begin
//      tltask.create(self.dodatasent,self,0,0);
//      //begin test code
//      fd_zero(fdstestr);
//      fd_zero(fdstestw);
//      fd_set(fdhandlein,fdstestr);
//      fd_set(fdhandleout,fdstestw);
//      select(maxs,@fdstestr,@fdstestw,nil,0);
//      writeln(fd_isset(fdhandlein,fdstestr),' ',fd_isset(fdhandleout,fdstestw));
//      //end test code
//    
//    end;
    writtenthiscycle := true;
  end;
end;

procedure tlasio.dupnowatch(invalue:longint);
begin
  {  debugout('invalue='+inttostr(invalue));}
  //readln;
  if state<> wsclosed then close;
  fdhandlein := invalue;
  fdhandleout := invalue;
  eventcore.setfdreverse(fdhandlein,self);
  {$ifndef mswindows}
    fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
  {$endif}
  state := wsconnected;

end;


procedure tlasio.dup(invalue:longint);
begin
  dupnowatch(invalue);
  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);
  eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
end;


procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);
var
  sendflushresult : integer;
  tempbuf:array[0..receivebufsize-1] of byte;
  a:integer;
begin
  if (state=wsconnected) and writetrigger then begin
    //writeln('write trigger');

    if (sendq.size >0) then begin

      sendflushresult := sendflush;
      if (sendflushresult <= 0) and (not writtenthiscycle) then begin
        if sendflushresult=0 then begin // linuxerror := 0;
          internalclose(0);

        end else begin
          {$ifdef mswindows}
          if sendflushlasterror=WSAEWOULDBLOCK then begin
            //the asynchronous nature of windows messages means we sometimes
            //get here with the buffer full
            //so do nothing in that case
          end else
          {$endif}
          begin
            internalclose({$ifdef mswindows}sendflushlasterror{$else}linuxerror{$endif});
          end  
        end;
      end;

    end else begin
      //everything is sent fire off ondatasent event
      if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
      if assigned(ondatasent) then begin
        if not datasentcalled then begin
          tltask.create(self.dodatasent,self,0,0);
          datasentcalled := true;
        end;
      end;

    end;
    if assigned(onfdwrite) then onfdwrite(self,0);
  end;
  writtenthiscycle := false;
  if (state =wsconnected) and readtrigger then begin
    if recvq.size=0 then begin
      a := recvbufsize;
      if (a <= 0) or (a > sizeof(tempbuf)) then a := sizeof(tempbuf);
      numread := myfdread(fdhandlein,tempbuf,a);
      if (numread=0) and (not mustrefreshfds) then begin
        {if i remember correctly numread=0 is caused by eof
        if this isn't dealt with then you get a cpu eating infinite loop
        however if onsessionconnected has called processmessages that could
        cause us to drop to here with an empty recvq and nothing left to read
        and we don't want that to cause the socket to close}

        internalclose(0);
      end else if (numread=-1) then begin
        {$ifdef mswindows}
          //sometimes on windows we get stale messages due to the inherent delays
          //in the windows message queue
          if WSAGetLastError = wsaewouldblock then begin
            //do nothing
          end else
        {$endif}
        begin
          numread := 0;
          internalclose({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});
        end;
      end else if numread > 0 then recvq.add(@tempbuf,numread);
    end;

    if recvq.size > 0 then begin
      if wsonoreceiveloop in componentoptions then eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster);
      if assigned(ondataavailable) then ondataAvailable(self,0);
      if not (wsonoreceiveloop in componentoptions) then if recvq.size > 0 then
      tltask.create(self.doreceiveloop,self,0,0);
    end;
    //until (numread = 0) or (currentsocket.state<>wsconnected);
{    debugout('inner loop complete');}
  end;
end;

procedure tlasio.flush;
{$ifdef mswindows}
type fdset = tfdset;
{$endif}
var
  fds : fdset;
begin
  fd_zero(fds);
  fd_set(fdhandleout,fds);
  while sendq.size>0 do begin
    select(fdhandleout+1,nil,@fds,nil,nil);
    if sendflush <= 0 then exit;
  end;
end;

procedure tlasio.dodatasent(wparam,lparam:longint);
begin
  if assigned(ondatasent) then ondatasent(self,lparam);
end;

procedure tlasio.deletebuffereddata;
begin
  sendq.del(maxlongint);
end;

procedure tlasio.sinkdata(sender:tobject;error:word);
begin
  tlasio(sender).recvq.del(maxlongint);
end;

{$ifndef mswindows}
  procedure tltimer.resettimes;
  begin
    gettimeofday(nextts);
    {if not initialevent then} tv_add(nextts,interval);
  end;
{$endif}

{procedure tltimer.setinitialevent(newvalue : boolean);
begin
  if newvalue <> finitialevent then begin
    finitialevent := newvalue;
    if assigned(timerwrapperinterface) then begin
      timerwrapperinterface.setinitialevent(wrappedtimer,newvalue);
    end else begin
      resettimes;
    end;
  end;
end;}

procedure tltimer.setontimer(newvalue:tnotifyevent);
begin
  if @newvalue <> @fontimer then begin
    fontimer := newvalue;
    if assigned(timerwrapperinterface) then begin
      timerwrapperinterface.setontimer(wrappedtimer,newvalue);
    end else begin

    end;
  end;

end;


procedure tltimer.setenabled(newvalue : boolean);
begin
  if newvalue <> fenabled then begin
    fenabled := newvalue;
    if assigned(timerwrapperinterface) then begin
      timerwrapperinterface.setenabled(wrappedtimer,newvalue);
    end else begin
      {$ifdef mswindows}
        raise exception.create('non wrapper timers are not permitted on windows');
      {$else}
        resettimes;
      {$endif}
    end;
  end;
end;

procedure tltimer.setinterval(newvalue:integer);
begin
  if newvalue <> finterval then begin
    finterval := newvalue;
    if assigned(timerwrapperinterface) then begin
      timerwrapperinterface.setinterval(wrappedtimer,newvalue);
    end else begin
      {$ifdef mswindows}
        raise exception.create('non wrapper timers are not permitted on windows');
      {$else}
        resettimes;
      {$endif}
    end;
  end;

end;


constructor tltimer.create;
begin
  inherited create(AOwner);
  if assigned(timerwrapperinterface) then begin
    wrappedtimer := timerwrapperinterface.createwrappedtimer;
  end else begin


    nexttimer := firsttimer;
    prevtimer := nil;

    if assigned(nexttimer) then nexttimer.prevtimer := self;
    firsttimer := self;
  end;
  interval := 1000;
  enabled := true;
end;

destructor tltimer.destroy;
begin
  if assigned(timerwrapperinterface) then begin
    wrappedtimer.free;
  end else begin
    if prevtimer <> nil then begin
      prevtimer.nexttimer := nexttimer;
    end else begin
      firsttimer := nexttimer;
    end;
    if nexttimer <> nil then begin
      nexttimer.prevtimer := prevtimer;
    end;
    
  end;
  inherited destroy;
end;

constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
begin
  inherited create;
  if assigned(onaddtask) then onaddtask(ahandler,aobj,awparam,alparam);
  handler   := ahandler;
  obj       := aobj;
  wparam    := awparam;
  lparam    := alparam;
  {nexttask  := firsttask;
  firsttask := self;}
  if assigned(lasttask) then begin
    lasttask.nexttask := self;
  end else begin
    firsttask := self;
  end;
  lasttask := self;
  //ahandler(wparam,lparam);
end;

procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
begin

  tltask.create(ahandler,aobj,awparam,alparam);
end;

{$ifndef nosignal}
  procedure prepsigpipe;{$ifndef ver1_0}inline;
{$endif}
  begin
    starthandlesignal(sigpipe);
    if not assigned(signalloopback) then begin
      signalloopback := tlloopback.create(nil);
      signalloopback.ondataAvailable := signalloopback.sinkdata;

    end;

  end;
{$endif}

procedure processtasks;//inline;
var
  temptask                : tltask   ;

begin

  if not assigned(currenttask) then begin
    currenttask := firsttask;
    firsttask := nil;
    lasttask  := nil;
  end;
  while assigned(currenttask) do begin

    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);
    if assigned(currenttask) then begin
      temptask := currenttask;
      currenttask := currenttask.nexttask;
      temptask.free;
    end;
    //writeln('processed a task');
  end;

end;


procedure disconnecttasks(aobj:tobject);
var
  currenttasklocal : tltask ;
  counter          : byte   ;
begin
  for counter := 0 to 1 do begin
    if counter = 0 then begin
      currenttasklocal := firsttask; //main list of tasks
    end else begin
      currenttasklocal := currenttask; //needed in case called from a task
    end;
    // note i don't bother to destroy the links here as that will happen when
    // the list of tasks is processed anyway
    while assigned(currenttasklocal) do begin
      if currenttasklocal.obj = aobj then begin
        currenttasklocal.obj := nil;
        currenttasklocal.handler := nil;
      end;
      currenttasklocal := currenttasklocal.nexttask;
    end;
  end;
end;


procedure processmessages;
begin
  eventcore.processmessages;
end;
procedure messageloop;
begin
  eventcore.messageloop;
end;

procedure exitmessageloop;
begin
  eventcore.exitmessageloop;
end;

function tlasio.RealSend(Data : Pointer; Len : Integer) : Integer;
begin
  result := myfdwrite(fdhandleout,data^,len);
  if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
  eventcore.wmasterset(fdhandleout);
end;
{$ifndef mswindows}
  procedure tlasio.myfdclose(fd : integer);
  begin
    fdclose(fd);
  end;
  function tlasio.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
  begin
    result := fdwrite(fd,buf,size);
  end;

  function tlasio.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
  begin
    result := fdread(fd,buf,size);
  end;


{$endif}


begin
  firsttask := nil;
  

  {$ifndef nosignal}
    signalloopback := nil;
  {$endif}
end.


No admin address has been configured">No admin address has been configured	ViewVC Help
Powered by ViewVC 1.1.22