* ExecuteProcess fixes, ProcessID and ThreadID added

rtl/amiga/system.pas

@@ -1812,6 +1812,9 @@ begin
   Initial:=FALSE;
 { Reset IO Error }
   InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
 { Startup }
   { Only AmigaOS v2.04 or greater is supported }
   If KickVersion < 36 then
@@ -1830,7 +1833,10 @@ end.
 
 {
   $Log$
-  Revision 1.9  2003-10-25 23:42:35  hajny
+  Revision 1.10  2004-01-20 23:05:31  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.9  2003/10/25 23:42:35  hajny
     * THandle in sysutils common using System.THandle
 
   Revision 1.8  2003/09/29 18:52:36  hajny

rtl/atari/system.pas

@@ -752,6 +752,9 @@ begin
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 { Reset IO Error }
   InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
   errno := 0;
 { Setup command line arguments }
   argc:=GetParamCount(args);
@@ -762,7 +765,10 @@ end.
 
 {
   $Log$
-  Revision 1.9  2003-10-25 23:42:35  hajny
+  Revision 1.10  2004-01-20 23:05:31  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.9  2003/10/25 23:42:35  hajny
     * THandle in sysutils common using System.THandle
 
   Revision 1.8  2003/09/29 18:52:36  hajny

rtl/beos/system.pp

@@ -532,13 +532,19 @@ begin
 
 { Reset IO Error }
   InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
 {$ifdef HASVARIANT}
   initvariantmanager;
 {$endif HASVARIANT}
 end.
 {
   $Log$
-  Revision 1.10  2003-10-25 23:42:35  hajny
+  Revision 1.11  2004-01-20 23:09:14  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.10  2003/10/25 23:42:35  hajny
     * THandle in sysutils common using System.THandle
 
   Revision 1.9  2003/09/27 11:52:35  peter

rtl/beos/sysutils.pp

@@ -4,7 +4,7 @@
     Copyright (c) 1999-2000 by Florian Klaempfl
     member of the Free Pascal development team
 
-    Sysutils unit for linux
+    Sysutils unit for BeOS
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -255,6 +255,25 @@ begin
   Result:=StrPas(beos.Getenv(PChar(EnvVar)));
 end;
 
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+                                                                       integer;
+
+var
+  CommandLine: AnsiString;
+
+begin
+  { always surround the name of the application by quotes
+    so that long filenames will always be accepted. But don't
+    do it if there are already double quotes!
+  }
+  if pos('"',path)=0 then
+    CommandLine:='"'+path+'"'
+  else
+    CommandLine:=path;
+  if ComLine <> '' then
+   CommandLine := Commandline + ' ' + ComLine;
+  ExecuteProcess := beos.shell (CommandLine);
+end;
 
 {****************************************************************************
                               Initialization code
@@ -268,7 +287,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.7  2003-11-26 20:00:19  florian
+  Revision 1.8  2004-01-20 23:09:14  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.7  2003/11/26 20:00:19  florian
     * error handling for Variants improved
 
   Revision 1.5  2003/03/29 15:16:26  hajny

rtl/bsd/system.pp

@@ -163,6 +163,9 @@ Begin
   SysInitStdIO;
 { Reset IO Error }
   InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
 {$ifdef HASVARIANT}
   initvariantmanager;
 {$endif HASVARIANT}  
@@ -170,7 +173,10 @@ End.
 
 {
   $Log$
-  Revision 1.12  2004-01-04 20:32:05  jonas
+  Revision 1.13  2004-01-20 23:09:14  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.12  2004/01/04 20:32:05  jonas
     + geterrnolocation for Darwin
     + C-style main for Darwin (generic, can be used for anything)
 

rtl/emx/system.pas

@@ -466,10 +466,10 @@ asm
     pushl %ebx
 {$IFDEF REGCALL}
     movl %eax,%ebx
-{$IFDEF REGCALL}
+{$ELSE REGCALL}
     movl handle,%ebx
     movl pos,%edx
-{$IFDEF REGCALL}
+{$ENDIF REGCALL}
     movw $0x4200,%ax
     call syscall
     jnc .LDOSSEEK1
@@ -1184,6 +1184,9 @@ end;
 var TIB: PThreadInfoBlock;
     PIB: PProcessInfoBlock;
 
+const
+ FatalHeap: array [0..33] of char = 'FATAL: Cannot initialize heap!!'#13#10'$';
+
 begin
     IsLibrary := FALSE;
     {Determine the operating system we are running on.}
@@ -1200,13 +1203,15 @@ begin
         mov os_mode, 2
     @noRSX:
     {Enable the brk area by initializing it with the initial heap size.}
-
         mov eax, 7F01h
         mov edx, heap_brk
         add edx, heap_base
         call syscall
         cmp eax, -1
         jnz @heapok
+        lea edx, FatalHeap
+        mov eax, 900h
+        call syscall
         pop ebx
         push dword 204
         call HandleError
@@ -1229,7 +1234,6 @@ begin
 {$ENDIF CONTHEAP}
         pop ebx
     end ['eax', 'ecx', 'edx'];
-
     { in OS/2 this will always be nil, but in DOS mode }
     { this can be changed.                             }
     first_meg := nil;
@@ -1261,7 +1265,8 @@ begin
                                                      also the stack bottom.}
                 ApplicationType := 1;   (* Running under DOS. *)
                 IsConsole := true;
-                DosEnvInit;
+                ProcessID := 1;
+                ThreadID := 1;
             end;
         osOS2:
             begin
@@ -1269,6 +1274,8 @@ begin
                 StackBottom := pointer (TIB^.Stack);
                 Environment := pointer (PIB^.Env);
                 ApplicationType := PIB^.ProcType;
+                ProcessID := PIB^.PID;
+                ThreadID := TIB^.TIB2^.TID;
                 IsConsole := ApplicationType <> 3;
             end;
         osDPMI:
@@ -1277,7 +1284,8 @@ begin
                                      always zero.}
                 ApplicationType := 1;   (* Running under DOS. *)
                 IsConsole := true;
-                DosEnvInit;
+                ProcessID := 1;
+                ThreadID := 1;
             end;
     end;
     exitproc:=nil;
@@ -1298,6 +1306,9 @@ begin
     initvariantmanager;
 {$endif HASVARIANT}
 
+    if os_Mode in [osDOS,osDPMI] then
+        DosEnvInit;
+
 {$IFDEF DUMPGROW}
  {$IFDEF CONTHEAP}
     WriteLn ('Initial brk size is ', GetHeapSize);
@@ -1307,7 +1318,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2003-12-26 22:20:44  hajny
+  Revision 1.23  2004-01-20 23:05:31  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.22  2003/12/26 22:20:44  hajny
     * regcall fixes
 
   Revision 1.21  2003/12/17 22:52:39  hajny

rtl/emx/systhrds.pp

@@ -223,6 +223,7 @@ end;
         { Open all stdio fds again }
         SysInitStdio;
         InOutRes:=0;
+        ThreadID := ...;
         // ErrNo:=0;
         { Stack checking }
         StackLength:=stklen;
@@ -379,7 +380,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.4  2003-10-19 09:35:28  hajny
+  Revision 1.5  2004-01-20 23:05:31  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.4  2003/10/19 09:35:28  hajny
     * fixes from OS/2 merged to EMX
 
   Revision 1.3  2003/03/23 23:11:17  hajny

rtl/emx/sysutils.pp

@@ -25,6 +25,7 @@ interface
 uses
  Dos;
 
+{$DEFINE HAS_SLEEP}
 { Include platform independent interface part }
 {$i sysutilh.inc}
 
@@ -46,44 +47,65 @@ implementation
 (* conflicts, so needed parts had to be redefined here). *)
 
 type
- TFileStatus = object
+        TFileStatus = object
-               end;
+        end;
- PFileStatus = ^TFileStatus;
+        PFileStatus = ^TFileStatus;
 
- TFileStatus0 = object (TFileStatus)
+        TFileStatus3 = object (TFileStatus)
-                 DateCreation,        {Date of file creation.}
+            DateCreation,               {Date of file creation.}
-                 TimeCreation,        {Time of file creation.}
+            TimeCreation,               {Time of file creation.}
-                 DateLastAccess,      {Date of last access to file.}
+            DateLastAccess,             {Date of last access to file.}
-                 TimeLastAccess,      {Time of last access to file.}
+            TimeLastAccess,             {Time of last access to file.}
-                 DateLastWrite,       {Date of last modification of file.}
+            DateLastWrite,              {Date of last modification of file.}
-                 TimeLastWrite: word; {Time of last modification of file.}
+            TimeLastWrite:word;         {Time of last modification of file.}
-                 FileSize,            {Size of file.}
+            FileSize,                   {Size of file.}
-                 FileAlloc: cardinal; {Amount of space the file really
+            FileAlloc:cardinal;         {Amount of space the file really
-                                       occupies on disk.}
+                                         occupies on disk.}
-                end;
+            AttrFile:cardinal;          {Attributes of file.}
- PFileStatus0 = ^TFileStatus0;
+        end;
+        PFileStatus3=^TFileStatus3;
 
- TFileStatus3 = object (TFileStatus)
+        TFileStatus4=object(TFileStatus3)
-                 NextEntryOffset: cardinal; {Offset of next entry}
+            cbList:cardinal;            {Length of entire EA set.}
-                 DateCreation,             {Date of file creation.}
+        end;
-                 TimeCreation,             {Time of file creation.}
+        PFileStatus4=^TFileStatus4;
-                 DateLastAccess,           {Date of last access to file.}
-                 TimeLastAccess,           {Time of last access to file.}
-                 DateLastWrite,            {Date of last modification of file.}
-                 TimeLastWrite: word;      {Time of last modification of file.}
-                 FileSize,                 {Size of file.}
-                 FileAlloc: cardinal;      {Amount of space the file really
-                                            occupies on disk.}
-                 AttrFile: cardinal;       {Attributes of file.}
-                end;
- PFileStatus3 = ^TFileStatus3;
 
- TFileFindBuf3 = object (TFileStatus3)
+        TFileFindBuf3=object(TFileStatus)
-                  Name: ShortString;       {Also possible to use as ASCIIZ.
+            NextEntryOffset: cardinal;  {Offset of next entry}
-                                            The byte following the last string
+            DateCreation,               {Date of file creation.}
-                                            character is always zero.}
+            TimeCreation,               {Time of file creation.}
-                 end;
+            DateLastAccess,             {Date of last access to file.}
- PFileFindBuf3 = ^TFileFindBuf3;
+            TimeLastAccess,             {Time of last access to file.}
+            DateLastWrite,              {Date of last modification of file.}
+            TimeLastWrite:word;         {Time of last modification of file.}
+            FileSize,                   {Size of file.}
+            FileAlloc:cardinal;         {Amount of space the file really
+                                         occupies on disk.}
+            AttrFile:cardinal;          {Attributes of file.}
+            Name:string;                {Also possible to use as ASCIIZ.
+                                         The byte following the last string
+                                         character is always zero.}
+        end;
+        PFileFindBuf3=^TFileFindBuf3;
+
+        TFileFindBuf4=object(TFileStatus)
+            NextEntryOffset: cardinal;  {Offset of next entry}
+            DateCreation,               {Date of file creation.}
+            TimeCreation,               {Time of file creation.}
+            DateLastAccess,             {Date of last access to file.}
+            TimeLastAccess,             {Time of last access to file.}
+            DateLastWrite,              {Date of last modification of file.}
+            TimeLastWrite:word;         {Time of last modification of file.}
+            FileSize,                   {Size of file.}
+            FileAlloc:cardinal;         {Amount of space the file really
+                                         occupies on disk.}
+            AttrFile:cardinal;          {Attributes of file.}
+            cbList:longint;             {Size of the file's extended attributes.}
+            Name:string;                {Also possible to use as ASCIIZ.
+                                         The byte following the last string
+                                         character is always zero.}
+        end;
+        PFileFindBuf4=^TFileFindBuf4;
 
  TFSInfo = record
             case word of
@@ -172,38 +194,154 @@ type
               end;
  PCountryInfo=^TCountryInfo;
 
+ TRequestData=record
+               PID,                {ID of process that wrote element.}
+               Data: cardinal;     {Information from process writing the data.}
+              end;
+ PRequestData=^TRequestData;
+
+{Queue data structure for synchronously started sessions.}
+ TChildInfo = record
+  case boolean of
+   false:
+    (SessionID,
+     Return: word);  {Return code from the child process.}
+   true:
+    (usSessionID,
+     usReturn: word);     {Return code from the child process.}
+ end;
+ PChildInfo = ^TChildInfo;
+
+ TStartData=record
+  {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
+  Length:word;                {Length, in bytes, of datastructure
+                               (24/30/32/50/60).}
+  Related:word;               {Independent/child session (0/1).}
+  FgBg:word;                  {Foreground/background (0/1).}
+  TraceOpt:word;              {No trace/trace this/trace all (0/1/2).}
+  PgmTitle:PChar;             {Program title.}
+  PgmName:PChar;              {Filename to program.}
+  PgmInputs:PChar;            {Command parameters (nil allowed).}
+  TermQ:PChar;                {System queue. (nil allowed).}
+  Environment:PChar;          {Environment to pass (nil allowed).}
+  InheritOpt:word;            {Inherit enviroment from shell/
+                               inherit environment from parent (0/1).}
+  SessionType:word;           {Auto/full screen/window/presentation
+                               manager/full screen Dos/windowed Dos
+                               (0/1/2/3/4/5/6/7).}
+  Iconfile:PChar;             {Icon file to use (nil allowed).}
+  PgmHandle:cardinal;         {0 or the program handle.}
+  PgmControl:word;            {Bitfield describing initial state
+                               of windowed sessions.}
+  InitXPos,InitYPos:word;     {Initial top coordinates.}
+  InitXSize,InitYSize:word;   {Initial size.}
+  Reserved:word;
+  ObjectBuffer:PChar;         {If a module cannot be loaded, its
+                               name will be returned here.}
+  ObjectBuffLen:cardinal;     {Size of your buffer.}
+ end;
+ PStartData=^TStartData;
+
 const
  ilStandard      = 1;
  ilQueryEAsize   = 2;
  ilQueryEAs      = 3;
  ilQueryFullName = 5;
 
+ quFIFO     = 0;
+ quLIFO     = 1;
+ quPriority = 2;
+
+ quNoConvert_Address = 0;
+ quConvert_Address   = 4;
+
+{Start the new session independent or as a child.}
+ ssf_Related_Independent = 0;    {Start new session independent
+                                  of the calling session.}
+ ssf_Related_Child       = 1;    {Start new session as a child 
+                                  session to the calling session.}
+
+{Start the new session in the foreground or in the background.}
+ ssf_FgBg_Fore           = 0;    {Start new session in foreground.}
+ ssf_FgBg_Back           = 1;    {Start new session in background.}
+
+{Should the program started in the new session
+ be executed under conditions for tracing?}
+ ssf_TraceOpt_None       = 0;    {No trace.}
+ ssf_TraceOpt_Trace      = 1;    {Trace with no notification
+                                  of descendants.}
+ ssf_TraceOpt_TraceAll   = 2;    {Trace all descendant sessions.  
+                                  A termination queue must be 
+                                  supplied and Related must be 
+                                  ssf_Related_Child (=1).}
+
+{Will the new session inherit open file handles
+ and environment from the calling process.}
+ ssf_InhertOpt_Shell     = 0;    {Inherit from the shell.}
+ ssf_InhertOpt_Parent    = 1;    {Inherit from the calling process.}
+
+{Specifies the type of session to start.}
+ ssf_Type_Default        = 0;    {Use program's type.}
+ ssf_Type_FullScreen     = 1;    {OS/2 full screen.}
+ ssf_Type_WindowableVIO  = 2;    {OS/2 window.}
+ ssf_Type_PM             = 3;    {Presentation Manager.}
+ ssf_Type_VDM            = 4;    {DOS full screen.}
+ ssf_Type_WindowedVDM    = 7;    {DOS window.}
+{Additional values for Windows programs}
+ Prog_31_StdSeamlessVDM    = 15; {Windows 3.1 program in its
+                                  own windowed session.}
+ Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
+                                  common windowed session.}
+ Prog_31_EnhSeamlessVDM    = 17; {Windows 3.1 program in enhanced
+                                  compatibility mode in its own
+                                  windowed session.}
+ Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
+                                  compatibility mode in a common
+                                  windowed session.}
+ Prog_31_Enh               = 19; {Windows 3.1 program in enhanced
+                                  compatibility mode in a full
+                                  screen session.}
+ Prog_31_Std               = 20; {Windows 3.1 program in a full
+                                  screen session.}
+
+{Specifies the initial attributes for a OS/2 window or DOS window session.}
+ ssf_Control_Visible      = 0;   {Window is visible.}
+ ssf_Control_Invisible    = 1;   {Window is invisible.}
+ ssf_Control_Maximize     = 2;   {Window is maximized.}
+ ssf_Control_Minimize     = 4;   {Window is minimized.}
+ ssf_Control_NoAutoClose  = 8;   {Window will not close after
+                                  the program has ended.}
+ ssf_Control_SetPos   = 32768;   {Use InitXPos, InitYPos,
+                                  InitXSize, and InitYSize for
+                                  the size and placement.}
+
+
 {This is the correct way to call external assembler procedures.}
 procedure syscall;external name '___SYSCALL';
 
-function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus;
+function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
         FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
 
 function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
                BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
 
-function DosQueryFileInfo (Handle: longint; InfoLevel: cardinal;
+function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
            AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
                                                  external 'DOSCALLS' index 279;
 
 function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
                                                  external 'DOSCALLS' index 227;
 
-function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: cardinal;
+function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
                        AFileStatus: PFileStatus; FileStatusLen: cardinal;
                     var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
                                                  external 'DOSCALLS' index 264;
 
-function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
+function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
                 FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
                                                  external 'DOSCALLS' index 265;
 
-function DosFindClose (Handle: longint): cardinal; cdecl;
+function DosFindClose (Handle: THandle): cardinal; cdecl;
                                                  external 'DOSCALLS' index 263;
 
 function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
@@ -213,6 +351,27 @@ function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
 function DosMapCase (Size: cardinal; var Country: TCountryCode;
                       AString: PChar): cardinal; cdecl; external 'NLS' index 7;
 
+procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
+
+function DosCreateQueue (var Handle: THandle; Priority:longint;
+                        Name: PChar): cardinal; cdecl;
+                                                  external 'QUECALLS' index 16;
+
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+                      var DataLen: cardinal; var DataPtr: pointer;
+                      Element, Wait: cardinal; var Priority: byte;
+                      ASem: THandle): cardinal; cdecl;
+                                                   external 'QUECALLS' index 9;
+
+function DosCloseQueue (Handle: THandle): cardinal; cdecl;
+                                                  external 'QUECALLS' index 11;
+
+function DosStartSession (var AStartData: TStartData;
+                          var SesID, PID: cardinal): cardinal; cdecl;
+                                                    external 'SESMGR' index 37;
+
+function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
+
 
 {****************************************************************************
                               File Functions
@@ -259,7 +418,7 @@ asm
 end {['eax', 'ebx', 'ecx', 'edx']};
 
 
-function FileCreate (const FileName: string; Mode: longint): longint;
+function FileCreate (const FileName: string; Mode: integer): longint;
 begin
   FileCreate:=FileCreate(FileName);
 end;
@@ -514,7 +673,7 @@ end {['eax', 'ebx', 'ecx', 'edx']};
 
 
 function FileSetDate (Handle, Age: longint): longint;
-var FStat: PFileStatus0;
+var FStat: PFileStatus3;
     RC: cardinal;
 begin
     if os_mode = osOS2 then
@@ -871,6 +1030,87 @@ begin
 end;
 
 
+{$ASMMODE INTEL}
+procedure Sleep (Milliseconds: cardinal);
+
+begin
+ if os_mode = osOS2 then DosSleep (Milliseconds) else
+  asm
+   mov edx, Milliseconds
+   mov eax, 7F30h
+   call syscall
+  end ['eax', 'edx'];
+end;
+{$ASMMODE DEFAULT}
+
+
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+                                                                       integer;
+var
+ HQ: THandle;
+ SPID, STID, QName: shortstring;
+ SD: TStartData;
+ SID, PID: cardinal;
+ RD: TRequestData;
+ PCI: PChildInfo;
+ CISize: cardinal;
+ Prio: byte;
+ E: EOSError;
+ CommandLine: ansistring;
+
+begin
+ if os_Mode = osOS2 then
+  begin
+   FillChar (SD, SizeOf (SD), 0);
+   SD.Length := 24;
+   SD.Related := ssf_Related_Child;
+   SD.PgmName := PChar (Path);
+   SD.PgmInputs := PChar (ComLine);
+   Str (ProcessID, SPID);
+   Str (ThreadID, STID);
+   QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
+   SD.TermQ := @QName [1];
+   Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
+   if Result = 0 then
+    begin
+     Result := DosStartSession (SD, SID, PID);
+     if (Result = 0) or (Result = 457) then
+      begin
+       Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
+       if Result = 0 then
+       begin
+        Result := PCI^.Return;
+        DosCloseQueue (HQ);
+        DosFreeMem (PCI);
+        Exit;
+       end;
+      end;
+     DosCloseQueue (HQ);
+    end;
+    if ComLine = '' then
+     CommandLine := Path
+    else
+     CommandLine := Path + ' ' + ComLine;
+    E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]);
+    E.ErrorCode := Result;
+    raise E;
+  end else
+  begin
+   Dos.Exec (Path, ComLine);
+   if DosError <> 0 then
+    begin
+    if ComLine = '' then
+     CommandLine := Path
+    else
+     CommandLine := Path + ' ' + ComLine;
+      E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, DosError]);
+      E.ErrorCode := DosError;
+      raise E;
+    end;
+   ExecuteProcess := DosExitCode;
+  end;
+end;
+
 {****************************************************************************
                               Initialization code
 ****************************************************************************}
