/pliant/language/optimizer/extend.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/" "/pliant/install/" 
 17  module "/pliant/install/ring2.pli" 
 18   
 19   
 20  method a access i -> m 
 21    arg Argument a ; arg Instruction i ; arg Int m 
 22    := 0 
 23    for (var Int u) i:size-1 
 24      var Pointer:Argument au :> u 
 25      if au=a 
 26        := '.or.' m (i:function arg u):access 
 27      while au:where=argument_indirect 
 28        au :> au pointer 
 29        if au=a 
 30          := '.or.' access_read 
 31    := '.and.' access_read+access_write 
 32   
 33   
 34  method a is_stable first last -> stable 
 35    arg Argument a ; arg Instruction first last ; arg CBool stable 
 36    if a:where=argument_indirect 
 37      if not (a:pointer is_stable first last) 
 38        return false 
 39    if a:is_mapped 
 40      return false 
 41    var Pointer:Instruction :> first 
 42    while true 
 43      if i:backward_jumps:first<>null 
 44        if i<>first 
 45          return false 
 46      if (addressof i:jump)<>null 
 47        if i<>last 
 48          return false 
 49      var Int count := 0 
 50      for (var Int u) i:size-1 
 51        var Pointer:Argument au :> u 
 52        if au=a 
 53          count := count+1 
 54        while au:where=argument_indirect 
 55          au :> au pointer 
 56          if au=a 
 57            count := count+1 
 58      if i=first or i=last 
 59        count := count-1 
 60      if count>0 
 61        return false 
 62      if i=last 
 63        return true 
 64      :> next_instruction 
 65   
 66  method a is_temporary -> temp 
 67    arg Argument a ; arg CBool temp 
 68    if a:where<>argument_local 
 69      return false 
 70    if (addressof a:first_instruction)=null or a:first_instruction=a:last_instruction 
 71      return 
 72    var Pointer:Instruction :> first_instruction 
 73    if i:size=or (i:size-1)<>a 
 74      return false 
 75    if (access a:first_instruction)<>access_write 
 76      return false 
 77    if (access a:last_instruction)<>access_read 
 78      return false 
 79    return (is_stable a:first_instruction a:last_instruction) 
 80   
 81   
 82 
 
 83   
 84   
 85  function keep_object a 
 86    arg Universal a 
 87  function keep_object_generate_binary instr function 
 88    arg Instruction instr ; arg_rw Function function 
 89  (the_function keep_object Universal) set_generate_binary (the_function keep_object_generate_binary Instruction Function) 
 90   
 91  method gc keep_object a 
 92    arg_rw GeneratorContext gc ; arg_rw Argument a 
 93    if a:requires:first<>null and a:first_instruction=a:last_instruction 
 94      gc insert_after_instruction a:first_instruction (instruction (the_function keep_object Universal) a) 
 95   
 96   
 97 
 
 98   
 99   
 100  function record_optimizer_function2 f section 
 101    arg Function f ; arg Str section 
 102    pliant_general_dictionary insert2 section false addressof:the_module:"/pliant/language/optimizer/basic.pli" 
 103   
 104  meta record_optimizer_function e 
 105    if e:size=and e:0:is_pure_ident and (e:cast Str) 
 106      compile_as (expression immediat (record_optimizer_function2 (the_function fun GeneratorContext) section) substitute fun e:0 substitute section e:1) 
 107   
 108   
 109  function optimizer_section name -> ptr 
 110    arg Str name ; arg Pointer:Arrow ptr 
 111    ptr :> 'pliant optimizer sections' first 
 112    while ptr<>null and (ptr map Str)<>name 
 113      ptr :> 'pliant optimizer sections' next ptr 
 114    if ptr=null 
 115      error "The optimizing section "+name+" does not exist" 
 116   
 117  function set_new_optimizing_sections 
 118    var Link:Str section0 :> new Str 
 119    section0 := "pliant optimizer rewrite instructions0" 
 120    'pliant optimizer sections' insert_before optimizer_section:"pliant optimizer rewrite instructions" addressof:section0 
 121    var Link:Str section2 :> new Str 
 122    section2 := "pliant optimizer rewrite instructions2" 
 123    'pliant optimizer sections' insert_after optimizer_section:"pliant optimizer rewrite instructions" addressof:section2 
 124  set_new_optimizing_sections 
 125   
 126   
 127  export '. is_stable' '. is_temporary' 
 128  export '. keep_object' 
 129  export record_optimizer_function record_optimizer_function2