parameter.c
1 //! @file parameter.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-2024 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 PARAMETER statement.
25
26 #include <vif.h>
27
28 void parameter (void)
29 {
30 int_4 rc, go_on = TRUE;
31 rc = scan (NULL);
32 if (!TOKEN ("(")) {
33 EXPECT (2301, "(");
34 return;
35 }
36 while (go_on) {
37 rc = scan (NULL);
38 if (TOKEN (")")) {
39 break;
40 }
41 if (rc != WORD) {
42 EXPECT (2302, "variable");
43 }
44 // IBM VS Fortran - idf must have been specified, explicitly or implicitly.
45 MODE mode;
46 IDENT *idf = impl_decl (curlex, &mode);
47 rc = scan ("=");
48 rc = scan (NULL);
49 EXPR reg;
50 express (®, mode.type, mode.len);
51 if (reg.variant == EXPR_CONST) {
52 idf->parm = stralloc (reg.str);
53 if (idf->mode.type == NOTYPE) {
54 idf->mode = reg.mode;
55 }
56 // Write constant in the listing file.
57 RECORD fold;
58 RECCLR (fold);
59 snprintf (fold, RECLN, "// %s = %s", CID(idf), idf->parm);
60 code (nprocs, PARAMETERS, fold);
61 } else {
62 EXPECT (2303, "constant");
63 }
64 rc = scan (NULL);
65 if (TOKEN (",")) {
66 continue;
67 } else if (TOKEN (")")) {
68 go_on = FALSE;
69 } else {
70 EXPECT (2304, ", or )");
71 go_on = FALSE;
72 }
73 }
74 (void) rc;
75 }
© 2002-2024 J.M. van der Veer (jmvdveer@xs4all.nl)
|