paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 21:28:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ExecuteProcess fixes, ProcessID and ThreadID added

Browse Source
This commit is contained in:
Tomas Hajny 2004-01-20 23:05:31 +00:00
parent 1779c5dd8c
commit e0f9297e01
28 changed files with 967 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
rtl/amiga/system.pas
View File

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

8
rtl/atari/system.pas
View File

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

8
rtl/beos/system.pp
View File

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

26
rtl/beos/sysutils.pp
View File

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

8
rtl/bsd/system.pp
View File

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

28
rtl/emx/system.pas
View File

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

6
rtl/emx/systhrds.pp
View File

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

329
rtl/emx/sysutils.pp
View File

@ -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
end;
PFileStatus = ^TFileStatus;
TFileStatus = object
end;
PFileStatus = ^TFileStatus;
TFileStatus0 = object (TFileStatus)
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.}
end;
PFileStatus0 = ^TFileStatus0;
TFileStatus3 = object (TFileStatus)
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.}
end;
PFileStatus3=^TFileStatus3;
TFileStatus3 = 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.}
end;
PFileStatus3 = ^TFileStatus3;
TFileStatus4=object(TFileStatus3)
cbList:cardinal; {Length of entire EA set.}
end;
PFileStatus4=^TFileStatus4;
TFileFindBuf3 = object (TFileStatus3)
Name: ShortString; {Also possible to use as ASCIIZ.
The byte following the last string
character is always zero.}
end;
PFileFindBuf3 = ^TFileFindBuf3;
TFileFindBuf3=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.}
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

6
rtl/go32v2/system.pp
View File

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

23
rtl/go32v2/sysutils.pp
View File

@ -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;
{ (dos)exit code is irrelevant, at least the unix implementation }
{ does not }
{ take it into account }
if (result <> 0) then
if (Dos.DosError <> 0) then
begin
e:=EOSError.CreateFmt('Failed to execute %s : %d',[ComLine,result]);
e.ErrorCode:=result;
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;
{*************************************************************************
@ -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

8
rtl/inc/systemh.inc
View File

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

6
rtl/inc/thread.inc
View File

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

10
rtl/linux/system.pp
View File

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

8
rtl/macos/system.pp
View File

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

9
rtl/netware/system.pp
View File

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

27
rtl/netware/sysutils.pp
View File

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

6
rtl/objpas/sysconst.pp
View File

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

78
rtl/os2/doscalls.pas
View File

@ -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;
var SesID,PID:longint):longint; cdecl;
function DosStartSession (var AStartData:TStartData;
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;
var SesID,PID:longint):longint; cdecl;
function DosStartSession (var AStartData:TStartData;
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

8
rtl/os2/system.pas
View File

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

301
rtl/os2/sysutils.pp
View File

@ -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
end;
PFileStatus = ^TFileStatus;
TFileStatus = object
end;
PFileStatus = ^TFileStatus;
TFileStatus0 = object (TFileStatus)
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.}
end;
PFileStatus0 = ^TFileStatus0;
TFileStatus3 = object (TFileStatus)
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.}
end;
PFileStatus3=^TFileStatus3;
TFileStatus3 = 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.}
end;
PFileStatus3 = ^TFileStatus3;
TFileStatus4=object(TFileStatus3)
cbList:cardinal; {Length of entire EA set.}
end;
PFileStatus4=^TFileStatus4;
TFileFindBuf3 = object (TFileStatus3)
Name: ShortString; {Also possible to use as ASCIIZ.
The byte following the last string
character is always zero.}
end;
PFileFindBuf3 = ^TFileFindBuf3;
TFileFindBuf3=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.}
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

12
rtl/template/system.pp
View File

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

26
rtl/template/sysutils.pp
View File

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

8
rtl/unix/cthreads.pp
View File

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

27
rtl/unix/sysutils.pp
View File

@ -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(Path)
else
Execl(Path+' '+ComLine);
Execl(CommandLine);
{ 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

8
rtl/watcom/system.pp
View File

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

94
rtl/watcom/sysutils.pp
View File

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

9
rtl/win32/system.pp
View File

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

16
rtl/win32/sysutils.pp
View File

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