* removed get/free video buf from video.pp

* implemented sockets
* basic library support
* threadvar memory leak removed
* fixes (ide now starts and editor is usable)
* support for lineinfo

rtl/netwlibc/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/10]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/19]
 #
 default: all
 MAKEFILETARGETS=netwlibc
@@ -228,8 +228,8 @@ override FPCOPT+=-Ur
 override FPCOPT+=-dMT -dDEBUG_MT
 CREATESMART=0
 OBJPASDIR=$(RTL)/objpas
-override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo systhrds classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconst math varutils freebidi utf8bidi mouse video keyboard
-override TARGET_LOADERS+=nwplibc
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo systhrds classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconst math varutils freebidi utf8bidi mouse video keyboard cmem sockets
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
 override TARGET_RSTS+=math varutils variants convutils typinfo systhrds classes dateutils sysconst rtlconst
 override INSTALL_FPCPACKAGE=y
 override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
@@ -805,7 +805,7 @@ ifndef COPY
 COPY:=$(CPPROG) -fp
 endif
 ifndef COPYTREE
-COPYTREE:=$(CPPROG) -rfp
+COPYTREE:=$(CPPROG) -Rfp
 endif
 ifndef MOVE
 MOVE:=$(MVPROG) -f
@@ -1400,6 +1400,10 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 nwplibc$(OEXT) :
 	cp pre/libcpre.gcc.o nwplibc.o
