Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/type/number/int.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"


operator '.+.' 3*256+1*16 1 1
operator '.-.' 3*256+1*16 1 1
operator '.*.' 3*256+2*16 1 1
operator '.^.' 3*256+3*16 1 1


#--------------------------------------------------------------------


function abs i -> a
  arg Int i a
  gcc_inline "$2 = ($1>=0 ? $1 : -$1);"
  if i>=0
    a := i
  else
    a := -i

export abs


type uInt
  field Int value


function cast_uInt_Int i -> j
  arg uInt i ; arg Int j
  extension ; has_no_side_effect ; gcc_nocheck_inline "$2 = $1;"
  check i:value>=0 "The value is too large to fit in an Int"
  j := i value
if pliant_debugging_level<2
  (the_function cast_uInt_Int uInt -> Int) flags := '.or.' (the_function cast_uInt_Int uInt -> Int):flags function_flag_copy
  (the_function cast_uInt_Int uInt -> Int) set_generate_assembly (the_function 'copy atomic' Int Int):generate_assembly

function cast_Int_uInt i -> j
  arg Int i ; arg uInt j
  reduction ; has_no_side_effect ; gcc_nocheck_inline "$2 = $1;"
  check i>=0 "The integer is negative"
  j value := i
if pliant_debugging_level<2
  (the_function cast_Int_uInt Int -> uInt) flags := '.or.' (the_function cast_Int_uInt Int -> uInt):flags function_flag_copy
  (the_function cast_Int_uInt Int -> uInt) set_generate_assembly (the_function 'copy atomic' Int Int):generate_assembly


function cast_uInt_Address i -> a
  arg uInt i ; arg Address a
  has_no_side_effect ; gcc_nocheck_inline "$2 = $1;"
  check uInt:size=Address:size
  memory_copy addressof:i addressof:a uInt:size
if pliant_debugging_level<2
  (the_function cast_uInt_Address uInt -> Address) flags := (the_function cast_uInt_Address uInt -> Address):flags+function_flag_copy
  (the_function cast_uInt_Address uInt -> Address) set_generate_assembly (the_function 'copy atomic' Int Int):generate_assembly

function cast_Address_uInt a -> i
  arg Address a ; arg uInt i
  has_no_side_effect ; gcc_nocheck_inline "$2 = $1;"
  check uInt:size=Address:size
  memory_copy addressof:a addressof:i uInt:size
if pliant_debugging_level<2
  (the_function cast_Address_uInt Address -> uInt) flags := (the_function cast_Address_uInt Address -> uInt):flags+function_flag_copy
  (the_function cast_Address_uInt Address -> uInt) set_generate_assembly (the_function 'copy atomic' Int Int):generate_assembly


function compare_uInt i j -> c
  arg uInt i j ; arg Int c
  gcc_inline "$3 = (unsigned int)$1<(unsigned int)$2 ? "+'convert to string':compare_inferior+" : (unsigned int)$1>(unsigned int)$2 ? "+'convert to string':compare_superior+" : "+'convert to string':compare_equal+";"
  gcc_inline_compare "$3 = (unsigned int)$1 compare (unsigned int)$2;"
  var Int ii := i:value+(-2)^(Int:bitsize-1)
  var Int jj := j:value-(-2)^(Int:bitsize-1)
  if ii=jj
    c := compare_equal
  eif ii<jj
    c := compare_inferior
  else
    check ii>jj
    c := compare_superior

export uInt
alias 'cast Int' cast_uInt_Int in "/pliant/language/basic/ultrasafe.pli"
alias 'cast uInt' cast_Int_uInt in "/pliant/language/basic/ultrasafe.pli"
alias 'cast Address' cast_uInt_Address in "/pliant/language/basic/safe.pli"
alias 'cast uInt' cast_Address_uInt in "/pliant/language/basic/safe.pli"
alias compare compare_uInt in "/pliant/language/basic/safe.pli"


#--------------------------------------------------------------------


