(file) Return to makereg.c CVS log (file) (dir) Up to [HallC] / Analyzer / CTP

  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 (&current_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           }

Analyzer/Replay: Mark Jones, Documents: Stephen Wood
Powered by
ViewCVS 0.9.2-cvsgraph-1.4.0