* changes for new threadvar support

rtl/netware/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2003/01/14]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2002/04/16]
 #
 default: all
-MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos macosx
+MAKEFILETARGETS=netware
 override PATH:=$(subst \,/,$(PATH))
 ifeq ($(findstring ;,$(PATH)),)
 inUnix=1
@@ -42,9 +42,6 @@ endif
 ifeq ($(OS_TARGET),netbsd)
 BSDhier=1
 endif
-ifeq ($(OS_TARGET),openbsd)
-BSDhier=1
-endif
 ifdef inUnix
 BATCHEXT=.sh
 else
@@ -58,9 +55,6 @@ ifdef inUnix
 PATHSEP=/
 else
 PATHSEP:=$(subst /,\,/)
-ifdef inCygWin
-PATHSEP=/
-endif
 endif
 ifdef PWD
 BASEDIR:=$(subst \,/,$(shell $(PWD)))
@@ -90,7 +84,7 @@ endif
 endif
 export ECHO
 endif
-override OS_TARGET_DEFAULT=netware
+OS_TARGET=netware
 override DEFAULT_FPCDIR=../..
 ifndef FPC
 ifdef PP
@@ -112,38 +106,37 @@ endif
 override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
 override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
 ifndef FPC_VERSION
-FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
-FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+FPC_VERSION:=$(shell $(FPC) -iV)
 endif
-export FPC FPC_VERSION FPC_COMPILERINFO
+export FPC FPC_VERSION
 unexport CHECKDEPEND ALLDEPENDENCIES
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+COMPILERINFO:=$(shell $(FPC) -iSP -iTP -iSO -iTO)
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 1,$(COMPILERINFO))
+endif
 ifndef CPU_TARGET
-ifdef CPU_TARGET_DEFAULT
-CPU_TARGET=$(CPU_TARGET_DEFAULT)
+CPU_TARGET:=$(word 2,$(COMPILERINFO))
 endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 3,$(COMPILERINFO))
 endif
 ifndef OS_TARGET
-ifdef OS_TARGET_DEFAULT
-OS_TARGET=$(OS_TARGET_DEFAULT)
-endif
-endif
-ifneq ($(words $(FPC_COMPILERINFO)),5)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+OS_TARGET:=$(word 4,$(COMPILERINFO))
 endif
+else
 ifndef CPU_SOURCE
-CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+CPU_SOURCE:=$(shell $(FPC) -iSP)
 endif
 ifndef CPU_TARGET
-CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+CPU_TARGET:=$(shell $(FPC) -iTP)
 endif
 ifndef OS_SOURCE
-OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+OS_SOURCE:=$(shell $(FPC) -iSO)
 endif
 ifndef OS_TARGET
-OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
 endif
 FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
 FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
@@ -218,7 +211,7 @@ override FPCOPT+=-Ur
 override FPCOPT+=-dMT
 CREATESMART=1
 OBJPASDIR=$(RTL)/objpas
-override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings netware winsock2 dos crt objects sysutils typinfo math cpu mmx getopts heaptrc lineinfo sockets aio varutils video mouse keyboard types
+override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings netware winsock2 dos crt objects sysutils typinfo math cpu mmx getopts heaptrc lineinfo sockets aio varutils video mouse keyboard types
 override TARGET_LOADERS+=nwpre prelude
 override TARGET_RSTS+=math typinfo varutils
 override INSTALL_FPCPACKAGE=y
@@ -241,15 +234,9 @@ endif
 ifeq ($(OS_TARGET),netbsd)
 UNIXINSTALLDIR=1
 endif
-ifeq ($(OS_TARGET),openbsd)
-UNIXINSTALLDIR=1
-endif
 ifeq ($(OS_TARGET),sunos)
 UNIXINSTALLDIR=1
 endif
-ifeq ($(OS_TARGET),qnx)
-UNIXINSTALLDIR=1
-endif
 else
 ifeq ($(OS_SOURCE),linux)
 UNIXINSTALLDIR=1