if processor_name="i386"

  function arithmetic_overflow
    has_no_side_effect
    error error_id_arithmetic "Arithmetic overflow"

  function generate_parameter_is_valid i f
    arg_rw Instruction i ; arg_rw Function f
  function parameter_is_valid -> p
    arg Int p
  (the_function parameter_is_valid -> Int) set_generate_binary (the_function generate_parameter_is_valid Instruction Function)

  function i386_jump_if_not_overflow
    void
  function generate_jump_if_not_overflow i f
    arg_rw Instruction i ; arg_rw Function f
    f code_immediat 8*4096+1*256+0*16+15 2
    f code_jump i:jump
  (the_function i386_jump_if_not_overflow) set_generate_binary (the_function generate_jump_if_not_overflow Instruction Function)

  function i386_jump_if_not_carry
    void
  function generate_jump_if_not_carry i f
    arg_rw Instruction i ; arg_rw Function f
    f code_immediat 8*4096+3*256+0*16+15 2
    f code_jump i:jump
  (the_function i386_jump_if_not_carry) set_generate_binary (the_function generate_jump_if_not_carry Instruction Function)

  function generate_overflow_checkup cur gc checkup parameter -> cur2
    arg Pointer:Instruction cur cur2 ; arg_rw GeneratorContext gc ; arg Int checkup ; arg_rw Argument parameter
    check checkup>=0 and checkup<=2 # 0 = no checkup , 1 = Int checkup , 2 = uInt checkup
    if pliant_debugging_level<2 or checkup=0
      return cur
    var Link:Instruction back :> instruction (the_function parameter_is_valid -> Int) parameter
    if checkup=1
      cur2 :> gc insert_after_instruction cur (instruction (the_function i386_jump_if_not_overflow) jump back)
    else
      cur2 :> gc insert_after_instruction cur (instruction (the_function i386_jump_if_not_carry) jump back)
    cur2 :> gc insert_after_instruction cur2 (instruction (the_function arithmetic_overflow))
    cur2 :> gc insert_after_instruction cur2 back


  function rename_function fun newname
    arg_rw Function fun ; arg Str newname
    pliant_general_dictionary insert2 newname true addressof:fun the_module:"/pliant/language/basic/safe.pli"
    pliant_general_dictionary remove fun:name addressof:fun
    fun name := newname

  function assemble_simple i gc fun checkup
    arg_rw Instruction i ; arg_rw GeneratorContext gc ; arg Function fun ; arg Int checkup
    var Pointer:Instruction cur :> i
    var Link:Argument r :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 r)
    cur :> gc insert_after_instruction cur (instruction fun i:1 r)
    cur :> generate_overflow_checkup cur gc checkup r
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) r i:2)
    gc remove i


  rename_function (the_function '+' Int Int -> Int) ".+."

  function '.+.' a b -> r
    arg uInt a b r ; gcc_inline "$3 = $1 + $2;"
  (the_function '.+.' uInt uInt -> uInt) set_generate_assembly (the_function '+' Int Int -> Int):generate_assembly

  function plus a b -> r
    arg Int a b r ; gcc_nocheck_inline "$3 = $1 + $2;"
  function assemble_add_checkup_int i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_simple i gc (the_function i386_add Int Int) 1
  (the_function plus Int Int -> Int) set_generate_assembly (the_function assemble_add_checkup_int Instruction GeneratorContext)
  rename_function (the_function plus Int Int -> Int) "+"

  function '+' a b -> r
    arg uInt a b r ; gcc_nocheck_inline "$3 = $1 + $2;"
  function assemble_add_checkup_uint i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_simple i gc (the_function i386_add Int Int) 2
  (the_function '+' uInt uInt -> uInt) set_generate_assembly (the_function assemble_add_checkup_uint Instruction GeneratorContext)


  rename_function (the_function '-' Int Int -> Int) ".-."

  function '.-.' a b -> r
    arg uInt a b r ; gcc_inline "$3 = $1 - $2;"
  (the_function '.-.' uInt uInt -> uInt) set_generate_assembly (the_function '-' Int Int -> Int):generate_assembly

  function minus a b -> r
    arg Int a b r ; gcc_nocheck_inline "$3 = $1 - $2;"
  function assemble_sub_checkup_int i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_simple i gc (the_function i386_sub Int Int) 1
  (the_function minus Int Int -> Int) set_generate_assembly (the_function assemble_sub_checkup_int Instruction GeneratorContext)
  rename_function (the_function minus Int Int -> Int) "-"

  function '-' a b -> r
    arg uInt a b r ; gcc_nocheck_inline "$3 = $1 - $2;"
  function assemble_sub_checkup_uint i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_simple i gc (the_function i386_sub Int Int) 2
  (the_function '-' uInt uInt -> uInt) set_generate_assembly (the_function assemble_sub_checkup_uint Instruction GeneratorContext)


  function i386_imul x eax edx
    arg Int x ; arg_rw Int eax ; arg_w Int edx
  function generate_i386_imul i f
    arg_rw Instruction i ; arg_rw Function f
    check i:1:where=argument_register and i:1:register=i386_eax
    check i:2:where=argument_register and i:2:register=i386_edx
    i386_regmem f 15*16+7 1 5 i:0
  (the_function i386_imul Int Int Int) set_generate_binary (the_function generate_i386_imul Instruction Function)
  ((the_function i386_imul Int Int Int) arg 1) access := access_read+access_write+access_byvalue
  ((the_function i386_imul Int Int Int) arg 2) access := access_write+access_byvalue

  function i386_mul x eax edx
    arg Int x ; arg_rw Int eax ; arg_w Int edx
  function generate_i386_mul i f
    arg_rw Instruction i ; arg_rw Function f
    check i:1:where=argument_register and i:1:register=i386_eax
    check i:2:where=argument_register and i:2:register=i386_edx
    i386_regmem f 15*16+7 1 4 i:0
  (the_function i386_mul Int Int Int) set_generate_binary (the_function generate_i386_mul Instruction Function)
  ((the_function i386_mul Int Int Int) arg 1) access := access_read+access_write+access_byvalue
  ((the_function i386_mul Int Int Int) arg 2) access := access_write+access_byvalue

  function assemble_mul i gc checkup imul_mul
    arg_rw Instruction i ; arg_rw GeneratorContext gc ; arg Int checkup imul_mul
    var Pointer:Instruction cur :> i
    var Pointer:Argument eax :> gc register i386_eax
    var Pointer:Argument edx :> gc register i386_edx
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 eax)
    if imul_mul=1
      cur :> gc insert_after_instruction cur (instruction (the_function i386_imul Int Int Int) i:1 eax edx)
    else
      cur :> gc insert_after_instruction cur (instruction (the_function i386_mul Int Int Int) i:1 eax edx)
    cur :> generate_overflow_checkup cur gc checkup eax
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) eax i:2)
    gc remove i


  rename_function (the_function '*' Int Int -> Int) ".*."

  function '.*.' a b -> r
    arg uInt a b r; gcc_inline "$3 = (unsigned int)$1 * (unsigned int)$2;"
  function assemble_mul_nocheckup_uint i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_mul i gc 0 2
  (the_function '.*.' uInt uInt -> uInt) set_generate_assembly (the_function assemble_mul_nocheckup_uint Instruction GeneratorContext)

  function multiply a b -> r
    arg Int a b r ; gcc_nocheck_inline "$3 = $1 * $2;"
  function assemble_mul_checkup_int i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_mul i gc 1 1
  (the_function multiply Int Int -> Int) set_generate_assembly (the_function assemble_mul_checkup_int Instruction GeneratorContext)
  rename_function (the_function multiply Int Int -> Int) "*"

  function '*' a b -> r
    arg uInt a b r; gcc_nocheck_inline "$3 = (unsigned int)$1 * (unsigned int)$2;"
  function assemble_mul_checkup_uint i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_mul i gc 2 2
  (the_function '*' uInt uInt -> uInt) set_generate_assembly (the_function assemble_mul_checkup_uint Instruction GeneratorContext)


  function i386_cdq eax edx
    arg Int eax ; arg_w Int edx
  function generate_i386_cdq i f
    arg_rw Instruction i ; arg_rw Function f
    check i:0:where=argument_register and i:0:register=i386_eax
    check i:1:where=argument_register and i:1:register=i386_edx
    f code_immediat 9*16+9 1
  (the_function i386_cdq Int Int) set_generate_binary (the_function generate_i386_cdq Instruction Function)
  ((the_function i386_cdq Int Int) arg 1) access := access_write+access_byvalue

  function i386_idiv eax edx x
    arg_rw Int eax edx ; arg Int x
  function generate_i386_idiv i f
    arg_rw Instruction i ; arg_rw Function f
    check i:0:where=argument_register and i:0:register=i386_eax
    check i:1:where=argument_register and i:1:register=i386_edx
    i386_regmem f 15*16+7 1 7 i:2
  (the_function i386_idiv Int Int Int) set_generate_binary (the_function generate_i386_idiv Instruction Function)
  ((the_function i386_idiv Int Int Int) arg 0) access := access_read+access_write+access_byvalue
  ((the_function i386_idiv Int Int Int) arg 1) access := access_read+access_write+access_byvalue

  function i386_div eax edx x
    arg_rw Int eax edx ; arg Int x
  function generate_i386_div i f
    arg_rw Instruction i ; arg_rw Function f
    check i:0:where=argument_register and i:0:register=i386_eax
    check i:1:where=argument_register and i:1:register=i386_edx
    i386_regmem f 15*16+7 1 6 i:2
  (the_function i386_div Int Int Int) set_generate_binary (the_function generate_i386_div Instruction Function)
  ((the_function i386_div Int Int Int) arg 0) access := access_read+access_write+access_byvalue
  ((the_function i386_div Int Int Int) arg 1) access := access_read+access_write+access_byvalue


  function assemble_divide i gc signed reg
    arg_rw Instruction i ; arg_rw GeneratorContext gc ; arg CBool signed ; arg Int reg
    var Pointer:Instruction cur :> i
    var Link:Argument eax :> gc register i386_eax
    var Link:Argument edx :> gc register i386_edx
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 eax)
    if signed
      cur :> gc insert_after_instruction cur (instruction (the_function i386_cdq Int Int) eax edx)
      cur :> gc insert_after_instruction cur (instruction (the_function i386_idiv Int Int Int) eax edx i:1)
    else
      cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) (argument constant Int 0) edx)
      cur :> gc insert_after_instruction cur (instruction (the_function i386_div Int Int Int) eax edx i:1)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) (gc register reg) i:2)
    gc remove i

  function assemble_idiv i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_divide i gc true i386_eax
  (the_function '\' Int Int -> Int) set_generate_assembly (the_function assemble_idiv Instruction GeneratorContext)

  function '\' a b -> r
    arg uInt a b r ; gcc_inline "$3 = (unsigned int)$1 / (unsigned int)$2;"
  function assemble_div i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_divide i gc false i386_eax
  (the_function '\' uInt uInt -> uInt) set_generate_assembly (the_function assemble_div Instruction GeneratorContext)

  function assemble_imod i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_divide i gc true i386_edx
  (the_function '%' Int Int -> Int) set_generate_assembly (the_function assemble_imod Instruction GeneratorContext)

  function '%' a b -> r
    arg uInt a b r ; gcc_inline "$3 = (unsigned int)$1 % (unsigned int)$2;"
  function assemble_mod i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_divide i gc false i386_edx
  (the_function '%' uInt uInt -> uInt) set_generate_assembly (the_function assemble_mod Instruction GeneratorContext)


meta '-' e
  strong_definition
  if e:size<>2
    return
  var Pointer:uInt a :> (e:0 constant uInt) map uInt
  if addressof:a=null
    return
  var Pointer:uInt b :> (e:1 constant uInt) map uInt
  if addressof:b=null
    return
  if b>a
    e set_result (argument constant Int (cast a Int)-(cast b Int)) access_read


export '+' '-' '*' '\' '%'
export '.+.' '.-.' '.*.'


#--------------------------------------------------------------------

module "/pliant/language/type/text/char.pli"


function parse_bin context line parameter
  arg_rw ParserContext context ; arg Str line ; arg Address parameter
  var uInt value := 0
  for (var Int i) 0 line:len-1
    var Char c := line i
    if c="0" or c="1"
      var uInt value2 := value .*. (cast 2 uInt) .+. (cast c:number-"0":0:number uInt)
      if value2\(cast 2 uInt)<>value
        return
      value := value2
    eif c="b" and i<>0
      if i+1<line:len and (line i+1):isidentcharacter
        return
      var Link:uInt t :> new uInt
      t := value
      context add_token addressof:t
      context forward i+1
      return
    else
      return

gvar ParserFilter bin_filter
bin_filter function :> the_function parse_bin ParserContext Str Address
constant 'pliant parser basic types' bin_filter
export 'pliant parser basic types'


function parse_dec context line parameter
  arg_rw ParserContext context ; arg Str line ; arg Address parameter
  var uInt value := 0
  var Int i := 0
  while i<line:len and line:i:number>="0":0:number and line:i:number<="9":0:number
    var uInt value2 := value .*. (cast 10 uInt) .+. (cast line:i:number-"0":0:number uInt)
    if value2\(cast 10 uInt)<>value
      return
    i := i+1
    value := value2
  if i=0 or (i<line:len and line:i:isidentcharacter)
    return
  var Link:uInt t :> new uInt
  t := value
  context add_token addressof:t
  context forward i

gvar ParserFilter dec_filter
dec_filter function :> the_function parse_dec ParserContext Str Address
constant 'pliant parser basic types' dec_filter
export 'pliant parser basic types'


function parse_hex context line parameter
  arg_rw ParserContext context ; arg Str line ; arg Address parameter
  var uInt value := 0 
  for (var Int i) 0 line:len-1
    var Char c := line i
    var uInt value2
    if c:number>="0":0:number and c:number<="9":0:number
      value2 := value .*. (cast 16 uInt) .+. (cast c:number-"0":0:number uInt)
      if value2\(cast 16 uInt)<>value
        return
      value := value2
    eif c:number>="A":0:number and c:number<="F":0:number
      value2 := value .*. (cast 16 uInt) .+. (cast 10+c:number-"A":0:number uInt)
      if value2\(cast 16 uInt)<>value
        return
      value := value2
    eif c="h" and i<>0
      if i+1<line:len and (line i+1):isidentcharacter
        return
      var Link:uInt t :> new uInt
      t := value
      context add_token addressof:t
      context forward i+1
      return
    else
      return

gvar ParserFilter hex_filter
hex_filter function :> the_function parse_hex ParserContext Str Address
constant 'pliant parser basic types' hex_filter
export 'pliant parser basic types'


#--------------------------------------------------------------------


if processor_name="i386"

  function i386_or a b
    arg Int a ; arg_rw Int b

  function generate_i386_or i f
    arg_rw Instruction i ; arg_rw Function f
    if i:0:where=argument_register
      i386_regmem f 00001001b 1 i:0:register i:1
    eif i:1:where=argument_register
      i386_regmem f 00001011b 1 i:1:register i:0
    else
      error error_id_unexpected "i386 code generation: Invalid or arguments"

  (the_function i386_or Int Int) set_generate_binary (the_function generate_i386_or Instruction Function)
  ((the_function i386_or Int Int) arg 1) access := access_read+access_write+access_byvalue

  function '.or.' a b -> r
    arg uInt a b r
    gcc_inline "$3 = $1 | $2;"

  function assemble_bit_or i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> i
    var Link:Argument reg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_or Int Int) i:1 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) reg i:2)
    gc remove i

  (the_function '.or.' Int Int -> Int) set_generate_assembly (the_function assemble_bit_or Instruction GeneratorContext)
  (the_function '.or.' uInt uInt -> uInt) set_generate_assembly (the_function assemble_bit_or Instruction GeneratorContext)

  operator '.or.' 290h 1 1
  export '.or.'


  function i386_and a b
    arg Int a ; arg_rw Int b

  function generate_i386_and i f
    arg_rw Instruction i ; arg_rw Function f
    if i:0:where=argument_register
      i386_regmem f 00100001b 1 i:0:register i:1
    eif i:1:where=argument_register
      i386_regmem f 00100011b 1 i:1:register i:0
    else
      error error_id_unexpected "i386 code generation: Invalid and arguments"

  (the_function i386_and Int Int) set_generate_binary (the_function generate_i386_and Instruction Function)
  ((the_function i386_and Int Int) arg 1) access := access_read+access_write+access_byvalue

  function '.and.' a b -> r
    arg uInt a b r
    gcc_inline "$3 = $1 & $2;"

  function assemble_bit_and i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> i
    var Link:Argument reg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_and Int Int) i:1 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) reg i:2)
    gc remove i

  (the_function '.and.' Int Int -> Int) set_generate_assembly (the_function assemble_bit_and Instruction GeneratorContext)
  (the_function '.and.' uInt uInt -> uInt) set_generate_assembly (the_function assemble_bit_and Instruction GeneratorContext)

  operator '.and.' 290h 1 1
  export '.and.'


  function i386_xor a b
    arg Int a ; arg_rw Int b

  function generate_i386_xor i f
    arg_rw Instruction i ; arg_rw Function f
    if i:0:where=argument_register
      i386_regmem f 00110001b 1 i:0:register i:1
    eif i:1:where=argument_register
      i386_regmem f 00110011b 1 i:1:register i:0
    else
      error error_id_unexpected "i386 code generation: Invalid and arguments"

  (the_function i386_xor Int Int) set_generate_binary (the_function generate_i386_xor Instruction Function)
  ((the_function i386_xor Int Int) arg 1) access := access_read+access_write+access_byvalue

  function '.xor.' a b -> r
    arg Int a b r
    gcc_inline "$3 = $1 ^ $2;"

  function '.xor.' a b -> r
    arg uInt a b r
    gcc_inline "$3 = $1 ^ $2;"

  function assemble_bit_xor i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> i
    var Link:Argument reg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_xor Int Int) i:1 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) reg i:2)
    gc remove i

  (the_function '.xor.' Int Int -> Int) set_generate_assembly (the_function assemble_bit_xor Instruction GeneratorContext)
  (the_function '.xor.' uInt uInt -> uInt) set_generate_assembly (the_function assemble_bit_xor Instruction GeneratorContext)

  operator '.xor.' 290h 1 1
  export '.xor.'


  function i386_not a
    arg_rw Int a

  function generate_i386_not i f
    arg_rw Instruction i ; arg_rw Function f
    i386_regmem f 11110111b 1 010b i:0

  (the_function i386_not Int) set_generate_binary (the_function generate_i386_not Instruction Function)
  ((the_function i386_not Int) arg 0) access := access_read+access_write+access_byvalue


  function '.not.' a -> r
    arg uInt a r
    gcc_inline "$2 = ~ $1;"

  function assemble_bit_not i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> i
    var Link:Argument reg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_not Int) reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) reg i:1)
    gc remove i

  (the_function '.not.' Int -> Int) set_generate_assembly (the_function assemble_bit_not Instruction GeneratorContext)
  (the_function '.not.' uInt -> uInt) set_generate_assembly (the_function assemble_bit_not Instruction GeneratorContext)

  operator '.not.' 2A0h 0 1
  export '.not.'


