diff --git a/rtl/amiga/system.pas b/rtl/amiga/system.pas index 27864ba993..7e70189d52 100644 --- a/rtl/amiga/system.pas +++ b/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 diff --git a/rtl/atari/system.pas b/rtl/atari/system.pas index e45e212ea9..4a1dc20125 100644 --- a/rtl/atari/system.pas +++ b/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 diff --git a/rtl/beos/system.pp b/rtl/beos/system.pp index c96ef40f04..9cbcd13aa1 100644 --- a/rtl/beos/system.pp +++ b/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 diff --git a/rtl/beos/sysutils.pp b/rtl/beos/sysutils.pp index aa323f98fd..e58f250496 100644 --- a/rtl/beos/sysutils.pp +++ b/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 diff --git a/rtl/bsd/system.pp b/rtl/bsd/system.pp index e9dd236152..68eec0bdc2 100644 --- a/rtl/bsd/system.pp +++ b/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) diff --git a/rtl/emx/system.pas b/rtl/emx/system.pas index 5a7b335a55..e450a8b929 100644 --- a/rtl/emx/system.pas +++ b/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 diff --git a/rtl/emx/systhrds.pp b/rtl/emx/systhrds.pp index d0ca44f8bf..fbb28bfd55 100644 --- a/rtl/emx/systhrds.pp +++ b/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 diff --git a/rtl/emx/sysutils.pp b/rtl/emx/sysutils.pp index b2cbf7c431..e51b02d0fa 100644 --- a/rtl/emx/sysutils.pp +++ b/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 - 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 diff --git a/rtl/go32v2/system.pp b/rtl/go32v2/system.pp index 805640e3a4..0ee32ae296 100644 --- a/rtl/go32v2/system.pp +++ b/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 diff --git a/rtl/go32v2/sysutils.pp b/rtl/go32v2/sysutils.pp index 5d8de1c996..331b30efd9 100644 --- a/rtl/go32v2/sysutils.pp +++ b/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; - { (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 diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 4616a705d4..fb3721ec4d 100644 --- a/rtl/inc/systemh.inc +++ b/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 diff --git a/rtl/inc/thread.inc b/rtl/inc/thread.inc index fa82eef223..3498f4cf1b 100644 --- a/rtl/inc/thread.inc +++ b/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 diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp index f9532d614d..367429b659 100644 --- a/rtl/linux/system.pp +++ b/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 diff --git a/rtl/macos/system.pp b/rtl/macos/system.pp index 1a69803553..1eed65b5ef 100644 --- a/rtl/macos/system.pp +++ b/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 diff --git a/rtl/netware/system.pp b/rtl/netware/system.pp index bbd7b0b220..2824b33ed5 100644 --- a/rtl/netware/system.pp +++ b/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 diff --git a/rtl/netware/sysutils.pp b/rtl/netware/sysutils.pp index f9cfa15bce..def25e6d04 100644 --- a/rtl/netware/sysutils.pp +++ b/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 diff --git a/rtl/objpas/sysconst.pp b/rtl/objpas/sysconst.pp index 7f354d9f1f..7fd976c126 100644 --- a/rtl/objpas/sysconst.pp +++ b/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 diff --git a/rtl/os2/doscalls.pas b/rtl/os2/doscalls.pas index 3a86f12a6b..f0a4e68704 100644 --- a/rtl/os2/doscalls.pas +++ b/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; - 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 diff --git a/rtl/os2/system.pas b/rtl/os2/system.pas index 362bac01ed..a2ea85177c 100644 --- a/rtl/os2/system.pas +++ b/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 diff --git a/rtl/os2/sysutils.pp b/rtl/os2/sysutils.pp index f530037311..f9ca41a807 100644 --- a/rtl/os2/sysutils.pp +++ b/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 - 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 diff --git a/rtl/template/system.pp b/rtl/template/system.pp index 833e3f6c21..1b8cb92caa 100644 --- a/rtl/template/system.pp +++ b/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 diff --git a/rtl/template/sysutils.pp b/rtl/template/sysutils.pp index 011cadbb92..4e52126106 100644 --- a/rtl/template/sysutils.pp +++ b/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 diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp index cb637f074a..e860c5a726 100644 --- a/rtl/unix/cthreads.pp +++ b/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 diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp index 07f3e62baf..48d28017e1 100644 --- a/rtl/unix/sysutils.pp +++ b/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(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 diff --git a/rtl/watcom/system.pp b/rtl/watcom/system.pp index 8313e7e4c6..21e63559b7 100644 --- a/rtl/watcom/system.pp +++ b/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 diff --git a/rtl/watcom/sysutils.pp b/rtl/watcom/sysutils.pp index 5510ec2ee3..56300c1b12 100644 --- a/rtl/watcom/sysutils.pp +++ b/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 diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index e2c6e17b1c..f396760993 100644 --- a/rtl/win32/system.pp +++ b/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 diff --git a/rtl/win32/sysutils.pp b/rtl/win32/sysutils.pp index ce3b859c10..df9574a093 100644 --- a/rtl/win32/sysutils.pp +++ b/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