emit.c

     1  //! @file emit.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  //! Emit C object code.
    25  
    26  #include <vif.h>
    27  
    28  //
    29  // Write intermediate code
    30  //
    31  
    32  char *newpage (char *module, char *section)
    33  {
    34    NEW_RECORD (str);
    35    _srecordf (str, "\f %s %s", module, section);
    36    return f_stralloc (str);
    37  }
    38  
    39  logical_4 no_comment (char *str)
    40  {
    41    if (strncmp (str, "//", 2) == 0) {
    42      return FALSE;
    43    }
    44    if (strncmp (str, "#", 1) == 0) {
    45      return FALSE;
    46    }
    47    return TRUE;
    48  }
    49  
    50  void newline (FILE * obj, char *info, int_4 phase, int_4 force)
    51  {
    52    if (page == 0 || (info != NULL && info[0] == '\f')) {
    53      sscanf (&info[1], "%s %s", hmodule, hsection);
    54    }
    55    if (force || line >= LINES_PER_PAGE) {
    56      NEW_RECORD (str);
    57      page++;
    58      _srecordf (str, "// %s  %16s  ** %-28s ** %-48s PAGE %05d", _strupper (PACKAGE), _strupper (hdate), _strupper (hmodule), _strupper (hsection), page);
    59      for (int_4 k = 0; k < (int_4) strlen (str); k++) {
    60        if (str[k] == '-') {
    61          str[k] = ' ';
    62        }
    63      }
    64      if (page == 1) {
    65        fprintf (obj, "%s\n\n", str);
    66        line = 1;
    67      } else {
    68        fprintf (obj, "\f\n%s\n\n", str);
    69        line = 1;
    70      }
    71      if (phase == JCL) {
    72        fprintf (obj, "\n//   Line    JCL *...*....1....|....2....|....3....|....4....|....5....|....6....|....7..*.|....8\n");
    73        line += 2;
    74      }
    75      if (phase == LIST) {
    76        fprintf (obj, "\n//   Line    ISN *...*....1....|....2....|....3....|....4....|....5....|....6....|....7..*.|....8\n");
    77        line += 2;
    78      }
    79    } else {
    80      fprintf (obj, "\n");
    81      line++;
    82    }
    83  }
    84  
    85  void indentation (FILE *obj, int_4 ind) {
    86    for (int_4 k = 1; k <= ind; k++) {
    87      fprintf (obj, " ");
    88    }
    89  }
    90  
    91  void emit_code (FILE * obj, int_4 proc)
    92  {
    93  // Write the procedure 'proc'.
    94    int_4 nl = FALSE, printed = 0;
    95    indent = 0;
    96    for (int_4 phase = HEADER; phase < MAXPHA; phase++) {
    97      int_4 N = 0;
    98      NEW_RECORD (prev);
    99      prev[0] = '\0';
   100      for (int_4 c_src = 0; c_src < n_c_src; c_src++) {
   101        C_SRC *lin = &object[c_src];
   102        if (! (lin->proc == proc && lin->phase == phase)) {
   103          continue;
   104        } else if (lin->text != NULL) {
   105          int_4 last = strlen (lin->text) - 1;
   106          if (lin->text[0] == '\f') {
   107            newline (obj, lin->text, phase, TRUE);
   108            prev[0] = '\0';
   109            N = 0;
   110          } else if (lin->text[0] == '\"' && lin->text[last] == '\"') {
   111            fprintf (obj, "%s", lin->text);
   112          } else if (lin->text[0] == '\'' && lin->text[last] == '\'') {
   113            fprintf (obj, "%s", lin->text);
   114          } else {
   115  // Close block - indent less.
   116            if (no_comment (lin->text) && strchr (lin->text, '}') != NULL && strchr (lin->text, '{') == NULL) {
   117              indent = _max (0, indent - INDENT);
   118            }
   119  // Indent, but not comments or cpp directives.
   120            if (nl && strncmp (lin->text, "# ", 2) != 0 && strncmp (lin->text, "//", 2) != 0) {
   121              if (strncmp (lin->text, "#define", 7) != 0) { 
   122                indentation (obj, indent);
   123                printed += INDENT;
   124              }
   125              nl = FALSE;
   126            }
   127  // Write new line.
   128            if (lin->text[last] == '\n') {
   129              nl = TRUE;
   130              last--;
   131            }
   132            if (last >= 0) {
   133  // Open block - indent more.
   134              if (no_comment (lin->text) && strchr (lin->text, '{') != NULL && strchr (lin->text, '}') == NULL) {
   135                indent += INDENT;
   136              }
   137  // Write respecting LINE_WIDTH.
   138              if (strncmp (lin->text, "#", 1) == 0 || strncmp (lin->text, "//", 2) == 0) {
   139                NEW_RECORD (str);
   140                bufcpy (str, lin->text, RECLN);
   141                int_4 len = strlen (str);
   142                if (len > 0 && str[len - 1] == '\n') {
   143                  str[len - 1] = '\0';
   144                }
   145                fprintf (obj, "%s", str);
   146              } else if (strncmp (lin->text, "~", 1) == 0) {
   147                NEW_RECORD (str);
   148                bufcpy (str, lin->text, RECLN);
   149                int_4 len = strlen (str);
   150                if (len > 0 && str[len - 1] == '\n') {
   151                  str[len - 1] = '\0';
   152                }
   153                fprintf (obj, "%s", &str[1]);
   154              } else {
   155                NEW_RECORD (str);
   156                bufcpy (str, lin->text, RECLN);
   157                char *rest = NULL, *token;
   158                for (token = strtok_r (str, " ", &rest); token != NULL; token = strtok_r (NULL, " ", &rest)) {
   159                  int_4 len = strlen (token);
   160                  if (N > 0) {
   161                    if (strchr (",;)}", token[0]) == NULL) {
   162                      if (strlen (prev) > 0 && strchr ("([", prev[strlen(prev) - 1]) == NULL) {
   163                        fprintf (obj, " ");
   164                        printed++;
   165                      }
   166                    }
   167                  }
   168                  if (printed + len >= LINE_WIDTH) {
   169                    newline (obj, lin->text, phase, FALSE);
   170                    indentation (obj, indent);
   171                    printed = INDENT;
   172                    prev[0] = '\0';
   173                    N = 0;
   174                  }
   175                  NEW_RECORD (tok);
   176                  bufcpy (tok, token, RECLN);
   177                  int_4 M = strlen (tok);
   178                  if (M > 0 && tok[M - 1] == '\n') {
   179                    tok[M - 1] = '\0';
   180                  }
   181                  fprintf (obj, "%s", tok);
   182                  bufcpy (prev, tok /* token ? */, RECLN);
   183                  printed += strlen (tok);
   184                  N++;
   185                }
   186              }
   187            }
   188  // New line afterwards.
   189            if (nl) {
   190              newline (obj, lin->text, phase, FALSE);
   191              printed = 0;
   192              prev[0] = '\0';
   193              N = 0;
   194            }
   195          }
   196        }
   197      }
   198  // Final new line.
   199      if (proc == 0) {
   200        newline (obj, "\n", MAXPHA, FALSE);
   201      }
   202    }
   203    if (proc > 0) {
   204      newline (obj, "\n", MAXPHA, FALSE);
   205    }
   206  }
   207  
   208  void write_object (char *name)
   209  {
   210  // Object code to file.
   211    FILE *obj;
   212    int_4 proc;
   213    if ((obj = fopen (name, "w")) == NULL) {
   214      FATAL (1301, "cannot open for writing", name);
   215      exit (EXIT_FAILURE);
   216    };
   217    page = 0;
   218    for (proc = 0; proc <= nprocs; proc++) {
   219      emit_code (obj, proc);
   220    }
   221    fclose (obj);
   222  }


© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)