]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* M2Emit.mod issue errors to the gm2 tools substructure. |
2 | ||
a945c346 | 3 | Copyright (C) 2019-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
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 | IMPLEMENTATION MODULE M2Emit ; | |
23 | ||
24 | FROM M2ColorString IMPORT filenameColor, endColor, errorColor, warningColor, noteColor, | |
25 | range1Color, range2Color ; | |
26 | ||
27 | FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToColumnNo, GetTokenNo, | |
28 | UnknownTokenNo, BuiltinTokenNo; | |
29 | ||
30 | FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, ConCatChar, Mark, string, KillString, Dup ; | |
31 | ||
32 | FROM ASCII IMPORT nul, nl ; | |
33 | FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ; | |
34 | FROM FIO IMPORT StdOut, WriteNBytes, Close, FlushBuffer ; | |
35 | FROM M2Printf IMPORT printf0, printf1, printf2 ; | |
36 | FROM M2Options IMPORT Xcode ; | |
37 | FROM StrLib IMPORT StrLen ; | |
38 | FROM libc IMPORT abort ; | |
39 | ||
40 | IMPORT StdIO, StrIO ; | |
41 | ||
42 | CONST | |
43 | Debugging = TRUE ; | |
44 | ||
45 | ||
46 | ||
47 | (* | |
48 | EmitError - pass the error to GCC. | |
49 | *) | |
50 | ||
51 | PROCEDURE EmitError (error, note: BOOLEAN; token: CARDINAL; message: String) ; | |
52 | BEGIN | |
53 | IF error | |
54 | THEN | |
55 | message := ConCat (errorColor (InitString (' error ')), endColor (message)) | |
56 | ELSIF note | |
57 | THEN | |
58 | message := ConCat (noteColor (InitString (' note ')), endColor (message)) | |
59 | ELSE | |
60 | message := ConCat (warningColor (InitString (' warning ')), endColor (message)) | |
61 | END ; | |
62 | OutString (FindFileNameFromToken (token, 0), | |
63 | TokenToLineNo (token, 0), TokenToColumnNo (token, 0), message) | |
64 | END EmitError ; | |
65 | ||
66 | ||
67 | (* | |
68 | OutString - writes the contents of String to stdout. | |
69 | The string, s, is destroyed. | |
70 | *) | |
71 | ||
72 | PROCEDURE OutString (file: String; line, col: CARDINAL; s: String) ; | |
73 | VAR | |
74 | leader : String ; | |
75 | p, q : POINTER TO CHAR ; | |
76 | space, | |
77 | newline: BOOLEAN ; | |
78 | BEGIN | |
79 | file := ConCat(filenameColor(InitString('')), file) ; | |
80 | file := endColor(file) ; | |
81 | INC(col) ; | |
82 | leader := ConCatChar(file, ':') ; | |
83 | leader := range1Color(leader) ; | |
84 | leader := ConCat(leader, Sprintf1(Mark(InitString('%d')), line)) ; | |
85 | leader := endColor(leader) ; | |
86 | leader := ConCatChar(leader, ':') ; | |
87 | IF NOT Xcode | |
88 | THEN | |
89 | leader := range2Color(leader) ; | |
90 | leader := ConCat(leader, Sprintf1(Mark(InitString('%d')), col)) ; | |
91 | leader := endColor(leader) ; | |
92 | leader := ConCatChar(leader, ':') | |
93 | END ; | |
94 | p := string(s) ; | |
95 | newline := TRUE ; | |
96 | space := FALSE ; | |
97 | WHILE (p#NIL) AND (p^#nul) DO | |
98 | IF newline | |
99 | THEN | |
100 | q := string(leader) ; | |
101 | WHILE (q#NIL) AND (q^#nul) DO | |
102 | StdIO.Write(q^) ; | |
103 | INC(q) | |
104 | END | |
105 | END ; | |
106 | newline := (p^=nl) ; | |
107 | space := (p^=' ') ; | |
108 | IF newline AND Xcode | |
109 | THEN | |
110 | printf1('(pos: %d)', col) | |
111 | END ; | |
112 | StdIO.Write(p^) ; | |
113 | INC(p) | |
114 | END ; | |
115 | IF NOT newline | |
116 | THEN | |
117 | IF Xcode | |
118 | THEN | |
119 | IF NOT space | |
120 | THEN | |
121 | StdIO.Write(' ') | |
122 | END ; | |
123 | printf1('(pos: %d)', col) | |
124 | END ; | |
125 | StdIO.Write(nl) | |
126 | END ; | |
127 | FlushBuffer(StdOut) ; | |
128 | IF NOT Debugging | |
129 | THEN | |
130 | s := KillString(s) ; | |
131 | leader := KillString(leader) | |
132 | END | |
133 | END OutString ; | |
134 | ||
135 | ||
136 | (* | |
137 | InternalError - | |
138 | *) | |
139 | ||
140 | PROCEDURE InternalError (message: ARRAY OF CHAR) ; | |
141 | VAR | |
142 | i, h: CARDINAL ; | |
143 | BEGIN | |
144 | StrIO.WriteString ('internal error: ') ; | |
145 | h := StrLen (message) ; | |
146 | i := 0 ; | |
147 | WHILE i<h DO | |
148 | StdIO.Write (message[i]) ; | |
149 | INC (i) | |
150 | END ; | |
151 | StdIO.Write(nl) ; | |
152 | FlushBuffer(StdOut) ; | |
153 | abort | |
154 | END InternalError ; | |
155 | ||
156 | ||
157 | (* | |
158 | UnknownLocation - return the unknown location (using GCC linemap for cc1gm2) | |
159 | and constants for gm2l and gm2m. | |
160 | *) | |
161 | ||
162 | PROCEDURE UnknownLocation () : location_t ; | |
163 | BEGIN | |
164 | RETURN UnknownTokenNo | |
165 | END UnknownLocation ; | |
166 | ||
167 | ||
168 | (* | |
169 | BuiltinsLocation - return the builtins location (using GCC linemap for cc1gm2) | |
170 | and constants for gm2l and gm2m. | |
171 | *) | |
172 | ||
173 | PROCEDURE BuiltinsLocation () : location_t ; | |
174 | BEGIN | |
175 | RETURN BuiltinTokenNo | |
176 | END BuiltinsLocation ; | |
177 | ||
178 | ||
179 | END M2Emit. |