--- Merging r30653 into '.':

U    rtl/inc/fexpand.inc
--- Recording mergeinfo for merge of r30653 into '.':
 U   .
--- Merging r30654 into '.':
U    tests/test/units/dos/tfexpand.pp
--- Recording mergeinfo for merge of r30654 into '.':
 G   .
--- Merging r30774 into '.':
G    tests/test/units/dos/tfexpand.pp
--- Recording mergeinfo for merge of r30774 into '.':
 G   .
--- Merging r30788 into '.':
U    rtl/amiga/system.pp
--- Recording mergeinfo for merge of r30788 into '.':
 G   .
--- Merging r30789 into '.':
U    rtl/morphos/system.pp
--- Recording mergeinfo for merge of r30789 into '.':
 G   .
--- Merging r30790 into '.':
U    packages/fcl-process/fpmake.pp
A    packages/fcl-process/src/amicommon
A    packages/fcl-process/src/amicommon/process.inc
A    packages/fcl-process/src/amicommon/pipes.inc
A    packages/fcl-process/src/amicommon/simpleipc.inc
--- Recording mergeinfo for merge of r30790 into '.':
 G   .
--- Merging r30803 into '.':
U    packages/fcl-process/src/amicommon/simpleipc.inc
--- Recording mergeinfo for merge of r30803 into '.':
 G   .
--- Merging r30805 into '.':
U    packages/fcl-process/src/amicommon/process.inc
U    packages/fcl-process/src/amicommon/pipes.inc
--- Recording mergeinfo for merge of r30805 into '.':
 G   .
--- Merging r30806 into '.':
G    packages/fcl-process/src/amicommon/process.inc
G    packages/fcl-process/src/amicommon/pipes.inc
--- Recording mergeinfo for merge of r30806 into '.':
 G   .
--- Merging r30812 into '.':
U    packages/morphunits/src/amigados.pas
U    packages/amunits/src/coreunits/amigados.pas
G    packages/fcl-process/src/amicommon/process.inc
G    packages/fcl-process/src/amicommon/pipes.inc
U    packages/arosunits/src/amigados.pas
--- Recording mergeinfo for merge of r30812 into '.':
 G   .
--- Merging r30813 into '.':
U    rtl/aros/system.pp
--- Recording mergeinfo for merge of r30813 into '.':
 G   .

# revisions: 30653,30654,30774,30788,30789,30790,30803,30805,30806,30812,30813

git-svn-id: branches/fixes_3_0@31082 -
This commit is contained in:
marco 2015-06-17 11:23:29 +00:00
parent e58f7faae9
commit 3605c0655a
13 changed files with 559 additions and 70 deletions

3
.gitattributes vendored
View File

@ -2529,6 +2529,9 @@ packages/fcl-process/Makefile svneol=native#text/plain
packages/fcl-process/Makefile.fpc svneol=native#text/plain packages/fcl-process/Makefile.fpc svneol=native#text/plain
packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
packages/fcl-process/fpmake.pp svneol=native#text/plain packages/fcl-process/fpmake.pp svneol=native#text/plain
packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
packages/fcl-process/src/amicommon/simpleipc.inc svneol=native#text/plain
packages/fcl-process/src/dbugintf.pp svneol=native#text/plain packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain

View File

