makefile.fpc for netware

stderr to netware console
free all memory (threadvars and heap) to avoid error message while unloading nlm

rtl/netware/Makefile.fpc

@@ -0,0 +1,182 @@
+#
+#   Makefile.fpc for Free Pascal Netware RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=nwpre prelude
+units=$(SYSTEMUNIT) objpas strings \
+      netware os_types winsock2 \
+      dos crt objects \
+      sysutils typinfo math \
+      cpu mmx getopts heaptrc lineinfo \
+      sockets aio varutils \
+      video mouse keyboard
+rsts=math typinfo varutils
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=netware
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+targetdir=.
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysnetwa
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# for netware always use multithread
+override FPCOPT+=-dMT
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+
+[rules]
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+nwpre$(OEXT) : nwpre.as
+        $(AS) -o nwpre$(OEXT) nwpre.as
+
+prelude$(OEXT) : prelude.as
+        $(AS) -o prelude$(OEXT) prelude.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp nwsys.inc $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+                   $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(WININC) netware.pp
+
+os_types$(PPUEXT) : $(INC)/os_types.pp
+
+winsock2$(PPUEXT) : winsock2.pp qos.inc netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) os_types$(PPUEXT)
+
+sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+                   $(INC)/sockets.inc $(INC)/socketsh.inc
+
+#dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+                    objpas$(PPUEXT) dos$(PPUEXT) nwsys.inc
+        $(COMPILER) -I$(OBJPASDIR) sysutils.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+        $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/math.pp
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+                    $(OBJPASDIR)/varutilh.inc varutils.pp
+        $(COMPILER) -I$(OBJPASDIR) varutils.pp
+
+#
+# Netware-.imp files need to be installed in the unit-dir
+#
+override INSTALLPPUFILES+=nwimp/aio.imp nwimp/aio.imp nwimp/audnlm32.imp \
+nwimp/calnlm32.imp nwimp/ccs.imp nwimp/ccs-os.imp nwimp/clibaux.imp \
+nwimp/clibctx.imp nwimp/clib.imp nwimp/clxnlm32.imp nwimp/dplsv386.imp \
+nwimp/dsapi.imp nwimp/dsevent.imp nwimp/fpsm.imp nwimp/lib0.imp \
+nwimp/locnlm32.imp nwimp/ndpsrpc.imp nwimp/netnlm32.imp nwimp/nit.imp \
+nwimp/nlmlib.imp nwimp/nwpsrv3x.imp nwimp/nwpsrv.imp nwimp/nwsnut.imp \
+nwimp/requestr.imp nwimp/socklib.imp nwimp/streams.imp nwimp/threads.imp \
+nwimp/tli.imp nwimp/vollib.imp nwimp/ws2_32.imp nwimp/ws2nlm.imp

rtl/netware/system.pp

@@ -16,6 +16,8 @@
 unit system;
 
 interface
+
+{$define StdErrToConsole}
 
 {$ifdef SYSTEMDEBUG}
   {$define SYSTEMEXCEPTIONDEBUG}
@@ -30,13 +32,6 @@ interface
 
 {$I systemh.inc}
 
-{ include heap support headers }
-{Why the hell do i have to define that ???
- otherwise FPC_FREEMEM expects 2 parameters but the compiler only
- puhes the address}
-{  DEFINE NEWMM}
-{  I heaph.inc}
-
 {Platform specific information}
 const
  LineEnding = #13#10;
@@ -126,7 +121,7 @@ procedure fpc_do_exit;external name 'FPC_DO_EXIT';
 *****************************************************************************}
 
 
-PROCEDURE _nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nlm_main'];
+PROCEDURE nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nlm_main'];
 BEGIN
   ArgC := _ArgC;
   ArgV := _ArgV;
@@ -135,7 +130,8 @@ END;
 
 
 {$ifdef MT}
