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

* demangled name of procsym reworked to become independant of the mangling scheme

Browse Source 
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
This commit is contained in:
pierre 1998-06-04 09:55:35 +00:00
parent c04eb73621
commit afe0d5a50d
9 changed files with 222 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/cgi386.pas
View File

@ -4203,6 +4203,8 @@ do_jmp:
begin
exprasmlist^.concatlist(p^.p_asm);
if not p^.object_preserved then
maybe_loadesi;
end;
procedure secondcase(var p : ptree);
@ -5059,7 +5061,12 @@ do_jmp:
end.
{
$Log$
Revision 1.31 1998-06-03 22:48:52 peter
Revision 1.32 1998-06-04 09:55:35 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.31 1998/06/03 22:48:52 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas

9
compiler/hcodegen.pas
View File

@ -50,6 +50,8 @@ unit hcodegen;
_class : pobjectdef;
{ return type }
retdef : pdef;
{ return type }
sym : pprocsym;
{ the definition of the proc itself }
def : pdef;
{ frame pointer offset }
@ -392,7 +394,12 @@ end.
{
$Log$
Revision 1.6 1998-05-23 01:21:08 peter
Revision 1.7 1998-06-04 09:55:38 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.6 1998/05/23 01:21:08 peter
+ aktasmmode, aktoptprocessor, aktoutputformat
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+ $LIBNAME to set the library name where the unit will be put in

71
compiler/pass_1.pas
View File

@ -500,7 +500,7 @@ unit pass_1;
putnode(p);
p:=genzeronode(funcretn);
p^.funcretprocinfo:=pprocinfo(pfuncretsym(p^.symtableentry)^.funcretprocinfo);
p^.retdef:=pfuncretsym(p^.symtableentry)^.retdef;
p^.retdef:=pfuncretsym(p^.symtableentry)^.funcretdef;
firstpass(p);
exit;
end;
@ -2568,6 +2568,48 @@ unit pass_1;
{ *************** subroutine handling **************** }
{ protected field handling
protected field can not appear in
var parameters of function !!
this can only be done after we have determined the
overloaded function
this is the reason why it is not in the parser
PM }
procedure test_protected_sym(sym : psym);
begin
if ((sym^.properties and sp_protected)<>0) and
((sym^.owner^.symtabletype=unitsymtable) or
((sym^.owner^.symtabletype=objectsymtable) and
(pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))) then
Message(parser_e_cant_access_protected_member);
end;
procedure test_protected(p : ptree);
begin
if p^.treetype=loadn then
begin
test_protected_sym(p^.symtableentry);
end
else if p^.treetype=typeconvn then
begin
test_protected(p^.left);
end
else if p^.treetype=derefn then
begin
test_protected(p^.left);
end
else if p^.treetype=subscriptn then
begin
{ test_protected(p^.left);
Is a field of a protected var
also protected ??? PM }
test_protected_sym(p^.vs);
end;
end;
procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
var store_valid : boolean;
@ -2612,6 +2654,8 @@ unit pass_1;
if count_ref then
begin
store_valid:=must_be_valid;
if (defcoll^.paratyp=vs_var) then
test_protected(p^.left);
if (defcoll^.paratyp<>vs_var) then
must_be_valid:=true
else
@ -3356,14 +3400,17 @@ unit pass_1;
procedure firstfuncret(var p : ptree);
begin
begin
{$ifdef TEST_FUNCRET}
p^.resulttype:=p^.retdef;
p^.location.loc:=LOC_REFERENCE;
if ret_in_param(p^.retdef) or
(@procinfo<>pprocinfo(p^.funcretprocinfo)) then
p^.registers32:=1;
if must_be_valid and not pprocinfo(p^.funcretprocinfo)^.funcret_is_valid then
p^.resulttype:=p^.retdef;
p^.location.loc:=LOC_REFERENCE;
if ret_in_param(p^.retdef) or
(@procinfo<>pprocinfo(p^.funcretprocinfo)) then
p^.registers32:=1;
{ no claim if setting higher return values }
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;
{$else TEST_FUNCRET}
@ -4949,7 +4996,12 @@ unit pass_1;
end.
{
$Log$
Revision 1.25 1998-06-03 22:48:57 peter
Revision 1.26 1998-06-04 09:55:39 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.25 1998/06/03 22:48:57 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
@ -4992,7 +5044,6 @@ end.
* UseBrower updated gives a global list of all position of all used symbols
with switch -gb
>>>>>>> h:/cvs/compiler/PASS_1.pas
Revision 1.18 1998/05/11 13:07:55 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required

57
compiler/pexpr.pas
View File

@ -599,9 +599,11 @@ unit pexpr;
if ((sym^.properties and sp_private)<>0) and
(pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
Message(parser_e_cant_access_private_member);
{ this is wrong protected should not be overwritten but
can be called !! PM
if ((sym^.properties and sp_protected)<>0) and
(pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then
Message(parser_e_cant_access_protected_member);
Message(parser_e_cant_access_protected_member); }
{ we assume, that only procsyms and varsyms are in an object }
{ symbol table, for classes, properties are allowed }
case sym^.typ of
@ -616,6 +618,11 @@ unit pexpr;
end;
varsym:
begin
if ((sym^.properties and sp_protected)<>0) and
(pobjectdef(pd)^.owner^.symtabletype=unitsymtable) and
not(afterassignment) and
not(in_args) then
Message(parser_e_cant_access_protected_member);
if isclassref then
Message(parser_e_only_class_methods_via_class_ref);
if (sym^.properties and sp_static)<>0 then
@ -918,6 +925,39 @@ unit pexpr;
p^[l]:=p^[l] or (1 shl (pos mod 8));
end;
{$ifdef TEST_FUNCRET}
function is_func_ret(sym : psym) : boolean;
var
p : pprocinfo;
begin
p:=@procinfo;
is_func_ret:=false;
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
(p^.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktswitches) and
(afterassignment or in_args))) then
begin
p1:=genzeronode(funcretn);
pd:=p^.retdef;
p1^.funcretprocinfo:=p;
p1^.retdef:=pd;
is_func_ret:=true;
exit;
end;
p:=p^.parent;
end;
end;
{$endif TEST_FUNCRET}
var
possible_error : boolean;
@ -953,6 +993,7 @@ unit pexpr;
else
getsym(pattern,true);
consume(ID);
{$ifndef TEST_FUNCRET}
{ is this an access to a function result ? }
if assigned(aktprocsym) and
((srsym^.name=aktprocsym^.name) or
@ -965,12 +1006,11 @@ unit pexpr;
begin
p1:=genzeronode(funcretn);
pd:=procinfo.retdef;
{$ifdef TEST_FUNCRET}
p1^.funcretprocinfo:=pointer(@procinfo);
p1^.retdef:=pd;
{$endif TEST_FUNCRET}
end
else
{$else TEST_FUNCRET}
if not is_func_ret(srsym) then
{$endif TEST_FUNCRET}
{ else it's a normal symbol }
begin
if srsym^.typ=unitsym then
@ -1752,7 +1792,12 @@ unit pexpr;
end.
{
$Log$
Revision 1.22 1998-06-02 17:03:03 pierre
Revision 1.23 1998-06-04 09:55:40 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.22 1998/06/02 17:03:03 pierre
* with node corrected for objects
* small bugs for SUPPORT_MMX fixed

18
compiler/pmodules.pas
View File

@ -312,8 +312,8 @@ unit pmodules;
{ but for the implementation part }
{ the written crc is false, because }
{ not defined when writing the ppufile !! }
(* if {(loaded_unit^.crc<>checksum) or}
(do_build and loaded_unit^.sources_avail) then
{$ifdef TEST_IMPL}
if (loaded_unit^.crc<>0) and (loaded_unit^.crc<>checksum) then
begin
{ we have to compile the current unit }
{ remove stuff which isn't needed }
@ -324,7 +324,7 @@ unit pmodules;
dispose(hp^.ppufile,done);
hp^.ppufile:=nil;
if not(hp^.sources_avail) then
Message1(unit_f_cant_compile_unit,hp^.unitname^)
Message1(unit_f_cant_compile_unit,hp^.modulename^)
else
begin
oldhp^.current_inputfile^.tempclose;
@ -332,7 +332,8 @@ unit pmodules;
oldhp^.current_inputfile^.tempclose;
end;
exit;
end; *)
end;
{$endif TEST_IMPL}
{ read until ibend }
hp^.ppufile^.read_data(b,1,count);
end;
@ -516,7 +517,7 @@ unit pmodules;
consume(SEMICOLON);
{ now insert the units in the symtablestack }
hp:=pused_unit(current_module^.used_units.first);
hp:=pused_unit(current_module^.used_units.first);
{ set the symtable to systemunit so it gets reorderd correctly }
symtablestack:=systemunit;
while assigned(hp) do
@ -981,7 +982,12 @@ unit pmodules;
end.
{
$Log$
Revision 1.19 1998-06-03 23:40:38 peter
Revision 1.20 1998-06-04 09:55:42 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.19 1998/06/03 23:40:38 peter
+ unlimited file support, release tempclose
Revision 1.18 1998/06/03 22:49:00 peter

48
compiler/pstatmnt.pas
View File

@ -584,6 +584,8 @@ unit pstatmnt;
{$ifdef i386}
function _asm_statement : ptree;
var asm_stat : ptree;
begin
if (aktprocsym^.definition^.options and poinline)<>0 then
Begin
@ -592,9 +594,9 @@ unit pstatmnt;
aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
End;
case aktasmmode of
I386_ATT : _asm_statement:=ratti386.assemble;
I386_INTEL : _asm_statement:=rai386.assemble;
I386_DIRECT : _asm_statement:=radi386.assemble;
I386_ATT : asm_stat:=ratti386.assemble;
I386_INTEL : asm_stat:=rai386.assemble;
I386_DIRECT : asm_stat:=radi386.assemble;
else internalerror(30004);
end;
@ -607,6 +609,7 @@ unit pstatmnt;
begin
{ it's possible to specify the modified registers }
consume(LECKKLAMMER);
asm_stat^.object_preserved:=true;
if token<>RECKKLAMMER then
repeat
pattern:=upper(pattern);
@ -619,7 +622,10 @@ unit pstatmnt;
else if pattern='EDX' then
usedinproc:=usedinproc or ($80 shr byte(R_EDX))
else if pattern='ESI' then
usedinproc:=usedinproc or ($80 shr byte(R_ESI))
begin
usedinproc:=usedinproc or ($80 shr byte(R_ESI));
asm_stat^.object_preserved:=false;
end
else if pattern='EDI' then
usedinproc:=usedinproc or ($80 shr byte(R_EDI))
else consume(RECKKLAMMER);
@ -630,6 +636,7 @@ unit pstatmnt;
consume(RECKKLAMMER);
end
else usedinproc:=$ff;
_asm_statement:=asm_stat;
end;
{$endif}
@ -1138,34 +1145,15 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.16 1998-06-02 17:03:04 pierre
Revision 1.17 1998-06-04 09:55:43 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.16 1998/06/02 17:03:04 pierre
* with node corrected for objects
* small bugs for SUPPORT_MMX fixed
<<<<<<< PSTATMNT.pas
Revision 1.14 1998/05/29 09:58:14 pierre
* OPR_REGISTER for 1 arg was missing in ratti386.pas
(probably a merging problem)
* errors at start of line were lost
Revision 1.13 1998/05/28 17:26:50 peter
* fixed -R switch, it didn't work after my previous akt/init patch
* fixed bugs 110,130,136
Revision 1.12 1998/05/21 19:33:33 peter
+ better procedure directive handling and only one table
Revision 1.11 1998/05/20 09:42:35 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)
the problem came from the label code !
+ first inlined procedures and function work
(warning there might be allowed cases were the result is still wrong !!)
* UseBrower updated gives a global list of all position of all used symbols
with switch -gb
=======
Revision 1.15 1998/05/30 14:31:06 peter
+ $ASMMODE
@ -1191,7 +1179,6 @@ end.
* UseBrower updated gives a global list of all position of all used symbols
with switch -gb
>>>>>>> h:/cvs/compiler/PSTATMNT.pas
Revision 1.10 1998/05/11 13:07:56 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
@ -1240,3 +1227,4 @@ end.
and creates wrong assembler files !!)
procsym types sym in tdef removed !!
}

43
compiler/symdef.inc
View File

@ -1556,6 +1556,33 @@
end;
end;
function tabstractprocdef.demangled_paras : string;
var s : string;
p : pdefcoll;
begin
s:='';
p:=para1;
if assigned(p) then
begin
s:=s+'(';
while assigned(p) do
begin
if assigned(p^.data^.sym) then
s:=s+p^.data^.sym^.name
else if p^.paratyp=vs_var then
s:=s+'var'
else if p^.paratyp=vs_const then
s:=s+'const';
p:=p^.next;
if assigned(p) then
s:=s+','
else
s:=s+')';
end;
end;
demangled_paras:=s;
end;
{$ifdef GDB}
function tabstractprocdef.stabstring : pchar;
begin
@ -2263,8 +2290,13 @@
while assigned(para) do
begin
if para^.data^.deftype = formaldef then
argnames := argnames+'3var'
else
begin
if para^.paratyp=vs_var then
argnames := argnames+'3var'
else if para^.paratyp=vs_const then
argnames:=argnames+'5const';
end
else
begin
{ if the arg definition is like (v: ^byte;..
there is no sym attached to data !!! }
@ -2375,7 +2407,12 @@
{
$Log$
Revision 1.3 1998-06-03 22:49:03 peter
Revision 1.4 1998-06-04 09:55:45 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.3 1998/06/03 22:49:03 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas

21
compiler/symsym.inc
View File

@ -533,7 +533,7 @@
function tprocsym.demangledname:string;
begin
demangledname:=name+'('+demangledparas(definition^.mangledname)+')';
demangledname:=name+definition^.demangled_paras;
end;
@ -550,10 +550,10 @@
begin
{$ifdef GDB}
if assigned(pd^._class) then
Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+'('+demangledparas(pd^.mangledname)+')')
else
Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
else
{$endif GDB}
Message1(sym_e_forward_not_resolved,demangledname)
Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras)
end;
pd:=pd^.nextoverloaded;
end;
@ -758,15 +758,15 @@
****************************************************************************}
{$ifdef TEST_FUNCRET}
constructor tfuncretsym.init(const n : string;approcinfo : pprocinfo);
constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
begin
tsym.init(n);
funcretprocinfo:=approcinfo;
funcretdef:=approcinfo^.retdef;
funcretdef:=pprocinfo(approcinfo)^.retdef;
{ address valid for ret in param only }
{ otherwise set by insert }
address:=approcinfo^.retoffset;
address:=pprocinfo(approcinfo)^.retoffset;
end;
{$endif TEST_FUNCRET}
@ -1690,7 +1690,12 @@
{
$Log$
Revision 1.3 1998-06-03 22:14:20 florian
Revision 1.4 1998-06-04 09:55:46 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.3 1998/06/03 22:14:20 florian
* problem with sizes of classes fixed (if the anchestor was declared
forward, the compiler doesn't update the child classes size)

13
compiler/tree.pas
View File

@ -228,7 +228,7 @@ unit tree;
retoffset,para_offset,para_size : longint);
setconstrn : (constset : pconstset);
loopn : (t1,t2 : ptree;backward : boolean);
asmn : (p_asm : paasmoutput);
asmn : (p_asm : paasmoutput;object_preserved : boolean);
casen : (nodes : pcaserecord;elseblock : ptree);
labeln,goton : (labelnr : plabel);
withn : (withsymtable : psymtable;tablecount : longint);
@ -294,6 +294,9 @@ unit tree;
implementation
uses
{$ifdef extdebug}
types,
{$endif extdebug}
verbose,files;
{****************************************************************************
@ -887,6 +890,7 @@ unit tree;
p^.treetype:=asmn;
p^.registers32:=4;
p^.p_asm:=p_asm;
p^.object_preserved:=false;
{ p^.registers16:=0;
p^.registers8:=0; }
p^.registersfpu:=8;
@ -1534,7 +1538,12 @@ unit tree;
end.
{
$Log$
Revision 1.12 1998-06-03 22:49:06 peter
Revision 1.13 1998-06-04 09:55:49 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.12 1998/06/03 22:49:06 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas