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 22 unit wpobase; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 globtype, 30 cclasses, 31 symtype; 32 33 type 34 { the types of available whole program optimization } 35 twpotype = (wpo_devirtualization_context_insensitive,wpo_live_symbol_information); 36 const 37 wpo2str: array[twpotype] of string[16] = ('devirtualization','symbol liveness'); 38 39 type 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}'] sectiongetnextlinenull47 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 } getwpotypenull70 class function getwpotype: twpotype; virtual; abstract; 71 72 { whole program optimizations for which this class generates information } generatesinfoforwposwitchesnull73 class function generatesinfoforwposwitches: twpoptimizerswitches; virtual; abstract; 74 75 { whole program optimizations performed by this class } performswpoforswitchesnull76 class function performswpoforswitches: twpoptimizerswitches; virtual; abstract; 77 78 { returns the name of the section parsed by this class } sectionnamenull79 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 getnextnoncommentlinenull231 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 } sectiongetnextlinenull243 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 } staticnameforcallingvirtualmethodnull257 function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: TSymStr): 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 } staticnameforvmtentrynull262 function staticnameforvmtentry(objdef, procdef: tdef; out staticname: TSymStr): 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 } symbolinfinalbinarynull271 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 } gethandlerforsectionnull302 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 } can_be_devirtualizednull328 function can_be_devirtualized(objdef, procdef: tdef; out name: TSymStr): boolean; virtual; abstract; 329 { 2) optimal replacement method name in vmt } optimized_name_for_vmtnull330 function optimized_name_for_vmt(objdef, procdef: tdef; out name: TSymStr): 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 } symbol_livenull334 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 344 implementation 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 twpofilereader.getnextnoncommentlinenull445 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 i:=2; 511 for i:=2 to length(s) do 512 if (s[i]<>' ') then 513 break; 514 sectionname:=copy(s,i,255); 515 516 { find handler for section and process } 517 sectionhandler:=fdest.gethandlerforsection(sectionname); 518 if assigned(sectionhandler) then 519 begin 520 wpotype:=sectionhandler.getwpotype; 521 cgmessage2(wpo_found_section,sectionname,wpo2str[wpotype]); 522 { do we need this information? } 523 if ((sectionhandler.performswpoforswitches * init_settings.dowpoptimizerswitches) <> []) then 524 begin 525 { did some other section already generate this type of information? } 526 if assigned(fdest.wpoinfouse[wpotype]) then 527 begin 528 cgmessage2(wpo_duplicate_wpotype,wpo2str[wpotype],sectionname); 529 fdest.wpoinfouse[wpotype].free; 530 end; 531 { process the section } 532 fdest.wpoinfouse[wpotype]:=sectionhandler.create; 533 twpocomponentbase(fdest.wpoinfouse[wpotype]).loadfromwpofilesection(self); 534 end 535 else 536 begin 537 cgmessage1(wpo_skipping_unnecessary_section,sectionname); 538 { skip the current section } 539 while sectiongetnextline(s) do 540 ; 541 end; 542 end 543 else 544 begin 545 cgmessage1(wpo_no_section_handler,sectionname); 546 { skip the current section } 547 while sectiongetnextline(s) do 548 ; 549 end; 550 end; 551 close(finputfile); 552 cgmessage1(wpo_end_processing,ffilename); 553 end; 554 twpofilereader.sectiongetnextlinenull555 function twpofilereader.sectiongetnextline(out s: string): boolean; 556 begin 557 result:=getnextnoncommentline(s); 558 if not result then 559 exit; 560 { start of new section? } 561 if (s<>'') and 562 (s[1]='%') then 563 begin 564 { keep read line for next call to getnextnoncommentline() } 565 fcurline:=s; 566 fusecurline:=true; 567 result:=false; 568 end; 569 end; 570 571 572 { twpocomponentbase } 573 574 constructor twpocomponentbase.create; 575 begin 576 { do nothing } 577 end; 578 579 580 class procedure twpocomponentbase.checkoptions; 581 begin 582 { do nothing } 583 end; 584 585 { twpofilewriter } 586 587 constructor twpofilewriter.create(const fn: tcmdstr); 588 begin 589 assign(foutputfile,fn); 590 ffilename:=fn; 591 fsectioncontents:=tfpobjectlist.create(true); 592 end; 593 594 destructor twpofilewriter.destroy; 595 begin 596 fsectioncontents.free; 597 inherited destroy; 598 end; 599 600 procedure twpofilewriter.writefile; 601 var 602 i: longint; 603 begin 604 {$push}{$i-} 605 rewrite(foutputfile); 606 {$pop} 607 if (ioresult <> 0) then 608 begin 609 cgmessage1(wpo_cant_create_feedback_file,ffilename); 610 exit; 611 end; 612 for i:=0 to fsectioncontents.count-1 do 613 twpocomponentbase(fsectioncontents[i]).storewpofilesection(self); 614 close(foutputfile); 615 end; 616 617 procedure twpofilewriter.startsection(const name: string); 618 begin 619 writeln(foutputfile,'% ',name); 620 end; 621 622 procedure twpofilewriter.sectionputline(const s: string); 623 begin 624 writeln(foutputfile,s); 625 end; 626 627 procedure twpofilewriter.registerwpocomponent( 628 component: twpocomponentbase); 629 begin 630 fsectioncontents.add(component); 631 end; 632 633 { twpoinfomanagerbase } 634 635 procedure twpoinfomanagerbase.registerwpocomponentclass(wpocomponent: twpocomponentbaseclass); 636 begin 637 fwpocomponents.add(wpocomponent.sectionname,wpocomponent); 638 end; 639 640 twpoinfomanagerbase.gethandlerforsectionnull641 function twpoinfomanagerbase.gethandlerforsection(const secname: string 642 ): twpocomponentbaseclass; 643 begin 644 result:=twpocomponentbaseclass(fwpocomponents.find(secname)); 645 end; 646 647 procedure twpoinfomanagerbase.setwpoinputfile(const fn: tcmdstr); 648 begin 649 freader:=twpofilereader.create(fn,self); 650 end; 651 652 procedure twpoinfomanagerbase.setwpooutputfile(const fn: tcmdstr); 653 begin 654 fwriter:=twpofilewriter.create(fn); 655 end; 656 657 procedure twpoinfomanagerbase.parseandcheckwpoinfo; 658 var 659 i: longint; 660 begin 661 { error if we don't have to optimize yet have an input feedback file } 662 if (init_settings.dowpoptimizerswitches=[]) and 663 assigned(freader) then 664 begin 665 cgmessage(wpo_input_without_info_use); 666 exit; 667 end; 668 669 { error if we have to optimize yet don't have an input feedback file } 670 if (init_settings.dowpoptimizerswitches<>[]) and 671 not assigned(freader) then 672 begin 673 cgmessage(wpo_no_input_specified); 674 exit; 675 end; 676 677 { if we have to generate wpo information, check that a file has been 678 specified and that we have something to write to it 679 } 680 if (init_settings.genwpoptimizerswitches<>[]) and 681 not assigned(fwriter) then 682 begin 683 cgmessage(wpo_no_output_specified); 684 exit; 685 end; 686 687 if (init_settings.genwpoptimizerswitches=[]) and 688 assigned(fwriter) then 689 begin 690 cgmessage(wpo_output_without_info_gen); 691 exit; 692 end; 693 694 { now read the input feedback file } 695 if assigned(freader) then 696 begin 697 freader.processfile; 698 freader.free; 699 freader:=nil; 700 end; 701 702 { and for each specified optimization check whether the input feedback 703 file contained the necessary information 704 } 705 if (([cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts] * init_settings.dowpoptimizerswitches) <> []) and 706 not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) then 707 begin 708 cgmessage1(wpo_not_enough_info,wpo2str[wpo_devirtualization_context_insensitive]); 709 exit; 710 end; 711 712 if (cs_wpo_symbol_liveness in init_settings.dowpoptimizerswitches) and 713 not assigned(wpoinfouse[wpo_live_symbol_information]) then 714 begin 715 cgmessage1(wpo_not_enough_info,wpo2str[wpo_live_symbol_information]); 716 exit; 717 end; 718 719 { perform pre-checking to ensure there are no known incompatibilities between 720 the selected optimizations and other switches 721 } 722 for i:=0 to fwpocomponents.count-1 do 723 if (twpocomponentbaseclass(fwpocomponents[i]).generatesinfoforwposwitches*init_settings.genwpoptimizerswitches)<>[] then 724 twpocomponentbaseclass(fwpocomponents[i]).checkoptions 725 end; 726 727 procedure twpoinfomanagerbase.extractwpoinfofromprogram; 728 var 729 i: longint; 730 info: twpocomponentbase; 731 begin 732 { if don't have to write anything, fwriter has not been created } 733 if not assigned(fwriter) then 734 exit; 735 736 { let all wpo components gather the necessary info from the compiler state } 737 for i:=0 to fwpocomponents.count-1 do 738 if (twpocomponentbaseclass(fwpocomponents[i]).generatesinfoforwposwitches*current_settings.genwpoptimizerswitches)<>[] then 739 begin 740 info:=twpocomponentbaseclass(fwpocomponents[i]).create; 741 info.constructfromcompilerstate; 742 fwriter.registerwpocomponent(info); 743 end; 744 { and write their info to disk } 745 fwriter.writefile; 746 fwriter.free; 747 fwriter:=nil; 748 end; 749 750 constructor twpoinfomanagerbase.create; 751 begin 752 inherited create; 753 fwpocomponents:=tfphashlist.create; 754 end; 755 756 destructor twpoinfomanagerbase.destroy; 757 var 758 i: twpotype; 759 begin 760 freader.free; 761 freader:=nil; 762 fwriter.free; 763 fwriter:=nil; 764 fwpocomponents.free; 765 fwpocomponents:=nil; 766 for i:=low(wpoinfouse) to high(wpoinfouse) do 767 if assigned(wpoinfouse[i]) then 768 wpoinfouse[i].free; 769 inherited destroy; 770 end; 771 772 { tcalledvmtentries } 773 774 constructor tcalledvmtentries.create(_objdef: tdef; nentries: longint); 775 begin 776 objdef:=_objdef; 777 calledentries:=tbitset.create(nentries); 778 end; 779 780 781 constructor tcalledvmtentries.ppuload(ppufile: tcompilerppufile); 782 var 783 len: longint; 784 begin 785 ppufile.getderef(fobjdefderef); 786 len:=ppufile.getlongint; 787 calledentries:=tbitset.create_bytesize(len); 788 if (len <> calledentries.datasize) then 789 internalerror(2009060301); 790 ppufile.readdata(calledentries.data^,len); 791 end; 792 793 794 destructor tcalledvmtentries.destroy; 795 begin 796 fcalledentries.free; 797 inherited destroy; 798 end; 799 800 801 procedure tcalledvmtentries.ppuwrite(ppufile: tcompilerppufile); 802 begin 803 ppufile.putderef(objdefderef); 804 ppufile.putlongint(calledentries.datasize); 805 ppufile.putdata(calledentries.data^,calledentries.datasize); 806 end; 807 808 809 procedure tcalledvmtentries.buildderef; 810 begin 811 objdefderef.build(objdef); 812 end; 813 814 815 procedure tcalledvmtentries.buildderefimpl; 816 begin 817 end; 818 819 820 procedure tcalledvmtentries.deref; 821 begin 822 objdef:=tdef(objdefderef.resolve); 823 end; 824 825 826 procedure tcalledvmtentries.derefimpl; 827 begin 828 end; 829 830 end. 831