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


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