/pliant/language/compiler/instruction/instruction2.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  function duplicate i -> i2 
 21    arg Instruction i ; arg_RW Instruction i2 
 22    i2 :> new Instruction 
 23    i2 function :> function 
 24    i2 'size :=' i:size 
 25    for (var Int u) i2:size-1 
 26      i2 :> u 
 27    i2 jump :> jump 
 28     
 29   
 30  function new_instruction f n -> i 
 31    arg Function f ; arg Int n; arg_RW Instruction i 
 32    if f:nb_args_with_result<>n 
 33      error error_id_unexpected "Expected "+('convert to string' f:nb_args_with_result)+" argument(s) for function at "+f:position 
 34    :> new Instruction 
 35    function :> f 
 36    'size :=' n 
 37    return i 
 38   
 39  function instruction_set_argument i u a 
 40    arg_rw Instruction i ; arg Int u ; arg Argument a 
 41    if addressof:a=null 
 42      error error_id_unexpected "Attempted to build an Instruction with a null argument ("+i:function:name+")" 
 43    :> a 
 44   
 45  function instruction_set_jump i j 
 46    arg_rw Instruction i ; arg Instruction j 
 47    jump :> j 
 48   
 49  function instruction_set_nested_with i j 
 50    arg_rw Instruction i ; arg Instruction j 
 51    nested_with :> j 
 52   
 53   
 54  meta instruction e 
 55    if e:size<or not (e:cast Function) 
 56      return 
 57    var Int stop := e:size 
 58    if stop>=and addressof:(entry_type e:(stop-2):value)=addressof:Ident and (e:(stop-2):value map Ident)=(cast "nested_with" Ident) 
 59      if not (e:(stop-1) cast Instruction) 
 60        return 
 61      stop := stop-2 
 62    if stop>=and addressof:(entry_type e:(stop-2):value)=addressof:Ident and (e:(stop-2):value map Ident)=(cast "jump" Ident) 
 63      if not (e:(stop-1) cast Instruction) 
 64        return 
 65      stop := stop-2 
 66    for (var Int i) stop-1 
 67      if not (e:cast Argument) 
 68        return 
 69    var Link:Argument adr :> argument local Address 
 70    var Link:Argument instr :> argument indirect Instruction adr 0 
 71    var Link:Instruction i1 :> new Instruction 
 72    i1 function :> the_function new_instruction Function Int -> Instruction 
 73    i1 'size :=' 3 
 74    e:cast Function 
 75    suckup e:0 
 76    i1 :> e:0:result 
 77    i1 :> argument constant Int stop-1 
 78    i1 :> instr 
 79    add i1 
 80    for (var Int i) stop-1 
 81      var Link:Instruction ii :> new Instruction 
 82      ii function :> the_function instruction_set_argument Instruction Int Argument 
 83      ii:arguments 'size :=' 3 
 84      ii :> instr 
 85      ii :> argument constant Int i-1 
 86      suckup e:i 
 87      ii :> e:i:result 
 88      add ii 
 89    while stop<>e:size 
 90      var Link:Instruction ij :> new Instruction 
 91      if (e:stop:value map Ident)=(cast "jump" Ident) 
 92        ij function :> the_function instruction_set_jump Instruction Instruction 
 93      eif (e:stop:value map Ident)=(cast "nested_with" Ident) 
 94        ij function :> the_function instruction_set_nested_with Instruction Instruction 
 95      ij:arguments 'size :=' 2 
 96      ij :> instr 
 97      suckup (stop+1) 
 98      ij :> (stop+1):result 
 99      add ij 
 100      stop := stop+2 
 101    set_result instr access_read+access_write 
 102   
 103   
 104  export duplicate instruction 
 105