pdecl.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877
  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. if (cs_create_smart in aktmoduleswitches) then
  241. begin
  242. objectlibrary.getdatalabel(hl);
  243. { we still want a warning if unused }
  244. hl.decrefs;
  245. end
  246. else
  247. objectlibrary.getlabel(hl);
  248. if token=_ID then
  249. symtablestack.insert(tlabelsym.create(orgpattern,hl))
  250. else
  251. symtablestack.insert(tlabelsym.create(pattern,hl));
  252. consume(token);
  253. end;
  254. if token<>_SEMICOLON then consume(_COMMA);
  255. until not(token in [_ID,_INTCONST]);
  256. consume(_SEMICOLON);
  257. end;
  258. { search in symtablestack used, but not defined type }
  259. procedure resolve_type_forward(p : tnamedindexitem;arg:pointer);
  260. var
  261. hpd,pd : tdef;
  262. stpos : tfileposinfo;
  263. again : boolean;
  264. srsym : tsym;
  265. srsymtable : tsymtable;
  266. {$ifdef gdb_notused}
  267. stab_str:Pchar;
  268. {$endif gdb_notused}
  269. begin
  270. { Check only typesyms or record/object fields }
  271. case tsym(p).typ of
  272. typesym :
  273. pd:=ttypesym(p).restype.def;
  274. varsym :
  275. if (tsym(p).owner.symtabletype in [objectsymtable,recordsymtable]) then
  276. pd:=tvarsym(p).vartype.def
  277. else
  278. exit;
  279. else
  280. exit;
  281. end;
  282. repeat
  283. again:=false;
  284. case pd.deftype of
  285. arraydef :
  286. begin
  287. { elementtype could also be defined using a forwarddef }
  288. pd:=tarraydef(pd).elementtype.def;
  289. again:=true;
  290. end;
  291. pointerdef,
  292. classrefdef :
  293. begin
  294. { classrefdef inherits from pointerdef }
  295. hpd:=tpointerdef(pd).pointertype.def;
  296. { still a forward def ? }
  297. if hpd.deftype=forwarddef then
  298. begin
  299. { try to resolve the forward }
  300. { get the correct position for it }
  301. stpos:=akttokenpos;
  302. akttokenpos:=tforwarddef(hpd).forwardpos;
  303. resolving_forward:=true;
  304. make_ref:=false;
  305. if not assigned(tforwarddef(hpd).tosymname) then
  306. internalerror(20021120);
  307. searchsym(tforwarddef(hpd).tosymname^,srsym,srsymtable);
  308. make_ref:=true;
  309. resolving_forward:=false;
  310. akttokenpos:=stpos;
  311. { we don't need the forwarddef anymore, dispose it }
  312. hpd.free;
  313. tpointerdef(pd).pointertype.def:=nil; { if error occurs }
  314. { was a type sym found ? }
  315. if assigned(srsym) and
  316. (srsym.typ=typesym) then
  317. begin
  318. tpointerdef(pd).pointertype.setsym(srsym);
  319. { avoid wrong unused warnings web bug 801 PM }
  320. inc(ttypesym(srsym).refs);
  321. {$ifdef GDB_UNUSED}
  322. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
  323. (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
  324. begin
  325. ttypesym(p).isusedinstab:=true;
  326. { ttypesym(p).concatstabto(debuglist);}
  327. {not stabs for forward defs }
  328. if not Ttypesym(p).isstabwritten then
  329. begin
  330. if Ttypesym(p).restype.def.typesym=p then
  331. Tstoreddef(Ttypesym(p).restype.def).concatstabto(debuglist)
  332. else
  333. begin
  334. stab_str:=Ttypesym(p).stabstring;
  335. if assigned(stab_str) then
  336. debuglist.concat(Tai_stabs.create(stab_str));
  337. Ttypesym(p).isstabwritten:=true;
  338. end;
  339. end;
  340. end;
  341. {$endif GDB_UNUSED}
  342. { we need a class type for classrefdef }
  343. if (pd.deftype=classrefdef) and
  344. not(is_class(ttypesym(srsym).restype.def)) then
  345. Message1(type_e_class_type_expected,ttypesym(srsym).restype.def.typename);
  346. end
  347. else
  348. begin
  349. MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
  350. { try to recover }
  351. tpointerdef(pd).pointertype:=generrortype;
  352. end;
  353. end;
  354. end;
  355. recorddef :
  356. trecorddef(pd).symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward,nil);
  357. objectdef :
  358. begin
  359. if not(m_fpc in aktmodeswitches) and
  360. (oo_is_forward in tobjectdef(pd).objectoptions) then
  361. begin
  362. { only give an error as the implementation may follow in an
  363. other type block which is allowed by FPC modes }
  364. MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
  365. end
  366. else
  367. begin
  368. { Check all fields of the object declaration, but don't
  369. check objectdefs in objects/records, because these
  370. can't exist (anonymous objects aren't allowed) }
  371. if not(tsym(p).owner.symtabletype in [objectsymtable,recordsymtable]) then
  372. tobjectdef(pd).symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward,nil);
  373. end;
  374. end;
  375. end;
  376. until not again;
  377. end;
  378. { reads a type declaration to the symbol table }
  379. procedure type_dec;
  380. var
  381. typename,orgtypename : stringid;
  382. newtype : ttypesym;
  383. sym : tsym;
  384. srsymtable : tsymtable;
  385. tt : ttype;
  386. oldfilepos,
  387. defpos,storetokenpos : tfileposinfo;
  388. old_block_type : tblock_type;
  389. ch : tclassheader;
  390. unique,istyperenaming : boolean;
  391. begin
  392. old_block_type:=block_type;
  393. block_type:=bt_type;
  394. consume(_TYPE);
  395. typecanbeforward:=true;
  396. repeat
  397. typename:=pattern;
  398. orgtypename:=orgpattern;
  399. defpos:=akttokenpos;
  400. istyperenaming:=false;
  401. consume(_ID);
  402. consume(_EQUAL);
  403. { support 'ttype=type word' syntax }
  404. unique:=try_to_consume(_TYPE);
  405. { is the type already defined? }
  406. searchsym(typename,sym,srsymtable);
  407. newtype:=nil;
  408. { found a symbol with this name? }
  409. if assigned(sym) then
  410. begin
  411. if (sym.typ=typesym) then
  412. begin
  413. if ((token=_CLASS) or
  414. (token=_INTERFACE)) and
  415. (assigned(ttypesym(sym).restype.def)) and
  416. is_class_or_interface(ttypesym(sym).restype.def) and
  417. (oo_is_forward in tobjectdef(ttypesym(sym).restype.def).objectoptions) then
  418. begin
  419. { we can ignore the result }
  420. { the definition is modified }
  421. object_dec(orgtypename,tobjectdef(ttypesym(sym).restype.def));
  422. newtype:=ttypesym(sym);
  423. tt:=newtype.restype;
  424. end
  425. else
  426. message1(parser_h_type_redef,typename);
  427. end;
  428. end;
  429. { no old type reused ? Then insert this new type }
  430. if not assigned(newtype) then
  431. begin
  432. { insert the new type first with an errordef, so that
  433. referencing the type before it's really set it
  434. will give an error (PFV) }
  435. tt:=generrortype;
  436. storetokenpos:=akttokenpos;
  437. newtype:=ttypesym.create(orgtypename,tt);
  438. symtablestack.insert(newtype);
  439. akttokenpos:=defpos;
  440. akttokenpos:=storetokenpos;
  441. { read the type definition }
  442. read_type(tt,orgtypename,false);
  443. { update the definition of the type }
  444. newtype.restype:=tt;
  445. if assigned(tt.sym) then
  446. istyperenaming:=true
  447. else
  448. tt.sym:=newtype;
  449. if unique and assigned(tt.def) then
  450. begin
  451. tt.setdef(tstoreddef(tt.def).getcopy);
  452. include(tt.def.defoptions,df_unique);
  453. newtype.restype:=tt;
  454. end;
  455. if assigned(tt.def) and not assigned(tt.def.typesym) then
  456. tt.def.typesym:=newtype;
  457. { KAZ: handle TGUID declaration in system unit }
  458. if (cs_compilesystem in aktmoduleswitches) and not assigned(rec_tguid) and
  459. (typename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
  460. assigned(tt.def) and (tt.def.deftype=recorddef) and (tt.def.size=16) then
  461. rec_tguid:=trecorddef(tt.def);
  462. end;
  463. if assigned(tt.def) then
  464. begin
  465. case tt.def.deftype of
  466. pointerdef :
  467. begin
  468. consume(_SEMICOLON);
  469. if try_to_consume(_FAR) then
  470. begin
  471. tpointerdef(tt.def).is_far:=true;
  472. consume(_SEMICOLON);
  473. end;
  474. end;
  475. procvardef :
  476. begin
  477. { in case of type renaming, don't parse proc directives }
  478. if istyperenaming then
  479. consume(_SEMICOLON)
  480. else
  481. begin
  482. if not is_proc_directive(token,true) then
  483. consume(_SEMICOLON);
  484. parse_var_proc_directives(tsym(newtype));
  485. handle_calling_convention(tprocvardef(tt.def));
  486. calc_parast(tprocvardef(tt.def));
  487. end;
  488. end;
  489. objectdef,
  490. recorddef :
  491. begin
  492. try_consume_hintdirective(newtype.symoptions);
  493. consume(_SEMICOLON);
  494. end;
  495. else
  496. consume(_SEMICOLON);
  497. end;
  498. end;
  499. { Write tables if we are the typesym that defines
  500. this type. This will not be done for simple type renamings }
  501. if (tt.def.typesym=newtype) then
  502. begin
  503. { file position }
  504. oldfilepos:=aktfilepos;
  505. aktfilepos:=newtype.fileinfo;
  506. { generate persistent init/final tables when it's declared in the interface so it can
  507. be reused in other used }
  508. if current_module.in_interface and
  509. ((is_class(tt.def) and
  510. tobjectdef(tt.def).members_need_inittable) or
  511. tt.def.needs_inittable) then
  512. generate_inittable(newtype);
  513. { for objects we should write the vmt and interfaces.
  514. This need to be done after the rtti has been written, because
  515. it can contain a reference to that data (PFV)
  516. This is not for forward classes }
  517. if (tt.def.deftype=objectdef) then
  518. with Tobjectdef(tt.def) do
  519. begin
  520. if not(oo_is_forward in objectoptions) then
  521. begin
  522. ch:=cclassheader.create(tobjectdef(tt.def));
  523. { generate and check virtual methods, must be done
  524. before RTTI is written }
  525. ch.genvmt;
  526. { Generate RTTI for class }
  527. generate_rtti(newtype);
  528. if is_interface(tobjectdef(tt.def)) then
  529. ch.writeinterfaceids;
  530. if (oo_has_vmt in objectoptions) then
  531. ch.writevmt;
  532. ch.free;
  533. end;
  534. end
  535. else
  536. begin
  537. { Always generate RTTI info for all types. This is to have typeinfo() return
  538. the same pointer }
  539. generate_rtti(newtype);
  540. end;
  541. aktfilepos:=oldfilepos;
  542. end;
  543. until token<>_ID;
  544. typecanbeforward:=false;
  545. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward,nil);
  546. block_type:=old_block_type;
  547. end;
  548. procedure var_dec;
  549. { parses variable declarations and inserts them in }
  550. { the top symbol table of symtablestack }
  551. begin
  552. consume(_VAR);
  553. read_var_decs(false,false,false);
  554. end;
  555. procedure property_dec;
  556. var
  557. old_block_type : tblock_type;
  558. begin
  559. consume(_PROPERTY);
  560. if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
  561. message(parser_e_resourcestring_only_sg);
  562. old_block_type:=block_type;
  563. block_type:=bt_const;
  564. repeat
  565. read_property_dec(nil);
  566. consume(_SEMICOLON);
  567. until token<>_ID;
  568. block_type:=old_block_type;
  569. end;
  570. procedure threadvar_dec;
  571. { parses thread variable declarations and inserts them in }
  572. { the top symbol table of symtablestack }
  573. begin
  574. consume(_THREADVAR);
  575. if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
  576. message(parser_e_threadvars_only_sg);
  577. read_var_decs(false,false,true);
  578. end;
  579. procedure resourcestring_dec;
  580. var
  581. orgname : stringid;
  582. p : tnode;
  583. storetokenpos,filepos : tfileposinfo;
  584. old_block_type : tblock_type;
  585. sp : pchar;
  586. begin
  587. consume(_RESOURCESTRING);
  588. if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then
  589. message(parser_e_resourcestring_only_sg);
  590. old_block_type:=block_type;
  591. block_type:=bt_const;
  592. repeat
  593. orgname:=orgpattern;
  594. filepos:=akttokenpos;
  595. consume(_ID);
  596. case token of
  597. _EQUAL:
  598. begin
  599. consume(_EQUAL);
  600. p:=comp_expr(true);
  601. storetokenpos:=akttokenpos;
  602. akttokenpos:=filepos;
  603. case p.nodetype of
  604. ordconstn:
  605. begin
  606. if is_constcharnode(p) then
  607. begin
  608. getmem(sp,2);
  609. sp[0]:=chr(tordconstnode(p).value);
  610. sp[1]:=#0;
  611. symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,1));
  612. end
  613. else
  614. Message(cg_e_illegal_expression);
  615. end;
  616. stringconstn:
  617. with Tstringconstnode(p) do
  618. begin
  619. getmem(sp,len+1);
  620. move(value_str^,sp^,len+1);
  621. symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,len));
  622. end;
  623. else
  624. Message(cg_e_illegal_expression);
  625. end;
  626. akttokenpos:=storetokenpos;
  627. consume(_SEMICOLON);
  628. p.free;
  629. end;
  630. else consume(_EQUAL);
  631. end;
  632. until token<>_ID;
  633. block_type:=old_block_type;
  634. end;
  635. end.
  636. {
  637. $Log$
  638. Revision 1.83 2004-03-08 22:07:47 peter
  639. * stabs updates to write stabs for def for all implictly used
  640. units
  641. Revision 1.82 2004/02/20 19:49:21 daniel
  642. * Message system uses open arrays internally
  643. * Bugfix for string handling in array constructor node
  644. * Micro code reductions in pdecl.pas
  645. Revision 1.81 2004/02/17 19:37:16 daniel
  646. * No longer treat threadvar is normakl var if threading off
  647. Revision 1.80 2004/02/17 17:38:11 daniel
  648. * Enable threadvars for all modes
  649. Revision 1.79 2004/02/12 15:54:03 peter
  650. * make extcycle is working again
  651. Revision 1.78 2004/02/11 19:59:06 peter
  652. * fix compilation without GDB
  653. Revision 1.77 2004/01/31 22:48:31 daniel
  654. * Fix stabs generation problem reported by Jonas
  655. Revision 1.76 2004/01/31 18:40:15 daniel
  656. * Last steps before removal of aasmtai dependency in symsym can be
  657. accomplished.
  658. Revision 1.75 2003/12/15 21:25:48 peter
  659. * reg allocations for imaginary register are now inserted just
  660. before reg allocation
  661. * tregister changed to enum to allow compile time check
  662. * fixed several tregister-tsuperregister errors
  663. Revision 1.74 2003/12/12 12:09:40 marco
  664. * always generate RTTI patch from peter
  665. Revision 1.73 2003/12/10 16:37:01 peter
  666. * global property support for fpc modes
  667. Revision 1.72 2003/11/12 15:48:48 peter
  668. * don't give redefinition warning for forward classes
  669. Revision 1.71 2003/10/03 14:45:09 peter
  670. * more proc directive for procvar fixes
  671. Revision 1.70 2003/10/02 21:13:09 peter
  672. * procvar directive parsing fixes
  673. Revision 1.69 2003/09/23 17:56:05 peter
  674. * locals and paras are allocated in the code generation
  675. * tvarsym.localloc contains the location of para/local when
  676. generating code for the current procedure
  677. Revision 1.68 2003/07/02 22:18:04 peter
  678. * paraloc splitted in callerparaloc,calleeparaloc
  679. * sparc calling convention updates
  680. Revision 1.67 2003/04/27 11:21:33 peter
  681. * aktprocdef renamed to current_procdef
  682. * procinfo renamed to current_procinfo
  683. * procinfo will now be stored in current_module so it can be
  684. cleaned up properly
  685. * gen_main_procsym changed to create_main_proc and release_main_proc
  686. to also generate a tprocinfo structure
  687. * fixed unit implicit initfinal
  688. Revision 1.66 2003/04/27 07:29:50 peter
  689. * current_procdef cleanup, current_procdef is now always nil when parsing
  690. a new procdef declaration
  691. * aktprocsym removed
  692. * lexlevel removed, use symtable.symtablelevel instead
  693. * implicit init/final code uses the normal genentry/genexit
  694. * funcret state checking updated for new funcret handling
  695. Revision 1.65 2003/04/01 16:17:15 peter
  696. * reset symbol for unique types
  697. Revision 1.64 2003/01/05 15:54:15 florian
  698. + added proper support of type = type <type>; for simple types
  699. Revision 1.63 2002/12/29 14:57:50 peter
  700. * unit loading changed to first register units and load them
  701. afterwards. This is needed to support uses xxx in yyy correctly
  702. * unit dependency check fixed
  703. Revision 1.62 2002/12/05 19:27:40 carl
  704. - remove lower in hint
  705. Revision 1.61 2002/11/25 18:43:32 carl
  706. - removed the invalid if <> checking (Delphi is strange on this)
  707. + implemented abstract warning on instance creation of class with
  708. abstract methods.
  709. * some error message cleanups
  710. Revision 1.60 2002/11/23 22:50:06 carl
  711. * some small speed optimizations
  712. + added several new warnings/hints
  713. Revision 1.59 2002/11/17 16:31:56 carl
  714. * memory optimization (3-4%) : cleanup of tai fields,
  715. cleanup of tdef and tsym fields.
  716. * make it work for m68k
  717. Revision 1.58 2002/11/15 16:29:30 peter
  718. * made tasmsymbol.refs private (merged)
  719. Revision 1.57 2002/10/20 15:34:16 peter
  720. * removed df_unique flag. It breaks code. For a good type=type <id>
  721. a def copy is required
  722. Revision 1.56 2002/10/19 15:09:25 peter
  723. + tobjectdef.members_need_inittable that is used to generate only the
  724. inittable when it is really used. This saves a lot of useless calls
  725. to fpc_finalize when destroying classes
  726. Revision 1.55 2002/10/14 19:45:02 peter
  727. * only allow threadvar when threading switch is defined
  728. Revision 1.54 2002/10/06 12:25:05 florian
  729. + proper support of type <id> = type <another id>;
  730. Revision 1.53 2002/08/25 19:25:19 peter
  731. * sym.insert_in_data removed
  732. * symtable.insertvardata/insertconstdata added
  733. * removed insert_in_data call from symtable.insert, it needs to be
  734. called separatly. This allows to deref the address calculation
  735. * procedures now calculate the parast addresses after the procedure
  736. directives are parsed. This fixes the cdecl parast problem
  737. * push_addr_param has an extra argument that specifies if cdecl is used
  738. or not
  739. Revision 1.52 2002/08/12 15:08:40 carl
  740. + stab register indexes for powerpc (moved from gdb to cpubase)
  741. + tprocessor enumeration moved to cpuinfo
  742. + linker in target_info is now a class
  743. * many many updates for m68k (will soon start to compile)
  744. - removed some ifdef or correct them for correct cpu
  745. Revision 1.51 2002/08/11 14:32:27 peter
  746. * renamed current_library to objectlibrary
  747. Revision 1.50 2002/08/11 13:24:12 peter
  748. * saving of asmsymbols in ppu supported
  749. * asmsymbollist global is removed and moved into a new class
  750. tasmlibrarydata that will hold the info of a .a file which
  751. corresponds with a single module. Added librarydata to tmodule
  752. to keep the library info stored for the module. In the future the
  753. objectfiles will also be stored to the tasmlibrarydata class
  754. * all getlabel/newasmsymbol and friends are moved to the new class
  755. Revision 1.49 2002/07/29 21:23:43 florian
  756. * more fixes for the ppc
  757. + wrappers for the tcnvnode.first_* stuff introduced
  758. Revision 1.48 2002/07/01 18:46:25 peter
  759. * internal linker
  760. * reorganized aasm layer
  761. Revision 1.47 2002/06/12 13:20:29 jonas
  762. * fix from Florian for init/final info of forward classes
  763. Revision 1.46 2002/05/18 13:34:12 peter
  764. * readded missing revisions
  765. Revision 1.45 2002/05/16 19:46:42 carl
  766. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  767. + try to fix temp allocation (still in ifdef)
  768. + generic constructor calls
  769. + start of tassembler / tmodulebase class cleanup
  770. Revision 1.43 2002/05/12 16:53:08 peter
  771. * moved entry and exitcode to ncgutil and cgobj
  772. * foreach gets extra argument for passing local data to the
  773. iterator function
  774. * -CR checks also class typecasts at runtime by changing them
  775. into as
  776. * fixed compiler to cycle with the -CR option
  777. * fixed stabs with elf writer, finally the global variables can
  778. be watched
  779. * removed a lot of routines from cga unit and replaced them by
  780. calls to cgobj
  781. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  782. u32bit then the other is typecasted also to u32bit without giving
  783. a rangecheck warning/error.
  784. * fixed pascal calling method with reversing also the high tree in
  785. the parast, detected by tcalcst3 test
  786. Revision 1.42 2002/04/19 15:46:02 peter
  787. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  788. in most cases and not written to the ppu
  789. * add mangeledname_prefix() routine to generate the prefix of
  790. manglednames depending on the current procedure, object and module
  791. * removed static procprefix since the mangledname is now build only
  792. on demand from tprocdef.mangledname
  793. Revision 1.41 2002/03/04 17:54:59 peter
  794. * allow oridinal labels again
  795. }