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

+ segment register support in g_concatcopy (should fix #9667, but I

Browse Source 
can't test since I don't have Dos/Windows -- at least the changes
    don't break Linux/i386)

git-svn-id: trunk@8608 -
This commit is contained in:
Jonas Maebe 2007-09-22 20:10:56 +00:00
parent 4d57395a12
commit ecd2445602
3 changed files with 76 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8460,6 +8460,7 @@ tests/webtbs/tw9347a.pp svneol=native#text/plain
tests/webtbs/tw9347b.pp svneol=native#text/plain
tests/webtbs/tw9384.pp svneol=native#text/plain
tests/webtbs/tw9385.pp svneol=native#text/plain
tests/webtbs/tw9667.pp svneol=native#text/plain
tests/webtbs/tw9672.pp svneol=native#text/plain
tests/webtbs/tw9673.pp -text
tests/webtbs/tw9695.pp svneol=native#text/plain

36
compiler/x86/cgx86.pas
View File

@ -1582,6 +1582,9 @@ unit cgx86;
if (cs_opt_size in current_settings.optimizerswitches) and
not((len<=16) and (cm=copy_mmx)) then
cm:=copy_string;
if (source.segment<>NR_NO) or
(dest.segment<>NR_NO) then
cm:=copy_string;
case cm of
copy_move:
begin
@ -1666,15 +1669,36 @@ unit cgx86;
else {copy_string, should be a good fallback in case of unhandled}
begin
getcpuregister(list,REGDI);
a_loadaddr_ref_reg(list,dest,REGDI);
if (dest.segment=NR_NO) then
a_loadaddr_ref_reg(list,dest,REGDI)
else
begin
dstref:=dest;
dstref.segment:=NR_NO;
a_loadaddr_ref_reg(list,dstref,REGDI);
list.concat(taicpu.op_reg(A_PUSH,S_L,NR_ES));
list.concat(taicpu.op_reg(A_PUSH,S_L,dest.segment));
list.concat(taicpu.op_reg(A_POP,S_L,NR_ES));
end;
getcpuregister(list,REGSI);
a_loadaddr_ref_reg(list,source,REGSI);
if (source.segment=NR_NO) then
a_loadaddr_ref_reg(list,source,REGSI)
else
begin
srcref:=source;
srcref.segment:=NR_NO;
a_loadaddr_ref_reg(list,srcref,REGSI);
list.concat(taicpu.op_reg(A_PUSH,S_L,NR_DS));
list.concat(taicpu.op_reg(A_PUSH,S_L,source.segment));
list.concat(taicpu.op_reg(A_POP,S_L,NR_DS));
end;
getcpuregister(list,REGCX);
{$ifdef i386}
list.concat(Taicpu.op_none(A_CLD,S_NO));
list.concat(Taicpu.op_none(A_CLD,S_NO));
{$endif i386}
if cs_opt_size in current_settings.optimizerswitches then
if (cs_opt_size in current_settings.optimizerswitches) and
(len>sizeof(aint)+(sizeof(aint) div 2)) then
begin
a_load_const_reg(list,OS_INT,len,REGCX);
list.concat(Taicpu.op_none(A_REP,S_NO));
@ -1714,6 +1738,10 @@ unit cgx86;
ungetcpuregister(list,REGCX);
ungetcpuregister(list,REGSI);
ungetcpuregister(list,REGDI);
if (source.segment<>NR_NO) then
list.concat(taicpu.op_reg(A_POP,S_L,NR_DS));
if (dest.segment<>NR_NO) then
list.concat(taicpu.op_reg(A_POP,S_L,NR_ES));
end;
end;
end;

43
tests/webtbs/tw9667.pp Normal file
View File

@ -0,0 +1,43 @@
{ %target=go32v2 }
{ compiled with smallest code option, control B does not work }
{ compiled with fastest code option, both controls work fine }
{ output with smallest code (note that control B output seems randomical)
1234567890
A >5/53<
B >M/77<
}
program tbug;
uses
crt;
type
TCharColor = record
car : char;
color : byte;
end;
TScreen = array[1..50,1..80] of TCharColor;
var
CGA : TScreen absolute $B800:0000;
c : char;
begin
clrscr;
write( '1234567890');
{ control A }
gotoxy( 1, 2);
write( 'A >', CGA[ 1, 5].car, '/', ord( CGA[ 1, 5].car), '<');
{ control B }
gotoxy( 1, 3);
c := CGA[ 1, 5].car;
write( 'B >', c, '/', ord( c), '<');
if (c<>'5') then
halt(1);
writeln;
end.