C Is Not a Low-level Language

Isn’t there also an issue involving aliases? In C, the two arrays are allowed to be aliased, and the compiler must allow for all possible memory associations between the two (i.e. no overlaps of memory, full overlap of memory, and all possible partial overlaps). If the C code were written as float* a (which actually is consistent with the original fortran reference specification), then the compiler must assume that the scalar might also be aliased to the arrays, and that must also be accounted for in generating the instructions.

In fortran, the two arrays and the scalar are not allowed to be aliased, so the compiler can be aggressive with reordering the memory fetches and stores, strip mining the loop, making optimal use of registers, and so on.

Or is it a high-low-level language? Or a low-high-level language? :smile:
Probably it depends also a lot on your programming style, as it has a rather flexible syntax. I have already seen here some C code with very high computing performances, better than Fortran, but looking like super Assembly language… It is also one of the best language for code obfuscation…

I’d be interested to see some C that actually compiles to a faster executing binary without utilizing the escape hatch of inline assembly. Obviously if you can entirely circumvent the compiler and just have it produce the machine code for the exact instructions you want then yes, it’s probably going to utilize SIMD better and stuff like that.

I’m not extremely familiar with the actual C standard, but it looks to me that the x86 intrinsic functions aren’t actually part of it. That said, if MSVC, ICC/ICX and GCC all support them with the same syntax… Who cares what the standard says.

2 Likes

Everything is a pointer, semi-colons and curly brackets are my three main reasons for disliking the language. Remove those and I would have no problem with it. Oh wait. If you remove those you don’t have a language. Never mind. :slightly_smiling_face:

There is, and indeed it can lead more efficient code. But this applies irrespective of OpenMP, which I mentioned in my original post.

The aliasing issue can be overcome in C with the standard restrict type qualifier (since C99). Here’s an example (Compiler Explorer), for an x86-64 processor:

void multiply_scalar(float *a, float *b) {
    *b = 3.0f*(*a);
}

void multiply_stream(float *a, float *b) {
    for (int i = 0; i < 4; i++)
        b[i] = 3.0f*a[i];
}

void multiply_stream_noalias(float * restrict a, float * restrict b) 
{
    for (int i = 0; i < 4; i++)
        b[i] = 3.0f*a[i];
}
multiply_scalar(float*, float*):
        vmovss  xmm0, DWORD PTR .LC0[rip]
        vmulss  xmm0, xmm0, DWORD PTR [rdi]
        vmovss  DWORD PTR [rsi], xmm0
        ret
multiply_stream(float*, float*):
        vmovss  xmm1, DWORD PTR .LC0[rip]
        xor     eax, eax
.L4:
        vmulss  xmm0, xmm1, DWORD PTR [rdi+rax]
        vmovss  DWORD PTR [rsi+rax], xmm0
        add     rax, 4
        cmp     rax, 16
        jne     .L4
        ret
multiply_stream_noalias(float*, float*):
        vbroadcastss    xmm0, DWORD PTR .LC0[rip]
        vmulps  xmm0, xmm0, XMMWORD PTR [rdi] 
        vmovups XMMWORD PTR [rsi], xmm0
        ret
.LC0:
        .long   1077936128

As you can see, in multiply_stream there is a loop implementing scalar multiplication (vmulss). Once the restrict qualifier is added (or __restrict extension in C++), the compiler performs 4 multiplications in parallel with the vmulps instruction. The xmm registers are part of the Streaming SIMD Extension (SSE). They are 128-bit wide, meaning they can fit four floats, or two doubles. When you multiply in scalar mode, you are essentially wasting three out of four SIMD lanes.

(Note, at -O3 optimization some C and C++ compilers may insert runtime checks for aliasing with separate vectorized and scalar codepaths depending on the aliasing result.)

In Fortran, because of the default aliasing rules, the vector instruction is produced directly:

subroutine multiply_stream(a,b)
   real, intent(in) :: a(4)
   real, intent(out) :: b(4)
   do i = 1, 4
    b(i) = 3.*a(i)
   end do
end subroutine
multiply_stream_:
        vbroadcastss    xmm0, DWORD PTR .LC0[rip]
        vmulps  xmm0, xmm0, XMMWORD PTR [rdi]
        vmovups XMMWORD PTR [rsi], xmm0
        ret
