blob: 4cdb3d72130c5c4592b1eb18f18ca97afedc9a00 (
plain) (
blame)
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
include defs
# gtok - get token for Ratfor
character function gtok (lexstr, toksiz)
character lexstr (MAXTOK)
integer toksiz
include COMMON_BLOCKS
character c
character ngetch
integer i
# external index
# integer index
# string digits "0123456789abcdefghijklmnopqrstuvwxyz"
c = ngetch (lexstr (1))
if (c == BLANK | c == TAB) {
lexstr (1) = BLANK
while (c == BLANK | c == TAB) # compress many blanks to one
c = ngetch (c)
if (c == SHARP)
while (ngetch (c) != NEWLINE) # strip comments
;
if (c != NEWLINE)
call putbak (c)
else
lexstr (1) = NEWLINE
lexstr (2) = EOS
gtok = lexstr (1)
return
}
i = 1
if (IS_LETTER(c)) { # alpha
gtok = ALPHA
if (c == LETX) { # "x$cccc" directive?
c = ngetch (lexstr(2))
if (c == DOLLAR) {
gtok = XPP_DIRECTIVE
i = 2
}
else
call putbak (c)
}
for (; i < toksiz - 2; i=i+1) {
c = ngetch (lexstr(i+1))
if (!IS_LETTER(c) & !IS_DIGIT(c) & c != UNDERLINE)
break
}
call putbak (c)
} else if (IS_DIGIT(c)) { # digits
for (i=1; i < toksiz - 2; i=i+1) {
c = ngetch (lexstr (i + 1))
if (!IS_DIGIT(c))
break
}
call putbak (c)
gtok = DIGIT
}
# The following is not needed since XPP does base conversion, and this caused
# fixed point overflow on a Data General machine.
#
# b = c - DIG0 # in case alternate base number
# for (i = 1; i < toksiz - 2; i = i + 1) {
# c = ngetch (lexstr (i + 1))
# if (!IS_DIGIT(c))
# break
# b = 10 * b + (c - DIG0)
# }
# if (c == RADIX & b >= 2 & b <= 36) { #n%ddd...
# n = 0
# repeat {
# d = index (digits, clower (ngetch (c))) - 1
# if (d < 0)
# break
# n = b * n + d
# }
# call putbak (c)
# i = itoc (n, lexstr, toksiz)
# }
# else
# call putbak (c)
# gtok = DIGIT
# }
else if (c == LBRACK) { # allow [ for {
lexstr (1) = LBRACE
gtok = LBRACE
}
else if (c == RBRACK) { # allow ] for }
lexstr (1) = RBRACE
gtok = RBRACE
}
else if (c == DOLLAR) { # $( and $) now used by macro processor
if (ngetch (lexstr (2)) == LPAREN) {
i = 2
gtok = LSTRIPC
}
else if (lexstr (2) == RPAREN) {
i = 2
gtok = RSTRIPC
}
else {
call putbak (lexstr (2))
gtok = DOLLAR
}
}
else if (c == SQUOTE | c == DQUOTE) {
gtok = c
for (i = 2; ngetch (lexstr (i)) != lexstr (1); i = i + 1) {
if (lexstr (i) == UNDERLINE)
if (ngetch (c) == NEWLINE) {
while (c == NEWLINE | c == BLANK | c == TAB)
c = ngetch (c)
lexstr (i) = c
}
else
call putbak (c)
if (lexstr (i) == NEWLINE | i >= toksiz - 1) {
call synerr ("missing quote.")
lexstr (i) = lexstr (1)
call putbak (NEWLINE)
break
}
}
}
else if (c == SHARP) { # strip comments
while (ngetch (lexstr (1)) != NEWLINE)
;
gtok = NEWLINE
}
else if (c == GREATER | c == LESS | c == NOT | c == BANG |
c == TILDE | c == CARET | c == EQUALS | c == AND | c == OR) {
call relate (lexstr, i)
gtok = c
}
else
gtok = c
if (i >= toksiz - 1)
call synerr ("token too long.")
lexstr (i + 1) = EOS
# Note: line number accounting is now done in 'ngetch'
return
end
|
