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
|
include defs
# DECLCO -- Process a declaration (xpp directive). Look up directive in
# the symbol table. If found, output the corresponding Fortran declaration,
# otherwise output the original string.
subroutine declco (id)
character id(MAXTOK)
character newid(MAXTOK), tok, tokbl
integer junk, ludef, equal, gettok
include COMMON_BLOCKS
string xptyp XPOINTER
string xpntr "x$pntr"
string xfunc "x$func"
string xsubr "x$subr"
ifdef (IMPNONE,
string impnone "implicit none")
if (ludef (id, newid, xpptbl) == YES) {
if (equal (id, xpntr) == YES) {
# Pointer declaration.
tokbl = gettok (newid, MAXTOK)
if (tokbl == BLANK)
tok = gettok (newid, MAXTOK)
else
tok = tokbl
if (tok == XPP_DIRECTIVE & equal (newid, xfunc) == YES) {
# Pointer function.
call outtab
call outstr (xptyp)
junk = ludef (newid, newid, xpptbl)
call outstr (newid)
call eatup
call outdon
ifdef (IMPNONE,
call outtab
call outstr (impnone)
call outdon)
call poicod (NO)
} else {
# Pointer variable.
call pbstr (newid)
call poicod (YES)
}
} else if (equal (id, xsubr) == YES) {
# Subroutine declaration.
call outtab
call outstr (newid)
call eatup
call outdon
ifdef (IMPNONE,
call outtab
call outstr (impnone)
call outdon)
} else {
# Some other declaration.
call outtab
call outstr (newid)
call outch (BLANK)
}
} else
call synerr ("Invalid x$type type declaration.")
end
|
