* updates from Armin commited

rtl/inc/objects.pp

@@ -215,6 +215,15 @@ const
    MaxReadBytes = $fffe;
    invalidhandle = -1;
 {$ENDIF}
+{$IFDEF Netware} 
+type 
+   FNameStr = String; 
+   THandle = Longint; 
+const 
+   MaxReadBytes = $7fffffff; 
+   invalidhandle = -1; 
+{$ENDIF} 
+
 
 {---------------------------------------------------------------------------}
 {                            DOS ASCIIZ FILENAME                            }
@@ -2800,7 +2809,10 @@ END;
 END.
 {
   $Log$
-  Revision 1.3  2000-11-13 13:40:04  marco
+  Revision 1.4  2001-04-16 18:36:41  florian
+    * updates from Armin commited
+
+  Revision 1.3  2000/11/13 13:40:04  marco
    * Renamefest
 
   Revision 1.2  2000/07/13 11:33:44  michael

rtl/netware/Makefile

@@ -0,0 +1,71 @@
+# Makefile for freepascal rtl for netware
+# Needs working nlmconv + i386-netware-ld
+
+UNITDIR = /usr/lib/fpc/1.1/units/netware/rtl
+PPC386OPT = -n -di386 -dSYSTEMDEBUG -O3 -Sg -Tnetware -Aelf -a -al -FE.
+INCLUDES = -I../inc -I../i386 -I../objpas
+
+SYSUNIT=system
+OBJEXT=on
+PPUEXT=ppn
+ASMEXT=s
+OBJS = $(SYSUNIT).$(OBJEXT) ../inc/strings.$(OBJEXT) dos.$(OBJEXT) nwpre.$(OBJEXT) ../objpas/objpas.$(OBJEXT) sysutils.$(OBJEXT) crt.$(OBJEXT) sockets.$(OBJEXT) mouse.$(OBJEXT) netware.$(OBJEXT) video.$(OBJEXT) keyboard.$(OBJEXT) ../objpas/math.$(OBJEXT) ../objpas/typinfo.$(OBJEXT) ../inc/objects.$(OBJEXT) ../inc/getopts.$(OBJEXT) ../inc/heaptrc.$(OBJEXT) varutils.$(OBJEXT) ../i386/cpu.$(OBJEXT) ../i386/mmx.$(OBJEXT)
+
+
+all:	$(OBJS)
+
+$(SYSUNIT).$(OBJEXT):	$(SYSUNIT).pp nwsys.inc
+	ppc386 -Us $(PPC386OPT) $(INCLUDES) $(SYSUNIT).pp
+
+%.$(OBJEXT):	%.pp nwsys.inc
+	ppc386 $(PPC386OPT) $(INCLUDES) $*.pp
+
+install: $(OBJS)
+
+	cp -f $(SYSUNIT).$(OBJEXT) $(UNITDIR)
+	cp -f $(SYSUNIT).$(PPUEXT) $(UNITDIR)
+	cp -f dos.$(OBJEXT) $(UNITDIR)
+	cp -f dos.$(PPUEXT) $(UNITDIR)
+	cp -f strings.$(OBJEXT) $(UNITDIR)
+	cp -f strings.$(PPUEXT) $(UNITDIR)
+	cp -f nwpre.$(OBJEXT) $(UNITDIR)
+	cp -f nwpre.$(PPUEXT) $(UNITDIR)
+	cp -f sysutils.$(OBJEXT) $(UNITDIR)
+	cp -f sysutils.$(PPUEXT) $(UNITDIR)
+	cp -f objpas.$(OBJEXT) $(UNITDIR)
+	cp -f objpas.$(PPUEXT) $(UNITDIR)
+	cp -f crt.$(OBJEXT) $(UNITDIR)
+	cp -f crt.$(PPUEXT) $(UNITDIR)
+	cp -f sockets.$(OBJEXT) $(UNITDIR)
+	cp -f sockets.$(PPUEXT) $(UNITDIR)
+	cp -f mouse.$(OBJEXT) $(UNITDIR)
+	cp -f mouse.$(PPUEXT) $(UNITDIR)
+	cp -f netware.$(OBJEXT) $(UNITDIR)
+	cp -f netware.$(PPUEXT) $(UNITDIR)
+	cp -f video.$(OBJEXT) $(UNITDIR)
+	cp -f video.$(PPUEXT) $(UNITDIR)
+	cp -f keyboard.$(OBJEXT) $(UNITDIR)
+	cp -f keyboard.$(PPUEXT) $(UNITDIR)
+	cp -f math.$(OBJEXT) $(UNITDIR)
+	cp -f math.$(PPUEXT) $(UNITDIR)
+	cp -f typinfo.$(OBJEXT) $(UNITDIR)
+	cp -f typinfo.$(PPUEXT) $(UNITDIR)
+	cp -f objects.$(OBJEXT) $(UNITDIR)
+	cp -f objects.$(PPUEXT) $(UNITDIR)
+	cp -f getopts.$(OBJEXT) $(UNITDIR)
+	cp -f getopts.$(PPUEXT) $(UNITDIR)
+	cp -f heaptrc.$(OBJEXT) $(UNITDIR)
+	cp -f heaptrc.$(PPUEXT) $(UNITDIR)
+	cp -f varutils.$(OBJEXT) $(UNITDIR)
+	cp -f varutils.$(PPUEXT) $(UNITDIR)
+	cp -f cpu.$(OBJEXT) $(UNITDIR)
+	cp -f cpu.$(PPUEXT) $(UNITDIR)
+	cp -f mmx.$(OBJEXT) $(UNITDIR)
+	cp -f mmx.$(PPUEXT) $(UNITDIR)
+	cp -f nwimp/*.imp $(UNITDIR)
+
+clean:
+	rm -f *.$(OBJEXT) *.$(PPUEXT) *.$(ASMEXT) *.bak
+
+dist:
+	clean

rtl/netware/README

@@ -0,0 +1,181 @@
+    News
+    ====
+    
+    2001/04/16 armin:
+     - implemented CRT and SYSUTILS
+     - nwimp/convertimp to convert .imp files to unix
+
+
+
+    General
+    =======
+
+    Currently generating NetWare-NLM's only work under Linux. (may be under bsd also)
+    This is because nlmconv from binutils does not work with i.e. win32 coff object files. 
+    It works fine with ELF-Objects.
+    
+    
+    Binutils with netware-support needed
+    ====================================
+    
+    You need a version of binutils compiled with netware-support. (nlmconv has to be present)
+    Unfortunately in the Linux distibutions this component of the binutils is not included 
+    so you have to compile it. So download the latest stable binutils package from your 
+    favourite GNU mirror, decompress it ('tar xfz binutils-x.yy.z.tar.gz' on unices 
+    with GNU tar), change to the binutils-x.yy.z directory and configure: 
+    
+      ./configure --prefix=/usr --enable-shared --enable-targets=i386-netware,i386-linux
+    
+    I used the prefix /usr because thats the default location on redhat (thats what I'm using)
+    
+    and use
+    
+      make 
+      make install
+    
+    to build and install binutils. To check that netware is supported by the version of binutils
+    installed, use ld --version. The emulation 'i386nw' must be present. Also check that nlmconv
+    is present and can be started without specifying the complete path of nlmconv.
+    
+    You can find more information and a binary version of binutils with netware-support for 
+    linux on:
+           http://home.sch.bme.hu/~keresztg/novell/howto/NLM-Linux-HOWTO.html.
+    
+    
+    Building the freepascal runtime-library for netware
+    ===================================================
+    
+    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.
+    Compile and install the rtl with
+    
+      make install
+      
+    Settings and needed files to compile for netware
+    ================================================
+    
+    Edit your /etc/ppc386.cfg and add the rtl source path for netware. This are my settings,
+    you may paste it to your ppc386.cfg:
+    
+#IFDEF Netware
+  -Fu/usr/lib/fpc/1.1/units/netware/rtl
+  -Fl/usr/lib/fpc/1.1/units/netware/rtl
+#ENDIF
+    
+    This adds the search path for the rtl-units as well as for the needed import-files.
+    You can use the import files from the rtl/netware directory, they are automaticly
+    installed. If you want to use import files from novell, be aware that you have to
+    convert the files to unix format (i.e. with dos2unix).
+    
+    Building the first nlm
+    ======================
+    
+    Ok, now you have installed all needed files, try the following program and compile it
+    with
+    
+      ppc386 -Tnetware hello.pas
+      
+    PROGRAM Hello;
+    {$Description The FreePascal HelloWorld for Netware}
+    {$Version 1.0.0}
+    
+    BEGIN
+      WriteLn ('This is open source ! FreePascal for netware');
+    END.
+    
+    Hints on using freepascal for nlm's
+    ===================================
+
+    - Compiler Switches
+      -----------------
+      The following compiler-swiches are supported for NetWare:
+      $DESCRIPTION    : NLM-Description, will be displayed at load-time
+      $M              : For Stack-Size. Heap-Size will be ignored
+      $VERSION x.x.x  : Sets Major, Minor and Revision, Revision 0 is nothing, 1=a, 2=b ...
+
+      Sorry, Displaying copyright does not work with nlmconv from gnu bunutils. There is a patch
+      available for nlmconv but currently there is no compiler switch in fpc. Implementing the
+      compiler switch is on my todo list. This is also valid for the screen-name.
+      
+    - Exports
+      -------
+
+      Exports will be handled like in win32:
+      procedure bla; CDECL; EXPORT;
+      begin
+      end;
+
+      exports bla name 'bla';
+
+      Be aware that without Name 'bla' this will be exported in upper-case.
+      
+    - Netware import (.imp) files
+      ---------------------------
+
+      Import files are needed by nlmconv as with other netware linkers. FreePascal is
+      searching import files via the specified library path (-Fl). If you plan to use
+      import files from novell be aware that they have to be converted from CR/LF to
+      LF only. The script 'convertimp' in rtl/netware/nwimp will do that.
+      If a module name is specified in an import, the module is automaticly 
+      declared as autoload by FreePascal.
+      
+      I.e. the following declaration needs nlmlib.imp and sets nlmlib.nlm as autoload:
+      
+        FUNCTION rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL 'nlmlib.nlm' NAME 'rmdir';
+	
+      while the following declaration only imports the symbol without autoloading:
+      
+      	FUNCTION rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL;
+	
+      If nlmlib.nlm is not loaded while loading yout nlm, you will get an error abount
+      unknown symbols. 
+      
+
+    - Debugging
+      ---------
+      
+      Thats currently a problem. There is no source level debugger available. The only way
+      to debug 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 read about plans to adapt gdb to current netware versions. As soon as i have news
+      about gdb i will change this document.
+      
+    - Netware SDK
+      -----------
+      
+      Delphi declarations for the multiplattform api is available at 
+      http://developer.novell.com. You can download the sdk after registering as a developer.
+      The files are designed for win32 so they will not work off the box. I think changing
+      the dll-name to the corrosponding nlm-name will work.
+      i.e. in calwin32.imp the following declaration:
+      
+        function NWAbortServicingQueueJob2;  StdCall; external 'calwin32.dll' index 231;
+      
+       has to be changed to
+       
+        function NWAbortServicingQueueJob2;  CDecl; external 'calwin32.nlm';
+      
+    - FreePascal RTL
+      --------------
+      
+      Currently the following units are available for netware:
+      
+        - SYSTEM
+	- CRT
+	- DOS
+	- SYSUTILS
+	- STRINGS
+	- KEYBOARD
+	- VIDEO
+	- MATH
+	- TYPINFO
+	- OBJECTS
+	- GETOPTS
+	- HEAPTRC
+	- VARUTILS
+	- CPU
+	- MMX
+	

rtl/netware/crt.pp

@@ -0,0 +1,723 @@
+{
+    $Id$
+    Copyright (c) 1999-2001 by the Free Pascal development team.
+
+    Borland Pascal 7 Compatible CRT Unit for Netware, tested with
+    Netware 4.11 and 5.1
+
+    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.
+
+ **********************************************************************}
+{At initialization time, AutoScreenDestructionMode is set to true so after program termination
+ no "press any key to close screen" is displayed. Also check for ctrl-c in readkey is disabled.
+ To enable ctrl-c check, set CheckBreak to true before calling ReadKey.
+
+ 2001/04/13 armin: first version for netware, compilable, completely untested
+ 2001/04/14 armin: tested, seems to work
+                   TextMode, Sound and NoSound are dummys, don't know how to
+                   implement that for netware
+}
+unit crt;
+interface
+
+const
+{ CRT modes }
+  BW40          = 0;            { 40x25 B/W on Color Adapter }
+  CO40          = 1;            { 40x25 Color on Color Adapter }
+  BW80          = 2;            { 80x25 B/W on Color Adapter }
+  CO80          = 3;            { 80x25 Color on Color Adapter }
+  Mono          = 7;            { 80x25 on Monochrome Adapter }
+  Font8x8       = 256;          { Add-in for ROM font }
+
+{ Mode constants for 3.0 compatibility }
+  C40           = CO40;
+  C80           = CO80;
+
+{ Foreground and background color constants }
+  Black         = 0;
+  Blue          = 1;
+  Green         = 2;
+  Cyan          = 3;
+  Red           = 4;
+  Magenta       = 5;
+  Brown         = 6;
+  LightGray     = 7;
+
+{ Foreground color constants }
+  DarkGray      = 8;
+  LightBlue     = 9;
+  LightGreen    = 10;
+  LightCyan     = 11;
+  LightRed      = 12;
+  LightMagenta  = 13;
+  Yellow        = 14;
+  White         = 15;
+
+{ Add-in for blinking }
+  Blink         = 128;
+
+var
+
+{ Interface variables }
+  CheckBreak: Boolean;    { Enable Ctrl-Break, supported on Netware }
+  CheckEOF: Boolean;      { Enable Ctrl-Z, supported on Netware }
+  DirectVideo: Boolean;   { Enable direct video addressing }
+  CheckSnow: Boolean;     { Enable snow filtering }
+  LastMode: Word;         { Current text mode }
+  TextAttr: Byte;         { Current text attribute }
+  WindMin: Word;          { Window upper left coordinates }
+  WindMax: Word;          { Window lower right coordinates }
+
+{ Interface procedures }
+procedure AssignCrt(var F: Text);
+function KeyPressed: Boolean;
+function ReadKey: Char;
+procedure TextMode(Mode: Integer);        {dummy function}
+procedure Window(X1,Y1,X2,Y2: Byte);
+procedure GotoXY(X,Y: Byte);
+function WhereX: Byte;
+function WhereY: Byte;
+procedure ClrScr;
+procedure ClrEol;
+procedure InsLine;
+procedure DelLine;
+procedure TextColor(Color: Byte);
+procedure TextBackground(Color: Byte);
+procedure LowVideo;
+procedure HighVideo;
+procedure NormVideo;
+procedure Delay(MS: Word);
+procedure Sound(Hz: Word);                {dummy function}
+procedure NoSound;                        {dummy function}
+
+{Extra Functions}
+procedure cursoron;
+procedure cursoroff;
+procedure cursorbig;
+
+
+implementation
+
+{$I nwsys.inc}
+
+
+{$ASMMODE ATT}
+
+var
+  DelayCnt,
+  ScreenWidth,
+  ScreenHeight : longint;
+  VidSeg : Word;
+
+{
+  definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
+
+
+{****************************************************************************
+                           Low level Routines
+****************************************************************************}
+
+procedure setscreenmode(mode : byte);
+begin
+end;
+
+
+function GetScreenHeight : longint;
+VAR Height, Width : WORD;
+begin
+ _GetSizeOfScreen (Height,Width);
+  GetScreenHeight := Height;
+end;
+
+
+function GetScreenWidth : longint;
+VAR Height, Width : WORD;
+begin
+ _GetSizeOfScreen (Height,Width);
+  GetScreenWidth := Width;
+end;
+
+
+procedure GetScreenCursor(var x,y : longint);
+begin
+  x := _wherex+1;
+  y := _wherey+1;
+end;
+
+
+{****************************************************************************
+                              Helper Routines
+****************************************************************************}
+
+Function WinMinX: Longint;
+{
+  Current Minimum X coordinate
+}
+Begin
+  WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Longint;
+{
+  Current Minimum Y Coordinate
+}
+Begin
+  WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Longint;
+{
+  Current Maximum X coordinate
+}
+Begin
+  WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Longint;
+{
+  Current Maximum Y coordinate;
+}
+Begin
+  WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+Function FullWin:boolean;
+{
+  Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+  FullWin:=(WinMinX=1) and (WinMinY=1) and
+           (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
+end;
+
+
+{****************************************************************************
+                             Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+begin
+  Window (1,1,ScreenWidth,ScreenHeight);
+  ClrScr;
+end;
+
+
+Procedure TextColor(Color: Byte);
+{
+  Switch foregroundcolor
+}
+Begin
+  TextAttr:=(Color and $f) or (TextAttr and $70);
+  If (Color>15) Then TextAttr:=TextAttr Or Blink;
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+  Switch backgroundcolor
+}
+Begin
+  TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+End;
+
+
+
+Procedure HighVideo;
+{
+  Set highlighted output.
+}
+Begin
+  TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+  Set normal output
+}
+Begin
+  TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+  Set normal back and foregroundcolors.
+}
+Begin
+  TextColor(7);
+  TextBackGround(0);
+End;
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+  Go to coordinates X,Y in the current window.
+}
+Begin
+  If (X>0) and (X<=WinMaxX- WinMinX+1) and
+     (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+   Begin
+     X := X + WinMinX - 1;
+     Y := Y + WinMinY - 1;
+     _GotoXY (x-1,y-1);
+   End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+  Set screen window to the specified coordinates.
+}
+Begin
+  if (X1>X2) or (X2>ScreenWidth) or
+     (Y1>Y2) or (Y2>ScreenHeight) then
+   exit;
+  WindMin:=((Y1-1) Shl 8)+(X1-1);
+  WindMax:=((Y2-1) Shl 8)+(X2-1);
+  GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+  Clear the current window, and set the cursor on 1,1
+}
+var
+  fil : word;
+  y   : longint;
+  p   : pointer;
+  rowlen,rows: longint;
+begin
+  fil:=32 or (textattr shl 8);
+  if FullWin then
+  begin
+    _clrscr;  {seems to swich cursor off}
+    _DisplayInputCursor;
+  end else
+   begin
+     rowlen := WinMaxX-WinMinX+1;
+     rows   := WinMaxY-WinMinY+1;
+     GetMem (p, rows * rowlen * 2);
+     FillWord (p^, rows * rowlen, fil);
+     _CopyToScreenMemory (rows,rowlen,p,WinMinX-1,WinMinY-1);
+     FreeMem (p, rows * rowlen * 2);
+   end;
+  Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+  Clear from current position to end of line.
+}
+var
+  x,y : longint;
+  fil : word;
+  rowlen : word;
+  p      : pointer;
+Begin
+  GetScreenCursor(x,y);
+  fil:=32 or (textattr shl 8);
+  if x<WinMaxX then
+  begin
+    rowlen := WinMaxX-x+1;
+    GetMem (p, rowlen * 2);
+    FillWord (p^, rowlen, fil);
+    _CopyToScreenMemory (1,rowlen,p,x-1,y-1);
+    FreeMem (p, rowlen * 2);
+  end;
+End;
+
+
+
+Function WhereX: Byte;
+{
+  Return current X-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereX:=x-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+  Return current Y-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereY:=y-WinMinY+1;
+End;
+
+
+{*************************************************************************
+                            Keyboard
+*************************************************************************}
+
+var
+   is_last : boolean;
+
+function readkey : char;
+var
+  char1 : char;
+begin
+  if is_last then
+  begin
+     is_last:=false;
+     readkey:=_getch;
+  end else
+  begin
+    _SetCtrlCharCheckMode (CheckBreak);
+    char1 := _getch;
+    if char1 = #0 then is_last := true;
+    readkey:=char1;
+  end;
+end;
+
+
+function keypressed : boolean;
+begin
+  if is_last then
+  begin
+    keypressed:=true;
+    exit;
+  end else
+    keypressed := (_kbhit <> 0);
+end;
+
+
+{*************************************************************************
+                                   Delay
+*************************************************************************}
+
+procedure Delay(MS: Word);
+begin
+  _delay (MS);
+end;
+
+
+procedure sound(hz : word);
+begin
+  _RingTheBell;
+end;
+
+
+procedure nosound;
+begin
+end;
+
+
+
+{****************************************************************************
+                          HighLevel Crt Functions
+****************************************************************************}
+
+procedure removeline(y : longint);
+var
+  fil : word;
+  rowlen : word;
+  p : pointer;
+begin
+  fil:=32 or (textattr shl 8);
+  rowlen:=WinMaxX-WinMinX+1;
+  GetMem (p, rowlen*2);
+  y:=WinMinY+y-1;
+  While (y<=WinMaxY) do
+   begin
+     _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,y);
+     _CopyToScreenMemory (1,rowlen,p,WinMinX-1,y-1);
+     inc(y);
+   end;
+  FillWord (p^,rowlen,fil);
+  _CopyToScreenMemory (1,rowlen,p,WinMinX-1,WinMaxY-1);
+  FreeMem (p, rowlen*2);
+end;
+
+
+procedure delline;
+begin
+  removeline(wherey);
+end;
+
+
+procedure insline;
+var
+  my,y : longint;
+  fil : word;
+  rowlen,x : word;
+  p : pointer;
+begin
+  fil:=32 or (textattr shl 8);
+  y:=WhereY-1;
+  my:=WinMaxY-WinMinY;
+  rowlen := WinMaxX-WinMinX+1;
+  GetMem (p, rowlen*2);
+  while (my>=y) do
+   begin
+     _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,my);
+     _CopyToScreenMemory (1,rowlen,p,WinMinX-1,my+1);
+     dec(my);
+   end;
+  FillWord (p^,rowlen,fil);
+  _CopyToScreenMemory (1,rowlen,p,x,y);
+  FreeMem (p, rowlen*2);
+end;
+
+
+
+
+{****************************************************************************
+                             Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+begin
+  if _IsColorMonitor <> 0 then
+    _SetCursorShape (9,$A)
+  else
+    _SetCursorShape ($B,$D);
+  _DisplayInputCursor;
+end;
+
+
+procedure cursoroff;
+begin
+  _HideInputCursor;
+end;
+
+
+procedure cursorbig;
+begin
+  _SetCursorShape (1,$A);
+  _DisplayInputCursor;
+end;
+
+
+{*****************************************************************************
+                          Read and Write routines
+*****************************************************************************}
+
+var
+  CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var
+  w    : word;
+begin
+  case c of
+   #10 : inc(CurrY);
+   #13 : CurrX:=WinMinX;
+    #8 : begin
+           if CurrX>WinMinX then
+            dec(CurrX);
+         end;
+    #7 : begin { beep }
+           _RingTheBell;
+         end;
+  else
+   begin
+     w:=(textattr shl 8) or byte(c);
+     _CopyToScreenMemory (1,1,@w,CurrX-1,CurrY-1);
+     inc(CurrX);
+   end;
+  end;
+  if CurrX>WinMaxX then
+   begin
+     CurrX:=WinMinX;
+     inc(CurrY);
+   end;
+  while CurrY>WinMaxY do
+   begin
+     removeline(1);
+     dec(CurrY);
+   end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+  i : longint;
+begin
+  GetScreenCursor(CurrX,CurrY);
+  for i:=0 to f.bufpos-1 do
+    WriteChar(f.buffer[i]);  { ad: may be better to use a buffer but i think it's fast enough }
+  _GotoXY (CurrX-1,CurrY-1);
+  f.bufpos:=0;
+  CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+  procedure BackSpace;
+  begin
+    if (f.bufpos>0) and (f.bufpos=f.bufend) then
+     begin
+       WriteChar(#8);
+       WriteChar(' ');
+       WriteChar(#8);
+       dec(f.bufpos);
+       dec(f.bufend);
+     end;
+  end;
+
+var
+  ch : Char;
+Begin
+  GetScreenCursor(CurrX,CurrY);
+  f.bufpos:=0;
+  f.bufend:=0;
+  repeat
+    if f.bufpos>f.bufend then
+     f.bufend:=f.bufpos;
+    _GotoXY (CurrX-1,CurrY-1);
+    ch:=readkey;
+    case ch of
+    #0 : case readkey of
+          #71 : while f.bufpos>0 do
+                 begin
+                   dec(f.bufpos);
+                   WriteChar(#8);
+                 end;
+          #75 : if f.bufpos>0 then
+                 begin
+                   dec(f.bufpos);
+                   WriteChar(#8);
+                 end;
+          #77 : if f.bufpos<f.bufend then
+                 begin
+                   WriteChar(f.bufptr^[f.bufpos]);
+                   inc(f.bufpos);
+                 end;
+          #79 : while f.bufpos<f.bufend do
+                 begin
+                   WriteChar(f.bufptr^[f.bufpos]);
+                   inc(f.bufpos);
+                 end;
+         end;
+    ^S,
+    #8 : BackSpace;
+    ^Y,
+   #27 : begin
+           f.bufpos:=f.bufend;
+           while f.bufend>0 do
+            BackSpace;
+         end;
+   #13 : begin
+           WriteChar(#13);
+           WriteChar(#10);
+           f.bufptr^[f.bufend]:=#13;
+           f.bufptr^[f.bufend+1]:=#10;
+           inc(f.bufend,2);
+           break;
+         end;
+   #26 : if CheckEOF then
+          begin
+            f.bufptr^[f.bufend]:=#26;
+            inc(f.bufend);
+            break;
+          end;
+    else
+     begin
+       if f.bufpos<f.bufsize-2 then
+        begin
+          f.buffer[f.bufpos]:=ch;
+          inc(f.bufpos);
+          WriteChar(ch);
+        end;
+     end;
+    end;
+  until false;
+  f.bufpos:=0;
+  _GotoXY (CurrX-1,CurrY-1);
+  CrtRead:=0;
+End;
+
+
+Function CrtReturn(Var F: TextRec): Integer;
+Begin
+  CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+  F.Mode:=fmClosed;
+  CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+  If F.Mode=fmOutput Then
+   begin
+     TextRec(F).InOutFunc:=@CrtWrite;
+     TextRec(F).FlushFunc:=@CrtWrite;
+   end
+  Else
+   begin
+     F.Mode:=fmInput;
+     TextRec(F).InOutFunc:=@CrtRead;
+     TextRec(F).FlushFunc:=@CrtReturn;
+   end;
+  TextRec(F).CloseFunc:=@CrtClose;
+  CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+  Assign(F,'');
+  TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+var
+  x,y : longint;
+begin
+{ Load startup values }
+  ScreenWidth:=GetScreenWidth;
+  ScreenHeight:=GetScreenHeight;
+  lastmode := CO80;
+  TextMode (lastmode);
+  GetScreenCursor(x,y);
+  if screenheight>25 then
+    lastmode:=lastmode or $100;
+  TextColor (LightGray);
+  TextBackground (Black);
+{ Redirect the standard output }
+  assigncrt(Output);
+  Rewrite(Output);
+  TextRec(Output).Handle:=StdOutputHandle;
+  assigncrt(Input);
+  Reset(Input);
+  TextRec(Input).Handle:=StdInputHandle;
+  CheckBreak := FALSE;
+  CheckEOF := FALSE;
+  _SetCtrlCharCheckMode (CheckBreak);
+  _SetAutoScreenDestructionMode (TRUE);
+end.
+

rtl/netware/dos.pp

@@ -15,9 +15,11 @@
  **********************************************************************}
 
 { 2000/09/03 armin: first version
-  2001/03/08 armin: implemented more functions
+  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;
@@ -79,8 +81,8 @@ Type
   End;
 
   searchrec = packed record
-     DirP  : POINTER;               { used for opendir }
-     EntryP: POINTER;               { and readdir }
+     DirP  : POINTER;              { used for opendir }
+     EntryP: POINTER;              { and readdir }
      Magic : WORD;
      fill  : array[1..11] of byte;
      attr  : byte;
@@ -134,8 +136,8 @@ 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}
+Function  FSearch(path: pathstr; dirlist: string): pathstr;  {ok}
+Function  FExpand(const path: pathstr): pathstr;             {ok}
 Procedure FSplit(path: pathstr; var dir: dirstr; var name:   {untested}
                  namestr; var ext: extstr);
 
@@ -263,12 +265,15 @@ end;
 
 procedure getcbreak(var breakvalue : boolean);
 begin
-  breakvalue := true;
+  breakvalue := _SetCtrlCharCheckMode (false);  { get current setting }
+  if breakvalue then
+    _SetCtrlCharCheckMode (breakvalue);         { and restore old setting }
 end;
 
 
 procedure setcbreak(breakvalue : boolean);
 begin
+  _SetCtrlCharCheckMode (breakvalue);
 end;
 
 
@@ -452,9 +457,11 @@ BEGIN
       time := PNWDirEnt(EntryP)^.d_time + (LONGINT (PNWDirEnt(EntryP)^.d_date) SHL 16);
       size := PNWDirEnt(EntryP)^.d_size;
       name := strpas (PNWDirEnt(EntryP)^.d_nameDOS);
+      doserror := 0;
     END ELSE
     BEGIN
       FillChar (f,SIZEOF(f),0);
+      doserror := 18;
     END;
   END;
 END;
@@ -480,8 +487,11 @@ begin
     F.Magic := $AD01;
     PNWDirEnt(f.EntryP) := _readdir (PNWDirEnt(f.DirP));
     IF F.EntryP = NIL THEN
-      doserror := 18
-    ELSE
+    BEGIN
+      _closedir (PNWDirEnt(f.DirP));
+      f.Magic := 0;
+      doserror := 18;
+    END ELSE
       find_setfields (f);
   END;
 end;
@@ -850,7 +860,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2001-04-11 14:17:00  florian
+  Revision 1.3  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.2  2001/04/11 14:17:00  florian
     * added logs, fixed email address of Armin, it is
       [email protected]
 

rtl/netware/keyboard.pp

@@ -0,0 +1,134 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2001 by the Free Pascal development team.
+
+    Keyboard unit for netware
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ 2001/04/16 armin: first version for netware }
+unit Keyboard;
+interface
+
+{$i keybrdh.inc}
+
+implementation
+
+{$i keyboard.inc}
+{$i nwsys.inc}
+
+procedure InitKeyboard;
+begin
+  PendingKeyEvent := 0;
+end;
+
+procedure DoneKeyboard;
+begin
+end;
+
+function GetKeyEvent: TKeyEvent;
+var T : TKeyEvent;
+begin
+  if PendingKeyEvent<>0 then
+  begin
+    GetKeyEvent:=PendingKeyEvent;
+    PendingKeyEvent:=0;
+    exit;
+  end;
+  T := byte(_getch);
+  if T = 0 then
+    T := word(_getch) shl 8;
+  GetKeyEvent := $03000000 OR T;
+end;
+
+
+function PollKeyEvent: TKeyEvent;
+begin
+  if PendingKeyEvent<>0 then
+   exit(PendingKeyEvent);
+  if _kbhit <> 0 then
+  begin
+    PendingKeyEvent := byte(_getch);
+    if PendingKeyEvent = 0 then
+      PendingKeyEvent := word(_getch) shl 8;
+    PendingKeyEvent := PendingKeyEvent OR $03000000;
+    PollKeyEvent := PendingKeyEvent;
+  end else
+    PollKeyEvent := 0;
+end;
+
+
+function PollShiftStateEvent: TKeyEvent;
+begin
+  PollShiftStateEvent:=0;
+end;
+
+
+{ Function key translation }
+type
+  TTranslationEntry = packed record
+    Min, Max: Byte;
+    Offset: Word;
+  end;
+const
+  TranslationTableEntries = 12;
+  TranslationTable: array [1..TranslationTableEntries] of TTranslationEntry =
+    ((Min: $3B; Max: $44; Offset: kbdF1),   { function keys F1-F10 }
+     (Min: $54; Max: $5D; Offset: kbdF1),   { Shift fn keys F1-F10 }
+     (Min: $5E; Max: $67; Offset: kbdF1),   { Ctrl fn keys F1-F10 }
+     (Min: $68; Max: $71; Offset: kbdF1),   { Alt fn keys F1-F10 }
+     (Min: $85; Max: $86; Offset: kbdF11),  { function keys F11-F12 }
+     (Min: $87; Max: $88; Offset: kbdF11),  { Shift+function keys F11-F12 }
+     (Min: $89; Max: $8A; Offset: kbdF11),  { Ctrl+function keys F11-F12 }
+     (Min: $8B; Max: $8C; Offset: kbdF11),  { Alt+function keys F11-F12 }
+     (Min:  71; Max:  73; Offset: kbdHome), { Keypad keys kbdHome-kbdPgUp }
+     (Min:  75; Max:  77; Offset: kbdLeft), { Keypad keys kbdLeft-kbdRight }
+     (Min:  79; Max:  81; Offset: kbdEnd),  { Keypad keys kbdEnd-kbdPgDn }
+     (Min: $52; Max: $53; Offset: kbdInsert));
+
+
+function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+var
+  I: Integer;
+  ScanCode: Byte;
+begin
+  if KeyEvent and $03000000 = $03000000 then
+   begin
+     if KeyEvent and $000000FF <> 0 then
+      begin
+        TranslateKeyEvent := KeyEvent and $00FFFFFF;
+        exit;
+      end
+     else
+      begin
+        { This is a function key }
+        ScanCode := (KeyEvent and $0000FF00) shr 8;
+        for I := 1 to TranslationTableEntries do
+         begin
+           if (TranslationTable[I].Min <= ScanCode) and (ScanCode <= TranslationTable[I].Max) then
+            begin
+              TranslateKeyEvent := $02000000 + (KeyEvent and $00FF0000) +
+                (ScanCode - TranslationTable[I].Min) + TranslationTable[I].Offset;
+              exit;
+            end;
+         end;
+      end;
+   end;
+  TranslateKeyEvent := KeyEvent;
+end;
+
+
+function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
+begin
+  TranslateKeyEventUniCode := KeyEvent;
+  ErrorCode:=errKbdNotImplemented;
+end;
+
+end.

rtl/netware/mouse.pp

@@ -0,0 +1,117 @@
+{
+    $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
+
+    Dummy Mouse unit for netware
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{2001/04/14 armin: first version, only a dummy, i think there is no 'official' way to support
+                   a mouse under netware }
+unit Mouse;
+interface
+
+{$ifdef NOMOUSE}
+{$DEFINE NOGPM}
+{$ENDIF}
+
+const
+  MouseEventBufSize = 16;
+
+{$i mouseh.inc}
+
+implementation
+
+
+procedure PlaceMouseCur(ofs:longint);
+begin
+end;
+
+
+procedure InitMouse;
+begin
+end;
+
+
+procedure DoneMouse;
+begin
+end;
+
+
+function DetectMouse:byte;
+begin
+  DetectMouse:=0;
+end;
+
+
+procedure ShowMouse;
+begin
+end;
+
+
+procedure HideMouse;
+begin
+end;
+
+
+function GetMouseX:word;
+begin
+  GetMouseX:=0;
+end;
+
+
+function GetMouseY:word;
+begin
+  GetMouseY:=0;
+end;
+
+
+function GetMouseButtons:word;
+begin
+  GetMouseButtons:=0;
+end;
+
+
+procedure SetMouseXY(x,y:word);
+begin
+end;
+
+
+procedure GetMouseEvent(var MouseEvent: TMouseEvent);
+begin
+  fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+end;
+
+
+procedure PutMouseEvent(const MouseEvent: TMouseEvent);
+begin
+end;
+
+
+function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+begin
+  fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+  exit(false);
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.2  2001/01/21 20:21:40  marco
+   * Rename fest II. Rtl OK
+
+  Revision 1.1  2001/01/13 11:03:58  peter
+    * API 2 RTL commit
+
+}

rtl/netware/netware.pp

@@ -0,0 +1,176 @@
+{
+    $Id$
+    <partof>
+    Copyright (c) 1998 by <yourname>
+
+    <infoline>
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit netware;
+
+interface
+
+const
+  NlmLib  = 'nlmlib.nlm';
+
+type
+  fdSet=array[0..7] of longint;{=256 bits}
+  pfdset=^fdset;
+  TFDSet=fdset;
+
+  timeval = packed record
+    sec,usec:longint
+  end;
+  ptimeval=^timeval;
+  TTimeVal=timeval;
+
+Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint; CDECL; EXTERNAL NlmLib NAME 'select';
+Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
+Function  SelectText(var T:Text;TimeOut :PTimeVal):Longint;
+
+Procedure FD_Zero(var fds:fdSet);
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+Procedure FD_Set(fd:longint;var fds:fdSet);
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+Function GetFS (var T:Text):longint;
+Function GetFS(Var F:File):longint;
+
+
+implementation
+
+{ Get the definitions of textrec and filerec }
+{$i textrec.inc}
+{$i filerec.inc}
+
+
+Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
+{
+  Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+  have changed.
+  This function allows specification of a timeout as a longint.
+}
+var
+  p  : PTimeVal;
+  tv : TimeVal;
+begin
+  if TimeOut=-1 then
+   p:=nil
+  else
+   begin
+     tv.Sec:=Timeout div 1000;
+     tv.Usec:=(Timeout mod 1000)*1000;
+     p:=@tv;
+   end;
+  Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
+end;
+
+
+
+Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
+Var
+  F:FDSet;
+begin
+  if textrec(t).mode=fmclosed then
+   begin
+     {LinuxError:=Sys_EBADF;}
+     exit(-1);
+   end;
+  FD_Zero(f);
+  FD_Set(textrec(T).handle,f);
+  if textrec(T).mode=fminput then
+   SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
+  else
+   SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
+end;
+
+
+{--------------------------------
+      FiledescriptorSets
+--------------------------------}
+
+Procedure FD_Zero(var fds:fdSet);
+{
+  Clear the set of filedescriptors
+}
+begin
+  FillChar(fds,sizeof(fdSet),0);
+end;
+
+
+
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+{
+  Remove fd from the set of filedescriptors
+}
+begin
+  fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
+end;
+
+
+
+Procedure FD_Set(fd:longint;var fds:fdSet);
+{
+  Add fd to the set of filedescriptors
+}
+begin
+  fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
+end;
+
+
+
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+{
+  Test if fd is part of the set of filedescriptors
+}
+begin
+  FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
+end;
+
+
+
+Function GetFS (var T:Text):longint;
+{
+  Get File Descriptor of a text file.
+}
+begin
+  if textrec(t).mode=fmclosed then
+   exit(-1)
+  else
+   GETFS:=textrec(t).Handle
+end;
+
+
+
+Function GetFS(Var F:File):longint;
+{
+  Get File Descriptor of an unTyped file.
+}
+begin
+  { Handle and mode are on the same place in textrec and filerec. }
+  if filerec(f).mode=fmclosed then
+   exit(-1)
+  else
+   GETFS:=filerec(f).Handle
+end;
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.1  1999/02/19 15:37:26  peter
+    + init
+
+}
+
+

rtl/netware/nwpre.pp

@@ -1,9 +1,32 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+    Copyright (c) 2001 Armin Diehl
+		
+    This unit implements the startup code for a netware nlm. It must be the first object file
+    linked. Currently the 'old-style', similar to novell's prelude.obj is used. With the newer
+    way (novells nwpre.obj) i only got abends. Dont know what's different in novells nwpre.
+		    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+			    
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+					
+**********************************************************************}
+
 unit 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
+{ 2000/08/29 armin: first version, untested
+  2000/09/02 armin: Dont know why its not working with kNLMInfo...
+                    It always abends in TerminateNLM, so i am using the old style
+  2001/04/15 armin: Added comments, S-
+                    Removed dead code }
+		    
 {$DEFINE OldPrelude}
 
 FUNCTION _Prelude (NLMHandle               : LONGINT;
@@ -19,24 +42,27 @@ FUNCTION _Prelude (NLMHandle               : LONGINT;
 
 implementation
 
+{$S-}
 
-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;		    
+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;
 
-(*****************************************************************************)
+
+{**************************************************************************************************}
 
 CONST TRADINIONAL_NLM_INFO_SIGNATURE = 0;
       TRADINIONAL_FLAVOR             = 0;
@@ -59,7 +85,7 @@ TYPE
     wchar_tSize    : LONGINT;
   END;
 
-CONST NLM_INFO_SIGNATURE             = 'NLMI';  // $494d3c3e;  // NLMI
+CONST NLM_INFO_SIGNATURE             = 'NLMI';  // $494d3c3e;
 
       kNLMInfo : kNLMInfoT =
        (Signature      : NLM_INFO_SIGNATURE;
@@ -69,8 +95,9 @@ CONST NLM_INFO_SIGNATURE             = 'NLMI';  // $494d3c3e;  // NLMI
         wchar_tSize    : 2);
 {$ENDIF}
 
-(*****************************************************************************)
+{**************************************************************************************************}
 
+{ _nlm_main is defined in system.pp. It sets command line parameters and calls PASCALMAIN }
 FUNCTION _nlm_main (Argc : LONGINT; ArgV : ARRAY OF PCHAR) : LONGINT; CDECL;
 EXTERNAL;
 
@@ -125,7 +152,10 @@ END;
 end.
 {
   $Log$
-  Revision 1.2  2001-04-11 14:17:00  florian
+  Revision 1.3  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.2  2001/04/11 14:17:00  florian
     * added logs, fixed email address of Armin, it is
       [email protected]
 

rtl/netware/nwsock.inc

@@ -0,0 +1,213 @@
+{! completely untested !}
+
+
+{******************************************************************************
+                          Import Socket Functions from nlmlib
+******************************************************************************}
+
+CONST SockLib = 'nlmlib.nlm';
+
+Function _NWsocket(Domain,SocketType,Protocol:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'socket';
+Function _NWSend(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'send';
+Function _NWRecv(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'recv';
+Function _NWBind(Sock:Longint;Var Addr;AddrLen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'bind';
+Function _NWListen(Sock,MaxConnect:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'listen';
+Function _NWAccept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'accept';
+Function _NWConnect(Sock:Longint;Var Addr;Addrlen:Longint): longint; CDECL; EXTERNAL SockLib NAME 'connect';
+Function _NWShutdown(Sock:Longint;How:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'shutdown';
+Function _NWGetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'getsocketname';
+Function _NWGetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'getpeername';
+Function _NWSetSockOpt(Sock,Level,OptName:Longint;Var OptVal;optlen:longint):Longint; CDECL; EXTERNAL SockLib NAME 'setsockopt';
+Function _NWGetSockOpt(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint; CDECL; EXTERNAL SockLib NAME 'getsockopt';
+
+
+{******************************************************************************
+                          Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+  Socket:=_NWSocket(Domain,SocketType,Protocol);
+end;
+
+Function Send(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
+begin
+  Send:=_NWSend(Sock,Addr,AddrLen,Flags);
+end;
+
+Function Recv(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
+begin
+  Recv:=_NWRecv(Sock,Addr,AddrLen,Flags);
+end;
+
+Function Bind(Sock:Longint;Var Addr;AddrLen:Longint):Boolean;
+begin
+  Bind:=(_NWBind(Sock,Addr,AddrLen)=0);
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+begin
+  Listen:=(_NWListen(Sock,MaxConnect)=0);
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  Accept:=_NWAccept(Sock,Addr,AddrLen);
+  If Accept<0 Then
+    Accept:=-1;
+end;
+
+Function Connect(Sock:Longint;Var Addr;Addrlen:Longint): boolean;
+begin
+  Connect:=_NWConnect(Sock,Addr,AddrLen)=0;
+end;
+
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+  ShutDown:=_NWShutdown(Sock,How);
+end;
+
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  GetSocketName:=_NWGetSocketName(Sock,Addr,AddrLen);
+end;
+
+
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  GetPeerName:=_NWGetPeerName(Sock,Addr,AddrLen);
+end;
+
+
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;optlen:longint):Longint;
+begin
+  SetSocketOptions:=_NWSetsockopt(Sock,Level,OptName,OptVal,OptLen);
+end;
+
+
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+  GetSocketOptions:=_NWGetsockopt(Sock,Level,OptName,OptVal,OptLen);
+end;
+
+
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+  //SocketPair:=do_syscall(syscall_nr_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+  Socketpair := -1;
+end;
+
+{******************************************************************************
+                               UnixSock
+******************************************************************************}
+
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+begin
+  Move(Addr[1],t.Path,length(Addr));
+  t.Family:=AF_UNIX;
+  t.Path[length(Addr)]:=#0;
+  Len:=Length(Addr)+3;
+end;
+
+
+Function Bind(Sock:longint;const addr:string):boolean;
+var
+  UnixAddr : TUnixSockAddr;
+  AddrLen  : longint;
+begin
+  Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+  Bind(Sock,UnixAddr,AddrLen);
+  Bind:=(SocketError=0);
+end;
+
+
+
+Function DoAccept(Sock:longint;var addr:string):longint;
+var
+  UnixAddr : TUnixSockAddr;
+  AddrLen  : longint;
+begin
+  AddrLen:=length(addr)+3;
+  DoAccept:=Accept(Sock,UnixAddr,AddrLen);
+  Move(UnixAddr.Path,Addr[1],AddrLen);
+  SetLength(Addr,AddrLen);
+end;
+
+
+
+Function DoConnect(Sock:longint;const addr:string):Boolean;
+var
+  UnixAddr : TUnixSockAddr;
+  AddrLen  : longint;
+begin
+  Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+  DoConnect:=Connect(Sock,UnixAddr,AddrLen);
+end;
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+var
+  s : longint;
+begin
+  S:=DoAccept(Sock,addr);
+  if S>0 then
+   begin
+     Sock2Text(S,SockIn,SockOut);
+     Accept:=true;
+   end
+  else
+   Accept:=false;
+end;
+
+
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+var
+  s : longint;
+begin
+  S:=DoAccept(Sock,addr);
+  if S>0 then
+   begin
+     Sock2File(S,SockIn,SockOut);
+     Accept:=true;
+   end
+  else
+   Accept:=false;
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+begin
+  Connect:=DoConnect(Sock,addr);
+  If Connect then
+     Sock2Text(Sock,SockIn,SockOut);
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+begin
+  Connect:=DoConnect(Sock,addr);
+  if Connect then
+     Sock2File(Sock,SockIn,SockOut);
+end;
+
+
+// fsread and fswrite are used in socket.inc
+procedure fdwrite (Handle:longint; VAR Data; Len : LONGINT);
+begin
+  { this has to be checked: }
+  _NWSend(Handle,Data,Len,0);
+end;
+
+function fdread (Handle:longint; VAR Data; Len : LONGINT) : LONGINT;
+begin
+  { this has to be checked: }
+  fdread := _NWRecv(Handle,Data,Len,0);
+end;

rtl/netware/nwsys.inc

@@ -2,6 +2,7 @@
     $Id$
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by the Free Pascal development team
+    Copyright (c) 2001 Armin Diehl
 
     Interface to netware clib
 
@@ -16,14 +17,16 @@
 
 { 2000/08/27 armin: first version
   2001/03/08 armin: additional functions
+  2001/04/14 armin: additional functions for crt-unit
 }
 
-CONST Clib   = 'clib.nlm';
-      NlmLib = 'nlmlib.nlm';
-      Threads= 'threads.nlm';
-      CalNlm = 'calnlm32.nlm';
-      ClxNlm = 'clxnlm32.nlm';
-      NitNlm = 'nit.nlm';
+CONST Clib       = 'clib.nlm';
+      NlmLib     = 'nlmlib.nlm';
+      Threads    = 'threads.nlm';
+      CalNlm     = 'calnlm32.nlm';
+      ClxNlm     = 'clxnlm32.nlm';
+      NitNlm     = 'nit.nlm';
+      ThreadsNlm = 'threads.nlm';
 
 TYPE
   dev_t         = LONGINT;
@@ -68,14 +71,12 @@ FUNCTION  _fstat (Fileno : LONGINT; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTE
 
 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;
+PROCEDURE PressAnyKeyToContinue; CDecl; EXTERNAL; // Clib;
+PROCEDURE ExitThread (action_code, termination_code : LONGINT); CDecl; EXTERNAL CLib;
+PROCEDURE _exit (ExitCode : LONGINT); CDecl; EXTERNAL CLib;
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib;
+PROCEDURE printf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib;
+PROCEDURE ConsolePrintf3 (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl; EXTERNAL CLib NAME 'ConsolePrintf';
 
 // values for __action_code used with ExitThread()
 CONST
@@ -87,15 +88,6 @@ FUNCTION _GetStdIn  : POINTER; CDECL; EXTERNAL Clib NAME '__get_stdin';  // resu
 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';
@@ -106,11 +98,50 @@ FUNCTION _write  (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CD
 FUNCTION _read   (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'read';
 FUNCTION _filelength (filedes : LONGINT) : LONGINT; CDECL; EXTERNAL NlmLib NAME 'filelength';
 
+TYPE 
+  NWModifyStructure =
+    RECORD
+       MModifyName            : PCHAR;
+       MFileAttributes        : LONGINT;
+       MFileAttributesMask    : LONGINT;
+       MCreateDate            : WORD;
+       MCreateTime            : WORD;
+       MOwnerID               : LONGINT;
+       MLastArchivedDate      : WORD;
+       MLastArchivedTime      : WORD;
+       MLastArchivedID        : LONGINT;
+       MLastUpdatedDate       : WORD;
+       MLastUpdatedTime       : WORD;
+       MLastUpdatedID         : LONGINT;
+       MLastAccessedDate      : WORD;
+       MInheritanceGrantMask  : WORD;
+       MInheritanceRevokeMask : WORD;
+       MMaximumSpace          : LONGINT;
+       MLastUpdatedInSeconds  : LONGINT
+     END;
+     
+CONST MModifyNameBit                 = $0001;
+      MFileAtrributesBit             = $0002;
+      MCreateDateBit                 = $0004;
+      MCreateTimeBit                 = $0008;
+      MOwnerIDBit                    = $0010;
+      MLastArchivedDateBit           = $0020; 
+      MLastArchivedTimeBit           = $0040;
+      MLastArchivedIDBit             = $0080;
+      MLastUpdatedDateBit            = $0100;
+      MLastUpdatedTimeBit            = $0200;
+      MLastUpdatedIDBit              = $0400;
+      MLastAccessedDateBit           = $0800;
+      MInheritanceRestrictionMaskBit = $1000; 
+      MMaximumSpaceBit               = $2000;
+      MLastUpdatedInSecondsBit       = $4000;
+
 // 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';
+FUNCTION _ChangeDirectoryEntry (PathName : PCHAR; VAR ModyStruct : NWModifyStructure; ModifyBits, AllowWildcard : LONGINT) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'ChangeDirectoryEntry';
 
 // get fileno from stream
 FUNCTION _fileno (Handle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fileno';
@@ -209,22 +240,22 @@ FUNCTION GetServerInformation(returnSize:longint; serverInfo:pFILE_SERV_INFO):lo
 // 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_attr                : LONGINT;
+    d_time                : WORD;           {modification time}
+    d_date                : WORD;           {modification date}
+    d_size                : LONGINT;        {filesize}
+    d_ino                 : LONGINT;        {serial number}
+    d_dev                 : LONGINT;        {volume number}
+    d_cdatetime           : time_t;         {creation date and time}
+    d_adatetime           : time_t;         {last access - files only}
+    d_bdatetime           : time_t;         {last archive date and time}
+    d_uid                 : LONGINT;        {owner id (object id) }
+    d_archivedID          : LONGINT;
+    d_updatedID           : LONGINT;
+    d_nameDOS             : ARRAY [0..12] OF CHAR;
     d_inheritedRightsMask : WORD;
     d_originatingNameSpace: BYTE;
-    d_ddatetime           : LONGINT;
+    d_ddatetime           : time_t;         {deleted date time}
     d_deletedID           : LONGINT;
     {---- new fields starting in v4.11 ----}
     d_name                : ARRAY [0..255] OF CHAR;  { enty's namespace name }
@@ -252,9 +283,36 @@ TYPE NWDirEnt =
                                  VAR volumeisRemovable   : WORD) : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetVolumeInfoWithNumber';
   FUNCTION _GetNumberOfVolumes : LONGINT; CDECL; EXTERNAL NitNlm NAME 'GetNumberOfVolumes';
 
+// Screen/Keyboad
+PROCEDURE _CopyToScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL ThreadsNlm NAME 'CopyToScreenMemory';
+PROCEDURE _CopyFromScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL ThreadsNlm NAME 'CopyFromScreenMemory';
+FUNCTION  _DisplayInputCursor : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'DisplayInputCursor';
+FUNCTION  _HideInputCursor : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'HideInputCursor';
+FUNCTION  _SetPositionOfInputCursor (row,col : WORD): LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'SetPositionOfInputCursor';
+PROCEDURE _GotoXY (col, row : WORD); CDECL; EXTERNAL ThreadsNlm NAME 'gotoxy';
+FUNCTION  _GetSizeOfScreen (VAR height,width : WORD): LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'GetSizeOfScreen';
+FUNCTION  _IsColorMonitor : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'IsColorMonitor';
+PROCEDURE _RingTheBell; CDECL; EXTERNAL ThreadsNlm NAME 'RingTheBell';
+FUNCTION  _SetCursorShape (startline,endline : BYTE) : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'SetCursorShape';
+FUNCTION  _GetCursorShape (VAR startline,endline : BYTE) : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'GetCursorShape';
+FUNCTION  _wherex : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'wherex';
+FUNCTION  _wherey : WORD; CDECL; EXTERNAL ThreadsNlm NAME 'wherey';
+PROCEDURE _clrscr; CDECL; EXTERNAL ThreadsNlm NAME 'clrscr';
+FUNCTION  _kbhit : LONGINT; CDECL; EXTERNAL ThreadsNlm NAME 'kbhit';
+FUNCTION  _getch : CHAR; CDECL; EXTERNAL ThreadsNlm NAME 'getch';
+PROCEDURE _delay (miliseconds : longint); CDECL; EXTERNAL ThreadsNlm NAME 'delay';
+FUNCTION  _SetCtrlCharCheckMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL ThreadsNlm NAME 'SetCtrlCharCheckMode';
+FUNCTION  _SetAutoScreenDestructionMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL ThreadsNlm NAME 'SetAutoScreenDestructionMode';
+
+// Misc
+FUNCTION _memcpy (Dest, Src : POINTER; Len : LONGINT) : POINTER; CDECL; EXTERNAL ThreadsNlm NAME 'memcpy';
+
 {
   $Log$
-  Revision 1.2  2001-04-11 14:17:00  florian
+  Revision 1.3  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.2  2001/04/11 14:17:00  florian
     * added logs, fixed email address of Armin, it is
       [email protected]
 

rtl/netware/objinc.inc

@@ -0,0 +1,87 @@
+{ 2001/04/16 armin: first version for netware }
+
+{$i errno.inc}
+{$i nwsys.inc}
+
+FUNCTION errno : LONGINT;
+BEGIN
+  errno := __get_errno_ptr^;
+END;
+
+FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+VAR NWMode : longint;
+BEGIN
+  NWMode:=0;
+  if Mode=stCreate then
+  Begin
+     NWMode:=O_Creat;
+     NWMode:=NWMode or O_RdWr;
+  end
+  else
+   Begin
+     Case (Mode and 3) of
+      0 : NWMode:=NWMode or O_RdOnly;
+      1 : NWMode:=NWMode or O_WrOnly;
+      2 : NWMode:=NWMode or O_RdWr;
+     end;
+   end;
+  FileOpen:=_open (pchar(@FileName[0]),NWMode,0);
+  If FileOpen=-1 then FileOpen:=0;
+  DosStreamError:=Errno;
+END;
+
+FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
+Var BytesMoved: Sw_Word): Word;
+BEGIN
+  BytesMoved:=_read (Handle,@BufferArea,BufferLength);
+  IF BytesMoved = -1 THEN
+  BEGIN
+    DosStreamError:=Errno;
+    FileRead:=Errno;
+  END ELSE
+  BEGIN
+    DosStreamError:=0;
+    FileRead:=0;
+  END;
+END;
+
+FUNCTION FileWrite (Handle:  THandle; Var BufferArea; BufferLength: Sw_Word;
+Var BytesMoved: Sw_Word): Word;
+BEGIN
+  BytesMoved:=_write (Handle,@BufferArea,BufferLength);
+  IF BytesMoved = -1 THEN
+  BEGIN
+    DosStreamError:=Errno;
+    FileWrite:=Errno;
+  END ELSE
+  BEGIN
+    DosStreamError:=0;
+    FileWrite:=0;
+  END;
+END;
+
+FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
+VAR NewPos: LongInt): Word;
+
+BEGIN
+  NewPos:=_lseek (Handle,Pos,MoveType);
+  IF NewPos = -1 THEN
+    SetFilePos:=Errno
+  ELSE
+    SetFilePos := 0;    
+END;
+
+FUNCTION FileClose (Handle: THandle): Word;
+BEGIN
+  _Close (Handle);
+  DosStreamError:=Errno;
+  FileClose := Errno;
+END;
+
+FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
+BEGIN
+  if _chsize (Handle, FileSize) = -1 then
+    SetFileSize := Errno
+  else
+    SetFileSize := 0;    
+END;

rtl/netware/sockets.pp

@@ -0,0 +1,178 @@
+{ Netware:UNTESTED !!
+    $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.
+
+ **********************************************************************}
+unit Sockets;
+Interface
+
+const
+ {$Ifndef BSD}
+  { Adress families, Linux specific }
+  AF_AX25         = 3;      { Amateur Radio AX.25          }
+  AF_IPX          = 4;      { Novell IPX                   }
+  AF_APPLETALK    = 5;      { Appletalk DDP                }
+  AF_NETROM       = 6;      { Amateur radio NetROM         }
+  AF_BRIDGE       = 7;       { Multiprotocol bridge         }
+  AF_AAL5         = 8;       { Reserved for Werner's ATM    }
+  AF_X25          = 9;       { Reserved for X.25 project    }
+  AF_INET6        = 10;      { IP version 6                 }
+  AF_MAX          = 12;
+
+  SOCK_PACKET     = 10;
+
+  PF_AX25         = AF_AX25;
+  PF_IPX          = AF_IPX;
+  PF_APPLETALK    = AF_APPLETALK;
+  PF_NETROM       = AF_NETROM;
+  PF_BRIDGE       = AF_BRIDGE;
+  PF_AAL5         = AF_AAL5;
+  PF_X25          = AF_X25;
+  PF_INET6        = AF_INET6;
+
+  PF_MAX          = AF_MAX;
+ {$ELSE}
+ {BSD}
+  AF_LOCAL        =1;              { local to host (pipes, portals) }
+  AF_IMPLINK      =3;               { arpanet imp addresses }
+  AF_PUP          =4;              { pup protocols: e.g. BSP }
+  AF_CHAOS        =5;               { mit CHAOS protocols }
+  AF_NS           =6;              { XEROX NS protocols }
+  AF_ISO          =7;              { ISO protocols }
+  AF_OSI          =AF_ISO;
+  AF_ECMA         =8;              { European computer manufacturers }
+  AF_DATAKIT      =9;              { datakit protocols }
+  AF_CCITT        =10;             { CCITT protocols, X.25 etc }
+  AF_SNA          =11;             { IBM SNA }
+  AF_DECnet       =12;             { DECnet }
+  AF_DLI          =13;             { DEC Direct data link interface }
+  AF_LAT          =14;             { LAT }
+  AF_HYLINK       =15;             { NSC Hyperchannel }
+  AF_APPLETALK    =16;             { Apple Talk }
+  AF_ROUTE        =17;             { Internal Routing Protocol }
+  AF_LINK         =18;             { Link layer interface }
+  pseudo_AF_XTP   =19;             { eXpress Transfer Protocol (no AF) }
+  AF_COIP         =20;             { connection-oriented IP, aka ST II }
+  AF_CNT          =21;             { Computer Network Technology }
+  pseudo_AF_RTIP  =22;             { Help Identify RTIP packets }
+  AF_IPX          =23;             { Novell Internet Protocol }
+  AF_SIP          =24;             { Simple Internet Protocol }
+  pseudo_AF_PIP   =25;             { Help Identify PIP packets }
+  AF_ISDN         =26;             { Integrated Services Digital Network}
+  AF_E164         =AF_ISDN;        { CCITT E.164 recommendation }
+  pseudo_AF_KEY   =27;             { Internal key-management function }
+  AF_INET6        =28;             { IPv6 }
+  AF_NATM         =29;             { native ATM access }
+  AF_ATM          =30;             { ATM }
+  pseudo_AF_HDRCMPLT=31;           { Used by BPF to not rewrite headers
+                                    in interface output routine}
+  AF_NETGRAPH     =32;             { Netgraph sockets }
+  AF_MAX          =33;
+
+  SOCK_MAXADDRLEN =255;             { longest possible addresses }
+
+{
+* Protocol families, same as address families for now.
+}
+  PF_LOCAL        =AF_LOCAL;
+  PF_IMPLINK      =AF_IMPLINK;
+  PF_PUP          =AF_PUP;
+  PF_CHAOS        =AF_CHAOS;
+  PF_NS           =AF_NS;
+  PF_ISO          =AF_ISO;
+  PF_OSI          =AF_ISO;
+  PF_ECMA         =AF_ECMA;
+  PF_DATAKIT      =AF_DATAKIT;
+  PF_CCITT        =AF_CCITT;
+  PF_SNA          =AF_SNA;
+  PF_DECnet       =AF_DECnet;
+  PF_DLI          =AF_DLI;
+  PF_LAT          =AF_LAT;
+  PF_HYLINK       =AF_HYLINK;
+  PF_APPLETALK    =AF_APPLETALK;
+  PF_ROUTE        =AF_ROUTE;
+  PF_LINK         =AF_LINK;
+  PF_XTP          =pseudo_AF_XTP;  { really just proto family, no AF }
+  PF_COIP         =AF_COIP;
+  PF_CNT          =AF_CNT;
+  PF_SIP          =AF_SIP;
+  PF_IPX          =AF_IPX;         { same format as AF_NS }
+  PF_RTIP         =pseudo_AF_RTIP; { same format as AF_INET }
+  PF_PIP          =pseudo_AF_PIP;
+  PF_ISDN         =AF_ISDN;
+  PF_KEY          =pseudo_AF_KEY;
+  PF_INET6        =AF_INET6;
+  PF_NATM         =AF_NATM;
+  PF_ATM          =AF_ATM;
+  PF_NETGRAPH     =AF_NETGRAPH;
+  PF_MAX          =AF_MAX;
+{$ENDIF}
+
+type
+  TUnixSockAddr = packed Record
+    family:word; { was byte, fixed }
+    path:array[0..108] of char;
+    end;
+
+{$i socketsh.inc}
+
+{ unix socket specific functions }
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+Function Bind(Sock:longint;const addr:string):boolean;
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+
+Implementation
+{$ifndef netware}
+Uses Unix;
+{$endif}
+
+{ Include filerec and textrec structures }
+{$i filerec.inc}
+{$i textrec.inc}
+{******************************************************************************
+                          Kernel Socket Callings
+******************************************************************************}
+
+{$ifdef BSD}
+ {$I bsdsock.inc}
+{$else}
+ {$ifdef netware}
+   {$I nwsock.inc}
+ {$else}
+   {$I linsock.inc}
+ {$endif}  
+{$endif}
+
+{$i sockets.inc}
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.3  2001/01/21 20:21:40  marco
+   * Rename fest II. Rtl OK
+
+  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/09/11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+  Revision 1.2  2000/07/13 11:33:49  michael
+  + removed logs
+ 
+}

rtl/netware/system.pp

@@ -17,6 +17,7 @@ unit system;
 
 { 2000/09/03 armin: first version
   2001/03/08 armin: changes for fpc 1.1
+  2001/04/16 armin: dummy envp for heaptrc-unit
 }
 
 interface
@@ -57,9 +58,18 @@ VAR
    ArgC   : INTEGER;
    ArgV   : ppchar;
 
+CONST   
+   envp   : ppchar = nil;   {dummy to make heaptrc happy}
+
 
 implementation
 
+{ ?? why does this not work ?? DEFINE FPC_SYSTEM_HAS_MOVE}
+{procedure move (const source; var dest; count : longint);
+begin
+  _memcpy (@dest, @source, count);
+end;}
+
 { include system independent routines }
 
 {$I system.inc}
@@ -76,7 +86,7 @@ end;
 
 
 
-procedure PascalMain;external name 'PASCALMAIN';
+procedure PASCALMAIN;external name 'PASCALMAIN';
 procedure fpc_do_exit;external name 'FPC_DO_EXIT';
 
 
@@ -545,10 +555,16 @@ Begin
   Setup_Arguments;
 { Reset IO Error }
   InOutRes:=0;
+  {Delphi Compatible}
+  IsLibrary := FALSE;
+  IsConsole := TRUE;
 End.
 {
   $Log$
-  Revision 1.2  2001-04-11 14:17:00  florian
+  Revision 1.3  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.2  2001/04/11 14:17:00  florian
     * added logs, fixed email address of Armin, it is
       [email protected]
 

rtl/netware/sysutils.pp

@@ -15,8 +15,6 @@
 
  **********************************************************************}
 
-{currently nothing is implemented !}
-
 unit sysutils;
 interface
 
@@ -25,14 +23,48 @@ interface
 {$H+}
 
 uses DOS;
-//  Unix,errors;
 
 {$I nwsys.inc}
 {$I errno.inc}
 
+TYPE
+  TNetwareFindData =
+  RECORD
+    DirP  : PNWDirEnt;               { used for opendir }
+    EntryP: PNWDirEnt;               { and readdir }
+    Magic : WORD;                    { to avoid abends with uninitialized TSearchRec }
+  END;
+  
+
+
 { Include platform independent interface part }
 {$i sysutilh.inc}
 
+{ additional NetWare file flags}
+CONST
+  faSHARE              = $00000080;  { Sharable file                   }
+
+  faNO_SUBALLOC        = $00000800;  { Don't sub alloc. this file      }
+  faTRANS              = $00001000;  { Transactional file (TTS usable) }
+  faREADAUD            = $00004000;  { Read audit                      }
+  faWRITAUD            = $00008000;  { Write audit                     }
+
+  faIMMPURG            = $00010000;  { Immediate purge                 }
+  faNORENAM            = $00020000;  { Rename inhibit                  }
+  faNODELET            = $00040000;  { Delete inhibit                  }
+  faNOCOPY             = $00080000;  { Copy inhibit                    }
+
+  faFILE_MIGRATED      = $00400000;  { File has been migrated          }
+  faDONT_MIGRATE       = $00800000;  { Don't migrate this file         }
+  faIMMEDIATE_COMPRESS = $02000000;  { Compress this file immediately  }
+  faFILE_COMPRESSED    = $04000000;  { File is compressed              }
+  faDONT_COMPRESS      = $08000000;  { Don't compress this file        }
+  faCANT_COMPRESS      = $20000000;  { Can't compress this file        }
+  faATTR_ARCHIVE       = $40000000;  { Entry has had an EA modified,   }
+                                     { an ownerID changed, or trustee  }
+                                     { info changed, etc.              }
+
+
 
 implementation
 
@@ -45,18 +77,16 @@ implementation
 ****************************************************************************}
 
 Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
-
-Var LinuxFlags : longint;
-
+VAR NWOpenFlags : longint;
 BEGIN
-  {LinuxFlags:=0;
+  NWOpenFlags:=0;
   Case (Mode and 3) of
-    0 : LinuxFlags:=LinuxFlags or Open_RdOnly;
-    1 : LinuxFlags:=LinuxFlags or Open_WrOnly;
-    2 : LinuxFlags:=LinuxFlags or Open_RdWr;
+    0 : NWOpenFlags:=NWOpenFlags or O_RDONLY;
+    1 : NWOpenFlags:=NWOpenFlags or O_WRONLY;
+    2 : NWOpenFlags:=NWOpenFlags or O_RDWR;
   end;
-  FileOpen:=fdOpen (FileName,LinuxFlags);
-  }
+  FileOpen := _open (pchar(FileName),NWOpenFlags,0);
+
   //!! We need to set locking based on Mode !!
 end;
 
@@ -64,211 +94,190 @@ end;
 Function FileCreate (Const FileName : String) : Longint;
 
 begin
-  //FileCreate:=fdOpen(FileName,Open_RdWr or Open_Creat or Open_Trunc);
+  FileCreate:=_open(Pchar(FileName),O_RdWr or O_Creat or O_Trunc,0);
 end;
 
 
 Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
 
 begin
-  //FileRead:=fdRead (Handle,Buffer,Count);
+  FileRead:=_read (Handle,@Buffer,Count);
 end;
 
 
 Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
 
 begin
-  //FileWrite:=fdWrite (Handle,Buffer,Count);
+  FileWrite:=_write (Handle,@Buffer,Count);
 end;
 
 
 Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
 
 begin
-  //FileSeek:=fdSeek (Handle,FOffset,Origin);
+  FileSeek:=_lseek (Handle,FOffset,Origin);
 end;
 
 
 Procedure FileClose (Handle : Longint);
 
 begin
-  //fdclose(Handle);
+  _close(Handle);
 end;
 
 Function FileTruncate (Handle,Size: Longint) : boolean;
 
 begin
-  //FileTruncate:=fdtruncate(Handle,Size);
+  FileTruncate:=(_chsize(Handle,Size) = 0);
 end;
 
 Function FileAge (Const FileName : String): Longint;
 
-//Var Info : Stat;
-//    Y,M,D,hh,mm,ss : word;
-
+VAR Info : NWStatBufT;
+    PTM  : PNWTM;
 begin
-{  If not fstat (FileName,Info) then
+  If _stat (pchar(FileName),Info) <> 0 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;}
+      PTM := _localtime (Info.st_mtime);
+      IF PTM = NIL THEN
+        exit(-1)
+      else
+        WITH PTM^ DO
+          Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+    end;
 end;
 
 
 Function FileExists (Const FileName : String) : Boolean;
-
-//Var Info : Stat;
-
-begin
-  //FileExists:=fstat(filename,Info);
-end;
-
-{
-Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
-
+VAR Info : NWStatBufT;
 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;
+  FileExists:=(_stat(pchar(filename),Info) = 0);
 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;
+PROCEDURE find_setfields (VAR f : TsearchRec);
+VAR T : Dos.DateTime;
+BEGIN
+  WITH F DO
+  BEGIN
+    IF FindData.Magic = $AD01 THEN
+    BEGIN
+      {attr := FindData.EntryP^.d_attr AND $FF;}  // lowest 8 bit -> same as dos
+      attr := FindData.EntryP^.d_attr;   { return complete netware attributes }
+      UnpackTime(FindData.EntryP^.d_time + (LONGINT (FindData.EntryP^.d_date) SHL 16), T);
+      time := DateTimeToFileDate(EncodeDate(T.Year,T.Month,T.day)+EncodeTime(T.Hour,T.Min,T.Sec,0));
+      size := FindData.EntryP^.d_size;
+      name := strpas (FindData.EntryP^.d_nameDOS);
+    END ELSE
+    BEGIN
+      FillChar (f,SIZEOF(f),0);
+    END;
+  END;
+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);}
+  IF path = '' then
+    exit (18);
+  Rslt.FindData.DirP := _opendir (pchar(Path));
+  IF Rslt.FindData.DirP = NIL THEN
+    exit (18);
+  IF attr <> faAnyFile THEN
+    _SetReaddirAttribute (Rslt.FindData.DirP, attr);
+  Rslt.FindData.Magic := $AD01;
+  Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
+  IF Rslt.FindData.EntryP = NIL THEN
+  BEGIN
+    _closedir (Rslt.FindData.DirP);
+    Rslt.FindData.DirP := NIL;
+    exit (18);
+  END ELSE
+  BEGIN
+    find_setfields (Rslt);
+    exit (0);
+  END;
 end;
 
 
 Function FindNext (Var Rslt : TSearchRec) : Longint;
 
 begin
-//  Result:=DoFind (Rslt);
+  IF Rslt.FindData.Magic <> $AD01 THEN
+    exit (18);
+  Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
+  IF Rslt.FindData.EntryP = NIL THEN
+    exit (18)
+  ELSE
+  BEGIN
+    find_setfields (Rslt);
+    exit (0);
+  END;
 end;
 
 
 Procedure FindClose (Var F : TSearchrec);
-
-//Var GlobSearchRec : PGlobSearchRec;
-
 begin
-  {GlobSearchRec:=PGlobSearchRec(F.FindHandle);
-  GlobFree (GlobSearchRec^.GlobHandle);
-  Dispose(GlobSearchRec);}
+  IF F.FindData.Magic = $AD01 THEN
+  BEGIN
+    IF F.FindData.DirP <> NIL THEN
+      _closedir (F.FindData.DirP);
+    F.FindData.Magic := 0;
+    F.FindData.DirP := NIL;
+    F.FindData.EntryP := NIL;
+  END;
 end;
 
 
 Function FileGetDate (Handle : Longint) : Longint;
-
-//Var Info : Stat;
-
+Var Info : NWStatBufT;
+    PTM  : PNWTM;
 begin
-  {If Not(FStat(Handle,Info)) then
+  If _fstat(Handle,Info) <> 0 then
     Result:=-1
   else
-    Result:=Info.Mtime;}
+    begin
+      PTM := _localtime (Info.st_mtime);
+      IF PTM = NIL THEN
+        exit(-1)
+      else
+        WITH PTM^ DO
+          Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+    end;
 end;
 
 
 Function FileSetDate (Handle,Age : Longint) : Longint;
-
 begin
-  // Impossible under Linux from FileHandle !!
+  { i think its impossible under netware from FileHandle. I dident found a way to get the
+    complete pathname of a filehandle, that would be needed for ChangeDirectoryEntry }
   FileSetDate:=-1;
+  ConsolePrintf ('warning: fpc sysutils.FileSetDate not implemented'#13#10,0);
 end;
 
 
 Function FileGetAttr (Const FileName : String) : Longint;
-
-//Var Info : Stat;
-
+Var Info : NWStatBufT;
 begin
-{  If Not FStat (FileName,Info) then
+  If _stat (pchar(FileName),Info) <> 0 then
     Result:=-1
   Else
-    Result:=LinuxToWinAttr(Pchar(FileName),Info);}
+    Result := Info.st_attr AND $FFFF;
 end;
 
 
 Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-
+VAR MS : NWModifyStructure;
 begin
-  Result:=-1;
+  FillChar (MS, SIZEOF (MS), 0);
+  if _ChangeDirectoryEntry (PChar (Filename), MS, MFileAtrributesBit, 0) <> 0 then
+    exit (-1)
+  else
+    exit (0);
 end;
 
 
@@ -282,12 +291,11 @@ end;
 Function RenameFile (Const OldName, NewName : String) : Boolean;
 
 begin
-//  RenameFile:=Unix.FRename(OldNAme,NewName);
+  RenameFile:=(_rename(pchar(OldName),pchar(NewName)) = 0);
 end;
 
 
 Function FileSearch (Const Name, DirList : String) : String;
-
 begin
   FileSearch:=Dos.FSearch(Name,Dirlist);
 end;
@@ -340,6 +348,8 @@ Begin
    Diskfree:=int64(fs.bavail)*int64(fs.bsize)
   else
    Diskfree:=-1;}
+  DiskFree := -1;
+  ConsolePrintf ('warning: fpc sysutils.diskfree not implemented'#13#10,0);
 End;
 
 
@@ -352,6 +362,8 @@ Begin
    DiskSize:=int64(fs.blocks)*int64(fs.bsize)
   else
    DiskSize:=-1;}
+  DiskSize := -1;
+  ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10,0);
 End;
 
 
@@ -394,6 +406,7 @@ end;
 
 procedure Beep;
 begin
+  _RingTheBell;
 end;
 
 
@@ -450,7 +463,7 @@ end;
 Function GetEnvironmentVariable(Const EnvVar : String) : String;
 
 begin
-//  Result:=StrPas(Unix.Getenv(PChar(EnvVar)));
+  Result:=StrPas(_getenv(PChar(EnvVar)));
 end;
 
 
@@ -468,7 +481,10 @@ end.
 {
 
   $Log$
-  Revision 1.2  2001-04-11 14:17:00  florian
+  Revision 1.3  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.2  2001/04/11 14:17:00  florian
     * added logs, fixed email address of Armin, it is
       [email protected]
 

rtl/netware/tests/Makefile

@@ -0,0 +1,33 @@
+# Makefile for freepascal nlm-test
+# Needs working nlmconv + i386-netware-ld
+# AD 8/2000
+
+UNITDIR = /usr/lib/fpc/1.1/units/netware/rtl
+PPC386OPT = -a -al -Or -O3 -XX -Tnetware -Fi$(UNITDIR)
+INCLUDES = -Fo$(UNITDIR) -Fu$(UNITDIR)
+
+OBJS = test.on
+
+%.on:	%.pas
+	ppc386 $(PPC386OPT) $(INCLUDES) $*.pas
+
+all:	$(OBJS)
+
+#test.nlm: $(OBJS)
+#	nlmconv -Ttest.def
+
+# mount netware and copy test.nlm to sys:test on 4.11 and 5.1 server
+install:	all
+	[ -d nw ] || mkdir nw
+	ncpmount -S FS-DEVELOP -U linux.home.ad -V sys -n nw
+	cp -f test.nlm nw/test/test.nlm
+	umount nw
+	ncpmount -S FS-AD -U linux.home.ad -V sys -n nw
+	cp -f test.nlm nw/test/test.nlm
+	umount nw
+
+clean:
+	rm -f *.on *.nlm *.ppn *.s *.bak *.o
+	[ -d nw ] && rmdir nw
+
+dist:		clean

rtl/netware/tests/test.pas

@@ -0,0 +1,604 @@
+Program Test;
+{$Description Test for FreePascal Netware-RTL}
+{$Version 1.1.0}
+
+{$I-}
+{$Mode Delphi}
+
+USES Strings, Dos, SysUtils, CRT, Video, Keyboard;
+
+TYPE Str255 = STRING [255];
+
+PROCEDURE ErrorCheck (Action,FN : STRING);
+VAR Err : INTEGER;
+BEGIN
+  Err := IOResult;
+  IF Err = 0 THEN
+  BEGIN
+    WriteLn (' OK');
+    EXIT;
+  END;
+  WriteLn (' ! Error (',Action,' in ',FN,'), IOResult: ',Err);
+  HALT;
+END;
+
+PROCEDURE FileTest;
+CONST TestFN = 'SYS:TEST/TEST.DAT';
+      NumBlocks = 100;
+      BlockSize = 1024;
+VAR F      : FILE;
+    Err    : LONGINT;
+    Buffer : ARRAY [0..BlockSize-1] OF BYTE;
+    Written: LONGINT;
+    I      : BYTE;
+    J      : LONGINT;
+BEGIN
+  Write ('Creating ',TestFN);
+  Assign (F,TestFN);
+  ReWrite (F,1);
+  ErrorCheck ('Create',TestFN);
+  FOR I := 1 TO NumBlocks DO
+  BEGIN
+    FillChar (Buffer, SIZEOF (Buffer), CHAR(I));
+    Write ('BlockWrite');
+    BlockWrite (F,Buffer,SIZEOF(Buffer));
+    ErrorCheck ('BlockWrite',TestFN);
+  END;
+  Write ('Seek');
+  Seek (F,0);
+  ErrorCheck ('Seek',TestFN);
+  FOR I := 1 TO NumBlocks DO
+  BEGIN
+    Write ('BlockRead');
+    BlockRead (F,Buffer,SIZEOF(Buffer));
+    ErrorCheck ('BlockRead',TestFN);
+    FOR J := LOW (Buffer) TO HIGH (Buffer) DO
+      IF Buffer[J] <> I THEN
+      BEGIN
+        WriteLn ('Verify-Error');
+        HALT;
+      END;
+  END;
+  Write ('Close');
+  Close (F);
+  ErrorCheck ('Close',TestFN);
+  Write ('Erase');
+  Erase (F);
+  ErrorCheck ('Erase',TestFN);
+END;
+
+PROCEDURE TextFileTest;
+CONST NumLines = 100;
+      FN = 'SYS:TEST/TEST.TXT';
+VAR I : LONGINT;
+    S,S1 : STRING;
+    T : TEXT;
+BEGIN
+  Assign (T,FN);
+  ReWrite (T);
+  ErrorCheck ('ReWrite',FN);
+  FOR I := 1 TO NumLines DO
+  BEGIN
+    Str (I, S);
+    Write ('WriteLn');
+    WriteLn (T, S);
+    ErrorCheck ('WriteLn',FN);
+  END;
+  Write ('Close'); Close (T); ErrorCheck ('Close',FN);
+  Assign (T,FN);
+  Reset (T);
+  ErrorCheck ('Reset',FN);
+  FOR I := 1 TO NumLines DO
+  BEGIN
+    Str (I, S1);
+    Write ('ReadLn');
+    ReadLn (T, S);
+    ErrorCheck ('ReadLn',FN);
+    IF (S <> S1) THEN
+    BEGIN
+      WriteLn ('Verify-Error "',S,'" <> "',S1,'"');
+      HALT;
+    END;
+  END;
+  Write ('Close'); Close (T); ErrorCheck ('Close',FN);
+  Write ('Erase'); Erase (T); ErrorCheck ('Erase',FN);
+END;
+
+
+PROCEDURE MemTest;
+CONST NumBlocks = 1000;
+      BlockSize = 1024;
+VAR I : LONGINT;
+    P : ARRAY [0..NumBlocks-1] OF POINTER;
+BEGIN
+  Write ('GetMem/FreeMem Test');
+  FillChar (P, SIZEOF(P), 0);
+  FOR I := 0 TO NumBlocks-1 DO
+  BEGIN
+    Write ('g');
+    GetMem (P[I],BlockSize);
+    FillChar (P[I]^,BlockSize,$FF);
+  END;
+  FOR I := 0 TO NumBlocks-1 DO
+  BEGIN
+    Write ('f');
+    FreeMem (P[I],BlockSize);
+  END;
+  WriteLn (' Ok');
+END;
+
+PROCEDURE DosTest;
+VAR Year, Month, Day, DayVal, hour, Minute, Second, Sec100 : WORD;
+BEGIN
+  GetDate (Year,Month, Day, DayVal);
+  WriteLn ('GetDate: ',Year,'/',Month,'/',Day);
+  GetTime (hour, Minute, Second, Sec100);
+  WriteLn ('GetTime: ',Hour,':',Minute,':',Second,':',Sec100);
+END;
+
+PROCEDURE ExceptTest;
+BEGIN
+  TRY
+    WriteLn ('Raising Exception');
+    Raise (Exception.Create (''));
+  EXCEPT
+    WriteLn ('Fine, Except-Handler called');
+  END;
+END;
+
+{PROCEDURE ReadDirTest;
+VAR EntryH, DirH : PNWDirEnt;
+    T : DateTime;
+BEGIN
+  DirH := _opendir ('SYS:TEST/*.*');
+  IF DirH <> NIL THEN
+  BEGIN
+    EntryH := _readdir (DirH);
+    WHILE (EntryH <> NIL) DO
+    BEGIN
+      unpacktime (EntryH^.d_time + (LONGINT (EntryH^.d_date) SHL 16),T);
+      WriteLn ('Name: "', EntryH^.d_nameDOS,'" size:',EntryH^.d_size,' namespace-name: "',EntryH^.d_name,'" ',T.Day,'.',T.Month,'.',T.Year,'  ',T.Hour,':',T.Min,':',T.Sec);
+      EntryH := _readdir (DirH);
+    END;
+    _closedir (DirH);
+  END ELSE
+    WriteLn ('opendir failed');
+END;}
+
+
+PROCEDURE FindTest;
+VAR f : Dos.SearchRec;
+    t : Dos.DateTime;
+    s : string [5];
+    fh: FILE;
+    time: LONGINT;
+    attr: word;
+BEGIN
+  Dos.FindFirst ('SYS:TEST\*.*',anyfile,f);
+  WHILE Dos.DosError = 0 DO
+  BEGIN
+    unpacktime (f.time,t);
+    IF f.attr AND directory <> 0 THEN
+      S := '<DIR>'
+    ELSE
+      S := '';
+    WriteLn (f.Name:15,f.attr:6,S:6,f.size:6,' ',t.Month:2,'/',t.day:2,'/',t.year,'  ',t.hour:2,':',t.min:2,':',t.sec:2);
+    Dos.FindNext (f);
+  END;
+  Dos.FindClose (f);
+  {WriteLn ('Directories:');
+  Dos.FindFirst ('SYS:SYSTEM\*.*',directory,f);
+  WHILE Dos.DosError = 0 DO
+  BEGIN
+    WriteLn (f.Name:15);
+    Dos.FindNext (f);
+  END;
+  Dos.FindClose (f);}
+  WriteLn;
+  Assign (FH,ParamStr(0));
+  Reset (FH,1);
+  ErrorCheck ('Reset',ParamStr(0));
+  Getftime (FH, time);
+  Getfattr (FH, attr);
+  Close (FH);
+  unpacktime (time,t);
+  WriteLn (ParamStr(0),attr:6,' ',t.Month:2,'/',t.day:2,'/',t.year,'  ',t.hour:2,':',t.min:2,':',t.sec:2);
+  WriteLn ('GetEnv (XX): "',GetEnv ('XX'),'"');
+END;
+
+{PROCEDURE VolInfo;
+VAR I : LONGINT;
+    Buf: ARRAY [0..255] OF CHAR;
+    TotalBlocks  : WORD;
+    SectorsPerBlock : WORD;
+    availableBlocks : WORD;
+    totalDirectorySlots : WORD;
+    availableDirSlots   : WORD;
+    volumeisRemovable   : WORD;
+    Err : LONGINT;
+BEGIN
+  WriteLn ('Number of Volumes: ',_GetNumberOfVolumes);
+  FOR I := 0 TO _GetNumberOfVolumes-1 DO
+  BEGIN
+    _GetVolumeName (I,@Buf);
+    WriteLn (I,': "',Buf,'"');
+    Err := _GetVolumeInfoWithNumber (I,@Buf,
+                                 TotalBlocks,
+                                 SectorsPerBlock,
+                                 availableBlocks,
+                                 totalDirectorySlots,
+                                 availableDirSlots,
+                                 volumeisRemovable);
+    IF Err = 0 THEN
+    BEGIN
+      WriteLn ('TotalBlocks: ',TotalBlocks,' Sectors/Block: ',SectorsPerBlock,' avail: ',availableBlocks);
+    END ELSE
+      WriteLn ('Err: ',Err);
+  END;
+  FOR I := 0 TO 5 DO
+  BEGIN
+    WriteLn ('DiskFree(',I,'): ',Dos.DiskFree(I));
+    WriteLn ('DiskSize(',I,'): ',Dos.DiskSize(I));
+  END;
+
+END;}
+
+PROCEDURE CrtTest;
+VAR C : CHAR;
+    I : INTEGER;
+
+    PROCEDURE KeyTest;
+    VAR C : CHAR;
+    BEGIN
+      WriteLn ('Key-Test, CR will be converted to ausgegeben, End with ESC');
+      Repeat
+        C := ReadKey;
+        CASE C OF
+          #0 : Write ('#0');
+          #13: Write (#13#10)
+          ELSE Write (C);
+        END;
+      Until C = #27;
+    END;
+
+    PROCEDURE FillScreen;
+    VAR I : INTEGER;
+    BEGIN
+      ClrScr;
+      TextColor (Green);
+      FOR I := 1 TO 24 DO
+        Write ('12345678901234567890123456789012345678901234567890123456789012345678901234567890');
+      TextColor (Yellow);
+      FOR I := 1 TO 25 DO
+      BEGIN
+        GotoXY (76,I); Write (' ',I,' ');
+      END;
+      TextColor (LightGray);
+    END;
+
+BEGIN
+  {GotoXY (1,1); writeln ('Text @ 1,1');
+  GotoXY (2,2); writeln ('Text @ 2,2');
+  GotoXY (3,3); writeln ('Text @ 3,3');
+  GotoXY (4,4); writeln ('Text @ 4,4, Delay 5 Secs');
+  GotoXY (1,1);
+  IF WhereX <> 1 THEN
+  BEGIN
+    GotoXY (1,10); Write ('WhereX - ERROR');
+  END;
+  GotoXY (1,1);
+  IF WhereY <> 1 THEN
+  BEGIN
+    GotoXY (1,11); Write ('WhereY - ERROR');
+  END;
+
+  Delay (1000);
+  }
+  ClrScr;
+
+  WriteLn ('Empty Screen ');
+  Delay (1000);
+  WriteLn ('Cursoroff '); CursorOff;
+  Delay (1000);
+  WriteLn ('Cursorbig '); CursorBig;
+  Delay (1000);
+  WriteLn ('Cursoron '); CursorOn;
+  LowVideo; Write ('Low '); HighVideo; Write ('High '); LowVideo; Write ('Low ');
+  Delay (1000);
+  KeyTest;
+  FillScreen;
+  Window (10,10,40,15);
+  ClrScr; Write ('Window 10,10,20,15');
+  KeyTest;
+  Window (1,1,80,25);
+  FillScreen;
+  GotoXY (10,10); ClrEol;
+  GotoXY (1,21); Write (' ClrEol @ 10,10 ');
+  ReadKey;
+  FillScreen;
+  GotoXY (10,10); InsLine;
+  GotoXY (1,21); Write (' Insline @ 10,10 ');
+  ReadKey;
+  Write ('Waiting for keypress: ');
+  WHILE NOT Keypressed DO
+  BEGIN
+    Delay (500);
+  END;
+  Write ('OK'); ReadKey;
+  FOR I := 1 TO 5 DO
+  BEGIN
+    Write (^G); Delay (200);
+  END;
+
+
+  Delay (1000);
+  GotoXY (1,25); ClrEol;
+END;
+
+{
+Function FileSetDate (Handle,Age : Longint) : Longint;
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+}
+PROCEDURE SysUtilsTest;
+VAR H,I,Attr : LONGINT;
+    X : ARRAY [0..255] OF CHAR;
+    TD: TDateTime;
+    SR: TSearchRec;
+    ST1,ST2: STRING;
+BEGIN
+  WriteLn ('FileExists SYS:SYSTEM/CLIB.NLM: ',FileExists ('SYS:SYSTEM/CLIB.NLM'));
+  WriteLn ('FileExists SYS:SYSTEM\CLIB.NLM: ',FileExists ('SYS:SYSTEM\CLIB.NLM'));
+  WriteLn ('FileExists SYS:SYSTEM/CLIB.N: ',FileExists ('SYS:SYSTEM/CLIB.N'));
+  WriteLn ('FileExists SYS:SYSTEM\CLIB.N: ',FileExists ('SYS:SYSTEM\CLIB.N'));
+  WriteLn ('FileExists SYS:SYSTEM: ',FileExists ('SYS:SYSTEM\CLIB.N'));
+
+  H := FileOpen ('SYS:TEST/Autoexec.ncf',0);
+  IF H >= 0 THEN
+  BEGIN
+    I := FileRead (H, X, 20); X[20] := #0;
+    WriteLn ('FileRead returned ',I,' Buffer: "',X,'"');
+  END ELSE
+    WriteLn ('FileOpen failed');
+  FileClose (H);
+
+  H := FileAge ('SYS:SYSTEM/CLIB.NLM');
+  TD := FileDateToDateTime (H);
+  WriteLn ('CLIBs file date: ',DateTimeToStr (TD));
+  H := FileAge ('SYS:SYSTEM/DSREPAIR.LOG');
+  TD := FileDateToDateTime (H);
+  WriteLn ('DSREPAIR.LOGs file date: ',DateTimeToStr (TD));
+  H := SysUtils.FindFirst ('SYS:SYSTEM/CLIB.nlm',faAnyFile,SR);
+  IF H = 0 THEN
+  BEGIN
+    WriteLn (SR.Name:20,SR.Size:6,'  ',DateTimeToStr (FileDateToDateTime (SR.time)):20,' ',hexstr (SR.attr,8));
+  END ELSE WriteLn ('FindFirst failed');
+  FindClose (SR);
+
+  H := SysUtils.FindFirst ('SYS:SYSTEM/CLIB.N',faAnyFile,SR);
+  IF H = 0 THEN
+    WriteLn ('FindFirst on non existing file returned 0 !');
+  FindClose (SR);
+
+  H := SysUtils.FindFirst ('SYS:SYSTEM/DSREPAIR.LOG',faAnyFile,SR);
+  IF H = 0 THEN
+  BEGIN
+    WriteLn (SR.Name:20,SR.Size:6,'  ',DateTimeToStr (FileDateToDateTime (SR.time)):20,' ',hexstr (SR.attr,8));
+  END ELSE WriteLn ('FindFirst failed');
+  FindClose (SR);
+
+  H := FileOpen ('SYS:SYSTEM/DSRepair.log',0);
+  IF H >= 0 THEN
+  BEGIN
+    I := FileGetDate (H);
+    FileClose (H);
+    TD := FileDateToDateTime (I);
+    WriteLn ('DSREPAIR.LOGs file date via FileGetDate: ',DateTimeToStr (TD));
+  END ELSE WriteLn ('FileOpen failed');
+  Attr := FileGetAttr ('SYS:SYSTEM/CLIB.NLM');
+  WriteLn ('Attr of clib: ',hexstr (Attr,8));
+
+  chdir ('sys:test');
+  H := FileCreate ('TEST12.DAT');
+  IF H >= 0 THEN
+  BEGIN
+    IF NOT FileExists ('SYS:TEST/TEST12.DAT') THEN
+      WriteLn ('FileCreate returned ok but FileExists returned false !');
+    FillChar (X,SIZEOF(X),BYTE('X'));
+    I := FileWrite (H,X,SIZEOF(X));
+    WriteLn ('FileWrite returned ',I);
+    IF I = SIZEOF (X) THEN
+    BEGIN
+      IF NOT FileTruncate (H,SIZEOF(X) DIV 2) THEN
+        WriteLn ('FileTruncate failed');
+    END;
+    FileClose (H);
+
+    I := SysUtils.FindFirst ('TEST12.DAT',faAnyFile,SR);
+    IF I <> 0 THEN
+      WriteLn ('FindFirst failed')
+    ELSE
+     IF SR.Size <> (SIZEOF (X) DIV 2) THEN
+      WriteLn ('FileTruncate: wrong FileSize after truncate (',SR.Size,')');
+    FindClose (SR);
+
+    IF NOT RenameFile ('TEST12.DAT','TEST12.BAK') THEN
+      WriteLn ('RenameFile failed')
+    ELSE
+    BEGIN
+      IF NOT FileExists ('SYS:TEST/TEST12.BAK') THEN
+        WriteLn ('FileRename returned ok but FileExists returned false');
+      IF NOT DeleteFile ('TEST12.BAK') THEN
+        WriteLn ('DeleteFile failed')
+      ELSE
+        IF FileExists ('SYS:TEST/TEST12.BAK') THEN
+          WriteLn ('DeleteFile returned ok but FileExists returned true');
+    END;
+
+  END ELSE WriteLn ('FileCreate failed');
+
+  H := FileCreate ('TEST12.DAT');
+  IF H >= 0 THEN
+  BEGIN
+    FillChar (X,SIZEOF(X),BYTE('X'));
+    FileWrite (H,X,SIZEOF(X));
+    I := FileSeek (H,10,fsFromBeginning);
+    X[0] := '0';
+    FileWrite (H,X,1);
+    IF I <> 10 THEN WriteLn ('FileSeek returned wrong result at 10 (',I,')');
+    I := FileSeek (H,10,fsFromCurrent);
+    X[0] := '1';
+    FileWrite (H,X,1);
+    IF I <> 21 THEN WriteLn ('FileSeek returned wrong result at 21 (',I,')');
+    I := FileSeek (H,-10,fsFromEnd);
+    X[0] := '2';
+    FileWrite (H,X,1);
+    IF I <> SIZEOF(X)-10 THEN WriteLn ('FileSeek returned wrong result at End-10 (',I,')');
+    FileClose (H);
+  END ELSE WriteLn ('FileCreate failed');
+
+  ST1 := 'SYS:ETC;SYS:TEST;SYS:SYSTEM/;SYS:PUBLIC';
+  ST2 := FileSearch ('clib.nlm',ST1);
+  WriteLn ('FileSearch (clib.nlm,',ST1,') returned "',ST2,'"');
+  WriteLn ('FExpand (TEST12.DAT): "',FExpand ('TEST12.DAT'));
+  WriteLn ('FExpand (.\TEST12.DAT): "',FExpand ('.\TEST12.DAT'));
+  WriteLn ('FExpand (..\SYSTEM\CLIB.NLM): "',FExpand ('..\SYSTEM\CLIB.NLM'));
+
+END;
+
+
+PROCEDURE VideoTest;
+
+  PROCEDURE WriteString (S : STRING; X,Y : WORD; Fore,Back: BYTE);
+  VAR I : INTEGER;
+      W : WORD;
+      P : POINTER;
+      Textattr : WORD;
+  BEGIN
+    W := X + (Y * Video.ScreenWidth);
+    P := Pointer (@VideoBuf^[W]);
+    TextAttr := (Fore and $f) or (Back shl 4);
+    FOR I := 1 TO Length (S) DO
+    BEGIN
+      W := (TextAttr SHL 8) or byte (S[I]);
+      PWord(P)^ := w;
+      INC (PChar(P),2);
+    END;
+  END;
+
+BEGIN
+  InitVideo;
+  Video.ClearScreen;
+  WriteString ('Test @ 0,0, LightGray on Black',0,0,LightGray,Black);
+  UpdateScreen (false);
+  WriteString ('Test @ 10,1, Yellow on Blue',1,1,Yellow,Blue);
+  UpdateScreen (false);
+  ReadKey;
+  Video.ClearScreen;
+  WriteString ('Cursor crHidden',0,0,Yellow,Blue);
+  SetCursorPos (0,0);
+  SetCursorType (crHidden);
+  UpdateScreen (false);
+  ReadKey;
+
+  Video.ClearScreen;
+  WriteString ('Cursor crUnderLine',0,0,Yellow,Blue);
+  SetCursorPos (0,0);
+  SetCursorType (crUnderLine);
+  UpdateScreen (false);
+  ReadKey;
+
+  Video.ClearScreen;
+  WriteString ('Cursor crBlock',0,0,Yellow,Blue);
+  SetCursorPos (0,0);
+  SetCursorType (crBlock);
+  UpdateScreen (false);
+  ReadKey;
+
+  Video.ClearScreen;
+  WriteString ('Cursor crHalfBlock',0,0,Yellow,Blue);
+  SetCursorPos (0,0);
+  SetCursorType (crHalfBlock);
+  UpdateScreen (false);
+  ReadKey;
+
+  CRT.ClrScr;
+  SetCursorType (crUnderLine);
+END;
+
+PROCEDURE KeyboardTest;
+VAR T : TKeyEvent;
+BEGIN
+  InitKeyboard;
+  WriteLn ('Keyboard-Test, ESC Ends');
+  REPEAT
+    T := GetKeyEvent;
+    WriteLn ('           Event: ',HexStr (T,8),' EventChar: "',GetKeyEventChar(T),'" KeyEventCode: ',HexStr (GetKeyEventCode(T),8));
+    T := TranslateKeyEvent (T);
+    WriteLn ('Translated Event: ',HexStr (T,8),' EventChar: "',GetKeyEventChar(T),'" KeyEventCode: ',HexStr (GetKeyEventCode(T),8));
+    WriteLn;
+  UNTIL GetKeyEventChar (T) = #27;
+END;
+
+
+VAR I : LONGINT;
+    S : STRING [255];
+    C : CHAR;
+    P : ^Str255;
+BEGIN
+  New (P);
+  Dispose (P);
+  // WriteLn ('Test');
+  //__ConsolePrintf ('Ok, this is PASCALMAIN'#13#10,0);
+  WriteLn ('Test via WriteLn');
+  WriteLn ('No of params: ', ParamCount);
+  //__EnterDebugger;
+  WriteLn ('ParamStr(0): "', ParamStr(0),'"');
+  IF ParamCount > 0 THEN
+    FOR I := 1 TO ParamCount DO
+      WriteLn (I:6,': "',ParamStr(I),'"');
+  GetDir (0, S);
+  WriteLn ('Current Directory: "',S,'"');
+//  ChDir ('TEST');
+//  GetDir (0, S);
+//  WriteLn ('Current Directory: "',S,'"');
+//  MkDir ('SYS:TEST');
+//  IF IOResult <> 0 THEN WriteLn ('MkDir SYS:TEST failed (Ok)');
+//  Write ('MkDir'); MkDir ('SYS:TEST/TESTDIR');
+//  ErrorCheck ('MkDir','SYS:TEST/TESTDIR');
+//  Write ('RmDir'); RmDir ('SYS:TEST/TESTDIR');
+//  ErrorCheck ('RmDir','SYS:TEST/TESTDIR');
+
+  REPEAT
+    WriteLn;
+    WriteLn ('1  : File-Test');
+    WriteLn ('2  : Textfile-Test');
+    WriteLn ('3  : GetMem/FreeMem Test');
+    WriteLn ('4  : DosTest');
+    WriteLn ('5  : ExceptTest');
+    WriteLn ('6  : Video-Test');
+    WriteLn ('7  : Find-Test');
+    WriteLn ('8  : SysUtils-Test');
+    WriteLn ('9  : CrtTest');
+    WriteLn ('K  : Keyboard-Test');
+    WriteLn ('E  : Ende');
+    WriteLn;
+    Write ('?: ');
+    C := Crt.ReadKey;
+    WriteLn (C);
+    CASE upcase(C) OF
+      '1' : FileTest;
+      '2' : TextfileTest;
+      '3' : MemTest;
+      '4' : DosTest;
+      '5' : ExceptTest;
+      '6' : VideoTest;
+      '7' : FindTest;
+      '8' : SysUtilsTest;
+      '9' : CrtTest;
+      'K' : KeyboardTest;
+    END;
+  UNTIL UpCase (C) = 'E';
+  (*$IFDEF Netware*)
+  PressAnyKeyToContinue;
+  (*$ENDIF*)
+END.

rtl/netware/varutils.pp

@@ -0,0 +1,53 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Interface and OS-dependent part of variant support
+       
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2001-04-16 18:39:50  florian
+    * updates from Armin commited
+
+  Revision 1.1  2000/08/29 18:21:58  michael
+  + new include files
+
+  Revision 1.1  2000/08/29 18:20:13  michael
+  + new include files
+
+}
+

rtl/netware/video.pp

@@ -0,0 +1,185 @@
+{
+    $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
+
+    Video unit for netware
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ 2001/04/16 armin: first version for netware }
+unit Video;
+interface
+
+{$i videoh.inc}
+
+implementation
+
+uses
+  dos;
+
+{$i video.inc}
+{$i nwsys.inc}
+
+var
+  OldVideoBuf : PVideoBuf;
+  MaxVideoBufSize : DWord;
+  VideoBufAllocated: boolean;
+
+
+procedure InitVideo;
+VAR height,width : WORD;
+    startline, endline : BYTE;
+begin
+  DoneVideo;
+  ScreenColor:= (_IsColorMonitor <> 0);
+  _GetSizeOfScreen (height, width);
+  ScreenWidth := width;
+  ScreenHeight:= height;
+
+  { TDrawBuffer only has FVMaxWidth elements
+    larger values lead to crashes }
+  if ScreenWidth> FVMaxWidth then
+    ScreenWidth:=FVMaxWidth;
+
+  CursorX := _wherex;
+  CursorY := _wherey;
+  _GetCursorShape (startline,endline);
+  {if not ConsoleCursorInfo.bvisible then
+    CursorLines:=0
+  else
+    CursorLines:=ConsoleCursorInfo.dwSize;}
+
+  { allocate back buffer }
+  MaxVideoBufSize:= ScreenWidth * ScreenHeight * 2;
+  VideoBufSize   := ScreenWidth * ScreenHeight * 2;
+
+  GetMem(VideoBuf,MaxVideoBufSize);
+  GetMem(OldVideoBuf,MaxVideoBufSize);
+  VideoBufAllocated := true;
+
+  {grab current screen contents}
+  _CopyFromScreenMemory (ScreenHeight, ScreenWidth, VideoBuf, 0, 0);
+  Move (VideoBuf^, OldVideoBuf^, MaxVideoBufSize);
+  LockUpdateScreen := 0;
+
+  {ClearScreen; not needed PM }
+end;
+
+
+procedure DoneVideo;
+begin
+  { ClearScreen; also not needed PM }
+  SetCursorType(crUnderLine);
+  { SetCursorPos(0,0); also not needed PM }
+  if videoBufAllocated then
+  begin
+    FreeMem(VideoBuf,MaxVideoBufSize);
+    FreeMem(OldVideoBuf,MaxVideoBufSize);
+    videoBufAllocated := false;
+  end;
+  VideoBufSize:=0;
+end;
+
+
+function GetCapabilities: Word;
+begin
+  GetCapabilities:=cpColor or cpChangeCursor;
+end;
+
+
+procedure SetCursorPos(NewCursorX, NewCursorY: Word);
+begin
+  _GotoXY (NewCursorX, NewCursorY);
+end;
+
+
+function GetCursorType: Word;
+var startline, endline : byte;
+begin
+  _GetCursorShape (startline, endline);
+  CASE startline of
+    1 : GetCursorType := crBlock;
+    5 : GetCursorType := crHalfBlock
+    ELSE
+       GetCursorType := crUnderline;
+  END;
+  {crHidden ?}
+end;
+
+
+procedure SetCursorType(NewType: Word);
+begin
+   if newType=crHidden then
+     _HideInputCursor
+   else
+     begin
+        case NewType of
+           crUnderline:
+             _SetCursorShape (9,$A);
+           crHalfBlock:
+             _SetCursorShape (5,$A);
+           crBlock:
+             _SetCursorShape (1,$A);
+        end;
+        _DisplayInputCursor;
+     end;
+end;
+
+
+function DefaultVideoModeSelector(const VideoMode: TVideoMode; Params: Longint): Boolean;
+begin
+  DefaultVideoModeSelector:=true;
+end;
+
+
+procedure ClearScreen;
+begin
+  FillWord(VideoBuf^,VideoBufSize div 2,$0720);
+  UpdateScreen(true);
+end;
+
+
+procedure UpdateScreen(Force: Boolean);
+begin
+  if (LockUpdateScreen<>0) or (VideoBufSize = 0) then
+   exit;
+  if not force then
+   begin
+     asm
+        movl    VideoBuf,%esi
+        movl    OldVideoBuf,%edi
+        movl    VideoBufSize,%ecx
+        shrl    $2,%ecx
+        repe
+        cmpsl
+        setne   force
+     end;
+   end;
+  if Force then
+    _CopyToScreenMemory (ScreenHeight, ScreenWidth, VideoBuf, 0, 0);
+end;
+
+procedure RegisterVideoModes;
+begin
+  { don't know what to do for netware }
+  RegisterVideoMode(80, 25, True, @DefaultVideoModeSelector, $00000003);
+end;
+
+
+initialization
+  VideoBufAllocated := false;
+  VideoBufSize := 0;
+  RegisterVideoModes;
+
+finalization
+  UnRegisterVideoModes;
+end.
+

rtl/objpas/filutilh.inc

@@ -23,10 +23,13 @@ Type
     Name : TFileName;
     ExcludeAttr : Longint;
     FindHandle : THandle;
-    {$ifdef Win32}
-    FindData : TWin32FindData;        
-    {$endif}
-    end;
+{$ifdef Win32}
+    FindData : TWin32FindData;   
+{$endif}
+{$ifdef netware} 
+    FindData : TNetwareFindData; 
+{$endif}
+  end;
 
 Const 
   { File attributes }
@@ -77,7 +80,10 @@ Function FileSearch (Const Name, DirList : String) : String;
 
 {
   $Log$
-  Revision 1.3  2001-01-18 22:09:09  michael
+  Revision 1.4  2001-04-16 18:34:46  florian
+    * updates from Armin commited
+
+  Revision 1.3  2001/01/18 22:09:09  michael
   + Merged fixes from fixbranch - file modes
 
   Revision 1.2  2000/07/13 11:33:51  michael