@@ -260,15 +247,9 @@ endif
 ifeq ($(OS_SOURCE),netbsd)
 UNIXINSTALLDIR=1
 endif
-ifeq ($(OS_SOURCE),openbsd)
-UNIXINSTALLDIR=1
-endif
 ifeq ($(OS_TARGET),sunos)
 UNIXINSTALLDIR=1
 endif
-ifeq ($(OS_TARGET),qnx)
-UNIXINSTALLDIR=1
-endif
 endif
 ifndef INSTALL_PREFIX
 ifdef PREFIX
@@ -464,12 +445,6 @@ HASSHAREDLIB=1
 FPCMADE=fpcmade.netbsd
 ZIPSUFFIX=netbsd
 endif
-ifeq ($(OS_TARGET),openbsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.openbsd
-ZIPSUFFIX=openbsd
-endif
 ifeq ($(OS_TARGET),win32)
 PPUEXT=.ppw
 OEXT=.ow
@@ -495,7 +470,7 @@ ECHO=echo
 endif
 ifeq ($(OS_TARGET),amiga)
 EXEEXT=
-PPUEXT=.ppu
+PPUEXT=.ppa
 ASMEXT=.asm
 OEXT=.o
 SMARTEXT=.sl
@@ -504,7 +479,7 @@ SHAREDLIBEXT=.library
 FPCMADE=fpcmade.amg
 endif
 ifeq ($(OS_TARGET),atari)
-PPUEXT=.ppu
+PPUEXT=.ppt
 ASMEXT=.s
 OEXT=.o
 SMARTEXT=.sl
@@ -554,15 +529,6 @@ FPCMADE=fpcmade.nw
 ZIPSUFFIX=nw
 EXEEXT=.nlm
 endif
-ifeq ($(OS_TARGET),macos)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-FPCMADE=fpcmade.mcc
-endif
 ifndef ECHO
 ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(ECHO),)
@@ -790,9 +756,6 @@ endif
 ifneq ($(OS_TARGET),$(OS_SOURCE))
 override FPCOPT+=-T$(OS_TARGET)
 endif
-ifeq ($(OS_SOURCE),openbsd)
-override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
-endif
 ifdef UNITDIR
 override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
 endif
@@ -874,11 +837,6 @@ override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
 override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
 endif
 endif
-ifeq ($(OS_TARGET),linux)
-ifeq ($(FPC_VERSION),1.0.6)
-override FPCOPTDEF+=HASUNIX
-endif
-endif
 ifdef OPT
 override FPCOPT+=$(OPT)
 endif
@@ -1113,7 +1071,6 @@ fpc_baseinfo:
 	@$(ECHO)  Rm........ $(RMPROG)
 	@$(ECHO)  GInstall.. $(GINSTALL)
 	@$(ECHO)  Echo...... $(ECHO)
-	@$(ECHO)  Shell..... $(SHELL)
 	@$(ECHO)  Date...... $(DATE)
 	@$(ECHO)  FPCMake... $(FPCMAKE)
 	@$(ECHO)  PPUMove... $(PPUMOVE)

rtl/netware/Makefile.fpc

@@ -7,7 +7,7 @@ main=rtl
 
 [target]
 loaders=nwpre prelude
-units=$(SYSTEMUNIT) objpas strings \
+units=$(SYSTEMUNIT) systhrds objpas strings \
       netware winsock2 \
       dos crt objects \
       sysutils typinfo math \
@@ -52,6 +52,10 @@ endif
 override FPCOPT+=-Ur
 # endif
 
+#override FPCOPT+=-a
+#override FPCOPT+=-al
+
+
 # for netware always use multithread
 override FPCOPT+=-dMT
 

rtl/netware/README

@@ -1,6 +1,8 @@
     News
     ====
 
+    2003/02/15 armin:
+     - changes for new threadvars
     2002/02/27 armin:
      - changes for current fpc 1.1
     2001/04/16 armin:
@@ -166,6 +168,10 @@
 
       I also have a compiled version of gdbserve.nlm for gdb on my homepage
       but this does not seem to be stable and will only run on netwar 4.x.
