!
! Fortran Unsigned Integers and common operations
!
!
!   Charles O'Neill May 6, 2009
!    charles.oneill@gmail.com
!    www.caselab.okstate.edu
!
!   Types:
!     UIone:  1 Byte Unsigned 
!     UIfour: 4 Byte Unsigned
!
!   Operations:
!     +, -, AND, OR, XOR, NOT, Print
!
!   Conversions:
!     Convert, UIoneConvert, UIfourConvert
!    
!
! Copyright (c) 2009 Charles O'Neill
!
! Permission is hereby granted, free of charge, to any person
! obtaining a copy of this software and associated documentation
! files (the "Software"), to deal in the Software without
! restriction, including without limitation the rights to use,
! copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the
! Software is furnished to do so, subject to the following
! conditions:
!
! The above copyright notice and this permission notice shall be
! included in all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
! OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
! NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
! HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
! WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
! FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
! OTHER DEALINGS IN THE SOFTWARE.

module UnsignedIntegers

  type UIone
    private
    integer(1) :: int
  end type

  type UIfour
    private
    integer(4) :: int
  end type

  integer,parameter :: Bit = 2
  integer,parameter :: BitsPerByte = 8
  integer,parameter :: UnsignedOneOffset = Bit**(BitsPerByte-1)
  integer,parameter :: UnsignedFourOffset = Bit**(4*BitsPerByte-1)
  integer,parameter :: TestBit = Bit**(4*BitsPerByte-1)

  interface assignment(=)
    module procedure UIone_AssignFromIntegerToUIone
    module procedure UIfour_AssignFromIntegerToUIfour

    module procedure UIone_AssignFromUIoneToInteger
    module procedure UIfour_AssignFromUIfourToInteger
  end interface

  interface operator(+)
    module procedure Add_UIone
    module procedure Add_UIfour
    module procedure Add_UIone_Integer
    module procedure Add_UIfour_Integer
  end interface

  interface operator(-)
    module procedure Subtract_UIone
    module procedure Subtract_UIfour
    module procedure Subtract_UIone_Integer
    module procedure Subtract_UIfour_Integer
  end interface


  interface printUI
    module procedure printUIone
    module procedure printUIfour
  end interface

  interface Convert
    module procedure UIone_ConvertToInteger
    module procedure UIfour_ConvertToInteger
  end interface

  interface UIoneConvert
    module procedure   UIone_ConvertFromInteger
  end interface

  interface UIfourConvert
    module procedure   UIfour_ConvertFromInteger
  end interface



  interface uiXOR
    module procedure XOR_UIone
    module procedure XOR_UIfour
  end interface

  interface uiAND
    module procedure AND_UIone
    module procedure AND_UIfour
  end interface

  interface uiOR
    module procedure OR_UIone
    module procedure OR_UIfour
  end interface

  interface uiNOT
    module procedure NOT_UIone
    module procedure NOT_UIfour
  end interface

  interface uiMOD
    module procedure MOD_UIone
    module procedure MOD_UIfour
  end interface

contains

  subroutine testUnsigned()
     type (UIone) :: a,b
!     type (UIfour) :: e,f

     write(*,*) " --------------- 1 Byte Unsigned --------------"
     a = 10
     b = 8
     write(*,*) "OFFSET = ", UnsignedOneOffset
     call printUI(a)
     call printUI(b)
     write(*,*) "XOR"
     call printUI(uiXOR(a,b))     
     write(*,*) "AND"
     call printUI(uiAND(a,b))    
     write(*,*) "OR"
     call printUI(uiOR(a,b))   
     write(*,*) "NOT"
     call printUI(uiNOT(a))   

     write(*,*) "Add"
     call printUI(a+1)   
     write(*,*) "Subtract"
     call printUI(a-1)   

     write(*,*) ",,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,<"
     write(*,*) "Add"
     a = 127
     b = 2
     call printUI(a)   
     call printUI(b)   
     call printUI(a+b)   

     call printUI(uiMOD(a,b))   

