/pliant/language/debug/record.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/ring1.pli" 
 18   
 19   
 20  # moved to /pliant/language/optimizer/gcc_base.pli 
 21  if false 
 22   
 23    type DebuggerInstructionRecord 
 24      field Int code_offset 
 25      field ListingPositions position 
 26      field Int profiler_counter <- 0 
 27   
 28    type DebuggerVariableRecord 
 29      field Int stack_offset 
 30      field Str name 
 31      field Link:Type type 
 32   
 33   
 34  public 
 35    type DebuggerInstructionRecords 
 36      field Int count <- 0 
 37   
 38  function destroy rs 
 39    arg_w DebuggerInstructionRecords rs 
 40    for (var Int i) rs:count-1 
 41      DebuggerInstructionRecord destroy_instance ((addressof:rs translate Int 1) translate DebuggerInstructionRecord i) 
 42   
 43   
 44  function generate_debugging_info gc 
 45    arg_rw GeneratorContext gc 
 46    if pliant_debugging_level_variable=or (gc:locals first "gcc compiled function")<>null 
 47      return 
 48    var Pointer:Function fun :> gc function 
 49    var Link:List deb 
 50    if fun:externals<>null and addressof:(entry_type fun:externals)=addressof:List 
 51      deb :> fun:externals map List 
 52    else 
 53      deb :> new List 
 54      if fun:externals<>null 
 55        deb append fun:externals 
 56      fun externals := addressof deb 
 57    if true 
 58      var Str last_position := "" ; var Int count := 0 
 59      var Pointer:Instruction :> gc first_instruction 
 60      while addressof:i<>null 
 61        if i:position<>last_position 
 62          count := count+1 
 63          last_position := position 
 64        :> next_instruction 
 65      if count>0 
 66        (addressof:DebuggerInstructionRecords map Type) size := Int:size+count*DebuggerInstructionRecord:size 
 67        var Link:DebuggerInstructionRecords rs :> new DebuggerInstructionRecords 
 68        rs count := count 
 69        deb append addressof:rs 
 70        var Str last_position := "" ; var Int index := 0 
 71        var Pointer:Instruction :> gc first_instruction 
 72        while addressof:i<>null 
 73          if i:position<>last_position 
 74            var Pointer:DebuggerInstructionRecord fi :> ((addressof:rs translate Int 1) translate DebuggerInstructionRecord index) map DebuggerInstructionRecord 
 75            DebuggerInstructionRecord build_instance addressof:fi 
 76            fi code_offset := order 
 77            fi position := position 
 78            last_position := position ; index := index+1 
 79          :> next_instruction 
 80    else 
 81      var Str last_position := "" 
 82      var Pointer:Instruction i :> gc first_instruction 
 83      while addressof:i<>null 
 84        if i:position<>last_position 
 85          var Link:DebuggerInstructionRecord fi :> new DebuggerInstructionRecord 
 86          fi code_offset := i order 
 87          fi position := i position 
 88          deb append addressof:fi 
 89          last_position := i position 
 90        i :> i next_instruction 
 91    if pliant_debugging_level_variable>=2 
 92      var Int pushsize := (gc:locals first "pliant push size"map Int 
 93      var Int localsize := (gc:locals first "pliant locals size"map Int 
 94      var Dictionary names 
 95      var Pointer:Arrow :> gc:arguments first 
 96      while c<>null 
 97        var Pointer:Argument :> map Argument 
 98        if a:name:len<>and a:where=3 
 99          var Str fullname := a:name+" "+('convert to string' a:offset) 
 100          if (names first fullname)=null 
 101            var Link:DebuggerVariableRecord fv :> new DebuggerVariableRecord 
 102            fv stack_offset := a:offset-pushsize-localsize 
 103            fv name := name 
 104            if a:pointer:where=and a:pointer:register=4 
 105              fv type :> type 
 106            else 
 107              fv type :> pointerto a:type 
 108            deb append addressof:fv 
 109            names insert fullname true addressof:a 
 110        :> gc:arguments next c 
 111   
 112   
 113  # sets the optimizer that will generate debugging informations 
 114   
 115  the_module:"/pliant/language/optimizer/basic.pli" define "pliant optimizer conclude" addressof:(the_function generate_debugging_info GeneratorContext)