mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-22 22:51:40 +02:00
* exiting threads at nlm unload
This commit is contained in:
armin
parent
173aea0681
commit
0f1fec0de1
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/16]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/22]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=netware
|
||||
@ -225,8 +225,8 @@ else
|
||||
SYSTEMUNIT=sysnetwa
|
||||
endif
|
||||
override FPCOPT+=-Ur
|
||||
override FPCOPT+=-dMT -dDEBUG_MT
|
||||
CREATESMART=0
|
||||
override FPCOPT+=-dMT
|
||||
CREATESMART=1
|
||||
OBJPASDIR=$(RTL)/objpas
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings lineinfo winsock heaptrc matrix initc dos crt objects sysutils classes typinfo math varutils cpu mmx getopts sockets video mouse keyboard types dateutils rtlconst sysconst strutils convutils aio nwsnut nwserv nwnit nwprot
|
||||
override TARGET_LOADERS+=nwpre prelude
|
||||
|
||||
@ -60,11 +60,10 @@ override FPCOPT+=-Ur
|
||||
|
||||
|
||||
# for netware always use multithread
|
||||
override FPCOPT+=-dMT -dDEBUG_MT
|
||||
override FPCOPT+=-dMT
|
||||
|
||||
# and alway use smartlinking
|
||||
#CREATESMART=1
|
||||
CREATESMART=0
|
||||
CREATESMART=1
|
||||
|
||||
# Paths
|
||||
OBJPASDIR=$(RTL)/objpas
|
||||
|
||||
@ -38,10 +38,20 @@ implementation
|
||||
{ OS - independent class implementations are in /inc directory. }
|
||||
{$i classes.inc}
|
||||
|
||||
initialization
|
||||
CommonInit;
|
||||
|
||||
finalization
|
||||
DoneThreads;
|
||||
CommonCleanup;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2004-08-01 20:02:48 armin
|
||||
Revision 1.5 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.4 2004/08/01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
|
||||
@ -1929,5 +1929,8 @@
|
||||
y1,
|
||||
YearsSince1970,
|
||||
yn,
|
||||
__ZBuf2F
|
||||
__ZBuf2F,
|
||||
# GetKey,UnGetKey from server.nlm (or syscalls)
|
||||
GetKey,
|
||||
UngetKey
|
||||
|
||||
|
||||
@ -961,6 +961,46 @@ const
|
||||
_SCREEN_HAS_TITLE_BAR = $00400000;
|
||||
_NON_SWITCHABLE_SCREEN = $01000000;
|
||||
|
||||
{ key types... }
|
||||
NORMAL_KEY = $00;
|
||||
FUNCTION_KEY = $01;
|
||||
ENTER_KEY = $02;
|
||||
ESCAPE_KEY = $03;
|
||||
BACKSPACE_KEY = $04;
|
||||
DELETE_KEY = $05;
|
||||
INSERT_KEY = $06;
|
||||
CURSOR_UP_KEY = $07;
|
||||
CURSOR_DOWN_KEY = $08;
|
||||
CURSOR_RIGHT_KEY = $09;
|
||||
CURSOR_LEFT_KEY = $0A;
|
||||
CURSOR_HOME_KEY = $0B;
|
||||
CURSOR_END_KEY = $0C;
|
||||
CURSOR_PUP_KEY = $0D;
|
||||
CURSOR_PDOWN_KEY = $0E;
|
||||
{ some name equivalents... }
|
||||
ENTER = $0D;
|
||||
ESCAPE = $1B;
|
||||
BACKSPACE = $08;
|
||||
{ modifier code constituents... }
|
||||
SHIFT_KEY_HELD = $01;
|
||||
CTRL_KEY_HELD = $04;
|
||||
ALT_KEY_HELD = $08;
|
||||
CAPS_LOCK_IS_ON = $40;
|
||||
NUM_LOCK_IS_ON = $20;
|
||||
SCROLL_LOCK_IS_ON = $10;
|
||||
|
||||
{ cursor types... }
|
||||
CURSOR_NORMAL = $0C0B;
|
||||
CURSOR_THICK = $0C09;
|
||||
CURSOR_BLOCK = $0C00;
|
||||
CURSOR_TOP = $0400;
|
||||
|
||||
type // libc compatible
|
||||
Pscr_t = ^scr_t;
|
||||
scr_t = pointer;
|
||||
TScr = scr_t;
|
||||
PScr = Pscr_t;
|
||||
|
||||
function getch:longint; cdecl; external 'clib' name 'getch';
|
||||
function getche:longint; cdecl; external 'clib' name 'getche';
|
||||
function kbhit:longint; cdecl; external 'clib' name 'kbhit';
|
||||
@ -968,6 +1008,7 @@ function putch(c:longint):longint; cdecl; external 'clib' name 'putch';
|
||||
function ungetch(c:longint):longint; cdecl; external 'clib' name 'ungetch';
|
||||
function cgets(buf:Pchar):Pchar; cdecl; external 'clib' name 'cgets';
|
||||
function CheckIfScreenDisplayed(screenHandle,waitFlag:longint):longint; cdecl; external 'clib' name 'CheckIfScreenDisplayed';
|
||||
function CheckIfScreenDisplayed(screenHandle:TScr;waitFlag:longint):longint; cdecl; external 'clib' name 'CheckIfScreenDisplayed';
|
||||
procedure clrscr; cdecl; external 'clib' name 'clrscr';
|
||||
procedure ConsolePrintf(format:Pchar; args:array of const); cdecl; external 'clib' name 'ConsolePrintf';
|
||||
procedure ConsolePrintf(format:Pchar); cdecl; external 'clib' name 'ConsolePrintf';
|
||||
@ -979,15 +1020,20 @@ function CoupleInputOutputCursors:longint; cdecl; external 'clib' name 'CoupleIn
|
||||
function cputs(buf:Pchar):longint; cdecl; external 'clib' name 'cputs';
|
||||
function cprintf(fmt:Pchar; args:array of const):longint; cdecl; external 'clib' name 'cprintf';
|
||||
function cprintf(fmt:Pchar):longint; cdecl; external 'clib' name 'cprintf';
|
||||
function CreateScreen(screenName:Pchar; attr:byte):longint; cdecl; external 'clib' name 'CreateScreen';
|
||||
//function CreateScreen(screenName:Pchar; attr:byte):longint; cdecl; external 'clib' name 'CreateScreen';
|
||||
function CreateScreen(screenName:Pchar; attr:byte):TScr; cdecl; external 'clib' name 'CreateScreen';
|
||||
function cscanf(fmt:Pchar; args:array of const):longint; cdecl; external 'clib' name 'cscanf';
|
||||
function cscanf(fmt:Pchar):longint; cdecl; external 'clib' name 'cscanf';
|
||||
function DecoupleInputOutputCursors:longint; cdecl; external 'clib' name 'DecoupleInputOutputCursors';
|
||||
function DestroyScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'DestroyScreen';
|
||||
function DestroyScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'DestroyScreen';
|
||||
function DisplayInputCursor:longint; cdecl; external 'clib' name 'DisplayInputCursor';
|
||||
function DisplayScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'DisplayScreen';
|
||||
function DisplayScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'DisplayScreen';
|
||||
function DropPopUpScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'DropPopUpScreen';
|
||||
function GetCurrentScreen:longint; cdecl; external 'clib' name 'GetCurrentScreen';
|
||||
function DropPopUpScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'DropPopUpScreen';
|
||||
//function GetCurrentScreen:longint; cdecl; external 'clib' name 'GetCurrentScreen';
|
||||
function GetCurrentScreen:TScr; cdecl; external 'clib' name 'GetCurrentScreen';
|
||||
function GetCursorCouplingMode:byte; cdecl; external 'clib' name 'GetCursorCouplingMode';
|
||||
function GetCursorShape(startline,endline:PBYTE):word; cdecl; external 'clib' name 'GetCursorShape';
|
||||
function GetCursorShape(var startline,endline:byte):word; cdecl; external 'clib' name 'GetCursorShape';
|
||||
@ -996,6 +1042,7 @@ function GetCursorSize(var firstline,lastline:byte):word; cdecl; external 'clib'
|
||||
function GetPositionOfOutputCursor(rowP,columnP:PWORD):longint; cdecl; external 'clib' name 'GetPositionOfOutputCursor';
|
||||
function GetPositionOfOutputCursor(var row,col:word):longint; cdecl; external 'clib' name 'GetPositionOfOutputCursor';
|
||||
function __GetScreenID(screenHandle:longint):longint; cdecl; external 'clib' name '__GetScreenID';
|
||||
function __GetScreenID(screenHandle:TScr):longint; cdecl; external 'clib' name '__GetScreenID';
|
||||
function GetScreenInfo(handle:longint; name:Pchar; attr:plongint):longint; cdecl; external 'clib' name 'GetScreenInfo';
|
||||
function GetScreenInfo(handle:longint; name:Pchar; var attr:longint):longint; cdecl; external 'clib' name 'GetScreenInfo';
|
||||
function GetSizeOfScreen(heightP,widthP:PWORD):longint; cdecl; external 'clib' name 'GetSizeOfScreen';
|
||||
@ -1004,10 +1051,17 @@ procedure gotoxy(col,row:word); cdecl; external 'clib' name 'gotoxy';
|
||||
function HideInputCursor:longint; cdecl; external 'clib' name 'HideInputCursor';
|
||||
function IsColorMonitor:longint; cdecl; external 'clib' name 'IsColorMonitor';
|
||||
function PressAnyKeyToContinue:longint; cdecl; external 'clib' name 'PressAnyKeyToContinue';
|
||||
function PressAnyKey:longint; cdecl; external 'clib' name 'PressAnyKeyToContinue';
|
||||
function PressEscapeToQuit:longint; cdecl; external 'clib' name 'PressEscapeToQuit';
|
||||
function PressEscape:longint; cdecl; external 'clib' name 'PressEscapeToQuit';
|
||||
procedure RingTheBell; cdecl; external 'clib' name 'RingTheBell';
|
||||
procedure RingBell; cdecl; external 'clib' name 'RingTheBell';
|
||||
|
||||
function ScanScreens(LastScreenID:longint; name:Pchar; attr:plongint):longint; cdecl; external 'clib' name 'ScanScreens';
|
||||
function ScanScreens(LastScreenID:longint; name:Pchar; var attr:longint):longint; cdecl; external 'clib' name 'ScanScreens';
|
||||
function ScanScreens(LastScreenID:TScr; name:Pchar; attr:plongint):TScr; cdecl; external 'clib' name 'ScanScreens';
|
||||
function ScanScreens(LastScreenID:TScr; name:Pchar; var attr:longint):TScr; cdecl; external 'clib' name 'ScanScreens';
|
||||
|
||||
function ScrollScreenRegionDown(firstLine,numLines:longint):longint; cdecl; external 'clib' name 'ScrollScreenRegionDown';
|
||||
function ScrollScreenRegionUp(firstLine,numLines:longint):longint; cdecl; external 'clib' name 'ScrollScreenRegionUp';
|
||||
function SetAutoScreenDestructionMode(newMode:byte):byte; cdecl; external 'clib' name 'SetAutoScreenDestructionMode';
|
||||
@ -1015,6 +1069,7 @@ function SetCtrlCharCheckMode(newMode:byte):byte; cdecl; external 'clib' name 'S
|
||||
function SetCursorCouplingMode(newMode:byte):byte; cdecl; external 'clib' name 'SetCursorCouplingMode';
|
||||
function SetCursorShape(startline,endline:byte):word; cdecl; external 'clib' name 'SetCursorShape';
|
||||
function SetCurrentScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'SetCurrentScreen';
|
||||
function SetCurrentScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'SetCurrentScreen';
|
||||
function SetInputAtOutputCursorPosition:longint; cdecl; external 'clib' name 'SetInputAtOutputCursorPosition';
|
||||
function SetOutputAtInputCursorPosition:longint; cdecl; external 'clib' name 'SetOutputAtInputCursorPosition';
|
||||
function SetPositionOfInputCursor(row,col:word):longint; cdecl; external 'clib' name 'SetPositionOfInputCursor';
|
||||
@ -1024,6 +1079,14 @@ function SetScreenCharacterAttribute(line,column,attr:longint):longint; cdecl; e
|
||||
function SetScreenRegionAttribute(firstLine,numLines:longint; attr:byte):longint; cdecl; external 'clib' name 'SetScreenRegionAttribute';
|
||||
function wherex:word; cdecl; external 'clib' name 'wherex';
|
||||
function wherey:word; cdecl; external 'clib' name 'wherey';
|
||||
|
||||
procedure GetKey(scrID:TScr; _type,value,status,scancode:Pbyte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
|
||||
procedure GetKey(scrID:TScr; var _type,value,status,scancode:byte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
|
||||
procedure GetKey(scrID:Longint; _type,value,status,scancode:Pbyte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
|
||||
procedure GetKey(scrID:Longint; var _type,value,status,scancode:byte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
|
||||
|
||||
function UngetKey(scrID:TScr; _type,value,status,scancode:byte):longint;cdecl;external 'clib' name 'UngetKey';
|
||||
function UngetKey(scrID:Longint; _type,value,status,scancode:byte):longint;cdecl;external 'clib' name 'UngetKey';
|
||||
{-nwconn.h---------------------------------------------------------------------}
|
||||
{ Structures and typedefs for connection services }
|
||||
|
||||
@ -3356,9 +3419,9 @@ function __get_stdin:PPFILE;cdecl;external 'clib' name '__get_stdin';
|
||||
function __get_stdout:PPFILE;cdecl;external 'clib' name '__get_stdout';
|
||||
function __get_stderr:PPFILE;cdecl;external 'clib' name '__get_stderr';
|
||||
|
||||
function stdin : PFILE;
|
||||
function stdout : PFILE;
|
||||
function stderr : PFILE;
|
||||
function __stdin : PFILE;
|
||||
function __stdout : PFILE;
|
||||
function __stderr : PFILE;
|
||||
{-stdlib.h---------------------------------------------------------------------}
|
||||
{$PACKRECORDS C}
|
||||
|
||||
@ -3395,7 +3458,7 @@ function atol(para1:Pchar):longint;cdecl;external 'clib' name 'atol';
|
||||
function bsearch(para1,para2:pointer; para3,para4:Tsize_t; para5:TBsearchFunc):pointer;cdecl;external 'clib' name 'bsearch';
|
||||
function calloc(para1:Tsize_t; para2:Tsize_t):pointer;cdecl;external 'clib' name 'calloc';
|
||||
function _div(para1,para2:longint):Tdiv_t;cdecl;external 'clib' name 'div';
|
||||
procedure exit(para1:longint);cdecl;external 'clib' name 'exit';
|
||||
//procedure exit(para1:longint);cdecl;external 'clib' name 'exit';
|
||||
procedure _exit(para1:longint);cdecl;external 'clib' name '_exit';
|
||||
function getenv(para1:Pchar):Pchar;cdecl;external 'clib' name 'getenv';
|
||||
function labs(para1:longint):longint;cdecl;external 'clib' name 'labs';
|
||||
@ -3452,24 +3515,30 @@ const
|
||||
type TPipeFiledes = array [0..1] of longint;
|
||||
|
||||
function access(path:Pchar; mode:longint):longint;cdecl;external 'clib' name 'access';
|
||||
function chdir(path:Pchar):longint;cdecl;external 'clib' name 'chdir';
|
||||
function _chdir(path:Pchar):longint;cdecl;external 'clib' name 'chdir';
|
||||
function Fpchdir(path:Pchar):longint;cdecl;external 'clib' name 'chdir';
|
||||
function chsize(fildes:longint; size:dword):longint;cdecl;external 'clib' name 'chsize';
|
||||
function close(fildes:longint):longint;cdecl;external 'clib' name 'close';
|
||||
function _close(fildes:longint):longint;cdecl;external 'clib' name 'close';
|
||||
function Fpclose(fildes:longint):longint;cdecl;external 'clib' name 'close';
|
||||
function dup(fildes:longint):longint;cdecl;external 'clib' name 'dup';
|
||||
function dup2(fildes1:longint; fildes2:longint):longint;cdecl;external 'clib' name 'dup2';
|
||||
function eof(fildes:longint):longint;cdecl;external 'clib' name 'eof';
|
||||
function _eof(fildes:longint):longint;cdecl;external 'clib' name 'eof';
|
||||
function Fpeof(fildes:longint):longint;cdecl;external 'clib' name 'eof';
|
||||
function getcwd(path:Pchar; len:Tsize_t):Pchar;cdecl;external 'clib' name 'getcwd';
|
||||
function isatty(fildes:longint):longint;cdecl;external 'clib' name 'isatty';
|
||||
function lseek(fildes:longint; offset:Toff_t; whence:longint):Toff_t;cdecl;external 'clib' name 'lseek';
|
||||
function pipe(fildes:TPipeFiledes):longint;cdecl;external 'clib' name 'pipe';
|
||||
function read(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'read';
|
||||
function _read(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'read';
|
||||
function Fpread(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'read';
|
||||
function rmdir(path:Pchar):longint;cdecl;external 'clib' name 'rmdir';
|
||||
function unlink(path:Pchar):longint;cdecl;external 'clib' name 'unlink';
|
||||
function write(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
|
||||
function _write(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
|
||||
function Fpwrite(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
|
||||
function pread(fildes:longint; buf:pointer; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pread';
|
||||
function pwrite(fildes:longint; buf:pointer; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pwrite';
|
||||
|
||||
function write(fildes:longint; var buf; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
|
||||
function _write(fildes:longint; var buf; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
|
||||
function Fpwrite(fildes:longint; var buf; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
|
||||
function pread(fildes:longint; var buf; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pread';
|
||||
function pwrite(fildes:longint; var buf; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pwrite';
|
||||
{-libcclib.h-------------------------------------------------------------------}
|
||||
@ -3702,6 +3771,7 @@ procedure TicksToSeconds(Ticks:longint; Seconds:Plongint; TenthsOfSeconds:Plongi
|
||||
function GetThreadHandicap(threadID:longint):longint; cdecl;external ThreadsNlm name 'GetThreadHandicap';
|
||||
function GetThreadID:longint; cdecl;external ThreadsNlm name 'GetThreadID';
|
||||
function GetThreadName(threadID:longint; tName:Pchar):longint; cdecl;external ThreadsNlm name 'GetThreadName';
|
||||
function GetThreadName(threadID:longint; var tName):longint; cdecl;external ThreadsNlm name 'GetThreadName';
|
||||
function MapNLMIDToHandle(NLMID:longint):longint; cdecl;external ThreadsNlm name 'MapNLMIDToHandle';
|
||||
function PopThreadCleanup(execute:longint):TCLEANUP; cdecl;external ThreadsNlm name 'PopThreadCleanup';
|
||||
function PopThreadGroupCleanup(execute:longint):TCLEANUP; cdecl;external ThreadsNlm name 'PopThreadGroupCleanup';
|
||||
@ -4709,19 +4779,19 @@ begin
|
||||
NetWareErrno := __get_NWErrno_ptr()^;
|
||||
end;
|
||||
|
||||
function stdin : PFILE;
|
||||
function __stdin : PFILE;
|
||||
begin
|
||||
stdin := __get_stdin^;
|
||||
__stdin := __get_stdin^;
|
||||
end;
|
||||
|
||||
function stdout : PFILE;
|
||||
function __stdout : PFILE;
|
||||
begin
|
||||
stdout := __get_stdout^;
|
||||
__stdout := __get_stdout^;
|
||||
end;
|
||||
|
||||
function stderr : PFILE;
|
||||
function __stderr : PFILE;
|
||||
begin
|
||||
stderr := __get_stderr^;
|
||||
__stderr := __get_stderr^;
|
||||
end;
|
||||
|
||||
function bisecond(var a : TDOSTime) : word;
|
||||
@ -4819,7 +4889,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2003-03-25 18:09:25 armin
|
||||
Revision 1.3 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.2 2003/03/25 18:09:25 armin
|
||||
* removed cvars because of problems with nlmconv
|
||||
|
||||
Revision 1.1 2003/02/22 18:23:26 armin
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2000 by the Free Pascal development team
|
||||
Copyright (c) 2001 Armin Diehl
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team
|
||||
Copyright (c) 2001-2004 Armin Diehl
|
||||
|
||||
Interface to netware clib
|
||||
|
||||
@ -17,6 +17,7 @@
|
||||
|
||||
|
||||
CONST Clib = 'clib';
|
||||
ThreadsNlm = 'threads';
|
||||
|
||||
TYPE
|
||||
dev_t = LONGINT;
|
||||
@ -69,9 +70,16 @@ FUNCTION _BeginThread (func, stack : pointer; Stacksize : LONGINT; arg : pointer
|
||||
FUNCTION _GetThreadDataAreaPtr : POINTER; CDecl; EXTERNAL CLib NAME 'GetThreadDataAreaPtr';
|
||||
PROCEDURE _SaveThreadDataAreaPtr (P : POINTER); CDecl; EXTERNAL CLib NAME 'SaveThreadDataAreaPtr';
|
||||
PROCEDURE _exit (ExitCode : LONGINT); CDecl; EXTERNAL CLib;
|
||||
function _SuspendThread(threadID:longint):longint; cdecl;external ThreadsNlm name 'SuspendThread';
|
||||
function _GetThreadID:longint; cdecl;external ThreadsNlm name 'GetThreadID';
|
||||
procedure _ThreadSwitchWithDelay; cdecl;external ThreadsNlm name 'ThreadSwitchWithDelay';
|
||||
function _GetThreadName(threadID:longint; var tName):longint; cdecl;external ThreadsNlm name 'GetThreadName';
|
||||
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
PROCEDURE ConsolePrintf3 (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : pchar); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR; P1,P2,P3,P4 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
|
||||
// this gives internal compiler error 1234124 ??
|
||||
//PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : array of const); CDecl; EXTERNAL CLib;
|
||||
@ -361,7 +369,10 @@ function spawnvp(mode:longint; path:Pchar; argv:PPchar):longint;cdecl;external C
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2004-08-01 20:02:48 armin
|
||||
Revision 1.11 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.10 2004/08/01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
|
||||
@ -11,8 +11,8 @@
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$mode objfpc}
|
||||
{$R-}
|
||||
unit Sockets;
|
||||
|
||||
Interface
|
||||
@ -20,9 +20,10 @@ Interface
|
||||
{$macro on}
|
||||
{$define maybelibc:=}
|
||||
|
||||
{$R-}
|
||||
|
||||
Uses
|
||||
winsock;
|
||||
Uses
|
||||
winsock;
|
||||
|
||||
Type
|
||||
cushort=word;
|
||||
@ -52,6 +53,14 @@ Implementation
|
||||
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);
|
||||
@ -92,7 +101,7 @@ 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^);
|
||||
fpRecvFrom:=WinSock.RecvFrom(S,Buf,Len,Flags,Winsock.TSockAddr(from^),FromLen^);
|
||||
if fpRecvFrom<0 then
|
||||
SocketError:=WSAGetLastError
|
||||
else
|
||||
@ -167,7 +176,7 @@ end;
|
||||
|
||||
function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
|
||||
begin
|
||||
fpAccept:=WinSock.Accept(S,WinSock.PSockAddr(Addrx),plongint(@AddrLen));
|
||||
fpAccept:=WinSock.Accept(S,WinSock.PSockAddr(Addrx),plongint(AddrLen));
|
||||
if fpAccept<0 then
|
||||
SocketError:=WSAGetLastError
|
||||
else
|
||||
@ -214,7 +223,7 @@ end;
|
||||
|
||||
function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
|
||||
begin
|
||||
fpsocketpair := -1;
|
||||
fpSocketPair := -1;
|
||||
end;
|
||||
|
||||
Function CloseSocket(Sock:Longint):Longint;
|
||||
@ -285,7 +294,7 @@ end;
|
||||
|
||||
Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
|
||||
begin
|
||||
// SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);a
|
||||
// SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
|
||||
SocketPair := -1;
|
||||
end;
|
||||
|
||||
@ -385,7 +394,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2004-09-18 23:45:43 armin
|
||||
Revision 1.7 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.6 2004/09/18 23:45:43 armin
|
||||
* make winsock more compatible to win32 version
|
||||
|
||||
Revision 1.5 2004/07/30 15:05:25 armin
|
||||
|
||||
@ -69,14 +69,18 @@ VAR
|
||||
NetwareCheckFunction : TNWCheckFunction;
|
||||
NetwareMainThreadGroupID: longint;
|
||||
NetwareCodeStartAddress : dword;
|
||||
NetwareUnloadProc : pointer = nil; {like exitProc but for nlm unload only}
|
||||
|
||||
CONST
|
||||
envp : ppchar = nil; {dummy to make heaptrc happy}
|
||||
|
||||
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl;
|
||||
PROCEDURE ConsolePrintf3 (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl;
|
||||
PROCEDURE ConsolePrintf (FormatStr : PCHAR); CDecl;
|
||||
procedure ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl;
|
||||
procedure ConsolePrintf (FormatStr : PCHAR; Param : pchar); CDecl;
|
||||
procedure ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT); CDecl;
|
||||
procedure ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl;
|
||||
procedure ConsolePrintf (FormatStr : PCHAR); CDecl;
|
||||
procedure __EnterDebugger; cdecl;
|
||||
|
||||
type
|
||||
TSysCloseAllRemainingSemaphores = procedure;
|
||||
@ -105,6 +109,9 @@ var
|
||||
CloseAllRemainingSemaphores : TSysCloseAllRemainingSemaphores = nil;
|
||||
ReleaseThreadVars : TSysReleaseThreadVars = nil;
|
||||
SetThreadDataAreaPtr : TSysSetThreadDataAreaPtr = nil;
|
||||
TerminatingThreadID : longint = 0; {used for unload, the signal handler will}
|
||||
{be called from the console thread. avoid}
|
||||
{calling _exit in another thread}
|
||||
|
||||
procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
|
||||
rtv:TSysReleaseThreadVars;
|
||||
@ -115,7 +122,7 @@ begin
|
||||
SetThreadDataAreaPtr := stdata;
|
||||
end;
|
||||
|
||||
|
||||
procedure __EnterDebugger; cdecl; external 'clib' name 'EnterDebugger';
|
||||
|
||||
|
||||
procedure PASCALMAIN;external name 'PASCALMAIN';
|
||||
@ -161,6 +168,18 @@ var SigTermHandlerActive : boolean;
|
||||
|
||||
Procedure system_exit;
|
||||
begin
|
||||
if TerminatingThreadID <> 0 then
|
||||
if TerminatingThreadID <> ThreadId then
|
||||
if TerminatingThreadID <> _GetThreadID then
|
||||
begin
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf ('Terminating Thread %x because halt was called while Thread %x terminates nlm'#13#10,_GetThreadId,TerminatingThreadId);
|
||||
{$endif}
|
||||
ExitThread (EXIT_THREAD,0);
|
||||
// only for the case ExitThread fails
|
||||
while true do
|
||||
_ThreadSwitchWithDelay;
|
||||
end;
|
||||
if assigned (CloseAllRemainingSemaphores) then CloseAllRemainingSemaphores;
|
||||
if assigned (ReleaseThreadVars) then ReleaseThreadVars;
|
||||
|
||||
@ -812,7 +831,13 @@ end;
|
||||
procedure TermSigHandler (Sig:longint); CDecl;
|
||||
var oldTG : longint;
|
||||
oldPtr: pointer;
|
||||
err : longint;
|
||||
current_exit : procedure;
|
||||
ThreadName : array [0..20] of char;
|
||||
HadExitProc : boolean;
|
||||
Count : longint;
|
||||
begin
|
||||
|
||||
oldTG := _SetThreadGroupID (NetwareMainThreadGroupID); { this is only needed for nw 3.11 }
|
||||
|
||||
{ _GetThreadDataAreaPtr will not be valid because the signal
|
||||
@ -821,18 +846,81 @@ begin
|
||||
here }
|
||||
if assigned (SetThreadDataAreaPtr) then
|
||||
oldPtr := SetThreadDataAreaPtr (NIL); { nil means main thread }
|
||||
|
||||
{this signal handler is called within the console command
|
||||
thread, the main thread is still running. Via NetwareUnloadProc
|
||||
running threads may terminate itself}
|
||||
TerminatingThreadID := _GetThreadID;
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'TermSigHandler Called, MainThread:%x, OurThread: %x'#13#10,ThreadId,TerminatingThreadId);
|
||||
if NetwareUnloadProc <> nil then
|
||||
ConsolePrintf (#13'Calling NetwareUnloadProcs'#13#10);
|
||||
{$endif}
|
||||
HadExitProc := false;
|
||||
{we need to finalize winock to release threads
|
||||
waiting on a blocking socket call. If that thread
|
||||
calls halt, we have to avoid that unit finalization
|
||||
is called by that thread because we are doing it
|
||||
here
|
||||
|
||||
like the old exitProc, mainly to allow winsock to release threads
|
||||
blocking in a winsock calls }
|
||||
while NetwareUnloadProc<>nil Do
|
||||
Begin
|
||||
InOutRes:=0;
|
||||
current_exit:=tProcedure(NetwareUnloadProc);
|
||||
NetwareUnloadProc:=nil;
|
||||
current_exit();
|
||||
_ThreadSwitchWithDelay;
|
||||
hadExitProc := true;
|
||||
End;
|
||||
|
||||
err := 0;
|
||||
if hadExitProc then
|
||||
begin {give the main thread a little bit of time to terminate}
|
||||
count := 0;
|
||||
repeat
|
||||
err := _GetThreadName(ThreadID,ThreadName);
|
||||
if err = 0 then _Delay (200);
|
||||
inc(count);
|
||||
until (err <> 0) or (count > 100); {about 20 seconds}
|
||||
{$ifdef DEBUG_MT}
|
||||
if err = 0 then
|
||||
ConsolePrintf (#13,'Main Thread not terminated'#13#10)
|
||||
else
|
||||
ConsolePrintf (#13'Main Thread has ended'#13#10);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
if err = 0 then
|
||||
{$ifdef DEBUG_MT}
|
||||
begin
|
||||
err := _SuspendThread(ThreadId);
|
||||
ConsolePrintf (#13'SuspendThread(%x) returned %d'#13#10,ThreadId,err);
|
||||
end;
|
||||
{$else}
|
||||
_SuspendThread(ThreadId);
|
||||
{$endif}
|
||||
_ThreadSwitchWithDelay;
|
||||
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'Calling do_exit'#13#10);
|
||||
{$endif}
|
||||
SigTermHandlerActive := true; { to avoid that system_exit calls _exit }
|
||||
do_exit; { calls finalize units }
|
||||
if assigned (SetThreadDataAreaPtr) then
|
||||
SetThreadDataAreaPtr (oldPtr);
|
||||
_SetThreadGroupID (oldTG);
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'TermSigHandler: all done'#13#10);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
procedure SysInitStdIO;
|
||||
begin
|
||||
{ Setup stdin, stdout and stderr }
|
||||
StdInputHandle := _fileno (LONGINT (_GetStdIn^)); // GetStd** returns **FILE !
|
||||
StdInputHandle := _fileno (LONGINT (_GetStdIn^)); // GetStd** returns **FILE
|
||||
StdOutputHandle:= _fileno (LONGINT (_GetStdOut^));
|
||||
StdErrorHandle := _fileno (LONGINT (_GetStdErr^));
|
||||
|
||||
@ -880,9 +968,10 @@ Begin
|
||||
{ Reset IO Error }
|
||||
InOutRes:=0;
|
||||
|
||||
(* This should be changed to a real value during *)
|
||||
(* thread driver initialization if appropriate. *)
|
||||
ThreadID := 1;
|
||||
ThreadID := _GetThreadID;
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'Start system, ThreadID: %x'#13#10,ThreadID);
|
||||
{$endif}
|
||||
|
||||
SysInitStdIO;
|
||||
|
||||
@ -896,7 +985,10 @@ Begin
|
||||
End.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2004-09-17 18:29:07 armin
|
||||
Revision 1.27 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.26 2004/09/17 18:29:07 armin
|
||||
* added NWGetCodeStart, needed for lineinfo
|
||||
|
||||
Revision 1.25 2004/09/03 19:26:27 olle
|
||||
|
||||
@ -81,7 +81,7 @@ begin
|
||||
offset:=threadvarblocksize;
|
||||
inc(threadvarblocksize,size);
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf3(#13'init_threadvar, new offset: (%d), Size:%d'#13#10,offset,size,0);
|
||||
ConsolePrintf(#13'init_threadvar, new offset: (%d), Size:%d'#13#10,offset,size,0);
|
||||
{$endif DEBUG_MT}
|
||||
end;
|
||||
|
||||
@ -120,7 +120,7 @@ procedure SysAllocateThreadVars;
|
||||
fillchar (threadvars^, threadvarblocksize, 0);
|
||||
_SaveThreadDataAreaPtr (threadvars);
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf3(#13'threadvars allocated at (%x), size: %d'#13#10,longint(threadvars),threadvarblocksize,0);
|
||||
ConsolePrintf(#13'threadvars allocated at (%x), size: %d'#13#10,longint(threadvars),threadvarblocksize,0);
|
||||
{$endif DEBUG_MT}
|
||||
if thredvarsmainthread = nil then
|
||||
thredvarsmainthread := threadvars;
|
||||
@ -187,7 +187,7 @@ function ThreadMain(param : pointer) : dword; cdecl;
|
||||
SysAllocateThreadVars;
|
||||
{$endif HASTHREADVAR}
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf(#13'New thread started, initialising ...'#13#10);
|
||||
ConsolePrintf(#13'New thread %x started, initialising ...'#13#10,_GetThreadID);
|
||||
{$endif DEBUG_MT}
|
||||
ti:=pthreadinfo(param)^;
|
||||
InitThread(ti.stklen);
|
||||
@ -232,6 +232,9 @@ function SysBeginThread(sa : Pointer;stacksize : dword;
|
||||
|
||||
procedure SysEndThread(ExitCode : DWord);
|
||||
begin
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'SysEndThread %x'#13#10,_GetThreadID);
|
||||
{$endif}
|
||||
DoneThread;
|
||||
ExitThread(ExitCode , TSR_THREAD);
|
||||
end;
|
||||
@ -270,6 +273,7 @@ begin
|
||||
end;
|
||||
|
||||
function GetThreadName (threadId : longint; var threadName) : longint; cdecl; external 'clib' name 'GetThreadName';
|
||||
function GetThreadID : dword; cdecl; external 'clib' name 'GetThreadID';
|
||||
//function __RenameThread (threadId : longint; threadName:pchar) : longint; cdecl; external 'clib' name 'RenameThread';
|
||||
|
||||
function SysWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;
|
||||
@ -278,6 +282,9 @@ var
|
||||
buf : array [0..50] of char;
|
||||
begin
|
||||
{$warning timeout needs to be implemented}
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'SysWaitForThreadTerminate ThreadID:%x Handle:%x'#13#10,GetThreadID,threadHandle);
|
||||
{$endif}
|
||||
repeat
|
||||
status := GetThreadName (ThreadHandle,Buf); {should return EBADHNDL if thread is terminated}
|
||||
ThreadSwitch;
|
||||
@ -295,7 +302,7 @@ begin
|
||||
SysThreadGetPriority := 0;
|
||||
end;
|
||||
|
||||
function GetThreadID : dword; cdecl; external 'clib' name 'GetThreadID';
|
||||
|
||||
|
||||
function SysGetCurrentThreadId : dword;
|
||||
begin
|
||||
@ -535,7 +542,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2004-07-30 15:05:25 armin
|
||||
Revision 1.5 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.4 2004/07/30 15:05:25 armin
|
||||
make netware rtl compilable under 1.9.5
|
||||
|
||||
Revision 1.3 2003/10/01 21:00:09 peter
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1999-2003 by the Free Pascal development team
|
||||
Copyright (c) 2003-2004 Armin Diehl, member of the Free Pascal
|
||||
development team
|
||||
|
||||
Netware TThread implementation
|
||||
Netware clib TThread implementation
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
@ -25,7 +26,7 @@ type
|
||||
var
|
||||
ThreadRoot : PThreadRec;
|
||||
ThreadsInited : boolean;
|
||||
// MainThreadID: longint;
|
||||
DisableRemoveThread : boolean;
|
||||
|
||||
Const
|
||||
ThreadCount: longint = 0;
|
||||
@ -55,19 +56,24 @@ procedure InitThreads;
|
||||
begin
|
||||
ThreadRoot:=nil;
|
||||
ThreadsInited:=true;
|
||||
DisableRemoveThread:=false;
|
||||
end;
|
||||
|
||||
|
||||
{DoneThreads will terminate all remaining threads}
|
||||
procedure DoneThreads;
|
||||
var
|
||||
hp : PThreadRec;
|
||||
hp,next : PThreadRec;
|
||||
begin
|
||||
DisableRemoveThread := true; {to avoid that Destroy calling RemoveThread modifies Thread List}
|
||||
while assigned(ThreadRoot) do
|
||||
begin
|
||||
ThreadRoot^.Thread.Destroy;
|
||||
hp:=ThreadRoot;
|
||||
ThreadRoot:=ThreadRoot^.Next;
|
||||
dispose(hp);
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf(#13'DoneThreads: called destroy, remaining threads: %d ThreadRoot: %x'#13#10,ThreadCount,longint(ThreadRoot));
|
||||
{$endif}
|
||||
end;
|
||||
ThreadsInited:=false;
|
||||
end;
|
||||
@ -87,7 +93,7 @@ begin
|
||||
hp^.next:=ThreadRoot;
|
||||
ThreadRoot:=hp;
|
||||
|
||||
inc(ThreadCount, 1);
|
||||
inc(ThreadCount);
|
||||
end;
|
||||
|
||||
|
||||
@ -95,25 +101,28 @@ procedure RemoveThread(t:TThread);
|
||||
var
|
||||
lasthp,hp : PThreadRec;
|
||||
begin
|
||||
hp:=ThreadRoot;
|
||||
lasthp:=nil;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if hp^.Thread=t then
|
||||
if not DisableRemoveThread then {disabled while in DoneThreads}
|
||||
begin
|
||||
hp:=ThreadRoot;
|
||||
lasthp:=nil;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if hp^.Thread=t then
|
||||
begin
|
||||
if assigned(lasthp) then
|
||||
lasthp^.next:=hp^.next
|
||||
else
|
||||
ThreadRoot:=hp^.next;
|
||||
dispose(hp);
|
||||
Dec(ThreadCount);
|
||||
if ThreadCount = 0 then ThreadsInited := false;
|
||||
exit;
|
||||
end;
|
||||
lasthp:=hp;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
|
||||
Dec(ThreadCount, 1);
|
||||
if ThreadCount = 0 then DoneThreads;
|
||||
lasthp:=hp;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
end else
|
||||
dec(ThreadCount);
|
||||
end;
|
||||
|
||||
|
||||
@ -133,7 +142,10 @@ begin
|
||||
Thread.FFinished := True;
|
||||
Thread.DoTerminate;
|
||||
if FreeThread then
|
||||
begin
|
||||
Thread.Destroy;
|
||||
Thread.Free;
|
||||
end;
|
||||
EndThread(Result);
|
||||
end;
|
||||
|
||||
@ -149,25 +161,24 @@ begin
|
||||
FHandle := BeginThread (@ThreadProc,pointer(self));
|
||||
if FSuspended then Suspend;
|
||||
FThreadID := FHandle;
|
||||
//IsMultiThread := TRUE; {already set by systhrds}
|
||||
FFatalException := nil;
|
||||
end;
|
||||
|
||||
|
||||
destructor TThread.Destroy;
|
||||
begin
|
||||
if not FFinished {and not Suspended} then
|
||||
begin
|
||||
if Suspended then ResumeThread (FHandle); {netware can not kill a thread}
|
||||
Terminate;
|
||||
WaitFor;
|
||||
end;
|
||||
{if FHandle <> -1 then
|
||||
KillThread (FHandle);} {something went wrong, kill the thread (not possible on netware)}
|
||||
if not FFinished then
|
||||
begin
|
||||
Terminate;
|
||||
if Suspended then
|
||||
ResumeThread (FHandle); {netware can not kill a thread, the thread has to}
|
||||
{leave it's execute routine if terminated is true}
|
||||
WaitFor; {wait for the thread to terminate}
|
||||
end;
|
||||
FFatalException.Free;
|
||||
FFatalException := nil;
|
||||
inherited Destroy;
|
||||
RemoveThread(self);
|
||||
RemoveThread(self); {remove it from the list of active threads}
|
||||
end;
|
||||
|
||||
|
||||
@ -209,14 +220,14 @@ end;
|
||||
{does not make sense for netware}
|
||||
procedure TThread.Synchronize(Method: TThreadMethod);
|
||||
begin
|
||||
{$ifndef netware}
|
||||
(*
|
||||
FSynchronizeException := nil;
|
||||
FMethod := Method;
|
||||
{ SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
|
||||
{$warning Synchronize needs implementation}
|
||||
if Assigned(FSynchronizeException) then
|
||||
raise FSynchronizeException;
|
||||
{$endif}
|
||||
*)
|
||||
end;
|
||||
|
||||
|
||||
@ -260,7 +271,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2004-07-30 15:05:25 armin
|
||||
Revision 1.3 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.2 2004/07/30 15:05:25 armin
|
||||
make netware rtl compilable under 1.9.5
|
||||
|
||||
Revision 1.1 2003/10/06 21:01:06 peter
|
||||
|
||||
@ -2417,15 +2417,33 @@ IOW, there _must_ be 3 versions then: var/const, pchar and pointer}
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
oldUnloadProc : pointer;
|
||||
|
||||
procedure exitProc;
|
||||
begin
|
||||
{$ifdef DEBUG_MT}
|
||||
ConsolePrintf (#13'winsock.exitProc called'#13#10);
|
||||
{$endif}
|
||||
NetwareUnloadProc := oldUnloadProc;
|
||||
WSACleanup;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
WSAstartupData.wVersion := $ffff;
|
||||
oldUnloadProc := NetwareUnloadProc;
|
||||
NetwareUnloadProc := @exitProc;
|
||||
finalization
|
||||
WSACleanUp;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2004-09-18 23:45:43 armin
|
||||
Revision 1.5 2004-09-26 19:25:49 armin
|
||||
* exiting threads at nlm unload
|
||||
|
||||
Revision 1.4 2004/09/18 23:45:43 armin
|
||||
* make winsock more compatible to win32 version
|
||||
|
||||
Revision 1.3 2003/10/25 23:42:35 hajny
|
||||
|
||||
Loading…
Reference in New Issue
Block a user