@@ -884,7 +1124,10 @@ end.
 
 {
   $Log$
-  Revision 1.13  2003-11-26 20:00:19  florian
+  Revision 1.14  2004-01-20 23:05:31  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.13  2003/11/26 20:00:19  florian
     * error handling for Variants improved
 
   Revision 1.12  2003/10/19 09:35:28  hajny

rtl/go32v2/system.pp

@@ -1597,6 +1597,7 @@ Begin
    FileNameCaseSensitive:=true;
 { Reset IO Error }
   InOutRes:=0;
+  ThreadID := 1;
 {$ifdef  EXCEPTIONS_IN_SYSTEM}
   InitDPMIExcp;
   InstallDefaultHandlers;
@@ -1607,7 +1608,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.31  2004-01-10 10:49:24  jonas
+  Revision 1.32  2004-01-20 23:09:14  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.31  2004/01/10 10:49:24  jonas
     * fixed compilation
 
   Revision 1.30  2003/12/17 20:40:38  hajny

rtl/go32v2/sysutils.pp

@@ -764,19 +764,22 @@ end;
 function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
 var
   e : EOSError;
+  CommandLine: AnsiString;
+
 begin
   dos.exec(path,comline);
 
-  result := dos.doserror;
+  if (Dos.DosError <> 0) then
-  { (dos)exit code is irrelevant, at least the unix implementation }
-  { does not }
-  { take it into account                                               }
-  if (result <> 0) then
     begin
-      e:=EOSError.CreateFmt('Failed to execute %s : %d',[ComLine,result]);
+      if ComLine <> '' then
-      e.ErrorCode:=result;
+       CommandLine := Path + ' ' + ComLine
+      else
+       CommandLine := Path;
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+      e.ErrorCode:=Dos.DosError;
       raise e;
     end;
+  Result := DosExitCode;
 end;
 
 {*************************************************************************
@@ -851,12 +854,16 @@ end;
 Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
+  InitDelay;
 Finalization
   DoneExceptions;
 end.
 {
   $Log$
-  Revision 1.21  2004-01-10 20:25:14  michael
+  Revision 1.22  2004-01-20 23:09:14  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.21  2004/01/10 20:25:14  michael
   + Added rtlconst dependency to classes.ppu and implemented sysutils.sleep
 
   Revision 1.20  2004/01/10 10:49:24  jonas

rtl/inc/systemh.inc

@@ -326,6 +326,8 @@ const
   fmAppend = $D7B4;
   Filemode : byte = 2;
   CmdLine : PChar = nil;
+  ProcessID: SizeUInt = 1;
+(* Value should be changed during system initialization as appropriate. *)
 
   { assume that this program will not spawn other threads, when the
     first thread is started the following constants need to be filled }
@@ -347,6 +349,7 @@ ThreadVar
 {$else SUPPORT_THREADVAR}
 Var
 {$endif SUPPORT_THREADVAR}
+  ThreadID    : SizeUInt;
   { Standard In- and Output }
   Output,
   Input,
@@ -717,7 +720,10 @@ const
 
 {
   $Log$
-  Revision 1.81  2003-12-29 19:24:12  florian
+  Revision 1.82  2004-01-20 23:13:53  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.81  2003/12/29 19:24:12  florian
     + introduced PtrInt and PtrUInt
     * made strscan 64 bit safe
 

rtl/inc/thread.inc

@@ -31,6 +31,7 @@
         { Stack checking }
         StackLength:=stklen;
         StackBottom:=Sptr - StackLength;
+        ThreadID := SysGetCurrentThreadID;
       end;
 
 {*****************************************************************************
@@ -320,7 +321,10 @@ end;
 
 {
   $Log$
-  Revision 1.6  2003-11-29 17:33:09  michael
+  Revision 1.7  2004-01-20 23:13:53  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.6  2003/11/29 17:33:09  michael
   + Removed dummy variable from SetNothreadManager
 
   Revision 1.5  2003/11/29 17:29:32  michael

rtl/linux/system.pp

@@ -4,7 +4,7 @@
     Copyright (c) 2000 by Marco van de Voort
     member of the Free Pascal development team.
 
-    System unit for the *BSD's.
+    System unit for Linux.
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -164,6 +164,9 @@ Begin
   SysInitStdIO;
 { Reset IO Error }
   InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
 {$ifdef HASVARIANT}
   initvariantmanager;
 {$endif HASVARIANT}
@@ -171,7 +174,10 @@ End.
 
 {
   $Log$
-  Revision 1.13  2004-01-01 14:16:55  marco
+  Revision 1.14  2004-01-20 23:09:14  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.13  2004/01/01 14:16:55  marco
    * getcwd missed cdecl
 
   Revision 1.12  2003/12/31 20:20:57  marco

rtl/macos/system.pp

@@ -1130,6 +1130,9 @@ begin
   { Reset IO Error }
   InOutRes:=0;
   errno:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
 {$ifdef HASVARIANT}
   initvariantmanager;
 {$endif HASVARIANT}
@@ -1138,7 +1141,10 @@ end.
 
 {
   $Log$
-  Revision 1.11  2004-01-04 21:06:43  jonas
+  Revision 1.12  2004-01-20 23:11:20  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.11  2004/01/04 21:06:43  jonas
     * make the C-main public
 
   Revision 1.10  2003/10/29 22:34:52  olle

rtl/netware/system.pp

@@ -802,6 +802,10 @@ Begin
 
 { Reset IO Error }
   InOutRes:=0;
+
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
   
   SysInitStdIO;  
 
@@ -815,7 +819,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.20  2003-10-25 23:43:59  hajny
+  Revision 1.21  2004-01-20 23:11:20  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.20  2003/10/25 23:43:59  hajny
     * THandle in sysutils common using System.THandle
 
   Revision 1.19  2003/10/17 22:12:02  olle

rtl/netware/sysutils.pp

@@ -487,6 +487,28 @@ begin
 end;
 
 
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+
+var
+  e : EOSError;
+  CommandLine: AnsiString;
+
+begin
+  dos.exec(path,comline);
+
+  if (Dos.DosError <> 0) then
+    begin
+      if ComLine <> '' then
+       CommandLine := Path + ' ' + ComLine
+      else
+       CommandLine := Path;
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+      e.ErrorCode:=Dos.DosError;
+      raise e;
+    end;
+  Result := DosExitCode;
+end;
+
 {****************************************************************************
                               Initialization code
 ****************************************************************************}
@@ -500,7 +522,10 @@ end.
 {
 
   $Log$
-  Revision 1.13  2003-11-26 20:00:19  florian
+  Revision 1.14  2004-01-20 23:11:20  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.13  2003/11/26 20:00:19  florian
     * error handling for Variants improved
 
   Revision 1.12  2003/10/25 23:42:35  hajny

rtl/objpas/sysconst.pp

@@ -42,6 +42,7 @@ resourcestring
   SErrInvalidTimeStamp   = 'Invalid date/timestamp : "%s"';
   SExceptionErrorMessage = 'exception at %p';
   SExceptionStack        = 'Exception stack error';
+  SExecuteProcessFailed  = 'Failed to execute %s : %d';
   SExternalException     = 'External exception %x';
   SFileNotAssigned       = 'File not assigned';
   SFileNotFound          = 'File not found';
@@ -205,7 +206,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2004-01-10 19:35:17  michael
+  Revision 1.8  2004-01-20 23:05:31  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.7  2004/01/10 19:35:17  michael
   + Moved all resource strings to rtlconst/sysconst
 
   Revision 1.6  2004/01/10 17:55:45  michael

rtl/os2/doscalls.pas

@@ -2475,6 +2475,67 @@ function DosQueryMessageCP(var Buf;BufSize:longint;const FileName:string;
 
 ****************************************************************************}
 
+const
+{Start the new session independent or as a child.}
+    ssf_Related_Independent = 0;    {Start new session independent
+                                     of the calling session.}
+    ssf_Related_Child       = 1;    {Start new session as a child 
+                                     session to the calling session.}
+
+{Start the new session in the foreground or in the background.}
+    ssf_FgBg_Fore           = 0;    {Start new session in foreground.}
+    ssf_FgBg_Back           = 1;    {Start new session in background.}
+
+{Should the program started in the new session
+ be executed under conditions for tracing?}
+    ssf_TraceOpt_None       = 0;    {No trace.}
+    ssf_TraceOpt_Trace      = 1;    {Trace with no notification
+                                     of descendants.}
+    ssf_TraceOpt_TraceAll   = 2;    {Trace all descendant sessions.  
+                                     A termination queue must be 
+                                     supplied and Related must be 
+                                     ssf_Related_Child (=1).}
+
+{Will the new session inherit open file handles
+ and environment from the calling process.}
+    ssf_InhertOpt_Shell     = 0;    {Inherit from the shell.}
+    ssf_InhertOpt_Parent    = 1;    {Inherit from the calling process.}
+
+{Specifies the type of session to start.}
+    ssf_Type_Default        = 0;    {Use program's type.}
+    ssf_Type_FullScreen     = 1;    {OS/2 full screen.}
+    ssf_Type_WindowableVIO  = 2;    {OS/2 window.}
+    ssf_Type_PM             = 3;    {Presentation Manager.}
+    ssf_Type_VDM            = 4;    {DOS full screen.}
+    ssf_Type_WindowedVDM    = 7;    {DOS window.}
+{Additional values for Windows programs}
+    Prog_31_StdSeamlessVDM    = 15; {Windows 3.1 program in its
+                                     own windowed session.}
+    Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
+                                     common windowed session.}
+    Prog_31_EnhSeamlessVDM    = 17; {Windows 3.1 program in enhanced
+                                     compatibility mode in its own
+                                     windowed session.}
+    Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
+                                     compatibility mode in a common
+                                     windowed session.}
+    Prog_31_Enh               = 19; {Windows 3.1 program in enhanced
+                                     compatibility mode in a full
+                                     screen session.}
+    Prog_31_Std               = 20; {Windows 3.1 program in a full
+                                     screen session.}
+
+{Specifies the initial attributes for a OS/2 window or DOS window session.}
+    ssf_Control_Visible      = 0;   {Window is visible.}
+    ssf_Control_Invisible    = 1;   {Window is invisible.}
+    ssf_Control_Maximize     = 2;   {Window is maximized.}
+    ssf_Control_Minimize     = 4;   {Window is minimized.}
+    ssf_Control_NoAutoClose  = 8;   {Window will not close after
+                                     the program has ended.}
+    ssf_Control_SetPos   = 32768;   {Use InitXPos, InitYPos,
+                                     InitXSize, and InitYSize for
+                                     the size and placement.}
+
 type    TStatusData=record
             Length:word;                {Length, in bytes, of datastructure.}
             SelectIND:word;             {Determines if the session can be
@@ -2526,13 +2587,13 @@ type    TStartData=record
  AStartData         = A startdata record.
  SesID              = Receives session ID of session created.
  PID                = Receives process ID of process created.}
-function DosStartSession(const AStartData:TStartData;
+function DosStartSession (var AStartData:TStartData;
-                         var SesID,PID:longint):longint; cdecl;
+                          var SesID,PID:longint):longint; cdecl;
 
 {Set the status of a child session.
  SesID              = ID of session.
  AStatus            = Status to set.}
-function DosSetSession(SesID:longint;const AStatus:TStatusData):longint; cdecl;
+function DosSetSession(SesID:longint;var AStatus:TStatusData):longint; cdecl;
 
 {Bring a child session to the foreground.
  SesID              = ID of session.}
@@ -4471,12 +4532,12 @@ begin
     DosPutMessage:=DosPutMessage(Handle,Length(Buf),@Buf[1]);
 end;
 
-function DosStartSession(const AStartData:TStartData;
+function DosStartSession (var AStartData:TStartData;
-                         var SesID,PID:longint):longint; cdecl;
+                          var SesID,PID:longint):longint; cdecl;
 
 external 'SESMGR' index 37;
 
-function DosSetSession(SesID:longint;const AStatus:TStatusData):longint; cdecl;
+function DosSetSession(SesID:longint;var AStatus:TStatusData):longint; cdecl;
 
 external 'SESMGR' index 39;
 
@@ -4713,7 +4774,10 @@ external 'DOSCALLS' index 582;
 end.
 {
   $Log$
-  Revision 1.24  2003-12-04 21:22:38  peter
+  Revision 1.25  2004-01-20 23:11:20  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.24  2003/12/04 21:22:38  peter
     * regcall updates (untested)
 
   Revision 1.23  2003/11/02 00:25:09  hajny

rtl/os2/system.pas

@@ -210,6 +210,7 @@ function DosClose(Handle:longint): longint; cdecl;
 function DosRead(Handle:longint; Buffer: Pointer;Count:longint;
                  var ActCount:longint):longint; cdecl;
     external 'DOSCALLS' index 281;
+
 function DosWrite(Handle:longint; Buffer: Pointer;Count:longint;
                   var ActCount:longint):longint; cdecl;
     external 'DOSCALLS' index 282;
@@ -1391,6 +1392,8 @@ begin
 
     {Set type of application}
     ApplicationType := PIB^.ProcType;
+    ProcessID := PIB^.PID;
+    ThreadID := TIB^.TIB2^.TID;
     IsConsole := ApplicationType <> 3;
 
     exitproc:=nil;
@@ -1438,7 +1441,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.61  2003-12-04 21:22:38  peter
+  Revision 1.62  2004-01-20 23:11:20  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.61  2003/12/04 21:22:38  peter
     * regcall updates (untested)
 
   Revision 1.60  2003/11/23 07:21:16  yuri

rtl/os2/sysutils.pp

@@ -25,6 +25,7 @@ interface
 uses
  Dos;
 
+{$DEFINE HAS_SLEEP}
 { Include platform independent interface part }
 {$i sysutilh.inc}
 
@@ -46,44 +47,65 @@ implementation
 (* conflicts, so needed parts had to be redefined here). *)
 
 type
- TFileStatus = object
+        TFileStatus = object
-               end;
+        end;
- PFileStatus = ^TFileStatus;
+        PFileStatus = ^TFileStatus;
 
- TFileStatus0 = object (TFileStatus)
+        TFileStatus3 = object (TFileStatus)
-                 DateCreation,        {Date of file creation.}
+            DateCreation,               {Date of file creation.}
-                 TimeCreation,        {Time of file creation.}
+            TimeCreation,               {Time of file creation.}
-                 DateLastAccess,      {Date of last access to file.}
+            DateLastAccess,             {Date of last access to file.}
-                 TimeLastAccess,      {Time of last access to file.}
+            TimeLastAccess,             {Time of last access to file.}
-                 DateLastWrite,       {Date of last modification of file.}
+            DateLastWrite,              {Date of last modification of file.}
-                 TimeLastWrite: word; {Time of last modification of file.}
+            TimeLastWrite:word;         {Time of last modification of file.}
-                 FileSize,            {Size of file.}
+            FileSize,                   {Size of file.}
-                 FileAlloc: cardinal; {Amount of space the file really
+            FileAlloc:cardinal;         {Amount of space the file really
-                                       occupies on disk.}
+                                         occupies on disk.}
-                end;
+            AttrFile:cardinal;          {Attributes of file.}
- PFileStatus0 = ^TFileStatus0;
+        end;
+        PFileStatus3=^TFileStatus3;
 
- TFileStatus3 = object (TFileStatus)
+        TFileStatus4=object(TFileStatus3)
-                 NextEntryOffset: cardinal; {Offset of next entry}
+            cbList:cardinal;            {Length of entire EA set.}
-                 DateCreation,             {Date of file creation.}
+        end;
-                 TimeCreation,             {Time of file creation.}
+        PFileStatus4=^TFileStatus4;
-                 DateLastAccess,           {Date of last access to file.}
-                 TimeLastAccess,           {Time of last access to file.}
-                 DateLastWrite,            {Date of last modification of file.}
-                 TimeLastWrite: word;      {Time of last modification of file.}
-                 FileSize,                 {Size of file.}
-                 FileAlloc: cardinal;      {Amount of space the file really
-                                            occupies on disk.}
-                 AttrFile: cardinal;       {Attributes of file.}
-                end;
- PFileStatus3 = ^TFileStatus3;
 
- TFileFindBuf3 = object (TFileStatus3)
+        TFileFindBuf3=object(TFileStatus)
-                  Name: ShortString;       {Also possible to use as ASCIIZ.
+            NextEntryOffset: cardinal;  {Offset of next entry}
-                                            The byte following the last string
+            DateCreation,               {Date of file creation.}
-                                            character is always zero.}
+            TimeCreation,               {Time of file creation.}
-                 end;
+            DateLastAccess,             {Date of last access to file.}
- PFileFindBuf3 = ^TFileFindBuf3;
+            TimeLastAccess,             {Time of last access to file.}
+            DateLastWrite,              {Date of last modification of file.}
+            TimeLastWrite:word;         {Time of last modification of file.}
+            FileSize,                   {Size of file.}
+            FileAlloc:cardinal;         {Amount of space the file really
+                                         occupies on disk.}
+            AttrFile:cardinal;          {Attributes of file.}
+            Name:string;                {Also possible to use as ASCIIZ.
+                                         The byte following the last string
+                                         character is always zero.}
+        end;
+        PFileFindBuf3=^TFileFindBuf3;
+
+        TFileFindBuf4=object(TFileStatus)
+            NextEntryOffset: cardinal;  {Offset of next entry}
+            DateCreation,               {Date of file creation.}
+            TimeCreation,               {Time of file creation.}
+            DateLastAccess,             {Date of last access to file.}
+            TimeLastAccess,             {Time of last access to file.}
+            DateLastWrite,              {Date of last modification of file.}
+            TimeLastWrite:word;         {Time of last modification of file.}
+            FileSize,                   {Size of file.}
+            FileAlloc:cardinal;         {Amount of space the file really
+                                         occupies on disk.}
+            AttrFile:cardinal;          {Attributes of file.}
+            cbList:longint;             {Size of the file's extended attributes.}
+            Name:string;                {Also possible to use as ASCIIZ.
+                                         The byte following the last string
+                                         character is always zero.}
+        end;
+        PFileFindBuf4=^TFileFindBuf4;
 
  TFSInfo = record
             case word of
@@ -172,12 +194,128 @@ type
               end;
  PCountryInfo=^TCountryInfo;
 
+ TRequestData=record
+               PID,                {ID of process that wrote element.}
+               Data: cardinal;     {Information from process writing the data.}
+              end;
+ PRequestData=^TRequestData;
+
+{Queue data structure for synchronously started sessions.}
+ TChildInfo = record
+  case boolean of
+   false:
+    (SessionID,
+     Return: word);  {Return code from the child process.}
+   true:
+    (usSessionID,
+     usReturn: word);     {Return code from the child process.}
+ end;
+ PChildInfo = ^TChildInfo;
+
+ TStartData=record
+  {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
+  Length:word;                {Length, in bytes, of datastructure
+                               (24/30/32/50/60).}
+  Related:word;               {Independent/child session (0/1).}
+  FgBg:word;                  {Foreground/background (0/1).}
+  TraceOpt:word;              {No trace/trace this/trace all (0/1/2).}
+  PgmTitle:PChar;             {Program title.}
+  PgmName:PChar;              {Filename to program.}
+  PgmInputs:PChar;            {Command parameters (nil allowed).}
+  TermQ:PChar;                {System queue. (nil allowed).}
+  Environment:PChar;          {Environment to pass (nil allowed).}
+  InheritOpt:word;            {Inherit enviroment from shell/
+                               inherit environment from parent (0/1).}
+  SessionType:word;           {Auto/full screen/window/presentation
+                               manager/full screen Dos/windowed Dos
+                               (0/1/2/3/4/5/6/7).}
+  Iconfile:PChar;             {Icon file to use (nil allowed).}
+  PgmHandle:cardinal;         {0 or the program handle.}
+  PgmControl:word;            {Bitfield describing initial state
+                               of windowed sessions.}
+  InitXPos,InitYPos:word;     {Initial top coordinates.}
+  InitXSize,InitYSize:word;   {Initial size.}
+  Reserved:word;
+  ObjectBuffer:PChar;         {If a module cannot be loaded, its
+                               name will be returned here.}
+  ObjectBuffLen:cardinal;     {Size of your buffer.}
+ end;
+ PStartData=^TStartData;
+
 const
  ilStandard      = 1;
  ilQueryEAsize   = 2;
  ilQueryEAs      = 3;
  ilQueryFullName = 5;
 
+ quFIFO     = 0;
+ quLIFO     = 1;
+ quPriority = 2;
+
+ quNoConvert_Address = 0;
+ quConvert_Address   = 4;
+
+{Start the new session independent or as a child.}
+ ssf_Related_Independent = 0;    {Start new session independent
+                                  of the calling session.}
+ ssf_Related_Child       = 1;    {Start new session as a child 
+                                  session to the calling session.}
+
+{Start the new session in the foreground or in the background.}
+ ssf_FgBg_Fore           = 0;    {Start new session in foreground.}
+ ssf_FgBg_Back           = 1;    {Start new session in background.}
+
+{Should the program started in the new session
+ be executed under conditions for tracing?}
+ ssf_TraceOpt_None       = 0;    {No trace.}
+ ssf_TraceOpt_Trace      = 1;    {Trace with no notification
+                                  of descendants.}
+ ssf_TraceOpt_TraceAll   = 2;    {Trace all descendant sessions.  
+                                  A termination queue must be 
+                                  supplied and Related must be 
+                                  ssf_Related_Child (=1).}
+
+{Will the new session inherit open file handles
+ and environment from the calling process.}
+ ssf_InhertOpt_Shell     = 0;    {Inherit from the shell.}
+ ssf_InhertOpt_Parent    = 1;    {Inherit from the calling process.}
+
+{Specifies the type of session to start.}
+ ssf_Type_Default        = 0;    {Use program's type.}
+ ssf_Type_FullScreen     = 1;    {OS/2 full screen.}
+ ssf_Type_WindowableVIO  = 2;    {OS/2 window.}
+ ssf_Type_PM             = 3;    {Presentation Manager.}
+ ssf_Type_VDM            = 4;    {DOS full screen.}
+ ssf_Type_WindowedVDM    = 7;    {DOS window.}
+{Additional values for Windows programs}
+ Prog_31_StdSeamlessVDM    = 15; {Windows 3.1 program in its
+                                  own windowed session.}
+ Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
+                                  common windowed session.}
+ Prog_31_EnhSeamlessVDM    = 17; {Windows 3.1 program in enhanced
+                                  compatibility mode in its own
+                                  windowed session.}
+ Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
+                                  compatibility mode in a common
+                                  windowed session.}
+ Prog_31_Enh               = 19; {Windows 3.1 program in enhanced
+                                  compatibility mode in a full
+                                  screen session.}
+ Prog_31_Std               = 20; {Windows 3.1 program in a full
+                                  screen session.}
+
+{Specifies the initial attributes for a OS/2 window or DOS window session.}
+ ssf_Control_Visible      = 0;   {Window is visible.}
+ ssf_Control_Invisible    = 1;   {Window is invisible.}
+ ssf_Control_Maximize     = 2;   {Window is maximized.}
+ ssf_Control_Minimize     = 4;   {Window is minimized.}
+ ssf_Control_NoAutoClose  = 8;   {Window will not close after
+                                  the program has ended.}
+ ssf_Control_SetPos   = 32768;   {Use InitXPos, InitYPos,
+                                  InitXSize, and InitYSize for
+                                  the size and placement.}
+
+
 function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus;
         FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
 
@@ -236,7 +374,8 @@ function DosClose(Handle:longint): longint; cdecl;
 function DosRead(Handle:longint; var Buffer; Count:longint;
                  var ActCount:longint):longint; cdecl;
     external 'DOSCALLS' index 281;
-function DosWrite(Handle:longint; const Buffer; Count:longint;
+
+function DosWrite(Handle:longint; Buffer: pointer; Count:longint;
                   var ActCount:longint):longint; cdecl;
     external 'DOSCALLS' index 282;
 
@@ -247,6 +386,28 @@ function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal;
 function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl;
     external 'DOSCALLS' index 272;
 
+procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
+
+function DosCreateQueue (var Handle: THandle; Priority:longint;
+                        Name: PChar): cardinal; cdecl;
+                                                  external 'QUECALLS' index 16;
+
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+                      var DataLen: cardinal; var DataPtr: pointer;
+                      Element, Wait: cardinal; var Priority: byte;
+                      ASem: THandle): cardinal; cdecl;
+                                                   external 'QUECALLS' index 9;
+
+function DosCloseQueue (Handle: THandle): cardinal; cdecl;
+                                                  external 'QUECALLS' index 11;
+
+function DosStartSession (var AStartData: TStartData;
+                          var SesID, PID: cardinal): cardinal; cdecl;
+                                                    external 'SESMGR' index 37;
+
+function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
+
+
 type
   TDT=packed record
     Hour,
@@ -314,7 +475,7 @@ Begin
     FileCreate:=-RC;
 End;
 
-function FileCreate (const FileName: string; Mode: longint): longint;
+function FileCreate (const FileName: string; Mode: integer): longint;
 begin
  FileCreate := FileCreate(FileName);
 end;
@@ -332,7 +493,7 @@ function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
 Var
   T: Longint;
 begin
-  DosWrite(Handle, Buffer, Count, T);
+  DosWrite (Handle, @Buffer, Count, T);
   FileWrite:=T;
 end;
 
@@ -472,7 +633,7 @@ end;
 
 function FileSetDate (Handle, Age: longint): longint;
 var
-  FStat: PFileStatus0;
+  FStat: PFileStatus3;
   RC: cardinal;
 begin
   New (FStat);
@@ -726,6 +887,63 @@ begin
 end;
 
 
+procedure Sleep (Milliseconds: cardinal);
+
+begin
+ DosSleep (Milliseconds);
+end;
+
+
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+                                                                       integer;
+var
+ HQ: THandle;
+ SPID, STID, QName: shortstring;
+ SD: TStartData;
+ SID, PID: cardinal;
+ RD: TRequestData;
+ PCI: PChildInfo;
+ CISize: cardinal;
+ Prio: byte;
+ E: EOSError;
+ CommandLine: ansistring;
+
+begin
+ FillChar (SD, SizeOf (SD), 0);
+ SD.Length := 24;
+ SD.Related := ssf_Related_Child;
+ SD.PgmName := PChar (Path);
+ SD.PgmInputs := PChar (ComLine);
+ Str (ProcessID, SPID);
+ Str (ThreadID, STID);
+ QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
+ SD.TermQ := @QName [1];
+ Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
+ if Result = 0 then
+  begin
+   Result := DosStartSession (SD, SID, PID);
+   if (Result = 0) or (Result = 457) then
+    begin
+     Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
+     if Result = 0 then
+      begin
+       Result := PCI^.Return;
+       DosCloseQueue (HQ);
+       DosFreeMem (PCI);
+       Exit;
+      end;
+    end;
+   DosCloseQueue (HQ);
+  end;
+ if ComLine = '' then
+  CommandLine := Path
+ else
+  CommandLine := Path + ' ' + ComLine;
+ E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]);
+ E.ErrorCode := Result;
+ raise E;
+end;
+
 {****************************************************************************
                               Initialization code
 ****************************************************************************}
@@ -739,7 +957,10 @@ end.
 
 {
   $Log$
-  Revision 1.39  2003-11-26 20:00:19  florian
+  Revision 1.40  2004-01-20 23:11:20  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.39  2003/11/26 20:00:19  florian
     * error handling for Variants improved
 
   Revision 1.38  2003/11/23 15:50:07  yuri

rtl/template/system.pp

@@ -25,6 +25,10 @@ interface
 
 {$I systemh.inc}
 
+type
+ THandle = longint;
+
+
 { include heap support headers }
 
 {$I heaph.inc}
@@ -288,10 +292,16 @@ Begin
   Setup_Arguments;
 { Reset IO Error }
   InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate.  *)
+  ThreadID := 1;
 End.
 {
   $Log$
-  Revision 1.9  2003-09-27 11:52:36  peter
+  Revision 1.10  2004-01-20 23:12:49  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.9  2003/09/27 11:52:36  peter
     * sbrk returns pointer
 
   Revision 1.8  2002/09/07 16:01:27  peter

rtl/template/sysutils.pp

@@ -249,6 +249,27 @@ begin
   Result:=StrPas(beos.Getenv(PChar(EnvVar)));
 end;
 
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+
+var
+  e : EOSError;
+  CommandLine: AnsiString;
+
+begin
+  dos.exec(path,comline);
+
+  if (Dos.DosError <> 0) then
+    begin
+      if ComLine <> '' then
+       CommandLine := Path + ' ' + ComLine
+      else
+       CommandLine := Path;
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+      e.ErrorCode:=Dos.DosError;
+      raise e;
+    end;
+  Result := DosExitCode;
+end;
 
 {****************************************************************************
                               Initialization code
@@ -263,7 +284,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.3  2003-03-29 15:16:26  hajny
+  Revision 1.4  2004-01-20 23:12:49  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.3  2003/03/29 15:16:26  hajny
     * dummy DirectoryExists added
 
   Revision 1.2  2002/09/07 16:01:27  peter

rtl/unix/cthreads.pp

@@ -365,7 +365,8 @@ begin
   Result:=True;
 {$else}  
   Result:=LoadPthreads;
-{$endif}  
+{$endif}
+  ThreadID := SizeUInt (pthread_self);
   Writeln('InitThreads : ',Result);
 end;
 
@@ -420,7 +421,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.6  2004-01-07 17:40:56  jonas
+  Revision 1.7  2004-01-20 23:13:53  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.6  2004/01/07 17:40:56  jonas
     * Darwin does not have a lib_r, libc itself is already reentrant
 
   Revision 1.5  2003/12/16 09:43:04  daniel

rtl/unix/sysutils.pp

@@ -483,23 +483,31 @@ var
   pid    : longint;
   err    : longint;
   e : EOSError;
-  
+  CommandLine: AnsiString;
+
 Begin
+  { always surround the name of the application by quotes
+    so that long filenames will always be accepted. But don't
+    do it if there are already double quotes!
+  }
+  if Pos ('"', Path) = 0 then
+    CommandLine := '"' + Path + '"'
+  else
+    CommandLine := Path;
+  if ComLine <> '' then
+    CommandLine := Commandline + ' ' + ComLine;
   pid:=fpFork;
   if pid=0 then
    begin
    {The child does the actual exec, and then exits}
-     if ComLine='' then
+     Execl(CommandLine);
-       Execl(Path)
-     else
-       Execl(Path+' '+ComLine);
      { If the execve fails, we return an exitvalue of 127, to let it be known}
      fpExit(127);
    end
   else
    if pid=-1 then         {Fork failed}
     begin
-      e:=EOSError.CreateFmt('Failed to execute %s : %d',[ComLine,-1]);
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,-1]);
       e.ErrorCode:=-1;
       raise e;
     end;
@@ -511,7 +519,7 @@ Begin
     result:=0
   else
     begin
-      e:=EOSError.CreateFmt('Failed to execute %s : %d',[ComLine,result]);
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,result]);
       e.ErrorCode:=result;
       raise e;
     end;
@@ -549,7 +557,10 @@ end.
 {
 
   $Log$
-  Revision 1.30  2004-01-10 17:34:36  michael
+  Revision 1.31  2004-01-20 23:13:53  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.30  2004/01/10 17:34:36  michael
   + Implemented sleep() on Unix.
 
   Revision 1.29  2004/01/05 22:42:35  florian

rtl/watcom/system.pp

@@ -1525,6 +1525,7 @@ Begin
    FileNameCaseSensitive:=true;
 { Reset IO Error }
   InOutRes:=0;
+  ThreadID := 1;
 {$ifdef  EXCEPTIONS_IN_SYSTEM}
   InitDPMIExcp;
   InstallDefaultHandlers;
@@ -1534,11 +1535,12 @@ Begin
 {$endif HASVARIANT}
 End.
 
-END.
-
 {
   $Log$
-  Revision 1.11  2004-01-11 23:08:39  hajny
+  Revision 1.12  2004-01-20 23:12:49  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.11  2004/01/11 23:08:39  hajny
     * merged Jonas fix from GO32v2
 
   Revision 1.10  2004/01/11 22:54:44  hajny

rtl/watcom/sysutils.pp

@@ -24,6 +24,7 @@ interface
 uses
   watcom,dos;
 
+{$DEFINE HAS_SLEEP}
 { Include platform independent interface part }
 {$i sysutilh.inc}
 
@@ -759,6 +760,93 @@ begin
    end;
 end;
 
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+
+var
+  e : EOSError;
+  CommandLine: AnsiString;
+
+begin
+  dos.exec(path,comline);
+
+  if (Dos.DosError <> 0) then
+    begin
+      if ComLine <> '' then
+       CommandLine := Path + ' ' + ComLine
+      else
+       CommandLine := Path;
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+      e.ErrorCode:=Dos.DosError;
+      raise e;
+    end;
+  Result := DosExitCode;
+end;
+
+{*************************************************************************
+                                   Sleep (copied from crt.Delay)
+*************************************************************************}
+
+var
+  DelayCnt : Longint;
+
+
+procedure Delayloop;assembler;
+asm
+.LDelayLoop1:
+        subl    $1,%eax
+        jc      .LDelayLoop2
+        cmpl    %fs:(%edi),%ebx
+        je      .LDelayLoop1
+.LDelayLoop2:
+end;
+
+
+procedure initdelay;assembler;
+asm
+	pushl %ebx
+	pushl %edi
+        { for some reason, using int $31/ax=$901 doesn't work here }
+        { and interrupts are always disabled at this point when    }
+        { running a program inside gdb(pas). Web bug 1345 (JM)     }
+        sti
+        movl    $0x46c,%edi
+        movl    $-28,%edx
+        movl    %fs:(%edi),%ebx
+.LInitDel1:
+        cmpl    %fs:(%edi),%ebx
+        je      .LInitDel1
+        movl    %fs:(%edi),%ebx
+        movl    %edx,%eax
+        call    DelayLoop
+
+        notl    %eax
+        xorl    %edx,%edx
+        movl    $55,%ecx
+        divl    %ecx
+        movl    %eax,DelayCnt
+	popl %edi
+	popl %ebx
+end;
+
+
+procedure Sleep(MilliSeconds: Cardinal);assembler;
+asm
+	pushl %ebx
+	pushl %edi
+        movl  MilliSeconds,%ecx
+        jecxz   .LDelay2
+        movl    $0x400,%edi
+        movl    DelayCnt,%edx
+        movl    %fs:(%edi),%ebx
+.LDelay1:
+        movl    %edx,%eax
+        call    DelayLoop
+        loop    .LDelay1
+.LDelay2:
+	popl %edi
+	popl %ebx
+end;
+
 {****************************************************************************
                               Initialization code
 ****************************************************************************}
@@ -766,13 +854,17 @@ end;
 Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
+  InitDelay;
 Finalization
   DoneExceptions;
 end.
 
 {
   $Log$
-  Revision 1.3  2003-12-15 15:57:49  peter
+  Revision 1.4  2004-01-20 23:12:49  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.3  2003/12/15 15:57:49  peter
     * patches from wiktor
 
   Revision 1.2  2003/11/26 20:00:19  florian

rtl/win32/system.pp

@@ -694,6 +694,9 @@ end;
    function GetCommandLine : pchar;
      stdcall;external 'kernel32' name 'GetCommandLineA';
 
+   function GetCurrentThread : dword;
+     stdcall; external 'kernel32' name 'GetCurrentThread';
+
 
 var
   ModuleName : array[0..255] of char;
@@ -1539,6 +1542,7 @@ begin
   setup_arguments;
   { Reset IO Error }
   InOutRes:=0;
+  ThreadID := GetCurrentThread;
   { Reset internal error variable }
   errno:=0;
 {$ifdef HASVARIANT}
@@ -1548,7 +1552,10 @@ end.
 
 {
   $Log$
-  Revision 1.51  2003-12-17 21:56:33  peter
+  Revision 1.52  2004-01-20 23:12:49  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.51  2003/12/17 21:56:33  peter
     * win32 regcall patches
 
   Revision 1.50  2003/12/04 20:52:41  peter

rtl/win32/sysutils.pp

@@ -688,7 +688,7 @@ begin
   FillChar(SI, SizeOf(SI), 0);
   SI.cb:=SizeOf(SI);
   SI.wShowWindow:=1;
-  { always surroound the name of the application by quotes
+  { always surround the name of the application by quotes
     so that long filenames will always be accepted. But don't
     do it if there are already double quotes, since Win32 does not
     like double quotes which are duplicated!
@@ -697,12 +697,15 @@ begin
     CommandLine:='"'+path+'"'
   else
     CommandLine:=path;
-  CommandLine:=Commandline+' '+ComLine+#0;
+  if ComLine <> '' then
+    CommandLine:=Commandline+' '+ComLine+#0
+  else
+    CommandLine := CommandLine + #0;
 
   if not CreateProcess(nil, pchar(CommandLine),
     Nil, Nil, ExecInheritsHandles,$20, Nil, Nil, SI, PI) then
     begin
-      e:=EOSError.CreateFmt('Failed to execute %s : %d',[CommandLine,GetLastError]);
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
       e.ErrorCode:=GetLastError;
       raise e;
     end;
@@ -716,7 +719,7 @@ begin
     end
   else
     begin
-      e:=EOSError.CreateFmt('Failed to execute %s : %d',[CommandLine,GetLastError]);
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
       e.ErrorCode:=GetLastError;
       CloseHandle(Proc);
       raise e;
@@ -790,7 +793,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.30  2004-01-16 20:53:33  michael
+  Revision 1.31  2004-01-20 23:12:49  hajny
+    * ExecuteProcess fixes, ProcessID and ThreadID added
+
+  Revision 1.30  2004/01/16 20:53:33  michael
   + DirectoryExists now closes findfirst handle
 
   Revision 1.29  2004/01/10 17:40:25  michael