.LC0:
        .long   1077936128

Addendum: using Intel Intrinsics (SSE), the function to multiply four floats with a constant value can be written as,

// Multiply elements of a by 3 and store result in b
void multiply_sse(float *a, float *b) {
    __m128 r = _mm_set_ps1(3.0f);        // Broadcast 3.0 to all elements of r
    r = _mm_mul_ps (r, _mm_loadu_ps(a)); // Multiply packed single-precision operands
                                         // (for second operand unaligned load is used)
    _mm_storeu_ps(b, r);                 // Store result in b
}

When this is done in C, who is responsible for ensuring there are no aliases. Is it up to the programmer, or is the compiler supposed to verify it at run time?

It’s up to the programmer (just like with Fortran)

I will note that it is at least a little insane that the Fortran language expects procedure arguments shall not alias, but no compiler will even warn if this assumption is violated at a call site.

There exist in large production code bases “routines that cannot be optimized” because anything beyond -O0 will make the compiler generate code that actually takes advantage of the no aliasing assumption. It would be nice if the compiler would at least warn the user when core assumptions of the language are being violated.

EDIT: A correction - it is possible there are compilers that will correctly warn the user (or better refuse to compile an issue an error) for the language assumption violation that is argument aliasing. However, gfortran, ifort, ifx, and aocc flang all fail to do so. They each compile and run the following program, but yield different outputs.

program main
implicit none

    real :: x, y

    x = 1.0
    y = 2.0
    write(*,*) 'MAIN -- x: ',x,', y: ',y

    call sub1(x, x)
    write(*,*) 'MAIN -- x: ',x,', y: ',y

    call sub2(y, y)
    write(*,*) 'MAIN -- x: ',x,', y: ',y

end program main
subroutine sub1(arg1, arg2)
implicit none
    real, intent(in) :: arg1
    real, intent(out) :: arg2
    write(*,*) 'entering sub1 -- arg1/arg2: ',arg1,arg2
    arg2 = arg1*10.0
    write(*,*) 'leaving sub1 -- arg1/arg2: ',arg1,arg2
end subroutine sub1
subroutine sub2(arg1, arg2)
implicit none
    real, intent(in) :: arg1
    real, intent(out) :: arg2
    write(*,*) 'entering sub2 -- arg1/arg2: ',arg1,arg2
    call sub1(arg1, arg1)
    write(*,*) 'sub2 returning from "call sub1" -- arg1/arg2: ',arg1,arg2
    arg2 = arg1*10.0
    write(*,*) 'leaving sub2 -- arg1/arg2: ',arg1,arg2
end subroutine sub2
2 Likes

If you want a language that actually does that you should try out Rust. Rust works by ensuring that all functions either get only immutable references or one mutable reference.

Rust is interesting. If I were to branch out language wise, it would be a top contender right next to Zig. My interest with Zig is more along the lines of comptime, but ease of use with C is also a big plus. Rust seems… Like a lot of hassle? I think it would be very rewarding, but the level of input effort required for basic competency sounds significantly higher than lots of other languages that I could devote my free time to learning.

Gfortran will, at least in some cases. After compiling the module

module m
implicit none
contains
subroutine sub(i,i2)
integer, intent(in)  :: i
integer, intent(out) :: i2
i2 = 2*i
end subroutine sub
end module m

gfortran -c -Wall -Wextra xxalias.f90 for

program main
use m
implicit none
integer :: i
i = 3
call sub(i,i)
print*,i
end program main

says

xxalias.f90:6:9:

    6 | call sub(i,i)
      |         1
Warning: Same actual argument associated with INTENT(IN) argument 'i' and INTENT(OUT) argument 'i2' at (1)

That is not true.

1 Like

@themos do you know if the NAG compiler warns about any possible alias, or only some?

