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,
  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. 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. { variable }
  230. else if (pt.nodetype=loadn) then
  231. begin
  232. { we should check the result type of srsym }
  233. if not (tloadnode(pt).symtableentry.typ in [varsym,typedconstsym]) then
  234. Message(parser_e_absolute_only_to_var_or_const);
  235. abssym:=tabsolutesym.create(vs.realname,tt);
  236. abssym.fileinfo:=vs.fileinfo;
  237. abssym.abstyp:=tovar;
  238. abssym.ref:=tstoredsym(tloadnode(pt).symtableentry);
  239. symtablestack.replace(vs,abssym);
  240. vs.free;
  241. { the variable cannot be put into a register
  242. if the size definition is not the same.
  243. }
  244. if tloadnode(pt).symtableentry.typ = varsym then
  245. begin
  246. if abssym.vartype.def <>
  247. tvarsym(tloadnode(pt).symtableentry).vartype.def then
  248. tvarsym(tloadnode(pt).symtableentry).varoptions:=
  249. tvarsym(tloadnode(pt).symtableentry).varoptions-[vo_regable,vo_fpuregable]
  250. end;
  251. end
  252. { address }
  253. else if is_constintnode(pt) and
  254. ((target_info.system in [system_i386_go32v2,system_i386_watcom,
  255. system_i386_wdosx,system_i386_win32]) or
  256. (m_objfpc in aktmodeswitches) or
  257. (m_delphi in aktmodeswitches)) then
  258. begin
  259. abssym:=tabsolutesym.create(vs.realname,tt);
  260. abssym.fileinfo:=vs.fileinfo;
  261. abssym.abstyp:=toaddr;
  262. abssym.absseg:=false;
  263. abssym.fieldoffset:=tordconstnode(pt).value;
  264. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  265. try_to_consume(_COLON) then
  266. begin
  267. pt.free;
  268. pt:=expr;
  269. if is_constintnode(pt) then
  270. begin
  271. abssym.fieldoffset:=abssym.fieldoffset shl 4+tordconstnode(pt).value;
  272. abssym.absseg:=true;
  273. end
  274. else
  275. Message(type_e_ordinal_expr_expected);
  276. end;
  277. symtablestack.replace(vs,abssym);
  278. vs.free;
  279. end
  280. else
  281. Message(parser_e_absolute_only_to_var_or_const);
  282. if assigned(abssym) then
  283. begin
  284. { try to consume the hint directives with absolute symbols }
  285. dummysymoptions:=[];
  286. try_consume_hintdirective(dummysymoptions);
  287. abssym.symoptions := abssym.symoptions + dummysymoptions;
  288. end;
  289. pt.free;
  290. symdone:=true;
  291. end;
  292. { Records and objects can't have default values }
  293. if is_record or is_object then
  294. begin
  295. { try to parse the hint directives }
  296. dummysymoptions:=[];
  297. try_consume_hintdirective(dummysymoptions);
  298. { for a record there doesn't need to be a ; before the END or ) }
  299. if not(token in [_END,_RKLAMMER]) then
  300. consume(_SEMICOLON);
  301. end
  302. else
  303. begin
  304. { Process procvar directives before = and ; }
  305. if (tt.def.deftype=procvardef) and
  306. (tt.def.typesym=nil) and
  307. is_proc_directive(token,true) then
  308. begin
  309. newtype:=ttypesym.create('unnamed',tt);
  310. parse_var_proc_directives(tsym(newtype));
  311. newtype.restype.def:=nil;
  312. tt.def.typesym:=nil;
  313. newtype.free;
  314. end;
  315. { try to parse the hint directives }
  316. dummysymoptions:=[];
  317. try_consume_hintdirective(dummysymoptions);
  318. { Handling of Delphi typed const = initialized vars ! }
  319. { When should this be rejected ?
  320. - in parasymtable
  321. - in record or object
  322. - ... (PM) }
  323. if (token=_EQUAL) and
  324. not(m_tp7 in aktmodeswitches) and
  325. not(symtablestack.symtabletype in [parasymtable]) and
  326. not is_record and
  327. not is_object then
  328. begin
  329. vs:=tvarsym(sc.first);
  330. if assigned(vs.listnext) then
  331. Message(parser_e_initialized_only_one_var);
  332. if is_threadvar then
  333. Message(parser_e_initialized_not_for_threadvar);
  334. if symtablestack.symtabletype=localsymtable then
  335. begin
  336. consume(_EQUAL);
  337. tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
  338. vs.defaultconstsym:=tconstsym;
  339. symtablestack.insert(tconstsym);
  340. insertconstdata(tconstsym);
  341. readtypedconst(tt,tconstsym,false);
  342. end
  343. else
  344. begin
  345. tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
  346. tconstsym.fileinfo:=vs.fileinfo;
  347. symtablestack.replace(vs,tconstsym);
  348. vs.free;
  349. insertconstdata(tconstsym);
  350. consume(_EQUAL);
  351. readtypedconst(tt,tconstsym,true);
  352. symdone:=true;
  353. end;
  354. consume(_SEMICOLON);
  355. end
  356. else
  357. begin
  358. consume(_SEMICOLON);
  359. end;
  360. end;
  361. { Parse procvar directives after ; }
  362. if (tt.def.deftype=procvardef) and
  363. (tt.def.typesym=nil) then
  364. begin
  365. if is_proc_directive(token,true) then
  366. begin
  367. newtype:=ttypesym.create('unnamed',tt);
  368. parse_var_proc_directives(tsym(newtype));
  369. newtype.restype.def:=nil;
  370. tt.def.typesym:=nil;
  371. newtype.free;
  372. end;
  373. { Add calling convention for procvar }
  374. handle_calling_convention(tprocvardef(tt.def));
  375. end;
  376. { Check for variable directives }
  377. if not symdone and (token=_ID) then
  378. begin
  379. { Check for C Variable declarations }
  380. if (m_cvar_support in aktmodeswitches) and
  381. not(is_record or is_object or is_threadvar) and
  382. (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
  383. begin
  384. { only allowed for one var }
  385. vs:=tvarsym(sc.first);
  386. if assigned(vs.listnext) then
  387. Message(parser_e_absolute_only_one_var);
  388. { set type of the var }
  389. vs.vartype:=tt;
  390. vs.symoptions := vs.symoptions + dummysymoptions;
  391. { defaults }
  392. is_dll:=false;
  393. is_cdecl:=false;
  394. extern_var:=false;
  395. export_var:=false;
  396. C_name:=sorg;
  397. { cdecl }
  398. if idtoken=_CVAR then
  399. begin
  400. consume(_CVAR);
  401. consume(_SEMICOLON);
  402. is_cdecl:=true;
  403. C_name:=target_info.Cprefix+sorg;
  404. end;
  405. { external }
  406. if idtoken=_EXTERNAL then
  407. begin
  408. consume(_EXTERNAL);
  409. extern_var:=true;
  410. end;
  411. { export }
  412. if idtoken in [_EXPORT,_PUBLIC] then
  413. begin
  414. consume(_ID);
  415. if extern_var or
  416. (symtablestack.symtabletype in [parasymtable,localsymtable]) then
  417. Message(parser_e_not_external_and_export)
  418. else
  419. export_var:=true;
  420. end;
  421. { external and export need a name after when no cdecl is used }
  422. if not is_cdecl then
  423. begin
  424. { dll name ? }
  425. if (extern_var) and (idtoken<>_NAME) then
  426. begin
  427. is_dll:=true;
  428. dll_name:=get_stringconst;
  429. end;
  430. consume(_NAME);
  431. C_name:=get_stringconst;
  432. end;
  433. { consume the ; when export or external is used }
  434. if extern_var or export_var then
  435. consume(_SEMICOLON);
  436. { set some vars options }
  437. if is_dll then
  438. include(vs.varoptions,vo_is_dll_var)
  439. else
  440. include(vs.varoptions,vo_is_C_var);
  441. vs.set_mangledname(C_Name);
  442. if export_var then
  443. begin
  444. inc(vs.refs);
  445. include(vs.varoptions,vo_is_exported);
  446. end;
  447. if extern_var then
  448. include(vs.varoptions,vo_is_external);
  449. { insert in the datasegment when it is not external }
  450. if (not extern_var) then
  451. insertbssdata(vs);
  452. { now we can insert it in the import lib if its a dll, or
  453. add it to the externals }
  454. if extern_var then
  455. begin
  456. if is_dll then
  457. begin
  458. if not(current_module.uses_imports) then
  459. begin
  460. current_module.uses_imports:=true;
  461. importlib.preparelib(current_module.modulename^);
  462. end;
  463. importlib.importvariable(vs,C_name,dll_name);
  464. end
  465. else
  466. if target_info.DllScanSupported then
  467. current_module.Externals.insert(tExternalsItem.create(vs.mangledname));
  468. end;
  469. symdone:=true;
  470. end
  471. else
  472. if (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then
  473. begin
  474. include(current_object_option,sp_static);
  475. insert_syms(sc,tt,false,dummysymoptions);
  476. exclude(current_object_option,sp_static);
  477. consume(_STATIC);
  478. consume(_SEMICOLON);
  479. symdone:=true;
  480. end;
  481. end;
  482. { insert it in the symtable, if not done yet }
  483. if not symdone then
  484. begin
  485. { save object option, because we can turn of the sp_published }
  486. if (sp_published in current_object_option) and
  487. not(is_class(tt.def)) then
  488. begin
  489. Message(parser_e_cant_publish_that);
  490. exclude(current_object_option,sp_published);
  491. { recover by changing access type to public }
  492. vs2:=tvarsym(sc.first);
  493. while assigned (vs2) do
  494. begin
  495. exclude(vs2.symoptions,sp_published);
  496. include(vs2.symoptions,sp_public);
  497. vs2:=tvarsym(vs2.listnext);
  498. end;
  499. end
  500. else
  501. if (sp_published in current_object_option) and
  502. not(oo_can_have_published in tobjectdef(tt.def).objectoptions) then
  503. begin
  504. Message(parser_e_only_publishable_classes_can__be_published);
  505. exclude(current_object_option,sp_published);
  506. end;
  507. insert_syms(sc,tt,is_threadvar,dummysymoptions);
  508. current_object_option:=old_current_object_option;
  509. end;
  510. end;
  511. { Check for Case }
  512. if is_record and (token=_CASE) then
  513. begin
  514. maxsize:=0;
  515. maxalignment:=0;
  516. consume(_CASE);
  517. sorg:=orgpattern;
  518. hs:=pattern;
  519. searchsym(hs,srsym,srsymtable);
  520. { may be only a type: }
  521. if assigned(srsym) and (srsym.typ in [typesym,unitsym]) then
  522. begin
  523. { for records, don't search the recordsymtable for
  524. the symbols of the types }
  525. oldsymtablestack:=symtablestack;
  526. symtablestack:=symtablestack.next;
  527. read_type(casetype,'',true);
  528. symtablestack:=oldsymtablestack;
  529. end
  530. else
  531. begin
  532. consume(_ID);
  533. consume(_COLON);
  534. { for records, don't search the recordsymtable for
  535. the symbols of the types }
  536. oldsymtablestack:=symtablestack;
  537. symtablestack:=symtablestack.next;
  538. read_type(casetype,'',true);
  539. symtablestack:=oldsymtablestack;
  540. vs:=tvarsym.create(sorg,vs_value,casetype);
  541. tabstractrecordsymtable(symtablestack).insertfield(vs,true);
  542. end;
  543. if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def) then
  544. Message(type_e_ordinal_expr_expected);
  545. consume(_OF);
  546. UnionSymtable:=trecordsymtable.create;
  547. Unionsymtable.next:=symtablestack;
  548. registerdef:=false;
  549. UnionDef:=trecorddef.create(unionsymtable);
  550. uniondef.isunion:=true;
  551. if assigned(symtablestack.defowner) then
  552. Uniondef.owner:=symtablestack.defowner.owner;
  553. registerdef:=true;
  554. startvarrecsize:=UnionSymtable.datasize;
  555. startvarrecalign:=UnionSymtable.dataalignment;
  556. symtablestack:=UnionSymtable;
  557. repeat
  558. repeat
  559. pt:=comp_expr(true);
  560. if not(pt.nodetype=ordconstn) then
  561. Message(cg_e_illegal_expression);
  562. pt.free;
  563. if token=_COMMA then
  564. consume(_COMMA)
  565. else
  566. break;
  567. until false;
  568. consume(_COLON);
  569. { read the vars }
  570. consume(_LKLAMMER);
  571. inc(variantrecordlevel);
  572. if token<>_RKLAMMER then
  573. read_var_decs(true,false,false);
  574. dec(variantrecordlevel);
  575. consume(_RKLAMMER);
  576. { calculates maximal variant size }
  577. maxsize:=max(maxsize,unionsymtable.datasize);
  578. maxalignment:=max(maxalignment,unionsymtable.dataalignment);
  579. { the items of the next variant are overlayed }
  580. unionsymtable.datasize:=startvarrecsize;
  581. unionsymtable.dataalignment:=startvarrecalign;
  582. if (token<>_END) and (token<>_RKLAMMER) then
  583. consume(_SEMICOLON)
  584. else
  585. break;
  586. until (token=_END) or (token=_RKLAMMER);
  587. { at last set the record size to that of the biggest variant }
  588. unionsymtable.datasize:=maxsize;
  589. unionsymtable.dataalignment:=maxalignment;
  590. uniontype.def:=uniondef;
  591. uniontype.sym:=nil;
  592. UnionSym:=tvarsym.create('$case',vs_value,uniontype);
  593. symtablestack:=symtablestack.next;
  594. { we do NOT call symtablestack.insert
  595. on purpose PM }
  596. if aktalignment.recordalignmax=-1 then
  597. begin
  598. {$ifdef i386}
  599. if maxalignment>2 then
  600. minalignment:=4
  601. else if maxalignment>1 then
  602. minalignment:=2
  603. else
  604. minalignment:=1;
  605. {$else}
  606. {$ifdef m68k}
  607. minalignment:=2;
  608. {$endif}
  609. minalignment:=1;
  610. {$endif}
  611. end
  612. else
  613. minalignment:=maxalignment;
  614. usedalign:=used_align(maxalignment,minalignment,maxalignment);
  615. offset:=align(trecordsymtable(symtablestack).datasize,usedalign);
  616. trecordsymtable(symtablestack).datasize:=offset+unionsymtable.datasize;
  617. if maxalignment>trecordsymtable(symtablestack).dataalignment then
  618. trecordsymtable(symtablestack).dataalignment:=maxalignment;
  619. Unionsymtable.Insert_in(trecordsymtable(symtablestack),offset);
  620. Unionsym.owner:=nil;
  621. unionsym.free;
  622. uniondef.owner:=nil;
  623. uniondef.free;
  624. end;
  625. block_type:=old_block_type;
  626. current_object_option:=old_current_object_option;
  627. { free the list }
  628. sc.free;
  629. end;
  630. end.
  631. {
  632. $Log$
  633. Revision 1.56 2003-10-05 12:55:37 peter
  634. * allow absolute with value for win32,wdos
  635. Revision 1.55 2003/10/03 14:45:09 peter
  636. * more proc directive for procvar fixes
  637. Revision 1.54 2003/10/02 21:13:09 peter
  638. * procvar directive parsing fixes
  639. Revision 1.53 2003/10/02 15:12:07 peter
  640. * fix type parsing in records
  641. Revision 1.52 2003/10/01 19:05:33 peter
  642. * searchsym_type to search for type definitions. It ignores
  643. records,objects and parameters
  644. Revision 1.51 2003/09/23 17:56:05 peter
  645. * locals and paras are allocated in the code generation
  646. * tvarsym.localloc contains the location of para/local when
  647. generating code for the current procedure
  648. Revision 1.50 2003/09/07 14:14:51 florian
  649. * proper error recovering from invalid published fields
  650. Revision 1.49 2003/09/05 17:41:12 florian
  651. * merged Wiktor's Watcom patches in 1.1
  652. Revision 1.48 2003/07/02 22:18:04 peter
  653. * paraloc splitted in callerparaloc,calleeparaloc
  654. * sparc calling convention updates
  655. Revision 1.47 2003/05/09 17:47:03 peter
  656. * self moved to hidden parameter
  657. * removed hdisposen,hnewn,selfn
  658. Revision 1.46 2003/04/25 20:59:33 peter
  659. * removed funcretn,funcretsym, function result is now in varsym
  660. and aliases for result and function name are added using absolutesym
  661. * vs_hidden parameter for funcret passed in parameter
  662. * vs_hidden fixes
  663. * writenode changed to printnode and released from extdebug
  664. * -vp option added to generate a tree.log with the nodetree
  665. * nicer printnode for statements, callnode
  666. Revision 1.45 2003/03/17 18:56:02 peter
  667. * fix crash with duplicate id
  668. Revision 1.44 2003/01/02 11:14:02 michael
  669. + Patch from peter to support initial values for local variables
  670. Revision 1.43 2002/12/27 15:22:20 peter
  671. * don't allow initialized threadvars
  672. Revision 1.42 2002/12/07 14:04:59 carl
  673. * convert some vars from longint -> byte
  674. Revision 1.41 2002/11/29 22:31:19 carl
  675. + unimplemented hint directive added
  676. * hint directive parsing implemented
  677. * warning on these directives
  678. Revision 1.40 2002/11/25 17:43:21 peter
  679. * splitted defbase in defutil,symutil,defcmp
  680. * merged isconvertable and is_equal into compare_defs(_ext)
  681. * made operator search faster by walking the list only once
  682. Revision 1.39 2002/11/15 16:29:31 peter
  683. * made tasmsymbol.refs private (merged)
  684. Revision 1.38 2002/11/15 01:58:53 peter
  685. * merged changes from 1.0.7 up to 04-11
  686. - -V option for generating bug report tracing
  687. - more tracing for option parsing
  688. - errors for cdecl and high()
  689. - win32 import stabs
  690. - win32 records<=8 are returned in eax:edx (turned off by default)
  691. - heaptrc update
  692. - more info for temp management in .s file with EXTDEBUG
  693. Revision 1.37 2002/10/05 15:18:43 carl
  694. * fix heap leaks
  695. Revision 1.36 2002/10/05 12:43:26 carl
  696. * fixes for Delphi 6 compilation
  697. (warning : Some features do not work under Delphi)
  698. Revision 1.35 2002/10/04 20:53:05 carl
  699. * bugfix of crash
  700. Revision 1.34 2002/10/03 21:22:01 carl
  701. * don't make the vars regable if they are absolute and their definitions
  702. are not the same.
  703. Revision 1.33 2002/09/16 18:08:45 peter
  704. * fix setting of sp_static
  705. Revision 1.32 2002/09/09 17:34:15 peter
  706. * tdicationary.replace added to replace and item in a dictionary. This
  707. is only allowed for the same name
  708. * varsyms are inserted in symtable before the types are parsed. This
  709. fixes the long standing "var longint : longint" bug
  710. - consume_idlist and idstringlist removed. The loops are inserted
  711. at the callers place and uses the symtable for duplicate id checking
  712. Revision 1.31 2002/08/25 19:25:20 peter
  713. * sym.insert_in_data removed
  714. * symtable.insertvardata/insertconstdata added
  715. * removed insert_in_data call from symtable.insert, it needs to be
  716. called separatly. This allows to deref the address calculation
  717. * procedures now calculate the parast addresses after the procedure
  718. directives are parsed. This fixes the cdecl parast problem
  719. * push_addr_param has an extra argument that specifies if cdecl is used
  720. or not
  721. Revision 1.30 2002/07/29 21:23:44 florian
  722. * more fixes for the ppc
  723. + wrappers for the tcnvnode.first_* stuff introduced
  724. Revision 1.29 2002/07/26 21:15:40 florian
  725. * rewrote the system handling
  726. Revision 1.28 2002/07/20 11:57:55 florian
  727. * types.pas renamed to defbase.pas because D6 contains a types
  728. unit so this would conflicts if D6 programms are compiled
  729. + Willamette/SSE2 instructions to assembler added
  730. Revision 1.27 2002/06/10 13:41:26 jonas
  731. * fixed bug 1985
  732. Revision 1.26 2002/05/18 13:34:12 peter
  733. * readded missing revisions
  734. Revision 1.25 2002/05/16 19:46:43 carl
  735. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  736. + try to fix temp allocation (still in ifdef)
  737. + generic constructor calls
  738. + start of tassembler / tmodulebase class cleanup
  739. Revision 1.23 2002/04/21 18:57:24 peter
  740. * fixed memleaks when file can't be opened
  741. }