function '.andnot.' a b -> r
  arg Int a b r
  r := a .and. .not. b

function '.andnot.' a b -> r
  arg uInt a b r
  r := a .and. .not. b

operator '.andnot.' 260h 1 1
export '.andnot.'


#--------------------------------------------------------------------


rename_function (the_function '^' Int Int -> Int) ".^."

function '^' a b -> r
  arg Int a b r
  check b>=0 "^ second argument must be positive"
  r := 1 ; var Int p := a ; var Int e := b
  while true
    if (e .and. 1)=1
      r := r*p
    if e<2
      return
    p := p*p
    e := e\2

function '.^.' a b -> r
  arg uInt a r ; arg Int b
  check b>=0 "^ second argument must be positive"
  r := 1 ; var uInt p := a ; var Int e := b
  while true
    if (e .and. 1)=1
      r := r .*. p
    if e<2
      return
    p := p .*. p
    e := e\2

function '^' a b -> r
  arg uInt a r ; arg Int b
  check b>=0 "^ second argument must be positive"
  r := 1 ; var uInt p := a ; var Int e := b
  while true
    if (e .and. 1)=1
      r := r*p
    if e<2
      return
    p := p*p
    e := e\2

export '^' '.^.'


#--------------------------------------------------------------------


function min a b -> m
  arg Int a b m
  gcc_inline "$3 = ($1 <= $2 ? $1 : $2);"
  if a<=b
    return a
  else
    return b


