PIPS
split_file.c
Go to the documentation of this file.
1 /*
2 
3  $Id: split_file.c 23065 2016-03-02 09:05:50Z coelho $
4 
5  Copyright 1989-2016 MINES ParisTech
6 
7  This file is part of PIPS.
8 
9  PIPS is free software: you can redistribute it and/or modify it
10  under the terms of the GNU General Public License as published by
11  the Free Software Foundation, either version 3 of the License, or
12  any later version.
13 
14  PIPS is distributed in the hope that it will be useful, but WITHOUT ANY
15  WARRANTY; without even the implied warranty of MERCHANTABILITY or
16  FITNESS FOR A PARTICULAR PURPOSE.
17 
18  See the GNU General Public License for more details.
19 
20  You should have received a copy of the GNU General Public License
21  along with PIPS. If not, see <http://www.gnu.org/licenses/>.
22 
23 */
24 #ifdef HAVE_CONFIG_H
25  #include "pips_config.h"
26 #endif
27 
28 // From "misc.h"
29 // FC: file not included because it would require more includes.
30 // also pips cannot be compiled without misc, so it will be available.
31 //extern void safe_link(const char*, const char*);
32 //extern void safe_unlink(const char*);
33 
34 // FI: I need a constant from pipsdbm.h and preprocessor does depend on pipsdbm
35 #include <stdio.h>
36 
37 #include "genC.h"
38 #include "misc.h"
39 #include "pipsdbm.h"
40 
41 /*
42  * adapted from what can be seen by FC 31/12/96
43  *
44  * - static declarations;
45  * - main -> function;
46  * - stdout -> FILE* out;
47  * - include unistd added
48  * - exit -> return
49  * - close ifp
50  * - bug labeled end (skipped) in lend()
51  * - tab in first columns...
52  * - bang comments added
53  * - bug name[20] overflow not checked in lname (20 -> 80)
54  * - hollerith constants conversion;-)
55  * - LINESIZE 80 -> 200...
56  * - "PROGRAM MAIN..." added if implicit program name.
57  * - extr* stuff dropped.
58  * - dir_name for localizing files...
59  * - \r skipped
60  * - last line may not be \n'ed.
61  * - bang comment management added (to avoid the parser)
62  *
63  */
64 
65 /* added macros
66  */
67 #define isbegincomment(c) \
68  ((c)=='!' || (c)=='*' || (c)=='c' || (c)=='C' || (c)=='#')
69 #define issquote(c) ((c)=='\'')
70 #define isdquote(c) ((c)=='\"')
71 #define ishH(c) ((c)=='h' || (c)=='H')
72 #define char2int(c) ((int)((c)-'0'))
73 
74 static char * hollerith_and_bangcomments(char *);
75 #define LINESIZE 200
76 
77 /*
78  * Copyright (c) 1983 The Regents of the University of California.
79  * All rights reserved.
80  *
81  * This code is derived from software contributed to Berkeley by
82  * Asa Romberger and Jerry Berkman.
83  *
84  * Redistribution and use in source and binary forms, with or without
85  * modification, are permitted provided that the following conditions
86  * are met:
87  * 1. Redistributions of source code must retain the above copyright
88  * notice, this list of conditions and the following disclaimer.
89  * 2. Redistributions in binary form must reproduce the above copyright
90  * notice, this list of conditions and the following disclaimer in the
91  * documentation and/or other materials provided with the distribution.
92  * 3. All advertising materials mentioning features or use of this software
93  * must display the following acknowledgement:
94  * This product includes software developed by the University of
95  * California, Berkeley and its contributors.
96  * 4. Neither the name of the University nor the names of its contributors
97  * may be used to endorse or promote products derived from this software
98  * without specific prior written permission.
99  *
100  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
101  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
102  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
103  * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
104  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
105  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
106  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
107  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
108  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
109  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
110  * SUCH DAMAGE.
111  */
112 
113 #ifndef lint
114 char fsplit_copyright[] =
115  "@(#) Copyright (c) 1983 The Regents of the University of California.\n\
116  All rights reserved.\n";
117 #endif /* not lint */
118 
119 #ifndef lint
120 char fsplit_sccsid[] = "@(#)fsplit.c 5.5 (Berkeley) 3/12/91";
121 #endif /* not lint */
122 
123 #include <stdlib.h>
124 #include <stdio.h>
125 #include <ctype.h>
126 #include <unistd.h>
127 #include <string.h>
128 #include <sys/types.h>
129 #include <sys/stat.h>
130 
131 /*
132  * usage: fsplit [-e efile] ... [file]
133  *
134  * split single file containing source for several fortran programs
135  * and/or subprograms into files each containing one
136  * subprogram unit.
137  * each separate file will be named using the corresponding subroutine,
138  * function, block data or program name if one is found; otherwise
139  * the name will be of the form mainNNN.f or blkdtaNNN.f .
140  * If a file of that name exists, it is saved in a name of the
141  * form zzz000.f .
142  * If -e option is used, then only those subprograms named in the -e
143  * option are split off; e.g.:
144  * fsplit -esub1 -e sub2 prog.f
145  * isolates sub1 and sub2 in sub1.f and sub2.f. The space
146  * after -e is optional.
147  *
148  * Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley.
149  * - added comments
150  * - more function types: double complex, character*(*), etc.
151  * - fixed minor bugs
152  * - instead of all unnamed going into zNNN.f, put mains in
153  * mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f .
154  */
155 
156 #define BSZ 512
157 static char buf[BSZ];
158 static FILE *ifp;
159 static char *x, *mainp, *blkp;
160 
161 #define true 1
162 #define false 0
163 static struct stat sbuf;
164 
165 static char *look(), *skiplab(), *functs();
166 static int scan_name();
167 static void get_name();
168 
169 #define trim(p) while (*p == ' ' || *p == '\t') p++
170 
171 static char * full_name(char * dir, char * name)
172 {
173  char * full = (char*) malloc(sizeof(char)*(strlen(dir)+strlen(name)+2));
174  sprintf(full, "%s/%s", dir, name);
175  return full;
176 }
177 
178 static void get_name(name)
179 char *name;
180 {
181  register char *ptr;
182 
183  while (stat(name, &sbuf) >= 0)
184  {
185  ptr = name + strlen(name) - 1;
186  while (!isdigit((int) *ptr--) && ptr>name);
187  for (ptr++; isdigit((int) *ptr) && ptr>name; ptr--) {
188  (*ptr)++;
189  if (*ptr <= '9')
190  break;
191  *ptr = '0';
192  }
193  if(ptr < name ) {
194  fprintf( stderr, "fsplit: ran out of file names\n");
195  exit(1);
196  }
197  }
198 }
199 
200 static int current_line_number = 0;
201 
202 /* getline does not handle continuations...
203  */
204 static int GetLine()
205 {
206  register char *ptr;
207 
208  current_line_number++;
209 
210  if (feof(ifp)) return -1;
211 
212  for (ptr = buf; ptr < &buf[BSZ]; ) {
213  *ptr = getc(ifp);
214  /* fix for the last line that may not have a \n.
215  * It is returned however and lend handles it correctly.
216  */
217  if (feof(ifp) || *ptr++ == '\n')
218  {
219  *ptr = 0;
220  return (1);
221  }
222  }
223  while (getc(ifp) != '\n' && feof(ifp) == 0) ;
224  fprintf(stderr, "line truncated to %d characters\n", BSZ);
225  return (1);
226 }
227 
228 static char * skip_comment_if_any(char * lines)
229 {
230  int i = 0;
231 
232  while (isbegincomment(lines[i]))
233  {
234  while (lines[i]!='\0' && lines[i]!='\n') i++;
235  if (lines[i]=='\n') i++;
236  }
237 
238  return lines+i;
239 }
240 
241 /* return 1 for 'end' alone on card (up to col. 72), 0 otherwise */
242 static int lend()
243 {
244  register char *p, * lbuf;
245  int tab = false;
246 
247  lbuf = skip_comment_if_any(buf);
248 
249  for (p=lbuf; p<&lbuf[6] && !tab; p++)
250  {
251  if (*p=='\0') return 0;
252  if (*p=='\t') tab=true;
253  }
254 
255  if (!tab && (lbuf[5]!=' ' && lbuf[5]!='\t'))
256  return 0; /* a continuation */
257 
258  trim(p);
259  if (*p != 'e' && *p != 'E') return(0);
260  p++;
261  trim(p);
262  if (*p != 'n' && *p != 'N') return(0);
263  p++;
264  trim(p);
265  if (*p != 'd' && *p != 'D') return(0);
266  p++;
267  trim(p);
268  if (p - buf >= 72 || *p == '\n' || *p == '\r' || *p == '\0')
269  return (1);
270  return (0);
271 }
272 
273 static int implicit_program; /* FC */
274 static int implicit_blockdata_name; /* FC */
275 static int implicit_program_name; /* FC */
276 static int it_is_a_main; /* FC */
277 static int it_is_an_entry;
278 
279 /* check for keywords for subprograms
280  return 0 if comment card, 1 if found
281  name and put in arg string. invent name for unnamed
282  block datas and main programs. */
283 static int lname(char * s, int look_for_entry)
284 {
285  register char *ptr, *p;
286  char line[LINESIZE], *iptr = line, * lbuf;
287 
288  implicit_program = 0;
289  implicit_blockdata_name = 0;
290  implicit_program_name = 0;
291  it_is_a_main = 0;
292  it_is_an_entry = 0;
293 
294  lbuf = skip_comment_if_any(buf);
295 
296  /* first check for comment cards */
297  if(isbegincomment(lbuf[0]))
298  return 0;
299  ptr = lbuf;
300  while (*ptr == ' ' || *ptr == '\t') ptr++;
301  if(*ptr == '\n') return(0);
302 
303  ptr = skiplab(lbuf);
304  if (ptr == 0) return (0);
305 
306  /* copy to buffer and converting to lower case */
307  p = ptr;
308  while (*p && p <= &lbuf[71] ) {
309  *iptr = isupper((int) *p) ? tolower(*p) : *p;
310  iptr++;
311  p++;
312  }
313  *iptr = '\n';
314 
315  if (look_for_entry) {
316  /* entry is looked for within a something... */
317  if ((ptr = look(line, "entry")) != 0)
318  if(scan_name(s, ptr))
319  it_is_an_entry = 1;
320  } else {
321  if ((ptr = look(line, "subroutine")) != 0 ||
322  (ptr = look(line, "function")) != 0 ||
323  (ptr = functs(line)) != 0) {
324  if(!scan_name(s, ptr))
325  strcpy( s, x);
326  } else if((ptr = look(line, "program")) != 0) {
327  it_is_a_main = 1;
328  if(!scan_name(s, ptr)) {
329  implicit_program_name = 1;
330  get_name( mainp);
331  strcpy( s, mainp);
332  }
333  } else if((ptr = look(line, "blockdata")) != 0) {
334  if(!scan_name(s, ptr)) {
335  implicit_blockdata_name = 1;
336  get_name( blkp);
337  strcpy( s, blkp);
338  }
339  } else if((ptr = functs(line)) != 0) {
340  if(!scan_name(s, ptr))
341  strcpy( s, x);
342  } else {
343  implicit_program = 1;
344  it_is_a_main = 1;
345  get_name(mainp);
346  strcpy(s, mainp);
347  }
348  }
349 
350  return(1);
351 }
352 
353 #define allowed_first_char(c) \
354  (((c)>='a' && (c)<='z') || ((c)>='A' && (c)<='Z') || ((c)=='_'))
355 
356 #define allowed_char(c) \
357  (allowed_first_char(c) || ((c)>='0' && (c)<='9'))
358 
359 #define skippable_char(c) \
360  ((c)==' ' || (c)=='\t' || (c)=='\r')
361 
362 static int scan_name(s, ptr)
363 char *s, *ptr;
364 {
365  char *sptr;
366 
367  /* scan off the name */
368  trim(ptr);
369  sptr = s;
370 
371  /* must have a valid first char. */
372  if (!allowed_first_char(*ptr)) return 0;
373 
374  while (allowed_char(*ptr) || skippable_char(*ptr)) {
375  if (!skippable_char(*ptr))
376  *sptr++ = *ptr;
377  ptr++;
378  }
379 
380  if (sptr == s) return(0);
381 
382  /* next char should be a ( or \n */
383  if (*ptr!='(' && *ptr!='\n') return 0;
384 
385  *sptr++ = '.';
386  *sptr++ = 'f';
387  *sptr++ = 0;
388  return(1);
389 }
390 
391 static char *functs(p)
392 char *p;
393 {
394  register char *ptr;
395 
396 /* look for typed functions such as: real*8 function,
397  character*16 function, character*(*) function */
398 
399  if((ptr = look(p,"character")) != 0 ||
400  (ptr = look(p,"logical")) != 0 ||
401  (ptr = look(p,"real")) != 0 ||
402  (ptr = look(p,"integer")) != 0 ||
403  (ptr = look(p,"doubleprecision")) != 0 ||
404  (ptr = look(p,"complex")) != 0 ||
405  (ptr = look(p,"doublecomplex")) != 0 ) {
406  while ( *ptr == ' ' || *ptr == '\t' || *ptr == '*'
407  || (*ptr >= '0' && *ptr <= '9')
408  || *ptr == '(' || *ptr == ')') ptr++;
409  ptr = look(ptr,"function");
410  return(ptr);
411  }
412  else
413  return(0);
414 }
415 
416 /* if first 6 col. blank, return ptr to col. 7,
417  if blanks and then tab, return ptr after tab,
418  else return 0 (labelled statement, comment or continuation */
419 static char *skiplab(p)
420 char *p;
421 {
422  register char *ptr;
423 
424  for (ptr = p; ptr < &p[6]; ptr++) {
425  if (*ptr == ' ')
426  continue;
427  if (*ptr == '\t') {
428  ptr++;
429  break;
430  }
431  return (0);
432  }
433  return (ptr);
434 }
435 
436 /* return 0 if m doesn't match initial part of s;
437  otherwise return ptr to next char after m in s */
438 static char *look(s, m)
439 char *s, *m;
440 {
441  register char *sp, *mp;
442 
443  sp = s; mp = m;
444  while (*mp) {
445  trim(sp);
446  if (*sp++ != *mp++)
447  return (0);
448  }
449  return (sp);
450 }
451 
452 static void put_upper_from_slash_till_dot_or_end(char * what, FILE * where)
453 {
454  if (*what=='.') {
455  char * tmp = what+strlen(what);
456  while (tmp>what && *tmp!='/') tmp--;
457  if (what!=tmp) what=tmp+1;
458  }
459  while (*what && *what!='.') putc(toupper(*what++), where);
460 }
461 
462 static void print_name(FILE * o, char * name, int n, int upper) /* FC */
463 {
464  name = name + strlen(name) - n - 2;
465  while (n-->0) putc(upper? toupper(*name++): *name++, o);
466 }
467 
468 #define FREE_STRINGS \
469  if (main_list) free(main_list), main_list = NULL; \
470  if (x) free(x), x = NULL; \
471  if (mainp) free(mainp), mainp = NULL; \
472  if (blkp) free(blkp), blkp = NULL;
473 
474 char * fsplit(char * dir_name, char * file_name, FILE * out)
475 {
476  FILE *ofp; /* output file */
477  int rv; /* 1 if got card in output file, 0 otherwise */
478  int nflag, /* 1 if got name of subprog., 0 otherwise */
479  someentry, newname;
480  /* ??? 20 -> 80 because not checked... smaller than a line is ok ? FC */
481  char name[80];
482  char tmpname[80];
483 
484  /* MALLOC STRINGS
485  */
486  char * main_list = full_name(dir_name, MAIN_FILE_NAMES);
487  x = full_name(dir_name, "###000.f");
488  mainp = full_name(dir_name, "main000.f");
489  blkp = full_name(dir_name, "data000.f");
490 
491  current_line_number = 0;
492 
493  if ((ifp = fopen(file_name, "r")) == NULL) {
494  fprintf(stderr, "fsplit: cannot open %s\n", file_name);
495  FREE_STRINGS;
496  return "cannot open file";
497  }
498 
499  for(;;) {
500 
501  /* look for a temp file that doesn't correspond to an existing file */
502  get_name(x);
503  ofp = fopen(x, "w");
504  if (ofp==NULL) {
505  fprintf(stderr, "%s %s -> %s\n", dir_name, file_name, x);
506  fprintf(stderr, "fopen(\"%s\", ...) failed\n", x);
507  abort();
508  }
509 
510  nflag = 0;
511  rv = 0;
512  newname = 0;
513  someentry = 0;
514 
515  while (GetLine() > 0)
516  {
517  char * error = hollerith_and_bangcomments(buf); /* FC */
518  if (error) {
519  fclose(ofp);
520  fclose(ifp);
521  FREE_STRINGS;
522  return error;
523  }
524 
525  if (nflag == 0) /* if no name yet, try and find one */
526  nflag = lname(name, 0), newname=nflag;
527  else { /* FC: some hack to deal with entry... */
528  lname(tmpname, 1);
529  newname = it_is_an_entry;
530  someentry = it_is_an_entry;
531  implicit_program = 0;
532  it_is_a_main = 0;
533  it_is_an_entry = 0;
534  }
535 
536  if (it_is_a_main) {
537  FILE * fm = fopen(main_list, "a");
538  if (fm==NULL) {
539  fprintf(stderr, "fopen(\"%s\", ...) failed\n", main_list);
540  // FI: not user friendly...
541  abort();
542  }
544  print_name(fm, name, 7, 1);
545  else
547  putc('\n', fm);
548  fclose(fm);
549  it_is_a_main = 0;
550  }
551 
552  if (implicit_program==1) /* FC again */
553  {
554  fprintf(ofp,
555  "! next line added by fsplit() in pips\n"
556  " PROGRAM ");
557  print_name(ofp, name, 7, 0);
558  putc('\n', ofp);
559  implicit_program = 0; /* now we gave it a name! */
560  }
561 
563  {
564  fprintf(ofp,
565  "! next line modified by fsplit() in pips\n"
566  " %s ",
567  implicit_program_name==1? "PROGRAM": "BLOCK DATA");
568  print_name(ofp, name, 7, 0);
569  putc('\n', ofp);
572  }
573  else
574  fprintf(ofp, "%s", buf);
575 
576  /* a new module name is appended to the current line... */
577  if (newname)
578  {
579  if ((someentry && tmpname[0]) || (!someentry && name[0]))
580  {
582  (someentry? tmpname: name, out);
583  putc(' ', out);
584  }
585  newname = 0;
586  someentry = 0;
587  tmpname[0] = '\0';
588  }
589 
590  rv = 1;
591 
592  if (lend()) /* look for an 'end' statement */
593  break;
594  } /* while */
595 
596  if (fclose(ofp)) {
597  fprintf(stderr, "fclose(ofp) failed\n");
598  exit(2);
599  }
600  if (rv == 0) { /* no lines in file, forget the file */
601  safe_unlink(x);
602  if (fclose(ifp)) {
603  fprintf(stderr, "fclose(ifp) failed\n");
604  exit(2);
605  }
606  FREE_STRINGS; return NULL;
607  }
608  if (nflag) /* rename the file */
609  {
610  if (strncmp(dir_name, name, strlen(dir_name))!=0)
611  {
612  char * full = full_name(dir_name, name);
613  strcpy(name, full);
614  free(full);
615  }
616  if (strcmp(name, x) == 0) {
617  printf(/* out? */ "%s\n", x);
618  }
619  else if (stat(name, &sbuf) < 0 )
620  {
621  int ok = link(x, name);
622  // FC: link() may fail but it is ok?
623  if (ok != 0 && ok != -1) abort();
624  safe_unlink(x);
625  fprintf(out, "%s\n", name);
626  }
627  else
628  printf("%s already exists, put in %s\n", name, x);
629  continue;
630  }
631  fprintf(out, "%s\n", x);
632  } /* for(;;) */
633 
634  if (fclose(ifp)) {
635  fprintf(stderr, "fclose(ifp) failed\n");
636  exit(2);
637  }
638  FREE_STRINGS;
639  return "bad fsplit() terminaison.";
640 }
641 
642 
643 /* ADDITION: basic Hollerith constants handling
644  * FC 11 Apr 1997
645  *
646  * bugs:
647  * - under special circonstances, the dilatation of the transformation
648  * may lead continuations to exceed the 19 lines limit.
649  *
650  * to improve:
651  * - hack for "real*8 hollerith", but should just forbids start after *?
652  * maybe some other characters?
653  */
654 
655 
656 /* global state
657  */
658 static int in_squotes=0, in_dquotes=0, in_id=0, in_hollerith=0;
659 
660 static int blank_line_p(char * line)
661 {
662  if (!line) return 1;
663  while (*line)
664  if (!isspace((int) *line++))
665  return 0;
666  return 1;
667 }
668 
669 #define HOLL_ERROR \
670  "pips internal error: cannot process " \
671  "hollerith constants on continued lines (line %d)"
672 
673 static char * hollerith_and_bangcomments(char * line)
674 {
675  int i,j,initial, touched=0, bang=0;
676  char bangcomment[BSZ];
677 
678  bangcomment[0] = '\0';
679 
680  if (!line) {
681  in_squotes=0, in_dquotes=0, in_id=0, in_hollerith=0; /* RESET */
682  return NULL;
683  }
684 
685  if (blank_line_p(line))
686  return NULL;
687 
688  if (isbegincomment(line[0]))
689  return NULL;
690 
691  i = (line[0]=='\t')? 1: 6; /* first column to analyze */
692 
693  for (j=0; j<i; j++)
694  if (!line[j]) return NULL;
695 
696  if (isspace((int) line[i-1]))
697  in_squotes=0, in_dquotes=0, in_id=0, in_hollerith=0; /* RESET */
698 
699  initial=i;
700 
701  while (line[i] && initial<72) /* 73.. ignored */
702  {
703  if (!in_dquotes && issquote(line[i]))
705  if (!in_squotes && isdquote(line[i]))
707  if (!in_squotes && !in_dquotes)
708  {
709  if (isalpha((int) line[i]))
710  in_id=1;
711  else if (!isalnum((int) line[i]) && !isspace((int) line[i])
712  && line[i]!='*') /* hack for real*8 hollerith */
713  in_id=0;
714  }
715 
716  if (!in_squotes && !in_dquotes && !in_id && isdigit((int) line[i]))
717  {
718  /* looks for [0-9 ]+[hH]
719  */
720  int len=char2int(line[i]), ni=i;
721  i++, initial++;
722 
723  while (line[i] && initial<72
724  && (isdigit((int) line[i]) || isspace((int) line[i])))
725  {
726  if (isdigit((int) line[i]))
727  len=10*len+char2int(line[i]);
728  i++, initial++;
729  }
730 
731  if (!line[i] || initial>=72) return NULL;
732 
733  if (ishH(line[i])) /* YEAH, here it is! */
734  {
735  char tmp[200];
736  int k;
737 
738  if (!touched) { /* rm potential 73-80 text */
739  touched=1;
740  line[72]='\n';
741  line[73]='\0';
742  }
743 
744  j=1;
745 
746  tmp[0] = '\''; i++, initial++;
747  while (j<200 && line[i] && initial<72 &&
748  line[i]!='\n' && len>0)
749  {
750  len--;
751  if (line[i]=='\'')
752  tmp[j++]='\'';
753  tmp[j++] = line[i++];
754  initial++;
755  }
756 
757  if (len!=0) /* should look for a continuation OR pad. */
758  {
759  if (initial==72)
760  {
761  char * msg = (char*) malloc((strlen(HOLL_ERROR)+10)*sizeof(char*));
762  (void) sprintf(msg, HOLL_ERROR, current_line_number);
763  return msg;
764  }
765  else
766  {
767  while (j<199 && len>0) /* padding */
768  tmp[j++]=' ', len--;
769  }
770  }
771 
772  tmp[j]='\'';
773 
774  /* must insert tmp[<j] in line[ni..]
775  * first, shift the line...
776  */
777 
778  {
779  int ll = strlen(line), shift = i-(ni+j+1);
780 
781  if (shift>0) /* to the left */
782  for (k=0; i+k<=ll; k++)
783  line[ni+j+1+k] = line[i+k];
784  else /* to the right */
785  for (k=ll-i; k>=0; k--)
786  line[ni+j+1+k] = line[i+k];
787  }
788 
789  i=ni+j+1;
790 
791  while(j>=0)
792  line[ni+j]=tmp[j], j--;
793 
794  }
795  }
796 
797  /* bang comment in the middle of a line. */
798  if (!in_squotes && !in_dquotes && line[i]=='!')
799  {
800  strcpy(bangcomment,&line[i]);
801  line[i]='\n', line[i+1]='\0'; /* stop while loop */
802  bang=1;
803  }
804 
805  i++, initial++;
806  }
807 
808  if (touched)
809  {
810  int len = strlen(line); /* the new line may exceed the 72 column */
811  /* caution, len includes cr... */
812  /* the dilatation cannot exceed one line (?) */
813  if (len-1>72) /* then shift and continuation... */
814  {
815  for (i=len; i>=72; i--) line[i+7] = line[i];
816  line[72]='\n'; line[73]=' '; line[74]=' ';
817  line[75]=' '; line[76]=' '; line[77]=' '; line[78]='x';
818  }
819  }
820 
821  /* the bang comment is moved to the preceding line.
822  */
823  if (bang)
824  {
825  char tmp[BSZ];
826  strcpy(tmp,line);
827  strcpy(line,bangcomment);
828  strcat(line,tmp);
829  }
830 
831  return NULL;
832 }
833 
834 /* processing extracted for includes...
835  */
836 char * process_bang_comments_and_hollerith(FILE * in, FILE * out)
837 {
838  char * error;
839  ifp = in;
841  while (GetLine()>0)
842  {
844  if (error) return error;
845  fputs(buf, out);
846  }
847  ifp = NULL;
848  return NULL;
849 }
#define error(fun, msg)
NewGen interface with C3 type Psysteme for PIPS project.
Definition: Psc.c:78
static FILE * out
Definition: alias_check.c:128
void safe_unlink(const char *file_name)
Delete the given file.
Definition: file.c:852
void * malloc(YYSIZE_T)
void free(void *)
#define exit(code)
Definition: misc-local.h:54
#define abort()
Definition: misc-local.h:53
int fprintf()
test sc_min : ce test s'appelle par : programme fichier1.data fichier2.data ...
int printf()
static int line
FLEX_SCANNER.
Definition: scanner.c:852
static bool ok
#define isdquote(c)
Definition: split_file.c:70
static void put_upper_from_slash_till_dot_or_end(char *what, FILE *where)
Definition: split_file.c:452
static int lend()
return 1 for 'end' alone on card (up to col.
Definition: split_file.c:242
static int blank_line_p(char *line)
Definition: split_file.c:660
static char * hollerith_and_bangcomments(char *)
Definition: split_file.c:673
static int lname(char *s, int look_for_entry)
check for keywords for subprograms return 0 if comment card, 1 if found name and put in arg string.
Definition: split_file.c:283
static int in_dquotes
Definition: split_file.c:658
static int in_squotes
ADDITION: basic Hollerith constants handling FC 11 Apr 1997.
Definition: split_file.c:658
static int in_id
Definition: split_file.c:658
static int in_hollerith
Definition: split_file.c:658
#define ishH(c)
Definition: split_file.c:71
static int it_is_an_entry
FC.
Definition: split_file.c:277
static int current_line_number
Definition: split_file.c:200
static FILE * ifp
Definition: split_file.c:158
#define isbegincomment(c)
added macros
Definition: split_file.c:67
static void print_name(FILE *o, char *name, int n, int upper)
FC.
Definition: split_file.c:462
#define HOLL_ERROR
Definition: split_file.c:669
static char * x
Definition: split_file.c:159
static int implicit_program_name
FC.
Definition: split_file.c:275
char * process_bang_comments_and_hollerith(FILE *in, FILE *out)
processing extracted for includes...
Definition: split_file.c:836
static char buf[BSZ]
Definition: split_file.c:157
#define issquote(c)
Definition: split_file.c:69
static int implicit_blockdata_name
FC.
Definition: split_file.c:274
static int it_is_a_main
FC.
Definition: split_file.c:276
static char * full_name(char *dir, char *name)
Definition: split_file.c:171
#define BSZ
not lint
Definition: split_file.c:156
#define char2int(c)
Definition: split_file.c:72
static struct stat sbuf
Definition: split_file.c:163
static int implicit_program
Definition: split_file.c:273
static int GetLine()
getline does not handle continuations...
Definition: split_file.c:204
#define FREE_STRINGS
Definition: split_file.c:468
@ full
Definition: union-local.h:65