mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-26 21:09:26 +02:00
* first rtl version for netwlibc
This commit is contained in:
armin
parent
8efa3e2c3d
commit
4add7ccbc6
1465
rtl/netwlibc/Makefile
Normal file
1465
rtl/netwlibc/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
240
rtl/netwlibc/Makefile.fpc
Normal file
240
rtl/netwlibc/Makefile.fpc
Normal file
@ -0,0 +1,240 @@
|
||||
#
|
||||
# Makefile.fpc for Free Pascal Netware RTL (Libc)
|
||||
#
|
||||
|
||||
[package]
|
||||
main=rtl
|
||||
|
||||
[target]
|
||||
loaders=nwplibc
|
||||
units=$(SYSTEMUNIT) objpas macpas strings \
|
||||
lineinfo winsock heaptrc matrix \
|
||||
nwsnut libc dos crt objects sysconst dynlibs \
|
||||
initc sysutils types typinfo systhrds classes \
|
||||
cpu mmx getopts \
|
||||
dateutils strutils convutils \
|
||||
charset ucomplex variants \
|
||||
rtlconst math varutils utf8bidi \
|
||||
mouse
|
||||
|
||||
rsts=math varutils variants convutils typinfo systhrds classes dateutils sysconst rtlconst
|
||||
|
||||
[require]
|
||||
nortl=y
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
target=netwlibc
|
||||
|
||||
[compiler]
|
||||
includedir=$(INC) $(PROCINC)
|
||||
sourcedir=$(INC) $(PROCINC)
|
||||
targetdir=.
|
||||
|
||||
|
||||
[prerules]
|
||||
RTL=..
|
||||
INC=$(RTL)/inc
|
||||
PROCINC=$(RTL)/$(CPU_TARGET)
|
||||
|
||||
UNITPREFIX=rtl
|
||||
|
||||
ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
|
||||
SYSTEMUNIT=system
|
||||
else
|
||||
SYSTEMUNIT=sysnetwa
|
||||
endif
|
||||
|
||||
# Use new feature from 1.0.5 version
|
||||
# that generates release PPU files
|
||||
# which will not be recompiled
|
||||
# ifdef RELEASE
|
||||
override FPCOPT+=-Ur
|
||||
# endif
|
||||
|
||||
#debug, -a: dont delete asm, -al include lines
|
||||
#override FPCOPT+=-a
|
||||
#override FPCOPT+=-al
|
||||
|
||||
|
||||
# for netware always use multithread
|
||||
override FPCOPT+=-dMT -dDEBUG_MT
|
||||
|
||||
# and alway use smartlinking
|
||||
#CREATESMART=1
|
||||
CREATESMART=0
|
||||
|
||||
# Paths
|
||||
OBJPASDIR=$(RTL)/objpas
|
||||
|
||||
|
||||
[rules]
|
||||
SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
|
||||
|
||||
# Get the system independent include file names.
|
||||
# This will set the following variables :
|
||||
# SYSINCNAMES
|
||||
include $(INC)/makefile.inc
|
||||
SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
|
||||
|
||||
# Get the processor dependent include file names.
|
||||
# This will set the following variables :
|
||||
# CPUINCNAMES
|
||||
include $(PROCINC)/makefile.cpu
|
||||
SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
|
||||
|
||||
# Put system unit dependencies together.
|
||||
SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
|
||||
|
||||
|
||||
#
|
||||
# Loaders
|
||||
#
|
||||
|
||||
#nwpre$(OEXT) : nwpre.as
|
||||
# $(AS) -o nwpre$(OEXT) nwpre.as
|
||||
|
||||
#prelude$(OEXT) : prelude.as
|
||||
# $(AS) -o prelude$(OEXT) prelude.as
|
||||
|
||||
# for now use the gcc pre
|
||||
nwplibc$(OEXT) :
|
||||
cp pre/libcpre.gcc.o nwplibc.o
|
||||
|
||||
#
|
||||
# System Units (System, Objpas, Strings)
|
||||
#
|
||||
|
||||
$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp libc.pp $(SYSDEPS)
|
||||
$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
|
||||
|
||||
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
|
||||
|
||||
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
|
||||
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
|
||||
$(SYSTEMUNIT)$(PPUEXT)
|
||||
systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
|
||||
|
||||
#
|
||||
# System Dependent Units
|
||||
#
|
||||
|
||||
netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -I$(WININC) netware.pp
|
||||
|
||||
|
||||
winsock2$(PPUEXT) : winsock2.pp qos.inc netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
|
||||
$(INC)/sockets.inc $(INC)/socketsh.inc
|
||||
|
||||
dynlibs$(PPUEXT) : $(INC)/dynlibs.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
initc$(PPUEXT) : initc.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
|
||||
#
|
||||
# TP7 Compatible RTL Units
|
||||
#
|
||||
|
||||
dos$(PPUEXT) : dos.pp libc.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
crt$(PPUEXT) : crt.pp libc.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
|
||||
|
||||
objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#
|
||||
# Delphi Compatible Units
|
||||
#
|
||||
|
||||
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
|
||||
objpas$(PPUEXT) dos$(PPUEXT) libc.pp sysconst$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
|
||||
|
||||
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
|
||||
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) \
|
||||
sysconst$(PPUEXT) types$(PPUEXT) systhrds$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
|
||||
|
||||
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
|
||||
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
|
||||
|
||||
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/math.pp
|
||||
|
||||
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/gettext.pp
|
||||
|
||||
varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
|
||||
objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
|
||||
$(COMPILER) -I$(OBJPASDIR) varutils.pp
|
||||
|
||||
utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp
|
||||
$(COMPILER) $(OBJPASDIR)/utf8bidi.pp
|
||||
|
||||
|
||||
variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT)
|
||||
|
||||
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/types.pp
|
||||
|
||||
rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/rtlconst.pp
|
||||
|
||||
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/sysconst.pp
|
||||
|
||||
dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
|
||||
|
||||
convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
|
||||
|
||||
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
|
||||
|
||||
#
|
||||
# Mac Pascal Model
|
||||
#
|
||||
|
||||
macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
|
||||
$(COMPILER) $(INC)/macpas.pp $(REDIR)
|
||||
|
||||
#
|
||||
# Other system-independent RTL Units
|
||||
#
|
||||
|
||||
cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -Sg $(INC)/heaptrc.pp
|
||||
|
||||
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
|
||||
#
|
||||
# Other system-dependent RTL Units
|
||||
#
|
||||
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#
|
||||
# Netware-.imp files need to be installed in the unit-dir
|
||||
#
|
||||
override INSTALLPPUFILES+=nwsnut.imp ws2_32.imp ws2nlm.imp libc.imp netware.imp \
|
||||
libcclib.imp nwplibc.o
|
||||
|
||||
48
rtl/netwlibc/classes.pp
Normal file
48
rtl/netwlibc/classes.pp
Normal file
@ -0,0 +1,48 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1999-2004 by Michael Van Canneyt and Florian Klaempfl
|
||||
|
||||
Classes unit for netware libc
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
{ determine the type of the resource/form file }
|
||||
{$define Win16Res}
|
||||
|
||||
unit Classes;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
sysutils,
|
||||
types,
|
||||
typinfo,
|
||||
rtlconst,
|
||||
systhrds,
|
||||
Libc;
|
||||
|
||||
|
||||
{$i classesh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
{ OS - independent class implementations are in /inc directory. }
|
||||
{$i classes.inc}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
626
rtl/netwlibc/crt.pp
Normal file
626
rtl/netwlibc/crt.pp
Normal file
@ -0,0 +1,626 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team.
|
||||
|
||||
Borland Pascal 7 Compatible CRT Unit for Netware (libc version)
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit crt;
|
||||
|
||||
interface
|
||||
|
||||
{$i crth.inc}
|
||||
|
||||
Const
|
||||
ScreenHeight : longint=25;
|
||||
ScreenWidth : longint=80;
|
||||
|
||||
implementation
|
||||
|
||||
uses Libc;
|
||||
|
||||
|
||||
{$ASMMODE ATT}
|
||||
|
||||
var
|
||||
ScreenHandle : scr_t;
|
||||
|
||||
{ Definition of textrec is in textrec.inc }
|
||||
{$i textrec.inc}
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Low level Routines
|
||||
****************************************************************************}
|
||||
|
||||
procedure setscreenmode(mode : byte);
|
||||
begin
|
||||
setscreenmode (mode);
|
||||
end;
|
||||
|
||||
|
||||
function GetScreenHeight : longint;
|
||||
VAR Height, Width : WORD;
|
||||
begin
|
||||
GetScreenSize(Height, Width);
|
||||
GetScreenHeight := Height;
|
||||
end;
|
||||
|
||||
|
||||
function GetScreenWidth : longint;
|
||||
VAR Height, Width : WORD;
|
||||
begin
|
||||
GetScreenSize(Height, Width);
|
||||
GetScreenWidth := Width;
|
||||
end;
|
||||
|
||||
procedure GetScreenCursor(var x,y : longint);
|
||||
begin
|
||||
x := wherecol+1;
|
||||
y := whererow+1;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Helper Routines
|
||||
****************************************************************************}
|
||||
|
||||
Function WinMinX: Longint;
|
||||
{
|
||||
Current Minimum X coordinate
|
||||
}
|
||||
Begin
|
||||
WinMinX:=(WindMin and $ff)+1;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function WinMinY: Longint;
|
||||
{
|
||||
Current Minimum Y Coordinate
|
||||
}
|
||||
Begin
|
||||
WinMinY:=(WindMin shr 8)+1;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function WinMaxX: Longint;
|
||||
{
|
||||
Current Maximum X coordinate
|
||||
}
|
||||
Begin
|
||||
WinMaxX:=(WindMax and $ff)+1;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function WinMaxY: Longint;
|
||||
{
|
||||
Current Maximum Y coordinate;
|
||||
}
|
||||
Begin
|
||||
WinMaxY:=(WindMax shr 8) + 1;
|
||||
End;
|
||||
|
||||
|
||||
Function FullWin:boolean;
|
||||
{
|
||||
Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
|
||||
}
|
||||
begin
|
||||
FullWin:=(WinMinX=1) and (WinMinY=1) and
|
||||
(WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Public Crt Functions
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
procedure textmode(mode : integer);
|
||||
begin
|
||||
Window (1,1,byte(ScreenWidth),byte(ScreenHeight));
|
||||
ClrScr;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TextColor(Color: Byte);
|
||||
{
|
||||
Switch foregroundcolor
|
||||
}
|
||||
Begin
|
||||
TextAttr:=(Color and $f) or (TextAttr and $70);
|
||||
If (Color>15) Then TextAttr:=TextAttr Or Blink;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Procedure TextBackground(Color: Byte);
|
||||
{
|
||||
Switch backgroundcolor
|
||||
}
|
||||
Begin
|
||||
TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Procedure HighVideo;
|
||||
{
|
||||
Set highlighted output.
|
||||
}
|
||||
Begin
|
||||
TextColor(TextAttr Or $08);
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Procedure LowVideo;
|
||||
{
|
||||
Set normal output
|
||||
}
|
||||
Begin
|
||||
TextColor(TextAttr And $77);
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Procedure NormVideo;
|
||||
{
|
||||
Set normal back and foregroundcolors.
|
||||
}
|
||||
Begin
|
||||
TextColor(7);
|
||||
TextBackGround(0);
|
||||
End;
|
||||
|
||||
|
||||
Procedure GotoXy(X: Byte; Y: Byte);
|
||||
{
|
||||
Go to coordinates X,Y in the current window.
|
||||
}
|
||||
Begin
|
||||
If (X>0) and (X<=WinMaxX- WinMinX+1) and
|
||||
(Y>0) and (Y<=WinMaxY-WinMinY+1) Then
|
||||
Begin
|
||||
X := X + WinMinX - 1;
|
||||
Y := Y + WinMinY - 1;
|
||||
gotorowcol (y-1,x-1);
|
||||
End;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Window(X1, Y1, X2, Y2: Byte);
|
||||
{
|
||||
Set screen window to the specified coordinates.
|
||||
}
|
||||
Begin
|
||||
if (X1>X2) or (X2>ScreenWidth) or
|
||||
(Y1>Y2) or (Y2>ScreenHeight) then
|
||||
exit;
|
||||
WindMin:=((Y1-1) Shl 8)+(X1-1);
|
||||
WindMax:=((Y2-1) Shl 8)+(X2-1);
|
||||
GoToXY(1,1);
|
||||
End;
|
||||
|
||||
|
||||
Procedure ClrScr;
|
||||
{
|
||||
Clear the current window, and set the cursor on 1,1
|
||||
}
|
||||
var
|
||||
rowlen,rows: longint;
|
||||
begin
|
||||
if FullWin then
|
||||
begin
|
||||
clearscreen; {seems to swich cursor off}
|
||||
//_DisplayInputCursor;
|
||||
end else
|
||||
begin
|
||||
rowlen := WinMaxX-WinMinX+1;
|
||||
rows := WinMaxY-WinMinY+1;
|
||||
FillScreenArea(ScreenHandle,WinMinY-1,WinMinX-1,rows,rowlen,' ',textattr);
|
||||
end;
|
||||
Gotoxy(1,1);
|
||||
end;
|
||||
|
||||
|
||||
Procedure ClrEol;
|
||||
{
|
||||
Clear from current position to end of line.
|
||||
}
|
||||
var
|
||||
x,y : longint;
|
||||
rowlen : word;
|
||||
Begin
|
||||
GetScreenCursor(x,y);
|
||||
if x<WinMaxX then
|
||||
begin
|
||||
rowlen := WinMaxX-x+1;
|
||||
FillScreenArea(ScreenHandle,y-1,x-1,1,rowlen,' ',textattr);
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function WhereX: Byte;
|
||||
{
|
||||
Return current X-position of cursor.
|
||||
}
|
||||
Begin
|
||||
WhereX:=wherecol-WinMinX+1;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function WhereY: Byte;
|
||||
{
|
||||
Return current Y-position of cursor.
|
||||
}
|
||||
Begin
|
||||
WhereY:=whererow-WinMinY+1;
|
||||
End;
|
||||
|
||||
|
||||
{*************************************************************************
|
||||
Keyboard
|
||||
*************************************************************************}
|
||||
|
||||
var
|
||||
is_last : boolean;
|
||||
|
||||
{
|
||||
function readkey : char;
|
||||
var
|
||||
keytype,modifier,scancode : longint;
|
||||
begin
|
||||
if is_last then
|
||||
begin
|
||||
is_last:=false;
|
||||
readkey:=getch;
|
||||
end else
|
||||
begin
|
||||
// _SetCtrlCharCheckMode (CheckBreak);
|
||||
WaitForKey (ScreenHandle);
|
||||
getkey(keytype,modifer,scancode):longint;
|
||||
char1 := getch;
|
||||
if char1 = #0 then is_last := true;
|
||||
readkey:=char1;
|
||||
end;
|
||||
end;
|
||||
}
|
||||
|
||||
function readkey : char; // for now
|
||||
begin
|
||||
readkey := char(getcharacter);
|
||||
end;
|
||||
|
||||
|
||||
function keypressed : boolean;
|
||||
begin
|
||||
if is_last then
|
||||
begin
|
||||
keypressed:=true;
|
||||
exit;
|
||||
end else
|
||||
keypressed := (kbhit <> 0);
|
||||
end;
|
||||
|
||||
|
||||
{*************************************************************************
|
||||
Delay
|
||||
*************************************************************************}
|
||||
|
||||
procedure Delay(MS: Word);
|
||||
begin
|
||||
libc.delay (MS);
|
||||
end;
|
||||
|
||||
procedure sound(hz : word);
|
||||
begin
|
||||
RingBell;
|
||||
end;
|
||||
|
||||
procedure nosound;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
HighLevel Crt Functions
|
||||
****************************************************************************}
|
||||
|
||||
{procedure removeline(y : longint);
|
||||
var
|
||||
fil : word;
|
||||
rowlen : word;
|
||||
p : pointer;
|
||||
begin
|
||||
fil:=32 or (textattr shl 8);
|
||||
rowlen:=WinMaxX-WinMinX+1;
|
||||
GetMem (p, rowlen*2);
|
||||
y:=WinMinY+y-1;
|
||||
While (y<=WinMaxY) do
|
||||
begin
|
||||
_CopyFromScreenMemory (1,rowlen,p,WinMinX-1,word(y));
|
||||
_CopyToScreenMemory (1,rowlen,p,WinMinX-1,word(y-1));
|
||||
inc(y);
|
||||
end;
|
||||
FillWord (p^,rowlen,fil);
|
||||
_CopyToScreenMemory (1,rowlen,p,WinMinX-1,WinMaxY-1);
|
||||
FreeMem (p, rowlen*2);
|
||||
end;}
|
||||
procedure removeline(y : longint);
|
||||
var rowlen : longint;
|
||||
begin
|
||||
rowlen:=WinMaxX-WinMinX+1;
|
||||
y:=WinMinY+y-1-1;
|
||||
ScrollScreenArea(ScreenHandle,y,WinMinX-1,WinMaxY-WinMinY+1,rowlen,1,0,SCROLL_UP);
|
||||
end;
|
||||
|
||||
|
||||
procedure delline;
|
||||
begin
|
||||
removeline(wherey);
|
||||
end;
|
||||
|
||||
|
||||
procedure insline;
|
||||
var rowlen : longint;
|
||||
begin
|
||||
rowlen:=WinMaxX-WinMinX+1;
|
||||
ScrollScreenArea(ScreenHandle,wherecol,WinMinX-1,WinMaxY-WinMinY+1,rowlen,1,textattr,SCROLL_DOWN);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Extra Crt Functions
|
||||
****************************************************************************}
|
||||
|
||||
procedure cursoron;
|
||||
begin
|
||||
SetCursorStyle(ScreenHandle,CURSOR_NORMAL);
|
||||
EnableInputCursor(ScreenHandle);
|
||||
end;
|
||||
|
||||
|
||||
procedure cursoroff;
|
||||
begin
|
||||
DisableInputCursor (ScreenHandle);
|
||||
end;
|
||||
|
||||
|
||||
procedure cursorbig;
|
||||
begin
|
||||
SetCursorStyle(ScreenHandle,CURSOR_BLOCK);
|
||||
EnableInputCursor(ScreenHandle);
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Read and Write routines
|
||||
*****************************************************************************}
|
||||
|
||||
var
|
||||
CurrX,CurrY : longint;
|
||||
|
||||
Procedure WriteChar(c:char);
|
||||
var st : array [0..1] of char;
|
||||
begin
|
||||
case c of
|
||||
#10 : inc(CurrY);
|
||||
#13 : CurrX:=WinMinX;
|
||||
#8 : begin
|
||||
if CurrX>WinMinX then
|
||||
dec(CurrX);
|
||||
end;
|
||||
#7 : begin { beep }
|
||||
RingBell;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
//WriteScreenCharacterAttribute(ScreenHandle,CurrY-1,CurrX-1,c,textattr); {not available in protected mode}
|
||||
st[0] := c;
|
||||
st[1] := #0;
|
||||
OutputToScreenWithAttribute(ScreenHandle,textattr,@st);
|
||||
inc(CurrX);
|
||||
end;
|
||||
end;
|
||||
if CurrX>WinMaxX then
|
||||
begin
|
||||
CurrX:=WinMinX;
|
||||
inc(CurrY);
|
||||
end;
|
||||
while CurrY>WinMaxY do
|
||||
begin
|
||||
removeline(1);
|
||||
dec(CurrY);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function CrtWrite(var f : textrec):integer;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
GetScreenCursor(CurrX,CurrY);
|
||||
for i:=0 to f.bufpos-1 do
|
||||
WriteChar(f.buffer[i]); { ad: may be better to use a buffer but i think it's fast enough }
|
||||
gotorowcol (CurrY-1,CurrX-1);
|
||||
f.bufpos:=0;
|
||||
CrtWrite:=0;
|
||||
end;
|
||||
|
||||
|
||||
Function CrtRead(Var F: TextRec): Integer;
|
||||
|
||||
procedure BackSpace;
|
||||
begin
|
||||
if (f.bufpos>0) and (f.bufpos=f.bufend) then
|
||||
begin
|
||||
WriteChar(#8);
|
||||
WriteChar(' ');
|
||||
WriteChar(#8);
|
||||
dec(f.bufpos);
|
||||
dec(f.bufend);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
ch : Char;
|
||||
Begin
|
||||
GetScreenCursor(CurrX,CurrY);
|
||||
f.bufpos:=0;
|
||||
f.bufend:=0;
|
||||
repeat
|
||||
if f.bufpos>f.bufend then
|
||||
f.bufend:=f.bufpos;
|
||||
gotorowcol (CurrY-1,CurrX-1);
|
||||
ch:=readkey;
|
||||
case ch of
|
||||
#0 : case readkey of
|
||||
#71 : while f.bufpos>0 do
|
||||
begin
|
||||
dec(f.bufpos);
|
||||
WriteChar(#8);
|
||||
end;
|
||||
#75 : if f.bufpos>0 then
|
||||
begin
|
||||
dec(f.bufpos);
|
||||
WriteChar(#8);
|
||||
end;
|
||||
#77 : if f.bufpos<f.bufend then
|
||||
begin
|
||||
WriteChar(f.bufptr^[f.bufpos]);
|
||||
inc(f.bufpos);
|
||||
end;
|
||||
#79 : while f.bufpos<f.bufend do
|
||||
begin
|
||||
WriteChar(f.bufptr^[f.bufpos]);
|
||||
inc(f.bufpos);
|
||||
end;
|
||||
end;
|
||||
^S,
|
||||
#8 : BackSpace;
|
||||
^Y,
|
||||
#27 : begin
|
||||
f.bufpos:=f.bufend;
|
||||
while f.bufend>0 do
|
||||
BackSpace;
|
||||
end;
|
||||
#13 : begin
|
||||
WriteChar(#13);
|
||||
WriteChar(#10);
|
||||
f.bufptr^[f.bufend]:=#13;
|
||||
f.bufptr^[f.bufend+1]:=#10;
|
||||
inc(f.bufend,2);
|
||||
break;
|
||||
end;
|
||||
#26 : if CheckEOF then
|
||||
begin
|
||||
f.bufptr^[f.bufend]:=#26;
|
||||
inc(f.bufend);
|
||||
break;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
if f.bufpos<f.bufsize-2 then
|
||||
begin
|
||||
f.buffer[f.bufpos]:=ch;
|
||||
inc(f.bufpos);
|
||||
WriteChar(ch);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until false;
|
||||
f.bufpos:=0;
|
||||
gotorowcol (CurrY-1,CurrX-1);
|
||||
CrtRead:=0;
|
||||
End;
|
||||
|
||||
{$Warnings off}
|
||||
Function CrtReturn(Var F: TextRec): Integer;
|
||||
Begin
|
||||
CrtReturn:=0;
|
||||
end;
|
||||
{$Warnings on}
|
||||
|
||||
|
||||
Function CrtClose(Var F: TextRec): Integer;
|
||||
Begin
|
||||
F.Mode:=fmClosed;
|
||||
CrtClose:=0;
|
||||
End;
|
||||
|
||||
|
||||
Function CrtOpen(Var F: TextRec): Integer;
|
||||
Begin
|
||||
If F.Mode=fmOutput Then
|
||||
begin
|
||||
TextRec(F).InOutFunc:=@CrtWrite;
|
||||
TextRec(F).FlushFunc:=@CrtWrite;
|
||||
end
|
||||
Else
|
||||
begin
|
||||
F.Mode:=fmInput;
|
||||
TextRec(F).InOutFunc:=@CrtRead;
|
||||
TextRec(F).FlushFunc:=@CrtReturn;
|
||||
end;
|
||||
TextRec(F).CloseFunc:=@CrtClose;
|
||||
CrtOpen:=0;
|
||||
End;
|
||||
|
||||
|
||||
procedure AssignCrt(var F: Text);
|
||||
begin
|
||||
Assign(F,'');
|
||||
TextRec(F).OpenFunc:=@CrtOpen;
|
||||
end;
|
||||
|
||||
procedure InitScreenMode;
|
||||
var
|
||||
s_mode : dword;
|
||||
begin
|
||||
getscreenmode (s_mode);
|
||||
lastmode := s_mode;
|
||||
end;
|
||||
|
||||
var
|
||||
x,y : longint;
|
||||
begin
|
||||
ScreenHandle := getscreenhandle;
|
||||
{ Load startup values }
|
||||
ScreenWidth:=GetScreenWidth;
|
||||
ScreenHeight:=GetScreenHeight;
|
||||
lastmode := CO80;
|
||||
GetScreenCursor(x,y);
|
||||
TextColor (LightGray);
|
||||
TextBackground (Black);
|
||||
InitScreenMode;
|
||||
{ Redirect the standard output }
|
||||
assigncrt(Output);
|
||||
Rewrite(Output);
|
||||
TextRec(Output).Handle:=StdOutputHandle;
|
||||
assigncrt(Input);
|
||||
Reset(Input);
|
||||
TextRec(Input).Handle:=StdInputHandle;
|
||||
CheckBreak := FALSE;
|
||||
CheckEOF := FALSE;
|
||||
//_SetCtrlCharCheckMode (CheckBreak);
|
||||
//_SetAutoScreenDestructionMode (TRUE);
|
||||
end.
|
||||
|
||||
748
rtl/netwlibc/dos.pp
Normal file
748
rtl/netwlibc/dos.pp
Normal file
@ -0,0 +1,748 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team.
|
||||
|
||||
Dos unit for BP7 compatible RTL (novell netware libc)
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit dos;
|
||||
interface
|
||||
|
||||
uses libc;
|
||||
|
||||
Const
|
||||
FileNameLen = 255;
|
||||
|
||||
Type
|
||||
searchrec = packed record
|
||||
DirP : POINTER; { used for opendir }
|
||||
EntryP: POINTER; { and readdir }
|
||||
Magic : WORD;
|
||||
fill : array[1..11] of byte;
|
||||
attr : byte;
|
||||
time : longint;
|
||||
size : longint;
|
||||
name : string[255];
|
||||
{ Internals used by netware port only: }
|
||||
_mask : string[255];
|
||||
_dir : string[255];
|
||||
end;
|
||||
|
||||
registers = packed record
|
||||
case i : integer of
|
||||
0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
|
||||
1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
|
||||
2 : (eax, ebx, ecx, edx, ebp, esi, edi : longint);
|
||||
end;
|
||||
|
||||
{$i dosh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
strings;
|
||||
|
||||
{$ASMMODE ATT}
|
||||
|
||||
{*****************************************************************************
|
||||
--- Info / Date / Time ---
|
||||
******************************************************************************}
|
||||
{$PACKRECORDS 4}
|
||||
|
||||
|
||||
function dosversion : word;
|
||||
var i : Tutsname;
|
||||
begin
|
||||
if uname (i) >= 0 then
|
||||
dosversion := WORD (i.netware_major) SHL 8 + i.netware_minor
|
||||
else dosversion := $0005;
|
||||
end;
|
||||
|
||||
|
||||
procedure getdate(var year,month,mday,wday : word);
|
||||
var
|
||||
t : TTime;
|
||||
tm : Ttm;
|
||||
begin
|
||||
time(t); localtime_r(t,tm);
|
||||
with tm do
|
||||
begin
|
||||
year := tm_year+1900;
|
||||
month := tm_mon+1;
|
||||
mday := tm_mday;
|
||||
wday := tm_wday;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure setdate(year,month,day : word);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure gettime(var hour,minute,second,sec100 : word);
|
||||
var
|
||||
t : TTime;
|
||||
tm : Ttm;
|
||||
begin
|
||||
time(t); localtime_r(t,tm);
|
||||
with tm do
|
||||
begin
|
||||
hour := tm_hour;
|
||||
minute := tm_min;
|
||||
second := tm_sec;
|
||||
sec100 := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure settime(hour,minute,second,sec100 : word);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure packtime(var t : datetime;var p : longint);
|
||||
Begin
|
||||
p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
|
||||
End;
|
||||
|
||||
|
||||
Procedure unpacktime(p : longint;var t : datetime);
|
||||
Begin
|
||||
with t do
|
||||
begin
|
||||
sec:=(p and 31) shl 1;
|
||||
min:=(p shr 5) and 63;
|
||||
hour:=(p shr 11) and 31;
|
||||
day:=(p shr 16) and 31;
|
||||
month:=(p shr 21) and 15;
|
||||
year:=(p shr 25)+1980;
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Exec ---
|
||||
******************************************************************************}
|
||||
|
||||
{$ifdef HASTHREADVAR}
|
||||
threadvar
|
||||
{$else HASTHREADVAR}
|
||||
var
|
||||
{$endif HASTHREADVAR}
|
||||
lastdosexitcode : word;
|
||||
|
||||
const maxargs=256;
|
||||
procedure exec(const path : pathstr;const comline : comstr);
|
||||
var c : comstr;
|
||||
i : integer;
|
||||
args : array[0..maxargs] of pchar;
|
||||
arg0 : pathstr;
|
||||
numargs,wstat : integer;
|
||||
begin
|
||||
//writeln ('dos.exec (',path,',',comline,')');
|
||||
arg0 := fexpand (path)+#0;
|
||||
args[0] := @arg0[1];
|
||||
numargs := 0;
|
||||
c:=comline;
|
||||
i:=1;
|
||||
while i<=length(c) do
|
||||
begin
|
||||
if c[i]<>' ' then
|
||||
begin
|
||||
{Commandline argument found. append #0 and set pointer in args }
|
||||
inc(numargs);
|
||||
args[numargs]:=@c[i];
|
||||
while (i<=length(c)) and (c[i]<>' ') do
|
||||
inc(i);
|
||||
c[i] := #0;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
args[numargs+1] := nil;
|
||||
// i := spawnvp (P_WAIT,args[0],@args);
|
||||
i := procve(args[0], PROC_CURRENT_SPACE+PROC_INHERIT_CWD,nil,nil,nil,nil,0,nil,args);
|
||||
if i <> -1 then
|
||||
begin
|
||||
waitpid(i,@wstat,0);
|
||||
doserror := 0;
|
||||
lastdosexitcode := wstat;
|
||||
end else
|
||||
begin
|
||||
doserror := 8; // for now, what about errno ?
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function dosexitcode : word;
|
||||
begin
|
||||
dosexitcode:=lastdosexitcode;
|
||||
end;
|
||||
|
||||
|
||||
procedure getcbreak(var breakvalue : boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure setcbreak(breakvalue : boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure getverify(var verify : boolean);
|
||||
begin
|
||||
verify := true;
|
||||
end;
|
||||
|
||||
|
||||
procedure setverify(verify : boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Disk ---
|
||||
******************************************************************************}
|
||||
|
||||
function getvolnum (drive : byte) : longint;
|
||||
var dir : STRING[255];
|
||||
P,PS,
|
||||
V : LONGINT;
|
||||
begin
|
||||
{if drive = 0 then
|
||||
begin // get volume name from current directory (i.e. SERVER-NAME/VOL2:TEST)
|
||||
getdir (0,dir);
|
||||
p := pos (':', dir);
|
||||
if p = 0 then
|
||||
begin
|
||||
getvolnum := -1;
|
||||
exit;
|
||||
end;
|
||||
byte (dir[0]) := p-1;
|
||||
dir[p] := #0;
|
||||
PS := pos ('/', dir);
|
||||
INC (PS);
|
||||
if _GetVolumeNumber (@dir[PS], V) <> 0 then
|
||||
getvolnum := -1
|
||||
else
|
||||
getvolnum := V;
|
||||
end else
|
||||
getvolnum := drive-1;}
|
||||
end;
|
||||
|
||||
|
||||
function diskfree(drive : byte) : int64;
|
||||
VAR Buf : ARRAY [0..255] OF CHAR;
|
||||
TotalBlocks : WORD;
|
||||
SectorsPerBlock : WORD;
|
||||
availableBlocks : WORD;
|
||||
totalDirectorySlots : WORD;
|
||||
availableDirSlots : WORD;
|
||||
volumeisRemovable : WORD;
|
||||
volumeNumber : LONGINT;
|
||||
begin
|
||||
volumeNumber := getvolnum (drive);
|
||||
(*
|
||||
if volumeNumber >= 0 then
|
||||
begin
|
||||
{i think thats not the right function but for others i need a connection handle}
|
||||
if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
|
||||
TotalBlocks,
|
||||
SectorsPerBlock,
|
||||
availableBlocks,
|
||||
totalDirectorySlots,
|
||||
availableDirSlots,
|
||||
volumeisRemovable) = 0 THEN
|
||||
begin
|
||||
diskfree := int64 (availableBlocks) * int64 (SectorsPerBlock) * 512;
|
||||
end else
|
||||
diskfree := 0;
|
||||
end else*)
|
||||
diskfree := 0;
|
||||
end;
|
||||
|
||||
|
||||
function disksize(drive : byte) : int64;
|
||||
VAR Buf : ARRAY [0..255] OF CHAR;
|
||||
TotalBlocks : WORD;
|
||||
SectorsPerBlock : WORD;
|
||||
availableBlocks : WORD;
|
||||
totalDirectorySlots : WORD;
|
||||
availableDirSlots : WORD;
|
||||
volumeisRemovable : WORD;
|
||||
volumeNumber : LONGINT;
|
||||
begin
|
||||
volumeNumber := getvolnum (drive);
|
||||
(*
|
||||
if volumeNumber >= 0 then
|
||||
begin
|
||||
{i think thats not the right function but for others i need a connection handle}
|
||||
if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
|
||||
TotalBlocks,
|
||||
SectorsPerBlock,
|
||||
availableBlocks,
|
||||
totalDirectorySlots,
|
||||
availableDirSlots,
|
||||
volumeisRemovable) = 0 THEN
|
||||
begin
|
||||
disksize := int64 (TotalBlocks) * int64 (SectorsPerBlock) * 512;
|
||||
end else
|
||||
disksize := 0;
|
||||
end else*)
|
||||
disksize := 0;
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Utils ---
|
||||
******************************************************************************}
|
||||
|
||||
procedure timet2dostime (timet:longint; var dostime : longint);
|
||||
var tm : Ttm;
|
||||
begin
|
||||
localtime_r(timet,tm);
|
||||
dostime:=(tm.tm_sec shr 1)+(tm.tm_min shl 5)+(tm.tm_hour shl 11)+(tm.tm_mday shl 16)+((tm.tm_mon+1) shl 21)+((tm.tm_year+1900-1980) shl 25);
|
||||
end;
|
||||
|
||||
function nwattr2dosattr (nwattr : longint) : word;
|
||||
begin
|
||||
nwattr2dosattr := 0;
|
||||
if nwattr and M_A_RDONLY > 0 then nwattr2dosattr := nwattr2dosattr + readonly;
|
||||
if nwattr and M_A_HIDDEN > 0 then nwattr2dosattr := nwattr2dosattr + hidden;
|
||||
if nwattr and M_A_SYSTEM > 0 then nwattr2dosattr := nwattr2dosattr + sysfile;
|
||||
if nwattr and M_A_SUBDIR > 0 then nwattr2dosattr := nwattr2dosattr + directory;
|
||||
if nwattr and M_A_ARCH > 0 then nwattr2dosattr := nwattr2dosattr + archive;
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Findfirst FindNext ---
|
||||
******************************************************************************}
|
||||
|
||||
|
||||
procedure find_setfields (var f : searchRec);
|
||||
var
|
||||
StatBuf : TStat;
|
||||
fname : string[255];
|
||||
begin
|
||||
with F do
|
||||
begin
|
||||
if Magic = $AD01 then
|
||||
begin
|
||||
attr := nwattr2dosattr (Pdirent(EntryP)^.d_mode);
|
||||
size := Pdirent(EntryP)^.d_size;
|
||||
name := strpas (Pdirent(EntryP)^.d_name);
|
||||
doserror := 0;
|
||||
fname := f._dir + f.name;
|
||||
if length (fname) = 255 then dec (byte(fname[0]));
|
||||
fname := fname + #0;
|
||||
if stat (@fname[1],StatBuf) = 0 then
|
||||
timet2dostime (StatBuf.st_mtim.tv_sec, time)
|
||||
else
|
||||
time := 0;
|
||||
end else
|
||||
begin
|
||||
FillChar (f,sizeof(f),0);
|
||||
doserror := 18;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
|
||||
var
|
||||
path0 : array[0..256] of char;
|
||||
p : longint;
|
||||
begin
|
||||
IF path = '' then
|
||||
begin
|
||||
doserror := 18;
|
||||
exit;
|
||||
end;
|
||||
if (pos ('?',path) > 0) or (pos ('*',path) > 0) then
|
||||
begin
|
||||
p := length (path);
|
||||
while (p > 0) and (not (path[p] in ['\','/'])) do
|
||||
dec (p);
|
||||
if p > 0 then
|
||||
begin
|
||||
f._mask := copy (path,p+1,255);
|
||||
f._dir := copy (path,1,p);
|
||||
strpcopy(path0,f._dir);
|
||||
end else
|
||||
begin
|
||||
f._mask := path;
|
||||
getdir (0,f._dir);
|
||||
if (f._dir[length(f._dir)] <> '/') and
|
||||
(f._dir[length(f._dir)] <> '\') then
|
||||
f._dir := f._dir + '/';
|
||||
end;
|
||||
end;
|
||||
//writeln (stderr,'mask: "',f._mask,'" dir:"',path0,'"');
|
||||
f._mask := f._mask + #0;
|
||||
Pdirent(f.DirP) := opendir (path0);
|
||||
if f.DirP = nil then
|
||||
doserror := 18
|
||||
else begin
|
||||
F.Magic := $AD01;
|
||||
findnext (f);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure findnext(var f : searchRec);
|
||||
begin
|
||||
if F.Magic <> $AD01 then
|
||||
begin
|
||||
doserror := 18;
|
||||
exit;
|
||||
end;
|
||||
doserror:=0;
|
||||
repeat
|
||||
Pdirent(f.EntryP) := readdir (Pdirent(f.DirP));
|
||||
if F.EntryP = nil then
|
||||
doserror := 18
|
||||
else
|
||||
if f._mask = #0 then
|
||||
begin
|
||||
find_setfields (f);
|
||||
exit;
|
||||
end else
|
||||
if fnmatch(@f._mask[1],Pdirent(f.EntryP)^.d_name,FNM_CASEFOLD) = 0 then
|
||||
begin
|
||||
find_setfields (f);
|
||||
exit;
|
||||
end;
|
||||
until doserror <> 0;
|
||||
end;
|
||||
|
||||
|
||||
Procedure FindClose(Var f: SearchRec);
|
||||
begin
|
||||
if F.Magic <> $AD01 then
|
||||
begin
|
||||
doserror := 18;
|
||||
EXIT;
|
||||
end;
|
||||
doserror:=0;
|
||||
closedir (Pdirent(f.DirP));
|
||||
f.Magic := 0;
|
||||
f.DirP := NIL;
|
||||
f.EntryP := NIL;
|
||||
end;
|
||||
|
||||
|
||||
procedure swapvectors;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- File ---
|
||||
******************************************************************************}
|
||||
|
||||
procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
|
||||
var
|
||||
dotpos,p1,i : longint;
|
||||
begin
|
||||
{ allow backslash as slash }
|
||||
for i:=1 to length(path) do
|
||||
if path[i]='\' then path[i]:='/';
|
||||
{ get volume name }
|
||||
p1:=pos(':',path);
|
||||
if p1>0 then
|
||||
begin
|
||||
dir:=copy(path,1,p1);
|
||||
delete(path,1,p1);
|
||||
end
|
||||
else
|
||||
dir:='';
|
||||
{ split the path and the name, there are no more path informtions }
|
||||
{ if path contains no backslashes }
|
||||
while true do
|
||||
begin
|
||||
p1:=pos('/',path);
|
||||
if p1=0 then
|
||||
break;
|
||||
dir:=dir+copy(path,1,p1);
|
||||
delete(path,1,p1);
|
||||
end;
|
||||
{ try to find out a extension }
|
||||
//if LFNSupport then
|
||||
begin
|
||||
Ext:='';
|
||||
i:=Length(Path);
|
||||
DotPos:=256;
|
||||
While (i>0) Do
|
||||
Begin
|
||||
If (Path[i]='.') Then
|
||||
begin
|
||||
DotPos:=i;
|
||||
break;
|
||||
end;
|
||||
Dec(i);
|
||||
end;
|
||||
Ext:=Copy(Path,DotPos,255);
|
||||
Name:=Copy(Path,1,DotPos - 1);
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
function GetShortName(var p : String) : boolean;
|
||||
begin
|
||||
GetShortName := false;
|
||||
end;
|
||||
|
||||
function GetLongName(var p : String) : boolean;
|
||||
begin
|
||||
GetLongName := false;
|
||||
end;
|
||||
|
||||
|
||||
{$define FPC_FEXPAND_DRIVES}
|
||||
{$define FPC_FEXPAND_VOLUMES}
|
||||
{$define FPC_FEXPAND_NO_DEFAULT_PATHS}
|
||||
{$i fexpand.inc}
|
||||
|
||||
Function FSearch(path: pathstr; dirlist: string): pathstr;
|
||||
var
|
||||
i,p1 : longint;
|
||||
s : searchrec;
|
||||
newdir : pathstr;
|
||||
begin
|
||||
system.write ('FSearch ("',path,'","',dirlist,'"');
|
||||
{ check if the file specified exists }
|
||||
findfirst(path,anyfile,s);
|
||||
if doserror=0 then
|
||||
begin
|
||||
findclose(s);
|
||||
fsearch:=path;
|
||||
exit;
|
||||
end;
|
||||
{ No wildcards allowed in these things }
|
||||
if (pos('?',path)<>0) or (pos('*',path)<>0) then
|
||||
fsearch:=''
|
||||
else
|
||||
begin
|
||||
{ allow backslash as slash }
|
||||
for i:=1 to length(dirlist) do
|
||||
if dirlist[i]='\' then dirlist[i]:='/';
|
||||
repeat
|
||||
p1:=pos(';',dirlist);
|
||||
if p1<>0 then
|
||||
begin
|
||||
newdir:=copy(dirlist,1,p1-1);
|
||||
delete(dirlist,1,p1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
newdir:=dirlist;
|
||||
dirlist:='';
|
||||
end;
|
||||
if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
|
||||
newdir:=newdir+'/';
|
||||
findfirst(newdir+path,anyfile,s);
|
||||
if doserror=0 then
|
||||
newdir:=newdir+path
|
||||
else
|
||||
newdir:='';
|
||||
until (dirlist='') or (newdir<>'');
|
||||
fsearch:=newdir;
|
||||
end;
|
||||
findclose(s);
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Get/Set File Time,Attr ---
|
||||
******************************************************************************}
|
||||
|
||||
|
||||
procedure getftime(var f;var time : longint);
|
||||
var
|
||||
StatBuf : TStat;
|
||||
begin
|
||||
doserror := 0;
|
||||
if fstat (FileRec (f).Handle, StatBuf) = 0 then
|
||||
timet2dostime (StatBuf.st_mtim.tv_sec,time)
|
||||
else begin
|
||||
time := 0;
|
||||
doserror := ___errno^;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure setftime(var f;time : longint);
|
||||
begin
|
||||
{is there a netware function to do that ?????}
|
||||
ConsolePrintf ('warning: fpc dos.setftime not implemented'#13#10);
|
||||
end;
|
||||
|
||||
|
||||
procedure getfattr(var f;var attr : word);
|
||||
VAR StatBuf : TStat;
|
||||
begin
|
||||
doserror := 0;
|
||||
if fstat (FileRec (f).Handle, StatBuf) = 0 then
|
||||
attr := nwattr2dosattr (StatBuf.st_mode)
|
||||
else
|
||||
begin
|
||||
attr := 0;
|
||||
doserror := ___errno^;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure setfattr(var f;attr : word);
|
||||
var
|
||||
StatBuf : TStat;
|
||||
newMode : longint;
|
||||
begin
|
||||
if fstat (FileRec(f).Handle,StatBuf) = 0 then
|
||||
begin
|
||||
newmode := StatBuf.st_mode and ($FFFFFFFF - M_A_RDONLY-M_A_HIDDEN-M_A_SYSTEM-M_A_ARCH); {only this can be set by dos unit}
|
||||
newmode := newmode and M_A_BITS_SIGNIFICANT; {set netware attributes}
|
||||
if attr and readonly > 0 then
|
||||
newmode := newmode or M_A_RDONLY;
|
||||
if attr and hidden > 0 then
|
||||
newmode := newmode or M_A_HIDDEN;
|
||||
if attr and sysfile > 0 then
|
||||
newmode := newmode or M_A_SYSTEM;
|
||||
if attr and archive > 0 then
|
||||
newmode := newmode or M_A_ARCH;
|
||||
if fchmod (FileRec(f).Handle,newMode) < 0 then
|
||||
doserror := ___errno^ else
|
||||
doserror := 0;
|
||||
end else
|
||||
doserror := ___errno^;
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Environment ---
|
||||
******************************************************************************}
|
||||
|
||||
Function EnvCount: Longint;
|
||||
var
|
||||
envcnt : longint;
|
||||
p : ppchar;
|
||||
Begin
|
||||
envcnt:=0;
|
||||
p:=envp; {defined in system}
|
||||
while (p^<>nil) do
|
||||
begin
|
||||
inc(envcnt);
|
||||
inc(p);
|
||||
end;
|
||||
EnvCount := envcnt
|
||||
End;
|
||||
|
||||
|
||||
Function EnvStr (Index: longint): String;
|
||||
Var
|
||||
i : longint;
|
||||
p : ppchar;
|
||||
Begin
|
||||
if Index <= 0 then
|
||||
envstr:=''
|
||||
else
|
||||
begin
|
||||
p:=envp; {defined in system}
|
||||
i:=1;
|
||||
while (i<Index) and (p^<>nil) do
|
||||
begin
|
||||
inc(i);
|
||||
inc(p);
|
||||
end;
|
||||
if p=nil then
|
||||
envstr:=''
|
||||
else
|
||||
envstr:=strpas(p^)
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ works fine (at least with netware 6.5) }
|
||||
Function GetEnv(envvar: string): string;
|
||||
var envvar0 : array[0..512] of char;
|
||||
p : pchar;
|
||||
i,isDosPath,res : longint;
|
||||
begin
|
||||
if upcase(envvar) = 'PATH' then
|
||||
begin // netware does not have search paths in the environment var PATH
|
||||
// return it here (needed for the compiler)
|
||||
GetEnv := '';
|
||||
i := 1;
|
||||
res := GetSearchPathElement (i, isdosPath, @envvar0[0]);
|
||||
while res = 0 do
|
||||
begin
|
||||
if GetEnv <> '' then GetEnv := GetEnv + ';';
|
||||
GetEnv := GetEnv + envvar0;
|
||||
inc (i);
|
||||
res := GetSearchPathElement (i, isdosPath, @envvar0[0]);
|
||||
end;
|
||||
for i := 1 to length(GetEnv) do
|
||||
if GetEnv[i] = '\' then
|
||||
GetEnv[i] := '/';
|
||||
end else
|
||||
begin
|
||||
strpcopy(envvar0,envvar);
|
||||
p := libc.getenv (envvar0);
|
||||
if p = NIL then
|
||||
GetEnv := ''
|
||||
else
|
||||
GetEnv := strpas (p);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Not Supported ---
|
||||
******************************************************************************}
|
||||
|
||||
Procedure keep(exitcode : word);
|
||||
Begin
|
||||
{ simply wait until nlm will be unloaded }
|
||||
while true do delay (60000);
|
||||
End;
|
||||
|
||||
Procedure getintvec(intno : byte;var vector : pointer);
|
||||
Begin
|
||||
{ no netware equivalent }
|
||||
End;
|
||||
|
||||
Procedure setintvec(intno : byte;vector : pointer);
|
||||
Begin
|
||||
{ no netware equivalent }
|
||||
End;
|
||||
|
||||
procedure intr(intno : byte;var regs : registers);
|
||||
begin
|
||||
{ no netware equivalent }
|
||||
end;
|
||||
|
||||
procedure msdos(var regs : registers);
|
||||
begin
|
||||
{ no netware equivalent }
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
|
||||
62
rtl/netwlibc/dynlibs.inc
Normal file
62
rtl/netwlibc/dynlibs.inc
Normal file
@ -0,0 +1,62 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team
|
||||
|
||||
Implement OS-dependent part of dynamic library loading.
|
||||
|
||||
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 readinterface}
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Interface declarations
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Type
|
||||
TLibHandle = Pointer;
|
||||
|
||||
Const
|
||||
NilHandle = Nil;
|
||||
|
||||
{$else}
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Implementation section
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
uses libc;
|
||||
|
||||
Function LoadLibrary(Name : AnsiString) : TLibHandle;
|
||||
|
||||
begin
|
||||
Result:=dlopen(Pchar(Name),RTLD_LAZY);
|
||||
end;
|
||||
|
||||
Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
|
||||
|
||||
begin
|
||||
Result:=dlsym(lib,pchar(ProcName));
|
||||
end;
|
||||
|
||||
Function UnloadLibrary(Lib : TLibHandle) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=dlClose(Lib)=0;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
147
rtl/netwlibc/errno.inc
Normal file
147
rtl/netwlibc/errno.inc
Normal file
@ -0,0 +1,147 @@
|
||||
{ -------------------------- Base POSIX-mandated constants --------------- }
|
||||
{ no such file or directory }
|
||||
const
|
||||
SYS_ENOENT = 1; // arg list too big
|
||||
SYS_E2BIG = 2; // arg list too big
|
||||
SYS_ENOEXEC = 3; // exec format error
|
||||
SYS_EBADF = 4; // bad file number
|
||||
SYS_ENOMEM = 5; // not enough memory
|
||||
SYS_EACCES = 6; // permission denied
|
||||
SYS_EEXIST = 7; // file exists
|
||||
SYS_EXDEV = 8; // cross-device link
|
||||
SYS_EINVAL = 9; // invalid argument
|
||||
SYS_ENFILE = 10; // file table overflow
|
||||
SYS_EMFILE = 11; // too many open files
|
||||
SYS_ENOSPC = 12; // no space left on device
|
||||
SYS_EDOM = 13; // argument too large
|
||||
SYS_ERANGE = 14; // result too large
|
||||
SYS_EDEADLK = 15; // resource deadlock would occur
|
||||
{ -------------------------- Miscellaneous NLM Library constants --------- }
|
||||
SYS_EINUSE = 16; // resource(s) in use
|
||||
SYS_ESERVER = 17; // server error (memory out, I/O error, etc.)
|
||||
SYS_ENOSERVR = 18; // no server (queue server, file server, etc.)
|
||||
SYS_EWRNGKND = 19; // wrong kind--an operation is being...
|
||||
// ...attempted on the wrong kind of object
|
||||
SYS_ETRNREST = 20; // transaction restarted
|
||||
SYS_ERESOURCE = 21; // resources unavailable (maybe permanently)
|
||||
SYS_EBADHNDL = 22; // bad non-file handle (screen, semaphore, etc)
|
||||
SYS_ENO_SCRNS = 23; // screen I/O attempted when no screens
|
||||
{ -------------------------- Additional POSIX / traditional UNIX constants }
|
||||
SYS_EAGAIN = 24; // resource temporarily unavailable
|
||||
SYS_ENXIO = 25; // no such device or address
|
||||
SYS_EBADMSG = 26; // not a data message
|
||||
SYS_EFAULT = 27; // bad address
|
||||
SYS_EIO = 28; // physical I/O error
|
||||
SYS_ENODATA = 29; // no data
|
||||
SYS_ENOSTRMS = 30; // streams not available
|
||||
{ Berkeley sockets constants ------------------ }
|
||||
SYS_EPROTO = 31; // fatal protocol error
|
||||
SYS_EPIPE = 32; // broken pipe
|
||||
SYS_ESPIPE = 33; // illegal seek
|
||||
{ Non-blocking and interrupt I/O constants ---- }
|
||||
SYS_ETIME = 34; // ioctl acknowledge timeout
|
||||
{ operation would block }
|
||||
SYS_EWOULDBLOCK=35; // operation would block
|
||||
SYS_EINPROGRESS=36; // operation now in progress
|
||||
SYS_EALREADY = 37; // operation already in progress
|
||||
{ IPC network argument constants -------------- }
|
||||
SYS_ENOTSOCK = 38; // socket operation on non-socket
|
||||
SYS_EDESTADDRREQ=39; // destination address required
|
||||
SYS_EMSGSIZE = 40; // message too long
|
||||
SYS_EPROTOTYPE= 41; // protocol wrong type for socket
|
||||
SYS_ENOPROTOOPT=42; // protocol not available
|
||||
SYS_EPROTONOSUPPORT = 43; // protocol not supported
|
||||
SYS_ESOCKTNOSUPPORT = 44; // socket type not supported
|
||||
SYS_EOPNOTSUPP = 45; // operation not supported on socket
|
||||
SYS_EPFNOSUPPORT = 46; // protocol family not supported
|
||||
SYS_EAFNOSUPPORT = 47; // address family unsupported by protocol family
|
||||
SYS_EADDRINUSE = 48; // address already in use
|
||||
SYS_EADDRNOTAVAIL = 49; // can't assign requested address
|
||||
{ Operational constants ----------------------- }
|
||||
SYS_ENETDOWN = 50; // Network is down
|
||||
{ network is unreachable }
|
||||
SYS_ENETUNREACH = 51;
|
||||
{ network dropped connection on reset }
|
||||
SYS_ENETRESET = 52;
|
||||
{ software caused connection abort }
|
||||
SYS_ECONNABORTED = 53;
|
||||
{ connection reset by peer }
|
||||
SYS_ECONNRESET = 54;
|
||||
{ no buffer space available }
|
||||
SYS_ENOBUFS = 55;
|
||||
{ socket is already connected }
|
||||
SYS_EISCONN = 56;
|
||||
{ socket is not connected }
|
||||
SYS_ENOTCONN = 57;
|
||||
{ can't send after socket shutdown }
|
||||
SYS_ESHUTDOWN = 58;
|
||||
{ too many references: can't splice }
|
||||
SYS_ETOOMANYREFS = 59;
|
||||
{ connection timed out }
|
||||
SYS_ETIMEDOUT = 60;
|
||||
{ connection refused }
|
||||
SYS_ECONNREFUSED = 61;
|
||||
{ -------------------------- Additional POSIX-mandated constants --------- }
|
||||
{ resource busy }
|
||||
SYS_EBUSY = 62;
|
||||
{ interrupted function call }
|
||||
SYS_EINTR = 63;
|
||||
{ is a directory }
|
||||
SYS_EISDIR = 64;
|
||||
{ filename too long }
|
||||
SYS_ENAMETOOLONG = 65;
|
||||
{ function not implemented }
|
||||
SYS_ENOSYS = 66;
|
||||
{ not a directory }
|
||||
SYS_ENOTDIR = 67;
|
||||
{ directory not empty }
|
||||
SYS_ENOTEMPTY = 68;
|
||||
{ operation not permitted }
|
||||
SYS_EPERM = 69;
|
||||
{ no child process }
|
||||
SYS_ECHILD = 70;
|
||||
{ file too large }
|
||||
SYS_EFBIG = 71;
|
||||
{ too many links }
|
||||
SYS_EMLINK = 72;
|
||||
SYS_ELOOP = SYS_EMLINK;
|
||||
{ no such device }
|
||||
SYS_ENODEV = 73;
|
||||
{ no locks available }
|
||||
SYS_ENOLCK = 74;
|
||||
{ inappropriate I/O control operation }
|
||||
SYS_ENOTTY = 75;
|
||||
{ inappropriate operation for file type }
|
||||
SYS_EFTYPE = SYS_ENOTTY;
|
||||
{ read-only file system }
|
||||
SYS_EROFS = 76;
|
||||
{ no such process }
|
||||
SYS_ESRCH = 77;
|
||||
{ operation was cancelled }
|
||||
SYS_ECANCELED = 78;
|
||||
{ this optional functionality not supported }
|
||||
SYS_ENOTSUP = 79;
|
||||
{ -------------------------- CLib-implementation-specific constants ------ }
|
||||
SYS_ECANCELLED = SYS_ECANCELED;
|
||||
{ anomaly in NLM data structure }
|
||||
SYS_ENLMDATA = 100;
|
||||
{ illegal character sequence in multibyte }
|
||||
SYS_EILSEQ = 101;
|
||||
{ internal library inconsistency }
|
||||
SYS_EINCONSIS = 102;
|
||||
{ DOS-text file inconsistency--no newline... }
|
||||
SYS_EDOSTEXTEOL = 103;
|
||||
{ ...after carriage return }
|
||||
{ object doesn't exist }
|
||||
SYS_ENONEXTANT = 104;
|
||||
SYS_ENOCONTEXT = 105; // no thread library context present
|
||||
SYS_ELASTERR = SYS_ENOCONTEXT;
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
Revision 1.4 2002/09/07 16:01:20 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
}
|
||||
54
rtl/netwlibc/initc.pp
Normal file
54
rtl/netwlibc/initc.pp
Normal file
@ -0,0 +1,54 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team.
|
||||
|
||||
This file handles the libc errno abstraction.
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
unit initc;
|
||||
|
||||
interface
|
||||
|
||||
type libcint = longint;
|
||||
plibcint = ^libcint;
|
||||
|
||||
function fpgetCerrno:libcint;
|
||||
procedure fpsetCerrno(err:libcint);
|
||||
|
||||
{$ifdef HASGLOBALPROPERTY}
|
||||
property cerrno:libcint read fpgetCerrno write fpsetcerrno;
|
||||
{$endif HASGLOBALPROPERTY}
|
||||
|
||||
implementation
|
||||
|
||||
const clib = 'libc';
|
||||
|
||||
function geterrnolocation: Plibcint; cdecl;external clib name '___errno';
|
||||
|
||||
function fpgetCerrno:libcint;
|
||||
|
||||
begin
|
||||
fpgetCerrno:=geterrnolocation^;
|
||||
end;
|
||||
|
||||
procedure fpsetCerrno(err:libcint);
|
||||
begin
|
||||
geterrnolocation^:=err;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
1391
rtl/netwlibc/libc.imp
Normal file
1391
rtl/netwlibc/libc.imp
Normal file
File diff suppressed because it is too large
Load Diff
9274
rtl/netwlibc/libc.pp
Normal file
9274
rtl/netwlibc/libc.pp
Normal file
File diff suppressed because it is too large
Load Diff
2
rtl/netwlibc/libcclib.imp
Normal file
2
rtl/netwlibc/libcclib.imp
Normal file
@ -0,0 +1,2 @@
|
||||
CLibLoadBroker,
|
||||
CLibUnloadBroker
|
||||
122
rtl/netwlibc/mouse.pp
Normal file
122
rtl/netwlibc/mouse.pp
Normal file
@ -0,0 +1,122 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 Armin Diehl, member of the
|
||||
Free Pascal development team
|
||||
|
||||
Dummy Mouse unit 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.
|
||||
|
||||
**********************************************************************}
|
||||
{2001/04/14 armin: first version, only a dummy, i think there is no 'official' way to support
|
||||
a mouse under netware }
|
||||
unit Mouse;
|
||||
interface
|
||||
|
||||
{$ifdef NOMOUSE}
|
||||
{$DEFINE NOGPM}
|
||||
{$ENDIF}
|
||||
|
||||
{const
|
||||
MouseEventBufSize = 16; }
|
||||
|
||||
{$i mouseh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
procedure PlaceMouseCur(ofs:longint);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure InitMouse;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure DoneMouse;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function DetectMouse:byte;
|
||||
begin
|
||||
DetectMouse:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure ShowMouse;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure HideMouse;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function GetMouseX:word;
|
||||
begin
|
||||
GetMouseX:=0;
|
||||
end;
|
||||
|
||||
|
||||
function GetMouseY:word;
|
||||
begin
|
||||
GetMouseY:=0;
|
||||
end;
|
||||
|
||||
|
||||
function GetMouseButtons:word;
|
||||
begin
|
||||
GetMouseButtons:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure SetMouseXY(x,y:word);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure GetMouseEvent(var MouseEvent: TMouseEvent);
|
||||
begin
|
||||
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
||||
end;
|
||||
|
||||
|
||||
procedure PutMouseEvent(const MouseEvent: TMouseEvent);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
|
||||
begin
|
||||
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
Procedure SetMouseDriver(Const Driver : TMouseDriver);
|
||||
{ Sets the mouse driver. }
|
||||
begin
|
||||
end;
|
||||
|
||||
Procedure GetMouseDriver(Var Driver : TMouseDriver);
|
||||
{ Returns the currently active mouse driver }
|
||||
begin
|
||||
FillChar (Driver, sizeof(Driver),0);
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
122
rtl/netwlibc/netware.imp
Normal file
122
rtl/netwlibc/netware.imp
Normal file
@ -0,0 +1,122 @@
|
||||
Abend,
|
||||
ActivateScreen,
|
||||
AddSearchPathAtEnd,
|
||||
AddSoftBreakpoint,
|
||||
AddressOfSoftBreakpoint,
|
||||
Alloc,
|
||||
AllocSleepOK,
|
||||
AllocateResourceTag,
|
||||
CSetABreakpoint,
|
||||
CanEventBlock,
|
||||
CheckForRegisteredEvent,
|
||||
CheckIfScreenActive,
|
||||
CheckKeyStatus,
|
||||
ClearScreen,
|
||||
CloseScreen,
|
||||
DSAllocateEventTag,
|
||||
DeRegisterCommand,
|
||||
DeleteSearchPath,
|
||||
DisableInputCursor,
|
||||
DisplayScreenLine,
|
||||
DisplayScreenText,
|
||||
DisplayScreenTextWithAttribute,
|
||||
EnableInputCursor,
|
||||
EnterDebugger,
|
||||
ESMAlloc,
|
||||
ESMAllocWindow,
|
||||
ESMCopy,
|
||||
ESMFill,
|
||||
ESMFree,
|
||||
ESMFreeWindow,
|
||||
ESMMapMemory,
|
||||
ESMQuery,
|
||||
EventCheck,
|
||||
EventReport,
|
||||
FillScreenArea,
|
||||
FillScreenAreaAttribute,
|
||||
Free,
|
||||
GetActiveScreen,
|
||||
GetActualScreenSize,
|
||||
GetCursorStyle,
|
||||
GetDebuggerActiveCount,
|
||||
GetHighResolutionTimer,
|
||||
GetInputCursorPosition,
|
||||
GetKey,
|
||||
GetOutputCursorPosition,
|
||||
GetScreenAddress,
|
||||
GetScreenName,
|
||||
GetScreenSize,
|
||||
GetSearchPathElement,
|
||||
GetSetableParameterValue,
|
||||
GetSuperHighResolutionTimer,
|
||||
InsertSearchPath,
|
||||
IsScreenModeSupported,
|
||||
KernelSpinLock,
|
||||
KernelSpinLockInit,
|
||||
KernelSpinTryLock,
|
||||
KernelSpinTryLockDisable,
|
||||
KernelSpinUnlock,
|
||||
KernelSpinUnlockRestore,
|
||||
KillMe,
|
||||
LoadLanguageMessageTable,
|
||||
LoadModule,
|
||||
NVMKernelLock,
|
||||
NVMKernelUnlock,
|
||||
NWGarbageCollect,
|
||||
NWGetAvailableMemory,
|
||||
NWGetPageSize,
|
||||
NWMemorySizeAddressable,
|
||||
OpenScreen,
|
||||
OutputToScreen,
|
||||
OutputToScreenWithAttribute,
|
||||
OutputToScreenWithPointer,
|
||||
ParseCommand,
|
||||
Pause,
|
||||
PauseWithEscape,
|
||||
PositionInputCursor,
|
||||
PositionOutputCursor,
|
||||
ReadScreenCharacter,
|
||||
RegisterCommand,
|
||||
RegisterConsoleCommand,
|
||||
RegisterDebugCommandParser,
|
||||
RegisterForEventNotification,
|
||||
RegisterTrackedResource,
|
||||
RemoveSoftBreakpoint,
|
||||
RestartServer,
|
||||
RestoreFullScreen,
|
||||
RestoreScreenArea,
|
||||
ReturnMessageInformation,
|
||||
ReturnScreenType,
|
||||
RingTheBell,
|
||||
RxIdentifyCode,
|
||||
RxRegisterKernelResource,
|
||||
RxRegisterSyscall,
|
||||
RxRegisterThreadResource,
|
||||
RxUnidentifyCode,
|
||||
RxUnregisterKernelResource,
|
||||
RxUnregisterSyscall,
|
||||
RxUnregisterThreadResource,
|
||||
SaveFullScreen,
|
||||
SaveScreenArea,
|
||||
ScanSetableParameters,
|
||||
ScrollScreenArea,
|
||||
SetAutoUnloadFlag,
|
||||
SetCursorStyle,
|
||||
SetInputToOutputCursorPosition,
|
||||
SetSetableParameterValue,
|
||||
ShowTitleBarText,
|
||||
ShutdownServer,
|
||||
SizeOfAllocBlock,
|
||||
StopServer,
|
||||
SynchronizeStart,
|
||||
UnRegisterConsoleCommand,
|
||||
UnRegisterDebugCommandParser,
|
||||
UnRegisterEventNotification,
|
||||
UnRegisterTrackedResource,
|
||||
UngetKey,
|
||||
UnloadModule,
|
||||
ValidateScreenHandle,
|
||||
WaitForKey,
|
||||
WriteScreenCharacter,
|
||||
WriteScreenCharacterAttribute,
|
||||
preferredModule
|
||||
147
rtl/netwlibc/nwsnut.imp
Normal file
147
rtl/netwlibc/nwsnut.imp
Normal file
@ -0,0 +1,147 @@
|
||||
NWSAlert,
|
||||
NWSAlertWithHelp,
|
||||
NWSAlloc,
|
||||
NWSAppendBoolField,
|
||||
NWSAppendCommentField,
|
||||
NWSAppendGenericBoolField,
|
||||
NWSAppendScrollableStringField,
|
||||
NWSAppendHexField,
|
||||
NWSAppendHotSpotField,
|
||||
NWSAppendIntegerField,
|
||||
NWSAppendMenuField,
|
||||
NWSAppendPasswordField,
|
||||
NWSAppendPromptField,
|
||||
NWSAppendStringField,
|
||||
NWSAppendToForm,
|
||||
NWSAppendToList,
|
||||
NWSAppendToMenu,
|
||||
NWSAppendToMenuField,
|
||||
NWSAppendUnsignedIntegerField,
|
||||
NWSAsciiHexToInt,
|
||||
NWSAsciiToInt,
|
||||
NWSAsciiToLONG,
|
||||
NWSClearPortal,
|
||||
NWSComputePortalPosition,
|
||||
NWSConfirm,
|
||||
NWSCreatePortal,
|
||||
NWSDeleteFromList,
|
||||
NWSDeleteFromPortalList,
|
||||
NWSDeselectPortal,
|
||||
NWSDestroyForm,
|
||||
NWSDestroyList,
|
||||
NWSDestroyMenu,
|
||||
NWSDestroyPortal,
|
||||
NWSDisableAllFunctionKeys,
|
||||
NWSDisableAllInterruptKeys,
|
||||
NWSDisableFunctionKey,
|
||||
NWSDisableInterruptKey,
|
||||
NWSDisablePortalCursor,
|
||||
NWSDisplayErrorCondition,
|
||||
NWSDisplayErrorText,
|
||||
NWSDisplayHelpScreen,
|
||||
NWSDisplayInformation,
|
||||
NWSDisplayInformationInPortal,
|
||||
NWSDisplayPreHelp,
|
||||
NWSDisplayTextInPortal,
|
||||
NWSDisplayTextJustifiedInPortal,
|
||||
NWSDrawPortalBorder,
|
||||
NWSEditForm,
|
||||
NWSEditPortalForm,
|
||||
NWSEditPortalFormField,
|
||||
NWSEditString,
|
||||
NWSEditText,
|
||||
NWSEditTextWithScrollBars,
|
||||
NWSEnableAllFunctionKeys,
|
||||
NWSEnableFunctionKey,
|
||||
NWSEnableFunctionKeyList,
|
||||
NWSEnableInterruptKey,
|
||||
NWSEnableInterruptList,
|
||||
NWSEnablePortalCursor,
|
||||
NWSEndWait,
|
||||
NWSFillPortalZone,
|
||||
NWSFillPortalZoneAttribute,
|
||||
NWSFree,
|
||||
NWSGetADisk,
|
||||
NWSGetCurrentPortal,
|
||||
NWSGetDefaultCompare,
|
||||
NWSGetFieldFunctionPtr,
|
||||
NWSGetHandleCustomData,
|
||||
NWSGetKey,
|
||||
NWSGetLineDrawCharacter,
|
||||
NWSGetList,
|
||||
NWSGetListElementText,
|
||||
NWSGetListHead,
|
||||
NWSGetListNotifyProcedure,
|
||||
NWSGetListSortFunction,
|
||||
NWSGetListTail,
|
||||
NWSGetMessage,
|
||||
NWSGetNUTVersion,
|
||||
NWSGetPCB,
|
||||
NWSGetScreenPalette,
|
||||
NWSGetSortCharacter,
|
||||
NWSInitForm,
|
||||
NWSInitializeNut,
|
||||
NWSInitList,
|
||||
NWSInitListPtr,
|
||||
NWSInitMenu,
|
||||
NWSInitMenuField,
|
||||
NWSInsertInList,
|
||||
NWSInsertInPortalList,
|
||||
NWSIsdigit,
|
||||
NWSIsxdigit,
|
||||
NWSKeyStatus,
|
||||
NWSList,
|
||||
NWSMemmove,
|
||||
NWSMenu,
|
||||
NWSModifyInPortalList,
|
||||
NWSPopHelpContext,
|
||||
NWSPopList,
|
||||
NWSPopMarks,
|
||||
NWSPositionCursor,
|
||||
NWSPositionPortalCursor,
|
||||
NWSPromptForPassword,
|
||||
NWSPushHelpContext,
|
||||
NWSPushList,
|
||||
NWSPushMarks,
|
||||
NWSRemovePreHelp,
|
||||
NWSRestoreDisplay,
|
||||
NWSRestoreList,
|
||||
NWSRestoreNut,
|
||||
NWSRestoreZone,
|
||||
NWSSaveFunctionKeyList,
|
||||
NWSSaveInterruptList,
|
||||
NWSSaveList,
|
||||
NWSSaveZone,
|
||||
NWSScreenSize,
|
||||
NWSScrollPortalZone,
|
||||
NWSScrollZone,
|
||||
NWSSelectPortal,
|
||||
NWSSetDefaultCompare,
|
||||
NWSSetDynamicMessage,
|
||||
NWSSetErrorLabelDisplayFlag,
|
||||
NWSSetFieldFunctionPtr,
|
||||
NWSSetFormNoWrap,
|
||||
NWSSetHandleCustomData,
|
||||
NWSSetHelpHelp,
|
||||
NWSSetList,
|
||||
NWSSetListNotifyProcedure,
|
||||
NWSSetListSortFunction,
|
||||
NWSSetScreenPalette,
|
||||
NWSSetScrollableFieldInsertProc,
|
||||
NWSShowLine,
|
||||
NWSShowLineAttribute,
|
||||
NWSShowPortalLine,
|
||||
NWSShowPortalLineAttribute,
|
||||
NWSSortList,
|
||||
NWSStartWait,
|
||||
NWSStrcat,
|
||||
NWSToupper,
|
||||
NWSTrace,
|
||||
NWSUngetKey,
|
||||
NWSUnmarkList,
|
||||
NWSUpdatePortal,
|
||||
NWSViewText,
|
||||
NWSViewTextWithScrollBars,
|
||||
NWSWaitForEscape,
|
||||
NWSWaitForEscapeOrCancel,
|
||||
NWSWaitForKeyAndValue
|
||||
9
rtl/netwlibc/nwsnut.pp
Normal file
9
rtl/netwlibc/nwsnut.pp
Normal file
@ -0,0 +1,9 @@
|
||||
{$I ../netware/nwsnut.pp}
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
BIN
rtl/netwlibc/pre/libcpre.gcc.o
Normal file
BIN
rtl/netwlibc/pre/libcpre.gcc.o
Normal file
Binary file not shown.
1
rtl/netwlibc/qos.inc
Normal file
1
rtl/netwlibc/qos.inc
Normal file
@ -0,0 +1 @@
|
||||
{$i ../netware/qos.inc}
|
||||
1007
rtl/netwlibc/system.pp
Normal file
1007
rtl/netwlibc/system.pp
Normal file
File diff suppressed because it is too large
Load Diff
481
rtl/netwlibc/systhrds.pp
Normal file
481
rtl/netwlibc/systhrds.pp
Normal file
@ -0,0 +1,481 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2002 by Peter Vreman,
|
||||
member of the Free Pascal development team.
|
||||
|
||||
netware (pthreads) threading support implementation
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$mode objfpc}
|
||||
|
||||
unit systhrds;
|
||||
interface
|
||||
{$S-}
|
||||
|
||||
//Procedure SetCThreadManager;
|
||||
|
||||
{ Posix compliant definition }
|
||||
|
||||
uses Libc;
|
||||
|
||||
type
|
||||
PRTLCriticalSection = Ppthread_mutex_t;
|
||||
TRTLCriticalSection = pthread_mutex_t;
|
||||
|
||||
|
||||
{$i threadh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Generic overloaded
|
||||
*****************************************************************************}
|
||||
|
||||
{$i thread.inc}
|
||||
|
||||
{*****************************************************************************
|
||||
Threadvar support
|
||||
*****************************************************************************}
|
||||
|
||||
{$ifdef HASTHREADVAR}
|
||||
const
|
||||
threadvarblocksize : dword = 0;
|
||||
|
||||
var
|
||||
TLSKey : pthread_key_t;
|
||||
ThVarAllocResourceTag : rtag_t;
|
||||
|
||||
procedure SysInitThreadvar(var offset : dword;size : dword);
|
||||
begin
|
||||
offset:=threadvarblocksize;
|
||||
inc(threadvarblocksize,size);
|
||||
end;
|
||||
|
||||
function SysRelocateThreadvar(offset : dword) : pointer;
|
||||
begin
|
||||
SysRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
|
||||
end;
|
||||
|
||||
|
||||
procedure SysAllocateThreadVars;
|
||||
var
|
||||
dataindex : pointer;
|
||||
begin
|
||||
{ we've to allocate the memory from system }
|
||||
{ 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 }
|
||||
DataIndex:=_Alloc(threadvarblocksize,ThVarAllocResourceTag);
|
||||
//DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
|
||||
FillChar(DataIndex^,threadvarblocksize,0);
|
||||
pthread_setspecific(tlskey,dataindex);
|
||||
end;
|
||||
|
||||
|
||||
procedure SysReleaseThreadVars;
|
||||
begin
|
||||
_Free (pthread_getspecific(tlskey));
|
||||
end;
|
||||
|
||||
{ Include OS independent Threadvar initialization }
|
||||
{$i threadvr.inc}
|
||||
|
||||
|
||||
{$endif HASTHREADVAR}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Thread starting
|
||||
*****************************************************************************}
|
||||
|
||||
type
|
||||
pthreadinfo = ^tthreadinfo;
|
||||
tthreadinfo = record
|
||||
f : tthreadfunc;
|
||||
p : pointer;
|
||||
stklen : cardinal;
|
||||
end;
|
||||
|
||||
procedure DoneThread;
|
||||
begin
|
||||
{ Release Threadvars }
|
||||
{$ifdef HASTHREADVAR}
|
||||
SysReleaseThreadVars;
|
||||
{$endif HASTHREADVAR}
|
||||
end;
|
||||
|
||||
|
||||
function ThreadMain(param : pointer) : pointer;cdecl;
|
||||
var
|
||||
ti : tthreadinfo;
|
||||
{$ifdef DEBUG_MT}
|
||||
// in here, don't use write/writeln before having called
|
||||
// InitThread! I wonder if anyone ever debugged these routines,
|
||||
// because they will have crashed if DEBUG_MT was enabled!
|
||||
// this took me the good part of an hour to figure out
|
||||
// why it was crashing all the time!
|
||||
// this is kind of a workaround, we simply write(2) to fd 0
|
||||
s: string[100]; // not an ansistring
|
||||
{$endif DEBUG_MT}
|
||||
begin
|
||||
{$ifdef DEBUG_MT}
|
||||
s := 'New thread started, initing threadvars'#10;
|
||||
fpwrite(0,s[1],length(s));
|
||||
{$endif DEBUG_MT}
|
||||
{$ifdef HASTHREADVAR}
|
||||
{ Allocate local thread vars, this must be the first thing,
|
||||
because the exception management and io depends on threadvars }
|
||||
SysAllocateThreadVars;
|
||||
{$endif HASTHREADVAR}
|
||||
{ Copy parameter to local data }
|
||||
{$ifdef DEBUG_MT}
|
||||
s := 'New thread started, initialising ...'#10;
|
||||
fpwrite(0,s[1],length(s));
|
||||
{$endif DEBUG_MT}
|
||||
ti:=pthreadinfo(param)^;
|
||||
dispose(pthreadinfo(param));
|
||||
{ Initialize thread }
|
||||
InitThread(ti.stklen);
|
||||
{ Start thread function }
|
||||
{$ifdef DEBUG_MT}
|
||||
writeln('Jumping to thread function');
|
||||
{$endif DEBUG_MT}
|
||||
ThreadMain:=pointer(ti.f(ti.p));
|
||||
DoneThread;
|
||||
pthread_detach(pointer(pthread_self));
|
||||
end;
|
||||
|
||||
|
||||
function SysBeginThread(sa : Pointer;stacksize : dword;
|
||||
ThreadFunction : tthreadfunc;p : pointer;
|
||||
creationFlags : dword; var ThreadId : THandle) : DWord;
|
||||
var
|
||||
ti : pthreadinfo;
|
||||
thread_attr : pthread_attr_t;
|
||||
begin
|
||||
{$ifdef DEBUG_MT}
|
||||
writeln('Creating new thread');
|
||||
{$endif DEBUG_MT}
|
||||
{ Initialize multithreading if not done }
|
||||
if not IsMultiThread then
|
||||
begin
|
||||
{$ifdef HASTHREADVAR}
|
||||
{ We're still running in single thread mode, setup the TLS }
|
||||
pthread_key_create(@TLSKey,nil);
|
||||
InitThreadVars(@SysRelocateThreadvar);
|
||||
{$endif HASTHREADVAR}
|
||||
IsMultiThread:=true;
|
||||
end;
|
||||
{ the only way to pass data to the newly created thread
|
||||
in a MT safe way, is to use the heap }
|
||||
getmem(ti,sizeof(pthreadinfo));
|
||||
ti^.f:=ThreadFunction;
|
||||
ti^.p:=p;
|
||||
ti^.stklen:=stacksize;
|
||||
{ call pthread_create }
|
||||
{$ifdef DEBUG_MT}
|
||||
writeln('Starting new thread');
|
||||
{$endif DEBUG_MT}
|
||||
pthread_attr_init(@thread_attr);
|
||||
pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
|
||||
|
||||
// will fail under linux -- apparently unimplemented
|
||||
pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
|
||||
|
||||
// don't create detached, we need to be able to join (waitfor) on
|
||||
// the newly created thread!
|
||||
//pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
|
||||
if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
|
||||
threadid := 0;
|
||||
end;
|
||||
SysBeginThread:=threadid;
|
||||
{$ifdef DEBUG_MT}
|
||||
writeln('BeginThread returning ',SysBeginThread);
|
||||
{$endif DEBUG_MT}
|
||||
end;
|
||||
|
||||
|
||||
procedure SysEndThread(ExitCode : DWord);
|
||||
begin
|
||||
DoneThread;
|
||||
pthread_detach(pointer(pthread_self));
|
||||
pthread_exit(pointer(ExitCode));
|
||||
end;
|
||||
|
||||
|
||||
function SysSuspendThread (threadHandle : dword) : dword;
|
||||
begin
|
||||
{$Warning SuspendThread needs to be implemented}
|
||||
end;
|
||||
|
||||
function SysResumeThread (threadHandle : dword) : dword;
|
||||
begin
|
||||
{$Warning ResumeThread needs to be implemented}
|
||||
end;
|
||||
|
||||
procedure SysThreadSwitch; {give time to other threads}
|
||||
begin
|
||||
{extern int pthread_yield (void) __THROW;}
|
||||
{$Warning ThreadSwitch needs to be implemented}
|
||||
end;
|
||||
|
||||
function SysKillThread (threadHandle : dword) : dword;
|
||||
begin
|
||||
pthread_detach(pointer(threadHandle));
|
||||
SysKillThread := pthread_cancel(Pointer(threadHandle));
|
||||
end;
|
||||
|
||||
function SysWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout}
|
||||
var
|
||||
LResultP: Pointer;
|
||||
LResult: DWord;
|
||||
begin
|
||||
LResult := 0;
|
||||
LResultP := @LResult;
|
||||
pthread_join(Pointer(threadHandle), @LResultP);
|
||||
SysWaitForThreadTerminate := LResult;
|
||||
end;
|
||||
|
||||
function SysThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
|
||||
begin
|
||||
{$Warning ThreadSetPriority needs to be implemented}
|
||||
end;
|
||||
|
||||
|
||||
function SysThreadGetPriority (threadHandle : dword): Integer;
|
||||
begin
|
||||
{$Warning ThreadGetPriority needs to be implemented}
|
||||
end;
|
||||
|
||||
function SysGetCurrentThreadId : dword;
|
||||
begin
|
||||
SysGetCurrentThreadId:=dword(pthread_self);
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Delphi/Win32 compatibility
|
||||
*****************************************************************************}
|
||||
|
||||
procedure SysInitCriticalSection(var CS);
|
||||
|
||||
Var
|
||||
P : PRTLCriticalSection;
|
||||
|
||||
begin
|
||||
P:=PRTLCriticalSection(@CS);
|
||||
FillChar (p^,sizeof(p^),0);
|
||||
pthread_mutex_init(P,NIL);
|
||||
end;
|
||||
|
||||
procedure SysEnterCriticalSection(var CS);
|
||||
begin
|
||||
pthread_mutex_lock(PRTLCriticalSection(@CS));
|
||||
end;
|
||||
|
||||
procedure SysLeaveCriticalSection(var CS);
|
||||
begin
|
||||
pthread_mutex_unlock(PRTLCriticalSection(@CS));
|
||||
end;
|
||||
|
||||
procedure SysDoneCriticalSection(var CS);
|
||||
begin
|
||||
pthread_mutex_destroy(PRTLCriticalSection(@CS));
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Heap Mutex Protection
|
||||
*****************************************************************************}
|
||||
|
||||
var
|
||||
HeapMutex : pthread_mutex_t;
|
||||
|
||||
procedure PThreadHeapMutexInit;
|
||||
begin
|
||||
pthread_mutex_init(@heapmutex,nil);
|
||||
end;
|
||||
|
||||
procedure PThreadHeapMutexDone;
|
||||
begin
|
||||
pthread_mutex_destroy(@heapmutex);
|
||||
end;
|
||||
|
||||
procedure PThreadHeapMutexLock;
|
||||
begin
|
||||
pthread_mutex_lock(@heapmutex);
|
||||
end;
|
||||
|
||||
procedure PThreadHeapMutexUnlock;
|
||||
begin
|
||||
pthread_mutex_unlock(@heapmutex);
|
||||
end;
|
||||
|
||||
const
|
||||
PThreadMemoryMutexManager : TMemoryMutexManager = (
|
||||
MutexInit : @PThreadHeapMutexInit;
|
||||
MutexDone : @PThreadHeapMutexDone;
|
||||
MutexLock : @PThreadHeapMutexLock;
|
||||
MutexUnlock : @PThreadHeapMutexUnlock;
|
||||
);
|
||||
|
||||
procedure InitHeapMutexes;
|
||||
begin
|
||||
SetMemoryMutexManager(PThreadMemoryMutexManager);
|
||||
end;
|
||||
|
||||
type
|
||||
TPthreadMutex = ppthread_mutex_t;
|
||||
Tbasiceventstate=record
|
||||
FSem: Pointer;
|
||||
FManualReset: Boolean;
|
||||
FEventSection: TPthreadMutex;
|
||||
end;
|
||||
plocaleventstate = ^tbasiceventstate;
|
||||
// peventstate=pointer;
|
||||
|
||||
Const
|
||||
wrSignaled = 0;
|
||||
wrTimeout = 1;
|
||||
wrAbandoned= 2;
|
||||
wrError = 3;
|
||||
|
||||
function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
|
||||
|
||||
var
|
||||
MAttr : pthread_mutex_attr_t;
|
||||
res : cint;
|
||||
|
||||
|
||||
begin
|
||||
//new(plocaleventstate(result));
|
||||
getmem (result,sizeof(plocaleventstate));
|
||||
plocaleventstate(result)^.FManualReset:=AManualReset;
|
||||
plocaleventstate(result)^.FSem:=New(PSemaphore); //sem_t.
|
||||
// plocaleventstate(result)^.feventsection:=nil;
|
||||
res:=pthread_mutexattr_init(@MAttr);
|
||||
if Res=0 then
|
||||
try
|
||||
Res:=pthread_mutexattr_settype(@MAttr,longint(PTHREAD_MUTEX_RECURSIVE));
|
||||
if Res=0 then
|
||||
Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr);
|
||||
finally
|
||||
pthread_mutexattr_destroy(@MAttr);
|
||||
end;
|
||||
sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState));
|
||||
end;
|
||||
|
||||
procedure Intbasiceventdestroy(state:peventstate);
|
||||
|
||||
begin
|
||||
sem_destroy(psem_t( plocaleventstate(state)^.FSem));
|
||||
end;
|
||||
|
||||
procedure IntbasiceventResetEvent(state:peventstate);
|
||||
|
||||
begin
|
||||
While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
|
||||
;
|
||||
end;
|
||||
|
||||
procedure IntbasiceventSetEvent(state:peventstate);
|
||||
|
||||
Var
|
||||
Value : Longint;
|
||||
|
||||
begin
|
||||
pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
|
||||
Try
|
||||
sem_getvalue(plocaleventstate(state)^.FSem,@value);
|
||||
if Value=0 then
|
||||
sem_post(psem_t( plocaleventstate(state)^.FSem));
|
||||
finally
|
||||
pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
|
||||
end;
|
||||
end;
|
||||
|
||||
function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
|
||||
|
||||
begin
|
||||
If TimeOut<>Cardinal($FFFFFFFF) then
|
||||
result:=wrError
|
||||
else
|
||||
begin
|
||||
sem_wait(psem_t(plocaleventstate(state)^.FSem));
|
||||
result:=wrSignaled;
|
||||
if plocaleventstate(state)^.FManualReset then
|
||||
begin
|
||||
pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
|
||||
Try
|
||||
intbasiceventresetevent(State);
|
||||
sem_post(psem_t( plocaleventstate(state)^.FSem));
|
||||
Finally
|
||||
pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Var
|
||||
NWThreadManager : TThreadManager;
|
||||
|
||||
Procedure SetNWThreadManager;
|
||||
|
||||
begin
|
||||
With NWThreadManager do
|
||||
begin
|
||||
InitManager :=nil;
|
||||
DoneManager :=nil;
|
||||
BeginThread :=@SysBeginThread;
|
||||
EndThread :=@SysEndThread;
|
||||
SuspendThread :=@SysSuspendThread;
|
||||
ResumeThread :=@SysResumeThread;
|
||||
KillThread :=@SysKillThread;
|
||||
ThreadSwitch :=@SysThreadSwitch;
|
||||
WaitForThreadTerminate :=@SysWaitForThreadTerminate;
|
||||
ThreadSetPriority :=@SysThreadSetPriority;
|
||||
ThreadGetPriority :=@SysThreadGetPriority;
|
||||
GetCurrentThreadId :=@SysGetCurrentThreadId;
|
||||
InitCriticalSection :=@SysInitCriticalSection;
|
||||
DoneCriticalSection :=@SysDoneCriticalSection;
|
||||
EnterCriticalSection :=@SysEnterCriticalSection;
|
||||
LeaveCriticalSection :=@SysLeaveCriticalSection;
|
||||
{$ifdef hasthreadvar}
|
||||
InitThreadVar :=@SysInitThreadVar;
|
||||
RelocateThreadVar :=@SysRelocateThreadVar;
|
||||
AllocateThreadVars :=@SysAllocateThreadVars;
|
||||
ReleaseThreadVars :=@SysReleaseThreadVars;
|
||||
{$endif}
|
||||
BasicEventCreate :=@intBasicEventCreate;
|
||||
BasicEventDestroy :=@intBasicEventDestroy;
|
||||
BasicEventResetEvent :=@intBasicEventResetEvent;
|
||||
BasicEventSetEvent :=@intBasicEventSetEvent;
|
||||
BasiceventWaitFor :=@intBasiceventWaitFor;
|
||||
end;
|
||||
SetThreadManager(NWThreadManager);
|
||||
InitHeapMutexes;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$ifdef HASTHREADVAR}
|
||||
ThVarAllocResourceTag := AllocateResourceTag(getnlmhandle,'Threadvar Memory',AllocSignature);
|
||||
{$endif}
|
||||
SetNWThreadManager;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
|
||||
563
rtl/netwlibc/sysutils.pp
Normal file
563
rtl/netwlibc/sysutils.pp
Normal file
@ -0,0 +1,563 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team.
|
||||
|
||||
Sysutils unit for netware (libc)
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit sysutils;
|
||||
interface
|
||||
|
||||
{$MODE objfpc}
|
||||
{ force ansistrings }
|
||||
{$H+}
|
||||
|
||||
uses Libc,DOS;
|
||||
|
||||
|
||||
TYPE
|
||||
TNetwareLibcFindData =
|
||||
RECORD
|
||||
DirP : Pdirent; { used for opendir }
|
||||
EntryP: Pdirent; { and readdir }
|
||||
Magic : WORD; { to avoid abends with uninitialized TSearchRec }
|
||||
END;
|
||||
|
||||
{ Include platform independent interface part }
|
||||
{$i sysutilh.inc}
|
||||
|
||||
|
||||
|
||||
{ additional NetWare file flags}
|
||||
CONST
|
||||
faSHARE = $00000080; { Sharable file }
|
||||
|
||||
faNO_SUBALLOC = $00000800; { Don't sub alloc. this file }
|
||||
faTRANS = $00001000; { Transactional file (TTS usable) }
|
||||
faREADAUD = $00004000; { Read audit }
|
||||
faWRITAUD = $00008000; { Write audit }
|
||||
|
||||
faIMMPURG = $00010000; { Immediate purge }
|
||||
faNORENAM = $00020000; { Rename inhibit }
|
||||
faNODELET = $00040000; { Delete inhibit }
|
||||
faNOCOPY = $00080000; { Copy inhibit }
|
||||
|
||||
faFILE_MIGRATED = $00400000; { File has been migrated }
|
||||
faDONT_MIGRATE = $00800000; { Don't migrate this file }
|
||||
faIMMEDIATE_COMPRESS = $02000000; { Compress this file immediately }
|
||||
faFILE_COMPRESSED = $04000000; { File is compressed }
|
||||
faDONT_COMPRESS = $08000000; { Don't compress this file }
|
||||
faCANT_COMPRESS = $20000000; { Can't compress this file }
|
||||
faATTR_ARCHIVE = $40000000; { Entry has had an EA modified, }
|
||||
{ an ownerID changed, or trustee }
|
||||
{ info changed, etc. }
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
sysconst;
|
||||
|
||||
{ Include platform independent implementation part }
|
||||
{$i sysutils.inc}
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
File Functions
|
||||
****************************************************************************}
|
||||
|
||||
Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
|
||||
VAR NWOpenFlags : longint;
|
||||
BEGIN
|
||||
NWOpenFlags:=0;
|
||||
Case (Mode and 3) of
|
||||
0 : NWOpenFlags:=NWOpenFlags or O_RDONLY;
|
||||
1 : NWOpenFlags:=NWOpenFlags or O_WRONLY;
|
||||
2 : NWOpenFlags:=NWOpenFlags or O_RDWR;
|
||||
end;
|
||||
FileOpen := open (pchar(FileName),NWOpenFlags);
|
||||
|
||||
//!! We need to set locking based on Mode !!
|
||||
end;
|
||||
|
||||
|
||||
Function FileCreate (Const FileName : String) : Longint;
|
||||
|
||||
begin
|
||||
FileCreate:=open(Pchar(FileName),O_RdWr or O_Creat or O_Trunc);
|
||||
end;
|
||||
|
||||
Function FileCreate (Const FileName : String; mode:longint) : Longint;
|
||||
|
||||
begin
|
||||
FileCreate:=FileCreate (FileName);
|
||||
end;
|
||||
|
||||
|
||||
Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
|
||||
|
||||
begin
|
||||
FileRead:=libc.fpread (Handle,@Buffer,Count);
|
||||
end;
|
||||
|
||||
|
||||
Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
|
||||
|
||||
begin
|
||||
FileWrite:=libc.fpwrite (Handle,@Buffer,Count);
|
||||
end;
|
||||
|
||||
|
||||
Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
|
||||
|
||||
begin
|
||||
FileSeek:=libc.fplseek (Handle,FOffset,Origin);
|
||||
end;
|
||||
|
||||
|
||||
Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
|
||||
begin
|
||||
FileSeek:=libc.fplseek (Handle,FOffset,Origin);
|
||||
end;
|
||||
|
||||
|
||||
Procedure FileClose (Handle : Longint);
|
||||
|
||||
begin
|
||||
libc.fpclose(Handle);
|
||||
end;
|
||||
|
||||
Function FileTruncate (Handle,Size: Longint) : boolean;
|
||||
|
||||
begin
|
||||
FileTruncate:=(libc.fpchsize(Handle,Size) = 0);
|
||||
end;
|
||||
|
||||
Function FileLock (Handle,FOffset,FLen : Longint) : Longint;
|
||||
begin
|
||||
{$warning FileLock not implemented}
|
||||
//FileLock := _lock (Handle,FOffset,FLen);
|
||||
end;
|
||||
|
||||
Function FileLock (Handle : Longint; FOffset,FLen : Int64) : Longint;
|
||||
begin
|
||||
{$warning need to add 64bit FileLock call }
|
||||
//FileLock := FileLock (Handle, longint(FOffset),longint(FLen));
|
||||
end;
|
||||
|
||||
Function FileUnlock (Handle,FOffset,FLen : Longint) : Longint;
|
||||
begin
|
||||
//FileUnlock := _unlock (Handle,FOffset,FLen);
|
||||
{$warning FileUnLock not implemented}
|
||||
end;
|
||||
|
||||
Function FileUnlock (Handle : Longint; FOffset,FLen : Int64) : Longint;
|
||||
begin
|
||||
{$warning need to add 64bit FileUnlock call }
|
||||
//FileUnlock := FileUnlock (Handle, longint(FOffset),longint(FLen));
|
||||
end;
|
||||
|
||||
Function FileAge (Const FileName : String): Longint;
|
||||
|
||||
VAR Info : TStat;
|
||||
_PTM : PTM;
|
||||
begin
|
||||
If stat (pchar(FileName),Info) <> 0 then
|
||||
exit(-1)
|
||||
else
|
||||
begin
|
||||
_PTM := localtime (Info.st_mtim.tv_sec);
|
||||
IF _PTM = NIL THEN
|
||||
exit(-1)
|
||||
else
|
||||
WITH _PTM^ DO
|
||||
Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function FileExists (Const FileName : String) : Boolean;
|
||||
VAR Info : TStat;
|
||||
begin
|
||||
FileExists:=(stat(pchar(filename),Info) = 0);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
PROCEDURE find_setfields (VAR f : TsearchRec);
|
||||
VAR T : Dos.DateTime;
|
||||
BEGIN
|
||||
WITH F DO
|
||||
BEGIN
|
||||
IF FindData.Magic = $AD01 THEN
|
||||
BEGIN
|
||||
{attr := FindData.EntryP^.d_attr AND $FF;} // lowest 8 bit -> same as dos
|
||||
attr := FindData.EntryP^.d_flags; { return complete netware attributes }
|
||||
//!!UnpackTime(FindData.EntryP^.d_time + (LONGINT (FindData.EntryP^.d_date) SHL 16), T);
|
||||
//!!time := DateTimeToFileDate(EncodeDate(T.Year,T.Month,T.day)+EncodeTime(T.Hour,T.Min,T.Sec,0));
|
||||
size := FindData.EntryP^.d_size;
|
||||
name := strpas (FindData.EntryP^.d_name);
|
||||
END ELSE
|
||||
BEGIN
|
||||
FillChar (f,SIZEOF(f),0);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
|
||||
|
||||
|
||||
Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
|
||||
begin
|
||||
IF path = '' then
|
||||
exit (18);
|
||||
Rslt.FindData.DirP := opendir (pchar(Path));
|
||||
IF Rslt.FindData.DirP = NIL THEN
|
||||
exit (18);
|
||||
//!!IF attr <> faAnyFile THEN
|
||||
//!! _SetReaddirAttribute (Rslt.FindData.DirP, attr);
|
||||
Rslt.FindData.Magic := $AD01;
|
||||
Rslt.FindData.EntryP := readdir (Rslt.FindData.DirP);
|
||||
if Rslt.FindData.EntryP = nil then
|
||||
begin
|
||||
closedir (Rslt.FindData.DirP);
|
||||
Rslt.FindData.DirP := NIL;
|
||||
result := 18;
|
||||
end else
|
||||
begin
|
||||
find_setfields (Rslt);
|
||||
result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function FindNext (Var Rslt : TSearchRec) : Longint;
|
||||
|
||||
begin
|
||||
if Rslt.FindData.Magic <> $AD01 then
|
||||
exit (18);
|
||||
Rslt.FindData.EntryP := readdir (Rslt.FindData.DirP);
|
||||
if Rslt.FindData.EntryP = nil then
|
||||
exit (18);
|
||||
find_setfields (Rslt);
|
||||
result := 0;
|
||||
end;
|
||||
|
||||
|
||||
Procedure FindClose (Var F : TSearchrec);
|
||||
begin
|
||||
if F.FindData.Magic = $AD01 then
|
||||
begin
|
||||
if F.FindData.DirP <> nil then
|
||||
closedir (F.FindData.DirP);
|
||||
F.FindData.Magic := 0;
|
||||
F.FindData.DirP := NIL;
|
||||
F.FindData.EntryP := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function FileGetDate (Handle : Longint) : Longint;
|
||||
Var Info : TStat;
|
||||
_PTM : PTM;
|
||||
begin
|
||||
If fstat(Handle,Info) <> 0 then
|
||||
Result:=-1
|
||||
else
|
||||
begin
|
||||
_PTM := localtime (Info.st_mtim.tv_sec);
|
||||
IF _PTM = NIL THEN
|
||||
exit(-1)
|
||||
else
|
||||
with _PTM^ do
|
||||
Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function FileSetDate (Handle,Age : Longint) : Longint;
|
||||
begin
|
||||
{ i think its impossible under netware from FileHandle. I dident found a way to get the
|
||||
complete pathname of a filehandle, that would be needed for ChangeDirectoryEntry }
|
||||
FileSetDate:=-1;
|
||||
ConsolePrintf ('warning: fpc sysutils.FileSetDate not implemented'#13#10);
|
||||
{$warning FileSetDate not implemented (i think is impossible) }
|
||||
end;
|
||||
|
||||
|
||||
Function FileGetAttr (Const FileName : String) : Longint;
|
||||
Var Info : TStat;
|
||||
begin
|
||||
If stat (pchar(FileName),Info) <> 0 then
|
||||
Result:=-1
|
||||
Else
|
||||
Result := Info.st_flags AND $FFFF;
|
||||
end;
|
||||
|
||||
|
||||
Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
|
||||
//VAR MS : NWModifyStructure;
|
||||
begin
|
||||
{FillChar (MS, SIZEOF (MS), 0);
|
||||
if _ChangeDirectoryEntry (PChar (Filename), MS, MFileAtrributesBit, 0) <> 0 then
|
||||
result := -1
|
||||
else
|
||||
result := 0;}
|
||||
{$warning FileSetAttr needs implementation}
|
||||
end;
|
||||
|
||||
|
||||
Function DeleteFile (Const FileName : String) : Boolean;
|
||||
|
||||
begin
|
||||
Result:= (libc.UnLink (pchar(FileName)) = 0);
|
||||
end;
|
||||
|
||||
|
||||
Function RenameFile (Const OldName, NewName : String) : Boolean;
|
||||
|
||||
begin
|
||||
RenameFile:=(libc.rename(pchar(OldName),pchar(NewName)) = 0);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Disk Functions
|
||||
****************************************************************************}
|
||||
|
||||
{
|
||||
The Diskfree and Disksize functions need a file on the specified drive, since this
|
||||
is required for the statfs system call.
|
||||
These filenames are set in drivestr[0..26], and have been preset to :
|
||||
0 - '.' (default drive - hence current dir is ok.)
|
||||
1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
|
||||
2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
|
||||
3 - '/' (C: equivalent of dos is the root partition)
|
||||
4..26 (can be set by you're own applications)
|
||||
! Use AddDisk() to Add new drives !
|
||||
They both return -1 when a failure occurs.
|
||||
}
|
||||
Const
|
||||
FixDriveStr : array[0..3] of pchar=(
|
||||
'.',
|
||||
'a:.',
|
||||
'b:.',
|
||||
'sys:/'
|
||||
);
|
||||
var
|
||||
Drives : byte;
|
||||
DriveStr : array[4..26] of pchar;
|
||||
|
||||
Procedure AddDisk(const path:string);
|
||||
begin
|
||||
if not (DriveStr[Drives]=nil) then
|
||||
FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
|
||||
GetMem(DriveStr[Drives],length(Path)+1);
|
||||
StrPCopy(DriveStr[Drives],path);
|
||||
inc(Drives);
|
||||
if Drives>26 then
|
||||
Drives:=4;
|
||||
end;
|
||||
|
||||
|
||||
Function DiskFree(Drive: Byte): int64;
|
||||
//var fs : statfs;
|
||||
Begin
|
||||
{ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
|
||||
((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
|
||||
Diskfree:=int64(fs.bavail)*int64(fs.bsize)
|
||||
else
|
||||
Diskfree:=-1;}
|
||||
DiskFree := -1;
|
||||
ConsolePrintf ('warning: fpc sysutils.diskfree not implemented'#13#10);
|
||||
{$warning DiskFree not implemented (does it make sense ?) }
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function DiskSize(Drive: Byte): int64;
|
||||
//var fs : statfs;
|
||||
Begin
|
||||
{ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
|
||||
((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
|
||||
DiskSize:=int64(fs.blocks)*int64(fs.bsize)
|
||||
else
|
||||
DiskSize:=-1;}
|
||||
DiskSize := -1;
|
||||
ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10);
|
||||
{$warning DiskSize not implemented (does it make sense ?) }
|
||||
End;
|
||||
|
||||
|
||||
Function GetCurrentDir : String;
|
||||
begin
|
||||
GetDir (0,Result);
|
||||
end;
|
||||
|
||||
|
||||
Function SetCurrentDir (Const NewDir : String) : Boolean;
|
||||
begin
|
||||
Libc.FpChDir(pchar(NewDir));
|
||||
result := (___errno^ = 0);
|
||||
end;
|
||||
|
||||
|
||||
Function CreateDir (Const NewDir : String) : Boolean;
|
||||
begin
|
||||
Libc.FpMkDir(pchar(NewDir),0);
|
||||
result := (___errno^ = 0);
|
||||
end;
|
||||
|
||||
|
||||
Function RemoveDir (Const Dir : String) : Boolean;
|
||||
begin
|
||||
libc.FpRmDir(pchar(Dir));
|
||||
result := (___errno^ = 0);
|
||||
end;
|
||||
|
||||
|
||||
function DirectoryExists (const Directory: string): boolean;
|
||||
var Info : TStat;
|
||||
begin
|
||||
If stat (pchar(Directory),Info) <> 0 then
|
||||
exit(false)
|
||||
else
|
||||
Exit ((Info.st_mode and M_A_SUBDIR) <> 0);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Misc Functions
|
||||
****************************************************************************}
|
||||
|
||||
procedure Beep;
|
||||
begin
|
||||
RingBell;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Locale Functions
|
||||
****************************************************************************}
|
||||
|
||||
Procedure GetLocalTime(var SystemTime: TSystemTime);
|
||||
var xx : word;
|
||||
begin
|
||||
Dos.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, xx);
|
||||
Dos.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day, xx);
|
||||
SystemTime.MilliSecond := 0;
|
||||
end;
|
||||
|
||||
|
||||
Procedure InitAnsi;
|
||||
Var i : longint;
|
||||
begin
|
||||
{ Fill table entries 0 to 127 }
|
||||
for i := 0 to 96 do
|
||||
UpperCaseTable[i] := chr(i);
|
||||
for i := 97 to 122 do
|
||||
UpperCaseTable[i] := chr(i - 32);
|
||||
for i := 123 to 191 do
|
||||
UpperCaseTable[i] := chr(i);
|
||||
Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
|
||||
|
||||
for i := 0 to 64 do
|
||||
LowerCaseTable[i] := chr(i);
|
||||
for i := 65 to 90 do
|
||||
LowerCaseTable[i] := chr(i + 32);
|
||||
for i := 91 to 191 do
|
||||
LowerCaseTable[i] := chr(i);
|
||||
Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
|
||||
end;
|
||||
|
||||
|
||||
Procedure InitInternational;
|
||||
begin
|
||||
InitAnsi;
|
||||
end;
|
||||
|
||||
function SysErrorMessage(ErrorCode: Integer): String;
|
||||
|
||||
begin
|
||||
Result:=''; // StrError(ErrorCode);
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
OS utility functions
|
||||
****************************************************************************}
|
||||
|
||||
Function GetEnvironmentVariable(Const EnvVar : String) : String;
|
||||
|
||||
begin
|
||||
Result:=StrPas(libc.getenv(PChar(EnvVar)));
|
||||
end;
|
||||
|
||||
|
||||
function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
|
||||
|
||||
var
|
||||
e : EOSError;
|
||||
CommandLine: AnsiString;
|
||||
|
||||
begin
|
||||
dos.exec(path,comline);
|
||||
|
||||
if (Dos.DosError <> 0) then
|
||||
begin
|
||||
if ComLine <> '' then
|
||||
CommandLine := Path + ' ' + ComLine
|
||||
else
|
||||
CommandLine := Path;
|
||||
e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
|
||||
e.ErrorCode:=Dos.DosError;
|
||||
raise e;
|
||||
end;
|
||||
Result := DosExitCode;
|
||||
end;
|
||||
|
||||
|
||||
function ExecuteProcess (const Path: AnsiString;
|
||||
const ComLine: array of AnsiString): integer;
|
||||
|
||||
var
|
||||
CommandLine: AnsiString;
|
||||
I: integer;
|
||||
|
||||
begin
|
||||
Commandline := '';
|
||||
for I := 0 to High (ComLine) do
|
||||
if Pos (' ', ComLine [I]) <> 0 then
|
||||
CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
|
||||
else
|
||||
CommandLine := CommandLine + ' ' + Comline [I];
|
||||
ExecuteProcess := ExecuteProcess (Path, CommandLine);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Initialization code
|
||||
****************************************************************************}
|
||||
|
||||
Initialization
|
||||
InitExceptions; { Initialize exceptions. OS independent }
|
||||
InitInternational; { Initialize internationalization settings }
|
||||
Finalization
|
||||
DoneExceptions;
|
||||
end.
|
||||
{
|
||||
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
332
rtl/netwlibc/tthread.inc
Normal file
332
rtl/netwlibc/tthread.inc
Normal file
@ -0,0 +1,332 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1999-2000 by Peter Vreman
|
||||
|
||||
Netware Libc TThread implementation
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
What follows, is a short description on my implementation of TThread.
|
||||
Most information can also be found by reading the source and accompanying
|
||||
comments.
|
||||
|
||||
A thread is created using BeginThread, which in turn calls
|
||||
pthread_create. So the threads here are always posix threads.
|
||||
Posix doesn't define anything for suspending threads as this is
|
||||
inherintly unsafe. Just don't suspend threads at points they cannot
|
||||
control. Therefore, I didn't implement .Suspend() if its called from
|
||||
outside the threads execution flow (except on Linux _without_ NPTL).
|
||||
|
||||
The implementation for .suspend uses a semaphore, which is initialized
|
||||
at thread creation. If the thread tries to suspend itself, we simply
|
||||
let it wait on the semaphore until it is unblocked by someone else
|
||||
who calls .Resume.
|
||||
|
||||
If a thread is supposed to be suspended (from outside its own path of
|
||||
execution) on a system where the symbol LINUX is defined, two things
|
||||
are possible.
|
||||
1) the system has the LinuxThreads pthread implementation
|
||||
2) the system has NPTL as the pthread implementation.
|
||||
|
||||
In the first case, each thread is a process on its own, which as far as
|
||||
know actually violates posix with respect to signal handling.
|
||||
But we can detect this case, because getpid(2) will
|
||||
return a different PID for each thread. In that case, sending SIGSTOP
|
||||
to the PID associated with a thread will actually stop that thread
|
||||
only.
|
||||
In the second case, this is not possible. But getpid(2) returns the same
|
||||
PID across all threads, which is detected, and TThread.Suspend() does
|
||||
nothing in that case. This should probably be changed, but I know of
|
||||
no way to suspend a thread when using NPTL.
|
||||
|
||||
If the symbol LINUX is not defined, then the unimplemented
|
||||
function SuspendThread is called.
|
||||
|
||||
Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
|
||||
}
|
||||
|
||||
// ========== semaphore stuff ==========
|
||||
{
|
||||
I don't like this. It eats up 2 filedescriptors for each thread,
|
||||
and those are a limited resource. If you have a server programm
|
||||
handling client connections (one per thread) it will not be able
|
||||
to handle many if we use 2 fds already for internal structures.
|
||||
However, right now I don't see a better option unless some sem_*
|
||||
functions are added to systhrds.
|
||||
I encapsulated all used functions here to make it easier to
|
||||
change them completely.
|
||||
}
|
||||
|
||||
function SemaphoreInit: Pointer;
|
||||
begin
|
||||
SemaphoreInit := GetMem(SizeOf(TFilDes));
|
||||
fppipe(PFilDes(SemaphoreInit)^);
|
||||
end;
|
||||
|
||||
procedure SemaphoreWait(const FSem: Pointer);
|
||||
var
|
||||
b: byte;
|
||||
begin
|
||||
fpread(PFilDes(FSem)^[0], b, 1);
|
||||
end;
|
||||
|
||||
procedure SemaphorePost(const FSem: Pointer);
|
||||
var c : char;
|
||||
begin
|
||||
c := #0;
|
||||
fpwrite(PFilDes(FSem)^[1], c, 1);
|
||||
end;
|
||||
|
||||
procedure SemaphoreDestroy(const FSem: Pointer);
|
||||
begin
|
||||
fpclose(PFilDes(FSem)^[0]);
|
||||
fpclose(PFilDes(FSem)^[1]);
|
||||
FreeMemory(FSem);
|
||||
end;
|
||||
|
||||
// =========== semaphore end ===========
|
||||
|
||||
var
|
||||
ThreadsInited: boolean = false;
|
||||
{$IFDEF LINUX}
|
||||
GMainPID: LongInt = 0;
|
||||
{$ENDIF}
|
||||
const
|
||||
// stupid, considering its not even implemented...
|
||||
Priorities: array [TThreadPriority] of Integer =
|
||||
(-20,-19,-10,0,9,18,19);
|
||||
|
||||
procedure InitThreads;
|
||||
begin
|
||||
if not ThreadsInited then begin
|
||||
ThreadsInited := true;
|
||||
{$IFDEF LINUX}
|
||||
GMainPid := fpgetpid();
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoneThreads;
|
||||
begin
|
||||
ThreadsInited := false;
|
||||
end;
|
||||
|
||||
{ ok, so this is a hack, but it works nicely. Just never use
|
||||
a multiline argument with WRITE_DEBUG! }
|
||||
{$MACRO ON}
|
||||
{$IFDEF DEBUG_MT}
|
||||
{$define WRITE_DEBUG := writeln} // actually write something
|
||||
{$ELSE}
|
||||
{$define WRITE_DEBUG := //} // just comment out those lines
|
||||
{$ENDIF}
|
||||
|
||||
function ThreadFunc(parameter: Pointer): LongInt;
|
||||
var
|
||||
LThread: TThread;
|
||||
c: char;
|
||||
begin
|
||||
WRITE_DEBUG('ThreadFunc is here...');
|
||||
LThread := TThread(parameter);
|
||||
{$IFDEF LINUX}
|
||||
// save the PID of the "thread"
|
||||
// this is different from the PID of the main thread if
|
||||
// the LinuxThreads implementation is used
|
||||
LThread.FPid := fpgetpid();
|
||||
{$ENDIF}
|
||||
WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
|
||||
try
|
||||
if LThread.FInitialSuspended then begin
|
||||
SemaphoreWait(LThread.FSem);
|
||||
if not LThread.FInitialSuspended then begin
|
||||
WRITE_DEBUG('going into LThread.Execute');
|
||||
LThread.Execute;
|
||||
end;
|
||||
end else begin
|
||||
WRITE_DEBUG('going into LThread.Execute');
|
||||
LThread.Execute;
|
||||
end;
|
||||
except
|
||||
on e: exception do begin
|
||||
WRITE_DEBUG('got exception: ',e.message);
|
||||
LThread.FFatalException := TObject(AcquireExceptionObject);
|
||||
// not sure if we should really do this...
|
||||
// but .Destroy was called, so why not try FreeOnTerminate?
|
||||
if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
|
||||
end;
|
||||
end;
|
||||
WRITE_DEBUG('thread done running');
|
||||
Result := LThread.FReturnValue;
|
||||
WRITE_DEBUG('Result is ',Result);
|
||||
LThread.FFinished := True;
|
||||
LThread.DoTerminate;
|
||||
if LThread.FreeOnTerminate then begin
|
||||
WRITE_DEBUG('Thread should be freed');
|
||||
LThread.Free;
|
||||
WRITE_DEBUG('Thread freed');
|
||||
end;
|
||||
WRITE_DEBUG('thread func exiting');
|
||||
end;
|
||||
|
||||
{ TThread }
|
||||
constructor TThread.Create(CreateSuspended: Boolean);
|
||||
begin
|
||||
// lets just hope that the user doesn't create a thread
|
||||
// via BeginThread and creates the first TThread Object in there!
|
||||
InitThreads;
|
||||
inherited Create;
|
||||
FSem := SemaphoreInit;
|
||||
FSuspended :=CreateSuspended;
|
||||
FSuspendedExternal := false;
|
||||
FInitialSuspended := CreateSuspended;
|
||||
FFatalException := nil;
|
||||
WRITE_DEBUG('creating thread, self = ',longint(self));
|
||||
FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
|
||||
WRITE_DEBUG('TThread.Create done');
|
||||
end;
|
||||
|
||||
|
||||
destructor TThread.Destroy;
|
||||
begin
|
||||
if FThreadID = GetCurrentThreadID then begin
|
||||
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
|
||||
end;
|
||||
// if someone calls .Free on a thread with
|
||||
// FreeOnTerminate, then don't crash!
|
||||
FFreeOnTerminate := false;
|
||||
if not FFinished and not FSuspended then begin
|
||||
Terminate;
|
||||
WaitFor;
|
||||
end;
|
||||
if (FInitialSuspended) then begin
|
||||
// thread was created suspended but never woken up.
|
||||
SemaphorePost(FSem);
|
||||
WaitFor;
|
||||
end;
|
||||
FFatalException.Free;
|
||||
FFatalException := nil;
|
||||
SemaphoreDestroy(FSem);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TThread.SetSuspended(Value: Boolean);
|
||||
begin
|
||||
if Value <> FSuspended then
|
||||
if Value then
|
||||
Suspend
|
||||
else
|
||||
Resume;
|
||||
end;
|
||||
|
||||
procedure TThread.Suspend;
|
||||
begin
|
||||
if not FSuspended then begin
|
||||
if FThreadID = GetCurrentThreadID then begin
|
||||
FSuspended := true;
|
||||
SemaphoreWait(FSem);
|
||||
end else begin
|
||||
FSuspendedExternal := true;
|
||||
{$IFDEF LINUX}
|
||||
// naughty hack if the user doesn't have Linux with NPTL...
|
||||
// in that case, the PID of threads will not be identical
|
||||
// to the other threads, which means that our thread is a normal
|
||||
// process that we can suspend via SIGSTOP...
|
||||
// this violates POSIX, but is the way it works on the
|
||||
// LinuxThreads pthread implementation. Not with NPTL, but in that case
|
||||
// getpid(2) also behaves properly and returns the same PID for
|
||||
// all threads. Thats actually (FINALLY!) native thread support :-)
|
||||
if FPid <> GMainPID then begin
|
||||
FSuspended := true;
|
||||
fpkill(FPid, SIGSTOP);
|
||||
end;
|
||||
{$ELSE}
|
||||
SuspendThread(FHandle);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Resume;
|
||||
begin
|
||||
if (not FSuspendedExternal) then begin
|
||||
if FSuspended then begin
|
||||
SemaphorePost(FSem);
|
||||
FInitialSuspended := false;
|
||||
FSuspended := False;
|
||||
end;
|
||||
end else begin
|
||||
{$IFDEF LINUX}
|
||||
// see .Suspend
|
||||
if FPid <> GMainPID then begin
|
||||
fpkill(FPid, SIGCONT);
|
||||
FSuspended := False;
|
||||
end;
|
||||
{$ELSE}
|
||||
ResumeThread(FHandle);
|
||||
{$ENDIF}
|
||||
FSuspendedExternal := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Terminate;
|
||||
begin
|
||||
FTerminated := True;
|
||||
end;
|
||||
|
||||
function TThread.WaitFor: Integer;
|
||||
begin
|
||||
WRITE_DEBUG('waiting for thread ',FHandle);
|
||||
WaitFor := WaitForThreadTerminate(FHandle, 0);
|
||||
WRITE_DEBUG('thread terminated');
|
||||
end;
|
||||
|
||||
procedure TThread.CallOnTerminate;
|
||||
begin
|
||||
// no need to check if FOnTerminate <> nil, because
|
||||
// thats already done in DoTerminate
|
||||
FOnTerminate(self);
|
||||
end;
|
||||
|
||||
procedure TThread.DoTerminate;
|
||||
begin
|
||||
if Assigned(FOnTerminate) then
|
||||
Synchronize(@CallOnTerminate);
|
||||
end;
|
||||
|
||||
function TThread.GetPriority: TThreadPriority;
|
||||
var
|
||||
P: Integer;
|
||||
I: TThreadPriority;
|
||||
begin
|
||||
P := ThreadGetPriority(FHandle);
|
||||
Result := tpNormal;
|
||||
for I := Low(TThreadPriority) to High(TThreadPriority) do
|
||||
if Priorities[I] = P then
|
||||
Result := I;
|
||||
end;
|
||||
|
||||
procedure TThread.Synchronize(Method: TThreadMethod);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TThread.SetPriority(Value: TThreadPriority);
|
||||
begin
|
||||
ThreadSetPriority(FHandle, Priorities[Value]);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
48
rtl/netwlibc/varutils.pp
Normal file
48
rtl/netwlibc/varutils.pp
Normal file
@ -0,0 +1,48 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2004 by the Free Pascal development team
|
||||
|
||||
Interface and OS-dependent part of variant support
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$MODE ObjFPC}
|
||||
|
||||
Unit varutils;
|
||||
|
||||
Interface
|
||||
|
||||
Uses sysutils;
|
||||
|
||||
// Read definitions.
|
||||
|
||||
{$i varutilh.inc}
|
||||
|
||||
Implementation
|
||||
|
||||
// Code common to all platforms.
|
||||
|
||||
{$i cvarutil.inc}
|
||||
|
||||
// Code common to non-win32 platforms.
|
||||
|
||||
{$i varutils.inc}
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
|
||||
}
|
||||
|
||||
11
rtl/netwlibc/winsock.pp
Normal file
11
rtl/netwlibc/winsock.pp
Normal file
@ -0,0 +1,11 @@
|
||||
{winsock is the same for clib and libc on netware}
|
||||
{$define netware}
|
||||
{$i ../netware/winsock.pp}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-09-05 20:58:47 armin
|
||||
* first rtl version for netwlibc
|
||||
|
||||
}
|
||||
|
||||
345
rtl/netwlibc/ws2_32.imp
Normal file
345
rtl/netwlibc/ws2_32.imp
Normal file
@ -0,0 +1,345 @@
|
||||
WS2_32_bind,
|
||||
WS2_32_closesocket,
|
||||
WS2_32_getpeername,
|
||||
WS2_32_getsockname,
|
||||
WS2_32_getsockopt,
|
||||
WS2_32_htonl,
|
||||
WS2_32_htons,
|
||||
WS2_32_ioctlsocket,
|
||||
WS2_32_listen,
|
||||
WS2_32_ntohl,
|
||||
WS2_32_ntohs,
|
||||
WS2_32_recv,
|
||||
WS2_32_recvfrom,
|
||||
WS2_32_select,
|
||||
WS2_32_send,
|
||||
WS2_32_sendto,
|
||||
WS2_32_setsockopt,
|
||||
WS2_32_shutdown,
|
||||
WS2_32_socket,
|
||||
WSAAccept,
|
||||
WSACancelBlockingCall,
|
||||
WSACleanup,
|
||||
WSACloseEvent,
|
||||
WSAConnect,
|
||||
WSACreateEvent,
|
||||
WSCEnableNSProvider,
|
||||
WSAEnumNetworkEvents,
|
||||
WSAEnumProtocolsA,
|
||||
WSAEnumProtocolsW,
|
||||
WSAEventSelect,
|
||||
WSAGetLastError,
|
||||
WSAGetOverlappedResult,
|
||||
WSAGetQOSByName,
|
||||
WSAHtonl,
|
||||
WSAHtons,
|
||||
WSAIoctl,
|
||||
WSAJoinLeaf,
|
||||
WSANtohl,
|
||||
WSANtohs,
|
||||
WSARecv,
|
||||
WSARecvDisconnect,
|
||||
WSARecvFrom,
|
||||
WSAResetEvent,
|
||||
WSASend,
|
||||
WSASendDisconnect,
|
||||
WSASendTo,
|
||||
WSASetEvent,
|
||||
WSASetLastError,
|
||||
WSASocketA,
|
||||
WSASocketW,
|
||||
WSAStartup,
|
||||
WSAWaitForMultipleEvents,
|
||||
WSAAddressToStringA,
|
||||
WSAAddressToStringW,
|
||||
WSAEnumNameSpaceProvidersA,
|
||||
WSAEnumNameSpaceProvidersW,
|
||||
WSAGetServiceClassInfoA,
|
||||
WSAGetServiceClassInfoW,
|
||||
WSAGetServiceClassNameByClassIdA,
|
||||
WSAGetServiceClassNameByClassIdW,
|
||||
WSAInstallServiceClassA,
|
||||
WSAInstallServiceClassW,
|
||||
WSALookupServiceBeginA,
|
||||
WSALookupServiceBeginW,
|
||||
WSALookupServiceEnd,
|
||||
WSALookupServiceNextA,
|
||||
WSALookupServiceNextW,
|
||||
WSARemoveServiceClass,
|
||||
WSASetServiceA,
|
||||
WSASetServiceW,
|
||||
WSAStringToAddressA,
|
||||
WSAStringToAddressW,
|
||||
WSCUnInstallNameSpace,
|
||||
WSCInstallNameSpace,
|
||||
WS2_32_gethostbyaddr,
|
||||
WS2_32_gethostbyname,
|
||||
WS2_32_gethostname,
|
||||
WS2_32_getprotobyname,
|
||||
WS2_32_getprotobynumber,
|
||||
WS2_32_getservbyname,
|
||||
WS2_32_getservbyport,
|
||||
WS2_32_inet_addr,
|
||||
WS2_32_inet_ntoa,
|
||||
__WSAFDIsSet,
|
||||
NiosCancelAESEvent,
|
||||
NiosFindNode,
|
||||
NiosDFindNode,
|
||||
NiosDLinkFirst,
|
||||
NiosDLinkLast,
|
||||
NiosDprintf,
|
||||
NiosDUnlinkFirst,
|
||||
NiosDUnlinkLast,
|
||||
NiosDUnlinkNode,
|
||||
NiosFree,
|
||||
NiosGetTickCount,
|
||||
NiosLinkFirst,
|
||||
NiosLinkLast,
|
||||
NiosLongTermAlloc,
|
||||
NiosMemSet,
|
||||
NiosPoll,
|
||||
NiosPrintf,
|
||||
NiosScheduleAESEvent,
|
||||
NiosScheduleForegroundEvent,
|
||||
NiosShortTermAlloc,
|
||||
NiosUnlinkFirst,
|
||||
NiosUnlinkNode,
|
||||
NiosMemCpy,
|
||||
WSDebMsg,
|
||||
WSAssertFail,
|
||||
WSdebugLevel,
|
||||
WSdebugModule,
|
||||
WSDebChar,
|
||||
WSDebugAllocCheck,
|
||||
WSDebugFreeCheck,
|
||||
WSDebugAlloc,
|
||||
WSDebugString,
|
||||
kYieldThreadStub,
|
||||
FreeObjectStub,
|
||||
AllocateObjectStub,
|
||||
DestroyObjectCacheStub,
|
||||
CreateObjectCacheStub,
|
||||
kRWWriteUnlockStub,
|
||||
kRWWriteLockStub,
|
||||
kRWReadUnlockStub,
|
||||
kRWReadLockStub,
|
||||
kRWLockFreeStub,
|
||||
kRWLockAllocStub,
|
||||
kCurrentThreadStub,
|
||||
WaitForSingleObject,
|
||||
CreateEvent,
|
||||
CloseHandle,
|
||||
WPUSetEvent,
|
||||
bufFree,
|
||||
WSCreateAndLinkObjectCache,
|
||||
WSDestroyObjectCacheList,
|
||||
WSGarbageCollectObjectCache,
|
||||
NetWareOSMajorVersion,
|
||||
WVT,
|
||||
ecbFreePlatformBuffer,
|
||||
ecbImportMsgByRef,
|
||||
ecbImportMsgByCopy,
|
||||
msgCreate,
|
||||
msgReset,
|
||||
msgIncRef,
|
||||
msgDecRef,
|
||||
msgForEach,
|
||||
msgDestroy,
|
||||
msgCopyBufAtFront,
|
||||
msgCopyBufAtEnd,
|
||||
msgCopyToBuf,
|
||||
msgRefBufAtFront,
|
||||
msgRefBufAtEnd,
|
||||
msgCopyMsgAtFront,
|
||||
msgRefMsgAtFront,
|
||||
msgCopyMsgAtEnd,
|
||||
msgImportECBByCopy,
|
||||
msgImportECBByRef,
|
||||
msgRefMsgAtEnd,
|
||||
msgRemoveDataAtFront,
|
||||
msgRemoveDataAtEnd,
|
||||
msgSetCurrentOffset,
|
||||
msgModifyCurrentOffset,
|
||||
msgPushWS,
|
||||
msgPopWS,
|
||||
msgPeekWS,
|
||||
msgLaunchCallback,
|
||||
msgPushAttrib,
|
||||
msgPopAttrib,
|
||||
msgScanMsgForAttrib,
|
||||
mapClose,
|
||||
mapCreate,
|
||||
createProto,
|
||||
termProto,
|
||||
new_termProto,
|
||||
addProtoToLlpList,
|
||||
removeProtoFromLlpList,
|
||||
incProtoRefCount,
|
||||
incSessnRefCount,
|
||||
decProtoRefCount,
|
||||
decSessnRefCount,
|
||||
createSocket,
|
||||
destroySocket,
|
||||
GetDown,
|
||||
setProtoVtbl,
|
||||
setSessnVtbl,
|
||||
ctlPushWS,
|
||||
ctlPopWS,
|
||||
ctlPeekWS,
|
||||
ctlLaunchCallback,
|
||||
wsSocket,
|
||||
wsGetAcceptData,
|
||||
wsAccept,
|
||||
wsBind,
|
||||
wsConnect,
|
||||
wsListen,
|
||||
wsRecv,
|
||||
wsRecvDisconnect,
|
||||
wsSend,
|
||||
wsSendDisconnect,
|
||||
wsCloseSocket,
|
||||
wsEventCallBack,
|
||||
wsRecvCallBack,
|
||||
wsREAD_EventCallBack,
|
||||
wsWRITE_EventCallBack,
|
||||
wsACCEPT_EventCallBack,
|
||||
wsFASTACCEPT_EventCallBack,
|
||||
wsCONNECT_EventCallBack,
|
||||
wsCLOSE_EventCallBack,
|
||||
wsCLOSE_DONE_EventCallBack,
|
||||
wsEventSelect,
|
||||
wsEventPoll,
|
||||
wsControl,
|
||||
wsGetSockName,
|
||||
wsGetPeerName,
|
||||
wsGetSockOpt,
|
||||
wsSetSockOpt,
|
||||
wsJoinLeaf,
|
||||
wsGetQOSByName,
|
||||
getProtoByModuleType,
|
||||
mergeProtoCallTable,
|
||||
estimateTypedData,
|
||||
addTypedDataBegin,
|
||||
addTypedDataNext,
|
||||
addTypedDataEnd,
|
||||
getTypedDataPtr,
|
||||
registerProtocolInfo,
|
||||
deregisterProtocolInfo,
|
||||
getModuleTypeByProtocolInfo,
|
||||
getModuleTypeByCatalogId,
|
||||
kSetThreadWinSockDataStub,
|
||||
kGetThreadWinSockDataStub,
|
||||
kScheduleWorkToDoStub,
|
||||
kCancelWorkToDoStub,
|
||||
kCreateExSetStub,
|
||||
kDestroyExSetStub,
|
||||
kGetExSetHandleStub,
|
||||
kEnterExSetStub,
|
||||
kExitExSetStub,
|
||||
kEnterNetWareStub,
|
||||
kExitNetWareStub,
|
||||
kBindExSetStub,
|
||||
CfwAtomicInc,
|
||||
CfwAtomicDec,
|
||||
destroyProto,
|
||||
kUnbindExSetStub,
|
||||
kCurrentExSetBindingStub,
|
||||
kMutexAllocStub,
|
||||
kMutexFreeStub,
|
||||
kMutexLockStub,
|
||||
kMutexTryLockStub,
|
||||
kMutexTimedWaitStub,
|
||||
kMutexUnlockStub,
|
||||
kMutexWaitCountStub,
|
||||
kSemaphoreAllocStub,
|
||||
kSemaphoreFreeStub,
|
||||
kSemaphoreWaitStub,
|
||||
kSemaphoreTryStub,
|
||||
kSemaphoreTimedWaitStub,
|
||||
kSemaphoreSignalStub,
|
||||
kSemaphoreExamineCountStub,
|
||||
kSemaphoreWaitCountStub,
|
||||
kRWReadTryLockStub,
|
||||
kRWWriteTryLockStub,
|
||||
kRWWriterToReaderStub,
|
||||
kRWReaderToWriterStub,
|
||||
kSpinLockInitStub,
|
||||
kSpinLockStub,
|
||||
kSpinTryLockStub,
|
||||
kSpinUnlockStub,
|
||||
kSpinLockDisableStub,
|
||||
kSpinTryLockDisableStub,
|
||||
kSpinUnlockRestoreStub,
|
||||
kAllocQueStub,
|
||||
kAllocQueNoSleepStub,
|
||||
kFreeQueStub,
|
||||
kQueCountStub,
|
||||
kEnQueStub,
|
||||
kEnQueOrderedStub,
|
||||
kDeQueStub,
|
||||
kDeQueWaitStub,
|
||||
kPushQueStub,
|
||||
kPushQueOrderedStub,
|
||||
kDeQueByQLinkStub,
|
||||
kDeQueAllStub,
|
||||
kEnQueNoLockStub,
|
||||
kEnQueOrderedNoLockStub,
|
||||
kPushQueNoLockStub,
|
||||
kPushQueOrderedNoLockStub,
|
||||
kDeQueNoLockStub,
|
||||
kDeQueByQLinkNoLockStub,
|
||||
kDeQueWaitNoLockStub,
|
||||
kDeQueAllNoLockStub,
|
||||
kFirstQLINKNoLockStub,
|
||||
atomic_incStub,
|
||||
atomic_decStub,
|
||||
atomic_addStub,
|
||||
atomic_subStub,
|
||||
kConditionAllocStub,
|
||||
kConditionDestroyStub,
|
||||
kConditionWaitStub,
|
||||
kConditionTimedWaitStub,
|
||||
kConditionSignalStub,
|
||||
kConditionBroadcastStub,
|
||||
gwspProto,
|
||||
getPackedMsg,
|
||||
putPackedMsg,
|
||||
WS2_32_DNSQuery,
|
||||
FreeDNSReply,
|
||||
HostsTable,
|
||||
HostsEntries,
|
||||
UsedHostsEntries,
|
||||
HostsRWLock,
|
||||
ResizeTable,
|
||||
WS2DNSAllocRTag,
|
||||
WSLocalToUnicode,
|
||||
WSUnicodeToLocal,
|
||||
WS2getservbyname,
|
||||
WS2getservbyport,
|
||||
WS2gethostbyaddr,
|
||||
WS2gethostbyname,
|
||||
WS2_32_GetGeneralStatistics,
|
||||
WS2_32_GetSocketStatistics,
|
||||
WS2_32_GetDebugState,
|
||||
WS2_32_SetDebugState,
|
||||
GetTimerMinorTicksPerSecondStub,
|
||||
WSStartupNLMQ,
|
||||
WSStartupNLMQSpinLock,
|
||||
WSPCloseSocket,
|
||||
wsSktDiag,
|
||||
NiosVidMessageBox,
|
||||
NiosThreadSignalId,
|
||||
NiosThreadBlockOnId,
|
||||
NiosThreadArmId,
|
||||
NiosStrLen,
|
||||
NiosStrCmp,
|
||||
NiosStrCat,
|
||||
NiosGetHighResIntervalMarker,
|
||||
NiosGetDateTime,
|
||||
NiosMemCmp,
|
||||
wsNewWindow,
|
||||
INWNSPInstallServiceClass,
|
||||
INWNSPGetServiceClassInfo,
|
||||
INWNSPRemoveServiceClass,
|
||||
mapReCreateTable
|
||||
|
||||
89
rtl/netwlibc/ws2nlm.imp
Normal file
89
rtl/netwlibc/ws2nlm.imp
Normal file
@ -0,0 +1,89 @@
|
||||
WS2_32_bind,
|
||||
WS2_32_closesocket,
|
||||
WS2_32_getpeername,
|
||||
WS2_32_getsockname,
|
||||
WS2_32_getsockopt,
|
||||
WS2_32_htonl,
|
||||
WS2_32_htons,
|
||||
WS2_32_ioctlsocket,
|
||||
WS2_32_listen,
|
||||
WS2_32_ntohl,
|
||||
WS2_32_ntohs,
|
||||
WS2_32_recv,
|
||||
WS2_32_recvfrom,
|
||||
WS2_32_select,
|
||||
WS2_32_send,
|
||||
WS2_32_sendto,
|
||||
WS2_32_setsockopt,
|
||||
WS2_32_shutdown,
|
||||
WS2_32_socket,
|
||||
WSAAccept,
|
||||
WSACancelBlockingCall,
|
||||
WSACleanup,
|
||||
WSACloseEvent,
|
||||
WSAConnect,
|
||||
WSACreateEvent,
|
||||
WSCEnableNSProvider,
|
||||
WSAEnumNetworkEvents,
|
||||
WSAEnumProtocolsA,
|
||||
WSAEnumProtocolsW,
|
||||
WSAEventSelect,
|
||||
WSAGetLastError,
|
||||
WSAGetOverlappedResult,
|
||||
WSAGetQOSByName,
|
||||
WSAHtonl,
|
||||
WSAHtons,
|
||||
WSAIoctl,
|
||||
WSAJoinLeaf,
|
||||
WSANtohl,
|
||||
WSANtohs,
|
||||
WSARecv,
|
||||
WSARecvDisconnect,
|
||||
WSARecvFrom,
|
||||
WSAResetEvent,
|
||||
WSASend,
|
||||
WSASendDisconnect,
|
||||
WSASendTo,
|
||||
WSASetEvent,
|
||||
WSASetLastError,
|
||||
WSASocketA,
|
||||
WSASocketW,
|
||||
WSAStartup,
|
||||
WSAWaitForMultipleEvents,
|
||||
WSAAddressToStringA,
|
||||
WSAAddressToStringW,
|
||||
WSAEnumNameSpaceProvidersA,
|
||||
WSAEnumNameSpaceProvidersW,
|
||||
WSAGetServiceClassInfoA,
|
||||
WSAGetServiceClassInfoW,
|
||||
WSAGetServiceClassNameByClassIdA,
|
||||
WSAGetServiceClassNameByClassIdW,
|
||||
WSAInstallServiceClassA,
|
||||
WSAInstallServiceClassW,
|
||||
WSALookupServiceBeginA,
|
||||
WSALookupServiceBeginW,
|
||||
WSALookupServiceEnd,
|
||||
WSALookupServiceNextA,
|
||||
WSALookupServiceNextW,
|
||||
WSARemoveServiceClass,
|
||||
WSASetServiceA,
|
||||
WSASetServiceW,
|
||||
WSAStringToAddressA,
|
||||
WSAStringToAddressW,
|
||||
WSCUnInstallNameSpace,
|
||||
WSCInstallNameSpace,
|
||||
WS2_32_gethostbyaddr,
|
||||
WS2_32_gethostbyname,
|
||||
WS2_32_gethostname,
|
||||
WS2_32_getprotobyname,
|
||||
WS2_32_getprotobynumber,
|
||||
WS2_32_getservbyname,
|
||||
WS2_32_getservbyport,
|
||||
WS2_32_inet_addr,
|
||||
WS2_32_inet_ntoa,
|
||||
__WSAFDIsSet,
|
||||
WS2_32_AcceptEx,
|
||||
WS2_32_CreateIoCompletionPort,
|
||||
WS2_32_GetQueuedCompletionStatus,
|
||||
WS2_32_PostQueuedCompletionStatus,
|
||||
WS2_32_DestroyIoCompletionPort
|
||||
Loading…
Reference in New Issue
Block a user