function max a b -> m
  arg Int a b m
  gcc_inline "$3 = ($1 >= $2 ? $1 : $2);"
  if a>=b
    return a
  else
    return b


export min max


#--------------------------------------------------------------------


function 'cast Status' i -> s
  arg Int i ; arg Status s
  explicit
  if i=(-2)^(Int:bitsize-1)
    s := undefined
  else
    s := defined

function 'cast Int' s -> i
  arg Status s ; arg Int i
  extension
  if pliant_debugging_level>=2
    if s<>undefined
      error error_id_unexpected "Unexpected Status value"
  i := (-2)^(Int:bitsize-1)


#--------------------------------------------------------------------


doc
  [These functions have been removed because you should use 'parse' or 'eparse' instead]


# function 'cast Int' s -> i
#   arg Str s ; arg Int i
#   i := 0 ; var CBool some := false
#   var Int start := 0
#   if s:len>0 and s:0="-"
#     start := 1
#   for (var Int u) start s:len-1
#     if s:u:number>="0":0:number and s:u:number<="9":0:number
#       i := 10*i + (s:u:number - "0":0:number) ; some := true
#     else
#       return undefined
#   if not some
#     return undefined
#   if start=1
#     i := -i


# function 'cast uInt' s -> ui
#   arg Str s ; arg uInt ui
#   ui := 0 ; var CBool some := false
#   for (var Int u) 0 s:len-1
#     if s:u:number>="0":0:number and s:u:number<="9":0:number
#       ui := 10*ui + (cast s:u:number - "0":0:number uInt) ; some := true
#     else
#       return 0
#   if not some
#     return 0


