1 saw 1.1 /* makereg.c version 1.0. August 1994, Allen Boozer
2 Report bugs to adb2y@virginia.edu
3 $Log: makereg.c,v $
4 Revision 1.2 1995/01/09 15:10:44 saw
5 Put titles in reg calls on a continuation line
6
7 * Revision 1.1 1994/08/26 17:47:07 saw
8 * Initial revision
9 *
10 */
11
12 #include <stdio.h>
13 #include <string.h>
14 #include <ctype.h>
15 #include <stdlib.h>
16 #include <time.h>
17
18 /*
19 c%% - Put the current line in the fortran code
20 c CTPTYPE = test - Use "test" call statements
21 c CTPTYPE = parm - Use "parm" call statements
22 saw 1.1 c CTPTYPE = event - Use "event" call statements
23 c CTPTYPE = off - Ignore all lines until CTYPE is set to test, parm, or event
24 */
25
26
27 #define VERSION "v1.01"
28 #define BUFFER_LEN 128
29 #define NUM_TYPES 8
30
31 #define CTPTEST 0
32 #define CTPPARM 1
33 #define CTPEVENT 2
34 #define CTPOFF 3
35
36 #define COMMON -1
37 #define PARAMETER -2
38 #define EQUIV -3
39 #define NOP -4
40 #define COMMON_CONTINUE -5
41 #define REGISTER_CONTINUE -6
42 #define MARK -7
43 saw 1.1 #define IGNORE -8
44 #define SKIP -9
45
46 /*
47 Two linked lists (the register list and the common list) are used to store
48 information about variables that have been declared. The register list
49 stores variables which have been registered, and the common list stores
50 variables which have been defined in common blocks. The elements of the
51 linked lists are of type "node", as defined below:
52 */
53
54 struct node {
55 int vartype; /* A number which represents the type of the variable */
56 int action; /* A number which tells what to do with the variable */
57 int calltype; /* Use test, parm, or event calls */
58 int line_number; /* The line number on which the variable occurs */
59 char *name; /* The name of the variable */
60 char *size; /* The size of the array, or NULL if not an array */
61 char *title; /* The title string, or NULL if no title string */
62 struct node *next; /* Ptr to the next node, or NULL if last node */
63 };
64 saw 1.1
65 struct node *register_start; /* Ptr to the first node of the register list */
66 struct node *common_start; /* Ptr to the first node of the common list */
67
68 /* Variable types (as they appear when variables are declared) */
69 char types[NUM_TYPES][20] = {
70 "logical", "logical*4",
71 "integer", "integer*4",
72 "real", "real*4",
73 "double precision", "real*8" };
74
75 /* Variable types (as the appear in fortran call statements) */
76 char type_names[5][10] = {"int", "int", "real", "double", "string"};
77
78 char keywords[3][15] = {"common", "parameter", "equivalence"};
79 char call_names[4][10] = {"test", "parm", "event", "off"};
80
81 int variable_flags[3][5] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
82 int array_flags[3][5] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
83
84 FILE *input, *output, *error;
85 saw 1.1 char input_filename[BUFFER_LEN];
86 char output_filename[BUFFER_LEN];
87 char error_filename[BUFFER_LEN] = {""};
88 char subroutine_name[BUFFER_LEN] = {""};
89 char command_line[BUFFER_LEN];
90 int current_calltype, current_line;
91
92 void eprint (char string[]);
93 void eprintn (char string[], int length);
94 void eprint_newline ();
95 void eprint_line (int line_num);
96 void memory_error ();
97 char *parse_array_size (char string[]);
98 void create (struct node *ptr, int vartype, char string[], char title[]);
99 int max (int a, int b);
100 int min (int a, int b);
101 void free_node (struct node *ptr);
102 void clear_list (struct node *ptr);
103 void copy (char dest[], char source[], int length);
104 int strncmp_i (char str1[], char str2[], int length);
105 struct node *find_node (struct node *start, char string[]);
106 saw 1.1 void mark_node (struct node *start, char string[], int new_action);
107 int determine_type (char string[]);
108 char *skip_blanks (char string[]);
109 char *skip_nonblanks (char string[]);
110 char *find_char (char string[], char character);
111 int extract_text (char string[]);
112 void shift_left (char string[]);
113 void parse (char string[]);
114 void compare_lists ();
115 void write_fortran_header ();
116 void write_fortran_code ();
117 void set_call_type (char string[]);
118
119 /***************************************************************************
120 * Linked list functions
121 ***************************************************************************/
122
123 /* Print a character string to "error" */
124 void eprint (char string[]) {
125 fprintf (error, "%s", string);
126 fprintf (output, "%s", string);
127 saw 1.1 }
128
129 /* Print "length" characters of a character string to "error" */
130 void eprintn (char string[], int length) {
131 char output_buffer[BUFFER_LEN];
132
133 copy (output_buffer, string, length);
134 fprintf (error, "%s", output_buffer);
135 fprintf (output, "%s", output_buffer);
136 }
137
138 /* Print a newline character to "error" */
139 void eprint_newline () {
140 fprintf (error, "\n");
141 fprintf (output, "\n* ");
142 }
143
144 /* Print a line number to "error" */
145 void eprint_line (int line_num) {
146 fprintf (error, "Line %d: ", line_num);
147 fprintf (output, "Line %d: ", line_num);
148 saw 1.1 }
149
150 /* memory_error is called if malloc returns a NULL pointer */
151 void memory_error () {
152 printf ("Memory allocation error\n");
153 fclose (input);
154 fclose (output);
155 fclose (error);
156 exit (0);
157 }
158
159 /* Return a pointer to a string containing the array size */
160 char *parse_array_size (char string[]) {
161 char output_buffer[BUFFER_LEN];
162 int length;
163 char *size_string, *ptr = string;
164
165 memset (output_buffer, '\0', BUFFER_LEN);
166 ptr = find_char (ptr, '(');
167 while (ptr < find_char(string,')')) {
168 if (strlen(output_buffer) != 0) strcat (output_buffer, "*");
169 saw 1.1 length = min (find_char(ptr,',')-ptr, find_char(ptr,')')-ptr) - 1;
170 strcat (output_buffer, "(");
171 if (find_char(ptr,':')-ptr < length) {
172 strcat (output_buffer, "1-");
173 strncat (output_buffer, ptr, find_char(ptr,':')-ptr-1);
174 strcat (output_buffer, "+");
175 ptr = find_char (ptr, ':');
176 length = min (find_char(ptr,',')-ptr, find_char(ptr,')')-ptr) - 1;
177 }
178 strncat (output_buffer, ptr, length);
179 strcat (output_buffer, ")");
180 ptr = skip_blanks (find_char (ptr, ','));
181 }
182 size_string = malloc (strlen(output_buffer)+1);
183 if (size_string == NULL) memory_error ();
184 strcpy (size_string, output_buffer);
185 return (size_string);
186 }
187
188 /* Add a variable to a linked list */
189 void create (struct node *start, int vartype, char string[], char comment[]) {
190 saw 1.1 struct node *end = start, *temp;
191
192 if (find_node (start, string) == NULL) {
193 /* Create a new node and add it to the end of the linked list */
194 while (end->next != NULL) end = end->next;
195 end->next = malloc (sizeof(struct node));
196 if (end->next == NULL) memory_error ();
197 end = end->next;
198 end->vartype = vartype;
199 end->action = NOP;
200 end->calltype = current_calltype;
201 end->line_number = current_line;
202 end->name = calloc (extract_text(string)+1, sizeof(char));
203 if (end->name == NULL) memory_error ();
204 copy (end->name, string, extract_text(string));
205 if ((find_char (string, '(') < find_char (string, ',')) &&
206 (find_char (string, '(') < find_char (string, '!'))) {
207 /* Variable is an array */
208 if (start == common_start) {
209 /* Array is defined in a common block, so print a warning */
210 eprint_newline ();
211 saw 1.1 eprint ("Warning - Array size defined in common block:");
212 eprint_newline ();
213 eprint_line (current_line);
214 eprintn (string, find_char(string, ')') - string);
215 eprint_newline ();
216 temp = find_node (register_start, string);
217 if (temp != NULL) {
218 if (temp->vartype > 0) array_flags[temp->calltype][temp->vartype]=1;
219 free (temp->size);
220 temp->size = parse_array_size (string);
221 end->size = NULL;
222 }
223 }
224 else end->size = parse_array_size (string);
225 }
226 else (end->size = NULL);
227 if (comment != NULL) {
228 end->title = calloc (strlen(comment), sizeof(char));
229 if (end->title == NULL) memory_error ();
230 copy (end->title, comment, strlen(comment)-1);
231 }
232 saw 1.1 else end->title = NULL;
233 end->next = NULL;
234 }
235 }
236
237 /* Return the maximum of a and b */
238 int max (int a, int b) {
239 return ((a < b) ? b : a);
240 }
241
242 /* Return the minimum of a and b */
243 int min (int a, int b) {
244 return ((a < b) ? a : b);
245 }
246
247 /* Release the memory used by a node */
248 void free_node (struct node *ptr) {
249 free (ptr->name);
250 if (ptr->size != NULL) free (ptr->size);
251 if (ptr->title != NULL) free (ptr->title);
252 free (ptr);
253 saw 1.1 }
254
255 /* Release the memory used by each node in a linked list */
256 void clear_list (struct node* start) {
257 struct node *ptr = start->next, *old_ptr;
258
259 while (ptr != NULL) {
260 old_ptr = ptr;
261 ptr = ptr->next;
262 free_node (old_ptr);
263 }
264 start->next = NULL;
265 }
266
267 /* Copy length chars from "dest" to "source", terminate "dest" with a \0 */
268 void copy (char dest[], char source[], int length) {
269 memcpy (dest, source, length);
270 dest[length] = '\0';
271 }
272
273 /* Case insensitive string compare */
274 saw 1.1 int strncmp_i (char str1[], char str2[], int length) {
275 int i;
276
277 for (i=0; i<length;i++) if (toupper(str1[i]) != toupper(str2[i])) return (1);
278 return (0);
279 }
280
281 /* Return a pointer to the node which has "string" as it's name field */
282 struct node *find_node (struct node *start, char string[]) {
283 int length, flag=1;
284 struct node *ptr = start;
285
286 do {
287 ptr = ptr->next;
288 if (ptr != NULL) {
289 length = max (extract_text(string), strlen(ptr->name));
290 flag = strncmp_i (ptr->name, string, length);
291 }
292 } while ((flag != 0) && (ptr != NULL));
293 return (ptr);
294 }
295 saw 1.1
296 /* Set the action of the node which has "string" as it's name field */
297 void mark_node (struct node *start, char string[], int new_action) {
298 struct node *node_ptr;
299
300 node_ptr = find_node (start, string);
301 if (node_ptr != NULL) node_ptr->action = new_action;
302 }
303
304 /***************************************************************************
305 * Parse functions
306 ***************************************************************************/
307
308 int determine_type (char string[]) {
309 int i, length;
310
311 for (i=0; i<NUM_TYPES; i++) {
312 length = max (strlen(types[i]), skip_nonblanks(string)-string);
313 if (strncmp_i(string, types[i], length) == 0) return (i/2);
314 }
315 if (strncmp_i(string, "character", 9) == 0) return (4);
316 saw 1.1 if (strncmp_i(string, "integer*2", 9) == 0) {
317 eprint_newline ();
318 eprint ("Warning - Type integer*2:");
319 eprint_newline ();
320 eprint_line (current_line);
321 eprintn (string, strlen(string) - 1);
322 eprint_newline ();
323 return (NOP);
324 }
325 for (i=0; i<3; i++) {
326 length = max (strlen(keywords[i]), extract_text(string));
327 if (strncmp_i(string, keywords[i], length) == 0) return (-i-1);
328 }
329 return (NOP);
330 }
331
332 /* Return a ptr to the first nonblank character in the string */
333 char *skip_blanks (char string[]) {
334 while (isspace (*string)) string++;
335 return (string);
336 }
337 saw 1.1
338 /* Return a ptr to the first blank character in the string */
339 char *skip_nonblanks (char string[]) {
340 while ((! isspace (*string)) && (*string != '\0')) string++;
341 return (string);
342 }
343
344 /* Return a ptr to the character after the first occurrence of "character" */
345 char *find_char (char string[], char character) {
346 while ((*string != character) && (*string != '\0')) string++;
347 if (*string == character) string++;
348 return (string);
349 }
350
351 /* Return the number of contiguous text characters in a string */
352 int extract_text (char string[]) {
353 int i=0;
354
355 while ((isalnum (string[i])) || (string[i] == '_')) i++;
356 return (i);
357 }
358 saw 1.1
359 /* Shift a character string one character to the right */
360 void shift_left (char string[]) {
361 char *ptr = string;
362
363 while (*ptr != '\0') ptr++;
364 *(ptr+1) = '\0';
365 while (ptr != string) *ptr = *(--ptr);
366 }
367
368 /* Parse one line of text */
369 void parse (char string[]) {
370 struct node *list_ptr, *node_ptr;
371 static int vartype = NOP, state = NOP;
372 char *ptr = string, *title_ptr, *temp;
373
374 if (((string[0] == ' ') && (strlen(string) > 6)) ||
375 ((string[0] == '\t') && (strlen(string) > 2))) {
376 /* The current line is not a comment */
377 if (string[0] == '\t') ptr++;
378 else ptr += 5;
379 saw 1.1 if ((isspace (*ptr)) || ((state != COMMON_CONTINUE) && (state != REGISTER_CONTINUE))) {
380 ptr = skip_blanks (ptr);
381 vartype = determine_type (ptr);
382 state = vartype;
383 if (strncmp_i("double precision", ptr, 16) == 0)
384 ptr = skip_blanks (skip_nonblanks (ptr));
385 }
386 if ((vartype != NOP) && (vartype != PARAMETER) && (vartype != EQUIV)) {
387 /* The current line is a list of variables */
388 if (state == COMMON_CONTINUE) {
389 /* The current line is the continuation of a common block */
390 list_ptr = common_start;
391 ptr++;
392 }
393 else if (state == COMMON) {
394 /* The current line is a common block */
395 list_ptr = common_start;
396 ptr = find_char (find_char (ptr, '/'), '/');
397 state = COMMON_CONTINUE;
398 }
399 else if (state == REGISTER_CONTINUE) {
400 saw 1.1 /* The current line is the continuation of a register statement */
401 list_ptr = register_start;
402 ptr++;
403 }
404 else {
405 /* The current line contains variables to be registered */
406 list_ptr = register_start;
407 ptr = skip_nonblanks (ptr);
408 state = REGISTER_CONTINUE;
409 }
410 ptr = skip_blanks (ptr);
411
412 /* Obtain the title string */
413 title_ptr = string;
414 if (find_char (ptr, ',') > find_char (ptr, '!')) {
415 while (*title_ptr != '!') title_ptr++;
416 title_ptr = skip_blanks (title_ptr+1);
417 if (*title_ptr == '\0') title_ptr = NULL;
418 }
419 else title_ptr = NULL;
420 /* Convert ' to '' in title string */
421 saw 1.1 if (title_ptr != NULL) {
422 temp = title_ptr;
423 while (*temp != '\0') {
424 if (*temp == '\'') shift_left (temp++);
425 temp++;
426 }
427 }
428
429 /* Add each variable to the linked list */
430 while ((ptr < find_char (string, '!')) && (*ptr != '!')) {
431 if ((find_char (ptr, '(') < find_char (ptr, ',')) &&
432 (find_char (ptr, '(') < find_char (ptr, '!'))) {
433 /* The variable is an array */
434 create (list_ptr, vartype, ptr, title_ptr);
435 if (vartype >= 0) array_flags[current_calltype][vartype] = 1;
436 ptr = skip_blanks (find_char (find_char (ptr, ')'), ','));
437 }
438 else {
439 /* The variable is not an array */
440 create (list_ptr, vartype, ptr, title_ptr);
441 if (vartype >=0) variable_flags[current_calltype][vartype] = 1;
442 saw 1.1 ptr = skip_blanks (find_char (ptr, ','));
443 }
444 }
445 }
446 if (vartype == PARAMETER)
447 /* If the line is a parameter statement, then ignore the variable */
448 mark_node (register_start, skip_blanks(find_char (ptr, '(')), IGNORE);
449 if (vartype == EQUIV) {
450 /* If the line is an equivalence statement, then skip the variables */
451 ptr = skip_blanks (find_char (ptr, '('));
452 mark_node (register_start, ptr, SKIP);
453 if (find_char(ptr,'(') < find_char(ptr,',')) ptr = find_char(ptr,')');
454 ptr = skip_blanks (find_char (ptr, ','));
455 mark_node (register_start, ptr, SKIP);
456 }
457 }
458 }
459
460 /* Compare the common list with the register list */
461 void compare_lists () {
462 struct node *ptr, *common_node;
463 saw 1.1
464 eprint_newline ();
465 eprint ("Registered, but did not occur in a common block:");
466 eprint_newline ();
467 ptr = register_start->next;
468 while (ptr != NULL) {
469 common_node = find_node (common_start, ptr->name);
470 if (common_node != NULL) {
471 common_node->action = MARK;
472 if ((common_node->title != NULL) && (ptr->title == NULL)) {
473 ptr->title = malloc (strlen(common_node->title)+1);
474 if (ptr->title == NULL) memory_error ();
475 strcpy (ptr->title, common_node->title);
476 }
477 }
478 else if ((ptr->action != IGNORE) && (ptr->action != SKIP)) {
479 eprint_line (ptr->line_number);
480 eprint (ptr->name);
481 eprint_newline ();
482 }
483 ptr = ptr->next;
484 saw 1.1 }
485
486 eprint_newline ();
487 eprint ("Occurred in a common block, but were not registered:");
488 ptr = common_start->next;
489 while (ptr != NULL) {
490 if (ptr->action != MARK) {
491 eprint_newline ();
492 eprint_line (ptr->line_number);
493 eprint (ptr->name);
494 }
495 ptr = ptr->next;
496 }
497 eprint ("\n\n");
498 }
499
500 /* Write a header to the output file */
501 void write_fortran_header () {
502 time_t current_time = time (NULL);
503
504 fprintf (output, "******************************************************");
505 saw 1.1 fprintf (output, "*************************\n");
506 fprintf (output, "* This file (%s) was generated ", output_filename);
507 fprintf (output, "from %s by makereg %s\n", input_filename, VERSION);
508 fprintf (output, "* This file was created on ");
509 fprintf (output, "%s", asctime (localtime (¤t_time)));
510 fprintf (output, "*\n");
511 fprintf (output, "* The command used to create this file was:\n");
512 fprintf (output, "* %s\n", command_line);
513 fprintf (output, "*\n");
514 fprintf (output, "* Do not edit this file.\n");
515 fprintf (output, "******************************************************");
516 fprintf (output, "*************************\n\n");
517 fprintf (output, " subroutine %s\n\n", subroutine_name);
518 fprintf (output, " implicit none\n\n");
519 }
520
521 /* Write the fortran code to an output file */
522 void write_fortran_code () {
523 struct node *ptr = register_start->next;
524 int i, j;
525
526 saw 1.1 for (j=0; j<3; j++) {
527 if (variable_flags[j][0] == 1) variable_flags[j][1] = 1;
528 if (array_flags[j][0] == 1) array_flags[j][1] = 1;
529 }
530
531 fprintf (output, " include '%s'\n\n", input_filename);
532 for (j=0; j<3; j++) {
533 for (i=1; i<5; i++) {
534 if (variable_flags[j][i] == 1) {
535 fprintf (output, "c integer ");
536 fprintf (output, "reg%s%s\n", call_names[j], type_names[i]);
537 fprintf (output, "c external ");
538 fprintf (output, "reg%s%s\n", call_names[j], type_names[i]);
539 }
540 if (array_flags[j][i] == 1) {
541 fprintf (output, "c integer ");
542 fprintf (output, "reg%s%sarray\n", call_names[j], type_names[i]);
543 fprintf (output, "c external ");
544 fprintf (output, "reg%s%sarray\n", call_names[j], type_names[i]);
545 }
546 }
547 saw 1.1 }
548 fprintf (output, "\n");
549
550 /* Loop to output the reg calls */
551 while (ptr != NULL) {
552 if (ptr->action != IGNORE) {
553 fprintf (output, " call reg%s", call_names[ptr->calltype]);
554 fprintf (output, "%s", type_names[ptr->vartype]);
555 if (ptr->size == NULL)
556 fprintf (output, "('%s',%s,", ptr->name, ptr->name);
557 else
558 fprintf (output, "array('%s',%s,%s,", ptr->name, ptr->name, ptr->size);
559 if (ptr->title == NULL) fprintf (output, "0)\n");
560 else {
561 fprintf (output, "\n & ");
562 fprintf (output, "'%s')\n", ptr->title);
563 }
564 }
565 ptr = ptr->next;
566 }
567
568 saw 1.1 fprintf (output, "\n");
569 fprintf (output, " return\n");
570 fprintf (output, " end\n");
571 }
572
573 /* Set the call type to "test", "parm", or "event" */
574 void set_call_type (char string[]) {
575 int i;
576 char *ptr;
577
578 if (strlen (string) != 0) {
579 ptr = skip_blanks (string+1);
580 if (strncmp_i(ptr, "CTPTYPE", 7) == 0) {
581 while (isalpha(*ptr) && (*ptr != '\0')) ptr++;
582 while ((! isalpha(*ptr)) && (*ptr != '\0')) ptr++;
583 if (*ptr != '\0')
584 for (i=0; i<4; i++)
585 if (strncmp_i(ptr, call_names[i], 3) == 0) current_calltype = i;
586 }
587 }
588 }
589 saw 1.1
590 void print_usage () {
591 printf ("Usage: makereg infile [-o outfile] [-e errorfile] ");
592 printf ("[-s subroutine name]\n");
593 printf (" [-c test | parm | event]\n");
594 exit (0);
595 }
596
597 int main (int argc, char *argv[]) {
598 char buffer[BUFFER_LEN];
599 struct node first_register_node, first_common_node;
600 int i, j;
601
602 first_register_node.next = NULL;
603 first_common_node.next = NULL;
604 register_start = &first_register_node;
605 common_start = &first_common_node;
606
607 for (i=0; i<argc; i++) {
608 strcat (command_line, argv[i]);
609 strcat (command_line, " ");
610 saw 1.1 }
611
612 current_calltype = CTPTEST;
613 error = stderr;
614 if (argc < 2) print_usage ();
615 strcpy (input_filename, argv[1]);
616 strcpy (output_filename, input_filename);
617 if ((strcmp (strrchr(output_filename, '.'), ".cmn")) == 0)
618 strcpy (strrchr(output_filename, '.'), ".f");
619 else strcat (output_filename, ".f");
620 i = 2;
621 while (i < argc) {
622 if (strcmp(argv[i], "-o") == 0) {
623 if (argc > i+1) strcpy (output_filename, argv[i+1]);
624 else print_usage ();
625 }
626 else if (strcmp(argv[i], "-e") == 0) {
627 if (argc > i+1) strcpy (error_filename, argv[i+1]);
628 else print_usage ();
629 }
630 else if (strcmp(argv[i], "-c") == 0) {
631 saw 1.1 if (argc > i+1) {
632 for (j=0; j<3; j++)
633 if (strcmp(argv[i+1], call_names[j]) == 0) current_calltype = j;
634 }
635 else print_usage ();
636 }
637 else if (strcmp(argv[i], "-s") == 0) {
638 if (argc > i+1) strcpy (subroutine_name, argv[i+1]);
639 else print_usage ();
640 }
641 i += 2;
642 }
643 input = fopen (input_filename, "r");
644 if (input == NULL) {
645 printf ("Invalid filename: %s\n", input_filename);
646 print_usage ();
647 }
648 output = fopen (output_filename, "w");
649 if (output == NULL) {
650 printf ("Invalid filename: %s\n", output_filename);
651 print_usage ();
652 saw 1.1 }
653 if (strlen(error_filename) != 0) {
654 error = fopen (error_filename, "w");
655 if (error == NULL) {
656 printf ("Invalid filename: %s\n", error_filename);
657 print_usage ();
658 }
659 }
660 if (strlen(subroutine_name) == 0) {
661 strcpy (subroutine_name, output_filename);
662 if (strrchr(subroutine_name, '.') != NULL)
663 *strrchr(subroutine_name, '.') = '\0';
664 }
665
666 write_fortran_header ();
667 current_line = 1;
668 while (fgets (buffer, BUFFER_LEN, input) != NULL) {
669 set_call_type (buffer);
670 if (strncmp(buffer, "*%%", 3) == 0)
671 fprintf (output, " %s", skip_blanks(skip_nonblanks(buffer)));
672 else if (current_calltype != CTPOFF) parse (buffer);
673 saw 1.1 current_line++;
674 }
675 compare_lists ();
676 write_fortran_code ();
677 clear_list (register_start);
678 clear_list (common_start);
679 fclose (input);
680 fclose (output);
681 fclose (error);
682 return 0;
683 }
|