statements.c
1 //! @file statements.c
2 //! @author J. Marcel van der Veer
3 //
4 //! @section Copyright
5 //
6 // This file is part of VIF - vintage FORTRAN compiler.
7 // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
8 //
9 //! @section License
10 //
11 // This program is free software; you can redistribute it and/or modify it
12 // under the terms of the GNU General Public License as published by the
13 // Free Software Foundation; either version 3 of the License, or
14 // (at your option) any later version.
15 //
16 // This program is distributed in the hope that it will be useful, but
17 // WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 // or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 // more details. You should have received a copy of the GNU General Public
20 // License along with this program. If not, see <http://www.gnu.org/licenses/>.
21
22 //! @section Synopsis
23 //!
24 //! Compile statements.
25
26 #include <vif.h>
27
28 int_4 patch (int_4 where, char *str)
29 {
30 if (where >= 0 && where < n_c_src) {
31 C_SRC *lin = &object[where];
32 if (str != NO_TEXT) {
33 lin->text = f_stralloc (str);
34 } else {
35 lin->text = NO_TEXT;
36 }
37 } else {
38 BUG ("patch");
39 }
40 return where;
41 }
42
43 void patch_args (void)
44 {
45 for (int_4 k = 0; k < nlocals; k++) {
46 IDENT *idf = &locals[k];
47 if (idf->arg) {
48 RECORD str;
49 if (idf->external) {
50 _srecordf (str, "%s (*%s)()", wtype (&idf->mode, NOARG, FUN), edit_f (C_NAME (idf)));
51 } else if (IS_SCALAR (idf->mode)) {
52 _srecordf (str, "%s%s", wtype (&idf->mode, ARG, NOFUN), C_NAME (idf));
53 } else {
54 _srecordf (str, "%s _p_ %s", wtype (&idf->mode, NOARG, FUN), C_NAME (idf));
55 }
56 if (idf->patch1 != 0) {
57 patch (idf->patch1, str);
58 }
59 if (idf->patch2 != 0) {
60 patch (idf->patch2, str);
61 }
62 }
63 }
64 }
65
66 //
67 // EXECUTABLE STATEMENTS
68 //
69
70 void vif_extensions(void)
71 {
72 if (TOKEN ("exit")) {
73 code (nprocs, BODY, "break;\n");
74 } else if (TOKEN ("break")) {
75 code (nprocs, BODY, "break;\n");
76 } else if (TOKEN ("cycle")) {
77 // CYCLE
78 code (nprocs, BODY, "continue;\n");
79 } else {
80 ERROR (2801, "syntax", curlex);
81 }
82 skip_card (FALSE);
83 }
84
85 void condit (int_4 depth)
86 {
87 int_4 rc = scan ("(");
88 int_4 apatch = code (nprocs, BODY, NO_TEXT);
89 EXPR reg;
90 rc = scan (EXPECT_NONE);
91 express (®, NOTYPE, NOLEN);
92 rc = scan (")");
93 rc = scan (EXPECT_NONE);
94 if (TOKEN ("then")) {
95 // Block IF.
96 skip_card (FALSE);
97 RECORD str;
98 if (reg.mode.type != LOGICAL) {
99 EXPECT (2802, "logical expression");
100 }
101 _srecordf (str, "if (%s) {\n", reg.str);
102 patch (apatch, str);
103 gen_statements (NO_LABEL, depth + 1);
104 while (TOKEN ("elseif")) {
105 EXPR reh;
106 rc = scan ("(");
107 rc = scan (EXPECT_NONE);
108 express (&reh, NOTYPE, NOLEN);
109 rc = scan (")");
110 rc = scan ("THEN");
111 if (reh.mode.type != LOGICAL) {
112 EXPECT (2803, "logical expression");
113 }
114 code (nprocs, BODY, "}\n");
115 _srecordf (str, "else if (%s) {\n", reh.str);
116 code (nprocs, BODY, str);
117 gen_statements (NO_LABEL, depth + 1);
118 }
119 if (TOKEN ("else")) {
120 skip_card (FALSE);
121 code (nprocs, BODY, "}\n");
122 code (nprocs, BODY, "else {\n");
123 gen_statements (NO_LABEL, depth + 1);
124 }
125 if (TOKEN ("endif")) {
126 skip_card (FALSE);
127 } else {
128 EXPECT (2804, "endif");
129 }
130 code (nprocs, BODY, "}\n");
131 } else if (rc == INT_NUMBER) {
132 // Arithmetic IF.
133 RECORD str, tmp, l1, l2, l3;
134 RECCLR (l1);
135 RECCLR (l2);
136 RECCLR (l3);
137 LBL *lab1, *lab2, *lab3;
138 IDENT *idf;
139 int_4 N = 0;
140 // Gather the labels
141 strcpy (l1, curlex);
142 lab1 = find_label (l1);
143 if (lab1 == NO_LABEL) {
144 ERROR (2805, "no such label", l1);
145 return;
146 }
147 lab1->jumped++;
148 rc = scan (",");
149 rc = scan (EXPECT_NONE);
150 if (rc != INT_NUMBER) {
151 EXPECT (2806, "label");
152 return;
153 }
154 strcpy (l2, curlex);
155 lab2 = find_label (l2);
156 if (lab2 == NO_LABEL) {
157 ERROR (2807, "no such label", l2);
158 return;
159 }
160 lab2->jumped++;
161 rc = scan (",");
162 if (rc == END_OF_LINE) {
163 N = 2;
164 } else {
165 N = 3;
166 rc = scan (EXPECT_NONE);
167 if (rc != INT_NUMBER) {
168 EXPECT (2808, "label");
169 return;
170 }
171 strcpy (l3, curlex);
172 lab3 = find_label (l3);
173 if (lab3 == NO_LABEL) {
174 ERROR (2809, "no such label", l3);
175 return;
176 }
177 lab3->jumped++;
178 }
179 if (N == 3) {
180 // ANSI FORTRAN three-branch arithmetic statement.
181 if (reg.mode.type != INTEGER && reg.mode.type != REAL) {
182 EXPECT (2810, "integer or real expression");
183 }
184 _srecordf (tmp, "%s", edit_tmp (nloctmps++));
185 idf = add_local (tmp, reg.mode.type, reg.mode.len, UNIQ, NOPATCH, NOARG, LOCAL, TEMP);
186 _srecordf (str, "%s = %s;\n", C_NAME (idf), reg.str);
187 code (nprocs, BODY, str);
188 _srecordf (str, "if (%s < 0) {\n", C_NAME (idf));
189 code (nprocs, BODY, str);
190 _srecordf (str, "goto _l%d;\n", lab1->num);
191 code (nprocs, BODY, str);
192 _srecordf (str, "}");
193 code (nprocs, BODY, str);
194 _srecordf (str, "else if (%s == 0) {\n", C_NAME (idf));
195 code (nprocs, BODY, str);
196 _srecordf (str, "goto _l%d;\n", lab2->num);
197 code (nprocs, BODY, str);
198 _srecordf (str, "}");
199 code (nprocs, BODY, str);
200 _srecordf (str, "else {\n");
201 code (nprocs, BODY, str);
202 _srecordf (str, "goto _l%d;\n", lab3->num);
203 code (nprocs, BODY, str);
204 _srecordf (str, "}\n");
205 code (nprocs, BODY, str);
206 } else {
207 // CRAY FORTRAN two-branch arithmetic statement.
208 if (reg.mode.type != INTEGER && reg.mode.type != REAL && reg.mode.type != LOGICAL) {
209 EXPECT (2811, "integer, real or logical expression");
210 }
211 if (reg.mode.type == INTEGER || reg.mode.type == REAL) {
212 if (reg.variant == EXPR_VAR || reg.variant == EXPR_SLICE) {
213 _srecordf (str, "if (%s != 0) {\n", reg.str);
214 } else {
215 _srecordf (str, "if ((%s) != 0) {\n", reg.str);
216 }
217 } else {
218 if (reg.variant == EXPR_VAR || reg.variant == EXPR_SLICE) {
219 _srecordf (str, "if (%s == TRUE) {\n", reg.str);
220 } else {
221 _srecordf (str, "if ((%s) == TRUE) {\n", reg.str);
222 }
223 }
224 code (nprocs, BODY, str);
225 _srecordf (str, "goto _l%d;\n", lab1->num);
226 code (nprocs, BODY, str);
227 _srecordf (str, "}");
228 code (nprocs, BODY, str);
229 _srecordf (str, "else {\n");
230 code (nprocs, BODY, str);
231 _srecordf (str, "goto _l%d;\n", lab2->num);
232 code (nprocs, BODY, str);
233 _srecordf (str, "}\n");
234 code (nprocs, BODY, str);
235 }
236 skip_card (FALSE);
237 } else {
238 // Logical IF.
239 RECORD str;
240 if (reg.mode.type != LOGICAL) {
241 EXPECT (2812, "logical expression");
242 }
243 _srecordf (str, "if (%s) {\n", reg.str);
244 patch (apatch, str);
245 if (TOKEN ("if")) {
246 condit (depth);
247 } else {
248 executable ();
249 }
250 code (nprocs, BODY, "}\n");
251 }
252 }
253
254 void do_loop (LBL * curlbl, int_4 depth)
255 {
256 int_4 rc;
257 LBL *newlbl;
258 EXPR lhs, from, to, by;
259 RECORD str;
260 lhs.mode.type = NOTYPE;
261 lhs.mode.len = 0;
262 rc = scan (EXPECT_LABEL);
263 if (rc != LABEL) {
264 newlbl = NO_LABEL;
265 } else {
266 newlbl = find_label (curlex);
267 if (newlbl == NO_LABEL) {
268 ERROR (2813, "no such label", curlex);
269 return;
270 }
271 if (curlbl != NO_LABEL && newlbl->line > curlbl->line) {
272 ERROR (2814, "incorrect loop nesting", NO_TEXT);
273 return;
274 }
275 rc = scan (EXPECT_NONE);
276 }
277 if (TOKEN ("repeat")) {
278 skip_card (FALSE);
279 code (nprocs, BODY, "do {\n");
280 gen_statements (newlbl, depth + 1);
281 code (nprocs, BODY, "} while (TRUE);\n");
282 } else if (TOKEN ("while")) {
283 rc = scan ("(");
284 EXPR reg;
285 rc = scan (EXPECT_NONE);
286 express (®, NOTYPE, NOLEN);
287 rc = scan (")");
288 skip_card (FALSE);
289 if (reg.mode.type != LOGICAL) {
290 EXPECT (2815, "logical expression");
291 }
292 _srecordf (str, "while (%s) {\n", reg.str);
293 code (nprocs, BODY, str);
294 gen_statements (newlbl, depth + 1);
295 code (nprocs, BODY, "}\n");
296 } else {
297 // DO 1, I = 1, 10, 2
298 if (TOKEN (",")) {
299 rc = scan (EXPECT_NONE);
300 }
301 if (rc != WORD) {
302 EXPECT (2816, "variable");
303 } else {
304 impl_decl (curlex, NO_MODE);
305 express (&lhs, NOTYPE, NOLEN);
306 if (lhs.variant != EXPR_VAR) {
307 EXPECT (2817, "variable");
308 return;
309 }
310 }
311 rc = scan ("=");
312 rc = scan (EXPECT_NONE);
313 express (&from, lhs.mode.type, lhs.mode.len);
314 rc = scan (",");
315 rc = scan (EXPECT_NONE);
316 express (&to, lhs.mode.type, lhs.mode.len);
317 rc = scan (EXPECT_NONE);
318 if (TOKEN (",")) {
319 rc = scan (EXPECT_NONE);
320 express (&by, lhs.mode.type, lhs.mode.len);
321 } else {
322 UNSCAN;
323 strcpy (by.str, "1");
324 }
325 skip_card (TRUE);
326 if (f4_do_loops) {
327 _srecordf (str, "%s = %s;\n", lhs.str, from.str);
328 code (nprocs, BODY, str);
329 code (nprocs, BODY, "do {\n");
330 gen_statements (newlbl, depth + 1);
331 if (strcmp (by.str, "1") == 0) {
332 _srecordf (str, "(%s)++;\n", lhs.str);
333 code (nprocs, BODY, str);
334 code (nprocs, BODY, "}\n");
335 _srecordf (str, "while (%s <= %s);\n", lhs.str, to.str);
336 code (nprocs, BODY, str);
337 } else if (strcmp (by.str, "-1") == 0) {
338 _srecordf (str, "(%s)--;\n", lhs.str);
339 code (nprocs, BODY, str);
340 code (nprocs, BODY, "}\n");
341 _srecordf (str, "while (%s >= %s);\n", lhs.str, to.str);
342 code (nprocs, BODY, str);
343 } else {
344 _srecordf (str, "%s += %s;\n", lhs.str, by.str);
345 code (nprocs, BODY, str);
346 code (nprocs, BODY, "}\n");
347 _srecordf (str, "while (%s > 0 ? %s <= %s : %s >= %s);\n", by.str, lhs.str, to.str, lhs.str, to.str);
348 code (nprocs, BODY, str);
349 }
350 } else {
351 if (strcmp (by.str, "1") == 0) {
352 _srecordf (str, "for (%s = %s; %s <= %s; (%s)++) {\n", lhs.str, from.str, lhs.str, to.str, lhs.str);
353 } else if (strcmp (by.str, "-1") == 0) {
354 _srecordf (str, "for (%s = %s; %s >= %s; (%s)--) {\n", lhs.str, from.str, lhs.str, to.str, lhs.str);
355 } else {
356 _srecordf (str, "for (%s = %s; (%s > 0 ? %s <= %s : %s >= %s); %s += %s) {\n", lhs.str, from.str, by.str, lhs.str, to.str, lhs.str, to.str, lhs.str, by.str);
357 }
358 code (nprocs, BODY, str);
359 gen_statements (newlbl, depth + 1);
360 code (nprocs, BODY, "}\n");
361 }
362 }
363 }
364
365 LBL *lbl = NO_LABEL;
366
367 void executable (void)
368 {
369 int_4 rc = curret;
370 if (TOKEN ("call")) {
371 // CALL
372 cpp_direct (nprocs, prelin, BODY);
373 call ();
374 code (nprocs, BODY, ";\n");
375 skip_card (FALSE);
376 } else if (TOKEN ("close")) {
377 cpp_direct (nprocs, prelin, BODY);
378 vif_close ();
379 skip_card (FALSE);
380 } else if (TOKEN ("endfile")) {
381 cpp_direct (nprocs, prelin, BODY);
382 vif_close ();
383 skip_card (FALSE);
384 } else if (TOKEN ("continue")) {
385 // CONTINUE
386 code (nprocs, BODY, ";\n");
387 skip_card (FALSE);
388 } else if (TOKEN ("goto")) {
389 // GOTO
390 cpp_direct (nprocs, prelin, BODY);
391 jump ();
392 } else if (TOKEN ("open")) {
393 cpp_direct (nprocs, prelin, BODY);
394 vif_open ();
395 skip_card (FALSE);
396 } else if (TOKEN ("pause")) {
397 // PAUSE
398 RECORD str;
399 cpp_direct (nprocs, prelin, BODY);
400 rc = scan (EXPECT_NONE);
401 if (rc == INT_NUMBER) {
402 sscanf (curlex, "%d", &rc);
403 _srecordf (str, "printf (\"PAUSE: %d\\n.\");\n", rc);
404 } else if (rc == TEXT && strlen (curlex) > 0) {
405 curlex[strlen(curlex) - 1] = '\0';
406 _srecordf (str, "printf (\"PAUSE: %s\\n.\");\n", &curlex[1]);
407 } else {
408 _srecordf (str, "printf (\"PAUSE\\n\");\n");
409 }
410 code (nprocs, BODY, str);
411 code (nprocs, BODY, "(void) fgetc (stdin);\n");
412 skip_card (FALSE);
413 } else if (TOKEN ("read")) {
414 // READ
415 int_4 nest = 0;
416 cpp_direct (nprocs, prelin, BODY);
417 do_io ("read", &nest);
418 if (nest != 0) {
419 ERROR (2818, "unbalanced parentheses", NO_TEXT);
420 }
421 skip_card (FALSE);
422 } else if (TOKEN ("accept")) {
423 // ACCEPT
424 int_4 nest = 0;
425 cpp_direct (nprocs, prelin, BODY);
426 do_io ("accept", &nest);
427 if (nest != 0) {
428 ERROR (2819, "unbalanced parentheses", NO_TEXT);
429 }
430 skip_card (FALSE);
431 } else if (TOKEN ("return")) {
432 // RETURN
433 cpp_direct (nprocs, prelin, BODY);
434 labels[0].jumped++;
435 code (nprocs, BODY, RETURN);
436 skip_card (FALSE);
437 // ENTRY
438 } else if (TOKEN ("entry")) {
439 ERROR (2820, "obsolete feature", "entry");
440 skip_card (FALSE);
441 } else if (TOKEN ("rewind")) {
442 // REWIND
443 cpp_direct (nprocs, prelin, BODY);
444 vif_rewind ();
445 skip_card (FALSE);
446 } else if (TOKEN ("stop")) {
447 // STOP
448 RECORD str;
449 cpp_direct (nprocs, prelin, BODY);
450 rc = scan (EXPECT_NONE);
451 if (rc == INT_NUMBER) {
452 sscanf (curlex, "%d", &rc);
453 _srecordf (str, "exit (%d);\n", rc);
454 } else {
455 _srecordf (str, "exit (EXIT_SUCCESS);\n");
456 }
457 code (nprocs, BODY, str);
458 skip_card (FALSE);
459 } else if (TOKEN ("write")) {
460 // WRITE
461 int_4 nest = 0;
462 cpp_direct (nprocs, prelin, BODY);
463 do_io ("write", &nest);
464 if (nest != 0) {
465 ERROR (2821, "unbalanced parentheses", NO_TEXT);
466 }
467 skip_card (FALSE);
468 } else if (TOKEN ("print")) {
469 // PRINT
470 int_4 nest = 0;
471 cpp_direct (nprocs, prelin, BODY);
472 do_io ("print", &nest);
473 if (nest != 0) {
474 ERROR (2822, "unbalanced parentheses", NO_TEXT);
475 }
476 skip_card (FALSE);
477 } else if (TOKEN ("punch")) {
478 // PUNCH
479 int_4 nest = 0;
480 cpp_direct (nprocs, prelin, BODY);
481 do_io ("punch", &nest);
482 if (nest != 0) {
483 ERROR (2823, "unbalanced parentheses", NO_TEXT);
484 }
485 skip_card (FALSE);
486 } else if (rc == WORD) {
487 // Single-word extensions EXIT, CYCLE, BREAK, etcetera.
488 SAVE_POS;
489 rc = scan (EXPECT_NONE);
490 if (rc == END_OF_LINE || rc == END_OF_MODULE) {
491 RESTORE_POS;
492 strcpy (curlex, prelex);
493 vif_extensions ();
494 } else {
495 UNSCAN;
496 // Primary - Assignation or call
497 EXPR reg;
498 MODE mode;
499 cpp_direct (nprocs, prelin, BODY);
500 (void) impl_decl (curlex, &mode);
501 memset (®, 0, sizeof (EXPR));
502 assign (®);
503 code (nprocs, BODY, reg.str);
504 code (nprocs, BODY, ";\n");
505 skip_card (FALSE);
506 }
507 }
508 }
509
510 void gen_statements (LBL * dolbl, int_4 depth)
511 {
512 int_4 rc;
513 while ((rc = scan (EXPECT_NONE)) != END_OF_MODULE) {
514 // Common mistakes.
515 if (TOKEN ("program")) {
516 ERROR (2824, "check for missing end statement", NO_TEXT);
517 } else if (TOKEN ("function")) {
518 ERROR (2825, "check for missing end statement", NO_TEXT);
519 } else if (TOKEN ("subroutine")) {
520 ERROR (2826, "check for missing end statement", NO_TEXT);
521 } else if (TOKEN ("block")) {
522 ERROR (2827, "check for missing end statement", NO_TEXT);
523 }
524 // FORTRAN statements.
525 LBL *statlbl = NO_LABEL;
526 if (rc == LABEL) {
527 RECORD str;
528 statlbl = lbl = find_label (curlex);
529 if (lbl == NO_LABEL) {
530 ERROR (2828, "no such label", curlex);
531 } else {
532 _srecordf (str, "_l%d:;\n", lbl->num);
533 lbl->patch = code (nprocs, BODY, str);
534 }
535 rc = scan (EXPECT_NONE);
536 if (TOKEN ("continue")) {
537 continue; // Sic!
538 }
539 }
540 _srecordf (stat_start, "%s:%s:%d", libnam, modnam, CUR_LIN.num);
541 if (rc == DECLAR) {
542 ERROR (2829, "declaration amidst executable statements", NO_TEXT);
543 } else if (TOKEN ("assign")) {
544 // ASSIGN statement, from before the Chicxulub impact.
545 // Relic from when computers had no way to organize subroutine calls.
546 rc = scan (EXPECT_LABEL);
547 if (rc != LABEL) {
548 SYNTAX (2830, "label expected");
549 } else {
550 LBL *slbl = find_label (curlex);
551 if (slbl == NO_LABEL) {
552 ERROR (2831, "no such label", NO_TEXT);
553 }
554 rc = scan ("to");
555 EXPR reg;
556 rc = scan (EXPECT_NONE);
557 express (®, INTEGER, 4);
558 RECORD str;
559 _srecordf (str, "%s = %d;\n", reg.str, slbl->index);
560 code (nprocs, BODY, str);
561 }
562 skip_card (FALSE);
563 } else if (TOKEN ("end")) {
564 skip_card (FALSE);
565 end_statements++;
566 // END is not executable.
567 RECORD str;
568 if (depth != 0) {
569 SYNTAX (2832, "end must end a subprogram");
570 abend = TRUE;
571 }
572 // Peephole optimisation, END following RETURN which is typical.
573 if (n_c_src > 0) {
574 C_SRC *lin = &object[n_c_src - 1];
575 if (EQUAL (lin->text, RETURN)) {
576 lin->text = NO_TEXT;
577 labels[0].jumped--;
578 }
579 }
580 // Return.
581 labels[0].patch = code (nprocs, BODY, "_l0:;\n");
582 _srecordf (str, "__calls[%d].calls++;\n", nprocs - 1);
583 code (nprocs, BODY, str);
584 if (func) {
585 _srecordf (str, "return %s;\n", retnam);
586 } else {
587 _srecordf (str, "return 0;\n");
588 }
589 cpp_direct (nprocs, prelin, BODY);
590 code (nprocs, BODY, str);
591 return;
592 } else if (TOKEN ("elseif")) {
593 if (depth > 0) {
594 return;
595 } else {
596 SYNTAX (2833, "stray symbol");
597 }
598 } else if (TOKEN ("else")) {
599 if (depth > 0) {
600 return;
601 } else {
602 SYNTAX (2834, "stray symbol");
603 }
604 } else if (TOKEN ("endif")) {
605 if (depth > 0) {
606 return;
607 } else {
608 SYNTAX (2835, "stray symbol");
609 }
610 } else if (TOKEN ("until")) {
611 RECORD str;
612 rc = scan ("(");
613 EXPR reg;
614 rc = scan (EXPECT_NONE);
615 express (®, NOTYPE, NOLEN);
616 rc = scan (")");
617 if (reg.mode.type != LOGICAL) {
618 EXPECT (2836, "logical expression");
619 }
620 _srecordf (str, "if (%s) {\n", reg.str);
621 code (nprocs, BODY, str);
622 _srecordf (str, "break;\n");
623 code (nprocs, BODY, str);
624 _srecordf (str, "}\n");
625 code (nprocs, BODY, str);
626 skip_card (FALSE);
627 } else if (TOKEN ("if")) {
628 cpp_direct (nprocs, prelin, BODY);
629 condit (depth);
630 } else if (TOKEN ("do")) {
631 // DO
632 cpp_direct (nprocs, prelin, BODY);
633 do_loop (dolbl, depth);
634 skip_card (FALSE);
635 } else if (TOKEN ("enddo")) {
636 if (dolbl != NO_LABEL) {
637 ERROR (2837, "misplaced end do", NO_TEXT);
638 }
639 if (depth > 0) {
640 return;
641 } else {
642 SYNTAX (2838, "stray symbol");
643 }
644 } else if (TOKEN ("format")) {
645 cpp_direct (nprocs, prelin, FMT);
646 format (statlbl);
647 skip_card (FALSE);
648 } else {
649 executable ();
650 }
651 // Return for DO loop (ending label reached).
652 if (dolbl != NO_LABEL && lbl != NO_LABEL && dolbl->num == lbl->num) {
653 if (depth == 0) {
654 BUG ("nesting");
655 }
656 return;
657 }
658 }
659 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