#--------------------------------------------------------------------


method data 'to string' options -> s
  arg uInt data ; arg Str options s
  if data<2^(uInt:bitsize-1)
    s := 'convert to string' (cast data Int)
  else
    s := ('convert to string' data\10)+('convert to string' data%10)
  # this method is redefined in int_extra.pli

method data 'from string' string options may_skip skiped offset -> status
  arg_w uInt data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  var Int stop := string:len-1
  if not may_skip and stop<>(-1)
    stop := 0
  for (var Int i) 0 stop
    var Int c0 := string:i number
    if c0>="0":0:number and c0<="9":0:number
      skiped := i
      data := 0
      while i<string:len and { var Int c := string:i number ; c>="0":0:number and c<="9":0:number }
        var uInt data2 := 10*data + (c - "0":0:number)
        if data2\(cast 10 uInt)<>data
          data := 0
          return failure
        data := data2
        i := i+1
      offset := i
      return success
  data := 0
  status := failure

method data 'to string' options -> s
  arg Int data ; arg Str options ; arg Str s
  s := 'convert to string' data
  # this method is redefined in int_extra.pli

method data 'from string' string options may_skip skiped offset -> status
  arg_w Int data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  var Int stop := string:len-1
  if not may_skip and stop<>(-1)
    stop := 0
  for (var Int i) 0 stop
    var Int c0 := string:i number
    if c0>="0":0:number and c0<="9":0:number
      skiped := i
      data := 0
      while i<string:len and { var Int c := string:i number ; c>="0":0:number and c<="9":0:number }
        var Int data2 := 10*data + (c - "0":0:number)
        if data2\(cast 10 Int)<>data
          data := undefined
          return failure
        data := data2
        i := i+1
      offset := i
      return success
    eif c0="-":0:number and i+1<>string:len and string:(i+1):number>="0":0:number and string:(i+1):number<="9":0:number
      skiped := i
      i := i+1
      data := 0
      while i<string:len and { var Int c := string:i number ; c>="0":0:number and c<="9":0:number }
        var Int data2 := 10*data + (c - "0":0:number)
        if data2\(cast 10 Int)<>data
          data := undefined
          return failure
        data := data2
        i := i+1
      data := -data
      offset := i
      return success
    eif c0="?":0:number
      data := undefined
      skiped := i
      offset := i+1
      return success
  data := undefined
  if string="" and options="db"
  if string="" and (options="db" or options="raw")
    status := success
  else
    status := failure


