paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-18 22:59:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ funcret setting in underproc testing

Browse Source 
compile with _dTEST_FUNCRET
This commit is contained in:
pierre 1998-08-20 09:26:37 +00:00
parent 2d3551267d
commit 2d9cbf7fde
7 changed files with 88 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/cg386ld.pas
View File

@ -532,22 +532,22 @@ implementation
hr:=getregister32;
hr_valid:=false;
hp:=new_reference(procinfo.framepointer,
pprocinfo(procinfo.framepointer_offset);
procinfo.framepointer_offset);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hr)));
pp:=procinfo.parent;
{ walk up the stack frame }
while pp<>pprocinfo(p^.funcretprocinfo) do
begin
hp:=new_reference(hr,
pprocinfo(pp^.framepointer_offset);
pp^.framepointer_offset);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hr)));
pp:=pp^.parent;
end;
p^.location.reference.base:=hr;
{ walk up the stack frame }
{ not done yet !! }
end
else
p^.location.reference.base:=procinfo.framepointer;
p^.location.reference.offset:=pprocinfo(p^.funcretprocinfo)^.retoffset;
p^.location.reference.offset:=procinfo.retoffset;
if ret_in_param(p^.retdef) then
{$endif TEST_FUNCRET}
begin
@ -565,7 +565,11 @@ implementation
end.
{
$Log$
Revision 1.8 1998-08-10 14:49:48 peter
Revision 1.9 1998-08-20 09:26:37 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.8 1998/08/10 14:49:48 peter
+ localswitches, moduleswitches, globalswitches splitting
Revision 1.7 1998/07/30 13:30:33 florian

10
compiler/hcodegen.pas
View File

@ -54,6 +54,10 @@ unit hcodegen;
retdef : pdef;
{ return type }
sym : pprocsym;
{$ifdef TEST_FUNCRET }
{ symbol of the function }
funcretsym : pfuncretsym;
{$endif TEST_FUNCRET }
{ the definition of the proc itself }
{ why was this a pdef only ?? PM }
def : pprocdef;
@ -405,7 +409,11 @@ end.
{
$Log$
Revision 1.12 1998-08-10 14:50:01 peter
Revision 1.13 1998-08-20 09:26:38 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.12 1998/08/10 14:50:01 peter
+ localswitches, moduleswitches, globalswitches splitting
Revision 1.11 1998/07/28 21:52:51 florian

11
compiler/pass_1.pas
View File

@ -3629,8 +3629,9 @@ unit pass_1;
if must_be_valid and
(@procinfo=pprocinfo(p^.funcretprocinfo)) and
not procinfo.funcret_is_valid then
note(uninitialized_function_return);
if count_ref then pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
Message(sym_w_function_result_not_set);
if count_ref then
pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
{$else TEST_FUNCRET}
p^.resulttype:=procinfo.retdef;
p^.location.loc:=LOC_REFERENCE;
@ -5258,7 +5259,11 @@ unit pass_1;
end.
{
$Log$
Revision 1.58 1998-08-19 16:07:51 jonas
Revision 1.59 1998-08-20 09:26:39 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.58 1998/08/19 16:07:51 jonas
* changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
Revision 1.57 1998/08/19 00:42:39 peter

30
compiler/pexpr.pas
View File

@ -1066,16 +1066,20 @@ unit pexpr;
function is_func_ret(sym : psym) : boolean;
var
p : pprocinfo;
storesymtablestack : psymtable;
begin
p:=@procinfo;
is_func_ret:=false;
if (sym^.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0) then
exit;
p:=@procinfo;
while assigned(p) do
begin
{ is this an access to a function result ? }
if assigned(aktprocsym) and
((sym^.name=aktprocsym^.name){ or
((pvarsym(srsym)=opsym) and
((p^.flags and pi_operator)<>0))}) and
if assigned(p^.funcretsym) and
((sym=p^.funcretsym) or
((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0))) and
(p^.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktmoduleswitches) and
@ -1090,6 +1094,16 @@ unit pexpr;
end;
p:=p^.parent;
end;
{ we must use the function call }
if(sym^.typ=funcretsym) then
begin
storesymtablestack:=symtablestack;
symtablestack:=srsymtable^.next;
getsym(sym^.name,true);
if srsym^.typ<>procsym then
Message(cg_e_illegal_expression);
symtablestack:=storesymtablestack;
end;
end;
{$endif TEST_FUNCRET}
@ -1841,7 +1855,11 @@ unit pexpr;
end.
{
$Log$
Revision 1.39 1998-08-18 16:48:48 pierre
Revision 1.40 1998-08-20 09:26:41 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.39 1998/08/18 16:48:48 pierre
* bug for -So proc assignment to p^rocvar fixed
Revision 1.38 1998/08/18 14:17:09 pierre

18
compiler/pstatmnt.pas
View File

@ -39,7 +39,7 @@ unit pstatmnt;
implementation
uses
cobjects,globals,files,verbose,systems,
strings,cobjects,globals,files,verbose,systems,
symtable,aasm,pass_1,types,scanner,hcodegen,ppu
,pbase,pexpr,pdecl
{$ifdef i386}
@ -1092,10 +1092,12 @@ unit pstatmnt;
begin
{ if the current is a function aktprocsym is non nil }
{ and there is a local symtable set }
funcretsym:=new(pfuncretsym,init(aktprocsym^.name),@procinfo);
procinfo.retoffset:=-funcretsym^.address;
funcretsym:=new(pfuncretsym,init(aktprocsym^.name,@procinfo));
{ insert in local symtable }
symtablestack^.insert(funcretsym);
if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
procinfo.retoffset:=-funcretsym^.address;
procinfo.funcretsym:=funcretsym;
end;
{$endif TEST_FUNCRET }
read_declarations(islibrary);
@ -1125,10 +1127,6 @@ unit pstatmnt;
{$ifdef TEST_FUNCRET }
{ the space has been set in the local symtable }
procinfo.retoffset:=-funcretsym^.address;
strdispose(funcretsym^._name);
{ lowercase name unreachable }
{ as it is handled differently }
funcretsym^._name:=strpnew('func_result');
{$else TEST_FUNCRET }
{ align func result at 4 byte }
procinfo.retoffset:=
@ -1238,7 +1236,11 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.34 1998-08-17 10:10:09 peter
Revision 1.35 1998-08-20 09:26:42 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.34 1998/08/17 10:10:09 peter
- removed OLDPPU
Revision 1.33 1998/08/12 19:39:30 peter

15
compiler/scanner.pas
View File

@ -570,10 +570,17 @@ implementation
procedure tscannerfile.inc_comment_level;
var
oldaktfilepos : tfileposinfo;
begin
inc(comment_level);
if (comment_level>1) then
Message1(scan_w_comment_level,tostr(comment_level));
begin
oldaktfilepos:=aktfilepos;
gettokenpos; { update for warning }
Message1(scan_w_comment_level,tostr(comment_level));
aktfilepos:=oldaktfilepos;
end;
end;
@ -1552,7 +1559,11 @@ exit_label:
end.
{
$Log$
Revision 1.42 1998-08-19 14:57:51 peter
Revision 1.43 1998-08-20 09:26:45 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.42 1998/08/19 14:57:51 peter
* small fix for aktfilepos
Revision 1.41 1998/08/18 14:17:10 pierre

15
compiler/symsym.inc
View File

@ -600,12 +600,21 @@
begin
tsym.init(n);
typ:=funcretsym;
funcretprocinfo:=approcinfo;
funcretdef:=pprocinfo(approcinfo)^.retdef;
{ address valid for ret in param only }
{ otherwise set by insert }
address:=pprocinfo(approcinfo)^.retoffset;
end;
{$ifdef GDB}
procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
begin
{ Nothing to do here, it is done in genexitcode }
end;
{$endif GDB}
{$endif TEST_FUNCRET}
{****************************************************************************
@ -1544,7 +1553,11 @@
{
$Log$
Revision 1.31 1998-08-17 10:10:12 peter
Revision 1.32 1998-08-20 09:26:46 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.31 1998/08/17 10:10:12 peter
- removed OLDPPU
Revision 1.30 1998/08/13 10:57:29 peter