gcc/m2/mc/mcPreprocess.mod

   1 (* Copyright (C) 2015-2022 Free Software Foundation, Inc.  *)
   2 (* This file is part of GNU Modula-2.
   3
   4 GNU Modula-2 is free software; you can redistribute it and/or modify it under
   5 the terms of the GNU General Public License as published by the Free
   6 Software Foundation; either version 3, or (at your option) any later
   7 version.
   8
   9 GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
  10 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  11 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  12 for more details.
  13
  14 You should have received a copy of the GNU General Public License along
  15 with gm2; see the file COPYING.  If not, write to the Free Software
  16 Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  *)
  17
  18 IMPLEMENTATION MODULE mcPreprocess ;
  19
  20
  21 FROM SYSTEM IMPORT ADDRESS ;
  22
  23 FROM DynamicStrings IMPORT string, InitString, Mark, KillString, EqualArray, InitStringCharStar,
  24                            Dup, ConCat, ConCatChar, RIndex, Slice ;
  25
  26 FROM libc IMPORT system, exit, unlink, printf ;
  27 FROM alists IMPORT alist, initList, killList, includeItemIntoList, foreachItemInListDo ;
  28 FROM M2RTS IMPORT InstallTerminationProcedure ;
  29 FROM FIO IMPORT StdErr, StdOut ;
  30 FROM mcPrintf IMPORT fprintf1 ;
  31 FROM mcOptions IMPORT getVerbose, getCppCommandLine ;
  32
  33
  34 VAR
  35    listOfFiles: alist ;
  36
  37
  38 (*
  39    makeTempFile -
  40 *)
  41
  42 PROCEDURE makeTempFile (ext: String) : String ;
  43 BEGIN
  44    RETURN ConCat (InitString ('/tmp/mctemp.'), ext)
  45 END makeTempFile ;
  46
  47
  48 (*
  49    onExitDelete -
  50 *)
  51
  52 PROCEDURE onExitDelete (filename: String) : String ;
  53 BEGIN
  54    includeItemIntoList (listOfFiles, Dup (filename)) ;
  55    RETURN filename
  56 END onExitDelete ;
  57
  58
  59 (*
  60    removeFile - removes a single file, s.
  61 *)
  62
  63 PROCEDURE removeFile (a: ADDRESS) ;
  64 VAR
  65    s: String ;
  66 BEGIN
  67    s := a ;
  68    IF unlink (string (s))#0
  69    THEN
  70    END
  71 END removeFile ;
  72
  73
  74 (*
  75    removeFiles -
  76 *)
  77
  78 PROCEDURE removeFiles ;
  79 BEGIN
  80    foreachItemInListDo (listOfFiles, removeFile)
  81 END removeFiles ;
  82
  83
  84 (*
  85    preprocessModule - preprocess a file, filename, returning the new filename
  86                       of the preprocessed file.
  87                       Preprocessing will only occur if requested by the user.
  88                       If no preprocessing was requested then filename is returned.
  89                       If preprocessing occurs then a temporary file is created
  90                       and its name is returned.
  91                       All temporary files will be deleted when the compiler exits.
  92 *)
  93
  94 PROCEDURE preprocessModule (filename: String) : String ;
  95 VAR
  96    tempfile,
  97    command,
  98    commandLine: String ;
  99    pos        : CARDINAL ;
 100 BEGIN
 101    command := getCppCommandLine () ;
 102    IF EqualArray (command, '')
 103    THEN
 104       RETURN filename
 105    ELSE
 106       tempfile := InitStringCharStar (makeTempFile (InitString ('cpp'))) ;
 107       commandLine := Dup (command) ;
 108       commandLine := ConCat (ConCat (ConCat (ConCatChar (Dup (commandLine), ' '), filename),
 109                                      Mark (InitString(' -o '))),
 110                              tempfile) ;
 111       IF getVerbose ()
 112       THEN
 113          fprintf1 (StdOut, "%s\n", commandLine)
 114       END ;
 115       IF system (string (commandLine))#0
 116       THEN
 117          fprintf1(StdErr, 'C preprocessor failed when preprocessing %s\n', filename) ;
 118          exit(1)
 119       END ;
 120       commandLine := KillString (commandLine) ;
 121       RETURN onExitDelete (tempfile)
 122    END
 123 END preprocessModule ;
 124
 125
 126 BEGIN
 127    listOfFiles := initList () ;
 128    IF NOT InstallTerminationProcedure (removeFiles)
 129    THEN
 130       HALT
 131    END
 132 END mcPreprocess.