1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
include <ctype.h>
define DOT '.'
define SQUOTE '\''
define DQUOTE '"'
define BSLASH '\\'
#* HISTORY *
#* B.Simon 04-Jan-93 Original
#* B.Simon 01-Dec-93 No longer removes backslashes
# FTNEXPR -- Convert a Fortran boolean expression to SPP
procedure ftnexpr (oldexpr, newexpr, maxch)
char oldexpr[ARB] # i: Fortran expression
char newexpr[ARB] # o: SPP expression
int maxch # i: Maximum length of SPP expression
#--
char ch, term
int ic, jc, kc, iw
pointer sp, dotbuf
string ftnlist ".eq. .and. .or. .gt. .ge. .lt. .le. .not. .ne."
string spplist " == && || > >= < <= ! !="
int gstrcpy(), word_match(), word_find()
begin
# Allocate dynamic memory for strings
call smark (sp)
call salloc (dotbuf, SZ_LINE, TY_CHAR)
# Loop over each character in the old expression
# Characters between quote marks or dots are treated specially
# To indicate this, term is set to the leading character
ic = 1
jc = 1
kc = 0
term = EOS
while (oldexpr[ic] != EOS) {
ch = oldexpr[ic]
if (ch != term) {
if (term == EOS) {
if (ch == DOT) {
kc = 1
term = ch
Memc[dotbuf] = ch
} else {
if (ch == SQUOTE || ch == DQUOTE)
term = ch
newexpr[jc] = ch
jc = jc + 1
}
} else if (term == DOT) {
if (IS_ALPHA(ch)) {
if (kc < SZ_LINE) {
Memc[dotbuf+kc] = ch
kc = kc + 1
}
} else {
Memc[dotbuf+kc] = ch
Memc[dotbuf+kc+1] = EOS
jc = jc + gstrcpy (Memc[dotbuf], newexpr[jc],
maxch-jc+1)
kc = 0
term = EOS
}
} else {
newexpr[jc] = ch
jc = jc + 1
if (ch == BSLASH) {
ic = ic + 1
newexpr[jc] = oldexpr[ic]
jc = jc + 1
}
}
} else {
term = EOS
if (ch != DOT) {
newexpr[jc] = ch
jc = jc + 1
} else {
Memc[dotbuf+kc] = ch
Memc[dotbuf+kc+1] = EOS
call strlwr (Memc[dotbuf])
iw = word_match (Memc[dotbuf], ftnlist)
if (iw == 0) {
jc = jc + gstrcpy (Memc[dotbuf], newexpr[jc],
maxch-jc+1)
} else {
jc = jc + word_find (iw, spplist, newexpr[jc],
maxch-jc+1)
}
kc = 0
}
}
ic = ic + 1
}
# If there is anything left in the dot buffer copy it unchanged
# to the output string
newexpr[jc] = EOS
if (kc > 0) {
Memc[dotbuf+kc] = EOS
call strcat (Memc[dotbuf], newexpr, maxch)
}
call sfree (sp)
end
|