+      
+      I also have a patched version of novells RDebug, you can try
+      http://home.arcor.de/armin.diehl/fpcnw/Rdebug.exe
+      
 
     - Netware SDK
       -----------
@@ -204,6 +210,7 @@
         - CPU
         - MMX
 	- WinSock2
+	- SYSTHRDS
 
 
 [email protected]

rtl/netware/system.pp

@@ -51,7 +51,7 @@ type
    end;
 
 { include threading stuff }
-{$i threadh.inc}
+{ i threadh.inc}
 
 { include heap support headers }
 {$I heaph.inc}
@@ -85,6 +85,14 @@ PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl;
 PROCEDURE ConsolePrintf3 (FormatStr : PCHAR; P1,P2,P3 : LONGINT);  CDecl;
 PROCEDURE ConsolePrintf (FormatStr : PCHAR);  CDecl;
 
+type 
+  TSysCloseAllRemainingSemaphores = procedure;
+  TSysReleaseThreadVars = procedure;
+  TSysSetThreadDataAreaPtr = function (newPtr:pointer):pointer;
+  
+procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
+                                   rtv:TSysReleaseThreadVars;
+				   stdata:TSysSetThreadDataAreaPtr);
 
 implementation
 { Indicate that stack checking is taken care by OS}
@@ -107,6 +115,21 @@ begin
 end;
 }
 
+var 
+  CloseAllRemainingSemaphores : TSysCloseAllRemainingSemaphores = nil;
+  ReleaseThreadVars : TSysReleaseThreadVars = nil;
+  SetThreadDataAreaPtr : TSysSetThreadDataAreaPtr = nil;
+
+procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
+                                   rtv:TSysReleaseThreadVars;
+				   stdata:TSysSetThreadDataAreaPtr);
+begin
+  CloseAllRemainingSemaphores := crs;
+  ReleaseThreadVars := rtv;
+  SetThreadDataAreaPtr := stdata;
+end;  
+
+
 
 
 procedure PASCALMAIN;external name 'PASCALMAIN';
@@ -122,16 +145,11 @@ PROCEDURE nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nl
 BEGIN
   ArgC := _ArgC;
   ArgV := _ArgV;
+  fpc_threadvar_relocate_proc := nil;
   PASCALMAIN;
 END;
 
 
-{$ifdef MT}
-procedure CloseAllRemainingSemaphores; FORWARD;
-procedure ReleaseThreadVars; FORWARD;
-{$endif}
-
-
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
@@ -142,10 +160,9 @@ var SigTermHandlerActive : boolean;
 
 Procedure system_exit;
 begin
-{$ifdef MT}
-  CloseAllRemainingSemaphores;
-  ReleaseThreadVars;
-{$endif}
+  if assigned (CloseAllRemainingSemaphores) then CloseAllRemainingSemaphores;
+  if assigned (ReleaseThreadVars) then ReleaseThreadVars;
+
   FreeSbrkMem;            { free memory allocated by heapmanager }
 
   if not SigTermHandlerActive then
@@ -202,6 +219,10 @@ end;
                               Heap Management
 *****************************************************************************}
 
+var
+  heap : longint;external name 'HEAP';
+  intern_heapsize : longint;external name 'HEAPSIZE';
+
 { first address of heap }
 function getheapstart:pointer;
 assembler;
@@ -213,7 +234,7 @@ end ['EAX'];
 function getheapsize:longint;
 assembler;
 asm
-        movl    HEAPSIZE,%eax
+        movl    intern_HEAPSIZE,%eax
 end ['EAX'];
 
 const HeapInitialMaxBlocks = 32;
@@ -240,8 +261,8 @@ begin
       if HeapSbrkBlockList = nil then
       begin
         _free (P);
-    Sbrk := -1;
-    exit;
+        Sbrk := -1;
+        exit;
       end;
       fillchar (HeapSbrkBlockList^,sizeof(HeapSbrkBlockList^),0);
       HeapSbrkAllocated := HeapInitialMaxBlocks;
