1 { 2 Copyright (c) 1998-2002 by Florian Klaempfl 3 4 Does the parsing of the statements 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21 } 22 unit pstatmnt; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 tokens,node; 30 31 statement_blocknull32 function statement_block(starttoken : ttoken) : tnode; 33 34 { reads an assembler block } assembler_blocknull35 function assembler_block : tnode; 36 37 38 implementation 39 40 uses 41 { common } 42 cutils,cclasses, 43 { global } 44 globtype,globals,verbose,constexp, 45 systems, 46 { aasm } 47 cpubase,aasmtai,aasmdata, 48 { symtable } 49 symconst,symbase,symtype,symdef,symsym,symtable,defutil,defcmp, 50 paramgr, 51 { pass 1 } 52 pass_1,htypechk, 53 nutils,ngenutil,nbas,ncal,nmem,nset,ncnv,ncon,nld,nflw, 54 { parser } 55 scanner, 56 pbase,ptype,pexpr, 57 { codegen } 58 procinfo,cgbase, 59 { assembler reader } 60 rabase; 61 62 63 function statement : tnode;forward; 64 65 if_statementnull66 function if_statement : tnode; 67 var 68 ex,if_a,else_a : tnode; 69 begin 70 consume(_IF); 71 ex:=comp_expr([ef_accept_equal]); 72 consume(_THEN); 73 if not(token in endtokens) then 74 if_a:=statement 75 else 76 if_a:=nil; 77 78 if try_to_consume(_ELSE) then 79 else_a:=statement 80 else 81 else_a:=nil; 82 result:=cifnode.create(ex,if_a,else_a); 83 end; 84 85 { creates a block (list) of statements, til the next END token } statements_til_endnull86 function statements_til_end : tnode; 87 88 var 89 first,last : tstatementnode; 90 91 begin 92 first:=nil; 93 last:=nil; 94 while token<>_END do 95 begin 96 if first=nil then 97 begin 98 last:=cstatementnode.create(statement,nil); 99 first:=last; 100 end 101 else 102 begin 103 last.right:=cstatementnode.create(statement,nil); 104 last:=tstatementnode(last.right); 105 end; 106 if not try_to_consume(_SEMICOLON) then 107 break; 108 consume_emptystats; 109 end; 110 consume(_END); 111 statements_til_end:=cblocknode.create(first); 112 end; 113 114 case_statementnull115 function case_statement : tnode; 116 var 117 casedef : tdef; 118 caseexpr,p : tnode; 119 blockid : longint; 120 hl1,hl2 : TConstExprInt; 121 sl1,sl2 : tstringconstnode; 122 casedeferror, caseofstring : boolean; 123 casenode : tcasenode; 124 begin 125 consume(_CASE); 126 caseexpr:=comp_expr([ef_accept_equal]); 127 { determines result type } 128 do_typecheckpass(caseexpr); 129 { variants must be accepted, but first they must be converted to integer } 130 if caseexpr.resultdef.typ=variantdef then 131 begin 132 caseexpr:=ctypeconvnode.create_internal(caseexpr,sinttype); 133 do_typecheckpass(caseexpr); 134 end; 135 set_varstate(caseexpr,vs_read,[vsf_must_be_valid]); 136 casedeferror:=false; 137 casedef:=caseexpr.resultdef; 138 { case of string must be rejected in delphi-, } 139 { tp7/bp7-, mac-compatibility modes. } 140 caseofstring := 141 ([m_delphi, m_mac, m_tp7] * current_settings.modeswitches = []) and 142 is_string(casedef); 143 144 if (not assigned(casedef)) or 145 ( not(is_ordinal(casedef)) and (not caseofstring) ) then 146 begin 147 CGMessage(type_e_ordinal_or_string_expr_expected); 148 { create a correct tree } 149 caseexpr.free; 150 caseexpr:=cordconstnode.create(0,u32inttype,false); 151 { set error flag so no rangechecks are done } 152 casedeferror:=true; 153 end; 154 { Create casenode } 155 casenode:=ccasenode.create(caseexpr); 156 consume(_OF); 157 { Parse all case blocks } 158 blockid:=0; 159 repeat 160 { maybe an instruction has more case labels } 161 repeat 162 p:=expr(true); 163 if is_widechar(casedef) then 164 begin 165 if (p.nodetype=rangen) then 166 begin 167 trangenode(p).left:=ctypeconvnode.create(trangenode(p).left,cwidechartype); 168 trangenode(p).right:=ctypeconvnode.create(trangenode(p).right,cwidechartype); 169 do_typecheckpass(trangenode(p).left); 170 do_typecheckpass(trangenode(p).right); 171 end 172 else 173 begin 174 p:=ctypeconvnode.create(p,cwidechartype); 175 do_typecheckpass(p); 176 end; 177 end 178 else 179 begin 180 if is_char(casedef) and is_widechar(p.resultdef) then 181 begin 182 if (p.nodetype=ordconstn) then 183 begin 184 p:=ctypeconvnode.create(p,cansichartype); 185 do_typecheckpass(p); 186 end 187 else if (p.nodetype=rangen) then 188 begin 189 trangenode(p).left:=ctypeconvnode.create(trangenode(p).left,cansichartype); 190 trangenode(p).right:=ctypeconvnode.create(trangenode(p).right,cansichartype); 191 do_typecheckpass(trangenode(p).left); 192 do_typecheckpass(trangenode(p).right); 193 end; 194 end; 195 end; 196 hl1:=0; 197 hl2:=0; 198 sl1:=nil; 199 sl2:=nil; 200 if (p.nodetype=rangen) then 201 begin 202 { type check for string case statements } 203 if caseofstring and 204 is_conststring_or_constcharnode(trangenode(p).left) and 205 is_conststring_or_constcharnode(trangenode(p).right) then 206 begin 207 { we need stringconstnodes, even if expression contains single chars } 208 sl1 := get_string_value(trangenode(p).left, tstringdef(casedef)); 209 sl2 := get_string_value(trangenode(p).right, tstringdef(casedef)); 210 if sl1.fullcompare(sl2) > 0 then 211 CGMessage(parser_e_case_lower_less_than_upper_bound); 212 end 213 { type checking for ordinal case statements } 214 else if (not caseofstring) and 215 is_subequal(casedef, trangenode(p).left.resultdef) and 216 is_subequal(casedef, trangenode(p).right.resultdef) then 217 begin 218 hl1:=get_ordinal_value(trangenode(p).left); 219 hl2:=get_ordinal_value(trangenode(p).right); 220 if hl1>hl2 then 221 CGMessage(parser_e_case_lower_less_than_upper_bound); 222 if not casedeferror then 223 begin 224 adaptrange(casedef,hl1,false,false,cs_check_range in current_settings.localswitches); 225 adaptrange(casedef,hl2,false,false,cs_check_range in current_settings.localswitches); 226 end; 227 end 228 else 229 CGMessage(parser_e_case_mismatch); 230 231 if caseofstring then 232 casenode.addlabel(blockid,sl1,sl2) 233 else 234 casenode.addlabel(blockid,hl1,hl2); 235 end 236 else 237 begin 238 { type check for string case statements } 239 if (caseofstring and (not is_conststring_or_constcharnode(p))) or 240 { type checking for ordinal case statements } 241 ((not caseofstring) and (not is_subequal(casedef, p.resultdef))) then 242 CGMessage(parser_e_case_mismatch); 243 244 if caseofstring then 245 begin 246 sl1:=get_string_value(p, tstringdef(casedef)); 247 casenode.addlabel(blockid,sl1,sl1); 248 end 249 else 250 begin 251 hl1:=get_ordinal_value(p); 252 if not casedeferror then 253 adaptrange(casedef,hl1,false,false,cs_check_range in current_settings.localswitches); 254 casenode.addlabel(blockid,hl1,hl1); 255 end; 256 end; 257 p.free; 258 sl1.free; 259 sl2.free; 260 261 if token=_COMMA then 262 consume(_COMMA) 263 else 264 break; 265 until false; 266 consume(_COLON); 267 268 { add instruction block } 269 casenode.addblock(blockid,statement); 270 271 { next block } 272 inc(blockid); 273 274 if not(token in [_ELSE,_OTHERWISE,_END]) then 275 consume(_SEMICOLON); 276 until (token in [_ELSE,_OTHERWISE,_END]); 277 278 if (token in [_ELSE,_OTHERWISE]) then 279 begin 280 if not try_to_consume(_ELSE) then 281 consume(_OTHERWISE); 282 casenode.addelseblock(statements_til_end); 283 end 284 else 285 consume(_END); 286 287 result:=casenode; 288 end; 289 290 repeat_statementnull291 function repeat_statement : tnode; 292 293 var 294 first,last,p_e : tnode; 295 296 begin 297 consume(_REPEAT); 298 299 first:=nil; 300 last:=nil; 301 while token<>_UNTIL do 302 begin 303 if first=nil then 304 begin 305 last:=cstatementnode.create(statement,nil); 306 first:=last; 307 end 308 else 309 begin 310 tstatementnode(last).right:=cstatementnode.create(statement,nil); 311 last:=tstatementnode(last).right; 312 end; 313 if not try_to_consume(_SEMICOLON) then 314 break; 315 consume_emptystats; 316 end; 317 consume(_UNTIL); 318 319 first:=cblocknode.create(first); 320 p_e:=comp_expr([ef_accept_equal]); 321 result:=cwhilerepeatnode.create(p_e,first,false,true); 322 end; 323 324 while_statementnull325 function while_statement : tnode; 326 327 var 328 p_e,p_a : tnode; 329 330 begin 331 consume(_WHILE); 332 p_e:=comp_expr([ef_accept_equal]); 333 consume(_DO); 334 p_a:=statement; 335 result:=cwhilerepeatnode.create(p_e,p_a,true,false); 336 end; 337 338 { a helper function which is used both by "with" and "for-in loop" nodes } skip_nodes_before_loadnull339 function skip_nodes_before_load(p: tnode): tnode; 340 begin 341 { ignore nodes that don't add instructions in the tree } 342 while assigned(p) and 343 { equal type conversions } 344 ( 345 (p.nodetype=typeconvn) and 346 (ttypeconvnode(p).convtype=tc_equal) 347 ) or 348 { constant array index } 349 ( 350 (p.nodetype=vecn) and 351 (tvecnode(p).right.nodetype=ordconstn) 352 ) do 353 p:=tunarynode(p).left; 354 result:=p; 355 end; 356 for_statementnull357 function for_statement : tnode; 358 359 procedure check_range(hp:tnode; fordef: tdef); 360 begin 361 if (hp.nodetype=ordconstn) and 362 (fordef.typ<>errordef) then 363 adaptrange(fordef,tordconstnode(hp).value,false,false,true); 364 end; 365 for_loop_createnull366 function for_loop_create(hloopvar: tnode): tnode; 367 var 368 hp, 369 hblock, 370 hto,hfrom : tnode; 371 backward : boolean; 372 loopvarsym : tabstractvarsym; 373 begin 374 { Check loop variable } 375 loopvarsym:=nil; 376 377 { variable must be an ordinal, int64 is not allowed for 32bit targets } 378 if ( 379 not(is_ordinal(hloopvar.resultdef)) 380 {$ifndef cpu64bitaddr} 381 or is_64bitint(hloopvar.resultdef) 382 {$endif not cpu64bitaddr} 383 ) and 384 (hloopvar.resultdef.typ<>undefineddef) 385 then 386 MessagePos(hloopvar.fileinfo,type_e_ordinal_expr_expected); 387 388 hp:=hloopvar; 389 while assigned(hp) and 390 ( 391 { record/object fields and array elements are allowed } 392 { in tp7 mode only } 393 ( 394 (m_tp7 in current_settings.modeswitches) and 395 ( 396 ((hp.nodetype=subscriptn) and 397 ((tsubscriptnode(hp).left.resultdef.typ=recorddef) or 398 is_object(tsubscriptnode(hp).left.resultdef)) 399 ) or 400 { constant array index } 401 ( 402 (hp.nodetype=vecn) and 403 is_constintnode(tvecnode(hp).right) 404 ) 405 ) 406 ) or 407 { equal typeconversions } 408 ( 409 (hp.nodetype=typeconvn) and 410 (ttypeconvnode(hp).convtype=tc_equal) 411 ) 412 ) do 413 begin 414 { Use the recordfield for loopvarsym } 415 if not assigned(loopvarsym) and 416 (hp.nodetype=subscriptn) then 417 loopvarsym:=tsubscriptnode(hp).vs; 418 hp:=tunarynode(hp).left; 419 end; 420 421 if assigned(hp) and 422 (hp.nodetype=loadn) then 423 begin 424 case tloadnode(hp).symtableentry.typ of 425 staticvarsym, 426 localvarsym, 427 paravarsym : 428 begin 429 { we need a simple loadn: 430 1. The load must be in a global symtable or 431 in the same level as the para of the current proc. 432 2. value variables (no const,out or var) 433 3. No threadvar, readonly or typedconst 434 } 435 if ( 436 (tloadnode(hp).symtable.symtablelevel=main_program_level) or 437 (tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel) 438 ) and 439 (tabstractvarsym(tloadnode(hp).symtableentry).varspez=vs_value) and 440 ([vo_is_thread_var,vo_is_typed_const] * tabstractvarsym(tloadnode(hp).symtableentry).varoptions=[]) then 441 begin 442 { Assigning for-loop variable is only allowed in tp7 and macpas } 443 if ([m_tp7,m_mac] * current_settings.modeswitches = []) then 444 begin 445 if not assigned(loopvarsym) then 446 loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry); 447 include(loopvarsym.varoptions,vo_is_loop_counter); 448 end; 449 end 450 else 451 begin 452 { Typed const is allowed in tp7 } 453 if not(m_tp7 in current_settings.modeswitches) or 454 not(vo_is_typed_const in tabstractvarsym(tloadnode(hp).symtableentry).varoptions) then 455 MessagePos(hp.fileinfo,type_e_illegal_count_var); 456 end; 457 end; 458 else 459 MessagePos(hp.fileinfo,type_e_illegal_count_var); 460 end; 461 end 462 else 463 MessagePos(hloopvar.fileinfo,type_e_illegal_count_var); 464 465 hfrom:=comp_expr([ef_accept_equal]); 466 467 if try_to_consume(_DOWNTO) then 468 backward:=true 469 else 470 begin 471 consume(_TO); 472 backward:=false; 473 end; 474 475 hto:=comp_expr([ef_accept_equal]); 476 consume(_DO); 477 478 { Check if the constants fit in the range } 479 check_range(hfrom,hloopvar.resultdef); 480 check_range(hto,hloopvar.resultdef); 481 482 { first set the varstate for from and to, so 483 uses of loopvar in those expressions will also 484 trigger a warning when it is not used yet. This 485 needs to be done before the instruction block is 486 parsed to have a valid hloopvar } 487 typecheckpass(hfrom); 488 set_varstate(hfrom,vs_read,[vsf_must_be_valid]); 489 typecheckpass(hto); 490 set_varstate(hto,vs_read,[vsf_must_be_valid]); 491 typecheckpass(hloopvar); 492 { in two steps, because vs_readwritten may turn on vsf_must_be_valid } 493 { for some subnodes } 494 set_varstate(hloopvar,vs_written,[]); 495 set_varstate(hloopvar,vs_read,[vsf_must_be_valid]); 496 497 { ... now the instruction block } 498 hblock:=statement; 499 500 { variable is not used for loop counter anymore } 501 if assigned(loopvarsym) then 502 exclude(loopvarsym.varoptions,vo_is_loop_counter); 503 504 result:=cfornode.create(hloopvar,hfrom,hto,hblock,backward); 505 end; 506 507 for_in_loop_createnull508 function for_in_loop_create(hloopvar: tnode): tnode; 509 var 510 expr,hloopbody,hp: tnode; 511 loopvarsym: tabstractvarsym; 512 begin 513 hp:=skip_nodes_before_load(hloopvar); 514 if assigned(hp)and(hp.nodetype=loadn) then 515 begin 516 loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry); 517 include(loopvarsym.varoptions,vo_is_loop_counter); 518 end 519 else 520 loopvarsym:=nil; 521 522 expr:=comp_expr([ef_accept_equal]); 523 524 consume(_DO); 525 526 set_varstate(hloopvar,vs_written,[]); 527 set_varstate(hloopvar,vs_read,[vsf_must_be_valid]); 528 529 hloopbody:=statement; 530 if assigned(loopvarsym) then 531 exclude(loopvarsym.varoptions,vo_is_loop_counter); 532 result:=create_for_in_loop(hloopvar,hloopbody,expr); 533 534 expr.free; 535 end; 536 537 538 var 539 hloopvar: tnode; 540 begin 541 { parse loop header } 542 consume(_FOR); 543 544 hloopvar:=factor(false,[]); 545 valid_for_loopvar(hloopvar,true); 546 547 if try_to_consume(_ASSIGNMENT) then 548 result:=for_loop_create(hloopvar) 549 else if try_to_consume(_IN) then 550 result:=for_in_loop_create(hloopvar) 551 else 552 begin 553 consume(_ASSIGNMENT); // fail 554 result:=cerrornode.create; 555 end; 556 end; 557 558 _with_statementnull559 function _with_statement : tnode; 560 561 var 562 p : tnode; 563 i : longint; 564 st : TSymtable; 565 newblock : tblocknode; 566 newstatement : tstatementnode; 567 calltempnode, 568 tempnode : ttempcreatenode; 569 valuenode, 570 hp, 571 refnode : tnode; 572 hdef : tdef; 573 helperdef : tobjectdef; 574 hasimplicitderef : boolean; 575 withsymtablelist : TFPObjectList; 576 577 procedure pushobjchild(withdef,obj:tobjectdef); 578 var 579 parenthelperdef : tobjectdef; 580 begin 581 if not assigned(obj) then 582 exit; 583 pushobjchild(withdef,obj.childof); 584 { we need to look for helpers that were defined for the parent 585 class as well } 586 search_last_objectpascal_helper(obj,current_structdef,parenthelperdef); 587 { push the symtables of the helper's parents in reverse order } 588 if assigned(parenthelperdef) then 589 pushobjchild(withdef,parenthelperdef.childof); 590 { keep the original tobjectdef as owner, because that is used for 591 visibility of the symtable } 592 st:=twithsymtable.create(withdef,obj.symtable.SymList,refnode.getcopy); 593 symtablestack.push(st); 594 withsymtablelist.add(st); 595 { push the symtable of the helper } 596 if assigned(parenthelperdef) then 597 begin 598 st:=twithsymtable.create(withdef,parenthelperdef.symtable.SymList,refnode.getcopy); 599 symtablestack.push(st); 600 withsymtablelist.add(st); 601 end; 602 end; 603 604 605 begin 606 calltempnode:=nil; 607 p:=comp_expr([ef_accept_equal]); 608 do_typecheckpass(p); 609 610 if (p.nodetype=vecn) and 611 (nf_memseg in p.flags) then 612 CGMessage(parser_e_no_with_for_variable_in_other_segments); 613 614 { "with procvar" can never mean anything, so always try 615 to call it in case it returns a record/object/... } 616 maybe_call_procvar(p,false); 617 618 if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) or 619 ((p.resultdef.typ=undefineddef) and (df_generic in current_procinfo.procdef.defoptions)) then 620 begin 621 newblock:=nil; 622 valuenode:=nil; 623 tempnode:=nil; 624 625 hp:=skip_nodes_before_load(p); 626 if (hp.nodetype=loadn) and 627 ( 628 (tloadnode(hp).symtable=current_procinfo.procdef.localst) or 629 (tloadnode(hp).symtable=current_procinfo.procdef.parast) or 630 (tloadnode(hp).symtable.symtabletype in [staticsymtable,globalsymtable]) 631 ) and 632 { MacPas objects are mapped to classes, and the MacPas compilers 633 interpret with-statements with MacPas objects the same way 634 as records (the object referenced by the with-statement 635 must remain constant) 636 } 637 not(is_class(hp.resultdef) and 638 (m_mac in current_settings.modeswitches)) then 639 begin 640 { simple load, we can reference direct } 641 refnode:=p; 642 end 643 else 644 begin 645 { complex load, load in temp first } 646 newblock:=internalstatements(newstatement); 647 { when we can't take the address of p, load it in a temp } 648 { since we may need its address later on } 649 if not valid_for_addr(p,false) then 650 begin 651 calltempnode:=ctempcreatenode.create(p.resultdef,p.resultdef.size,tt_persistent,true); 652 addstatement(newstatement,calltempnode); 653 addstatement(newstatement,cassignmentnode.create( 654 ctemprefnode.create(calltempnode), 655 p)); 656 p:=ctemprefnode.create(calltempnode); 657 typecheckpass(p); 658 end; 659 { several object types have implicit dereferencing } 660 { is_implicit_pointer_object_type() returns true for records 661 on the JVM target because they are implemented as classes 662 there, but we definitely have to take their address here 663 since otherwise a deep copy is made and changes are made to 664 this copy rather than to the original one } 665 hasimplicitderef:= 666 (is_implicit_pointer_object_type(p.resultdef) or 667 (p.resultdef.typ=classrefdef)) and 668 not((target_info.system in systems_jvm) and 669 ((p.resultdef.typ=recorddef) or 670 is_object(p.resultdef))); 671 if hasimplicitderef then 672 hdef:=p.resultdef 673 else 674 hdef:=cpointerdef.create(p.resultdef); 675 { load address of the value in a temp } 676 tempnode:=ctempcreatenode.create_withnode(hdef,sizeof(pint),tt_persistent,true,p); 677 typecheckpass(tnode(tempnode)); 678 valuenode:=p; 679 refnode:=ctemprefnode.create(tempnode); 680 fillchar(refnode.fileinfo,sizeof(tfileposinfo),0); 681 { add address call for valuenode and deref for refnode if this 682 is not done implicitly } 683 if not hasimplicitderef then 684 begin 685 valuenode:=caddrnode.create_internal_nomark(valuenode); 686 include(taddrnode(valuenode).addrnodeflags,anf_typedaddr); 687 refnode:=cderefnode.create(refnode); 688 fillchar(refnode.fileinfo,sizeof(tfileposinfo),0); 689 end; 690 addstatement(newstatement,tempnode); 691 addstatement(newstatement,cassignmentnode.create( 692 ctemprefnode.create(tempnode), 693 valuenode)); 694 typecheckpass(refnode); 695 end; 696 { Note: the symtable of the helper is pushed after the following 697 "case", the symtables of the helper's parents are passed in 698 the "case" branches } 699 withsymtablelist:=TFPObjectList.create(true); 700 case p.resultdef.typ of 701 objectdef : 702 begin 703 { do we have a helper for this type? } 704 search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef); 705 { push symtables of all parents in reverse order } 706 pushobjchild(tobjectdef(p.resultdef),tobjectdef(p.resultdef).childof); 707 { push symtables of all parents of the helper in reverse order } 708 if assigned(helperdef) then 709 pushobjchild(helperdef,helperdef.childof); 710 { push object symtable } 711 st:=twithsymtable.Create(tobjectdef(p.resultdef),tobjectdef(p.resultdef).symtable.SymList,refnode); 712 symtablestack.push(st); 713 withsymtablelist.add(st); 714 end; 715 classrefdef : 716 begin 717 { do we have a helper for this type? } 718 search_last_objectpascal_helper(tobjectdef(tclassrefdef(p.resultdef).pointeddef),current_structdef,helperdef); 719 { push symtables of all parents in reverse order } 720 pushobjchild(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).childof); 721 { push symtables of all parents of the helper in reverse order } 722 if assigned(helperdef) then 723 pushobjchild(helperdef,helperdef.childof); 724 { push object symtable } 725 st:=twithsymtable.Create(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).symtable.SymList,refnode); 726 symtablestack.push(st); 727 withsymtablelist.add(st); 728 end; 729 recorddef : 730 begin 731 { do we have a helper for this type? } 732 search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef); 733 { push symtables of all parents of the helper in reverse order } 734 if assigned(helperdef) then 735 pushobjchild(helperdef,helperdef.childof); 736 { push record symtable } 737 st:=twithsymtable.create(trecorddef(p.resultdef),trecorddef(p.resultdef).symtable.SymList,refnode); 738 symtablestack.push(st); 739 withsymtablelist.add(st); 740 end; 741 undefineddef : 742 begin 743 if not(df_generic in current_procinfo.procdef.defoptions) then 744 internalerror(2012122802); 745 helperdef:=nil; 746 { push record symtable } 747 st:=twithsymtable.create(p.resultdef,nil,refnode); 748 symtablestack.push(st); 749 withsymtablelist.add(st); 750 end; 751 else 752 internalerror(200601271); 753 end; 754 755 { push helper symtable } 756 if assigned(helperdef) then 757 begin 758 st:=twithsymtable.Create(helperdef,helperdef.symtable.SymList,refnode.getcopy); 759 symtablestack.push(st); 760 withsymtablelist.add(st); 761 end; 762 763 if try_to_consume(_COMMA) then 764 p:=_with_statement() 765 else 766 begin 767 consume(_DO); 768 if token<>_SEMICOLON then 769 p:=statement 770 else 771 p:=cnothingnode.create; 772 end; 773 774 { remove symtables in reverse order from the stack } 775 for i:=withsymtablelist.count-1 downto 0 do 776 symtablestack.pop(TSymtable(withsymtablelist[i])); 777 withsymtablelist.free; 778 779 { Finalize complex withnode with destroy of temp } 780 if assigned(newblock) then 781 begin 782 addstatement(newstatement,p); 783 if assigned(tempnode) then 784 addstatement(newstatement,ctempdeletenode.create(tempnode)); 785 if assigned(calltempnode) then 786 addstatement(newstatement,ctempdeletenode.create(calltempnode)); 787 p:=newblock; 788 end; 789 result:=p; 790 end 791 else 792 begin 793 p.free; 794 Message1(parser_e_false_with_expr,p.resultdef.GetTypeName); 795 { try to recover from error } 796 if try_to_consume(_COMMA) then 797 begin 798 hp:=_with_statement(); 799 if (hp=nil) then; { remove warning about unused } 800 end 801 else 802 begin 803 consume(_DO); 804 { ignore all } 805 if token<>_SEMICOLON then 806 statement; 807 end; 808 result:=nil; 809 end; 810 end; 811 812 with_statementnull813 function with_statement : tnode; 814 begin 815 consume(_WITH); 816 with_statement:=_with_statement(); 817 end; 818 819 raise_statementnull820 function raise_statement : tnode; 821 var 822 p,pobj,paddr,pframe : tnode; 823 begin 824 pobj:=nil; 825 paddr:=nil; 826 pframe:=nil; 827 consume(_RAISE); 828 if not(token in endtokens) then 829 begin 830 { object } 831 pobj:=comp_expr([ef_accept_equal]); 832 if try_to_consume(_AT) then 833 begin 834 paddr:=comp_expr([ef_accept_equal]); 835 if try_to_consume(_COMMA) then 836 pframe:=comp_expr([ef_accept_equal]); 837 end; 838 end 839 else 840 begin 841 if (block_type<>bt_except) then 842 Message(parser_e_no_reraise_possible); 843 end; 844 p:=craisenode.create(pobj,paddr,pframe); 845 raise_statement:=p; 846 end; 847 848 try_statementnull849 function try_statement : tnode; 850 851 procedure check_type_valid(var def: tdef); 852 begin 853 if not (is_class(def) or is_javaclass(def) or 854 { skip showing error message the second time } 855 (def.typ=errordef)) then 856 begin 857 Message1(type_e_class_type_expected,def.typename); 858 def:=generrordef; 859 end; 860 end; 861 862 var 863 p_try_block,p_finally_block,first,last, 864 p_default,p_specific,hp : tnode; 865 ot : tDef; 866 sym : tlocalvarsym; 867 old_block_type : tblock_type; 868 excepTSymtable : TSymtable; 869 objname,objrealname : TIDString; 870 srsym : tsym; 871 srsymtable : TSymtable; 872 t:ttoken; 873 unit_found:boolean; 874 oldcurrent_exceptblock: integer; 875 begin 876 p_default:=nil; 877 p_specific:=nil; 878 excepTSymtable:=nil; 879 last:=nil; 880 881 { read statements to try } 882 consume(_TRY); 883 first:=nil; 884 inc(exceptblockcounter); 885 oldcurrent_exceptblock := current_exceptblock; 886 current_exceptblock := exceptblockcounter; 887 old_block_type := block_type; 888 block_type := bt_body; 889 890 while (token<>_FINALLY) and (token<>_EXCEPT) do 891 begin 892 if first=nil then 893 begin 894 last:=cstatementnode.create(statement,nil); 895 first:=last; 896 end 897 else 898 begin 899 tstatementnode(last).right:=cstatementnode.create(statement,nil); 900 last:=tstatementnode(last).right; 901 end; 902 if not try_to_consume(_SEMICOLON) then 903 break; 904 consume_emptystats; 905 end; 906 p_try_block:=cblocknode.create(first); 907 908 if try_to_consume(_FINALLY) then 909 begin 910 inc(exceptblockcounter); 911 current_exceptblock := exceptblockcounter; 912 p_finally_block:=statements_til_end; 913 try_statement:=ctryfinallynode.create(p_try_block,p_finally_block); 914 end 915 else 916 begin 917 consume(_EXCEPT); 918 block_type:=bt_except; 919 inc(exceptblockcounter); 920 current_exceptblock := exceptblockcounter; 921 ot:=generrordef; 922 p_specific:=nil; 923 if (idtoken=_ON) then 924 { catch specific exceptions } 925 begin 926 repeat 927 consume(_ON); 928 if token=_ID then 929 begin 930 objname:=pattern; 931 objrealname:=orgpattern; 932 { can't use consume_sym here, because we need already 933 to check for the colon } 934 searchsym(objname,srsym,srsymtable); 935 consume(_ID); 936 { is a explicit name for the exception given ? } 937 if try_to_consume(_COLON) then 938 begin 939 single_type(ot,[]); 940 check_type_valid(ot); 941 sym:=clocalvarsym.create(objrealname,vs_value,ot,[]); 942 end 943 else 944 begin 945 { check if type is valid, must be done here because 946 with "e: Exception" the e is not necessary } 947 948 { support unit.identifier } 949 unit_found:=try_consume_unitsym_no_specialize(srsym,srsymtable,t,false,objname); 950 if srsym=nil then 951 begin 952 identifier_not_found(orgpattern); 953 srsym:=generrorsym; 954 end; 955 if unit_found then 956 consume(t); 957 { check if type is valid, must be done here because 958 with "e: Exception" the e is not necessary } 959 if (srsym.typ=typesym) then 960 begin 961 ot:=ttypesym(srsym).typedef; 962 parse_nested_types(ot,false,false,nil); 963 check_type_valid(ot); 964 end 965 else 966 begin 967 Message(type_e_type_id_expected); 968 ot:=generrordef; 969 end; 970 971 { create dummy symbol so we don't need a special 972 case in ncgflw, and so that we always know the 973 type } 974 sym:=clocalvarsym.create('$exceptsym',vs_value,ot,[]); 975 end; 976 excepTSymtable:=tstt_excepTSymtable.create; 977 excepTSymtable.insert(sym); 978 symtablestack.push(excepTSymtable); 979 end 980 else 981 consume(_ID); 982 consume(_DO); 983 hp:=connode.create(nil,statement); 984 if ot.typ=errordef then 985 begin 986 hp.free; 987 hp:=cerrornode.create; 988 end; 989 if p_specific=nil then 990 begin 991 last:=hp; 992 p_specific:=last; 993 end 994 else 995 begin 996 tonnode(last).left:=hp; 997 last:=tonnode(last).left; 998 end; 999 { set the informations } 1000 { only if the creation of the onnode was succesful, it's possible } 1001 { that last and hp are errornodes (JM) } 1002 if last.nodetype = onn then 1003 begin 1004 tonnode(last).excepttype:=tobjectdef(ot); 1005 tonnode(last).excepTSymtable:=excepTSymtable; 1006 end; 1007 { remove exception symtable } 1008 if assigned(excepTSymtable) then 1009 begin 1010 symtablestack.pop(excepTSymtable); 1011 if last.nodetype <> onn then 1012 excepTSymtable.free; 1013 end; 1014 if not try_to_consume(_SEMICOLON) then 1015 break; 1016 consume_emptystats; 1017 until (token in [_END,_ELSE]); 1018 if try_to_consume(_ELSE) then 1019 begin 1020 { catch the other exceptions } 1021 p_default:=statements_til_end; 1022 end 1023 else 1024 consume(_END); 1025 end 1026 else 1027 begin 1028 { catch all exceptions } 1029 p_default:=statements_til_end; 1030 end; 1031 1032 try_statement:=ctryexceptnode.create(p_try_block,p_specific,p_default); 1033 end; 1034 block_type:=old_block_type; 1035 current_exceptblock := oldcurrent_exceptblock; 1036 end; 1037 1038 _asm_statementnull1039 function _asm_statement : tnode; 1040 var 1041 asmstat : tasmnode; 1042 reg : tregister; 1043 asmreader : tbaseasmreader; 1044 entrypos : tfileposinfo; 1045 hl : TAsmList; 1046 begin 1047 Inside_asm_statement:=true; 1048 asmstat:=nil; 1049 hl:=nil; 1050 if assigned(asmmodeinfos[current_settings.asmmode]) then 1051 begin 1052 asmreader:=asmmodeinfos[current_settings.asmmode]^.casmreader.create; 1053 entrypos:=current_filepos; 1054 hl:=asmreader.assemble as TAsmList; 1055 if (not hl.empty) then 1056 begin 1057 { mark boundaries of assembler block, this is necessary for optimizer } 1058 hl.insert(tai_marker.create(mark_asmblockstart)); 1059 hl.concat(tai_marker.create(mark_asmblockend)); 1060 end; 1061 asmstat:=casmnode.create(hl); 1062 asmstat.fileinfo:=entrypos; 1063 asmreader.free; 1064 end 1065 else 1066 Message(parser_f_assembler_reader_not_supported); 1067 1068 { Mark procedure that it has assembler blocks } 1069 include(current_procinfo.flags,pi_has_assembler_block); 1070 1071 { Read first the _ASM statement } 1072 consume(_ASM); 1073 1074 { Force an empty register list for pure assembler routines, 1075 so that pass2 won't allocate volatile registers for them. } 1076 asmstat.has_registerlist:=(po_assembler in current_procinfo.procdef.procoptions); 1077 1078 { END is read, got a list of changed registers? } 1079 if try_to_consume(_LECKKLAMMER) then 1080 begin 1081 if token<>_RECKKLAMMER then 1082 begin 1083 if po_assembler in current_procinfo.procdef.procoptions then 1084 Message(parser_w_register_list_ignored); 1085 repeat 1086 { it's possible to specify the modified registers } 1087 reg:=std_regnum_search(lower(cstringpattern)); 1088 if reg<>NR_NO then 1089 begin 1090 if not(po_assembler in current_procinfo.procdef.procoptions) and assigned(hl) then 1091 begin 1092 hl.Insert(tai_regalloc.alloc(reg,nil)); 1093 hl.Insert(tai_regalloc.markused(reg)); 1094 hl.Concat(tai_regalloc.dealloc(reg,nil)); 1095 end; 1096 end 1097 else 1098 Message(asmr_e_invalid_register); 1099 consume(_CSTRING); 1100 if not try_to_consume(_COMMA) then 1101 break; 1102 until false; 1103 asmstat.has_registerlist:=true; 1104 end; 1105 consume(_RECKKLAMMER); 1106 end; 1107 1108 Inside_asm_statement:=false; 1109 _asm_statement:=asmstat; 1110 end; 1111 1112 statementnull1113 function statement : tnode; 1114 var 1115 p, 1116 code : tnode; 1117 filepos : tfileposinfo; 1118 srsym : tsym; 1119 srsymtable : TSymtable; 1120 s : TIDString; 1121 begin 1122 filepos:=current_tokenpos; 1123 code:=nil; 1124 case token of 1125 _GOTO : 1126 begin 1127 if not(cs_support_goto in current_settings.moduleswitches) then 1128 Message(sym_e_goto_and_label_not_supported); 1129 consume(_GOTO); 1130 if (token<>_INTCONST) and (token<>_ID) then 1131 begin 1132 Message(sym_e_label_not_found); 1133 code:=cerrornode.create; 1134 end 1135 else 1136 begin 1137 if token=_ID then 1138 consume_sym(srsym,srsymtable) 1139 else 1140 begin 1141 if token<>_INTCONST then 1142 internalerror(201008021); 1143 1144 { strip leading 0's in iso mode } 1145 if (([m_iso,m_extpas]*current_settings.modeswitches)<>[]) then 1146 while pattern[1]='0' do 1147 delete(pattern,1,1); 1148 1149 searchsym(pattern,srsym,srsymtable); 1150 if srsym=nil then 1151 begin 1152 identifier_not_found(pattern); 1153 srsym:=generrorsym; 1154 srsymtable:=nil; 1155 end; 1156 consume(token); 1157 end; 1158 1159 if srsym.typ<>labelsym then 1160 begin 1161 Message(sym_e_id_is_no_label_id); 1162 code:=cerrornode.create; 1163 end 1164 else 1165 begin 1166 { goto outside the current scope? } 1167 if srsym.owner<>current_procinfo.procdef.localst then 1168 begin 1169 { allowed? } 1170 if not(m_non_local_goto in current_settings.modeswitches) then 1171 Message(parser_e_goto_outside_proc); 1172 include(current_procinfo.flags,pi_has_global_goto); 1173 end; 1174 code:=cgotonode.create(tlabelsym(srsym)); 1175 tgotonode(code).labelsym:=tlabelsym(srsym); 1176 { set flag that this label is used } 1177 tlabelsym(srsym).used:=true; 1178 end; 1179 end; 1180 end; 1181 _BEGIN : 1182 code:=statement_block(_BEGIN); 1183 _IF : 1184 code:=if_statement; 1185 _CASE : 1186 code:=case_statement; 1187 _REPEAT : 1188 code:=repeat_statement; 1189 _WHILE : 1190 code:=while_statement; 1191 _FOR : 1192 code:=for_statement; 1193 _WITH : 1194 code:=with_statement; 1195 _TRY : 1196 code:=try_statement; 1197 _RAISE : 1198 code:=raise_statement; 1199 { semicolons,else until and end are ignored } 1200 _SEMICOLON, 1201 _ELSE, 1202 _UNTIL, 1203 _END: 1204 code:=cnothingnode.create; 1205 _FAIL : 1206 begin 1207 if (current_procinfo.procdef.proctypeoption<>potype_constructor) then 1208 Message(parser_e_fail_only_in_constructor); 1209 consume(_FAIL); 1210 code:=cnodeutils.call_fail_node; 1211 end; 1212 _ASM : 1213 begin 1214 if parse_generic then 1215 Message(parser_e_no_assembler_in_generic); 1216 code:=_asm_statement; 1217 end; 1218 _EOF : 1219 Message(scan_f_end_of_file); 1220 else 1221 begin 1222 { don't typecheck yet, because that will also simplify, which may 1223 result in not detecting certain kinds of syntax errors -- 1224 see mantis #15594 } 1225 p:=expr(false); 1226 { save the pattern here for latter usage, the label could be "000", 1227 even if we read an expression, the pattern is still valid if it's really 1228 a label (FK) 1229 if you want to mess here, take care of 1230 tests/webtbs/tw3546.pp 1231 } 1232 s:=pattern; 1233 1234 { When a colon follows a intconst then transform it into a label } 1235 if (p.nodetype=ordconstn) and 1236 try_to_consume(_COLON) then 1237 begin 1238 { in iso mode, 0003: is equal to 3: } 1239 if (([m_iso,m_extpas]*current_settings.modeswitches)<>[]) then 1240 searchsym(tostr(tordconstnode(p).value),srsym,srsymtable) 1241 else 1242 searchsym(s,srsym,srsymtable); 1243 p.free; 1244 1245 if assigned(srsym) and 1246 (srsym.typ=labelsym) then 1247 begin 1248 if tlabelsym(srsym).defined then 1249 Message(sym_e_label_already_defined); 1250 if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then 1251 begin 1252 tlabelsym(srsym).nonlocal:=true; 1253 exclude(current_procinfo.procdef.procoptions,po_inline); 1254 end; 1255 if tlabelsym(srsym).nonlocal and 1256 (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then 1257 Message(sym_e_interprocgoto_into_init_final_code_not_allowed); 1258 1259 tlabelsym(srsym).defined:=true; 1260 p:=clabelnode.create(nil,tlabelsym(srsym)); 1261 tlabelsym(srsym).code:=p; 1262 end 1263 else 1264 begin 1265 Message1(sym_e_label_used_and_not_defined,s); 1266 p:=cnothingnode.create; 1267 end; 1268 end; 1269 1270 if p.nodetype=labeln then 1271 begin 1272 { the pointer to the following instruction } 1273 { isn't a very clean way } 1274 if token in endtokens then 1275 tlabelnode(p).left:=cnothingnode.create 1276 else 1277 tlabelnode(p).left:=statement(); 1278 { be sure to have left also typecheckpass } 1279 typecheckpass(tlabelnode(p).left); 1280 end 1281 else 1282 1283 { change a load of a procvar to a call. this is also 1284 supported in fpc mode } 1285 if p.nodetype in [vecn,derefn,typeconvn,subscriptn,loadn] then 1286 maybe_call_procvar(p,false); 1287 1288 { blockn support because a read/write is changed into a blocknode 1289 with a separate statement for each read/write operation (JM) 1290 the same is true for val() if the third parameter is not 32 bit 1291 1292 goto nodes are created by the compiler for non local exit statements, so 1293 include them as well 1294 } 1295 if not(p.nodetype in [nothingn,errorn,calln,ifn,assignn,breakn,inlinen, 1296 continuen,labeln,blockn,exitn,goton]) or 1297 ((p.nodetype=inlinen) and 1298 not is_void(p.resultdef)) or 1299 ((p.nodetype=calln) and 1300 (assigned(tcallnode(p).procdefinition)) and 1301 (tcallnode(p).procdefinition.proctypeoption=potype_operator)) then 1302 Message(parser_e_illegal_expression); 1303 1304 if not assigned(p.resultdef) then 1305 do_typecheckpass(p); 1306 1307 { Specify that we don't use the value returned by the call. 1308 This is used for : 1309 - dispose of temp stack space 1310 - dispose on FPU stack 1311 - extended syntax checking } 1312 if (p.nodetype=calln) then 1313 begin 1314 exclude(tcallnode(p).callnodeflags,cnf_return_value_used); 1315 1316 { in $x- state, the function result must not be ignored } 1317 if not(cs_extsyntax in current_settings.moduleswitches) and 1318 not(is_void(p.resultdef)) and 1319 { can be nil in case there was an error in the expression } 1320 assigned(tcallnode(p).procdefinition) and 1321 { allow constructor calls to drop the result if they are 1322 called as instance methods instead of class methods } 1323 not( 1324 (tcallnode(p).procdefinition.proctypeoption=potype_constructor) and 1325 is_class_or_object(tprocdef(tcallnode(p).procdefinition).struct) and 1326 assigned(tcallnode(p).methodpointer) and 1327 (tnode(tcallnode(p).methodpointer).resultdef.typ=objectdef) 1328 ) then 1329 Message(parser_e_illegal_expression); 1330 end; 1331 1332 code:=p; 1333 end; 1334 end; 1335 if assigned(code) then 1336 begin 1337 typecheckpass(code); 1338 code.fileinfo:=filepos; 1339 end; 1340 statement:=code; 1341 end; 1342 1343 statement_blocknull1344 function statement_block(starttoken : ttoken) : tnode; 1345 1346 var 1347 first,last : tnode; 1348 filepos : tfileposinfo; 1349 1350 begin 1351 first:=nil; 1352 last:=nil; 1353 filepos:=current_tokenpos; 1354 consume(starttoken); 1355 1356 while not((token=_END) or (token=_FINALIZATION)) do 1357 begin 1358 if first=nil then 1359 begin 1360 last:=cstatementnode.create(statement,nil); 1361 first:=last; 1362 end 1363 else 1364 begin 1365 tstatementnode(last).right:=cstatementnode.create(statement,nil); 1366 last:=tstatementnode(last).right; 1367 end; 1368 if ((token=_END) or (token=_FINALIZATION)) then 1369 break 1370 else 1371 begin 1372 { if no semicolon, then error and go on } 1373 if token<>_SEMICOLON then 1374 begin 1375 consume(_SEMICOLON); 1376 consume_all_until(_SEMICOLON); 1377 end; 1378 consume(_SEMICOLON); 1379 end; 1380 consume_emptystats; 1381 end; 1382 1383 { don't consume the finalization token, it is consumed when 1384 reading the finalization block, but allow it only after 1385 an initalization ! } 1386 if (starttoken<>_INITIALIZATION) or (token<>_FINALIZATION) then 1387 consume(_END); 1388 1389 last:=cblocknode.create(first); 1390 last.fileinfo:=filepos; 1391 statement_block:=last; 1392 end; 1393 1394 assembler_blocknull1395 function assembler_block : tnode; 1396 var 1397 p : tnode; 1398 {$if not(defined(sparcgen)) and not(defined(arm)) and not(defined(avr)) and not(defined(mips))} 1399 locals : longint; 1400 {$endif not(defined(sparcgen)) and not(defined(arm)) and not(defined(avr)) and not(defined(mips))} 1401 srsym : tsym; 1402 begin 1403 if parse_generic then 1404 message(parser_e_no_assembler_in_generic); 1405 1406 { Rename the funcret so that recursive calls are possible } 1407 if not is_void(current_procinfo.procdef.returndef) then 1408 begin 1409 srsym:=TSym(current_procinfo.procdef.localst.Find(current_procinfo.procdef.procsym.name)); 1410 if assigned(srsym) then 1411 srsym.realname:='$hiddenresult'; 1412 end; 1413 1414 { delphi uses register calling for assembler methods } 1415 if (m_delphi in current_settings.modeswitches) and 1416 (po_assembler in current_procinfo.procdef.procoptions) and 1417 not(po_hascallingconvention in current_procinfo.procdef.procoptions) then 1418 current_procinfo.procdef.proccalloption:=pocall_register; 1419 1420 { force the asm statement } 1421 if token<>_ASM then 1422 consume(_ASM); 1423 include(current_procinfo.flags,pi_is_assembler); 1424 p:=_asm_statement; 1425 1426 {$if not(defined(sparcgen)) and not(defined(arm)) and not(defined(avr)) and not(defined(mips))} 1427 if (po_assembler in current_procinfo.procdef.procoptions) then 1428 begin 1429 { set the framepointer to esp for assembler functions when the 1430 following conditions are met: 1431 - if the are no local variables and parameters (except the allocated result) 1432 - no reference to the result variable (refcount<=1) 1433 - result is not stored as parameter 1434 - target processor has optional frame pointer save 1435 (vm, i386, vm only currently) 1436 } 1437 locals:=tabstractlocalsymtable(current_procinfo.procdef.parast).count_locals; 1438 if (current_procinfo.procdef.localst.symtabletype=localsymtable) then 1439 inc(locals,tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals); 1440 if (locals=0) and 1441 not (current_procinfo.procdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) and 1442 (not assigned(current_procinfo.procdef.funcretsym) or 1443 (tabstractvarsym(current_procinfo.procdef.funcretsym).refs<=1)) and 1444 not (df_generic in current_procinfo.procdef.defoptions) and 1445 not(paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef)) then 1446 begin 1447 { Only need to set the framepointer, the locals will 1448 be inserted with the correct reference in tcgasmnode.pass_generate_code } 1449 current_procinfo.framepointer:=NR_STACK_POINTER_REG; 1450 end; 1451 end; 1452 {$endif not(defined(sparcgen)) and not(defined(arm)) and not(defined(avr)) not(defined(mipsel))} 1453 1454 { Flag the result as assigned when it is returned in a 1455 register. 1456 } 1457 if assigned(current_procinfo.procdef.funcretsym) and 1458 not (df_generic in current_procinfo.procdef.defoptions) and 1459 (not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef)) then 1460 tabstractvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_initialised; 1461 1462 { because the END is already read we need to get the 1463 last_endtoken_filepos here (PFV) } 1464 last_endtoken_filepos:=current_tokenpos; 1465 1466 assembler_block:=p; 1467 end; 1468 1469 end. 1470