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

* split type reading from pdecl to ptype unit

Browse Source 
* parameter_dec routine is now used for procedure and procvars
This commit is contained in:
peter 1999-10-22 10:39:34 +00:00
parent de4c17fb9e
commit 89b677a0ee
7 changed files with 2133 additions and 2123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/globtype.pas
View File

@ -137,7 +137,7 @@ interface
{ currently parsed block type }
tblock_type = (bt_none,
bt_general,bt_type,bt_const
bt_general,bt_type,bt_const,bt_except
);
{ packrecords types }
@ -179,7 +179,11 @@ begin
end.
{
$Log$
Revision 1.19 1999-09-20 16:38:54 peter
Revision 1.20 1999-10-22 10:39:34 peter
* split type reading from pdecl to ptype unit
* parameter_dec routine is now used for procedure and procvars
Revision 1.19 1999/09/20 16:38:54 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.

8
compiler/parser.pas
View File

@ -67,7 +67,7 @@ unit parser;
{ cgbase must be after hcodegen to use the correct procinfo !!! }
cgbase,
{$endif newcg}
comphook,tree,scanner,pbase,pdecl,psystem,pmodules,cresstr;
comphook,tree,scanner,pbase,ptype,psystem,pmodules,cresstr;
procedure initparser;
@ -487,7 +487,11 @@ unit parser;
end.
{
$Log$
Revision 1.88 1999-10-12 21:20:45 florian
Revision 1.89 1999-10-22 10:39:34 peter
* split type reading from pdecl to ptype unit
* parameter_dec routine is now used for procedure and procvars
Revision 1.88 1999/10/12 21:20:45 florian
* new codegenerator compiles again
Revision 1.87 1999/10/03 19:44:41 peter

2381
compiler/pdecl.pas
View File

File diff suppressed because it is too large Load Diff

10
compiler/pexpr.pas
View File

@ -60,7 +60,7 @@ unit pexpr;
{$endif newcg}
pass_1,
{ parser specific stuff }
pbase,pdecl,
pbase,ptype,
{ processor specific stuff }
cpubase,cpuinfo;
@ -1757,7 +1757,7 @@ unit pexpr;
p1:=genrealconstnode(d,bestrealdef^);
end;
_STRING : begin
pd:=stringtype;
pd:=string_dec;
{ STRING can be also a type cast }
if token=_LKLAMMER then
begin
@ -2113,7 +2113,11 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.148 1999-10-14 14:57:52 florian
Revision 1.149 1999-10-22 10:39:34 peter
* split type reading from pdecl to ptype unit
* parameter_dec routine is now used for procedure and procvars
Revision 1.148 1999/10/14 14:57:52 florian
- removed the hcodegen use in the new cg, use cgbase instead
Revision 1.147 1999/09/28 11:03:54 peter

22
compiler/pstatmnt.pas
View File

@ -26,10 +26,6 @@ unit pstatmnt;
uses tree;
var
{ true, if we are in a except block }
in_except_block : boolean;
{ reads a block }
function block(islibrary : boolean) : ptree;
@ -506,7 +502,7 @@ unit pstatmnt;
end
else
begin
if not(in_except_block) then
if (block_type<>bt_except) then
Message(parser_e_no_reraise_possible);
end;
raise_statement:=gennode(raisen,p1,p2);
@ -520,7 +516,7 @@ unit pstatmnt;
p_default,p_specific,hp : ptree;
ot : pobjectdef;
sym : pvarsym;
old_in_except_block : boolean;
old_block_type : tblock_type;
exceptsymtable : psymtable;
objname : stringid;
@ -564,8 +560,8 @@ unit pstatmnt;
else
begin
consume(_EXCEPT);
old_in_except_block:=in_except_block;
in_except_block:=true;
old_block_type:=block_type;
block_type:=bt_except;
p_specific:=nil;
if token=_ON then
{ catch specific exceptions }
@ -677,7 +673,7 @@ unit pstatmnt;
end;
dec(statement_level);
in_except_block:=old_in_except_block;
block_type:=old_block_type;
try_statement:=genloopnode(tryexceptn,p_try_block,p_specific,p_default,false);
end;
end;
@ -694,7 +690,7 @@ unit pstatmnt;
begin
p:=comp_expr(true);
consume(_RKLAMMER);
if in_except_block then
if (block_type=bt_except) then
Message(parser_e_exit_with_argument_not__possible);
if procinfo^.retdef=pdef(voiddef) then
Message(parser_e_void_function);
@ -1324,7 +1320,11 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.104 1999-10-14 14:57:54 florian
Revision 1.105 1999-10-22 10:39:35 peter
* split type reading from pdecl to ptype unit
* parameter_dec routine is now used for procedure and procvars
Revision 1.104 1999/10/14 14:57:54 florian
- removed the hcodegen use in the new cg, use cgbase instead
Revision 1.103 1999/09/27 23:44:56 peter

211
compiler/psub.pas
View File

@ -78,7 +78,7 @@ uses
,tgen68k,cga68k
{$endif}
{ parser specific stuff }
,pbase,pdecl,pexpr,pstatmnt
,pbase,ptype,pdecl,pexpr,pstatmnt
{$ifdef newcg}
,tgcpu,convtree,cgobj,tgeni386 { for the new code generator tgeni386 is only a dummy }
{$endif newcg}
@ -88,204 +88,6 @@ var
realname:string; { contains the real name of a procedure as it's typed }
procedure formal_parameter_list;
{
handle_procvar needs the same changes
}
var
sc : Pstringcontainer;
s : string;
storetokenpos : tfileposinfo;
p : Pdef;
hsym : psym;
hvs,
vs : Pvarsym;
hs1,hs2 : string;
varspez : Tvarspez;
inserthigh : boolean;
begin
consume(_LKLAMMER);
inc(testcurobject);
repeat
if try_to_consume(_VAR) then
varspez:=vs_var
else
if try_to_consume(_CONST) then
varspez:=vs_const
else
varspez:=vs_value;
inserthigh:=false;
readtypesym:=nil;
if idtoken=_SELF then
begin
{ we parse the defintion in the class definition }
if assigned(procinfo^._class) and procinfo^._class^.is_class then
begin
{$ifndef UseNiceNames}
hs2:=hs2+'$'+'self';
{$else UseNiceNames}
hs2:=hs2+tostr(length('self'))+'self';
{$endif UseNiceNames}
vs:=new(Pvarsym,init('@',procinfo^._class));
vs^.varspez:=vs_var;
{ insert the sym in the parasymtable }
aktprocsym^.definition^.parast^.insert(vs);
{$ifdef INCLUDEOK}
include(aktprocsym^.definition^.procoptions,po_containsself);
{$else}
aktprocsym^.definition^.procoptions:=aktprocsym^.definition^.procoptions+[po_containsself];
{$endif}
{$ifdef newcg}
inc(procinfo^.selfpointer_offset,vs^.address);
{$else newcg}
inc(procinfo^.ESI_offset,vs^.address);
{$endif newcg}
consume(idtoken);
consume(_COLON);
p:=single_type(hs1,false);
if assigned(readtypesym) then
aktprocsym^.definition^.concattypesym(readtypesym,vs_value)
else
aktprocsym^.definition^.concatdef(p,vs_value);
CheckTypes(p,procinfo^._class);
end
else
consume(_ID);
end
else
begin
{ read identifiers }
sc:=idlist;
{ read type declaration, force reading for value and const paras }
if (token=_COLON) or (varspez=vs_value) then
begin
consume(_COLON);
{ check for an open array }
if token=_ARRAY then
begin
consume(_ARRAY);
consume(_OF);
{ define range and type of range }
p:=new(Parraydef,init(0,-1,s32bitdef));
{ array of const ? }
if (token=_CONST) and (m_objpas in aktmodeswitches) then
begin
consume(_CONST);
srsym:=nil;
getsymonlyin(systemunit,'TVARREC');
if not assigned(srsym) then
InternalError(1234124);
Parraydef(p)^.definition:=ptypesym(srsym)^.definition;
Parraydef(p)^.IsArrayOfConst:=true;
hs1:='array_of_const';
end
else
begin
{ define field type }
Parraydef(p)^.definition:=single_type(hs1,false);
hs1:='array_of_'+hs1;
{ we don't need the typesym anymore }
readtypesym:=nil;
end;
inserthigh:=true;
end
{ open string ? }
else if (varspez=vs_var) and
(
(
((token=_STRING) or (idtoken=_SHORTSTRING)) and
(cs_openstring in aktmoduleswitches) and
not(cs_ansistrings in aktlocalswitches)
) or
(idtoken=_OPENSTRING)) then
begin
consume(token);
p:=openshortstringdef;
hs1:='openstring';
inserthigh:=true;
end
{ everything else }
else
p:=single_type(hs1,false);
end
else
begin
{$ifndef UseNiceNames}
hs1:='$$$';
{$else UseNiceNames}
hs1:='var';
{$endif UseNiceNames}
p:=cformaldef;
{ }
end;
hs2:=aktprocsym^.definition^.mangledname;
storetokenpos:=tokenpos;
while not sc^.empty do
begin
{$ifndef UseNiceNames}
hs2:=hs2+'$'+hs1;
{$else UseNiceNames}
hs2:=hs2+tostr(length(hs1))+hs1;
{$endif UseNiceNames}
s:=sc^.get_with_tokeninfo(tokenpos);
if assigned(readtypesym) then
begin
aktprocsym^.definition^.concattypesym(readtypesym,varspez);
vs:=new(Pvarsym,initsym(s,readtypesym))
end
else
begin
aktprocsym^.definition^.concatdef(p,varspez);
vs:=new(Pvarsym,init(s,p));
end;
vs^.varspez:=varspez;
{ we have to add this to avoid var param to be in registers !!!}
if (varspez in [vs_var,vs_const]) and push_addr_param(p) then
{$ifdef INCLUDEOK}
include(vs^.varoptions,vo_regable);
{$else}
vs^.varoptions:=vs^.varoptions+[vo_regable];
{$endif}
{ search for duplicate ids in object members/methods }
{ but only the current class, I don't know why ... }
{ at least TP and Delphi do it in that way (FK) }
if assigned(procinfo^._class) and
(lexlevel=normal_function_level) then
begin
hsym:=procinfo^._class^.symtable^.search(vs^.name);
if assigned(hsym) then
DuplicateSym(hsym);
end;
{ do we need a local copy }
if (varspez=vs_value) and push_addr_param(p) and
not(is_open_array(p) or is_array_of_const(p)) then
vs^.setname('val'+vs^.name);
{ insert the sym in the parasymtable }
aktprocsym^.definition^.parast^.insert(vs);
{ also need to push a high value? }
if inserthigh then
begin
hvs:=new(Pvarsym,init('high'+s,s32bitdef));
hvs^.varspez:=vs_const;
aktprocsym^.definition^.parast^.insert(hvs);
end;
end;
dispose(sc,done);
tokenpos:=storetokenpos;
end;
aktprocsym^.definition^.setmangledname(hs2);
until not try_to_consume(_SEMICOLON);
dec(testcurobject);
consume(_RKLAMMER);
end;
procedure parse_proc_head(options:tproctypeoption);
var sp:stringid;
pd:Pprocdef;
@ -543,7 +345,8 @@ begin
definitions of args defs in staticsymtable for
implementation of a global method }
if token=_LKLAMMER then
formal_parameter_list;
parameter_dec(aktprocsym^.definition);
{ so we only restore the symtable now }
symtablestack:=st;
if (options=potype_operator) then
@ -1577,7 +1380,7 @@ begin
getlabel(quickexitlabel);
end;
{ reset break and continue labels }
in_except_block:=false;
block_type:=bt_general;
aktbreaklabel:=nil;
aktcontinuelabel:=nil;
@ -2099,7 +1902,11 @@ end.
{
$Log$
Revision 1.28 1999-10-13 10:37:36 peter
Revision 1.29 1999-10-22 10:39:35 peter
* split type reading from pdecl to ptype unit
* parameter_dec routine is now used for procedure and procvars
Revision 1.28 1999/10/13 10:37:36 peter
* moved mangledname creation of normal proc so it also handles a wrong
method proc

1616
compiler/ptype.pas Normal file
View File

File diff suppressed because it is too large Load Diff