/pliant/language/compiler/argument/argument2.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  function new_argument_immediat t v -> a 
 20    arg Type t ; arg Universal v ; arg_RW Argument a 
 21    :> new Argument 
 22    locate argument_constant 
 23    constant := entry_new t 
 24    copy_instance addressof:a:constant 
 25   
 26  function new_argument_mapped t v -> a 
 27    arg Type t ; arg Universal v ; arg_RW Argument a 
 28    :> new Argument 
 29    locate argument_constant 
 30    constant := addressof:v 
 31   
 32  function new_argument_local t -> a 
 33    arg Type t ; arg_RW Argument a 
 34    :> new Argument 
 35    locate argument_local 
 36   
 37  function new_argument_indirect t p o -> a 
 38    arg Type t ; arg Argument p ; arg Int o ; arg_RW Argument a 
 39    :> new Argument 
 40    locate argument_indirect 
 41    pointer :> p 
 42    offset := o 
 43   
 44  function new_argument_a_register -> a 
 45    arg_RW Argument a 
 46    :> new Argument 
 47    locate Int argument_a_register 
 48   
 49  function new_argument_register r -> a 
 50    arg Int r; arg_RW Argument a 
 51    :> new Argument 
 52    locate Int argument_register 
 53    register := r 
 54   
 55   
 56  public 
 57   
 58  meta argument e 
 59    if e:size=0 
 60      return 
 61    if addressof:(entry_type e:0:value)<>addressof:Ident 
 62      return 
 63    var Link:Instruction :> new Instruction 
 64    var Str id := cast (e:0:value map Ident) Str 
 65    if id="constant" or id="mapped_constant" 
 66      if e:size<>3 
 67        return 
 68      var Pointer:Type :> (e:constant Type) map Type 
 69      if addressof:t=null 
 70        return 
 71      if not (e:cast t) 
 72        return 
 73      if id="constant" 
 74        function :> the_function new_argument_immediat Type Universal -> Argument 
 75      eif id="mapped_constant" 
 76        function :> the_function new_argument_mapped Type Universal -> Argument 
 77      else 
 78        error error_id_unexpected "bug" 
 79      'size :=' 3 
 80      var Link:Argument :> new Argument 
 81      locate Type argument_constant 
 82      constant := addressof t 
 83      :> a 
 84      suckup e:2 
 85      :> e:2:result 
 86    eif id="local" 
 87      if e:size<>or not (e:cast Type) 
 88        return 
 89      function :> the_function new_argument_local Type -> Argument 
 90      'size :=' 2 
 91      suckup e:1 
 92      :> e:1:result 
 93    eif id="indirect" 
 94      if e:size<>or not (e:cast Type) or not (e:cast Argument) or not (e:cast Int) 
 95        return 
 96      function :> the_function new_argument_indirect Type Argument Int -> Argument 
 97      'size :=' 4 
 98      suckup e:1 
 99      suckup e:2 
 100      suckup e:3 
 101      :> e:1:result 
 102      :> e:2:result 
 103      :> e:3:result 
 104    eif id="a_register" 
 105      if e:size<>1 
 106        return 
 107      function :> the_function new_argument_a_register -> Argument 
 108      'size :=' 1 
 109    eif id="register" 
 110      if e:size<>or not (e:cast Int) 
 111        return 
 112      function :> the_function new_argument_register Int -> Argument 
 113      'size :=' 2 
 114      suckup e:1 
 115      :> e:1:result 
 116    else 
 117      error error_id_unexpected "unknown argument location" 
 118      return 
 119    var Link:Argument adr :> new Argument 
 120    adr locate Address argument_local 
 121    var Link:Argument :> new Argument 
 122    locate Argument argument_indirect 
 123    pointer :> adr ; offset := 0 
 124    i:size-:> a 
 125    add i 
 126    set_result access_read+access_write