Algol 68 Genie

rts-char.c

     1  //! @file rts-char.c
     2  //! @author J. Marcel van der Veer
     3  //
     4  //! @section Copyright
     5  //
     6  // This file is part of VIF - vintage FORTRAN compiler.
     7  // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
     8  //
     9  //! @section License
    10  //
    11  // This program is free software; you can redistribute it and/or modify it 
    12  // under the terms of the GNU General Public License as published by the 
    13  // Free Software Foundation; either version 3 of the License, or 
    14  // (at your option) any later version.
    15  //
    16  // This program is distributed in the hope that it will be useful, but 
    17  // WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
    18  // or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
    19  // more details. You should have received a copy of the GNU General Public 
    20  // License along with this program. If not, see <http://www.gnu.org/licenses/>.
    21  
    22  //! @section Synopsis
    23  //!
    24  //! Runtime support for character - integer/real conversion.
    25  
    26  #include <vif.h>
    27  
    28  int_4 _str_to_int4 (char *str)
    29  {
    30    int_4 sum = 0, fact = 1, len = strlen (str);
    31    for (int_4 k = 0; k < 4 && k < len; k++) {
    32      sum += fact * (int_4) str[k];
    33      fact <<= CHAR_BIT;
    34    }
    35    return sum;
    36  }
    37  
    38  real_8 _str_to_real8 (char *str)
    39  {
    40    real_8 sum = 0.0;
    41    int_8 fact = 1, len = strlen (str);
    42    for (int_4 k = 0; k < (DBL_MANT_DIG / CHAR_BIT) && k < len; k++) {
    43      sum += fact * (int_4) str[k];
    44      fact <<= CHAR_BIT;
    45    }
    46    return sum;
    47  }
    48  
    49  char *bufcpy (char *dst, char *src, int_4 len)
    50  {
    51  // Fortran string lengths are len+1, last one is for null.
    52    memset (dst, '\0', len + 1);
    53    strncpy (dst, src, len);
    54    return dst;
    55  }
    56  
    57  char *bufcat (char *dst, char *src, int_4 len)
    58  {
    59  // Fortran string lengths are len+1, last one is for null.
    60    int_4 N = len - (int_4) strlen (dst);
    61    if (N > 0) {
    62      strncat (dst, src, N);
    63      dst[len] = '\0';
    64    }
    65    return dst;
    66  }
    67  
    68  char *bufrep (char *dst, char *src)
    69  {
    70  // Replace first chars of dst with src without its null char.
    71  // A(I:J) = B
    72    while (src[0] != 0 && dst[0] != 0) {
    73      (dst++)[0] = (src++)[0];
    74    }
    75    return dst;
    76  }
    77  
    78  char *_bufsub(char *dst, char *src, int_4 i, int_4 f)
    79  { 
    80    int_4 N = f - i + 1;
    81    if (N > 0 && i >= 1) {
    82      bufcpy (dst, &src[i - 1], N);
    83      dst[N] = '\0';
    84    } else {
    85      dst[0] = '\0';
    86    }
    87    return dst;
    88  }
    89  
    90  char *concat (char *dst, char *lhs, char *rhs)
    91  {
    92  // Fortran // operator.
    93    strcpy (dst, lhs);
    94    strcat (dst, rhs);
    95    return dst;
    96  }
    97  
    98  char *_char (int c)
    99  {
   100  #define N_CHARS 256
   101    static char _ch[N_CHARS][2];
   102    int N = c % N_CHARS;
   103    _ch[N][0] = (char) N;
   104    _ch[N][1] = '\0';
   105    return &_ch[N][0];
   106  #undef N_CHARS
   107  }
   108  
   109  int_4 _index (char *stack, char *needle)
   110  {
   111     char *p = strstr (stack, needle);
   112     if (p == NO_TEXT) {
   113       return 0;
   114     }
   115     ptrdiff_t N = p - stack;
   116     return abs (N) + 1;
   117  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.