export 'cast Status' 'cast Int'


#--------------------------------------------------------------------


if processor_name="i386"

  function assemble_shift i gc fun
    arg_rw Instruction i ; arg_rw GeneratorContext gc ; arg Function fun
    var Pointer:Instruction cur :> i
    var Link:Argument r :> argument a_register
    var Link:Argument ecx :> gc register i386_ecx
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:0 r)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:1 ecx)
    cur :> gc insert_after_instruction cur (instruction fun r ecx)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) r i:2)
    gc remove i


  function i386_shl i ecx
    arg Int i ecx
  function i386_shl_generate_binary instr function
    arg Instruction instr ; arg_rw Function function
    check instr:1:where=argument_register and instr:1:register=i386_ecx
    i386_regmem function 0D3h 1 4h instr:0
  (the_function i386_shl Int Int) set_generate_binary (the_function i386_shl_generate_binary Instruction Function) 
  ((the_function i386_shl Int Int) arg 0) access := access_read+access_write+access_byvalue
        
  function shift_left a n -> r
    arg Int a n r ; gcc_nocheck_inline "$3 = $1 << $2;"
  function assemble_shift_left i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_shift i gc (the_function i386_shl Int Int)
  (the_function shift_left Int Int -> Int) set_generate_assembly (the_function assemble_shift_left Instruction GeneratorContext) 

 
  function i386_sar i ecx
    arg Int i ecx
  function i386_sar_generate_binary instr function
    arg Instruction instr ; arg_rw Function function
    check instr:1:where=argument_register and instr:1:register=i386_ecx
    i386_regmem function 0D3h 1 7h instr:0
  (the_function i386_sar Int Int) set_generate_binary (the_function i386_sar_generate_binary Instruction Function) 
  ((the_function i386_sar Int Int) arg 0) access := access_read+access_write+access_byvalue
        
  function shift_right a n -> r
    arg Int a n r ; gcc_nocheck_inline "$3 = $1 >> $2;"
  function assemble_shift_right2 i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_shift i gc (the_function i386_sar Int Int)
  (the_function shift_right Int Int -> Int) set_generate_assembly (the_function assemble_shift_right2 Instruction GeneratorContext) 


  function i386_shr i ecx
    arg Int i ecx
  function i386_shr_generate_binary instr function
    arg Instruction instr ; arg_rw Function function
    check instr:1:where=argument_register and instr:1:register=i386_ecx
    i386_regmem function 0D3h 1 5h instr:0
  (the_function i386_shr Int Int) set_generate_binary (the_function i386_shr_generate_binary Instruction Function) 
  ((the_function i386_shr Int Int) arg 0) access := access_read+access_write+access_byvalue
        
  function shift_right a n -> r
    arg uInt a r ; arg Int n ; gcc_nocheck_inline "$3 = (unsigned int)$1 >> $2;"
  function assemble_shift_right1 i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    assemble_shift i gc (the_function i386_shr Int Int)
  (the_function shift_right uInt Int -> uInt) set_generate_assembly (the_function assemble_shift_right1 Instruction GeneratorContext) 


