paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-30 20:22:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added support for nested procvars in the i8086 far data memory models

Browse Source 
git-svn-id: trunk@27812 -
This commit is contained in:
nickysn 2014-05-22 23:44:09 +00:00
parent f526f39f8f
commit 24fcac9f87
4 changed files with 46 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/i8086/hlcgcpu.pas
View File

@ -52,7 +52,9 @@ interface
and registerhi with the following sizes:
register - cgsize = int_cgsize(voidcodepointertype.size)
registerhi - cgsize = int_cgsize(voidpointertype.size) }
registerhi - cgsize = int_cgsize(voidpointertype.size) or int_cgsize(parentfpvoidpointertype.size)
(check d.size to determine which one of the two)
}
function is_methodptr_like_type(d:tdef): boolean;
{ 4-byte records in registers need special handling as well. A record may
@ -307,7 +309,13 @@ implementation
tmpref:=ref;
a_load_reg_ref(list,voidcodepointertype,voidcodepointertype,loc.register,tmpref);
inc(tmpref.offset,voidcodepointertype.size);
a_load_reg_ref(list,voidpointertype,voidpointertype,loc.registerhi,tmpref);
{ the second part could be either self or parentfp }
if tosize.size=(voidcodepointertype.size+voidpointertype.size) then
a_load_reg_ref(list,voidpointertype,voidpointertype,loc.registerhi,tmpref)
else if tosize.size=(voidcodepointertype.size+parentfpvoidpointertype.size) then
a_load_reg_ref(list,parentfpvoidpointertype,parentfpvoidpointertype,loc.registerhi,tmpref)
else
internalerror(2014052201);
end
else if is_fourbyterecord(tosize) and (loc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
begin
@ -396,7 +404,13 @@ implementation
a_load_reg_ref(list,voidcodepointertype,voidcodepointertype,l.register,tmpref);
inc(tmpref.offset,voidcodepointertype.size);
a_load_reg_ref(list,voidpointertype,voidpointertype,l.registerhi,tmpref);
{ the second part could be either self or parentfp }
if size.size=(voidcodepointertype.size+voidpointertype.size) then
a_load_reg_ref(list,voidpointertype,voidpointertype,l.registerhi,tmpref)
else if size.size=(voidcodepointertype.size+parentfpvoidpointertype.size) then
a_load_reg_ref(list,parentfpvoidpointertype,parentfpvoidpointertype,l.registerhi,tmpref)
else
internalerror(2014052202);
location_reset_ref(l,LOC_REFERENCE,l.size,0);
l.reference:=r;

20
compiler/ncal.pas
View File

@ -65,7 +65,8 @@ interface
function is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean;
procedure maybe_load_in_temp(var p:tnode);
function gen_high_tree(var p:tnode;paradef:tdef):tnode;
function gen_procvar_context_tree:tnode;
function gen_procvar_context_tree_self:tnode;
function gen_procvar_context_tree_parentfp:tnode;
function gen_self_tree:tnode;
function gen_vmt_tree:tnode;
procedure gen_hidden_parameters;
@ -1742,15 +1743,24 @@ implementation
end;
function tcallnode.gen_procvar_context_tree:tnode;
function tcallnode.gen_procvar_context_tree_self:tnode;
begin
{ Load tmehodpointer(right).self (either self or parentfp) }
{ Load tmehodpointer(right).self }
result:=genloadfield(ctypeconvnode.create_internal(
right.getcopy,methodpointertype),
'self');
end;
function tcallnode.gen_procvar_context_tree_parentfp: tnode;
begin
{ Load tnestedprocpointer(right).parentfp }
result:=genloadfield(ctypeconvnode.create_internal(
right.getcopy,nestedprocpointertype),
'parentfp');
end;
function tcallnode.gen_self_tree:tnode;
var
selftree : tnode;
@ -2508,7 +2518,7 @@ implementation
if vo_is_self in para.parasym.varoptions then
begin
if assigned(right) then
para.left:=gen_procvar_context_tree
para.left:=gen_procvar_context_tree_self
else
para.left:=gen_self_tree;
{ make sure that e.g. the self pointer of an advanced
@ -2540,7 +2550,7 @@ implementation
internalerror(200309287);
end
else
para.left:=gen_procvar_context_tree;
para.left:=gen_procvar_context_tree_parentfp;
end
else
if vo_is_range_check in para.parasym.varoptions then

7
compiler/psystem.pas
View File

@ -496,6 +496,12 @@ implementation
addfield(hrecst,cfieldvarsym.create('$self',vs_value,voidpointertype,[]));
methodpointertype:=crecorddef.create('',hrecst);
addtype('$methodpointer',methodpointertype);
{ Add a type for nested proc pointers }
hrecst:=trecordsymtable.create('',1);
addfield(hrecst,cfieldvarsym.create('$proc',vs_value,voidcodepointertype,[]));
addfield(hrecst,cfieldvarsym.create('$parentfp',vs_value,parentfpvoidpointertype,[]));
nestedprocpointertype:=crecorddef.create('',hrecst);
addtype('$nestedprocpointer',nestedprocpointertype);
end;
symtablestack.pop(systemunit);
end;
@ -593,6 +599,7 @@ implementation
loadtype('variant',cvarianttype);
loadtype('olevariant',colevarianttype);
loadtype('methodpointer',methodpointertype);
loadtype('nestedprocpointer',nestedprocpointertype);
loadtype('HRESULT',hresultdef);
set_default_int_types;
set_default_ptr_types;

8
compiler/symdef.pas
View File

@ -986,6 +986,7 @@ interface
cfiletype, { get the same definition for all file }
{ used for stabs }
methodpointertype, { typecasting of methodpointers to extract self }
nestedprocpointertype, { typecasting of nestedprocpointers to extract parentfp }
hresultdef,
{ we use only one variant def for every variant class }
cvarianttype,
@ -5597,7 +5598,12 @@ implementation
if ((po_methodpointer in procoptions) or
is_nested_pd(self)) and
not(po_addressonly in procoptions) then
size:=voidcodepointertype.size+voidpointertype.size
begin
if is_nested_pd(self) then
size:=voidcodepointertype.size+parentfpvoidpointertype.size
else
size:=voidcodepointertype.size+voidpointertype.size;
end
else
size:=voidcodepointertype.size;
end;