Moving Bits Question

Help
14

Well, if you have a big-endian machine, try out the code and adapt it as needed. At this point, it ain’t a discourse, damn it - it’s just do it!

Here, going by IBM’s write-up with

const int i = 1;
#define is_bigendian() ( (∗(char∗)&i) == 0 )

the following should work in Fortran:

   logical, parameter :: IS_BIG_ENDIAN = iachar( c=transfer(source=1,mold="a") ) == 0

So then the above bitbucket approach can likely be as follows instead:

! File p.f90
module bitbucket_m
   
   use, intrinsic :: iso_c_binding, only : I1 => c_int8_t, I4 => c_int32_t, I8 => c_int64_t, c_loc, &
      c_f_pointer
      
   private

   type, public :: bitbucket_t
   ! Field of 8-bit integers
      private
      integer(I1) :: m_fields(8) = 0_i1
   contains
      private
      procedure, pass(this) :: zap_fields
      procedure, pass(this), public :: int32 => get_int32
      procedure, pass(this), public :: int64 => get_int64
      generic, public :: zap => zap_fields
   end type bitbucket_t

   ! Ref: https://developer.ibm.com/articles/au-endianc/
   logical, parameter :: IS_BIG_ENDIAN = iachar( c=transfer(source=1,mold="a") ) == 0
   integer, parameter :: POS = merge( 3, 1, IS_BIG_ENDIAN )

contains

   subroutine zap_fields( this, idx )
      ! Argument list
      class(bitbucket_t), intent(inout) :: this
      integer, intent(in)               :: idx(:)
      ! Local variable
      if ( size(idx) > size(this%m_fields) ) error stop 
      if ( any(idx > size(this%m_fields)) ) error stop 
      this%m_fields( idx ) = 0_i1
      return
   end subroutine zap_fields
   
   function get_int32( this ) result(pval)
      ! Argument list
      class(bitbucket_t), intent(in), target :: this
      ! Function result
      integer(I4), pointer :: pval
      call c_f_pointer( cptr=c_loc(this%m_fields(POS)), fptr=pval )
      return
   end function get_int32
   
   function get_int64( this ) result(pval)
      ! Argument list
      class(bitbucket_t), intent(in), target :: this
      ! Function result
      integer(I8), pointer :: pval
      call c_f_pointer( cptr=c_loc(this%m_fields), fptr=pval )
      return
   end function get_int64
   
end module
   use, intrinsic :: iso_fortran_env, only : int32, int64
   block 
      integer(int32) :: i32
      integer(int64) :: i64
      print *, "Block 1: using copy assignment with a type conversion function"
      i32 = -123456
      i64 = bit32_to_64( i32 )
      print "(*(g0))", "i32  = ", i32
      print "(*(g0))", "i64  = ", i64
      print "(g0,32x,b0)", "i32 (bit pattern): ", i32
      print "(g0,b64)","i64 (bit pattern): ", i64
   end block
   print *
   block 
      use bitbucket_m, only : bitbucket_t
      type(bitbucket_t) :: bucket
      print *, "Block 2: using a custom type"
      bucket%int32() = -123456
      print "(*(g0))", "bucket%int32()  = ", bucket%int32()
      print "(*(g0))", "bucket%int64()  = ", bucket%int64()
      print "(g0,32x,b0)", "bucket%int32() (bit pattern): ", bucket%int32()
      print "(g0,b64)","bucket%int64() (bit pattern): ", bucket%int64()
   end block
contains
   ! copy an int32 to the first 32 bits of an int64
   elemental integer(int64) function bit32_to_64(i32) result(i64)
      integer(int32), intent(in) :: i32

      integer :: bit
     
      i64 = 0 
      do bit=0,31
          i64 = merge(ibset(i64,bit),ibclr(i64,bit),btest(i32,bit))
      end do
   end function
end

On a little-endian processor, the above yields:

C:\temp>p.exe
 Block 1: using copy assignment with a type conversion function
i32  = -123456
i64  = 4294843840
i32 (bit pattern):                                 11111111111111100001110111000000
i64 (bit pattern):                                 11111111111111100001110111000000

 Block 2: using a custom type
bucket%int32()  = -123456
bucket%int64()  = 4294843840
bucket%int32() (bit pattern):                                 11111111111111100001110111000000
bucket%int64() (bit pattern):                                 11111111111111100001110111000000

C:\temp>
1 Like