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

* @procvar fixes for tp mode

Browse Source 
* @<id>:= gives now an error
This commit is contained in:
peter 1999-09-17 17:14:02 +00:00
parent 5c391dc7e9
commit 7f63615b43
10 changed files with 1498 additions and 1392 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/cg386mem.pas
View File

@ -222,6 +222,15 @@ implementation
procedure secondaddr(var p : ptree);
begin
secondpass(p^.left);
{ when loading procvar we do nothing with this node, so load the
location of left }
if p^.procvarload then
begin
set_location(p^.location,p^.left^.location);
exit;
end;
p^.location.loc:=LOC_REGISTER;
del_reference(p^.left^.location.reference);
p^.location.register:=getregister32;
@ -859,7 +868,11 @@ implementation
end.
{
$Log$
Revision 1.57 1999-09-14 07:59:46 florian
Revision 1.58 1999-09-17 17:14:02 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.57 1999/09/14 07:59:46 florian
* finally!? fixed
with <function with result in temp> do
My last and also Peter's fix before were wrong :(

4
compiler/errore.msg
View File

@ -914,6 +914,10 @@ type_e_cannot_local_proc_to_procvar=E_Can't assign local procedure/function to p
% It's not allowed to assign a local procedure/function to a
% procedure variable, because the calling of local procedure/function is
% different. You can only assign local procedure/function to a void pointer.
type_e_no_assign_to_addr=E_Can't assign values to an address
% It's not allowed to assign a value to an address of a variable,constant,
% procedure or function. You can try compiling with -So if the identifier
% is a procedure variable.
% \end{description}
#
# Symtable

17
compiler/htypechk.pas
View File

@ -107,9 +107,18 @@ implementation
exit;
end;
b:=0;
{ tp7 procvar def support, in tp7 a procvar is always called, if the
procvar is passed explicit a addrn would be there }
if (m_tp_procvar in aktmodeswitches) and
(def_from^.deftype=procvardef) and
(fromtreetype=loadn) then
begin
def_from:=pprocvardef(def_from)^.retdef;
end;
{ we walk the wanted (def_to) types and check then the def_from
types if there is a conversion possible }
b:=0;
case def_to^.deftype of
orddef :
begin
@ -696,7 +705,11 @@ implementation
end.
{
$Log$
Revision 1.38 1999-08-17 13:26:07 peter
Revision 1.39 1999-09-17 17:14:04 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.38 1999/08/17 13:26:07 peter
* arrayconstructor -> arrayofconst fixed when arraycosntructor was not
variant.

1295
compiler/msgidx.inc
View File

File diff suppressed because it is too large Load Diff

1343
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

11
compiler/pp.pas
View File

@ -268,9 +268,6 @@ end;
begin
oldexit:=exitproc;
exitproc:=@myexit;
{$ifdef fpc}
heapblocks:=true;
{$endif}
{$ifdef UseOverlay}
InitOverlay;
{$endif}
@ -280,7 +277,11 @@ begin
end.
{
$Log$
Revision 1.49 1999-09-16 23:05:54 florian
Revision 1.50 1999-09-17 17:14:10 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.49 1999/09/16 23:05:54 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.48 1999/09/10 18:48:08 florian
@ -303,7 +304,7 @@ end.
Revision 1.43 1999/06/02 22:25:44 pierre
* catch is used for go32v2 also
Revision 1.42 1999/05/12 22:36:11 florian
* override isn't allowed in objects!

22
compiler/tccnv.pas
View File

@ -832,6 +832,22 @@ implementation
CGMessage2(type_e_incompatible_types,p^.left^.resulttype^.typename,p^.resulttype^.typename);
end;
{ tp7 procvar support, when right is not a procvardef and we got a
loadn of a procvar then convert to a calln, the check for the
result is already done in is_convertible, also no conflict with
@procvar is here because that has an extra addrn }
if (m_tp_procvar in aktmodeswitches) and
(p^.resulttype^.deftype<>procvardef) and
(p^.left^.resulttype^.deftype=procvardef) and
(p^.left^.treetype=loadn) then
begin
hp:=gencallnode(nil,nil);
hp^.right:=p^.left;
firstpass(hp);
p^.left:=hp;
end;
{ ordinal contants can be directly converted }
{ but not int64/qword }
if (p^.left^.treetype=ordconstn) and is_ordinal(p^.resulttype) and
@ -928,7 +944,11 @@ implementation
end.
{
$Log$
Revision 1.47 1999-09-11 09:08:34 florian
Revision 1.48 1999-09-17 17:14:12 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.47 1999/09/11 09:08:34 florian
* fixed bug 596
* fixed some problems with procedure variables and procedures of object,
especially in TP mode. Procedure of object doesn't apply only to classes,

11
compiler/tcld.pas
View File

@ -238,6 +238,11 @@ implementation
if is_open_array(p^.left^.resulttype) then
CGMessage(type_e_mismatch);
{ assignments to addr aren't allowed, but support @procvar for tp }
if (p^.left^.treetype=addrn) and
not(p^.left^.procvarload) then
CGMessage(type_e_no_assign_to_addr);
{ test if we can avoid copying string to temp
as in s:=s+...; (PM) }
{$ifdef dummyi386}
@ -504,7 +509,11 @@ implementation
end.
{
$Log$
Revision 1.44 1999-09-11 19:47:26 florian
Revision 1.45 1999-09-17 17:14:12 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.44 1999/09/11 19:47:26 florian
* bug fix for @tobject.method, fixes bug 557, 605 and 606
Revision 1.43 1999/09/11 09:08:34 florian

165
compiler/tcmem.pas
View File

@ -173,78 +173,113 @@ implementation
make_not_regable(p^.left);
if not(assigned(p^.resulttype)) then
begin
{ proc/procvar 2 procvar ? }
{ tp @procvar support (type of @procvar is a void pointer)
Note: we need to leave the addrn in the tree,
else we can't see the difference between @procvar and procvar.
we set the procvarload flag so a secondpass does nothing for
this node (PFV) }
if (m_tp_procvar in aktmodeswitches) then
begin
hp:=p^.left;
case hp^.treetype of
calln :
begin
{ is it a procvar? }
hp:=hp^.right;
if assigned(hp) then
begin
{ remove calln node }
putnode(p^.left);
p^.left:=hp;
firstpass(hp);
p^.procvarload:=true;
end;
end;
loadn,
vecn,
derefn :
begin
firstpass(hp);
if codegenerror then
exit;
if hp^.resulttype^.deftype=procvardef then
begin
p^.procvarload:=true;
end;
end;
end;
end;
if p^.procvarload then
begin
p^.registers32:=p^.left^.registers32;
p^.registersfpu:=p^.left^.registersfpu;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
if p^.registers32<1 then
p^.registers32:=1;
p^.location.loc:=p^.left^.location.loc;
p^.resulttype:=voidpointerdef;
exit;
end;
{ proc 2 procvar ? }
if p^.left^.treetype=calln then
begin
{ is it a procvar, this is needed for @procvar in tp mode ! }
if assigned(p^.left^.right) then
begin
{ just return the load of the procvar, remove the
addrn and calln nodes }
hp:=p^.left^.right;
putnode(p^.left);
putnode(p);
firstpass(hp);
p:=hp;
exit;
end
else
begin
{ generate a methodcallnode or proccallnode }
{ we shouldn't convert things like @tcollection.load }
if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable) and
not(assigned(p^.left^.methodpointer) and (p^.left^.methodpointer^.treetype=typen)) then
begin
hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
getcopy(p^.left^.methodpointer));
disposetree(p);
firstpass(hp);
p:=hp;
exit;
end
else
hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
end;
{ generate a methodcallnode or proccallnode }
{ we shouldn't convert things like @tcollection.load }
if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable) and
not(assigned(p^.left^.methodpointer) and (p^.left^.methodpointer^.treetype=typen)) then
begin
hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
getcopy(p^.left^.methodpointer));
disposetree(p);
firstpass(hp);
p:=hp;
exit;
end
else
hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
{ result is a procedure variable }
{ No, to be TP compatible, you must return a pointer to
the procedure that is stored in the procvar.}
if not(m_tp_procvar in aktmodeswitches) then
begin
p^.resulttype:=new(pprocvardef,init);
{ result is a procedure variable }
{ No, to be TP compatible, you must return a pointer to
the procedure that is stored in the procvar.}
if not(m_tp_procvar in aktmodeswitches) then
begin
p^.resulttype:=new(pprocvardef,init);
{ it could also be a procvar, not only pprocsym ! }
if p^.left^.symtableprocentry^.typ=varsym then
hp3:=pabstractprocdef(pvarsym(p^.left^.symtableentry)^.definition)
else
hp3:=pabstractprocdef(pprocsym(p^.left^.symtableprocentry)^.definition);
{ it could also be a procvar, not only pprocsym ! }
if p^.left^.symtableprocentry^.typ=varsym then
hp3:=pabstractprocdef(pvarsym(p^.left^.symtableentry)^.definition)
else
hp3:=pabstractprocdef(pprocsym(p^.left^.symtableprocentry)^.definition);
pprocvardef(p^.resulttype)^.proctypeoption:=hp3^.proctypeoption;
pprocvardef(p^.resulttype)^.proccalloptions:=hp3^.proccalloptions;
pprocvardef(p^.resulttype)^.procoptions:=hp3^.procoptions;
pprocvardef(p^.resulttype)^.retdef:=hp3^.retdef;
pprocvardef(p^.resulttype)^.symtablelevel:=hp3^.symtablelevel;
pprocvardef(p^.resulttype)^.proctypeoption:=hp3^.proctypeoption;
pprocvardef(p^.resulttype)^.proccalloptions:=hp3^.proccalloptions;
pprocvardef(p^.resulttype)^.procoptions:=hp3^.procoptions;
pprocvardef(p^.resulttype)^.retdef:=hp3^.retdef;
pprocvardef(p^.resulttype)^.symtablelevel:=hp3^.symtablelevel;
{ method ? then set the methodpointer flag }
if (hp3^.owner^.symtabletype=objectsymtable) and
(pobjectdef(hp3^.owner^.defowner)^.is_class) then
{ method ? then set the methodpointer flag }
if (hp3^.owner^.symtabletype=objectsymtable) and
(pobjectdef(hp3^.owner^.defowner)^.is_class) then
{$ifdef INCLUDEOK}
include(pprocvardef(p^.resulttype)^.procoptions,po_methodpointer);
include(pprocvardef(p^.resulttype)^.procoptions,po_methodpointer);
{$else}
pprocvardef(p^.resulttype)^.procoptions:=pprocvardef(p^.resulttype)^.procoptions+[po_methodpointer];
pprocvardef(p^.resulttype)^.procoptions:=pprocvardef(p^.resulttype)^.procoptions+[po_methodpointer];
{$endif}
hp2:=hp3^.para1;
while assigned(hp2) do
begin
pprocvardef(p^.resulttype)^.concatdef(hp2^.data,hp2^.paratyp);
hp2:=hp2^.next;
end;
end
else
p^.resulttype:=voidpointerdef;
hp2:=hp3^.para1;
while assigned(hp2) do
begin
pprocvardef(p^.resulttype)^.concatdef(hp2^.data,hp2^.paratyp);
hp2:=hp2^.next;
end;
end
else
p^.resulttype:=voidpointerdef;
disposetree(p^.left);
p^.left:=hp;
disposetree(p^.left);
p^.left:=hp;
end
else
begin
@ -595,7 +630,11 @@ implementation
end.
{
$Log$
Revision 1.27 1999-09-11 11:10:39 florian
Revision 1.28 1999-09-17 17:14:12 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.27 1999/09/11 11:10:39 florian
* fix of my previous commit, make cycle was broken
Revision 1.26 1999/09/11 09:08:34 florian

7
compiler/tree.pas
View File

@ -218,6 +218,7 @@ unit tree;
methodpointer : ptree;
no_check,unit_specific,
return_value_used,static_call : boolean);
addrn : (procvarload:boolean);
ordconstn : (value : longint);
realconstn : (value_real : bestreal;lab_real : pasmlabel);
fixconstn : (value_fix: longint);
@ -1765,7 +1766,11 @@ unit tree;
end.
{
$Log$
Revision 1.96 1999-09-16 11:34:59 pierre
Revision 1.97 1999-09-17 17:14:13 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
Revision 1.96 1999/09/16 11:34:59 pierre
* typo correction
Revision 1.95 1999/09/10 18:48:11 florian