Resistance to modernization

As a sidenote, the motivation for this thread came from refactoring the LAPACK function lsame. The Reference LAPACK version is cluttered by additional else-if branches for processors that use other encodings than ASCII such as IBM mainframes using EBCDIC or the Prime OS @MarDie posted about.

lsame is really just a “trivial” support routine used to compare two characters. It is used in the routines which can perform operations on non-transpose, transpose or conjugate forms of matrices, i.e. 'N', 'T', to check which character was provided at the call site and perform the corresponding operation.

The original and F95 code are given in the drop-down arrows below. Observe that gfortran generates the same assembly code when using a reasonable optimization flag. Based on the character encoding it infers from the statement ZCODE = ichar('Z') it can simply eliminate the dead branches.

Original
      LOGICAL FUNCTION LSAME( CA, CB )
*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          CA, CB
*     ..
*
* =====================================================================
*
*     .. Intrinsic Functions ..
      INTRINSIC          ICHAR
*     ..
*     .. Local Scalars ..
      INTEGER            INTA, INTB, ZCODE
*     ..
*     .. Executable Statements ..
*
*     Test if the characters are equal
*
      LSAME = CA.EQ.CB
      IF( LSAME )
     $   RETURN
*
*     Now test for equivalence if both characters are alphabetic.
*
      ZCODE = ICHAR( 'Z' )
*
*     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
*     machines, on which ICHAR returns a value with bit 8 set.
*     ICHAR('A') on Prime machines returns 193 which is the same as
*     ICHAR('A') on an EBCDIC machine.
*
      INTA = ICHAR( CA )
      INTB = ICHAR( CB )
*
      IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
*
*        ASCII is assumed - ZCODE is the ASCII code of either lower or
*        upper case 'Z'.
*
         IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
         IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
*
      ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
*
*        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
*        upper case 'Z'.
*
         IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
     $       INTA.GE.145 .AND. INTA.LE.153 .OR.
     $       INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
         IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
     $       INTB.GE.145 .AND. INTB.LE.153 .OR.
     $       INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
*
      ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
*
*        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
*        plus 128 of either lower or upper case 'Z'.
*
         IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
         IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
      END IF
      LSAME = INTA.EQ.INTB
*
*     RETURN
*
*     End of LSAME
*
      END

Output from compiler explorer, with gfortran-12 -ffixed-form -O2

lsame_:
        movzx   eax, BYTE PTR [rdi]
        movzx   edx, BYTE PTR [rsi]
        mov     ecx, 1
        cmp     al, dl
        je      .L1
        lea     esi, [rax-97]
        lea     ecx, [rax-32]
        cmp     esi, 26
        lea     esi, [rdx-97]
        cmovb   eax, ecx
        cmp     esi, 26
        lea     ecx, [rdx-32]
        cmovb   edx, ecx
        xor     ecx, ecx
        cmp     eax, edx
        sete    cl
.L1:
        mov     eax, ecx
        ret
Refactored
      pure logical function lsame( ca, cb )
         character(len=1), intent(in) :: ca, cb

         integer, parameter :: diff_case = iachar('a')-iachar('A')
         integer :: ia, ib

         lsame = ca == cb
         if (lsame) return 

         ! case-insensitive test
         ia = iachar(ca)
         ib = iachar(cb)

         ! Capital alphabetic characters are between 65 and 90
         ! in the ASCII character encoding
         if ( 64 < ia .and. ia < 91) ia = ia + diff_case
         if ( 64 < ib .and. ib < 91) ib = ib + diff_case

         lsame = ia == ib

      end

Output from compiler explorer, with gfortran-12 -ffixed-form -f95 -O2

lsame_:
        movzx   eax, BYTE PTR [rdi]
        movzx   edx, BYTE PTR [rsi]
        mov     ecx, 1
        cmp     al, dl
        je      .L1
        lea     esi, [rax-65]
        lea     ecx, [rax+32]
        cmp     esi, 26
        lea     esi, [rdx-65]
        cmovb   eax, ecx
        cmp     esi, 26
        lea     ecx, [rdx+32]
        cmovb   edx, ecx
        xor     ecx, ecx
        cmp     eax, edx
        sete    cl
.L1:
        mov     eax, ecx
        ret

From a functional point of view, you could say the refactoring brings little to no change. However the impact on readability and intent is non-negligible IMO.

Amusingly, the C interfaces to this function (which from a modern Fortran perspective shouldn’t even be part of the public interface) are different:

  • Intel MKL: int lsame( const char* ca, const char* cb, int lca, int lcb );
  • BLIS: int PASTEF770(lsame)(const char *ca, const char *cb, int ca_len, int cb_len)
  • OpenBLAS: int NAME(char *A, char *B){
  • Reference LAPACK: lapack_logical LAPACK_lsame_base( char* ca, char* cb, lapack_int lca, lapack_int lcb

OpenBLAS also maintains several assembly specializations for DEC Alpha, ia64, power, sparc and x86. Btw, OpenBLAS also seems to have kicked out EBCDIC and Prime OS. Now, to add further to my confusion as a Fortran programmer, in C you also need a version which can accept literals by value:

lapack_logical LAPACKE_lsame( char ca,  char cb )
{
    return (lapack_logical) LAPACK_lsame( &ca, &cb, 1, 1 );
}

Since the function is used a lot in LAPACK, it tripped up the GCC static analyzer, leading the developers to add __attribute__((const)), which is kind of similar to what simple procedures will provide in Fortran 202x but without requiring a preprocessor.

TL;DR Doing a case-insensitive comparison led to a big language mess.

It makes me afraid of what idiosyncrasies/baggage can be found in the rest of the interfaces.

2 Likes