| (* gm2lgen.mod generates the main C function from a list of module names. |
| |
| Copyright (C) 2001-2023 Free Software Foundation, Inc. |
| Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
| |
| This file is part of GNU Modula-2. |
| |
| GNU Modula-2 is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 3, or (at your option) |
| any later version. |
| |
| GNU Modula-2 is distributed in the hope that it will be useful, but |
| WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with GNU Modula-2; see the file COPYING3. If not see |
| <http://www.gnu.org/licenses/>. *) |
| |
| MODULE gm2lgen ; |
| |
| (* |
| Author : Gaius Mulley |
| Title : gm2lgen |
| Date : Fri Sep 15 14:42:17 BST 1989 |
| Description: Generates the main C function, from a list of module names. |
| *) |
| |
| FROM libc IMPORT exit ; |
| FROM ASCII IMPORT eof ; |
| FROM SArgs IMPORT GetArg ; |
| |
| FROM Indexing IMPORT Index, InitIndex, KillIndex, HighIndice, LowIndice, |
| IncludeIndiceIntoIndex, GetIndice ; |
| |
| FROM FIO IMPORT File, StdIn, StdOut, StdErr, WriteChar, |
| ReadString, WriteString, EOF, IsNoError, WriteLine, Close ; |
| |
| FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, RemoveWhitePrefix, |
| EqualArray, Mark, Assign, Fin, InitStringChar, Length, Slice, Equal, |
| RemoveComment ; |
| |
| FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2 ; |
| FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead ; |
| FROM FormatStrings IMPORT Sprintf0, Sprintf1 ; |
| |
| |
| CONST |
| Comment = '#' ; (* Comment leader *) |
| |
| VAR |
| CPlusPlus, |
| SharedLibrary, |
| NeedInitial, |
| NeedTerminate, |
| ExitNeeded : BOOLEAN ; |
| MainName : String ; |
| FunctionList : Index ; |
| fi, fo : File ; |
| |
| |
| (* |
| OpenOutputFile - attempts to open an output file. |
| *) |
| |
| PROCEDURE OpenOutputFile (s: String) ; |
| BEGIN |
| fo := OpenToWrite(s) ; |
| IF NOT IsNoError(fo) |
| THEN |
| fprintf1(StdErr, 'cannot write to: %s\n', s) ; |
| exit(1) |
| END |
| END OpenOutputFile ; |
| |
| |
| (* |
| OpenInputFile - attempts to open an input file. |
| *) |
| |
| PROCEDURE OpenInputFile (s: String) ; |
| BEGIN |
| fi := OpenToRead(s) ; |
| IF NOT IsNoError(fo) |
| THEN |
| fprintf1 (StdErr, 'cannot open: %s\n', s) ; |
| exit (1) |
| END |
| END OpenInputFile ; |
| |
| |
| (* |
| DisplayHelp - display brief help and exit. |
| *) |
| |
| PROCEDURE DisplayHelp ; |
| BEGIN |
| fprintf0 (StdErr, 'gm2lgen [--exit] [-fcpp] [-fshared] [-h] [--help] [--main function]\n'); |
| fprintf0 (StdErr, ' [-o outputfile] [--terminate] [inputfile]\n'); |
| exit (0) |
| END DisplayHelp ; |
| |
| |
| (* |
| ScanArgs - |
| *) |
| |
| PROCEDURE ScanArgs ; |
| VAR |
| i: CARDINAL ; |
| s: String ; |
| BEGIN |
| i := 1 ; |
| CPlusPlus := FALSE ; |
| NeedTerminate := TRUE ; |
| NeedInitial := TRUE ; |
| ExitNeeded := TRUE ; |
| SharedLibrary := FALSE ; |
| MainName := InitString('main') ; |
| fi := StdIn ; |
| fo := StdOut ; |
| WHILE GetArg(s, i) DO |
| IF EqualArray(s, '--exit') |
| THEN |
| ExitNeeded := FALSE |
| ELSIF EqualArray(s, '--terminate') |
| THEN |
| NeedTerminate := FALSE |
| ELSIF EqualArray(s, '--initial') |
| THEN |
| NeedInitial := FALSE |
| ELSIF EqualArray(s, '-h') OR EqualArray(s, '--help') |
| THEN |
| DisplayHelp |
| ELSIF EqualArray(s, '-fshared') |
| THEN |
| SharedLibrary := TRUE |
| ELSIF EqualArray(s, '-fcpp') |
| THEN |
| CPlusPlus := TRUE |
| ELSIF EqualArray(s, '-o') |
| THEN |
| INC(i) ; |
| IF GetArg(s, i) |
| THEN |
| OpenOutputFile(s) |
| ELSE |
| fprintf0(StdErr, 'missing filename option after -o\n') ; |
| exit(1) |
| END |
| ELSIF EqualArray(s, '--main') |
| THEN |
| INC(i) ; |
| IF GetArg(s, i) |
| THEN |
| MainName := Assign(MainName, s) |
| ELSE |
| fprintf0(StdErr, 'missing functionname after option -main\n') ; |
| exit(1) |
| END |
| ELSE |
| OpenInputFile(s) |
| END ; |
| INC(i) |
| END |
| END ScanArgs ; |
| |
| |
| (* |
| GenInit - |
| *) |
| |
| PROCEDURE GenInit ; |
| BEGIN |
| IF SharedLibrary |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((constructor)) init (void);\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((constructor)) init (void)\n')))))) |
| ELSE |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nstatic void init (int argc, char *argv[])\n')))))) ; |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))); |
| GenInitializationCalls ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n')))))); |
| END GenInit ; |
| |
| |
| (* |
| GenFinish - |
| *) |
| |
| PROCEDURE GenFinish ; |
| BEGIN |
| IF SharedLibrary |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((destructor)) finish (void);\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((destructor)) finish (void)\n')))))) |
| ELSE |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nstatic void finish (void)\n')))))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))) ; |
| GenFinalizationCalls ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n')))))) |
| END GenFinish ; |
| |
| |
| (* |
| GenMain - writes out the main() function together with module initialization |
| calls. |
| *) |
| |
| PROCEDURE GenMain ; |
| BEGIN |
| FunctionList := InitIndex(1) ; |
| ScanArgs ; |
| BuildFunctionList ; |
| GenExternals ; |
| GenInit ; |
| GenFinish ; |
| IF NOT SharedLibrary |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('\nint %s (int argc, char *argv[])\n')), MainName)))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' init (argc, argv);\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' finish ();\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' return (0);\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n')))))) |
| END ; |
| Close(fo) |
| END GenMain ; |
| |
| |
| (* |
| GenExternals - writes out the external prototypes for each module initializer. |
| *) |
| |
| PROCEDURE GenExternals ; |
| VAR |
| funcname: String ; |
| i, n : CARDINAL ; |
| BEGIN |
| IF ExitNeeded |
| THEN |
| Fin(WriteS(fo, Mark(InitString('extern ')))) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString('"C"')))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void exit(int);\n\n')))))) ; |
| END ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString('extern "C"')))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void RTExceptions_DefaultErrorCatch(void);\n')))))) |
| END ; |
| n := HighIndice(FunctionList) ; |
| i := 1 ; |
| WHILE i<=n DO |
| funcname := GetIndice(FunctionList, i) ; |
| Fin(WriteS(fo, Mark(InitString('extern ')))) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString('"C"')))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' void _M2_%s_init (int argc, char *argv[]);\n')), funcname)))) ; |
| Fin(WriteS(fo, Mark(InitString('extern ')))) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString('"C"')))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' void _M2_%s_finish (void);\n')), funcname)))) ; |
| INC(i) |
| END ; |
| IF NeedTerminate |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nextern ')))))) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString('"C"')))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void M2RTS_ExecuteTerminationProcedures(void);\n')))))) |
| END ; |
| IF NeedInitial |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nextern ')))))) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString('"C"')))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void M2RTS_ExecuteInitialProcedures(void);\n')))))) |
| END |
| END GenExternals ; |
| |
| |
| (* |
| GenInitializationCalls - writes out the initialization calls for the modules |
| in the application suit. |
| *) |
| |
| PROCEDURE GenInitializationCalls ; |
| VAR |
| funcname: String ; |
| i, n : CARDINAL ; |
| BEGIN |
| n := HighIndice(FunctionList) ; |
| i := LowIndice(FunctionList) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' try {\n')))))) |
| END ; |
| WHILE i<=n DO |
| IF i=n |
| THEN |
| IF NeedInitial |
| THEN |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' ')))))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' M2RTS_ExecuteInitialProcedures ();\n')))))) |
| END |
| END ; |
| funcname := GetIndice(FunctionList, i) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(InitString(' ')))) |
| END ; |
| IF SharedLibrary |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' _M2_%s_init (0, (char **)0);\n')), |
| funcname)))) |
| ELSE |
| Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' _M2_%s_init (argc, argv);\n')), |
| funcname)))) |
| END ; |
| INC(i) |
| END ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' }\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' catch (...) {\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' RTExceptions_DefaultErrorCatch();\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' }\n')))))) |
| END ; |
| END GenInitializationCalls ; |
| |
| |
| (* |
| GenFinalizationCalls - writes out the finalization calls for the modules |
| in the application suit. |
| *) |
| |
| PROCEDURE GenFinalizationCalls ; |
| VAR |
| funcname: String ; |
| i, n : CARDINAL ; |
| BEGIN |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' try {\n')))))) |
| END ; |
| IF NeedTerminate |
| THEN |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' ')))))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' M2RTS_ExecuteTerminationProcedures ();\n')))))) |
| END ; |
| n := HighIndice(FunctionList) ; |
| i := LowIndice(FunctionList) ; |
| WHILE i<=n DO |
| funcname := GetIndice(FunctionList, n) ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' ')))))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' _M2_%s_finish ();\n')), |
| funcname)))) ; |
| DEC(n) |
| END ; |
| IF ExitNeeded |
| THEN |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' ')))))) |
| END ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' exit (0);\n')))))) |
| END ; |
| IF CPlusPlus |
| THEN |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' }\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' catch (...) {\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' RTExceptions_DefaultErrorCatch();\n')))))) ; |
| Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' }\n')))))) |
| END |
| END GenFinalizationCalls ; |
| |
| |
| (* |
| BuildFunctionList - reads in the list of functions and stores them. |
| *) |
| |
| PROCEDURE BuildFunctionList ; |
| VAR |
| s: String ; |
| BEGIN |
| REPEAT |
| s := RemoveComment(RemoveWhitePrefix(ReadS(fi)), Comment) ; |
| IF (NOT Equal(Mark(InitStringChar(Comment)), |
| Mark(Slice(s, 0, Length(Mark(InitStringChar(Comment)))-1)))) AND |
| (NOT EqualArray(s, '')) |
| THEN |
| IncludeIndiceIntoIndex(FunctionList, s) |
| END |
| UNTIL EOF(fi) |
| END BuildFunctionList ; |
| |
| |
| BEGIN |
| GenMain |
| END gm2lgen. |