function optimize_add gc
  arg_rw GeneratorContext gc
  var Link:Instruction i :> gc first_instruction
  while addressof:i<>null
    var Link:Instruction i2 :> null map Instruction
    var Pointer:Function f :> i function
    if pliant_debugging_level<2
      if f=(the_function '+' Int Int -> Int)
        i function :> the_function '.+.' Int Int -> Int
      if f=(the_function '+' uInt uInt -> uInt)
        i function :> the_function '.+.' uInt uInt -> uInt
      if f=(the_function '-' Int Int -> Int)
        i function :> the_function '.-.' Int Int -> Int
      if f=(the_function '-' uInt uInt -> uInt)
        i function :> the_function '.-.' uInt uInt -> uInt
      f :> i function
    if f=(the_function '.+.' Int Int -> Int) or f=(the_function '.+.' uInt uInt -> uInt) or f=(the_function '.-.' Int Int -> Int) or f=(the_function '.-.' uInt uInt -> uInt)
      for (var Int p) 0 1
        if i:p:where=argument_constant
          var uInt cst := i:p:constant map uInt
          if cst=0
            if f=(the_function '.+.' Int Int -> Int) or f=(the_function '.+.' uInt uInt -> uInt)
              i2 :> instruction (the_function 'copy atomic' Int Int) i:(1-p) i:2
            if f=(the_function '.-.' Int Int -> Int) or f=(the_function '.-.' uInt uInt -> uInt)
              if p=1
                i2 :> instruction (the_function 'copy atomic' Int Int) i:0 i:2
    if addressof:i2<>null
      gc insert_after_instruction i i2
      gc remove i
      i :> i2
    i :> i next_instruction

