Jelajahi Sumber

Amiga: Debugoutput for all socket functions

Marcus Sackrow 1 bulan lalu
induk
melakukan
dd75a44709
1 mengubah file dengan 129 tambahan dan 20 penghapusan
  1. 129 20
      packages/rtl-extra/src/amiga/sockets.pp

+ 129 - 20
packages/rtl-extra/src/amiga/sockets.pp

@@ -13,6 +13,7 @@
 {$PACKRECORDS 2}
 {.$DEFINE SOCKETS_DEBUG}
 {$ModeSwitch out}
+{$modeSwitch result}
 
 {$IFNDEF FPC_DOTTEDUNITS}
 unit Sockets;
@@ -25,6 +26,9 @@ uses
   System.CTypes,Amiga.Core.Exec;
 {$ELSE FPC_DOTTEDUNITS}
 uses
+  {$IFDEF SOCKETS_DEBUG}
+  sysutils,
+  {$ENDIF}
   ctypes,exec;
 {$ENDIF FPC_DOTTEDUNITS}
 
@@ -287,15 +291,27 @@ end;
 
 function FpIOCtl(d: Cint; request: LongWord; Data: Pointer): cint;
 begin
-  FpIOCtl := bsd_ioctlsocket(d, request, Data);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpIOCtl(' + IntToStr(d) + ', ' + IntToStr(Request) + ', ' + HexStr(Data) + ')...');
+  {$ENDIF}
+  Result := bsd_ioctlsocket(d, request, Data);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpIOCtl results in ' + IntToStr(Result));
+  {$ENDIF}
 end;
 
 function fpSelect(N: LongInt; readfds, writefds, exceptfds: pfdset; TimeOut: PTimeVal):LongInt;
 var
   Lw: LongWord;
 begin
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSelect(' + IntToStr(n) + ', ' + HexStr(readfds) + ', ' + HexStr(Writefds) + ' ' + HexStr(TimeOut) + ')...');
+  {$ENDIF}
   Lw := 0;
-  fpSelect := bsd_waitselect(N, Readfds, WriteFds, ExceptFds, Timeout, @LW);
+  Result := bsd_waitselect(N, Readfds, WriteFds, ExceptFds, Timeout, @LW);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSelect results in ' + IntToStr(Result));
+  {$ENDIF}
 end;
 
 function socketerror: cint;
@@ -313,107 +329,200 @@ end;
 
 function fpClose(d: LongInt): LongInt; inline;
 begin
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpClose(' + IntToStr(d) + ')...');
+  {$ENDIF}
   if Assigned(SocketBase) then
-    fpClose := bsd_CloseSocket(d)
+    Result := bsd_CloseSocket(d)
   else
-    fpClose := -1;
+    Result := -1;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpClose results in ' + IntToStr(Result));
+  {$ENDIF}
 end;
 
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
 begin
