/compiler/wpobase.pas
Pascal | 829 lines | 499 code | 146 blank | 184 comment | 41 complexity | 950e3e2213b78b1a0115dd4522fb2fc1 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{ 2 Copyright (c) 2008 by Jonas Maebe 3 4 Whole program optimisation information collection base class 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 22unit wpobase; 23 24{$i fpcdefs.inc} 25 26interface 27 28uses 29 globtype, 30 cclasses, 31 symtype; 32 33type 34 { the types of available whole program optimization } 35 twpotype = (wpo_devirtualization_context_insensitive,wpo_live_symbol_information); 36const 37 wpo2str: array[twpotype] of string[16] = ('devirtualization','symbol liveness'); 38 39type 40 { ************************************************************************* } 41 { ******************** General base classes/interfaces ******************** } 42 { ************************************************************************* } 43 44 { interface to reading a section from a file with wpo info } 45 twposectionreaderintf = interface 46 ['{51BE3F89-C9C5-4965-9C83-AE7490C92E3E}'] 47 function sectiongetnextline(out s: string): boolean; 48 end; 49 50 51 { interface to writing sections to a file with wpoinfo } 52 twposectionwriterintf = interface 53 ['{C056F0DD-62B1-4612-86C7-2D39944C4437}'] 54 procedure startsection(const name: string); 55 procedure sectionputline(const s: string); 56 end; 57 58 59 { base class for wpo information stores } 60 61 { twpocomponentbase } 62 63 twpocomponentbase = class 64 public 65 constructor create; reintroduce; virtual; 66 67 { type of whole program optimization information collected/provided by 68 this class 69 } 70 class function getwpotype: twpotype; virtual; abstract; 71 72 { whole program optimizations for which this class generates information } 73 class function generatesinfoforwposwitches: twpoptimizerswitches; virtual; abstract; 74 75 { whole program optimizations performed by this class } 76 class function performswpoforswitches: twpoptimizerswitches; virtual; abstract; 77 78 { returns the name of the section parsed by this class } 79 class function sectionname: shortstring; virtual; abstract; 80 81 { checks whether the compiler options are compatible with this 82 optimization (default: don't check anything) 83 } 84 class procedure checkoptions; virtual; 85 86 { loads the information pertinent to this whole program optimization from 87 the current section being processed by reader 88 } 89 procedure loadfromwpofilesection(reader: twposectionreaderintf); virtual; abstract; 90 91 { stores the information of this component to a file in a format that can 92 be loaded again using loadfromwpofilesection() 93 } 94 procedure storewpofilesection(writer: twposectionwriterintf); virtual; abstract; 95 96 { extracts the information pertinent to this whole program optimization 97 from the current compiler state (loaded units, ...) 98 } 99 procedure constructfromcompilerstate; virtual; abstract; 100 end; 101 102 twpocomponentbaseclass = class of twpocomponentbase; 103 104 105 { forward declaration of overall wpo info manager class } 106 107 twpoinfomanagerbase = class; 108 109 { ************************************************************************* } 110 { ** Information created per unit for use during subsequent compilation *** } 111 { ************************************************************************* } 112 113 { information about called vmt entries for a class } 114 tcalledvmtentries = class 115 protected 116 { the class } 117 fobjdef: tdef; 118 fobjdefderef: tderef; 119 { the vmt entries } 120 fcalledentries: tbitset; 121 public 122 constructor create(_objdef: tdef; nentries: longint); 123 constructor ppuload(ppufile: tcompilerppufile); 124 destructor destroy; override; 125 procedure ppuwrite(ppufile: tcompilerppufile); 126 127 procedure buildderef; 128 procedure buildderefimpl; 129 procedure deref; 130 procedure derefimpl; 131 132 property objdef: tdef read fobjdef write fobjdef; 133 property objdefderef: tderef read fobjdefderef write fobjdefderef; 134 property calledentries: tbitset read fcalledentries write fcalledentries; 135 end; 136 137 138 { base class of information collected per unit. Still needs to be 139 generalised for different kinds of wpo information, currently specific 140 to devirtualization. 141 } 142 143 tunitwpoinfobase = class 144 protected 145 { created object types } 146 fcreatedobjtypes: tfpobjectlist; 147 { objectdefs pointed to by created classrefdefs } 148 fcreatedclassrefobjtypes: tfpobjectlist; 149 { objtypes potentially instantiated by fcreatedclassrefobjtypes 150 (objdectdefs pointed to by classrefdefs that are 151 passed as a regular parameter, loaded in a variable, ... 152 so they can end up in a classrefdef var and be instantiated) 153 } 154 fmaybecreatedbyclassrefdeftypes: tfpobjectlist; 155 156 { called virtual methods for all classes (hashed by mangled classname, 157 entries bitmaps indicating which vmt entries per class are called -- 158 tcalledvmtentries) 159 } 160 fcalledvmtentries: tfphashlist; 161 public 162 constructor create; reintroduce; virtual; 163 destructor destroy; override; 164 165 property createdobjtypes: tfpobjectlist read fcreatedobjtypes; 166 property createdclassrefobjtypes: tfpobjectlist read fcreatedclassrefobjtypes; 167 property maybecreatedbyclassrefdeftypes: tfpobjectlist read fmaybecreatedbyclassrefdeftypes; 168 property calledvmtentries: tfphashlist read fcalledvmtentries; 169 170 procedure addcreatedobjtype(def: tdef); 171 procedure addcreatedobjtypeforclassref(def: tdef); 172 procedure addmaybecreatedbyclassref(def: tdef); 173 procedure addcalledvmtentry(def: tdef; index: longint); 174 175 { resets the "I've been registered with wpo" flags for all defs in the 176 above lists } 177 procedure resetdefs; 178 end; 179 180 { ************************************************************************* } 181 { **** Total information created for use during subsequent compilation **** } 182 { ************************************************************************* } 183 184 { class to create a file with wpo information } 185 186 { tavailablewpofilewriter } 187 188 twpofilewriter = class(tobject,twposectionwriterintf) 189 private 190 { array of class *instances* that wish to be written out to the 191 whole program optimization feedback file 192 } 193 fsectioncontents: tfpobjectlist; 194 195 ffilename: tcmdstr; 196 foutputfile: text; 197 198 public 199 constructor create(const fn: tcmdstr); 200 destructor destroy; override; 201 202 procedure writefile; 203 204 { starts a new section with name "name" } 205 procedure startsection(const name: string); 206 { writes s to the wpo file } 207 procedure sectionputline(const s: string); 208 209 { register a component instance that needs to be written 210 to the wpo feedback file 211 } 212 procedure registerwpocomponent(component: twpocomponentbase); 213 end; 214 215 { ************************************************************************* } 216 { ************ Information for use during current compilation ************* } 217 { ************************************************************************* } 218 219 { class to read a file with wpo information } 220 twpofilereader = class(tobject,twposectionreaderintf) 221 private 222 ffilename: tcmdstr; 223 flinenr: longint; 224 finputfile: text; 225 fcurline: string; 226 fusecurline: boolean; 227 228 { destination for the read information } 229 fdest: twpoinfomanagerbase; 230 231 function getnextnoncommentline(out s: string): boolean; 232 public 233 234 constructor create(const fn: tcmdstr; dest: twpoinfomanagerbase); 235 destructor destroy; override; 236 237 { processes the wpo info in the file } 238 procedure processfile; 239 240 { returns next line of the current section in s, and false if no more 241 lines in the current section 242 } 243 function sectiongetnextline(out s: string): boolean; 244 end; 245 246 247 { ************************************************************************* } 248 { ******* Specific kinds of whole program optimization components ********* } 249 { ************************************************************************* } 250 251 { method devirtualisation } 252 twpodevirtualisationhandler = class(twpocomponentbase) 253 { checks whether procdef (a procdef for a virtual method) can be replaced with 254 a static call when it's called as objdef.procdef, and if so returns the 255 mangled name in staticname. 256 } 257 function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean; virtual; abstract; 258 { checks whether procdef (a procdef for a virtual method) can be replaced with 259 a different procname in the vmt of objdef, and if so returns the new 260 mangledname in staticname 261 } 262 function staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean; virtual; abstract; 263 end; 264 265 twpodeadcodehandler = class(twpocomponentbase) 266 { checks whether a mangledname was removed as dead code from the final 267 binary (WARNING: must *not* be called for functions marked as inline, 268 since if all call sites are inlined, it won't appear in the final 269 binary but nevertheless is still necessary!) 270 } 271 function symbolinfinalbinary(const s: shortstring): boolean; virtual; abstract; 272 end; 273 274 275 { ************************************************************************* } 276 { ************ Collection of all instances of wpo components ************** } 277 { ************************************************************************* } 278 279 { class doing all the bookkeeping for everything } 280 281 twpoinfomanagerbase = class 282 private 283 { array of classrefs of handler classes for the various kinds of whole 284 program optimizations that we support 285 } 286 fwpocomponents: tfphashlist; 287 288 freader: twpofilereader; 289 fwriter: twpofilewriter; 290 public 291 { instances of the various optimizers/information collectors (for 292 information used during this compilation) 293 } 294 wpoinfouse: array[twpotype] of twpocomponentbase; 295 296 { register a whole program optimization class type } 297 procedure registerwpocomponentclass(wpocomponent: twpocomponentbaseclass); 298 299 { get the program optimization class type that can parse the contents 300 of the section with name "secname" in the wpo feedback file 301 } 302 function gethandlerforsection(const secname: string): twpocomponentbaseclass; 303 304 { tell all instantiated wpo component classes to collect the information 305 from the global compiler state that they need (done at the very end of 306 the compilation process) 307 } 308 procedure extractwpoinfofromprogram; 309 310 { set the name of the feedback file from which all whole-program information 311 to be used during the current compilation will be read 312 } 313 procedure setwpoinputfile(const fn: tcmdstr); 314 315 { set the name of the feedback file to which all whole-program information 316 collected during the current compilation will be written 317 } 318 procedure setwpooutputfile(const fn: tcmdstr); 319 320 { check whether the specified wpo options (-FW/-Fw/-OW/-Ow) are complete 321 and sensical, and parse the wpo feedback file specified with 322 setwpoinputfile 323 } 324 procedure parseandcheckwpoinfo; 325 326 { routines accessing the optimizer information } 327 { 1) devirtualization at the symbol name level } 328 function can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean; virtual; abstract; 329 { 2) optimal replacement method name in vmt } 330 function optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean; virtual; abstract; 331 { 3) does a symbol appear in the final binary (i.e., not removed by dead code stripping/smart linking). 332 WARNING: do *not* call for inline functions/procedures/methods/... 333 } 334 function symbol_live(const name: shortstring): boolean; virtual; abstract; 335 336 constructor create; reintroduce; 337 destructor destroy; override; 338 end; 339 340 341 var 342 wpoinfomanager: twpoinfomanagerbase; 343 344implementation 345 346 uses 347 globals, 348 cutils, 349 sysutils, 350 symdef, 351 verbose; 352 353 354 { tcreatedwpoinfobase } 355 356 constructor tunitwpoinfobase.create; 357 begin 358 fcreatedobjtypes:=tfpobjectlist.create(false); 359 fcreatedclassrefobjtypes:=tfpobjectlist.create(false); 360 fmaybecreatedbyclassrefdeftypes:=tfpobjectlist.create(false); 361 fcalledvmtentries:=tfphashlist.create; 362 end; 363 364 365 destructor tunitwpoinfobase.destroy; 366 var 367 i: longint; 368 begin 369 { don't call resetdefs here, because the defs may have been freed 370 already } 371 fcreatedobjtypes.free; 372 fcreatedobjtypes:=nil; 373 fcreatedclassrefobjtypes.free; 374 fcreatedclassrefobjtypes:=nil; 375 fmaybecreatedbyclassrefdeftypes.free; 376 fmaybecreatedbyclassrefdeftypes:=nil; 377 378 { may not be assigned in case the info was loaded from a ppu and we 379 are not generating a wpo feedback file (see tunitwpoinfo.ppuload) 380 } 381 if assigned(fcalledvmtentries) then 382 begin 383 for i:=0 to fcalledvmtentries.count-1 do 384 tcalledvmtentries(fcalledvmtentries[i]).free; 385 fcalledvmtentries.free; 386 fcalledvmtentries:=nil; 387 end; 388 389 inherited destroy; 390 end; 391 392 393 procedure tunitwpoinfobase.resetdefs; 394 var 395 i: ptrint; 396 begin 397 if assigned(fcreatedobjtypes) then 398 for i:=0 to fcreatedobjtypes.count-1 do 399 tobjectdef(fcreatedobjtypes[i]).created_in_current_module:=false; 400 if assigned(fcreatedclassrefobjtypes) then 401 for i:=0 to fcreatedclassrefobjtypes.count-1 do 402 tobjectdef(fcreatedclassrefobjtypes[i]).classref_created_in_current_module:=false; 403 if assigned(fmaybecreatedbyclassrefdeftypes) then 404 for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do 405 tobjectdef(fmaybecreatedbyclassrefdeftypes[i]).maybe_created_in_current_module:=false; 406 end; 407 408 409 procedure tunitwpoinfobase.addcreatedobjtype(def: tdef); 410 begin 411 fcreatedobjtypes.add(def); 412 end; 413 414 415 procedure tunitwpoinfobase.addcreatedobjtypeforclassref(def: tdef); 416 begin 417 fcreatedclassrefobjtypes.add(def); 418 end; 419 420 421 procedure tunitwpoinfobase.addmaybecreatedbyclassref(def: tdef); 422 begin 423 fmaybecreatedbyclassrefdeftypes.add(def); 424 end; 425 426 427 procedure tunitwpoinfobase.addcalledvmtentry(def: tdef; index: longint); 428 var 429 entries: tcalledvmtentries; 430 key: shortstring; 431 begin 432 key:=tobjectdef(def).vmt_mangledname; 433 entries:=tcalledvmtentries(fcalledvmtentries.find(key)); 434 if not assigned(entries) then 435 begin 436 entries:=tcalledvmtentries.create(def,tobjectdef(def).vmtentries.count); 437 fcalledvmtentries.add(key,entries); 438 end; 439 entries.calledentries.include(index); 440 end; 441 442 443 { twpofilereader } 444 445 function twpofilereader.getnextnoncommentline(out s: string): 446 boolean; 447 begin 448 if (fusecurline) then 449 begin 450 s:=fcurline; 451 fusecurline:=false; 452 result:=true; 453 exit; 454 end; 455 repeat 456 readln(finputfile,s); 457 if (s='') and 458 eof(finputfile) then 459 begin 460 result:=false; 461 exit; 462 end; 463 inc(flinenr); 464 until (s='') or 465 (s[1]<>'#'); 466 result:=true; 467 end; 468 469 constructor twpofilereader.create(const fn: tcmdstr; dest: twpoinfomanagerbase); 470 begin 471 if not FileExists(fn) or 472 { FileExists also returns true for directories } 473 DirectoryExists(fn) then 474 begin 475 cgmessage1(wpo_cant_find_file,fn); 476 exit; 477 end; 478 assign(finputfile,fn); 479 ffilename:=fn; 480 481 fdest:=dest; 482 end; 483 484 destructor twpofilereader.destroy; 485 begin 486 inherited destroy; 487 end; 488 489 procedure twpofilereader.processfile; 490 var 491 sectionhandler: twpocomponentbaseclass; 492 i: longint; 493 wpotype: twpotype; 494 s, 495 sectionname: string; 496 begin 497 cgmessage1(wpo_begin_processing,ffilename); 498 reset(finputfile); 499 flinenr:=0; 500 while getnextnoncommentline(s) do 501 begin 502 if (s='') then 503 continue; 504 { format: "% sectionname" } 505 if (s[1]<>'%') then 506 begin 507 cgmessage2(wpo_expected_section,tostr(flinenr),s); 508 break; 509 end; 510 for i:=2 to length(s) do 511 if (s[i]<>' ') then 512 break; 513 sectionname:=copy(s,i,255); 514 515 { find handler for section and process } 516 sectionhandler:=fdest.gethandlerforsection(sectionname); 517 if assigned(sectionhandler) then 518 begin 519 wpotype:=sectionhandler.getwpotype; 520 cgmessage2(wpo_found_section,sectionname,wpo2str[wpotype]); 521 { do we need this information? } 522 if ((sectionhandler.performswpoforswitches * init_settings.dowpoptimizerswitches) <> []) then 523 begin 524 { did some other section already generate this type of information? } 525 if assigned(fdest.wpoinfouse[wpotype]) then 526 begin 527 cgmessage2(wpo_duplicate_wpotype,wpo2str[wpotype],sectionname); 528 fdest.wpoinfouse[wpotype].free; 529 end; 530 { process the section } 531 fdest.wpoinfouse[wpotype]:=sectionhandler.create; 532 twpocomponentbase(fdest.wpoinfouse[wpotype]).loadfromwpofilesection(self); 533 end 534 else 535 begin 536 cgmessage1(wpo_skipping_unnecessary_section,sectionname); 537 { skip the current section } 538 while sectiongetnextline(s) do 539 ; 540 end; 541 end 542 else 543 begin 544 cgmessage1(wpo_no_section_handler,sectionname); 545 { skip the current section } 546 while sectiongetnextline(s) do 547 ; 548 end; 549 end; 550 close(finputfile); 551 cgmessage1(wpo_end_processing,ffilename); 552 end; 553 554 function twpofilereader.sectiongetnextline(out s: string): boolean; 555 begin 556 result:=getnextnoncommentline(s); 557 if not result then 558 exit; 559 { start of new section? } 560 if (s<>'') and 561 (s[1]='%') then 562 begin 563 { keep read line for next call to getnextnoncommentline() } 564 fcurline:=s; 565 fusecurline:=true; 566 result:=false; 567 end; 568 end; 569 570 571 { twpocomponentbase } 572 573 constructor twpocomponentbase.create; 574 begin 575 { do nothing } 576 end; 577 578 579 class procedure twpocomponentbase.checkoptions; 580 begin 581 { do nothing } 582 end; 583 584 { twpofilewriter } 585 586 constructor twpofilewriter.create(const fn: tcmdstr); 587 begin 588 assign(foutputfile,fn); 589 ffilename:=fn; 590 fsectioncontents:=tfpobjectlist.create(true); 591 end; 592 593 destructor twpofilewriter.destroy; 594 begin 595 fsectioncontents.free; 596 inherited destroy; 597 end; 598 599 procedure twpofilewriter.writefile; 600 var 601 i: longint; 602 begin 603 {$push}{$i-} 604 rewrite(foutputfile); 605 {$pop} 606 if (ioresult <> 0) then 607 begin 608 cgmessage1(wpo_cant_create_feedback_file,ffilename); 609 exit; 610 end; 611 for i:=0 to fsectioncontents.count-1 do 612 twpocomponentbase(fsectioncontents[i]).storewpofilesection(self); 613 close(foutputfile); 614 end; 615 616 procedure twpofilewriter.startsection(const name: string); 617 begin 618 writeln(foutputfile,'% ',name); 619 end; 620 621 procedure twpofilewriter.sectionputline(const s: string); 622 begin 623 writeln(foutputfile,s); 624 end; 625 626 procedure twpofilewriter.registerwpocomponent( 627 component: twpocomponentbase); 628 begin 629 fsectioncontents.add(component); 630 end; 631 632{ twpoinfomanagerbase } 633 634 procedure twpoinfomanagerbase.registerwpocomponentclass(wpocomponent: twpocomponentbaseclass); 635 begin 636 fwpocomponents.add(wpocomponent.sectionname,wpocomponent); 637 end; 638 639 640 function twpoinfomanagerbase.gethandlerforsection(const secname: string 641 ): twpocomponentbaseclass; 642 begin 643 result:=twpocomponentbaseclass(fwpocomponents.find(secname)); 644 end; 645 646 procedure twpoinfomanagerbase.setwpoinputfile(const fn: tcmdstr); 647 begin 648 freader:=twpofilereader.create(fn,self); 649 end; 650 651 procedure twpoinfomanagerbase.setwpooutputfile(const fn: tcmdstr); 652 begin 653 fwriter:=twpofilewriter.create(fn); 654 end; 655 656 procedure twpoinfomanagerbase.parseandcheckwpoinfo; 657 var 658 i: longint; 659 begin 660 { error if we don't have to optimize yet have an input feedback file } 661 if (init_settings.dowpoptimizerswitches=[]) and 662 assigned(freader) then 663 begin 664 cgmessage(wpo_input_without_info_use); 665 exit; 666 end; 667 668 { error if we have to optimize yet don't have an input feedback file } 669 if (init_settings.dowpoptimizerswitches<>[]) and 670 not assigned(freader) then 671 begin 672 cgmessage(wpo_no_input_specified); 673 exit; 674 end; 675 676 { if we have to generate wpo information, check that a file has been 677 specified and that we have something to write to it 678 } 679 if (init_settings.genwpoptimizerswitches<>[]) and 680 not assigned(fwriter) then 681 begin 682 cgmessage(wpo_no_output_specified); 683 exit; 684 end; 685 686 if (init_settings.genwpoptimizerswitches=[]) and 687 assigned(fwriter) then 688 begin 689 cgmessage(wpo_output_without_info_gen); 690 exit; 691 end; 692 693 { now read the input feedback file } 694 if assigned(freader) then 695 begin 696 freader.processfile; 697 freader.free; 698 freader:=nil; 699 end; 700 701 { and for each specified optimization check whether the input feedback 702 file contained the necessary information 703 } 704 if (([cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts] * init_settings.dowpoptimizerswitches) <> []) and 705 not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) then 706 begin 707 cgmessage1(wpo_not_enough_info,wpo2str[wpo_devirtualization_context_insensitive]); 708 exit; 709 end; 710 711 if (cs_wpo_symbol_liveness in init_settings.dowpoptimizerswitches) and 712 not assigned(wpoinfouse[wpo_live_symbol_information]) then 713 begin 714 cgmessage1(wpo_not_enough_info,wpo2str[wpo_live_symbol_information]); 715 exit; 716 end; 717 718 { perform pre-checking to ensure there are no known incompatibilities between 719 the selected optimizations and other switches 720 } 721 for i:=0 to fwpocomponents.count-1 do 722 if (twpocomponentbaseclass(fwpocomponents[i]).generatesinfoforwposwitches*init_settings.genwpoptimizerswitches)<>[] then 723 twpocomponentbaseclass(fwpocomponents[i]).checkoptions 724 end; 725 726 procedure twpoinfomanagerbase.extractwpoinfofromprogram; 727 var 728 i: longint; 729 info: twpocomponentbase; 730 begin 731 { if don't have to write anything, fwriter has not been created } 732 if not assigned(fwriter) then 733 exit; 734 735 { let all wpo components gather the necessary info from the compiler state } 736 for i:=0 to fwpocomponents.count-1 do 737 if (twpocomponentbaseclass(fwpocomponents[i]).generatesinfoforwposwitches*current_settings.genwpoptimizerswitches)<>[] then 738 begin 739 info:=twpocomponentbaseclass(fwpocomponents[i]).create; 740 info.constructfromcompilerstate; 741 fwriter.registerwpocomponent(info); 742 end; 743 { and write their info to disk } 744 fwriter.writefile; 745 fwriter.free; 746 fwriter:=nil; 747 end; 748 749 constructor twpoinfomanagerbase.create; 750 begin 751 inherited create; 752 fwpocomponents:=tfphashlist.create; 753 end; 754 755 destructor twpoinfomanagerbase.destroy; 756 var 757 i: twpotype; 758 begin 759 freader.free; 760 freader:=nil; 761 fwriter.free; 762 fwriter:=nil; 763 fwpocomponents.free; 764 fwpocomponents:=nil; 765 for i:=low(wpoinfouse) to high(wpoinfouse) do 766 if assigned(wpoinfouse[i]) then 767 wpoinfouse[i].free; 768 inherited destroy; 769 end; 770 771 { tcalledvmtentries } 772 773 constructor tcalledvmtentries.create(_objdef: tdef; nentries: longint); 774 begin 775 objdef:=_objdef; 776 calledentries:=tbitset.create(nentries); 777 end; 778 779 780 constructor tcalledvmtentries.ppuload(ppufile: tcompilerppufile); 781 var 782 len: longint; 783 begin 784 ppufile.getderef(fobjdefderef); 785 len:=ppufile.getlongint; 786 calledentries:=tbitset.create_bytesize(len); 787 if (len <> calledentries.datasize) then 788 internalerror(2009060301); 789 ppufile.readdata(calledentries.data^,len); 790 end; 791 792 793 destructor tcalledvmtentries.destroy; 794 begin 795 fcalledentries.free; 796 inherited destroy; 797 end; 798 799 800 procedure tcalledvmtentries.ppuwrite(ppufile: tcompilerppufile); 801 begin 802 ppufile.putderef(objdefderef); 803 ppufile.putlongint(calledentries.datasize); 804 ppufile.putdata(calledentries.data^,calledentries.datasize); 805 end; 806 807 808 procedure tcalledvmtentries.buildderef; 809 begin 810 objdefderef.build(objdef); 811 end; 812 813 814 procedure tcalledvmtentries.buildderefimpl; 815 begin 816 end; 817 818 819 procedure tcalledvmtentries.deref; 820 begin 821 objdef:=tdef(objdefderef.resolve); 822 end; 823 824 825 procedure tcalledvmtentries.derefimpl; 826 begin 827 end; 828 829end.