pexpr.pas 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692
  1. {
  2. $Id$
  3. Copyright (c) 1998-2001 by Florian Klaempfl
  4. Does parsing of expression 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 pexpr;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. symtype,
  23. node,
  24. cpuinfo;
  25. { reads a whole expression }
  26. function expr : tnode;
  27. { reads an expression without assignements and .. }
  28. function comp_expr(accept_equal : boolean):tnode;
  29. { reads a single factor }
  30. function factor(getaddr : boolean) : tnode;
  31. procedure string_dec(var t: ttype);
  32. { the ID token has to be consumed before calling this function }
  33. procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean);
  34. {$ifdef int64funcresok}
  35. function get_intconst:TConstExprInt;
  36. {$else int64funcresok}
  37. function get_intconst:longint;
  38. {$endif int64funcresok}
  39. function get_stringconst:string;
  40. implementation
  41. uses
  42. {$ifdef delphi}
  43. SysUtils,
  44. {$endif}
  45. { common }
  46. cutils,
  47. { global }
  48. globtype,globals,tokens,verbose,
  49. systems,widestr,
  50. { symtable }
  51. symconst,symbase,symdef,symsym,symtable,types,
  52. { pass 1 }
  53. pass_1,htypechk,
  54. nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
  55. { parser }
  56. scanner,
  57. pbase,
  58. { codegen }
  59. cgbase
  60. ;
  61. { sub_expr(opmultiply) is need to get -1 ** 4 to be
  62. read as - (1**4) and not (-1)**4 PM }
  63. type
  64. Toperator_precedence=(opcompare,opaddition,opmultiply,oppower);
  65. const
  66. highest_precedence = oppower;
  67. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;forward;
  68. const
  69. got_addrn : boolean = false;
  70. auto_inherited : boolean = false;
  71. procedure string_dec(var t: ttype);
  72. { reads a string type with optional length }
  73. { and returns a pointer to the string }
  74. { definition }
  75. var
  76. p : tnode;
  77. begin
  78. t:=cshortstringtype;
  79. consume(_STRING);
  80. if token=_LECKKLAMMER then
  81. begin
  82. consume(_LECKKLAMMER);
  83. p:=comp_expr(true);
  84. if not is_constintnode(p) then
  85. begin
  86. Message(cg_e_illegal_expression);
  87. { error recovery }
  88. consume(_RECKKLAMMER);
  89. end
  90. else
  91. begin
  92. if (tordconstnode(p).value<=0) then
  93. begin
  94. Message(parser_e_invalid_string_size);
  95. tordconstnode(p).value:=255;
  96. end;
  97. consume(_RECKKLAMMER);
  98. if tordconstnode(p).value>255 then
  99. t.setdef(tstringdef.createlong(tordconstnode(p).value))
  100. else
  101. if tordconstnode(p).value<>255 then
  102. t.setdef(tstringdef.createshort(tordconstnode(p).value));
  103. end;
  104. p.free;
  105. end
  106. else
  107. begin
  108. if cs_ansistrings in aktlocalswitches then
  109. t:=cansistringtype
  110. else
  111. t:=cshortstringtype;
  112. end;
  113. end;
  114. function parse_paras(__colon,in_prop_paras : boolean) : tnode;
  115. var
  116. p1,p2 : tnode;
  117. end_of_paras : ttoken;
  118. prev_in_args : boolean;
  119. old_allow_array_constructor : boolean;
  120. begin
  121. if in_prop_paras then
  122. end_of_paras:=_RECKKLAMMER
  123. else
  124. end_of_paras:=_RKLAMMER;
  125. if token=end_of_paras then
  126. begin
  127. parse_paras:=nil;
  128. exit;
  129. end;
  130. { save old values }
  131. prev_in_args:=in_args;
  132. old_allow_array_constructor:=allow_array_constructor;
  133. { set para parsing values }
  134. in_args:=true;
  135. inc(parsing_para_level);
  136. allow_array_constructor:=true;
  137. p2:=nil;
  138. while true do
  139. begin
  140. p1:=comp_expr(true);
  141. p2:=ccallparanode.create(p1,p2);
  142. { it's for the str(l:5,s); }
  143. if __colon and (token=_COLON) then
  144. begin
  145. consume(_COLON);
  146. p1:=comp_expr(true);
  147. p2:=ccallparanode.create(p1,p2);
  148. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  149. if token=_COLON then
  150. begin
  151. consume(_COLON);
  152. p1:=comp_expr(true);
  153. p2:=ccallparanode.create(p1,p2);
  154. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  155. end
  156. end;
  157. if token=_COMMA then
  158. consume(_COMMA)
  159. else
  160. break;
  161. end;
  162. allow_array_constructor:=old_allow_array_constructor;
  163. dec(parsing_para_level);
  164. in_args:=prev_in_args;
  165. parse_paras:=p2;
  166. end;
  167. procedure check_tp_procvar(var p : tnode);
  168. var
  169. p1 : tnode;
  170. begin
  171. if (m_tp_procvar in aktmodeswitches) and
  172. (not got_addrn) and
  173. (not in_args) and
  174. (p.nodetype=loadn) then
  175. begin
  176. { support if procvar then for tp7 and many other expression like this }
  177. do_resulttypepass(p);
  178. set_varstate(p,false);
  179. { reset varstateset to maybe set used state later web bug769 PM }
  180. unset_varstate(p);
  181. if (getprocvardef=nil) and (p.resulttype.def.deftype=procvardef) then
  182. begin
  183. p1:=ccallnode.create(nil,nil,nil,nil);
  184. tcallnode(p1).set_procvar(p);
  185. resulttypepass(p1);
  186. p:=p1;
  187. end;
  188. end;
  189. end;
  190. function new_dispose_statement(is_new:boolean) : tnode;
  191. var
  192. p,p2 : tnode;
  193. again : boolean; { dummy for do_proc_call }
  194. destructorname : stringid;
  195. sym : tsym;
  196. classh : tobjectdef;
  197. destructorpos,
  198. storepos : tfileposinfo;
  199. begin
  200. consume(_LKLAMMER);
  201. p:=comp_expr(true);
  202. { calc return type }
  203. { rg.cleartempgen; }
  204. set_varstate(p,(not is_new));
  205. { constructor,destructor specified }
  206. if try_to_consume(_COMMA) then
  207. begin
  208. { extended syntax of new and dispose }
  209. { function styled new is handled in factor }
  210. { destructors have no parameters }
  211. destructorname:=pattern;
  212. destructorpos:=akttokenpos;
  213. consume(_ID);
  214. if (p.resulttype.def.deftype<>pointerdef) then
  215. begin
  216. Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
  217. p.free;
  218. p:=factor(false);
  219. p.free;
  220. consume(_RKLAMMER);
  221. new_dispose_statement:=cerrornode.create;
  222. exit;
  223. end;
  224. { first parameter must be an object or class }
  225. if tpointerdef(p.resulttype.def).pointertype.def.deftype<>objectdef then
  226. begin
  227. Message(parser_e_pointer_to_class_expected);
  228. p.free;
  229. new_dispose_statement:=factor(false);
  230. consume_all_until(_RKLAMMER);
  231. consume(_RKLAMMER);
  232. exit;
  233. end;
  234. { check, if the first parameter is a pointer to a _class_ }
  235. classh:=tobjectdef(tpointerdef(p.resulttype.def).pointertype.def);
  236. if is_class(classh) then
  237. begin
  238. Message(parser_e_no_new_or_dispose_for_classes);
  239. new_dispose_statement:=factor(false);
  240. consume_all_until(_RKLAMMER);
  241. consume(_RKLAMMER);
  242. exit;
  243. end;
  244. { search cons-/destructor, also in parent classes }
  245. storepos:=akttokenpos;
  246. akttokenpos:=destructorpos;
  247. sym:=search_class_member(classh,destructorname);
  248. akttokenpos:=storepos;
  249. { the second parameter of new/dispose must be a call }
  250. { to a cons-/destructor }
  251. if (not assigned(sym)) or (sym.typ<>procsym) then
  252. begin
  253. if is_new then
  254. Message(parser_e_expr_have_to_be_constructor_call)
  255. else
  256. Message(parser_e_expr_have_to_be_destructor_call);
  257. p.free;
  258. new_dispose_statement:=cerrornode.create;
  259. end
  260. else
  261. begin
  262. if is_new then
  263. p2:=chnewnode.create
  264. else
  265. p2:=chdisposenode.create(p);
  266. do_resulttypepass(p2);
  267. p2.resulttype:=tpointerdef(p.resulttype.def).pointertype;
  268. if is_new then
  269. do_member_read(false,sym,p2,again)
  270. else
  271. begin
  272. if not(m_fpc in aktmodeswitches) then
  273. do_member_read(false,sym,p2,again)
  274. else
  275. begin
  276. p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
  277. { support dispose(p,done()); }
  278. if try_to_consume(_LKLAMMER) then
  279. begin
  280. if not try_to_consume(_RKLAMMER) then
  281. begin
  282. Message(parser_e_no_paras_for_destructor);
  283. consume_all_until(_RKLAMMER);
  284. consume(_RKLAMMER);
  285. end;
  286. end;
  287. end;
  288. end;
  289. { we need the real called method }
  290. { rg.cleartempgen;}
  291. do_resulttypepass(p2);
  292. if not codegenerror then
  293. begin
  294. if is_new then
  295. begin
  296. if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
  297. Message(parser_e_expr_have_to_be_constructor_call);
  298. p2:=cnewnode.create(p2);
  299. do_resulttypepass(p2);
  300. p2.resulttype:=p.resulttype;
  301. p2:=cassignmentnode.create(p,p2);
  302. end
  303. else
  304. begin
  305. if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
  306. Message(parser_e_expr_have_to_be_destructor_call);
  307. end;
  308. end;
  309. new_dispose_statement:=p2;
  310. end;
  311. end
  312. else
  313. begin
  314. if (p.resulttype.def.deftype<>pointerdef) then
  315. Begin
  316. Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
  317. new_dispose_statement:=cerrornode.create;
  318. end
  319. else
  320. begin
  321. if (tpointerdef(p.resulttype.def).pointertype.def.deftype=objectdef) and
  322. (oo_has_vmt in tobjectdef(tpointerdef(p.resulttype.def).pointertype.def).objectoptions) then
  323. Message(parser_w_use_extended_syntax_for_objects);
  324. if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
  325. (torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
  326. begin
  327. if (m_tp7 in aktmodeswitches) or
  328. (m_delphi in aktmodeswitches) then
  329. Message(parser_w_no_new_dispose_on_void_pointers)
  330. else
  331. Message(parser_e_no_new_dispose_on_void_pointers);
  332. end;
  333. if is_new then
  334. new_dispose_statement:=csimplenewdisposenode.create(simplenewn,p)
  335. else
  336. new_dispose_statement:=csimplenewdisposenode.create(simpledisposen,p);
  337. end;
  338. end;
  339. consume(_RKLAMMER);
  340. end;
  341. function new_function : tnode;
  342. var
  343. p1,p2 : tnode;
  344. classh : tobjectdef;
  345. sym : tsym;
  346. again : boolean; { dummy for do_proc_call }
  347. begin
  348. consume(_LKLAMMER);
  349. p1:=factor(false);
  350. if p1.nodetype<>typen then
  351. begin
  352. Message(type_e_type_id_expected);
  353. p1.destroy;
  354. p1:=cerrornode.create;
  355. do_resulttypepass(p1);
  356. end;
  357. if (p1.resulttype.def.deftype<>pointerdef) then
  358. Message1(type_e_pointer_type_expected,p1.resulttype.def.typename)
  359. else
  360. if token=_RKLAMMER then
  361. begin
  362. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
  363. (oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions) then
  364. Message(parser_w_use_extended_syntax_for_objects);
  365. p2:=cnewnode.create(nil);
  366. do_resulttypepass(p2);
  367. p2.resulttype:=p1.resulttype;
  368. p1.destroy;
  369. p1:=p2;
  370. consume(_RKLAMMER);
  371. end
  372. else
  373. begin
  374. p2:=chnewnode.create;
  375. do_resulttypepass(p2);
  376. p2.resulttype:=tpointerdef(p1.resulttype.def).pointertype;
  377. consume(_COMMA);
  378. afterassignment:=false;
  379. { determines the current object defintion }
  380. classh:=tobjectdef(p2.resulttype.def);
  381. if classh.deftype<>objectdef then
  382. Message(parser_e_pointer_to_class_expected)
  383. else
  384. begin
  385. { check for an abstract class }
  386. if (oo_has_abstract in classh.objectoptions) then
  387. Message(sym_e_no_instance_of_abstract_object);
  388. { search the constructor also in the symbol tables of
  389. the parents }
  390. sym:=searchsym_in_class(classh,pattern);
  391. consume(_ID);
  392. do_member_read(false,sym,p2,again);
  393. { we need to know which procedure is called }
  394. do_resulttypepass(p2);
  395. if (p2.nodetype<>calln) or
  396. (assigned(tcallnode(p2).procdefinition) and
  397. (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
  398. Message(parser_e_expr_have_to_be_constructor_call);
  399. end;
  400. p2:=cnewnode.create(p2);
  401. do_resulttypepass(p2);
  402. p2.resulttype:=p1.resulttype;
  403. p1.destroy;
  404. p1:=p2;
  405. consume(_RKLAMMER);
  406. end;
  407. new_function:=p1;
  408. end;
  409. function statement_syssym(l : longint) : tnode;
  410. var
  411. p1,p2,paras : tnode;
  412. prev_in_args : boolean;
  413. begin
  414. prev_in_args:=in_args;
  415. case l of
  416. in_new_x :
  417. begin
  418. if afterassignment or in_args then
  419. statement_syssym:=new_function
  420. else
  421. statement_syssym:=new_dispose_statement(true);
  422. end;
  423. in_dispose_x :
  424. begin
  425. statement_syssym:=new_dispose_statement(false);
  426. end;
  427. in_ord_x :
  428. begin
  429. consume(_LKLAMMER);
  430. in_args:=true;
  431. p1:=comp_expr(true);
  432. consume(_RKLAMMER);
  433. p1:=geninlinenode(in_ord_x,false,p1);
  434. statement_syssym := p1;
  435. end;
  436. in_break :
  437. begin
  438. statement_syssym:=cbreaknode.create;
  439. end;
  440. in_continue :
  441. begin
  442. statement_syssym:=ccontinuenode.create;
  443. end;
  444. in_typeof_x :
  445. begin
  446. consume(_LKLAMMER);
  447. in_args:=true;
  448. p1:=comp_expr(true);
  449. consume(_RKLAMMER);
  450. if p1.nodetype=typen then
  451. ttypenode(p1).allowed:=true;
  452. if p1.resulttype.def.deftype=objectdef then
  453. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  454. else
  455. begin
  456. Message(type_e_mismatch);
  457. p1.destroy;
  458. statement_syssym:=cerrornode.create;
  459. end;
  460. end;
  461. in_sizeof_x :
  462. begin
  463. consume(_LKLAMMER);
  464. in_args:=true;
  465. p1:=comp_expr(true);
  466. consume(_RKLAMMER);
  467. if (p1.nodetype<>typen) and
  468. (
  469. (is_object(p1.resulttype.def) and
  470. (oo_has_constructor in tobjectdef(p1.resulttype.def).objectoptions)) or
  471. is_open_array(p1.resulttype.def) or
  472. is_open_string(p1.resulttype.def)
  473. ) then
  474. statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
  475. else
  476. begin
  477. statement_syssym:=cordconstnode.create(p1.resulttype.def.size,s32bittype);
  478. { p1 not needed !}
  479. p1.destroy;
  480. end;
  481. end;
  482. in_typeinfo_x :
  483. begin
  484. consume(_LKLAMMER);
  485. in_args:=true;
  486. p1:=comp_expr(true);
  487. if p1.nodetype=typen then
  488. ttypenode(p1).allowed:=true
  489. else
  490. begin
  491. p1.destroy;
  492. p1:=cerrornode.create;
  493. Message(parser_e_illegal_parameter_list);
  494. end;
  495. consume(_RKLAMMER);
  496. p2:=ccallparanode.create(p1,nil);
  497. p2:=geninlinenode(in_typeinfo_x,false,p2);
  498. statement_syssym:=p2;
  499. end;
  500. in_assigned_x :
  501. begin
  502. consume(_LKLAMMER);
  503. in_args:=true;
  504. p1:=comp_expr(true);
  505. if not codegenerror then
  506. begin
  507. case p1.resulttype.def.deftype of
  508. pointerdef,
  509. procvardef,
  510. classrefdef : ;
  511. objectdef :
  512. if not is_class_or_interface(p1.resulttype.def) then
  513. Message(parser_e_illegal_parameter_list);
  514. else
  515. Message(parser_e_illegal_parameter_list);
  516. end;
  517. end;
  518. p2:=ccallparanode.create(p1,nil);
  519. p2:=geninlinenode(in_assigned_x,false,p2);
  520. consume(_RKLAMMER);
  521. statement_syssym:=p2;
  522. end;
  523. in_addr_x :
  524. begin
  525. consume(_LKLAMMER);
  526. in_args:=true;
  527. p1:=comp_expr(true);
  528. p1:=caddrnode.create(p1);
  529. consume(_RKLAMMER);
  530. statement_syssym:=p1;
  531. end;
  532. in_ofs_x :
  533. begin
  534. consume(_LKLAMMER);
  535. in_args:=true;
  536. p1:=comp_expr(true);
  537. p1:=caddrnode.create(p1);
  538. do_resulttypepass(p1);
  539. { Ofs() returns a cardinal, not a pointer }
  540. p1.resulttype:=u32bittype;
  541. consume(_RKLAMMER);
  542. statement_syssym:=p1;
  543. end;
  544. in_seg_x :
  545. begin
  546. consume(_LKLAMMER);
  547. in_args:=true;
  548. p1:=comp_expr(true);
  549. p1:=geninlinenode(in_seg_x,false,p1);
  550. consume(_RKLAMMER);
  551. statement_syssym:=p1;
  552. end;
  553. in_high_x,
  554. in_low_x :
  555. begin
  556. consume(_LKLAMMER);
  557. in_args:=true;
  558. p1:=comp_expr(true);
  559. p2:=geninlinenode(l,false,p1);
  560. consume(_RKLAMMER);
  561. statement_syssym:=p2;
  562. end;
  563. in_succ_x,
  564. in_pred_x :
  565. begin
  566. consume(_LKLAMMER);
  567. in_args:=true;
  568. p1:=comp_expr(true);
  569. p2:=geninlinenode(l,false,p1);
  570. consume(_RKLAMMER);
  571. statement_syssym:=p2;
  572. end;
  573. in_inc_x,
  574. in_dec_x :
  575. begin
  576. consume(_LKLAMMER);
  577. in_args:=true;
  578. p1:=comp_expr(true);
  579. if token=_COMMA then
  580. begin
  581. consume(_COMMA);
  582. p2:=ccallparanode.create(comp_expr(true),nil);
  583. end
  584. else
  585. p2:=nil;
  586. p2:=ccallparanode.create(p1,p2);
  587. statement_syssym:=geninlinenode(l,false,p2);
  588. consume(_RKLAMMER);
  589. end;
  590. in_finalize_x:
  591. begin
  592. consume(_LKLAMMER);
  593. in_args:=true;
  594. p1:=comp_expr(true);
  595. if token=_COMMA then
  596. begin
  597. consume(_COMMA);
  598. p2:=ccallparanode.create(comp_expr(true),nil);
  599. end
  600. else
  601. p2:=nil;
  602. p2:=ccallparanode.create(p1,p2);
  603. statement_syssym:=geninlinenode(in_finalize_x,false,p2);
  604. consume(_RKLAMMER);
  605. end;
  606. in_concat_x :
  607. begin
  608. consume(_LKLAMMER);
  609. in_args:=true;
  610. p2:=nil;
  611. while true do
  612. begin
  613. p1:=comp_expr(true);
  614. set_varstate(p1,true);
  615. if not((p1.resulttype.def.deftype=stringdef) or
  616. ((p1.resulttype.def.deftype=orddef) and
  617. (torddef(p1.resulttype.def).typ=uchar))) then
  618. Message(parser_e_illegal_parameter_list);
  619. if p2<>nil then
  620. p2:=caddnode.create(addn,p2,p1)
  621. else
  622. p2:=p1;
  623. if token=_COMMA then
  624. consume(_COMMA)
  625. else
  626. break;
  627. end;
  628. consume(_RKLAMMER);
  629. statement_syssym:=p2;
  630. end;
  631. in_read_x,
  632. in_readln_x :
  633. begin
  634. if token=_LKLAMMER then
  635. begin
  636. consume(_LKLAMMER);
  637. in_args:=true;
  638. paras:=parse_paras(false,false);
  639. consume(_RKLAMMER);
  640. end
  641. else
  642. paras:=nil;
  643. p1:=geninlinenode(l,false,paras);
  644. statement_syssym := p1;
  645. end;
  646. in_setlength_x:
  647. begin
  648. if token=_LKLAMMER then
  649. begin
  650. consume(_LKLAMMER);
  651. in_args:=true;
  652. paras:=parse_paras(false,false);
  653. consume(_RKLAMMER);
  654. end
  655. else
  656. paras:=nil;
  657. p1:=geninlinenode(l,false,paras);
  658. statement_syssym := p1;
  659. end;
  660. in_length_x:
  661. begin
  662. consume(_LKLAMMER);
  663. in_args:=true;
  664. p1:=comp_expr(true);
  665. p2:=geninlinenode(l,false,p1);
  666. consume(_RKLAMMER);
  667. statement_syssym:=p2;
  668. end;
  669. in_write_x,
  670. in_writeln_x :
  671. begin
  672. if token=_LKLAMMER then
  673. begin
  674. consume(_LKLAMMER);
  675. in_args:=true;
  676. paras:=parse_paras(true,false);
  677. consume(_RKLAMMER);
  678. end
  679. else
  680. paras:=nil;
  681. p1 := geninlinenode(l,false,paras);
  682. statement_syssym := p1;
  683. end;
  684. in_str_x_string :
  685. begin
  686. consume(_LKLAMMER);
  687. in_args:=true;
  688. paras:=parse_paras(true,false);
  689. consume(_RKLAMMER);
  690. p1 := geninlinenode(l,false,paras);
  691. statement_syssym := p1;
  692. end;
  693. in_val_x:
  694. Begin
  695. consume(_LKLAMMER);
  696. in_args := true;
  697. p1:= ccallparanode.create(comp_expr(true), nil);
  698. consume(_COMMA);
  699. p2 := ccallparanode.create(comp_expr(true),p1);
  700. if (token = _COMMA) then
  701. Begin
  702. consume(_COMMA);
  703. p2 := ccallparanode.create(comp_expr(true),p2)
  704. End;
  705. consume(_RKLAMMER);
  706. p2 := geninlinenode(l,false,p2);
  707. statement_syssym := p2;
  708. End;
  709. in_include_x_y,
  710. in_exclude_x_y :
  711. begin
  712. consume(_LKLAMMER);
  713. in_args:=true;
  714. p1:=comp_expr(true);
  715. consume(_COMMA);
  716. p2:=comp_expr(true);
  717. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  718. consume(_RKLAMMER);
  719. end;
  720. in_assert_x_y :
  721. begin
  722. consume(_LKLAMMER);
  723. in_args:=true;
  724. p1:=comp_expr(true);
  725. if token=_COMMA then
  726. begin
  727. consume(_COMMA);
  728. p2:=comp_expr(true);
  729. end
  730. else
  731. begin
  732. { then insert an empty string }
  733. p2:=cstringconstnode.createstr('',st_default);
  734. end;
  735. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  736. consume(_RKLAMMER);
  737. end;
  738. else
  739. internalerror(15);
  740. end;
  741. in_args:=prev_in_args;
  742. end;
  743. { reads the parameter for a subroutine call }
  744. procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode);
  745. var
  746. prevafterassn : boolean;
  747. hs,hs1 : tvarsym;
  748. para,p2 : tnode;
  749. hst : tsymtable;
  750. aprocdef : tprocdef;
  751. begin
  752. prevafterassn:=afterassignment;
  753. afterassignment:=false;
  754. { want we only determine the address of }
  755. { a subroutine ? }
  756. if not(getaddr) then
  757. begin
  758. para:=nil;
  759. if auto_inherited then
  760. begin
  761. hst:=symtablestack;
  762. while assigned(hst) and (hst.symtabletype<>parasymtable) do
  763. hst:=hst.next;
  764. if assigned(hst) then
  765. begin
  766. hs:=tvarsym(hst.symindex.first);
  767. while assigned(hs) do
  768. begin
  769. if hs.typ<>varsym then
  770. internalerror(54382953);
  771. { if there is a localcopy then use that }
  772. if assigned(hs.localvarsym) then
  773. hs1:=hs.localvarsym
  774. else
  775. hs1:=hs;
  776. para:=ccallparanode.create(cloadnode.create(hs1,hs1.owner),para);
  777. hs:=tvarsym(hs.indexnext);
  778. end;
  779. end
  780. else
  781. internalerror(54382954);
  782. end
  783. else
  784. begin
  785. if token=_LKLAMMER then
  786. begin
  787. consume(_LKLAMMER);
  788. para:=parse_paras(false,false);
  789. consume(_RKLAMMER);
  790. end;
  791. end;
  792. p1:=ccallnode.create(para,tprocsym(sym),st,p1);
  793. end
  794. else
  795. begin
  796. { address operator @: }
  797. if not assigned(p1) then
  798. begin
  799. if (st.symtabletype=withsymtable) and
  800. (st.defowner.deftype=objectdef) then
  801. begin
  802. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  803. end
  804. else
  805. begin
  806. { we must provide a method pointer, if it isn't given, }
  807. { it is self }
  808. if (st.symtabletype=objectsymtable) then
  809. p1:=cselfnode.create(tobjectdef(st.defowner));
  810. end;
  811. end;
  812. { generate a methodcallnode or proccallnode }
  813. { we shouldn't convert things like @tcollection.load }
  814. if assigned(getprocvardef) then
  815. aprocdef:=get_proc_2_procvar_def(tprocsym(sym),getprocvardef)
  816. else
  817. aprocdef:=nil;
  818. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  819. if assigned(p1) then
  820. tloadnode(p2).set_mp(p1);
  821. p1:=p2;
  822. { no postfix operators }
  823. again:=false;
  824. end;
  825. afterassignment:=prevafterassn;
  826. end;
  827. procedure handle_procvar(pv : tprocvardef;var p2 : tnode; getaddr: boolean);
  828. procedure doconv(procvar : tprocvardef;var t : tnode);
  829. var
  830. hp : tnode;
  831. currprocdef : tprocdef;
  832. begin
  833. hp:=nil;
  834. currprocdef:=get_proc_2_procvar_def(tcallnode(t).symtableprocentry,procvar);
  835. if assigned(currprocdef) then
  836. begin
  837. hp:=cloadnode.create_procvar(tprocsym(tcallnode(t).symtableprocentry),currprocdef,tcallnode(t).symtableproc);
  838. if (po_methodpointer in procvar.procoptions) then
  839. tloadnode(hp).set_mp(tnode(tcallnode(t).methodpointer).getcopy);
  840. t.destroy;
  841. t:=hp;
  842. end;
  843. end;
  844. begin
  845. if ((m_tp_procvar in aktmodeswitches) or
  846. not getaddr) then
  847. if (p2.nodetype=calln) and
  848. { a procvar can't have parameters! }
  849. not assigned(tcallnode(p2).left) then
  850. doconv(pv,p2)
  851. else
  852. if (p2.nodetype=typeconvn) and
  853. (ttypeconvnode(p2).left.nodetype=calln) and
  854. { a procvar can't have parameters! }
  855. not assigned(tcallnode(ttypeconvnode(p2).left).left) then
  856. doconv(pv,ttypeconvnode(p2).left);
  857. end;
  858. { the following procedure handles the access to a property symbol }
  859. procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode; getaddr: boolean);
  860. procedure symlist_to_node(var p1:tnode;pl:tsymlist);
  861. var
  862. plist : psymlistitem;
  863. begin
  864. plist:=pl.firstsym;
  865. while assigned(plist) do
  866. begin
  867. case plist^.sltype of
  868. sl_load :
  869. begin
  870. { p1 can already contain the loadnode of
  871. the class variable. Then we need to use a
  872. subscriptn. If no tree is found (with block), then
  873. generate a loadn }
  874. if assigned(p1) then
  875. p1:=csubscriptnode.create(tvarsym(plist^.sym),p1)
  876. else
  877. p1:=cloadnode.create(tvarsym(plist^.sym),st);
  878. end;
  879. sl_subscript :
  880. p1:=csubscriptnode.create(tvarsym(plist^.sym),p1);
  881. sl_vec :
  882. p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,s32bittype));
  883. else
  884. internalerror(200110205);
  885. end;
  886. plist:=plist^.next;
  887. end;
  888. include(p1.flags,nf_isproperty);
  889. end;
  890. var
  891. paras : tnode;
  892. p2 : tnode;
  893. begin
  894. paras:=nil;
  895. { property parameters? read them only if the property really }
  896. { has parameters }
  897. if (ppo_hasparameters in tpropertysym(sym).propoptions) then
  898. begin
  899. if token=_LECKKLAMMER then
  900. begin
  901. consume(_LECKKLAMMER);
  902. paras:=parse_paras(false,true);
  903. consume(_RECKKLAMMER);
  904. end;
  905. end;
  906. { indexed property }
  907. if (ppo_indexed in tpropertysym(sym).propoptions) then
  908. begin
  909. p2:=cordconstnode.create(tpropertysym(sym).index,tpropertysym(sym).indextype);
  910. paras:=ccallparanode.create(p2,paras);
  911. end;
  912. { we need only a write property if a := follows }
  913. { if not(afterassignment) and not(in_args) then }
  914. if token=_ASSIGNMENT then
  915. begin
  916. { write property: }
  917. if not tpropertysym(sym).writeaccess.empty then
  918. begin
  919. case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
  920. procsym :
  921. begin
  922. { generate the method call }
  923. p1:=ccallnode.create(paras,
  924. tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1);
  925. paras:=nil;
  926. consume(_ASSIGNMENT);
  927. { read the expression }
  928. if tpropertysym(sym).proptype.def.deftype=procvardef then
  929. getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
  930. p2:=comp_expr(true);
  931. if assigned(getprocvardef) then
  932. handle_procvar(getprocvardef,p2,getaddr);
  933. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  934. include(tcallnode(p1).flags,nf_isproperty);
  935. getprocvardef:=nil;
  936. end;
  937. varsym :
  938. begin
  939. { generate access code }
  940. symlist_to_node(p1,tpropertysym(sym).writeaccess);
  941. consume(_ASSIGNMENT);
  942. { read the expression }
  943. p2:=comp_expr(true);
  944. p1:=cassignmentnode.create(p1,p2);
  945. end
  946. else
  947. begin
  948. p1:=cerrornode.create;
  949. Message(parser_e_no_procedure_to_access_property);
  950. end;
  951. end;
  952. end
  953. else
  954. begin
  955. p1:=cerrornode.create;
  956. Message(parser_e_no_procedure_to_access_property);
  957. end;
  958. end
  959. else
  960. begin
  961. { read property: }
  962. if not tpropertysym(sym).readaccess.empty then
  963. begin
  964. case tpropertysym(sym).readaccess.firstsym^.sym.typ of
  965. varsym :
  966. begin
  967. { generate access code }
  968. symlist_to_node(p1,tpropertysym(sym).readaccess);
  969. end;
  970. procsym :
  971. begin
  972. { generate the method call }
  973. p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1);
  974. paras:=nil;
  975. include(p1.flags,nf_isproperty);
  976. end
  977. else
  978. begin
  979. p1:=cerrornode.create;
  980. Message(type_e_mismatch);
  981. end;
  982. end;
  983. end
  984. else
  985. begin
  986. { error, no function to read property }
  987. p1:=cerrornode.create;
  988. Message(parser_e_no_procedure_to_access_property);
  989. end;
  990. end;
  991. { release paras if not used }
  992. if assigned(paras) then
  993. paras.free;
  994. end;
  995. { the ID token has to be consumed before calling this function }
  996. procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean);
  997. var
  998. static_name : string;
  999. isclassref : boolean;
  1000. srsymtable : tsymtable;
  1001. begin
  1002. if sym=nil then
  1003. begin
  1004. { pattern is still valid unless
  1005. there is another ID just after the ID of sym }
  1006. Message1(sym_e_id_no_member,pattern);
  1007. p1.free;
  1008. p1:=cerrornode.create;
  1009. { try to clean up }
  1010. again:=false;
  1011. end
  1012. else
  1013. begin
  1014. if assigned(p1) then
  1015. begin
  1016. if not assigned(p1.resulttype.def) then
  1017. do_resulttypepass(p1);
  1018. isclassref:=(p1.resulttype.def.deftype=classrefdef);
  1019. end
  1020. else
  1021. isclassref:=false;
  1022. { we assume, that only procsyms and varsyms are in an object }
  1023. { symbol table, for classes, properties are allowed }
  1024. case sym.typ of
  1025. procsym:
  1026. begin
  1027. do_proc_call(sym,sym.owner,
  1028. getaddr or
  1029. (assigned(getprocvardef) and
  1030. ((block_type=bt_const) or
  1031. ((m_tp_procvar in aktmodeswitches) and
  1032. proc_to_procvar_equal(tprocsym(sym).defs^.def,getprocvardef,false)
  1033. )
  1034. )
  1035. ),again,p1);
  1036. if (block_type=bt_const) and
  1037. assigned(getprocvardef) then
  1038. handle_procvar(getprocvardef,p1,getaddr);
  1039. { we need to know which procedure is called }
  1040. do_resulttypepass(p1);
  1041. { now we know the real method e.g. we can check for a class method }
  1042. if isclassref and
  1043. assigned(tcallnode(p1).procdefinition) and
  1044. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1045. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1046. Message(parser_e_only_class_methods_via_class_ref);
  1047. end;
  1048. varsym:
  1049. begin
  1050. if isclassref then
  1051. Message(parser_e_only_class_methods_via_class_ref);
  1052. if (sp_static in sym.symoptions) then
  1053. begin
  1054. static_name:=lower(sym.owner.name^)+'_'+sym.name;
  1055. searchsym(static_name,sym,srsymtable);
  1056. p1.free;
  1057. p1:=cloadnode.create(tvarsym(sym),srsymtable);
  1058. end
  1059. else
  1060. p1:=csubscriptnode.create(tvarsym(sym),p1);
  1061. end;
  1062. propertysym:
  1063. begin
  1064. if isclassref then
  1065. Message(parser_e_only_class_methods_via_class_ref);
  1066. handle_propertysym(sym,sym.owner,p1,getaddr);
  1067. end;
  1068. else internalerror(16);
  1069. end;
  1070. end;
  1071. end;
  1072. {****************************************************************************
  1073. Factor
  1074. ****************************************************************************}
  1075. {$ifdef fpc}
  1076. {$maxfpuregisters 0}
  1077. {$endif fpc}
  1078. function factor(getaddr : boolean) : tnode;
  1079. {---------------------------------------------
  1080. Is_func_ret
  1081. ---------------------------------------------}
  1082. function is_func_ret(var p1:tnode;var sym : tsym;var srsymtable:tsymtable) : boolean;
  1083. var
  1084. p : pprocinfo;
  1085. storesymtablestack : tsymtable;
  1086. begin
  1087. is_func_ret:=false;
  1088. if not assigned(procinfo) or
  1089. ((sym.typ<>funcretsym) and ((procinfo^.flags and pi_operator)=0)) then
  1090. exit;
  1091. p:=procinfo;
  1092. while assigned(p) do
  1093. begin
  1094. { is this an access to a function result? Accessing _RESULT is
  1095. always allowed and funcretn is generated }
  1096. if assigned(p^.procdef.funcretsym) and
  1097. ((tfuncretsym(sym)=p^.procdef.resultfuncretsym) or
  1098. ((tfuncretsym(sym)=p^.procdef.funcretsym) or
  1099. ((tvarsym(sym)=otsym) and ((p^.flags and pi_operator)<>0))) and
  1100. (not is_void(p^.procdef.rettype.def)) and
  1101. (token<>_LKLAMMER) and
  1102. (not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args)))
  1103. ) then
  1104. begin
  1105. if ((tvarsym(sym)=otsym) and
  1106. ((p^.flags and pi_operator)<>0)) then
  1107. inc(otsym.refs);
  1108. p1:=cfuncretnode.create(p^.procdef.funcretsym);
  1109. is_func_ret:=true;
  1110. if tfuncretsym(p^.procdef.funcretsym).funcretstate=vs_declared then
  1111. begin
  1112. tfuncretsym(p^.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
  1113. include(p1.flags,nf_is_first_funcret);
  1114. end;
  1115. exit;
  1116. end;
  1117. p:=p^.parent;
  1118. end;
  1119. { we must use the function call, update the
  1120. sym to be the procsym }
  1121. if (sym.typ=funcretsym) then
  1122. begin
  1123. storesymtablestack:=symtablestack;
  1124. symtablestack:=sym.owner.next;
  1125. searchsym(sym.name,sym,srsymtable);
  1126. if not assigned(sym) then
  1127. sym:=generrorsym;
  1128. if (sym.typ<>procsym) then
  1129. Message(cg_e_illegal_expression);
  1130. symtablestack:=storesymtablestack;
  1131. end;
  1132. end;
  1133. {---------------------------------------------
  1134. Factor_read_id
  1135. ---------------------------------------------}
  1136. procedure factor_read_id(var p1:tnode;var again:boolean);
  1137. var
  1138. pc : pchar;
  1139. len : longint;
  1140. srsym : tsym;
  1141. possible_error : boolean;
  1142. srsymtable : tsymtable;
  1143. htype : ttype;
  1144. static_name : string;
  1145. begin
  1146. { allow post fix operators }
  1147. again:=true;
  1148. consume_sym(srsym,srsymtable);
  1149. if not is_func_ret(p1,srsym,srsymtable) then
  1150. begin
  1151. { check semantics of private }
  1152. if (srsym.typ in [propertysym,procsym,varsym]) and
  1153. (srsym.owner.symtabletype=objectsymtable) then
  1154. begin
  1155. if (sp_private in srsym.symoptions) and
  1156. (tobjectdef(srsym.owner.defowner).owner.symtabletype=globalsymtable) and
  1157. (tobjectdef(srsym.owner.defowner).owner.unitid<>0) then
  1158. Message(parser_e_cant_access_private_member);
  1159. end;
  1160. case srsym.typ of
  1161. absolutesym :
  1162. begin
  1163. p1:=cloadnode.create(tvarsym(srsym),srsymtable);
  1164. end;
  1165. varsym :
  1166. begin
  1167. { are we in a class method ? }
  1168. if (srsym.owner.symtabletype=objectsymtable) and
  1169. assigned(aktprocsym) and
  1170. (po_classmethod in aktprocdef.procoptions) then
  1171. Message(parser_e_only_class_methods);
  1172. if (sp_static in srsym.symoptions) then
  1173. begin
  1174. static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
  1175. searchsym(static_name,srsym,srsymtable);
  1176. end;
  1177. p1:=cloadnode.create(tvarsym(srsym),srsymtable);
  1178. if tvarsym(srsym).varstate=vs_declared then
  1179. begin
  1180. include(p1.flags,nf_first);
  1181. { set special between first loaded until checked in resulttypepass }
  1182. tvarsym(srsym).varstate:=vs_declared_and_first_found;
  1183. end;
  1184. end;
  1185. typedconstsym :
  1186. begin
  1187. p1:=cloadnode.create(srsym,srsymtable);
  1188. end;
  1189. syssym :
  1190. begin
  1191. p1:=statement_syssym(tsyssym(srsym).number);
  1192. end;
  1193. typesym :
  1194. begin
  1195. htype.setsym(srsym);
  1196. if not assigned(htype.def) then
  1197. begin
  1198. again:=false;
  1199. end
  1200. else
  1201. begin
  1202. if token=_LKLAMMER then
  1203. begin
  1204. consume(_LKLAMMER);
  1205. p1:=comp_expr(true);
  1206. consume(_RKLAMMER);
  1207. p1:=ctypeconvnode.create(p1,htype);
  1208. include(p1.flags,nf_explizit);
  1209. end
  1210. else { not LKLAMMER }
  1211. if (token=_POINT) and
  1212. is_object(htype.def) then
  1213. begin
  1214. consume(_POINT);
  1215. if assigned(procinfo) and
  1216. assigned(procinfo^._class) and
  1217. not(getaddr) then
  1218. begin
  1219. if procinfo^._class.is_related(tobjectdef(htype.def)) then
  1220. begin
  1221. p1:=ctypenode.create(htype);
  1222. { search also in inherited methods }
  1223. srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
  1224. consume(_ID);
  1225. do_member_read(false,srsym,p1,again);
  1226. end
  1227. else
  1228. begin
  1229. Message(parser_e_no_super_class);
  1230. again:=false;
  1231. end;
  1232. end
  1233. else
  1234. begin
  1235. { allows @TObject.Load }
  1236. { also allows static methods and variables }
  1237. p1:=ctypenode.create(htype);
  1238. { TP allows also @TMenu.Load if Load is only }
  1239. { defined in an anchestor class }
  1240. srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
  1241. if not assigned(srsym) then
  1242. Message1(sym_e_id_no_member,pattern)
  1243. else if not(getaddr) and not(sp_static in srsym.symoptions) then
  1244. Message(sym_e_only_static_in_static)
  1245. else
  1246. begin
  1247. consume(_ID);
  1248. do_member_read(getaddr,srsym,p1,again);
  1249. end;
  1250. end;
  1251. end
  1252. else
  1253. begin
  1254. { class reference ? }
  1255. if is_class(htype.def) then
  1256. begin
  1257. if getaddr and (token=_POINT) then
  1258. begin
  1259. consume(_POINT);
  1260. { allows @Object.Method }
  1261. { also allows static methods and variables }
  1262. p1:=ctypenode.create(htype);
  1263. { TP allows also @TMenu.Load if Load is only }
  1264. { defined in an anchestor class }
  1265. srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
  1266. if not assigned(srsym) then
  1267. Message1(sym_e_id_no_member,pattern)
  1268. else
  1269. begin
  1270. consume(_ID);
  1271. do_member_read(getaddr,srsym,p1,again);
  1272. end;
  1273. end
  1274. else
  1275. begin
  1276. p1:=ctypenode.create(htype);
  1277. { For a type block we simply return only
  1278. the type. For all other blocks we return
  1279. a loadvmt node }
  1280. if (block_type<>bt_type) then
  1281. p1:=cloadvmtnode.create(p1);
  1282. end;
  1283. end
  1284. else
  1285. p1:=ctypenode.create(htype);
  1286. end;
  1287. end;
  1288. end;
  1289. enumsym :
  1290. begin
  1291. p1:=genenumnode(tenumsym(srsym));
  1292. end;
  1293. constsym :
  1294. begin
  1295. case tconstsym(srsym).consttyp of
  1296. constint :
  1297. begin
  1298. { do a very dirty trick to bootstrap this code }
  1299. if (tconstsym(srsym).valueord>=-(int64(2147483647)+int64(1))) and
  1300. (tconstsym(srsym).valueord<=2147483647) then
  1301. p1:=cordconstnode.create(tconstsym(srsym).valueord,s32bittype)
  1302. else if (tconstsym(srsym).valueord > maxlongint) and
  1303. (tconstsym(srsym).valueord <= int64(maxlongint)+int64(maxlongint)+1) then
  1304. p1:=cordconstnode.create(tconstsym(srsym).valueord,u32bittype)
  1305. else
  1306. p1:=cordconstnode.create(tconstsym(srsym).valueord,cs64bittype);
  1307. end;
  1308. conststring :
  1309. begin
  1310. len:=tconstsym(srsym).len;
  1311. if not(cs_ansistrings in aktlocalswitches) and (len>255) then
  1312. len:=255;
  1313. getmem(pc,len+1);
  1314. move(pchar(tconstsym(srsym).valueptr)^,pc^,len);
  1315. pc[len]:=#0;
  1316. p1:=cstringconstnode.createpchar(pc,len);
  1317. end;
  1318. constchar :
  1319. p1:=cordconstnode.create(tconstsym(srsym).valueord,cchartype);
  1320. constreal :
  1321. p1:=crealconstnode.create(pbestreal(tconstsym(srsym).valueptr)^,pbestrealtype^);
  1322. constbool :
  1323. p1:=cordconstnode.create(tconstsym(srsym).valueord,booltype);
  1324. constset :
  1325. p1:=csetconstnode.create(pconstset(tconstsym(srsym).valueptr),tconstsym(srsym).consttype);
  1326. constord :
  1327. p1:=cordconstnode.create(tconstsym(srsym).valueord,tconstsym(srsym).consttype);
  1328. constpointer :
  1329. p1:=cpointerconstnode.create(tconstsym(srsym).valueordptr,tconstsym(srsym).consttype);
  1330. constnil :
  1331. p1:=cnilnode.create;
  1332. constresourcestring:
  1333. begin
  1334. p1:=cloadnode.create(tvarsym(srsym),srsymtable);
  1335. do_resulttypepass(p1);
  1336. p1.resulttype:=cansistringtype;
  1337. end;
  1338. constguid :
  1339. p1:=cguidconstnode.create(pguid(tconstsym(srsym).valueptr)^);
  1340. end;
  1341. end;
  1342. procsym :
  1343. begin
  1344. { are we in a class method ? }
  1345. possible_error:=(srsym.owner.symtabletype=objectsymtable) and
  1346. assigned(aktprocsym) and
  1347. (po_classmethod in aktprocdef.procoptions);
  1348. do_proc_call(srsym,srsymtable,
  1349. getaddr or
  1350. (assigned(getprocvardef) and
  1351. ((block_type=bt_const) or
  1352. ((m_tp_procvar in aktmodeswitches) and
  1353. proc_to_procvar_equal(tprocsym(srsym).defs^.def,getprocvardef,false)
  1354. )
  1355. )
  1356. ),again,p1);
  1357. if (block_type=bt_const) and
  1358. assigned(getprocvardef) then
  1359. handle_procvar(getprocvardef,p1,getaddr);
  1360. { we need to know which procedure is called }
  1361. if possible_error then
  1362. begin
  1363. do_resulttypepass(p1);
  1364. if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) then
  1365. Message(parser_e_only_class_methods);
  1366. end;
  1367. end;
  1368. propertysym :
  1369. begin
  1370. { access to property in a method }
  1371. { are we in a class method ? }
  1372. if (srsym.owner.symtabletype=objectsymtable) and
  1373. assigned(aktprocsym) and
  1374. (po_classmethod in aktprocdef.procoptions) then
  1375. Message(parser_e_only_class_methods);
  1376. { no method pointer }
  1377. p1:=nil;
  1378. handle_propertysym(srsym,srsymtable,p1,getaddr);
  1379. end;
  1380. labelsym :
  1381. begin
  1382. consume(_COLON);
  1383. if tlabelsym(srsym).defined then
  1384. Message(sym_e_label_already_defined);
  1385. tlabelsym(srsym).defined:=true;
  1386. p1:=clabelnode.create(tlabelsym(srsym),nil);
  1387. end;
  1388. errorsym :
  1389. begin
  1390. p1:=cerrornode.create;
  1391. if token=_LKLAMMER then
  1392. begin
  1393. consume(_LKLAMMER);
  1394. parse_paras(false,false);
  1395. consume(_RKLAMMER);
  1396. end;
  1397. end;
  1398. else
  1399. begin
  1400. p1:=cerrornode.create;
  1401. Message(cg_e_illegal_expression);
  1402. end;
  1403. end; { end case }
  1404. end;
  1405. end;
  1406. {---------------------------------------------
  1407. Factor_Read_Set
  1408. ---------------------------------------------}
  1409. { Read a set between [] }
  1410. function factor_read_set:tnode;
  1411. var
  1412. p1,p2 : tnode;
  1413. lastp,
  1414. buildp : tarrayconstructornode;
  1415. begin
  1416. buildp:=nil;
  1417. { be sure that a least one arrayconstructn is used, also for an
  1418. empty [] }
  1419. if token=_RECKKLAMMER then
  1420. buildp:=carrayconstructornode.create(nil,buildp)
  1421. else
  1422. begin
  1423. while true do
  1424. begin
  1425. p1:=comp_expr(true);
  1426. if token=_POINTPOINT then
  1427. begin
  1428. consume(_POINTPOINT);
  1429. p2:=comp_expr(true);
  1430. p1:=carrayconstructorrangenode.create(p1,p2);
  1431. end;
  1432. { insert at the end of the tree, to get the correct order }
  1433. if not assigned(buildp) then
  1434. begin
  1435. buildp:=carrayconstructornode.create(p1,nil);
  1436. lastp:=buildp;
  1437. end
  1438. else
  1439. begin
  1440. lastp.right:=carrayconstructornode.create(p1,nil);
  1441. lastp:=tarrayconstructornode(lastp.right);
  1442. end;
  1443. { there could be more elements }
  1444. if token=_COMMA then
  1445. consume(_COMMA)
  1446. else
  1447. break;
  1448. end;
  1449. end;
  1450. factor_read_set:=buildp;
  1451. end;
  1452. {---------------------------------------------
  1453. PostFixOperators
  1454. ---------------------------------------------}
  1455. procedure postfixoperators(var p1:tnode;var again:boolean);
  1456. { tries to avoid syntax errors after invalid qualifiers }
  1457. procedure recoverconsume_postfixops;
  1458. begin
  1459. while true do
  1460. begin
  1461. case token of
  1462. _CARET:
  1463. consume(_CARET);
  1464. _POINT:
  1465. begin
  1466. consume(_POINT);
  1467. if token=_ID then
  1468. consume(_ID);
  1469. end;
  1470. _LECKKLAMMER:
  1471. begin
  1472. consume(_LECKKLAMMER);
  1473. repeat
  1474. comp_expr(true);
  1475. if token=_COMMA then
  1476. consume(_COMMA)
  1477. else
  1478. break;
  1479. until false;
  1480. consume(_RECKKLAMMER);
  1481. end
  1482. else
  1483. break;
  1484. end;
  1485. end;
  1486. end;
  1487. var
  1488. store_static : boolean;
  1489. protsym : tpropertysym;
  1490. p2,p3 : tnode;
  1491. hsym : tsym;
  1492. classh : tobjectdef;
  1493. begin
  1494. again:=true;
  1495. while again do
  1496. begin
  1497. { we need the resulttype }
  1498. do_resulttypepass(p1);
  1499. if codegenerror then
  1500. begin
  1501. recoverconsume_postfixops;
  1502. exit;
  1503. end;
  1504. { handle token }
  1505. case token of
  1506. _CARET:
  1507. begin
  1508. consume(_CARET);
  1509. if (p1.resulttype.def.deftype<>pointerdef) then
  1510. begin
  1511. { ^ as binary operator is a problem!!!! (FK) }
  1512. again:=false;
  1513. Message(cg_e_invalid_qualifier);
  1514. recoverconsume_postfixops;
  1515. p1.destroy;
  1516. p1:=cerrornode.create;
  1517. end
  1518. else
  1519. begin
  1520. p1:=cderefnode.create(p1);
  1521. end;
  1522. end;
  1523. _LECKKLAMMER:
  1524. begin
  1525. if is_class_or_interface(p1.resulttype.def) then
  1526. begin
  1527. { default property }
  1528. protsym:=search_default_property(tobjectdef(p1.resulttype.def));
  1529. if not(assigned(protsym)) then
  1530. begin
  1531. p1.destroy;
  1532. p1:=cerrornode.create;
  1533. again:=false;
  1534. message(parser_e_no_default_property_available);
  1535. end
  1536. else
  1537. handle_propertysym(protsym,protsym.owner,p1,getaddr);
  1538. end
  1539. else
  1540. begin
  1541. consume(_LECKKLAMMER);
  1542. repeat
  1543. case p1.resulttype.def.deftype of
  1544. pointerdef:
  1545. begin
  1546. { support delphi autoderef }
  1547. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
  1548. (m_autoderef in aktmodeswitches) then
  1549. begin
  1550. p1:=cderefnode.create(p1);
  1551. end;
  1552. p2:=comp_expr(true);
  1553. p1:=cvecnode.create(p1,p2);
  1554. end;
  1555. stringdef :
  1556. begin
  1557. p2:=comp_expr(true);
  1558. p1:=cvecnode.create(p1,p2);
  1559. end;
  1560. arraydef :
  1561. begin
  1562. p2:=comp_expr(true);
  1563. { support SEG:OFS for go32v2 Mem[] }
  1564. if (target_info.target=target_i386_go32v2) and
  1565. (p1.nodetype=loadn) and
  1566. assigned(tloadnode(p1).symtableentry) and
  1567. assigned(tloadnode(p1).symtableentry.owner.name) and
  1568. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1569. ((tloadnode(p1).symtableentry.name='MEM') or
  1570. (tloadnode(p1).symtableentry.name='MEMW') or
  1571. (tloadnode(p1).symtableentry.name='MEML')) then
  1572. begin
  1573. if (token=_COLON) then
  1574. begin
  1575. consume(_COLON);
  1576. p3:=caddnode.create(muln,cordconstnode.create($10,s32bittype),p2);
  1577. p2:=comp_expr(true);
  1578. p2:=caddnode.create(addn,p2,p3);
  1579. p1:=cvecnode.create(p1,p2);
  1580. include(tvecnode(p1).flags,nf_memseg);
  1581. include(tvecnode(p1).flags,nf_memindex);
  1582. end
  1583. else
  1584. begin
  1585. p1:=cvecnode.create(p1,p2);
  1586. include(tvecnode(p1).flags,nf_memindex);
  1587. end;
  1588. end
  1589. else
  1590. p1:=cvecnode.create(p1,p2);
  1591. end;
  1592. else
  1593. begin
  1594. Message(cg_e_invalid_qualifier);
  1595. p1.destroy;
  1596. p1:=cerrornode.create;
  1597. comp_expr(true);
  1598. again:=false;
  1599. end;
  1600. end;
  1601. do_resulttypepass(p1);
  1602. if token=_COMMA then
  1603. consume(_COMMA)
  1604. else
  1605. break;
  1606. until false;
  1607. consume(_RECKKLAMMER);
  1608. end;
  1609. end;
  1610. _POINT :
  1611. begin
  1612. consume(_POINT);
  1613. if (p1.resulttype.def.deftype=pointerdef) and
  1614. (m_autoderef in aktmodeswitches) then
  1615. begin
  1616. p1:=cderefnode.create(p1);
  1617. do_resulttypepass(p1);
  1618. end;
  1619. case p1.resulttype.def.deftype of
  1620. recorddef:
  1621. begin
  1622. hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
  1623. if assigned(hsym) and
  1624. (hsym.typ=varsym) then
  1625. p1:=csubscriptnode.create(tvarsym(hsym),p1)
  1626. else
  1627. begin
  1628. Message1(sym_e_illegal_field,pattern);
  1629. p1.destroy;
  1630. p1:=cerrornode.create;
  1631. end;
  1632. consume(_ID);
  1633. end;
  1634. variantdef:
  1635. begin
  1636. end;
  1637. classrefdef:
  1638. begin
  1639. classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
  1640. hsym:=searchsym_in_class(classh,pattern);
  1641. if hsym=nil then
  1642. begin
  1643. Message1(sym_e_id_no_member,pattern);
  1644. p1.destroy;
  1645. p1:=cerrornode.create;
  1646. { try to clean up }
  1647. consume(_ID);
  1648. end
  1649. else
  1650. begin
  1651. consume(_ID);
  1652. do_member_read(getaddr,hsym,p1,again);
  1653. end;
  1654. end;
  1655. objectdef:
  1656. begin
  1657. store_static:=allow_only_static;
  1658. allow_only_static:=false;
  1659. classh:=tobjectdef(p1.resulttype.def);
  1660. hsym:=searchsym_in_class(classh,pattern);
  1661. allow_only_static:=store_static;
  1662. if hsym=nil then
  1663. begin
  1664. Message1(sym_e_id_no_member,pattern);
  1665. p1.destroy;
  1666. p1:=cerrornode.create;
  1667. { try to clean up }
  1668. consume(_ID);
  1669. end
  1670. else
  1671. begin
  1672. consume(_ID);
  1673. do_member_read(getaddr,hsym,p1,again);
  1674. end;
  1675. end;
  1676. pointerdef:
  1677. begin
  1678. Message(cg_e_invalid_qualifier);
  1679. if tpointerdef(p1.resulttype.def).pointertype.def.deftype in [recorddef,objectdef,classrefdef] then
  1680. Message(parser_h_maybe_deref_caret_missing);
  1681. end;
  1682. else
  1683. begin
  1684. Message(cg_e_invalid_qualifier);
  1685. p1.destroy;
  1686. p1:=cerrornode.create;
  1687. consume(_ID);
  1688. end;
  1689. end;
  1690. end;
  1691. else
  1692. begin
  1693. { is this a procedure variable ? }
  1694. if assigned(p1.resulttype.def) then
  1695. begin
  1696. if (p1.resulttype.def.deftype=procvardef) then
  1697. begin
  1698. if assigned(getprocvardef) and
  1699. is_equal(p1.resulttype.def,getprocvardef) then
  1700. again:=false
  1701. else
  1702. if (token=_LKLAMMER) or
  1703. ((tprocvardef(p1.resulttype.def).para.empty) and
  1704. (not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
  1705. (not afterassignment) and
  1706. (not in_args)) then
  1707. begin
  1708. { do this in a strange way }
  1709. { it's not a clean solution }
  1710. p2:=p1;
  1711. p1:=ccallnode.create(nil,nil,nil,nil);
  1712. tcallnode(p1).set_procvar(p2);
  1713. if token=_LKLAMMER then
  1714. begin
  1715. consume(_LKLAMMER);
  1716. tcallnode(p1).left:=parse_paras(false,false);
  1717. consume(_RKLAMMER);
  1718. end;
  1719. { proc():= is never possible }
  1720. if token=_ASSIGNMENT then
  1721. begin
  1722. Message(cg_e_illegal_expression);
  1723. p1:=cerrornode.create;
  1724. again:=false;
  1725. end;
  1726. end
  1727. else
  1728. again:=false;
  1729. end
  1730. else
  1731. again:=false;
  1732. end
  1733. else
  1734. again:=false;
  1735. end;
  1736. end;
  1737. end; { while again }
  1738. end;
  1739. {---------------------------------------------
  1740. Factor (Main)
  1741. ---------------------------------------------}
  1742. var
  1743. l : longint;
  1744. card : cardinal;
  1745. ic : TConstExprInt;
  1746. oldp1,
  1747. p1 : tnode;
  1748. code : integer;
  1749. again : boolean;
  1750. sym : tsym;
  1751. classh : tobjectdef;
  1752. d : bestreal;
  1753. hs : string;
  1754. htype : ttype;
  1755. filepos : tfileposinfo;
  1756. {---------------------------------------------
  1757. Helpers
  1758. ---------------------------------------------}
  1759. procedure check_tokenpos;
  1760. begin
  1761. if (p1<>oldp1) then
  1762. begin
  1763. if assigned(p1) then
  1764. p1.set_tree_filepos(filepos);
  1765. oldp1:=p1;
  1766. filepos:=akttokenpos;
  1767. end;
  1768. end;
  1769. begin
  1770. oldp1:=nil;
  1771. p1:=nil;
  1772. filepos:=akttokenpos;
  1773. again:=false;
  1774. if token=_ID then
  1775. begin
  1776. factor_read_id(p1,again);
  1777. if again then
  1778. begin
  1779. check_tokenpos;
  1780. { handle post fix operators }
  1781. postfixoperators(p1,again);
  1782. end;
  1783. end
  1784. else
  1785. case token of
  1786. _SELF :
  1787. begin
  1788. again:=true;
  1789. consume(_SELF);
  1790. if not assigned(procinfo^._class) then
  1791. begin
  1792. p1:=cerrornode.create;
  1793. again:=false;
  1794. Message(parser_e_self_not_in_method);
  1795. end
  1796. else
  1797. begin
  1798. if (po_classmethod in aktprocdef.procoptions) then
  1799. begin
  1800. { self in class methods is a class reference type }
  1801. htype.setdef(procinfo^._class);
  1802. p1:=cselfnode.create(tobjectdef(tclassrefdef.create(htype)));
  1803. end
  1804. else
  1805. p1:=cselfnode.create(procinfo^._class);
  1806. postfixoperators(p1,again);
  1807. end;
  1808. end;
  1809. _INHERITED :
  1810. begin
  1811. again:=true;
  1812. consume(_INHERITED);
  1813. if assigned(procinfo^._class) then
  1814. begin
  1815. { if inherited; only then we need the method with
  1816. the same name }
  1817. if token=_SEMICOLON then
  1818. begin
  1819. hs:=aktprocsym.name;
  1820. auto_inherited:=true
  1821. end
  1822. else
  1823. begin
  1824. hs:=pattern;
  1825. consume(_ID);
  1826. auto_inherited:=false;
  1827. end;
  1828. classh:=procinfo^._class.childof;
  1829. sym:=searchsym_in_class(classh,hs);
  1830. if assigned(sym) then
  1831. begin
  1832. if sym.typ=procsym then
  1833. begin
  1834. htype.setdef(classh);
  1835. p1:=ctypenode.create(htype);
  1836. end;
  1837. do_member_read(false,sym,p1,again);
  1838. end
  1839. else
  1840. begin
  1841. Message1(sym_e_id_no_member,hs);
  1842. again:=false;
  1843. p1:=cerrornode.create;
  1844. end;
  1845. { turn auto inheriting off }
  1846. auto_inherited:=false;
  1847. end
  1848. else
  1849. begin
  1850. Message(parser_e_generic_methods_only_in_methods);
  1851. again:=false;
  1852. p1:=cerrornode.create;
  1853. end;
  1854. postfixoperators(p1,again);
  1855. end;
  1856. _INTCONST :
  1857. begin
  1858. { try cardinal first }
  1859. val(pattern,card,code);
  1860. if code<>0 then
  1861. begin
  1862. { then longint }
  1863. valint(pattern,l,code);
  1864. if code <> 0 then
  1865. begin
  1866. { then int64 }
  1867. val(pattern,ic,code);
  1868. if code<>0 then
  1869. begin
  1870. {finally float }
  1871. val(pattern,d,code);
  1872. if code<>0 then
  1873. begin
  1874. Message(cg_e_invalid_integer);
  1875. consume(_INTCONST);
  1876. l:=1;
  1877. p1:=cordconstnode.create(l,s32bittype);
  1878. end
  1879. else
  1880. begin
  1881. consume(_INTCONST);
  1882. p1:=crealconstnode.create(d,pbestrealtype^);
  1883. end;
  1884. end
  1885. else
  1886. begin
  1887. consume(_INTCONST);
  1888. p1:=cordconstnode.create(ic,cs64bittype);
  1889. end
  1890. end
  1891. else
  1892. begin
  1893. consume(_INTCONST);
  1894. p1:=cordconstnode.create(l,s32bittype)
  1895. end
  1896. end
  1897. else
  1898. begin
  1899. consume(_INTCONST);
  1900. { check whether the value isn't in the longint range as well }
  1901. { (longint is easier to perform calculations with) (JM) }
  1902. if card <= $7fffffff then
  1903. { no sign extension necessary, so not longint typecast (JM) }
  1904. p1:=cordconstnode.create(card,s32bittype)
  1905. else
  1906. p1:=cordconstnode.create(card,u32bittype)
  1907. end;
  1908. end;
  1909. _REALNUMBER :
  1910. begin
  1911. val(pattern,d,code);
  1912. if code<>0 then
  1913. begin
  1914. Message(parser_e_error_in_real);
  1915. d:=1.0;
  1916. end;
  1917. consume(_REALNUMBER);
  1918. p1:=crealconstnode.create(d,pbestrealtype^);
  1919. end;
  1920. _STRING :
  1921. begin
  1922. string_dec(htype);
  1923. { STRING can be also a type cast }
  1924. if token=_LKLAMMER then
  1925. begin
  1926. consume(_LKLAMMER);
  1927. p1:=comp_expr(true);
  1928. consume(_RKLAMMER);
  1929. p1:=ctypeconvnode.create(p1,htype);
  1930. include(p1.flags,nf_explizit);
  1931. { handle postfix operators here e.g. string(a)[10] }
  1932. again:=true;
  1933. postfixoperators(p1,again);
  1934. end
  1935. else
  1936. p1:=ctypenode.create(htype);
  1937. end;
  1938. _FILE :
  1939. begin
  1940. htype:=cfiletype;
  1941. consume(_FILE);
  1942. { FILE can be also a type cast }
  1943. if token=_LKLAMMER then
  1944. begin
  1945. consume(_LKLAMMER);
  1946. p1:=comp_expr(true);
  1947. consume(_RKLAMMER);
  1948. p1:=ctypeconvnode.create(p1,htype);
  1949. include(p1.flags,nf_explizit);
  1950. { handle postfix operators here e.g. string(a)[10] }
  1951. again:=true;
  1952. postfixoperators(p1,again);
  1953. end
  1954. else
  1955. begin
  1956. p1:=ctypenode.create(htype);
  1957. end;
  1958. end;
  1959. _CSTRING :
  1960. begin
  1961. p1:=cstringconstnode.createstr(pattern,st_default);
  1962. consume(_CSTRING);
  1963. end;
  1964. _CCHAR :
  1965. begin
  1966. p1:=cordconstnode.create(ord(pattern[1]),cchartype);
  1967. consume(_CCHAR);
  1968. end;
  1969. _CWSTRING:
  1970. begin
  1971. p1:=cstringconstnode.createwstr(patternw);
  1972. consume(_CWSTRING);
  1973. end;
  1974. _CWCHAR:
  1975. begin
  1976. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype);
  1977. consume(_CWCHAR);
  1978. end;
  1979. _KLAMMERAFFE :
  1980. begin
  1981. consume(_KLAMMERAFFE);
  1982. got_addrn:=true;
  1983. { support both @<x> and @(<x>) }
  1984. if token=_LKLAMMER then
  1985. begin
  1986. consume(_LKLAMMER);
  1987. p1:=factor(true);
  1988. consume(_RKLAMMER);
  1989. if token in [_CARET,_POINT,_LECKKLAMMER] then
  1990. begin
  1991. again:=true;
  1992. postfixoperators(p1,again);
  1993. end;
  1994. end
  1995. else
  1996. p1:=factor(true);
  1997. got_addrn:=false;
  1998. p1:=caddrnode.create(p1);
  1999. if assigned(getprocvardef) then
  2000. taddrnode(p1).getprocvardef:=getprocvardef;
  2001. end;
  2002. _LKLAMMER :
  2003. begin
  2004. consume(_LKLAMMER);
  2005. p1:=comp_expr(true);
  2006. consume(_RKLAMMER);
  2007. { it's not a good solution }
  2008. { but (a+b)^ makes some problems }
  2009. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2010. begin
  2011. again:=true;
  2012. postfixoperators(p1,again);
  2013. end;
  2014. end;
  2015. _LECKKLAMMER :
  2016. begin
  2017. consume(_LECKKLAMMER);
  2018. p1:=factor_read_set;
  2019. consume(_RECKKLAMMER);
  2020. end;
  2021. _PLUS :
  2022. begin
  2023. consume(_PLUS);
  2024. p1:=factor(false);
  2025. end;
  2026. _MINUS :
  2027. begin
  2028. consume(_MINUS);
  2029. p1:=sub_expr(oppower,false);
  2030. p1:=cunaryminusnode.create(p1);
  2031. end;
  2032. _OP_NOT :
  2033. begin
  2034. consume(_OP_NOT);
  2035. p1:=factor(false);
  2036. p1:=cnotnode.create(p1);
  2037. end;
  2038. _TRUE :
  2039. begin
  2040. consume(_TRUE);
  2041. p1:=cordconstnode.create(1,booltype);
  2042. end;
  2043. _FALSE :
  2044. begin
  2045. consume(_FALSE);
  2046. p1:=cordconstnode.create(0,booltype);
  2047. end;
  2048. _NIL :
  2049. begin
  2050. consume(_NIL);
  2051. p1:=cnilnode.create;
  2052. end;
  2053. else
  2054. begin
  2055. p1:=cerrornode.create;
  2056. consume(token);
  2057. Message(cg_e_illegal_expression);
  2058. end;
  2059. end;
  2060. { generate error node if no node is created }
  2061. if not assigned(p1) then
  2062. begin
  2063. {$ifdef EXTDEBUG}
  2064. Comment(V_Warning,'factor: p1=nil');
  2065. {$endif}
  2066. p1:=cerrornode.create;
  2067. end;
  2068. { get the resulttype for the node }
  2069. if (not assigned(p1.resulttype.def)) then
  2070. do_resulttypepass(p1);
  2071. { tp7 procvar handling, but not if the next token
  2072. will be a := }
  2073. if (m_tp_procvar in aktmodeswitches) and
  2074. (token<>_ASSIGNMENT) then
  2075. check_tp_procvar(p1);
  2076. factor:=p1;
  2077. check_tokenpos;
  2078. end;
  2079. {$ifdef fpc}
  2080. {$maxfpuregisters default}
  2081. {$endif fpc}
  2082. {****************************************************************************
  2083. Sub_Expr
  2084. ****************************************************************************}
  2085. const
  2086. { Warning these stay be ordered !! }
  2087. operator_levels:array[Toperator_precedence] of set of Ttoken=
  2088. ([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN,_OP_IS],
  2089. [_PLUS,_MINUS,_OP_OR,_OP_XOR],
  2090. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2091. _OP_AS,_OP_AND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2092. [_STARSTAR] );
  2093. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
  2094. {Reads a subexpression while the operators are of the current precedence
  2095. level, or any higher level. Replaces the old term, simpl_expr and
  2096. simpl2_expr.}
  2097. var
  2098. p1,p2 : tnode;
  2099. oldt : Ttoken;
  2100. filepos : tfileposinfo;
  2101. begin
  2102. if pred_level=highest_precedence then
  2103. p1:=factor(false)
  2104. else
  2105. p1:=sub_expr(succ(pred_level),true);
  2106. repeat
  2107. if (token in operator_levels[pred_level]) and
  2108. ((token<>_EQUAL) or accept_equal) then
  2109. begin
  2110. oldt:=token;
  2111. filepos:=akttokenpos;
  2112. consume(token);
  2113. if pred_level=highest_precedence then
  2114. p2:=factor(false)
  2115. else
  2116. p2:=sub_expr(succ(pred_level),true);
  2117. case oldt of
  2118. _PLUS :
  2119. p1:=caddnode.create(addn,p1,p2);
  2120. _MINUS :
  2121. p1:=caddnode.create(subn,p1,p2);
  2122. _STAR :
  2123. p1:=caddnode.create(muln,p1,p2);
  2124. _SLASH :
  2125. p1:=caddnode.create(slashn,p1,p2);
  2126. _EQUAL :
  2127. p1:=caddnode.create(equaln,p1,p2);
  2128. _GT :
  2129. p1:=caddnode.create(gtn,p1,p2);
  2130. _LT :
  2131. p1:=caddnode.create(ltn,p1,p2);
  2132. _GTE :
  2133. p1:=caddnode.create(gten,p1,p2);
  2134. _LTE :
  2135. p1:=caddnode.create(lten,p1,p2);
  2136. _SYMDIF :
  2137. p1:=caddnode.create(symdifn,p1,p2);
  2138. _STARSTAR :
  2139. p1:=caddnode.create(starstarn,p1,p2);
  2140. _OP_AS :
  2141. p1:=casnode.create(p1,p2);
  2142. _OP_IN :
  2143. p1:=cinnode.create(p1,p2);
  2144. _OP_IS :
  2145. p1:=cisnode.create(p1,p2);
  2146. _OP_OR :
  2147. p1:=caddnode.create(orn,p1,p2);
  2148. _OP_AND :
  2149. p1:=caddnode.create(andn,p1,p2);
  2150. _OP_DIV :
  2151. p1:=cmoddivnode.create(divn,p1,p2);
  2152. _OP_NOT :
  2153. p1:=cnotnode.create(p1);
  2154. _OP_MOD :
  2155. p1:=cmoddivnode.create(modn,p1,p2);
  2156. _OP_SHL :
  2157. p1:=cshlshrnode.create(shln,p1,p2);
  2158. _OP_SHR :
  2159. p1:=cshlshrnode.create(shrn,p1,p2);
  2160. _OP_XOR :
  2161. p1:=caddnode.create(xorn,p1,p2);
  2162. _ASSIGNMENT :
  2163. p1:=cassignmentnode.create(p1,p2);
  2164. _CARET :
  2165. p1:=caddnode.create(caretn,p1,p2);
  2166. _UNEQUAL :
  2167. p1:=caddnode.create(unequaln,p1,p2);
  2168. end;
  2169. p1.set_tree_filepos(filepos);
  2170. end
  2171. else
  2172. break;
  2173. until false;
  2174. sub_expr:=p1;
  2175. end;
  2176. function comp_expr(accept_equal : boolean):tnode;
  2177. var
  2178. oldafterassignment : boolean;
  2179. p1 : tnode;
  2180. begin
  2181. oldafterassignment:=afterassignment;
  2182. afterassignment:=true;
  2183. p1:=sub_expr(opcompare,accept_equal);
  2184. { get the resulttype for this expression }
  2185. if not assigned(p1.resulttype.def) then
  2186. do_resulttypepass(p1);
  2187. afterassignment:=oldafterassignment;
  2188. comp_expr:=p1;
  2189. end;
  2190. function expr : tnode;
  2191. var
  2192. p1,p2 : tnode;
  2193. oldafterassignment : boolean;
  2194. oldp1 : tnode;
  2195. filepos : tfileposinfo;
  2196. begin
  2197. oldafterassignment:=afterassignment;
  2198. p1:=sub_expr(opcompare,true);
  2199. { get the resulttype for this expression }
  2200. if not assigned(p1.resulttype.def) then
  2201. do_resulttypepass(p1);
  2202. filepos:=akttokenpos;
  2203. if (m_tp_procvar in aktmodeswitches) and
  2204. (token<>_ASSIGNMENT) then
  2205. check_tp_procvar(p1);
  2206. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2207. afterassignment:=true;
  2208. oldp1:=p1;
  2209. case token of
  2210. _POINTPOINT :
  2211. begin
  2212. consume(_POINTPOINT);
  2213. p2:=sub_expr(opcompare,true);
  2214. p1:=crangenode.create(p1,p2);
  2215. end;
  2216. _ASSIGNMENT :
  2217. begin
  2218. consume(_ASSIGNMENT);
  2219. if (p1.resulttype.def.deftype=procvardef) then
  2220. getprocvardef:=tprocvardef(p1.resulttype.def);
  2221. p2:=sub_expr(opcompare,true);
  2222. if assigned(getprocvardef) then
  2223. handle_procvar(getprocvardef,p2,true);
  2224. getprocvardef:=nil;
  2225. p1:=cassignmentnode.create(p1,p2);
  2226. end;
  2227. _PLUSASN :
  2228. begin
  2229. consume(_PLUSASN);
  2230. p2:=sub_expr(opcompare,true);
  2231. p1:=cassignmentnode.create(p1,caddnode.create(addn,p1.getcopy,p2));
  2232. end;
  2233. _MINUSASN :
  2234. begin
  2235. consume(_MINUSASN);
  2236. p2:=sub_expr(opcompare,true);
  2237. p1:=cassignmentnode.create(p1,caddnode.create(subn,p1.getcopy,p2));
  2238. end;
  2239. _STARASN :
  2240. begin
  2241. consume(_STARASN );
  2242. p2:=sub_expr(opcompare,true);
  2243. p1:=cassignmentnode.create(p1,caddnode.create(muln,p1.getcopy,p2));
  2244. end;
  2245. _SLASHASN :
  2246. begin
  2247. consume(_SLASHASN );
  2248. p2:=sub_expr(opcompare,true);
  2249. p1:=cassignmentnode.create(p1,caddnode.create(slashn,p1.getcopy,p2));
  2250. end;
  2251. end;
  2252. { get the resulttype for this expression }
  2253. if not assigned(p1.resulttype.def) then
  2254. do_resulttypepass(p1);
  2255. afterassignment:=oldafterassignment;
  2256. if p1<>oldp1 then
  2257. p1.set_tree_filepos(filepos);
  2258. expr:=p1;
  2259. end;
  2260. {$ifdef int64funcresok}
  2261. function get_intconst:TConstExprInt;
  2262. {$else int64funcresok}
  2263. function get_intconst:longint;
  2264. {$endif int64funcresok}
  2265. {Reads an expression, tries to evalute it and check if it is an integer
  2266. constant. Then the constant is returned.}
  2267. var
  2268. p:tnode;
  2269. begin
  2270. p:=comp_expr(true);
  2271. if not codegenerror then
  2272. begin
  2273. if (p.nodetype<>ordconstn) or
  2274. not(is_integer(p.resulttype.def)) then
  2275. Message(cg_e_illegal_expression)
  2276. else
  2277. get_intconst:=tordconstnode(p).value;
  2278. end;
  2279. p.free;
  2280. end;
  2281. function get_stringconst:string;
  2282. {Reads an expression, tries to evaluate it and checks if it is a string
  2283. constant. Then the constant is returned.}
  2284. var
  2285. p:tnode;
  2286. begin
  2287. get_stringconst:='';
  2288. p:=comp_expr(true);
  2289. if p.nodetype<>stringconstn then
  2290. begin
  2291. if (p.nodetype=ordconstn) and is_char(p.resulttype.def) then
  2292. get_stringconst:=char(tordconstnode(p).value)
  2293. else
  2294. Message(cg_e_illegal_expression);
  2295. end
  2296. else
  2297. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2298. p.free;
  2299. end;
  2300. end.
  2301. {
  2302. $Log$
  2303. Revision 1.60 2002-04-01 20:57:13 jonas
  2304. * fixed web bug 1907
  2305. * fixed some other procvar related bugs (all related to accepting procvar
  2306. constructs with either too many or too little parameters)
  2307. (both merged, includes second typo fix of pexpr.pas)
  2308. Revision 1.59 2002/03/31 20:26:35 jonas
  2309. + a_loadfpu_* and a_loadmm_* methods in tcg
  2310. * register allocation is now handled by a class and is mostly processor
  2311. independent (+rgobj.pas and i386/rgcpu.pas)
  2312. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  2313. * some small improvements and fixes to the optimizer
  2314. * some register allocation fixes
  2315. * some fpuvaroffset fixes in the unary minus node
  2316. * push/popusedregisters is now called rg.save/restoreusedregisters and
  2317. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  2318. also better optimizable)
  2319. * fixed and optimized register saving/restoring for new/dispose nodes
  2320. * LOC_FPU locations now also require their "register" field to be set to
  2321. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  2322. - list field removed of the tnode class because it's not used currently
  2323. and can cause hard-to-find bugs
  2324. Revision 1.58 2002/03/01 14:08:26 peter
  2325. * fixed sizeof(TClass) to return only 4
  2326. Revision 1.57 2002/02/03 09:30:04 peter
  2327. * more fixes for protected handling
  2328. Revision 1.56 2002/01/29 21:25:22 peter
  2329. * more checks for private and protected
  2330. Revision 1.55 2002/01/24 18:25:49 peter
  2331. * implicit result variable generation for assembler routines
  2332. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  2333. Revision 1.54 2002/01/06 21:47:32 peter
  2334. * removed getprocvar, use only getprocvardef
  2335. Revision 1.53 2001/12/31 16:59:42 peter
  2336. * protected/private symbols parsing fixed
  2337. Revision 1.52 2001/12/06 17:57:36 florian
  2338. + parasym to tparaitem added
  2339. Revision 1.51 2001/11/14 01:12:44 florian
  2340. * variant paramter passing and functions results fixed
  2341. Revision 1.50 2001/11/02 23:16:51 peter
  2342. * removed obsolete chainprocsym and test_procsym code
  2343. Revision 1.49 2001/11/02 22:58:05 peter
  2344. * procsym definition rewrite
  2345. Revision 1.48 2001/10/28 17:22:25 peter
  2346. * allow assignment of overloaded procedures to procvars when we know
  2347. which procedure to take
  2348. Revision 1.47 2001/10/24 11:51:39 marco
  2349. * Make new/dispose system functions instead of keywords
  2350. Revision 1.46 2001/10/21 13:10:51 peter
  2351. * better support for indexed properties
  2352. Revision 1.45 2001/10/21 12:33:07 peter
  2353. * array access for properties added
  2354. Revision 1.44 2001/10/20 19:28:39 peter
  2355. * interface 2 guid support
  2356. * guid constants support
  2357. Revision 1.43 2001/10/18 16:30:38 jonas
  2358. * property parameters are now fully parsed by the firstcall code to
  2359. check for the correct amount and types (merged)
  2360. Revision 1.42 2001/09/02 21:18:28 peter
  2361. * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
  2362. is used for holding target platform pointer values. As those can be
  2363. bigger than the source platform.
  2364. Revision 1.41 2001/08/26 13:36:45 florian
  2365. * some cg reorganisation
  2366. * some PPC updates
  2367. Revision 1.40 2001/08/22 21:16:21 florian
  2368. * some interfaces related problems regarding
  2369. mapping of interface implementions fixed
  2370. Revision 1.39 2001/08/06 21:40:47 peter
  2371. * funcret moved from tprocinfo to tprocdef
  2372. Revision 1.38 2001/07/09 21:15:41 peter
  2373. * Length made internal
  2374. * Add array support for Length
  2375. Revision 1.37 2001/06/29 14:16:57 jonas
  2376. * fixed inconsistent handling of procvars in FPC mode (sometimes @ was
  2377. required to assign the address of a procedure to a procvar, sometimes
  2378. not. Now it is always required) (merged)
  2379. Revision 1.36 2001/06/04 18:16:42 peter
  2380. * fixed tp procvar support in parameters of a called procvar
  2381. * typenode cleanup, no special handling needed anymore for bt_type
  2382. Revision 1.35 2001/06/04 11:45:35 peter
  2383. * parse const after .. using bt_const block to allow expressions, this
  2384. is Delphi compatible
  2385. Revision 1.34 2001/05/19 21:15:53 peter
  2386. * allow typenodes for typeinfo and typeof
  2387. * tp procvar fixes for properties
  2388. Revision 1.33 2001/05/19 12:23:59 peter
  2389. * fixed crash with auto dereferencing
  2390. Revision 1.32 2001/05/09 19:52:51 peter
  2391. * removed unused allow_type
  2392. Revision 1.31 2001/05/04 15:52:03 florian
  2393. * some Delphi incompatibilities fixed:
  2394. - out, dispose and new can be used as idenfiers now
  2395. - const p = apointerype(nil); is supported now
  2396. + support for const p = apointertype(pointer(1234)); added
  2397. Revision 1.30 2001/04/14 14:07:10 peter
  2398. * moved more code from pass_1 to det_resulttype
  2399. Revision 1.29 2001/04/13 23:50:24 peter
  2400. * fpc mode now requires @ also when left of assignment is an procvardef
  2401. Revision 1.28 2001/04/13 01:22:12 peter
  2402. * symtable change to classes
  2403. * range check generation and errors fixed, make cycle DEBUG=1 works
  2404. * memory leaks fixed
  2405. Revision 1.27 2001/04/04 22:43:52 peter
  2406. * remove unnecessary calls to firstpass
  2407. Revision 1.26 2001/04/02 21:20:33 peter
  2408. * resulttype rewrite
  2409. Revision 1.25 2001/03/11 22:58:50 peter
  2410. * getsym redesign, removed the globals srsym,srsymtable
  2411. Revision 1.24 2000/12/25 00:07:27 peter
  2412. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  2413. tlinkedlist objects)
  2414. Revision 1.23 2000/12/19 20:36:03 peter
  2415. * cardinal const expr fix from jonas
  2416. Revision 1.22 2000/12/17 14:00:18 peter
  2417. * fixed static variables
  2418. Revision 1.21 2000/12/15 13:26:01 jonas
  2419. * only return int64's from functions if it int64funcresok is defined
  2420. + added int64funcresok define to options.pas
  2421. Revision 1.20 2000/12/15 12:13:52 michael
  2422. + Fix from Peter
  2423. Revision 1.19 2000/12/07 17:19:42 jonas
  2424. * new constant handling: from now on, hex constants >$7fffffff are
  2425. parsed as unsigned constants (otherwise, $80000000 got sign extended
  2426. and became $ffffffff80000000), all constants in the longint range
  2427. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  2428. are cardinals and the rest are int64's.
  2429. * added lots of longint typecast to prevent range check errors in the
  2430. compiler and rtl
  2431. * type casts of symbolic ordinal constants are now preserved
  2432. * fixed bug where the original resulttype.def wasn't restored correctly
  2433. after doing a 64bit rangecheck
  2434. Revision 1.18 2000/11/29 00:30:36 florian
  2435. * unused units removed from uses clause
  2436. * some changes for widestrings
  2437. Revision 1.17 2000/11/09 17:46:55 florian
  2438. * System.TypeInfo fixed
  2439. + System.Finalize implemented
  2440. + some new keywords for interface support added
  2441. Revision 1.16 2000/11/06 20:30:55 peter
  2442. * more fixes to get make cycle working
  2443. Revision 1.15 2000/11/04 14:25:20 florian
  2444. + merged Attila's changes for interfaces, not tested yet
  2445. Revision 1.14 2000/10/31 22:02:49 peter
  2446. * symtable splitted, no real code changes
  2447. Revision 1.13 2000/10/26 23:40:54 peter
  2448. * fixed crash with call from type decl which is not allowed (merged)
  2449. Revision 1.12 2000/10/21 18:16:12 florian
  2450. * a lot of changes:
  2451. - basic dyn. array support
  2452. - basic C++ support
  2453. - some work for interfaces done
  2454. ....
  2455. Revision 1.11 2000/10/14 10:14:51 peter
  2456. * moehrendorf oct 2000 rewrite
  2457. Revision 1.10 2000/10/01 19:48:25 peter
  2458. * lot of compile updates for cg11
  2459. Revision 1.9 2000/09/24 21:19:50 peter
  2460. * delphi compile fixes
  2461. Revision 1.8 2000/09/24 15:06:22 peter
  2462. * use defines.inc
  2463. Revision 1.7 2000/08/27 16:11:51 peter
  2464. * moved some util functions from globals,cobjects to cutils
  2465. * splitted files into finput,fmodule
  2466. Revision 1.6 2000/08/20 15:12:49 peter
  2467. * auto derefence mode for array pointer (merged)
  2468. Revision 1.5 2000/08/16 18:33:53 peter
  2469. * splitted namedobjectitem.next into indexnext and listnext so it
  2470. can be used in both lists
  2471. * don't allow "word = word" type definitions (merged)
  2472. Revision 1.4 2000/08/16 13:06:06 florian
  2473. + support of 64 bit integer constants
  2474. Revision 1.3 2000/08/04 22:00:52 peter
  2475. * merges from fixes
  2476. Revision 1.2 2000/07/13 11:32:44 michael
  2477. + removed logs
  2478. }