emit.c
1 //! @file emit.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 //! Emit C object code.
25
26 #include <vif.h>
27
28 //
29 // Write intermediate code
30 //
31
32 char *newpage (char *module, char *section)
33 {
34 NEW_RECORD (str);
35 _srecordf (str, "\f %s %s", module, section);
36 return f_stralloc (str);
37 }
38
39 logical_4 no_comment (char *str)
40 {
41 if (strncmp (str, "//", 2) == 0) {
42 return FALSE;
43 }
44 if (strncmp (str, "#", 1) == 0) {
45 return FALSE;
46 }
47 return TRUE;
48 }
49
50 void newline (FILE * obj, char *info, int_4 phase, int_4 force)
51 {
52 if (page == 0 || (info != NULL && info[0] == '\f')) {
53 sscanf (&info[1], "%s %s", hmodule, hsection);
54 }
55 if (force || line >= LINES_PER_PAGE) {
56 NEW_RECORD (str);
57 page++;
58 _srecordf (str, "// %s %16s ** %-28s ** %-48s PAGE %05d", _strupper (PACKAGE), _strupper (hdate), _strupper (hmodule), _strupper (hsection), page);
59 for (int_4 k = 0; k < (int_4) strlen (str); k++) {
60 if (str[k] == '-') {
61 str[k] = ' ';
62 }
63 }
64 if (page == 1) {
65 fprintf (obj, "%s\n\n", str);
66 line = 1;
67 } else {
68 fprintf (obj, "\f\n%s\n\n", str);
69 line = 1;
70 }
71 if (phase == JCL) {
72 fprintf (obj, "\n// Line JCL *...*....1....|....2....|....3....|....4....|....5....|....6....|....7..*.|....8\n");
73 line += 2;
74 }
75 if (phase == LIST) {
76 fprintf (obj, "\n// Line ISN *...*....1....|....2....|....3....|....4....|....5....|....6....|....7..*.|....8\n");
77 line += 2;
78 }
79 } else {
80 fprintf (obj, "\n");
81 line++;
82 }
83 }
84
85 void indentation (FILE *obj, int_4 ind) {
86 for (int_4 k = 1; k <= ind; k++) {
87 fprintf (obj, " ");
88 }
89 }
90
91 void emit_code (FILE * obj, int_4 proc)
92 {
93 // Write the procedure 'proc'.
94 int_4 nl = FALSE, printed = 0;
95 indent = 0;
96 for (int_4 phase = HEADER; phase < MAXPHA; phase++) {
97 int_4 N = 0;
98 NEW_RECORD (prev);
99 prev[0] = '\0';
100 for (int_4 c_src = 0; c_src < n_c_src; c_src++) {
101 C_SRC *lin = &object[c_src];
102 if (! (lin->proc == proc && lin->phase == phase)) {
103 continue;
104 } else if (lin->text != NULL) {
105 int_4 last = strlen (lin->text) - 1;
106 if (lin->text[0] == '\f') {
107 newline (obj, lin->text, phase, TRUE);
108 prev[0] = '\0';
109 N = 0;
110 } else if (lin->text[0] == '\"' && lin->text[last] == '\"') {
111 fprintf (obj, "%s", lin->text);
112 } else if (lin->text[0] == '\'' && lin->text[last] == '\'') {
113 fprintf (obj, "%s", lin->text);
114 } else {
115 // Close block - indent less.
116 // if (no_comment (lin->text) && strchr (lin->text, '}') != NULL && strchr (lin->text, '{') == NULL) {
117 // indent = _max (0, indent - INDENT);
118 // }
119 if (no_comment (lin->text)) {
120 for (char *q = lin->text; q[0] != '\0'; q++) {
121 if (q[0] == '}') {
122 indent = _max (0, indent - INDENT);
123 }
124 }
125 }
126 // Indent, but not comments or cpp directives.
127 if (nl && strncmp (lin->text, "# ", 2) != 0 && strncmp (lin->text, "//", 2) != 0) {
128 if (strncmp (lin->text, "#define", 7) != 0) {
129 indentation (obj, indent);
130 printed += INDENT;
131 }
132 nl = FALSE;
133 }
134 // Write new line.
135 if (lin->text[last] == '\n') {
136 nl = TRUE;
137 last--;
138 }
139 if (last >= 0) {
140 // Open block - indent more.
141 // if (no_comment (lin->text) && strchr (lin->text, '{') != NULL && strchr (lin->text, '}') == NULL) {
142 // indent += INDENT;
143 // }
144 if (no_comment (lin->text)) {
145 for (char *q = lin->text; q[0] != '\0'; q++) {
146 if (q[0] == '{') {
147 indent = _min (32, indent + INDENT);
148 }
149 }
150 }
151 // Write respecting LINE_WIDTH.
152 if (strncmp (lin->text, "#", 1) == 0 || strncmp (lin->text, "//", 2) == 0) {
153 NEW_RECORD (str);
154 bufcpy (str, lin->text, RECLN);
155 int_4 len = strlen (str);
156 if (len > 0 && str[len - 1] == '\n') {
157 str[len - 1] = '\0';
158 }
159 fprintf (obj, "%s", str);
160 } else if (strncmp (lin->text, "~", 1) == 0) {
161 NEW_RECORD (str);
162 bufcpy (str, lin->text, RECLN);
163 int_4 len = strlen (str);
164 if (len > 0 && str[len - 1] == '\n') {
165 str[len - 1] = '\0';
166 }
167 fprintf (obj, "%s", &str[1]);
168 } else {
169 NEW_RECORD (str);
170 bufcpy (str, lin->text, RECLN);
171 char *rest = NULL, *token;
172 for (token = strtok_r (str, " ", &rest); token != NULL; token = strtok_r (NULL, " ", &rest)) {
173 int_4 len = strlen (token);
174 if (N > 0) {
175 if (strchr (",;)}", token[0]) == NULL) {
176 if (strlen (prev) > 0 && strchr ("([", prev[strlen(prev) - 1]) == NULL) {
177 fprintf (obj, " ");
178 printed++;
179 }
180 }
181 }
182 if (printed + len >= LINE_WIDTH) {
183 newline (obj, lin->text, phase, FALSE);
184 indentation (obj, indent);
185 printed = INDENT;
186 prev[0] = '\0';
187 N = 0;
188 }
189 NEW_RECORD (tok);
190 bufcpy (tok, token, RECLN);
191 int_4 M = strlen (tok);
192 if (M > 0 && tok[M - 1] == '\n') {
193 tok[M - 1] = '\0';
194 }
195 fprintf (obj, "%s", tok);
196 bufcpy (prev, tok /* token ? */, RECLN);
197 printed += strlen (tok);
198 N++;
199 }
200 }
201 }
202 // New line afterwards.
203 if (nl) {
204 newline (obj, lin->text, phase, FALSE);
205 printed = 0;
206 prev[0] = '\0';
207 N = 0;
208 }
209 }
210 }
211 }
212 // Final new line.
213 if (proc == 0) {
214 newline (obj, "\n", MAXPHA, FALSE);
215 }
216 }
217 if (proc > 0) {
218 newline (obj, "\n", MAXPHA, FALSE);
219 }
220 }
221
222 void write_object (char *name)
223 {
224 // Object code to file.
225 FILE *obj;
226 int_4 proc;
227 if ((obj = fopen (name, "w")) == NULL) {
228 FATAL (1301, "cannot open for writing", name);
229 exit (EXIT_FAILURE);
230 };
231 page = 0;
232 for (proc = 0; proc <= nprocs; proc++) {
233 emit_code (obj, proc);
234 }
235 fclose (obj);
236 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