!     write(*,*) " --------------- 4 Byte Unsigned --------------"
!     e = 10
!     f = 8
!     write(*,*) "OFFSET = ", UnsignedFourOffset
!     call printUI(e)
!     call printUI(f)
!     write(*,*) "XOR"
!     call printUI(uiXOR(e,f))     
!     write(*,*) "AND"
!     call printUI(uiAND(e,f))    
!     write(*,*) "OR"
!     call printUI(uiOR(e,f))   
!     write(*,*) "NOT"
!     call printUI(uiNOT(e))   
!
!     write(*,*) "Add"
!     call printUI(e+1)   
!     write(*,*) "Subtract"
!     call printUI(e-1)   
!
!     write(*,'( B32.32 )') TestBit   
!     write(*,'( B32.32 )') UnsignedFourOffset   

  end subroutine


!==========================================================================
!  One Bit Unsigned
!==========================================================================
  subroutine printUIone(a)
     type (UIone) :: a
     write(*,*) " Unsigned Integer 1 bit"
     write(*,*) "     Stored as", a%int
     write(*,*) "     Represents", UIone_ConvertToInteger(a)
     write(*,'( A, B8.8 )') "      Bits ", UIone_ConvertToInteger(a)
  end subroutine

  function MOD_UIone(L,R)
    type (UIone) :: MOD_UIone
    type (UIone),intent(in) :: L,R
    MOD_UIone = UIone_ConvertFromInteger( &
                 MOD(UIone_ConvertToInteger(L), UIone_ConvertToInteger(R)))
  end function

  function AND_UIone(L,R)
    type (UIone) :: AND_UIone
    type (UIone),intent(in) :: L,R
    AND_UIone = UIone_ConvertFromInteger( &
                 IAND(UIone_ConvertToInteger(L), UIone_ConvertToInteger(R)))
  end function

  function XOR_UIone(L,R)
    type (UIone) :: XOR_UIone
    type (UIone),intent(in) :: L,R
    XOR_UIone = UIone_ConvertFromInteger( &
                 IEOR(UIone_ConvertToInteger(L), UIone_ConvertToInteger(R)))
  end function

  function OR_UIone(L,R)
    type (UIone) :: OR_UIone
    type (UIone),intent(in) :: L,R
    OR_UIone = UIone_ConvertFromInteger( &
                IOR(UIone_ConvertToInteger(L), UIone_ConvertToInteger(R)))
  end function

  function NOT_UIone(R)
    type (UIone) :: NOT_UIone
    type (UIone),intent(in) :: R
    NOT_UIone = UIone_ConvertFromInteger( &
                 NOT(UIone_ConvertToInteger(R)))
  end function

  function Add_UIone_Integer(L,R)
    type (UIone) :: Add_UIone_Integer
    type (UIone),intent(in) :: L
    integer,intent(in) :: R
    Add_UIone_Integer%int = L%int + R
  end function

  function Add_UIone(L,R)
    type (UIone) :: Add_UIone
    type (UIone),intent(in) :: L,R
    Add_UIone%int = L%int + R%int
  end function

  function Subtract_UIone(L,R)
    type (UIone) :: Subtract_UIone
    type (UIone),intent(in) :: L,R
    Subtract_UIone%int = L%int - R%int
  end function

  function Subtract_UIone_Integer(L,R)
    type (UIone) :: Subtract_UIone_Integer
    type (UIone),intent(in) :: L
    integer,intent(in) :: R
    Subtract_UIone_Integer%int = L%int - R
  end function

  elemental subroutine UIone_AssignFromIntegerToUIone(x,R)
    type (UIone),intent(out) :: x
    integer,intent(in) :: R
    x%int = R - UnsignedOneOffset
  end subroutine

  elemental subroutine UIone_AssignFromUIoneToInteger(x,R)
    type (UIone),intent(in) :: R
    integer,intent(out) :: x
    x= R%int + UnsignedOneOffset
  end subroutine

  elemental function UIone_ConvertToInteger(R)
    type (UIone),intent(in) :: R
    integer :: UIone_ConvertToInteger
    UIone_ConvertToInteger = R%int + UnsignedOneOffset
  end function 

  elemental function UIone_ConvertFromInteger(R)
    type (UIone) :: UIone_ConvertFromInteger
    integer,intent(in) :: R
    UIone_ConvertFromInteger%int = R - UnsignedOneOffset
  end function 

