autosave.c
1 //! @file autosave.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 SAVE.
25
26 #include <vif.h>
27
28 static void save_all (void)
29 {
30 int_4 k;
31 for (k = 0; k < nlocals; k++) {
32 IDENT *idf = &locals[k];
33 if (idf->arg) {
34 ;
35 } else if (idf->common != LOCAL) {
36 ;
37 } else if (idf->external) {
38 ;
39 } else if (idf->alias != NO_IDENT && idf->alias->save == AUTOMATIC) {
40 ;
41 } else if (idf->equiv != NO_IDENT && idf->equiv->save == AUTOMATIC) {
42 ;
43 } else {
44 idf->mode.save = STATIC;
45 }
46 }
47 }
48
49 static void auto_all (void)
50 {
51 int_4 k;
52 for (k = 0; k < nlocals; k++) {
53 IDENT *idf = &locals[k];
54 if (idf->arg) {
55 ;
56 } else if (idf->common != LOCAL) {
57 ;
58 } else if (idf->external) {
59 ;
60 } else if (idf->alias != NO_IDENT && idf->alias->save == STATIC) {
61 ;
62 } else if (idf->equiv != NO_IDENT && idf->equiv->save == STATIC) {
63 ;
64 } else {
65 idf->mode.save = AUTOMATIC;
66 }
67 }
68 }
69
70 void save (void)
71 {
72 int_4 rc;
73 if ((rc = scan (EXPECT_NONE)) == END_OF_LINE) {
74 save_all ();
75 return;
76 } else {
77 UNSCAN;
78 }
79 while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
80 if (TOKEN (",")) {
81 ;
82 } else if (rc == WORD) {
83 IDENT *idf = void_decl (curlex, NO_MODE);
84 if (idf->arg) {
85 ERROR (201, "variable is an argument", C_NAME (idf));
86 } else if (idf->common != LOCAL) {
87 ERROR (202, "variable is in common block", C_NAME (idf));
88 } else if (idf->external) {
89 ERROR (203, "variable is external", C_NAME (idf));
90 } else if (idf->alias != NO_IDENT && idf->alias->save == AUTOMATIC) {
91 ERROR (204, "equivalenced to automatic storage", C_NAME (idf));
92 } else if (idf->equiv != NO_IDENT && idf->equiv->save == AUTOMATIC) {
93 ERROR (205, "equivalenced to automatic storage", C_NAME (idf));
94 } else {
95 idf->mode.save = STATIC;
96 }
97 } else if (TOKEN ("/")) {
98 rc = scan (EXPECT_NONE);
99 if (rc != WORD) {
100 SYNTAX (206, "common block name");
101 } else {
102 ; // Common block name is allowed but ignored in F77 ...
103 }
104 rc = scan ("/");
105 } else {
106 EXPECT (207, "variable name");
107 }
108 }
109 }
110
111 void automatic (void)
112 {
113 int_4 rc;
114 if ((rc = scan (EXPECT_NONE)) == END_OF_LINE) {
115 auto_all ();
116 return;
117 } else {
118 UNSCAN;
119 }
120 while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
121 if (TOKEN (",")) {
122 ;
123 } else if (rc == WORD) {
124 IDENT *idf = void_decl (curlex, NO_MODE);
125 if (idf->arg) {
126 ERROR (208, "variable is an argument", C_NAME (idf));
127 } else if (idf->common != LOCAL) {
128 ERROR (209, "variable is in common block", C_NAME (idf));
129 } else if (idf->external) {
130 ERROR (210, "variable is external", C_NAME (idf));
131 } else if (idf->alias != NO_IDENT && idf->alias->save == STATIC) {
132 ERROR (211, "equivalenced to static storage", C_NAME (idf));
133 } else if (idf->equiv != NO_IDENT && idf->equiv->save == STATIC) {
134 ERROR (212, "equivalenced to static storage", C_NAME (idf));
135 } else {
136 idf->mode.save = AUTOMATIC;
137 }
138 } else {
139 EXPECT (213, "variable name");
140 }
141 }
142 }
143
144 void decl_autosave (void)
145 {
146 int_4 go_on = TRUE;
147 while (go_on) {
148 SAVE_POS;
149 int_4 rc = scan (EXPECT_NONE);
150 if (rc == DECLAR) {
151 skip_card (FALSE);
152 } else if (TOKEN ("implicit")) {
153 skip_card (FALSE);
154 } else if (TOKEN ("save")) {
155 save ();
156 skip_card (FALSE);
157 } else if (TOKEN ("automatic")) {
158 automatic ();
159 skip_card (FALSE);
160 } else if (TOKEN ("parameter")) {
161 skip_card (FALSE);
162 } else if (TOKEN ("common")) {
163 skip_card (FALSE);
164 } else if (TOKEN ("dimension")) {
165 skip_card (FALSE);
166 } else if (TOKEN ("equivalence")) {
167 skip_card (FALSE);
168 } else if (TOKEN ("external")) {
169 skip_card (FALSE);
170 } else if (TOKEN ("intrinsic")) {
171 skip_card (FALSE);
172 } else if (TOKEN ("data")) {
173 skip_card (FALSE);
174 } else if (rc == WORD && is_macro_decl (curlex)) {
175 skip_card (FALSE);
176 } else if (strlen (curlex) > 0) {
177 // Backspace and done.
178 RESTORE_POS;
179 go_on = FALSE;
180 }
181 }
182 }
183
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
