X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/3d939725e66414faa7684bbcd5f4ffe95ee2108d..31396218eb1b42b37f8f527f3081ea233f967ca1:/lcore.pas diff --git a/lcore.pas b/lcore.pas index f6b0342..bb9eb8d 100755 --- a/lcore.pas +++ b/lcore.pas @@ -26,16 +26,23 @@ interface {$ifdef VER1_0} linux, {$else} - baseunix,unix,unixutil, + baseunix,unix,unixutil,sockets, {$endif} fd_utils, {$endif} - classes,pgtypes,bfifo; + classes,pgtypes,bfifo,ltimevalstuff; procedure processtasks; const - receivebufsize=1460*8; + {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 absoloutemaxs:integer=0; @@ -66,8 +73,9 @@ interface TSendData = procedure (Sender: TObject; BytesSent: Integer) of object; tlcomponent = class(tcomponent) + private + procedure releasetaskhandler(wparam,lparam:longint); public - released:boolean; procedure release; virtual; destructor destroy; override; end; @@ -87,8 +95,6 @@ interface onsenddata : tsenddata ; ondatasent : tsocketevent ; //connected : boolean ; - nextasin : tlasio ; - prevasin : tlasio ; recvq : tfifo; OnBgException : TBgExceptionEvent ; @@ -121,7 +127,7 @@ interface //procedure messageloop; function Receive(Buf:Pointer;BufSize:integer):integer; virtual; - procedure flush;virtual;{$ifdef win32} abstract;{$endif} + procedure flush;virtual; procedure dodatasent(wparam,lparam:longint); procedure doreceiveloop(wparam,lparam:longint); procedure sinkdata(sender:tobject;error:word); @@ -148,12 +154,6 @@ interface var timerwrapperinterface : ttimerwrapperinterface; type - {$ifdef win32} - ttimeval = record - tv_sec : longint; - tv_usec : longint; - end; - {$endif} tltimer=class(tlcomponent) protected @@ -220,7 +220,6 @@ procedure messageloop; procedure exitmessageloop; var - firstasin : tlasio ; firsttimer : tltimer ; firsttask , lasttask , currenttask : tltask ; @@ -255,7 +254,6 @@ implementation {$ifndef win32} {$include unixstuff.inc} {$endif} -{$include ltimevalstuff.inc} {!!! added sleep call -beware} @@ -278,12 +276,15 @@ begin inherited destroy; end; - +procedure tlcomponent.releasetaskhandler(wparam,lparam:longint); +begin + free; +end; procedure tlcomponent.release; begin - released := true; + addtask(releasetaskhandler,self,0,0); end; procedure tlasio.release; @@ -336,26 +337,12 @@ begin state := wsclosed; fdhandlein := -1; fdhandleout := -1; - nextasin := firstasin; - prevasin := nil; - if assigned(nextasin) then nextasin.prevasin := self; - firstasin := self; - - released := false; end; destructor tlasio.destroy; begin destroying := true; if state <> wsclosed then close; - if prevasin <> nil then begin - prevasin.nextasin := nextasin; - end else begin - firstasin := nextasin; - end; - if nextasin <> nil then begin - nextasin.prevasin := prevasin; - end; recvq.free; sendq.free; inherited destroy; @@ -398,6 +385,9 @@ 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); @@ -488,9 +478,12 @@ var // fdstestr : fdset; // fdstestw : fdset; begin - if state <> wsconnected then exit; + if state <> wsconnected then begin + result := -1; + exit; + end; - lensent := sendq.get(data,2920); + 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; @@ -566,7 +559,16 @@ begin internalclose(0); end else begin - internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif}); + {$ifdef win32} + if getlasterror=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 win32}getlasterror{$else}linuxerror{$endif}); + end end; end; @@ -617,19 +619,20 @@ begin end; end; -{$ifndef win32} - procedure tlasio.flush; - 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.flush; +{$ifdef win32} +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 @@ -732,8 +735,6 @@ begin end; interval := 1000; enabled := true; - released := false; - end; destructor tltimer.destroy; @@ -884,7 +885,6 @@ end; begin - firstasin := nil; firsttask := nil;