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

* 8086: Proper implementation of: If a far procvar is called, it must be in a memory location. This fixes a hack to emulate CALL reg1:reg2.

Browse Source 
git-svn-id: trunk@46641 -
This commit is contained in:
yury 2020-08-23 10:26:54 +00:00
parent 04baeb2bcf
commit e5a923eb7a
4 changed files with 45 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/i8086/cgcpu.pas
View File

@ -45,8 +45,6 @@ unit cgcpu;
procedure a_call_name_far(list : TAsmList;const s : string; weak: boolean);
procedure a_call_name_static(list : TAsmList;const s : string);override;
procedure a_call_name_static_far(list : TAsmList;const s : string);
procedure a_call_reg(list : TAsmList;reg : tregister);override;
procedure a_call_reg_far(list : TAsmList;reg : tregister);
procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
@ -200,38 +198,6 @@ unit cgcpu;
end;
procedure tcg8086.a_call_reg(list: TAsmList; reg: tregister);
begin
if current_settings.x86memorymodel in x86_far_code_models then
a_call_reg_far(list,reg)
else
a_call_reg_near(list,reg);
end;
procedure tcg8086.a_call_reg_far(list: TAsmList; reg: tregister);
var
href: treference;
begin
{ unfortunately, x86 doesn't have a 'call far reg:reg' instruction, so }
{ we have to use a temp }
tg.gettemp(list,4,2,tt_normal,href);
{ HACK!!! at this point all registers are allocated, due to the fact that
in the pascal calling convention, all registers are caller saved. This
causes the register allocator to fail on the next move instruction, so we
temporarily deallocate 2 registers.
TODO: figure out a better way to do this. }
cg.ungetcpuregister(list,NR_BX);
cg.ungetcpuregister(list,NR_SI);
a_load_reg_ref(list,OS_32,OS_32,reg,href);
cg.getcpuregister(list,NR_BX);
cg.getcpuregister(list,NR_SI);
href.segment:=NR_NO;
list.concat(taicpu.op_ref(A_CALL,S_FAR,href));
tg.ungettemp(list,href);
end;
procedure tcg8086.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize;
a: tcgint; reg: TRegister);
type

9
compiler/i8086/hlcgcpu.pas
View File

@ -71,6 +71,7 @@ interface
function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
function a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override;
procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
@ -334,6 +335,14 @@ implementation
end;
function thlcgcpu.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
begin
if is_proc_far(pd) then
Internalerror(2020082201);
Result:=inherited a_call_reg(list, pd, reg, paras);
end;
procedure thlcgcpu.a_load_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference);
var
tmpref: treference;

24
compiler/i8086/n8086cal.pas
View File

@ -28,6 +28,7 @@ interface
{ $define AnsiStrRef}
uses
node,
parabase,
nx86cal,cgutils;
@ -39,6 +40,8 @@ interface
procedure extra_call_ref_code(var ref: treference);override;
function do_call_ref(ref: treference): tcgpara;override;
function can_call_ref(var ref: treference): boolean; override;
public
function pass_1: tnode; override;
end;
@ -47,6 +50,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
htypechk,pass_1,
cgbase,
cpubase,paramgr,
aasmtai,aasmdata,aasmcpu,
@ -150,6 +154,26 @@ implementation
end;
function ti8086callnode.pass_1: tnode;
begin
{ If a far procvar is called, it must be in a memory location.
There is no CALL reg1:reg2 instruction. }
if (right<>nil) then
if is_proc_far(procdefinition) then
begin
make_not_regable(right,[]);
firstpass(right);
if not (right.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
begin
{ Use a temp if the procvar still not a reference }
load_in_temp(right);
make_not_regable(right,[]);
end;
end;
Result:=inherited pass_1;
end;
begin
ccallnode:=ti8086callnode;
end.

16
compiler/ncal.pas
View File

@ -92,6 +92,7 @@ interface
function get_expect_loc: tcgloc;
protected
function safe_call_self_node: tnode;
procedure load_in_temp(var p:tnode);
procedure gen_vmt_entry_load; virtual;
procedure gen_syscall_para(para: tcallparanode); virtual;
procedure objc_convert_to_message_send;virtual;
@ -2109,6 +2110,16 @@ implementation
end;
procedure tcallnode.maybe_load_in_temp(var p:tnode);
begin
{ Load all complex loads into a temp to prevent
double calls to a function. We can't simply check for a hp.nodetype=calln }
if assigned(p) and
foreachnodestatic(p,@look_for_call,nil) then
load_in_temp(p);
end;
procedure tcallnode.load_in_temp(var p:tnode);
var
loadp,
refp : tnode;
@ -2116,10 +2127,7 @@ implementation
ptemp : ttempcreatenode;
usederef : boolean;
begin
{ Load all complex loads into a temp to prevent
double calls to a function. We can't simply check for a hp.nodetype=calln }
if assigned(p) and
foreachnodestatic(p,@look_for_call,nil) then
if assigned(p) then
begin
{ temp create }
usederef:=(p.resultdef.typ in [arraydef,recorddef]) or