gcc/m2/gm2-compiler/gm2lgen.mod

   1 (* gm2lgen.mod generates the main C function from a list of module names.
   2
   3 Copyright (C) 2001-2022 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  *)
  21
  22 MODULE gm2lgen ;
  23
  24 (*
  25    Author     : Gaius Mulley
  26    Title      : gm2lgen
  27    Date       : Fri Sep 15 14:42:17 BST 1989
  28    Description: Generates the main C function, from a list of module names.
  29 *)
  30
  31 FROM libc IMPORT exit ;
  32 FROM ASCII IMPORT eof ;
  33 FROM SArgs IMPORT GetArg ;
  34
  35 FROM Indexing IMPORT Index, InitIndex, KillIndex, HighIndice, LowIndice,
  36                      IncludeIndiceIntoIndex, GetIndice ;
  37
  38 FROM FIO IMPORT File, StdIn, StdOut, StdErr, WriteChar,
  39                 ReadString, WriteString, EOF, IsNoError, WriteLine, Close ;
  40
  41 FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, RemoveWhitePrefix,
  42                     EqualArray, Mark, Assign, Fin, InitStringChar, Length, Slice, Equal,
  43                     RemoveComment ;
  44
  45 FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2 ;
  46 FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead ;
  47 FROM FormatStrings IMPORT Sprintf0, Sprintf1 ;
  48
  49
  50 CONST
  51    Comment = '#'  ; (* Comment leader      *)
  52
  53 VAR
  54    CPlusPlus,
  55    SharedLibrary,
  56    NeedInitial,
  57    NeedTerminate,
  58    ExitNeeded   : BOOLEAN ;
  59    MainName     : String ;
  60    FunctionList : Index ;
  61    fi, fo       : File ;
  62
  63
  64 (*
  65    OpenOutputFile - attempts to open an output file.
  66 *)
  67
  68 PROCEDURE OpenOutputFile (s: String) ;
  69 BEGIN
  70    fo := OpenToWrite(s) ;
  71    IF NOT IsNoError(fo)
  72    THEN
  73       fprintf1(StdErr, 'cannot write to: %s\n', s) ;
  74       exit(1)
  75    END
  76 END OpenOutputFile ;
  77
  78
  79 (*
  80    OpenInputFile - attempts to open an input file.
  81 *)
  82
  83 PROCEDURE OpenInputFile (s: String) ;
  84 BEGIN
  85    fi := OpenToRead(s) ;
  86    IF NOT IsNoError(fo)
  87    THEN
  88       fprintf1 (StdErr, 'cannot open: %s\n', s) ;
  89       exit (1)
  90    END
  91 END OpenInputFile ;
  92
  93
  94 (*
  95    DisplayHelp - display brief help and exit.
  96 *)
  97
  98 PROCEDURE DisplayHelp ;
  99 BEGIN
 100    fprintf0 (StdErr, 'gm2lgen [--exit] [-fcpp] [-fshared] [-h] [--help] [--main function]\n');
 101    fprintf0 (StdErr, '        [-o outputfile] [--terminate] [inputfile]\n');
 102    exit (0)
 103 END DisplayHelp ;
 104
 105
 106 (*
 107    ScanArgs -
 108 *)
 109
 110 PROCEDURE ScanArgs ;
 111 VAR
 112    i: CARDINAL ;
 113    s: String ;
 114 BEGIN
 115    i             := 1 ;
 116    CPlusPlus     := FALSE ;
 117    NeedTerminate := TRUE ;
 118    NeedInitial   := TRUE ;
 119    ExitNeeded    := TRUE ;
 120    SharedLibrary := FALSE ;
 121    MainName      := InitString('main') ;
 122    fi            := StdIn ;
 123    fo            := StdOut ;
 124    WHILE GetArg(s, i) DO
 125       IF EqualArray(s, '--exit')
 126       THEN
 127          ExitNeeded := FALSE
 128       ELSIF EqualArray(s, '--terminate')
 129       THEN
 130          NeedTerminate := FALSE
 131       ELSIF EqualArray(s, '--initial')
 132       THEN
 133          NeedInitial := FALSE
 134       ELSIF EqualArray(s, '-h') OR EqualArray(s, '--help')
 135       THEN
 136          DisplayHelp
 137       ELSIF EqualArray(s, '-fshared')
 138       THEN
 139          SharedLibrary := TRUE
 140       ELSIF EqualArray(s, '-fcpp')
 141       THEN
 142          CPlusPlus := TRUE
 143       ELSIF EqualArray(s, '-o')
 144       THEN
 145          INC(i) ;
 146          IF GetArg(s, i)
 147          THEN
 148             OpenOutputFile(s)
 149          ELSE
 150             fprintf0(StdErr, 'missing filename option after -o\n') ;
 151             exit(1)
 152          END
 153       ELSIF EqualArray(s, '--main')
 154       THEN
 155          INC(i) ;
 156          IF GetArg(s, i)
 157          THEN
 158             MainName := Assign(MainName, s)
 159          ELSE
 160             fprintf0(StdErr, 'missing functionname after option -main\n') ;
 161             exit(1)
 162          END
 163       ELSE
 164          OpenInputFile(s)
 165       END ;
 166       INC(i)
 167    END
 168 END ScanArgs ;
 169
 170
 171 (*
 172    GenInit -
 173 *)
 174
 175 PROCEDURE GenInit ;
 176 BEGIN
 177    IF SharedLibrary
 178    THEN
 179       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((constructor)) init (void);\n')))))) ;
 180       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((constructor)) init (void)\n'))))))
 181    ELSE
 182       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nstatic void init (int argc, char *argv[])\n')))))) ;
 183    END ;
 184    Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n'))))));
 185    GenInitializationCalls ;
 186    Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n'))))));
 187 END GenInit ;
 188
 189
 190 (*
 191    GenFinish -
 192 *)
 193
 194 PROCEDURE GenFinish ;
 195 BEGIN
 196    IF SharedLibrary
 197    THEN
 198       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((destructor)) finish (void);\n')))))) ;
 199       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((destructor)) finish (void)\n'))))))
 200    ELSE
 201       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nstatic void finish (void)\n'))))))
 202    END ;
 203    Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))) ;
 204    GenFinalizationCalls ;
 205    Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n'))))))
 206 END GenFinish ;
 207
 208
 209 (*
 210    GenMain - writes out the main() function together with module initialization
 211              calls.
 212 *)
 213
 214 PROCEDURE GenMain ;
 215 BEGIN
 216    FunctionList := InitIndex(1) ;
 217    ScanArgs ;
 218    BuildFunctionList ;
 219    GenExternals ;
 220    GenInit ;
 221    GenFinish ;
 222    IF NOT SharedLibrary
 223    THEN
 224       Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('\nint %s (int argc, char *argv[])\n')), MainName)))) ;
 225       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))) ;
 226       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   init (argc, argv);\n')))))) ;
 227       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   finish ();\n')))))) ;
 228       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   return (0);\n')))))) ;
 229       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n'))))))
 230    END ;
 231    Close(fo)
 232 END GenMain ;
 233
 234
 235 (*
 236    GenExternals - writes out the external prototypes for each module initializer.
 237 *)
 238
 239 PROCEDURE GenExternals ;
 240 VAR
 241    funcname: String ;
 242    i, n    : CARDINAL ;
 243 BEGIN
 244    IF ExitNeeded
 245    THEN
 246       Fin(WriteS(fo, Mark(InitString('extern ')))) ;
 247       IF CPlusPlus
 248       THEN
 249          Fin(WriteS(fo, Mark(InitString('"C"'))))
 250       END ;
 251       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void exit(int);\n\n')))))) ;
 252    END ;
 253    IF CPlusPlus
 254    THEN
 255       Fin(WriteS(fo, Mark(InitString('extern "C"')))) ;
 256       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void RTExceptions_DefaultErrorCatch(void);\n'))))))
 257    END ;
 258    n := HighIndice(FunctionList) ;
 259    i := 1 ;
 260    WHILE i<=n DO
 261       funcname := GetIndice(FunctionList, i) ;
 262       Fin(WriteS(fo, Mark(InitString('extern ')))) ;
 263       IF CPlusPlus
 264       THEN
 265          Fin(WriteS(fo, Mark(InitString('"C"'))))
 266       END ;
 267       Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' void _M2_%s_init (int argc, char *argv[]);\n')), funcname)))) ;
 268       Fin(WriteS(fo, Mark(InitString('extern ')))) ;
 269       IF CPlusPlus
 270       THEN
 271          Fin(WriteS(fo, Mark(InitString('"C"'))))
 272       END ;
 273       Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' void _M2_%s_finish (void);\n')), funcname)))) ;
 274       INC(i)
 275    END ;
 276    IF NeedTerminate
 277    THEN
 278       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nextern ')))))) ;
 279       IF CPlusPlus
 280       THEN
 281          Fin(WriteS(fo, Mark(InitString('"C"'))))
 282       END ;
 283       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void M2RTS_ExecuteTerminationProcedures(void);\n'))))))
 284    END ;
 285    IF NeedInitial
 286    THEN
 287       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nextern ')))))) ;
 288       IF CPlusPlus
 289       THEN
 290          Fin(WriteS(fo, Mark(InitString('"C"'))))
 291       END ;
 292       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void M2RTS_ExecuteInitialProcedures(void);\n'))))))
 293    END
 294 END GenExternals ;
 295
 296
 297 (*
 298    GenInitializationCalls - writes out the initialization calls for the modules
 299                             in the application suit.
 300 *)
 301
 302 PROCEDURE GenInitializationCalls ;
 303 VAR
 304    funcname: String ;
 305    i, n    : CARDINAL ;
 306 BEGIN
 307    n := HighIndice(FunctionList) ;
 308    i := LowIndice(FunctionList) ;
 309    IF CPlusPlus
 310    THEN
 311       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   try {\n'))))))
 312    END ;
 313    WHILE i<=n DO
 314       IF i=n
 315       THEN
 316          IF NeedInitial
 317          THEN
 318             IF CPlusPlus
 319             THEN
 320                Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
 321             END ;
 322             Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   M2RTS_ExecuteInitialProcedures ();\n'))))))
 323          END
 324       END ;
 325       funcname := GetIndice(FunctionList, i) ;
 326       IF CPlusPlus
 327       THEN
 328          Fin(WriteS(fo, Mark(InitString('   '))))
 329       END ;
 330       IF SharedLibrary
 331       THEN
 332          Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('    _M2_%s_init (0, (char **)0);\n')),
 333                                       funcname))))
 334       ELSE
 335          Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('    _M2_%s_init (argc, argv);\n')),
 336                                       funcname))))
 337       END ;
 338       INC(i)
 339    END ;
 340    IF CPlusPlus
 341    THEN
 342       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n')))))) ;
 343       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    catch (...) {\n')))))) ;
 344       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('       RTExceptions_DefaultErrorCatch();\n')))))) ;
 345       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n'))))))
 346    END ;
 347 END GenInitializationCalls ;
 348
 349
 350 (*
 351    GenFinalizationCalls - writes out the finalization calls for the modules
 352                           in the application suit.
 353 *)
 354
 355 PROCEDURE GenFinalizationCalls ;
 356 VAR
 357    funcname: String ;
 358    i, n    : CARDINAL ;
 359 BEGIN
 360    IF CPlusPlus
 361    THEN
 362       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   try {\n'))))))
 363    END ;
 364    IF NeedTerminate
 365    THEN
 366       IF CPlusPlus
 367       THEN
 368          Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
 369       END ;
 370       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   M2RTS_ExecuteTerminationProcedures ();\n'))))))
 371    END ;
 372    n := HighIndice(FunctionList) ;
 373    i := LowIndice(FunctionList) ;
 374    WHILE i<=n DO
 375       funcname := GetIndice(FunctionList, n) ;
 376       IF CPlusPlus
 377       THEN
 378          Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
 379       END ;
 380       Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('   _M2_%s_finish ();\n')),
 381                                    funcname)))) ;
 382       DEC(n)
 383    END ;
 384    IF ExitNeeded
 385    THEN
 386       IF CPlusPlus
 387       THEN
 388          Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
 389       END ;
 390       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   exit (0);\n'))))))
 391    END ;
 392    IF CPlusPlus
 393    THEN
 394       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n')))))) ;
 395       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    catch (...) {\n')))))) ;
 396       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('       RTExceptions_DefaultErrorCatch();\n')))))) ;
 397       Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n'))))))
 398    END
 399 END GenFinalizationCalls ;
 400
 401
 402 (*
 403    BuildFunctionList - reads in the list of functions and stores them.
 404 *)
 405
 406 PROCEDURE BuildFunctionList ;
 407 VAR
 408    s: String ;
 409 BEGIN
 410    REPEAT
 411       s := RemoveComment(RemoveWhitePrefix(ReadS(fi)), Comment) ;
 412       IF (NOT Equal(Mark(InitStringChar(Comment)),
 413                     Mark(Slice(s, 0, Length(Mark(InitStringChar(Comment)))-1)))) AND
 414          (NOT EqualArray(s, ''))
 415       THEN
 416          IncludeIndiceIntoIndex(FunctionList, s)
 417       END
 418    UNTIL EOF(fi)
 419 END BuildFunctionList ;
 420
 421
 422 BEGIN
 423    GenMain
 424 END gm2lgen.