function optimize_shift i gc -> i2
  arg_rw Instruction i ; arg_rw GeneratorContext gc ; arg_C Instruction i2
  i2 :> null map Instruction
  var Pointer:Function f :> i function
  if f=(the_function '^' uInt Int -> uInt)
    if i:0:where=argument_constant and (i:0:constant map uInt)=2
      return (instruction (the_function shift_left Int Int -> Int) (argument constant uInt 1) i:1 i:2)
  if pliant_debugging_level<2
    if f=(the_function '*' Int Int -> Int)
      i function :> the_function '.*.' Int Int -> Int
    if f=(the_function '*' uInt uInt -> uInt)
      i function :> the_function '.*.' uInt uInt -> uInt
    f :> i function
  if f=(the_function '.*.' Int Int -> Int) or f=(the_function '.*.' uInt uInt -> uInt) or f=(the_function '\' Int Int -> Int) or f=(the_function '\' uInt uInt -> uInt) or f=(the_function '%' uInt uInt -> uInt)
    for (var Int p) 0 1
      if i:p:where=argument_constant
        var uInt cst := i:p:constant map uInt
        if cst=1
          if f=(the_function '.*.' Int Int -> Int) or f=(the_function '.*.' uInt uInt -> uInt)
            return (instruction (the_function 'copy atomic' Int Int) i:(1-p) i:2)
          if f=(the_function '\' Int Int -> Int) or f=(the_function '\' uInt uInt -> uInt)
            if p=1
              return (instruction (the_function 'copy atomic' Int Int) i:0  i:2)
        for (var Int b) 0 Int:bitsize-2
          if cst=2^b
            if f=(the_function '.*.' Int Int -> Int) or f=(the_function '.*.' uInt uInt -> uInt)
              return (instruction (the_function shift_left Int Int -> Int) i:(1-p) (argument constant Int b) i:2)
            eif f=(the_function '\' Int Int -> Int)
              if p=1
                return (instruction (the_function shift_right Int Int -> Int) i:0 (argument constant Int b) i:2)
            eif f=(the_function '\' uInt uInt -> uInt)
              if p=1
                return (instruction (the_function shift_right uInt Int -> uInt) i:0 (argument constant Int b) i:2)
            eif f=(the_function '%' uInt uInt -> uInt)
              if p=1
                return (instruction (the_function '.and.' Int Int -> Int) i:0 (argument constant Int 2^b-1) i:2)
  if f=(the_function '.*.' Int Int -> Int) or f=(the_function '.*.' uInt uInt -> uInt) or f=(the_function '\' Int Int -> Int) or f=(the_function '\' uInt uInt -> uInt) 
    var Pointer:Argument a :> i 1
    if a:first_instruction:function=(the_function shift_left Int Int -> Int) and a:last_instruction=i
      if a:is_temporary
        var Pointer:Argument c :> a:first_instruction:0
        if c:where=argument_constant and (c:constant map uInt)=1
          if (a:first_instruction:1 is_stable a:first_instruction i)
            var Link:Argument s :> a:first_instruction 1
            gc remove a:first_instruction
            if f=(the_function '.*.' Int Int -> Int) or f=(the_function '.*.' uInt uInt -> uInt)
              return (instruction (the_function shift_left Int Int -> Int) i:0 s i:2)
            eif f=(the_function '\' Int Int -> Int)
              return (instruction (the_function shift_right Int Int -> Int) i:0 s i:2)
            eif f=(the_function '\' uInt uInt -> uInt)
              return (instruction (the_function shift_right uInt Int -> uInt) i:0 s i:2)

function optimize_shift gc
  arg_rw GeneratorContext gc
  var Link:Instruction i :> gc first_instruction
  while addressof:i<>null
    var Link:Instruction i2 :> optimize_shift i gc
    if addressof:i2<>null
      gc insert_after_instruction i i2
      gc remove i
      i :> i2
    i :> i next_instruction

record_optimizer_function optimize_add "pliant optimizer rewrite instructions"
record_optimizer_function optimize_shift "pliant optimizer rewrite instructions"