-PROCEDURE CloseAllRemainingSemaphores; FORWARD;
+procedure CloseAllRemainingSemaphores; FORWARD;
+procedure ReleaseThreadVars; FORWARD;
 {$endif}
 
 { if return-value is <> 0, netware shows the message
@@ -161,11 +157,20 @@ end;
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
+
+procedure FreeSbrkMem; forward;
+
 Procedure system_exit;
 begin
-  {$ifdef MT}
+{$ifdef MT}
   CloseAllRemainingSemaphores;
-  {$endif}
+  ReleaseThreadVars;
+{$endif}
+  FreeSbrkMem;            { free memory allocated by heapmanager }
+
+  if ExitCode <> 0 Then   { otherwise we dont see runtime-errors }
+    PressAnyKeyToContinue;
+  
   _exit (ExitCode);
 end;
 
@@ -228,19 +233,66 @@ assembler;
 asm
         movl    HEAPSIZE,%eax
 end ['EAX'];
-
+
+const HeapInitialMaxBlocks = 32;
+type THeapSbrkBlockList = array [1.. HeapInitialMaxBlocks] of pointer;
+var  HeapSbrkBlockList : ^THeapSbrkBlockList = nil;
+     HeapSbrkLastUsed  : dword = 0;
+     HeapSbrkAllocated : dword = 0;
+
 { function to allocate size bytes more for the program }
 { must return the first address of new data space or -1 if fail }
-FUNCTION Sbrk(size : longint):longint;
+{ for netware all allocated blocks are saved to free them at }
-VAR P : POINTER;
+{ exit (to avoid message "Module did not release xx resources") }
-BEGIN
+Function Sbrk(size : longint):longint;
+var P,P2 : POINTER;
+begin
   P := _malloc (size);
-  IF P = NIL THEN
+  if P = nil then
     Sbrk := -1
-  ELSE
+  else begin
     Sbrk := LONGINT (P);
-END;
+    if HeapSbrkBlockList = nil then
-
+    begin
+      Pointer (HeapSbrkBlockList) := _malloc (sizeof (HeapSbrkBlockList^));
+      if HeapSbrkBlockList = nil then
+      begin
+        _free (P);
+	Sbrk := -1;
+	exit;
+      end;
+      fillchar (HeapSbrkBlockList^,sizeof(HeapSbrkBlockList^),0);
+      HeapSbrkAllocated := HeapInitialMaxBlocks;
+    end;
+    if (HeapSbrkLastUsed = HeapSbrkAllocated) then
+    begin  { grow }
+      p2 := _realloc (HeapSbrkBlockList, HeapSbrkAllocated + HeapInitialMaxBlocks);
+      if p2 = nil then
+      begin
+        _free (P);
+	Sbrk := -1;
+	exit;
+      end;
+      inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
+    end;
+    inc (HeapSbrkLastUsed);
+    HeapSbrkBlockList^[HeapSbrkLastUsed] := P;
+  end; 
+end;
+
+
+procedure FreeSbrkMem;
+var i : longint;
+begin
+  if HeapSbrkBlockList <> nil then
+  begin
+    for i := 1 to HeapSbrkLastUsed do
+      _free (HeapSbrkBlockList^[i]);
+    _free (HeapSbrkBlockList);
+    HeapSbrkAllocated := 0;
+    HeapSbrkLastUsed := 0;
+  end;    
+end;
 
 { include standard heap management }
 {$I heap.inc}
@@ -606,6 +658,51 @@ procedure InitFPU;assembler;
 
 { include threading stuff, this is os dependend part }
 {$I thread.inc}
+
+{$ifdef StdErrToConsole}
+var ConsoleBuff : array [0..512] of char;
+
+Function ConsoleWrite(Var F: TextRec): Integer;
+var
+  i : longint;
+Begin
+  if F.BufPos>0 then
+  begin
+     if F.BufPos>sizeof(ConsoleBuff)-1 then
+       i:=sizeof(ConsoleBuff)-1
+     else
+       i:=F.BufPos;
+     Move(F.BufPtr^,ConsoleBuff,i);
+     ConsoleBuff[i] := #0;
+     ConsolePrintf(@ConsoleBuff[0]);
+  end;
+  F.BufPos:=0;
+  ConsoleWrite := 0;
+End;
+
+
+Function ConsoleClose(Var F: TextRec): Integer;
+begin
+  ConsoleClose:=0;
+end;
+
+
+Function ConsoleOpen(Var F: TextRec): Integer;
+Begin
+  TextRec(F).InOutFunc:=@ConsoleWrite;
+  TextRec(F).FlushFunc:=@ConsoleWrite;
+  TextRec(F).CloseFunc:=@ConsoleClose;
+  ConsoleOpen:=0;
+End;
+
+
+procedure AssignStdErrConsole(Var T: Text);
+begin
+  Assign(T,'');
+  TextRec(T).OpenFunc:=@ConsoleOpen;
+  Rewrite(T);
+end;
+{$endif}
 
 
 
@@ -634,7 +731,13 @@ Begin
   OpenStdIO(Input,fmInput,StdInputHandle);
   OpenStdIO(Output,fmOutput,StdOutputHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  
+  {$ifdef StdErrToConsole}
+  AssignStdErrConsole(StdErr);
+  {$else}
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  {$endif}
+  
 { Setup environment and arguments }
   Setup_Environment;
   Setup_Arguments;
@@ -643,10 +746,16 @@ Begin
   {Delphi Compatible}
   IsLibrary := FALSE;
   IsConsole := TRUE;
+  ExitCode  := 0;
 End.
 {
   $Log$
-  Revision 1.8  2002-03-30 09:09:47  armin
+  Revision 1.9  2002-04-01 10:47:31  armin
+  makefile.fpc for netware
+  stderr to netware console
+  free all memory (threadvars and heap) to avoid error message while unloading nlm
+
+  Revision 1.8  2002/03/30 09:09:47  armin
   + support check-function for netware
 
   Revision 1.7  2002/03/17 17:57:33  armin

rtl/netware/sysutils.pp

@@ -121,7 +121,7 @@ end;
 
 Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
 begin
-  {$warning need to add 64bit call }
+  {$warning need to add 64bit FileSeek }
   FileSeek:=FileSeek(Handle,Longint(FOffset),Longint(Origin));
 end;
 
@@ -198,16 +198,16 @@ begin
     _SetReaddirAttribute (Rslt.FindData.DirP, attr);
   Rslt.FindData.Magic := $AD01;
   Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
-  IF Rslt.FindData.EntryP = NIL THEN
+  if Rslt.FindData.EntryP = nil then
-  BEGIN
+  begin
     _closedir (Rslt.FindData.DirP);
     Rslt.FindData.DirP := NIL;
-    exit (18);
+    result := 18;
-  END ELSE
+  end else
-  BEGIN
+  begin
     find_setfields (Rslt);
-    exit (0);
+    result := 0;
-  END;
+  end;
 end;
 
 
@@ -218,12 +218,9 @@ begin
     exit (18);
   Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
   IF Rslt.FindData.EntryP = NIL THEN
-    exit (18)
+    exit (18);
-  ELSE
+  find_setfields (Rslt);
-  BEGIN
+  result := 0;
-    find_setfields (Rslt);
-    exit (0);
-  END;
 end;
 
 
@@ -264,6 +261,7 @@ begin
     complete pathname of a filehandle, that would be needed for ChangeDirectoryEntry }
   FileSetDate:=-1;
   ConsolePrintf ('warning: fpc sysutils.FileSetDate not implemented'#13#10,0);
+  {$warning FileSetDate not implemented (i think is impossible) }
 end;
 
 
@@ -282,9 +280,9 @@ VAR MS : NWModifyStructure;
 begin
   FillChar (MS, SIZEOF (MS), 0);
   if _ChangeDirectoryEntry (PChar (Filename), MS, MFileAtrributesBit, 0) <> 0 then
-    exit (-1)
+    result := -1
   else
-    exit (0);
+    result := 0;
 end;
 
 
@@ -301,12 +299,6 @@ begin
   RenameFile:=(_rename(pchar(OldName),pchar(NewName)) = 0);
 end;
 
-{ ad: 27 Feb 2002: now implemented globaly ??
-Function FileSearch (Const Name, DirList : String) : String;
-begin
-  FileSearch:=Dos.FSearch(Name,Dirlist);
-end;
-}
 
 {****************************************************************************
                               Disk Functions
@@ -327,9 +319,9 @@ end;
 Const
   FixDriveStr : array[0..3] of pchar=(
     '.',
-    '/fd0/.',
+    'a:.',
-    '/fd1/.',
+    'b:.',
-    '/.'
+    'sys:/'
     );
 var
   Drives   : byte;
@@ -357,6 +349,7 @@ Begin
    Diskfree:=-1;}
   DiskFree := -1;
   ConsolePrintf ('warning: fpc sysutils.diskfree not implemented'#13#10,0);
+  {$warning DiskFree not implemented (does it make sense ?) }
 End;
 
 
@@ -371,6 +364,7 @@ Begin
    DiskSize:=-1;}
   DiskSize := -1;
   ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10,0);
+  {$warning DiskSize not implemented (does it make sense ?) }
 End;
 
 
@@ -487,7 +481,12 @@ end.
 {
 
   $Log$
-  Revision 1.5  2002-03-08 19:10:14  armin
+  Revision 1.6  2002-04-01 10:47:31  armin
+  makefile.fpc for netware
+  stderr to netware console
+  free all memory (threadvars and heap) to avoid error message while unloading nlm
+
+  Revision 1.5  2002/03/08 19:10:14  armin
   * added 64 bit fileseek (currently only 32 bit supported)
 
   Revision 1.4  2001/06/03 15:18:01  peter

rtl/netware/thread.inc

@@ -130,15 +130,15 @@ procedure AllocateThreadVars;
   end;
 
 procedure ReleaseThreadVars;
-
+var threadvars : pointer;
-  var
+begin
-     threadvars : pointer;
+   { release thread vars }
-
+   if threadvarblocksize > 0 then
-  begin
+   begin
-     { release thread vars }
      threadvars:=_GetThreadDataAreaPtr;
-     _Free (threadvars);
+    _Free (threadvars);
   end;
+end;
 
 procedure InitThread;
 
@@ -161,7 +161,7 @@ procedure DoneThread;
      ReleaseThreadVars;
   end;
 
-function ThreadMain(param : pointer) : dword;stdcall;
+function ThreadMain(param : pointer) : dword; cdecl;
 
   var
      ti : tthreadinfo;
@@ -178,6 +178,7 @@ function ThreadMain(param : pointer) : dword;stdcall;
      writeln('Jumping to thread function');
 {$endif DEBUG_MT}
      ThreadMain:=ti.f(ti.p);
+     DoneThread;
   end;
 
 
@@ -355,7 +356,12 @@ end;
 
 {
   $Log$
-  Revision 1.2  2002-03-28 16:11:17  armin
+  Revision 1.3  2002-04-01 10:47:31  armin
+  makefile.fpc for netware
+  stderr to netware console
+  free all memory (threadvars and heap) to avoid error message while unloading nlm
+
+  Revision 1.2  2002/03/28 16:11:17  armin
   + initialize threadvars defined local in units
 
   Revision 1.1  2002/03/17 17:57:33  armin