]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* ProgramArgs.mod implement the ISO ProgramArgs specification. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2008-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 ProgramArgs ; | |
28 | ||
29 | FROM RTgen IMPORT ChanDev, InitChanDev, DeviceType, doLook, doSkip, doSkipLook, | |
30 | doReadText, doReadLocs ; | |
31 | ||
32 | FROM SYSTEM IMPORT ADDRESS, ADR ; | |
33 | FROM UnixArgs IMPORT GetArgC, GetArgV ; | |
34 | FROM RTgenif IMPORT GenDevIF, InitGenDevIF ; | |
35 | FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData ; | |
36 | FROM IOLink IMPORT DeviceId, DeviceTablePtr, DeviceTablePtrValue, AllocateDeviceId, MakeChan, RAISEdevException ; | |
37 | FROM IOChan IMPORT ChanExceptions ; | |
38 | FROM IOConsts IMPORT ReadResults ; | |
39 | FROM ChanConsts IMPORT read, text ; | |
40 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
41 | FROM ASCII IMPORT nul, lf ; | |
42 | ||
43 | ||
44 | TYPE | |
45 | PtrToChar = POINTER TO CHAR ; | |
46 | ArgInfo = POINTER TO RECORD | |
47 | currentPtr: PtrToChar ; | |
48 | currentPos: CARDINAL ; | |
49 | currentArg: CARDINAL ; | |
50 | argLength : CARDINAL ; | |
51 | argc : CARDINAL ; | |
52 | END ; | |
53 | ||
54 | ||
55 | VAR | |
56 | mid : ModuleId ; | |
57 | did : DeviceId ; | |
58 | cid : ChanId ; | |
59 | ArgData : PtrToChar ; | |
60 | ArgLength: CARDINAL ; | |
61 | gen : GenDevIF ; | |
62 | dev : ChanDev ; | |
63 | ||
64 | ||
65 | PROCEDURE look (d: DeviceTablePtr; | |
66 | VAR ch: CHAR; VAR r: ReadResults) ; | |
67 | BEGIN | |
68 | doLook(dev, d, ch, r) | |
69 | END look ; | |
70 | ||
71 | ||
72 | PROCEDURE skip (d: DeviceTablePtr) ; | |
73 | BEGIN | |
74 | doSkip(dev, d) | |
75 | END skip ; | |
76 | ||
77 | ||
78 | PROCEDURE skiplook (d: DeviceTablePtr; | |
79 | VAR ch: CHAR; VAR r: ReadResults) ; | |
80 | BEGIN | |
81 | doSkipLook(dev, d, ch, r) | |
82 | END skiplook ; | |
83 | ||
84 | ||
85 | PROCEDURE textread (d: DeviceTablePtr; | |
86 | to: ADDRESS; | |
87 | maxChars: CARDINAL; | |
88 | VAR charsRead: CARDINAL) ; | |
89 | BEGIN | |
90 | doReadText(dev, d, to, maxChars, charsRead) | |
91 | END textread ; | |
92 | ||
93 | ||
94 | PROCEDURE rawread (d: DeviceTablePtr; | |
95 | to: ADDRESS; | |
96 | maxLocs: CARDINAL; | |
97 | VAR locsRead: CARDINAL) ; | |
98 | BEGIN | |
99 | doReadLocs(dev, d, to, maxLocs, locsRead) | |
100 | END rawread ; | |
101 | ||
102 | ||
103 | PROCEDURE getname (d: DeviceTablePtr; | |
104 | VAR a: ARRAY OF CHAR) ; | |
105 | BEGIN | |
106 | d^.doGetName(d, a) | |
107 | END getname ; | |
108 | ||
109 | ||
110 | PROCEDURE flush (d: DeviceTablePtr) ; | |
111 | BEGIN | |
112 | END flush ; | |
113 | ||
114 | ||
115 | PROCEDURE handlefree (d: DeviceTablePtr) ; | |
116 | BEGIN | |
117 | END handlefree ; | |
118 | ||
119 | ||
120 | PROCEDURE reset (d: DeviceTablePtr) ; | |
121 | VAR | |
122 | a : ArgInfo ; | |
123 | BEGIN | |
124 | a := GetData(d, mid) ; | |
125 | WITH a^ DO | |
126 | currentPtr := ArgData ; | |
127 | currentPos := 0 ; | |
128 | currentArg := 0 ; | |
129 | argLength := strlen(currentPtr)+1 ; | |
130 | argc := GetArgC () | |
131 | END | |
132 | END reset ; | |
133 | ||
134 | ||
135 | (* | |
136 | doreadchar - returns a CHAR from the file associated with, g. | |
137 | *) | |
138 | ||
139 | PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ; | |
140 | VAR | |
141 | a : ArgInfo ; | |
142 | ch: CHAR ; | |
143 | BEGIN | |
144 | d := DeviceTablePtrValue(cid, did) ; | |
145 | a := GetData(d, mid) ; | |
146 | WITH a^ DO | |
147 | IF currentPos<argLength | |
148 | THEN | |
149 | ch := currentPtr^ ; | |
150 | INC(currentPtr) ; | |
151 | INC(currentPos) ; | |
152 | d^.result := allRight ; | |
153 | RETURN( ch ) | |
154 | ELSE | |
155 | d^.result := endOfInput ; | |
156 | RETURN( nul ) | |
157 | END | |
158 | END | |
159 | END doreadchar ; | |
160 | ||
161 | ||
162 | (* | |
163 | dounreadchar - pushes a CHAR back onto the file associated with, g. | |
164 | *) | |
165 | ||
166 | PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ; | |
167 | VAR | |
168 | a: ArgInfo ; | |
169 | BEGIN | |
170 | d := DeviceTablePtrValue(cid, did) ; | |
171 | a := GetData(d, mid) ; | |
172 | WITH a^ DO | |
173 | IF currentPos>0 | |
174 | THEN | |
175 | DEC(currentPtr) ; | |
176 | DEC(currentPos) | |
177 | END | |
178 | END ; | |
179 | RETURN( ch ) | |
180 | END dounreadchar ; | |
181 | ||
182 | ||
183 | (* | |
184 | dogeterrno - returns the errno relating to the generic device. | |
185 | *) | |
186 | ||
187 | PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ; | |
188 | BEGIN | |
189 | RETURN 0 | |
190 | END dogeterrno ; | |
191 | ||
192 | ||
193 | (* | |
194 | dorbytes - reads upto, max, bytes setting, actual, and | |
195 | returning FALSE if an error (not due to eof) | |
196 | occurred. | |
197 | *) | |
198 | ||
199 | PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr; | |
200 | to: ADDRESS; | |
201 | max: CARDINAL; | |
202 | VAR actual: CARDINAL) : BOOLEAN ; | |
203 | VAR | |
204 | p: PtrToChar ; | |
205 | i: CARDINAL ; | |
206 | BEGIN | |
207 | WITH d^ DO | |
208 | p := to ; | |
209 | i := 0 ; | |
210 | WHILE (i<max) AND ((result=notKnown) OR (result=allRight) OR (result=endOfLine)) DO | |
211 | p^ := doreadchar(g, d) ; | |
212 | INC(i) ; | |
213 | INC(p) | |
214 | END ; | |
215 | RETURN( TRUE ) | |
216 | END | |
217 | END dorbytes ; | |
218 | ||
219 | ||
220 | (* | |
221 | dowbytes - | |
222 | *) | |
223 | ||
224 | PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr; | |
225 | from: ADDRESS; | |
226 | nBytes: CARDINAL; | |
227 | VAR actual: CARDINAL) : BOOLEAN ; | |
228 | BEGIN | |
229 | RAISEdevException(cid, did, notAvailable, | |
230 | 'ProgramArgs.dowbytes: not allowed to write to this channel') ; | |
231 | RETURN( FALSE ) | |
232 | END dowbytes ; | |
233 | ||
234 | ||
235 | (* | |
236 | dowriteln - attempt to write an end of line marker to the | |
237 | file and returns TRUE if successful. | |
238 | *) | |
239 | ||
240 | PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ; | |
241 | BEGIN | |
242 | RAISEdevException(cid, did, notAvailable, | |
243 | 'ProgramArgs.dowbytes: not allowed to write to this channel') ; | |
244 | RETURN( FALSE ) | |
245 | END dowriteln ; | |
246 | ||
247 | ||
248 | (* | |
249 | iseof - returns TRUE if end of file is seen. | |
250 | *) | |
251 | ||
252 | PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ; | |
253 | VAR | |
254 | a: ArgInfo ; | |
255 | BEGIN | |
256 | d := DeviceTablePtrValue(cid, did) ; | |
257 | a := GetData(d, mid) ; | |
258 | WITH a^ DO | |
259 | RETURN( currentPos=ArgLength ) | |
260 | END | |
261 | END iseof ; | |
262 | ||
263 | ||
264 | (* | |
265 | iseoln - returns TRUE if end of line is seen. | |
266 | *) | |
267 | ||
268 | PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ; | |
269 | VAR | |
270 | ch: CHAR ; | |
271 | BEGIN | |
272 | IF iseof(g, d) | |
273 | THEN | |
274 | RETURN( FALSE ) | |
275 | ELSE | |
276 | ch := doreadchar(g, d) ; | |
277 | IF ch#dounreadchar(g, d, ch) | |
278 | THEN | |
279 | RAISEdevException(cid, did, hardDeviceError, | |
280 | 'ProgramArgs.iseoln: internal inconsistancy error') | |
281 | END ; | |
282 | RETURN( ch=lf ) | |
283 | END | |
284 | END iseoln ; | |
285 | ||
286 | ||
287 | (* | |
288 | iserror - returns TRUE if an error was seen on the device. | |
289 | *) | |
290 | ||
291 | PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ; | |
292 | BEGIN | |
293 | RETURN( FALSE ) | |
294 | END iserror ; | |
295 | ||
296 | ||
297 | (* | |
298 | strlen - returns the number characters in string at this point. | |
299 | *) | |
300 | ||
301 | PROCEDURE strlen (p: PtrToChar) : CARDINAL ; | |
302 | VAR | |
303 | n: CARDINAL ; | |
304 | BEGIN | |
305 | n := 0 ; | |
306 | WHILE p^#nul DO | |
307 | INC(n) ; | |
308 | INC(p) | |
309 | END ; | |
310 | RETURN( n ) | |
311 | END strlen ; | |
312 | ||
313 | ||
314 | (* | |
315 | ArgChan - returns a value that identifies a channel for | |
316 | reading program arguments. | |
317 | *) | |
318 | ||
319 | PROCEDURE ArgChan () : ChanId ; | |
320 | BEGIN | |
321 | RETURN( cid ) | |
322 | END ArgChan ; | |
323 | ||
324 | ||
325 | (* | |
326 | IsArgPresent - tests if there is a current argument to | |
327 | read from. If not, | |
328 | read <= IOChan.CurrentFlags() will be FALSE, | |
329 | and attempting to read from the argument | |
330 | channel will raise the exception | |
331 | notAvailable. | |
332 | *) | |
333 | ||
334 | PROCEDURE IsArgPresent () : BOOLEAN ; | |
335 | VAR | |
336 | d: DeviceTablePtr ; | |
337 | a: ArgInfo ; | |
338 | BEGIN | |
339 | d := DeviceTablePtrValue(cid, did) ; | |
340 | a := GetData(d, mid) ; | |
341 | WITH a^ DO | |
342 | RETURN( currentArg<argc ) | |
343 | END | |
344 | END IsArgPresent ; | |
345 | ||
346 | ||
347 | (* | |
348 | NextArg - if there is another argument, causes subsequent | |
349 | input from the argument device to come from the | |
350 | start of the next argument. Otherwise there is | |
351 | no argument to read from, and a call of | |
352 | IsArgPresent will return FALSE. | |
353 | *) | |
354 | ||
355 | PROCEDURE NextArg ; | |
356 | VAR | |
357 | d: DeviceTablePtr ; | |
358 | a: ArgInfo ; | |
359 | p: PtrToChar ; | |
360 | BEGIN | |
361 | d := DeviceTablePtrValue(cid, did) ; | |
362 | a := GetData(d, mid) ; | |
363 | WITH a^ DO | |
364 | IF currentArg<argc | |
365 | THEN | |
366 | INC(currentArg) ; | |
367 | WHILE (currentPos<argLength) AND (currentPtr^#nul) DO | |
368 | INC(currentPos) ; | |
369 | INC(currentPtr) | |
370 | END ; | |
371 | INC(currentPtr) ; (* move over nul onto first char of next arg *) | |
372 | argLength := strlen(currentPtr)+1 ; | |
373 | currentPos := 0 | |
374 | END | |
375 | END | |
376 | END NextArg ; | |
377 | ||
378 | ||
379 | (* | |
380 | collectArgs - | |
381 | *) | |
382 | ||
383 | PROCEDURE collectArgs ; | |
384 | VAR | |
385 | i : INTEGER ; | |
386 | n : CARDINAL ; | |
387 | pp : POINTER TO PtrToChar ; | |
388 | p, q: PtrToChar ; | |
389 | BEGIN | |
390 | (* count the number of bytes necessary to remember all arg data *) | |
391 | n := 0 ; | |
392 | i := 0 ; | |
393 | pp := GetArgV () ; | |
394 | WHILE i < GetArgC () DO | |
395 | p := pp^ ; | |
396 | WHILE p^#nul DO | |
397 | INC(p) ; | |
398 | INC(n) | |
399 | END ; | |
400 | INC(n) ; | |
401 | INC(pp, SIZE(ADDRESS)) ; | |
402 | INC(i) | |
403 | END ; | |
404 | ArgLength := n ; | |
405 | (* now allocate correct amount of memory and copy the data *) | |
406 | ALLOCATE(ArgData, ArgLength) ; | |
407 | i := 0 ; | |
408 | pp := GetArgV () ; | |
409 | q := ArgData ; | |
410 | WHILE i < GetArgC () DO | |
411 | p := pp^ ; | |
412 | WHILE p^#nul DO | |
413 | q^ := p^ ; | |
414 | INC(q) ; | |
415 | INC(p) | |
416 | END ; | |
417 | q^ := p^ ; | |
418 | INC(q) ; | |
419 | INC(pp, SIZE(ADDRESS)) ; | |
420 | INC(i) | |
421 | END | |
422 | END collectArgs ; | |
423 | ||
424 | ||
425 | (* | |
426 | freeData - deallocates, a. | |
427 | *) | |
428 | ||
429 | PROCEDURE freeData (a: ArgInfo) ; | |
430 | BEGIN | |
431 | DISPOSE(a) | |
432 | END freeData ; | |
433 | ||
434 | ||
435 | (* | |
436 | Init - | |
437 | *) | |
438 | ||
439 | PROCEDURE Init ; | |
440 | VAR | |
441 | d: DeviceTablePtr ; | |
442 | a: ArgInfo ; | |
443 | BEGIN | |
444 | MakeModuleId(mid) ; | |
445 | AllocateDeviceId(did) ; | |
446 | MakeChan(did, cid) ; | |
447 | collectArgs ; | |
448 | NEW(a) ; | |
449 | WITH a^ DO | |
450 | currentPtr := ArgData ; | |
451 | currentPos := 0 ; | |
452 | currentArg := 0 ; | |
453 | argLength := strlen(currentPtr)+1 ; | |
454 | argc := GetArgC () | |
455 | END ; | |
456 | d := DeviceTablePtrValue(cid, did) ; | |
457 | InitData(d, mid, a, freeData) ; | |
458 | gen := InitGenDevIF(did, | |
459 | doreadchar, dounreadchar, | |
460 | dogeterrno, dorbytes, dowbytes, | |
461 | dowriteln, | |
462 | iseof, iseoln, iserror) ; | |
463 | dev := InitChanDev(programargs, did, gen) ; | |
464 | WITH d^ DO | |
465 | flags := read + text ; | |
466 | errNum := 0 ; | |
467 | doLook := look ; | |
468 | doSkip := skip ; | |
469 | doSkipLook := skiplook ; | |
470 | doTextRead := textread ; | |
471 | doRawRead := rawread ; | |
472 | doGetName := getname ; | |
473 | doReset := reset ; | |
474 | doFlush := flush ; | |
475 | doFree := handlefree | |
476 | END | |
477 | END Init ; | |
478 | ||
479 | ||
480 | BEGIN | |
481 | Init | |
482 | END ProgramArgs. |