paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 04:29:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/unicodekvm@48737 -
This commit is contained in:
nickysn 2021-02-21 06:27:43 +00:00
commit d892db6238
6 changed files with 104 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/m68k/n68kmem.pas
View File

@ -75,8 +75,11 @@ implementation
var
hreg: tregister;
scaled: boolean;
regcgsize: tcgsize;
begin
scaled:=false;
regcgsize:=def_cgsize(regsize);
//current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: called')));
if l<>1 then
begin
@ -86,8 +89,10 @@ implementation
((CPUM68K_HAS_INDEXSCALE8 in cpu_capabilities[current_settings.cputype]) and (l in [2,4,8]))) then
begin
//current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: mul')));
hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_S32);
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_IMUL,def_cgsize(regsize),l,maybe_const_reg,hreg);
hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,regcgsize,OS_ADDR,maybe_const_reg,hreg);
cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_IMUL,OS_ADDR,l,hreg);
regcgsize:=OS_ADDR;
maybe_const_reg:=hreg;
end
else
@ -104,7 +109,7 @@ implementation
begin
//current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: copytoa')));
hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,def_cgsize(regsize),OS_ADDR,maybe_const_reg,hreg);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,regcgsize,OS_ADDR,maybe_const_reg,hreg);
maybe_const_reg:=hreg;
end;
location.reference.base:=maybe_const_reg;
@ -118,13 +123,13 @@ implementation
cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg);
reference_reset_base(location.reference,hreg,0,location.reference.temppos,location.reference.alignment,location.reference.volatility);
end;
if def_cgsize(regsize) in [OS_8,OS_16] then
if regcgsize in [OS_8,OS_16] then
begin
{ index registers are always sign extended on m68k, so we have to zero extend by hand,
if the index variable is unsigned, and its width is less than the whole register }
//current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: index zero extend')));
hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,def_cgsize(regsize),OS_ADDR,maybe_const_reg,hreg);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,regcgsize,OS_ADDR,maybe_const_reg,hreg);
maybe_const_reg:=hreg;
end;
{ insert new index register }

7
packages/fcl-process/src/amicommon/pipes.inc
View File

@ -27,9 +27,12 @@ end;
Function TInputPipeStream.GetNumBytesAvailable: DWord;
var
fib: TFileInfoBlock;
begin
Result := 0;
if Boolean(ExamineFH(BPTR(Handle), @fib)) then
Result := fib.fib_size;
end;
function TInputPipeStream.GetPosition: Int64;
@ -53,5 +56,5 @@ begin
FileClose(FHandle);
if DeleteIt then
AmigaDos.dosDeleteFile(@(Filename[0]));
end;
end;
end;

77
packages/fcl-process/src/amicommon/process.inc
View File

@ -65,6 +65,13 @@ end;
var
UID: Integer = 0;
{$ifdef MorphOS}
const
BUF_LINE = 0; // flush on \n, etc
BUF_FULL = 1; // never flush except when needed
BUF_NONE = 2; // no buffering
{$endif}
Procedure TProcess.Execute;
var
I: integer;
@ -74,6 +81,10 @@ var
Params: string;
TempName: string;
cos: BPTR;
{$ifdef MorphOS}
inA, inB, OutA, OutB: BPTR;
Res: Integer;
{$endif}
begin
if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
raise EProcess.Create (SNoCommandline);
@ -114,17 +125,61 @@ begin
ChDir (FCurrentDirectory);
end;
try
cos := BPTR(0);
repeat
Inc(UID);
TempName := 'T:PrO_'+ HexStr(FindTask(nil)) + '_' + IntToHex(UID,8);
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);
{$ifdef MorphOS}
if (poUsePipes in Options) and (not (poWaitOnExit in Options)) then
begin
FProcessID := 0;
// Pipenames, should be unique
TempName := 'PIPE:PrO_' + HexStr(Self) + HexStr(GetTickCount, 8);
inA := DOSOpen(PChar(TempName), MODE_OLDFILE);
inB := DOSOpen(PChar(TempName), MODE_NEWFILE);
TempName := TempName + 'o';
outA := DOSOpen(PChar(TempName), MODE_OLDFILE);
outB := DOSOpen(PChar(TempName), MODE_NEWFILE);
// set buffer for all pipes
SetVBuf(inA, nil, BUF_NONE, -1);
SetVBuf(inB, nil, BUF_LINE, -1);
SetVBuf(outA, nil, BUF_NONE, -1);
SetVBuf(outB, nil, BUF_LINE, -1);
// the actual Start of the command with given parameter and streams
Res := SystemTags(PChar(ExecName + ' ' + Params),
[SYS_Input, AsTag(outA),
SYS_Output, AsTag(inB),
SYS_Asynch, AsTag(True),
TAG_END]);
// the two streams will be destroyed by system, we do not need to care about
// the other two we will destroy when the PipeStreams they are attached to are destroyed
if Res <> -1 then
begin
FProcessID := 1;
CreateStreams(THandle(outB), THandle(inA),0);
end
else
begin
// if the command did not start, we need to delete all Streams
if outB <> BPTR(0) then DosClose(outB);
if outA <> BPTR(0) then DosClose(outA);
if inB <> BPTR(0) then DosClose(inB);
if inA <> BPTR(0) then DosClose(inA);
end;
end
else
{$endif}
begin
// if no streams needed we still use the old sychronous way
FProcessID := 0;
cos := BPTR(0);
repeat
Inc(UID);
TempName := 'T:PrO_'+ HexStr(FindTask(nil)) + '_' + IntToHex(UID,8);
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);
end;
//FExitCode := ExecuteProcess (ExecName, Params);
except
(* Normalize the raised exception so that it is aligned to other platforms. *)
On E: EOSError do

22
packages/fcl-process/src/pipes.pp
View File

@ -91,10 +91,30 @@ begin
end;
Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
{$ifdef MorphOS}
var
i: Integer;
Runner: PByte;
{$endif}
begin
{$ifdef MorphOS}
FillChar(Buffer, Count, 0);
if FGetS(Handle, @Buffer, Count) = nil then
Result := 0
else
begin
Result := 0;
Runner := @Buffer;
repeat
if Runner^ = 0 then
Break;
Inc(Result);
until Result >= Count;
end;
{$else}
Result:=Inherited Read(Buffer,Count);
Inc(FPos,Result);
{$endif}
end;
function TInputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;

1
rtl/embedded/arm/cortexm4f_start.inc
View File

@ -74,3 +74,4 @@ asm
.Ltext_start:
.long _text_start
{$endif REMAP_VECTTAB}
end;

2
rtl/freertos/arm/cortexm4f_start.inc
View File

@ -64,7 +64,7 @@ asm
.long _data
.L_edata:
.long _edata
{$if not defined(FPUARM_HAS_VFP_EXTENSION)}
{$if defined(FPUARM_HAS_VFP_EXTENSION)}
.Lcpacr:
.long 0xE000ED88
{$endif defined(FPUARM_HAS_VFP_EXTENSION)}