mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-08 09:01:32 +01:00
* changed dir separator from \ to /
* long namespace by default
* dos.exec implemented
* getenv ('PATH') is now supported
* changed FExpand to global version
* fixed heaplist growth error
* support SysOSFree
* stackcheck was without saveregisters
* fpc can compile itself on netware
This commit is contained in:
armin
parent
1d50f840f2
commit
bd9e93087c
@ -225,7 +225,7 @@ else
|
||||
SYSTEMUNIT=sysnetwa
|
||||
endif
|
||||
override FPCOPT+=-Ur
|
||||
override FPCOPT+=-dMT
|
||||
override FPCOPT+=-dMT -dDEBUG_MT
|
||||
CREATESMART=0
|
||||
OBJPASDIR=$(RTL)/objpas
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings lineinfo winsock heaptrc matrix initc dos crt objects sysutils classes typinfo math varutils cpu mmx getopts sockets video mouse keyboard types dateutils rtlconst sysconst strutils convutils aio nwsnut nwserv nwnit nwprot
|
||||
@ -1401,7 +1401,8 @@ sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
|
||||
objpas$(PPUEXT) dos$(PPUEXT) nwsys.inc sysconst$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
|
||||
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
|
||||
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) sysconst$(PPUEXT)
|
||||
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
|
||||
@ -1412,7 +1413,7 @@ gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
||||
varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
|
||||
objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
|
||||
$(COMPILER) -I$(OBJPASDIR) varutils.pp
|
||||
types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/types.pp
|
||||
rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
|
||||
$(COMPILER) $(OBJPASDIR)/rtlconst.pp
|
||||
@ -1432,9 +1433,6 @@ heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
|
||||
$(OBJPASDIR)/varutilh.inc varutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) varutils.pp
|
||||
override INSTALLPPUFILES+=nwimp/aio.imp nwimp/aio.imp nwimp/audnlm32.imp \
|
||||
nwimp/calnlm32.imp nwimp/ccs.imp nwimp/ccs-os.imp nwimp/clibaux.imp \
|
||||
nwimp/clibctx.imp nwimp/clib.imp nwimp/clxnlm32.imp nwimp/dplsv386.imp \
|
||||
|
||||
@ -60,7 +60,7 @@ override FPCOPT+=-Ur
|
||||
|
||||
|
||||
# for netware always use multithread
|
||||
override FPCOPT+=-dMT
|
||||
override FPCOPT+=-dMT -dDEBUG_MT
|
||||
|
||||
# and alway use smartlinking
|
||||
#CREATESMART=1
|
||||
@ -151,7 +151,8 @@ sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
|
||||
|
||||
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
|
||||
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) sysconst$(PPUEXT)
|
||||
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)
|
||||
@ -164,10 +165,10 @@ 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
|
||||
objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
|
||||
$(COMPILER) -I$(OBJPASDIR) varutils.pp
|
||||
|
||||
types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/types.pp
|
||||
|
||||
rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
|
||||
@ -209,10 +210,6 @@ callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
|
||||
$(OBJPASDIR)/varutilh.inc varutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) varutils.pp
|
||||
|
||||
#
|
||||
# Netware-.imp files need to be installed in the unit-dir
|
||||
#
|
||||
|
||||
@ -1,6 +1,8 @@
|
||||
News
|
||||
====
|
||||
|
||||
2004/08/01 armin:
|
||||
- lot of fixes, compiler can compile itself on a netware server
|
||||
2003/02/16 armin:
|
||||
- added nwconio, nwthreads, nwsnut
|
||||
2003/02/15 armin:
|
||||
@ -63,14 +65,11 @@
|
||||
|
||||
Install the current fpc sources from ftp.freepascal.org and change to the directory
|
||||
rtl/netware under the freepascal sourcetree. Verify the path of your units in
|
||||
Makefile. The default is /usr/lib/fpc/1.1/units/netware/rtl.
|
||||
Makefile. The default is /usr/lib/fpc/1.9.5/units/netware/rtl.
|
||||
Compile and install the rtl with
|
||||
|
||||
make install
|
||||
|
||||
on win32 you can use the script compile.cmd. You need to adjust the
|
||||
destination directory in the script.
|
||||
|
||||
Settings and needed files to compile for netware
|
||||
================================================
|
||||
|
||||
@ -78,8 +77,8 @@
|
||||
you may paste it to your fpc.cfg:
|
||||
|
||||
#IFDEF Netware
|
||||
-Fu/usr/lib/fpc/1.1/units/netware/rtl
|
||||
-Fl/usr/lib/fpc/1.1/units/netware/rtl
|
||||
-Fu/usr/lib/fpc/1.9.5/units/netware/rtl
|
||||
-Fl/usr/lib/fpc/1.9.5/units/netware/rtl
|
||||
#ENDIF
|
||||
|
||||
This adds the search path for the rtl-units as well as for the needed import-files.
|
||||
@ -158,21 +157,8 @@
|
||||
- Debugging
|
||||
---------
|
||||
|
||||
Thats currently a problem. As for as i know, there is no source level debugger
|
||||
available that works with freepascal. (But i have a modified version of
|
||||
Novells Rdebug that works with nlms generated by freepascal. Currently
|
||||
i'm waiting for novell to answer my questions about redistributing Rdebug.
|
||||
|
||||
The only way to debug i know is using the netware internal debugger or nwdbg.
|
||||
Nwdbg is a debugger on assembler level written by Jan Beulich. Symbols are
|
||||
supported. You can get nwdbg for netware 4.11,5.0 or 5.1 at developer.novell.com.
|
||||
I have no Information about netware 6 yet.
|
||||
|
||||
I also have a compiled version of gdbserve.nlm for gdb on my homepage
|
||||
but this does not seem to be stable and will only run on netwar 4.x.
|
||||
|
||||
I also have a patched version of novells RDebug, you can try
|
||||
http://home.arcor.de/armin.diehl/fpcnw/Rdebug.exe
|
||||
Debugging is possible with gdb on Netware 4.11, 5, 6 and 6.5.
|
||||
See http://home.arcor.de/armin.diehl/fpcnw/gdbnw.html for details
|
||||
|
||||
|
||||
- Netware SDK
|
||||
|
||||
@ -25,10 +25,11 @@ interface
|
||||
|
||||
uses
|
||||
sysutils,
|
||||
rtlconst,
|
||||
types,
|
||||
typinfo,
|
||||
rtlconst,
|
||||
systhrds;
|
||||
|
||||
|
||||
{$i classesh.inc}
|
||||
|
||||
@ -40,7 +41,18 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2004-01-22 17:11:23 peter
|
||||
Revision 1.4 2004-08-01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
* getenv ('PATH') is now supported
|
||||
* changed FExpand to global version
|
||||
* fixed heaplist growth error
|
||||
* support SysOSFree
|
||||
* stackcheck was without saveregisters
|
||||
* fpc can compile itself on netware
|
||||
|
||||
Revision 1.3 2004/01/22 17:11:23 peter
|
||||
* classes uses types to import TPoint and TRect
|
||||
|
||||
Revision 1.2 2004/01/10 20:15:21 michael
|
||||
|
||||
@ -14,14 +14,6 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ 2000/09/03 armin: first version
|
||||
2001/04/08 armin: implemented more functions
|
||||
OK: Implemented and tested
|
||||
NI: not implemented
|
||||
2001/04/15 armin: FindFirst bug corrected, FExpand and FSearch tested, GetCBreak, SetCBreak
|
||||
implemented
|
||||
}
|
||||
|
||||
unit dos;
|
||||
interface
|
||||
|
||||
@ -141,12 +133,47 @@ 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 : integer;
|
||||
begin
|
||||
ConsolePrintf ('warning: fpc dos.exec not implemented'#13#10,0);
|
||||
//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);
|
||||
if i >= 0 then
|
||||
begin
|
||||
doserror := 0;
|
||||
lastdosexitcode := i;
|
||||
end else
|
||||
begin
|
||||
doserror := 8; // for now, what about errno ?
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function dosexitcode : word;
|
||||
begin
|
||||
dosexitcode:=lastdosexitcode;
|
||||
@ -208,7 +235,6 @@ begin
|
||||
getvolnum := drive-1;
|
||||
end;
|
||||
|
||||
{$ifdef Int64}
|
||||
|
||||
function diskfree(drive : byte) : int64;
|
||||
VAR Buf : ARRAY [0..255] OF CHAR;
|
||||
@ -224,7 +250,7 @@ begin
|
||||
if volumeNumber >= 0 then
|
||||
begin
|
||||
{i think thats not the right function but for others i need a connection handle}
|
||||
if _GetVolumeInfoWithNumber (volumeNumber,@Buf,
|
||||
if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
|
||||
TotalBlocks,
|
||||
SectorsPerBlock,
|
||||
availableBlocks,
|
||||
@ -254,7 +280,7 @@ begin
|
||||
if volumeNumber >= 0 then
|
||||
begin
|
||||
{i think thats not the right function but for others i need a connection handle}
|
||||
if _GetVolumeInfoWithNumber (volumeNumber,@Buf,
|
||||
if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
|
||||
TotalBlocks,
|
||||
SectorsPerBlock,
|
||||
availableBlocks,
|
||||
@ -268,69 +294,6 @@ begin
|
||||
end else
|
||||
disksize := 0;
|
||||
end;
|
||||
{$else}
|
||||
|
||||
function diskfree(drive : byte) : longint;
|
||||
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) and (volumeNumber <= 255) 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 := availableBlocks * SectorsPerBlock * 512;
|
||||
end else
|
||||
diskfree := 0;
|
||||
end else
|
||||
diskfree := 0;
|
||||
end;
|
||||
|
||||
|
||||
function disksize(drive : byte) : longint;
|
||||
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) and (volumeNumber <= 255) 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 := TotalBlocks * SectorsPerBlock * 512;
|
||||
end else
|
||||
disksize := 0;
|
||||
end else
|
||||
disksize := 0;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
--- Findfirst FindNext ---
|
||||
@ -346,7 +309,9 @@ BEGIN
|
||||
attr := WORD (PNWDirEnt(EntryP)^.d_attr); // lowest 16 bit -> same as dos
|
||||
time := PNWDirEnt(EntryP)^.d_time + (LONGINT (PNWDirEnt(EntryP)^.d_date) SHL 16);
|
||||
size := PNWDirEnt(EntryP)^.d_size;
|
||||
name := strpas (PNWDirEnt(EntryP)^.d_nameDOS);
|
||||
name := strpas (PNWDirEnt(EntryP)^.d_name);
|
||||
if name = '' then
|
||||
name := strpas (PNWDirEnt(EntryP)^.d_nameDOS);
|
||||
doserror := 0;
|
||||
END ELSE
|
||||
BEGIN
|
||||
@ -431,14 +396,14 @@ procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : ex
|
||||
var
|
||||
dotpos,p1,i : longint;
|
||||
begin
|
||||
{ allow slash as backslash }
|
||||
{ allow backslash as slash }
|
||||
for i:=1 to length(path) do
|
||||
if path[i]='/' then path[i]:='\';
|
||||
{ get drive name }
|
||||
if path[i]='\' then path[i]:='/';
|
||||
{ get volume name }
|
||||
p1:=pos(':',path);
|
||||
if p1>0 then
|
||||
begin
|
||||
dir:=path[1]+':';
|
||||
dir:=copy(path,1,p1);
|
||||
delete(path,1,p1);
|
||||
end
|
||||
else
|
||||
@ -447,14 +412,14 @@ begin
|
||||
{ if path contains no backslashes }
|
||||
while true do
|
||||
begin
|
||||
p1:=pos('\',path);
|
||||
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
|
||||
//if LFNSupport then
|
||||
begin
|
||||
Ext:='';
|
||||
i:=Length(Path);
|
||||
@ -471,7 +436,7 @@ begin
|
||||
Ext:=Copy(Path,DotPos,255);
|
||||
Name:=Copy(Path,1,DotPos - 1);
|
||||
end
|
||||
else
|
||||
(* else
|
||||
begin
|
||||
p1:=pos('.',path);
|
||||
if p1>0 then
|
||||
@ -482,115 +447,25 @@ begin
|
||||
else
|
||||
ext:='';
|
||||
name:=path;
|
||||
end;
|
||||
end;*)
|
||||
end;
|
||||
|
||||
|
||||
function fexpand(const path : pathstr) : pathstr;
|
||||
var
|
||||
s,pa : pathstr;
|
||||
i,j : longint;
|
||||
function GetShortName(var p : String) : boolean;
|
||||
begin
|
||||
getdir(0,s);
|
||||
i:=ioresult;
|
||||
if LFNSupport then
|
||||
begin
|
||||
pa:=path;
|
||||
end
|
||||
else
|
||||
if FileNameCaseSensitive then
|
||||
pa:=path
|
||||
else
|
||||
pa:=upcase(path);
|
||||
|
||||
{ allow slash as backslash }
|
||||
for i:=1 to length(pa) do
|
||||
if pa[i]='/' then
|
||||
pa[i]:='\';
|
||||
|
||||
if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
|
||||
begin
|
||||
{ Always uppercase driveletter }
|
||||
if (pa[1] in ['a'..'z']) then
|
||||
pa[1]:=Chr(Ord(Pa[1])-32);
|
||||
{ we must get the right directory }
|
||||
getdir(ord(pa[1])-ord('A')+1,s);
|
||||
i:=ioresult;
|
||||
if (ord(pa[0])>2) and (pa[3]<>'\') then
|
||||
if pa[1]=s[1] then
|
||||
begin
|
||||
{ remove ending slash if it already exists }
|
||||
if s[length(s)]='\' then
|
||||
dec(s[0]);
|
||||
pa:=s+'\'+copy (pa,3,length(pa));
|
||||
end
|
||||
else
|
||||
pa:=pa[1]+':\'+copy (pa,3,length(pa))
|
||||
end
|
||||
else
|
||||
if pa[1]='\' then
|
||||
begin
|
||||
{ Do not touch Network drive names if LFNSupport is true }
|
||||
if not ((Length(pa)>1) and (pa[2]='\') and LFNSupport) then
|
||||
pa:=s[1]+':'+pa;
|
||||
end
|
||||
else if s[0]=#3 then
|
||||
pa:=s+pa
|
||||
else
|
||||
pa:=s+'\'+pa;
|
||||
|
||||
{ Turbo Pascal gives current dir on drive if only drive given as parameter! }
|
||||
if length(pa) = 2 then
|
||||
begin
|
||||
getdir(byte(pa[1])-64,s);
|
||||
pa := s;
|
||||
end;
|
||||
|
||||
{First remove all references to '\.\'}
|
||||
while pos ('\.\',pa)<>0 do
|
||||
delete (pa,pos('\.\',pa),2);
|
||||
{Now remove also all references to '\..\' + of course previous dirs..}
|
||||
repeat
|
||||
i:=pos('\..\',pa);
|
||||
if i<>0 then
|
||||
begin
|
||||
j:=i-1;
|
||||
while (j>1) and (pa[j]<>'\') do
|
||||
dec (j);
|
||||
if pa[j+1] = ':' then j := 3;
|
||||
delete (pa,j,i-j+3);
|
||||
end;
|
||||
until i=0;
|
||||
|
||||
{ Turbo Pascal gets rid of a \.. at the end of the path }
|
||||
{ Now remove also any reference to '\..' at end of line
|
||||
+ of course previous dir.. }
|
||||
i:=pos('\..',pa);
|
||||
if i<>0 then
|
||||
begin
|
||||
if i = length(pa) - 2 then
|
||||
begin
|
||||
j:=i-1;
|
||||
while (j>1) and (pa[j]<>'\') do
|
||||
dec (j);
|
||||
delete (pa,j,i-j+3);
|
||||
end;
|
||||
pa := pa + '\';
|
||||
end;
|
||||
{ Remove End . and \}
|
||||
if (length(pa)>0) and (pa[length(pa)]='.') then
|
||||
dec(byte(pa[0]));
|
||||
{ if only the drive + a '\' is left then the '\' should be left to prevtn the program
|
||||
accessing the current directory on the drive rather than the root!}
|
||||
{ if the last char of path = '\' then leave it in as this is what TP does! }
|
||||
if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
|
||||
dec(byte(pa[0]));
|
||||
{ if only a drive is given in path then there should be a '\' at the
|
||||
end of the string given back }
|
||||
if length(pa) = 2 then pa := pa + '\';
|
||||
fexpand:=pa;
|
||||
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
|
||||
@ -598,6 +473,7 @@ var
|
||||
s : searchrec;
|
||||
newdir : pathstr;
|
||||
begin
|
||||
write ('FSearch ("',path,'","',dirlist,'"');
|
||||
{ check if the file specified exists }
|
||||
findfirst(path,anyfile,s);
|
||||
if doserror=0 then
|
||||
@ -611,9 +487,9 @@ begin
|
||||
fsearch:=''
|
||||
else
|
||||
begin
|
||||
{ allow slash as backslash }
|
||||
{ allow backslash as slash }
|
||||
for i:=1 to length(dirlist) do
|
||||
if dirlist[i]='/' then dirlist[i]:='\';
|
||||
if dirlist[i]='\' then dirlist[i]:='/';
|
||||
repeat
|
||||
p1:=pos(';',dirlist);
|
||||
if p1<>0 then
|
||||
@ -626,8 +502,8 @@ begin
|
||||
newdir:=dirlist;
|
||||
dirlist:='';
|
||||
end;
|
||||
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
|
||||
newdir:=newdir+'\';
|
||||
if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
|
||||
newdir:=newdir+'/';
|
||||
findfirst(newdir+path,anyfile,s);
|
||||
if doserror=0 then
|
||||
newdir:=newdir+path
|
||||
@ -701,19 +577,37 @@ begin
|
||||
ConsolePrintf ('warning: fpc dos.envstr not implemented'#13#10,0);
|
||||
end;
|
||||
|
||||
{ the function exists in clib but i dont know how to set environment vars.
|
||||
may be it's only a dummy in clib }
|
||||
{ works fine (at least with netware 6.5) }
|
||||
Function GetEnv(envvar: string): string;
|
||||
var
|
||||
envvar0 : array[0..256] of char;
|
||||
p : pchar;
|
||||
var envvar0 : array[0..512] of char;
|
||||
p : pchar;
|
||||
i,isDosPath,res : longint;
|
||||
begin
|
||||
strpcopy(envvar0,envvar);
|
||||
p := _getenv (envvar0);
|
||||
if p = NIL then
|
||||
GetEnv := ''
|
||||
else
|
||||
GetEnv := strpas (p);
|
||||
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 := _NWGetSearchPathElement (i, isdosPath, @envvar0[0]);
|
||||
while res = 0 do
|
||||
begin
|
||||
if GetEnv <> '' then GetEnv := GetEnv + ';';
|
||||
GetEnv := GetEnv + envvar0;
|
||||
inc (i);
|
||||
res := _NWGetSearchPathElement (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 := _getenv (envvar0);
|
||||
if p = NIL then
|
||||
GetEnv := ''
|
||||
else
|
||||
GetEnv := strpas (p);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -723,7 +617,8 @@ end;
|
||||
|
||||
Procedure keep(exitcode : word);
|
||||
Begin
|
||||
{ no netware equivalent }
|
||||
{ simply wait until nlm will be unloaded }
|
||||
while true do _delay (60000);
|
||||
End;
|
||||
|
||||
Procedure getintvec(intno : byte;var vector : pointer);
|
||||
@ -750,7 +645,18 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2004-02-17 17:37:26 daniel
|
||||
Revision 1.11 2004-08-01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
* getenv ('PATH') is now supported
|
||||
* changed FExpand to global version
|
||||
* fixed heaplist growth error
|
||||
* support SysOSFree
|
||||
* stackcheck was without saveregisters
|
||||
* fpc can compile itself on netware
|
||||
|
||||
Revision 1.10 2004/02/17 17:37:26 daniel
|
||||
* Enable threadvars again
|
||||
|
||||
Revision 1.9 2004/02/16 22:16:59 hajny
|
||||
@ -772,3 +678,4 @@ end.
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
}
|
||||
|
||||
|
||||
@ -3,17 +3,19 @@
|
||||
Netware Server Imports for FreePascal, contains definitions for the
|
||||
netware server protocol library
|
||||
|
||||
Initial Version 2002/02/23 Armin (diehl@nordrhein.de or armin@freepascal.org)
|
||||
Initial Version 2003/02/23 Armin (diehl@nordrhein.de or armin@freepascal.org)
|
||||
|
||||
The C-NDK and Documentation can be found here:
|
||||
http://developer.novell.com
|
||||
|
||||
This program is distributed in the hope that it will be useful,but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
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.
|
||||
|
||||
Do not blame Novell if there are errors in this file, instead
|
||||
contact me and i will se what i can do.
|
||||
|
||||
This module is untested, for the socket functions please use winsock
|
||||
}
|
||||
|
||||
unit nwprot;
|
||||
@ -60,7 +62,7 @@ type
|
||||
|
||||
const
|
||||
SNPA_MX = 10; // maximum address mapping size is that largest we currently use
|
||||
|
||||
|
||||
// Simple IP interface information block --
|
||||
type
|
||||
Pip_if_info = ^Tip_if_info;
|
||||
@ -223,32 +225,32 @@ type
|
||||
{ Declare the context block. The client must supply the actual
|
||||
block by placing NETDB_DEFINE_CONTEXT in one of the C modules
|
||||
in the link. }
|
||||
var nwSocketCtx : longint;cvar;external;
|
||||
// var nwSocketCtx : longint;cvar;external;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Host file examination
|
||||
------------------------------------------------------------------------ }
|
||||
{ Local-file-only routines }
|
||||
|
||||
function NWgethostbyname(nwsktctx:Pnwsockent; name:Pchar):Phostent;cdecl;external 'tcpip' name 'NWgethostbyname';
|
||||
function NWgethostbyname(var nwsktctx:Tnwsockent; name:Pchar):Phostent;cdecl;external 'tcpip' name 'NWgethostbyname';
|
||||
function NWgethostbyname(nwsktctx:Pnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyname';
|
||||
function NWgethostbyname(var nwsktctx:Tnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyname';
|
||||
|
||||
function NWgethostbyaddr(nwsktctx:Pnwsockent; addr:Pchar; length:longint; _type:longint):Phostent;cdecl;external 'tcpip' name 'NWgethostbyaddr';
|
||||
function NWgethostbyaddr(var nwsktctx:Tnwsockent; addr:Pchar; length:longint; _type:longint):Phostent;cdecl;external 'tcpip' name 'NWgethostbyaddr';
|
||||
function NWgethostbyaddr(nwsktctx:Pnwsockent; addr:Pchar; length:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyaddr';
|
||||
function NWgethostbyaddr(var nwsktctx:Tnwsockent; addr:Pchar; length:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyaddr';
|
||||
|
||||
function NWgethostent(nwsktctx:Pnwsockent):Phostent;cdecl;external 'tcpip' name 'NWgethostent';
|
||||
function NWgethostent(var nwsktctx:Tnwsockent):Phostent;cdecl;external 'tcpip' name 'NWgethostent';
|
||||
function NWgethostent(nwsktctx:Pnwsockent):Phostent;cdecl;external {'tcpip'} name 'NWgethostent';
|
||||
function NWgethostent(var nwsktctx:Tnwsockent):Phostent;cdecl;external {'tcpip'} name 'NWgethostent';
|
||||
|
||||
procedure NWsethostent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsethostent';
|
||||
procedure NWsethostent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsethostent';
|
||||
procedure NWsethostent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsethostent';
|
||||
procedure NWsethostent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsethostent';
|
||||
|
||||
procedure NWendhostent(nwsktctx:Pnwsockent);cdecl;external 'tcpip' name 'NWendhostent';
|
||||
procedure NWendhostent(var nwsktctx:Tnwsockent);cdecl;external 'tcpip' name 'NWendhostent';
|
||||
procedure NWendhostent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendhostent';
|
||||
procedure NWendhostent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendhostent';
|
||||
{ Internet Name Service routines }
|
||||
{
|
||||
NetDBgethostbyname() -- returns the host entry (struct hostent ) given
|
||||
the name of a host.
|
||||
|
||||
|
||||
The local file sys:/etc/hosts is consulted first to see if the entry
|
||||
exists there. If so, then that is returned. If not, then if DNS is
|
||||
installed on the machine, it will be consulted to perform the lookup.
|
||||
@ -258,32 +260,32 @@ procedure NWendhostent(var nwsktctx:Tnwsockent);cdecl;external 'tcpip' name 'NWe
|
||||
This function returns NULL when an error occurs. The integer
|
||||
nwsktent->nse_h_errno can be checked to determine the nature of the
|
||||
error.
|
||||
|
||||
|
||||
The integer nwsktent->nse_h_errno can have the following values:
|
||||
|
||||
|
||||
HOST_NOT_FOUND No such host exists.
|
||||
|
||||
If the NetDBgethostbyname function succeeds, it will return a pointer
|
||||
to a structure of type struct hostent.
|
||||
|
||||
|
||||
Syntax:
|
||||
struct hostent NetDBgethostbyname(struct nwsockent nwsktent,
|
||||
char name);
|
||||
|
||||
|
||||
nwskent: Points to a context block.
|
||||
|
||||
|
||||
name: Official name of the host.
|
||||
|
||||
|
||||
Returns:
|
||||
A pointer to the appropriate struct hostent if any that matches.
|
||||
NULL if no match found.
|
||||
}
|
||||
function NetDBgethostbyname(nwskent:Pnwsockent; name:Pchar):Phostent;cdecl;external 'tcpip' name 'NetDBgethostbyname';
|
||||
function NetDBgethostbyname(var nwskent:Tnwsockent; name:Pchar):Phostent;cdecl;external 'tcpip' name 'NetDBgethostbyname';
|
||||
function NetDBgethostbyname(nwskent:Pnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyname';
|
||||
function NetDBgethostbyname(var nwskent:Tnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyname';
|
||||
{
|
||||
NetDBgethostbyaddr() -- returns the host entry (struct hostent ) given
|
||||
the address of a host.
|
||||
|
||||
|
||||
The local file sys:/etc/hosts is consulted first to see if the entry
|
||||
exists there. If so, then that is returned. If not, then if DNS is
|
||||
installed on the machine, it will be consulted to perform the lookup.
|
||||
@ -293,70 +295,70 @@ function NetDBgethostbyname(var nwskent:Tnwsockent; name:Pchar):Phostent;cdecl;e
|
||||
This function returns NULL when an error occurs. The integer
|
||||
nwsktent->nse_h_errno can be checked to determine the nature of the
|
||||
error.
|
||||
|
||||
|
||||
The integer nwsktent->nse_h_errno can have the following values:
|
||||
|
||||
|
||||
HOST_NOT_FOUND No such host exists.
|
||||
|
||||
|
||||
If the NetDBgethostbyaddr function succeeds, it will return a pointer
|
||||
to a structure of type struct hostent.
|
||||
|
||||
|
||||
Syntax:
|
||||
struct hostent NetDBgethostbyaddr(struct nwsockent nwskent,
|
||||
char addr, int len, int type);
|
||||
|
||||
|
||||
nwsktent: (Input) Points to a context block.
|
||||
|
||||
|
||||
addr: (Input) Internet address of the host.
|
||||
|
||||
len: (Input) Length of the Internet address, in bytes.
|
||||
|
||||
|
||||
type: (Input) Value corresponding to the type of Internet
|
||||
address. Currently, the type is always AF_INET.
|
||||
|
||||
|
||||
Returns:
|
||||
A pointer to the appropriate struct hostent if any that matches.
|
||||
NULL if no match found.
|
||||
}
|
||||
function NetDBgethostbyaddr(nwsktent:Pnwsockent; addr:Pchar; len:longint; _type:longint):Phostent;cdecl;external 'tcpip' name 'NetDBgethostbyaddr';
|
||||
function NetDBgethostbyaddr(var nwsktent:Tnwsockent; addr:Pchar; len:longint; _type:longint):Phostent;cdecl;external 'tcpip' name 'NetDBgethostbyaddr';
|
||||
{
|
||||
function NetDBgethostbyaddr(nwsktent:Pnwsockent; addr:Pchar; len:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyaddr';
|
||||
function NetDBgethostbyaddr(var nwsktent:Tnwsockent; addr:Pchar; len:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyaddr';
|
||||
{
|
||||
NetDBgethostent() -- returns the next sequential entry from the
|
||||
SYS:ETC/HOSTS file, opening the file it it is not already open. Once
|
||||
the local file is depleted, all of the NIS host entries will be
|
||||
retrieved until those are depleted.
|
||||
|
||||
|
||||
Note that there may be duplicate entries in the local and NIS databases.
|
||||
The caller should handle these appropriately.
|
||||
|
||||
|
||||
This function returns NULL when an error occurs. The integer
|
||||
nwsktent->nse_h_errno can be checked to determine the nature of the
|
||||
error.
|
||||
|
||||
|
||||
The integer nwsktent->nse_h_errno can have the following values:
|
||||
|
||||
HOST_NOT_FOUND No more hosts exist in either SYS:ETC/HOSTS or
|
||||
NIS.
|
||||
|
||||
|
||||
Syntax:
|
||||
struct hostent NetDBgethostent(struct nwsockent nwsktent,
|
||||
short ploc);
|
||||
|
||||
|
||||
nwsktent: (Input) Points to a context block.
|
||||
|
||||
ploc: (Output) If non-NULL, this short will indicate if this
|
||||
entry is from the local sys:etc/hosts file (NETDB_LOC_LOCAL)
|
||||
or from the NIS database (NETDB_LOC_NIS).
|
||||
|
||||
|
||||
Pass in NULL if you're not interested in this information.
|
||||
|
||||
|
||||
Returns:
|
||||
A pointer to the next host entry if the function is successful.
|
||||
NULL if no more entries or an error occurred.
|
||||
}
|
||||
function NetDBgethostent(nwsktent:Pnwsockent; ploc:Psmallint):Phostent;cdecl;external 'tcpip' name 'NetDBgethostent';
|
||||
function NetDBgethostent(var nwsktent:Tnwsockent; ploc:Psmallint):Phostent;cdecl;external 'tcpip' name 'NetDBgethostent';
|
||||
{
|
||||
function NetDBgethostent(nwsktent:Pnwsockent; ploc:Psmallint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostent';
|
||||
function NetDBgethostent(var nwsktent:Tnwsockent; ploc:Psmallint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostent';
|
||||
{
|
||||
NetDBsethostent() -- rewinds the SYS:ETC/HOSTS file if the file is
|
||||
already open. This call guarantees that the next call to
|
||||
NetDBgethostent() will return the FIRST record in the local hosts file,
|
||||
@ -366,36 +368,36 @@ function NetDBgethostent(var nwsktent:Tnwsockent; ploc:Psmallint):Phostent;cdecl
|
||||
If the stayopen flag is set (nonzero), the SYS:ETC/HOSTS file is NOT
|
||||
closed after each call made to NetDBgethostbyname() or
|
||||
NetDBgethostbyaddr().
|
||||
|
||||
|
||||
Syntax:
|
||||
void NetDBsethostent(struct nwsockent nwsktent, int stayopen);
|
||||
|
||||
|
||||
nwsktent: (Input) Points to a context block.
|
||||
|
||||
|
||||
stayopen: (Input) If nonzero, causes SYS:ETC/HOSTS to remain open
|
||||
after a call to NetDBgethostbyname() or
|
||||
NetDBgethostbyaddr().
|
||||
|
||||
|
||||
Returns:
|
||||
Nothing.
|
||||
}
|
||||
procedure NetDBsethostent(nwsktent:Pnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NetDBsethostent';
|
||||
procedure NetDBsethostent(var nwsktent:Tnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NetDBsethostent';
|
||||
{
|
||||
procedure NetDBsethostent(nwsktent:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NetDBsethostent';
|
||||
procedure NetDBsethostent(var nwsktent:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NetDBsethostent';
|
||||
{
|
||||
NetDBendhostent() -- closes the SYS:ETC/HOSTS file. Also ends access
|
||||
to the NIS database. After this call, the next call to
|
||||
NetDBgethostent() will be from the beginning of the local file again.
|
||||
|
||||
|
||||
Syntax:
|
||||
void NetDBendhostent(struct nwsockent nwsktent);
|
||||
|
||||
nwsktent: (Input) Points to a context block.
|
||||
|
||||
|
||||
Returns:
|
||||
Nothing.
|
||||
}
|
||||
procedure NetDBendhostent(nwsktent:Pnwsockent);cdecl;external 'tcpip' name 'NetDBendhostent';
|
||||
procedure NetDBendhostent(var nwsktent:Tnwsockent);cdecl;external 'tcpip' name 'NetDBendhostent';
|
||||
procedure NetDBendhostent(nwsktent:Pnwsockent);cdecl;external {'tcpip'} name 'NetDBendhostent';
|
||||
procedure NetDBendhostent(var nwsktent:Tnwsockent);cdecl;external {'tcpip'} name 'NetDBendhostent';
|
||||
{
|
||||
NetDBgethostname() -- this gets the current machine's host name into the
|
||||
passed in buffer (if it is large enough).
|
||||
@ -418,59 +420,59 @@ procedure NetDBendhostent(var nwsktent:Tnwsockent);cdecl;external 'tcpip' name '
|
||||
0: The call succeeded.
|
||||
-1: The call failed.
|
||||
}
|
||||
function NetDBgethostname(nwsktent:Pnwsockent; name:Pchar; namelen:longint):longint;cdecl;external 'tcpip' name 'NetDBgethostname';
|
||||
function NetDBgethostname(var nwsktent:Tnwsockent; name:Pchar; namelen:longint):longint;cdecl;external 'tcpip' name 'NetDBgethostname';
|
||||
function NetDBgethostname(nwsktent:Pnwsockent; name:Pchar; namelen:longint):longint;cdecl;external {'tcpip'} name 'NetDBgethostname';
|
||||
function NetDBgethostname(var nwsktent:Tnwsockent; name:Pchar; namelen:longint):longint;cdecl;external {'tcpip'} name 'NetDBgethostname';
|
||||
|
||||
// Network file examination
|
||||
function NWgetnetbyname(nwsktctx:Pnwsockent; name:Pchar):Pnetent;cdecl;external 'tcpip' name 'NWgetnetbyname';
|
||||
function NWgetnetbyname(var nwsktctx:Tnwsockent; name:Pchar):Pnetent;cdecl;external 'tcpip' name 'NWgetnetbyname';
|
||||
function NWgetnetbyname(nwsktctx:Pnwsockent; name:Pchar):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyname';
|
||||
function NWgetnetbyname(var nwsktctx:Tnwsockent; name:Pchar):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyname';
|
||||
|
||||
function NWgetnetbyaddr(nwsktctx:Pnwsockent; net:longint; _type:longint):Pnetent;cdecl;external 'tcpip' name 'NWgetnetbyaddr';
|
||||
function NWgetnetbyaddr(var nwsktctx:Tnwsockent; net:longint; _type:longint):Pnetent;cdecl;external 'tcpip' name 'NWgetnetbyaddr';
|
||||
function NWgetnetbyaddr(nwsktctx:Pnwsockent; net:longint; _type:longint):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyaddr';
|
||||
function NWgetnetbyaddr(var nwsktctx:Tnwsockent; net:longint; _type:longint):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyaddr';
|
||||
|
||||
function NWgetnetent(nwsktctx:Pnwsockent):Pnetent;cdecl;external 'tcpip' name 'NWgetnetent';
|
||||
function NWgetnetent(var nwsktctx:Tnwsockent):Pnetent;cdecl;external 'tcpip' name 'NWgetnetent';
|
||||
function NWgetnetent(nwsktctx:Pnwsockent):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetent';
|
||||
function NWgetnetent(var nwsktctx:Tnwsockent):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetent';
|
||||
|
||||
procedure NWsetnetent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsetnetent';
|
||||
procedure NWsetnetent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsetnetent';
|
||||
procedure NWsetnetent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetnetent';
|
||||
procedure NWsetnetent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetnetent';
|
||||
|
||||
procedure NWendnetent(nwsktctx:Pnwsockent);cdecl;external 'tcpip' name 'NWendnetent';
|
||||
procedure NWendnetent(var nwsktctx:Tnwsockent);cdecl;external 'tcpip' name 'NWendnetent';
|
||||
procedure NWendnetent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendnetent';
|
||||
procedure NWendnetent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendnetent';
|
||||
|
||||
// Service file examination
|
||||
function NWgetservbyname(nwsktctx:Pnwsockent; name:Pchar; protocol:Pchar):Pservent;cdecl;external 'tcpip' name 'NWgetservbyname';
|
||||
function NWgetservbyname(var nwsktctx:Tnwsockent; name:Pchar; protocol:Pchar):Pservent;cdecl;external 'tcpip' name 'NWgetservbyname';
|
||||
function NWgetservbyname(nwsktctx:Pnwsockent; name:Pchar; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyname';
|
||||
function NWgetservbyname(var nwsktctx:Tnwsockent; name:Pchar; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyname';
|
||||
|
||||
function NWgetservbyport(nwsktctx:Pnwsockent; port:longint; protocol:Pchar):Pservent;cdecl;external 'tcpip' name 'NWgetservbyport';
|
||||
function NWgetservbyport(var nwsktctx:Tnwsockent; port:longint; protocol:Pchar):Pservent;cdecl;external 'tcpip' name 'NWgetservbyport';
|
||||
function NWgetservbyport(nwsktctx:Pnwsockent; port:longint; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyport';
|
||||
function NWgetservbyport(var nwsktctx:Tnwsockent; port:longint; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyport';
|
||||
|
||||
function NWgetservent(nwsktctx:Pnwsockent):Pservent;cdecl;external 'tcpip' name 'NWgetservent';
|
||||
function NWgetservent(var nwsktctx:Tnwsockent):Pservent;cdecl;external 'tcpip' name 'NWgetservent';
|
||||
function NWgetservent(nwsktctx:Pnwsockent):Pservent;cdecl;external {'tcpip'} name 'NWgetservent';
|
||||
function NWgetservent(var nwsktctx:Tnwsockent):Pservent;cdecl;external {'tcpip'} name 'NWgetservent';
|
||||
|
||||
procedure NWsetservent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsetservent';
|
||||
procedure NWsetservent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsetservent';
|
||||
procedure NWsetservent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetservent';
|
||||
procedure NWsetservent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetservent';
|
||||
|
||||
procedure NWendservent(nwsktctx:Pnwsockent);cdecl;external 'tcpip' name 'NWendservent';
|
||||
procedure NWendservent(var nwsktctx:Tnwsockent);cdecl;external 'tcpip' name 'NWendservent';
|
||||
procedure NWendservent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendservent';
|
||||
procedure NWendservent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendservent';
|
||||
|
||||
// Protocol file examination
|
||||
function NWgetprotobyname(nwsktctx:Pnwsockent; name:Pchar):Pprotoent;cdecl;external 'tcpip' name 'NWgetprotobyname';
|
||||
function NWgetprotobyname(var nwsktctx:Tnwsockent; name:Pchar):Pprotoent;cdecl;external 'tcpip' name 'NWgetprotobyname';
|
||||
function NWgetprotobyname(nwsktctx:Pnwsockent; name:Pchar):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobyname';
|
||||
function NWgetprotobyname(var nwsktctx:Tnwsockent; name:Pchar):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobyname';
|
||||
|
||||
function NWgetprotobynumber(nwsktctx:Pnwsockent; protocol:longint):Pprotoent;cdecl;external 'tcpip' name 'NWgetprotobynumber';
|
||||
function NWgetprotobynumber(var nwsktctx:Tnwsockent; protocol:longint):Pprotoent;cdecl;external 'tcpip' name 'NWgetprotobynumber';
|
||||
function NWgetprotobynumber(nwsktctx:Pnwsockent; protocol:longint):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobynumber';
|
||||
function NWgetprotobynumber(var nwsktctx:Tnwsockent; protocol:longint):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobynumber';
|
||||
|
||||
function NWgetprotoent(nwsktctx:Pnwsockent):Pprotoent;cdecl;external 'tcpip' name 'NWgetprotoent';
|
||||
function NWgetprotoent(var nwsktctx:Tnwsockent):Pprotoent;cdecl;external 'tcpip' name 'NWgetprotoent';
|
||||
function NWgetprotoent(nwsktctx:Pnwsockent):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotoent';
|
||||
function NWgetprotoent(var nwsktctx:Tnwsockent):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotoent';
|
||||
|
||||
procedure NWsetprotoent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsetprotoent';
|
||||
procedure NWsetprotoent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external 'tcpip' name 'NWsetprotoent';
|
||||
procedure NWsetprotoent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetprotoent';
|
||||
procedure NWsetprotoent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetprotoent';
|
||||
|
||||
procedure NWendprotoent(nwsktctx:Pnwsockent);cdecl;external 'tcpip' name 'NWendprotoent';
|
||||
procedure NWendprotoent(var nwsktctx:Tnwsockent);cdecl;external 'tcpip' name 'NWendprotoent';
|
||||
procedure NWendprotoent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendprotoent';
|
||||
procedure NWendprotoent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendprotoent';
|
||||
|
||||
function gethostname(name:Pchar; namelen:longint):longint;cdecl;external 'tcpip' name 'gethostname';
|
||||
function gethostid:longint;cdecl;external 'tcpip' name 'gethostid';
|
||||
function gethostname(name:Pchar; namelen:longint):longint;cdecl;external {'tcpip'} name 'gethostname';
|
||||
function gethostid:longint;cdecl;external {'tcpip'} name 'gethostid';
|
||||
{-tiuser.h---------------------------------------------------------------------}
|
||||
const
|
||||
EAGAIN = -(1);
|
||||
@ -518,7 +520,7 @@ const
|
||||
_T_DEFAULT = $10;
|
||||
_T_SUCCESS = $20;
|
||||
_T_FAILURE = $40;
|
||||
|
||||
|
||||
var t_errno : longint;cvar;external;
|
||||
|
||||
type
|
||||
@ -957,7 +959,7 @@ type
|
||||
Tmblk_t = Tmsgb;
|
||||
Pmblk_t = Pmsgb;
|
||||
|
||||
Pq_xtra = pointer; // dont know where this is defined
|
||||
Pq_xtra = pointer; // dont know where this is defined
|
||||
|
||||
Pqueue = ^Tqueue;
|
||||
Tqueue = record
|
||||
@ -1113,7 +1115,7 @@ const
|
||||
STRMEDFRAC = 90;
|
||||
MAXBSIZE = MAXMSGSIZE;
|
||||
|
||||
type TFuncLongCdecl = function : longint; cdecl;
|
||||
type TFuncLongCdecl = function : longint; cdecl;
|
||||
|
||||
function allocb(size:longint; pri:longint):Pmblk_t;cdecl;external 'streams' name 'allocb';
|
||||
function allocq:Pqueue_t;cdecl;external 'streams' name 'allocq';
|
||||
@ -1325,10 +1327,10 @@ const
|
||||
const
|
||||
IP_OPTIONS = 1;
|
||||
|
||||
function ntohs(value:word):word;cdecl;external 'tcpip' name 'ntohs';
|
||||
function htons(value:word):word;cdecl;external 'tcpip' name 'htons';
|
||||
function ntohl(value:dword):dword;cdecl;external 'tcpip' name 'ntohl';
|
||||
function htonl(value:dword):dword;cdecl;external 'tcpip' name 'htonl';
|
||||
function ntohs(value:word):word;cdecl;external {'tcpip'} name 'ntohs';
|
||||
function htons(value:word):word;cdecl;external {'tcpip'} name 'htons';
|
||||
function ntohl(value:dword):dword;cdecl;external {'tcpip'} name 'ntohl';
|
||||
function htonl(value:dword):dword;cdecl;external {'tcpip'} name 'htonl';
|
||||
{------------------------------------------------------------------------------}
|
||||
|
||||
implementation
|
||||
@ -1348,7 +1350,18 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-02-23 18:41:42 armin
|
||||
Revision 1.2 2004-08-01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
* getenv ('PATH') is now supported
|
||||
* changed FExpand to global version
|
||||
* fixed heaplist growth error
|
||||
* support SysOSFree
|
||||
* stackcheck was without saveregisters
|
||||
* fpc can compile itself on netware
|
||||
|
||||
Revision 1.1 2003/02/23 18:41:42 armin
|
||||
* added nwprot, contains types/imports for netware server protocol library
|
||||
|
||||
}
|
||||
|
||||
@ -15,14 +15,9 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ 2000/08/27 armin: first version
|
||||
2001/03/08 armin: additional functions
|
||||
2001/04/14 armin: additional functions for crt-unit
|
||||
}
|
||||
|
||||
CONST Clib = 'clib';
|
||||
|
||||
|
||||
TYPE
|
||||
dev_t = LONGINT;
|
||||
ino_t = LONGINT;
|
||||
@ -106,6 +101,8 @@ FUNCTION _tell (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'tell';
|
||||
FUNCTION _write (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'write';
|
||||
FUNCTION _read (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'read';
|
||||
FUNCTION _filelength (filedes : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'filelength';
|
||||
FUNCTION _lock (filedes : LONGINT; Offset, Length : Cardinal) : LONGINT; CDECL; EXTERNAL Clib NAME 'lock';
|
||||
FUNCTION _unlock (filedes : LONGINT; Offset, Length : Cardinal) : LONGINT; CDECL; EXTERNAL Clib NAME 'unlock';
|
||||
|
||||
TYPE
|
||||
NWModifyStructure =
|
||||
@ -184,7 +181,7 @@ FUNCTION __get_errno_ptr : _PLONGINT; CDECL; EXTERNAL Clib;
|
||||
FUNCTION _malloc (size : LONGINT) : POINTER; CDECL; EXTERNAL CLib NAME 'malloc';
|
||||
FUNCTION _realloc (p : POINTER; size : LONGINT) : POINTER; CDECL; EXTERNAL CLib NAME 'realloc';
|
||||
PROCEDURE _free (what : POINTER); CDECL; EXTERNAL CLib NAME 'free';
|
||||
FUNCTION _stackavail : LONGINT; CDECL; EXTERNAL CLib NAME 'stackavail';
|
||||
FUNCTION _stackavail : CARDINAL; CDECL; EXTERNAL CLib NAME 'stackavail';
|
||||
|
||||
// Debug
|
||||
PROCEDURE _EnterDebugger; CDECL; EXTERNAL Clib NAME 'EnterDebugger';
|
||||
@ -332,10 +329,50 @@ CONST _SIGTERM = 6;
|
||||
|
||||
PROCEDURE _Signal (Sig : longint; SigFunc : pointer); CDECL; EXTERNAL Clib NAME 'signal';
|
||||
|
||||
FUNCTION _SetCurrentNameSpace (newNameSpace : BYTE) : BYTE; CDECL; EXTERNAL Clib NAME 'SetCurrentNameSpace';
|
||||
FUNCTION _SetTargetNameSpace (newNameSpace : BYTE) : BYTE; CDECL; EXTERNAL Clib NAME 'SetTargetNameSpace';
|
||||
|
||||
CONST
|
||||
NW_NS_DOS = 0;
|
||||
NW_NS_MAC = 1;
|
||||
NW_NS_NFS = 2;
|
||||
NW_NS_FTAM = 3;
|
||||
NW_NS_LONG = 4;
|
||||
|
||||
function _NWAddSearchPathAtEnd (searchPath : pchar; var number : longint) : longint; cdecl; external Clib name 'NWAddSearchPathAtEnd';
|
||||
function _NWDeleteSearchPath (searchPathNumber : longint) : longint; cdecl; external Clib name 'NWDeleteSearchPath';
|
||||
function _NWInsertSearchPath (searchPathNumber : longint; path : pchar) : longint; cdecl; external Clib name 'NWInsertSearchPath';
|
||||
function _NWGetSearchPathElement (searchPathNumber : longint; var isDOSSearchPath : longint; searchPath : pchar) : longint; cdecl; external Clib name 'NWGetSearchPathElement';
|
||||
|
||||
|
||||
// values for __mode used with spawnxx()
|
||||
CONST
|
||||
P_WAIT = 0;
|
||||
P_NOWAIT = 1;
|
||||
P_OVERLAY = 2;
|
||||
P_NOWAITO = 4;
|
||||
P_SPAWN_IN_CURRENT_DOMAIN = 8;
|
||||
|
||||
|
||||
//function spawnlp(mode:longint; path:Pchar; arg0:Pchar; args:array of const):longint;cdecl;external CLib name 'spawnlp';
|
||||
function spawnlp(mode:longint; path:Pchar; arg0:Pchar):longint;cdecl;external Clib name 'spawnlp';
|
||||
function spawnvp(mode:longint; path:Pchar; argv:PPchar):longint;cdecl;external Clib name 'spawnvp';
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2003-03-25 18:17:54 armin
|
||||
Revision 1.10 2004-08-01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
* getenv ('PATH') is now supported
|
||||
* changed FExpand to global version
|
||||
* fixed heaplist growth error
|
||||
* support SysOSFree
|
||||
* stackcheck was without saveregisters
|
||||
* fpc can compile itself on netware
|
||||
|
||||
Revision 1.9 2003/03/25 18:17:54 armin
|
||||
* support for fcl, support for linking without debug info
|
||||
* renamed winsock2 to winsock for win32 compatinility
|
||||
* new sockets unit for netware
|
||||
@ -358,3 +395,4 @@ PROCEDURE _Signal (Sig : longint; SigFunc : pointer); CDECL; EXTERNAL Clib NAME
|
||||
* Additional routines needed for MT
|
||||
|
||||
}
|
||||
|
||||
|
||||
@ -18,6 +18,8 @@ unit system;
|
||||
interface
|
||||
|
||||
{$define StdErrToConsole}
|
||||
{$define useLongNamespaceByDefault}
|
||||
{$define autoHeapRelease}
|
||||
|
||||
{$ifdef SYSTEMDEBUG}
|
||||
{$define SYSTEMEXCEPTIONDEBUG}
|
||||
@ -36,8 +38,8 @@ type THandle = DWord;
|
||||
{Platform specific information}
|
||||
const
|
||||
LineEnding = #13#10;
|
||||
LFNSupport = false; { ??? - that's how it was declared in dos.pp! }
|
||||
DirectorySeparator = '\';
|
||||
LFNSupport : boolean = false;
|
||||
DirectorySeparator = '/';
|
||||
DriveSeparator = ':';
|
||||
PathSeparator = ';';
|
||||
{ FileNameCaseSensitive is defined separately below!!! }
|
||||
@ -96,15 +98,6 @@ implementation
|
||||
{$I nwsys.inc}
|
||||
{$I errno.inc}
|
||||
|
||||
{procedure setup_arguments;
|
||||
begin
|
||||
end;
|
||||
}
|
||||
|
||||
{procedure setup_environment;
|
||||
begin
|
||||
end;
|
||||
}
|
||||
|
||||
var
|
||||
CloseAllRemainingSemaphores : TSysCloseAllRemainingSemaphores = nil;
|
||||
@ -153,7 +146,9 @@ END;
|
||||
System Dependent Exit code
|
||||
*****************************************************************************}
|
||||
|
||||
{$ifdef autoHeapRelease}
|
||||
procedure FreeSbrkMem; forward;
|
||||
{$endif}
|
||||
|
||||
var SigTermHandlerActive : boolean;
|
||||
|
||||
@ -162,7 +157,9 @@ begin
|
||||
if assigned (CloseAllRemainingSemaphores) then CloseAllRemainingSemaphores;
|
||||
if assigned (ReleaseThreadVars) then ReleaseThreadVars;
|
||||
|
||||
{$ifdef autoHeapRelease}
|
||||
FreeSbrkMem; { free memory allocated by heapmanager }
|
||||
{$endif}
|
||||
|
||||
if not SigTermHandlerActive then
|
||||
begin
|
||||
@ -176,17 +173,21 @@ end;
|
||||
{*****************************************************************************
|
||||
Stack check code
|
||||
*****************************************************************************}
|
||||
procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
|
||||
|
||||
const StackErr : boolean = false;
|
||||
|
||||
procedure int_stackcheck(stack_size:Cardinal);[saveregisters,public,alias:'FPC_STACKCHECK'];
|
||||
{
|
||||
called when trying to get local stack if the compiler directive $S
|
||||
is set this function must preserve esi !!!! because esi is set by
|
||||
the calling proc for methods it must preserve all registers !!
|
||||
is set this function must preserve all registers
|
||||
|
||||
With a 2048 byte safe area used to write to StdIo without crossing
|
||||
the stack boundary
|
||||
}
|
||||
begin
|
||||
IF _stackavail > stack_size + 2048 THEN EXIT;
|
||||
if StackErr then exit; // avoid recursive calls
|
||||
if _stackavail > stack_size + 2048 THEN EXIT;
|
||||
StackErr := true;
|
||||
HandleError (202);
|
||||
end;
|
||||
{*****************************************************************************
|
||||
@ -203,8 +204,14 @@ end;
|
||||
function paramstr(l : longint) : string;
|
||||
begin
|
||||
if (l>=0) and (l+1<=argc) then
|
||||
paramstr:=strpas(argv[l])
|
||||
else
|
||||
begin
|
||||
paramstr:=strpas(argv[l]);
|
||||
if l = 0 then // fix nlm path
|
||||
begin
|
||||
for l := 1 to length (paramstr) do
|
||||
if paramstr[l] = '\' then paramstr[l] := '/';
|
||||
end;
|
||||
end else
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
@ -236,6 +243,8 @@ asm
|
||||
movl intern_HEAPSIZE,%eax
|
||||
end ['EAX'];
|
||||
|
||||
{$ifdef autoHeapRelease}
|
||||
|
||||
const HeapInitialMaxBlocks = 32;
|
||||
type THeapSbrkBlockList = array [1.. HeapInitialMaxBlocks] of pointer;
|
||||
var HeapSbrkBlockList : ^THeapSbrkBlockList = nil;
|
||||
@ -273,13 +282,14 @@ begin
|
||||
end;
|
||||
if (HeapSbrkLastUsed = HeapSbrkAllocated) then
|
||||
begin { grow }
|
||||
p2 := _realloc (HeapSbrkBlockList, HeapSbrkAllocated + HeapInitialMaxBlocks);
|
||||
if p2 = nil then
|
||||
p2 := _realloc (HeapSbrkBlockList, (HeapSbrkAllocated + HeapInitialMaxBlocks) * sizeof(pointer));
|
||||
if p2 = nil then // should we better terminate with error ?
|
||||
begin
|
||||
_free (Sbrk);
|
||||
Sbrk := nil;
|
||||
exit;
|
||||
end;
|
||||
HeapSbrkBlockList := p2;
|
||||
inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
|
||||
end;
|
||||
inc (HeapSbrkLastUsed);
|
||||
@ -304,7 +314,7 @@ begin
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
OS Memory allocation / deallocation
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
@ -329,6 +339,22 @@ begin
|
||||
HandleError (204); // invalid pointer operation
|
||||
end;
|
||||
|
||||
{$else autoHeapRelease}
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
begin
|
||||
_free (p);
|
||||
end;
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
begin
|
||||
SysOSAlloc := _malloc (size);
|
||||
end;
|
||||
|
||||
{$endif autoHeapRelease}
|
||||
|
||||
{ include standard heap management }
|
||||
{$I heap.inc}
|
||||
|
||||
@ -574,7 +600,7 @@ Begin
|
||||
end;
|
||||
{ real open call }
|
||||
FileRec(f).Handle := _open(p,oflags,438);
|
||||
//WriteLn ('_open (',p,') liefert ',ErrNo, 'Handle: ',FileRec(f).Handle);
|
||||
//WriteLn ('_open (',p,') returned ',ErrNo, 'Handle: ',FileRec(f).Handle);
|
||||
// errno does not seem to be set on succsess ??
|
||||
IF FileRec(f).Handle < 0 THEN
|
||||
if (ErrNo=Sys_EROFS) and ((OFlags and O_RDWR)<>0) then
|
||||
@ -661,16 +687,25 @@ begin
|
||||
end;
|
||||
|
||||
procedure getdir(drivenr : byte;var dir : shortstring);
|
||||
VAR P : ARRAY [0..255] OF CHAR;
|
||||
Len: LONGINT;
|
||||
VAR P : ARRAY [0..255] OF CHAR;
|
||||
i : LONGINT;
|
||||
begin
|
||||
P[0] := #0;
|
||||
_getcwd (@P, SIZEOF (P));
|
||||
Len := _strlen (P);
|
||||
IF Len > 0 THEN
|
||||
BEGIN
|
||||
Move (P, dir[1], Len);
|
||||
BYTE(dir[0]) := Len;
|
||||
i := _strlen (P);
|
||||
if i > 0 then
|
||||
begin
|
||||
Move (P, dir[1], i);
|
||||
BYTE(dir[0]) := i;
|
||||
For i := 1 to length (dir) do
|
||||
if dir[i] = '\' then dir [i] := '/';
|
||||
// fix / after volume, the compiler needs that
|
||||
// normaly root of a volumes is SERVERNAME/SYS:, change that
|
||||
// to SERVERNAME/SYS:/
|
||||
i := pos (':',dir);
|
||||
if (i > 0) then
|
||||
if i = Length (dir) then dir := dir + '/' else
|
||||
if dir [i+1] <> '/' then insert ('/',dir,i+1);
|
||||
END ELSE
|
||||
InOutRes := 1;
|
||||
end;
|
||||
@ -818,6 +853,19 @@ Begin
|
||||
|
||||
_Signal (_SIGTERM, @TermSigHandler);
|
||||
|
||||
{$ifdef useLongNamespaceByDefault}
|
||||
if _getenv ('FPC_DISABLE_LONG_NAMESPACE') = nil then
|
||||
begin
|
||||
if _SetCurrentNameSpace (NW_NS_LONG) <> 255 then
|
||||
begin
|
||||
if _SetTargetNamespace (NW_NS_LONG) <> 255 then
|
||||
LFNSupport := true
|
||||
else
|
||||
_SetCurrentNameSpace (NW_NS_DOS);
|
||||
end;
|
||||
end;
|
||||
{$endif useLongNamespaceByDefault}
|
||||
|
||||
{ Setup heap }
|
||||
InitHeap;
|
||||
SysInitExceptions;
|
||||
@ -841,7 +889,18 @@ Begin
|
||||
End.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 2004-07-30 15:05:25 armin
|
||||
Revision 1.24 2004-08-01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
* getenv ('PATH') is now supported
|
||||
* changed FExpand to global version
|
||||
* fixed heaplist growth error
|
||||
* support SysOSFree
|
||||
* stackcheck was without saveregisters
|
||||
* fpc can compile itself on netware
|
||||
|
||||
Revision 1.23 2004/07/30 15:05:25 armin
|
||||
make netware rtl compilable under 1.9.5
|
||||
|
||||
Revision 1.22 2004/06/17 16:16:14 peter
|
||||
|
||||
@ -147,6 +147,28 @@ begin
|
||||
FileTruncate:=(_chsize(Handle,Size) = 0);
|
||||
end;
|
||||
|
||||
Function FileLock (Handle,FOffset,FLen : Longint) : Longint;
|
||||
begin
|
||||
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);
|
||||
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 : NWStatBufT;
|
||||
@ -542,7 +564,18 @@ end.
|
||||
{
|
||||
|
||||
$Log$
|
||||
Revision 1.15 2004-02-15 21:34:06 hajny
|
||||
Revision 1.16 2004-08-01 20:02:48 armin
|
||||
* changed dir separator from \ to /
|
||||
* long namespace by default
|
||||
* dos.exec implemented
|
||||
* getenv ('PATH') is now supported
|
||||
* changed FExpand to global version
|
||||
* fixed heaplist growth error
|
||||
* support SysOSFree
|
||||
* stackcheck was without saveregisters
|
||||
* fpc can compile itself on netware
|
||||
|
||||
Revision 1.15 2004/02/15 21:34:06 hajny
|
||||
* overloaded ExecuteProcess added, EnvStr param changed to longint
|
||||
|
||||
Revision 1.14 2004/01/20 23:11:20 hajny
|
||||
|
||||
Loading…
Reference in New Issue
Block a user