paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-26 16:33:45 +01:00
Code Issues Packages Projects Releases Wiki Activity

* support for fcl, support for linking without debug info

Browse Source 
* renamed winsock2 to winsock for win32 compatinility
* new sockets unit for netware
* changes for compiler warnings
This commit is contained in:
armin 2003-03-25 18:17:54 +00:00
parent c6b7a67ca9
commit cc769a33ea
11 changed files with 312 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
rtl/netware/Makefile
View File

@ -1,8 +1,8 @@
# #
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/03/22] # Don't edit, this file is generated by FPCMake Version 1.1 [2003/03/25]
# #
default: all default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos macosx emx MAKEFILETARGETS=netware
override PATH:=$(subst \,/,$(PATH)) override PATH:=$(subst \,/,$(PATH))
ifeq ($(findstring ;,$(PATH)),) ifeq ($(findstring ;,$(PATH)),)
inUnix=1 inUnix=1
@ -216,9 +216,9 @@ SYSTEMUNIT=sysnetwa
endif endif
override FPCOPT+=-Ur override FPCOPT+=-Ur
override FPCOPT+=-dMT override FPCOPT+=-dMT
CREATESMART=1 CREATESMART=0
OBJPASDIR=$(RTL)/objpas OBJPASDIR=$(RTL)/objpas
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 nwsnut nwserv nwnit nwprot override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings winsock dos crt objects sysutils typinfo math cpu mmx getopts heaptrc lineinfo sockets aio varutils video mouse keyboard types nwsnut nwserv nwnit nwprot
override TARGET_LOADERS+=nwpre prelude override TARGET_LOADERS+=nwpre prelude
override TARGET_RSTS+=math typinfo varutils override TARGET_RSTS+=math typinfo varutils
override INSTALL_FPCPACKAGE=y override INSTALL_FPCPACKAGE=y
@ -545,8 +545,8 @@ ZIPSUFFIX=qnx
endif endif
ifeq ($(OS_TARGET),netware) ifeq ($(OS_TARGET),netware)
STATICLIBPREFIX= STATICLIBPREFIX=
PPUEXT=.ppn PPUEXT=.ppu
OEXT=.on OEXT=.o
ASMEXT=.s ASMEXT=.s
SMARTEXT=.sl SMARTEXT=.sl
STATICLIBEXT=.a STATICLIBEXT=.a
@ -1339,7 +1339,7 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
override INSTALLPPUFILES+=nwimp/aio.imp nwimp/aio.imp nwimp/audnlm32.imp \ override INSTALLPPUFILES+=nwimp/aio.imp nwimp/aio.imp nwimp/audnlm32.imp \
nwimp/calnlm32.imp nwimp/ccs.imp nwimp/ccs-os.imp nwimp/clibaux.imp \ nwimp/calnlm32.imp nwimp/ccs.imp nwimp/ccs-os.imp nwimp/clibaux.imp \
nwimp/clibctx.imp nwimp/clib.imp nwimp/clxnlm32.imp nwimp/dplsv386.imp \ nwimp/clibctx.imp nwimp/clib.imp nwimp/clxnlm32.imp nwimp/dplsv386.imp \
nwimp/dsapi.imp nwimp/dsevent.imp nwimp/fpsm.imp nwimp/lib0.imp \ nwimp/dsapi.imp nwimp/dsevent.imp nwimp/lib0.imp \
nwimp/locnlm32.imp nwimp/ndpsrpc.imp nwimp/netnlm32.imp nwimp/nit.imp \ nwimp/locnlm32.imp nwimp/ndpsrpc.imp nwimp/netnlm32.imp nwimp/nit.imp \
nwimp/nlmlib.imp nwimp/nwpsrv3x.imp nwimp/nwpsrv.imp nwimp/nwsnut.imp \ nwimp/nlmlib.imp nwimp/nwpsrv3x.imp nwimp/nwpsrv.imp nwimp/nwsnut.imp \
nwimp/requestr.imp nwimp/socklib.imp nwimp/streams.imp nwimp/threads.imp \ nwimp/requestr.imp nwimp/socklib.imp nwimp/streams.imp nwimp/threads.imp \

8
rtl/netware/Makefile.fpc
View File

@ -8,7 +8,7 @@ main=rtl
[target] [target]
loaders=nwpre prelude loaders=nwpre prelude
units=$(SYSTEMUNIT) systhrds objpas strings \ units=$(SYSTEMUNIT) systhrds objpas strings \
netware winsock2 \ winsock \
dos crt objects \ dos crt objects \
sysutils typinfo math \ sysutils typinfo math \
cpu mmx getopts heaptrc lineinfo \ cpu mmx getopts heaptrc lineinfo \
@ -53,6 +53,7 @@ endif
override FPCOPT+=-Ur override FPCOPT+=-Ur
# endif # endif
#debug, -a: dont delete asm, -al include lines
#override FPCOPT+=-a #override FPCOPT+=-a
#override FPCOPT+=-al #override FPCOPT+=-al
@ -61,7 +62,8 @@ override FPCOPT+=-Ur
override FPCOPT+=-dMT override FPCOPT+=-dMT
# and alway use smartlinking # and alway use smartlinking
CREATESMART=1 #CREATESMART=1
CREATESMART=0
# Paths # Paths
OBJPASDIR=$(RTL)/objpas OBJPASDIR=$(RTL)/objpas
@ -192,7 +194,7 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
override INSTALLPPUFILES+=nwimp/aio.imp nwimp/aio.imp nwimp/audnlm32.imp \ override INSTALLPPUFILES+=nwimp/aio.imp nwimp/aio.imp nwimp/audnlm32.imp \
nwimp/calnlm32.imp nwimp/ccs.imp nwimp/ccs-os.imp nwimp/clibaux.imp \ nwimp/calnlm32.imp nwimp/ccs.imp nwimp/ccs-os.imp nwimp/clibaux.imp \
nwimp/clibctx.imp nwimp/clib.imp nwimp/clxnlm32.imp nwimp/dplsv386.imp \ nwimp/clibctx.imp nwimp/clib.imp nwimp/clxnlm32.imp nwimp/dplsv386.imp \
nwimp/dsapi.imp nwimp/dsevent.imp nwimp/fpsm.imp nwimp/lib0.imp \ nwimp/dsapi.imp nwimp/dsevent.imp nwimp/lib0.imp \
nwimp/locnlm32.imp nwimp/ndpsrpc.imp nwimp/netnlm32.imp nwimp/nit.imp \ nwimp/locnlm32.imp nwimp/ndpsrpc.imp nwimp/netnlm32.imp nwimp/nit.imp \
nwimp/nlmlib.imp nwimp/nwpsrv3x.imp nwimp/nwpsrv.imp nwimp/nwsnut.imp \ nwimp/nlmlib.imp nwimp/nwpsrv3x.imp nwimp/nwpsrv.imp nwimp/nwsnut.imp \
nwimp/requestr.imp nwimp/socklib.imp nwimp/streams.imp nwimp/threads.imp \ nwimp/requestr.imp nwimp/socklib.imp nwimp/streams.imp nwimp/threads.imp \

