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

* fixed public/export support for initialised variables/typed

Browse Source 
constants (mantis #9113)

git-svn-id: trunk@7772 -
This commit is contained in:
Jonas Maebe 2007-06-22 17:10:15 +00:00
parent ba0d0d4bb8
commit 20a35f9701
7 changed files with 206 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -8308,6 +8308,7 @@ tests/webtbs/tw9076a.pp svneol=native#text/plain
tests/webtbs/tw9085.pp svneol=native#text/plain
tests/webtbs/tw9098.pp svneol=native#text/plain
tests/webtbs/tw9107.pp svneol=native#text/plain
tests/webtbs/tw9113.pp svneol=native#text/plain
tests/webtbs/tw9128.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
@ -8359,6 +8360,8 @@ tests/webtbs/uw6767.pp svneol=native#text/plain
tests/webtbs/uw7381.pp svneol=native#text/plain
tests/webtbs/uw8180.pp svneol=native#text/plain
tests/webtbs/uw8372.pp svneol=native#text/plain
tests/webtbs/uw9113a.pp svneol=native#text/plain
tests/webtbs/uw9113b.pp svneol=native#text/plain
utils/Makefile svneol=native#text/plain
utils/Makefile.fpc svneol=native#text/plain
utils/README -text

1
compiler/pdecl.pas
View File

@ -242,7 +242,6 @@ implementation
else
tclist:=current_asmdata.asmlists[al_typedconsts];
read_typed_const(tclist,tstaticvarsym(sym));
consume(_SEMICOLON);
end;
end;

259
compiler/pdecvar.pas
View File

@ -39,6 +39,7 @@ interface
procedure read_record_fields(options:Tvar_dec_options);
procedure read_public_and_external(vs: tabstractvarsym);
implementation
@ -701,6 +702,137 @@ implementation
const
variantrecordlevel : longint = 0;
procedure read_public_and_external_sc(sc:TFPObjectList);
var
vs: tabstractvarsym;
begin
{ only allowed for one var }
vs:=tabstractvarsym(sc[0]);
if sc.count>1 then
Message(parser_e_absolute_only_one_var);
read_public_and_external(vs);
end;
procedure read_public_and_external(vs: tabstractvarsym);
var
is_dll,
is_cdecl,
is_external_var,
is_public_var : boolean;
dll_name,
C_name : string;
begin
{ only allowed for one var }
{ only allow external and public on global symbols }
if vs.typ<>staticvarsym then
begin
Message(parser_e_no_local_var_external);
exit;
end;
{ defaults }
is_dll:=false;
is_cdecl:=false;
is_external_var:=false;
is_public_var:=false;
C_name:=vs.realname;
{ macpas specific handling due to some switches}
if (m_mac in current_settings.modeswitches) then
begin
if (cs_external_var in current_settings.localswitches) then
begin {The effect of this is the same as if cvar; external; has been given as directives.}
is_cdecl:=true;
is_external_var:=true;
end
else if (cs_externally_visible in current_settings.localswitches) then
begin {The effect of this is the same as if cvar has been given as directives and it's made public.}
is_cdecl:=true;
is_public_var:=true;
end;
end;
{ cdecl }
if try_to_consume(_CVAR) then
begin
consume(_SEMICOLON);
is_cdecl:=true;
end;
{ external }
if try_to_consume(_EXTERNAL) then
begin
is_external_var:=true;
if not is_cdecl then
begin
if idtoken<>_NAME then
begin
is_dll:=true;
dll_name:=get_stringconst;
if ExtractFileExt(dll_name)='' then
dll_name:=ChangeFileExt(dll_name,target_info.sharedlibext);
end;
if try_to_consume(_NAME) then
C_name:=get_stringconst;
end;
consume(_SEMICOLON);
end;
{ export or public }
if idtoken in [_EXPORT,_PUBLIC] then
begin
consume(_ID);
if is_external_var then
Message(parser_e_not_external_and_export)
else
is_public_var:=true;
if try_to_consume(_NAME) then
C_name:=get_stringconst;
consume(_SEMICOLON);
end;
{ Windows uses an indirect reference using import tables }
if is_dll and
(target_info.system in system_all_windows) then
include(vs.varoptions,vo_is_dll_var);
{ Add C _ prefix }
if is_cdecl or
(
is_dll and
(target_info.system in systems_darwin)
) then
C_Name := target_info.Cprefix+C_Name;
if is_public_var then
begin
include(vs.varoptions,vo_is_public);
vs.varregable := vr_none;
{ mark as referenced }
inc(vs.refs);
end;
{ now we can insert it in the import lib if its a dll, or
add it to the externals }
if is_external_var then
begin
if vo_is_typed_const in vs.varoptions then
Message(parser_e_initialized_not_for_external);
include(vs.varoptions,vo_is_external);
vs.varregable := vr_none;
if is_dll then
current_module.AddExternalImport(dll_name,C_Name,0,true)
else
if tf_has_dllscanner in target_info.flags then
current_module.dllscannerinputlist.Add(vs.mangledname,vs);
end;
{ Set the assembler name }
tstaticvarsym(vs).set_mangledname(C_Name);
end;
procedure read_var_decls(options:Tvar_dec_options);
procedure read_default_value(sc : TFPObjectList);
@ -858,127 +990,6 @@ implementation
end;
end;
procedure read_public_and_external(sc:TFPObjectList);
var
vs : tabstractvarsym;
is_dll,
is_cdecl,
is_external_var,
is_public_var : boolean;
dll_name,
C_name : string;
begin
{ only allowed for one var }
vs:=tabstractvarsym(sc[0]);
if sc.count>1 then
Message(parser_e_absolute_only_one_var);
{ only allow external and public on global symbols }
if vs.typ<>staticvarsym then
begin
Message(parser_e_no_local_var_external);
exit;
end;
{ defaults }
is_dll:=false;
is_cdecl:=false;
is_external_var:=false;
is_public_var:=false;
C_name:=vs.realname;
{ macpas specific handling due to some switches}
if (m_mac in current_settings.modeswitches) then
begin
if (cs_external_var in current_settings.localswitches) then
begin {The effect of this is the same as if cvar; external; has been given as directives.}
is_cdecl:=true;
is_external_var:=true;
end
else if (cs_externally_visible in current_settings.localswitches) then
begin {The effect of this is the same as if cvar has been given as directives and it's made public.}
is_cdecl:=true;
is_public_var:=true;
end;
end;
{ cdecl }
if try_to_consume(_CVAR) then
begin
consume(_SEMICOLON);
is_cdecl:=true;
end;
{ external }
if try_to_consume(_EXTERNAL) then
begin
is_external_var:=true;
if not is_cdecl then
begin
if idtoken<>_NAME then
begin
is_dll:=true;
dll_name:=get_stringconst;
if ExtractFileExt(dll_name)='' then
dll_name:=ChangeFileExt(dll_name,target_info.sharedlibext);
end;
if try_to_consume(_NAME) then
C_name:=get_stringconst;
end;
consume(_SEMICOLON);
end;
{ export or public }
if idtoken in [_EXPORT,_PUBLIC] then
begin
consume(_ID);
if is_external_var then
Message(parser_e_not_external_and_export)
else
is_public_var:=true;
if try_to_consume(_NAME) then
C_name:=get_stringconst;
consume(_SEMICOLON);
end;
{ Windows uses an indirect reference using import tables }
if is_dll and
(target_info.system in system_all_windows) then
include(vs.varoptions,vo_is_dll_var);
{ Add C _ prefix }
if is_cdecl or
(
is_dll and
(target_info.system in systems_darwin)
) then
C_Name := target_info.Cprefix+C_Name;
if is_public_var then
begin
include(vs.varoptions,vo_is_public);
vs.varregable := vr_none;
{ mark as referenced }
inc(vs.refs);
end;
{ now we can insert it in the import lib if its a dll, or
add it to the externals }
if is_external_var then
begin
if vo_is_typed_const in vs.varoptions then
Message(parser_e_initialized_not_for_external);
include(vs.varoptions,vo_is_external);
vs.varregable := vr_none;
if is_dll then
current_module.AddExternalImport(dll_name,C_Name,0,true)
else
if tf_has_dllscanner in target_info.flags then
current_module.dllscannerinputlist.Add(vs.mangledname,vs);
end;
{ Set the assembler name }
tstaticvarsym(vs).set_mangledname(C_Name);
end;
var
sc : TFPObjectList;
vs : tabstractvarsym;
@ -1059,7 +1070,7 @@ implementation
{ Check for EXTERNAL etc directives before a semicolon }
if (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
begin
read_public_and_external(sc);
read_public_and_external_sc(sc);
allowdefaultvalue:=false;
semicoloneaten:=true;
end;
@ -1084,7 +1095,6 @@ implementation
(hdef.typesym=nil) then
handle_calling_convention(tprocvardef(hdef));
read_default_value(sc);
consume(_SEMICOLON);
hasdefaultvalue:=true;
end
else
@ -1108,7 +1118,6 @@ implementation
(symtablestack.top.symtabletype<>parasymtable) then
begin
read_default_value(sc);
consume(_SEMICOLON);
hasdefaultvalue:=true;
end;
end;
@ -1127,7 +1136,7 @@ implementation
)
)
) then
read_public_and_external(sc);
read_public_and_external_sc(sc);
{ allocate normal variable (non-external and non-typed-const) staticvarsyms }
for i:=0 to sc.count-1 do

49
compiler/ptconst.pas
View File

@ -42,7 +42,7 @@ implementation
node,htypechk,procinfo,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
{ parser specific stuff }
pbase,pexpr,
pbase,pexpr,pdecvar,
{ codegen }
cpuinfo,cgbase,dbgbase
;
@ -1303,6 +1303,7 @@ implementation
storefilepos : tfileposinfo;
cursectype : TAsmSectionType;
C_name : string;
valuelist : tasmlist;
begin
{ mark the staticvarsym as typedconst }
include(sym.varoptions,vo_is_typed_const);
@ -1319,6 +1320,33 @@ implementation
else
cursectype:=sec_data;
maybe_new_object_file(list);
valuelist:=tasmlist.create;
read_typed_const_data(valuelist,sym.vardef);
{ Parse hints }
try_consume_hintdirective(sym.symoptions);
consume(_SEMICOLON);
{ parse public/external/export/... }
if (
(
(token = _ID) and
(idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and
(m_cvar_support in current_settings.modeswitches)
) or
(
(m_mac in current_settings.modeswitches) and
(
(cs_external_var in current_settings.localswitches) or
(cs_externally_visible in current_settings.localswitches)
)
)
) then
read_public_and_external(sym);
{ only now add items based on the symbolname, because it may }
{ have been modified by the directives parsed above }
new_section(list,cursectype,lower(sym.mangledname),const_align(sym.vardef.alignment));
if (sym.owner.symtabletype=globalsymtable) or
maybe_smartlink_symbol or
@ -1328,23 +1356,12 @@ implementation
list.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,0))
else
list.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,0));
read_typed_const_data(list,sym.vardef);
{ add the parsed value }
list.concatlist(valuelist);
valuelist.free;
list.concat(tai_symbol_end.Createname(sym.mangledname));
current_filepos:=storefilepos;
{ Parse hints }
try_consume_hintdirective(sym.symoptions);
{ Support public name directive }
if try_to_consume(_PUBLIC) then
begin
include(sym.varoptions,vo_is_public);
if try_to_consume(_NAME) then
C_name:=get_stringconst
else
C_name:=sym.realname;
sym.set_mangledname(C_Name);
end;
end;
end.

20
tests/webtbs/tw9113.pp Normal file
View File

@ -0,0 +1,20 @@
uses uw9113a, uw9113b;
var
v1: smallint; cvar; external;
myv2: smallint; external name '_v2';
myv3: smallint; external name '_v3';
v4: smallint; cvar; external;
myv5: smallint; external name '_v5';
myv6: smallint; external name '_v6';
begin
if (v1 <> 1) or
(myv2 <> 2) or
(myv3 <> 3) or
(v4 <> 4) or
(myv5 <> 5) or
(myv6 <> 6) then
halt(1);
end.

8
tests/webtbs/uw9113a.pp Normal file
View File

@ -0,0 +1,8 @@
unit uw9113a;
interface
var
v1: integer = 1; cvar;
v2: integer = 2; export name '_v2';
v3: integer = 3; public name '_v3';
implementation
end.

8
tests/webtbs/uw9113b.pp Normal file
View File

@ -0,0 +1,8 @@
{$mode macpas}
unit uw9113b;
interface
var
v4: integer = 4; cvar;
v5: integer = 5; export name '_v5';
v6: integer = 6; public name '_v6';
end.