pdecl.pas 32 KB

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