pdecvar.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Parses variable declarations. Used for var statement and record
  5. definitions
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit pdecvar;
  20. {$i fpcdefs.inc}
  21. interface
  22. procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
  23. implementation
  24. uses
  25. { common }
  26. cutils,cclasses,
  27. { global }
  28. globtype,globals,tokens,verbose,
  29. systems,
  30. { symtable }
  31. symconst,symbase,symtype,symdef,symsym,symtable,defutil,
  32. fmodule,
  33. { pass 1 }
  34. node,
  35. nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
  36. { codegen }
  37. ncgutil,
  38. { parser }
  39. scanner,
  40. pbase,pexpr,ptype,ptconst,pdecsub,
  41. { link }
  42. import
  43. {$ifdef Delphi}
  44. ,dmisc
  45. ,sysutils
  46. {$endif}
  47. ;
  48. const
  49. variantrecordlevel : longint = 0;
  50. procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
  51. { reads the filed of a record into a }
  52. { symtablestack, if record=false }
  53. { variants are forbidden, so this procedure }
  54. { can be used to read object fields }
  55. { if absolute is true, ABSOLUTE and file }
  56. { types are allowed }
  57. { => the procedure is also used to read }
  58. { a sequence of variable declaration }
  59. procedure insert_syms(sc : tsinglelist;tt : ttype;is_threadvar : boolean; addsymopts : tsymoptions);
  60. { inserts the symbols of sc in st with def as definition or sym as ttypesym, sc is disposed }
  61. var
  62. vs,vs2 : tvarsym;
  63. begin
  64. vs:=tvarsym(sc.first);
  65. while assigned(vs) do
  66. begin
  67. vs.vartype:=tt;
  68. { insert any additional hint directives }
  69. vs.symoptions := vs.symoptions + addsymopts;
  70. if (sp_static in current_object_option) then
  71. include(vs.symoptions,sp_static);
  72. if is_threadvar then
  73. include(vs.varoptions,vo_is_thread_var);
  74. { static data fields are inserted in the globalsymtable }
  75. if (symtablestack.symtabletype=objectsymtable) and
  76. (sp_static in current_object_option) then
  77. begin
  78. vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt);
  79. symtablestack.defowner.owner.insert(vs2);
  80. insertbssdata(vs2);
  81. end
  82. else
  83. begin
  84. { external data is not possible here }
  85. case symtablestack.symtabletype of
  86. globalsymtable,
  87. staticsymtable :
  88. insertbssdata(vs);
  89. recordsymtable,
  90. objectsymtable :
  91. tabstractrecordsymtable(symtablestack).insertfield(vs,false);
  92. end;
  93. end;
  94. vs:=tvarsym(vs.listnext);
  95. end;
  96. end;
  97. var
  98. sc : tsinglelist;
  99. old_block_type : tblock_type;
  100. symdone : boolean;
  101. { to handle absolute }
  102. abssym : tabsolutesym;
  103. { c var }
  104. newtype : ttypesym;
  105. is_dll,
  106. is_gpc_name,is_cdecl,
  107. extern_var,export_var : boolean;
  108. old_current_object_option : tsymoptions;
  109. hs,sorg,C_name,dll_name : string;
  110. tt,casetype : ttype;
  111. { Delphi initialized vars }
  112. tconstsym : ttypedconstsym;
  113. { maxsize contains the max. size of a variant }
  114. { startvarrec contains the start of the variant part of a record }
  115. maxsize, startvarrecsize : longint;
  116. usedalign,
  117. minalignment,maxalignment,startvarrecalign : byte;
  118. hp,pt : tnode;
  119. vs,vs2 : tvarsym;
  120. srsym : tsym;
  121. oldsymtablestack,
  122. srsymtable : tsymtable;
  123. unionsymtable : trecordsymtable;
  124. offset : longint;
  125. uniondef : trecorddef;
  126. unionsym : tvarsym;
  127. uniontype : ttype;
  128. dummysymoptions : tsymoptions;
  129. begin
  130. old_current_object_option:=current_object_option;
  131. { all variables are public if not in a object declaration }
  132. if not is_object then
  133. current_object_option:=[sp_public];
  134. old_block_type:=block_type;
  135. block_type:=bt_type;
  136. is_gpc_name:=false;
  137. { Force an expected ID error message }
  138. if not (token in [_ID,_CASE,_END]) then
  139. consume(_ID);
  140. { read vars }
  141. sc:=tsinglelist.create;
  142. while (token=_ID) and
  143. not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED])) do
  144. begin
  145. sorg:=orgpattern;
  146. sc.reset;
  147. repeat
  148. vs:=tvarsym.create(orgpattern,vs_value,generrortype);
  149. symtablestack.insert(vs);
  150. if assigned(vs.owner) then
  151. sc.insert(vs)
  152. else
  153. vs.free;
  154. consume(_ID);
  155. until not try_to_consume(_COMMA);
  156. consume(_COLON);
  157. if (m_gpc in aktmodeswitches) and
  158. not(is_record or is_object or is_threadvar) and
  159. (token=_ID) and (orgpattern='__asmname__') then
  160. begin
  161. consume(_ID);
  162. C_name:=get_stringconst;
  163. Is_gpc_name:=true;
  164. end;
  165. { this is needed for Delphi mode at least
  166. but should be OK for all modes !! (PM) }
  167. ignore_equal:=true;
  168. if is_record or is_object then
  169. begin
  170. { for records, don't search the recordsymtable for
  171. the symbols of the types }
  172. oldsymtablestack:=symtablestack;
  173. symtablestack:=symtablestack.next;
  174. read_type(tt,'',true);
  175. symtablestack:=oldsymtablestack;
  176. end
  177. else
  178. read_type(tt,'',true);
  179. { types that use init/final are not allowed in variant parts, but
  180. classes are allowed }
  181. if (variantrecordlevel>0) and
  182. (tt.def.needs_inittable and not is_class(tt.def)) then
  183. Message(parser_e_cant_use_inittable_here);
  184. ignore_equal:=false;
  185. symdone:=false;
  186. if is_gpc_name then
  187. begin
  188. vs:=tvarsym(sc.first);
  189. if assigned(vs.listnext) then
  190. Message(parser_e_absolute_only_one_var);
  191. vs.vartype:=tt;
  192. include(vs.varoptions,vo_is_C_var);
  193. vs.set_mangledname(target_info.Cprefix+sorg);
  194. include(vs.varoptions,vo_is_external);
  195. symdone:=true;
  196. end;
  197. { check for absolute }
  198. if not symdone and
  199. (idtoken=_ABSOLUTE) and not(is_record or is_object or is_threadvar) then
  200. begin
  201. consume(_ABSOLUTE);
  202. abssym:=nil;
  203. { only allowed for one var }
  204. vs:=tvarsym(sc.first);
  205. if assigned(vs.listnext) then
  206. Message(parser_e_absolute_only_one_var);
  207. { parse the rest }
  208. pt:=expr;
  209. { transform a procvar calln to loadn }
  210. if pt.nodetype=calln then
  211. load_procvar_from_calln(pt);
  212. { check allowed absolute types }
  213. if (pt.nodetype=stringconstn) or
  214. (is_constcharnode(pt)) then
  215. begin
  216. abssym:=tabsolutesym.create(vs.realname,tt);
  217. abssym.fileinfo:=vs.fileinfo;
  218. if pt.nodetype=stringconstn then
  219. hs:=strpas(tstringconstnode(pt).value_str)
  220. else
  221. hs:=chr(tordconstnode(pt).value);
  222. consume(token);
  223. abssym.abstyp:=toasm;
  224. abssym.asmname:=stringdup(hs);
  225. { replace the varsym }
  226. symtablestack.replace(vs,abssym);
  227. vs.free;
  228. end
  229. { address }
  230. else if is_constintnode(pt) and
  231. ((target_info.system in [system_i386_go32v2,system_i386_watcom,
  232. system_i386_wdosx,system_i386_win32]) or
  233. (m_objfpc in aktmodeswitches) or
  234. (m_delphi in aktmodeswitches)) then
  235. begin
  236. abssym:=tabsolutesym.create(vs.realname,tt);
  237. abssym.fileinfo:=vs.fileinfo;
  238. abssym.abstyp:=toaddr;
  239. abssym.absseg:=false;
  240. abssym.fieldoffset:=tordconstnode(pt).value;
  241. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  242. try_to_consume(_COLON) then
  243. begin
  244. pt.free;
  245. pt:=expr;
  246. if is_constintnode(pt) then
  247. begin
  248. abssym.fieldoffset:=abssym.fieldoffset shl 4+tordconstnode(pt).value;
  249. abssym.absseg:=true;
  250. end
  251. else
  252. Message(type_e_ordinal_expr_expected);
  253. end;
  254. symtablestack.replace(vs,abssym);
  255. vs.free;
  256. end
  257. { variable }
  258. else
  259. begin
  260. { remove subscriptn before checking for loadn }
  261. hp:=pt;
  262. while (hp.nodetype in [subscriptn,typeconvn,vecn]) do
  263. hp:=tsubscriptnode(hp).left;
  264. if (hp.nodetype=loadn) then
  265. begin
  266. { we should check the result type of loadn }
  267. if not (tloadnode(hp).symtableentry.typ in [varsym,typedconstsym]) then
  268. Message(parser_e_absolute_only_to_var_or_const);
  269. abssym:=tabsolutesym.create(vs.realname,tt);
  270. abssym.fileinfo:=vs.fileinfo;
  271. abssym.abstyp:=tovar;
  272. abssym.ref:=node_to_symlist(pt);
  273. symtablestack.replace(vs,abssym);
  274. vs.free;
  275. end
  276. else
  277. Message(parser_e_absolute_only_to_var_or_const);
  278. end;
  279. if assigned(abssym) then
  280. begin
  281. { try to consume the hint directives with absolute symbols }
  282. dummysymoptions:=[];
  283. try_consume_hintdirective(dummysymoptions);
  284. abssym.symoptions := abssym.symoptions + dummysymoptions;
  285. end;
  286. pt.free;
  287. symdone:=true;
  288. end;
  289. { Records and objects can't have default values }
  290. if is_record or is_object then
  291. begin
  292. { try to parse the hint directives }
  293. dummysymoptions:=[];
  294. try_consume_hintdirective(dummysymoptions);
  295. { for a record there doesn't need to be a ; before the END or ) }
  296. if not(token in [_END,_RKLAMMER]) then
  297. consume(_SEMICOLON);
  298. end
  299. else
  300. begin
  301. { Process procvar directives before = and ; }
  302. if (tt.def.deftype=procvardef) and
  303. (tt.def.typesym=nil) and
  304. is_proc_directive(token,true) then
  305. begin
  306. newtype:=ttypesym.create('unnamed',tt);
  307. parse_var_proc_directives(tsym(newtype));
  308. newtype.restype.def:=nil;
  309. tt.def.typesym:=nil;
  310. newtype.free;
  311. end;
  312. { try to parse the hint directives }
  313. dummysymoptions:=[];
  314. try_consume_hintdirective(dummysymoptions);
  315. { Handling of Delphi typed const = initialized vars ! }
  316. { When should this be rejected ?
  317. - in parasymtable
  318. - in record or object
  319. - ... (PM) }
  320. if (token=_EQUAL) and
  321. not(m_tp7 in aktmodeswitches) and
  322. not(symtablestack.symtabletype in [parasymtable]) and
  323. not is_record and
  324. not is_object then
  325. begin
  326. vs:=tvarsym(sc.first);
  327. if assigned(vs.listnext) then
  328. Message(parser_e_initialized_only_one_var);
  329. if is_threadvar then
  330. Message(parser_e_initialized_not_for_threadvar);
  331. if symtablestack.symtabletype=localsymtable then
  332. begin
  333. consume(_EQUAL);
  334. tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
  335. vs.defaultconstsym:=tconstsym;
  336. symtablestack.insert(tconstsym);
  337. insertconstdata(tconstsym);
  338. readtypedconst(tt,tconstsym,false);
  339. end
  340. else
  341. begin
  342. tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
  343. tconstsym.fileinfo:=vs.fileinfo;
  344. symtablestack.replace(vs,tconstsym);
  345. vs.free;
  346. insertconstdata(tconstsym);
  347. consume(_EQUAL);
  348. readtypedconst(tt,tconstsym,true);
  349. symdone:=true;
  350. end;
  351. consume(_SEMICOLON);
  352. end
  353. else
  354. begin
  355. consume(_SEMICOLON);
  356. end;
  357. end;
  358. { Parse procvar directives after ; }
  359. if (tt.def.deftype=procvardef) and
  360. (tt.def.typesym=nil) then
  361. begin
  362. if is_proc_directive(token,true) then
  363. begin
  364. newtype:=ttypesym.create('unnamed',tt);
  365. parse_var_proc_directives(tsym(newtype));
  366. newtype.restype.def:=nil;
  367. tt.def.typesym:=nil;
  368. newtype.free;
  369. end;
  370. { Add calling convention for procvar }
  371. handle_calling_convention(tprocvardef(tt.def));
  372. end;
  373. { Check for variable directives }
  374. if not symdone and (token=_ID) then
  375. begin
  376. { Check for C Variable declarations }
  377. if (m_cvar_support in aktmodeswitches) and
  378. not(is_record or is_object or is_threadvar) and
  379. (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
  380. begin
  381. { only allowed for one var }
  382. vs:=tvarsym(sc.first);
  383. if assigned(vs.listnext) then
  384. Message(parser_e_absolute_only_one_var);
  385. { set type of the var }
  386. vs.vartype:=tt;
  387. vs.symoptions := vs.symoptions + dummysymoptions;
  388. { defaults }
  389. is_dll:=false;
  390. is_cdecl:=false;
  391. extern_var:=false;
  392. export_var:=false;
  393. C_name:=sorg;
  394. { cdecl }
  395. if idtoken=_CVAR then
  396. begin
  397. consume(_CVAR);
  398. consume(_SEMICOLON);
  399. is_cdecl:=true;
  400. C_name:=target_info.Cprefix+sorg;
  401. end;
  402. { external }
  403. if idtoken=_EXTERNAL then
  404. begin
  405. consume(_EXTERNAL);
  406. extern_var:=true;
  407. end;
  408. { export }
  409. if idtoken in [_EXPORT,_PUBLIC] then
  410. begin
  411. consume(_ID);
  412. if extern_var or
  413. (symtablestack.symtabletype in [parasymtable,localsymtable]) then
  414. Message(parser_e_not_external_and_export)
  415. else
  416. export_var:=true;
  417. end;
  418. { external and export need a name after when no cdecl is used }
  419. if not is_cdecl then
  420. begin
  421. { dll name ? }
  422. if (extern_var) and (idtoken<>_NAME) then
  423. begin
  424. is_dll:=true;
  425. dll_name:=get_stringconst;
  426. end;
  427. consume(_NAME);
  428. C_name:=get_stringconst;
  429. end;
  430. { consume the ; when export or external is used }
  431. if extern_var or export_var then
  432. consume(_SEMICOLON);
  433. { set some vars options }
  434. if is_dll then
  435. include(vs.varoptions,vo_is_dll_var)
  436. else
  437. include(vs.varoptions,vo_is_C_var);
  438. vs.set_mangledname(C_Name);
  439. if export_var then
  440. begin
  441. inc(vs.refs);
  442. include(vs.varoptions,vo_is_exported);
  443. end;
  444. if extern_var then
  445. include(vs.varoptions,vo_is_external);
  446. { insert in the datasegment when it is not external }
  447. if (not extern_var) then
  448. insertbssdata(vs);
  449. { now we can insert it in the import lib if its a dll, or
  450. add it to the externals }
  451. if extern_var then
  452. begin
  453. if is_dll then
  454. begin
  455. if not(current_module.uses_imports) then
  456. begin
  457. current_module.uses_imports:=true;
  458. importlib.preparelib(current_module.modulename^);
  459. end;
  460. importlib.importvariable(vs,C_name,dll_name);
  461. end
  462. else
  463. if target_info.DllScanSupported then
  464. current_module.Externals.insert(tExternalsItem.create(vs.mangledname));
  465. end;
  466. symdone:=true;
  467. end
  468. else
  469. if (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then
  470. begin
  471. include(current_object_option,sp_static);
  472. insert_syms(sc,tt,false,dummysymoptions);
  473. exclude(current_object_option,sp_static);
  474. consume(_STATIC);
  475. consume(_SEMICOLON);
  476. symdone:=true;
  477. end;
  478. end;
  479. { insert it in the symtable, if not done yet }
  480. if not symdone then
  481. begin
  482. { save object option, because we can turn of the sp_published }
  483. if (sp_published in current_object_option) and
  484. not(is_class(tt.def)) then
  485. begin
  486. Message(parser_e_cant_publish_that);
  487. exclude(current_object_option,sp_published);
  488. { recover by changing access type to public }
  489. vs2:=tvarsym(sc.first);
  490. while assigned (vs2) do
  491. begin
  492. exclude(vs2.symoptions,sp_published);
  493. include(vs2.symoptions,sp_public);
  494. vs2:=tvarsym(vs2.listnext);
  495. end;
  496. end
  497. else
  498. if (sp_published in current_object_option) and
  499. not(oo_can_have_published in tobjectdef(tt.def).objectoptions) then
  500. begin
  501. Message(parser_e_only_publishable_classes_can__be_published);
  502. exclude(current_object_option,sp_published);
  503. end;
  504. insert_syms(sc,tt,is_threadvar,dummysymoptions);
  505. current_object_option:=old_current_object_option;
  506. end;
  507. end;
  508. { Check for Case }
  509. if is_record and (token=_CASE) then
  510. begin
  511. maxsize:=0;
  512. maxalignment:=0;
  513. consume(_CASE);
  514. sorg:=orgpattern;
  515. hs:=pattern;
  516. searchsym(hs,srsym,srsymtable);
  517. { may be only a type: }
  518. if assigned(srsym) and (srsym.typ in [typesym,unitsym]) then
  519. begin
  520. { for records, don't search the recordsymtable for
  521. the symbols of the types }
  522. oldsymtablestack:=symtablestack;
  523. symtablestack:=symtablestack.next;
  524. read_type(casetype,'',true);
  525. symtablestack:=oldsymtablestack;
  526. end
  527. else
  528. begin
  529. consume(_ID);
  530. consume(_COLON);
  531. { for records, don't search the recordsymtable for
  532. the symbols of the types }
  533. oldsymtablestack:=symtablestack;
  534. symtablestack:=symtablestack.next;
  535. read_type(casetype,'',true);
  536. symtablestack:=oldsymtablestack;
  537. vs:=tvarsym.create(sorg,vs_value,casetype);
  538. tabstractrecordsymtable(symtablestack).insertfield(vs,true);
  539. end;
  540. if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def) then
  541. Message(type_e_ordinal_expr_expected);
  542. consume(_OF);
  543. UnionSymtable:=trecordsymtable.create;
  544. Unionsymtable.next:=symtablestack;
  545. registerdef:=false;
  546. UnionDef:=trecorddef.create(unionsymtable);
  547. uniondef.isunion:=true;
  548. if assigned(symtablestack.defowner) then
  549. Uniondef.owner:=symtablestack.defowner.owner;
  550. registerdef:=true;
  551. startvarrecsize:=UnionSymtable.datasize;
  552. startvarrecalign:=UnionSymtable.dataalignment;
  553. symtablestack:=UnionSymtable;
  554. repeat
  555. repeat
  556. pt:=comp_expr(true);
  557. if not(pt.nodetype=ordconstn) then
  558. Message(cg_e_illegal_expression);
  559. pt.free;
  560. if token=_COMMA then
  561. consume(_COMMA)
  562. else
  563. break;
  564. until false;
  565. consume(_COLON);
  566. { read the vars }
  567. consume(_LKLAMMER);
  568. inc(variantrecordlevel);
  569. if token<>_RKLAMMER then
  570. read_var_decs(true,false,false);
  571. dec(variantrecordlevel);
  572. consume(_RKLAMMER);
  573. { calculates maximal variant size }
  574. maxsize:=max(maxsize,unionsymtable.datasize);
  575. maxalignment:=max(maxalignment,unionsymtable.dataalignment);
  576. { the items of the next variant are overlayed }
  577. unionsymtable.datasize:=startvarrecsize;
  578. unionsymtable.dataalignment:=startvarrecalign;
  579. if (token<>_END) and (token<>_RKLAMMER) then
  580. consume(_SEMICOLON)
  581. else
  582. break;
  583. until (token=_END) or (token=_RKLAMMER);
  584. { at last set the record size to that of the biggest variant }
  585. unionsymtable.datasize:=maxsize;
  586. unionsymtable.dataalignment:=maxalignment;
  587. uniontype.def:=uniondef;
  588. uniontype.sym:=nil;
  589. UnionSym:=tvarsym.create('$case',vs_value,uniontype);
  590. symtablestack:=symtablestack.next;
  591. { we do NOT call symtablestack.insert
  592. on purpose PM }
  593. if aktalignment.recordalignmax=-1 then
  594. begin
  595. {$ifdef i386}
  596. if maxalignment>2 then
  597. minalignment:=4
  598. else if maxalignment>1 then
  599. minalignment:=2
  600. else
  601. minalignment:=1;
  602. {$else}
  603. {$ifdef m68k}
  604. minalignment:=2;
  605. {$endif}
  606. minalignment:=1;
  607. {$endif}
  608. end
  609. else
  610. minalignment:=maxalignment;
  611. usedalign:=used_align(maxalignment,minalignment,maxalignment);
  612. offset:=align(trecordsymtable(symtablestack).datasize,usedalign);
  613. trecordsymtable(symtablestack).datasize:=offset+unionsymtable.datasize;
  614. if maxalignment>trecordsymtable(symtablestack).dataalignment then
  615. trecordsymtable(symtablestack).dataalignment:=maxalignment;
  616. Unionsymtable.Insert_in(trecordsymtable(symtablestack),offset);
  617. Unionsym.owner:=nil;
  618. unionsym.free;
  619. uniondef.owner:=nil;
  620. uniondef.free;
  621. end;
  622. block_type:=old_block_type;
  623. current_object_option:=old_current_object_option;
  624. { free the list }
  625. sc.free;
  626. end;
  627. end.
  628. {
  629. $Log$
  630. Revision 1.57 2003-10-28 15:36:01 peter
  631. * absolute to object field supported, fixes tb0458
  632. Revision 1.56 2003/10/05 12:55:37 peter
  633. * allow absolute with value for win32,wdos
  634. Revision 1.55 2003/10/03 14:45:09 peter
  635. * more proc directive for procvar fixes
  636. Revision 1.54 2003/10/02 21:13:09 peter
  637. * procvar directive parsing fixes
  638. Revision 1.53 2003/10/02 15:12:07 peter
  639. * fix type parsing in records
  640. Revision 1.52 2003/10/01 19:05:33 peter
  641. * searchsym_type to search for type definitions. It ignores
  642. records,objects and parameters
  643. Revision 1.51 2003/09/23 17:56:05 peter
  644. * locals and paras are allocated in the code generation
  645. * tvarsym.localloc contains the location of para/local when
  646. generating code for the current procedure
  647. Revision 1.50 2003/09/07 14:14:51 florian
  648. * proper error recovering from invalid published fields
  649. Revision 1.49 2003/09/05 17:41:12 florian
  650. * merged Wiktor's Watcom patches in 1.1
  651. Revision 1.48 2003/07/02 22:18:04 peter
  652. * paraloc splitted in callerparaloc,calleeparaloc
  653. * sparc calling convention updates
  654. Revision 1.47 2003/05/09 17:47:03 peter
  655. * self moved to hidden parameter
  656. * removed hdisposen,hnewn,selfn
  657. Revision 1.46 2003/04/25 20:59:33 peter
  658. * removed funcretn,funcretsym, function result is now in varsym
  659. and aliases for result and function name are added using absolutesym
  660. * vs_hidden parameter for funcret passed in parameter
  661. * vs_hidden fixes
  662. * writenode changed to printnode and released from extdebug
  663. * -vp option added to generate a tree.log with the nodetree
  664. * nicer printnode for statements, callnode
  665. Revision 1.45 2003/03/17 18:56:02 peter
  666. * fix crash with duplicate id
  667. Revision 1.44 2003/01/02 11:14:02 michael
  668. + Patch from peter to support initial values for local variables
  669. Revision 1.43 2002/12/27 15:22:20 peter
  670. * don't allow initialized threadvars
  671. Revision 1.42 2002/12/07 14:04:59 carl
  672. * convert some vars from longint -> byte
  673. Revision 1.41 2002/11/29 22:31:19 carl
  674. + unimplemented hint directive added
  675. * hint directive parsing implemented
  676. * warning on these directives
  677. Revision 1.40 2002/11/25 17:43:21 peter
  678. * splitted defbase in defutil,symutil,defcmp
  679. * merged isconvertable and is_equal into compare_defs(_ext)
  680. * made operator search faster by walking the list only once
  681. Revision 1.39 2002/11/15 16:29:31 peter
  682. * made tasmsymbol.refs private (merged)
  683. Revision 1.38 2002/11/15 01:58:53 peter
  684. * merged changes from 1.0.7 up to 04-11
  685. - -V option for generating bug report tracing
  686. - more tracing for option parsing
  687. - errors for cdecl and high()
  688. - win32 import stabs
  689. - win32 records<=8 are returned in eax:edx (turned off by default)
  690. - heaptrc update
  691. - more info for temp management in .s file with EXTDEBUG
  692. Revision 1.37 2002/10/05 15:18:43 carl
  693. * fix heap leaks
  694. Revision 1.36 2002/10/05 12:43:26 carl
  695. * fixes for Delphi 6 compilation
  696. (warning : Some features do not work under Delphi)
  697. Revision 1.35 2002/10/04 20:53:05 carl
  698. * bugfix of crash
  699. Revision 1.34 2002/10/03 21:22:01 carl
  700. * don't make the vars regable if they are absolute and their definitions
  701. are not the same.
  702. Revision 1.33 2002/09/16 18:08:45 peter
  703. * fix setting of sp_static
  704. Revision 1.32 2002/09/09 17:34:15 peter
  705. * tdicationary.replace added to replace and item in a dictionary. This
  706. is only allowed for the same name
  707. * varsyms are inserted in symtable before the types are parsed. This
  708. fixes the long standing "var longint : longint" bug
  709. - consume_idlist and idstringlist removed. The loops are inserted
  710. at the callers place and uses the symtable for duplicate id checking
  711. Revision 1.31 2002/08/25 19:25:20 peter
  712. * sym.insert_in_data removed
  713. * symtable.insertvardata/insertconstdata added
  714. * removed insert_in_data call from symtable.insert, it needs to be
  715. called separatly. This allows to deref the address calculation
  716. * procedures now calculate the parast addresses after the procedure
  717. directives are parsed. This fixes the cdecl parast problem
  718. * push_addr_param has an extra argument that specifies if cdecl is used
  719. or not
  720. Revision 1.30 2002/07/29 21:23:44 florian
  721. * more fixes for the ppc
  722. + wrappers for the tcnvnode.first_* stuff introduced
  723. Revision 1.29 2002/07/26 21:15:40 florian
  724. * rewrote the system handling
  725. Revision 1.28 2002/07/20 11:57:55 florian
  726. * types.pas renamed to defbase.pas because D6 contains a types
  727. unit so this would conflicts if D6 programms are compiled
  728. + Willamette/SSE2 instructions to assembler added
  729. Revision 1.27 2002/06/10 13:41:26 jonas
  730. * fixed bug 1985
  731. Revision 1.26 2002/05/18 13:34:12 peter
  732. * readded missing revisions
  733. Revision 1.25 2002/05/16 19:46:43 carl
  734. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  735. + try to fix temp allocation (still in ifdef)
  736. + generic constructor calls
  737. + start of tassembler / tmodulebase class cleanup
  738. Revision 1.23 2002/04/21 18:57:24 peter
  739. * fixed memleaks when file can't be opened
  740. }