38
rtl/netware/compile.cmd
View File

@ -1,38 +0,0 @@
@echo off
REM comile and install fpc rtl for netware under winnt/win2k
REM make seems to have a problem unter nt/w2k
REM
SET DEST=\compiler\fpc\units\netware
REM Compile and install system unit first
SET INC=-I../inc -I../i386 -I../objpas ../inc/strings.pp
SET OPT=-di386 -XX -O3 -Sg -Tnetware
del /Q *.ppn
del /Q *.on
ppc386 %OPT% -dSYSTEMDEBUG -FE. %INC%
copy *.ppn %DEST%
copy *.on %DEST%
REM copy the import files
copy nwimp\*.imp %DEST%
REM and build other stuff
#ppc386 -di386 -XX -O3 -Sg -Tnetware -FE. nwpre.pp
asw nwpre.as -o nwpre.on
asw prelude.as -o prelude.on
ppc386 %OPT% %INC% dos.pp
ppc386 %OPT% %INC% crt.pp
ppc386 %OPT% %INC% ../objpas/objpas.pp
ppc386 %OPT% %INC% sysutils.pp
ppc386 %OPT% %INC% keyboard.pp
ppc386 %OPT% %INC% mouse.pp
ppc386 %OPT% %INC% video.pp
ppc386 %OPT% %INC% sockets.pp
ppc386 %OPT% %INC% netware.pp
ppc386 %OPT% %INC% winsock2.pp
ppc386 %OPT% %INC% aio.pp
copy *.on %DEST%
copy *.ppn %DEST%

19
rtl/netware/crt.pp
View File

@ -219,7 +219,7 @@ end;
procedure textmode(mode : integer); procedure textmode(mode : integer);
begin begin
Window (1,1,ScreenWidth,ScreenHeight); Window (1,1,byte(ScreenWidth),byte(ScreenHeight));
ClrScr; ClrScr;
end; end;
@ -325,7 +325,7 @@ begin
rows := WinMaxY-WinMinY+1; rows := WinMaxY-WinMinY+1;
GetMem (p, rows * rowlen * 2); GetMem (p, rows * rowlen * 2);
FillWord (p^, rows * rowlen, fil); FillWord (p^, rows * rowlen, fil);
_CopyToScreenMemory (rows,rowlen,p,WinMinX-1,WinMinY-1); _CopyToScreenMemory (word(rows),word(rowlen),p,WinMinX-1,WinMinY-1);
FreeMem (p, rows * rowlen * 2); FreeMem (p, rows * rowlen * 2);
end; end;
Gotoxy(1,1); Gotoxy(1,1);
@ -455,8 +455,8 @@ begin
y:=WinMinY+y-1; y:=WinMinY+y-1;
While (y<=WinMaxY) do While (y<=WinMaxY) do
begin begin
_CopyFromScreenMemory (1,rowlen,p,WinMinX-1,y); _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,word(y));
_CopyToScreenMemory (1,rowlen,p,WinMinX-1,y-1); _CopyToScreenMemory (1,rowlen,p,WinMinX-1,word(y-1));
inc(y); inc(y);
end; end;
FillWord (p^,rowlen,fil); FillWord (p^,rowlen,fil);
@ -473,9 +473,10 @@ end;
procedure insline; procedure insline;
var var
my,y : longint; my : longint;
y : word;
fil : word; fil : word;
rowlen,x : word; rowlen : word;
p : pointer; p : pointer;
begin begin
fil:=32 or (textattr shl 8); fil:=32 or (textattr shl 8);
@ -485,12 +486,12 @@ begin
GetMem (p, rowlen*2); GetMem (p, rowlen*2);
while (my>=y) do while (my>=y) do
begin begin
_CopyFromScreenMemory (1,rowlen,p,WinMinX-1,my); _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,word(my));
_CopyToScreenMemory (1,rowlen,p,WinMinX-1,my+1); _CopyToScreenMemory (1,rowlen,p,WinMinX-1,word(my+1));
dec(my); dec(my);
end; end;
FillWord (p^,rowlen,fil); FillWord (p^,rowlen,fil);
_CopyToScreenMemory (1,rowlen,p,x,y); _CopyToScreenMemory (1,rowlen,p,WinMinX-1,y);
FreeMem (p, rowlen*2); FreeMem (p, rowlen*2);
end; end;

18
rtl/netware/dos.pp
View File

@ -292,7 +292,7 @@ end;
function getvolnum (drive : byte) : longint; function getvolnum (drive : byte) : longint;
var dir : STRING[255]; var dir : STRING[255];
P,PS: BYTE; P,PS,
V : LONGINT; V : LONGINT;
begin begin
if drive = 0 then if drive = 0 then
@ -389,10 +389,10 @@ VAR Buf : ARRAY [0..255] OF CHAR;
volumeNumber : LONGINT; volumeNumber : LONGINT;
begin begin
volumeNumber := getvolnum (drive); volumeNumber := getvolnum (drive);
if volumeNumber >= 0 then if (volumeNumber >= 0) and (volumeNumber <= 255) then
begin begin
{i think thats not the right function but for others i need a connection handle} {i think thats not the right function but for others i need a connection handle}
if _GetVolumeInfoWithNumber (volumeNumber,@Buf, if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
TotalBlocks, TotalBlocks,
SectorsPerBlock, SectorsPerBlock,
availableBlocks, availableBlocks,
@ -419,10 +419,10 @@ VAR Buf : ARRAY [0..255] OF CHAR;
volumeNumber : LONGINT; volumeNumber : LONGINT;
begin begin
volumeNumber := getvolnum (drive); volumeNumber := getvolnum (drive);
if volumeNumber >= 0 then if (volumeNumber >= 0) and (volumeNumber <= 255) then
begin begin
{i think thats not the right function but for others i need a connection handle} {i think thats not the right function but for others i need a connection handle}
if _GetVolumeInfoWithNumber (volumeNumber,@Buf, if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
TotalBlocks, TotalBlocks,
SectorsPerBlock, SectorsPerBlock,
availableBlocks, availableBlocks,
@ -858,7 +858,13 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2002-09-07 16:01:20 peter Revision 1.6 2003-03-25 18:17:54 armin
* support for fcl, support for linking without debug info
* renamed winsock2 to winsock for win32 compatinility
* new sockets unit for netware
* changes for compiler warnings
Revision 1.5 2002/09/07 16:01:20 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
} }

