pdecl.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Does declaration (but not type) parsing for Free Pascal
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit pdecl;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { global }
  23. globals,
  24. { symtable }
  25. symsym,
  26. { pass_1 }
  27. node;
  28. function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym;
  29. procedure const_dec;
  30. procedure label_dec;
  31. procedure type_dec;
  32. procedure var_dec;
  33. procedure threadvar_dec;
  34. procedure property_dec;
  35. procedure resourcestring_dec;
  36. implementation
  37. uses
  38. { common }
  39. cutils,cclasses,
  40. { global }
  41. globtype,tokens,verbose,
  42. systems,
  43. { aasm }
  44. aasmbase,aasmtai,fmodule,
  45. { symtable }
  46. symconst,symbase,symtype,symdef,symtable,paramgr,
  47. { pass 1 }
  48. nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
  49. { codegen }
  50. ncgutil,
  51. {$ifdef GDB}
  52. gdb,
  53. {$endif GDB}
  54. { parser }
  55. scanner,
  56. pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
  57. { cpu-information }
  58. cpuinfo
  59. ;
  60. function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym;
  61. var
  62. hp : tconstsym;
  63. p : tnode;
  64. ps : pconstset;
  65. pd : pbestreal;
  66. pg : pguid;
  67. sp : pchar;
  68. storetokenpos : tfileposinfo;
  69. begin
  70. readconstant:=nil;
  71. if orgname='' then
  72. internalerror(9584582);
  73. hp:=nil;
  74. p:=comp_expr(true);
  75. storetokenpos:=akttokenpos;
  76. akttokenpos:=filepos;
  77. case p.nodetype of
  78. ordconstn:
  79. begin
  80. if is_constintnode(p) then
  81. hp:=tconstsym.create_ord_typed(orgname,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
  82. else if is_constcharnode(p) then
  83. hp:=tconstsym.create_ord(orgname,constchar,tordconstnode(p).value)
  84. else if is_constboolnode(p) then
  85. hp:=tconstsym.create_ord(orgname,constbool,tordconstnode(p).value)
  86. else if is_constwidecharnode(p) then
  87. hp:=tconstsym.create_ord(orgname,constwchar,tordconstnode(p).value)
  88. else if p.resulttype.def.deftype=enumdef then
  89. hp:=tconstsym.create_ord_typed(orgname,constord,tordconstnode(p).value,p.resulttype)
  90. else if p.resulttype.def.deftype=pointerdef then
  91. hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tordconstnode(p).value,p.resulttype)
  92. else internalerror(111);
  93. end;
  94. stringconstn:
  95. begin
  96. getmem(sp,tstringconstnode(p).len+1);
  97. move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
  98. hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len);
  99. end;
  100. realconstn :
  101. begin
  102. new(pd);
  103. pd^:=trealconstnode(p).value_real;
  104. hp:=tconstsym.create_ptr(orgname,constreal,pd);
  105. end;
  106. setconstn :
  107. begin
  108. new(ps);
  109. ps^:=tsetconstnode(p).value_set^;
  110. hp:=tconstsym.create_ptr_typed(orgname,constset,ps,p.resulttype);
  111. end;
  112. pointerconstn :
  113. begin
  114. hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tpointerconstnode(p).value,p.resulttype);
  115. end;
  116. niln :
  117. begin
  118. hp:=tconstsym.create_ord_typed(orgname,constnil,0,p.resulttype);
  119. end;
  120. typen :
  121. begin
  122. if is_interface(p.resulttype.def) then
  123. begin
  124. if assigned(tobjectdef(p.resulttype.def).iidguid) then
  125. begin
  126. new(pg);
  127. pg^:=tobjectdef(p.resulttype.def).iidguid^;
  128. hp:=tconstsym.create_ptr(orgname,constguid,pg);
  129. end
  130. else
  131. Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objrealname^);
  132. end
  133. else
  134. Message(cg_e_illegal_expression);
  135. end;
  136. else
  137. Message(cg_e_illegal_expression);
  138. end;
  139. akttokenpos:=storetokenpos;
  140. p.free;
  141. readconstant:=hp;
  142. end;
  143. procedure const_dec;
  144. var
  145. orgname : stringid;
  146. tt : ttype;
  147. sym : tsym;
  148. storetokenpos,filepos : tfileposinfo;
  149. old_block_type : tblock_type;
  150. skipequal : boolean;
  151. begin
  152. consume(_CONST);
  153. old_block_type:=block_type;
  154. block_type:=bt_const;
  155. repeat
  156. orgname:=orgpattern;
  157. filepos:=akttokenpos;
  158. consume(_ID);
  159. case token of
  160. _EQUAL:
  161. begin
  162. consume(_EQUAL);
  163. sym:=readconstant(orgname,filepos);
  164. if assigned(sym) then
  165. symtablestack.insert(sym);
  166. try_consume_hintdirective(sym.symoptions);
  167. consume(_SEMICOLON);
  168. end;
  169. _COLON:
  170. begin
  171. { set the blocktype first so a consume also supports a
  172. caret, to support const s : ^string = nil }
  173. block_type:=bt_type;
  174. consume(_COLON);
  175. ignore_equal:=true;
  176. read_type(tt,'',false);
  177. ignore_equal:=false;
  178. block_type:=bt_const;
  179. skipequal:=false;
  180. { create symbol }
  181. storetokenpos:=akttokenpos;
  182. akttokenpos:=filepos;
  183. sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
  184. akttokenpos:=storetokenpos;
  185. symtablestack.insert(sym);
  186. insertconstdata(ttypedconstsym(sym));
  187. { procvar can have proc directives, but not type references }
  188. if (tt.def.deftype=procvardef) and
  189. (tt.sym=nil) then
  190. begin
  191. { support p : procedure;stdcall=nil; }
  192. if try_to_consume(_SEMICOLON) then
  193. begin
  194. if is_proc_directive(token,true) then
  195. parse_var_proc_directives(sym)
  196. else
  197. begin
  198. Message(parser_e_proc_directive_expected);
  199. skipequal:=true;
  200. end;
  201. end
  202. else
  203. { support p : procedure stdcall=nil; }
  204. begin
  205. if is_proc_directive(token,true) then
  206. parse_var_proc_directives(sym);
  207. end;
  208. { add default calling convention }
  209. handle_calling_convention(tabstractprocdef(tt.def));
  210. calc_parast(tprocvardef(tt.def));
  211. end;
  212. if not skipequal then
  213. begin
  214. { get init value }
  215. consume(_EQUAL);
  216. readtypedconst(tt,ttypedconstsym(sym),(cs_typed_const_writable in aktlocalswitches));
  217. try_consume_hintdirective(sym.symoptions);
  218. consume(_SEMICOLON);
  219. end;
  220. end;
  221. else
  222. { generate an error }
  223. consume(_EQUAL);
  224. end;
  225. until token<>_ID;
  226. block_type:=old_block_type;
  227. end;
  228. procedure label_dec;
  229. var
  230. hl : tasmlabel;
  231. begin
  232. consume(_LABEL);
  233. if not(cs_support_goto in aktmoduleswitches) then
  234. Message(sym_e_goto_and_label_not_supported);
  235. repeat
  236. if not(token in [_ID,_INTCONST]) then
  237. consume(_ID)
  238. else
  239. begin
  240. objectlibrary.getlabel(hl);
  241. if token=_ID then
  242. symtablestack.insert(tlabelsym.create(orgpattern,hl))
  243. else
  244. symtablestack.insert(tlabelsym.create(pattern,hl));
  245. consume(token);
  246. end;
  247. if token<>_SEMICOLON then consume(_COMMA);
  248. until not(token in [_ID,_INTCONST]);
  249. consume(_SEMICOLON);
  250. end;
  251. { search in symtablestack used, but not defined type }
  252. procedure resolve_type_forward(p : tnamedindexitem;arg:pointer);
  253. var
  254. hpd,pd : tdef;
  255. stpos : tfileposinfo;
  256. again : boolean;
  257. srsym : tsym;
  258. srsymtable : tsymtable;
  259. {$ifdef gdb_notused}
  260. stab_str:Pchar;
  261. {$endif gdb_notused}
  262. begin
  263. { Check only typesyms or record/object fields }
  264. case tsym(p).typ of
  265. typesym :
  266. pd:=ttypesym(p).restype.def;
  267. varsym :
  268. if (tsym(p).owner.symtabletype in [objectsymtable,recordsymtable]) then
  269. pd:=tvarsym(p).vartype.def
  270. else
  271. exit;
  272. else
  273. exit;
  274. end;
  275. repeat
  276. again:=false;
  277. case pd.deftype of
  278. arraydef :
  279. begin
  280. { elementtype could also be defined using a forwarddef }
  281. pd:=tarraydef(pd).elementtype.def;
  282. again:=true;
  283. end;
  284. pointerdef,
  285. classrefdef :
  286. begin
  287. { classrefdef inherits from pointerdef }
  288. hpd:=tpointerdef(pd).pointertype.def;
  289. { still a forward def ? }
  290. if hpd.deftype=forwarddef then
  291. begin
  292. { try to resolve the forward }
  293. { get the correct position for it }
  294. stpos:=akttokenpos;
  295. akttokenpos:=tforwarddef(hpd).forwardpos;
  296. resolving_forward:=true;
  297. make_ref:=false;
  298. if not assigned(tforwarddef(hpd).tosymname) then
  299. internalerror(20021120);
  300. searchsym(tforwarddef(hpd).tosymname^,srsym,srsymtable);
  301. make_ref:=true;
  302. resolving_forward:=false;
  303. akttokenpos:=stpos;
  304. { we don't need the forwarddef anymore, dispose it }
  305. hpd.free;
  306. tpointerdef(pd).pointertype.def:=nil; { if error occurs }
  307. { was a type sym found ? }
  308. if assigned(srsym) and
  309. (srsym.typ=typesym) then
  310. begin
  311. tpointerdef(pd).pointertype.setsym(srsym);
  312. { avoid wrong unused warnings web bug 801 PM }
  313. inc(ttypesym(srsym).refs);
  314. {$ifdef GDB_UNUSED}
  315. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
  316. (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
  317. begin
  318. ttypesym(p).isusedinstab:=true;
  319. { ttypesym(p).concatstabto(debuglist);}
  320. {not stabs for forward defs }
  321. if not Ttypesym(p).isstabwritten then
  322. begin
  323. if Ttypesym(p).restype.def.typesym=p then
  324. Tstoreddef(Ttypesym(p).restype.def).concatstabto(debuglist)
  325. else
  326. begin
  327. stab_str:=Ttypesym(p).stabstring;
  328. if assigned(stab_str) then
  329. debuglist.concat(Tai_stabs.create(stab_str));
  330. Ttypesym(p).isstabwritten:=true;
  331. end;
  332. end;
  333. end;
  334. {$endif GDB_UNUSED}
  335. { we need a class type for classrefdef }
  336. if (pd.deftype=classrefdef) and
  337. not(is_class(ttypesym(srsym).restype.def)) then
  338. Message1(type_e_class_type_expected,ttypesym(srsym).restype.def.typename);
  339. end
  340. else
  341. begin
  342. MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
  343. { try to recover }
  344. tpointerdef(pd).pointertype:=generrortype;
  345. end;
  346. end;
  347. end;
  348. recorddef :
  349. trecorddef(pd).symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward,nil);
  350. objectdef :
  351. begin
  352. if not(m_fpc in aktmodeswitches) and
  353. (oo_is_forward in tobjectdef(pd).objectoptions) then
  354. begin
  355. { only give an error as the implementation may follow in an
  356. other type block which is allowed by FPC modes }
  357. MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
  358. end
  359. else
  360. begin
  361. { Check all fields of the object declaration, but don't
  362. check objectdefs in objects/records, because these
  363. can't exist (anonymous objects aren't allowed) }
  364. if not(tsym(p).owner.symtabletype in [objectsymtable,recordsymtable]) then
  365. tobjectdef(pd).symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward,nil);
  366. end;
  367. end;
  368. end;
  369. until not again;
  370. end;
  371. { reads a type declaration to the symbol table }
  372. procedure type_dec;
  373. var
  374. typename,orgtypename : stringid;
  375. newtype : ttypesym;
  376. sym : tsym;
  377. srsymtable : tsymtable;
  378. tt : ttype;
  379. oldfilepos,
  380. defpos,storetokenpos : tfileposinfo;
  381. old_block_type : tblock_type;
  382. ch : tclassheader;
  383. unique,istyperenaming : boolean;
  384. begin
  385. old_block_type:=block_type;
  386. block_type:=bt_type;
  387. consume(_TYPE);
  388. typecanbeforward:=true;
  389. repeat
  390. typename:=pattern;
  391. orgtypename:=orgpattern;
  392. defpos:=akttokenpos;
  393. istyperenaming:=false;
  394. consume(_ID);
  395. consume(_EQUAL);
  396. { support 'ttype=type word' syntax }
  397. unique:=try_to_consume(_TYPE);
  398. { is the type already defined? }
  399. searchsym(typename,sym,srsymtable);
  400. newtype:=nil;
  401. { found a symbol with this name? }
  402. if assigned(sym) then
  403. begin
  404. if (sym.typ=typesym) then
  405. begin
  406. if ((token=_CLASS) or
  407. (token=_INTERFACE)) and
  408. (assigned(ttypesym(sym).restype.def)) and
  409. is_class_or_interface(ttypesym(sym).restype.def) and
  410. (oo_is_forward in tobjectdef(ttypesym(sym).restype.def).objectoptions) then
  411. begin
  412. { we can ignore the result }
  413. { the definition is modified }
  414. object_dec(orgtypename,tobjectdef(ttypesym(sym).restype.def));
  415. newtype:=ttypesym(sym);
  416. tt:=newtype.restype;
  417. end
  418. else
  419. message1(parser_h_type_redef,typename);
  420. end;
  421. end;
  422. { no old type reused ? Then insert this new type }
  423. if not assigned(newtype) then
  424. begin
  425. { insert the new type first with an errordef, so that
  426. referencing the type before it's really set it
  427. will give an error (PFV) }
  428. tt:=generrortype;
  429. storetokenpos:=akttokenpos;
  430. newtype:=ttypesym.create(orgtypename,tt);
  431. symtablestack.insert(newtype);
  432. akttokenpos:=defpos;
  433. akttokenpos:=storetokenpos;
  434. { read the type definition }
  435. read_type(tt,orgtypename,false);
  436. { update the definition of the type }
  437. newtype.restype:=tt;
  438. if assigned(tt.sym) then
  439. istyperenaming:=true
  440. else
  441. tt.sym:=newtype;
  442. if unique and assigned(tt.def) then
  443. begin
  444. tt.setdef(tstoreddef(tt.def).getcopy);
  445. include(tt.def.defoptions,df_unique);
  446. newtype.restype:=tt;
  447. end;
  448. if assigned(tt.def) and not assigned(tt.def.typesym) then
  449. tt.def.typesym:=newtype;
  450. { KAZ: handle TGUID declaration in system unit }
  451. if (cs_compilesystem in aktmoduleswitches) and not assigned(rec_tguid) and
  452. (typename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
  453. assigned(tt.def) and (tt.def.deftype=recorddef) and (tt.def.size=16) then
  454. rec_tguid:=trecorddef(tt.def);
  455. end;
  456. if assigned(tt.def) then
  457. begin
  458. case tt.def.deftype of
  459. pointerdef :
  460. begin
  461. consume(_SEMICOLON);
  462. if try_to_consume(_FAR) then
  463. begin
  464. tpointerdef(tt.def).is_far:=true;
  465. consume(_SEMICOLON);
  466. end;
  467. end;
  468. procvardef :
  469. begin
  470. { in case of type renaming, don't parse proc directives }
  471. if istyperenaming then
  472. consume(_SEMICOLON)
  473. else
  474. begin
  475. if not is_proc_directive(token,true) then
  476. consume(_SEMICOLON);
  477. parse_var_proc_directives(tsym(newtype));
  478. handle_calling_convention(tprocvardef(tt.def));
  479. calc_parast(tprocvardef(tt.def));
  480. end;
  481. end;
  482. objectdef,
  483. recorddef :
  484. begin
  485. try_consume_hintdirective(newtype.symoptions);
  486. consume(_SEMICOLON);
  487. end;
  488. else
  489. consume(_SEMICOLON);
  490. end;
  491. end;
  492. { Write tables if we are the typesym that defines
  493. this type. This will not be done for simple type renamings }
  494. if (tt.def.typesym=newtype) then
  495. begin
  496. { file position }
  497. oldfilepos:=aktfilepos;
  498. aktfilepos:=newtype.fileinfo;
  499. { generate persistent init/final tables when it's declared in the interface so it can
  500. be reused in other used }
  501. if current_module.in_interface and
  502. ((is_class(tt.def) and
  503. tobjectdef(tt.def).members_need_inittable) or
  504. tt.def.needs_inittable) then
  505. generate_inittable(newtype);
  506. { for objects we should write the vmt and interfaces.
  507. This need to be done after the rtti has been written, because
  508. it can contain a reference to that data (PFV)
  509. This is not for forward classes }
  510. if (tt.def.deftype=objectdef) then
  511. with Tobjectdef(tt.def) do
  512. begin
  513. if not(oo_is_forward in objectoptions) then
  514. begin
  515. ch:=cclassheader.create(tobjectdef(tt.def));
  516. { generate and check virtual methods, must be done
  517. before RTTI is written }
  518. ch.genvmt;
  519. { Generate RTTI for class }
  520. generate_rtti(newtype);
  521. if is_interface(tobjectdef(tt.def)) then
  522. ch.writeinterfaceids;
  523. if (oo_has_vmt in objectoptions) then
  524. ch.writevmt;
  525. ch.free;
  526. end;
  527. end
  528. else
  529. begin
  530. { Always generate RTTI info for all types. This is to have typeinfo() return
  531. the same pointer }
  532. generate_rtti(newtype);
  533. end;
  534. aktfilepos:=oldfilepos;
  535. end;
  536. until token<>_ID;
  537. typecanbeforward:=false;
  538. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward,nil);
  539. block_type:=old_block_type;
  540. end;
  541. procedure var_dec;
  542. { parses variable declarations and inserts them in }
  543. { the top symbol table of symtablestack }
  544. begin
  545. consume(_VAR);
  546. read_var_decs(false,false,false);
  547. end;
  548. procedure property_dec;
  549. var
  550. old_block_type : tblock_type;
  551. begin
  552. consume(_PROPERTY);
  553. if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
  554. message(parser_e_resourcestring_only_sg);
  555. old_block_type:=block_type;
  556. block_type:=bt_const;
  557. repeat
  558. read_property_dec(nil);
  559. consume(_SEMICOLON);
  560. until token<>_ID;
  561. block_type:=old_block_type;
  562. end;
  563. procedure threadvar_dec;
  564. { parses thread variable declarations and inserts them in }
  565. { the top symbol table of symtablestack }
  566. begin
  567. consume(_THREADVAR);
  568. if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
  569. message(parser_e_threadvars_only_sg);
  570. read_var_decs(false,false,true);
  571. end;
  572. procedure resourcestring_dec;
  573. var
  574. orgname : stringid;
  575. p : tnode;
  576. storetokenpos,filepos : tfileposinfo;
  577. old_block_type : tblock_type;
  578. sp : pchar;
  579. begin
  580. consume(_RESOURCESTRING);
  581. if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
  582. message(parser_e_resourcestring_only_sg);
  583. old_block_type:=block_type;
  584. block_type:=bt_const;
  585. repeat
  586. orgname:=orgpattern;
  587. filepos:=akttokenpos;
  588. consume(_ID);
  589. case token of
  590. _EQUAL:
  591. begin
  592. consume(_EQUAL);
  593. p:=comp_expr(true);
  594. storetokenpos:=akttokenpos;
  595. akttokenpos:=filepos;
  596. case p.nodetype of
  597. ordconstn:
  598. begin
  599. if is_constcharnode(p) then
  600. begin
  601. getmem(sp,2);
  602. sp[0]:=chr(tordconstnode(p).value);
  603. sp[1]:=#0;
  604. symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,1));
  605. end
  606. else
  607. Message(cg_e_illegal_expression);
  608. end;
  609. stringconstn:
  610. with Tstringconstnode(p) do
  611. begin
  612. getmem(sp,len+1);
  613. move(value_str^,sp^,len+1);
  614. symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,len));
  615. end;
  616. else
  617. Message(cg_e_illegal_expression);
  618. end;
  619. akttokenpos:=storetokenpos;
  620. consume(_SEMICOLON);
  621. p.free;
  622. end;
  623. else consume(_EQUAL);
  624. end;
  625. until token<>_ID;
  626. block_type:=old_block_type;
  627. end;
  628. end.
  629. {
  630. $Log$
  631. Revision 1.84 2004-03-20 20:55:36 florian
  632. + implemented cdecl'd varargs on arm
  633. + -dCMEM supported by the compiler
  634. * label/goto asmsymbol type with -dextdebug fixed
  635. Revision 1.83 2004/03/08 22:07:47 peter
  636. * stabs updates to write stabs for def for all implictly used
  637. units
  638. Revision 1.82 2004/02/20 19:49:21 daniel
  639. * Message system uses open arrays internally
  640. * Bugfix for string handling in array constructor node
  641. * Micro code reductions in pdecl.pas
  642. Revision 1.81 2004/02/17 19:37:16 daniel
  643. * No longer treat threadvar is normakl var if threading off
  644. Revision 1.80 2004/02/17 17:38:11 daniel
  645. * Enable threadvars for all modes
  646. Revision 1.79 2004/02/12 15:54:03 peter
  647. * make extcycle is working again
  648. Revision 1.78 2004/02/11 19:59:06 peter
  649. * fix compilation without GDB
  650. Revision 1.77 2004/01/31 22:48:31 daniel
  651. * Fix stabs generation problem reported by Jonas
  652. Revision 1.76 2004/01/31 18:40:15 daniel
  653. * Last steps before removal of aasmtai dependency in symsym can be
  654. accomplished.
  655. Revision 1.75 2003/12/15 21:25:48 peter
  656. * reg allocations for imaginary register are now inserted just
  657. before reg allocation
  658. * tregister changed to enum to allow compile time check
  659. * fixed several tregister-tsuperregister errors
  660. Revision 1.74 2003/12/12 12:09:40 marco
  661. * always generate RTTI patch from peter
  662. Revision 1.73 2003/12/10 16:37:01 peter
  663. * global property support for fpc modes
  664. Revision 1.72 2003/11/12 15:48:48 peter
  665. * don't give redefinition warning for forward classes
  666. Revision 1.71 2003/10/03 14:45:09 peter
  667. * more proc directive for procvar fixes
  668. Revision 1.70 2003/10/02 21:13:09 peter
  669. * procvar directive parsing fixes
  670. Revision 1.69 2003/09/23 17:56:05 peter
  671. * locals and paras are allocated in the code generation
  672. * tvarsym.localloc contains the location of para/local when
  673. generating code for the current procedure
  674. Revision 1.68 2003/07/02 22:18:04 peter
  675. * paraloc splitted in callerparaloc,calleeparaloc
  676. * sparc calling convention updates
  677. Revision 1.67 2003/04/27 11:21:33 peter
  678. * aktprocdef renamed to current_procdef
  679. * procinfo renamed to current_procinfo
  680. * procinfo will now be stored in current_module so it can be
  681. cleaned up properly
  682. * gen_main_procsym changed to create_main_proc and release_main_proc
  683. to also generate a tprocinfo structure
  684. * fixed unit implicit initfinal
  685. Revision 1.66 2003/04/27 07:29:50 peter
  686. * current_procdef cleanup, current_procdef is now always nil when parsing
  687. a new procdef declaration
  688. * aktprocsym removed
  689. * lexlevel removed, use symtable.symtablelevel instead
  690. * implicit init/final code uses the normal genentry/genexit
  691. * funcret state checking updated for new funcret handling
  692. Revision 1.65 2003/04/01 16:17:15 peter
  693. * reset symbol for unique types
  694. Revision 1.64 2003/01/05 15:54:15 florian
  695. + added proper support of type = type <type>; for simple types
  696. Revision 1.63 2002/12/29 14:57:50 peter
  697. * unit loading changed to first register units and load them
  698. afterwards. This is needed to support uses xxx in yyy correctly
  699. * unit dependency check fixed
  700. Revision 1.62 2002/12/05 19:27:40 carl
  701. - remove lower in hint
  702. Revision 1.61 2002/11/25 18:43:32 carl
  703. - removed the invalid if <> checking (Delphi is strange on this)
  704. + implemented abstract warning on instance creation of class with
  705. abstract methods.
  706. * some error message cleanups
  707. Revision 1.60 2002/11/23 22:50:06 carl
  708. * some small speed optimizations
  709. + added several new warnings/hints
  710. Revision 1.59 2002/11/17 16:31:56 carl
  711. * memory optimization (3-4%) : cleanup of tai fields,
  712. cleanup of tdef and tsym fields.
  713. * make it work for m68k
  714. Revision 1.58 2002/11/15 16:29:30 peter
  715. * made tasmsymbol.refs private (merged)
  716. Revision 1.57 2002/10/20 15:34:16 peter
  717. * removed df_unique flag. It breaks code. For a good type=type <id>
  718. a def copy is required
  719. Revision 1.56 2002/10/19 15:09:25 peter
  720. + tobjectdef.members_need_inittable that is used to generate only the
  721. inittable when it is really used. This saves a lot of useless calls
  722. to fpc_finalize when destroying classes
  723. Revision 1.55 2002/10/14 19:45:02 peter
  724. * only allow threadvar when threading switch is defined
  725. Revision 1.54 2002/10/06 12:25:05 florian
  726. + proper support of type <id> = type <another id>;
  727. Revision 1.53 2002/08/25 19:25:19 peter
  728. * sym.insert_in_data removed
  729. * symtable.insertvardata/insertconstdata added
  730. * removed insert_in_data call from symtable.insert, it needs to be
  731. called separatly. This allows to deref the address calculation
  732. * procedures now calculate the parast addresses after the procedure
  733. directives are parsed. This fixes the cdecl parast problem
  734. * push_addr_param has an extra argument that specifies if cdecl is used
  735. or not
  736. Revision 1.52 2002/08/12 15:08:40 carl
  737. + stab register indexes for powerpc (moved from gdb to cpubase)
  738. + tprocessor enumeration moved to cpuinfo
  739. + linker in target_info is now a class
  740. * many many updates for m68k (will soon start to compile)
  741. - removed some ifdef or correct them for correct cpu
  742. Revision 1.51 2002/08/11 14:32:27 peter
  743. * renamed current_library to objectlibrary
  744. Revision 1.50 2002/08/11 13:24:12 peter
  745. * saving of asmsymbols in ppu supported
  746. * asmsymbollist global is removed and moved into a new class
  747. tasmlibrarydata that will hold the info of a .a file which
  748. corresponds with a single module. Added librarydata to tmodule
  749. to keep the library info stored for the module. In the future the
  750. objectfiles will also be stored to the tasmlibrarydata class
  751. * all getlabel/newasmsymbol and friends are moved to the new class
  752. Revision 1.49 2002/07/29 21:23:43 florian
  753. * more fixes for the ppc
  754. + wrappers for the tcnvnode.first_* stuff introduced
  755. Revision 1.48 2002/07/01 18:46:25 peter
  756. * internal linker
  757. * reorganized aasm layer
  758. Revision 1.47 2002/06/12 13:20:29 jonas
  759. * fix from Florian for init/final info of forward classes
  760. Revision 1.46 2002/05/18 13:34:12 peter
  761. * readded missing revisions
  762. Revision 1.45 2002/05/16 19:46:42 carl
  763. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  764. + try to fix temp allocation (still in ifdef)
  765. + generic constructor calls
  766. + start of tassembler / tmodulebase class cleanup
  767. Revision 1.43 2002/05/12 16:53:08 peter
  768. * moved entry and exitcode to ncgutil and cgobj
  769. * foreach gets extra argument for passing local data to the
  770. iterator function
  771. * -CR checks also class typecasts at runtime by changing them
  772. into as
  773. * fixed compiler to cycle with the -CR option
  774. * fixed stabs with elf writer, finally the global variables can
  775. be watched
  776. * removed a lot of routines from cga unit and replaced them by
  777. calls to cgobj
  778. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  779. u32bit then the other is typecasted also to u32bit without giving
  780. a rangecheck warning/error.
  781. * fixed pascal calling method with reversing also the high tree in
  782. the parast, detected by tcalcst3 test
  783. Revision 1.42 2002/04/19 15:46:02 peter
  784. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  785. in most cases and not written to the ppu
  786. * add mangeledname_prefix() routine to generate the prefix of
  787. manglednames depending on the current procedure, object and module
  788. * removed static procprefix since the mangledname is now build only
  789. on demand from tprocdef.mangledname
  790. Revision 1.41 2002/03/04 17:54:59 peter
  791. * allow oridinal labels again
  792. }