Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Transfer
91 views
Skip to first unread message
Gary Scott
Aug 13, 2012, 10:03:56 PM8/13/12
to
I find a frequent need to byte swap when I transfer from little endian
to big endian destined output. It would be nice if transfer
automatically byte swapped (by selection). Does it already support this
byte swapping readily?
to big endian destined output. It would be nice if transfer
automatically byte swapped (by selection). Does it already support this
byte swapping readily?
glen herrmannsfeldt
Aug 13, 2012, 11:05:40 PM8/13/12
to
data while copying it.
Otherwise, with the appropriate ORDER it seems to me that
TRANSFER would byte swap data in an array of a one-byte type.
That might take a TRANSFER to a one byte type, TRANSFER to
do the byte swap, and TRANSFER again to the destination type.
Or call swab() with C interoperability.
Now, I believe that some C compilers will inline swab(), especially
on processors that have a byte swap instruction. For a large
enough data structure, though, the function call overhead
shouldn't be so big.
-- glen
Dick Hendrickson
Aug 13, 2012, 11:09:45 PM8/13/12
to
this deep into the hardware. But, how about something like
char_array(whatever:1:-1) = transfer(thing, "x", whatever)
backwards_thing = transfer(char_array(1:whatever), thing, whatever)
I'm not sure what you need for the size arguments.
With a little work you can convert this into a one line expression by
nesting the transfers and then it's easy to convert it into either a
statement function or external function.
Not particularly elegant, but if you're doing I/O a few memory moves
aren't a real cost.
Dick Hendrickson
Louisa
Aug 13, 2012, 11:48:17 PM8/13/12
to
it's easy to do with a few shifts and logical ands.
If reals, EQUIVALENCE to integer(s) and do as above.
Richard Maine
Aug 14, 2012, 2:18:57 AM8/14/12
to
and in at least one case on their type. Transfer pretty much ignore type
- that's its whole point.
--
Richard Maine
email: last name at domain . net
domain: summer-triangle
Tobias Burnus
Aug 14, 2012, 2:19:26 AM8/14/12
to
endianness of the I/O via environment variables, command-line arguments
and via a call to an intrinsic or withing an extra argument in the OPEN
or WRITE/READ statement.
Contrary to the transfer suggestions, it is compiler dependent, but it
might be faster and easier – at least if you mostly use a single compiler.
Tobias
Richard Maine
Aug 14, 2012, 8:40:38 AM8/14/12
to
the variable at the time of the I/O. Otherwise, they won't know what
particular byte swapping to apply. For example, if 4 bytes are to be
treated as a single 4-byte integer, the swapping required is different
from if it is two 2-byte integers; and, of course, if it is 4 1-byte
integers, there is no swapping at all.
In some apps, you essentially read a block full of bytes. The particular
data types are not known at the time you read the block, but are
determined dynamically by embedded data within the block. To trivially
illustrate, each data item could be preceded by a 1-byte field to
indicate the type and kind of the data that follows it. The actual data
formats I deal with aren't quite like that, but that's a simple way to
explain the basic problem. There just is no way for the compiler to
automatically deal with structures like that. You have to parse the data
in the block and do any needed swapping yourself. Not that such swapping
is particularly hard to do yourself, assuming that you write the app to
accomodate such things in the first place. Retrofitting to an app that
previously ignored the matter can certainly be harder.
Gary Scott
Aug 14, 2012, 9:20:55 AM8/14/12
to
thing, was just thinking that the need for such a thing in system
programming, and in many areas of data processing and sharing across
systems, that adding an option to transfer might be useful.
Gary Scott
Aug 14, 2012, 9:22:41 AM8/14/12
to
>
> Tobias
the immediate target is internal write to character. It will eventually
be stored on disk, but part of a structure.
Thomas Jahns
Aug 14, 2012, 12:39:05 PM8/14/12
to
On 08/14/2012 05:05 AM, glen herrmannsfeldt wrote:
> Some C systems have a swab() function, which will byte-swap
> data while copying it.
swab only handles 2 byte quantities. If you want to do this both fast and
> Some C systems have a swab() function, which will byte-swap
> data while copying it.
portably, it's probably better to look at what some portability library like
libSDL does.
> Otherwise, with the appropriate ORDER it seems to me that
> TRANSFER would byte swap data in an array of a one-byte type.
>
> That might take a TRANSFER to a one byte type, TRANSFER to
> do the byte swap, and TRANSFER again to the destination type.
that are likely to make a copy of their arguments. Let's hope the OP is
not sensitive to low performance.
> Or call swab() with C interoperability.
>
> Now, I believe that some C compilers will inline swab(), especially
> on processors that have a byte swap instruction. For a large
> enough data structure, though, the function call overhead
> shouldn't be so big.
to address the general case.
Regards, Thomas
garyl...@sbcglobal.net
Aug 14, 2012, 12:55:51 PM8/14/12
to
On Tuesday, August 14, 2012 11:39:05 AM UTC-5, Thomas Jahns wrote:
> On 08/14/2012 05:05 AM, glen herrmannsfeldt wrote: > Some C systems have a swab() function, which will byte-swap > data while copying it. swab only handles 2 byte quantities. If you want to do this both fast and portably, it's probably better to look at what some portability library like libSDL does. > Otherwise, with the appropriate ORDER it seems to me that > TRANSFER would byte swap data in an array of a one-byte type. > > That might take a TRANSFER to a one byte type, TRANSFER to > do the byte swap, and TRANSFER again to the destination type. ORDER is an argument to RESHAPE, so this would already chain two intrinsics that are likely to make a copy of their arguments. Let's hope the OP is not sensitive to low performance. > Or call swab() with C interoperability. > > Now, I believe that some C compilers will inline swab(), especially > on processors that have a byte swap instruction. For a large > enough data structure, though, the function call overhead > shouldn't be so big. It's probably faster to have one's own output conversion function than to address the general case. Regards, Thomas
I am indeed very sensitive to performance. That's why I spent considerable time getting the UUID conversion from binary to character down from 64us per to 7us per conversion (16 bytes to formatted 38 bytes). And the conversion from MS GUIDStruct to big endian 16 bytes from 650ns to 328ns. Mostly i eliminated use of transfer and fell back to equivalence :(. It just was taking too long for the conversion. A major improvement also was gained by a more sophisticated internal write (with implied do) and eliminating external looping.
> On 08/14/2012 05:05 AM, glen herrmannsfeldt wrote: > Some C systems have a swab() function, which will byte-swap > data while copying it. swab only handles 2 byte quantities. If you want to do this both fast and portably, it's probably better to look at what some portability library like libSDL does. > Otherwise, with the appropriate ORDER it seems to me that > TRANSFER would byte swap data in an array of a one-byte type. > > That might take a TRANSFER to a one byte type, TRANSFER to > do the byte swap, and TRANSFER again to the destination type. ORDER is an argument to RESHAPE, so this would already chain two intrinsics that are likely to make a copy of their arguments. Let's hope the OP is not sensitive to low performance. > Or call swab() with C interoperability. > > Now, I believe that some C compilers will inline swab(), especially > on processors that have a byte swap instruction. For a large > enough data structure, though, the function call overhead > shouldn't be so big. It's probably faster to have one's own output conversion function than to address the general case. Regards, Thomas
Richard Maine
Aug 15, 2012, 2:47:43 AM8/15/12
to
TRANSFER is just the wrong place to start. The whole concept of TRANSFER
is to move bits without regard to type or kind. As I noted elsewhere,
byte swapping is closely tied to type and kind. Doesn't fit well.
\"Vladimír Fuka <"name.surnameat
Aug 15, 2012, 5:07:52 AM8/15/12
to
I use something like this. Do you recommend something other?
Vladimir
elemental function BigEnd32(x) result(res)
real(real32) :: res
real(real32),intent(in)::x
integer(selected_int_kind(1)),dimension(4):: bytes !may not work on
some processors
if (.not.littleendian) then
res = x
else
bytes = transfer(x,bytes,4)
res = transfer(bytes(4:1:-1),x)
endif
end function BigEnd32
Dne Wed, 15 Aug 2012 08:47:43 +0200 Richard Maine <nos...@see.signature>
napsal(a):
> Gary Scott <garyl...@sbcglobal.net> wrote:
>
>> I have my own byteswap procedure for integers. It isn't a difficult
>> thing, was just thinking that the need for such a thing in system
>> programming, and in many areas of data processing and sharing across
>> systems, that adding an option to transfer might be useful.
>
> While I could see having some kind of intrinsic for the purpose,
> TRANSFER is just the wrong place to start. The whole concept of TRANSFER
> is to move bits without regard to type or kind. As I noted elsewhere,
> byte swapping is closely tied to type and kind. Doesn't fit well.
>
--
Tato zpráva byla vytvořena převratným poštovním klientem Opery:
http://www.opera.com/mail/
Vladimir
elemental function BigEnd32(x) result(res)
real(real32) :: res
real(real32),intent(in)::x
integer(selected_int_kind(1)),dimension(4):: bytes !may not work on
some processors
if (.not.littleendian) then
res = x
else
bytes = transfer(x,bytes,4)
res = transfer(bytes(4:1:-1),x)
endif
end function BigEnd32
Dne Wed, 15 Aug 2012 08:47:43 +0200 Richard Maine <nos...@see.signature>
napsal(a):
> Gary Scott <garyl...@sbcglobal.net> wrote:
>
>> I have my own byteswap procedure for integers. It isn't a difficult
>> thing, was just thinking that the need for such a thing in system
>> programming, and in many areas of data processing and sharing across
>> systems, that adding an option to transfer might be useful.
>
> While I could see having some kind of intrinsic for the purpose,
> TRANSFER is just the wrong place to start. The whole concept of TRANSFER
> is to move bits without regard to type or kind. As I noted elsewhere,
> byte swapping is closely tied to type and kind. Doesn't fit well.
>
--
http://www.opera.com/mail/
Richard Maine
Aug 15, 2012, 11:01:57 AM8/15/12
to
[Confusing (to me) top-posting reordered]
> Dne Wed, 15 Aug 2012 08:47:43 +0200 Richard Maine <nos...@see.signature>
> napsal(a):
>
That's ok. (I didn't carefully check it - just skimmed for the idea,
which seems fine). You are using TRANSFER, but you aren't asking
TRANSFER to be aware of the byte swapping needed for the type. You are
providing that information in your own code. I see nothing obviously
wrong in your code. I might suspect that its performance would be less
than could be obtained by other coding, but the only way to know that
for sure is to test. You also might not particularly care about the
performance.
I had some apps where performance of the byte swapping was important
enough to be worth some attention, so I spent a bit of time fiddling
with it. But that was quite a while ago - about 2 decades now. Compilers
might have done a lot since then.
> Dne Wed, 15 Aug 2012 08:47:43 +0200 Richard Maine <nos...@see.signature>
> napsal(a):
>
> > While I could see having some kind of intrinsic for the purpose,
> > TRANSFER is just the wrong place to start. The whole concept of TRANSFER
> > is to move bits without regard to type or kind. As I noted elsewhere,
> > byte swapping is closely tied to type and kind. Doesn't fit well.
> > TRANSFER is just the wrong place to start. The whole concept of TRANSFER
> > is to move bits without regard to type or kind. As I noted elsewhere,
> > byte swapping is closely tied to type and kind. Doesn't fit well.
\"Vladim�r Fuka <\"name.surname at <mffDOTcuniDOTcz"> wrote:
> I use something like this. Do you recommend something other?
[user subroutine using TRANSFER elided]
> I use something like this. Do you recommend something other?
That's ok. (I didn't carefully check it - just skimmed for the idea,
which seems fine). You are using TRANSFER, but you aren't asking
TRANSFER to be aware of the byte swapping needed for the type. You are
providing that information in your own code. I see nothing obviously
wrong in your code. I might suspect that its performance would be less
than could be obtained by other coding, but the only way to know that
for sure is to test. You also might not particularly care about the
performance.
I had some apps where performance of the byte swapping was important
enough to be worth some attention, so I spent a bit of time fiddling
with it. But that was quite a while ago - about 2 decades now. Compilers
might have done a lot since then.
Louisa
Aug 15, 2012, 8:42:10 PM8/15/12
to
On Aug 15, 7:07 pm, \"Vladimír Fuka <\"name.surname at
something like the following will be more portable than the above
code, for integer kinds. Capable of extension to real.
! Swap order: bytes of k are the reverse of those of i
k = 0
do j = 1, bit_size(k)/8
k = ishft(k, 8) + iand(i, 255)
i = ishft(i, -8)
end do
<mffDOTcuniDOTcz">> wrote:
> I use something like this. Do you recommend something other?
>
> Vladimir
>
> elemental function BigEnd32(x) result(res)
> real(real32) :: res
> real(real32),intent(in)::x
> integer(selected_int_kind(1)),dimension(4):: bytes !may not work on
> some processors
>
> if (.not.littleendian) then
> res = x
> else
> bytes = transfer(x,bytes,4)
> res = transfer(bytes(4:1:-1),x)
> endif
> end function BigEnd32
As I suggested before, using some bit functions will do it.
> I use something like this. Do you recommend something other?
>
> Vladimir
>
> elemental function BigEnd32(x) result(res)
> real(real32) :: res
> real(real32),intent(in)::x
> integer(selected_int_kind(1)),dimension(4):: bytes !may not work on
> some processors
>
> if (.not.littleendian) then
> res = x
> else
> bytes = transfer(x,bytes,4)
> res = transfer(bytes(4:1:-1),x)
> endif
> end function BigEnd32
something like the following will be more portable than the above
code, for integer kinds. Capable of extension to real.
! Swap order: bytes of k are the reverse of those of i
k = 0
do j = 1, bit_size(k)/8
k = ishft(k, 8) + iand(i, 255)
i = ishft(i, -8)
end do
James Van Buskirk
Aug 16, 2012, 3:58:41 PM8/16/12
to
"Tobias Burnus" <bur...@net-b.de> wrote in message
news:5029EDEE...@net-b.de...
I was looking at
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40210
And it seemed to me that either
C:\gfortran\clf\bswap>type bswap.f90
module builtins
use ISO_C_BINDING
implicit none
private
public bswap, bswap16, bswap32, bswap64, bswap128
interface bswap
function bswap32(x) bind(C,name='__builtin_bswap32')
import
implicit none
integer(C_INT32_T) bswap32
integer(C_INT32_T), value :: x
end function bswap32
function bswap64(x) bind(C,name='__builtin_bswap64')
import
implicit none
integer(C_INT64_T) bswap64
integer(C_INT64_T), value :: x
end function bswap64
module procedure bswap16, bswap128
end interface bswap
contains
function bswap16(x)
integer(C_INT16_T) bswap16
integer(C_INT16_T), value :: x
bswap16 = ishftc(x,8)
end function bswap16
function bswap128(x)
integer(C_INT128_T) bswap128
integer(C_INT128_T), value :: x
bswap128 = ior( &
ishft(int(bswap64(int(x,C_INT64_T)),C_INT128_T),64), &
int(bswap64(int(ishft(x,-64),C_INT64_T)),C_INT128_T))
end function bswap128
end module builtins
module testmod
contains
function test16(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT16_T) test16
integer(C_INT16_T), value :: x
test16 = bswap(x)
end function test16
function test32(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT32_T) test32
integer(C_INT32_T), value :: x
test32 = bswap(x)
end function test32
function test64(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT64_T) test64
integer(C_INT64_T), value :: x
test64 = bswap(x)
end function test64
function test128(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT128_T) test128
integer(C_INT128_T), value :: x
test128 = bswap(x)
end function test128
end module testmod
program test
use ISO_C_BINDING
use testmod
implicit none
integer(C_INT16_T) :: x16 = 1
integer(C_INT32_T) :: x32 = 1
integer(C_INT64_T) :: x64 = 1
integer(C_INT128_T) :: x128 = 1
write(*,*) test16(x16)+test32(x32)+test64(x64)+test128(x128)
end program test
C:\gfortran\clf\bswap>gfortran bswap.f90 -obswap
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x1d):
undefined
reference to `__builtin_bswap64'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x44):
undefined
reference to `__builtin_bswap64'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x105):
undefined
reference to `__builtin_bswap64'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x126):
undefined
reference to `__builtin_bswap32'
c:/gcc_equation/bin/../lib/gcc/x86_64-w64-mingw32/4.8.0/../../../../x86_64-w64-m
ingw32/bin/ld.exe: C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o: bad reloc
addr
ess 0x0 in section `.pdata'
c:/gcc_equation/bin/../lib/gcc/x86_64-w64-mingw32/4.8.0/../../../../x86_64-w64-m
ingw32/bin/ld.exe: final link failed: Invalid operation
collect2.exe: error: ld returned 1 exit status
or
C:\gfortran\clf\bswap>type bswap2.f90
module test
use ISO_C_BINDING
implicit none
contains
function bswap32(x) bind(C,name='bswap32')
integer(C_INT32_T) bswap32
integer(C_INT32_T), value :: x
bswap32 = ior(ior(ior( &
ishft(iand(x,int(Z'000000FF',C_INT32_T)),24), &
ishft(iand(x,int(Z'0000FF00',C_INT32_T)),8)), &
ishft(iand(x,int(Z'00FF0000',C_INT32_T)),-8)), &
ishft(iand(x,int(Z'FF000000',C_INT32_T)),-24))
end function bswap32
function bswap64(x) bind(C,name='bswap64')
integer(C_INT64_T) bswap64
integer(C_INT64_T), value :: x
bswap64 = ior(ior(ior(ior(ior(ior(ior( &
ishft(iand(x,int(Z'00000000000000FF',C_INT64_T)),56), &
ishft(iand(x,int(Z'000000000000FF00',C_INT64_T)),40)), &
ishft(iand(x,int(Z'0000000000FF0000',C_INT64_T)),24)), &
ishft(iand(x,int(Z'00000000FF000000',C_INT64_T)),8)), &
ishft(iand(x,int(Z'000000FF00000000',C_INT64_T)),-8)), &
ishft(iand(x,int(Z'0000FF0000000000',C_INT64_T)),-24)), &
ishft(iand(x,int(Z'00FF000000000000',C_INT64_T)),-40)), &
ishft(iand(x,int(Z'FF00000000000000',C_INT64_T)),-56))
end function bswap64
end module test
program main
use test
implicit none
integer(C_INT32_T) :: x32 = 1
integer(C_INT64_T) :: x64 = 1
write(*,*) bswap32(x32)+bswap64(x64)
end program main
C:\gfortran\clf\bswap>gfortran -fno-range-check -O3 -mtune=native -march=native
-fomit-frame-pointer bswap2.f90 -S
C:\gfortran\clf\bswap>type bswap2.s
.file "bswap2.f90"
.text
.p2align 4,,15
.globl bswap64
.def bswap64; .scl 2; .type 32; .endef
.seh_proc bswap64
bswap64:
.seh_endprologue
movq %rcx, %rax
movq %rcx, %rdx
andl $65280, %eax
salq $56, %rdx
salq $40, %rax
orq %rdx, %rax
movq %rcx, %rdx
andl $16711680, %edx
salq $24, %rdx
orq %rdx, %rax
movq %rcx, %rdx
andl $4278190080, %edx
salq $8, %rdx
orq %rdx, %rax
movq %rcx, %rdx
shrq $8, %rdx
andl $4278190080, %edx
orq %rdx, %rax
movq %rcx, %rdx
shrq $24, %rdx
andl $16711680, %edx
orq %rdx, %rax
movq %rcx, %rdx
shrq $56, %rcx
shrq $40, %rdx
andl $65280, %edx
orq %rdx, %rax
orq %rcx, %rax
ret
.seh_endproc
.section .rdata,"dr"
.LC0:
.ascii "bswap2.f90\0"
.text
.p2align 4,,15
.def MAIN__; .scl 3; .type 32; .endef
.seh_proc MAIN__
MAIN__:
subq $536, %rsp
.seh_stackalloc 536
.seh_endprologue
leaq .LC0(%rip), %rax
leaq 48(%rsp), %rcx
movq %rax, 56(%rsp)
movl $35, 64(%rsp)
movl $128, 48(%rsp)
movl $6, 52(%rsp)
call _gfortran_st_write
movl $1, %ecx
call bswap64
leaq 40(%rsp), %rdx
movl $8, %r8d
leaq 48(%rsp), %rcx
addq $16777216, %rax
movq %rax, 40(%rsp)
call _gfortran_transfer_integer_write
leaq 48(%rsp), %rcx
call _gfortran_st_write_done
nop
addq $536, %rsp
ret
.seh_endproc
.p2align 4,,15
.globl bswap32
.def bswap32; .scl 2; .type 32; .endef
.seh_proc bswap32
bswap32:
.seh_endprologue
movl %ecx, %eax
movl %ecx, %edx
andl $65280, %eax
sall $24, %edx
sall $8, %eax
orl %edx, %eax
movl %ecx, %edx
shrl $24, %ecx
andl $16711680, %edx
shrl $8, %edx
orl %edx, %eax
orl %ecx, %eax
ret
.seh_endproc
.def __main; .scl 2; .type 32; .endef
.section .text.startup,"x"
.p2align 4,,15
.globl main
.def main; .scl 2; .type 32; .endef
.seh_proc main
main:
pushq %rsi
.seh_pushreg %rsi
pushq %rbx
.seh_pushreg %rbx
subq $40, %rsp
.seh_stackalloc 40
.seh_endprologue
movl %ecx, %ebx
movq %rdx, %rsi
call __main
movq %rsi, %rdx
movl %ebx, %ecx
call _gfortran_set_args
leaq options.1.1878(%rip), %rdx
movl $7, %ecx
call _gfortran_set_options
call MAIN__
xorl %eax, %eax
addq $40, %rsp
popq %rbx
popq %rsi
ret
.seh_endproc
.section .rdata,"dr"
.align 16
options.1.1878:
.long 68
.long 1023
.long 0
.long 0
.long 1
.long 1
.long 0
.def _gfortran_st_write; .scl 2; .type 32;
.endef
.def _gfortran_transfer_integer_write; .scl 2;
.type
32; .endef
.def _gfortran_st_write_done; .scl 2; .type 32;
.endef
.def _gfortran_set_args; .scl 2; .type 32;
.endef
.def _gfortran_set_options; .scl 2; .type 32;
.endef
should work, but neither did, the first because gfortran couldn't
figure out __builtin_bswap* and the second because gfortran wasn't
as alert as gcc at determining when to use a bswap instruction.
Can you get either or both of these examples to work in gfortran?
--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end
news:5029EDEE...@net-b.de...
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40210
And it seemed to me that either
C:\gfortran\clf\bswap>type bswap.f90
module builtins
use ISO_C_BINDING
implicit none
private
public bswap, bswap16, bswap32, bswap64, bswap128
interface bswap
function bswap32(x) bind(C,name='__builtin_bswap32')
import
implicit none
integer(C_INT32_T) bswap32
integer(C_INT32_T), value :: x
end function bswap32
function bswap64(x) bind(C,name='__builtin_bswap64')
import
implicit none
integer(C_INT64_T) bswap64
integer(C_INT64_T), value :: x
end function bswap64
module procedure bswap16, bswap128
end interface bswap
contains
function bswap16(x)
integer(C_INT16_T) bswap16
integer(C_INT16_T), value :: x
bswap16 = ishftc(x,8)
end function bswap16
function bswap128(x)
integer(C_INT128_T) bswap128
integer(C_INT128_T), value :: x
bswap128 = ior( &
ishft(int(bswap64(int(x,C_INT64_T)),C_INT128_T),64), &
int(bswap64(int(ishft(x,-64),C_INT64_T)),C_INT128_T))
end function bswap128
end module builtins
module testmod
contains
function test16(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT16_T) test16
integer(C_INT16_T), value :: x
test16 = bswap(x)
end function test16
function test32(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT32_T) test32
integer(C_INT32_T), value :: x
test32 = bswap(x)
end function test32
function test64(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT64_T) test64
integer(C_INT64_T), value :: x
test64 = bswap(x)
end function test64
function test128(x)
use builtins
use ISO_C_BINDING
implicit none
integer(C_INT128_T) test128
integer(C_INT128_T), value :: x
test128 = bswap(x)
end function test128
end module testmod
program test
use ISO_C_BINDING
use testmod
implicit none
integer(C_INT16_T) :: x16 = 1
integer(C_INT32_T) :: x32 = 1
integer(C_INT64_T) :: x64 = 1
integer(C_INT128_T) :: x128 = 1
write(*,*) test16(x16)+test32(x32)+test64(x64)+test128(x128)
end program test
C:\gfortran\clf\bswap>gfortran bswap.f90 -obswap
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x1d):
undefined
reference to `__builtin_bswap64'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x44):
undefined
reference to `__builtin_bswap64'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x105):
undefined
reference to `__builtin_bswap64'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o:bswap.f90:(.text+0x126):
undefined
reference to `__builtin_bswap32'
c:/gcc_equation/bin/../lib/gcc/x86_64-w64-mingw32/4.8.0/../../../../x86_64-w64-m
ingw32/bin/ld.exe: C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\ccAbEXSA.o: bad reloc
addr
ess 0x0 in section `.pdata'
c:/gcc_equation/bin/../lib/gcc/x86_64-w64-mingw32/4.8.0/../../../../x86_64-w64-m
ingw32/bin/ld.exe: final link failed: Invalid operation
collect2.exe: error: ld returned 1 exit status
or
C:\gfortran\clf\bswap>type bswap2.f90
module test
use ISO_C_BINDING
implicit none
contains
function bswap32(x) bind(C,name='bswap32')
integer(C_INT32_T) bswap32
integer(C_INT32_T), value :: x
bswap32 = ior(ior(ior( &
ishft(iand(x,int(Z'000000FF',C_INT32_T)),24), &
ishft(iand(x,int(Z'0000FF00',C_INT32_T)),8)), &
ishft(iand(x,int(Z'00FF0000',C_INT32_T)),-8)), &
ishft(iand(x,int(Z'FF000000',C_INT32_T)),-24))
end function bswap32
function bswap64(x) bind(C,name='bswap64')
integer(C_INT64_T) bswap64
integer(C_INT64_T), value :: x
bswap64 = ior(ior(ior(ior(ior(ior(ior( &
ishft(iand(x,int(Z'00000000000000FF',C_INT64_T)),56), &
ishft(iand(x,int(Z'000000000000FF00',C_INT64_T)),40)), &
ishft(iand(x,int(Z'0000000000FF0000',C_INT64_T)),24)), &
ishft(iand(x,int(Z'00000000FF000000',C_INT64_T)),8)), &
ishft(iand(x,int(Z'000000FF00000000',C_INT64_T)),-8)), &
ishft(iand(x,int(Z'0000FF0000000000',C_INT64_T)),-24)), &
ishft(iand(x,int(Z'00FF000000000000',C_INT64_T)),-40)), &
ishft(iand(x,int(Z'FF00000000000000',C_INT64_T)),-56))
end function bswap64
end module test
program main
use test
implicit none
integer(C_INT32_T) :: x32 = 1
integer(C_INT64_T) :: x64 = 1
write(*,*) bswap32(x32)+bswap64(x64)
end program main
C:\gfortran\clf\bswap>gfortran -fno-range-check -O3 -mtune=native -march=native
-fomit-frame-pointer bswap2.f90 -S
C:\gfortran\clf\bswap>type bswap2.s
.file "bswap2.f90"
.text
.p2align 4,,15
.globl bswap64
.def bswap64; .scl 2; .type 32; .endef
.seh_proc bswap64
bswap64:
.seh_endprologue
movq %rcx, %rax
movq %rcx, %rdx
andl $65280, %eax
salq $56, %rdx
salq $40, %rax
orq %rdx, %rax
movq %rcx, %rdx
andl $16711680, %edx
salq $24, %rdx
orq %rdx, %rax
movq %rcx, %rdx
andl $4278190080, %edx
salq $8, %rdx
orq %rdx, %rax
movq %rcx, %rdx
shrq $8, %rdx
andl $4278190080, %edx
orq %rdx, %rax
movq %rcx, %rdx
shrq $24, %rdx
andl $16711680, %edx
orq %rdx, %rax
movq %rcx, %rdx
shrq $56, %rcx
shrq $40, %rdx
andl $65280, %edx
orq %rdx, %rax
orq %rcx, %rax
ret
.seh_endproc
.section .rdata,"dr"
.LC0:
.ascii "bswap2.f90\0"
.text
.p2align 4,,15
.def MAIN__; .scl 3; .type 32; .endef
.seh_proc MAIN__
MAIN__:
subq $536, %rsp
.seh_stackalloc 536
.seh_endprologue
leaq .LC0(%rip), %rax
leaq 48(%rsp), %rcx
movq %rax, 56(%rsp)
movl $35, 64(%rsp)
movl $128, 48(%rsp)
movl $6, 52(%rsp)
call _gfortran_st_write
movl $1, %ecx
call bswap64
leaq 40(%rsp), %rdx
movl $8, %r8d
leaq 48(%rsp), %rcx
addq $16777216, %rax
movq %rax, 40(%rsp)
call _gfortran_transfer_integer_write
leaq 48(%rsp), %rcx
call _gfortran_st_write_done
nop
addq $536, %rsp
ret
.seh_endproc
.p2align 4,,15
.globl bswap32
.def bswap32; .scl 2; .type 32; .endef
.seh_proc bswap32
bswap32:
.seh_endprologue
movl %ecx, %eax
movl %ecx, %edx
andl $65280, %eax
sall $24, %edx
sall $8, %eax
orl %edx, %eax
movl %ecx, %edx
shrl $24, %ecx
andl $16711680, %edx
shrl $8, %edx
orl %edx, %eax
orl %ecx, %eax
ret
.seh_endproc
.def __main; .scl 2; .type 32; .endef
.section .text.startup,"x"
.p2align 4,,15
.globl main
.def main; .scl 2; .type 32; .endef
.seh_proc main
main:
pushq %rsi
.seh_pushreg %rsi
pushq %rbx
.seh_pushreg %rbx
subq $40, %rsp
.seh_stackalloc 40
.seh_endprologue
movl %ecx, %ebx
movq %rdx, %rsi
call __main
movq %rsi, %rdx
movl %ebx, %ecx
call _gfortran_set_args
leaq options.1.1878(%rip), %rdx
movl $7, %ecx
call _gfortran_set_options
call MAIN__
xorl %eax, %eax
addq $40, %rsp
popq %rbx
popq %rsi
ret
.seh_endproc
.section .rdata,"dr"
.align 16
options.1.1878:
.long 68
.long 1023
.long 0
.long 0
.long 1
.long 1
.long 0
.def _gfortran_st_write; .scl 2; .type 32;
.endef
.def _gfortran_transfer_integer_write; .scl 2;
.type
32; .endef
.def _gfortran_st_write_done; .scl 2; .type 32;
.endef
.def _gfortran_set_args; .scl 2; .type 32;
.endef
.def _gfortran_set_options; .scl 2; .type 32;
.endef
should work, but neither did, the first because gfortran couldn't
figure out __builtin_bswap* and the second because gfortran wasn't
as alert as gcc at determining when to use a bswap instruction.
Can you get either or both of these examples to work in gfortran?
--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end
Steven G. Kargl
Aug 16, 2012, 7:48:38 PM8/16/12
to
used here. This is a reserved identifier within the C implementation.
(See 7.1.3 in n1256.pdf). It does not need to actually exist outside
of the C implementation. (See note 163, p 167 in n1256.pdf, which
clearly states that a C implementation can generate in-line code
for such an identifier).
--
steve
James Van Buskirk
Aug 16, 2012, 8:48:10 PM8/16/12
to
"Steven G. Kargl" <s...@REMOVEtroutmask.apl.washington.edu> wrote in message
news:k0k0sm$stq$1...@dont-email.me...
Not infrequently equivalent gfortran and gcc code seem to produce
identical machine-language output. I assumed that the C side of
things saw that function call and converted it into inline code
at some point. If the conversion happened late enough in the
code generation process I figured it had a good chance to work
for gfortran since it shares the same back-end. I have definitely
used some of these builtins in gfortran before to fill in for
intrinsics which were missing at the time, but these were
complicated enough functions that they weren't inlined by gcc.
Of course you can always use gfortran to force bswap, but the
result isn't inlined like the compiler could potentially do it
and the technique is OS-dependent:
C:\gfortran\clf\bswap>type bswap3.f90
module bswap_stuff
integer(C_INT8_T) BAD_STUFF(40)
data BAD_STUFF / &
Z'89', Z'c8', Z'0f', Z'c8', Z'c3', Z'90', Z'90', Z'90', &
Z'48', Z'89', Z'c8', Z'48', Z'0f', Z'c8', Z'c3', Z'90', &
Z'8b', Z'44', Z'24', Z'04', Z'0f', Z'c8', Z'c3', Z'90', &
Z'8b', Z'44', Z'24', Z'08', Z'0f', Z'c8', Z'8b', Z'54', &
Z'24', Z'04', Z'0f', Z'ca', Z'c3', Z'90', Z'90', Z'90' /
abstract interface
function bswap32_template(x) bind(C)
import
implicit none
integer(C_INT32_T) bswap32_template
integer(C_INT32_T), value :: x
end function bswap32_template
function bswap64_template(x) bind(C)
import
implicit none
integer(C_INT64_T) bswap64_template
integer(C_INT64_T), value :: x
end function bswap64_template
end interface
procedure(bswap32_template), pointer :: bswap32 => NULL()
procedure(bswap64_template), pointer :: bswap64 => NULL()
interface
function VirtualAlloc(lpAddress, dwSize, flAllocationType, &
flProtect) bind(C, name = 'VirtualAlloc')
import
implicit none
!GCC$ ATTRIBUTES STDCALL :: VirtualAlloc
type(C_PTR) VirtualAlloc
type(C_PTR), value :: lpAddress
integer(C_SIZE_T), value :: dwSize
integer(C_LONG), value :: flAllocationType
integer(C_LONG), value :: flProtect
end function VirtualAlloc
function GetLastError() bind(C,name='GetLastError')
use ISO_C_BINDING
implicit none
!GCC$ ATTRIBUTES STDCALL :: GetLastError
integer(C_LONG) GetLastError
end function GetLastError
end interface
contains
subroutine bswap_init
type(C_PTR) address
integer(C_INTPTR_T) temp
integer(C_LONG) error
integer(C_INT8_T), pointer :: temp_ptr(:)
type(C_FUNPTR) fun_address
logical :: first = .TRUE.
if(.NOT.first) return
first = .FALSE.
address = VirtualAlloc(C_NULL_PTR, &
size(BAD_STUFF,kind=C_SIZE_T),int(Z'1000',C_LONG), &
int(Z'40',C_LONG))
if(.NOT.C_ASSOCIATED(address)) then
error = GetLastError()
write(*,'(a,z0,a)') "Error Z'",error,"' allocating memory"
stop
end if
call C_F_POINTER(address, temp_ptr, shape(BAD_STUFF))
temp_ptr = BAD_STUFF
temp = transfer(address, temp)
if(C_INT32_T == C_INTPTR_T) then
temp = temp+16
end if
fun_address = transfer(temp, fun_address)
call C_F_PROCPOINTER(fun_address, bswap32)
temp = temp+8
fun_address = transfer(temp, fun_address)
call C_F_PROCPOINTER(fun_address, bswap64)
end subroutine bswap_init
end module bswap_stuff
program bswap_test
use bswap_stuff
use ISO_C_BINDING
implicit none
integer(C_INT32_T) :: x32 = int(Z'12345678', C_INT32_T)
integer(C_INT64_T) :: x64 = int(Z'1234567890abcdef', C_INT64_T)
call bswap_init
write(*,'(a,i0,a)') 'This is a ',bit_size(0_C_INTPTR_T),'-bit system.'
write(*,'(z8.8,1x,z8.8)') x32, bswap32(x32)
write(*,'(z16.16,1x,z16.16)') x64, bswap64(x64)
end program bswap_test
C:\gfortran\clf\bswap>gfortran -fno-range-check bswap3.f90 -obswap3
C:\gfortran\clf\bswap>bswap3
This is a 64-bit system.
12345678 78563412
1234567890ABCDEF EFCDAB9078563412
C:\gfortran\clf\bswap>gfortran -fno-range-check bswap3.f90 -obswap3
C:\gfortran\clf\bswap>bswap3
This is a 32-bit system.
12345678 78563412
1234567890ABCDEF EFCDAB9078563412
news:k0k0sm$stq$1...@dont-email.me...
identical machine-language output. I assumed that the C side of
things saw that function call and converted it into inline code
at some point. If the conversion happened late enough in the
code generation process I figured it had a good chance to work
for gfortran since it shares the same back-end. I have definitely
used some of these builtins in gfortran before to fill in for
intrinsics which were missing at the time, but these were
complicated enough functions that they weren't inlined by gcc.
Of course you can always use gfortran to force bswap, but the
result isn't inlined like the compiler could potentially do it
and the technique is OS-dependent:
C:\gfortran\clf\bswap>type bswap3.f90
module bswap_stuff
use ISO_C_BINDING
implicit none
private
public bswap_init, bswap32, bswap64
implicit none
private
integer(C_INT8_T) BAD_STUFF(40)
data BAD_STUFF / &
Z'89', Z'c8', Z'0f', Z'c8', Z'c3', Z'90', Z'90', Z'90', &
Z'48', Z'89', Z'c8', Z'48', Z'0f', Z'c8', Z'c3', Z'90', &
Z'8b', Z'44', Z'24', Z'04', Z'0f', Z'c8', Z'c3', Z'90', &
Z'8b', Z'44', Z'24', Z'08', Z'0f', Z'c8', Z'8b', Z'54', &
Z'24', Z'04', Z'0f', Z'ca', Z'c3', Z'90', Z'90', Z'90' /
abstract interface
function bswap32_template(x) bind(C)
import
implicit none
integer(C_INT32_T) bswap32_template
integer(C_INT32_T), value :: x
end function bswap32_template
function bswap64_template(x) bind(C)
import
implicit none
integer(C_INT64_T) bswap64_template
integer(C_INT64_T), value :: x
end function bswap64_template
end interface
procedure(bswap32_template), pointer :: bswap32 => NULL()
procedure(bswap64_template), pointer :: bswap64 => NULL()
interface
function VirtualAlloc(lpAddress, dwSize, flAllocationType, &
flProtect) bind(C, name = 'VirtualAlloc')
import
implicit none
!GCC$ ATTRIBUTES STDCALL :: VirtualAlloc
type(C_PTR) VirtualAlloc
type(C_PTR), value :: lpAddress
integer(C_SIZE_T), value :: dwSize
integer(C_LONG), value :: flAllocationType
integer(C_LONG), value :: flProtect
end function VirtualAlloc
function GetLastError() bind(C,name='GetLastError')
use ISO_C_BINDING
implicit none
!GCC$ ATTRIBUTES STDCALL :: GetLastError
integer(C_LONG) GetLastError
end function GetLastError
end interface
contains
subroutine bswap_init
type(C_PTR) address
integer(C_INTPTR_T) temp
integer(C_LONG) error
integer(C_INT8_T), pointer :: temp_ptr(:)
type(C_FUNPTR) fun_address
logical :: first = .TRUE.
if(.NOT.first) return
first = .FALSE.
address = VirtualAlloc(C_NULL_PTR, &
size(BAD_STUFF,kind=C_SIZE_T),int(Z'1000',C_LONG), &
int(Z'40',C_LONG))
if(.NOT.C_ASSOCIATED(address)) then
error = GetLastError()
write(*,'(a,z0,a)') "Error Z'",error,"' allocating memory"
stop
end if
call C_F_POINTER(address, temp_ptr, shape(BAD_STUFF))
temp_ptr = BAD_STUFF
temp = transfer(address, temp)
if(C_INT32_T == C_INTPTR_T) then
temp = temp+16
end if
fun_address = transfer(temp, fun_address)
call C_F_PROCPOINTER(fun_address, bswap32)
temp = temp+8
fun_address = transfer(temp, fun_address)
call C_F_PROCPOINTER(fun_address, bswap64)
end subroutine bswap_init
end module bswap_stuff
program bswap_test
use bswap_stuff
use ISO_C_BINDING
implicit none
integer(C_INT32_T) :: x32 = int(Z'12345678', C_INT32_T)
integer(C_INT64_T) :: x64 = int(Z'1234567890abcdef', C_INT64_T)
call bswap_init
write(*,'(a,i0,a)') 'This is a ',bit_size(0_C_INTPTR_T),'-bit system.'
write(*,'(z8.8,1x,z8.8)') x32, bswap32(x32)
write(*,'(z16.16,1x,z16.16)') x64, bswap64(x64)
end program bswap_test
C:\gfortran\clf\bswap>gfortran -fno-range-check bswap3.f90 -obswap3
C:\gfortran\clf\bswap>bswap3
This is a 64-bit system.
12345678 78563412
1234567890ABCDEF EFCDAB9078563412
C:\gfortran\clf\bswap>gfortran -fno-range-check bswap3.f90 -obswap3
C:\gfortran\clf\bswap>bswap3
This is a 32-bit system.
12345678 78563412
1234567890ABCDEF EFCDAB9078563412
Steven G. Kargl
Aug 16, 2012, 10:51:06 PM8/16/12
to
to include __builtin_bswap32 into its internal list of available
intrinsics. Otherwise, it will be marked as an external procedure.
--
steve
Robin Vowels
Aug 16, 2012, 10:51:49 PM8/16/12
to
On Aug 14, 12:03 pm, Gary Scott <garylsc...@sbcglobal.net> wrote:
data.
The attributes NONNATIVE and NATIVE are used in declarations
of variables to indicate one or the other (big- or little-endian).
Steven G. Kargl
Aug 17, 2012, 12:36:01 AM8/17/12
to
4 'bswap32' 'builtins' '__builtin_bswap32' 1 ((PROCEDURE UNKNOWN-INTENT
MODULE-PROC BODY UNKNOWN 0 0 EXTERNAL FUNCTION IS_BIND_C IS_C_INTEROP) (
INTEGER 4 0 1 0 INTEGER ()) 8 0 (9) () 4 () () () 0 0)
3 'bswap64' 'builtins' '__builtin_bswap64' 1 ((PROCEDURE UNKNOWN-INTENT
MODULE-PROC BODY UNKNOWN 0 0 EXTERNAL FUNCTION IS_BIND_C IS_C_INTEROP) (
INTEGER 8 0 1 0 INTEGER ()) 10 0 (11) () 3 () () () 0 0)
Notice the 'EXTERNAL FUNCTION' tag, I suspect that this inhibits
the middle/back-end from using the in-line code.
--
steve
0 new messages