The claim (https://www.nag.com/nagware/np/r71_doc/manual/compiler_2_4.html#OPTIONS) is that

The -C=alias option will produce a runtime error when it is detected that assignment to a dummy argument affects another dummy argument. At this release this is only detected for scalar dummy arguments.

I know NAG will welcome feedback on desirable features from paying customers. After 30-odd years of development, I have to assume that the demand for more alias detection just wasn’t there in sufficient quantity.

1 Like

Thank you for pointing out my error. I have since corrected my post. Among the compilers I regularly interact with, gfortran, ifort, ifx, and AMD flang, none of them emit compiler errors (or even warnings) about the following program - at least not with default flags (i.e. none). They also produce different results:

subroutine sub1(arg1, arg2)
implicit none
    real, intent(in) :: arg1
    real, intent(out) :: arg2
    write(*,*) 'entering sub1 -- arg1/arg2: ',arg1,arg2
    arg2 = arg1*10.0
    write(*,*) 'leaving sub1 -- arg1/arg2: ',arg1,arg2
end subroutine sub1
subroutine sub2(arg1, arg2)
implicit none
    real, intent(in) :: arg1
    real, intent(out) :: arg2
    write(*,*) 'entering sub2 -- arg1/arg2: ',arg1,arg2
    call sub1(arg1, arg1)
    write(*,*) 'sub2 returning from "call sub1" -- arg1/arg2: ',arg1,arg2
    arg2 = arg1*10.0
    write(*,*) 'leaving sub2 -- arg1/arg2: ',arg1,arg2
end subroutine sub2
program main
implicit none

    real :: x, y

    x = 1.0
    y = 2.0
    write(*,*) 'MAIN -- x: ',x,', y: ',y

    call sub1(x, x)
    write(*,*) 'MAIN -- x: ',x,', y: ',y

    call sub2(y, y)
    write(*,*) 'MAIN -- x: ',x,', y: ',y

end program main

@tyranids looks like you are using implicit interfaces, i.e. the routines are not in a module, are not contained, and they don’t have interface blocks. Then, when the compiler encounters a call, it doesn’t know that one of the dummy argument is intent(out) (remind that aliasing is fine as long as the arguments are not modified).

Exactly, and this is a common configuration of legacy code bases, which also happens to be (likely the most) common use case for the Fortran programming language.

I would argue it is a fundamental design flaw that a language would have underlying rules with no way to verify that they are followed at compile time. This is especially true when not following said rules leads to different results.

EDIT: Even more common would be not including the intent bits at all. The fact that they can exist and still be ignored or effectively do nothing is an entirely separate issue (which I would also consider unacceptable).

Gfortran by default refuses to compile the subroutines when they are placed in a

module
module m
contains
subroutine sub1(arg1, arg2)
implicit none
    real, intent(in) :: arg1
    real, intent(out) :: arg2
    write(*,*) 'entering sub1 -- arg1/arg2: ',arg1,arg2
    arg2 = arg1*10.0
    write(*,*) 'leaving sub1 -- arg1/arg2: ',arg1,arg2
end subroutine sub1
subroutine sub2(arg1, arg2)
implicit none
    real, intent(in) :: arg1
    real, intent(out) :: arg2
    write(*,*) 'entering sub2 -- arg1/arg2: ',arg1,arg2
    call sub1(arg1, arg1)
    write(*,*) 'sub2 returning from "call sub1" -- arg1/arg2: ',arg1,arg2
    arg2 = arg1*10.0
    write(*,*) 'leaving sub2 -- arg1/arg2: ',arg1,arg2
end subroutine sub2
end module m
alias.f90:16:20:

   16 |     call sub1(arg1, arg1)
      |                    1
Error: Dummy argument 'arg1' with INTENT(IN) in variable definition context (actual argument to INTENT = OUT/INOUT) at (1)

A known Fortran best practice is to put procedures in modules, or at least to provide explicit interfaces. This, along with adding argument intents, is part of the modernization process.

This is why IMPLICIT NONE(EXTERNAL) was added to Fortran 2018 - to force the programmer to specify the interface (or at least to explicitly declare external) called procedures. Many compilers nowadays have the ability to check interfaces if you don’t use them, but aliasing is a tricky thing to reliably diagnose.

Legacy code base is as it is, you won’t change the past…

This kind of “flaw” is quite common in any language, especially in oldest ones like Fortran. You cannot expect a compiler to catch every possible violation of the standard. Yet, modern Fortran aims at catching more of them, but it’s the responsability of the developer to effectively use the modern feature (an analogy for what it’s worth: modern cars have seatbelts, but still, you are allowed to drive old cars without seatbelts).