paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 10:30:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* call by reference and call by value open arrays fixed

Browse Source
This commit is contained in:
florian 1998-04-13 08:42:51 +00:00
parent c2ca131926
commit 08767b7891
2 changed files with 187 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
compiler/cgi386.pas
View File

@ -252,7 +252,9 @@ implementation
{ in case call by reference, then calculate: } { in case call by reference, then calculate: }
if (pvarsym(p^.symtableentry)^.varspez=vs_var) or if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
((pvarsym(p^.symtableentry)^.varspez=vs_const) and ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) then dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) or
{ call by value open arrays are also indirect addressed }
is_open_array(pvarsym(p^.symtableentry)^.definition) then
begin begin
simple_loadn:=false; simple_loadn:=false;
if hregister=R_NO then if hregister=R_NO then
@ -2282,6 +2284,33 @@ implementation
procedure secondcallparan(var p : ptree;defcoll : pdefcoll; procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
push_from_left_to_right : boolean); push_from_left_to_right : boolean);
procedure maybe_push_open_array_high;
var
r : preference;
begin
{ open array ? }
{ defcoll^.data can be nil for read/write }
if assigned(defcoll^.data) and
is_open_array(defcoll^.data) then
begin
{ push high }
if is_open_array(p^.left^.resulttype) then
begin
new(r);
reset_reference(r^);
r^.base:=highframepointer;
r^.offset:=highoffset+4;
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)));
end
else
push_int(parraydef(p^.left^.resulttype)^.highrange-
parraydef(p^.left^.resulttype)^.lowrange);
inc(pushedparasize,4);
end;
end;
var var
size : longint; size : longint;
stackref : treference; stackref : treference;
@ -2311,7 +2340,7 @@ implementation
{ allow @var } { allow @var }
if p^.left^.treetype=addrn then if p^.left^.treetype=addrn then
begin begin
{ allways a register } { always a register }
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register))); exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
ungetregister32(p^.left^.location.register); ungetregister32(p^.left^.location.register);
end end
@ -2333,25 +2362,7 @@ implementation
begin begin
if (p^.left^.location.loc<>LOC_REFERENCE) then if (p^.left^.location.loc<>LOC_REFERENCE) then
Message(cg_e_var_must_be_reference); Message(cg_e_var_must_be_reference);
{ open array ? } maybe_push_open_array_high;
{ defcoll^.data can be nil for read/write }
if assigned(defcoll^.data) and
is_open_array(defcoll^.data) then
begin
{ push high }
if is_open_array(p^.left^.resulttype) then
begin
new(r);
reset_reference(r^);
r^.base:=highframepointer;
r^.offset:=highoffset+4;
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)));
end
else
push_int(parraydef(p^.left^.resulttype)^.highrange-
parraydef(p^.left^.resulttype)^.lowrange);
inc(pushedparasize,4);
end;
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
del_reference(p^.left^.location.reference); del_reference(p^.left^.location.reference);
inc(pushedparasize,4); inc(pushedparasize,4);
@ -2364,6 +2375,7 @@ implementation
if (defcoll^.paratyp=vs_const) and if (defcoll^.paratyp=vs_const) and
dont_copy_const_param(p^.resulttype) then dont_copy_const_param(p^.resulttype) then
begin begin
maybe_push_open_array_high;
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
del_reference(p^.left^.location.reference); del_reference(p^.left^.location.reference);
inc(pushedparasize,4); inc(pushedparasize,4);
@ -2371,7 +2383,8 @@ implementation
else else
case p^.left^.location.loc of case p^.left^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : begin LOC_CREGISTER:
begin
case p^.left^.location.register of case p^.left^.location.register of
R_EAX,R_EBX,R_ECX,R_EDX,R_ESI, R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
R_EDI,R_ESP,R_EBP : R_EDI,R_ESP,R_EBP :
@ -2396,7 +2409,8 @@ implementation
end; end;
end; end;
end; end;
LOC_FPU : begin LOC_FPU:
begin
size:=pfloatdef(p^.left^.resulttype)^.size; size:=pfloatdef(p^.left^.resulttype)^.size;
inc(pushedparasize,size); inc(pushedparasize,size);
exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP))); exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
@ -2461,14 +2475,26 @@ implementation
end; end;
arraydef,recorddef,stringdef,setdef,objectdef : arraydef,recorddef,stringdef,setdef,objectdef :
begin begin
{ small set ? }
if ((p^.resulttype^.deftype=setdef) and if ((p^.resulttype^.deftype=setdef) and
(psetdef(p^.resulttype)^.settype=smallset)) then (psetdef(p^.resulttype)^.settype=smallset)) then
begin begin
emit_push_mem(tempreference); emit_push_mem(tempreference);
inc(pushedparasize,4); inc(pushedparasize,4);
end end
{ call by value open array ? }
else if (p^.resulttype^.deftype=arraydef) and
assigned(defcoll^.data) and
is_open_array(defcoll^.data) then
begin
{ first, push high }
maybe_push_open_array_high;
emitpushreferenceaddr(p^.left^.location.reference);
inc(pushedparasize,4);
end
else else
begin begin
size:=p^.resulttype^.size; size:=p^.resulttype^.size;
{ Alignment } { Alignment }
@ -5725,7 +5751,10 @@ do_jmp:
end. end.
{ {
$Log$ $Log$
Revision 1.10 1998-04-12 22:39:43 florian Revision 1.11 1998-04-13 08:42:51 florian
* call by reference and call by value open arrays fixed
Revision 1.10 1998/04/12 22:39:43 florian
* problem with read access to properties solved * problem with read access to properties solved
* correct handling of hidding methods via virtual (COM) * correct handling of hidding methods via virtual (COM)
* correct result type of constructor calls (COM), the resulttype * correct result type of constructor calls (COM), the resulttype

9
compiler/pass_1.pas
View File

@ -464,7 +464,9 @@ unit pass_1;
if (pvarsym(p^.symtableentry)^.varspez=vs_var) or if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
((pvarsym(p^.symtableentry)^.varspez=vs_const) and ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
dont_copy_const_param(pvarsym(p^.symtableentry)^.definition) dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)
) then ) or
{ call by value open arrays are also indirect addressed }
is_open_array(pvarsym(p^.symtableentry)^.definition) then
p^.registers32:=1; p^.registers32:=1;
if p^.symtable^.symtabletype=withsymtable then if p^.symtable^.symtabletype=withsymtable then
p^.registers32:=1; p^.registers32:=1;
@ -4500,7 +4502,10 @@ unit pass_1;
end. end.
{ {
$Log$ $Log$
Revision 1.7 1998-04-12 22:39:44 florian Revision 1.8 1998-04-13 08:42:52 florian
* call by reference and call by value open arrays fixed
Revision 1.7 1998/04/12 22:39:44 florian
* problem with read access to properties solved * problem with read access to properties solved
* correct handling of hidding methods via virtual (COM) * correct handling of hidding methods via virtual (COM)
* correct result type of constructor calls (COM), the resulttype * correct result type of constructor calls (COM), the resulttype