lcore.org gitweb
/
lcore.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fpc 3.0.0 support - fpc 3 renames fields in TInetSockAddr so we define it ourselves...
[lcore.git]
/
lcore.pas
diff --git
a/lcore.pas
b/lcore.pas
old mode 100755
(executable)
new mode 100644
(file)
index
6effe0e
..
097ea79
--- a/
lcore.pas
+++ b/
lcore.pas
@@
-16,21
+16,21
@@
unit lcore;
{$ifdef fpc}
\r
{$mode delphi}
\r
{$endif}
\r
{$ifdef fpc}
\r
{$mode delphi}
\r
{$endif}
\r
-{$ifdef
win32
}
\r
+{$ifdef
mswindows
}
\r
{$define nosignal}
\r
{$endif}
\r
interface
\r
uses
\r
sysutils,
\r
{$define nosignal}
\r
{$endif}
\r
interface
\r
uses
\r
sysutils,
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
{$ifdef VER1_0}
\r
linux,
\r
{$else}
\r
{$ifdef VER1_0}
\r
linux,
\r
{$else}
\r
- baseunix,unix,unixutil,
\r
+ baseunix,unix,unixutil,
sockets,
\r
{$endif}
\r
fd_utils,
\r
{$endif}
\r
{$endif}
\r
fd_utils,
\r
{$endif}
\r
- classes,pgtypes,bfifo;
\r
+ classes,pgtypes,bfifo
,ltimevalstuff
;
\r
procedure processtasks;
\r
\r
\r
procedure processtasks;
\r
\r
\r
@@
-45,7
+45,7
@@
interface
receivebufsize=packetbasesize*8;
\r
\r
var
\r
receivebufsize=packetbasesize*8;
\r
\r
var
\r
- absol
o
utemaxs:integer=0;
\r
+ absolutemaxs:integer=0;
\r
\r
type
\r
{$ifdef ver1_0}
\r
\r
type
\r
{$ifdef ver1_0}
\r
@@
-73,8
+73,8
@@
interface
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;
\r
\r
tlcomponent = class(tcomponent)
\r
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;
\r
\r
tlcomponent = class(tcomponent)
\r
- private
- procedure releasetaskhandler(wparam,lparam:longint);
+ private
\r
+ procedure releasetaskhandler(wparam,lparam:longint);
\r
public
\r
procedure release; virtual;
\r
destructor destroy; override;
\r
public
\r
procedure release; virtual;
\r
destructor destroy; override;
\r
@@
-84,8
+84,8
@@
interface
public
\r
state : tsocketstate ;
\r
ComponentOptions : TWSocketOptions;
\r
public
\r
state : tsocketstate ;
\r
ComponentOptions : TWSocketOptions;
\r
- fdhandlein : Longint ; {file d
i
scriptor}
\r
- fdhandleout : Longint ; {file d
i
scriptor}
\r
+ fdhandlein : Longint ; {file d
e
scriptor}
\r
+ fdhandleout : Longint ; {file d
e
scriptor}
\r
\r
onsessionclosed : tsocketevent ;
\r
ondataAvailable : tsocketevent ;
\r
\r
onsessionclosed : tsocketevent ;
\r
ondataAvailable : tsocketevent ;
\r
@@
-106,7
+106,11
@@
interface
lasterror:integer;
\r
destroying:boolean;
\r
recvbufsize:integer;
\r
lasterror:integer;
\r
destroying:boolean;
\r
recvbufsize:integer;
\r
- function receivestr:string; virtual;
\r
+ datasentcalled:boolean;
\r
+ {$ifdef mswindows}
\r
+ sendflushlasterror:integer;
\r
+ {$endif}
\r
+ function receivestr:tbufferstring; virtual;
\r
procedure close;
\r
procedure abort;
\r
procedure internalclose(error:word); virtual;
\r
procedure close;
\r
procedure abort;
\r
procedure internalclose(error:word); virtual;
\r
@@
-119,8
+123,8
@@
interface
procedure dup(invalue:longint);
\r
\r
function sendflush : integer;
\r
procedure dup(invalue:longint);
\r
\r
function sendflush : integer;
\r
- procedure sendstr(const str : string);virtual;
\r
- procedure putstringinsendbuffer(const newstring : string);
\r
+ procedure sendstr(const str :
tbuffer
string);virtual;
\r
+ procedure putstringinsendbuffer(const newstring :
tbuffer
string);
\r
function send(data:pointer;len:integer):integer;virtual;
\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
\r
procedure deletebuffereddata;
\r
function send(data:pointer;len:integer):integer;virtual;
\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
\r
procedure deletebuffereddata;
\r
@@
-136,9
+140,9
@@
interface
\r
function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
\r
\r
\r
function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
\r
\r
- procedure myfdclose(fd : integer); virtual;{$ifdef
win32
}abstract;{$endif}
\r
- function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef
win32
}abstract;{$endif}
\r
- function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef
win32
}abstract;{$endif}
\r
+ procedure myfdclose(fd : integer); virtual;{$ifdef
mswindows
}abstract;{$endif}
\r
+ function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef
mswindows
}abstract;{$endif}
\r
+ function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef
mswindows
}abstract;{$endif}
\r
protected
\r
procedure dupnowatch(invalue:longint);
\r
end;
\r
protected
\r
procedure dupnowatch(invalue:longint);
\r
end;
\r
@@
-154,12
+158,6
@@
interface
var
\r
timerwrapperinterface : ttimerwrapperinterface;
\r
type
\r
var
\r
timerwrapperinterface : ttimerwrapperinterface;
\r
type
\r
- {$ifdef win32}
\r
- ttimeval = record
\r
- tv_sec : longint;
\r
- tv_usec : longint;
\r
- end;
\r
- {$endif}
\r
tltimer=class(tlcomponent)
\r
protected
\r
\r
tltimer=class(tlcomponent)
\r
protected
\r
\r
@@
-170,8
+168,8
@@
interface
// finitialevent : boolean ;
\r
fontimer : tnotifyevent ;
\r
fenabled : boolean ;
\r
// finitialevent : boolean ;
\r
fontimer : tnotifyevent ;
\r
fenabled : boolean ;
\r
- finterval : integer ; {miliseconds, default 1000}
\r
- {$ifndef
win32
}
\r
+ finterval : integer ; {mil
l
iseconds, default 1000}
\r
+ {$ifndef
mswindows
}
\r
procedure resettimes;
\r
{$endif}
\r
// procedure setinitialevent(newvalue : boolean);
\r
procedure resettimes;
\r
{$endif}
\r
// procedure setinitialevent(newvalue : boolean);
\r
@@
-179,7
+177,7
@@
interface
procedure setenabled(newvalue : boolean);
\r
procedure setinterval(newvalue : integer);
\r
public
\r
procedure setenabled(newvalue : boolean);
\r
procedure setinterval(newvalue : integer);
\r
public
\r
- //making the
ese public for now, this code should probabl
ly be restructured later though
\r
+ //making the
se public for now, this code should probab
ly be restructured later though
\r
prevtimer : tltimer ;
\r
nexttimer : tltimer ;
\r
nextts : ttimeval ;
\r
prevtimer : tltimer ;
\r
nexttimer : tltimer ;
\r
nextts : ttimeval ;
\r
@@
-254,44
+252,45
@@
implementation
{$ifndef nosignal}
\r
uses {sockets,}lloopback,lsignal;
\r
{$endif}
\r
{$ifndef nosignal}
\r
uses {sockets,}lloopback,lsignal;
\r
{$endif}
\r
-{$ifdef
win32
}
\r
+{$ifdef
mswindows
}
\r
uses windows,winsock;
\r
{$endif}
\r
uses windows,winsock;
\r
{$endif}
\r
-{$ifndef
win32
}
\r
+{$ifndef
mswindows
}
\r
{$include unixstuff.inc}
\r
{$endif}
\r
{$include unixstuff.inc}
\r
{$endif}
\r
-{$include ltimevalstuff.inc}
\r
\r
\r
{!!! added sleep call -beware}
\r
procedure sleep(i:integer);
\r
\r
\r
{!!! added sleep call -beware}
\r
procedure sleep(i:integer);
\r
+{$ifdef mswindows}
\r
+begin
\r
+ windows.sleep(i);
\r
+{$else}
\r
var
\r
tv:ttimeval;
\r
begin
\r
var
\r
tv:ttimeval;
\r
begin
\r
- {$ifdef win32}
\r
- windows.sleep(i);
\r
- {$else}
\r
- tv.tv_sec := i div 1000;
\r
- tv.tv_usec := (i mod 1000) * 1000;
\r
- select(0,nil,nil,nil,@tv);
\r
- {$endif}
\r
+ tv.tv_sec := i div 1000;
\r
+ tv.tv_usec := (i mod 1000) * 1000;
\r
+ select(0,nil,nil,nil,@tv);
\r
+{$endif}
\r
end;
\r
\r
end;
\r
\r
+
\r
destructor tlcomponent.destroy;
\r
begin
\r
disconnecttasks(self);
\r
inherited destroy;
\r
end;
\r
\r
destructor tlcomponent.destroy;
\r
begin
\r
disconnecttasks(self);
\r
inherited destroy;
\r
end;
\r
\r
-procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
-begin
- free;
-end;
+procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
\r
+begin
\r
+ free;
\r
+end;
\r
\r
\r
procedure tlcomponent.release;
\r
begin
\r
\r
\r
procedure tlcomponent.release;
\r
begin
\r
- addtask(releasetaskhandler,self,0,0);
+ addtask(releasetaskhandler,self,0,0);
\r
end;
\r
\r
procedure tlasio.release;
\r
end;
\r
\r
procedure tlasio.release;
\r
@@
-400,13
+399,13
@@
begin
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
\r
if closehandles then begin
\r
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
\r
if closehandles then begin
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
//anyone remember why this is here? --plugwash
\r
fcntl(fdhandlein,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandlein);
\r
if fdhandleout <> fdhandlein then begin
\r
//anyone remember why this is here? --plugwash
\r
fcntl(fdhandlein,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandlein);
\r
if fdhandleout <> fdhandlein then begin
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
fcntl(fdhandleout,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandleout);
\r
fcntl(fdhandleout,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandleout);
\r
@@
-449,13
+448,13
@@
begin
end;
\r
end;
\r
\r
end;
\r
end;
\r
\r
-procedure tlasio.sendstr(const str : string);
\r
+procedure tlasio.sendstr(const str :
tbuffer
string);
\r
begin
\r
putstringinsendbuffer(str);
\r
sendflush;
\r
end;
\r
\r
begin
\r
putstringinsendbuffer(str);
\r
sendflush;
\r
end;
\r
\r
-procedure tlasio.putstringinsendbuffer(const newstring : string);
\r
+procedure tlasio.putstringinsendbuffer(const newstring :
tbuffer
string);
\r
begin
\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
\r
end;
\r
begin
\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
\r
end;
\r
@@
-485,13
+484,21
@@
var
// fdstestr : fdset;
\r
// fdstestw : fdset;
\r
begin
\r
// fdstestr : fdset;
\r
// fdstestw : fdset;
\r
begin
\r
- if state <> wsconnected then exit;
\r
+ if state <> wsconnected then begin
\r
+ result := -1;
\r
+ exit;
\r
+ end;
\r
+ datasentcalled := false;
\r
\r
lensent := sendq.get(data,packetbasesize*2);
\r
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
\r
\r
if result = -1 then lensent := 0 else lensent := result;
\r
\r
\r
lensent := sendq.get(data,packetbasesize*2);
\r
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
\r
\r
if result = -1 then lensent := 0 else lensent := result;
\r
\r
+ {$ifdef mswindows}
\r
+ if (result = -1) then sendflushlasterror := getlasterror else sendflushlasterror := 0;
\r
+ {$endif}
\r
+
\r
//sendq := copy(sendq,lensent+1,length(sendq)-lensent);
\r
sendq.del(lensent);
\r
\r
//sendq := copy(sendq,lensent+1,length(sendq)-lensent);
\r
sendq.del(lensent);
\r
\r
@@
-530,7
+537,7
@@
begin
fdhandlein := invalue;
\r
fdhandleout := invalue;
\r
eventcore.setfdreverse(fdhandlein,self);
\r
fdhandlein := invalue;
\r
fdhandleout := invalue;
\r
eventcore.setfdreverse(fdhandlein,self);
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
\r
{$endif}
\r
state := wsconnected;
\r
fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
\r
{$endif}
\r
state := wsconnected;
\r
@@
-563,15
+570,15
@@
begin
internalclose(0);
\r
\r
end else begin
\r
internalclose(0);
\r
\r
end else begin
\r
- {$ifdef
win32
}
\r
- if
get
lasterror=WSAEWOULDBLOCK then begin
\r
+ {$ifdef
mswindows
}
\r
+ if
sendflush
lasterror=WSAEWOULDBLOCK then begin
\r
//the asynchronous nature of windows messages means we sometimes
\r
//get here with the buffer full
\r
//so do nothing in that case
\r
end else
\r
{$endif}
\r
begin
\r
//the asynchronous nature of windows messages means we sometimes
\r
//get here with the buffer full
\r
//so do nothing in that case
\r
end else
\r
{$endif}
\r
begin
\r
- internalclose({$ifdef
win32}get
lasterror{$else}linuxerror{$endif});
\r
+ internalclose({$ifdef
mswindows}sendflush
lasterror{$else}linuxerror{$endif});
\r
end
\r
end;
\r
end;
\r
end
\r
end;
\r
end;
\r
@@
-579,7
+586,13
@@
begin
end else begin
\r
//everything is sent fire off ondatasent event
\r
if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
end else begin
\r
//everything is sent fire off ondatasent event
\r
if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
- if assigned(ondatasent) then tltask.create(self.dodatasent,self,0,0);
\r
+ if assigned(ondatasent) then begin
\r
+ if not datasentcalled then begin
\r
+ tltask.create(self.dodatasent,self,0,0);
\r
+ datasentcalled := true;
\r
+ end;
\r
+ end;
\r
+
\r
end;
\r
if assigned(onfdwrite) then onfdwrite(self,0);
\r
end;
\r
end;
\r
if assigned(onfdwrite) then onfdwrite(self,0);
\r
end;
\r
@@
-592,13
+605,13
@@
begin
if (numread=0) and (not mustrefreshfds) then begin
\r
{if i remember correctly numread=0 is caused by eof
\r
if this isn't dealt with then you get a cpu eating infinite loop
\r
if (numread=0) and (not mustrefreshfds) then begin
\r
{if i remember correctly numread=0 is caused by eof
\r
if this isn't dealt with then you get a cpu eating infinite loop
\r
- however if onsessioncon
en
cted has called processmessages that could
\r
+ however if onsessioncon
ne
cted has called processmessages that could
\r
cause us to drop to here with an empty recvq and nothing left to read
\r
and we don't want that to cause the socket to close}
\r
\r
internalclose(0);
\r
end else if (numread=-1) then begin
\r
cause us to drop to here with an empty recvq and nothing left to read
\r
and we don't want that to cause the socket to close}
\r
\r
internalclose(0);
\r
end else if (numread=-1) then begin
\r
- {$ifdef
win32
}
\r
+ {$ifdef
mswindows
}
\r
//sometimes on windows we get stale messages due to the inherent delays
\r
//in the windows message queue
\r
if WSAGetLastError = wsaewouldblock then begin
\r
//sometimes on windows we get stale messages due to the inherent delays
\r
//in the windows message queue
\r
if WSAGetLastError = wsaewouldblock then begin
\r
@@
-607,7
+620,7
@@
begin
{$endif}
\r
begin
\r
numread := 0;
\r
{$endif}
\r
begin
\r
numread := 0;
\r
- internalclose({$ifdef
win32
}wsagetlasterror{$else}linuxerror{$endif});
\r
+ internalclose({$ifdef
mswindows
}wsagetlasterror{$else}linuxerror{$endif});
\r
end;
\r
end else if numread > 0 then recvq.add(@tempbuf,numread);
\r
end;
\r
end;
\r
end else if numread > 0 then recvq.add(@tempbuf,numread);
\r
end;
\r
@@
-624,7
+637,7
@@
begin
end;
\r
\r
procedure tlasio.flush;
\r
end;
\r
\r
procedure tlasio.flush;
\r
-{$ifdef
win32
}
\r
+{$ifdef
mswindows
}
\r
type fdset = tfdset;
\r
{$endif}
\r
var
\r
type fdset = tfdset;
\r
{$endif}
\r
var
\r
@@
-653,7
+666,7
@@
begin
tlasio(sender).recvq.del(maxlongint);
\r
end;
\r
\r
tlasio(sender).recvq.del(maxlongint);
\r
end;
\r
\r
-{$ifndef
win32
}
\r
+{$ifndef
mswindows
}
\r
procedure tltimer.resettimes;
\r
begin
\r
gettimeofday(nextts);
\r
procedure tltimer.resettimes;
\r
begin
\r
gettimeofday(nextts);
\r
@@
-694,7
+707,7
@@
begin
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setenabled(wrappedtimer,newvalue);
\r
end else begin
\r
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setenabled(wrappedtimer,newvalue);
\r
end else begin
\r
- {$ifdef
win32
}
\r
+ {$ifdef
mswindows
}
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
@@
-710,7
+723,7
@@
begin
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setinterval(wrappedtimer,newvalue);
\r
end else begin
\r
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setinterval(wrappedtimer,newvalue);
\r
end else begin
\r
- {$ifdef
win32
}
\r
+ {$ifdef
mswindows
}
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
@@
-836,7
+849,7
@@
begin
end else begin
\r
currenttasklocal := currenttask; //needed in case called from a task
\r
end;
\r
end else begin
\r
currenttasklocal := currenttask; //needed in case called from a task
\r
end;
\r
- // note i don't bother to
s
estroy the links here as that will happen when
\r
+ // note i don't bother to
d
estroy the links here as that will happen when
\r
// the list of tasks is processed anyway
\r
while assigned(currenttasklocal) do begin
\r
if currenttasklocal.obj = aobj then begin
\r
// the list of tasks is processed anyway
\r
while assigned(currenttasklocal) do begin
\r
if currenttasklocal.obj = aobj then begin
\r
@@
-869,7
+882,7
@@
begin
if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
\r
eventcore.wmasterset(fdhandleout);
\r
end;
\r
if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
\r
eventcore.wmasterset(fdhandleout);
\r
end;
\r
-{$ifndef
win32
}
\r
+{$ifndef
mswindows
}
\r
procedure tlasio.myfdclose(fd : integer);
\r
begin
\r
fdclose(fd);
\r
procedure tlasio.myfdclose(fd : integer);
\r
begin
\r
fdclose(fd);
\r
lcore.org gitweb / lcore.git / blobdiff