* 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

rtl/netware/Makefile

@@ -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 \

rtl/netware/Makefile.fpc

@@ -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
 #

rtl/netware/README

@@ -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

rtl/netware/classes.pp

@@ -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

rtl/netware/dos.pp

@@ -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);
-begin
-  ConsolePrintf ('warning: fpc dos.exec not implemented'#13#10,0);
+var c : comstr;
+    i : integer;
+    args : array[0..maxargs] of pchar;
+    arg0 : pathstr;
+    numargs : 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);
+  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,
@@ -252,66 +278,6 @@ VAR Buf                 : ARRAY [0..255] OF CHAR;
 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 (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;
-{$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,
@@ -322,16 +288,13 @@ begin
                                  availableDirSlots,
                                  volumeisRemovable) = 0 THEN
     begin
-      disksize := TotalBlocks * SectorsPerBlock * 512;
+      disksize := int64 (TotalBlocks) * int64 (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,122 +447,33 @@ 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]:='\';
+  GetShortName := false;
+end;
 
-  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;
+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
+  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;
-begin
-  strpcopy(envvar0,envvar);
-  p := _getenv (envvar0);
-  if p = NIL then
-    GetEnv := ''
-  else
-    GetEnv := strpas (p);
+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 := _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
 
 }
+

rtl/netware/nwprot.pp

@@ -3,17 +3,19 @@
   Netware Server Imports for FreePascal, contains definitions for the
   netware server protocol library
 
-  Initial Version 2002/02/23 Armin ([email protected] or [email protected])
+  Initial Version 2003/02/23 Armin ([email protected] or [email protected])
 
   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
 
 }

rtl/netware/nwsys.inc

@@ -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
 
 }
+

rtl/netware/system.pp

@@ -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

rtl/netware/sysutils.pp

@@ -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