--- Merging r30991 into '.':

U    rtl/morphos/system.pp
U    rtl/amicommon/sysosh.inc
U    rtl/amicommon/sysos.inc
U    rtl/amiga/system.pp
--- Recording mergeinfo for merge of r30991 into '.':
 U   .
--- Merging r30992 into '.':
U    rtl/amicommon/athreads.pp
--- Recording mergeinfo for merge of r30992 into '.':
 G   .
--- Merging r30993 into '.':
U    packages/rtl-extra/src/amiga/sockets.pp
D    packages/rtl-extra/src/morphos
U    packages/rtl-extra/fpmake.pp
--- Recording mergeinfo for merge of r30993 into '.':
 G   .
--- Merging r30994 into '.':
G    packages/rtl-extra/src/amiga/sockets.pp
--- Recording mergeinfo for merge of r30994 into '.':
 G   .
--- Merging r30995 into '.':
U    packages/morphunits/src/utility.pas
--- Recording mergeinfo for merge of r30995 into '.':
 G   .
--- Merging r30996 into '.':
U    packages/morphunits/src/exec.pas
--- Recording mergeinfo for merge of r30996 into '.':
 G   .
--- Merging r30997 into '.':
U    packages/morphunits/src/amigalib.pas
--- Recording mergeinfo for merge of r30997 into '.':
 G   .
--- Merging r30998 into '.':
U    packages/amunits/src/coreunits/exec.pas
--- Recording mergeinfo for merge of r30998 into '.':
 G   .
--- Merging r30999 into '.':
G    packages/morphunits/src/amigalib.pas
--- Recording mergeinfo for merge of r30999 into '.':
 G   .
--- Merging r31000 into '.':
G    packages/morphunits/src/exec.pas
--- Recording mergeinfo for merge of r31000 into '.':
 G   .
--- Merging r31001 into '.':
U    packages/amunits/src/coreunits/amigalib.pas
--- Recording mergeinfo for merge of r31001 into '.':
 G   .
--- Merging r31005 into '.':
U    utils/fpcres/fpmake.pp
--- Recording mergeinfo for merge of r31005 into '.':
 G   .

# revisions: 30991,30992,30993,30994,30995,30996,30997,30998,30999,31000,31001,31005

git-svn-id: branches/fixes_3_0@31097 -

.gitattributes

@@ -6714,7 +6714,6 @@ packages/rtl-extra/src/linux/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/linux/unixsockets.inc svneol=native#text/plain
 packages/rtl-extra/src/linux/unixsocketsh.inc svneol=native#text/plain
 packages/rtl-extra/src/linux/unxsockh.inc svneol=native#text/plain
-packages/rtl-extra/src/morphos/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/msdos/printer.pp svneol=native#text/plain
 packages/rtl-extra/src/netbsd/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/netbsd/unxsockh.inc svneol=native#text/plain

packages/amunits/src/coreunits/amigalib.pas

@@ -100,6 +100,8 @@ function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
 function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
 function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong;
 
