pdecvar.pas 32 KB

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