38
rtl/netware/nwpre.as
View File

@ -45,17 +45,18 @@ _Prelude:
pushl %ebx pushl %ebx
movl 0x14(%ebp),%edi movl 0x14(%ebp),%edi
movl 0x18(%ebp),%esi movl 0x18(%ebp),%esi
movl %esi, __uninitializedDataSize
movl 0x1c(%ebp),%ebx movl 0x1c(%ebp),%ebx
movl 0x20(%ebp),%ecx movl 0x20(%ebp),%ecx
movl 0x28(%ebp),%eax movl 0x28(%ebp),%eax
pushl $_pasStart_ pushl $_pasStart_
pushl $_kNLMInfo pushl $_kNLMInfo
pushl %eax pushl %eax
movl 0x24(%ebp),%edx movl 0x24(%ebp),%edx # 1b7f6
pushl %edx pushl %edx
pushl %ecx pushl %ecx
pushl %ebx pushl %ebx
pushl %esi pushl %esi # uninitialized data size
pushl %edi pushl %edi
movl 0x10(%ebp),%edx movl 0x10(%ebp),%edx
pushl %edx pushl %edx
@ -105,8 +106,37 @@ _Stop:
# LongDoubleSize : LONGINT; // gcc nwpre defines 12, watcom 8 # LongDoubleSize : LONGINT; // gcc nwpre defines 12, watcom 8
# wchar_tSize : LONGINT; # wchar_tSize : LONGINT;
# END; # END;
.globl _kNLMInfo # will be used as data start
_kNLMInfo: _kNLMInfo:
.ascii "NLMI" .ascii "NLMI"
.long 0,1,8,2 .long 0,1,8,2
.text
.globl __getTextStart
__getTextStart:
movl $.text,%eax
ret
.text
.globl __getDataStart
__getDataStart:
movl $.data,%eax
ret
.text
.globl __getBssStart
__getBssStart:
movl $.bss,%eax
ret
.data
__uninitializedDataSize: .long
.text
.globl __getUninitializedDataSize
__getUninitializedDataSize:
movl __uninitializedDataSize, %eax
ret

145
rtl/netware/nwsys.inc
View File

