/pliant/language/basic/swap.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 general_swap a b size 
 20    arg Universal b ; arg Int size 
 21    var Address pa := addressof a ; var Address pb := addressof b ; var Int remain := size 
 22    while remain>=uInt:size 
 23      var uInt := pa map uInt 
 24      pa map uInt := pb map uInt 
 25      pb map uInt := i 
 26      pa := pa translate uInt 1 
 27      pb := pb translate uInt 1 
 28      remain -= uInt size 
 29    while remain>0 
 30      var uInt := pa map uInt8 
 31      pa map uInt8 := pb map uInt8 
 32      pb map uInt8 := i 
 33      pa := pa translate uInt8 1 
 34      pb := pb translate uInt8 1 
 35      remain -= uInt8 size 
 36   
 37  meta swap e 
 38    if e:size<>2 
 39      return 
 40    e:compile ? 
 41    var Link:Type :> e:0:result:type real_data_type 
 42    if not (e:cast t) 
 43      :> e:1:result:type real_data_type 
 44      if not (e:cast t) 
 45        return 
 46    e:cast t ; e:cast t 
 47    if (e:0:access .and. access_write)=or (e:1:access .and. access_write)=0 
 48      return 
 49    suckup e:0 ; suckup e:1 
 50    if t:size=Int:size 
 51      var Link:Argument tmp :> argument local Int 
 52      add (instruction (the_function 'copy atomic' Int Int) e:0:result tmp) 
 53      add (instruction (the_function 'copy atomic' Int Int) e:1:result e:0:result) 
 54      add (instruction (the_function 'copy atomic' Int Int) tmp e:1:result) 
 55    else 
 56      var Link:Argument tsize :> argument constant Int t:size 
 57      add (instruction (the_function general_swap Universal Universal Int) e:0:result e:1:result tsize) 
 58    set_void_result 
 59   
 60  export swap