Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/type/number/int_sized.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"


function select_low_bytes adr big_type small_type -> part
  arg Address adr part ; arg Type big_type small_type
  if processor_is_low_indian
    part := adr
  eif processor_is_high_indian
    part := (adr translate big_type 1) translate small_tye -1
  else
    error error_id_runtime "processor "+processor_name+" is unknown indian"


function build_fixed_size_type name signed size
  arg Str name ; arg CBool signed ; arg Int size
  var Str ename := shunt signed "Int" "uInt"
  var Ident reduced_type := cast name Ident
  var Ident extended_type := cast ename Ident
  var Ident cast_extension := cast "cast "+ename Ident
  var Ident cast_reduction := cast "cast "+ename+('convert to string' size*8) Ident
  var Str ctype
  if size=1
    ctype := "char"
  eif size=2
    ctype := "short"
  else
    ctype := "int"
  if signed
    ctype := "signed "+ctype
  else
    ctype := "unsigned "+ctype
  runtime_compile reduced_type reduced_type  extended_type extended_type  signed signed  s size  cast_extension cast_extension  cast_reduction cast_reduction ctype ctype

    type reduced_type
      field Byte b1
      if s>=2
        field Byte b2
      if s>=4
        field Byte b3 b4
    
    function cast_extension i -> j
      arg reduced_type i ; arg extended_type j
      extension ; has_no_side_effect ; gcc_inline "$2 = *("+ctype+" *)@1;"
      if reduced_type:size=extended_type:size
        j := addressof:i map extended_type
      eif signed
        if ((addressof:i map extended_type) .and. 80h*100h^(reduced_type:size-1))=0
          j := 0
        else
          j := -1
        memory_copy addressof:i (select_low_bytes addressof:j extended_type reduced_type) reduced_type:size
      else
        j := 0
        memory_copy addressof:i (select_low_bytes addressof:j extended_type reduced_type) reduced_type:size

    function cast_reduction i -> j
      arg extended_type i ; arg reduced_type j      
      reduction ; has_no_side_effect ; gcc_nocheck_inline "*("+ctype+" *)@2 = $1;"
      if reduced_type:size<extended_type:size
        if signed
          check i>=-(256^s\2) and i<256^s\2 "The value is too large to fit in an "+reduced_type:name
        else
          check i<256^s "The value is too large to fit in an "+reduced_type:name
        memory_copy (select_low_bytes addressof:i extended_type reduced_type) addressof:j reduced_type:size
      else
        addressof:j map extended_type := i  

    # function compare i j -> c
    #   arg reduced_type i j ; arg Int c
    #   c := compare (cast i extended_type) (cast j extended_type)

    export reduced_type cast_extension cast_reduction # compare


build_fixed_size_type "Int8" true 1
build_fixed_size_type "Int16" true 2
build_fixed_size_type "Int32" true 4

build_fixed_size_type "uInt8" false 1
build_fixed_size_type "uInt16" false 2
build_fixed_size_type "uInt32" false 4
if Int:size=8
  build_fixed_size_type "Int64" true 8
  build_fixed_size_type "uInt64" false 8

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


if processor_name="i386" and pliant_debugging_level<2
  
  function generate_extend_Int8_assembly instr gc
    arg_rw Instruction instr ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> instr
    var Link:Argument arg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_movsx8 Int -> Int) instr:0 arg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
    gc remove instr
  (the_function 'cast Int' Int8 -> Int) set_generate_assembly (the_function generate_extend_Int8_assembly Instruction GeneratorContext)

  function generate_extend_Int16_assembly instr gc
    arg_rw Instruction instr ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> instr
    var Link:Argument arg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_movsx16 Int -> Int) instr:0 arg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
    gc remove instr
  (the_function 'cast Int' Int16 -> Int) set_generate_assembly (the_function generate_extend_Int16_assembly Instruction GeneratorContext)

  function generate_extend_uInt8_assembly instr gc
    arg_rw Instruction instr ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> instr
    var Link:Argument arg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_movzx8 Int -> Int) instr:0 arg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
    gc remove instr
  (the_function 'cast uInt' uInt8 -> uInt) set_generate_assembly (the_function generate_extend_uInt8_assembly Instruction GeneratorContext)

  function generate_extend_uInt16_assembly instr gc
    arg_rw Instruction instr ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> instr
    var Link:Argument arg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_movzx16 Int -> Int) instr:0 arg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
    gc remove instr
  (the_function 'cast uInt' uInt16 -> uInt) set_generate_assembly (the_function generate_extend_uInt16_assembly Instruction GeneratorContext)

  function generate_reduce_Int8_assembly instr gc
    arg_rw Instruction instr ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> instr
    var Link:Argument arg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) instr:0 arg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov8 Int -> Int) arg instr:1)
    gc remove instr
  (the_function 'cast Int8' Int -> Int8) set_generate_assembly (the_function generate_reduce_Int8_assembly Instruction GeneratorContext)
  (the_function 'cast uInt8' uInt -> uInt8) set_generate_assembly (the_function generate_reduce_Int8_assembly Instruction GeneratorContext)

  function generate_reduce_Int16_assembly instr gc
    arg_rw Instruction instr ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> instr
    var Link:Argument arg :> argument a_register
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) instr:0 arg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov16 Int -> Int) arg instr:1)
    gc remove instr
  (the_function 'cast Int16' Int -> Int16) set_generate_assembly (the_function generate_reduce_Int16_assembly Instruction GeneratorContext)
  (the_function 'cast uInt16' uInt -> uInt16) set_generate_assembly (the_function generate_reduce_Int16_assembly Instruction GeneratorContext)