@ -20,13 +20,8 @@
2001/04/14 armin: additional functions for crt-unit 2001/04/14 armin: additional functions for crt-unit
} }
CONST Clib = 'clib.nlm'; CONST Clib = 'clib';
NlmLib = 'nlmlib.nlm';
Threads = 'threads.nlm';
CalNlm = 'calnlm32.nlm';
ClxNlm = 'clxnlm32.nlm';
NitNlm = 'nit.nlm';
ThreadsNlm = 'threads.nlm';
TYPE TYPE
dev_t = LONGINT; dev_t = LONGINT;
@ -66,8 +61,8 @@ TYPE
st_spare : ARRAY [0..3] OF LONGINT; st_spare : ARRAY [0..3] OF LONGINT;
END; END;
FUNCTION _stat (path : PCHAR; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'stat_411'; FUNCTION _stat (path : PCHAR; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL Clib NAME 'stat_411';
FUNCTION _fstat (Fileno : LONGINT; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'fstat_411'; FUNCTION _fstat (Fileno : LONGINT; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL CLib NAME 'fstat_411';
PROCEDURE NWFree (P : POINTER); CDECL; EXTERNAL Clib NAME 'free'; PROCEDURE NWFree (P : POINTER); CDECL; EXTERNAL Clib NAME 'free';
@ -75,9 +70,9 @@ PROCEDURE PressAnyKeyToContinue; CDecl; EXTERNAL; // Clib;
PROCEDURE ExitThread (action_code, termination_code : LONGINT); CDecl; EXTERNAL CLib; PROCEDURE ExitThread (action_code, termination_code : LONGINT); CDecl; EXTERNAL CLib;
FUNCTION _BeginThread (func, stack : pointer; Stacksize : LONGINT; arg : pointer) : LONGINT; Cdecl; EXTERNAL Threads NAME 'BeginThread'; FUNCTION _BeginThread (func, stack : pointer; Stacksize : LONGINT; arg : pointer) : LONGINT; Cdecl; EXTERNAL CLib NAME 'BeginThread';
FUNCTION _GetThreadDataAreaPtr : POINTER; CDecl; EXTERNAL NlmLib NAME 'GetThreadDataAreaPtr'; FUNCTION _GetThreadDataAreaPtr : POINTER; CDecl; EXTERNAL CLib NAME 'GetThreadDataAreaPtr';
PROCEDURE _SaveThreadDataAreaPtr (P : POINTER); CDecl; EXTERNAL NlmLib NAME 'SaveThreadDataAreaPtr'; PROCEDURE _SaveThreadDataAreaPtr (P : POINTER); CDecl; EXTERNAL CLib NAME 'SaveThreadDataAreaPtr';
PROCEDURE _exit (ExitCode : LONGINT); CDecl; EXTERNAL CLib; PROCEDURE _exit (ExitCode : LONGINT); CDecl; EXTERNAL CLib;
PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf'; PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
@ -103,14 +98,14 @@ FUNCTION _GetStdOut : POINTER; CDECL; EXTERNAL Clib NAME '__get_stdout';
FUNCTION _GetStdErr : POINTER; CDECL; EXTERNAL Clib NAME '__get_stderr'; FUNCTION _GetStdErr : POINTER; CDECL; EXTERNAL Clib NAME '__get_stderr';
// FileIO by Fileno // FileIO by Fileno
FUNCTION _open (FileName : PCHAR; access, mode : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'open'; FUNCTION _open (FileName : PCHAR; access, mode : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'open';
FUNCTION _close (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'close'; FUNCTION _close (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'close';
FUNCTION _lseek (FileNo,Pos,whence :LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'lseek'; FUNCTION _lseek (FileNo,Pos,whence :LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'lseek';
FUNCTION _chsize (FileNo,Pos : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'chsize'; FUNCTION _chsize (FileNo,Pos : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'chsize';
FUNCTION _tell (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'tell'; FUNCTION _tell (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'tell';
FUNCTION _write (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'write'; FUNCTION _write (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'write';
FUNCTION _read (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'read'; FUNCTION _read (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'read';
FUNCTION _filelength (filedes : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'filelength'; FUNCTION _filelength (filedes : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'filelength';
TYPE TYPE
NWModifyStructure = NWModifyStructure =
@ -151,15 +146,15 @@ CONST MModifyNameBit = $0001;
MLastUpdatedInSecondsBit = $4000; MLastUpdatedInSecondsBit = $4000;
// Directory // Directory
FUNCTION _chdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'chdir'; FUNCTION _chdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'chdir';
FUNCTION _getcwd (path : PCHAR; pathlen : LONGINT) : PCHAR; CDECL; EXTERNAL NlmLib NAME 'getcwd'; FUNCTION _getcwd (path : PCHAR; pathlen : LONGINT) : PCHAR; CDECL; EXTERNAL CLib NAME 'getcwd';
FUNCTION _mkdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'mkdir'; FUNCTION _mkdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'mkdir';
FUNCTION _rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'rmdir'; FUNCTION _rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'rmdir';
FUNCTION _ChangeDirectoryEntry (PathName : PCHAR; VAR ModyStruct : NWModifyStructure; ModifyBits, AllowWildcard : LONGINT) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'ChangeDirectoryEntry'; FUNCTION _ChangeDirectoryEntry (PathName : PCHAR; VAR ModyStruct : NWModifyStructure; ModifyBits, AllowWildcard : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'ChangeDirectoryEntry';
// get fileno from stream // get fileno from stream
FUNCTION _fileno (Handle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fileno'; FUNCTION _fileno (Handle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fileno';
FUNCTION _isatty (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'isatty'; FUNCTION _isatty (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'isatty';
(* values for 'o_flag' in open()... *) (* values for 'o_flag' in open()... *)
CONST O_RDONLY = $0000; (* open for read only *) CONST O_RDONLY = $0000; (* open for read only *)
@ -178,7 +173,7 @@ CONST O_RDONLY = $0000; (* open for read only *)
// File Utils // File Utils
FUNCTION _unlink (FileName : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'unlink'; FUNCTION _unlink (FileName : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'unlink';
FUNCTION _rename (oldpath, newpath : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'rename'; FUNCTION _rename (oldpath, newpath : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'rename';
// Error // Error
@ -186,10 +181,10 @@ TYPE _PLONGINT = ^LONGINT;
FUNCTION __get_errno_ptr : _PLONGINT; CDECL; EXTERNAL Clib; FUNCTION __get_errno_ptr : _PLONGINT; CDECL; EXTERNAL Clib;
// Memory // Memory
FUNCTION _malloc (size : LONGINT) : POINTER; CDECL; EXTERNAL Threads NAME 'malloc'; FUNCTION _malloc (size : LONGINT) : POINTER; CDECL; EXTERNAL CLib NAME 'malloc';
FUNCTION _realloc (p : POINTER; size : LONGINT) : POINTER; CDECL; EXTERNAL Threads NAME 'realloc'; FUNCTION _realloc (p : POINTER; size : LONGINT) : POINTER; CDECL; EXTERNAL CLib NAME 'realloc';
PROCEDURE _free (what : POINTER); CDECL; EXTERNAL Threads NAME 'free'; PROCEDURE _free (what : POINTER); CDECL; EXTERNAL CLib NAME 'free';
FUNCTION _stackavail : LONGINT; CDECL; EXTERNAL Threads NAME 'stackavail'; FUNCTION _stackavail : LONGINT; CDECL; EXTERNAL CLib NAME 'stackavail';
// Debug // Debug
PROCEDURE _EnterDebugger; CDECL; EXTERNAL Clib NAME 'EnterDebugger'; PROCEDURE _EnterDebugger; CDECL; EXTERNAL Clib NAME 'EnterDebugger';
@ -221,9 +216,9 @@ TYPE NWCONN_HANDLE = LONGINT;
Hour,Minute,Second,DayOfWeek : BYTE; Hour,Minute,Second,DayOfWeek : BYTE;
END; END;
PROCEDURE GetFileServerDateAndTime (VAR TimeBuf : NWDateAndTime); CDECL; EXTERNAL NitNlm NAME 'GetFileServerDateAndTime'; PROCEDURE GetFileServerDateAndTime (VAR TimeBuf : NWDateAndTime); CDECL; EXTERNAL CLib NAME 'GetFileServerDateAndTime';
FUNCTION SetFileServerDateAndTime(year:WORD; month:WORD; day:WORD; hour:WORD; minute:WORD; FUNCTION SetFileServerDateAndTime(year:WORD; month:WORD; day:WORD; hour:WORD; minute:WORD;
second:WORD):longint;cdecl; EXTERNAL NitNlm Name 'SetFileServerDateAndTime'; second:WORD):longint;cdecl; EXTERNAL CLib Name 'SetFileServerDateAndTime';
TYPE FILE_SERV_INFO = record TYPE FILE_SERV_INFO = record
serverName : array[0..47] of char; serverName : array[0..47] of char;
@ -250,7 +245,7 @@ TYPE FILE_SERV_INFO = record
end; end;
pFILE_SERV_INFO = ^FILE_SERV_INFO; pFILE_SERV_INFO = ^FILE_SERV_INFO;
FUNCTION GetServerInformation(returnSize:longint; serverInfo:pFILE_SERV_INFO):longint;cdecl; EXTERNAL NitNlm NAME 'GetServerInformation'; FUNCTION GetServerInformation(returnSize:longint; serverInfo:pFILE_SERV_INFO):longint;cdecl; EXTERNAL CLib NAME 'GetServerInformation';
// Directory // Directory
TYPE NWDirEnt = TYPE NWDirEnt =
@ -277,17 +272,17 @@ TYPE NWDirEnt =
END; END;
PNWDirEnt = ^NWDirEnt; PNWDirEnt = ^NWDirEnt;
FUNCTION _opendir (pathname : PCHAR) : PNWDirEnt; CDECL; EXTERNAL NlmLib NAME 'opendir_411'; FUNCTION _opendir (pathname : PCHAR) : PNWDirEnt; CDECL; EXTERNAL CLib NAME 'opendir_411';
FUNCTION _closedir (dirH : PNWDirEnt) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'closedir'; FUNCTION _closedir (dirH : PNWDirEnt) : LONGINT; CDECL; EXTERNAL CLib NAME 'closedir';
FUNCTION _readdir (dirH : PNWDirEnt) : PNWDirEnt; CDECL; EXTERNAL NlmLib NAME 'readdir'; FUNCTION _readdir (dirH : PNWDirEnt) : PNWDirEnt; CDECL; EXTERNAL CLib NAME 'readdir';
FUNCTION _SetReaddirAttribute (dirH : PNWDirEnt; Attribute : LONGINT) : LONGINT; EXTERNAL NlmLib NAME 'SetReaddirAttribute'; FUNCTION _SetReaddirAttribute (dirH : PNWDirEnt; Attribute : LONGINT) : LONGINT; EXTERNAL CLib NAME 'SetReaddirAttribute';
// Environment // Environment
FUNCTION _getenv (name : PCHAR) : PCHAR; CDECL; EXTERNAL NlmLib NAME 'getenv'; FUNCTION _getenv (name : PCHAR) : PCHAR; CDECL; EXTERNAL CLib NAME 'getenv';
// Volumes // Volumes
FUNCTION _GetVolumeName (volumeNumber : LONGINT; volumeName : PCHAR) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeName'; FUNCTION _GetVolumeName (volumeNumber : LONGINT; volumeName : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'GetVolumeName';
FUNCTION _GetVolumeNumber (volumeName : PCHAR; VAR volumeNumber : LONGINT) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeNumber'; FUNCTION _GetVolumeNumber (volumeName : PCHAR; VAR volumeNumber : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'GetVolumeNumber';
FUNCTION _GetVolumeInfoWithNumber (VolumeNumber : BYTE; FUNCTION _GetVolumeInfoWithNumber (VolumeNumber : BYTE;
VolumeName : PCHAR; VolumeName : PCHAR;
VAR TotalBlocks : WORD; VAR TotalBlocks : WORD;
@ -295,43 +290,43 @@ TYPE NWDirEnt =
VAR availableBlocks : WORD; VAR availableBlocks : WORD;
VAR totalDirectorySlots : WORD; VAR totalDirectorySlots : WORD;
VAR availableDirSlots : WORD; VAR availableDirSlots : WORD;
VAR volumeisRemovable : WORD) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeInfoWithNumber'; VAR volumeisRemovable : WORD) : LONGINT; CDECL; EXTERNAL CLib NAME 'GetVolumeInfoWithNumber';
FUNCTION _GetNumberOfVolumes : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetNumberOfVolumes'; FUNCTION _GetNumberOfVolumes : LONGINT; CDECL; EXTERNAL CLib NAME 'GetNumberOfVolumes';
// Screen/Keyboad // Screen/Keyboad
PROCEDURE _CopyToScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL ThreadsNlm NAME 'CopyToScreenMemory'; PROCEDURE _CopyToScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL Clib NAME 'CopyToScreenMemory';
PROCEDURE _CopyFromScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL ThreadsNlm NAME 'CopyFromScreenMemory'; PROCEDURE _CopyFromScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL CLib NAME 'CopyFromScreenMemory';
FUNCTION _DisplayInputCursor : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'DisplayInputCursor'; FUNCTION _DisplayInputCursor : LONGINT; CDECL; EXTERNAL CLib NAME 'DisplayInputCursor';
FUNCTION _HideInputCursor : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'HideInputCursor'; FUNCTION _HideInputCursor : LONGINT; CDECL; EXTERNAL CLib NAME 'HideInputCursor';
FUNCTION _SetPositionOfInputCursor (row,col : WORD): LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'SetPositionOfInputCursor'; FUNCTION _SetPositionOfInputCursor (row,col : WORD): LONGINT; CDECL; EXTERNAL Clib NAME 'SetPositionOfInputCursor';
PROCEDURE _GotoXY (col, row : WORD); CDECL; EXTERNAL ThreadsNlm NAME 'gotoxy'; PROCEDURE _GotoXY (col, row : WORD); CDECL; EXTERNAL Clib NAME 'gotoxy';
FUNCTION _GetSizeOfScreen (VAR height,width : WORD): LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'GetSizeOfScreen'; FUNCTION _GetSizeOfScreen (VAR height,width : WORD): LONGINT; CDECL; EXTERNAL CLib NAME 'GetSizeOfScreen';
FUNCTION _IsColorMonitor : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'IsColorMonitor'; FUNCTION _IsColorMonitor : LONGINT; CDECL; EXTERNAL CLib NAME 'IsColorMonitor';
PROCEDURE _RingTheBell; CDECL; EXTERNAL ThreadsNlm NAME 'RingTheBell'; PROCEDURE _RingTheBell; CDECL; EXTERNAL CLib NAME 'RingTheBell';
FUNCTION _SetCursorShape (startline,endline : BYTE) : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'SetCursorShape'; FUNCTION _SetCursorShape (startline,endline : BYTE) : WORD; CDECL; EXTERNAL CLib NAME 'SetCursorShape';
FUNCTION _GetCursorShape (VAR startline,endline : BYTE) : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'GetCursorShape'; FUNCTION _GetCursorShape (VAR startline,endline : BYTE) : WORD; CDECL; EXTERNAL CLib NAME 'GetCursorShape';
FUNCTION _wherex : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'wherex'; FUNCTION _wherex : WORD; CDECL; EXTERNAL CLib NAME 'wherex';
FUNCTION _wherey : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'wherey'; FUNCTION _wherey : WORD; CDECL; EXTERNAL CLib NAME 'wherey';
PROCEDURE _clrscr; CDECL; EXTERNAL ThreadsNlm NAME 'clrscr'; PROCEDURE _clrscr; CDECL; EXTERNAL CLib NAME 'clrscr';
FUNCTION _kbhit : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'kbhit'; FUNCTION _kbhit : LONGINT; CDECL; EXTERNAL Clib NAME 'kbhit';
FUNCTION _getch : CHAR; CDECL; EXTERNAL ThreadsNlm NAME 'getch'; FUNCTION _getch : CHAR; CDECL; EXTERNAL CLib NAME 'getch';
PROCEDURE _delay (miliseconds : longint); CDECL; EXTERNAL ThreadsNlm NAME 'delay'; PROCEDURE _delay (miliseconds : longint); CDECL; EXTERNAL Clib NAME 'delay';
FUNCTION _SetCtrlCharCheckMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL ThreadsNlm NAME 'SetCtrlCharCheckMode'; FUNCTION _SetCtrlCharCheckMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL CLib NAME 'SetCtrlCharCheckMode';
FUNCTION _SetAutoScreenDestructionMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL ThreadsNlm NAME 'SetAutoScreenDestructionMode'; FUNCTION _SetAutoScreenDestructionMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL CLib NAME 'SetAutoScreenDestructionMode';
// Misc // Misc
FUNCTION _memcpy (Dest, Src : POINTER; Len : LONGINT) : POINTER; CDECL; EXTERNAL ThreadsNlm NAME 'memcpy'; FUNCTION _memcpy (Dest, Src : POINTER; Len : LONGINT) : POINTER; CDECL; EXTERNAL Clib NAME 'memcpy';
FUNCTION _OpenLocalSemaphore (InitialValue : LONGINT) : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'OpenLocalSemaphore'; FUNCTION _OpenLocalSemaphore (InitialValue : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'OpenLocalSemaphore';
FUNCTION _WaitOnLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'WaitOnLocalSemaphore'; FUNCTION _WaitOnLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'WaitOnLocalSemaphore';
FUNCTION _SignalLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'SignalLocalSemaphore'; FUNCTION _SignalLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'SignalLocalSemaphore';
FUNCTION _CloseLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'CloseLocalSemaphore'; FUNCTION _CloseLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'CloseLocalSemaphore';
FUNCTION _EnterCritSec : LONGINT; CDecl; EXTERNAL ThreadsNlm NAME 'EnterCritSec'; FUNCTION _EnterCritSec : LONGINT; CDecl; EXTERNAL CLib NAME 'EnterCritSec';
FUNCTION _ExitCritSec : LONGINT; CDecl; EXTERNAL ThreadsNlm NAME 'ExitCritSec'; FUNCTION _ExitCritSec : LONGINT; CDecl; EXTERNAL CLib NAME 'ExitCritSec';
FUNCTION _SetThreadGroupID (id : longint) : longint; CDecl; EXTERNAL ThreadsNlm NAME 'SetThreadGroupID'; FUNCTION _SetThreadGroupID (id : longint) : longint; CDecl; EXTERNAL CLib NAME 'SetThreadGroupID';
FUNCTION _GetThreadGroupID : longint; CDecl; EXTERNAL ThreadsNlm NAME 'GetThreadGroupID'; FUNCTION _GetThreadGroupID : longint; CDecl; EXTERNAL CLib NAME 'GetThreadGroupID';
CONST _SIGTERM = 6; CONST _SIGTERM = 6;
@ -340,7 +335,13 @@ PROCEDURE _Signal (Sig : longint; SigFunc : pointer); CDECL; EXTERNAL Clib NAME
{ {
$Log$ $Log$
Revision 1.8 2003-02-16 17:46:11 armin Revision 1.9 2003-03-25 18:17:54 armin
* support for fcl, support for linking without debug info
* renamed winsock2 to winsock for win32 compatinility
* new sockets unit for netware
* changes for compiler warnings
Revision 1.8 2003/02/16 17:46:11 armin
* typo fixed * typo fixed
Revision 1.7 2002/09/07 16:01:20 peter Revision 1.7 2002/09/07 16:01:20 peter

34
rtl/netware/prelude.as
View File

@ -23,11 +23,15 @@
# it sets up the argc and argv and calls _nlm_main (in system.pp) # it sets up the argc and argv and calls _nlm_main (in system.pp)
# This version uses the old _SetupArgv and not the newer _SetupArvV_411 # This version uses the old _SetupArgv and not the newer _SetupArvV_411
# #
.globl _pas_Start_
_pasStart_: _pasStart_:
pushl $_nlm_main pushl $_nlm_main
call _SetupArgv call _SetupArgv
addl $4,%esp addl $4,%esp
ret ret
# this is a hack to avoid that FPC_NW_CHECKFUNCTION will be
# eleminated by the linker (with smartlinking)
call FPC_NW_CHECKFUNCTION
# #
@ -43,6 +47,7 @@ _Prelude:
pushl %ebx pushl %ebx
movl 0x14(%ebp),%edi movl 0x14(%ebp),%edi
movl 0x18(%ebp),%esi movl 0x18(%ebp),%esi
movl %esi, __uninitializedDataSize
movl 0x1c(%ebp),%ebx movl 0x1c(%ebp),%ebx
movl 0x20(%ebp),%ecx movl 0x20(%ebp),%ecx
movl 0x28(%ebp),%eax movl 0x28(%ebp),%eax
@ -97,3 +102,32 @@ _Stop:
_NLMID: _NLMID:
.long 0 .long 0
.text
.globl __getTextStart
__getTextStart:
movl $.text,%eax
ret
.text
.globl __getDataStart
__getDataStart:
movl $.data,%eax
ret
.text
.globl __getBssStart
__getBssStart:
movl $.bss,%eax
ret
.data
__uninitializedDataSize: .long
.text
.globl __getUninitializedDataSize
__getUninitializedDataSize:
movl __uninitializedDataSize, %eax
ret

9
rtl/netware/sockets.pp
View File

@ -12,6 +12,7 @@
**********************************************************************} **********************************************************************}
{$mode objfpc} {$mode objfpc}
{$R-}
unit Sockets; unit Sockets;
Interface Interface
@ -260,7 +261,13 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.3 2003-03-23 17:47:15 armin Revision 1.4 2003-03-25 18:17:54 armin
* support for fcl, support for linking without debug info
* renamed winsock2 to winsock for win32 compatinility
* new sockets unit for netware
* changes for compiler warnings
Revision 1.3 2003/03/23 17:47:15 armin
* CloseSocket added * CloseSocket added
Revision 1.10 2003/01/01 14:34:22 peter Revision 1.10 2003/01/01 14:34:22 peter

22
rtl/netware/system.pp
View File

@ -76,6 +76,7 @@ VAR
ArgV : ppchar; ArgV : ppchar;
NetwareCheckFunction : TNWCheckFunction; NetwareCheckFunction : TNWCheckFunction;
NetwareMainThreadGroupID: longint; NetwareMainThreadGroupID: longint;
NetwareCodeStartAddress : dword;
CONST CONST
envp : ppchar = nil; {dummy to make heaptrc happy} envp : ppchar = nil; {dummy to make heaptrc happy}
@ -140,9 +141,17 @@ procedure fpc_do_exit;external name 'FPC_DO_EXIT';
Startup Startup
*****************************************************************************} *****************************************************************************}
function __GetBssStart : pointer; external name '__getBssStart';
function __getUninitializedDataSize : longint; external name '__getUninitializedDataSize';
//function __getDataStart : longint; external name '__getDataStart';
function __GetTextStart : longint; external name '__getTextStart';
PROCEDURE nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nlm_main']; PROCEDURE nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nlm_main'];
BEGIN BEGIN
// Initialize BSS
if __getUninitializedDataSize > 0 then
fillchar (__getBssStart^,__getUninitializedDataSize,0);
NetwareCodeStartAddress := __GetTextStart;
ArgC := _ArgC; ArgC := _ArgC;
ArgV := _ArgV; ArgV := _ArgV;
fpc_threadvar_relocate_proc := nil; fpc_threadvar_relocate_proc := nil;
@ -168,7 +177,7 @@ begin
if not SigTermHandlerActive then if not SigTermHandlerActive then
begin begin
if ExitCode <> 0 Then { otherwise we dont see runtime-errors } if ExitCode <> 0 Then { otherwise we dont see runtime-errors }
PressAnyKeyToContinue; _SetAutoScreenDestructionMode (false);
_exit (ExitCode); _exit (ExitCode);
end; end;
@ -790,10 +799,11 @@ Begin
{ Setup heap } { Setup heap }
InitHeap; InitHeap;
SysInitExceptions; SysInitExceptions;
SysInitStdIO;
{ Reset IO Error } { Reset IO Error }
InOutRes:=0; InOutRes:=0;
SysInitStdIO;
{Delphi Compatible} {Delphi Compatible}
IsLibrary := FALSE; IsLibrary := FALSE;
@ -805,7 +815,13 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.16 2003-02-15 19:12:54 armin Revision 1.17 2003-03-25 18:17:54 armin
* support for fcl, support for linking without debug info
* renamed winsock2 to winsock for win32 compatinility
* new sockets unit for netware
* changes for compiler warnings
Revision 1.16 2003/02/15 19:12:54 armin
* changes for new threadvar support * changes for new threadvar support
Revision 1.15 2002/10/13 09:28:45 florian Revision 1.15 2002/10/13 09:28:45 florian

152
rtl/netware/winsock2.pp → rtl/netware/winsock.pp
View File

@ -4,7 +4,7 @@
This unit contains the declarations for the WinSock2 This unit contains the declarations for the WinSock2
Socket Library for Netware and Win32 Socket Library for Netware and Win32
Copyright (c) 1999-2002 by the Free Pascal development team Copyright (c) 1999-2003 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -19,18 +19,22 @@
**********************************************************************} **********************************************************************}
{$PACKRECORDS 1} {$PACKRECORDS 1}
unit winsock2; {$R-}
{$ifndef VER0_99_14}
{$ifndef NO_SMART_LINK} unit winsock;
{$define support_smartlink} { ifndef VER0_99_14}
{$endif} { ifndef NO_SMART_LINK}
{$endif} { define support_smartlink}
{ endif}
{ endif}
{$ifdef support_smartlink} { ifdef support_smartlink}
{$smartlink on} { smartlink on}
{$endif} { endif}
{$smartlink off} {for now, there seems to be a problem with fpc or the linker !}
{$mode objfpc}
interface interface
@ -259,17 +263,20 @@ unit winsock2;
PInAddr = ^TInAddr; PInAddr = ^TInAddr;
sockaddr_in = record sockaddr_in = record
sin_family : SmallInt; (* 2 byte *)
case integer of case integer of
0 : ( (* equals to sockaddr_in, size is 16 byte *) 0 : ( (* equals to sockaddr_in, size is 16 byte *)
sin_port : u_short; (* 2 byte *) sin_family : SmallInt; (* 2 byte *)
sin_addr : TInAddr; (* 4 byte *) sin_port : u_short; (* 2 byte *)
sin_zero : array[0..8-1] of char; (* 8 byte *) sin_addr : TInAddr; (* 4 byte *)
sin_zero : array[0..7] of char; (* 8 byte *)
); );
1 : ( (* equals to sockaddr, size is 16 byte *) 1 : ( (* equals to sockaddr, size is 16 byte *)
sin_data : array[0..14-1] of char; (* 14 byte *) sa_family : SmallInt; (* 2 byte *)
sa_data : array[0..13] of char; (* 14 byte *)
); );
end; end;
TSockAddrIn = sockaddr_in; TSockAddrIn = sockaddr_in;
PSockAddrIn = ^TSockAddrIn; PSockAddrIn = ^TSockAddrIn;
TSockAddr = sockaddr_in; TSockAddr = sockaddr_in;
@ -332,7 +339,7 @@ unit winsock2;
taken from the BSD file sys/socket.h. taken from the BSD file sys/socket.h.
} }
const const
INVALID_SOCKET = longint(not(1)); INVALID_SOCKET = u_long(not(1));
SOCKET_ERROR = -1; SOCKET_ERROR = -1;
SOCK_STREAM = 1; SOCK_STREAM = 1;
SOCK_DGRAM = 2; SOCK_DGRAM = 2;
@ -1856,7 +1863,7 @@ unit winsock2;
function accept(s:TSocket; addr: PSockAddr; var addrlen : tOS_INT) : TSocket;stdcall;external winsockdll name 'accept'; function accept(s:TSocket; addr: PSockAddr; var addrlen : tOS_INT) : TSocket;stdcall;external winsockdll name 'accept';
{$endif} {$endif}
function bind(s:TSocket; addr: PSockaddr;namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_Bind; function bind(s:TSocket; addr: PSockaddr;namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_Bind;
function bind(s:TSocket; const addr: TSockaddr;namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_Bind; function bind(s:TSocket; var addr: TSockaddr;namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_Bind;
function closesocket(s:TSocket):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_closesocket; function closesocket(s:TSocket):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_closesocket;
{$ifdef netware} {$ifdef netware}
function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT; function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT;
@ -1888,16 +1895,19 @@ unit winsock2;
function recv(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv; function recv(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv;
function recv(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv; function recv(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv;
function recvfrom(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT;from:PSockAddr; fromlen:ptOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom; function recvfrom(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT;from:PSockAddr; fromlen:ptOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom;
function recvfrom(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT;Const from:TSockAddr; var fromlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom; function recvfrom(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT;var from:TSockAddr; var fromlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom;
function select(nfds:tOS_INT; readfds,writefds,exceptfds : PFDSet;timeout: PTimeVal):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function select(nfds:tOS_INT; readfds,writefds,exceptfds : PFDSet;timeout: PTimeVal):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_select; external winsockdll name _fn_select;
function send(s:TSocket;Const buf; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function send(s:TSocket;const buf; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_send; external winsockdll name _fn_send;
function sendto(s:TSocket; buf:pchar; len:tOS_INT; flags:tOS_INT;Const toaddr:TSockAddr; tolen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function sendto(s:TSocket; buf:pchar; len:tOS_INT; flags:tOS_INT;var toaddr:TSockAddr; tolen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_sendto; external winsockdll name _fn_sendto;
function sendto(s:TSocket; const buf; len:tOS_INT; flags:tOS_INT;var toaddr:TSockAddr; tolen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_sendto;
function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pchar; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pchar; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_setsockopt; external winsockdll name _fn_setsockopt;
function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; Const optval; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; var optval; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_setsockopt; external winsockdll name _fn_setsockopt;
function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pointer; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pointer; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name _fn_setsockopt; external winsockdll name _fn_setsockopt;
@ -1916,9 +1926,8 @@ unit winsock2;
function getprotobyname(name:pchar):PProtoEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_getprotobyname; function getprotobyname(name:pchar):PProtoEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_getprotobyname;
{ Microsoft Windows Extension function prototypes } { Microsoft Windows Extension function prototypes }
function WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;
external winsockdll name 'WSAStartup'; function WSACleanup:tOS_INT;
function WSACleanup:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSACleanup';
procedure WSASetLastError(iError:tOS_INT);{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSASetLastError'; procedure WSASetLastError(iError:tOS_INT);{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSASetLastError';
function WSAGetLastError:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetLastError'; function WSAGetLastError:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetLastError';
{$ifndef netware} {$ifndef netware}
@ -1952,6 +1961,11 @@ unit winsock2;
external winsockdll name '__WSAFDIsSet'; external winsockdll name '__WSAFDIsSet';
function __WSAFDIsSet_(s:TSocket; var FDSet:TFDSet):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} function __WSAFDIsSet_(s:TSocket; var FDSet:TFDSet):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name '__WSAFDIsSet'; external winsockdll name '__WSAFDIsSet';
function FD_ISSET(s:TSocket; var FDSet:TFDSet):Bool;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name '__WSAFDIsSet';
{$ifndef netware} {$ifndef netware}
function TransmitFile(hSocket:TSocket; hFile:THandle; nNumberOfBytesToWrite:dword; function TransmitFile(hSocket:TSocket; hFile:THandle; nNumberOfBytesToWrite:dword;
nNumberOfBytesPerSend:DWORD; lpOverlapped:POverlapped; nNumberOfBytesPerSend:DWORD; lpOverlapped:POverlapped;
@ -1978,7 +1992,7 @@ unit winsock2;
function WSAGetSelectEvent(Param:dword):Word; function WSAGetSelectEvent(Param:dword):Word;
function WSAGetSelectError(Param:dword):Word; function WSAGetSelectError(Param:dword):Word;
procedure FD_CLR(Socket:TSocket; var FDSet:TFDSet); procedure FD_CLR(Socket:TSocket; var FDSet:TFDSet);
function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean; {function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean;}
procedure FD_SET(Socket:TSocket; var FDSet:TFDSet); procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
procedure FD_ZERO(var FDSet:TFDSet); procedure FD_ZERO(var FDSet:TFDSet);
@ -2321,31 +2335,36 @@ unit winsock2;
end; end;
end; end;
function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean; {function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean;
begin
begin FD_ISSET:=__WSAFDIsSet(Socket,FDSet);
FD_ISSET:=__WSAFDIsSet(Socket,FDSet); end;}
end;
procedure FD_SET(Socket:TSocket; var FDSet:TFDSet); procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
var i : integer;
begin
if FDSet.fd_count > FD_SETSIZE then
FDSet.fd_count := FD_SETSIZE;
for i := 1 to FDSet.fd_count do
if FDSet.fd_array[i-1] = Socket then exit; {this is what the c macro FD_SET does}
if FDSet.fd_count<FD_SETSIZE then
begin begin
if FDSet.fd_count<FD_SETSIZE then FDSet.fd_array[FDSet.fd_count]:=Socket;
begin Inc(FDSet.fd_count);
FDSet.fd_array[FDSet.fd_count]:=Socket;
Inc(FDSet.fd_count);
end;
end; end;
end;
procedure FD_ZERO(var FDSet:TFDSet); procedure FD_ZERO(var FDSet:TFDSet);
var i : integer;
begin begin
FDSet.fd_count:=0; for i := 0 to high (FDSet.fd_array) do
end; FDSet.fd_array[i] := INVALID_SOCKET;
FDSet.fd_count:=0;
end;
{$ifdef netware} {$ifdef netware}
{windows has connect and accept in ws2_32.dll, netware has not, they {windows has connect and accept in ws2_32.dll, netware has not, they
are defines as macros in ws2nlm.h} are defined as macros in ws2nlm.h }
function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT; function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT;
begin begin
connect := WSAConnect (s,addr,namelen,nil,nil,nil,nil); connect := WSAConnect (s,addr,namelen,nil,nil,nil,nil);
@ -2369,8 +2388,57 @@ unit winsock2;
{$endif} {$endif}
{AD 2003/03/25: Special for netware
if WSAStartup is called more than once, bad thinks will happen
on netware. This is not a problem under windows.
This happens with fcl because the unit initialization of SSockets and
resolve both calls WSAStartup, for the second startup we simply
return success without calling the WS2_32 WSAStartup }
function __WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;
{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
external winsockdll name 'WSAStartup';
function __WSACleanup:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSACleanup';
var WSAstartupData : TWSADATA;
function WSACleanup:tOS_INT;
begin
if WSAstartupData.wVersion <> $ffff then
begin
Result := __WSACleanup;
if Result = 0 then WSAstartupData.wVersion := $ffff;
end else Result := WSANOTINITIALISED;
end;
function WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;
begin
if WSAstartupData.wVersion = $ffff then
begin
Result := __WSAStartup(wVersionRequired,WSAData);
if Result = 0 then WSAstartupData := WSAData;
Writeln (stderr,'WSAStartup called');
end else
begin
result := 0;
Writeln (stderr,'WSAStartup should be called only once !');
end;
end;
initialization
WSAstartupData.wVersion := $ffff;
finalization
WSACleanUp;
end. end.
{ {
$Log: $Log$
Revision 1.1 2003-03-25 18:17:54 armin
* support for fcl, support for linking without debug info
* renamed winsock2 to winsock for win32 compatinility
* new sockets unit for netware
* changes for compiler warnings
} }