]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* FormatStrings.mod provides a pseudo printf capability. |
2 | ||
a945c346 | 3 | Copyright (C) 2005-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 | 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 FormatStrings ; | |
28 | ||
01cca857 | 29 | FROM DynamicStrings IMPORT InitString, InitStringChar, Mark, |
1eee94d3 GM |
30 | ConCat, Slice, Index, char, string, |
31 | Assign, Length, Mult, Dup, ConCatChar, | |
32 | PushAllocation, PopAllocationExemption, | |
33 | InitStringDB, InitStringCharStarDB, | |
34 | InitStringCharDB, MultDB, DupDB, SliceDB, | |
01cca857 | 35 | KillString ; |
1eee94d3 GM |
36 | |
37 | FROM StringConvert IMPORT IntegerToString, CardinalToString, hstoc ; | |
38 | FROM SYSTEM IMPORT ADDRESS ; | |
39 | ||
40 | IMPORT ASCII ; | |
41 | ||
42 | ||
43 | (* | |
44 | #undef GM2_DEBUG_FORMATSTRINGS | |
45 | #if defined(GM2_DEBUG_FORMATSTRINGS) | |
46 | # define InitString(X) InitStringDB(X, __FILE__, __LINE__) | |
47 | # define InitStringCharStar(X) InitStringCharStarDB(X, __FILE__, __LINE__) | |
48 | # define InitStringChar(X) InitStringCharDB(X, __FILE__, __LINE__) | |
49 | # define Mult(X,Y) MultDB(X, Y, __FILE__, __LINE__) | |
50 | # define Dup(X) DupDB(X, __FILE__, __LINE__) | |
51 | # define Slice(X,Y,Z) SliceDB(X, Y, Z, __FILE__, __LINE__) | |
52 | #endif | |
53 | *) | |
54 | ||
55 | ||
56 | (* | |
57 | doDSdbEnter - | |
58 | *) | |
59 | ||
60 | PROCEDURE doDSdbEnter ; | |
61 | BEGIN | |
62 | PushAllocation | |
63 | END doDSdbEnter ; | |
64 | ||
65 | ||
66 | (* | |
67 | doDSdbExit - | |
68 | *) | |
69 | ||
70 | PROCEDURE doDSdbExit (s: String) ; | |
71 | BEGIN | |
72 | s := PopAllocationExemption (TRUE, s) | |
73 | END doDSdbExit ; | |
74 | ||
75 | ||
76 | (* | |
77 | DSdbEnter - | |
78 | *) | |
79 | ||
80 | PROCEDURE DSdbEnter ; | |
81 | BEGIN | |
82 | END DSdbEnter ; | |
83 | ||
84 | ||
85 | (* | |
86 | DSdbExit - | |
87 | *) | |
88 | ||
89 | PROCEDURE DSdbExit (s: String) ; | |
90 | BEGIN | |
91 | END DSdbExit ; | |
92 | ||
93 | ||
94 | (* | |
95 | #if defined(GM2_DEBUG_FORMATSTRINGS) | |
96 | # define DBsbEnter doDBsbEnter | |
97 | # define DBsbExit doDBsbExit | |
98 | #endif | |
99 | *) | |
100 | ||
101 | ||
102 | (* | |
103 | IsDigit - returns TRUE if ch lies in the range: 0..9 | |
104 | *) | |
105 | ||
106 | PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ; | |
107 | BEGIN | |
108 | RETURN( (ch>='0') AND (ch<='9') ) | |
109 | END IsDigit ; | |
110 | ||
111 | ||
112 | (* | |
113 | Cast - casts a := b | |
114 | *) | |
115 | ||
116 | PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ; | |
117 | VAR | |
118 | i: CARDINAL ; | |
119 | BEGIN | |
120 | IF HIGH(a)=HIGH(b) | |
121 | THEN | |
122 | FOR i := 0 TO HIGH(a) DO | |
123 | a[i] := b[i] | |
124 | END | |
125 | ELSE | |
126 | HALT | |
127 | END | |
128 | END Cast ; | |
129 | ||
130 | ||
131 | (* | |
132 | isHex - | |
133 | *) | |
134 | ||
135 | PROCEDURE isHex (ch: CHAR) : BOOLEAN ; | |
136 | BEGIN | |
137 | RETURN ( ((ch >= '0') AND (ch <= '9')) OR | |
138 | ((ch >= 'A') AND (ch <= 'F')) OR | |
139 | ((ch >= 'a') AND (ch <= 'f')) ) | |
140 | END isHex ; | |
141 | ||
142 | ||
143 | (* | |
144 | toHex - | |
145 | *) | |
146 | ||
147 | PROCEDURE toHex (ch: CHAR) : CARDINAL ; | |
148 | BEGIN | |
149 | IF ((ch >= '0') AND (ch <= '9')) | |
150 | THEN | |
151 | RETURN ORD (ch) - ORD ('0') | |
152 | ELSIF (ch >= 'A') AND (ch <= 'F') | |
153 | THEN | |
154 | RETURN ORD (ch) - ORD ('A') + 10 | |
155 | ELSE | |
156 | RETURN ORD (ch) - ORD ('a') + 10 | |
157 | END | |
158 | END toHex ; | |
159 | ||
160 | ||
161 | (* | |
162 | toOct - | |
163 | *) | |
164 | ||
165 | PROCEDURE toOct (ch: CHAR) : CARDINAL ; | |
166 | BEGIN | |
167 | RETURN ORD (ch) - ORD ('0') | |
168 | END toOct ; | |
169 | ||
170 | ||
171 | (* | |
172 | isOct - | |
173 | *) | |
174 | ||
175 | PROCEDURE isOct (ch: CHAR) : BOOLEAN ; | |
176 | BEGIN | |
177 | RETURN (ch >= '0') AND (ch <= '8') | |
178 | END isOct ; | |
179 | ||
180 | ||
181 | (* | |
182 | HandleEscape - translates \a, \b, \e, \f, \n, \r, \x[hex] \[octal] into | |
183 | their respective ascii codes. It also converts \[any] into | |
184 | a single [any] character. | |
185 | *) | |
186 | ||
187 | PROCEDURE HandleEscape (s: String) : String ; | |
188 | VAR | |
189 | d : String ; | |
190 | i, j: INTEGER ; | |
191 | ch : CHAR ; | |
192 | b : BYTE ; | |
193 | BEGIN | |
194 | DSdbEnter ; | |
195 | d := InitString ('') ; | |
196 | i := Index (s, '\', 0) ; | |
197 | j := 0 ; | |
198 | WHILE i>=0 DO | |
199 | IF i>0 | |
200 | THEN | |
201 | (* initially i might be zero which means the end of the string, which is not what we want. *) | |
202 | d := ConCat (d, Slice (s, j, i)) | |
203 | END ; | |
204 | ch := char (s, i+1) ; | |
205 | IF ch='a' | |
206 | THEN | |
207 | (* requires a bell. *) | |
208 | d := ConCat (d, Mark (InitStringChar (ASCII.bel))) | |
209 | ELSIF ch='b' | |
210 | THEN | |
211 | (* requires a backspace. *) | |
212 | d := ConCat (d, Mark (InitStringChar (ASCII.bs))) | |
213 | ELSIF ch='e' | |
214 | THEN | |
215 | (* requires a escape. *) | |
216 | d := ConCat (d, Mark (InitStringChar (ASCII.esc))) | |
217 | ELSIF ch='f' | |
218 | THEN | |
219 | (* requires a formfeed. *) | |
220 | d := ConCat (d, Mark (InitStringChar (ASCII.ff))) | |
221 | ELSIF ch='n' | |
222 | THEN | |
223 | (* requires a newline. *) | |
224 | d := ConCat (d, Mark (InitStringChar (ASCII.nl))) | |
225 | ELSIF ch='r' | |
226 | THEN | |
227 | (* requires a carriage return. *) | |
228 | d := ConCat (d, Mark (InitStringChar (ASCII.cr))) | |
229 | ELSIF ch='t' | |
230 | THEN | |
231 | (* requires a tab. *) | |
232 | d := ConCat (d, Mark (InitStringChar (ASCII.tab))) | |
233 | ELSIF ch='x' | |
234 | THEN | |
235 | INC (i) ; | |
236 | IF isHex (char (s, i+1)) | |
237 | THEN | |
238 | b := VAL (BYTE, toHex (char (s, i+1))) ; | |
239 | INC (i) ; | |
240 | IF isHex (char (s, i+1)) | |
241 | THEN | |
242 | b := VAL (BYTE, VAL (CARDINAL, b) * 010H + toHex (char (s, i+1))) ; | |
243 | d := ConCat (d, Mark (InitStringChar (VAL (CHAR, b)))) | |
244 | END | |
245 | END | |
246 | ELSIF isOct (ch) | |
247 | THEN | |
248 | b := VAL (BYTE, toOct (ch)) ; | |
249 | INC (i) ; | |
250 | IF isOct (char (s, i+1)) | |
251 | THEN | |
252 | b := VAL (BYTE, VAL (CARDINAL, b) * 8 + toOct (char (s, i+1))) ; | |
253 | INC (i) ; | |
254 | IF isOct (char (s, i+1)) | |
255 | THEN | |
256 | b := VAL (BYTE, VAL (CARDINAL, b) * 8 + toOct (char (s, i+1))) | |
257 | END | |
258 | END ; | |
259 | d := ConCat (d, Mark (InitStringChar (VAL (CHAR, b)))) | |
260 | ELSE | |
261 | (* copy escaped character. *) | |
262 | d := ConCat (d, Mark (InitStringChar (ch))) | |
263 | END ; | |
264 | INC (i, 2) ; | |
265 | j := i ; | |
266 | i := Index (s, '\', CARDINAL (i)) | |
267 | END ; | |
268 | (* s := Assign(s, Mark(ConCat(d, Mark(Slice(s, j, 0))))) ; (* dont Mark(s) in the Slice as we Assign contents *) *) | |
269 | s := ConCat (d, Mark (Slice (Mark (s), j, 0))) ; | |
270 | DSdbExit (s) ; | |
271 | RETURN s | |
272 | END HandleEscape ; | |
273 | ||
274 | ||
275 | (* | |
276 | FormatString - returns a String containing, s, together with encapsulated | |
277 | entity, w. It only formats the first %s or %d or %u with n. | |
278 | A new string is returned. | |
279 | *) | |
280 | ||
281 | PROCEDURE FormatString (fmt: String; VAR startpos: INTEGER; in: String; w: ARRAY OF BYTE) : String ; | |
282 | VAR | |
283 | s: String ; | |
284 | BEGIN | |
285 | DSdbEnter ; | |
286 | IF startpos >= 0 | |
287 | THEN | |
288 | s := PerformFormatString (fmt, startpos, in, w) | |
289 | ELSE | |
290 | s := Dup (in) | |
291 | END ; | |
292 | DSdbExit (s) ; | |
293 | RETURN s | |
294 | END FormatString ; | |
295 | ||
296 | ||
297 | PROCEDURE PerformFormatString (fmt: String; VAR startpos: INTEGER; in: String; w: ARRAY OF BYTE) : String ; | |
298 | VAR | |
299 | left : BOOLEAN ; | |
300 | u : CARDINAL ; | |
301 | c, | |
302 | width, | |
303 | nextperc, | |
1bd13193 | 304 | afterperc: INTEGER ; |
1eee94d3 GM |
305 | leader, |
306 | ch, ch2 : CHAR ; | |
307 | p : String ; | |
308 | BEGIN | |
309 | WHILE startpos >= 0 DO | |
310 | nextperc := Index (fmt, '%', startpos) ; | |
311 | afterperc := nextperc ; | |
312 | IF nextperc >= 0 | |
313 | THEN | |
314 | INC (afterperc) ; | |
315 | IF char (fmt, afterperc)='-' | |
316 | THEN | |
317 | left := TRUE ; | |
318 | INC (afterperc) | |
319 | ELSE | |
320 | left := FALSE | |
321 | END ; | |
322 | ch := char (fmt, afterperc) ; | |
323 | IF ch = '0' | |
324 | THEN | |
325 | leader := '0' | |
326 | ELSE | |
327 | leader := ' ' | |
328 | END ; | |
329 | width := 0 ; | |
330 | WHILE IsDigit (ch) DO | |
331 | width := (width*10)+VAL (INTEGER, ORD (ch) - ORD ('0')) ; | |
332 | INC (afterperc) ; | |
333 | ch := char (fmt, afterperc) | |
334 | END ; | |
335 | IF (ch='c') OR (ch='s') | |
336 | THEN | |
337 | INC (afterperc) ; | |
338 | IF (ch='c') | |
339 | THEN | |
340 | ch2 := w[0] ; | |
341 | p := ConCatChar (InitString (''), ch2) | |
342 | ELSE | |
343 | Cast (p, w) ; | |
344 | p := Dup (p) | |
345 | END ; | |
346 | IF (width>0) AND (VAL (INTEGER, Length (p)) < width) | |
347 | THEN | |
348 | IF left | |
349 | THEN | |
350 | (* place trailing spaces after, p. *) | |
351 | p := ConCat(p, | |
352 | Mark(Mult(Mark(InitString(' ')), width-VAL(INTEGER, Length(p))))) | |
353 | ELSE | |
354 | (* padd string, p, with leading spaces. *) | |
355 | p := ConCat(Mult(Mark(InitString(' ')), width-VAL(INTEGER, Length(p))), | |
356 | Mark(p)) | |
357 | END | |
358 | END ; | |
359 | (* include string, p, into, in. *) | |
360 | IF nextperc > 0 | |
361 | THEN | |
362 | in := ConCat (in, Slice (fmt, startpos, nextperc)) | |
363 | END ; | |
364 | in := ConCat (in, p) ; | |
365 | startpos := afterperc ; | |
366 | DSdbExit (NIL) ; | |
367 | RETURN in | |
368 | ELSIF ch='d' | |
369 | THEN | |
370 | INC (afterperc) ; | |
371 | Cast (c, w) ; | |
372 | in := Copy (fmt, in, startpos, nextperc) ; | |
373 | in := ConCat (in, IntegerToString (c, width, leader, FALSE, 10, FALSE)) ; | |
374 | startpos := afterperc ; | |
375 | DSdbExit (NIL) ; | |
376 | RETURN in | |
377 | ELSIF ch='x' | |
378 | THEN | |
379 | INC (afterperc) ; | |
380 | Cast (u, w) ; | |
381 | in := ConCat (in, Slice (fmt, startpos, nextperc)) ; | |
382 | in := ConCat (in, CardinalToString (u, width, leader, 16, TRUE)) ; | |
383 | startpos := afterperc ; | |
384 | DSdbExit (NIL) ; | |
385 | RETURN in | |
386 | ELSIF ch='u' | |
387 | THEN | |
388 | INC (afterperc) ; | |
389 | Cast (u, w) ; | |
390 | in := ConCat (in, Slice (fmt, startpos, nextperc)) ; | |
391 | in := ConCat (in, CardinalToString (u, width, leader, 10, FALSE)) ; | |
392 | startpos := afterperc ; | |
393 | DSdbExit (NIL) ; | |
394 | RETURN in | |
395 | ELSE | |
396 | INC (afterperc) ; | |
397 | (* copy format string. *) | |
398 | IF nextperc > 0 | |
399 | THEN | |
400 | in := ConCat (in, Slice (fmt, startpos, nextperc)) | |
401 | END ; | |
402 | (* and the character after the %. *) | |
403 | in := ConCat (in, Mark (InitStringChar (ch))) | |
404 | END ; | |
405 | startpos := afterperc | |
406 | ELSE | |
407 | (* nothing to do. *) | |
408 | DSdbExit (NIL) ; | |
409 | RETURN in | |
410 | END | |
411 | END ; | |
412 | DSdbExit (NIL) ; | |
413 | RETURN in | |
414 | END PerformFormatString ; | |
415 | ||
416 | ||
417 | (* | |
418 | Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0. | |
419 | *) | |
420 | ||
421 | PROCEDURE Copy (fmt, in: String; start, end: INTEGER) : String ; | |
422 | BEGIN | |
423 | IF start >= 0 | |
424 | THEN | |
425 | IF end > 0 | |
426 | THEN | |
427 | in := ConCat (in, Mark (Slice (fmt, start, end))) | |
428 | ELSIF end < 0 | |
429 | THEN | |
430 | in := ConCat (in, Mark (Slice (fmt, start, 0))) | |
431 | END | |
432 | END ; | |
433 | RETURN in | |
434 | END Copy ; | |
435 | ||
436 | ||
437 | (* | |
438 | HandlePercent - pre-condition: s, is a string. | |
439 | Post-condition: a new string is returned which is a copy of, | |
440 | s, except %% is transformed into %. | |
441 | *) | |
442 | ||
443 | PROCEDURE HandlePercent (fmt, s: String; startpos: INTEGER) : String ; | |
444 | VAR | |
445 | prevpos: INTEGER ; | |
1eee94d3 GM |
446 | BEGIN |
447 | IF (startpos = VAL (INTEGER, Length (fmt))) OR (startpos < 0) | |
448 | THEN | |
449 | RETURN s | |
450 | ELSE | |
451 | prevpos := startpos ; | |
452 | WHILE (startpos >= 0) AND (prevpos < INTEGER (Length (fmt))) DO | |
453 | startpos := Index (fmt, '%', startpos) ; | |
454 | IF startpos >= prevpos | |
455 | THEN | |
456 | IF startpos > 0 | |
457 | THEN | |
458 | s := ConCat (s, Mark (Slice (fmt, prevpos, startpos))) | |
459 | END ; | |
460 | INC (startpos) ; | |
461 | IF char (fmt, startpos) = '%' | |
462 | THEN | |
463 | s := ConCatChar (s, '%') ; | |
464 | INC (startpos) | |
465 | END ; | |
466 | prevpos := startpos | |
467 | END | |
468 | END ; | |
469 | IF (prevpos < INTEGER (Length (fmt))) | |
470 | THEN | |
471 | s := ConCat (s, Mark (Slice (fmt, prevpos, 0))) | |
472 | END ; | |
473 | RETURN s | |
474 | END | |
475 | END HandlePercent ; | |
476 | ||
477 | ||
478 | (* | |
479 | Sprintf0 - returns a String containing, s, after it has had its | |
480 | escape sequences translated. | |
481 | *) | |
482 | ||
483 | PROCEDURE Sprintf0 (fmt: String) : String ; | |
484 | VAR | |
485 | s: String ; | |
486 | BEGIN | |
487 | DSdbEnter ; | |
488 | fmt := HandleEscape (fmt) ; | |
489 | s := HandlePercent (fmt, InitString (''), 0) ; | |
490 | DSdbExit (s) ; | |
491 | RETURN s | |
492 | END Sprintf0 ; | |
493 | ||
494 | ||
495 | (* | |
496 | Sprintf1 - returns a String containing, s, together with encapsulated | |
497 | entity, w. It only formats the first %s or %d with n. | |
498 | *) | |
499 | ||
500 | PROCEDURE Sprintf1 (fmt: String; w: ARRAY OF BYTE) : String ; | |
501 | VAR | |
502 | i: INTEGER ; | |
503 | s: String ; | |
504 | BEGIN | |
505 | DSdbEnter ; | |
506 | fmt := HandleEscape (fmt) ; | |
507 | i := 0 ; | |
508 | s := FormatString (fmt, i, InitString (''), w) ; | |
509 | s := HandlePercent (fmt, s, i) ; | |
510 | DSdbExit (s) ; | |
511 | RETURN s | |
512 | END Sprintf1 ; | |
513 | ||
514 | ||
515 | (* | |
516 | Sprintf2 - returns a string, s, which has been formatted. | |
517 | *) | |
518 | ||
519 | PROCEDURE Sprintf2 (fmt: String; w1, w2: ARRAY OF BYTE) : String ; | |
520 | VAR | |
521 | i: INTEGER ; | |
522 | s: String ; | |
523 | BEGIN | |
524 | DSdbEnter ; | |
525 | fmt := HandleEscape (fmt) ; | |
526 | i := 0 ; | |
527 | s := FormatString (fmt, i, InitString (''), w1) ; | |
528 | s := FormatString (fmt, i, s, w2) ; | |
529 | s := HandlePercent (fmt, s, i) ; | |
530 | DSdbExit (s) ; | |
531 | RETURN s | |
532 | END Sprintf2 ; | |
533 | ||
534 | ||
535 | (* | |
536 | Sprintf3 - returns a string, s, which has been formatted. | |
537 | *) | |
538 | ||
539 | PROCEDURE Sprintf3 (fmt: String; w1, w2, w3: ARRAY OF BYTE) : String ; | |
540 | VAR | |
541 | i: INTEGER ; | |
542 | s: String ; | |
543 | BEGIN | |
544 | DSdbEnter ; | |
545 | fmt := HandleEscape (fmt) ; | |
546 | i := 0 ; | |
547 | s := FormatString (fmt, i, InitString (''), w1) ; | |
548 | s := FormatString (fmt, i, s, w2) ; | |
549 | s := FormatString (fmt, i, s, w3) ; | |
550 | s := HandlePercent (fmt, s, i) ; | |
551 | DSdbExit (s) ; | |
552 | RETURN s | |
553 | END Sprintf3 ; | |
554 | ||
555 | ||
556 | (* | |
557 | Sprintf4 - returns a string, s, which has been formatted. | |
558 | *) | |
559 | ||
560 | PROCEDURE Sprintf4 (fmt: String; w1, w2, w3, w4: ARRAY OF BYTE) : String ; | |
561 | VAR | |
562 | i: INTEGER ; | |
563 | s: String ; | |
564 | BEGIN | |
565 | DSdbEnter ; | |
566 | fmt := HandleEscape (fmt) ; | |
567 | i := 0 ; | |
568 | s := FormatString (fmt, i, InitString (''), w1) ; | |
569 | s := FormatString (fmt, i, s, w2) ; | |
570 | s := FormatString (fmt, i, s, w3) ; | |
571 | s := FormatString (fmt, i, s, w4) ; | |
572 | s := HandlePercent (fmt, s, i) ; | |
573 | DSdbExit (s) ; | |
574 | RETURN s | |
575 | END Sprintf4 ; | |
576 | ||
577 | ||
578 | END FormatStrings. |