@@ -252,8 +273,8 @@ begin
       if p2 = nil then
       begin
         _free (P);
-    Sbrk := -1;
-    exit;
+         Sbrk := -1;
+         exit;
       end;
       inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
     end;
@@ -628,9 +649,6 @@ end;
                              Thread Handling
 *****************************************************************************}
 
-const
-  fpucw : word = $1332;
-
 procedure InitFPU;assembler;
 
   asm
@@ -639,9 +657,6 @@ procedure InitFPU;assembler;
   end;
 
 
-{ include threading stuff, this is os dependend part }
-{$I thread.inc}
-
 { if return-value is <> 0, netware shows the message
   Unload Anyway ?
   To Disable unload at all, SetNLMDontUnloadFlag can be used on
@@ -658,11 +673,13 @@ begin
     oldTG := _SetThreadGroupID (NetwareMainThreadGroupID);
     { to allow use of threadvars, we simply set the threadvar-memory
       from the main thread }
-    oldPtr:= _GetThreadDataAreaPtr;
-    _SaveThreadDataAreaPtr (thredvarsmainthread);
+    if assigned (SetThreadDataAreaPtr) then 
+      oldPtr := SetThreadDataAreaPtr (NIL);  { nil means main threadvars }
     result := 0;
     NetwareCheckFunction (result);
-    _SaveThreadDataAreaPtr (oldPtr);
+    if assigned (SetThreadDataAreaPtr) then
+      SetThreadDataAreaPtr (oldPtr);
+      
     _SetThreadGroupID (oldTG);
   end else
     result := 0;
@@ -729,35 +746,18 @@ begin
     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 }
-  oldPtr:= _GetThreadDataAreaPtr;
-  _SaveThreadDataAreaPtr (thredvarsmainthread);
+  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 }
-  _SaveThreadDataAreaPtr (oldPtr);
+  if assigned (SetThreadDataAreaPtr) then
+    SetThreadDataAreaPtr (oldPtr);  
   _SetThreadGroupID (oldTG);
 end;
 
 
-{*****************************************************************************
-                         SystemUnit Initialization
-*****************************************************************************}
-
-Begin
-   StackBottom := SPtr - StackLength;
-{$ifdef MT}
-  { the exceptions use threadvars so do this _before_ initexceptions }
-  AllocateThreadVars;
-{$endif MT}
-  SigTermHandlerActive := false;
-  NetwareCheckFunction := nil;
-  NetwareMainThreadGroupID := _GetThreadGroupID;
-
-  _Signal (_SIGTERM, @TermSigHandler);
-
-{ Setup heap }
-  InitHeap;
-  InitExceptions;
-
+procedure SysInitStdIO;
+begin
 { Setup stdin, stdout and stderr }
   StdInputHandle := _fileno (LONGINT (_GetStdIn^));    // GetStd** returns **FILE !
   StdOutputHandle:= _fileno (LONGINT (_GetStdOut^));
