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

AROS: StdErrout introduced, string fixes, preparations for threading

Browse Source 
git-svn-id: trunk@28602 -
This commit is contained in:
marcus 2014-09-05 18:45:00 +00:00
parent 684c8842e7
commit 85700afd0d
4 changed files with 18 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
rtl/aros/i386/doslibf.inc
View File

@ -39,6 +39,7 @@ function SetFileDate(name: PChar; date: PDateStamp): LongBool; syscall AOS_DOSBa
function NameFromLock(lock: longint; buffer: PChar; len: longint): LongBool; syscall AOS_DOSBase 67;
function SetFileSize(fh: longint; pos: longint; mode: longint): longint; syscall AOS_DOSBase 76;
function Cli : pCommandLineInterface; syscall AOS_DOSBase 82;
function CreateNewProc(const Tags: PTagItem): PProcess; syscall AOS_DOSBase 83;
function GetArgStr: PChar; syscall AOS_DOSBase 89;
function GetCurrentDirName(buf: PChar; len: longint): LongBool; syscall AOS_DOSBase 94;
function GetProgramName(buf: PChar; len: longint): LongBool; syscall AOS_DOSBase 96;

2
rtl/aros/i386/execd.inc
View File

@ -876,7 +876,7 @@ type
PStackSwapStruct = ^TStackSwapStruct;
TStackSwapStruct = record
stk_Lower : Pointer; { * Lowest byte of stack * }
stk_Upper : Pointer; { * Upper end of stack (size + Lowert) * }
stk_Upper : Pointer; { * Upper end of stack (size + Lowert) * }
stk_Pointer: Pointer; { * Stack pointer at switch point * }
end;

10
rtl/aros/i386/execf.inc
View File

@ -16,11 +16,14 @@
var
LocalExecBase : Pointer; external name '_ExecBase';
procedure Forbid; syscall AOS_ExecBase 22;
procedure Permit; syscall AOS_ExecBase 23;
function execAllocMem(byteSize: Cardinal; requirements: Cardinal): Pointer; syscall LocalExecBase 33;
procedure execFreeMem(memoryBlock: Pointer; byteSize: Cardinal); syscall LocalExecBase 35;
function FindTask(name: PChar): PTask; syscall LocalExecBase 49;
function SetSignal(newSignals: Cardinal; signalSet : Cardinal): Cardinal; syscall LocalExecBase 51;
function Wait(SignalSet: LongWord): LongWord; syscall AOS_ExecBase 53;
procedure Signal(Task: PTask; SignalSet: LongWord); syscall AOS_ExecBase 54;
function AllocSignal(signalNum: LongInt): ShortInt; syscall LocalExecBase 55;
procedure FreeSignal(signalNum: LongInt); syscall LocalExecBase 56;
procedure AddPort(port: PMsgPort); syscall LocalExecBase 59;
@ -33,10 +36,15 @@ function OpenDevice(devName: PChar; numunit: Cardinal; ioRequest: pIORequest; fl
procedure CloseDevice(ioRequest: PIORequest); syscall LocalExecBase 75;
function DoIO(ioRequest: PIORequest): ShortInt; syscall LocalExecBase 76;
function OpenLibrary(libname: PChar; libver : Cardinal): Pointer; syscall LocalExecBase 92;
procedure InitSemaphore(SigSem: PSignalSemaphore); syscall AOS_ExecBase 93;
procedure ObtainSemaphore(SigSem: PSignalSemaphore); syscall AOS_ExecBase 94;
procedure ReleaseSemaphore(SigSem: PSignalSemaphore); syscall AOS_ExecBase 95;
function AttemptSemaphore(SigSem: PSignalSemaphore): LongWord; syscall AOS_ExecBase 96;
function CreatePool(requirements: Cardinal; puddleSize: Cardinal; threshSize: Cardinal): Pointer; syscall LocalExecBase 116;
procedure DeletePool(poolHeader: Pointer); syscall LocalExecBase 117;
function AllocPooled(poolHeader: Pointer; memSize: Cardinal): Pointer; syscall LocalExecBase 118;
function FreePooled(poolHeader: Pointer; memory: Pointer; memSize: Cardinal): Pointer; syscall LocalExecBase 119;
procedure StackSwap(NewStack: PStackSwapStruct); syscall AOS_ExecBase 122;
//function RawDoFmt(const formatString : pCHAR;const dataStream : POINTER; putChProc : tPROCEDURE; putChData : POINTER): pointer;
function RawDoFmt(const formatString : pCHAR;const dataStream : POINTER; putChProc : POINTER; putChData : POINTER): pointer; syscall LocalExecBase 87;

15
rtl/aros/system.pp
View File

@ -249,6 +249,7 @@ var
counter: Byte;
begin
GetProgDir:='';
SetLength(s1, 256);
FillChar(s1,255,#0);
{ GetLock of program directory }
@ -257,7 +258,7 @@ begin
if NameFromLock(alock,@s1[1],255) then begin
counter:=1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
SetLength(s1, counter-1);
GetProgDir:=s1;
end;
end;
@ -270,13 +271,14 @@ var
counter: Byte;
begin
GetProgramName:='';
SetLength(s1, 256);
FillChar(s1,255,#0);
if GetProgramName(@s1[1],255) then begin
{ now check out and assign the length of the string }
counter := 1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
SetLength(s1, counter-1);
{ now remove any component path which should not be there }
for counter:=length(s1) downto 1 do
@ -408,11 +410,13 @@ begin
if AOS_wbMsg = nil then begin
StdInputHandle := THandle(dosInput);
StdOutputHandle := THandle(dosOutput);
StdErrorHandle := THandle(DosError1);
end else begin
AOS_ConHandle := Open(AOS_ConName, MODE_OLDFILE);
if AOS_ConHandle <> 0 then begin
StdInputHandle := AOS_ConHandle;
StdOutputHandle := AOS_ConHandle;
StdErrorHandle := AOS_ConHandle;
end else
Halt(1);
end;
@ -424,12 +428,7 @@ begin
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
{ * AmigaOS doesn't have a separate stderr * }
StdErrorHandle:=StdOutputHandle;
//OpenStdIO(StdErr,fmOutput,StdErrorHandle);
//OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
end;
function GetProcessID: SizeUInt;