!==========================================================================
!  Four Bit Unsigned
!==========================================================================

  subroutine printUIfour(a)
     type (UIfour) :: a
     write(*,*) " Unsigned Integer 4 bit"
     write(*,*) "     Stored as", a%int
     write(*,*) "     Represents", UIfour_ConvertToInteger(a)
     write(*,'( A, B32.32 )') "      Bits ", UIfour_ConvertToInteger(a)
  end subroutine

  function MOD_UIfour(L,R)
    type (UIfour) :: MOD_UIfour
    type (UIfour),intent(in) :: L,R
    MOD_UIfour = UIfour_ConvertFromInteger( &
                 MOD(UIfour_ConvertToInteger(L), UIfour_ConvertToInteger(R)))
  end function

  function AND_UIfour(L,R)
    type (UIfour) :: AND_UIfour
    type (UIfour),intent(in) :: L,R
    AND_UIfour = UIfour_ConvertFromInteger( &
                 IAND(UIfour_ConvertToInteger(L), UIfour_ConvertToInteger(R)))
  end function

  function XOR_UIfour(L,R)
    type (UIfour) :: XOR_UIfour
    type (UIfour),intent(in) :: L,R
    XOR_UIfour = UIfour_ConvertFromInteger( &
                 IEOR(UIfour_ConvertToInteger(L), UIfour_ConvertToInteger(R)))
  end function

  function OR_UIfour(L,R)
    type (UIfour) :: OR_UIfour
    type (UIfour),intent(in) :: L,R
    OR_UIfour = UIfour_ConvertFromInteger( &
                IOR(UIfour_ConvertToInteger(L), UIfour_ConvertToInteger(R)))
  end function

  function NOT_UIfour(R)
    type (UIfour) :: NOT_UIfour
    type (UIfour),intent(in) :: R
    NOT_UIfour = UIfour_ConvertFromInteger( &
                 NOT(UIfour_ConvertToInteger(R)))
  end function

  function Add_UIfour(L,R)
    type (UIfour) :: Add_UIfour
    type (UIfour),intent(in) :: L,R
    Add_UIfour%int = L%int + R%int
  end function

  function Add_UIfour_Integer(L,R)
    type (UIfour) :: Add_UIfour_Integer
    type (UIfour),intent(in) :: L
    integer,intent(in) :: R
    Add_UIfour_Integer%int = L%int + R
  end function

  function Subtract_UIfour(L,R)
    type (UIfour) :: Subtract_UIfour
    type (UIfour),intent(in) :: L,R
    Subtract_UIfour%int = L%int - R%int
  end function

  function Subtract_UIfour_Integer(L,R)
    type (UIfour) :: Subtract_UIfour_Integer
    type (UIfour),intent(in) :: L
    integer,intent(in) :: R
    Subtract_UIfour_Integer%int = L%int - R
  end function

  elemental subroutine UIfour_AssignFromIntegerToUIfour(x,R)
    type (UIfour),intent(out) :: x
    integer,intent(in) :: R
    x%int = R - UnsignedFourOffset
  end subroutine

  elemental subroutine UIfour_AssignFromUIfourToInteger(x,R)
    type (UIfour),intent(in) :: R
    integer,intent(out) :: x
    x= R%int + UnsignedFourOffset
  end subroutine

  elemental function UIfour_ConvertToInteger(R)
    type (UIfour),intent(in) :: R
    integer :: UIfour_ConvertToInteger
    UIfour_ConvertToInteger = R%int + UnsignedFourOffset
  end function 

  elemental function UIfour_ConvertFromInteger(R)
    type (UIfour) :: UIfour_ConvertFromInteger
    integer,intent(in) :: R
    UIfour_ConvertFromInteger%int = R - UnsignedFourOffset
  end function 


end module