1) The following three routines:
pdecsub.pas!parse_parameter_dec
pdecvar.pas!maybe_parse_proc_directives
ptype.pas!read_named_type\procvar_dec
create a dummy typesym for the procdef, for the sole purpose of invoking
parse_var_proc_directives, which merely extracts that procdef. The attached
parse_proctype_directives-1.patch replaces these hacks with calls to the new
routine parse_proctype_directives that takes a procvardef directly.
2) Now, there remain three callers of the old parse_var_proc_directives:
pdecl.pas!consts_dec x2
pdecl.pas!types_dec
pgenutil.pas!generate_specialization_phase2
and all of them have procvardefs readily available. The attached
parse_proctype_directives-2.patch drops parse_var_proc_directives in favour of
parse_proctype_directives.
P.S. It seems that the cases localvarsym and paravarsym @
parse_var_proc_directives were unreachable.
3) The attached consts_dec.patch refactors consts_dec:
skipequal -> skip_initialiser, with better locality;
deduplicates:
calls to check_proc_directive & parse_proctype_directives;
checks of current_settings;
indexations of current_asmdata.asmlists;
elucidates comments.
4) The attached pdflags.patch removes the line
pdflags:=pdflags+[pd_body,pd_implemen];
from pgenutil.pas!generate_specialization_phase2. The variable pdflags is not
used after that statement; thus, it is confusing: makes the code look like some
related logic is missing.
5) The attached parse_objrec_proc_directives.patch changes
parse_object_proc_directives & parse_record_proc_directives to take tprocdef
instead of tabstractprocdef.
--
βþ
# HG changeset patch
# User Blaise.ru
# Date 1640117985 -10800
# Tue Dec 21 23:19:45 2021 +0300
= parse_parameter_dec, maybe_parse_proc_directives,
read_named_type\procvar_dec: instead of calling
parse_var_proc_directives(dummy-typesym), call new
parse_proctype_directives(tprocvardef)
diff -r d880e6695537 -r a2bda2c4af8e pdecsub.pas
--- a/pdecsub.pas Mon Dec 20 20:55:22 2021 +0300
+++ b/pdecsub.pas Tue Dec 21 23:19:45 2021 +0300
@@ -63,6 +63,7 @@
procedure parse_parameter_dec(pd:tabstractprocdef);
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
procedure parse_var_proc_directives(sym:tsym);
+ procedure parse_proctype_directives(pd:tprocvardef);
procedure parse_object_proc_directives(pd:tabstractprocdef);
procedure parse_record_proc_directives(pd:tabstractprocdef);
function
parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;isgeneric:boolean;genericdef:tdef;generictypelist:tfphashobjectlist;out
pd:tprocdef):boolean;
@@ -212,7 +213,6 @@
parseprocvar : tppv;
locationstr : string;
paranr : integer;
- dummytype : ttypesym;
explicit_paraloc,
need_array,
is_univ: boolean;
@@ -346,22 +346,16 @@
single_type(pv.returndef,[]);
block_type:=bt_var;
end;
- hdef:=pv;
{ possible proc directives }
if check_proc_directive(true) then
- begin
- dummytype:=ctypesym.create('unnamed',hdef);
- parse_var_proc_directives(tsym(dummytype));
- dummytype.typedef:=nil;
- hdef.typesym:=nil;
- dummytype.free;
- end;
+ parse_proctype_directives(pv);
{ Add implicit hidden parameters and function result }
handle_calling_convention(pv,hcc_default_actions_intf);
{$ifdef jvm}
{ anonymous -> no name }
jvm_create_procvar_class('',pv);
{$endif}
+ hdef:=pv;
end
else
{ read type declaration, force reading for value paras }
@@ -3406,25 +3400,29 @@
procedure parse_var_proc_directives(sym:tsym);
var
- pdflags : tpdflags;
- pd : tabstractprocdef;
+ pd : tprocvardef;
begin
- pdflags:=[pd_procvar];
- pd:=nil;
case sym.typ of
fieldvarsym,
staticvarsym,
localvarsym,
paravarsym :
- pd:=tabstractprocdef(tabstractvarsym(sym).vardef);
+ pd:=tprocvardef(tabstractvarsym(sym).vardef);
typesym :
- pd:=tabstractprocdef(ttypesym(sym).typedef);
+ pd:=tprocvardef(ttypesym(sym).typedef);
else
internalerror(2003042617);
end;
if pd.typ<>procvardef then
internalerror(2003042618);
- { names should never be used anyway }
+ parse_proctype_directives(pd);
+ end;
+
+ procedure parse_proctype_directives(pd:tprocvardef);
+ var
+ pdflags : tpdflags;
+ begin
+ pdflags:=[pd_procvar];
parse_proc_directives(pd,pdflags);
end;
diff -r d880e6695537 -r a2bda2c4af8e pdecvar.pas
--- a/pdecvar.pas Mon Dec 20 20:55:22 2021 +0300
+++ b/pdecvar.pas Tue Dec 21 23:19:45 2021 +0300
@@ -886,8 +886,6 @@
function maybe_parse_proc_directives(def:tdef):boolean;
- var
- newtype : ttypesym;
begin
result:=false;
{ Process procvar directives before = and ; }
@@ -895,11 +893,7 @@
(def.typesym=nil) and
check_proc_directive(true) then
begin
- newtype:=ctypesym.create('unnamed',def);
- parse_var_proc_directives(tsym(newtype));
- newtype.typedef:=nil;
- def.typesym:=nil;
- newtype.free;
+ parse_proctype_directives(tprocvardef(def));
result:=true;
end;
end;
diff -r d880e6695537 -r a2bda2c4af8e ptype.pas
--- a/ptype.pas Mon Dec 20 20:55:22 2021 +0300
+++ b/ptype.pas Tue Dec 21 23:19:45 2021 +0300
@@ -1562,8 +1562,7 @@
function
procvar_dec(genericdef:tstoreddef;genericlist:tfphashobjectlist):tdef;
var
is_func:boolean;
- pd:tabstractprocdef;
- newtype:ttypesym;
+ pd:tprocvardef;
old_current_genericdef,
old_current_specializedef: tstoreddef;
old_parse_generic: boolean;
@@ -1622,18 +1621,11 @@
end;
symtablestack.pop(pd.parast);
tparasymtable(pd.parast).readonly:=false;
- result:=pd;
{ possible proc directives }
if parseprocvardir then
begin
if check_proc_directive(true) then
- begin
- newtype:=ctypesym.create('unnamed',result);
- parse_var_proc_directives(tsym(newtype));
- newtype.typedef:=nil;
- result.typesym:=nil;
- newtype.free;
- end;
+ parse_proctype_directives(pd);
{ Add implicit hidden parameters and function result }
handle_calling_convention(pd,hcc_default_actions_intf);
end;
@@ -1641,6 +1633,8 @@
parse_generic:=old_parse_generic;
current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef;
+
+ result:=pd;
end;
const
# HG changeset patch
# User Blaise.ru
# Date 1640053801 -10800
# Tue Dec 21 05:30:01 2021 +0300
= consts_dec, types_dec, generate_specialization_phase2:
parse_var_proc_directives(tsym) -> parse_proctype_directives(tprocvardef)
diff -r a2bda2c4af8e -r b05f9e671444 pdecl.pas
--- a/pdecl.pas Tue Dec 21 23:19:45 2021 +0300
+++ b/pdecl.pas Tue Dec 21 05:30:01 2021 +0300
@@ -323,7 +323,7 @@
if try_to_consume(_SEMICOLON) then
begin
if check_proc_directive(true) then
- parse_var_proc_directives(sym)
+ parse_proctype_directives(tprocvardef(hdef))
else
begin
Message(parser_e_proc_directive_expected);
@@ -334,7 +334,7 @@
{ support p : procedure stdcall=nil; }
begin
if check_proc_directive(true) then
- parse_var_proc_directives(sym);
+ parse_proctype_directives(tprocvardef(hdef));
end;
{ add default calling convention }
handle_calling_convention(tabstractprocdef(hdef),hcc_default_actions_intf);
@@ -1079,7 +1079,7 @@
try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
consume(_SEMICOLON);
end;
- parse_var_proc_directives(tsym(newtype));
+ parse_proctype_directives(tprocvardef(hdef));
if po_is_function_ref in tprocvardef(hdef).procoptions
then
begin
{ these always support everything, no "of object" or
diff -r a2bda2c4af8e -r b05f9e671444 pdecsub.pas
--- a/pdecsub.pas Tue Dec 21 23:19:45 2021 +0300
+++ b/pdecsub.pas Tue Dec 21 05:30:01 2021 +0300
@@ -62,7 +62,6 @@
procedure parse_parameter_dec(pd:tabstractprocdef);
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
- procedure parse_var_proc_directives(sym:tsym);
procedure parse_proctype_directives(pd:tprocvardef);
procedure parse_object_proc_directives(pd:tabstractprocdef);
procedure parse_record_proc_directives(pd:tabstractprocdef);
@@ -3398,26 +3397,6 @@
end;
- procedure parse_var_proc_directives(sym:tsym);
- var
- pd : tprocvardef;
- begin
- case sym.typ of
- fieldvarsym,
- staticvarsym,
- localvarsym,
- paravarsym :
- pd:=tprocvardef(tabstractvarsym(sym).vardef);
- typesym :
- pd:=tprocvardef(ttypesym(sym).typedef);
- else
- internalerror(2003042617);
- end;
- if pd.typ<>procvardef then
- internalerror(2003042618);
- parse_proctype_directives(pd);
- end;
-
procedure parse_proctype_directives(pd:tprocvardef);
var
pdflags : tpdflags;
@@ -3426,7 +3405,6 @@
parse_proc_directives(pd,pdflags);
end;
-
procedure parse_object_proc_directives(pd:tabstractprocdef);
var
pdflags : tpdflags;
diff -r a2bda2c4af8e -r b05f9e671444 pgenutil.pas
--- a/pgenutil.pas Tue Dec 21 23:19:45 2021 +0300
+++ b/pgenutil.pas Tue Dec 21 05:30:01 2021 +0300
@@ -1248,7 +1248,7 @@
hintsprocessed:=true;
end;
if replaydepth>current_scanner.replay_stack_depth then
- parse_var_proc_directives(ttypesym(srsym));
+ parse_proctype_directives(tprocvardef(result));
handle_calling_convention(tprocvardef(result),hcc_default_actions_intf);
if not hintsprocessed and
(replaydepth>current_scanner.replay_stack_depth) then
begin
# HG changeset patch
# User Blaise.ru
# Date 1640114015 -10800
# Tue Dec 21 22:13:35 2021 +0300
= consts_dec: deduplicate calls to check_proc_directive &
parse_proctype_directives, checks of current_settings, and indexations of
current_asmdata.asmlists
diff -r b05f9e671444 -r 71856f37bb17 pdecl.pas
--- a/pdecl.pas Tue Dec 21 05:30:01 2021 +0300
+++ b/pdecl.pas Tue Dec 21 22:13:35 2021 +0300
@@ -227,9 +227,10 @@
old_block_type : tblock_type;
first,
isgeneric,
- skipequal : boolean;
- tclist : tasmlist;
+ expect_directive,
+ skip_initialiser : boolean;
varspez : tvarspez;
+ asmtype : TAsmListType;
begin
old_block_type:=block_type;
block_type:=bt_const;
@@ -287,14 +288,19 @@
consume(_COLON);
read_anon_type(hdef,false);
block_type:=bt_const;
- skipequal:=false;
{ create symbol }
storetokenpos:=current_tokenpos;
current_tokenpos:=filepos;
if not (cs_typed_const_writable in
current_settings.localswitches) then
- varspez:=vs_const
+ begin
+ varspez:=vs_const;
+ asmtype:=al_rotypedconsts;
+ end
else
- varspez:=vs_value;
+ begin
+ varspez:=vs_value;
+ asmtype:=al_typedconsts;
+ end;
{ if we are dealing with structure const then we need to
handle it as a
structure static variable: create a symbol in unit
symtable and a reference
to it from the structure or linking will fail }
@@ -315,39 +321,28 @@
end;
sym.register_sym;
current_tokenpos:=storetokenpos;
- { procvar can have proc directives, but not type references
}
+ skip_initialiser:=false;
+ { Anonymous proctype definitions can have proc directives }
if (hdef.typ=procvardef) and
(hdef.typesym=nil) then
begin
- { support p : procedure;stdcall=nil; }
- if try_to_consume(_SEMICOLON) then
+ { Either "procedure; stdcall" or "procedure stdcall" }
+ expect_directive:=try_to_consume(_SEMICOLON);
+ if check_proc_directive(true) then
+ parse_proctype_directives(tprocvardef(hdef))
+ else if expect_directive then
begin
- if check_proc_directive(true) then
- parse_proctype_directives(tprocvardef(hdef))
- else
- begin
- Message(parser_e_proc_directive_expected);
- skipequal:=true;
- end;
- end
- else
- { support p : procedure stdcall=nil; }
- begin
- if check_proc_directive(true) then
- parse_proctype_directives(tprocvardef(hdef));
+ Message(parser_e_proc_directive_expected);
+ skip_initialiser:=true;
end;
{ add default calling convention }
handle_calling_convention(tabstractprocdef(hdef),hcc_default_actions_intf);
end;
- if not skipequal then
+ { Parse the initialiser }
+ if not skip_initialiser then
begin
- { get init value }
consume(_EQ);
- if (cs_typed_const_writable in
current_settings.localswitches) then
- tclist:=current_asmdata.asmlists[al_typedconsts]
- else
- tclist:=current_asmdata.asmlists[al_rotypedconsts];
- read_typed_const(tclist,tstaticvarsym(sym),in_structure);
+
read_typed_const(current_asmdata.asmlists[asmtype],tstaticvarsym(sym),in_structure);
end;
end;
# HG changeset patch
# User Blaise.ru
# Date 1640115809 -10800
# Tue Dec 21 22:43:29 2021 +0300
= generate_specialization_phase2: remove bogus pdflags manipulation
diff -r 71856f37bb17 -r be7ac48a05fb pgenutil.pas
--- a/pgenutil.pas Tue Dec 21 22:13:35 2021 +0300
+++ b/pgenutil.pas Tue Dec 21 22:43:29 2021 +0300
@@ -1271,7 +1271,6 @@
handle_calling_convention(tprocdef(result),hcc_default_actions_intf)
else
handle_calling_convention(tprocdef(result),hcc_default_actions_impl);
- pdflags:=pdflags+[pd_body,pd_implemen];
proc_add_definition(tprocdef(result));
{ for partial specializations we implicitely declare the
routine as
having its implementation although we'll not
specialize it in reality }
# HG changeset patch
# User Blaise.ru
# Date 1640116911 -10800
# Tue Dec 21 23:01:51 2021 +0300
= parse_object_proc_directives & parse_record_proc_directives: take tprocdef
instead of tabstractprocdef
diff -r be7ac48a05fb -r 768020dbe0c6 pdecsub.pas
--- a/pdecsub.pas Tue Dec 21 22:43:29 2021 +0300
+++ b/pdecsub.pas Tue Dec 21 23:01:51 2021 +0300
@@ -63,8 +63,8 @@
procedure parse_parameter_dec(pd:tabstractprocdef);
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
procedure parse_proctype_directives(pd:tprocvardef);
- procedure parse_object_proc_directives(pd:tabstractprocdef);
- procedure parse_record_proc_directives(pd:tabstractprocdef);
+ procedure parse_object_proc_directives(pd:tprocdef);
+ procedure parse_record_proc_directives(pd:tprocdef);
function
parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;isgeneric:boolean;genericdef:tdef;generictypelist:tfphashobjectlist;out
pd:tprocdef):boolean;
function
parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef;isgeneric:boolean):tprocdef;
procedure
parse_proc_dec_finish(pd:tprocdef;isclassmethod:boolean;astruct:tabstractrecorddef);
@@ -3405,7 +3405,7 @@
parse_proc_directives(pd,pdflags);
end;
- procedure parse_object_proc_directives(pd:tabstractprocdef);
+ procedure parse_object_proc_directives(pd:tprocdef);
var
pdflags : tpdflags;
begin
@@ -3413,7 +3413,7 @@
parse_proc_directives(pd,pdflags);
end;
- procedure parse_record_proc_directives(pd:tabstractprocdef);
+ procedure parse_record_proc_directives(pd:tprocdef);
var
pdflags : tpdflags;
begin
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