@ -1598,7 +1598,7 @@ FUNCTION CreateProc(const name : pCHAR location 'd1'; pri : LONGINT location 'd2
FUNCTION CurrentDir(lock : LONGINT location 'd1') : LONGINT; syscall _DOSBase 126; FUNCTION CurrentDir(lock : LONGINT location 'd1') : LONGINT; syscall _DOSBase 126;
PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192; PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192;
FUNCTION DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744; FUNCTION DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744;
FUNCTION DeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072; FUNCTION DOSDeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072;
FUNCTION DeleteVar(const name : pCHAR location 'd1'; flags : ULONG location 'd2') : LongBool; syscall _DOSBase 912; FUNCTION DeleteVar(const name : pCHAR location 'd1'; flags : ULONG location 'd2') : LongBool; syscall _DOSBase 912;
FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174; FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174;
FUNCTION DoPkt(port : pMsgPort location 'd1'; action : LONGINT location 'd2'; arg1 : LONGINT location 'd3'; arg2 : LONGINT location 'd4'; arg3 : LONGINT location 'd5'; arg4 : LONGINT location 'd6'; arg5 : LONGINT location 'd7') : LONGINT; syscall _DOSBase 240; FUNCTION DoPkt(port : pMsgPort location 'd1'; action : LONGINT location 'd2'; arg1 : LONGINT location 'd3'; arg2 : LONGINT location 'd4'; arg3 : LONGINT location 'd5'; arg4 : LONGINT location 'd6'; arg5 : LONGINT location 'd7') : LONGINT; syscall _DOSBase 240;
@ -1756,7 +1756,7 @@ FUNCTION AssignPath(const name : pCHAR;const path : string) : BOOLEAN;
FUNCTION AssignPath(const name : string;const path : string) : BOOLEAN; FUNCTION AssignPath(const name : string;const path : string) : BOOLEAN;
FUNCTION CreateDir(const name : string) : LONGINT; FUNCTION CreateDir(const name : string) : LONGINT;
FUNCTION CreateProc(const name : string; pri : LONGINT; segList : LONGINT; stackSize : LONGINT) : pMsgPort; FUNCTION CreateProc(const name : string; pri : LONGINT; segList : LONGINT; stackSize : LONGINT) : pMsgPort;
FUNCTION DeleteFile(const name : string) : BOOLEAN; FUNCTION DOSDeleteFile(const name : string) : BOOLEAN;
FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN; FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;
FUNCTION DeviceProc(const name : string) : pMsgPort; FUNCTION DeviceProc(const name : string) : pMsgPort;
FUNCTION DOSOpen(const name : string; accessMode : LONGINT) : LONGINT; FUNCTION DOSOpen(const name : string; accessMode : LONGINT) : LONGINT;
@ -1904,9 +1904,9 @@ begin
CreateProc := CreateProc(pas2c(name),pri,segList,stackSize); CreateProc := CreateProc(pas2c(name),pri,segList,stackSize);
end; end;
FUNCTION DeleteFile(const name : string) : BOOLEAN; FUNCTION DOSDeleteFile(const name : string) : BOOLEAN;
begin begin
DeleteFile := DeleteFile(pas2c(name)); DOSDeleteFile := DOSDeleteFile(pas2c(name));
end; end;
FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN; FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;

View File

@ -2265,14 +2265,14 @@ function Cli: PCommandLineInterface; syscall AOS_DOSBase 82;
function CliInitNewcli(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 155; function CliInitNewcli(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 155;
function CliInitRun(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 156; function CliInitRun(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 156;
function CompareDates(const Date1: PDateStamp; const Date2: PDateStamp): LongInt; syscall AOS_DOSBase 123; function CompareDates(const Date1: PDateStamp; const Date2: PDateStamp): LongInt; syscall AOS_DOSBase 123;
function CreateDir(const Name: STRPTR): BPTR; syscall AOS_DOSBase 20; function DOSCreateDir(const Name: STRPTR): BPTR; syscall AOS_DOSBase 20;
function CreateNewProc(const Tags: PTagItem): PProcess; syscall AOS_DOSBase 83; function CreateNewProc(const Tags: PTagItem): PProcess; syscall AOS_DOSBase 83;
//function CreateNewProcTagList(const Tags : PTagItem) : pProcess; //function CreateNewProcTagList(const Tags : PTagItem) : pProcess;
function CreateProc(const Name: STRPTR; Pri: LongInt; SegList: BPTR; StackSize: LongInt): PMsgPort; syscall AOS_DOSBase 23; function CreateProc(const Name: STRPTR; Pri: LongInt; SegList: BPTR; StackSize: LongInt): PMsgPort; syscall AOS_DOSBase 23;
function CurrentDir(Lock: BPTR): BPTR; syscall AOS_DOSBase 21; function CurrentDir(Lock: BPTR): BPTR; syscall AOS_DOSBase 21;
function DateStamp(Date: PDateStamp): PDateStamp; syscall AOS_DOSBase 32; function DateStamp(Date: PDateStamp): PDateStamp; syscall AOS_DOSBase 32;
function DateToStr(Datetime: PDateTime): LongBool; syscall AOS_DOSBase 124; function DateToStr(Datetime: PDateTime): LongBool; syscall AOS_DOSBase 124;
function DeleteFile(const Name: STRPTR): LongBool; syscall AOS_DOSBase 12; function DOSDeleteFile(const Name: STRPTR): LongBool; syscall AOS_DOSBase 12;
function DeleteVar(const Name: STRPTR; Flags: LongWord): LongInt; syscall AOS_DOSBase 152; function DeleteVar(const Name: STRPTR; Flags: LongWord): LongInt; syscall AOS_DOSBase 152;
function DeviceProc(const Name: STRPTR): PMsgPort; syscall AOS_DOSBase 29; function DeviceProc(const Name: STRPTR): PMsgPort; syscall AOS_DOSBase 29;
function DisplayError(FormstStr: STRPTR; Flags: LongWord; Args: APTR): LongInt; syscall AOS_DOSBase 81; function DisplayError(FormstStr: STRPTR; Flags: LongWord; Args: APTR): LongInt; syscall AOS_DOSBase 81;

View File

@ -30,8 +30,13 @@ begin
P.SourcePath.Add('src'); P.SourcePath.Add('src');
P.IncludePath.Add('src/unix',AllUnixOSes); P.IncludePath.Add('src/unix',AllUnixOSes);
P.IncludePath.Add('src/win',[win32,win64]); P.IncludePath.Add('src/win',[win32,win64]);
P.IncludePath.Add('src/$(OS)',AllOSes-[win32,win64]-AllUnixOSes); P.IncludePath.Add('src/amicommon',AllAmigaLikeOSes);
P.IncludePath.Add('src/dummy',AllOSes-[win32,win64]-AllUnixOSes); P.IncludePath.Add('src/$(OS)',AllOSes-[win32,win64]-AllUnixOSes-AllAmigaLikeOSes);
P.IncludePath.Add('src/dummy',AllOSes-[win32,win64]-AllUnixOSes-AllAmigaLikeOSes);
P.Dependencies.add('morphunits',[morphos]);
P.Dependencies.add('arosunits',[aros]);
P.Dependencies.add('amunits',[amiga]);
T:=P.Targets.AddUnit('pipes.pp'); T:=P.Targets.AddUnit('pipes.pp');
T.Dependencies.AddInclude('pipes.inc'); T.Dependencies.AddInclude('pipes.inc');

View File

@ -0,0 +1,57 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Michael Van Canneyt
DOS/go32v2 specific part of pipe stream.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
uses
exec, AmigaDos;
// No pipes under dos, sorry...
Function CreatePipeHandles (Var Inhandle,OutHandle : THandle; APipeBufferSize : Cardinal = 1024) : Boolean;
begin
InHandle := THandle (UnusedHandle);
OutHandle := THandle (UnusedHandle);
Result := False;
end;
Function TInputPipeStream.GetNumBytesAvailable: DWord;
begin
Result := 0;
end;
function TInputPipeStream.GetPosition: Int64;
begin
Result:=FPos;
end;
procedure TInputPipeStream.InvalidSeek;
begin
Raise EPipeSeek.Create (ENoSeekMsg);
end;
procedure PipeClose (const FHandle: THandle);
var
Filename: array[0..255] of Char;
DeleteIt: Boolean;
begin
if (FHandle <> UnusedHandle) and (FHandle <> 0) then
begin
DeleteIt := NameFromFH(BPTR(FHandle), @(Filename[0]), 255);
FileClose(FHandle);
if DeleteIt then
AmigaDos.dosDeleteFile(@(Filename[0]));
end;
end;

View File

@ -0,0 +1,165 @@
{
Dummy process.inc - the simplest version based on SysUtils.ExecuteProcess
}
uses
Exec, AmigaDos, Utility;
Resourcestring
SNoCommandLine = 'Cannot execute empty command-line';
SErrCannotExecute = 'Failed to execute %s : %d';
SErrNoSuchProgram = 'Executable not found: "%s"';
procedure TProcess.CloseProcessHandles;
begin
end;
Function TProcess.PeekExitStatus : Boolean;
begin
Result := true; (* Dummy version assumes always synchronous execution *)
end;
function GetNextWordPos (const S: string): integer;
const
WhiteSpace = [' ', #9, #10, #13];
Literals = ['"', ''''];
var
WStart: integer;
InLiteral: boolean;
LastLiteral: char;
begin
WStart := 1;
(* Skip whitespaces at the beginning *)
while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
Inc (WStart);
InLiteral := false;
LastLiteral := #0;
while (WStart <= Length (S)) and
(not (S [WStart] in WhiteSpace) or InLiteral) do
begin
if S [WStart] in Literals then
if InLiteral then
InLiteral := not (S [WStart] = LastLiteral)
else
begin
InLiteral := true;
LastLiteral := S [WStart];
end;
Inc (WStart);
end;
(* Skip whitespaces at the end *)
while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
Inc (WStart);
Result := WStart;
end;
function MaybeQuote (const S: string): string;
begin
if (Pos (' ', S) <> 0) then
Result := '"' + S + '"'
else
Result := S;
end;
var
UID: Integer = 0;
Procedure TProcess.Execute;
var
I: integer;
ExecName, FoundName: string;
E2: EProcess;
OrigDir: string;
Params: string;
TempName: string;
cos: BPTR;
begin
if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
raise EProcess.Create (SNoCommandline);
if (FApplicationName <> '') then
ExecName := FApplicationName;
if (FCommandLine <> '') then
begin
Params := FCommandLine;
if ExecName = '' then
begin
I := GetNextWordPos (Params);
ExecName := Copy (Params, 1, Pred (I));
Trim (ExecName);
Delete (Params, 1, Pred (I));
end
else if Copy (FCommandLine, 1, Length (ExecName)) = ExecName then
Delete (Params, 1, Succ (Length (ExecName)))
else
Delete (Params, 1, Pred (GetNextWordPos (Params)));
Trim (Params);
end
else
for I := 0 to Pred (Parameters.Count) do
Params := Params + ' ' + MaybeQuote (Parameters [I]);
if (FExecutable <> '') and (ExecName = '') then
ExecName := Executable;
if not FileExists (ExecName) then
begin
FoundName := ExeSearch (ExecName, '');
if FoundName <> '' then
ExecName := FoundName
else
raise EProcess.CreateFmt (SErrNoSuchProgram, [ExecName]);
end;
if (FCurrentDirectory <> '') then
begin
GetDir (0, OrigDir);
ChDir (FCurrentDirectory);
end;
try
cos := BPTR(0);
repeat
Inc(UID);
TempName := 'T:'+HexStr(FindTask(nil)) + '_' + HexStr(Self) + '_'+ IntToStr(UID) + '_Starter.tmp';
until not FileExists(TempName);
//sysdebugln('TProcess start: "' + ExecName + ' ' + Params+'" >' + TempName);
cos := AmigaDos.DosOpen(PChar(TempName), MODE_READWRITE);
FExitCode := LongInt(amigados.Execute(PChar(ExecName + ' ' + Params), BPTR(0), cos));
DosSeek(cos, 0, OFFSET_BEGINNING);
CreateStreams(0, THandle(cos),0);
//FExitCode := ExecuteProcess (ExecName, Params);
except
(* Normalize the raised exception so that it is aligned to other platforms. *)
On E: EOSError do
begin
raise EProcess.CreateFmt (SErrCannotExecute, [FCommandLine, E.ErrorCode]);
if (FCurrentDirectory <> '') then
ChDir (OrigDir);
end;
end;
if (FCurrentDirectory <> '') then
ChDir (OrigDir);
end;
Function TProcess.WaitOnExit : Boolean;
begin
Result:=True;
end;
Function TProcess.Suspend : Longint;
begin
Result:=0;
end;
Function TProcess.Resume : LongInt;
begin
Result:=0;
end;
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
begin
Result:=False;
end;
Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
begin
end;

View File

@ -0,0 +1,258 @@
{
Amiga style simpleipc.inc
}
{$DEFINE OSNEEDIPCINITDONE}
uses
Exec, dos;
ResourceString
SErrMsgPortExists = 'MsgPort already exists: %s';
const
PORTNAMESTART = 'fpc_';
Var
MsgPorts: Classes.TList;
procedure AddMsgPort(AMsgPort: PMsgPort);
begin
if Assigned(MsgPorts) then
begin
MsgPorts.Add(AMsgPort);
end;
end;
procedure RemoveMsgPort(AMsgPort: PMsgPort);
var
Idx: Integer;
begin
if Assigned(MsgPorts) then
begin
Idx := MsgPorts.IndexOf(AMsgPort);
if Idx >= 0 then
begin
MsgPorts.Delete(Idx);
if Assigned(AMsgPort^.mp_Node.ln_Name) and (string(AMsgPort^.mp_Node.ln_Name) <> '') and Assigned(FindPort(AMsgPort^.mp_Node.ln_Name)) then
RemPort(AMsgPort);
DeleteMsgPort(AMsgPort);
end;
end;
end;
procedure IPCInit;
begin
MsgPorts := Classes.TList.Create;
end;
procedure IPCDone;
var
I: integer;
begin
try
for i := 0 to MsgPorts.Count - 1 do
RemoveMsgPort(PMsgPort(MsgPorts[i]));
finally
FreeAndNil(MsgPorts);
end;
end;
Type
TAmigaClientComm = Class(TIPCClientComm)
Private
FMsgPort: PMsgPort;
FPortName: String;
Public
Constructor Create(AOwner: TSimpleIPCClient); override;
Procedure Connect; override;
Procedure Disconnect; override;
Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
//Function ServerRunning : Boolean; override;
end;
TAmigaServerComm = Class(TIPCServerComm)
Private
FMsgPort: PMsgPort;
FPortName: String;
MsgBody: PMessage;
Public
Constructor Create(AOwner: TSimpleIPCServer); override;
destructor Destroy; override;
Procedure StartServer; override;
Procedure StopServer; override;
Function PeekMessage(TimeOut : Integer) : Boolean; override;
Procedure ReadMessage ; override;
Function GetInstanceID : String;override;
end;
// ####### CLIENT
function SafePutToPort(Msg: PMessage; Portname: string): Integer;
var
Port: PMsgPort;
PName: PChar;
begin
Result := -1;
PName := PChar(Portname + #0);
Forbid();
Port := FindPort(PName);
if Assigned(Port) then
begin
PutMsg(Port, Msg);
Result := 0;
end;
Permit();
end;
Constructor TAmigaClientComm.Create(AOwner: TSimpleIPCClient);
begin
inherited;
end;
Procedure TAmigaClientComm.Connect;
begin
end;
Procedure TAmigaClientComm.Disconnect;
begin
end;
Procedure TAmigaClientComm.SendMessage(MsgType : TMessageType; AStream : TStream);
var
Size: Integer;
FullSize: Integer;
Memory: Pointer;
Temp: PByte;
MsgHead: Exec.PMessage;
MP: PMsgPort;
PortName: string;
begin
Size := AStream.Size - AStream.Position;
FullSize := Size + Sizeof(Exec.TMessage);
PortName := PORTNAMESTART + Owner.ServerID;
Memory := System.AllocMem(FullSize);
MP := CreateMsgPort;
try
MsgHead := Memory;
MsgHead^.mn_ReplyPort := MP;
MsgHead^.mn_Length := Size;
Temp := Memory;
Inc(Temp, SizeOf(Exec.TMessage));
AStream.Read(Temp^, Size);
if SafePutToPort(MsgHead, PortName) = 0 then
WaitPort(MP);
finally
System.FreeMem(Memory);
DeleteMsgPort(MP);
end;
end;
// ###### SERVER
Constructor TAmigaServerComm.Create(AOwner: TSimpleIPCServer);
begin
inherited;
FMsgPort := CreateMsgPort;
AddMsgPort(FMsgPort);
MsgBody := nil;
end;
destructor TAmigaServerComm.Destroy;
begin
if Assigned(MsgBody) then
System.FreeMem(MsgBody);
RemoveMsgPort(FMsgPort);
inherited;
end;
Procedure TAmigaServerComm.StartServer;
begin
FPortName := PORTNAMESTART + Owner.ServerID + #0;
if Assigned(FindPort(PChar(FPortName))) then
begin
DoError(SErrMsgPortExists,[FPortName]);
Exit;
end;
FMsgPort^.mp_Node.ln_Name := PChar(FPortName);
FMsgPort^.mp_Node.ln_Pri := 0;
AddPort(FMsgPort);
if Assigned(MsgBody) then
System.FreeMem(MsgBody);
MsgBody := nil;
end;
Procedure TAmigaServerComm.StopServer;
begin
RemPort(FMsgPort);
if Assigned(MsgBody) then
System.FreeMem(MsgBody);
MsgBody := nil;
end;
Function TAmigaServerComm.PeekMessage(TimeOut : Integer) : Boolean;
var
Msg: PMessage;
Temp: PByte;
StartTime: Int64;
begin
StartTime := GetMsCount;
Result := False;
if TimeOut < 0 then
TimeOut := MaxInt;
repeat
Msg := GetMsg(FMsgPort);
if Assigned(Msg) then
begin
Result := True;
Temp := PByte(Msg);
Inc(Temp, SizeOf(Exec.TMessage));
if Assigned(MsgBody) then
System.FreeMem(MsgBody);
MsgBody := System.AllocMem(SizeOf(Exec.TMessage) + Msg^.mn_Length);
Move(Msg^, MsgBody^, SizeOf(Exec.TMessage) + Msg^.mn_Length);
ReplyMsg(Msg);
break;
end;
Sleep(25);
until GetMsCount - StartTime >= TimeOut;
end;
Procedure TAmigaServerComm.ReadMessage;
var
Temp: PByte;
begin
if Assigned(MsgBody) then
begin
Temp := Pointer(MsgBody);
Inc(Temp, SizeOf(Exec.TMessage));
Owner.FMsgType := mtString;
Owner.FMsgData.Size := 0;
Owner.FMsgData.Seek(0, soFrombeginning);
Owner.FMsgData.WriteBuffer(temp^, MsgBody^.mn_Length);
System.FreeMem(MsgBody);
MsgBody := nil;
end;
end;
Function TAmigaServerComm.GetInstanceID: String;
begin
Result := HexStr(FindTask(nil));
end;
// ###### Register
Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
begin
Result:=TAmigaServerComm;
end;
function TSimpleIPCClient.CommClass: TIPCClientCommClass;
begin
Result:=TAmigaClientComm;
end;

View File

@ -1392,7 +1392,7 @@ type
{ dos.library functions } { dos.library functions }
function Open(fname : PChar location 'd1'; function dosOpen(fname : PChar location 'd1';
accessMode: LongInt location 'd2'): LongInt; accessMode: LongInt location 'd2'): LongInt;
SysCall MOS_DOSBase 30; SysCall MOS_DOSBase 30;

View File

@ -360,11 +360,13 @@ begin
if AOS_wbMsg=nil then begin if AOS_wbMsg=nil then begin
StdInputHandle:=dosInput; StdInputHandle:=dosInput;
StdOutputHandle:=dosOutput; StdOutputHandle:=dosOutput;
StdErrorHandle:=StdOutputHandle;
end else begin end else begin
AOS_ConHandle:=Open(AOS_ConName,MODE_OLDFILE); AOS_ConHandle:=Open(AOS_ConName,MODE_OLDFILE);
if AOS_ConHandle<>0 then begin if AOS_ConHandle<>0 then begin
StdInputHandle:=AOS_ConHandle; StdInputHandle:=AOS_ConHandle;
StdOutputHandle:=AOS_ConHandle; StdOutputHandle:=AOS_ConHandle;
StdErrorHandle:=AOS_ConHandle;
end else end else
Halt(1); Halt(1);
end; end;
@ -377,11 +379,8 @@ begin
OpenStdIO(Output,fmOutput,StdOutputHandle); OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle); OpenStdIO(StdOut,fmOutput,StdOutputHandle);
{ * AmigaOS doesn't have a separate stderr * } OpenStdIO(StdErr,fmOutput,StdErrorHandle);
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
StdErrorHandle:=StdOutputHandle;
//OpenStdIO(StdErr,fmOutput,StdErrorHandle);
//OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
end; end;
function GetProcessID: SizeUInt; function GetProcessID: SizeUInt;

View File

@ -121,9 +121,6 @@ begin
Killed := True; Killed := True;
{ Closing opened files } { Closing opened files }
CloseList(ASYS_fileList); CloseList(ASYS_fileList);
//
if AOS_wbMsg <> nil then
ReplyMsg(AOS_wbMsg);
{ Changing back to original directory if changed } { Changing back to original directory if changed }
if ASYS_OrigDir <> 0 then begin if ASYS_OrigDir <> 0 then begin
oldDirLock:=CurrentDir(ASYS_origDir); oldDirLock:=CurrentDir(ASYS_origDir);
@ -142,6 +139,14 @@ begin
CloseLibrary(AOS_DOSBase); CloseLibrary(AOS_DOSBase);
AOS_DOSBase := nil; AOS_DOSBase := nil;
// //
if AOS_wbMsg <> nil then
begin
// forbid -> Amiga RKM Libraries Manual
Forbid();
// Reply WBStartupMessage
ReplyMsg(AOS_wbMsg);
end;
//
HaltProc(ExitCode); HaltProc(ExitCode);
end; end;

View File

@ -479,7 +479,7 @@ begin
{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR} {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
{$IFDEF FPC_FEXPAND_UPDIR_HELPER} {$IFDEF FPC_FEXPAND_UPDIR_HELPER}
(* Now remove all references to '//' plus previous directories... *) { Now remove all references to '//' or '::' plus previous directories... }
I := Pos (DirectorySeparator + DirectorySeparator, Dirs); I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
while I <> 0 do while I <> 0 do
begin begin
@ -507,22 +507,6 @@ begin
end; end;
{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR} {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
(* Remove a possible reference to '/' at the *)
(* end of line plus the previous directory. *)
I := Length (Dirs);
if (I > 0) and (Dirs [I] = DirectorySeparator) then
begin
J := Pred (I);
while (J > 0) and (Dirs [J] <> DirectorySeparator) do
Dec (J);
if (J = 0) then
Dirs := ''
else
Delete (Dirs, J, Succ (I - J));
end;
{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
{$IFNDEF FPC_FEXPAND_NO_CURDIR} {$IFNDEF FPC_FEXPAND_NO_CURDIR}
{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR} {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
{...and also a possible reference to '\.'} {...and also a possible reference to '\.'}
@ -666,7 +650,7 @@ end;
parent directory and so on (Amiga). Please, note that you can decide parent directory and so on (Amiga). Please, note that you can decide
to support both '..' and DirectorySeparator as references to the parent to support both '..' and DirectorySeparator as references to the parent
directory at the same time for compatibility reasons - however this directory at the same time for compatibility reasons - however this
support makes it impossible to use anotherwise possibly valid name support makes it impossible to use otherwise possibly valid name
of '..'. of '..'.
FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of

View File

@ -372,11 +372,13 @@ begin
MOS_ConHandle:=0; MOS_ConHandle:=0;
StdInputHandle:=dosInput; StdInputHandle:=dosInput;
StdOutputHandle:=dosOutput; StdOutputHandle:=dosOutput;
StdErrorHandle:=StdOutputHandle;
end else begin end else begin
MOS_ConHandle:=Open(MOS_ConName,MODE_OLDFILE); MOS_ConHandle:=Open(MOS_ConName,MODE_OLDFILE);
if MOS_ConHandle<>0 then begin if MOS_ConHandle<>0 then begin
StdInputHandle:=MOS_ConHandle; StdInputHandle:=MOS_ConHandle;
StdOutputHandle:=MOS_ConHandle; StdOutputHandle:=MOS_ConHandle;
StdErrorHandle:=MOS_ConHandle;
end else end else
Halt(1); Halt(1);
end; end;
@ -389,10 +391,8 @@ begin
OpenStdIO(Output,fmOutput,StdOutputHandle); OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle); OpenStdIO(StdOut,fmOutput,StdOutputHandle);
{ * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * } OpenStdIO(StdErr,fmOutput,StdErrorHandle);
StdErrorHandle:=StdOutputHandle; OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
// OpenStdIO(StdErr,fmOutput,StdErrorHandle);
// OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
end; end;
function GetProcessID: SizeUInt; function GetProcessID: SizeUInt;

View File

@ -59,9 +59,16 @@ uses
{$ENDIF LINUX} {$ENDIF LINUX}
{$IFDEF AMIGA} {$IFDEF AMIGA}
{$IFNDEF HASAMIGA}
{$DEFINE HASAMIGA}
{$ENDIF HASAMIGA}
{$ENDIF AMIGA}
{$IFDEF HASAMIGA}
{$DEFINE VOLUMES} {$DEFINE VOLUMES}
{$DEFINE NODRIVEC} {$DEFINE NODRIVEC}
{$ENDIF AMIGA} {$DEFINE NODOTS}
{$ENDIF HASAMIGA}
{$IFDEF NETWARE} {$IFDEF NETWARE}
{$DEFINE VOLUMES} {$DEFINE VOLUMES}
@ -103,13 +110,13 @@ const
DriveSeparator = '/'; DriveSeparator = '/';
FileNameCasePreserving = true; FileNameCasePreserving = true;
{$ELSE UNIX} {$ELSE UNIX}
{$IFDEF AMIGA} {$IFDEF HASAMIGA}
DirectorySeparator = ':'; DirectorySeparator = '/';
FileNameCasePreserving = true; FileNameCasePreserving = true;
{$ELSE AMIGA} {$ELSE HASAMIGA}
DirectorySeparator = '\'; DirectorySeparator = '\';
FileNameCasePreserving = false; FileNameCasePreserving = false;
{$ENDIF AMIGA} {$ENDIF HASAMIGA}
{$ENDIF UNIX} {$ENDIF UNIX}
{$ENDIF MACOS} {$ENDIF MACOS}
{$ENDIF DIRECT} {$ENDIF DIRECT}
@ -117,11 +124,7 @@ const
{$IFDEF MACOS} {$IFDEF MACOS}
DriveSep = ''; DriveSep = '';
{$ELSE MACOS} {$ELSE MACOS}
{$IFDEF AMIGA}
DriveSep = '';
{$ELSE AMIGA}
DriveSep = DriveSeparator; DriveSep = DriveSeparator;
{$ENDIF AMIGA}
{$ENDIF MACOS} {$ENDIF MACOS}
{$IFDEF UNIX} {$IFDEF UNIX}
CDrive = ''; CDrive = '';
@ -129,11 +132,11 @@ const
{$IFDEF MACOS} {$IFDEF MACOS}
CDrive = 'C'; CDrive = 'C';
{$ELSE MACOS} {$ELSE MACOS}
{$IFDEF AMIGA} {$IFDEF HASAMIGA}
CDrive = 'C'; CDrive = 'C';
{$ELSE AMIGA} {$ELSE HASAMIGA}
CDrive = 'C:'; CDrive = 'C:';
{$ENDIF AMIGA} {$ENDIF HASAMIGA}
{$ENDIF MACOS} {$ENDIF MACOS}
{$ENDIF UNIX} {$ENDIF UNIX}
{$ENDIF FPC} {$ENDIF FPC}
@ -289,11 +292,11 @@ begin
GetDir (3, CDir); GetDir (3, CDir);
{$ENDIF NODRIVEC} {$ENDIF NODRIVEC}
Check (' ', CurDir + DirSep + ' '); Check (' ', CurDir + DirSep + ' ');
{$IFDEF AMIGA} {$IFDEF HASAMIGA}
Check ('', CurDir); Check ('', CurDir);
{$ELSE AMIGA} {$ELSE HASAMIGA}
Check ('', CurDir + DirSep); Check ('', CurDir + DirSep);
{$ENDIF AMIGA} {$ENDIF HASAMIGA}
{$IFDEF MACOS} {$IFDEF MACOS}
Check (':', CurDir + DirSep); Check (':', CurDir + DirSep);
{$ELSE MACOS} {$ELSE MACOS}
@ -304,26 +307,26 @@ begin
if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything') if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
else Check ('c:anything', CDir + DirSep + 'anything'); else Check ('c:anything', CDir + DirSep + 'anything');
Check (CC + DirSep, CDrive + DirSep); Check (CC + DirSep, CDrive + DirSep);
{$IFDEF NODOTS} {$IFDEF NODOTS}
Check ('C:.', 'C:.'); Check ('C:.', 'C:.');
Check (CC + DirSep + '.', CDrive + DirSep + '.'); Check (CC + DirSep + '.', CDrive + DirSep + '.');
Check (CC + DirSep + '..', CDrive + DirSep + '..'); Check (CC + DirSep + '..', CDrive + DirSep + '..');
{$ELSE NODOTS} {$ELSE NODOTS}
Check ('C:.', CDir); Check ('C:.', CDir);
Check (CC + DirSep + '.', CDrive + DirSep); Check (CC + DirSep + '.', CDrive + DirSep);
Check (CC + DirSep + '..', CDrive + DirSep); Check (CC + DirSep + '..', CDrive + DirSep);
{$ENDIF NODOTS} {$ENDIF NODOTS}
Check (CC + DirSep + 'DOS', CDrive + DirSep + 'DOS'); Check (CC + DirSep + 'DOS', CDrive + DirSep + 'DOS');
{$IFNDEF NODOTS} {$IFNDEF NODOTS}
Check (CC + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS'); Check (CC + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS');
{$ENDIF NODOTS} {$ENDIF NODOTS}
Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.'); Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
{$IFDEF AMIGA} {$IFDEF HASAMIGA} (* This has no effect - AMIGA has NODRIVEC defined... *)
Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep); Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep);
{$ELSE AMIGA} {$ELSE HASAMIGA}
Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep); Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep);
{$ENDIF AMIGA} {$ENDIF HASAMIGA}
{$IFNDEF NODOTS} {$IFNDEF NODOTS}
Check (CC + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS'); Check (CC + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS');
Check (CC + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep); Check (CC + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep);
Check (CC + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep); Check (CC + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep);
@ -331,14 +334,20 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
DirSep + 'DOS'); DirSep + 'DOS');
Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep, Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep,
CDrive + DirSep + 'DOS' + DirSep); CDrive + DirSep + 'DOS' + DirSep);
{$ENDIF NODOTS} {$ENDIF NODOTS}
{$ENDIF NODRIVEC} {$ENDIF NODRIVEC}
{$IFNDEF MACOS} {$IFNDEF MACOS}
{$IFDEF HASAMIGA}
Check (DirSep, TestDir + TestDir1Name);
Check (DirSep + DirSep + TestFileName, TestDir + TestFileName);
Check (DirSep + 'DOS', TestDir + TestDir1Name + DirSep + 'DOS');
{$ELSE HASAMIGA}
Check (DirSep, TestDrive + DirSep); Check (DirSep, TestDrive + DirSep);
Check (DirSep + '.', TestDrive + DirSep); Check (DirSep + '.', TestDrive + DirSep);
Check (DirSep + '..', TestDrive + DirSep); Check (DirSep + '..', TestDrive + DirSep);
Check (DirSep + 'DOS', TestDrive + DirSep + 'DOS'); Check (DirSep + 'DOS', TestDrive + DirSep + 'DOS');
{$ENDIF HASAMIGA}
{$ENDIF MACOS} {$ENDIF MACOS}
Check ('d', CurDir + DirSep + 'd'); Check ('d', CurDir + DirSep + 'd');
{$IFDEF MACOS} {$IFDEF MACOS}
@ -367,15 +376,15 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
Check ('.special', CurDir + DirSep + '.special'); Check ('.special', CurDir + DirSep + '.special');
Check ('..special', CurDir + DirSep + '..special'); Check ('..special', CurDir + DirSep + '..special');
Check ('special..', CurDir + DirSep + 'special..'); Check ('special..', CurDir + DirSep + 'special..');
{$IFDEF AMIGA} {$IFDEF HASAMIGA}
Check ('special.' + DirSep, CurDir); Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
{$ELSE AMIGA} {$ELSE HASAMIGA}
{$IFDEF MACOS} {$IFDEF MACOS}
Check ('special.' + DirSep, 'special.' + DirSep); Check ('special.' + DirSep, 'special.' + DirSep);
{$ELSE MACOS} {$ELSE MACOS}
Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep); Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
{$ENDIF MACOS} {$ENDIF MACOS}
{$ENDIF AMIGA} {$ENDIF HASAMIGA}
{$IFDEF MACOS} {$IFDEF MACOS}
Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep); Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep);
Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
@ -481,7 +490,11 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
{$ENDIF NODRIVEC} {$ENDIF NODRIVEC}
{$ENDIF UNIX} {$ENDIF UNIX}
{$IFDEF VOLUMES} {$IFDEF VOLUMES}
{$IFDEF HASAMIGA}
Check ('VolName' + DriveSep + 'DIR1', 'VolName' + DriveSep + 'DIR1');
{$ELSE HASAMIGA}
Check ('VolName' + DriveSep + DirSep + 'DIR1', 'VolName' + DriveSep + DirSep + 'DIR1'); Check ('VolName' + DriveSep + DirSep + 'DIR1', 'VolName' + DriveSep + DirSep + 'DIR1');
{$ENDIF HASAMIGA}
{$IFNDEF NODOTS} {$IFNDEF NODOTS}
Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..', 'VolName' + DriveSep + DirSep); Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..', 'VolName' + DriveSep + DirSep);
Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..' + DirSep + '..', Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..' + DirSep + '..',
@ -496,13 +509,13 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
Check ('SrvName/VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' + Check ('SrvName/VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' +
DriveSep + DirSep + 'TEST'); DriveSep + DirSep + 'TEST');
{$ENDIF NETWARE} {$ENDIF NETWARE}
{$IFDEF AMIGA} {$IFDEF HASAMIGA}
{$IFDEF NODOTS} {$IFDEF NODOTS}
Check ('.', CurDir + DirSep + '.'); Check ('.', CurDir + DirSep + '.');
{$ELSE NODOTS} {$ELSE NODOTS}
Check ('.', CurDir); Check ('.', CurDir);
{$ENDIF NODOTS} {$ENDIF NODOTS}
{$ENDIF AMIGA} {$ENDIF HASAMIGA}
{$ENDIF VOLUMES} {$ENDIF VOLUMES}
Erase (F); Erase (F);
{$IFNDEF NODRIVEC} {$IFNDEF NODRIVEC}