فهرست منبع

* initial commit, thanks to Armin Diehl (diehl@nordrhein)

florian 24 سال پیش
والد
کامیت
3143b484c4
6فایلهای تغییر یافته به همراه2436 افزوده شده و 0 حذف شده
  1. 857 0
      rtl/netware/dos.pp
  2. 138 0
      rtl/netware/errno.inc
  3. 125 0
      rtl/netware/nwpre.pp
  4. 253 0
      rtl/netware/nwsys.inc
  5. 557 0
      rtl/netware/system.pp
  6. 506 0
      rtl/netware/sysutils.pp

+ 857 - 0
rtl/netware/dos.pp

@@ -0,0 +1,857 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    Dos unit for BP7 compatible RTL (novell netware)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ 2000/09/03 armin: first version
+  2001/03/08 armin: implemented more functions
+                      OK: Implemented and tested
+                      NI: not implemented
+}
+
+unit dos;
+interface
+
+CONST LFNSupport = FALSE;
+
+Const
+  {Bitmasks for CPU Flags}
+  fcarry     = $0001;
+  fparity    = $0004;
+  fauxiliary = $0010;
+  fzero      = $0040;
+  fsign      = $0080;
+  foverflow  = $0800;
+
+  {Bitmasks for file attribute}
+  readonly  = $01;
+  hidden    = $02;
+  sysfile   = $04;
+  volumeid  = $08;
+  nwexeconly= $08;
+  directory = $10;
+  archive   = $20;
+  sharable  = $80;
+  anyfile   = $3F;
+
+  {File Status}
+  fmclosed = $D7B0;
+  fminput  = $D7B1;
+  fmoutput = $D7B2;
+  fminout  = $D7B3;
+
+
+Type
+{ Needed for LFN Support }
+  ComStr  = String[255];
+  PathStr = String[255];
+  DirStr  = String[255];
+  NameStr = String[255];
+  ExtStr  = String[255];
+
+{
+  filerec.inc contains the definition of the filerec.
+  textrec.inc contains the definition of the textrec.
+  It is in a separate file to make it available in other units without
+  having to use the DOS unit for it.
+}
+{$i filerec.inc}
+{$i textrec.inc}
+
+  DateTime = packed record
+    Year,
+    Month,
+    Day,
+    Hour,
+    Min,
+    Sec   : word;
+  End;
+
+  searchrec = packed record
+     DirP  : POINTER;               { used for opendir }
+     EntryP: POINTER;               { and readdir }
+     Magic : WORD;
+     fill  : array[1..11] of byte;
+     attr  : byte;
+     time  : longint;
+     { reserved : word; not in DJGPP V2 }
+     size  : longint;
+     name  : string[255]; { NW uses only [12] but more can't hurt }
+   end;
+
+  registers = packed record
+    case i : integer of
+     0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
+     1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
+     2 : (eax,  ebx,  ecx,  edx,  ebp,  esi,  edi : longint);
+    end;
+
+
+Var
+  DosError : integer;
+
+
+
+{Info/Date/Time}
+Function  DosVersion: Word;                                  {ok}
+Procedure GetDate(var year, month, mday, wday: word);        {ok}
+Procedure GetTime(var hour, minute, second, sec100: word);   {ok}
+procedure SetDate(year,month,day: word);                     {ok}
+Procedure SetTime(hour,minute,second,sec100: word);          {ok}
+Procedure UnpackTime(p: longint; var t: datetime);           {ok}
+Procedure PackTime(var t: datetime; var p: longint);         {ok}
+
+{Exec}
+Procedure Exec(const path: pathstr; const comline: comstr);  {ni}
+Function  DosExitCode: word;                                 {ni}
+
+{Disk}
+{$ifdef Int64}
+ Function  DiskFree(drive: byte) : int64;                    {ok}
+ Function  DiskSize(drive: byte) : int64;                    {ok}
+{$else}
+ Function  DiskFree(drive: byte) : longint;                  {ok}
+ Function  DiskSize(drive: byte) : longint;                  {ok}
+{$endif}
+
+{FincClose has to be called to avoid memory leaks}
+Procedure FindFirst(const path: pathstr; attr: word;         {ok}
+                    var f: searchRec);
+Procedure FindNext(var f: searchRec);                        {ok}
+Procedure FindClose(Var f: SearchRec);                       {ok}
+
+{File}
+Procedure GetFAttr(var f; var attr: word);                   {ok}
+Procedure GetFTime(var f; var time: longint);                {ok}
+Function  FSearch(path: pathstr; dirlist: string): pathstr;  {untested}
+Function  FExpand(const path: pathstr): pathstr;             {untested}
+Procedure FSplit(path: pathstr; var dir: dirstr; var name:   {untested}
+                 namestr; var ext: extstr);
+
+{Environment}
+Function  EnvCount: longint;                                 {ni}
+Function  EnvStr(index: integer): string;                    {ni}
+Function  GetEnv(envvar: string): string;                    {ok}
+
+{Misc}
+Procedure SetFAttr(var f; attr: word);                       {ni}
+Procedure SetFTime(var f; time: longint);                    {ni}
+Procedure GetCBreak(var breakvalue: boolean);                {ni}
+Procedure SetCBreak(breakvalue: boolean);                    {ni}
+Procedure GetVerify(var verify: boolean);                    {ni}
+Procedure SetVerify(verify: boolean);                        {ni}
+
+{Do Nothing Functions}
+Procedure SwapVectors;                                       {ni}
+Procedure GetIntVec(intno: byte; var vector: pointer);       {ni}
+Procedure SetIntVec(intno: byte; vector: pointer);           {ni}
+Procedure Keep(exitcode: word);                              {ni}
+
+Procedure Intr(intno: byte; var regs: registers);            {ni}
+Procedure MSDos(var regs: registers);                        {ni}
+
+
+implementation
+
+uses
+  strings;
+
+{$ASMMODE ATT}
+{$I nwsys.inc }
+
+{*****************************************************************************
+                        --- Info / Date / Time ---
+******************************************************************************}
+{$PACKRECORDS 4}
+
+
+function dosversion : word;
+VAR F : FILE_SERV_INFO;
+begin
+  IF GetServerInformation(SIZEOF(F),@F) = 0 THEN
+    dosversion := WORD (F.netwareVersion) SHL 8 + F.netwareSubVersion;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+VAR N : NWdateAndTime;
+begin
+  GetFileServerDateAndTime (N);
+  wday:=N.DayOfWeek;
+  year:=1900 + N.Year;
+  month:=N.Month;
+  mday:=N.Day;
+end;
+
+
+procedure setdate(year,month,day : word);
+VAR N : NWdateAndTime;
+begin
+  GetFileServerDateAndTime (N);
+  SetFileServerDateAndTime(year,month,day,N.Hour,N.Minute,N.Second);
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+VAR N : NWdateAndTime;
+begin
+  GetFileServerDateAndTime (N);
+  hour := N.Hour;
+  Minute:= N.Minute;
+  Second := N.Second;
+  sec100 := 0;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+VAR N : NWdateAndTime;
+begin
+  GetFileServerDateAndTime (N);
+  SetFileServerDateAndTime(N.year,N.month,N.day,hour,minute,second);
+end;
+
+
+Procedure packtime(var t : datetime;var p : longint);
+Begin
+  p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
+End;
+
+
+Procedure unpacktime(p : longint;var t : datetime);
+Begin
+  with t do
+   begin
+     sec:=(p and 31) shl 1;
+     min:=(p shr 5) and 63;
+     hour:=(p shr 11) and 31;
+     day:=(p shr 16) and 31;
+     month:=(p shr 21) and 15;
+     year:=(p shr 25)+1980;
+   end;
+End;
+
+
+{******************************************************************************
+                               --- Exec ---
+******************************************************************************}
+
+var
+  lastdosexitcode : word;
+
+procedure exec(const path : pathstr;const comline : comstr);
+begin
+  ConsolePrintf ('warning: fpc dos.exec not implemented'#13#10,0);
+end;
+
+
+function dosexitcode : word;
+begin
+  dosexitcode:=lastdosexitcode;
+end;
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+  breakvalue := true;
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+  verify := true;
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+end;
+
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+function getvolnum (drive : byte) : longint;
+var dir : STRING[255];
+    P,PS: BYTE;
+    V   : LONGINT;
+begin
+  if drive = 0 then
+  begin  // get volume name from current directory (i.e. SERVER-NAME/VOL2:TEST)
+    getdir (0,dir);
+    p := pos (':', dir);
+    if p = 0 then
+    begin
+      getvolnum := -1;
+      exit;
+    end;
+    byte (dir[0]) := p-1;
+    dir[p] := #0;
+    PS := pos ('/', dir);
+    INC (PS);
+    if _GetVolumeNumber (@dir[PS], V) <> 0 then
+      getvolnum := -1
+    else
+      getvolnum := V;
+  end else
+    getvolnum := drive-1;
+end;
+
+{$ifdef Int64}
+
+function diskfree(drive : byte) : int64;
+VAR Buf                 : ARRAY [0..255] OF CHAR;
+    TotalBlocks         : WORD;
+    SectorsPerBlock     : WORD;
+    availableBlocks     : WORD;
+    totalDirectorySlots : WORD;
+    availableDirSlots   : WORD;
+    volumeisRemovable   : WORD;
+    volumeNumber        : LONGINT;
+begin
+  volumeNumber := getvolnum (drive);
+  if volumeNumber >= 0 then
+  begin
+    {i think thats not the right function but for others i need a connection handle}
+    if _GetVolumeInfoWithNumber (volumeNumber,@Buf,
+                                 TotalBlocks,
+                                 SectorsPerBlock,
+                                 availableBlocks,
+                                 totalDirectorySlots,
+                                 availableDirSlots,
+                                 volumeisRemovable) = 0 THEN
+    begin
+      diskfree := int64 (availableBlocks) * int64 (SectorsPerBlock) * 512;
+    end else
+      diskfree := 0;
+  end else
+    diskfree := 0;
+end;
+
+
+function disksize(drive : byte) : int64;
+VAR Buf                 : ARRAY [0..255] OF CHAR;
+    TotalBlocks         : WORD;
+    SectorsPerBlock     : WORD;
+    availableBlocks     : WORD;
+    totalDirectorySlots : WORD;
+    availableDirSlots   : WORD;
+    volumeisRemovable   : WORD;
+    volumeNumber        : LONGINT;
+begin
+  volumeNumber := getvolnum (drive);
+  if volumeNumber >= 0 then
+  begin
+    {i think thats not the right function but for others i need a connection handle}
+    if _GetVolumeInfoWithNumber (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 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
+      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 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 := TotalBlocks * SectorsPerBlock * 512;
+    end else
+      disksize := 0;
+  end else
+    disksize := 0;
+end;
+
+{$endif}
+
+
+{******************************************************************************
+                     --- Findfirst FindNext ---
+******************************************************************************}
+
+
+PROCEDURE find_setfields (VAR f : searchRec);
+BEGIN
+  WITH F DO
+  BEGIN
+    IF Magic = $AD01 THEN
+    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);
+    END ELSE
+    BEGIN
+      FillChar (f,SIZEOF(f),0);
+    END;
+  END;
+END;
+
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+  path0 : array[0..256] of char;
+begin
+  IF path = '' then
+  begin
+    doserror := 18;
+    exit;
+  end;
+  strpcopy(path0,path);
+  PNWDirEnt(f.DirP) := _opendir (path0);
+  IF f.DirP = NIL THEN
+    doserror := 18
+  ELSE
+  BEGIN
+    IF attr <> anyfile THEN
+      _SetReaddirAttribute (PNWDirEnt(f.DirP), attr);
+    F.Magic := $AD01;
+    PNWDirEnt(f.EntryP) := _readdir (PNWDirEnt(f.DirP));
+    IF F.EntryP = NIL THEN
+      doserror := 18
+    ELSE
+      find_setfields (f);
+  END;
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+  IF F.Magic <> $AD01 THEN
+  BEGIN
+    doserror := 18;
+    EXIT;
+  END;
+  doserror:=0;
+  PNWDirEnt(f.EntryP) := _readdir (PNWDirEnt(f.DirP));
+  IF F.EntryP = NIL THEN
+    doserror := 18
+  ELSE
+    find_setfields (f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+  IF F.Magic <> $AD01 THEN
+  BEGIN
+    doserror := 18;
+    EXIT;
+  END;
+  doserror:=0;
+  _closedir (PNWDirEnt(f.DirP));
+  f.Magic := 0;
+  f.DirP := NIL;
+  f.EntryP := NIL;
+end;
+
+
+procedure swapvectors;
+begin
+end;
+
+
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
+
+procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
+var
+   dotpos,p1,i : longint;
+begin
+  { allow slash as backslash }
+  for i:=1 to length(path) do
+   if path[i]='/' then path[i]:='\';
+  { get drive name }
+  p1:=pos(':',path);
+  if p1>0 then
+    begin
+       dir:=path[1]+':';
+       delete(path,1,p1);
+    end
+  else
+    dir:='';
+  { split the path and the name, there are no more path informtions }
+  { if path contains no backslashes                                 }
+  while true do
+    begin
+       p1:=pos('\',path);
+       if p1=0 then
+         break;
+       dir:=dir+copy(path,1,p1);
+       delete(path,1,p1);
+    end;
+  { try to find out a extension }
+  if LFNSupport then
+    begin
+       Ext:='';
+       i:=Length(Path);
+       DotPos:=256;
+       While (i>0) Do
+         Begin
+            If (Path[i]='.') Then
+              begin
+                 DotPos:=i;
+                 break;
+              end;
+            Dec(i);
+         end;
+       Ext:=Copy(Path,DotPos,255);
+       Name:=Copy(Path,1,DotPos - 1);
+    end
+  else
+    begin
+       p1:=pos('.',path);
+       if p1>0 then
+         begin
+            ext:=copy(path,p1,4);
+            delete(path,p1,length(path)-p1+1);
+         end
+       else
+         ext:='';
+       name:=path;
+    end;
+end;
+
+
+function fexpand(const path : pathstr) : pathstr;
+var
+  s,pa : pathstr;
+  i,j  : longint;
+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;
+end;
+
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+  i,p1   : longint;
+  s      : searchrec;
+  newdir : pathstr;
+begin
+{ check if the file specified exists }
+  findfirst(path,anyfile,s);
+  if doserror=0 then
+   begin
+     findclose(s);
+     fsearch:=path;
+     exit;
+   end;
+{ No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+    fsearch:=''
+  else
+    begin
+       { allow slash as backslash }
+       for i:=1 to length(dirlist) do
+         if dirlist[i]='/' then dirlist[i]:='\';
+       repeat
+         p1:=pos(';',dirlist);
+         if p1<>0 then
+          begin
+            newdir:=copy(dirlist,1,p1-1);
+            delete(dirlist,1,p1);
+          end
+         else
+          begin
+            newdir:=dirlist;
+            dirlist:='';
+          end;
+         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+          newdir:=newdir+'\';
+         findfirst(newdir+path,anyfile,s);
+         if doserror=0 then
+          newdir:=newdir+path
+         else
+          newdir:='';
+       until (dirlist='') or (newdir<>'');
+       fsearch:=newdir;
+    end;
+  findclose(s);
+end;
+
+
+{******************************************************************************
+                       --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+VAR StatBuf : NWStatBufT;
+    T       : DateTime;
+    DosDate,
+    DosTime : WORD;
+begin
+  IF _fstat (FileRec (f).Handle, StatBuf) = 0 THEN
+  BEGIN
+    _ConvertTimeToDos (StatBuf.st_mtime, DosDate, DosTime);
+    time := DosTime + (LONGINT (DosDate) SHL 16);
+  END ELSE
+    time := 0;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+  {is there a netware function to do that ?????}
+  ConsolePrintf ('warning: fpc dos.setftime not implemented'#13#10,0);
+end;
+
+
+procedure getfattr(var f;var attr : word);
+VAR StatBuf : NWStatBufT;
+begin
+  IF _fstat (FileRec (f).Handle, StatBuf) = 0 THEN
+  BEGIN
+    attr := word (StatBuf.st_attr);
+  END ELSE
+    attr := 0;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+  {is there a netware function to do that ?????}
+  ConsolePrintf ('warning: fpc dos.setfattr not implemented'#13#10,0);
+end;
+
+
+{******************************************************************************
+                             --- Environment ---
+******************************************************************************}
+
+function envcount : longint;
+begin
+  envcount := 0;  {is there a netware function to do that ?????}
+  ConsolePrintf ('warning: fpc dos.envcount not implemented'#13#10,0);
+end;
+
+
+function envstr(index : integer) : string;
+begin
+  envstr := '';   {is there a netware function to do that ?????}
+  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 }
+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);
+end;
+
+
+{******************************************************************************
+                             --- Not Supported ---
+******************************************************************************}
+
+Procedure keep(exitcode : word);
+Begin
+ { no netware equivalent }
+End;
+
+Procedure getintvec(intno : byte;var vector : pointer);
+Begin
+ { no netware equivalent }
+End;
+
+Procedure setintvec(intno : byte;vector : pointer);
+Begin
+ { no netware equivalent }
+End;
+
+procedure intr(intno : byte;var regs : registers);
+begin
+ { no netware equivalent }
+end;
+
+procedure msdos(var regs : registers);
+begin
+ { no netware equivalent }
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-11 14:14:12  florian
+    * initial commit, thanks to Armin Diehl (diehl@nordrhein)
+
+
+}

+ 138 - 0
rtl/netware/errno.inc

@@ -0,0 +1,138 @@
+  { -------------------------- Base POSIX-mandated constants ---------------  }
+  { no such file or directory                      }
+  const
+     SYS_ENOENT = 1;      // arg list too big
+     SYS_E2BIG = 2;       // arg list too big
+     SYS_ENOEXEC = 3;     // exec format error
+     SYS_EBADF = 4;       // bad file number
+     SYS_ENOMEM = 5;      // not enough memory
+     SYS_EACCES = 6;      // permission denied
+     SYS_EEXIST = 7;      // file exists
+     SYS_EXDEV = 8;       // cross-device link
+     SYS_EINVAL = 9;      // invalid argument
+     SYS_ENFILE = 10;     // file table overflow
+     SYS_EMFILE = 11;     // too many open files
+     SYS_ENOSPC = 12;     // no space left on device
+     SYS_EDOM = 13;       // argument too large
+     SYS_ERANGE = 14;     // result too large
+     SYS_EDEADLK = 15;    // resource deadlock would occur
+  { -------------------------- Miscellaneous NLM Library constants ---------  }
+     SYS_EINUSE    = 16;  // resource(s) in use
+     SYS_ESERVER   = 17;  // server error (memory out, I/O error, etc.)
+     SYS_ENOSERVR  = 18;  // no server (queue server, file server, etc.)
+     SYS_EWRNGKND  = 19;  // wrong kind--an operation is being...
+                          // ...attempted on the wrong kind of object
+     SYS_ETRNREST  = 20;  // transaction restarted
+     SYS_ERESOURCE = 21;  // resources unavailable (maybe permanently)
+     SYS_EBADHNDL  = 22;  // bad non-file handle (screen, semaphore, etc)
+     SYS_ENO_SCRNS = 23;  // screen I/O attempted when no screens
+  { -------------------------- Additional POSIX / traditional UNIX constants  }
+     SYS_EAGAIN    = 24;  // resource temporarily unavailable
+     SYS_ENXIO     = 25;  // no such device or address
+     SYS_EBADMSG   = 26;  // not a data message
+     SYS_EFAULT    = 27;  // bad address
+     SYS_EIO       = 28;  // physical I/O error
+     SYS_ENODATA   = 29;  // no data
+     SYS_ENOSTRMS  = 30;  // streams not available
+  { Berkeley sockets constants ------------------  }
+     SYS_EPROTO    = 31;  // fatal protocol error
+     SYS_EPIPE     = 32;  // broken pipe
+     SYS_ESPIPE    = 33;  // illegal seek
+  { Non-blocking and interrupt I/O constants ----  }
+     SYS_ETIME     = 34;  // ioctl acknowledge timeout
+  { operation would block                          }
+     SYS_EWOULDBLOCK=35;  // operation would block
+     SYS_EINPROGRESS=36;  // operation now in progress
+     SYS_EALREADY  = 37;  // operation already in progress
+  { IPC network argument constants --------------  }
+     SYS_ENOTSOCK  = 38;  // socket operation on non-socket
+     SYS_EDESTADDRREQ=39; // destination address required
+     SYS_EMSGSIZE  = 40;  // message too long
+     SYS_EPROTOTYPE= 41;  // protocol wrong type for socket
+     SYS_ENOPROTOOPT=42;  // protocol not available
+     SYS_EPROTONOSUPPORT = 43;  // protocol not supported
+     SYS_ESOCKTNOSUPPORT = 44;  // socket type not supported
+     SYS_EOPNOTSUPP      = 45;  // operation not supported on socket
+     SYS_EPFNOSUPPORT    = 46;  // protocol family not supported
+     SYS_EAFNOSUPPORT    = 47;  // address family unsupported by protocol family
+     SYS_EADDRINUSE      = 48;  // address already in use
+     SYS_EADDRNOTAVAIL   = 49;  // can't assign requested address
+  { Operational constants -----------------------  }
+     SYS_ENETDOWN        = 50;  // Network is down
+  { network is unreachable                         }
+     SYS_ENETUNREACH = 51;
+  { network dropped connection on reset            }
+     SYS_ENETRESET = 52;
+  { software caused connection abort               }
+     SYS_ECONNABORTED = 53;
+  { connection reset by peer                       }
+     SYS_ECONNRESET = 54;
+  { no buffer space available                      }
+     SYS_ENOBUFS = 55;
+  { socket is already connected                    }
+     SYS_EISCONN = 56;
+  { socket is not connected                        }
+     SYS_ENOTCONN = 57;
+  { can't send after socket shutdown               }
+     SYS_ESHUTDOWN = 58;
+  { too many references: can't splice              }
+     SYS_ETOOMANYREFS = 59;
+  { connection timed out                           }
+     SYS_ETIMEDOUT = 60;
+  { connection refused                             }
+     SYS_ECONNREFUSED = 61;
+  { -------------------------- Additional POSIX-mandated constants ---------  }
+  { resource busy                                  }
+     SYS_EBUSY = 62;
+  { interrupted function call                      }
+     SYS_EINTR = 63;
+  { is a directory                                 }
+     SYS_EISDIR = 64;
+  { filename too long                              }
+     SYS_ENAMETOOLONG = 65;
+  { function not implemented                       }
+     SYS_ENOSYS = 66;
+  { not a directory                                }
+     SYS_ENOTDIR = 67;
+  { directory not empty                            }
+     SYS_ENOTEMPTY = 68;
+  { operation not permitted                        }
+     SYS_EPERM = 69;
+  { no child process                               }
+     SYS_ECHILD = 70;
+  { file too large                                 }
+     SYS_EFBIG = 71;
+  { too many links                                 }
+     SYS_EMLINK = 72;
+     SYS_ELOOP  = SYS_EMLINK;
+  { no such device                                 }
+     SYS_ENODEV = 73;
+  { no locks available                             }
+     SYS_ENOLCK = 74;
+  { inappropriate I/O control operation            }
+     SYS_ENOTTY = 75;
+  { inappropriate operation for file type      }
+     SYS_EFTYPE = SYS_ENOTTY;
+  { read-only file system                          }
+     SYS_EROFS = 76;
+  { no such process                                }
+     SYS_ESRCH = 77;
+  { operation was cancelled                        }
+     SYS_ECANCELED = 78;
+  { this optional functionality not supported      }
+     SYS_ENOTSUP = 79;
+  { -------------------------- CLib-implementation-specific constants ------  }
+     SYS_ECANCELLED = SYS_ECANCELED;
+  { anomaly in NLM data structure                  }
+     SYS_ENLMDATA = 100;
+  { illegal character sequence in multibyte        }
+     SYS_EILSEQ = 101;
+  { internal library inconsistency                 }
+     SYS_EINCONSIS = 102;
+  { DOS-text file inconsistency--no newline...     }
+     SYS_EDOSTEXTEOL = 103;
+  { ...after carriage return                       }
+  { object doesn't exist                           }
+     SYS_ENONEXTANT = 104;
+     SYS_ENOCONTEXT = 105;        // no thread library context present
+     SYS_ELASTERR = SYS_ENOCONTEXT;

+ 125 - 0
rtl/netware/nwpre.pp

@@ -0,0 +1,125 @@
+unit nwpre;
+
+interface
+
+// AD 02.09.2000: Dont know why its not working with kNLMInfo...
+//                It always abends in TerminateNLM, so i am using the old style
+{$DEFINE OldPrelude}
+
+FUNCTION _Prelude (NLMHandle               : LONGINT;
+                   initErrorScreenID       : LONGINT;
+                   cmdLineP                : PCHAR;
+                   loadDirectoryPath       : PCHAR;
+                   uninitializedDataLength : LONGINT;
+                   NLMFileHandle           : LONGINT;
+                   readRoutineP            : POINTER;
+                   customDataOffset        : LONGINT;
+                   customDataSize          : LONGINT) : LONGINT; CDECL;
+
+
+implementation
+
+
+FUNCTION _TerminateNLM (NLMInformation : POINTER; threadID, status : LONGINT) : LONGINT; CDECL; EXTERNAL;
+FUNCTION _SetupArgV_411 (MainProc : POINTER) : LONGINT; CDECL; EXTERNAL;
+FUNCTION _StartNLM (NLMHandle               : LONGINT;
+                    initErrorScreenID       : LONGINT;
+                    cmdLineP                : PCHAR;
+                    loadDirectoryPath       : PCHAR;
+                    uninitializedDataLength : LONGINT;
+                    NLMFileHandle           : LONGINT;
+                    readRoutineP            : POINTER;
+                    customDataOffset        : LONGINT;
+                    customDataSize          : LONGINT;
+                    NLMInformation          : POINTER;
+                    userStartFunc           : POINTER) : LONGINT; CDECL; EXTERNAL;
+//PROCEDURE _exit (x : LONGINT); CDECL; EXTERNAL;		    
+
+
+(*****************************************************************************)
+
+CONST TRADINIONAL_NLM_INFO_SIGNATURE = 0;
+      TRADINIONAL_FLAVOR             = 0;
+      TRADINIONAL_VERSION            = 0;
+      LIBERTY_VERSION                = 1;
+      TERMINATE_BY_EXTERNAL_THREAD   = 0;
+      TERMINATE_BY_UNLOAD            = 5;
+
+
+{$IFDEF OldPrelude}
+CONST NLMID : LONGINT = 0;
+{$ELSE}
+TYPE 
+  kNLMInfoT =
+  PACKED RECORD
+    Signature      : ARRAY [0..3] OF CHAR;  // LONG
+    Flavor         : LONGINT;
+    Version        : LONGINT;
+    LongDoubleSize : LONGINT;
+    wchar_tSize    : LONGINT;
+  END;
+
+CONST NLM_INFO_SIGNATURE             = 'NLMI';  // $494d3c3e;  // NLMI
+
+      kNLMInfo : kNLMInfoT =
+       (Signature      : NLM_INFO_SIGNATURE;
+        Flavor         : TRADINIONAL_FLAVOR;    // 0
+        Version        : LIBERTY_VERSION;       // 1
+        LongDoubleSize : 8; 
+        wchar_tSize    : 2);
+{$ENDIF}
+
+(*****************************************************************************)
+
+FUNCTION _nlm_main (Argc : LONGINT; ArgV : ARRAY OF PCHAR) : LONGINT; CDECL;
+EXTERNAL;
+
+
+FUNCTION _Stop : LONGINT; CDECL;
+BEGIN
+  {$IFDEF OldPrelude}
+  _Stop := _TerminateNLM (POINTER(NLMID),0,TERMINATE_BY_UNLOAD);
+  {$ELSE}
+  _Stop := _TerminateNLM (@kNLMInfo,0,TERMINATE_BY_UNLOAD);
+  {$ENDIF}
+END;
+
+
+FUNCTION _cstart_ : LONGINT; CDECL;
+BEGIN
+  _cstart_ := _SetupArgV_411 (@_nlm_main);
+END;
+
+
+FUNCTION _Prelude (NLMHandle               : LONGINT;
+                   initErrorScreenID       : LONGINT;
+                   cmdLineP                : PCHAR;
+                   loadDirectoryPath       : PCHAR;
+                   uninitializedDataLength : LONGINT;
+                   NLMFileHandle           : LONGINT;
+                   readRoutineP            : POINTER;
+                   customDataOffset        : LONGINT;
+                   customDataSize          : LONGINT) : LONGINT; CDECL;
+BEGIN
+  _Prelude := _StartNLM
+            (NLMHandle,
+             initErrorScreenID,
+             cmdLineP,
+             loadDirectoryPath,
+             uninitializedDataLength,
+             NLMFileHandle,
+             readRoutineP,
+             customDataOffset,
+             customDataSize,
+	     {$IFDEF OldPrelude}
+	     @NLMID,
+	     {$ELSE}
+             @kNLMInfo,
+	     {$ENDIF}
+             @_cstart_);
+END;
+
+
+
+
+end.

+ 253 - 0
rtl/netware/nwsys.inc

@@ -0,0 +1,253 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Interface to netware clib
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ 2000/08/27 armin: first version
+  2001/03/08 armin: additional functions
+}
+
+CONST Clib   = 'clib.nlm';
+      NlmLib = 'nlmlib.nlm';
+      Threads= 'threads.nlm';
+      CalNlm = 'calnlm32.nlm';
+      ClxNlm = 'clxnlm32.nlm';
+      NitNlm = 'nit.nlm';
+
+TYPE
+  dev_t         = LONGINT;
+  ino_t         = LONGINT;
+  unsignedshort = WORD;
+  unsignedlong  = LONGINT;
+  unsignedint   = LONGINT;
+  off_t         = LONGINT;
+  size_t        = LONGINT;
+  time_t        = LONGINT;
+  NWStatBufT = PACKED RECORD
+   st_dev        : dev_t;         (* volume number *)
+   st_ino        : ino_t;         (* directory entry number of the st_name *)
+   st_mode       : unsignedshort; (* emulated file mode *)
+   st_nlink      : unsignedshort; (* count of hard links (always 1) *)
+   st_uid        : unsignedlong;  (* object id of owner *)
+   st_gid        : unsignedshort; (* group-id (always 0) *)
+   st_rdev       : dev_t;         (* device type (always 0) *)
+   st_size       : off_t;         (* total file size--files only *)
+   st_atime      : time_t;        (* last access date--files only *)
+   st_mtime      : time_t;        (* last modify date and time *)
+   st_ctime      : time_t;        (* POSIX: last status change time... *)
+                                  (* ...NetWare: creation date/time *)
+   st_btime      : time_t;        (* last archived date and time *)
+   st_attr       : unsignedlong;  (* file attributes *)
+   st_archivedID : unsignedlong;  (* user/object ID of last archive *)
+   st_updatedID  : unsignedlong;  (* user/object ID of last update *)
+   st_inheritedRightsMask
+                 : unsignedshort; (* inherited rights mask *)
+   st_originatingNameSpace
+                 : BYTE;          (* namespace of creation       *)
+   st_name       : ARRAY [0..255] OF CHAR;
+                                  (* TARGET_NAMESPACE name *)
+   st_blksize    : LONGINT;
+   st_blocks     : LONGINT;
+   st_flags      : LONGINT;
+   st_spare      : ARRAY [0..3] OF LONGINT;
+  END;
+
+FUNCTION  _stat  (path : PCHAR; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'stat_411';
+FUNCTION  _fstat (Fileno : LONGINT; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'fstat_411';
+
+PROCEDURE NWFree   (P : POINTER); CDECL; EXTERNAL Clib NAME 'free';
+
+PROCEDURE PressAnyKeyToContinue; CDecl; EXTERNAL 'CLib.NLM';
+PROCEDURE ExitThread (action_code, termination_code : LONGINT); CDecl; EXTERNAL 'CLib.NLM';
+PROCEDURE _exit (ExitCode : LONGINT); CDecl; EXTERNAL 'CLib.NLM';
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL ('CLib.NLM');
+PROCEDURE printf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL ('CLib.NLM');
+//PROCEDURE printf (FormatStr : PCHAR; Param : PCHAR); CDecl; EXTERNAL ('CLib.NLM');
+PROCEDURE ConsolePrintf3 (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl; EXTERNAL ('CLib.NLM') NAME 'ConsolePrintf';
+//FUNCTION  strlen(lpString: PChar): LONGINT; CDECL; EXTERNAL Clib;
+
+// values for __action_code used with ExitThread()
+CONST
+  TSR_THREAD  = -1;
+  EXIT_THREAD = 0;
+  EXIT_NLM    = 1;
+
+FUNCTION _GetStdIn  : POINTER; CDECL; EXTERNAL Clib NAME '__get_stdin';  // result: **FILE
+FUNCTION _GetStdOut : POINTER; CDECL; EXTERNAL Clib NAME '__get_stdout';
+FUNCTION _GetStdErr : POINTER; CDECL; EXTERNAL Clib NAME '__get_stderr';
+
+// Stream FileIO
+//FUNCTION _fopen (filename, mode : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'fopen';
+//FUNCTION _fclose (hFile : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fclose';
+//FUNCTION _fwrite (Buffer : POINTER; S1,S2,hFile : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fwrite';
+//FUNCTION _fread  (Buffer : POINTER; S1,S2,hFile : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fread';
+//FUNCTION _fseek  (hFile, Offset, Where : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fseek';
+//FUNCTION _ftell  (hFile : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'ftell';
+
+
+// FileIO by Fileno
+FUNCTION _open   (FileName : PCHAR; access, mode : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'open';
+FUNCTION _close  (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'close';
+FUNCTION _lseek  (FileNo,Pos,whence :LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'lseek';
+FUNCTION _chsize (FileNo,Pos : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'chsize';
+FUNCTION _tell   (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'tell';
+FUNCTION _write  (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'write';
+FUNCTION _read   (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'read';
+FUNCTION _filelength (filedes : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'filelength';
+
+// Directory
+FUNCTION _chdir  (path : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'chdir';
+FUNCTION _getcwd (path : PCHAR; pathlen : LONGINT) : PCHAR; CDECL; EXTERNAL NlmLib NAME 'getcwd';
+FUNCTION _mkdir  (path : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'mkdir';
+FUNCTION _rmdir  (path : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'rmdir';
+
+// get fileno from stream
+FUNCTION _fileno (Handle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fileno';
+FUNCTION _isatty (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'isatty';
+
+(* values for 'o_flag' in open()... *)
+CONST O_RDONLY     = $0000;   (* open for read only *)
+      O_WRONLY     = $0001;   (* open for write only *)
+      O_RDWR       = $0002;   (* open for read and write *)
+      O_ACCMODE    = $0003;   (* AND with value to extract access flags *)
+      O_APPEND     = $0010;   (* writes done at end of file *)
+      O_CREAT      = $0020;   (* create new file *)
+      O_TRUNC      = $0040;   (* truncate existing file *)
+      O_EXCL       = $0080;   (* exclusive open *)
+      O_TEXT       = $0100;   (* text file--unsupported *)
+      O_BINARY     = $0200;   (* binary file *)
+      O_NDELAY     = $0400;   (* nonblocking flag *)
+      O_NOCTTY     = $0800;   (* currently unsupported *)
+      O_NONBLOCK   = O_NDELAY;
+
+
+// File Utils
+FUNCTION _unlink (FileName : PCHAR) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'unlink';
+FUNCTION _rename (oldpath, newpath : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'rename';
+
+// Error
+TYPE _PLONGINT = ^LONGINT;
+FUNCTION __get_errno_ptr : _PLONGINT; CDECL; EXTERNAL Clib;
+
+// Memory
+FUNCTION _malloc (size : LONGINT) : POINTER; CDECL; EXTERNAL Threads NAME 'malloc';
+PROCEDURE _free (what : POINTER); CDECL; EXTERNAL Threads NAME 'free';
+FUNCTION _stackavail : LONGINT; CDECL; EXTERNAL Threads NAME 'stackavail';
+
+// Debug
+PROCEDURE _EnterDebugger; CDECL; EXTERNAL Clib NAME 'EnterDebugger';
+
+// String
+FUNCTION _strlen (P : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'strlen';
+
+// Time/Date
+TYPE NWTM = RECORD
+              tm_sec, tm_min, tm_hour,
+              tm_mday, tm_mon, tm_year,
+              tm_wday, tm_yday, tm_isdst : LONGINT;
+            END;
+     PNWTM = ^NWTM;
+FUNCTION _localtime (VAR time : time_t) : PNWTM; CDECL; EXTERNAL Clib NAME 'localtime';
+FUNCTION _time (tloc : POINTER) : LONGINT; CDECL; EXTERNAL Clib NAME 'time';
+PROCEDURE _ConvertTimeToDOS (time : time_t; VAR DosDate, DosTime : WORD); CDECL; EXTERNAL Clib NAME '_ConvertTimeToDOS';
+PROCEDURE _tzset; CDECL; EXTERNAL Clib NAME 'tzset';
+
+
+//-----------------------------------------------------------------------
+
+CONST NWDEFCONN_HANDLE = 0;
+
+TYPE NWCONN_HANDLE = LONGINT;
+     NWRCODE = LONGINT;
+     NWDateAndTime = PACKED RECORD
+                       Year,Month,Day,
+                       Hour,Minute,Second,DayOfWeek : BYTE;
+                     END;
+
+PROCEDURE GetFileServerDateAndTime (VAR TimeBuf : NWDateAndTime); CDECL; EXTERNAL NitNlm NAME 'GetFileServerDateAndTime';
+FUNCTION  SetFileServerDateAndTime(year:WORD; month:WORD; day:WORD; hour:WORD; minute:WORD;
+               second:WORD):longint;cdecl; EXTERNAL NitNlm Name 'SetFileServerDateAndTime';
+
+TYPE   FILE_SERV_INFO = record
+            serverName              : array[0..47] of char;
+            netwareVersion          : BYTE;
+            netwareSubVersion       : BYTE;
+            maxConnectionsSupported : WORD;
+            connectionsInUse        : WORD;
+            maxVolumesSupported     : WORD;
+            revisionLevel           : BYTE;
+            SFTLevel                : BYTE;
+            TTSLevel                : BYTE;
+            peakConnectionsUsed     : WORD;
+            accountingVersion       : BYTE;
+            VAPversion              : BYTE;
+            queingVersion           : BYTE;
+            printServerVersion      : BYTE;
+            virtualConsoleVersion   : BYTE;
+            securityRestrictionLevel: BYTE;
+            internetBridgeSupport   : BYTE;
+            reserved                : array[0..59] of BYTE;
+            CLibMajorVersion        : BYTE;
+            CLibMinorVersion        : BYTE;
+            CLibRevision            : BYTE;
+         end;
+   pFILE_SERV_INFO = ^FILE_SERV_INFO;
+
+FUNCTION GetServerInformation(returnSize:longint; serverInfo:pFILE_SERV_INFO):longint;cdecl; EXTERNAL NitNlm NAME 'GetServerInformation';
+
+// Directory
+TYPE NWDirEnt =
+  PACKED RECORD
+    d_attr      : LONGINT;
+    d_time      : WORD;
+    d_date      : WORD;
+    d_size      : LONGINT;
+    d_ino       : LONGINT;
+    d_dev       : LONGINT;
+    d_cdatetime : LONGINT;
+    d_adatetime : LONGINT;
+    d_bdatetime : LONGINT;
+    d_uid       : LONGINT;
+    d_archivedID: LONGINT;
+    d_updatedID : LONGINT;
+    d_nameDOS   : ARRAY [0..12] OF CHAR;
+    d_inheritedRightsMask : WORD;
+    d_originatingNameSpace: BYTE;
+    d_ddatetime           : LONGINT;
+    d_deletedID           : LONGINT;
+    {---- new fields starting in v4.11 ----}
+    d_name                : ARRAY [0..255] OF CHAR;  { enty's namespace name }
+  END;
+  PNWDirEnt = ^NWDirEnt;
+
+  FUNCTION _opendir (pathname : PCHAR) : PNWDirEnt; CDECL; EXTERNAL NlmLib NAME 'opendir_411';
+  FUNCTION _closedir (dirH : PNWDirEnt) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'closedir';
+  FUNCTION _readdir  (dirH : PNWDirEnt) : PNWDirEnt; CDECL; EXTERNAL NlmLib NAME 'readdir';
+  FUNCTION _SetReaddirAttribute (dirH : PNWDirEnt; Attribute : LONGINT) : LONGINT; EXTERNAL NlmLib NAME 'SetReaddirAttribute';
+
+// Environment
+  FUNCTION _getenv (name : PCHAR) : PCHAR; CDECL; EXTERNAL NlmLib NAME 'getenv';
+
+// Volumes
+  FUNCTION _GetVolumeName (volumeNumber : LONGINT; volumeName : PCHAR) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeName';
+  FUNCTION _GetVolumeNumber (volumeName : PCHAR; VAR volumeNumber : LONGINT) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeNumber';
+  FUNCTION _GetVolumeInfoWithNumber (VolumeNumber : BYTE;
+                                     VolumeName   : PCHAR;
+                                 VAR TotalBlocks  : WORD;
+                                 VAR SectorsPerBlock : WORD;
+                                 VAR availableBlocks : WORD;
+                                 VAR totalDirectorySlots : WORD;
+                                 VAR availableDirSlots   : WORD;
+                                 VAR volumeisRemovable   : WORD) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeInfoWithNumber';
+  FUNCTION _GetNumberOfVolumes : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetNumberOfVolumes';

+ 557 - 0
rtl/netware/system.pp

@@ -0,0 +1,557 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ no stack check in system }
+{$S-}
+unit system;
+
+{ 2000/09/03 armin: first version
+  2001/03/08 armin: changes for fpc 1.1
+}
+
+interface
+
+{$ifdef SYSTEMDEBUG}
+  {$define SYSTEMEXCEPTIONDEBUG}
+{$endif SYSTEMDEBUG}
+
+{$ifdef i386}
+  {$define Set_i386_Exception_handler}
+{$endif i386}
+
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+{ include heap support headers }
+{Why the hell do i have to define that ???
+ otherwise FPC_FREEMEM expects 2 parameters but the compiler only
+ puhes the address}
+{$DEFINE NEWMM}
+{$I heaph.inc}
+
+CONST
+  { Default filehandles }
+   UnusedHandle    : longint = -1;
+   StdInputHandle  : longint = 0;
+   StdOutputHandle : longint = 0;
+   StdErrorHandle  : longint = 0;
+
+   FileNameCaseSensitive : boolean = false;
+
+   sLineBreak : STRING [2] = #13#10;
+   DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+VAR
+   ArgC   : INTEGER;
+   ArgV   : ppchar;
+
+
+implementation
+
+{ include system independent routines }
+
+{$I system.inc}
+{$I nwsys.inc}
+{$I errno.inc}
+
+procedure setup_arguments;
+begin
+end;
+
+procedure setup_environment;
+begin
+end;
+
+
+
+procedure PascalMain;external name 'PASCALMAIN';
+procedure fpc_do_exit;external name 'FPC_DO_EXIT';
+
+
+{*****************************************************************************
+                         Startup
+*****************************************************************************}
+
+
+PROCEDURE _nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nlm_main'];
+BEGIN
+  ArgC := _ArgC;
+  ArgV := _ArgV;
+  PASCALMAIN;
+END;
+
+
+
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+Procedure system_exit;
+begin
+  _exit (ExitCode);
+end;
+
+{*****************************************************************************
+                         Stack check code
+*****************************************************************************}
+procedure int_stackcheck(stack_size:longint);[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 !!
+
+  With a 2048 byte safe area used to write to StdIo without crossing
+  the stack boundary
+}
+begin
+  IF _stackavail > stack_size + 2048 THEN EXIT;
+  HandleError (202);
+end;
+
+{*****************************************************************************
+                              ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+begin
+  if (l>=0) and (l+1<=argc) then
+   paramstr:=strpas(argv[l])
+  else
+   paramstr:='';
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+begin
+  randseed := _time (NIL);
+end;
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+{ first address of heap }
+function getheapstart:pointer;
+assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+{ current length of heap }
+function getheapsize:longint;
+assembler;
+asm
+        movl    HEAPSIZE,%eax
+end ['EAX'];
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or -1 if fail }
+FUNCTION Sbrk(size : longint):longint;
+VAR P : POINTER;
+BEGIN
+  P := _malloc (size);
+  IF P = NIL THEN
+    Sbrk := -1
+  ELSE
+    Sbrk := LONGINT (P);
+END;
+
+
+{ include standard heap management }
+{$I heap.inc}
+
+
+{****************************************************************************
+                        Low level File Routines
+       All these functions can set InOutRes on errors
+ ****************************************************************************}
+
+
+PROCEDURE NW2PASErr (Err : LONGINT);
+BEGIN
+  if Err = 0 then { Else it will go through all the cases }
+   exit;
+  case Err of
+   Sys_ENFILE,
+   Sys_EMFILE : Inoutres:=4;
+   Sys_ENOENT : Inoutres:=2;
+    Sys_EBADF : Inoutres:=6;
+   Sys_ENOMEM,
+   Sys_EFAULT : Inoutres:=217;
+   Sys_EINVAL : Inoutres:=218;
+    Sys_EPIPE,
+    Sys_EINTR,
+      Sys_EIO,
+   Sys_EAGAIN,
+   Sys_ENOSPC : Inoutres:=101;
+ Sys_ENAMETOOLONG,
+    Sys_ELOOP,
+  Sys_ENOTDIR : Inoutres:=3;
+    Sys_EROFS,
+   Sys_EEXIST,
+   Sys_EACCES : Inoutres:=5;
+  Sys_EBUSY   : Inoutres:=162;
+  end;
+END;
+
+FUNCTION errno : LONGINT;
+BEGIN
+  errno := __get_errno_ptr^;
+END;
+
+PROCEDURE Errno2Inoutres;
+BEGIN
+  NW2PASErr (errno);
+END;
+
+PROCEDURE SetFileError (VAR Err : LONGINT);
+BEGIN
+  IF Err >= 0 THEN
+    InOutRes := 0
+  ELSE
+  BEGIN
+    Err := errno;
+    NW2PASErr (Err);
+    Err := 0;
+  END;
+END;
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+VAR res : LONGINT;
+begin
+  res := _close (handle);
+  IF res <> 0 THEN
+    SetFileError (res)
+  ELSE
+    InOutRes := 0;
+end;
+
+procedure do_erase(p : pchar);
+VAR res : LONGINT;
+begin
+  res := _unlink (p);
+  IF Res < 0 THEN
+    SetFileError (res)
+  ELSE
+    InOutRes := 0;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+VAR res : LONGINT;
+begin
+  res := _rename (p1,p2);
+  IF Res < 0 THEN
+    SetFileError (res)
+  ELSE
+    InOutRes := 0
+end;
+
+function do_write(h,addr,len : longint) : longint;
+VAR res : LONGINT;
+begin
+  res := _write (h,POINTER(addr),len);
+  IF res > 0 THEN
+    InOutRes := 0
+  ELSE
+    SetFileError (res);
+  do_write := res;
+end;
+
+function do_read(h,addr,len : longint) : longint;
+VAR res : LONGINT;
+begin
+  res := _read (h,POINTER(addr),len);
+  IF res > 0 THEN
+    InOutRes := 0
+  ELSE
+    SetFileError (res);
+  do_read := res;
+end;
+
+
+function do_filepos(handle : longint) : longint;
+VAR res : LONGINT;
+begin
+  InOutRes:=1;
+  res := _tell (handle);
+  IF res < 0 THEN
+    SetFileError (res)
+  ELSE
+    InOutRes := 0;
+  do_filepos := res;
+end;
+
+CONST SEEK_SET = 0;	// Seek from beginning of file.
+      SEEK_CUR = 1;	// Seek from current position.
+      SEEK_END = 2;	// Seek from end of file.
+
+
+procedure do_seek(handle,pos : longint);
+VAR res : LONGINT;
+begin
+  res := _lseek (handle,pos, SEEK_SET);
+  IF res >= 0 THEN
+    InOutRes := 0
+  ELSE
+    SetFileError (res);
+end;
+
+function do_seekend(handle:longint):longint;
+VAR res : LONGINT;
+begin
+  res := _lseek (handle,0, SEEK_END);
+  IF res >= 0 THEN
+    InOutRes := 0
+  ELSE
+    SetFileError (res);
+  do_seekend := res;
+end;
+
+
+function do_filesize(handle : longint) : longint;
+VAR res     : LONGINT;
+begin
+  res := _filelength (handle);
+  IF res < 0 THEN
+  BEGIN
+    SetFileError (Res);
+    do_filesize := -1;
+  END ELSE
+  BEGIN
+    InOutRes := 0;
+    do_filesize := res;
+  END;
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+VAR res : LONGINT;
+begin
+  res := _chsize (handle,pos);
+  IF res <> 0 THEN
+    SetFileError (res)
+  ELSE
+    InOutRes := 0;
+end;
+
+// mostly stolen from syslinux
+procedure do_open(var f;p:pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $10)   the file will be append
+  when (flags and $100)  the file will be truncate/rewritten
+  when (flags and $1000) there is no check for close (needed for textfiles)
+}
+var
+  oflags : longint;
+Begin
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case FileRec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file Handle }
+  FileRec(f).Handle:=UnusedHandle;
+
+{ We do the conversion of filemodes here, concentrated on 1 place }
+  case (flags and 3) of
+   0 : begin
+         oflags := O_RDONLY;
+         filerec(f).mode := fminput;
+       end;
+   1 : begin
+         oflags := O_WRONLY;
+         filerec(f).mode := fmoutput;
+       end;
+   2 : begin
+         oflags := O_RDWR;
+         filerec(f).mode := fminout;
+       end;
+  end;
+  if (flags and $1000)=$1000 then
+   oflags:=oflags or (O_CREAT or O_TRUNC)
+  else
+   if (flags and $100)=$100 then
+    oflags:=oflags or (O_APPEND);
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{ real open call }
+  FileRec(f).Handle := _open(p,oflags,438);
+  //WriteLn ('_open (',p,') liefert ',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
+    begin  // i.e. for cd-rom
+      Oflags:=Oflags and not(O_RDWR);
+      FileRec(f).Handle := _open(p,oflags,438);
+    end;
+  IF FileRec(f).Handle < 0 THEN
+    Errno2Inoutres
+  ELSE
+    InOutRes := 0;
+End;
+
+function do_isdevice(handle:longint):boolean;
+begin
+  do_isdevice := (_isatty (handle) > 0);
+end;
+
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{ should we consider #26 as the  end of a file ? }
+{?? $DEFINE EOF_CTRLZ}
+
+{$i text.inc}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+    Res: LONGINT;
+BEGIN
+  S2 := S;
+  IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+  S2 := S2 + #0;
+  Res := _mkdir (@S2[1]);
+  IF Res = 0 THEN
+    InOutRes:=0
+  ELSE
+    SetFileError (Res);
+END;
+
+procedure rmdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+    Res: LONGINT;
+BEGIN
+  S2 := S;
+  IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+  S2 := S2 + #0;
+  Res := _rmdir (@S2[1]);
+  IF Res = 0 THEN
+    InOutRes:=0
+  ELSE
+    SetFileError (Res);
+end;
+
+procedure chdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+    Res: LONGINT;
+begin
+  S2 := S;
+  IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+  S2 := S2 + #0;
+  Res := _chdir (@S2[1]);
+  IF Res = 0 THEN
+    InOutRes:=0
+  ELSE
+    SetFileError (Res);
+end;
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+VAR P  : ARRAY [0..255] OF CHAR;
+    Len: 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;
+  END ELSE
+    InOutRes := 1;
+end;
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+Begin
+{ Setup heap }
+  InitHeap;
+{ Setup stdin, stdout and stderr }
+  StdInputHandle := _fileno (LONGINT (_GetStdIn^));    // GetStd** returns **FILE !
+  StdOutputHandle:= _fileno (LONGINT (_GetStdOut^));
+  StdErrorHandle := _fileno (LONGINT (_GetStdErr^));
+
+  InitExceptions;
+
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Setup environment and arguments }
+  Setup_Environment;
+  Setup_Arguments;
+{ Reset IO Error }
+  InOutRes:=0;
+End.
+{
+  $Log$
+  Revision 1.1  2001-04-11 14:14:12  florian
+    * initial commit, thanks to Armin Diehl (diehl@nordrhein)
+
+  Revision 1.2  2000/07/13 11:33:56  michael
+  + removed logs
+
+}

+ 506 - 0
rtl/netware/sysutils.pp

@@ -0,0 +1,506 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Sysutils unit for netware
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{currently nothing is implemented !}
+
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses DOS;
+//  Unix,errors;
+
+{$I nwsys.inc}
+{$I errno.inc}
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+
+Var LinuxFlags : longint;
+
+BEGIN
+  {LinuxFlags:=0;
+  Case (Mode and 3) of
+    0 : LinuxFlags:=LinuxFlags or Open_RdOnly;
+    1 : LinuxFlags:=LinuxFlags or Open_WrOnly;
+    2 : LinuxFlags:=LinuxFlags or Open_RdWr;
+  end;
+  FileOpen:=fdOpen (FileName,LinuxFlags);
+  }
+  //!! We need to set locking based on Mode !!
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+
+begin
+  //FileCreate:=fdOpen(FileName,Open_RdWr or Open_Creat or Open_Trunc);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+
+begin
+  //FileRead:=fdRead (Handle,Buffer,Count);
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+
+begin
+  //FileWrite:=fdWrite (Handle,Buffer,Count);
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+
+begin
+  //FileSeek:=fdSeek (Handle,FOffset,Origin);
+end;
+
+
+Procedure FileClose (Handle : Longint);
+
+begin
+  //fdclose(Handle);
+end;
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+
+begin
+  //FileTruncate:=fdtruncate(Handle,Size);
+end;
+
+Function FileAge (Const FileName : String): Longint;
+
+//Var Info : Stat;
+//    Y,M,D,hh,mm,ss : word;
+
+begin
+{  If not fstat (FileName,Info) then
+    exit(-1)
+  else
+    begin
+    EpochToLocal(info.mtime,y,m,d,hh,mm,ss);
+    Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
+    end;}
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+
+//Var Info : Stat;
+
+begin
+  //FileExists:=fstat(filename,Info);
+end;
+
+{
+Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
+
+begin
+  Result:=faArchive;
+  If (Info.Mode and STAT_IFDIR)=STAT_IFDIR then
+    Result:=Result or faDirectory;
+  If (FN[0]='.') and (not (FN[1] in [#0,'.']))  then
+    Result:=Result or faHidden;
+  If (Info.Mode and STAT_IWUSR)=0 Then
+     Result:=Result or faReadOnly;
+  If (Info.Mode and
+      (STAT_IFSOCK or STAT_IFBLK or STAT_IFCHR or STAT_IFIFO))<>0 then
+     Result:=Result or faSysFile;
+end;
+}
+{
+ GlobToSearch takes a glob entry, stats the file.
+ The glob entry is removed.
+ If FileAttributes match, the entry is reused
+}
+
+{Type
+  TGlobSearchRec = Record
+    Path       : String;
+    GlobHandle : PGlob;
+  end;
+  PGlobSearchRec = ^TGlobSearchRec;}
+
+{Function GlobToTSearchRec (Var Info : TSearchRec) : Boolean;
+
+Var SInfo : Stat;
+    p     : Pglob;
+    GlobSearchRec : PGlobSearchrec;
+
+begin
+  GlobSearchRec:=PGlobSearchrec(Info.FindHandle);
+  P:=GlobSearchRec^.GlobHandle;
+  Result:=P<>Nil;
+  If Result then
+    begin
+    GlobSearchRec^.GlobHandle:=P^.Next;
+    Result:=Fstat(GlobSearchRec^.Path+StrPas(p^.name),SInfo);
+    If Result then
+      begin
+      Info.Attr:=LinuxToWinAttr(p^.name,SInfo);
+      Result:=(Info.ExcludeAttr and Info.Attr)=0;
+      If Result Then
+         With Info do
+           begin
+           Attr:=Info.Attr;
+           If P^.Name<>Nil then
+           Name:=strpas(p^.name);
+           Time:=Sinfo.mtime;
+           Size:=Sinfo.Size;
+           end;
+      end;
+    P^.Next:=Nil;
+    GlobFree(P);
+    end;
+end;}
+
+Function DoFind(Var Rslt : TSearchRec) : Longint;
+
+//Var GlobSearchRec : PGlobSearchRec;
+
+begin
+  Result:=-1;
+{  GlobSearchRec:=PGlobSearchRec(Rslt.FindHandle);
+  If (GlobSearchRec^.GlobHandle<>Nil) then
+    While (GlobSearchRec^.GlobHandle<>Nil) and not (Result=0) do
+      If GlobToTSearchRec(Rslt) Then Result:=0;}
+end;
+
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+
+//Var  GlobSearchRec : PGlobSearchRec;
+
+begin
+  {New(GlobSearchRec);
+  GlobSearchRec^.Path:=ExpandFileName(ExtractFilePath(Path));
+  GlobSearchRec^.GlobHandle:=Glob(Path);
+  Rslt.ExcludeAttr:=Not Attr; //!! Not correct !!
+  Rslt.FindHandle:=Longint(GlobSearchRec);
+  Result:=DoFind (Rslt);}
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+
+begin
+//  Result:=DoFind (Rslt);
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+
+//Var GlobSearchRec : PGlobSearchRec;
+
+begin
+  {GlobSearchRec:=PGlobSearchRec(F.FindHandle);
+  GlobFree (GlobSearchRec^.GlobHandle);
+  Dispose(GlobSearchRec);}
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+
+//Var Info : Stat;
+
+begin
+  {If Not(FStat(Handle,Info)) then
+    Result:=-1
+  else
+    Result:=Info.Mtime;}
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+
+begin
+  // Impossible under Linux from FileHandle !!
+  FileSetDate:=-1;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+
+//Var Info : Stat;
+
+begin
+{  If Not FStat (FileName,Info) then
+    Result:=-1
+  Else
+    Result:=LinuxToWinAttr(Pchar(FileName),Info);}
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+
+begin
+  Result:=-1;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+
+begin
+  Result:= (_UnLink (pchar(FileName)) = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+
+begin
+//  RenameFile:=Unix.FRename(OldNAme,NewName);
+end;
+
+
+Function FileSearch (Const Name, DirList : String) : String;
+
+begin
+  FileSearch:=Dos.FSearch(Name,Dirlist);
+end;
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+{
+  The Diskfree and Disksize functions need a file on the specified drive, since this
+  is required for the statfs system call.
+  These filenames are set in drivestr[0..26], and have been preset to :
+   0 - '.'      (default drive - hence current dir is ok.)
+   1 - '/fd0/.'  (floppy drive 1 - should be adapted to local system )
+   2 - '/fd1/.'  (floppy drive 2 - should be adapted to local system )
+   3 - '/'       (C: equivalent of dos is the root partition)
+   4..26          (can be set by you're own applications)
+  ! Use AddDisk() to Add new drives !
+  They both return -1 when a failure occurs.
+}
+Const
+  FixDriveStr : array[0..3] of pchar=(
+    '.',
+    '/fd0/.',
+    '/fd1/.',
+    '/.'
+    );
+var
+  Drives   : byte;
+  DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+  if not (DriveStr[Drives]=nil) then
+   FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+  GetMem(DriveStr[Drives],length(Path)+1);
+  StrPCopy(DriveStr[Drives],path);
+  inc(Drives);
+  if Drives>26 then
+   Drives:=4;
+end;
+
+
+Function DiskFree(Drive: Byte): int64;
+//var fs : statfs;
+Begin
+{  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+     ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+   Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+  else
+   Diskfree:=-1;}
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+//var fs : statfs;
+Begin
+{  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+     ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+   DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+  else
+   DiskSize:=-1;}
+End;
+
+
+Function GetCurrentDir : String;
+begin
+  GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+  {$I-}
+   ChDir(NewDir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+  {$I-}
+   MkDir(NewDir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+  {$I-}
+   RmDir(Dir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var xx : word;
+begin
+  Dos.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, xx);
+  Dos.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day, xx);
+  SystemTime.MilliSecond := 0;
+end;
+
+
+Procedure InitAnsi;
+Var i : longint;
+begin
+  {  Fill table entries 0 to 127  }
+  for i := 0 to 96 do
+    UpperCaseTable[i] := chr(i);
+  for i := 97 to 122 do
+    UpperCaseTable[i] := chr(i - 32);
+  for i := 123 to 191 do
+    UpperCaseTable[i] := chr(i);
+  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+  for i := 0 to 64 do
+    LowerCaseTable[i] := chr(i);
+  for i := 65 to 90 do
+    LowerCaseTable[i] := chr(i + 32);
+  for i := 91 to 191 do
+    LowerCaseTable[i] := chr(i);
+  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+  InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+  Result:='';  // StrError(ErrorCode);
+end;
+
+{****************************************************************************
+                              OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+//  Result:=StrPas(Unix.Getenv(PChar(EnvVar)));
+end;
+
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  OutOfMemory.Free;
+  InValidPointer.Free;
+end.
+{
+
+  $Log$
+  Revision 1.1  2001-04-11 14:14:12  florian
+    * initial commit, thanks to Armin Diehl (diehl@nordrhein)
+
+  Revision 1.8  2001/02/20 22:19:38  peter
+    * always test before commiting after merging, linux -> unix change
+
+  Revision 1.7  2001/02/20 22:14:19  peter
+    * merged getenvironmentvariable
+
+  Revision 1.6  2001/01/21 20:21:40  marco
+   * Rename fest II. Rtl OK
+
+  Revision 1.5  2000/12/28 20:50:04  peter
+    * merged fixes from 1.0.x
+
+  Revision 1.4  2000/12/18 14:01:42  jonas
+    * fixed constant range error
+
+  Revision 1.3  2000/11/28 20:06:12  michael
+  + merged fix for findfirst/findnext/findclose
+
+  Revision 1.2  2000/09/18 13:14:51  marco
+   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
+
+  Revision 1.3  2000/08/29 17:58:13  michael
+  Merged syserrormsg fix
+
+  Revision 1.2  2000/08/20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+  Revision 1.1.2.2  2000/11/28 20:01:22  michael
+    + Fixed findfirst/findnext/findclose
+
+  Revision 1.1.2.1  2000/09/14 13:38:26  marco
+    * Moved from Linux dir. now start of generic unix dir, from which the
+      really exotic features should be moved to the target specific dirs.
+}