mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 12:39:25 +02:00
* defer codegeneration for nested procedures
This commit is contained in:
peter
parent
31286d02e6
commit
345228fd29
@ -29,15 +29,17 @@ interface
|
||||
uses
|
||||
tokens,symconst,symtype,symdef,symsym;
|
||||
|
||||
const
|
||||
pd_global = $1; { directive must be global }
|
||||
pd_body = $2; { directive needs a body }
|
||||
pd_implemen = $4; { directive can be used implementation section }
|
||||
pd_interface = $8; { directive can be used interface section }
|
||||
pd_object = $10; { directive can be used object declaration }
|
||||
pd_procvar = $20; { directive can be used procvar declaration }
|
||||
pd_notobject = $40; { directive can not be used object declaration }
|
||||
pd_notobjintf= $80; { directive can not be used interface declaration }
|
||||
type
|
||||
tpdflag=(
|
||||
pd_body, { directive needs a body }
|
||||
pd_implemen, { directive can be used implementation section }
|
||||
pd_interface, { directive can be used interface section }
|
||||
pd_object, { directive can be used object declaration }
|
||||
pd_procvar, { directive can be used procvar declaration }
|
||||
pd_notobject, { directive can not be used object declaration }
|
||||
pd_notobjintf { directive can not be used interface declaration }
|
||||
);
|
||||
tpdflags=set of tpdflag;
|
||||
|
||||
function is_proc_directive(tok:ttoken):boolean;
|
||||
|
||||
@ -50,7 +52,7 @@ interface
|
||||
procedure handle_calling_convention(pd:tabstractprocdef);
|
||||
|
||||
procedure parse_parameter_dec(pd:tabstractprocdef);
|
||||
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:word);
|
||||
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
|
||||
procedure parse_var_proc_directives(sym:tsym);
|
||||
procedure parse_object_proc_directives(pd:tabstractprocdef);
|
||||
function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption):tprocdef;
|
||||
@ -341,7 +343,6 @@ implementation
|
||||
srsym : tsym;
|
||||
hs1 : string;
|
||||
varspez : Tvarspez;
|
||||
hpara : tparaitem;
|
||||
tdefaultvalue : tconstsym;
|
||||
defaultrequired : boolean;
|
||||
old_object_option : tsymoptions;
|
||||
@ -484,7 +485,7 @@ implementation
|
||||
paramanager.push_addr_param(tt.def,pd.proccalloption) then
|
||||
include(vs.varoptions,vo_regable);
|
||||
end;
|
||||
hpara:=pd.concatpara(nil,tt,vs,tdefaultvalue,false);
|
||||
pd.concatpara(nil,tt,vs,tdefaultvalue,false);
|
||||
vs:=tvarsym(vs.listnext);
|
||||
end;
|
||||
until not try_to_consume(_SEMICOLON);
|
||||
@ -588,9 +589,6 @@ implementation
|
||||
begin
|
||||
aclass:=tobjectdef(ttypesym(sym).restype.def);
|
||||
aprocsym:=tprocsym(aclass.symtable.search(sp));
|
||||
{ The procedure has been found. So it is
|
||||
a global one. Set the flags to mark this.}
|
||||
include(current_procinfo.flags,pi_is_global);
|
||||
{ we solve this below }
|
||||
if assigned(aprocsym) then
|
||||
begin
|
||||
@ -695,13 +693,6 @@ implementation
|
||||
else
|
||||
aprocsym:=tprocsym.create(orgsp);
|
||||
symtablestack.insert(aprocsym);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Set global flag when found in globalsytmable }
|
||||
if (not parse_only) and
|
||||
(aprocsym.owner.symtabletype=globalsymtable) then
|
||||
include(current_procinfo.flags,pi_is_global);
|
||||
end;
|
||||
|
||||
{ to get the correct symtablelevel we must ignore objectsymtables }
|
||||
@ -712,6 +703,10 @@ implementation
|
||||
pd._class:=aclass;
|
||||
pd.procsym:=aprocsym;
|
||||
pd.proctypeoption:=potype;
|
||||
{ methods need to be exported }
|
||||
if assigned(aclass) and
|
||||
(symtablestack.symtablelevel=main_program_level) then
|
||||
include(pd.procoptions,po_public);
|
||||
|
||||
{ symbol options that need to be kept per procdef }
|
||||
pd.fileinfo:=procstartfilepos;
|
||||
@ -756,9 +751,6 @@ implementation
|
||||
inc(testcurobject);
|
||||
single_type(pd.rettype,hs,false);
|
||||
pd.test_if_fpu_result;
|
||||
if (pd.rettype.def.deftype=stringdef) and
|
||||
(tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
|
||||
include(current_procinfo.flags,pi_needs_implicit_finally);
|
||||
dec(testcurobject);
|
||||
end
|
||||
else
|
||||
@ -1174,7 +1166,7 @@ type
|
||||
pd_handler=procedure(pd:tabstractprocdef);
|
||||
proc_dir_rec=record
|
||||
idtok : ttoken;
|
||||
pd_flags : longint;
|
||||
pd_flags : tpdflags;
|
||||
handler : pd_handler;
|
||||
pocall : tproccalloption;
|
||||
pooption : tprocoptions;
|
||||
@ -1189,7 +1181,7 @@ const
|
||||
(
|
||||
(
|
||||
idtok:_ABSTRACT;
|
||||
pd_flags : pd_interface+pd_object+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_abstract;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_abstractmethod];
|
||||
@ -1198,7 +1190,7 @@ const
|
||||
mutexclpo : [po_exports,po_interrupt,po_external]
|
||||
),(
|
||||
idtok:_ALIAS;
|
||||
pd_flags : pd_implemen+pd_body+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_alias;
|
||||
pocall : pocall_none;
|
||||
pooption : [];
|
||||
@ -1207,7 +1199,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_ASMNAME;
|
||||
pd_flags : pd_interface+pd_implemen+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_asmname;
|
||||
pocall : pocall_cdecl;
|
||||
pooption : [po_external];
|
||||
@ -1216,7 +1208,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_ASSEMBLER;
|
||||
pd_flags : pd_implemen+pd_body+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_notobjintf];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_assembler];
|
||||
@ -1225,7 +1217,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_CDECL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_cdecl;
|
||||
pooption : [];
|
||||
@ -1234,7 +1226,7 @@ const
|
||||
mutexclpo : [po_assembler,po_external]
|
||||
),(
|
||||
idtok:_DYNAMIC;
|
||||
pd_flags : pd_interface+pd_object+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_virtualmethod];
|
||||
@ -1243,16 +1235,16 @@ const
|
||||
mutexclpo : [po_exports,po_interrupt,po_external]
|
||||
),(
|
||||
idtok:_EXPORT;
|
||||
pd_flags : pd_body+pd_global+pd_interface+pd_implemen{??}+pd_notobjintf;
|
||||
pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_export;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_exports];
|
||||
pooption : [po_exports,po_public];
|
||||
mutexclpocall : [pocall_internproc,pocall_inline];
|
||||
mutexclpotype : [potype_constructor,potype_destructor];
|
||||
mutexclpo : [po_external,po_interrupt]
|
||||
),(
|
||||
idtok:_EXTERNAL;
|
||||
pd_flags : pd_implemen+pd_interface+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_external;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_external];
|
||||
@ -1261,7 +1253,7 @@ const
|
||||
mutexclpo : [po_exports,po_interrupt,po_assembler]
|
||||
),(
|
||||
idtok:_FAR;
|
||||
pd_flags : pd_implemen+pd_body+pd_interface+pd_procvar+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_far;
|
||||
pocall : pocall_none;
|
||||
pooption : [];
|
||||
@ -1270,7 +1262,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_FAR16;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar+pd_notobject;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject];
|
||||
handler : nil;
|
||||
pocall : pocall_far16;
|
||||
pooption : [];
|
||||
@ -1279,7 +1271,7 @@ const
|
||||
mutexclpo : [po_external,po_leftright]
|
||||
),(
|
||||
idtok:_FORWARD;
|
||||
pd_flags : pd_implemen+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_forward;
|
||||
pocall : pocall_none;
|
||||
pooption : [];
|
||||
@ -1288,7 +1280,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_FPCCALL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_fpccall;
|
||||
pooption : [];
|
||||
@ -1297,7 +1289,7 @@ const
|
||||
mutexclpo : [po_leftright]
|
||||
),(
|
||||
idtok:_INLINE;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_inline;
|
||||
pocall : pocall_inline;
|
||||
pooption : [];
|
||||
@ -1306,7 +1298,7 @@ const
|
||||
mutexclpo : [po_exports,po_external,po_interrupt]
|
||||
),(
|
||||
idtok:_INTERNCONST;
|
||||
pd_flags : pd_implemen+pd_body+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_internconst];
|
||||
@ -1315,7 +1307,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_INTERNPROC;
|
||||
pd_flags : pd_implemen+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
|
||||
pocall : pocall_internproc;
|
||||
pooption : [];
|
||||
@ -1324,7 +1316,7 @@ const
|
||||
mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_leftright]
|
||||
),(
|
||||
idtok:_INTERRUPT;
|
||||
pd_flags : pd_implemen+pd_body+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_interrupt;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_interrupt];
|
||||
@ -1334,7 +1326,7 @@ const
|
||||
mutexclpo : [po_external,po_leftright,po_clearstack]
|
||||
),(
|
||||
idtok:_IOCHECK;
|
||||
pd_flags : pd_implemen+pd_body+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_notobjintf];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_iocheck];
|
||||
@ -1343,7 +1335,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_MESSAGE;
|
||||
pd_flags : pd_interface+pd_object+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_message;
|
||||
pocall : pocall_none;
|
||||
pooption : []; { can be po_msgstr or po_msgint }
|
||||
@ -1352,7 +1344,7 @@ const
|
||||
mutexclpo : [po_interrupt,po_external]
|
||||
),(
|
||||
idtok:_NEAR;
|
||||
pd_flags : pd_implemen+pd_body+pd_procvar+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_near;
|
||||
pocall : pocall_none;
|
||||
pooption : [];
|
||||
@ -1361,7 +1353,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_OVERLOAD;
|
||||
pd_flags : pd_implemen+pd_interface+pd_body;
|
||||
pd_flags : [pd_implemen,pd_interface,pd_body];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_overload;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_overload];
|
||||
@ -1370,7 +1362,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_OVERRIDE;
|
||||
pd_flags : pd_interface+pd_object+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_override;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_overridingmethod,po_virtualmethod];
|
||||
@ -1379,7 +1371,7 @@ const
|
||||
mutexclpo : [po_exports,po_external,po_interrupt]
|
||||
),(
|
||||
idtok:_PASCAL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_pascal;
|
||||
pooption : [];
|
||||
@ -1388,7 +1380,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_POPSTACK;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_clearstack];
|
||||
@ -1397,16 +1389,16 @@ const
|
||||
mutexclpo : [po_assembler,po_external]
|
||||
),(
|
||||
idtok:_PUBLIC;
|
||||
pd_flags : pd_implemen+pd_body+pd_global+pd_notobject+pd_notobjintf;
|
||||
pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [];
|
||||
pooption : [po_public];
|
||||
mutexclpocall : [pocall_internproc,pocall_inline];
|
||||
mutexclpotype : [];
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_REGISTER;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_register;
|
||||
pooption : [];
|
||||
@ -1415,7 +1407,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_REINTRODUCE;
|
||||
pd_flags : pd_interface+pd_object;
|
||||
pd_flags : [pd_interface,pd_object];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_reintroduce;
|
||||
pocall : pocall_none;
|
||||
pooption : [];
|
||||
@ -1424,7 +1416,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_SAFECALL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_safecall;
|
||||
pooption : [];
|
||||
@ -1433,7 +1425,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_SAVEREGISTERS;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobjintf];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_saveregisters];
|
||||
@ -1442,7 +1434,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_STATIC;
|
||||
pd_flags : pd_interface+pd_object+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_static;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_staticmethod];
|
||||
@ -1451,7 +1443,7 @@ const
|
||||
mutexclpo : [po_external,po_interrupt,po_exports]
|
||||
),(
|
||||
idtok:_STDCALL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_stdcall;
|
||||
pooption : [];
|
||||
@ -1460,7 +1452,7 @@ const
|
||||
mutexclpo : [po_external]
|
||||
),(
|
||||
idtok:_SYSCALL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
|
||||
pocall : pocall_palmossyscall;
|
||||
pooption : [];
|
||||
@ -1469,7 +1461,7 @@ const
|
||||
mutexclpo : [po_external,po_assembler,po_interrupt,po_exports]
|
||||
),(
|
||||
idtok:_VIRTUAL;
|
||||
pd_flags : pd_interface+pd_object+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
handler : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_virtualmethod];
|
||||
@ -1478,7 +1470,7 @@ const
|
||||
mutexclpo : [po_external,po_interrupt,po_exports]
|
||||
),(
|
||||
idtok:_CPPDECL;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_cppdecl;
|
||||
pooption : [po_savestdregs];
|
||||
@ -1487,7 +1479,7 @@ const
|
||||
mutexclpo : [po_assembler,po_external,po_virtualmethod]
|
||||
),(
|
||||
idtok:_VARARGS;
|
||||
pd_flags : pd_interface+pd_implemen+pd_procvar;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_procvar];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_varargs];
|
||||
@ -1497,7 +1489,7 @@ const
|
||||
mutexclpo : [po_assembler,po_interrupt,po_leftright]
|
||||
),(
|
||||
idtok:_COMPILERPROC;
|
||||
pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
|
||||
handler : nil;
|
||||
pocall : pocall_compilerproc;
|
||||
pooption : [];
|
||||
@ -1522,7 +1514,7 @@ const
|
||||
end;
|
||||
|
||||
|
||||
function parse_proc_direc(pd:tabstractprocdef;var pdflags:word):boolean;
|
||||
function parse_proc_direc(pd:tabstractprocdef;var pdflags:tpdflags):boolean;
|
||||
{
|
||||
Parse the procedure directive, returns true if a correct directive is found
|
||||
}
|
||||
@ -1560,7 +1552,7 @@ const
|
||||
begin
|
||||
{ parsing a procvar type the name can be any
|
||||
next variable !! }
|
||||
if (pdflags and (pd_procvar or pd_object))=0 then
|
||||
if (pdflags * [pd_procvar,pd_object])=[] then
|
||||
Message1(parser_w_unknown_proc_directive_ignored,name);
|
||||
exit;
|
||||
end;
|
||||
@ -1592,19 +1584,19 @@ const
|
||||
|
||||
{ check if method and directive not for object, like public.
|
||||
This needs to be checked also for procvars }
|
||||
if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and
|
||||
if (pd_notobject in proc_direcdata[p].pd_flags) and
|
||||
(pd.owner.symtabletype=objectsymtable) then
|
||||
exit;
|
||||
|
||||
if pd.deftype=procdef then
|
||||
begin
|
||||
{ Check if the directive is only for objects }
|
||||
if ((proc_direcdata[p].pd_flags and pd_object)<>0) and
|
||||
if (pd_object in proc_direcdata[p].pd_flags) and
|
||||
not assigned(tprocdef(pd)._class) then
|
||||
exit;
|
||||
|
||||
{ check if method and directive not for interface }
|
||||
if ((proc_direcdata[p].pd_flags and pd_notobjintf)<>0) and
|
||||
if (pd_notobjintf in proc_direcdata[p].pd_flags) and
|
||||
is_interface(tprocdef(pd)._class) then
|
||||
exit;
|
||||
end;
|
||||
@ -1614,30 +1606,28 @@ const
|
||||
parse_proc_direc:=true;
|
||||
|
||||
{ Check the pd_flags if the directive should be allowed }
|
||||
if ((pdflags and pd_interface)<>0) and
|
||||
((proc_direcdata[p].pd_flags and pd_interface)=0) then
|
||||
if (pd_interface in pdflags) and
|
||||
not(pd_interface in proc_direcdata[p].pd_flags) then
|
||||
begin
|
||||
Message1(parser_e_proc_dir_not_allowed_in_interface,name);
|
||||
exit;
|
||||
end;
|
||||
if ((pdflags and pd_implemen)<>0) and
|
||||
((proc_direcdata[p].pd_flags and pd_implemen)=0) then
|
||||
if (pd_implemen in pdflags) and
|
||||
not(pd_implemen in proc_direcdata[p].pd_flags) then
|
||||
begin
|
||||
Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
|
||||
exit;
|
||||
end;
|
||||
if ((pdflags and pd_procvar)<>0) and
|
||||
((proc_direcdata[p].pd_flags and pd_procvar)=0) then
|
||||
if (pd_procvar in pdflags) and
|
||||
not(pd_procvar in proc_direcdata[p].pd_flags) then
|
||||
begin
|
||||
Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ Return the new pd_flags }
|
||||
if (proc_direcdata[p].pd_flags and pd_body)=0 then
|
||||
pdflags:=pdflags and (not pd_body);
|
||||
if (proc_direcdata[p].pd_flags and pd_global)<>0 then
|
||||
pdflags:=pdflags or pd_global;
|
||||
if not(pd_body in proc_direcdata[p].pd_flags) then
|
||||
exclude(pdflags,pd_body);
|
||||
|
||||
{ Add the correct flag }
|
||||
pd.procoptions:=pd.procoptions+proc_direcdata[p].pooption;
|
||||
@ -1826,7 +1816,7 @@ const
|
||||
|
||||
|
||||
|
||||
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:word);
|
||||
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
|
||||
{
|
||||
Parse the procedure directives. It does not matter if procedure directives
|
||||
are written using ;procdir; or ['procdir'] syntax.
|
||||
@ -1870,10 +1860,10 @@ const
|
||||
|
||||
procedure parse_var_proc_directives(sym:tsym);
|
||||
var
|
||||
pdflags : word;
|
||||
pdflags : tpdflags;
|
||||
pd : tabstractprocdef;
|
||||
begin
|
||||
pdflags:=pd_procvar;
|
||||
pdflags:=[pd_procvar];
|
||||
pd:=nil;
|
||||
case sym.typ of
|
||||
varsym :
|
||||
@ -1894,9 +1884,9 @@ const
|
||||
|
||||
procedure parse_object_proc_directives(pd:tabstractprocdef);
|
||||
var
|
||||
pdflags : word;
|
||||
pdflags : tpdflags;
|
||||
begin
|
||||
pdflags:=pd_object;
|
||||
pdflags:=[pd_object];
|
||||
parse_proc_directives(pd,pdflags);
|
||||
end;
|
||||
|
||||
@ -2173,7 +2163,10 @@ const
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.124 2003-05-15 18:58:53 peter
|
||||
Revision 1.125 2003-05-22 21:31:35 peter
|
||||
* defer codegeneration for nested procedures
|
||||
|
||||
Revision 1.124 2003/05/15 18:58:53 peter
|
||||
* removed selfpointer_offset, vmtpointer_offset
|
||||
* tvarsym.adjusted_address
|
||||
* address in localsymtable is now in the real direction
|
||||
|
||||
@ -725,6 +725,7 @@ implementation
|
||||
inc(ps.refs);
|
||||
symtablestack.insert(ps);
|
||||
pd:=tprocdef.create(main_program_level);
|
||||
include(pd.procoptions,po_public);
|
||||
pd.procsym:=ps;
|
||||
ps.addprocdef(pd);
|
||||
{ restore symtable }
|
||||
@ -799,7 +800,7 @@ implementation
|
||||
objectlibrary.getlabel(aktexitlabel);
|
||||
objectlibrary.getlabel(aktexit2label);
|
||||
include(current_procinfo.flags,pi_do_call);
|
||||
genentrycode(list,true,0,parasize,nostackframe,false);
|
||||
genentrycode(list,0,parasize,nostackframe,false);
|
||||
genexitcode(list,parasize,nostackframe,false);
|
||||
list.convert_registers;
|
||||
release_main_proc(pd);
|
||||
@ -844,18 +845,15 @@ implementation
|
||||
|
||||
if token=_ID then
|
||||
begin
|
||||
{ create filenames and unit name }
|
||||
{ create filenames and unit name }
|
||||
main_file := current_scanner.inputfile;
|
||||
while assigned(main_file.next) do
|
||||
main_file := main_file.next;
|
||||
|
||||
current_module.SetFileName(main_file.path^+main_file.name^,true);
|
||||
current_module.SetModuleName(orgpattern);
|
||||
|
||||
stringdispose(current_module.modulename);
|
||||
stringdispose(current_module.realmodulename);
|
||||
current_module.modulename:=stringdup(pattern);
|
||||
current_module.realmodulename:=stringdup(orgpattern);
|
||||
{ check for system unit }
|
||||
{ check for system unit }
|
||||
new(s2);
|
||||
s2^:=upper(SplitName(main_file.name^));
|
||||
if (cs_check_unit_name in aktglobalswitches) and
|
||||
@ -1040,7 +1038,9 @@ implementation
|
||||
{ Compile the unit }
|
||||
pd:=create_main_proc(current_module.modulename^+'_init',potype_unitinit,st);
|
||||
pd.aliasnames.insert('INIT$$'+current_module.modulename^);
|
||||
compile_proc_body(pd,true,false);
|
||||
tcgprocinfo(current_procinfo).parse_body;
|
||||
tcgprocinfo(current_procinfo).generate_code;
|
||||
tcgprocinfo(current_procinfo).resetprocdef;
|
||||
release_main_proc(pd);
|
||||
|
||||
{ if the unit contains ansi/widestrings, initialization and
|
||||
@ -1064,7 +1064,9 @@ implementation
|
||||
{ Compile the finalize }
|
||||
pd:=create_main_proc(current_module.modulename^+'_finalize',potype_unitfinalize,st);
|
||||
pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
|
||||
compile_proc_body(pd,true,false);
|
||||
tcgprocinfo(current_procinfo).parse_body;
|
||||
tcgprocinfo(current_procinfo).generate_code;
|
||||
tcgprocinfo(current_procinfo).resetprocdef;
|
||||
release_main_proc(pd);
|
||||
end
|
||||
else if force_init_final then
|
||||
@ -1352,7 +1354,9 @@ implementation
|
||||
PROCEDURE main(ArgC:Integer;ArgV,EnvP:ARRAY OF PChar):Integer;CDECL;
|
||||
So, all parameters are passerd into registers in sparc architecture.}
|
||||
{$ENDIF SPARC}
|
||||
compile_proc_body(pd,true,false);
|
||||
tcgprocinfo(current_procinfo).parse_body;
|
||||
tcgprocinfo(current_procinfo).generate_code;
|
||||
tcgprocinfo(current_procinfo).resetprocdef;
|
||||
release_main_proc(pd);
|
||||
|
||||
{ should we force unit initialization? }
|
||||
@ -1390,7 +1394,9 @@ So, all parameters are passerd into registers in sparc architecture.}
|
||||
{ Compile the finalize }
|
||||
pd:=create_main_proc(current_module.modulename^+'_finalize',potype_unitfinalize,st);
|
||||
pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
|
||||
compile_proc_body(pd,true,false);
|
||||
tcgprocinfo(current_procinfo).parse_body;
|
||||
tcgprocinfo(current_procinfo).generate_code;
|
||||
tcgprocinfo(current_procinfo).resetprocdef;
|
||||
release_main_proc(pd);
|
||||
end;
|
||||
|
||||
@ -1482,7 +1488,10 @@ So, all parameters are passerd into registers in sparc architecture.}
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.106 2003-05-15 18:58:53 peter
|
||||
Revision 1.107 2003-05-22 21:31:35 peter
|
||||
* defer codegeneration for nested procedures
|
||||
|
||||
Revision 1.106 2003/05/15 18:58:53 peter
|
||||
* removed selfpointer_offset, vmtpointer_offset
|
||||
* tvarsym.adjusted_address
|
||||
* address in localsymtable is now in the real direction
|
||||
|
||||
@ -27,12 +27,27 @@ unit psub;
|
||||
interface
|
||||
|
||||
uses
|
||||
symdef;
|
||||
cclasses,
|
||||
node,
|
||||
symdef,cgbase;
|
||||
|
||||
type
|
||||
tcgprocinfo=class(tprocinfo)
|
||||
{ code for the subroutine as tree }
|
||||
code : tnode;
|
||||
nestedprocs : tlinkedlist;
|
||||
constructor create(aparent:tprocinfo);override;
|
||||
destructor destroy;override;
|
||||
procedure generate_code;
|
||||
procedure resetprocdef;
|
||||
procedure add_to_symtablestack;
|
||||
procedure remove_from_symtablestack;
|
||||
procedure parse_body;
|
||||
end;
|
||||
|
||||
|
||||
procedure printnode_reset;
|
||||
|
||||
procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
|
||||
|
||||
{ reads the declaration blocks }
|
||||
procedure read_declarations(islibrary : boolean);
|
||||
|
||||
@ -44,7 +59,7 @@ implementation
|
||||
|
||||
uses
|
||||
{ common }
|
||||
cutils,cclasses,
|
||||
cutils,
|
||||
{ global }
|
||||
globtype,globals,tokens,verbose,comphook,
|
||||
systems,
|
||||
@ -55,7 +70,6 @@ implementation
|
||||
paramgr,
|
||||
ppu,fmodule,
|
||||
{ pass 1 }
|
||||
node,
|
||||
nutils,nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem,
|
||||
pass_1,
|
||||
{$ifdef state_tracking}
|
||||
@ -69,7 +83,7 @@ implementation
|
||||
scanner,
|
||||
pbase,pstatmnt,pdecl,pdecsub,pexports,
|
||||
{ codegen }
|
||||
tgobj,cgbase,rgobj,rgcpu,
|
||||
tgobj,rgobj,
|
||||
ncgutil
|
||||
{$ifndef NOOPT}
|
||||
{$ifdef i386}
|
||||
@ -80,7 +94,6 @@ implementation
|
||||
{$endif}
|
||||
;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
PROCEDURE/FUNCTION BODY PARSING
|
||||
****************************************************************************}
|
||||
@ -515,251 +528,204 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
|
||||
{
|
||||
Compile the body of a procedure
|
||||
}
|
||||
var
|
||||
oldexitlabel,oldexit2label : tasmlabel;
|
||||
oldquickexitlabel:tasmlabel;
|
||||
_class,hp:tobjectdef;
|
||||
{ switches can change inside the procedure }
|
||||
entryswitches, exitswitches : tlocalswitches;
|
||||
oldaktmaxfpuregisters,localmaxfpuregisters : longint;
|
||||
{ code for the subroutine as tree }
|
||||
code:tnode;
|
||||
{ true when no stackframe is required }
|
||||
nostackframe:boolean;
|
||||
{ number of bytes which have to be cleared by RET }
|
||||
parasize:longint;
|
||||
{ filepositions }
|
||||
entrypos,
|
||||
savepos,
|
||||
exitpos : tfileposinfo;
|
||||
oldprocdef : tprocdef;
|
||||
{****************************************************************************
|
||||
TCGProcInfo
|
||||
****************************************************************************}
|
||||
|
||||
constructor tcgprocinfo.create(aparent:tprocinfo);
|
||||
begin
|
||||
oldprocdef:=current_procdef;
|
||||
current_procdef:=pd;
|
||||
inherited Create(aparent);
|
||||
nestedprocs:=tlinkedlist.create;
|
||||
end;
|
||||
|
||||
{ calculate the lexical level }
|
||||
if current_procdef.parast.symtablelevel>maxnesting then
|
||||
Message(parser_e_too_much_lexlevel);
|
||||
|
||||
{ static is also important for local procedures !! }
|
||||
if (po_staticmethod in current_procdef.procoptions) then
|
||||
allow_only_static:=true
|
||||
else if (current_procdef.parast.symtablelevel=normal_function_level) then
|
||||
allow_only_static:=false;
|
||||
destructor tcgprocinfo.destroy;
|
||||
begin
|
||||
inherited destroy;
|
||||
nestedprocs.free;
|
||||
end;
|
||||
|
||||
{ save old labels }
|
||||
oldexitlabel:=aktexitlabel;
|
||||
oldexit2label:=aktexit2label;
|
||||
oldquickexitlabel:=quickexitlabel;
|
||||
{ get new labels }
|
||||
objectlibrary.getlabel(aktexitlabel);
|
||||
objectlibrary.getlabel(aktexit2label);
|
||||
{ exit for fail in constructors }
|
||||
if (current_procdef.proctypeoption=potype_constructor) then
|
||||
objectlibrary.getlabel(quickexitlabel);
|
||||
{ reset break and continue labels }
|
||||
block_type:=bt_general;
|
||||
aktbreaklabel:=nil;
|
||||
aktcontinuelabel:=nil;
|
||||
{$ifdef state_tracking}
|
||||
{ aktstate:=Tstate_storage.create;}
|
||||
{$endif state_tracking}
|
||||
|
||||
{ insert symtables for the class, but only if it is no nested function }
|
||||
if assigned(current_procdef._class) and not(parent_has_class) then
|
||||
begin
|
||||
{ insert them in the reverse order }
|
||||
hp:=nil;
|
||||
repeat
|
||||
_class:=current_procdef._class;
|
||||
while _class.childof<>hp do
|
||||
_class:=_class.childof;
|
||||
hp:=_class;
|
||||
_class.symtable.next:=symtablestack;
|
||||
symtablestack:=_class.symtable;
|
||||
until hp=current_procdef._class;
|
||||
end;
|
||||
procedure tcgprocinfo.generate_code;
|
||||
var
|
||||
oldprocdef : tprocdef;
|
||||
oldprocinfo : tprocinfo;
|
||||
oldexitlabel,
|
||||
oldexit2label : tasmlabel;
|
||||
oldaktmaxfpuregisters : longint;
|
||||
oldfilepos : tfileposinfo;
|
||||
{ true when no stackframe is required }
|
||||
nostackframe:boolean;
|
||||
{ number of bytes which have to be cleared by RET }
|
||||
parasize:longint;
|
||||
begin
|
||||
{ the initialization procedure can be empty, then we
|
||||
don't need to generate anything. When it was an empty
|
||||
procedure there would be at least a blocknode }
|
||||
if not assigned(code) then
|
||||
exit;
|
||||
|
||||
{ insert parasymtable in symtablestack when parsing
|
||||
a function }
|
||||
if current_procdef.parast.symtablelevel>=normal_function_level then
|
||||
begin
|
||||
current_procdef.parast.next:=symtablestack;
|
||||
symtablestack:=current_procdef.parast;
|
||||
end;
|
||||
{ create a local symbol table for this routine }
|
||||
if not assigned(current_procdef.localst) then
|
||||
current_procdef.insert_localst;
|
||||
{ insert localsymtable in symtablestack}
|
||||
current_procdef.localst.next:=symtablestack;
|
||||
symtablestack:=current_procdef.localst;
|
||||
{ constant symbols are inserted in this symboltable }
|
||||
constsymtable:=symtablestack;
|
||||
oldprocinfo:=current_procinfo;
|
||||
oldprocdef:=current_procdef;
|
||||
oldfilepos:=aktfilepos;
|
||||
oldaktmaxfpuregisters:=aktmaxfpuregisters;
|
||||
|
||||
{ reset the temporary memory }
|
||||
rg.cleartempgen;
|
||||
rg.usedinproc:=[];
|
||||
rg.usedbyproc:=[];
|
||||
current_procinfo:=self;
|
||||
current_procdef:=procdef;
|
||||
|
||||
{ save entry info }
|
||||
entrypos:=aktfilepos;
|
||||
entryswitches:=aktlocalswitches;
|
||||
localmaxfpuregisters:=aktmaxfpuregisters;
|
||||
{ parse the code ... }
|
||||
code:=block(current_module.islibrary);
|
||||
{ get a better entry point }
|
||||
if assigned(code) then
|
||||
entrypos:=code.fileinfo;
|
||||
{ save exit info }
|
||||
exitswitches:=aktlocalswitches;
|
||||
exitpos:=last_endtoken_filepos;
|
||||
{ save current filepos }
|
||||
savepos:=aktfilepos;
|
||||
{ add implicit entry and exit code }
|
||||
if assigned(code) then
|
||||
add_entry_exit_code(code,entrypos,exitpos);
|
||||
{ store a copy of the original tree for inline, for
|
||||
normal procedures only store a reference to the
|
||||
current tree }
|
||||
if (current_procdef.proccalloption=pocall_inline) then
|
||||
current_procdef.code:=code.getcopy
|
||||
else
|
||||
current_procdef.code:=code;
|
||||
{ save old labels }
|
||||
oldexitlabel:=aktexitlabel;
|
||||
oldexit2label:=aktexit2label;
|
||||
{ get new labels }
|
||||
objectlibrary.getlabel(aktexitlabel);
|
||||
objectlibrary.getlabel(aktexit2label);
|
||||
aktbreaklabel:=nil;
|
||||
aktcontinuelabel:=nil;
|
||||
|
||||
{When we are called to compile the body of a unit, aktprocsym should
|
||||
point to the unit initialization. If the unit has no initialization,
|
||||
aktprocsym=nil. But in that case code=nil. Thus we should check for
|
||||
code=nil, when we use aktprocsym.}
|
||||
{ add parast/localst to symtablestack }
|
||||
add_to_symtablestack;
|
||||
|
||||
{ set the start offset to the start of the temp area in the stack }
|
||||
tg.setfirsttemp(current_procinfo.firsttemp_offset);
|
||||
{ reset the temporary memory }
|
||||
rg.cleartempgen;
|
||||
rg.usedinproc:=[];
|
||||
rg.usedbyproc:=[];
|
||||
|
||||
{ ... and generate assembler }
|
||||
{ but set the right switches for entry !! }
|
||||
aktlocalswitches:=entryswitches;
|
||||
oldaktmaxfpuregisters:=aktmaxfpuregisters;
|
||||
aktmaxfpuregisters:=localmaxfpuregisters;
|
||||
if assigned(code) then
|
||||
begin
|
||||
{ the procedure is now defined }
|
||||
current_procdef.forwarddef:=false;
|
||||
{ set the start offset to the start of the temp area in the stack }
|
||||
tg.setfirsttemp(current_procinfo.firsttemp_offset);
|
||||
|
||||
if paraprintnodetree=1 then
|
||||
printnode_procdef(current_procdef);
|
||||
generatecode(code);
|
||||
|
||||
{ only generate the code if no type errors are found, else
|
||||
finish at least the type checking pass }
|
||||
{$ifndef NOPASS2}
|
||||
if (status.errorcount=0) then
|
||||
begin
|
||||
generatecode(code);
|
||||
{ first generate entry code with the correct position and switches }
|
||||
aktfilepos:=entrypos;
|
||||
aktlocalswitches:=entryswitches;
|
||||
genentrycode(current_procinfo.aktentrycode,make_global,0,parasize,nostackframe,false);
|
||||
{ first generate entry code with the correct position and switches }
|
||||
aktfilepos:=current_procinfo.entrypos;
|
||||
aktlocalswitches:=current_procinfo.entryswitches;
|
||||
genentrycode(current_procinfo.aktentrycode,0,parasize,nostackframe,false);
|
||||
|
||||
{ FPC_POPADDRSTACK destroys all registers (JM) }
|
||||
if (pi_needs_implicit_finally in current_procinfo.flags) or
|
||||
(pi_uses_exceptions in current_procinfo.flags) then
|
||||
begin
|
||||
rg.usedinproc := ALL_REGISTERS;
|
||||
end;
|
||||
{ now generate exit code with the correct position and switches }
|
||||
aktfilepos:=current_procinfo.exitpos;
|
||||
aktlocalswitches:=current_procinfo.exitswitches;
|
||||
genexitcode(current_procinfo.aktexitcode,parasize,nostackframe,false);
|
||||
|
||||
{ now generate exit code with the correct position and switches }
|
||||
aktfilepos:=exitpos;
|
||||
aktlocalswitches:=exitswitches;
|
||||
genexitcode(current_procinfo.aktexitcode,parasize,nostackframe,false);
|
||||
|
||||
{ now all the registers used are known }
|
||||
current_procdef.usedintregisters:=rg.usedintinproc;
|
||||
current_procdef.usedotherregisters:=rg.usedinproc;
|
||||
current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
|
||||
current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
|
||||
{ now all the registers used are known }
|
||||
current_procdef.usedintregisters:=rg.usedintinproc;
|
||||
current_procdef.usedotherregisters:=rg.usedinproc;
|
||||
current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
|
||||
current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
|
||||
{$ifdef newra}
|
||||
{ rg.writegraph;}
|
||||
{$endif}
|
||||
if not(cs_no_regalloc in aktglobalswitches) then
|
||||
begin
|
||||
if not(cs_no_regalloc in aktglobalswitches) then
|
||||
begin
|
||||
{$ifdef newra}
|
||||
{Do register allocation.}
|
||||
repeat
|
||||
rg.prepare_colouring;
|
||||
rg.colour_registers;
|
||||
rg.epilogue_colouring;
|
||||
{Are there spilled registers? We cannot do that yet.}
|
||||
if rg.spillednodes<>'' then
|
||||
internalerror(200304221);
|
||||
{if not try_fast_spill(rg) then
|
||||
slow_spill(rg);
|
||||
}
|
||||
until rg.spillednodes='';
|
||||
current_procinfo.aktproccode.translate_registers(rg.colour);
|
||||
current_procinfo.aktproccode.convert_registers;
|
||||
{Do register allocation.}
|
||||
repeat
|
||||
rg.prepare_colouring;
|
||||
rg.colour_registers;
|
||||
rg.epilogue_colouring;
|
||||
{Are there spilled registers? We cannot do that yet.}
|
||||
if rg.spillednodes<>'' then
|
||||
internalerror(200304221);
|
||||
{if not try_fast_spill(rg) then
|
||||
slow_spill(rg);
|
||||
}
|
||||
until rg.spillednodes='';
|
||||
current_procinfo.aktproccode.translate_registers(rg.colour);
|
||||
current_procinfo.aktproccode.convert_registers;
|
||||
{$else newra}
|
||||
current_procinfo.aktproccode.convert_registers;
|
||||
current_procinfo.aktproccode.convert_registers;
|
||||
{$ifndef NoOpt}
|
||||
if (cs_optimize in aktglobalswitches) and
|
||||
{ do not optimize pure assembler procedures }
|
||||
not(pi_is_assembler in current_procinfo.flags) then
|
||||
optimize(current_procinfo.aktproccode);
|
||||
if (cs_optimize in aktglobalswitches) and
|
||||
{ do not optimize pure assembler procedures }
|
||||
not(pi_is_assembler in current_procinfo.flags) then
|
||||
optimize(current_procinfo.aktproccode);
|
||||
{$endif NoOpt}
|
||||
{$endif newra}
|
||||
end;
|
||||
{ save local data (casetable) also in the same file }
|
||||
if assigned(current_procinfo.aktlocaldata) and
|
||||
(not current_procinfo.aktlocaldata.empty) then
|
||||
begin
|
||||
current_procinfo.aktproccode.concat(Tai_section.Create(sec_data));
|
||||
current_procinfo.aktproccode.concatlist(current_procinfo.aktlocaldata);
|
||||
current_procinfo.aktproccode.concat(Tai_section.Create(sec_code));
|
||||
end;
|
||||
|
||||
{ add the procedure to the codesegment }
|
||||
if (cs_create_smart in aktmoduleswitches) then
|
||||
codeSegment.concat(Tai_cut.Create);
|
||||
codeSegment.concatlist(current_procinfo.aktproccode);
|
||||
end
|
||||
else
|
||||
do_resulttypepass(code);
|
||||
{$else NOPASS2}
|
||||
do_resulttypepass(code);
|
||||
{$endif NOPASS2}
|
||||
end;
|
||||
|
||||
{ ... remove symbol tables }
|
||||
if current_procdef.parast.symtablelevel>=normal_function_level then
|
||||
symtablestack:=symtablestack.next.next
|
||||
else
|
||||
symtablestack:=symtablestack.next;
|
||||
{ save local data (casetable) also in the same file }
|
||||
if assigned(current_procinfo.aktlocaldata) and
|
||||
(not current_procinfo.aktlocaldata.empty) then
|
||||
begin
|
||||
current_procinfo.aktproccode.concat(Tai_section.Create(sec_data));
|
||||
current_procinfo.aktproccode.concatlist(current_procinfo.aktlocaldata);
|
||||
current_procinfo.aktproccode.concat(Tai_section.Create(sec_code));
|
||||
end;
|
||||
|
||||
{ ... check for unused symbols }
|
||||
{ but only if there is no asm block }
|
||||
if assigned(code) then
|
||||
begin
|
||||
if (Errorcount=0) then
|
||||
begin
|
||||
{ check if forwards are resolved }
|
||||
tstoredsymtable(current_procdef.localst).check_forwards;
|
||||
{ check if all labels are used }
|
||||
tstoredsymtable(current_procdef.localst).checklabels;
|
||||
{ remove cross unit overloads }
|
||||
tstoredsymtable(current_procdef.localst).unchain_overloaded;
|
||||
end;
|
||||
if not(pi_uses_asm in current_procinfo.flags) then
|
||||
begin
|
||||
{ not for unit init, becuase the var can be used in finalize,
|
||||
it will be done in proc_unit }
|
||||
if not(current_procdef.proctypeoption
|
||||
in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
|
||||
tstoredsymtable(current_procdef.localst).allsymbolsused;
|
||||
tstoredsymtable(current_procdef.parast).allsymbolsused;
|
||||
end;
|
||||
end;
|
||||
{ add the procedure to the codesegment }
|
||||
if (cs_create_smart in aktmoduleswitches) then
|
||||
codeSegment.concat(Tai_cut.Create);
|
||||
codeSegment.concatlist(current_procinfo.aktproccode);
|
||||
|
||||
{ all registers can be used again }
|
||||
rg.resetusableregisters;
|
||||
{ only now we can remove the temps }
|
||||
tg.resettempgen;
|
||||
|
||||
{ restore symtablestack }
|
||||
remove_from_symtablestack;
|
||||
|
||||
{ restore labels }
|
||||
aktexitlabel:=oldexitlabel;
|
||||
aktexit2label:=oldexit2label;
|
||||
|
||||
{ restore }
|
||||
aktmaxfpuregisters:=oldaktmaxfpuregisters;
|
||||
aktfilepos:=oldfilepos;
|
||||
current_procdef:=oldprocdef;
|
||||
current_procinfo:=oldprocinfo;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgprocinfo.add_to_symtablestack;
|
||||
var
|
||||
_class,hp : tobjectdef;
|
||||
begin
|
||||
{ insert symtables for the class, but only if it is no nested function }
|
||||
if assigned(procdef._class) and
|
||||
not(assigned(parent) and
|
||||
assigned(parent.procdef) and
|
||||
assigned(parent.procdef._class)) then
|
||||
begin
|
||||
{ insert them in the reverse order }
|
||||
hp:=nil;
|
||||
repeat
|
||||
_class:=procdef._class;
|
||||
while _class.childof<>hp do
|
||||
_class:=_class.childof;
|
||||
hp:=_class;
|
||||
_class.symtable.next:=symtablestack;
|
||||
symtablestack:=_class.symtable;
|
||||
until hp=procdef._class;
|
||||
end;
|
||||
|
||||
{ insert parasymtable in symtablestack when parsing
|
||||
a function }
|
||||
if procdef.parast.symtablelevel>=normal_function_level then
|
||||
begin
|
||||
procdef.parast.next:=symtablestack;
|
||||
symtablestack:=procdef.parast;
|
||||
end;
|
||||
|
||||
procdef.localst.next:=symtablestack;
|
||||
symtablestack:=procdef.localst;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgprocinfo.remove_from_symtablestack;
|
||||
begin
|
||||
{ remove localst/parast }
|
||||
if procdef.parast.symtablelevel>=normal_function_level then
|
||||
symtablestack:=symtablestack.next.next
|
||||
else
|
||||
symtablestack:=symtablestack.next;
|
||||
|
||||
{ remove class member symbol tables }
|
||||
while symtablestack.symtabletype=objectsymtable do
|
||||
symtablestack:=symtablestack.next;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgprocinfo.resetprocdef;
|
||||
begin
|
||||
{ the local symtables can be deleted, but the parast }
|
||||
{ doesn't, (checking definitons when calling a }
|
||||
{ function }
|
||||
@ -768,49 +734,133 @@ implementation
|
||||
{ so no dispose here !! }
|
||||
if assigned(code) and
|
||||
not(cs_browser in aktmoduleswitches) and
|
||||
(current_procdef.proccalloption<>pocall_inline) then
|
||||
(procdef.proccalloption<>pocall_inline) then
|
||||
begin
|
||||
if current_procdef.parast.symtablelevel>=normal_function_level then
|
||||
current_procdef.localst.free;
|
||||
current_procdef.localst:=nil;
|
||||
if procdef.parast.symtablelevel>=normal_function_level then
|
||||
procdef.localst.free;
|
||||
procdef.localst:=nil;
|
||||
end;
|
||||
|
||||
{ all registers can be used again }
|
||||
rg.resetusableregisters;
|
||||
{ only now we can remove the temps }
|
||||
tg.resettempgen;
|
||||
|
||||
{ remove code tree, if not inline procedure }
|
||||
if assigned(code) then
|
||||
begin
|
||||
{ the inline procedure has already got a copy of the tree
|
||||
stored in current_procdef.code }
|
||||
code.free;
|
||||
if (current_procdef.proccalloption<>pocall_inline) then
|
||||
current_procdef.code:=nil;
|
||||
if (procdef.proccalloption<>pocall_inline) then
|
||||
procdef.code:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ remove class member symbol tables }
|
||||
while symtablestack.symtabletype=objectsymtable do
|
||||
symtablestack:=symtablestack.next;
|
||||
|
||||
aktmaxfpuregisters:=oldaktmaxfpuregisters;
|
||||
procedure tcgprocinfo.parse_body;
|
||||
var
|
||||
oldprocdef : tprocdef;
|
||||
oldprocinfo : tprocinfo;
|
||||
begin
|
||||
oldprocdef:=current_procdef;
|
||||
oldprocinfo:=current_procinfo;
|
||||
|
||||
current_procinfo:=self;
|
||||
current_procdef:=procdef;
|
||||
|
||||
{ calculate the lexical level }
|
||||
if procdef.parast.symtablelevel>maxnesting then
|
||||
Message(parser_e_too_much_lexlevel);
|
||||
|
||||
{ static is also important for local procedures !! }
|
||||
if (po_staticmethod in procdef.procoptions) then
|
||||
allow_only_static:=true
|
||||
else if (procdef.parast.symtablelevel=normal_function_level) then
|
||||
allow_only_static:=false;
|
||||
|
||||
{ reset break and continue labels }
|
||||
block_type:=bt_general;
|
||||
{$ifdef state_tracking}
|
||||
{ aktstate:=Tstate_storage.create;}
|
||||
{$endif state_tracking}
|
||||
|
||||
{ create a local symbol table for this routine }
|
||||
if not assigned(procdef.localst) then
|
||||
procdef.insert_localst;
|
||||
|
||||
{ add parast/localst to symtablestack }
|
||||
add_to_symtablestack;
|
||||
|
||||
{ constant symbols are inserted in this symboltable }
|
||||
constsymtable:=symtablestack;
|
||||
|
||||
{ save entry info }
|
||||
entrypos:=aktfilepos;
|
||||
entryswitches:=aktlocalswitches;
|
||||
|
||||
{ parse the code ... }
|
||||
code:=block(current_module.islibrary);
|
||||
|
||||
{ save exit info }
|
||||
exitswitches:=aktlocalswitches;
|
||||
exitpos:=last_endtoken_filepos;
|
||||
|
||||
if assigned(code) then
|
||||
begin
|
||||
{ get a better entry point }
|
||||
entrypos:=code.fileinfo;
|
||||
|
||||
{ the procedure is now defined }
|
||||
procdef.forwarddef:=false;
|
||||
|
||||
{ add implicit entry and exit code }
|
||||
add_entry_exit_code(code,entrypos,exitpos);
|
||||
|
||||
if (Errorcount=0) then
|
||||
begin
|
||||
{ check if forwards are resolved }
|
||||
tstoredsymtable(procdef.localst).check_forwards;
|
||||
{ check if all labels are used }
|
||||
tstoredsymtable(procdef.localst).checklabels;
|
||||
{ remove cross unit overloads }
|
||||
tstoredsymtable(procdef.localst).unchain_overloaded;
|
||||
end;
|
||||
|
||||
{ check for unused symbols, but only if there is no asm block }
|
||||
if not(pi_uses_asm in flags) then
|
||||
begin
|
||||
{ not for unit init, becuase the var can be used in finalize,
|
||||
it will be done in proc_unit }
|
||||
if not(procdef.proctypeoption in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
|
||||
tstoredsymtable(procdef.localst).allsymbolsused;
|
||||
tstoredsymtable(procdef.parast).allsymbolsused;
|
||||
end;
|
||||
|
||||
{ Finish type checking pass }
|
||||
do_resulttypepass(code);
|
||||
|
||||
{ Print the node to tree.log }
|
||||
if paraprintnodetree=1 then
|
||||
printnode_procdef(procdef);
|
||||
end;
|
||||
|
||||
{ store a copy of the original tree for inline, for
|
||||
normal procedures only store a reference to the
|
||||
current tree }
|
||||
if (procdef.proccalloption=pocall_inline) then
|
||||
procdef.code:=code.getcopy
|
||||
else
|
||||
procdef.code:=code;
|
||||
|
||||
{ ... remove symbol tables }
|
||||
remove_from_symtablestack;
|
||||
|
||||
{$ifdef state_tracking}
|
||||
{ aktstate.destroy;}
|
||||
{$endif state_tracking}
|
||||
{ restore filepos, the switches are already set }
|
||||
aktfilepos:=savepos;
|
||||
{ restore labels }
|
||||
aktexitlabel:=oldexitlabel;
|
||||
aktexit2label:=oldexit2label;
|
||||
quickexitlabel:=oldquickexitlabel;
|
||||
|
||||
{ reset to normal non static function }
|
||||
if (current_procdef.parast.symtablelevel=normal_function_level) then
|
||||
allow_only_static:=false;
|
||||
|
||||
current_procdef:=oldprocdef;
|
||||
current_procinfo:=oldprocinfo;
|
||||
end;
|
||||
|
||||
|
||||
@ -852,14 +902,32 @@ implementation
|
||||
Parses the procedure directives, then parses the procedure body, then
|
||||
generates the code for it
|
||||
}
|
||||
|
||||
procedure do_generate_code(pi:tcgprocinfo);
|
||||
var
|
||||
hpi : tcgprocinfo;
|
||||
begin
|
||||
{ process nested procs first }
|
||||
hpi:=tcgprocinfo(pi.nestedprocs.first);
|
||||
while assigned(hpi) do
|
||||
begin
|
||||
do_generate_code(hpi);
|
||||
hpi:=tcgprocinfo(hpi.next);
|
||||
end;
|
||||
{ generate code for this procedure }
|
||||
pi.generate_code;
|
||||
pi.resetprocdef;
|
||||
end;
|
||||
|
||||
var
|
||||
oldprocdef : tprocdef;
|
||||
old_current_procinfo : tprocinfo;
|
||||
oldconstsymtable : tsymtable;
|
||||
oldselftokenmode,
|
||||
oldfailtokenmode : tmodeswitch;
|
||||
pdflags : word;
|
||||
pdflags : tpdflags;
|
||||
pd : tprocdef;
|
||||
isnestedproc : boolean;
|
||||
begin
|
||||
{ save old state }
|
||||
oldprocdef:=current_procdef;
|
||||
@ -869,18 +937,14 @@ implementation
|
||||
{ reset current_procdef to nil to be sure that nothing is writing
|
||||
to an other procdef }
|
||||
current_procdef:=nil;
|
||||
|
||||
{ create a new procedure }
|
||||
current_procinfo:=cprocinfo.create(old_current_procinfo);
|
||||
current_module.procinfo:=current_procinfo;
|
||||
current_procinfo:=nil;
|
||||
|
||||
{ parse procedure declaration }
|
||||
if assigned(current_procinfo.parent) and
|
||||
assigned(current_procinfo.parent.procdef) then
|
||||
pd:=parse_proc_dec(current_procinfo.parent.procdef._class)
|
||||
if assigned(old_current_procinfo) and
|
||||
assigned(old_current_procinfo.procdef) then
|
||||
pd:=parse_proc_dec(old_current_procinfo.procdef._class)
|
||||
else
|
||||
pd:=parse_proc_dec(nil);
|
||||
current_procinfo.procdef:=pd;
|
||||
|
||||
{ set the default function options }
|
||||
if parse_only then
|
||||
@ -889,15 +953,17 @@ implementation
|
||||
{ set also the interface flag, for better error message when the
|
||||
implementation doesn't much this header }
|
||||
pd.interfacedef:=true;
|
||||
pdflags:=pd_interface;
|
||||
include(pd.procoptions,po_public);
|
||||
pdflags:=[pd_interface];
|
||||
end
|
||||
else
|
||||
begin
|
||||
pdflags:=pd_body;
|
||||
pdflags:=[pd_body];
|
||||
if (not current_module.in_interface) then
|
||||
pdflags:=pdflags or pd_implemen;
|
||||
if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
|
||||
pdflags:=pdflags or pd_global;
|
||||
include(pdflags,pd_implemen);
|
||||
if (not current_module.is_unit) or
|
||||
(cs_create_smart in aktmoduleswitches) then
|
||||
include(pd.procoptions,po_public);
|
||||
pd.forwarddef:=false;
|
||||
end;
|
||||
|
||||
@ -918,7 +984,7 @@ implementation
|
||||
begin
|
||||
{ A method must be forward defined (in the object declaration) }
|
||||
if assigned(pd._class) and
|
||||
(not assigned(current_procinfo.parent.procdef._class)) then
|
||||
(not assigned(old_current_procinfo.procdef._class)) then
|
||||
begin
|
||||
Message1(parser_e_header_dont_match_any_member,pd.fullprocname(false));
|
||||
tprocsym(pd.procsym).write_parameter_lists(pd);
|
||||
@ -941,79 +1007,81 @@ implementation
|
||||
begin
|
||||
{ check the global flag, for delphi this is not
|
||||
required }
|
||||
if not(m_delphi in aktmodeswitches) and
|
||||
(pi_is_global in current_procinfo.flags) then
|
||||
Message(parser_e_overloaded_must_be_all_global);
|
||||
{if not(m_delphi in aktmodeswitches) and
|
||||
not(pd.procsym.owner.symtabletype=globalsymtable) then
|
||||
Message(parser_e_overloaded_must_be_all_global);}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ update procinfo, because the procdef can be
|
||||
changed by check_identical_proc (PFV) }
|
||||
current_procinfo.procdef:=pd;
|
||||
|
||||
{ compile procedure when a body is needed }
|
||||
if (pdflags and pd_body)<>0 then
|
||||
begin
|
||||
Message1(parser_d_procedure_start,pd.fullprocname(false));
|
||||
pd.aliasnames.insert(pd.mangledname);
|
||||
if (pd_body in pdflags) then
|
||||
begin
|
||||
Message1(parser_d_procedure_start,pd.fullprocname(false));
|
||||
|
||||
{ Insert result variables in the localst }
|
||||
insert_funcret_local(pd);
|
||||
{ create a new procedure }
|
||||
current_procinfo:=cprocinfo.create(old_current_procinfo);
|
||||
current_module.procinfo:=current_procinfo;
|
||||
current_procinfo.procdef:=pd;
|
||||
isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level);
|
||||
|
||||
{ Insert local copies for value para }
|
||||
pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
|
||||
{ Insert mangledname }
|
||||
pd.aliasnames.insert(pd.mangledname);
|
||||
|
||||
{ Insert result variables in the localst }
|
||||
insert_funcret_local(pd);
|
||||
|
||||
{ Insert local copies for value para }
|
||||
pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
|
||||
|
||||
{ Update parameter information }
|
||||
current_procinfo.allocate_implicit_parameter;
|
||||
{$ifdef i386}
|
||||
{ add implicit pushes for interrupt routines }
|
||||
if (po_interrupt in pd.procoptions) then
|
||||
current_procinfo.allocate_interrupt_stackframe;
|
||||
{ add implicit pushes for interrupt routines }
|
||||
if (po_interrupt in pd.procoptions) then
|
||||
current_procinfo.allocate_interrupt_stackframe;
|
||||
{$endif i386}
|
||||
|
||||
{$ifdef powerpc}
|
||||
{ temp hack for nested procedures on ppc }
|
||||
{ Calculate offsets }
|
||||
current_procinfo.after_header;
|
||||
|
||||
{ Calculate offsets }
|
||||
current_procinfo.after_header;
|
||||
{ set _FAIL as keyword if constructor }
|
||||
if (pd.proctypeoption=potype_constructor) then
|
||||
begin
|
||||
oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
|
||||
tokeninfo^[_FAIL].keyword:=m_all;
|
||||
end;
|
||||
{ set _SELF as keyword if methods }
|
||||
if assigned(pd._class) then
|
||||
begin
|
||||
oldselftokenmode:=tokeninfo^[_SELF].keyword;
|
||||
tokeninfo^[_SELF].keyword:=m_all;
|
||||
end;
|
||||
|
||||
{ Update parameter information }
|
||||
current_procinfo.allocate_implicit_parameter;
|
||||
{$else powerpc}
|
||||
{ Update parameter information }
|
||||
current_procinfo.allocate_implicit_parameter;
|
||||
tcgprocinfo(current_procinfo).parse_body;
|
||||
|
||||
{ Calculate offsets }
|
||||
current_procinfo.after_header;
|
||||
{$endif powerpc}
|
||||
{ When it's a nested procedure then defer the code generation,
|
||||
when back at normal function level then generate the code
|
||||
for all defered nested procedures and the current procedure }
|
||||
if isnestedproc then
|
||||
tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
|
||||
else
|
||||
do_generate_code(tcgprocinfo(current_procinfo));
|
||||
|
||||
{ set _FAIL as keyword if constructor }
|
||||
if (pd.proctypeoption=potype_constructor) then
|
||||
begin
|
||||
oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
|
||||
tokeninfo^[_FAIL].keyword:=m_all;
|
||||
end;
|
||||
{ set _SELF as keyword if methods }
|
||||
if assigned(pd._class) then
|
||||
begin
|
||||
oldselftokenmode:=tokeninfo^[_SELF].keyword;
|
||||
tokeninfo^[_SELF].keyword:=m_all;
|
||||
end;
|
||||
{ reset _FAIL as _SELF normal }
|
||||
if (pd.proctypeoption=potype_constructor) then
|
||||
tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
|
||||
if assigned(pd._class) then
|
||||
tokeninfo^[_SELF].keyword:=oldselftokenmode;
|
||||
consume(_SEMICOLON);
|
||||
|
||||
compile_proc_body(pd,((pdflags and pd_global)<>0),assigned(current_procinfo.parent.procdef._class));
|
||||
|
||||
{ reset _FAIL as _SELF normal }
|
||||
if (pd.proctypeoption=potype_constructor) then
|
||||
tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
|
||||
if assigned(pd._class) then
|
||||
tokeninfo^[_SELF].keyword:=oldselftokenmode;
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
|
||||
{ release procinfo }
|
||||
if tprocinfo(current_module.procinfo)<>current_procinfo then
|
||||
internalerror(200304274);
|
||||
current_module.procinfo:=current_procinfo.parent;
|
||||
current_procinfo.free;
|
||||
{ release procinfo }
|
||||
if tprocinfo(current_module.procinfo)<>current_procinfo then
|
||||
internalerror(200304274);
|
||||
current_module.procinfo:=current_procinfo.parent;
|
||||
if not isnestedproc then
|
||||
current_procinfo.free;
|
||||
end;
|
||||
|
||||
{ Restore old state }
|
||||
constsymtable:=oldconstsymtable;
|
||||
@ -1138,10 +1206,16 @@ implementation
|
||||
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
cprocinfo:=tcgprocinfo;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.114 2003-05-16 20:00:39 jonas
|
||||
Revision 1.115 2003-05-22 21:31:35 peter
|
||||
* defer codegeneration for nested procedures
|
||||
|
||||
Revision 1.114 2003/05/16 20:00:39 jonas
|
||||
* powerpc nested procedure fixes, should work completely now if all
|
||||
local variables of the parent procedure are declared before the
|
||||
nested procedures are declared
|
||||
|
||||
@ -194,7 +194,8 @@ type
|
||||
po_leftright, { push arguments from left to right }
|
||||
po_clearstack, { caller clears the stack }
|
||||
po_internconst, { procedure has constant evaluator intern }
|
||||
po_addressonly { flag that only the address of a method is returned and not a full methodpointer }
|
||||
po_addressonly, { flag that only the address of a method is returned and not a full methodpointer }
|
||||
po_public { procedure is exported }
|
||||
);
|
||||
tprocoptions=set of tprocoption;
|
||||
|
||||
@ -351,7 +352,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.55 2003-05-15 21:10:32 peter
|
||||
Revision 1.56 2003-05-22 21:31:35 peter
|
||||
* defer codegeneration for nested procedures
|
||||
|
||||
Revision 1.55 2003/05/15 21:10:32 peter
|
||||
* remove po_containsself
|
||||
|
||||
Revision 1.54 2003/05/09 17:47:03 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user