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
|
#-h- strdcl 2575 local 12/01/80 15:55:05
# strdcl - generate code for string declaration
include defs
subroutine strdcl
include COMMON_BLOCKS
character t, token (MAXTOK), dchar (MAXTOK)
character gnbtok
integer i, j, k, n, len
integer length, ctoi, lex
string char "integer*2/"
string dat "data "
string eoss "0/"
t = gnbtok (token, MAXTOK)
if (t != ALPHA)
call synerr ("missing string token.")
call squash (token)
call outtab
call pbstr (char) # use defined meaning of "character"
repeat {
t = gnbtok (dchar, MAXTOK)
if (t == SLASH)
break
call outstr (dchar)
}
call outch (BLANK) # separator in declaration
call outstr (token)
call addstr (token, sbuf, sbp, SBUFSIZE) # save for later
call addchr (EOS, sbuf, sbp, SBUFSIZE)
if (gnbtok (token, MAXTOK) != LPAREN) { # make size same as initial value
len = length (token) + 1
if (token (1) == SQUOTE | token (1) == DQUOTE)
len = len - 2
}
else { # form is string name (size) init
t = gnbtok (token, MAXTOK)
i = 1
len = ctoi (token, i)
if (token (i) != EOS)
call synerr ("invalid string size.")
if (gnbtok (token, MAXTOK) != RPAREN)
call synerr ("missing right paren.")
else
t = gnbtok (token, MAXTOK)
}
call outch (LPAREN)
call outnum (len)
call outch (RPAREN)
call outdon
if (token (1) == SQUOTE | token (1) == DQUOTE) {
len = length (token)
token (len) = EOS
call addstr (token (2), sbuf, sbp, SBUFSIZE)
}
else
call addstr (token, sbuf, sbp, SBUFSIZE)
call addchr (EOS, sbuf, sbp, SBUFSIZE)
t = lex (token) # peek at next token
call pbstr (token)
if (t != LEXSTRING) { # dump accumulated data statements
for (i = 1; i < sbp; i = j + 1) {
call outtab
call outstr (dat)
k = 1
for (j = i + length (sbuf (i)) + 1; ; j = j + 1) {
if (k > 1)
call outch (COMMA)
call outstr (sbuf (i))
call outch (LPAREN)
call outnum (k)
call outch (RPAREN)
call outch (SLASH)
if (sbuf (j) == EOS)
break
n = sbuf (j)
call outnum (n)
call outch (SLASH)
k = k + 1
}
call pbstr (eoss) # use defined meaning of EOS
repeat {
t = gnbtok (token, MAXTOK)
call outstr (token)
} until (t == SLASH)
call outdon
}
sbp = 1
}
return
end
|
