1
/*===========================================================================
2
Copyright (C) 1987-2009 European Southern Observatory (ESO)
4
This program is free software; you can redistribute it and/or
5
modify it under the terms of the GNU General Public License as
6
published by the Free Software Foundation; either version 2 of
7
the License, or (at your option) any later version.
9
This program is distributed in the hope that it will be useful,
10
but WITHOUT ANY WARRANTY; without even the implied warranty of
11
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12
GNU General Public License for more details.
14
You should have received a copy of the GNU General Public
15
License along with this program; if not, write to the Free
16
Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
19
Correspondence concerning ESO-MIDAS should be addressed as follows:
20
Internet e-mail: midas@eso.org
21
Postal address: European Southern Observatory
22
Data Management Division
23
Karl-Schwarzschild-Strasse 2
24
D 85748 Garching bei Muenchen
26
===========================================================================*/
28
/*+++++++++ Remove ESO extensions to FORTRAN 77 ++++++++++++++++++++
29
.COPYRIGHT (c) 1994 European Southern Observatory
32
.AUTHOR Preben J. Grosbol [ESO/IPG]
33
.KEYWORDS ESO fortran, line input
36
.VERSION 1.0 10-Nov-1987: Creation, PJG
37
.VERSION 1.1 14-Jan-1988: Replace tabs with space, PJG
38
.VERSION 1.2 15-Feb-1988: Replace form-feed with space, PJG
39
.VERSION 1.3 23-Mar-1988: Redefine 'c' as int, PJG
40
.VERSION 1.4 20-Dec-1988: Check for max. line ident., PJG
41
.VERSION 1.5 24-Jun-1992: Correct check for '' in format, PJG
42
.VERSION 1.6 27-Apr-1994: Warning for character after col.72, PJG
43
.VERSION 1.7 06-May-1994: Check only non-space after col72, PJG
46
------------------------------------------------------------------------*/
47
#include <stdio.h> /* standard I/O functions */
48
#include <ctype.h> /* character types */
49
#include <f77ext.h> /* definition of constants */
51
extern int x_flag; /* extension option flag */
52
extern int equal; /* level zero equal sign */
53
extern int comma; /* level zero comma */
54
extern int nlb; /* present index in 'lbuf' */
55
extern int id_size; /* length of identifier */
56
extern int no_lid; /* no. of line identifiers */
57
extern int nstat; /* char. index in 'stat' */
58
extern char stmt[]; /* present statement */
59
extern char lbuf[MXLBUF][MXLINE]; /* buffer for input lines */
60
extern LID lid[]; /* list of line identifiers */
62
static int q_level; /* quote level in statement */
63
static int p_level; /* parenthesis level */
64
static char *pstat; /* pointer to statement */
66
char get_line(fp) /* add character to buffer */
69
int c, nlbuf, e_mark, ncol, ncx;
73
if (!nstat) { /* reset at start of statement */
74
q_level = 0; p_level = 0;
75
pstat = stmt; id_size = 0;
78
nlbuf = 0; e_mark = 0;
79
plbuf = &lbuf[nlb][0];
81
while ((c=getc(fp)) != '\n' && c != EOF) { /* read rest of line */
82
if (c=='\t' || c=='\f') c = ' ';
83
if (MXLINE<=nlbuf) continue;
85
if (!(x_flag & EXC_FLAG)) { *plbuf++ = c; nlbuf++; }
88
if (c=='\'') q_level = !q_level;
89
if (c=='!' && !q_level) {
90
if (!(x_flag & EXC_FLAG)) { *plbuf++ = c; nlbuf++; }
94
if (65<ncol++ && c!=' ') ncx = 1;
95
if (c==',' && !p_level && !q_level) comma = 1;
96
if (c=='=' && !p_level && !q_level) equal = 1;
97
if (!q_level && (x_flag & UPC_FLAG)) c = (islower(c)) ? toupper(c) : c;
99
if (id_size && c!=' ') { /* check for identifiers */
100
if (isalpha(c) || isdigit(c) || c=='_') /* continue identifier */
102
else { /* end of identifier */
103
lid[no_lid].size = id_size;
104
lid[no_lid].level = p_level;
105
lid[no_lid].id = (ID *) 0;
108
fprintf(stderr,"Error: Too many identifiers in statement\n");
111
else if (!q_level && isalpha(c)) { /* start of identifier */
112
lid[no_lid].sid = pstat;
113
lid[no_lid].lid = plbuf;
114
lid[no_lid].lno = nlb;
117
if (c=='(') p_level++;
118
if (c==')') p_level--;
119
*plbuf++ = c; nlbuf++;
120
if (c!=' ' || q_level) { *pstat++ = c; nstat++; }
122
if (id_size) { /* end of identifier */
123
lid[no_lid].size = id_size;
124
lid[no_lid].level = p_level;
125
lid[no_lid].id = (ID *) 0;
128
fprintf(stderr,"Error: Too many identifiers in statement\n");
131
if (ncx) { /* characters after column 72 */
132
fprintf(stderr,"esoext-warning: Non-space characters after column 72\n");
133
fprintf(stderr," >%-75.75s\n",&lbuf[nlb][0]);