@@ -766,20 +766,36 @@ Begin
   OpenStdIO(Input,fmInput,StdInputHandle);
   OpenStdIO(Output,fmOutput,StdOutputHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-
+  
   {$ifdef StdErrToConsole}
   AssignStdErrConsole(StdErr);
   {$else}
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
   {$endif}
+end;
+
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+Begin
+  StackBottom := SPtr - StackLength;
+  SigTermHandlerActive := false;
+  NetwareCheckFunction := nil;
+  NetwareMainThreadGroupID := _GetThreadGroupID;
+
+  _Signal (_SIGTERM, @TermSigHandler);
+
+{ Setup heap }
+  InitHeap;
+  SysInitExceptions;
+  SysInitStdIO;
 
-{ Setup environment and arguments }
-  {Setup_Environment;
-  Setup_Arguments;
-}
 { Reset IO Error }
   InOutRes:=0;
-  {Delphi Compatible}
+
+{Delphi Compatible}
   IsLibrary := FALSE;
   IsConsole := TRUE;
   ExitCode  := 0;
@@ -789,7 +805,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.15  2002-10-13 09:28:45  florian
+  Revision 1.16  2003-02-15 19:12:54  armin
+  * changes for new threadvar support
+
+  Revision 1.15  2002/10/13 09:28:45  florian
     + call to initvariantmanager inserted
 
   Revision 1.14  2002/09/07 16:01:21  peter

rtl/netware/sysutils.pp

@@ -97,6 +97,12 @@ begin
   FileCreate:=_open(Pchar(FileName),O_RdWr or O_Creat or O_Trunc,0);
 end;
 
+Function FileCreate (Const FileName : String; mode:longint) : Longint;
+
+begin
+  FileCreate:=FileCreate (FileName);
+end;
+
 
 Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
 
@@ -481,7 +487,10 @@ end.
 {
 
   $Log$
-  Revision 1.7  2002-09-07 16:01:21  peter
+  Revision 1.8  2003-02-15 19:12:54  armin
+  * changes for new threadvar support
+
+  Revision 1.7  2002/09/07 16:01:21  peter
     * old logs removed and tabs fixed
 
   Revision 1.6  2002/04/01 10:47:31  armin

rtl/netware/tests/Makefile

@@ -2,11 +2,11 @@
 # Needs working nlmconv + i386-netware-ld
 # AD 8/2000
 
-UNITDIR = /usr/lib/fpc/1.1/units/netware/rtl
+UNITDIR = /usr/lib/fpc/1.1/cross/i386-netware/units/rtl
 PPC386OPT = -a -al -Or -O3 -XX -Tnetware -Fi$(UNITDIR)
 INCLUDES = -Fo$(UNITDIR) -Fu$(UNITDIR)
 
-OBJS = test.on
+OBJS = test.on thrd.on
 
 %.on:	%.pas
 	ppc386 $(PPC386OPT) $(INCLUDES) $*.pas
@@ -18,16 +18,11 @@ all:	$(OBJS)
 
 # mount netware and copy test.nlm to sys:test on 4.11 and 5.1 server
 install:	all
-	[ -d nw ] || mkdir nw
-	ncpmount -S FS-DEVELOP -U linux.home.ad -V sys -n nw
-	cp -f test.nlm nw/test/test.nlm
-	umount nw
-	ncpmount -S FS-AD -U linux.home.ad -V sys -n nw
-	cp -f test.nlm nw/test/test.nlm
-	umount nw
+	ncftpput -u linux -p linux fs-develop /sys/test *.nlm
+	ncftpput -u linux -p linux fs-ad /sys/test *.nlm
+
 
 clean:
 	rm -f *.on *.nlm *.ppn *.s *.bak *.o
-	[ -d nw ] && rmdir nw
 
 dist:		clean

rtl/netware/thread.inc

@@ -1,390 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001-2002 by the Free Pascal development team.
-
-    Multithreading implementation for NetWare
-
-    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.
-
- **********************************************************************}
-{$ifdef MT}
-
-{ Multithreading for netware, armin 16 Mar 2002
-  - threads are basicly tested and working
-  - threadvars should work but currently there is a bug in the
-    compiler preventing using multithreading
-  - TRTLCriticalSections are working but NEVER call Enter or
-    LeaveCriticalSection with uninitialized CriticalSections.
-    Critial Sections are based on local semaphores and the
-    Server will abend if the semaphore handles are invalid. There
-    are basic tests in the rtl but this will not work in every case.
-    Not closed semaphores will be closed by the rtl on program
-    termination because some versions of netware will abend if there
-    are open semaphores on nlm unload.
-}
-
-const
-   threadvarblocksize : dword = 0;     // total size of allocated threadvars
-   thredvarsmainthread: pointer = nil; // to free the threadvars in the signal handler
-
-type
-   tthreadinfo = record
-      f : tthreadfunc;
-      p : pointer;
-   end;
-   pthreadinfo = ^tthreadinfo;
-
-{ all needed import stuff is in nwsys.inc and already included by
-  system.pp }
-
-
-procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_INIT_THREADVAR'];
-begin
-  offset:=threadvarblocksize;
-  inc(threadvarblocksize,size);
-  {$ifdef DEBUG_MT}
-  ConsolePrintf3(#13'init_threadvar, new offset: (%d), Size:%d'#13#10,offset,size,0);
-  {$endif DEBUG_MT}
-end;
-
-type ltvInitEntry =
-  record
-    varaddr : pdword;
-    size    : longint;
-  end;
-  pltvInitEntry = ^ltvInitEntry;
-
-procedure init_unit_threadvars (tableEntry : pltvInitEntry);
-begin
-  while tableEntry^.varaddr <> nil do
-  begin
-    init_threadvar (tableEntry^.varaddr^, tableEntry^.size);
-    inc (pchar (tableEntry), sizeof (tableEntry^));
-  end;
-end;
-
-type TltvInitTablesTable =
-  record
-    count : dword;
-    tables: array [1..32767] of pltvInitEntry;
-  end;
-
-var
-  ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_LOCALTHREADVARTABLES';
-
-procedure init_all_unit_threadvars; [public,alias: 'FPC_INITIALIZELOCALTHREADVARS'];
-var i : integer;
-begin
-  {$ifdef DEBUG_MT}
-  ConsolePrintf(#13'init_all_unit_threadvars (%d) units'#13#10,ThreadvarTablesTable.count);
-  {$endif}
-  for i := 1 to ThreadvarTablesTable.count do
-  begin
-    {$ifdef DEBUG_MT}
-    ConsolePrintf(#13'init_unit_threadvars for unit (%d):'#13#10,i);
-    {$endif}
-    init_unit_threadvars (ThreadvarTablesTable.tables[i]);
-    {$ifdef DEBUG_MT}
-    ConsolePrintf(#13'init_unit_threadvars for unit (%d) done'#13#10,i);
-    {$endif}
-  end;
-end;
-
-{$ifdef DEBUG_MT}
-var dummy_buff : array [0..255] of char;  // to avoid abends (for current compiler error that not all threadvars are initialized)
-{$endif}
-
-function relocate_threadvar(offset : dword) : pointer;[public,alias: 'FPC_RELOCATE_THREADVAR'];
-var p : pointer;
-begin
- {$ifdef DEBUG_MT}
-//   ConsolePrintf(#13'relocate_threadvar, offset: (%d)'#13#10,offset);
-   if offset > threadvarblocksize then
-   begin
-//     ConsolePrintf(#13'relocate_threadvar, invalid offset'#13#10,0);
-     relocate_threadvar := @dummy_buff;
-     exit;
-   end;
- {$endif DEBUG_MT}
- relocate_threadvar:= _GetThreadDataAreaPtr + offset;
-end;
-
-procedure AllocateThreadVars;
-
-  var
-     threadvars : pointer;
-
-  begin
-     { we've to allocate the memory from netware }
-     { because the FPC heap management uses      }
-     { exceptions which use threadvars but       }
-     { these aren't allocated yet ...            }
-     { allocate room on the heap for the thread vars }
-     threadvars := _malloc (threadvarblocksize);
-     fillchar (threadvars^, threadvarblocksize, 0);
-     _SaveThreadDataAreaPtr (threadvars);
-     {$ifdef DEBUG_MT}
-       ConsolePrintf3(#13'threadvars allocated at (%x), size: %d'#13#10,longint(threadvars),threadvarblocksize,0);
-     {$endif DEBUG_MT}
-     if thredvarsmainthread = nil then
-       thredvarsmainthread := threadvars;
-  end;
-
-procedure ReleaseThreadVars;
-var threadvars : pointer;
-begin
-   { release thread vars }
-   if threadvarblocksize > 0 then
-   begin
-     threadvars:=_GetThreadDataAreaPtr;
-     if threadvars <> nil then
-     begin
-       {$ifdef DEBUG_MT}
-        ConsolePrintf (#13'free threadvars'#13#10,0);
-       {$endif DEBUG_MT}
-       _Free (threadvars);
-     end;
-  end;
-end;
-
-procedure InitThread;
-
-  begin
-     InitFPU;
-     { we don't need to set the data to 0 because we did this with }
-     { the fillchar above, but it looks nicer                      }
-
-     { ExceptAddrStack and ExceptObjectStack are threadvars       }
-     { so every thread has its on exception handling capabilities }
-     InitExceptions;
-     InOutRes:=0;
-     // ErrNo:=0;
-  end;
-
-procedure DoneThread;
-
-  begin
-     { release thread vars }
-     ReleaseThreadVars;
-  end;
-
-function ThreadMain(param : pointer) : dword; cdecl;
-
-  var
-     ti : tthreadinfo;
-
-  begin
-{$ifdef DEBUG_MT}
-     writeln('New thread started, initialising ...');
-{$endif DEBUG_MT}
-     AllocateThreadVars;
-     InitThread;
-     ti:=pthreadinfo(param)^;
-     dispose(pthreadinfo(param));
-{$ifdef DEBUG_MT}
-     writeln('Jumping to thread function');
-{$endif DEBUG_MT}
-     ThreadMain:=ti.f(ti.p);
-     DoneThread;
-  end;
-
-
-function BeginThread(sa : Pointer;stacksize : dword;
-  ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
-  var ThreadId : DWord) : DWord;
-
-  var ti : pthreadinfo;
-
-  begin
-{$ifdef DEBUG_MT}
-     writeln('Creating new thread');
-{$endif DEBUG_MT}
-     IsMultithread:=true;
-     { the only way to pass data to the newly created thread }
-     { in a MT safe way, is to use the heap                  }
-     new(ti);
-     ti^.f:=ThreadFunction;
-     ti^.p:=p;
-{$ifdef DEBUG_MT}
-     writeln('Starting new thread');
-{$endif DEBUG_MT}
-     BeginThread :=
-       _BeginThread (@ThreadMain,NIL,Stacksize,ti);
-  end;
-
-function BeginThread(ThreadFunction : tthreadfunc) : DWord;
-var dummy : dword;
-begin
-  BeginThread:=BeginThread(nil,0,ThreadFunction,nil,0,dummy);
-end;
-
-function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
-var dummy : dword;
-begin
-  BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,dummy);
-end;
-
-function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : DWord) : DWord;
-begin
-  BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,ThreadId);
-end;
-
-procedure EndThread(ExitCode : DWord);
-begin
-  DoneThread;
-  ExitThread(ExitCode, TSR_THREAD);
-end;
-
-procedure EndThread;
-begin
-  EndThread(0);
-end;
-
-
-{ netware requires all allocated semaphores }
-{ to be closed before terminating the nlm, otherwise }
-{ the server will abend (except for netware 6 i think) }
-
-TYPE TSemaList = ARRAY [1..1000] OF LONGINT;
-     PSemaList = ^TSemaList;
-
-CONST NumSemaOpen   : LONGINT = 0;
-      NumEntriesMax : LONGINT = 0;
-      SemaList      : PSemaList = NIL;
-
-PROCEDURE SaveSema (Handle : LONGINT);
-BEGIN
-  {$ifdef DEBUG_MT}
-     ConsolePrintf(#13'new Semaphore allocated (%x)'#13#10,Handle);
-  {$endif DEBUG_MT}
-  _EnterCritSec;
-  IF NumSemaOpen = NumEntriesMax THEN
-  BEGIN
-    IF SemaList = NIL THEN
-    BEGIN
-      SemaList := _malloc (32 * SIZEOF (TSemaList[0]));
-      NumEntriesMax := 32;
-    END ELSE
-    BEGIN
-      INC (NumEntriesMax, 16);
-      SemaList := _realloc (SemaList, NumEntriesMax * SIZEOF (TSemaList[0]));
-    END;
-  END;
-  INC (NumSemaOpen);
-  SemaList^[NumSemaOpen] := Handle;
-  _ExitCritSec;
-END;
-
-PROCEDURE ReleaseSema (Handle : LONGINT);
-VAR I : LONGINT;
-BEGIN
-  {$ifdef DEBUG_MT}
-     ConsolePrintf(#13'Semaphore released (%x)'#13#10,Handle);
-  {$endif DEBUG_MT}
-  _EnterCritSec;
-  IF SemaList <> NIL then
-    if NumSemaOpen > 0 then
-    begin
-      for i := 1 to NumSemaOpen do
-        if SemaList^[i] = Handle then
-        begin
-          if i < NumSemaOpen then
-            SemaList^[i] := SemaList^[NumSemaOpen];
-          dec (NumSemaOpen);
-          _ExitCritSec;
-          exit;
-        end;
-    end;
-  _ExitCritSec;
-  ConsolePrintf (#13'fpc-rtl: ReleaseSema, Handle not found'#13#10,0);
-END;
-
-
-PROCEDURE CloseAllRemainingSemaphores;
-var i : LONGINT;
-begin
-  IF SemaList <> NIL then
-  begin
-    if NumSemaOpen > 0 then
-      for i := 1 to NumSemaOpen do
-        _CloseLocalSemaphore (SemaList^[i]);
-     _free (SemaList);
-     SemaList := NIL;
-     NumSemaOpen := 0;
-     NumEntriesMax := 0;
-  end;
-end;
-
-{ this allows to do a lot of things in MT safe way }
-{ it is also used to make the heap management      }
-{ thread safe                                      }
-procedure InitCriticalSection(var cs : TRTLCriticalSection);
-begin
-  cs.SemaHandle := _OpenLocalSemaphore (1);
-  if cs.SemaHandle <> 0 then
-  begin
-    cs.SemaIsOpen := true;
-    SaveSema (cs.SemaHandle);
-  end else
-  begin
-    cs.SemaIsOpen := false;
-    ConsolePrintf (#13'fpc-rtl: InitCriticalsection, OpenLocalSemaphore returned error'#13#10,0);
-  end;
-end;
-
-procedure DoneCriticalsection(var cs : TRTLCriticalSection);
-begin
-  if cs.SemaIsOpen then
-  begin
-    _CloseLocalSemaphore (cs.SemaHandle);
-    ReleaseSema (cs.SemaHandle);
-    cs.SemaIsOpen := FALSE;
-  end;
-end;
-
-procedure EnterCriticalsection(var cs : TRTLCriticalSection);
-begin
-  if cs.SemaIsOpen then
-    _WaitOnLocalSemaphore (cs.SemaHandle)
-  else
-    ConsolePrintf (#13'fpc-rtl: EnterCriticalsection, TRTLCriticalSection not open'#13#10,0);
-end;
-
-procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
-begin
-  if cs.SemaIsOpen then
-    _SignalLocalSemaphore (cs.SemaHandle)
-  else
-    ConsolePrintf (#13'fpc-rtl: LeaveCriticalsection, TRTLCriticalSection not open'#13#10,0);
-end;
-
-
-{$endif MT}
-
-{
-  $Log$
-  Revision 1.5  2002-09-07 16:01:21  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.4  2002/04/01 15:20:08  armin
-  + unload module no longer shows: Module did not release...
-  + check-function will no longer be removed when smartlink is on
-
-  Revision 1.3  2002/04/01 10:47:31  armin
-  makefile.fpc for netware
-  stderr to netware console
-  free all memory (threadvars and heap) to avoid error message while unloading nlm
-
-  Revision 1.2  2002/03/28 16:11:17  armin
-  + initialize threadvars defined local in units
-
-  Revision 1.1  2002/03/17 17:57:33  armin
-  + threads and winsock2 implemented
-
-}

rtl/netware/winsock2.pp

@@ -35,7 +35,7 @@ unit winsock2;
   interface
 
     uses
-       os_types,netware;
+       netware;
 
     const
        {
@@ -47,6 +47,11 @@ unit winsock2;
        FD_SETSIZE = 64;
 
     type
+       tOS_INT  = LongInt;
+       tOS_UINT = DWord;
+       ptOS_INT = ^tOS_INT;
+       ptOS_UINT = ^tOS_UINT;
+    
        u_char = char;
        u_short = word;
        u_int = tOS_UINT;