+procedure HookEntry;
+
 {
 
    NAME
@@ -391,6 +393,19 @@ begin
     SetSuperAttrsA := DoSuperMethodA(cl, obj, @arr);
 end;
 
+{ Do *NOT* change this to nostackframe! }
+{ The compiler will build a stackframe with link/unlk. So that will actually correct
+  the stackpointer for both Pascal/StdCall and cdecl functions, so the stackpointer will
+  be correct on exit. It also needs no manual RTS. The argument push order is also
+  correct for both. (KB) }
+procedure HookEntry; assembler; 
+asm
+  move.l a1,-(a7)    // Msg
+  move.l a2,-(a7)    // Obj
+  move.l a0,-(a7)    // PHook
+  move.l 12(a0),a0   // h_SubEntry = Offset 12
+  jsr (a0)           // Call the SubEntry
+end;
 
 procedure printf(Fmtstr : pchar; const Args : array of const);
 var

packages/amunits/src/coreunits/exec.pas

@@ -110,7 +110,6 @@ TYPE
        PULONG   = ^longword;
        PAPTR    = ^APTR;
        PLONG    = ^LONG;
-       psmallint = ^smallint;
 
 const
        {There is a problem with boolean

packages/morphunits/src/amigalib.pas

@@ -33,9 +33,11 @@ function DoSuperNew(class_: pointer; obj: pointer; tags: array of LongWord): lon
 // This procedure is used to pop dispatcher args from emulstruc
 procedure DISPATCHERARG(var cl; var obj; var msg); assembler;
 
+function HookEntry: longword;
+
 implementation
 
-uses intuition;
+uses exec, intuition, utility;
 
 function DoMethodA(obj : longword; msg1 : Pointer): longword; assembler;
 asm
@@ -111,4 +113,15 @@ asm
   stw r6,(r5)   // msg
 end;
 
+type
+  THookSubEntryFunc = function(a, b, c: Pointer): longword;
+
+function HookEntry: longword;
+var
+  hook: PHook;
+begin
+  hook:=REG_A0;
+  HookEntry:=THookSubEntryFunc(hook^.h_SubEntry)(hook, REG_A2, REG_A1);
+end;
+
 end.

packages/morphunits/src/exec.pas

@@ -23,8 +23,30 @@ interface
 var
   ExecBase: Pointer;
 
-{.$include execd.inc}
-{.$include execf.inc}
+
+{ Some types for classic Amiga and AROS compatibility }
+type
+  STRPTR    = PChar;
+  ULONG     = Longword;
+  LONG      = Longint;
+  APTR      = Pointer;
+  BPTR      = Longint;
+  BSTR      = Longint;
+  BOOL      = Smallint; { I think this could be changed to WordBool (KB) }
+  UWORD     = Word;
+  WORDBITS  = Word;
+  LONGBITS  = Longword;
+  PLONGBITS = ^LONGBITS;
+  UBYTE     = Byte;
+  PULONG    = ^Longword;
+  PAPTR     = ^APTR;
+  PLONG     = ^LONG;
+
+{ Some constants for classic Amiga and AROS compatibility }
+const
+  LTrue  : Longint = 1;
+  LFalse : Longint = 0;
+
 
 { * emulinterface consts from MorphOS SDK * }
 
@@ -66,6 +88,26 @@ type
     Func     : Pointer;
   end;
 
+function REG_D0: DWord;
+function REG_D1: DWord;
+function REG_D2: DWord;
+function REG_D3: DWord;
+function REG_D4: DWord;
+function REG_D5: DWord;
+function REG_D6: DWord;
+function REG_D7: DWord;
+
+function REG_A0: Pointer;
+function REG_A1: Pointer;
+function REG_A2: Pointer;
+function REG_A3: Pointer;
+function REG_A4: Pointer;
+function REG_A5: Pointer;
+function REG_A6: Pointer;
+function REG_A7: Pointer;
+
+function REG_PC: Pointer;
+function REG_SR: DWord;
 
 { * "dummy" definitions from utility, which we can't include here because it
   *  would create a circular dependency (KB) }
@@ -2372,6 +2414,98 @@ begin
 end;
 
 
+function REG_D0: DWord; assembler; nostackframe;
+asm
+  lwz r3,0(r2)
+end;
+
+function REG_D1: DWord; assembler; nostackframe;
+asm
+  lwz r3,4(r2)
+end;
+
+function REG_D2: DWord; assembler; nostackframe;
+asm
+  lwz r3,8(r2)
+end;
+
+function REG_D3: DWord; assembler; nostackframe;
+asm
+  lwz r3,12(r2)
+end;
+
+function REG_D4: DWord; assembler; nostackframe;
+asm
+  lwz r3,16(r2)
+end;
+
+function REG_D5: DWord; assembler; nostackframe;
+asm
+  lwz r3,20(r2)
+end;
+
+function REG_D6: DWord; assembler; nostackframe;
+asm
+  lwz r3,24(r2)
+end;
+
+function REG_D7: DWord; assembler; nostackframe;
+asm
+  lwz r3,28(r2)
+end;
+
+
+function REG_A0: Pointer; assembler; nostackframe;
+asm
+  lwz r3,32(r2) 
+end;
+
+function REG_A1: Pointer; assembler; nostackframe;
+asm
+  lwz r3,36(r2) 
+end;
+function REG_A2: Pointer; assembler; nostackframe;
+asm
+  lwz r3,40(r2) 
+end;
+
+function REG_A3: Pointer; assembler; nostackframe;
+asm
+  lwz r3,44(r2) 
+end;
+
+function REG_A4: Pointer; assembler; nostackframe;
+asm
+  lwz r3,48(r2) 
+end;
+
+function REG_A5: Pointer; assembler; nostackframe;
+asm
+  lwz r3,52(r2) 
+end;
+
+function REG_A6: Pointer; assembler; nostackframe;
+asm
+  lwz r3,56(r2) 
+end;
+
+function REG_A7: Pointer; assembler; nostackframe;
+asm
+  lwz r3,60(r2) 
+end;
+
+
+function REG_PC: Pointer; assembler; nostackframe;
+asm
+  lwz r3,64(r2)
+end;
+
+function REG_SR: DWord; assembler; nostackframe;
+asm
+  lwz r3,68(r2)
+end;
+
+
 begin
   ExecBase:=MOS_ExecBase;
 end.

packages/morphunits/src/utility.pas

@@ -188,8 +188,8 @@ type
   PHook = ^THook;
   THook = packed record
     h_MinNode : TMinNode;
-    h_Entry   : Cardinal;
-    h_SubEntry: Cardinal;
+    h_Entry   : Pointer;
+    h_SubEntry: Pointer;
     h_Data    : Pointer;
   end;
 

packages/rtl-extra/fpmake.pp

@@ -67,6 +67,7 @@ begin
     // unit from that directory. Maybe we should try to merge the WinSock(2)
     // units to remove the wince directory completely...
     P.SourcePath.Add('src/win',[win32,win64,wince]);
+    P.SourcePath.Add('src/amiga',[morphos]);
 
     P.IncludePath.Add('src/bsd',AllBSDOSes);
     P.IncludePath.Add('src/inc');

packages/rtl-extra/src/amiga/sockets.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2007 by the Free Pascal development team
+    Copyright (c) 1999-2015 by the Free Pascal development team
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -11,6 +11,7 @@
 
  **********************************************************************}
 {$PACKRECORDS 2}
+{.$DEFINE SOCKETS_DEBUG}
 unit Sockets;
 Interface
 
@@ -109,7 +110,7 @@ Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
 //function  fpbind      (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;  maybelibc
 //function  fpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;  maybelibc
 
-var
+threadvar
   SocketBase: PLibrary;
 
 function bsd_socket(Domain: LongInt location 'd0'; Type_: LongInt location 'd1'; Protocol: LongInt location 'd2'): LongInt; syscall SocketBase 30;
@@ -133,6 +134,15 @@ function bsd_inet_addr(const cp: PChar location 'a0'): LongWord; syscall SocketB
 function bsd_gethostbyname(const Name: PChar location 'a0'): PHostEnt; syscall SocketBase 210;
 function bsd_gethostbyaddr(const Addr: PByte location 'a0'; Len: LongInt location 'd0'; Type_: LongInt location 'd1'): PHostEnt; syscall SocketBase 216;
 
+{ Definition for Release(CopyOf)Socket unique id }
+const
+  UNIQUE_ID = -1;
+
+{ Amiga-specific functions for passing socket descriptors between threads (processes) }
+function ObtainSocket(id: LongInt location 'd0'; domain: LongInt location 'd1'; _type: LongInt location 'd2'; protocol: LongInt location 'd3'): LongInt; syscall SocketBase 144;
+function ReleaseSocket(s: LongInt location 'd0'; id: LongInt location 'd1'): LongInt; syscall SocketBase 150;
+function ReleaseCopyOfSocket(s: LongInt location 'd0'; id: LongInt location 'd1'): LongInt; syscall SocketBase 156;
+
 Implementation
 
 threadvar internal_socketerror: cint;
@@ -258,14 +268,37 @@ end;
 {$i sockovl.inc}
 {$i sockets.inc}
 
-// FIXME: this doesn't make any sense here, because SocketBase should be task-specific
-// but FPC doesn't support that yet (TODO)
-{$WARNING FIX ME, TODO}
+const
+  BSDSOCKET_LIBRARY_VER = 4;
+
+procedure BSDSocketOpen;
+begin
+{$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: Opening bsdsocket.library...');
+{$ENDIF}
+  SocketBase:=OpenLibrary('bsdsocket.library', BSDSOCKET_LIBRARY_VER);
+{$IFDEF SOCKETS_DEBUG}
+  if SocketBase = nil then
+    SysDebugLn('FPC Sockets: FAILED to open bsdsocket.library.')
+  else
+    SysDebugLn('FPC Sockets: bsdsocket.library opened successfully.');
+{$ENDIF}
+end;
 
+procedure BSDSocketClose;
+begin
+  if (SocketBase<>NIL) then CloseLibrary(SocketBase);
+  SocketBase:=NIL;
+{$IFDEF SOCKETS_DEBUG}
+  SysDebugLn('FPC Sockets: bsdsocket.library closed.');
+{$ENDIF}
+end;
 
 initialization
-  SocketBase := OpenLibrary('bsdsocket.library',0);
+  AddThreadInitProc(@BSDSocketOpen);
+  AddThreadExitProc(@BSDSocketClose);
+  BSDSocketOpen;
+
 finalization
-  if SocketBase <> nil then
-    CloseLibrary(SocketBase);
+  BSDSocketClose;
 end.

packages/rtl-extra/src/morphos/sockets.pp

@@ -1,309 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2007 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{$PACKRECORDS 2}
-unit Sockets;
-Interface
-
-Uses ctypes,exec;
-
-type
-    size_t   = cuint32;         { as definied in the C standard}
-    ssize_t  = cint32;          { used by function for returning number of bytes}
-
-    socklen_t= cuint32;
-    TSocklen = socklen_t;
-    pSocklen = ^socklen_t;
-
-
-//{ $i unxsockh.inc}
-{$define BSD}
-{$define SOCK_HAS_SINLEN}
-{$i socketsh.inc}
-
-type
-  TUnixSockAddr = packed Record
-                  sa_len     : cuchar;
-                  family       : sa_family_t;
-                  path:array[0..107] of char;    //104 total for freebsd.
-                  end;
-
-type
-  hostent = record
-    h_name     : PChar;
-    h_aliases  : PPChar;
-    h_addrtype : LongInt;
-    h_Length   : LongInt;
-    h_addr_list: ^PDWord;
-  end;
-  THostEnt = hostent;
-  PHostEnt = ^THostEnt;
-
-
-const
-  AF_UNSPEC      = 0;               {* unspecified *}
-  AF_LOCAL       = 1;               {* local to host (pipes, portals) *}
-  AF_UNIX        = AF_LOCAL;        {* backward compatibility *}
-  AF_INET        = 2;               {* internetwork: UDP, TCP, etc. *}
-  AF_IMPLINK     = 3;               {* arpanet imp addresses *}
-  AF_PUP         = 4;               {* pup protocols: e.g. BSP *}
-  AF_CHAOS       = 5;               {* mit CHAOS protocols *}
-  AF_NS          = 6;               {* XEROX NS protocols *}
-  AF_ISO         = 7;               {* ISO protocols *}
-  AF_OSI         = AF_ISO;
-  AF_ECMA        = 8;               {* european computer manufacturers *}
-  AF_DATAKIT     = 9;               {* datakit protocols *}
-  AF_CCITT       = 10;              {* CCITT protocols, X.25 etc *}
-  AF_SNA         = 11;              {* IBM SNA *}
-  AF_DECnet      = 12;              {* DECnet *}
-  AF_DLI         = 13;              {* DEC Direct data link interface *}
-  AF_LAT         = 14;              {* LAT *}
-  AF_HYLINK      = 15;              {* NSC Hyperchannel *}
-  AF_APPLETALK   = 16;              {* Apple Talk *}
-  AF_ROUTE       = 17;              {* Internal Routing Protocol *}
-  AF_LINK        = 18;              {* Link layer interface *}
-  pseudo_AF_XTP  = 19;              {* eXpress Transfer Protocol (no AF) *}
-  AF_COIP        = 20;              {* connection-oriented IP, aka ST II *}
-  AF_CNT         = 21;              {* Computer Network Technology *}
-  pseudo_AF_RTIP = 22;              {* Help Identify RTIP packets *}
-  AF_IPX         = 23;              {* Novell Internet Protocol *}
-  AF_SIP         = 24;              {* Simple Internet Protocol *}
-  pseudo_AF_PIP  = 25;              {* Help Identify PIP packets *}
-
-  AF_MAX         = 26;
-  SO_LINGER     = $0080;
-  SOL_SOCKET    = $FFFF;
-
-const
-  EsockEINTR            = 4; // EsysEINTR;   
-  EsockEBADF            = 9; // EsysEBADF;
-  EsockEFAULT           = 14; // EsysEFAULT;
-  EsockEINVAL           = 22; //EsysEINVAL;
-  EsockEACCESS          = 13; //ESysEAcces;
-  EsockEMFILE           = 24; //ESysEmfile;
-  EsockENOBUFS          = 55; //ESysENoBufs;
-  EsockENOTCONN         = 57; //ESysENotConn;
-  EsockEPROTONOSUPPORT  = 43; //ESysEProtoNoSupport;
-  EsockEWOULDBLOCK      = 35; //ESysEWouldBlock; // same as eagain on morphos
-
-{ unix socket specific functions }
-{*
-Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint); deprecated;
-Function Bind(Sock:longint;const addr:string):boolean; deprecated;
-Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean; deprecated;
-Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean; deprecated;
-Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;    deprecated;
-Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;    deprecated;
-*}
-//function  fpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint; maybelibc
-//function  fpbind      (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;  maybelibc
-//function  fpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;  maybelibc
-
-var SocketBase : pLibrary;
-
-function bsd_socket(domain : LongInt location 'd0'; type_ : LongInt location 'd1'; protocol : LongInt location 'd2') : LongInt; syscall legacy SocketBase 030;
-function bsd_bind(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 036;
-function bsd_listen(s : LongInt location 'd0'; backlog : LongInt location 'd1') : LongInt; syscall legacy SocketBase 042;
-function bsd_accept(s : LongInt location 'd0'; addr : psockaddr location 'a0'; var addrlen : LongInt location 'a1') : LongInt; syscall legacy SocketBase 048;
-function bsd_connect(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 054;
-function bsd_sendto(s : LongInt location 'd0'; const msg : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2'; const to_ : psockaddr location 'a1'; tolen : LongInt location 'd3') : LongInt; syscall legacy SocketBase 060;
-function bsd_send(s : LongInt location 'd0'; const msg : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 066;
-function bsd_recvfrom(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2'; from : psockaddr location 'a1'; var fromlen : LongInt location 'a2') : LongInt; syscall legacy SocketBase 072;
-function bsd_recv(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 078;
-function bsd_shutdown(s : LongInt location 'd0'; how : LongInt location 'd1') : LongInt; syscall legacy SocketBase 084;
-function bsd_closesocket(d : LongInt location 'd0') : LongInt; syscall legacy SocketBase 120;
-function bsd_Errno: LongInt; syscall SocketBase 162;
-function bsd_inet_ntoa(in_ : DWord location 'd0') : pChar; syscall legacy SocketBase 174;
-function bsd_inet_addr(const cp : pChar location 'a0') : DWord; syscall legacy SocketBase 180;
-function bsd_gethostbyname(const name : pChar location 'a0') : phostent; syscall legacy SocketBase 210;
-function bsd_gethostbyaddr(const addr : pChar location 'a0'; len : LongInt location 'd0'; type_ : LongInt location 'd1') : phostent; syscall legacy SocketBase 216;
-
-Implementation
-
-//Uses {$ifndef FPC_USE_LIBC}SysCall{$else}initc{$endif};
-
-threadvar internal_socketerror : cint;
-
-{******************************************************************************
-                          Kernel Socket Callings
-******************************************************************************}
-
-function socketerror:cint;
-
-begin
-  socketerror:=internal_socketerror;
-end;
-
-//{$define uselibc:=cdecl; external;}
-
-//const libname='c';
-{
-function cfpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint; cdecl; external libname name 'accept';
-function cfpbind        (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;  cdecl; external libname name 'bind';
-function cfpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;  cdecl; external libname name 'connect';
-function cfpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint; cdecl; external libname name 'getpeername';
-function cfpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint; cdecl; external libname name 'getsockname';
-function cfpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint; cdecl; external libname name 'getsockopt';
-function cfplisten      (s:cint; backlog : cint):cint;                          cdecl; external libname name 'listen';
-function cfprecv        (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t; cdecl; external libname name 'recv';
-function cfprecvfrom    (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t; cdecl; external libname name 'recvfrom';
-//function cfprecvmsg     (s:cint; msg: pmsghdr; flags:cint):ssize_t; cdecl; external libname name '';
-function cfpsend        (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t; cdecl; external libname name 'send';
-function cfpsendto      (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t; cdecl; external libname name 'sendto';
-//function cfpsendmsg   (s:cint; hdr: pmsghdr; flags:cint):ssize; cdecl; external libname name '';
-function cfpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint; cdecl; external libname name 'setsockopt';
-function cfpshutdown    (s:cint; how:cint):cint; cdecl; external libname name 'shutdown';
-function cfpsocket      (domain:cint; xtype:cint; protocol: cint):cint; cdecl; external libname name 'socket';
-function cfpsocketpair  (d:cint; xtype:cint; protocol:cint; sv:pcint):cint; cdecl; external libname name 'socketpair';
-}
-
-function cfpaccept(s : LongInt location 'd0'; addr : psockaddr location 'a0';  addrlen : pSocklen location 'a1') : LongInt; syscall legacy SocketBase 048;
-function cfpbind(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 036;
-function cfpconnect(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 054;
-function cfpsendto(s : LongInt location 'd0'; const msg : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2'; const to_ : psockaddr location 'a1'; tolen : LongInt location 'd3') : LongInt; syscall legacy SocketBase 060;
-function cfpsend(s : LongInt location 'd0'; const msg : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 066;
-function cfprecvfrom(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2'; from : psockaddr location 'a1'; fromlen : pSockLen location 'a2') : LongInt; syscall legacy SocketBase 072;
-function cfprecv(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 078;
-function cfpgetsockopt(s : LongInt location 'd0'; level : LongInt location 'd1'; optname : LongInt location 'd2'; optval : Pointer location 'a0'; optlen : pSockLen location 'a1') : LongInt; syscall legacy SocketBase 096;
-function cfpgetsockname(s : LongInt location 'd0'; hostname : psockaddr location 'a0'; namelen : pSockLen location 'a1') : LongInt; syscall legacy SocketBase 102;
-function cfpgetpeername(s : LongInt location 'd0'; hostname : psockaddr location 'a0'; namelen : pSockLen location 'a1') : LongInt; syscall legacy SocketBase 108;
-function cfpsetsockopt(s : LongInt location 'd0'; level : LongInt location 'd1'; optname : LongInt location 'd2'; const optval : Pointer location 'a0'; optlen : LongInt location 'd3') : LongInt; syscall legacy SocketBase 090;
-function cfplisten(s : LongInt location 'd0'; backlog : LongInt location 'd1') : LongInt; syscall legacy SocketBase 042;
-function cfpsocket(domain : LongInt location 'd0'; type_ : LongInt location 'd1'; protocol : LongInt location 'd2') : LongInt; syscall legacy SocketBase 030;
-function cfpshutdown(s : LongInt location 'd0'; how : LongInt location 'd1') : LongInt; syscall legacy SocketBase 084;
-function cfpCloseSocket(d : LongInt location 'd0') : LongInt; syscall legacy SocketBase 120;
-
-function cfpErrno : LongInt; syscall legacy SocketBase 162;
-
-function fpgeterrno: longint; inline;
-begin
-  fpgeterrno:=cfpErrno;
-end;
-
-function fpClose(d: LongInt): LongInt; inline;
-begin
-  fpClose:=cfpCloseSocket(d);
-end;
-
-function fpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
-
-begin
- fpaccept:=cfpaccept(s,addrx,addrlen);
- internal_socketerror:=fpgeterrno; 
-end;
-
-function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
-begin
-  fpbind:=cfpbind (s,addrx,addrlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;
-begin
-  fpconnect:=cfpconnect (s,name,namelen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpgetpeername:=cfpgetpeername (s,name,namelen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpgetsockname:=cfpgetsockname(s,name,namelen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
-begin
-  fpgetsockopt:=cfpgetsockopt(s,level,optname,optval,optlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fplisten      (s:cint; backlog : cint):cint;
-begin
-  fplisten:=cfplisten(s,backlog);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fprecv         (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
-begin
-  fprecv:= cfprecv      (s,buf,len,flags);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fprecvfrom    (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
-begin
-  fprecvfrom:= cfprecvfrom (s,buf,len,flags,from,fromlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpsend         (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
-begin
-  fpsend:=cfpsend (s,msg,len,flags);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpsendto       (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
-begin
-  fpsendto:=cfpsendto (s,msg,len,flags,tox,tolen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
-begin
-  fpsetsockopt:=cfpsetsockopt(s,level,optname,optval,optlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpshutdown     (s:cint; how:cint):cint;
-begin
-  fpshutdown:=cfpshutdown(s,how);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function fpsocket       (domain:cint; xtype:cint; protocol: cint):cint;
-begin
-  fpsocket:=cfpsocket(domain,xtype,protocol);
-  internal_socketerror:=fpgeterrno;
-end;
-
-
-function fpsocketpair  (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
-begin
-{
-  fpsocketpair:=cfpsocketpair(d,xtype,protocol,sv);
-  internal_socketerror:=fpgeterrno;
-}
-  fpsocketpair:=-1;
-end;
-
-
-{$i sockovl.inc}
-{$i sockets.inc}
-
-// FIXME: this doesn't make any sense here, because SocketBase should be task-specific
-// but FPC doesn't support that yet (TODO)
-{$WARNING FIX ME, TODO}
-
-initialization
-
-  SocketBase:=NIL;
-  SocketBase:=OpenLibrary('bsdsocket.library',4);
-
-finalization
-
-  if (SocketBase<>NIL) then CloseLibrary(SocketBase);
-
-end.

rtl/amicommon/athreads.pp

@@ -460,7 +460,9 @@ begin
   if not exitSuspend then
     begin
       InitThread(threadInfo^.stackLen);
+      DoThreadInitProcChain;
       threadInfo^.exitCode:=Pointer(threadInfo^.f(threadInfo^.p));
+      DoThreadExitProcChain;
       DoneThread;
     end;
 

rtl/amicommon/sysos.inc

@@ -172,3 +172,66 @@ begin
     end;
   end;
 end;
+
+{ Thread Init/Exit Procedure support }
+Type
+  PThreadProcInfo = ^TThreadProcInfo;
+  TThreadProcInfo = Record
+    Next     : PThreadProcInfo;
+    Proc     : TProcedure;
+  End;
+
+const
+  threadInitProcList :PThreadProcInfo = nil;
+  threadExitProcList :PThreadProcInfo = nil;
+
+Procedure DoThreadProcChain(p: PThreadProcInfo);
+Begin
+  while p <> nil do
+    begin
+      p^.proc;
+      p:=p^.next;
+    end;
+End;
+
+Procedure AddThreadProc(var procList: PThreadProcInfo; Proc: TProcedure);
+var
+  P : PThreadProcInfo;
+Begin
+  New(P);
+  P^.Next:=procList;
+  P^.Proc:=Proc;
+  procList:=P;
+End;
+
+Procedure CleanupThreadProcChain(var procList: PThreadProcInfo);
+var
+  P : PThreadProcInfo;
+Begin
+  while procList <> nil do
+    begin
+      p:=procList;
+      procList:=procList^.next;
+      dispose(p);
+    end;
+End;
+
+Procedure AddThreadInitProc(Proc: TProcedure);
+Begin
+  AddThreadProc(threadInitProcList,Proc);
+End;
+
+Procedure AddThreadExitProc(Proc: TProcedure);
+Begin
+  AddThreadProc(threadExitProcList,Proc);
+End;
+
+Procedure DoThreadInitProcChain;
+Begin
+  DoThreadProcChain(threadInitProcList);
+End;
+
+Procedure DoThreadExitProcChain;
+Begin
+  DoThreadProcChain(threadExitProcList);
+End;

rtl/amicommon/sysosh.inc

@@ -39,3 +39,9 @@ type
 const
   CREATE_SUSPENDED = 1;
   STACK_SIZE_PARAM_IS_A_RESERVATION = 2;
+
+{ Thread Init/Exit Procedure support }
+Procedure AddThreadInitProc(Proc: TProcedure);
+Procedure AddThreadExitProc(Proc: TProcedure);
+Procedure DoThreadInitProcChain;
+Procedure DoThreadExitProcChain;

rtl/amiga/system.pp

@@ -141,6 +141,10 @@ procedure System_exit;
 var
   oldDirLock: LongInt;
 begin
+  { Dispose the thread init/exit chains }
+  CleanupThreadProcChain(threadInitProcList);
+  CleanupThreadProcChain(threadExitProcList);
+
   { We must remove the CTRL-C FLAG here because halt }
   { may call I/O routines, which in turn might call  }
   { halt, so a recursive stack crash                 }

rtl/morphos/system.pp

@@ -99,6 +99,10 @@ procedure System_exit;
 var
   oldDirLock: LongInt;
 begin
+  { Dispose the thread init/exit chains }
+  CleanupThreadProcChain(threadInitProcList);
+  CleanupThreadProcChain(threadExitProcList);
+
   { We must remove the CTRL-C FLAG here because halt }
   { may call I/O routines, which in turn might call  }
   { halt, so a recursive stack crash                 }

utils/fpcres/fpmake.pp

@@ -27,7 +27,7 @@ begin
     P.Directory:=ADirectory;
     P.Version:='3.0.1';
 
-    P.OSes:=[win32,win64,wince,haiku,linux,freebsd,openbsd,netbsd,darwin,iphonesim,solaris,os2,emx,aix,aros];
+    P.OSes:=[win32,win64,wince,haiku,linux,freebsd,openbsd,netbsd,darwin,iphonesim,solaris,os2,emx,aix,aros,amiga,morphos];
 
     P.Dependencies.Add('fcl-res');
     P.Dependencies.Add('paszlib');