]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* PushBackInput.mod provides a method for pushing back and consuming input. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2001-2023 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 | Under Section 7 of GPL version 3, you are granted additional | |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 3.1, as published by the Free Software Foundation. | |
21 | ||
22 | You should have received a copy of the GNU General Public License and | |
23 | a copy of the GCC Runtime Library Exception along with this program; | |
24 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
25 | <http://www.gnu.org/licenses/>. *) | |
26 | ||
27 | IMPLEMENTATION MODULE PushBackInput ; | |
28 | ||
29 | ||
30 | FROM FIO IMPORT ReadChar, IsNoError, EOF, OpenToRead, WriteChar, StdErr ; | |
31 | FROM DynamicStrings IMPORT string, Length, char ; | |
32 | FROM ASCII IMPORT nul, cr, lf ; | |
33 | FROM Debug IMPORT Halt ; | |
34 | FROM StrLib IMPORT StrCopy, StrLen ; | |
35 | FROM NumberIO IMPORT WriteCard ; | |
36 | FROM StrIO IMPORT WriteString, WriteLn ; | |
37 | FROM StdIO IMPORT Write, PushOutput, PopOutput ; | |
38 | FROM libc IMPORT exit ; | |
39 | ||
40 | IMPORT FIO ; | |
41 | ||
42 | ||
43 | CONST | |
44 | MaxPushBackStack = 8192 ; | |
45 | MaxFileName = 4096 ; | |
46 | ||
47 | VAR | |
48 | FileName : ARRAY [0..MaxFileName] OF CHAR ; | |
49 | CharStack : ARRAY [0..MaxPushBackStack] OF CHAR ; | |
50 | ExitStatus: CARDINAL ; | |
51 | Column, | |
52 | StackPtr, | |
53 | LineNo : CARDINAL ; | |
54 | Debugging : BOOLEAN ; | |
55 | ||
56 | ||
57 | (* | |
58 | GetCh - gets a character from either the push back stack or | |
59 | from file, f. | |
60 | *) | |
61 | ||
62 | PROCEDURE GetCh (f: File) : CHAR ; | |
63 | VAR | |
64 | ch: CHAR ; | |
65 | BEGIN | |
66 | IF StackPtr>0 | |
67 | THEN | |
68 | DEC(StackPtr) ; | |
69 | IF Debugging | |
70 | THEN | |
71 | Write(CharStack[StackPtr]) | |
72 | END ; | |
73 | RETURN( CharStack[StackPtr] ) | |
74 | ELSE | |
75 | IF EOF(f) OR (NOT IsNoError(f)) | |
76 | THEN | |
77 | ch := nul | |
78 | ELSE | |
79 | REPEAT | |
80 | ch := ReadChar(f) | |
81 | UNTIL (ch#cr) OR EOF(f) OR (NOT IsNoError(f)) ; | |
82 | IF ch=lf | |
83 | THEN | |
84 | Column := 0 ; | |
85 | INC(LineNo) | |
86 | ELSE | |
87 | INC(Column) | |
88 | END | |
89 | END ; | |
90 | IF Debugging | |
91 | THEN | |
92 | Write(ch) | |
93 | END ; | |
94 | RETURN( ch ) | |
95 | END | |
96 | END GetCh ; | |
97 | ||
98 | ||
99 | (* | |
100 | PutStr - pushes a dynamic string onto the push back stack. | |
101 | The string, s, is not deallocated. | |
102 | *) | |
103 | ||
104 | PROCEDURE PutStr (s: String) ; | |
105 | VAR | |
106 | i: CARDINAL ; | |
107 | BEGIN | |
108 | i := Length (s) ; | |
109 | WHILE i > 0 DO | |
110 | DEC (i) ; | |
111 | IF PutCh (char (s, i)) # char (s, i) | |
112 | THEN | |
77924dff | 113 | Halt('assert failed', __FILE__, __FUNCTION__, __LINE__) |
1eee94d3 GM |
114 | END |
115 | END | |
116 | END PutStr ; | |
117 | ||
118 | ||
119 | (* | |
120 | PutString - pushes a string onto the push back stack. | |
121 | *) | |
122 | ||
123 | PROCEDURE PutString (a: ARRAY OF CHAR) ; | |
124 | VAR | |
125 | l: CARDINAL ; | |
126 | BEGIN | |
127 | l := StrLen (a) ; | |
128 | WHILE l > 0 DO | |
129 | DEC (l) ; | |
130 | IF PutCh (a[l]) # a[l] | |
131 | THEN | |
77924dff | 132 | Halt ('assert failed', __FILE__, __FUNCTION__, __LINE__) |
1eee94d3 GM |
133 | END |
134 | END | |
135 | END PutString ; | |
136 | ||
137 | ||
138 | (* | |
139 | PutCh - pushes a character onto the push back stack, it also | |
140 | returns the character which has been pushed. | |
141 | *) | |
142 | ||
143 | PROCEDURE PutCh (ch: CHAR) : CHAR ; | |
144 | BEGIN | |
145 | IF StackPtr<MaxPushBackStack | |
146 | THEN | |
147 | CharStack[StackPtr] := ch ; | |
148 | INC(StackPtr) | |
149 | ELSE | |
77924dff GM |
150 | Halt('max push back stack exceeded, increase MaxPushBackStack', |
151 | __FILE__, __FUNCTION__, __LINE__) | |
1eee94d3 GM |
152 | END ; |
153 | RETURN( ch ) | |
154 | END PutCh ; | |
155 | ||
156 | ||
157 | (* | |
158 | Open - opens a file for reading. | |
159 | *) | |
160 | ||
161 | PROCEDURE Open (a: ARRAY OF CHAR) : File ; | |
162 | BEGIN | |
163 | Init ; | |
164 | StrCopy(a, FileName) ; | |
165 | RETURN( OpenToRead(a) ) | |
166 | END Open ; | |
167 | ||
168 | ||
169 | (* | |
170 | Close - closes the opened file. | |
171 | *) | |
172 | ||
173 | PROCEDURE Close (f: File) ; | |
174 | BEGIN | |
175 | FIO.Close(f) | |
176 | END Close ; | |
177 | ||
178 | ||
179 | (* | |
180 | ErrChar - writes a char, ch, to stderr. | |
181 | *) | |
182 | ||
183 | PROCEDURE ErrChar (ch: CHAR) ; | |
184 | BEGIN | |
185 | WriteChar(StdErr, ch) | |
186 | END ErrChar ; | |
187 | ||
188 | ||
189 | (* | |
190 | Error - emits an error message with the appropriate file, line combination. | |
191 | *) | |
192 | ||
193 | PROCEDURE Error (a: ARRAY OF CHAR) ; | |
194 | BEGIN | |
195 | PushOutput(ErrChar) ; | |
196 | WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') ; WriteString(a) ; WriteLn ; | |
197 | PopOutput ; | |
198 | FIO.Close(StdErr) ; | |
199 | exit(1) | |
200 | END Error ; | |
201 | ||
202 | ||
203 | (* | |
204 | WarnError - emits an error message with the appropriate file, line combination. | |
205 | It does not terminate but when the program finishes an exit status of | |
206 | 1 will be issued. | |
207 | *) | |
208 | ||
209 | PROCEDURE WarnError (a: ARRAY OF CHAR) ; | |
210 | BEGIN | |
211 | PushOutput(ErrChar) ; | |
212 | WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') ; WriteString(a) ; WriteLn ; | |
213 | PopOutput ; | |
214 | ExitStatus := 1 | |
215 | END WarnError ; | |
216 | ||
217 | ||
218 | (* | |
219 | WarnString - emits an error message with the appropriate file, line combination. | |
220 | It does not terminate but when the program finishes an exit status of | |
221 | 1 will be issued. | |
222 | *) | |
223 | ||
224 | PROCEDURE WarnString (s: String) ; | |
225 | VAR | |
226 | p : POINTER TO CHAR ; | |
227 | BEGIN | |
228 | p := string(s) ; | |
229 | WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') ; | |
230 | REPEAT | |
231 | IF p#NIL | |
232 | THEN | |
233 | IF p^=lf | |
234 | THEN | |
235 | WriteLn ; | |
236 | WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') | |
237 | ELSE | |
238 | Write(p^) | |
239 | END ; | |
240 | INC(p) | |
241 | END ; | |
242 | UNTIL (p=NIL) OR (p^=nul) ; | |
243 | ExitStatus := 1 | |
244 | END WarnString ; | |
245 | ||
246 | ||
247 | (* | |
248 | GetExitStatus - returns the exit status which will be 1 if any warnings were issued. | |
249 | *) | |
250 | ||
251 | PROCEDURE GetExitStatus () : CARDINAL ; | |
252 | BEGIN | |
253 | RETURN( ExitStatus ) | |
254 | END GetExitStatus ; | |
255 | ||
256 | ||
257 | (* | |
258 | SetDebug - sets the debug flag on or off. | |
259 | *) | |
260 | ||
261 | PROCEDURE SetDebug (d: BOOLEAN) ; | |
262 | BEGIN | |
263 | Debugging := d | |
264 | END SetDebug ; | |
265 | ||
266 | ||
267 | (* | |
268 | GetColumnPosition - returns the column position of the current character. | |
269 | *) | |
270 | ||
271 | PROCEDURE GetColumnPosition () : CARDINAL ; | |
272 | BEGIN | |
273 | IF StackPtr>Column | |
274 | THEN | |
275 | RETURN( 0 ) | |
276 | ELSE | |
277 | RETURN( Column-StackPtr ) | |
278 | END | |
279 | END GetColumnPosition ; | |
280 | ||
281 | ||
282 | (* | |
283 | GetCurrentLine - returns the current line number. | |
284 | *) | |
285 | ||
286 | PROCEDURE GetCurrentLine () : CARDINAL ; | |
287 | BEGIN | |
288 | RETURN( LineNo ) | |
289 | END GetCurrentLine ; | |
290 | ||
291 | ||
292 | (* | |
293 | Init - initialize global variables. | |
294 | *) | |
295 | ||
296 | PROCEDURE Init ; | |
297 | BEGIN | |
298 | ExitStatus := 0 ; | |
299 | StackPtr := 0 ; | |
300 | LineNo := 1 ; | |
301 | Column := 0 | |
302 | END Init ; | |
303 | ||
304 | ||
305 | BEGIN | |
306 | SetDebug(FALSE) ; | |
307 | Init | |
308 | END PushBackInput. |