-  fpaccept := bsd_accept(s,addrx,addrlen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpAccept(' + IntToStr(s) + ', ' + HexStr(Addrx) + ', ' + HexStr(AddrLen) + ')...');
+  {$ENDIF}
+  Result := bsd_accept(s,addrx,addrlen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpAccept results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
 begin
-  fpbind := bsd_bind(s, addrx, addrlen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpBind(' + IntToStr(s) + ', ' + HexStr(Addrx) + ', ' + IntToStr(AddrLen) + ')...');
+  {$ENDIF}
+  Result := bsd_bind(s, addrx, addrlen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpBind results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
 begin
-  fpconnect := bsd_connect(s, name, namelen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpConnect(' + IntToStr(s) + ', ' + HexStr(Name) + ', ' + IntToStr(NameLen) + ')...');
+  {$ENDIF}
+  Result := bsd_connect(s, name, namelen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpConnect results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
 begin
-  fpgetpeername := bsd_getpeername(s,name,namelen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpGetPeername(' + IntToStr(s) + ', ' + HexStr(Name) + ', ' + HexStr(NameLen) + ')...');
+  {$ENDIF}
+  Result := bsd_getpeername(s,name,namelen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpGetPeername results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpgetsockname(s:cint; name  : psockaddr; namelen : psocklen):cint;
 begin
-  fpgetsockname := bsd_getsockname(s,name,namelen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpGetSockName(' + IntToStr(s) + ', ' + HexStr(Name) + ', ' + HexStr(NameLen) + ')...');
+  {$ENDIF}
+  Result := bsd_getsockname(s,name,namelen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpGetSockName results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
-function fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+function fpgetsockopt(s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
 begin
-  fpgetsockopt := bsd_getsockopt(s,level,optname,optval,optlen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpGetSockOpt(' + IntToStr(s) + ', ' + IntToStr(Level) + ', ' + IntToStr(optname) + ', ' + HexStr(OptVal) + ', ' + HexStr(OptLen) +')...');
+  {$ENDIF}
+  Result := bsd_getsockopt(s,level,optname,optval,optlen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpGetSockOpt results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fplisten(s:cint; backlog : cint):cint;
 begin
-  fplisten := bsd_listen(s, backlog);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpListen(' + IntToStr(s) + ', ' + IntToStr(backlog) + ')...');
+  {$ENDIF}
+  Result := bsd_listen(s, backlog);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpListen results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fprecv(s:cint; buf: pointer; len: size_t; Flags: cint): ssize_t;
 begin
-  fprecv := bsd_recv(s,buf,len,flags);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpRecv(' + IntToStr(s) + ', ' + HexStr(buf) + ', ' + IntToStr(len) + ', ' + IntToStr(Flags) + ')...');
+  {$ENDIF}
+  Result := bsd_recv(s,buf,len,flags);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpRecv results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fprecvfrom(s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
 begin
-  fprecvfrom := bsd_recvfrom(s, buf, len, flags, from, fromlen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpRecvFrom(' + IntToStr(s) + ', ' + HexStr(buf) + ', ' + IntToStr(len) + ', ' + IntToStr(Flags) + ', ' + HexStr(From) + ', ' + HexStr(FromLen) + ')...');
+  {$ENDIF}
+  Result := bsd_recvfrom(s, buf, len, flags, from, fromlen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpRecvFrom results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpsend(s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
 begin
-  fpsend := bsd_send(s, msg, len, flags);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSend(' + IntToStr(s) + ', ' + HexStr(Msg) + ', ' + IntToStr(len) + ', ' + IntToStr(Flags) + ')...');
+  {$ENDIF}
+  Result := bsd_send(s, msg, len, flags);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSend results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpsendto(s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
 begin
-  fpsendto := bsd_sendto(s, msg, len, flags, tox, tolen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSendTo(' + IntToStr(s) + ', ' + HexStr(Msg) + ', ' + IntToStr(len) + ', ' + IntToStr(Flags) + ', ' + HexStr(tox) + ', ' + IntToStr(ToLen) + ')...');
+  {$ENDIF}
+  Result := bsd_sendto(s, msg, len, flags, tox, tolen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSendTo results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpsetsockopt(s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
 begin
-  fpsetsockopt := bsd_setsockopt(s, level, optname, optval, optlen);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSetSockOpt(' + IntToStr(s) + ', ' + IntToStr(Level) + ', ' + IntToStr(optname) + ', ' + HexStr(OptVal) + ', ' + IntToStr(OptLen) +')...');
+  {$ENDIF}
+  Result := bsd_setsockopt(s, level, optname, optval, optlen);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSetSockOpt results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpshutdown(s: cint; how: cint): cint;
 begin
-  fpshutdown := bsd_shutdown(s, how);
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpShutdown(' + IntToStr(s) + ', ' + IntToStr(how) + ')...');
+  {$ENDIF}
+  Result := bsd_shutdown(s, how);
   internal_socketerror := fpgeterrno;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpShutdown results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 begin
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSocket(' + IntToStr(Domain) + ', ' + IntToStr(xtype) + ', ' + IntToStr(Protocol) + ')...');
+  {$ENDIF}
   if Assigned(SocketBase) then
   begin
-    fpsocket := bsd_socket(domain, xtype, protocol);
+    Result := bsd_socket(domain, xtype, protocol);
     internal_socketerror := fpgeterrno;
   end
   else
   begin
-    fpsocket := -1;
+    Result := -1;
     internal_socketerror := ESockEPROTONOSUPPORT;
   end;
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSocket results in ' + IntToStr(Result) + ' with error code ' + IntToStr(internal_socketerror));
+  {$ENDIF}
 end;
 
 
 function fpsocketpair(d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
 begin
+  {$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: fpSocketPair(' + IntToStr(d) + ', ' + IntToStr(xtype) + ', ' + IntToStr(Protocol) + ', ' + HexStr(sv) + ')...');
+  {$ENDIF}
 {
   fpsocketpair:=cfpsocketpair(d,xtype,protocol,sv);
   internal_socketerror:=fpgeterrno;