implicit.c
1 //! @file implicit.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 //! IMPLICIT declaration routines.
25
26 #include <vif.h>
27
28 IDENT *impl_decl (char *name, MODE * mode)
29 {
30 // This routine is called with a subexpression as 'name'.
31 //
32 // Filter commons, arguments and equivalences.
33 if (strchr (name, '.') != NO_TEXT) {
34 return NO_IDENT;
35 }
36 if (strstr (name, "->") != NO_TEXT) {
37 return NO_IDENT;
38 }
39 if (strchr (name, '*') != NO_TEXT) {
40 return NO_IDENT;
41 }
42 if (!IS_VAR (name)) {
43 ERROR (2101, "not a variable name", curlex);
44 return NO_IDENT;
45 }
46 // Apparently a normal local variable.
47 IDENT *idf = find_local (name, mode);
48 if (idf != NO_IDENT) {
49 if (idf->mode.type == NOTYPE) {
50 impl_type (name, &idf->mode);
51 }
52 } else {
53 if (nlocals >= MAX_IDENTS) {
54 FATAL (2102, "too many identifiers", NO_TEXT);
55 return NO_IDENT;
56 }
57 idf = &locals[nlocals++];
58 memset (idf, 0, sizeof (IDENT));
59 idf->line = curlin;
60 C_NAME (idf) = c_name (name);
61 FTN_NAME (idf) = f_stralloc (name);
62 idf->external = FALSE;
63 impl_type (name, &idf->mode);
64 if (mode != NO_MODE) {
65 *mode = idf->mode;
66 }
67 }
68 return idf;
69 }
70
71 void idfs_impl (void)
72 {
73 // Implicit-type remaining stuff
74 int_4 k;
75 for (k = 0; k < nlocals; k++) {
76 IDENT *idf = &locals[k];
77 if (idf->mode.type == NOTYPE && !idf->external) {
78 int_4 dim = idf->mode.dim;
79 impl_type (C_NAME (idf), &(idf->mode));
80 idf->mode.dim = dim;
81 }
82 }
83 }
84
85 void implicit (void)
86 {
87 int_4 k, rc, nest = 0;
88 NEW_RECORD (mode);
89 while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
90 if (TOKEN ("none")) {
91 for (k = ord ('a'); k <= ord ('z'); k++) {
92 f2c_type ("none", &(implic[k].mode), NOARG, NOFUN);
93 }
94 } else if (rc == DECLAR) {
95 RECCPY (mode, curlex);
96 } else if (TOKEN ("automatic")) {
97 RECCPY (mode, curlex);
98 } else if (TOKEN ("(")) {
99 NEW_RECORD (a);
100 NEW_RECORD (z);
101 nest++;
102 do {
103 rc = scan (EXPECT_NONE);
104 if (rc != WORD || strlen (curlex) > 1) {
105 EXPECT (2103, "a-z");
106 return;
107 }
108 RECCPY (a, curlex);
109 rc = scan (EXPECT_NONE);
110 if (TOKEN ("-")) {
111 rc = scan (EXPECT_NONE);
112 if (rc != WORD || strlen (curlex) > 1) {
113 EXPECT (2104, "a-z");
114 return;
115 }
116 RECCPY (z, curlex);
117 for (k = ord (a[0]); k <= ord (z[0]); k++) {
118 if (EQUAL (mode, "automatic")) {
119 implic[k].mode.save = AUTOMATIC;
120 } else {
121 f2c_type (mode, &(implic[k].mode), NOARG, NOFUN);
122 }
123 }
124 } else {
125 UNSCAN;
126 k = ord (a[0]);
127 if (EQUAL (mode, "automatic")) {
128 implic[k].mode.save = AUTOMATIC;
129 } else {
130 f2c_type (mode, &(implic[k].mode), NOARG, NOFUN);
131 }
132 }
133 rc = scan (EXPECT_NONE);
134 } while (TOKEN (","));
135 if (TOKEN (")")) {
136 UNSCAN;
137 }
138 } else if (TOKEN (")")) {
139 nest--;
140 } else if (TOKEN (",")) {
141 continue;
142 }
143 }
144 if (nest != 0) {
145 SYNTAX (2105, "parenthesis nesting");
146 }
147 }
148
149 void get_impl (void)
150 {
151 int_4 go_on = TRUE;
152 default_impl ();
153 while (go_on) {
154 SAVE_POS;
155 int_4 rc = scan (EXPECT_NONE);
156 if (rc == DECLAR) {
157 skip_card (FALSE);
158 } else if (TOKEN ("implicit")) {
159 implicit ();
160 skip_card (FALSE);
161 } else if (TOKEN ("save")) {
162 skip_card (FALSE);
163 } else if (TOKEN ("automatic")) {
164 skip_card (FALSE);
165 } else if (TOKEN ("parameter")) {
166 skip_card (FALSE);
167 } else if (TOKEN ("common")) {
168 skip_card (FALSE);
169 } else if (TOKEN ("dimension")) {
170 skip_card (FALSE);
171 } else if (TOKEN ("equivalence")) {
172 skip_card (FALSE);
173 } else if (TOKEN ("external")) {
174 skip_card (FALSE);
175 } else if (TOKEN ("intrinsic")) {
176 skip_card (FALSE);
177 } else if (TOKEN ("data")) {
178 skip_card (FALSE);
179 } else if (rc == WORD && is_macro_decl (curlex)) {
180 skip_card (FALSE);
181 } else if (strlen (curlex) > 0) {
182 // Backspace and done.
183 RESTORE_POS;
184 go_on = FALSE;
185 }
186 }
187 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