+nwl_main$(OEXT) : nwl_main.as
+	$(AS) -o nwl_main$(OEXT) nwl_main.as
+nwl_dlle$(OEXT) : nwl_dlle.as
+	$(AS) -o nwl_dlle$(OEXT) nwl_dlle.as
 $(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp libc.pp $(SYSDEPS)
 	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
@@ -1410,8 +1414,8 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(WININC) netware.pp
-winsock2$(PPUEXT) : winsock2.pp qos.inc netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+winsock$(PPUEXT) : winsock.pp ../netware/winsock.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
+sockets$(PPUEXT) : sockets.pp winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
 		   $(INC)/sockets.inc $(INC)/socketsh.inc
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 initc$(PPUEXT) : initc.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
@@ -1435,8 +1439,8 @@ varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
 		    objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
 	$(COMPILER) -I$(OBJPASDIR) varutils.pp
 freebidi$(PPUEXT) : $(OBJPASDIR)/freebidi.pp
-utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp
-	$(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp freebidi.ppu
+utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp freebidi$(PPUEXT)
+	$(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp
 variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT)
 types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/types.pp
@@ -1444,7 +1448,7 @@ rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUE
 	$(COMPILER) $(OBJPASDIR)/rtlconst.pp
 sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/sysconst.pp
-dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp $(OBJPASDIR)/dateutil.inc
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
 convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
@@ -1463,6 +1467,7 @@ ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 mouse$(PPUEXT) : $(INC)/mouseh.inc $(SYSTEMUNIT)$(PPUEXT)
 video$(PPUEXT) : $(INC)/video.inc $(SYSTEMUNIT)$(PPUEXT)
 keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
 callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
 aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
 override INSTALLPPUFILES+=nwsnut.imp ws2_32.imp ws2nlm.imp libc.imp netware.imp \

rtl/netwlibc/Makefile.fpc

@@ -6,7 +6,7 @@
 main=rtl
 
 [target]
-loaders=nwplibc
+loaders=nwplibc nwl_main nwl_dlle
 units=$(SYSTEMUNIT) objpas macpas strings \
       lineinfo winsock heaptrc matrix \
       nwsnut libc dos crt objects sysconst dynlibs \
@@ -15,7 +15,7 @@ units=$(SYSTEMUNIT) objpas macpas strings \
       dateutils strutils convutils \
       charset ucomplex variants \
       rtlconst math varutils freebidi utf8bidi \
-      mouse video keyboard
+      mouse video keyboard cmem sockets
 
 rsts=math varutils variants convutils typinfo systhrds classes dateutils sysconst rtlconst
 
@@ -104,6 +104,12 @@ SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 nwplibc$(OEXT) :
         cp pre/libcpre.gcc.o nwplibc.o
 
+nwl_main$(OEXT) : nwl_main.as
+        $(AS) -o nwl_main$(OEXT) nwl_main.as
+
+nwl_dlle$(OEXT) : nwl_dlle.as
+        $(AS) -o nwl_dlle$(OEXT) nwl_dlle.as
+
 #
 # System Units (System, Objpas, Strings)
 #
@@ -127,9 +133,9 @@ netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(WININC) netware.pp
 
 
-winsock2$(PPUEXT) : winsock2.pp qos.inc netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+winsock$(PPUEXT) : winsock.pp ../netware/winsock.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 
-sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+sockets$(PPUEXT) : sockets.pp winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
                    $(INC)/sockets.inc $(INC)/socketsh.inc
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
@@ -175,8 +181,8 @@ varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
 
 freebidi$(PPUEXT) : $(OBJPASDIR)/freebidi.pp
 
-utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp
-        $(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp freebidi.ppu
+utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp freebidi$(PPUEXT)
+        $(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp
 
 
 variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT)
@@ -190,7 +196,7 @@ rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUE
 sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/sysconst.pp
 
-dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp $(OBJPASDIR)/dateutil.inc
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
 
 convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
@@ -231,6 +237,7 @@ video$(PPUEXT) : $(INC)/video.inc $(SYSTEMUNIT)$(PPUEXT)
 
 keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT)
 
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units

rtl/netwlibc/dos.pp

@@ -283,20 +283,21 @@ begin
       getvolnum := V;
   end else
     getvolnum := drive-1;}
+  getvolnum := -1;
 end;
 
 
 function diskfree(drive : byte) : int64;
-VAR Buf                 : ARRAY [0..255] OF CHAR;
+{VAR Buf                 : ARRAY [0..255] OF CHAR;
     TotalBlocks         : WORD;
     SectorsPerBlock     : WORD;
     availableBlocks     : WORD;
     totalDirectorySlots : WORD;
     availableDirSlots   : WORD;
     volumeisRemovable   : WORD;
-    volumeNumber        : LONGINT;
+    volumeNumber        : LONGINT;}
 begin
-  volumeNumber := getvolnum (drive);
+  // volumeNumber := getvolnum (drive);
   (*
   if volumeNumber >= 0 then
   begin
@@ -821,7 +822,15 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2004-09-12 20:51:22  armin
+  Revision 1.3  2004-09-19 20:06:37  armin
+  * removed get/free video buf from video.pp
+  * implemented sockets
+  * basic library support
+  * threadvar memory leak removed
+  * fixes (ide now starts and editor is usable)
+  * support for lineinfo
+
+  Revision 1.2  2004/09/12 20:51:22  armin
   * added keyboard and video
   * a lot of fixes
 

rtl/netwlibc/libc.pp

@@ -1964,7 +1964,7 @@ type
         nlmrevision      : longint;
         nlmtimer         : time_t;               // module's date and time stamp in UTC
         nlmcommandline   : Pchar;
-        nlmmessagecount  : size_t;
+        nlmmessagecount  : dword;
         nlmmessagetable  : ^Pchar;
         nlmname          : array[0..35] of char;
         nlmloadpath      : array[0..255] of char;
@@ -1979,9 +1979,9 @@ type
         nodename         : array[0..15] of char;
         treename         : array[0..95] of char; // name of NDS tree
         codeoffset       : pointer;
-        codelength       : size_t;
+        codelength       : dword;
         dataoffset       : pointer;
-        datalength       : size_t;
+        datalength       : dword;
         reserved4        : array[0..27] of longint;
      end;
 
@@ -2082,10 +2082,9 @@ type
 
 { data...  }
 
-  var
-     in6addr_any : in6_addr;cvar;external;
-
-     in6addr_loopback : in6_addr;cvar;external;
+//  var
+//     in6addr_any : in6_addr;cvar;external;
+//     in6addr_loopback : in6_addr;cvar;external;
 
 
 function inet_addr(_string:Pchar):dword;cdecl;external libc_nlm name 'inet_addr';
@@ -3570,6 +3569,10 @@ function putstring(_string:Pchar):longint;cdecl;external libc_nlm name 'putstrin
 function screenprintf(_para1:scr_t; _para2:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'screenprintf';
 {$endif}
 function screenprintf(_para1:scr_t; _para2:Pchar):longint;cdecl;external libc_nlm name 'screenprintf';
+function screenprintfL1(_para1:scr_t; _para2:Pchar; l1:longint):longint;cdecl;external libc_nlm name 'screenprintf';
+function screenprintfL2(_para1:scr_t; _para2:Pchar; l1,l2:longint):longint;cdecl;external libc_nlm name 'screenprintf';
+function screenprintfL3(_para1:scr_t; _para2:Pchar; l1,l2,l3:longint):longint;cdecl;external libc_nlm name 'screenprintf';
+
 function setscreenmode(mode:dword):longint;cdecl;external libc_nlm name 'setscreenmode';
 
 function renamescreen(name:Pchar):longint;cdecl;external libc_nlm name 'renamescreen';
@@ -5612,22 +5615,19 @@ function NXCondTimedWait(cond:PNXCond_t; mutex:PNXMutex_t; interval:dword):longi
 
 //  assert.h
 
-procedure _assert(_para1:Pchar; _para2:Pchar; _para3:Pchar; _para4:longint);cdecl;external libc_nlm name '_assert';
-{ modifications to behavior of assert()        }
-{ assert() prints but returns -1               }
-{ (value returned for no assertion)            }
-{ assert() aborts (normal, default action)     }
-{ assert() prints and drops into the debugger  }
+procedure _assert(_para1,_para2, _para3:Pchar; ActionCode:longint);cdecl;external libc_nlm name '_assert';
+procedure FpAssert(_para1,_para2, _para3:Pchar; ActionCode:longint);cdecl;external libc_nlm name '_assert';
+
 type
-   action_code =  Longint;
-Const
-  __IGNORE = -(1);
-  __NOERR = 0;
-  __ABORT = 1;
-  __DEBUGGER = 2;
+   Taction_code =  Longint;
+Const                         // modifications to behavior of assert()
+  __IGNORE = -(1);            // assert() prints but returns -1
+  __NOERR = 0;                // (value returned for no assertion)
+  __ABORT = 1;                // assert() aborts (normal, default action)
+  __DEBUGGER = 2;             // assert() prints and drops into the debugger
 
-function assert_action(_para1:action_code):longint;cdecl;external libc_nlm name 'assert_action';
-function _assert_expr(_para1:longint; _para2:Pchar; _para3:Pchar; _para4:Pchar; _para5:longint):longint;cdecl;external libc_nlm name '_assert_expr';
+function assert_action(_para1:Taction_code):longint;cdecl;external libc_nlm name 'assert_action';
+function _assert_expr(_para1:longint; _para2,_para3,_para4:Pchar; _para5:longint):longint;cdecl;external libc_nlm name '_assert_expr';
 
 // nks/unix.h
 
@@ -5856,8 +5856,7 @@ function send_ncp(session:longint; requestCode:longint; sendFragCount:longint; s
 
 
 // ctype.h
-  var
-     __ctype : array of byte;cvar;external;
+//  var __ctype : array of byte;cvar;external;
 { standard prototypes...  }
 
 function isalnum(_para1:longint):longint;cdecl;external libc_nlm name 'isalnum';
@@ -7584,11 +7583,11 @@ type
      end;
 
 (** unsupported pragma#pragma pack()*)
-{const }  var
-     ___nan_float : double;cvar;external;
-{const }     ___huge_float : double;cvar;external;
-{const }     ___huge_double : double;cvar;external;
-{const }     ___huge_long_double : double;cvar;external;
+//var
+//  ___nan_float : double;cvar;external;
+//  ___huge_float : double;cvar;external;
+//  ___huge_double : double;cvar;external;
+//  ___huge_long_double : double;cvar;external;
 
 function acos(_para1:double):double;cdecl;external libc_nlm name 'acos';
 function asin(_para1:double):double;cdecl;external libc_nlm name 'asin';
@@ -9052,8 +9051,7 @@ type
    Putf8_t = ^utf8_t;
    utf8_t = byte;
    PPutf8_t = ^Putf8_t;
-  var
-     __utf8width : array of byte;cvar;external;
+// var __utf8width : array of byte;cvar;external;
 { prototypes...  }
 
 

rtl/netwlibc/sockets.pp

@@ -0,0 +1,404 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2004 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.
+
+ **********************************************************************}
+{$mode objfpc}
+unit Sockets;
+
+Interface
+
+{$macro on}
+{$define maybelibc:=}
+
+{$R-}
+
+Uses
+  winsock;
+
+Type
+  cushort=word;
+  cuint16=word;
+  cuint32=cardinal;
+  size_t =cuint32;
+  ssize_t=cuint16;
+  cint   =longint;
+  pcint  =^cint;
+  tsocklen=cint;
+  psocklen=^tsocklen;
+
+
+  Const
+     AF_MAX          = WinSock.AF_MAX;
+     PF_MAX          = AF_MAX;
+
+{$i socketsh.inc}
+
+Implementation
+
+{ Include filerec and textrec structures }
+{$i filerec.inc}
+{$i textrec.inc}
+
+{******************************************************************************
+                          Basic Socket Functions
+******************************************************************************}
+
+
+
+//function fprecvmsg     (s:cint; msg: pmsghdr; flags:cint):ssize_t;
+//function fpsendmsg 	(s:cint; hdr: pmsghdr; flags:cint):ssize;
+
+//function fpsocket 	(domain:cint; xtype:cint; protocol: cint):cint;
+
+
+function fpsocket 	(domain:cint; xtype:cint; protocol: cint):cint;
+begin
+  fpSocket:=WinSock.Socket(Domain,xtype,ProtoCol);
+  if fpSocket<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+  fpSend:=WinSock.Send(S,msg,len,flags);
+  if fpSend<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+  // Dubious construct, this should be checked. (IPV6 fails ?)
+  fpSendTo:=WinSock.SendTo(S,msg,Len,Flags,Winsock.TSockAddr(tox^),toLen);
+  if fpSendTo<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fprecv 	(s:cint; buf: pointer; len: size_t; flags: cint):ssize_t;
+begin
+  fpRecv:=WinSock.Recv(S,Buf,Len,Flags);
+  if fpRecv<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fprecvfrom    (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+
+begin
+fpRecvFrom:=WinSock.RecvFrom(S,Buf,Len,Flags,Winsock.TSockAddr(from^),FromLen^);
+  if fpRecvFrom<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;
+
+begin
+  fpConnect:=WinSock.Connect(S,WinSock.TSockAddr(name^),nameLen);
+  if fpConnect<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpshutdown 	(s:cint; how:cint):cint;
+begin
+  fpShutDown:=WinSock.ShutDown(S,How);
+  if fpShutDown<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+  socket:=fpsocket(Domain,sockettype,protocol);
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+
+begin
+  send:=fpsend(sock,@buf,buflen,flags);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+
+begin
+  sendto:=fpsendto(sock,@buf,buflen,flags,@addr,addrlen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+  Recv:=fpRecv(Sock,@Buf,BufLen,Flags);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; var AddrLen : longint) : longint;
+begin
+  RecvFrom:=fpRecvFrom(Sock,@Buf,BufLen,Flags,@Addr,@AddrLen);
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+
+begin
+  fpbind:=WinSock.Bind(S,WinSock.PSockAddr(Addrx),AddrLen);
+  if fpbind<0 then
+       SocketError:=WSAGetLastError
+  else
+       SocketError:=0;
+end;
+
+function fplisten      (s:cint; backlog : cint):cint;
+
+begin
+  fplisten:=WinSock.Listen(S,backlog);
+  if fplisten<0 then
+       SocketError:=WSAGetLastError
+  else
+       SocketError:=0;
+end;
+
+function fpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+  fpAccept:=WinSock.Accept(S,WinSock.PSockAddr(Addrx),plongint(AddrLen));
+  if fpAccept<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
+
+begin
+  fpGetSockName:=WinSock.GetSockName(S,WinSock.TSockAddr(name^),nameLen^);
+  if fpGetSockName<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpGetPeerName:=WinSock.GetPeerName(S,WinSock.TSockAddr(name^),NameLen^);
+  if fpGetPeerName<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+  fpGetSockOpt:=WinSock.GetSockOpt(S,Level,OptName,OptVal,OptLen^);
+  if fpGetSockOpt<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
+
+begin
+  fpSetSockOpt:=WinSock.SetSockOpt(S,Level,OptName,OptVal,OptLen);
+  if fpSetSockOpt<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+function fpsocketpair  (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+  fpSocketPair := -1;
+end;
+
+Function CloseSocket(Sock:Longint):Longint;
+var i : longint;
+begin
+  i := Winsock.CloseSocket (Sock);
+  if i <> 0 then
+  begin
+    SocketError:=WSAGetLastError;
+    CloseSocket := i;
+  end else
+  begin
+    CloseSocket := 0;
+    SocketError := 0;	
+  end;
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+
+begin
+  bind:=fpBind(Sock,@Addr,AddrLen)=0;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+
+begin
+  Listen:=fplisten(Sock,MaxConnect)=0;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+
+begin
+  Accept:=FPAccept(sock,@addr,@addrlen);
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+
+begin
+ shutdown:=fpshutdown(sock,how);
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):Boolean;
+
+begin
+ connect:=fpconnect(sock,@addr,addrlen)=0;
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=fpGetSockName(sock,@addr,@addrlen);
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=fpGetPeerName(Sock,@addr,@addrlen);
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=fpGetSockOpt(sock,level,optname,@optval,@optlen);
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+
+begin
+ SetSocketOptions:=fpsetsockopt(sock,level,optname,@optval,optlen);
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+  // SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+  SocketPair := -1;
+end;
+
+
+{$ifdef unix}
+{ mimic the linux fpWrite/fpRead calls for the file/text socket wrapper }
+function fpWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+  fpWrite := dword(WinSock.send(handle, bufptr, size, 0));
+  if fpWrite = dword(SOCKET_ERROR) then
+  begin
+    SocketError := WSAGetLastError;
+    fpWrite := 0;
+  end
+  else
+    SocketError := 0;
+end;
+
+function fpRead(handle : longint;var bufptr;size : dword) : dword;
+  var
+     d : dword;
+
+  begin
+     if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+       begin
+         SocketError:=WSAGetLastError;
+         fpRead:=0;
+         exit;
+       end;
+     if d>0 then
+       begin
+         if size>d then
+           size:=d;
+         fpRead := dword(WinSock.recv(handle, bufptr, size, 0));
+         if fpRead = dword(SOCKET_ERROR) then
+         begin
+           SocketError:= WSAGetLastError;
+           fpRead := 0;
+         end else
+           SocketError:=0;
+       end
+     else
+       SocketError:=0;
+  end;
+{$else}
+{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
+function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+  fdWrite := dword(WinSock.send(handle, bufptr, size, 0));
+  if fdWrite = dword(SOCKET_ERROR) then
+  begin
+    SocketError := WSAGetLastError;
+    fdWrite := 0;
+  end
+  else
+    SocketError := 0;
+end;
+
+function fdRead(handle : longint;var bufptr;size : dword) : dword;
+  var
+     d : dword;
+
+  begin
+     if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+       begin
+         SocketError:=WSAGetLastError;
+         fdRead:=0;
+         exit;
+       end;
+     if d>0 then
+       begin
+         if size>d then
+           size:=d;
+         fdRead := dword(WinSock.recv(handle, bufptr, size, 0));
+         if fdRead = dword(SOCKET_ERROR) then
+         begin
+           SocketError:= WSAGetLastError;
+           fdRead := 0;
+         end else
+           SocketError:=0;
+       end
+     else
+       SocketError:=0;
+  end;
+{$endif}
+
+{$i sockets.inc}
+
+{ winsocket stack needs an init. and cleanup code }
+var
+  wsadata : twsadata;
+
+initialization
+  WSAStartUp($2,wsadata);
+finalization
+  WSACleanUp;
+end.
+{
+  $Log$
+  Revision 1.1  2004-09-19 20:06:37  armin
+  * removed get/free video buf from video.pp
+  * implemented sockets
+  * basic library support
+  * threadvar memory leak removed
+  * fixes (ide now starts and editor is usable)
+  * support for lineinfo
+
+}

rtl/netwlibc/system.pp

@@ -66,33 +66,43 @@ CONST
    sLineBreak = LineEnding;
    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
 
-TYPE
+type
    TNWCheckFunction = procedure (var code : longint);
+   TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
+   TDLL_Entry_Hook = procedure (dllparam : longint);
 
 VAR
-   ArgC   : INTEGER;
-   ArgV   : ppchar;
-   NetwareCheckFunction    : TNWCheckFunction;
-   NetwareMainThreadGroupID: longint;
-   NetwareCodeStartAddress : dword;
+   ArgC                : INTEGER;
+   ArgV                : ppchar;
+   NetwareCheckFunction: TNWCheckFunction;
+   NWLoggerScreen      : pointer = nil;
 
-
-CONST
-   envp   : ppchar = nil;
+const
+  Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
+  Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
+  Dll_Thread_Attach_Hook  : TDLL_Entry_Hook = nil;
+  Dll_Thread_Detach_Hook  : TDLL_Entry_Hook = nil;
+  envp : ppchar = nil;
 
 
 
-{type
-  TSysCloseAllRemainingSemaphores = procedure;
+type
+  //TSysCloseAllRemainingSemaphores = procedure;
   TSysReleaseThreadVars = procedure;
   TSysSetThreadDataAreaPtr = function (newPtr:pointer):pointer;
 
-procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
+procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
                                    rtv:TSysReleaseThreadVars;
-				   stdata:TSysSetThreadDataAreaPtr);
-}
+                                   stdata:TSysSetThreadDataAreaPtr);
+
+
+procedure __ConsolePrintf (s :shortstring);
+procedure __EnterDebugger; cdecl;
 
-procedure __ConsolePrintf (s :string);
+function NWGetCodeStart : pointer;  // needed for Lineinfo
+function NWGetCodeLength : dword;
+function NWGetDataStart : pointer;
+function NWGetDataLength : dword;
 
 implementation
 { Indicate that stack checking is taken care by OS}
@@ -107,25 +117,24 @@ implementation
 {$define INCLUDED_FROM_SYSTEM}
 {$I libc.pp}
 
-
 var
-  HeapAllocResourceTag,HeapListAllocResourceTag : rtag_t;
-  NLMHandle : pointer;
-  {$ifdef StdErrToConsole}
-  NWLoggerScreen : Tscr;
+  {$ifdef autoHeapRelease}
+  HeapListAllocResourceTag,
   {$endif}
-  {CloseAllRemainingSemaphores : TSysCloseAllRemainingSemaphores = nil;
+  HeapAllocResourceTag : rtag_t;
+  NLMHandle : pointer;
   ReleaseThreadVars : TSysReleaseThreadVars = nil;
+  AllocateThreadVars: TSysReleaseThreadVars = nil;
   SetThreadDataAreaPtr : TSysSetThreadDataAreaPtr = nil;
 
-procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
+procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
                                    rtv:TSysReleaseThreadVars;
-				   stdata:TSysSetThreadDataAreaPtr);
+                                   stdata:TSysSetThreadDataAreaPtr);
 begin
-  CloseAllRemainingSemaphores := crs;
+  AllocateThreadVars := atv;
   ReleaseThreadVars := rtv;
   SetThreadDataAreaPtr := stdata;
-end;}
+end;
 
 
 procedure PASCALMAIN;external name 'PASCALMAIN';
@@ -144,19 +153,17 @@ var SigTermHandlerActive : boolean;
 
 Procedure system_exit;
 begin
-  __ConsolePrintf ('system_exit');
-  //if assigned (CloseAllRemainingSemaphores) then CloseAllRemainingSemaphores;
-  //if assigned (ReleaseThreadVars) then ReleaseThreadVars;
+  //__ConsolePrintf ('system_exit');
+  if assigned (ReleaseThreadVars) then ReleaseThreadVars;
 
   {$ifdef autoHeapRelease}
-  FreeSbrkMem;            { free memory allocated by heapmanager }
+  FreeSbrkMem;              { free memory allocated by heapmanager }
   {$endif}
-  __ConsolePrintf ('Heap mem released');
 
   if not SigTermHandlerActive then
   begin
-    //if ExitCode <> 0 Then   { otherwise we dont see runtime-errors }
-    //  _SetAutoScreenDestructionMode (false);
+    if Erroraddr <> nil then   { otherwise we dont see runtime-errors }
+      SetScreenMode (0);
 
     _exit (ExitCode);
   end;
@@ -173,12 +180,12 @@ procedure int_stackcheck(stack_size:Cardinal);[saveregisters,public,alias:'FPC_S
   called when trying to get local stack if the compiler directive $S
   is set this function must preserve all registers
 
-  With a 2048 byte safe area used to write to StdIo without crossing
-  the stack boundary
+  With a 5k byte safe area used to write to StdIo and some libc
+  functions without crossing the stack boundary
 }
 begin
   if StackErr then exit;  // avoid recursive calls
-  if stackavail > stack_size + 2048 THEN EXIT;
+  if stackavail > stack_size + 5120 then exit;  // we really need that much, at least on nw6.5
   StackErr := true;
   HandleError (202);
 end;
@@ -349,7 +356,6 @@ end;
 
 function SysOSAlloc(size: ptrint): pointer;
 begin
-  writeln ('Alloc ',size,' bytes');
   SysOSAlloc := _Alloc(size,HeapAllocResourceTag);
 end;
 
@@ -388,14 +394,15 @@ BEGIN
     Sys_EROFS,
    Sys_EEXIST,
    Sys_EACCES : Inoutres:=5;
-  Sys_EBUSY   : Inoutres:=162;
+  Sys_EBUSY   : Inoutres:=162
+  else begin
+    Writeln (stderr,'NW2PASErr: unknown error ',err);
+    libc_perror('NW2PASErr');
+    Inoutres := Err;
+  end;
   end;
 END;
 
-{FUNCTION errno : LONGINT;
-BEGIN
-  errno := ___errno^;
-END;}
 
 procedure Errno2Inoutres;
 begin
@@ -462,6 +469,7 @@ begin
   else
     SetFileError (res);
   do_write := res;
+  NXThreadYield;
 end;
 
 function do_read(h:thandle;addr:pointer;len : longint) : longint;
@@ -477,6 +485,7 @@ begin
   ELSE
     SetFileError (res);
   do_read := res;
+  NXThreadYield;
 end;
 
 
@@ -629,14 +638,16 @@ Begin
      exit;
    end;
 { real open call }
+  ___errno^ := 0;
   FileRec(f).Handle := open(p,oflags,438);
-  if FileRec(f).Handle < 0 then
+  { open somtimes returns > -1 but errno was set }
+  if (___errno^ <> 0) or (longint(FileRec(f).Handle) < 0) then
     if (___errno^=Sys_EROFS) and ((OFlags and O_RDWR)<>0) then
     begin  // i.e. for cd-rom
       Oflags:=Oflags and not(O_RDWR);
       FileRec(f).Handle := open(p,oflags,438);
     end;
-  if FileRec(f).Handle < 0 then
+  if (___errno^ <> 0) or (longint(FileRec(f).Handle) < 0) then
     Errno2Inoutres
   else
     InOutRes := 0;
@@ -755,9 +766,6 @@ end;
                            Text File Handling
 *****************************************************************************}
 
-{ should we consider #26 as the  end of a file ? }
-{?? $DEFINE EOF_CTRLZ}
-
 {$i text.inc}
 
 {*****************************************************************************
@@ -806,12 +814,11 @@ begin
 end;
 
 procedure getdir(drivenr : byte;var dir : shortstring);
-VAR P : ARRAY [0..255] OF CHAR;
+var P : array [0..255] of CHAR;
     i : LONGINT;
 begin
   P[0] := #0;
-  //getcwd (@P, SIZEOF (P));
-  getcwdpath(@P,nil,0);
+  getcwdpath(@P,nil,0);   // getcwd does not return volume, getcwdpath does
   i := libc_strlen (P);
   if i > 0 then
   begin
@@ -826,7 +833,7 @@ begin
     if (i > 0) then
       if i = Length (dir) then dir := dir + '/' else
       if dir [i+1] <> '/' then insert ('/',dir,i+1);
-  END ELSE
+  end else
     InOutRes := 1;
 end;
 
@@ -849,38 +856,71 @@ procedure InitFPU;assembler;
   Netware >= 4.0 }
 
 function CheckFunction : longint; CDECL; [public,alias: '_NonAppCheckUnload'];
+var oldPtr : pointer;
 begin
-  __ConsolePrintf ('CheckFunction');
+  //__ConsolePrintf ('CheckFunction');
   if assigned (NetwareCheckFunction) then
   begin
-    { this function is called without clib context, to allow clib
-      calls, we set the thread group id before calling the
-      user-function }
-    //oldTG := _SetThreadGroupID (NetwareMainThreadGroupID);
-    { to allow use of threadvars, we simply set the threadvar-memory
-      from the main thread }
-    //if assigned (SetThreadDataAreaPtr) then
-    //  oldPtr := SetThreadDataAreaPtr (NIL);  { nil means main threadvars }
+    if assigned (SetThreadDataAreaPtr) then
+      oldPtr := SetThreadDataAreaPtr (NIL);  { nil means main thread }
+
     result := 0;
     NetwareCheckFunction (result);
-//    if assigned (SetThreadDataAreaPtr) then
-//      SetThreadDataAreaPtr (oldPtr);
 
-//    _SetThreadGroupID (oldTG);
+    if assigned (SetThreadDataAreaPtr) then
+      SetThreadDataAreaPtr (oldPtr);
+
   end else
     result := 0;
 end;
 
 
-procedure __ConsolePrintf (s : string);
+procedure __ConsolePrintf (s : shortstring);
 begin
   if length(s) > 252 then
     byte(s[0]) := 252;
   s := s + #13#10#0;
+  if NWLoggerScreen = nil then
+    NWLoggerScreen := getnetwarelogger;
   screenprintf (NWLoggerScreen,@s[1]);
 end;
 
 
+procedure __EnterDebugger;cdecl;external '!netware' name 'EnterDebugger';
+
+var NWUts : Tutsname;
+
+procedure getCodeAddresses;
+begin
+  if uname(NWUts) < 0 then
+    FillChar(NWuts,sizeof(NWUts),0);
+end;
+
+function NWGetCodeStart : pointer;
+begin
+  NWGetCodeStart := NWUts.codeoffset;
+  NXThreadYield;
+end;
+
+function NWGetCodeLength : dword;
+begin
+  NWGetCodeLength := NWUts.codelength;
+  NXThreadYield;
+end;
+
+function NWGetDataStart : pointer;
+begin
+  NWGetDataStart := NWUts.dataoffset;
+  NXThreadYield;
+end;
+
+function NWGetDataLength : dword;
+begin
+  NWGetDataLength := NWUts.datalength;
+  NXThreadYield;
+end;
+
+
 {$ifdef StdErrToConsole}
 var ConsoleBuff : array [0..512] of char;
 
@@ -900,6 +940,7 @@ Begin
   end;
   F.BufPos:=0;
   ConsoleWrite := 0;
+  NXThreadYield;
 End;
 
 
@@ -931,9 +972,18 @@ end;
   called if the program exits i.e. with halt.
   Halt (or _exit) can not be called from this callback procedure }
 procedure TermSigHandler (Sig:longint); CDecl;
+var oldPtr : pointer;
 begin
+  { Threadvar Pointer will not be valid because the signal
+    handler is called by netware with a differnt thread. To avoid
+    problems in the exit routines, we set the data of the main thread
+    here }
+  if assigned (SetThreadDataAreaPtr) then
+    oldPtr := SetThreadDataAreaPtr (NIL);  { nil means main thread }
   SigTermHandlerActive := true;  { to avoid that system_exit calls _exit }
   do_exit;                       { calls finalize units }
+  if assigned (SetThreadDataAreaPtr) then
+    SetThreadDataAreaPtr (oldPtr);
 end;
 
 
@@ -961,19 +1011,72 @@ begin
   {$endif}
 end;
 
-procedure nlm_main (_ArgC : LONGINT; _ArgV : ppchar); cdecl; [public,alias: 'main'];
+// this is called by main.as, setup args and call PASCALMAIN
+procedure nlm_main (_ArgC : LONGINT; _ArgV : ppchar); cdecl; [public,alias: '_FPC_NLM_Entry'];
 BEGIN
   ArgC := _ArgC;
   ArgV := _ArgV;
+  isLibrary := false;
   PASCALMAIN;
+  do_exit;    // currently not needed
 END;
 
+function _DLLMain (hInstDLL:pointer; fdwReason:dword; DLLParam:longint):longbool; cdecl;
+[public, alias : '_FPC_DLL_Entry'];
+var res : longbool;
+begin
+  __ConsolePrintf ('_FPC_DLL_Entry called');
+  _DLLMain := false;
+  isLibrary := true;
+  case fdwReason of
+    DLL_ACTUAL_DLLMAIN  : _DLLMain := true;
+    DLL_NLM_STARTUP     : begin
+                            //__ConsolePrintf ('DLL_NLM_STARTUP');
+                            if assigned(Dll_Process_Attach_Hook) then
+                            begin
+                              res:=Dll_Process_Attach_Hook(DllParam);
+                              if not res then
+                                exit(false);
+                            end;
+                            PASCALMAIN;
+                            _DLLMain := true;
+                          end;
+    DLL_NLM_SHUTDOWN    : begin
+                            //__ConsolePrintf ('DLL_NLM_SHUTDOWN');
+                            TermSigHandler(0);
+                            _DLLMain := true;
+                          end;
+     { standard DllMain() messages...  }
+    DLL_THREAD_ATTACH,
+    DLL_PROCESS_ATTACH  : begin
+                            //__ConsolePrintf ('DLL_PROCESS/THREAD_ATTACH');
+                            if assigned(AllocateThreadVars) then
+                              AllocateThreadVars;
+                            if assigned(Dll_Thread_Attach_Hook) then
+                              Dll_Thread_Attach_Hook(DllParam);
+
+                            _DLLMain := true;
+                          end;
+    DLL_THREAD_DETACH,
+    DLL_PROCESS_DETACH  : begin
+                            //__ConsolePrintf ('DLL_PROCESS/THREAD_DETACH');
+                            if assigned(Dll_Thread_Detach_Hook) then
+                              Dll_Thread_Detach_Hook(DllParam);
+                            if assigned(ReleaseThreadVars) then
+                              ReleaseThreadVars;
+                            _DLLMain := true;
+                          end;
+  end;
+end;
+
+
 
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
 
 Begin
+  getCodeAddresses;
   StackBottom := SPtr - StackLength;
   SigTermHandlerActive := false;
   NetwareCheckFunction := nil;
@@ -982,12 +1085,15 @@ Begin
   {$endif}
   CheckFunction;  // avoid check function to be removed by the linker
 
-  envp := ____environ^;  // nxGetEnviron;
+  envp := ____environ^;
   NLMHandle := getnlmhandle;
+  { allocate resource tags to see what kind of memory i forgot to release }
   HeapAllocResourceTag :=
     AllocateResourceTag(NLMHandle,'Heap Memory',AllocSignature);
+  {$ifdef autoHeapRelease}
   HeapListAllocResourceTag :=
     AllocateResourceTag(NLMHandle,'Heap Memory List',AllocSignature);
+  {$endif}
   Signal (SIGTERM, @TermSigHandler);
 
 { Setup heap }
@@ -997,14 +1103,11 @@ Begin
 { Reset IO Error }
   InOutRes:=0;
 
-(* This should be changed to a real value during *)
-(* thread driver initialization if appropriate.  *)
-  ThreadID := 1;
+  ThreadID := dword(pthread_self);
 
   SysInitStdIO;
 
 {Delphi Compatible}
-  IsLibrary := FALSE;
   IsConsole := TRUE;
   ExitCode  := 0;
 {$ifdef HASVARIANT}
@@ -1013,7 +1116,15 @@ Begin
 End.
 {
   $Log$
-  Revision 1.2  2004-09-12 20:51:22  armin
+  Revision 1.3  2004-09-19 20:06:37  armin
+  * removed get/free video buf from video.pp
+  * implemented sockets
+  * basic library support
+  * threadvar memory leak removed
+  * fixes (ide now starts and editor is usable)
+  * support for lineinfo
+
+  Revision 1.2  2004/09/12 20:51:22  armin
   * added keyboard and video
   * a lot of fixes
 

rtl/netwlibc/systhrds.pp

@@ -1,10 +1,11 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2002 by Peter Vreman,
-    member of the Free Pascal development team.
+    Copyright (c) 2002-2004 by the Free Pascal development team.
 
-    netware (pthreads) threading support implementation
+    netware (pthreads) threading support implementation, most of
+    this is copied from the linux implementation because netware
+    libc also provides pthreads
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -20,8 +21,6 @@ unit systhrds;
 interface
 {$S-}
 
-//Procedure SetCThreadManager;
-
 { Posix compliant definition }
 
 uses Libc;
@@ -30,7 +29,7 @@ type
   PRTLCriticalSection = Ppthread_mutex_t;
   TRTLCriticalSection = pthread_mutex_t;
 
-
+{$define DISABLE_NO_THREAD_MANAGER}
 {$i threadh.inc}
 
 implementation
@@ -49,6 +48,8 @@ implementation
 {$ifdef HASTHREADVAR}
     const
       threadvarblocksize : dword = 0;
+      thredvarsmainthread: pointer = nil; // to free the threadvars in the signal handler
+
 
     var
       TLSKey : pthread_key_t;
@@ -79,14 +80,31 @@ implementation
         //DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
         FillChar(DataIndex^,threadvarblocksize,0);
         pthread_setspecific(tlskey,dataindex);
+        if thredvarsmainthread = nil then
+          thredvarsmainthread := dataindex;
+        {$ifdef DEBUG_MT}
+        __ConsolePrintf ('SysAllocateThreadVars');
+        {$endif}
       end;
 
 
     procedure SysReleaseThreadVars;
       begin
+        {$ifdef DEBUG_MT}
+        __ConsolePrintf ('SysReleaseThreadVars');
+        {$endif}
         _Free (pthread_getspecific(tlskey));
       end;
 
+    function SetThreadDataAreaPtr (newPtr:pointer):pointer;
+    begin
+      SetThreadDataAreaPtr := pthread_getspecific(tlskey);  // return current
+      if newPtr = nil then                                  // if nil
+        newPtr := thredvarsmainthread;                      // set main thread vars
+      pthread_setspecific(tlskey,newPtr);
+    end;
+
+
 { Include OS independent Threadvar initialization }
 {$i threadvr.inc}
 
@@ -110,6 +128,9 @@ implementation
       begin
         { Release Threadvars }
 {$ifdef HASTHREADVAR}
+{$ifdef DEBUG_MT}
+        __ConsolePrintf('DoneThread, releasing threadvars');
+{$endif DEBUG_MT}
         SysReleaseThreadVars;
 {$endif HASTHREADVAR}
       end;
@@ -129,8 +150,7 @@ implementation
 {$endif DEBUG_MT}
       begin
 {$ifdef DEBUG_MT}
-        s := 'New thread started, initing threadvars'#10;
-        fpwrite(0,s[1],length(s));
+        __ConsolePrintf('New thread started, initing threadvars');
 {$endif DEBUG_MT}
 {$ifdef HASTHREADVAR}
         { Allocate local thread vars, this must be the first thing,
@@ -139,8 +159,7 @@ implementation
 {$endif HASTHREADVAR}
         { Copy parameter to local data }
 {$ifdef DEBUG_MT}
-        s := 'New thread started, initialising ...'#10;
-        fpwrite(0,s[1],length(s));
+        __ConsolePrintf ('New thread started, initialising ...');
 {$endif DEBUG_MT}
         ti:=pthreadinfo(param)^;
         dispose(pthreadinfo(param));
@@ -148,7 +167,7 @@ implementation
         InitThread(ti.stklen);
         { Start thread function }
 {$ifdef DEBUG_MT}
-        writeln('Jumping to thread function');
+        __ConsolePrintf('Jumping to thread function');
 {$endif DEBUG_MT}
         ThreadMain:=pointer(ti.f(ti.p));
         DoneThread;
@@ -164,7 +183,7 @@ implementation
         thread_attr : pthread_attr_t;
       begin
 {$ifdef DEBUG_MT}
-        writeln('Creating new thread');
+        __ConsolePrintf('Creating new thread');
 {$endif DEBUG_MT}
         { Initialize multithreading if not done }
         if not IsMultiThread then
@@ -184,7 +203,7 @@ implementation
         ti^.stklen:=stacksize;
         { call pthread_create }
 {$ifdef DEBUG_MT}
-        writeln('Starting new thread');
+        __ConsolePrintf('Starting new thread');
 {$endif DEBUG_MT}
         pthread_attr_init(@thread_attr);
         pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
@@ -216,17 +235,18 @@ implementation
     function  SysSuspendThread (threadHandle : dword) : dword;
     begin
       {$Warning SuspendThread needs to be implemented}
+      SysSuspendThread := $0FFFFFFFF;
     end;
 
     function  SysResumeThread  (threadHandle : dword) : dword;
     begin
       {$Warning ResumeThread needs to be implemented}
+      SysResumeThread := $0FFFFFFFF;
     end;
 
     procedure SysThreadSwitch;  {give time to other threads}
     begin
-      {extern int pthread_yield (void) __THROW;}
-      {$Warning ThreadSwitch needs to be implemented}
+      pthread_yield;
     end;
 
     function  SysKillThread (threadHandle : dword) : dword;
@@ -248,13 +268,15 @@ implementation
 
     function  SysThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
     begin
-      {$Warning ThreadSetPriority needs to be implemented}
+      {priority is ignored on netware}
+      SysThreadSetPriority := true;
     end;
 
 
     function  SysThreadGetPriority (threadHandle : dword): Integer;
     begin
-      {$Warning ThreadGetPriority needs to be implemented}
+      {priority is ignored on netware}
+      SysThreadGetPriority := 0;
     end;
 
     function  SysGetCurrentThreadId : dword;
@@ -471,10 +493,22 @@ initialization
   ThVarAllocResourceTag := AllocateResourceTag(getnlmhandle,'Threadvar Memory',AllocSignature);
   {$endif}
   SetNWThreadManager;
+  NWSysSetThreadFunctions (@SysAllocateThreadVars,
+                           @SysReleaseThreadVars,
+                           @SetThreadDataAreaPtr);
+
 end.
 {
   $Log$
-  Revision 1.1  2004-09-05 20:58:47  armin
+  Revision 1.2  2004-09-19 20:06:37  armin
+  * removed get/free video buf from video.pp
+  * implemented sockets
+  * basic library support
+  * threadvar memory leak removed
+  * fixes (ide now starts and editor is usable)
+  * support for lineinfo
+
+  Revision 1.1  2004/09/05 20:58:47  armin
   * first rtl version for netwlibc
 
 }

rtl/netwlibc/sysutils.pp

@@ -147,24 +147,28 @@ Function FileLock (Handle,FOffset,FLen : Longint) : Longint;
 begin
   {$warning FileLock not implemented}
   //FileLock := _lock (Handle,FOffset,FLen);
+  FileLock := -1;
 end;
 
 Function FileLock (Handle : Longint; FOffset,FLen : Int64) : Longint;
 begin
   {$warning need to add 64bit FileLock call }
   //FileLock := FileLock (Handle, longint(FOffset),longint(FLen));
+  FileLock := -1;
 end;
 
 Function FileUnlock (Handle,FOffset,FLen : Longint) : Longint;
 begin
   //FileUnlock := _unlock (Handle,FOffset,FLen);
   {$warning FileUnLock not implemented}
+  FileUnlock := -1;
 end;
 
 Function FileUnlock (Handle : Longint; FOffset,FLen : Int64) : Longint;
 begin
   {$warning need to add 64bit FileUnlock call }
   //FileUnlock := FileUnlock (Handle, longint(FOffset),longint(FLen));
+  FileUnlock := -1;
 end;
 
 Function FileAge (Const FileName : String): Longint;
@@ -255,57 +259,6 @@ begin
   end;
 end;
 
-
-
-(*
-Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
-begin
-  IF path = '' then
-    exit (18);
-  Rslt.FindData.DirP := opendir (pchar(Path));
-  IF Rslt.FindData.DirP = NIL THEN
-    exit (18);
-  //!!IF attr <> faAnyFile THEN
-  //!!  _SetReaddirAttribute (Rslt.FindData.DirP, attr);
-  Rslt.FindData.Magic := $AD01;
-  Rslt.FindData.EntryP := readdir (Rslt.FindData.DirP);
-  if Rslt.FindData.EntryP = nil then
-  begin
-    closedir (Rslt.FindData.DirP);
-    Rslt.FindData.DirP := NIL;
-    result := 18;
-  end else
-  begin
-    find_setfields (Rslt);
-    result := 0;
-  end;
-end;
-
-
-Function FindNext (Var Rslt : TSearchRec) : Longint;
-
-begin
-  if Rslt.FindData.Magic <> $AD01 then
-    exit (18);
-  Rslt.FindData.EntryP := readdir (Rslt.FindData.DirP);
-  if Rslt.FindData.EntryP = nil then
-    exit (18);
-  find_setfields (Rslt);
-  result := 0;
-end;
-
-
-Procedure FindClose (Var F : TSearchrec);
-begin
-  if F.FindData.Magic = $AD01 then
-  begin
-    if F.FindData.DirP <> nil then
-      closedir (F.FindData.DirP);
-    F.FindData.Magic := 0;
-    F.FindData.DirP := NIL;
-    F.FindData.EntryP := NIL;
-  end;
-end;*)
 function findfirst(const path : string;attr : longint;var Rslt : TsearchRec) : longint;
 var
   path0 : string;
@@ -382,7 +335,7 @@ end;
 
 Function FileGetDate (Handle : Longint) : Longint;
 Var Info : TStat;
-    _PTM  : PTM;
+    _PTM : PTM;
 begin
   If fstat(Handle,Info) <> 0 then
     Result:=-1
@@ -521,7 +474,7 @@ Begin
   else
    DiskSize:=-1;}
   DiskSize := -1;
-  ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10);
+  __ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10);
   {$warning DiskSize not implemented (does it make sense ?) }
 End;
 
