pexpr.pas 96 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687
  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. { 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. { 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:=nil;
  391. while assigned(classh) do
  392. begin
  393. sym:=tsym(classh.symtable.search(pattern));
  394. if assigned(sym) then
  395. break;
  396. classh:=classh.childof;
  397. end;
  398. consume(_ID);
  399. do_member_read(false,sym,p2,again);
  400. { we need to know which procedure is called }
  401. do_resulttypepass(p2);
  402. if (p2.nodetype<>calln) or
  403. (assigned(tcallnode(p2).procdefinition) and
  404. (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
  405. Message(parser_e_expr_have_to_be_constructor_call);
  406. end;
  407. p2:=cnewnode.create(p2);
  408. do_resulttypepass(p2);
  409. p2.resulttype:=p1.resulttype;
  410. p1.destroy;
  411. p1:=p2;
  412. consume(_RKLAMMER);
  413. end;
  414. new_function:=p1;
  415. end;
  416. function statement_syssym(l : longint) : tnode;
  417. var
  418. p1,p2,paras : tnode;
  419. prev_in_args : boolean;
  420. begin
  421. prev_in_args:=in_args;
  422. case l of
  423. in_new_x :
  424. begin
  425. if afterassignment or in_args then
  426. statement_syssym:=new_function
  427. else
  428. statement_syssym:=new_dispose_statement(true);
  429. end;
  430. in_dispose_x :
  431. begin
  432. statement_syssym:=new_dispose_statement(false);
  433. end;
  434. in_ord_x :
  435. begin
  436. consume(_LKLAMMER);
  437. in_args:=true;
  438. p1:=comp_expr(true);
  439. consume(_RKLAMMER);
  440. p1:=geninlinenode(in_ord_x,false,p1);
  441. statement_syssym := p1;
  442. end;
  443. in_break :
  444. begin
  445. statement_syssym:=cbreaknode.create;
  446. end;
  447. in_continue :
  448. begin
  449. statement_syssym:=ccontinuenode.create;
  450. end;
  451. in_typeof_x :
  452. begin
  453. consume(_LKLAMMER);
  454. in_args:=true;
  455. p1:=comp_expr(true);
  456. consume(_RKLAMMER);
  457. if p1.nodetype=typen then
  458. ttypenode(p1).allowed:=true;
  459. if p1.resulttype.def.deftype=objectdef then
  460. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  461. else
  462. begin
  463. Message(type_e_mismatch);
  464. p1.destroy;
  465. statement_syssym:=cerrornode.create;
  466. end;
  467. end;
  468. in_sizeof_x :
  469. begin
  470. consume(_LKLAMMER);
  471. in_args:=true;
  472. p1:=comp_expr(true);
  473. consume(_RKLAMMER);
  474. if (p1.nodetype<>typen) and
  475. (
  476. ((p1.resulttype.def.deftype=objectdef) and
  477. (oo_has_constructor in tobjectdef(p1.resulttype.def).objectoptions)) or
  478. is_open_array(p1.resulttype.def) or
  479. is_open_string(p1.resulttype.def)
  480. ) then
  481. statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
  482. else
  483. begin
  484. statement_syssym:=cordconstnode.create(p1.resulttype.def.size,s32bittype);
  485. { p1 not needed !}
  486. p1.destroy;
  487. end;
  488. end;
  489. in_typeinfo_x :
  490. begin
  491. consume(_LKLAMMER);
  492. in_args:=true;
  493. p1:=comp_expr(true);
  494. if p1.nodetype=typen then
  495. ttypenode(p1).allowed:=true
  496. else
  497. begin
  498. p1.destroy;
  499. p1:=cerrornode.create;
  500. Message(parser_e_illegal_parameter_list);
  501. end;
  502. consume(_RKLAMMER);
  503. p2:=ccallparanode.create(p1,nil);
  504. p2:=geninlinenode(in_typeinfo_x,false,p2);
  505. statement_syssym:=p2;
  506. end;
  507. in_assigned_x :
  508. begin
  509. consume(_LKLAMMER);
  510. in_args:=true;
  511. p1:=comp_expr(true);
  512. if not codegenerror then
  513. begin
  514. case p1.resulttype.def.deftype of
  515. pointerdef,
  516. procvardef,
  517. classrefdef : ;
  518. objectdef :
  519. if not is_class_or_interface(p1.resulttype.def) then
  520. Message(parser_e_illegal_parameter_list);
  521. else
  522. Message(parser_e_illegal_parameter_list);
  523. end;
  524. end;
  525. p2:=ccallparanode.create(p1,nil);
  526. p2:=geninlinenode(in_assigned_x,false,p2);
  527. consume(_RKLAMMER);
  528. statement_syssym:=p2;
  529. end;
  530. in_addr_x :
  531. begin
  532. consume(_LKLAMMER);
  533. in_args:=true;
  534. p1:=comp_expr(true);
  535. p1:=caddrnode.create(p1);
  536. consume(_RKLAMMER);
  537. statement_syssym:=p1;
  538. end;
  539. in_ofs_x :
  540. begin
  541. consume(_LKLAMMER);
  542. in_args:=true;
  543. p1:=comp_expr(true);
  544. p1:=caddrnode.create(p1);
  545. do_resulttypepass(p1);
  546. { Ofs() returns a cardinal, not a pointer }
  547. p1.resulttype:=u32bittype;
  548. consume(_RKLAMMER);
  549. statement_syssym:=p1;
  550. end;
  551. in_seg_x :
  552. begin
  553. consume(_LKLAMMER);
  554. in_args:=true;
  555. p1:=comp_expr(true);
  556. p1:=geninlinenode(in_seg_x,false,p1);
  557. consume(_RKLAMMER);
  558. statement_syssym:=p1;
  559. end;
  560. in_high_x,
  561. in_low_x :
  562. begin
  563. consume(_LKLAMMER);
  564. in_args:=true;
  565. p1:=comp_expr(true);
  566. p2:=geninlinenode(l,false,p1);
  567. consume(_RKLAMMER);
  568. statement_syssym:=p2;
  569. end;
  570. in_succ_x,
  571. in_pred_x :
  572. begin
  573. consume(_LKLAMMER);
  574. in_args:=true;
  575. p1:=comp_expr(true);
  576. p2:=geninlinenode(l,false,p1);
  577. consume(_RKLAMMER);
  578. statement_syssym:=p2;
  579. end;
  580. in_inc_x,
  581. in_dec_x :
  582. begin
  583. consume(_LKLAMMER);
  584. in_args:=true;
  585. p1:=comp_expr(true);
  586. if token=_COMMA then
  587. begin
  588. consume(_COMMA);
  589. p2:=ccallparanode.create(comp_expr(true),nil);
  590. end
  591. else
  592. p2:=nil;
  593. p2:=ccallparanode.create(p1,p2);
  594. statement_syssym:=geninlinenode(l,false,p2);
  595. consume(_RKLAMMER);
  596. end;
  597. in_finalize_x:
  598. begin
  599. consume(_LKLAMMER);
  600. in_args:=true;
  601. p1:=comp_expr(true);
  602. if token=_COMMA then
  603. begin
  604. consume(_COMMA);
  605. p2:=ccallparanode.create(comp_expr(true),nil);
  606. end
  607. else
  608. p2:=nil;
  609. p2:=ccallparanode.create(p1,p2);
  610. statement_syssym:=geninlinenode(in_finalize_x,false,p2);
  611. consume(_RKLAMMER);
  612. end;
  613. in_concat_x :
  614. begin
  615. consume(_LKLAMMER);
  616. in_args:=true;
  617. p2:=nil;
  618. while true do
  619. begin
  620. p1:=comp_expr(true);
  621. set_varstate(p1,true);
  622. if not((p1.resulttype.def.deftype=stringdef) or
  623. ((p1.resulttype.def.deftype=orddef) and
  624. (torddef(p1.resulttype.def).typ=uchar))) then
  625. Message(parser_e_illegal_parameter_list);
  626. if p2<>nil then
  627. p2:=caddnode.create(addn,p2,p1)
  628. else
  629. p2:=p1;
  630. if token=_COMMA then
  631. consume(_COMMA)
  632. else
  633. break;
  634. end;
  635. consume(_RKLAMMER);
  636. statement_syssym:=p2;
  637. end;
  638. in_read_x,
  639. in_readln_x :
  640. begin
  641. if token=_LKLAMMER then
  642. begin
  643. consume(_LKLAMMER);
  644. in_args:=true;
  645. paras:=parse_paras(false,false);
  646. consume(_RKLAMMER);
  647. end
  648. else
  649. paras:=nil;
  650. p1:=geninlinenode(l,false,paras);
  651. statement_syssym := p1;
  652. end;
  653. in_setlength_x:
  654. begin
  655. if token=_LKLAMMER then
  656. begin
  657. consume(_LKLAMMER);
  658. in_args:=true;
  659. paras:=parse_paras(false,false);
  660. consume(_RKLAMMER);
  661. end
  662. else
  663. paras:=nil;
  664. p1:=geninlinenode(l,false,paras);
  665. statement_syssym := p1;
  666. end;
  667. in_length_x:
  668. begin
  669. consume(_LKLAMMER);
  670. in_args:=true;
  671. p1:=comp_expr(true);
  672. p2:=geninlinenode(l,false,p1);
  673. consume(_RKLAMMER);
  674. statement_syssym:=p2;
  675. end;
  676. in_write_x,
  677. in_writeln_x :
  678. begin
  679. if token=_LKLAMMER then
  680. begin
  681. consume(_LKLAMMER);
  682. in_args:=true;
  683. paras:=parse_paras(true,false);
  684. consume(_RKLAMMER);
  685. end
  686. else
  687. paras:=nil;
  688. p1 := geninlinenode(l,false,paras);
  689. statement_syssym := p1;
  690. end;
  691. in_str_x_string :
  692. begin
  693. consume(_LKLAMMER);
  694. in_args:=true;
  695. paras:=parse_paras(true,false);
  696. consume(_RKLAMMER);
  697. p1 := geninlinenode(l,false,paras);
  698. statement_syssym := p1;
  699. end;
  700. in_val_x:
  701. Begin
  702. consume(_LKLAMMER);
  703. in_args := true;
  704. p1:= ccallparanode.create(comp_expr(true), nil);
  705. consume(_COMMA);
  706. p2 := ccallparanode.create(comp_expr(true),p1);
  707. if (token = _COMMA) then
  708. Begin
  709. consume(_COMMA);
  710. p2 := ccallparanode.create(comp_expr(true),p2)
  711. End;
  712. consume(_RKLAMMER);
  713. p2 := geninlinenode(l,false,p2);
  714. statement_syssym := p2;
  715. End;
  716. in_include_x_y,
  717. in_exclude_x_y :
  718. begin
  719. consume(_LKLAMMER);
  720. in_args:=true;
  721. p1:=comp_expr(true);
  722. consume(_COMMA);
  723. p2:=comp_expr(true);
  724. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  725. consume(_RKLAMMER);
  726. end;
  727. in_assert_x_y :
  728. begin
  729. consume(_LKLAMMER);
  730. in_args:=true;
  731. p1:=comp_expr(true);
  732. if token=_COMMA then
  733. begin
  734. consume(_COMMA);
  735. p2:=comp_expr(true);
  736. end
  737. else
  738. begin
  739. { then insert an empty string }
  740. p2:=cstringconstnode.createstr('',st_default);
  741. end;
  742. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  743. consume(_RKLAMMER);
  744. end;
  745. else
  746. internalerror(15);
  747. end;
  748. in_args:=prev_in_args;
  749. end;
  750. { reads the parameter for a subroutine call }
  751. procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode);
  752. var
  753. prevafterassn : boolean;
  754. hs,hs1 : tvarsym;
  755. para,p2 : tnode;
  756. hst : tsymtable;
  757. aprocdef : tprocdef;
  758. begin
  759. prevafterassn:=afterassignment;
  760. afterassignment:=false;
  761. { want we only determine the address of }
  762. { a subroutine ? }
  763. if not(getaddr) then
  764. begin
  765. para:=nil;
  766. if auto_inherited then
  767. begin
  768. hst:=symtablestack;
  769. while assigned(hst) and (hst.symtabletype<>parasymtable) do
  770. hst:=hst.next;
  771. if assigned(hst) then
  772. begin
  773. hs:=tvarsym(hst.symindex.first);
  774. while assigned(hs) do
  775. begin
  776. if hs.typ<>varsym then
  777. internalerror(54382953);
  778. { if there is a localcopy then use that }
  779. if assigned(hs.localvarsym) then
  780. hs1:=hs.localvarsym
  781. else
  782. hs1:=hs;
  783. para:=ccallparanode.create(cloadnode.create(hs1,hs1.owner),para);
  784. hs:=tvarsym(hs.indexnext);
  785. end;
  786. end
  787. else
  788. internalerror(54382954);
  789. end
  790. else
  791. begin
  792. if token=_LKLAMMER then
  793. begin
  794. consume(_LKLAMMER);
  795. para:=parse_paras(false,false);
  796. consume(_RKLAMMER);
  797. end;
  798. end;
  799. p1:=ccallnode.create(para,tprocsym(sym),st,p1);
  800. end
  801. else
  802. begin
  803. { address operator @: }
  804. if not assigned(p1) then
  805. begin
  806. if (st.symtabletype=withsymtable) and
  807. (st.defowner.deftype=objectdef) then
  808. begin
  809. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  810. end
  811. else
  812. begin
  813. { we must provide a method pointer, if it isn't given, }
  814. { it is self }
  815. if (st.symtabletype=objectsymtable) then
  816. p1:=cselfnode.create(tobjectdef(st.defowner));
  817. end;
  818. end;
  819. { generate a methodcallnode or proccallnode }
  820. { we shouldn't convert things like @tcollection.load }
  821. if assigned(getprocvardef) then
  822. aprocdef:=get_proc_2_procvar_def(tprocsym(sym),getprocvardef)
  823. else
  824. aprocdef:=nil;
  825. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  826. if assigned(p1) then
  827. tloadnode(p2).set_mp(p1);
  828. p1:=p2;
  829. { no postfix operators }
  830. again:=false;
  831. end;
  832. afterassignment:=prevafterassn;
  833. end;
  834. procedure handle_procvar(pv : tprocvardef;var p2 : tnode; getaddr: boolean);
  835. procedure doconv(procvar : tprocvardef;var t : tnode);
  836. var
  837. hp : tnode;
  838. currprocdef : tprocdef;
  839. begin
  840. hp:=nil;
  841. currprocdef:=get_proc_2_procvar_def(tcallnode(t).symtableprocentry,procvar);
  842. if assigned(currprocdef) then
  843. begin
  844. hp:=cloadnode.create_procvar(tprocsym(tcallnode(t).symtableprocentry),currprocdef,tcallnode(t).symtableproc);
  845. if (po_methodpointer in procvar.procoptions) then
  846. tloadnode(hp).set_mp(tnode(tcallnode(t).methodpointer).getcopy);
  847. t.destroy;
  848. t:=hp;
  849. end;
  850. end;
  851. begin
  852. if ((m_tp_procvar in aktmodeswitches) or
  853. not getaddr) then
  854. if (p2.nodetype=calln) then
  855. doconv(pv,p2)
  856. else
  857. if (p2.nodetype=typeconvn) and
  858. (ttypeconvnode(p2).left.nodetype=calln) then
  859. doconv(pv,ttypeconvnode(p2).left);
  860. end;
  861. { the following procedure handles the access to a property symbol }
  862. procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode; getaddr: boolean);
  863. procedure symlist_to_node(var p1:tnode;pl:tsymlist);
  864. var
  865. plist : psymlistitem;
  866. begin
  867. plist:=pl.firstsym;
  868. while assigned(plist) do
  869. begin
  870. case plist^.sltype of
  871. sl_load :
  872. begin
  873. { p1 can already contain the loadnode of
  874. the class variable. Then we need to use a
  875. subscriptn. If no tree is found (with block), then
  876. generate a loadn }
  877. if assigned(p1) then
  878. p1:=csubscriptnode.create(tvarsym(plist^.sym),p1)
  879. else
  880. p1:=cloadnode.create(tvarsym(plist^.sym),st);
  881. end;
  882. sl_subscript :
  883. p1:=csubscriptnode.create(tvarsym(plist^.sym),p1);
  884. sl_vec :
  885. p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,s32bittype));
  886. else
  887. internalerror(200110205);
  888. end;
  889. plist:=plist^.next;
  890. end;
  891. include(p1.flags,nf_isproperty);
  892. end;
  893. var
  894. paras : tnode;
  895. p2 : tnode;
  896. begin
  897. paras:=nil;
  898. { property parameters? read them only if the property really }
  899. { has parameters }
  900. if (ppo_hasparameters in tpropertysym(sym).propoptions) then
  901. begin
  902. if token=_LECKKLAMMER then
  903. begin
  904. consume(_LECKKLAMMER);
  905. paras:=parse_paras(false,true);
  906. consume(_RECKKLAMMER);
  907. end;
  908. end;
  909. { indexed property }
  910. if (ppo_indexed in tpropertysym(sym).propoptions) then
  911. begin
  912. p2:=cordconstnode.create(tpropertysym(sym).index,tpropertysym(sym).indextype);
  913. paras:=ccallparanode.create(p2,paras);
  914. end;
  915. { we need only a write property if a := follows }
  916. { if not(afterassignment) and not(in_args) then }
  917. if token=_ASSIGNMENT then
  918. begin
  919. { write property: }
  920. if not tpropertysym(sym).writeaccess.empty then
  921. begin
  922. case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
  923. procsym :
  924. begin
  925. { generate the method call }
  926. p1:=ccallnode.create(paras,
  927. tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1);
  928. paras:=nil;
  929. consume(_ASSIGNMENT);
  930. { read the expression }
  931. if tpropertysym(sym).proptype.def.deftype=procvardef then
  932. getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
  933. p2:=comp_expr(true);
  934. if assigned(getprocvardef) then
  935. handle_procvar(getprocvardef,p2,getaddr);
  936. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  937. include(tcallnode(p1).flags,nf_isproperty);
  938. getprocvardef:=nil;
  939. end;
  940. varsym :
  941. begin
  942. { generate access code }
  943. symlist_to_node(p1,tpropertysym(sym).writeaccess);
  944. consume(_ASSIGNMENT);
  945. { read the expression }
  946. p2:=comp_expr(true);
  947. p1:=cassignmentnode.create(p1,p2);
  948. end
  949. else
  950. begin
  951. p1:=cerrornode.create;
  952. Message(parser_e_no_procedure_to_access_property);
  953. end;
  954. end;
  955. end
  956. else
  957. begin
  958. p1:=cerrornode.create;
  959. Message(parser_e_no_procedure_to_access_property);
  960. end;
  961. end
  962. else
  963. begin
  964. { read property: }
  965. if not tpropertysym(sym).readaccess.empty then
  966. begin
  967. case tpropertysym(sym).readaccess.firstsym^.sym.typ of
  968. varsym :
  969. begin
  970. { generate access code }
  971. symlist_to_node(p1,tpropertysym(sym).readaccess);
  972. end;
  973. procsym :
  974. begin
  975. { generate the method call }
  976. p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1);
  977. paras:=nil;
  978. include(p1.flags,nf_isproperty);
  979. end
  980. else
  981. begin
  982. p1:=cerrornode.create;
  983. Message(type_e_mismatch);
  984. end;
  985. end;
  986. end
  987. else
  988. begin
  989. { error, no function to read property }
  990. p1:=cerrornode.create;
  991. Message(parser_e_no_procedure_to_access_property);
  992. end;
  993. end;
  994. { release paras if not used }
  995. if assigned(paras) then
  996. paras.free;
  997. end;
  998. { the ID token has to be consumed before calling this function }
  999. procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean);
  1000. var
  1001. static_name : string;
  1002. isclassref : boolean;
  1003. srsymtable : tsymtable;
  1004. begin
  1005. if sym=nil then
  1006. begin
  1007. { pattern is still valid unless
  1008. there is another ID just after the ID of sym }
  1009. Message1(sym_e_id_no_member,pattern);
  1010. p1.free;
  1011. p1:=cerrornode.create;
  1012. { try to clean up }
  1013. again:=false;
  1014. end
  1015. else
  1016. begin
  1017. if assigned(p1) then
  1018. begin
  1019. if not assigned(p1.resulttype.def) then
  1020. do_resulttypepass(p1);
  1021. isclassref:=(p1.resulttype.def.deftype=classrefdef);
  1022. end
  1023. else
  1024. isclassref:=false;
  1025. { we assume, that only procsyms and varsyms are in an object }
  1026. { symbol table, for classes, properties are allowed }
  1027. case sym.typ of
  1028. procsym:
  1029. begin
  1030. do_proc_call(sym,sym.owner,
  1031. getaddr or
  1032. (assigned(getprocvardef) and
  1033. ((block_type=bt_const) or
  1034. ((m_tp_procvar in aktmodeswitches) and
  1035. proc_to_procvar_equal(tprocsym(sym).defs^.def,getprocvardef,false)
  1036. )
  1037. )
  1038. ),again,p1);
  1039. if (block_type=bt_const) and
  1040. assigned(getprocvardef) then
  1041. handle_procvar(getprocvardef,p1,getaddr);
  1042. { we need to know which procedure is called }
  1043. do_resulttypepass(p1);
  1044. { now we know the real method e.g. we can check for a class method }
  1045. if isclassref and
  1046. assigned(tcallnode(p1).procdefinition) and
  1047. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1048. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1049. Message(parser_e_only_class_methods_via_class_ref);
  1050. end;
  1051. varsym:
  1052. begin
  1053. if isclassref then
  1054. Message(parser_e_only_class_methods_via_class_ref);
  1055. if (sp_static in sym.symoptions) then
  1056. begin
  1057. static_name:=lower(sym.owner.name^)+'_'+sym.name;
  1058. searchsym(static_name,sym,srsymtable);
  1059. p1.free;
  1060. p1:=cloadnode.create(tvarsym(sym),srsymtable);
  1061. end
  1062. else
  1063. p1:=csubscriptnode.create(tvarsym(sym),p1);
  1064. end;
  1065. propertysym:
  1066. begin
  1067. if isclassref then
  1068. Message(parser_e_only_class_methods_via_class_ref);
  1069. handle_propertysym(sym,sym.owner,p1,getaddr);
  1070. end;
  1071. else internalerror(16);
  1072. end;
  1073. end;
  1074. end;
  1075. {****************************************************************************
  1076. Factor
  1077. ****************************************************************************}
  1078. {$ifdef fpc}
  1079. {$maxfpuregisters 0}
  1080. {$endif fpc}
  1081. function factor(getaddr : boolean) : tnode;
  1082. {---------------------------------------------
  1083. Is_func_ret
  1084. ---------------------------------------------}
  1085. function is_func_ret(var p1:tnode;var sym : tsym;var srsymtable:tsymtable) : boolean;
  1086. var
  1087. p : pprocinfo;
  1088. storesymtablestack : tsymtable;
  1089. begin
  1090. is_func_ret:=false;
  1091. if not assigned(procinfo) or
  1092. ((sym.typ<>funcretsym) and ((procinfo^.flags and pi_operator)=0)) then
  1093. exit;
  1094. p:=procinfo;
  1095. while assigned(p) do
  1096. begin
  1097. { is this an access to a function result? Accessing _RESULT is
  1098. always allowed and funcretn is generated }
  1099. if assigned(p^.procdef.funcretsym) and
  1100. ((tfuncretsym(sym)=p^.procdef.resultfuncretsym) or
  1101. ((tfuncretsym(sym)=p^.procdef.funcretsym) or
  1102. ((tvarsym(sym)=otsym) and ((p^.flags and pi_operator)<>0))) and
  1103. (not is_void(p^.procdef.rettype.def)) and
  1104. (token<>_LKLAMMER) and
  1105. (not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args)))
  1106. ) then
  1107. begin
  1108. if ((tvarsym(sym)=otsym) and
  1109. ((p^.flags and pi_operator)<>0)) then
  1110. inc(otsym.refs);
  1111. p1:=cfuncretnode.create(p^.procdef.funcretsym);
  1112. is_func_ret:=true;
  1113. if tfuncretsym(p^.procdef.funcretsym).funcretstate=vs_declared then
  1114. begin
  1115. tfuncretsym(p^.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
  1116. include(p1.flags,nf_is_first_funcret);
  1117. end;
  1118. exit;
  1119. end;
  1120. p:=p^.parent;
  1121. end;
  1122. { we must use the function call, update the
  1123. sym to be the procsym }
  1124. if (sym.typ=funcretsym) then
  1125. begin
  1126. storesymtablestack:=symtablestack;
  1127. symtablestack:=sym.owner.next;
  1128. searchsym(sym.name,sym,srsymtable);
  1129. if not assigned(sym) then
  1130. sym:=generrorsym;
  1131. if (sym.typ<>procsym) then
  1132. Message(cg_e_illegal_expression);
  1133. symtablestack:=storesymtablestack;
  1134. end;
  1135. end;
  1136. {---------------------------------------------
  1137. Factor_read_id
  1138. ---------------------------------------------}
  1139. procedure factor_read_id(var p1:tnode;var again:boolean);
  1140. var
  1141. pc : pchar;
  1142. len : longint;
  1143. srsym : tsym;
  1144. possible_error : boolean;
  1145. srsymtable : tsymtable;
  1146. htype : ttype;
  1147. static_name : string;
  1148. begin
  1149. { allow post fix operators }
  1150. again:=true;
  1151. consume_sym(srsym,srsymtable);
  1152. if not is_func_ret(p1,srsym,srsymtable) then
  1153. begin
  1154. { check semantics of private }
  1155. if (srsym.typ in [propertysym,procsym,varsym]) and
  1156. (srsym.owner.symtabletype=objectsymtable) then
  1157. begin
  1158. if (sp_private in srsym.symoptions) and
  1159. (tobjectdef(srsym.owner.defowner).owner.symtabletype=globalsymtable) and
  1160. (tobjectdef(srsym.owner.defowner).owner.unitid<>0) then
  1161. Message(parser_e_cant_access_private_member);
  1162. end;
  1163. case srsym.typ of
  1164. absolutesym :
  1165. begin
  1166. p1:=cloadnode.create(tvarsym(srsym),srsymtable);
  1167. end;
  1168. varsym :
  1169. begin
  1170. { are we in a class method ? }
  1171. if (srsym.owner.symtabletype=objectsymtable) and
  1172. assigned(aktprocsym) and
  1173. (po_classmethod in aktprocdef.procoptions) then
  1174. Message(parser_e_only_class_methods);
  1175. if (sp_static in srsym.symoptions) then
  1176. begin
  1177. static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
  1178. searchsym(static_name,srsym,srsymtable);
  1179. end;
  1180. p1:=cloadnode.create(tvarsym(srsym),srsymtable);
  1181. if tvarsym(srsym).varstate=vs_declared then
  1182. begin
  1183. include(p1.flags,nf_first);
  1184. { set special between first loaded until checked in resulttypepass }
  1185. tvarsym(srsym).varstate:=vs_declared_and_first_found;
  1186. end;
  1187. end;
  1188. typedconstsym :
  1189. begin
  1190. p1:=cloadnode.create(srsym,srsymtable);
  1191. end;
  1192. syssym :
  1193. begin
  1194. p1:=statement_syssym(tsyssym(srsym).number);
  1195. end;
  1196. typesym :
  1197. begin
  1198. htype.setsym(srsym);
  1199. if not assigned(htype.def) then
  1200. begin
  1201. again:=false;
  1202. end
  1203. else
  1204. begin
  1205. if token=_LKLAMMER then
  1206. begin
  1207. consume(_LKLAMMER);
  1208. p1:=comp_expr(true);
  1209. consume(_RKLAMMER);
  1210. p1:=ctypeconvnode.create(p1,htype);
  1211. include(p1.flags,nf_explizit);
  1212. end
  1213. else { not LKLAMMER }
  1214. if (token=_POINT) and
  1215. is_object(htype.def) then
  1216. begin
  1217. consume(_POINT);
  1218. if assigned(procinfo) and
  1219. assigned(procinfo^._class) and
  1220. not(getaddr) then
  1221. begin
  1222. if procinfo^._class.is_related(tobjectdef(htype.def)) then
  1223. begin
  1224. p1:=ctypenode.create(htype);
  1225. { search also in inherited methods }
  1226. repeat
  1227. srsym:=tvarsym(tobjectdef(htype.def).symtable.search(pattern));
  1228. if assigned(srsym) then
  1229. break;
  1230. htype.def:=tobjectdef(htype.def).childof;
  1231. until not assigned(htype.def);
  1232. consume(_ID);
  1233. do_member_read(false,srsym,p1,again);
  1234. end
  1235. else
  1236. begin
  1237. Message(parser_e_no_super_class);
  1238. again:=false;
  1239. end;
  1240. end
  1241. else
  1242. begin
  1243. { allows @TObject.Load }
  1244. { also allows static methods and variables }
  1245. p1:=ctypenode.create(htype);
  1246. { TP allows also @TMenu.Load if Load is only }
  1247. { defined in an anchestor class }
  1248. srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
  1249. if not assigned(srsym) then
  1250. Message1(sym_e_id_no_member,pattern)
  1251. else if not(getaddr) and not(sp_static in srsym.symoptions) then
  1252. Message(sym_e_only_static_in_static)
  1253. else
  1254. begin
  1255. consume(_ID);
  1256. do_member_read(getaddr,srsym,p1,again);
  1257. end;
  1258. end;
  1259. end
  1260. else
  1261. begin
  1262. { class reference ? }
  1263. if is_class(htype.def) then
  1264. begin
  1265. if getaddr and (token=_POINT) then
  1266. begin
  1267. consume(_POINT);
  1268. { allows @Object.Method }
  1269. { also allows static methods and variables }
  1270. p1:=ctypenode.create(htype);
  1271. { TP allows also @TMenu.Load if Load is only }
  1272. { defined in an anchestor class }
  1273. srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
  1274. if not assigned(srsym) then
  1275. Message1(sym_e_id_no_member,pattern)
  1276. else
  1277. begin
  1278. consume(_ID);
  1279. do_member_read(getaddr,srsym,p1,again);
  1280. end;
  1281. end
  1282. else
  1283. begin
  1284. p1:=ctypenode.create(htype);
  1285. { For a type block we simply return only
  1286. the type. For all other blocks we return
  1287. a loadvmt node }
  1288. if (block_type<>bt_type) then
  1289. p1:=cloadvmtnode.create(p1);
  1290. end;
  1291. end
  1292. else
  1293. p1:=ctypenode.create(htype);
  1294. end;
  1295. end;
  1296. end;
  1297. enumsym :
  1298. begin
  1299. p1:=genenumnode(tenumsym(srsym));
  1300. end;
  1301. constsym :
  1302. begin
  1303. case tconstsym(srsym).consttyp of
  1304. constint :
  1305. begin
  1306. { do a very dirty trick to bootstrap this code }
  1307. if (tconstsym(srsym).valueord>=-(int64(2147483647)+int64(1))) and
  1308. (tconstsym(srsym).valueord<=2147483647) then
  1309. p1:=cordconstnode.create(tconstsym(srsym).valueord,s32bittype)
  1310. else if (tconstsym(srsym).valueord > maxlongint) and
  1311. (tconstsym(srsym).valueord <= int64(maxlongint)+int64(maxlongint)+1) then
  1312. p1:=cordconstnode.create(tconstsym(srsym).valueord,u32bittype)
  1313. else
  1314. p1:=cordconstnode.create(tconstsym(srsym).valueord,cs64bittype);
  1315. end;
  1316. conststring :
  1317. begin
  1318. len:=tconstsym(srsym).len;
  1319. if not(cs_ansistrings in aktlocalswitches) and (len>255) then
  1320. len:=255;
  1321. getmem(pc,len+1);
  1322. move(pchar(tconstsym(srsym).valueptr)^,pc^,len);
  1323. pc[len]:=#0;
  1324. p1:=cstringconstnode.createpchar(pc,len);
  1325. end;
  1326. constchar :
  1327. p1:=cordconstnode.create(tconstsym(srsym).valueord,cchartype);
  1328. constreal :
  1329. p1:=crealconstnode.create(pbestreal(tconstsym(srsym).valueptr)^,pbestrealtype^);
  1330. constbool :
  1331. p1:=cordconstnode.create(tconstsym(srsym).valueord,booltype);
  1332. constset :
  1333. p1:=csetconstnode.create(pconstset(tconstsym(srsym).valueptr),tconstsym(srsym).consttype);
  1334. constord :
  1335. p1:=cordconstnode.create(tconstsym(srsym).valueord,tconstsym(srsym).consttype);
  1336. constpointer :
  1337. p1:=cpointerconstnode.create(tconstsym(srsym).valueordptr,tconstsym(srsym).consttype);
  1338. constnil :
  1339. p1:=cnilnode.create;
  1340. constresourcestring:
  1341. begin
  1342. p1:=cloadnode.create(tvarsym(srsym),srsymtable);
  1343. do_resulttypepass(p1);
  1344. p1.resulttype:=cansistringtype;
  1345. end;
  1346. constguid :
  1347. p1:=cguidconstnode.create(pguid(tconstsym(srsym).valueptr)^);
  1348. end;
  1349. end;
  1350. procsym :
  1351. begin
  1352. { are we in a class method ? }
  1353. possible_error:=(srsym.owner.symtabletype=objectsymtable) and
  1354. assigned(aktprocsym) and
  1355. (po_classmethod in aktprocdef.procoptions);
  1356. do_proc_call(srsym,srsymtable,
  1357. getaddr or
  1358. (assigned(getprocvardef) and
  1359. ((block_type=bt_const) or
  1360. ((m_tp_procvar in aktmodeswitches) and
  1361. proc_to_procvar_equal(tprocsym(srsym).defs^.def,getprocvardef,false)
  1362. )
  1363. )
  1364. ),again,p1);
  1365. if (block_type=bt_const) and
  1366. assigned(getprocvardef) then
  1367. handle_procvar(getprocvardef,p1,getaddr);
  1368. { we need to know which procedure is called }
  1369. if possible_error then
  1370. begin
  1371. do_resulttypepass(p1);
  1372. if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) then
  1373. Message(parser_e_only_class_methods);
  1374. end;
  1375. end;
  1376. propertysym :
  1377. begin
  1378. { access to property in a method }
  1379. { are we in a class method ? }
  1380. if (srsym.owner.symtabletype=objectsymtable) and
  1381. assigned(aktprocsym) and
  1382. (po_classmethod in aktprocdef.procoptions) then
  1383. Message(parser_e_only_class_methods);
  1384. { no method pointer }
  1385. p1:=nil;
  1386. handle_propertysym(srsym,srsymtable,p1,getaddr);
  1387. end;
  1388. labelsym :
  1389. begin
  1390. consume(_COLON);
  1391. if tlabelsym(srsym).defined then
  1392. Message(sym_e_label_already_defined);
  1393. tlabelsym(srsym).defined:=true;
  1394. p1:=clabelnode.create(tlabelsym(srsym),nil);
  1395. end;
  1396. errorsym :
  1397. begin
  1398. p1:=cerrornode.create;
  1399. if token=_LKLAMMER then
  1400. begin
  1401. consume(_LKLAMMER);
  1402. parse_paras(false,false);
  1403. consume(_RKLAMMER);
  1404. end;
  1405. end;
  1406. else
  1407. begin
  1408. p1:=cerrornode.create;
  1409. Message(cg_e_illegal_expression);
  1410. end;
  1411. end; { end case }
  1412. end;
  1413. end;
  1414. {---------------------------------------------
  1415. Factor_Read_Set
  1416. ---------------------------------------------}
  1417. { Read a set between [] }
  1418. function factor_read_set:tnode;
  1419. var
  1420. p1,p2 : tnode;
  1421. lastp,
  1422. buildp : tarrayconstructornode;
  1423. begin
  1424. buildp:=nil;
  1425. { be sure that a least one arrayconstructn is used, also for an
  1426. empty [] }
  1427. if token=_RECKKLAMMER then
  1428. buildp:=carrayconstructornode.create(nil,buildp)
  1429. else
  1430. begin
  1431. while true do
  1432. begin
  1433. p1:=comp_expr(true);
  1434. if token=_POINTPOINT then
  1435. begin
  1436. consume(_POINTPOINT);
  1437. p2:=comp_expr(true);
  1438. p1:=carrayconstructorrangenode.create(p1,p2);
  1439. end;
  1440. { insert at the end of the tree, to get the correct order }
  1441. if not assigned(buildp) then
  1442. begin
  1443. buildp:=carrayconstructornode.create(p1,nil);
  1444. lastp:=buildp;
  1445. end
  1446. else
  1447. begin
  1448. lastp.right:=carrayconstructornode.create(p1,nil);
  1449. lastp:=tarrayconstructornode(lastp.right);
  1450. end;
  1451. { there could be more elements }
  1452. if token=_COMMA then
  1453. consume(_COMMA)
  1454. else
  1455. break;
  1456. end;
  1457. end;
  1458. factor_read_set:=buildp;
  1459. end;
  1460. {---------------------------------------------
  1461. PostFixOperators
  1462. ---------------------------------------------}
  1463. procedure postfixoperators(var p1:tnode;var again:boolean);
  1464. { tries to avoid syntax errors after invalid qualifiers }
  1465. procedure recoverconsume_postfixops;
  1466. begin
  1467. while true do
  1468. begin
  1469. case token of
  1470. _CARET:
  1471. consume(_CARET);
  1472. _POINT:
  1473. begin
  1474. consume(_POINT);
  1475. if token=_ID then
  1476. consume(_ID);
  1477. end;
  1478. _LECKKLAMMER:
  1479. begin
  1480. consume(_LECKKLAMMER);
  1481. repeat
  1482. comp_expr(true);
  1483. if token=_COMMA then
  1484. consume(_COMMA)
  1485. else
  1486. break;
  1487. until false;
  1488. consume(_RECKKLAMMER);
  1489. end
  1490. else
  1491. break;
  1492. end;
  1493. end;
  1494. end;
  1495. var
  1496. store_static : boolean;
  1497. protsym : tpropertysym;
  1498. p2,p3 : tnode;
  1499. hsym : tsym;
  1500. classh : tobjectdef;
  1501. begin
  1502. again:=true;
  1503. while again do
  1504. begin
  1505. { we need the resulttype }
  1506. do_resulttypepass(p1);
  1507. if codegenerror then
  1508. begin
  1509. recoverconsume_postfixops;
  1510. exit;
  1511. end;
  1512. { handle token }
  1513. case token of
  1514. _CARET:
  1515. begin
  1516. consume(_CARET);
  1517. if (p1.resulttype.def.deftype<>pointerdef) then
  1518. begin
  1519. { ^ as binary operator is a problem!!!! (FK) }
  1520. again:=false;
  1521. Message(cg_e_invalid_qualifier);
  1522. recoverconsume_postfixops;
  1523. p1.destroy;
  1524. p1:=cerrornode.create;
  1525. end
  1526. else
  1527. begin
  1528. p1:=cderefnode.create(p1);
  1529. end;
  1530. end;
  1531. _LECKKLAMMER:
  1532. begin
  1533. if is_class_or_interface(p1.resulttype.def) then
  1534. begin
  1535. { default property }
  1536. protsym:=search_default_property(tobjectdef(p1.resulttype.def));
  1537. if not(assigned(protsym)) then
  1538. begin
  1539. p1.destroy;
  1540. p1:=cerrornode.create;
  1541. again:=false;
  1542. message(parser_e_no_default_property_available);
  1543. end
  1544. else
  1545. handle_propertysym(protsym,protsym.owner,p1,getaddr);
  1546. end
  1547. else
  1548. begin
  1549. consume(_LECKKLAMMER);
  1550. repeat
  1551. case p1.resulttype.def.deftype of
  1552. pointerdef:
  1553. begin
  1554. { support delphi autoderef }
  1555. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
  1556. (m_autoderef in aktmodeswitches) then
  1557. begin
  1558. p1:=cderefnode.create(p1);
  1559. end;
  1560. p2:=comp_expr(true);
  1561. p1:=cvecnode.create(p1,p2);
  1562. end;
  1563. stringdef :
  1564. begin
  1565. p2:=comp_expr(true);
  1566. p1:=cvecnode.create(p1,p2);
  1567. end;
  1568. arraydef :
  1569. begin
  1570. p2:=comp_expr(true);
  1571. { support SEG:OFS for go32v2 Mem[] }
  1572. if (target_info.target=target_i386_go32v2) and
  1573. (p1.nodetype=loadn) and
  1574. assigned(tloadnode(p1).symtableentry) and
  1575. assigned(tloadnode(p1).symtableentry.owner.name) and
  1576. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1577. ((tloadnode(p1).symtableentry.name='MEM') or
  1578. (tloadnode(p1).symtableentry.name='MEMW') or
  1579. (tloadnode(p1).symtableentry.name='MEML')) then
  1580. begin
  1581. if (token=_COLON) then
  1582. begin
  1583. consume(_COLON);
  1584. p3:=caddnode.create(muln,cordconstnode.create($10,s32bittype),p2);
  1585. p2:=comp_expr(true);
  1586. p2:=caddnode.create(addn,p2,p3);
  1587. p1:=cvecnode.create(p1,p2);
  1588. include(tvecnode(p1).flags,nf_memseg);
  1589. include(tvecnode(p1).flags,nf_memindex);
  1590. end
  1591. else
  1592. begin
  1593. p1:=cvecnode.create(p1,p2);
  1594. include(tvecnode(p1).flags,nf_memindex);
  1595. end;
  1596. end
  1597. else
  1598. p1:=cvecnode.create(p1,p2);
  1599. end;
  1600. else
  1601. begin
  1602. Message(cg_e_invalid_qualifier);
  1603. p1.destroy;
  1604. p1:=cerrornode.create;
  1605. comp_expr(true);
  1606. again:=false;
  1607. end;
  1608. end;
  1609. do_resulttypepass(p1);
  1610. if token=_COMMA then
  1611. consume(_COMMA)
  1612. else
  1613. break;
  1614. until false;
  1615. consume(_RECKKLAMMER);
  1616. end;
  1617. end;
  1618. _POINT :
  1619. begin
  1620. consume(_POINT);
  1621. if (p1.resulttype.def.deftype=pointerdef) and
  1622. (m_autoderef in aktmodeswitches) then
  1623. begin
  1624. p1:=cderefnode.create(p1);
  1625. do_resulttypepass(p1);
  1626. end;
  1627. case p1.resulttype.def.deftype of
  1628. recorddef:
  1629. begin
  1630. hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
  1631. if assigned(hsym) and
  1632. (hsym.typ=varsym) then
  1633. p1:=csubscriptnode.create(tvarsym(hsym),p1)
  1634. else
  1635. begin
  1636. Message1(sym_e_illegal_field,pattern);
  1637. p1.destroy;
  1638. p1:=cerrornode.create;
  1639. end;
  1640. consume(_ID);
  1641. end;
  1642. variantdef:
  1643. begin
  1644. end;
  1645. classrefdef:
  1646. begin
  1647. classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
  1648. hsym:=nil;
  1649. while assigned(classh) do
  1650. begin
  1651. hsym:=tsym(classh.symtable.search(pattern));
  1652. if assigned(hsym) then
  1653. break;
  1654. classh:=classh.childof;
  1655. end;
  1656. if hsym=nil then
  1657. begin
  1658. Message1(sym_e_id_no_member,pattern);
  1659. p1.destroy;
  1660. p1:=cerrornode.create;
  1661. { try to clean up }
  1662. consume(_ID);
  1663. end
  1664. else
  1665. begin
  1666. consume(_ID);
  1667. do_member_read(getaddr,hsym,p1,again);
  1668. end;
  1669. end;
  1670. objectdef:
  1671. begin
  1672. classh:=tobjectdef(p1.resulttype.def);
  1673. hsym:=nil;
  1674. store_static:=allow_only_static;
  1675. allow_only_static:=false;
  1676. while assigned(classh) do
  1677. begin
  1678. hsym:=tsym(classh.symtable.search(pattern));
  1679. if assigned(hsym) then
  1680. break;
  1681. classh:=classh.childof;
  1682. end;
  1683. allow_only_static:=store_static;
  1684. if hsym=nil then
  1685. begin
  1686. Message1(sym_e_id_no_member,pattern);
  1687. p1.destroy;
  1688. p1:=cerrornode.create;
  1689. { try to clean up }
  1690. consume(_ID);
  1691. end
  1692. else
  1693. begin
  1694. consume(_ID);
  1695. do_member_read(getaddr,hsym,p1,again);
  1696. end;
  1697. end;
  1698. pointerdef:
  1699. begin
  1700. Message(cg_e_invalid_qualifier);
  1701. if tpointerdef(p1.resulttype.def).pointertype.def.deftype in [recorddef,objectdef,classrefdef] then
  1702. Message(parser_h_maybe_deref_caret_missing);
  1703. end;
  1704. else
  1705. begin
  1706. Message(cg_e_invalid_qualifier);
  1707. p1.destroy;
  1708. p1:=cerrornode.create;
  1709. consume(_ID);
  1710. end;
  1711. end;
  1712. end;
  1713. else
  1714. begin
  1715. { is this a procedure variable ? }
  1716. if assigned(p1.resulttype.def) then
  1717. begin
  1718. if (p1.resulttype.def.deftype=procvardef) then
  1719. begin
  1720. if assigned(getprocvardef) and
  1721. is_equal(p1.resulttype.def,getprocvardef) then
  1722. again:=false
  1723. else
  1724. if (token=_LKLAMMER) or
  1725. ((tprocvardef(p1.resulttype.def).para.empty) and
  1726. (not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
  1727. (not afterassignment) and
  1728. (not in_args)) then
  1729. begin
  1730. { do this in a strange way }
  1731. { it's not a clean solution }
  1732. p2:=p1;
  1733. p1:=ccallnode.create(nil,nil,nil,nil);
  1734. tcallnode(p1).set_procvar(p2);
  1735. if token=_LKLAMMER then
  1736. begin
  1737. consume(_LKLAMMER);
  1738. tcallnode(p1).left:=parse_paras(false,false);
  1739. consume(_RKLAMMER);
  1740. end;
  1741. { proc():= is never possible }
  1742. if token=_ASSIGNMENT then
  1743. begin
  1744. Message(cg_e_illegal_expression);
  1745. p1:=cerrornode.create;
  1746. again:=false;
  1747. end;
  1748. end
  1749. else
  1750. again:=false;
  1751. end
  1752. else
  1753. again:=false;
  1754. end
  1755. else
  1756. again:=false;
  1757. end;
  1758. end;
  1759. end; { while again }
  1760. end;
  1761. {---------------------------------------------
  1762. Factor (Main)
  1763. ---------------------------------------------}
  1764. var
  1765. l : longint;
  1766. card : cardinal;
  1767. ic : TConstExprInt;
  1768. oldp1,
  1769. p1 : tnode;
  1770. code : integer;
  1771. again : boolean;
  1772. sym : tsym;
  1773. classh : tobjectdef;
  1774. d : bestreal;
  1775. hs : string;
  1776. htype : ttype;
  1777. filepos : tfileposinfo;
  1778. {---------------------------------------------
  1779. Helpers
  1780. ---------------------------------------------}
  1781. procedure check_tokenpos;
  1782. begin
  1783. if (p1<>oldp1) then
  1784. begin
  1785. if assigned(p1) then
  1786. p1.set_tree_filepos(filepos);
  1787. oldp1:=p1;
  1788. filepos:=akttokenpos;
  1789. end;
  1790. end;
  1791. begin
  1792. oldp1:=nil;
  1793. p1:=nil;
  1794. filepos:=akttokenpos;
  1795. again:=false;
  1796. if token=_ID then
  1797. begin
  1798. factor_read_id(p1,again);
  1799. if again then
  1800. begin
  1801. check_tokenpos;
  1802. { handle post fix operators }
  1803. postfixoperators(p1,again);
  1804. end;
  1805. end
  1806. else
  1807. case token of
  1808. _SELF :
  1809. begin
  1810. again:=true;
  1811. consume(_SELF);
  1812. if not assigned(procinfo^._class) then
  1813. begin
  1814. p1:=cerrornode.create;
  1815. again:=false;
  1816. Message(parser_e_self_not_in_method);
  1817. end
  1818. else
  1819. begin
  1820. if (po_classmethod in aktprocdef.procoptions) then
  1821. begin
  1822. { self in class methods is a class reference type }
  1823. htype.setdef(procinfo^._class);
  1824. p1:=cselfnode.create(tobjectdef(tclassrefdef.create(htype)));
  1825. end
  1826. else
  1827. p1:=cselfnode.create(procinfo^._class);
  1828. postfixoperators(p1,again);
  1829. end;
  1830. end;
  1831. _INHERITED :
  1832. begin
  1833. again:=true;
  1834. consume(_INHERITED);
  1835. if assigned(procinfo^._class) then
  1836. begin
  1837. { if inherited; only then we need the method with
  1838. the same name }
  1839. if token=_SEMICOLON then
  1840. begin
  1841. hs:=aktprocsym.name;
  1842. auto_inherited:=true
  1843. end
  1844. else
  1845. begin
  1846. hs:=pattern;
  1847. consume(_ID);
  1848. auto_inherited:=false;
  1849. end;
  1850. classh:=procinfo^._class.childof;
  1851. while assigned(classh) do
  1852. begin
  1853. sym:=tsym(tobjectdef(classh).symtable.search(hs));
  1854. if assigned(sym) then
  1855. begin
  1856. if sym.typ=procsym then
  1857. begin
  1858. htype.setdef(classh);
  1859. p1:=ctypenode.create(htype);
  1860. end;
  1861. do_member_read(false,sym,p1,again);
  1862. break;
  1863. end;
  1864. classh:=classh.childof;
  1865. end;
  1866. if classh=nil then
  1867. begin
  1868. Message1(sym_e_id_no_member,hs);
  1869. again:=false;
  1870. p1:=cerrornode.create;
  1871. end;
  1872. { turn auto inheriting off }
  1873. auto_inherited:=false;
  1874. end
  1875. else
  1876. begin
  1877. Message(parser_e_generic_methods_only_in_methods);
  1878. again:=false;
  1879. p1:=cerrornode.create;
  1880. end;
  1881. postfixoperators(p1,again);
  1882. end;
  1883. _INTCONST :
  1884. begin
  1885. { try cardinal first }
  1886. val(pattern,card,code);
  1887. if code<>0 then
  1888. begin
  1889. { then longint }
  1890. valint(pattern,l,code);
  1891. if code <> 0 then
  1892. begin
  1893. { then int64 }
  1894. val(pattern,ic,code);
  1895. if code<>0 then
  1896. begin
  1897. {finally float }
  1898. val(pattern,d,code);
  1899. if code<>0 then
  1900. begin
  1901. Message(cg_e_invalid_integer);
  1902. consume(_INTCONST);
  1903. l:=1;
  1904. p1:=cordconstnode.create(l,s32bittype);
  1905. end
  1906. else
  1907. begin
  1908. consume(_INTCONST);
  1909. p1:=crealconstnode.create(d,pbestrealtype^);
  1910. end;
  1911. end
  1912. else
  1913. begin
  1914. consume(_INTCONST);
  1915. p1:=cordconstnode.create(ic,cs64bittype);
  1916. end
  1917. end
  1918. else
  1919. begin
  1920. consume(_INTCONST);
  1921. p1:=cordconstnode.create(l,s32bittype)
  1922. end
  1923. end
  1924. else
  1925. begin
  1926. consume(_INTCONST);
  1927. { check whether the value isn't in the longint range as well }
  1928. { (longint is easier to perform calculations with) (JM) }
  1929. if card <= $7fffffff then
  1930. { no sign extension necessary, so not longint typecast (JM) }
  1931. p1:=cordconstnode.create(card,s32bittype)
  1932. else
  1933. p1:=cordconstnode.create(card,u32bittype)
  1934. end;
  1935. end;
  1936. _REALNUMBER :
  1937. begin
  1938. val(pattern,d,code);
  1939. if code<>0 then
  1940. begin
  1941. Message(parser_e_error_in_real);
  1942. d:=1.0;
  1943. end;
  1944. consume(_REALNUMBER);
  1945. p1:=crealconstnode.create(d,pbestrealtype^);
  1946. end;
  1947. _STRING :
  1948. begin
  1949. string_dec(htype);
  1950. { STRING can be also a type cast }
  1951. if token=_LKLAMMER then
  1952. begin
  1953. consume(_LKLAMMER);
  1954. p1:=comp_expr(true);
  1955. consume(_RKLAMMER);
  1956. p1:=ctypeconvnode.create(p1,htype);
  1957. include(p1.flags,nf_explizit);
  1958. { handle postfix operators here e.g. string(a)[10] }
  1959. again:=true;
  1960. postfixoperators(p1,again);
  1961. end
  1962. else
  1963. p1:=ctypenode.create(htype);
  1964. end;
  1965. _FILE :
  1966. begin
  1967. htype:=cfiletype;
  1968. consume(_FILE);
  1969. { FILE can be also a type cast }
  1970. if token=_LKLAMMER then
  1971. begin
  1972. consume(_LKLAMMER);
  1973. p1:=comp_expr(true);
  1974. consume(_RKLAMMER);
  1975. p1:=ctypeconvnode.create(p1,htype);
  1976. include(p1.flags,nf_explizit);
  1977. { handle postfix operators here e.g. string(a)[10] }
  1978. again:=true;
  1979. postfixoperators(p1,again);
  1980. end
  1981. else
  1982. begin
  1983. p1:=ctypenode.create(htype);
  1984. end;
  1985. end;
  1986. _CSTRING :
  1987. begin
  1988. p1:=cstringconstnode.createstr(pattern,st_default);
  1989. consume(_CSTRING);
  1990. end;
  1991. _CCHAR :
  1992. begin
  1993. p1:=cordconstnode.create(ord(pattern[1]),cchartype);
  1994. consume(_CCHAR);
  1995. end;
  1996. _CWSTRING:
  1997. begin
  1998. p1:=cstringconstnode.createwstr(patternw);
  1999. consume(_CWSTRING);
  2000. end;
  2001. _CWCHAR:
  2002. begin
  2003. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype);
  2004. consume(_CWCHAR);
  2005. end;
  2006. _KLAMMERAFFE :
  2007. begin
  2008. consume(_KLAMMERAFFE);
  2009. got_addrn:=true;
  2010. { support both @<x> and @(<x>) }
  2011. if token=_LKLAMMER then
  2012. begin
  2013. consume(_LKLAMMER);
  2014. p1:=factor(true);
  2015. consume(_RKLAMMER);
  2016. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2017. begin
  2018. again:=true;
  2019. postfixoperators(p1,again);
  2020. end;
  2021. end
  2022. else
  2023. p1:=factor(true);
  2024. got_addrn:=false;
  2025. p1:=caddrnode.create(p1);
  2026. if assigned(getprocvardef) then
  2027. taddrnode(p1).getprocvardef:=getprocvardef;
  2028. end;
  2029. _LKLAMMER :
  2030. begin
  2031. consume(_LKLAMMER);
  2032. p1:=comp_expr(true);
  2033. consume(_RKLAMMER);
  2034. { it's not a good solution }
  2035. { but (a+b)^ makes some problems }
  2036. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2037. begin
  2038. again:=true;
  2039. postfixoperators(p1,again);
  2040. end;
  2041. end;
  2042. _LECKKLAMMER :
  2043. begin
  2044. consume(_LECKKLAMMER);
  2045. p1:=factor_read_set;
  2046. consume(_RECKKLAMMER);
  2047. end;
  2048. _PLUS :
  2049. begin
  2050. consume(_PLUS);
  2051. p1:=factor(false);
  2052. end;
  2053. _MINUS :
  2054. begin
  2055. consume(_MINUS);
  2056. p1:=sub_expr(oppower,false);
  2057. p1:=cunaryminusnode.create(p1);
  2058. end;
  2059. _OP_NOT :
  2060. begin
  2061. consume(_OP_NOT);
  2062. p1:=factor(false);
  2063. p1:=cnotnode.create(p1);
  2064. end;
  2065. _TRUE :
  2066. begin
  2067. consume(_TRUE);
  2068. p1:=cordconstnode.create(1,booltype);
  2069. end;
  2070. _FALSE :
  2071. begin
  2072. consume(_FALSE);
  2073. p1:=cordconstnode.create(0,booltype);
  2074. end;
  2075. _NIL :
  2076. begin
  2077. consume(_NIL);
  2078. p1:=cnilnode.create;
  2079. end;
  2080. else
  2081. begin
  2082. p1:=cerrornode.create;
  2083. consume(token);
  2084. Message(cg_e_illegal_expression);
  2085. end;
  2086. end;
  2087. { generate error node if no node is created }
  2088. if not assigned(p1) then
  2089. begin
  2090. {$ifdef EXTDEBUG}
  2091. Comment(V_Warning,'factor: p1=nil');
  2092. {$endif}
  2093. p1:=cerrornode.create;
  2094. end;
  2095. { get the resulttype for the node }
  2096. if (not assigned(p1.resulttype.def)) then
  2097. do_resulttypepass(p1);
  2098. { tp7 procvar handling, but not if the next token
  2099. will be a := }
  2100. if (m_tp_procvar in aktmodeswitches) and
  2101. (token<>_ASSIGNMENT) then
  2102. check_tp_procvar(p1);
  2103. factor:=p1;
  2104. check_tokenpos;
  2105. end;
  2106. {$ifdef fpc}
  2107. {$maxfpuregisters default}
  2108. {$endif fpc}
  2109. {****************************************************************************
  2110. Sub_Expr
  2111. ****************************************************************************}
  2112. const
  2113. { Warning these stay be ordered !! }
  2114. operator_levels:array[Toperator_precedence] of set of Ttoken=
  2115. ([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN,_OP_IS],
  2116. [_PLUS,_MINUS,_OP_OR,_OP_XOR],
  2117. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2118. _OP_AS,_OP_AND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2119. [_STARSTAR] );
  2120. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
  2121. {Reads a subexpression while the operators are of the current precedence
  2122. level, or any higher level. Replaces the old term, simpl_expr and
  2123. simpl2_expr.}
  2124. var
  2125. p1,p2 : tnode;
  2126. oldt : Ttoken;
  2127. filepos : tfileposinfo;
  2128. begin
  2129. if pred_level=highest_precedence then
  2130. p1:=factor(false)
  2131. else
  2132. p1:=sub_expr(succ(pred_level),true);
  2133. repeat
  2134. if (token in operator_levels[pred_level]) and
  2135. ((token<>_EQUAL) or accept_equal) then
  2136. begin
  2137. oldt:=token;
  2138. filepos:=akttokenpos;
  2139. consume(token);
  2140. if pred_level=highest_precedence then
  2141. p2:=factor(false)
  2142. else
  2143. p2:=sub_expr(succ(pred_level),true);
  2144. case oldt of
  2145. _PLUS :
  2146. p1:=caddnode.create(addn,p1,p2);
  2147. _MINUS :
  2148. p1:=caddnode.create(subn,p1,p2);
  2149. _STAR :
  2150. p1:=caddnode.create(muln,p1,p2);
  2151. _SLASH :
  2152. p1:=caddnode.create(slashn,p1,p2);
  2153. _EQUAL :
  2154. p1:=caddnode.create(equaln,p1,p2);
  2155. _GT :
  2156. p1:=caddnode.create(gtn,p1,p2);
  2157. _LT :
  2158. p1:=caddnode.create(ltn,p1,p2);
  2159. _GTE :
  2160. p1:=caddnode.create(gten,p1,p2);
  2161. _LTE :
  2162. p1:=caddnode.create(lten,p1,p2);
  2163. _SYMDIF :
  2164. p1:=caddnode.create(symdifn,p1,p2);
  2165. _STARSTAR :
  2166. p1:=caddnode.create(starstarn,p1,p2);
  2167. _OP_AS :
  2168. p1:=casnode.create(p1,p2);
  2169. _OP_IN :
  2170. p1:=cinnode.create(p1,p2);
  2171. _OP_IS :
  2172. p1:=cisnode.create(p1,p2);
  2173. _OP_OR :
  2174. p1:=caddnode.create(orn,p1,p2);
  2175. _OP_AND :
  2176. p1:=caddnode.create(andn,p1,p2);
  2177. _OP_DIV :
  2178. p1:=cmoddivnode.create(divn,p1,p2);
  2179. _OP_NOT :
  2180. p1:=cnotnode.create(p1);
  2181. _OP_MOD :
  2182. p1:=cmoddivnode.create(modn,p1,p2);
  2183. _OP_SHL :
  2184. p1:=cshlshrnode.create(shln,p1,p2);
  2185. _OP_SHR :
  2186. p1:=cshlshrnode.create(shrn,p1,p2);
  2187. _OP_XOR :
  2188. p1:=caddnode.create(xorn,p1,p2);
  2189. _ASSIGNMENT :
  2190. p1:=cassignmentnode.create(p1,p2);
  2191. _CARET :
  2192. p1:=caddnode.create(caretn,p1,p2);
  2193. _UNEQUAL :
  2194. p1:=caddnode.create(unequaln,p1,p2);
  2195. end;
  2196. p1.set_tree_filepos(filepos);
  2197. end
  2198. else
  2199. break;
  2200. until false;
  2201. sub_expr:=p1;
  2202. end;
  2203. function comp_expr(accept_equal : boolean):tnode;
  2204. var
  2205. oldafterassignment : boolean;
  2206. p1 : tnode;
  2207. begin
  2208. oldafterassignment:=afterassignment;
  2209. afterassignment:=true;
  2210. p1:=sub_expr(opcompare,accept_equal);
  2211. { get the resulttype for this expression }
  2212. if not assigned(p1.resulttype.def) then
  2213. do_resulttypepass(p1);
  2214. afterassignment:=oldafterassignment;
  2215. comp_expr:=p1;
  2216. end;
  2217. function expr : tnode;
  2218. var
  2219. p1,p2 : tnode;
  2220. oldafterassignment : boolean;
  2221. oldp1 : tnode;
  2222. filepos : tfileposinfo;
  2223. begin
  2224. oldafterassignment:=afterassignment;
  2225. p1:=sub_expr(opcompare,true);
  2226. { get the resulttype for this expression }
  2227. if not assigned(p1.resulttype.def) then
  2228. do_resulttypepass(p1);
  2229. filepos:=akttokenpos;
  2230. if (m_tp_procvar in aktmodeswitches) and
  2231. (token<>_ASSIGNMENT) then
  2232. check_tp_procvar(p1);
  2233. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2234. afterassignment:=true;
  2235. oldp1:=p1;
  2236. case token of
  2237. _POINTPOINT :
  2238. begin
  2239. consume(_POINTPOINT);
  2240. p2:=sub_expr(opcompare,true);
  2241. p1:=crangenode.create(p1,p2);
  2242. end;
  2243. _ASSIGNMENT :
  2244. begin
  2245. consume(_ASSIGNMENT);
  2246. if (p1.resulttype.def.deftype=procvardef) then
  2247. getprocvardef:=tprocvardef(p1.resulttype.def);
  2248. p2:=sub_expr(opcompare,true);
  2249. if assigned(getprocvardef) then
  2250. handle_procvar(getprocvardef,p2,true);
  2251. getprocvardef:=nil;
  2252. p1:=cassignmentnode.create(p1,p2);
  2253. end;
  2254. _PLUSASN :
  2255. begin
  2256. consume(_PLUSASN);
  2257. p2:=sub_expr(opcompare,true);
  2258. p1:=cassignmentnode.create(p1,caddnode.create(addn,p1.getcopy,p2));
  2259. end;
  2260. _MINUSASN :
  2261. begin
  2262. consume(_MINUSASN);
  2263. p2:=sub_expr(opcompare,true);
  2264. p1:=cassignmentnode.create(p1,caddnode.create(subn,p1.getcopy,p2));
  2265. end;
  2266. _STARASN :
  2267. begin
  2268. consume(_STARASN );
  2269. p2:=sub_expr(opcompare,true);
  2270. p1:=cassignmentnode.create(p1,caddnode.create(muln,p1.getcopy,p2));
  2271. end;
  2272. _SLASHASN :
  2273. begin
  2274. consume(_SLASHASN );
  2275. p2:=sub_expr(opcompare,true);
  2276. p1:=cassignmentnode.create(p1,caddnode.create(slashn,p1.getcopy,p2));
  2277. end;
  2278. end;
  2279. { get the resulttype for this expression }
  2280. if not assigned(p1.resulttype.def) then
  2281. do_resulttypepass(p1);
  2282. afterassignment:=oldafterassignment;
  2283. if p1<>oldp1 then
  2284. p1.set_tree_filepos(filepos);
  2285. expr:=p1;
  2286. end;
  2287. {$ifdef int64funcresok}
  2288. function get_intconst:TConstExprInt;
  2289. {$else int64funcresok}
  2290. function get_intconst:longint;
  2291. {$endif int64funcresok}
  2292. {Reads an expression, tries to evalute it and check if it is an integer
  2293. constant. Then the constant is returned.}
  2294. var
  2295. p:tnode;
  2296. begin
  2297. p:=comp_expr(true);
  2298. if not codegenerror then
  2299. begin
  2300. if (p.nodetype<>ordconstn) or
  2301. not(is_integer(p.resulttype.def)) then
  2302. Message(cg_e_illegal_expression)
  2303. else
  2304. get_intconst:=tordconstnode(p).value;
  2305. end;
  2306. p.free;
  2307. end;
  2308. function get_stringconst:string;
  2309. {Reads an expression, tries to evaluate it and checks if it is a string
  2310. constant. Then the constant is returned.}
  2311. var
  2312. p:tnode;
  2313. begin
  2314. get_stringconst:='';
  2315. p:=comp_expr(true);
  2316. if p.nodetype<>stringconstn then
  2317. begin
  2318. if (p.nodetype=ordconstn) and is_char(p.resulttype.def) then
  2319. get_stringconst:=char(tordconstnode(p).value)
  2320. else
  2321. Message(cg_e_illegal_expression);
  2322. end
  2323. else
  2324. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2325. p.free;
  2326. end;
  2327. end.
  2328. {
  2329. $Log$
  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. }