@@ -616,7 +569,7 @@ end;
 function SysErrorMessage(ErrorCode: Integer): String;
 
 begin
-  Result:='';  // StrError(ErrorCode);
+  Result:='';  // only found perror that prints the message
 end;
 
 {****************************************************************************
@@ -685,7 +638,15 @@ end.
 {
 
   $Log$
-  Revision 1.2  2004-09-12 20:51:22  armin
+  Revision 1.3  2004-09-19 20:06:37  armin
+  * removed get/free video buf from video.pp
+  * implemented sockets
+  * basic library support
+  * threadvar memory leak removed
+  * fixes (ide now starts and editor is usable)
+  * support for lineinfo
+
+  Revision 1.2  2004/09/12 20:51:22  armin
   * added keyboard and video
   * a lot of fixes
 

rtl/netwlibc/video.pp

@@ -29,8 +29,28 @@ uses
 
 var
   MaxVideoBufSize : DWord;
-  VideoBufAllocated: boolean;
   ScreenHandle : scr_t;
+  CursorIsHidden : boolean;
+
+
+procedure SysSetCursorType(NewType: Word);
+begin
+   if newType=crHidden then
+   begin
+     Libc.DisableInputCursor (ScreenHandle);
+     cursorIsHidden := true;
+   end else
+   begin
+     cursorIsHidden := false;
+     case NewType of
+       crUnderline: Libc.SetCursorStyle (ScreenHandle,CURSOR_NORMAL);
+       crHalfBlock: Libc.SetCursorStyle (ScreenHandle,CURSOR_TOP);
+       crBlock    : Libc.SetCursorStyle (ScreenHandle,CURSOR_BLOCK);
+     end;
+     Libc.EnableInputCursor (ScreenHandle);
+   end;
+end;
+
 
 procedure SysInitVideo;
 VAR height,width,x,y : WORD;
@@ -51,37 +71,25 @@ begin
   GetOutputCursorPosition(ScreenHandle,y,x);
   CursorX := x;
   CursorY := y;
-  //_GetCursorShape (startline,endline);
-  {if not ConsoleCursorInfo.bvisible then
-    CursorLines:=0
-  else
-    CursorLines:=ConsoleCursorInfo.dwSize;}
-
+(* done in video.inc
   { allocate back buffer }
   MaxVideoBufSize:= ScreenWidth * ScreenHeight * 2;
   VideoBufSize   := ScreenWidth * ScreenHeight * 2;
 
   GetMem(VideoBuf,MaxVideoBufSize);
   GetMem(OldVideoBuf,MaxVideoBufSize);
-  VideoBufAllocated := true;
-
+*)
   {grab current screen contents}
-  Libc.SaveFullScreen (ScreenHandle,VideoBuf);
-  Move (VideoBuf^, OldVideoBuf^, MaxVideoBufSize);
-  LockUpdateScreen := 0;
+//  Libc.SaveFullScreen (ScreenHandle,VideoBuf);
+//  Move (VideoBuf^, OldVideoBuf^, MaxVideoBufSize);
+//  LockUpdateScreen := 0;
+  SysSetCursorType (crBlock);
 end;
 
 
 procedure SysDoneVideo;
 begin
   SetCursorType(crUnderLine);
-  if videoBufAllocated then
-  begin
-    FreeMem(VideoBuf,MaxVideoBufSize);
-    FreeMem(OldVideoBuf,MaxVideoBufSize);
-    videoBufAllocated := false;
-  end;
-  VideoBufSize:=0;
 end;
 
 
@@ -90,16 +98,21 @@ begin
   SysGetCapabilities:=cpColor or cpChangeCursor;
 end;
 
-
 procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
 begin
-  Libc.GetOutputCursorPosition(ScreenHandle,NewCursorY,NewCursorX);
+  Libc.PositionInputCursor(ScreenHandle,NewCursorY,NewCursorX);
 end;
 
 
+
 function SysGetCursorType: Word;
 var style : word;
 begin
+  if cursorIsHidden then
+  begin
+    SysGetCursorType := crHidden;
+    exit;
+  end;
   Libc.GetCursorStyle (ScreenHandle,style);
   case style of
     //CURSOR_NORMAL : SysGetCursorType := crUnderline;
@@ -109,28 +122,18 @@ begin
   else
     SysGetCursorType := crUnderline;
   end;
-  {crHidden ?}
-end;
-
-
-procedure SysSetCursorType(NewType: Word);
-begin
-   if newType=crHidden then
-     Libc.DisableInputCursor (ScreenHandle)
-   else
-     begin
-        case NewType of
-           crUnderline: Libc.SetCursorStyle (ScreenHandle,CURSOR_NORMAL);
-           crHalfBlock: Libc.SetCursorStyle (ScreenHandle,CURSOR_TOP);
-           crBlock    : Libc.SetCursorStyle (ScreenHandle,CURSOR_BLOCK);
-        end;
-        Libc.EnableInputCursor (ScreenHandle);
-     end;
 end;
 
 
 procedure SysUpdateScreen(Force: Boolean);
 begin
+  {$ifdef debug}
+  if VideoBuf = nil then
+  begin
+    __ConsolePrintf ('Fatal: Video buff accessed after DoneVideo');
+    exit;
+  end;
+  {$endif}
   if (LockUpdateScreen<>0) or (VideoBufSize = 0) then
    exit;
   if not force then
@@ -191,7 +194,7 @@ Const
 
 
 initialization
-  VideoBufAllocated := false;
+  VideoBuf := nil;
   VideoBufSize := 0;
   ScreenHandle := Libc.getscreenhandle;
   SetVideoDriver (SysVideoDriver);