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
|
subroutine cascod (lab, token)
integer lab, token
common /cdefio/ bp, buf (4096)
integer bp
integer buf
common /cfname/ fcname (30)
integer fcname
common /cfor/ fordep, forstk (200)
integer fordep
integer forstk
common /cgoto/ xfer
integer xfer
common /clabel/ label, retlab, memflg, col, logic0
integer label
integer retlab
integer memflg
integer col
integer logic0
common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
*p, fnames ( 150)
integer dbgout
integer dbglev
integer level
integer linect
integer infile
integer fnamp
integer fnames
common /cmacro/ cp, ep, evalst (500), deftbl
integer cp
integer ep
integer evalst
integer deftbl
common /coutln/ outp, outbuf (74)
integer outp
integer outbuf
common /csbuf/ sbp, sbuf(2048), smem(240)
integer sbp
integer sbuf
integer smem
common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
*k(10), swinrg
integer swtop
integer swlast
integer swstak
integer swvnum
integer swvlev
integer swvstk
integer swinrg
common /ckword/ rkwtbl
integer rkwtbl
common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
integer fkwtbl
integer namtbl
integer gentbl
integer errtbl
integer xpptbl
common /erchek/ ername, body, esp, errstk(30)
integer ername
integer body
integer esp
integer errstk
integer mem( 60000)
common/cdsmem/mem
integer t, l, lb, ub, i, j, junk
integer caslab, labgen, gnbtok
integer tok (100)
if (.not.(swtop .le. 0))goto 23000
call synerr (24Hillegal case or default.)
return
23000 continue
call indent (-1)
call outgo (lab + 1)
xfer = 1
l = labgen (1)
if (.not.(token .eq. -91))goto 23002
23004 if (.not.(caslab (lb, t) .ne. -1))goto 23005
ub = lb
if (.not.(t .eq. 45))goto 23006
junk = caslab (ub, t)
23006 continue
if (.not.(lb .gt. ub))goto 23008
call synerr (28Hillegal range in case label.)
ub = lb
23008 continue
if (.not.(swlast + 3 .gt. 1000))goto 23010
call baderr (22Hswitch table overflow.)
23010 continue
i = swtop + 3
23012 if (.not.(i .lt. swlast))goto 23014
if (.not.(lb .le. swstak (i)))goto 23015
goto 23014
23015 continue
if (.not.(lb .le. swstak (i+1)))goto 23017
call synerr (21Hduplicate case label.)
23017 continue
23016 continue
23013 i = i + 3
goto 23012
23014 continue
if (.not.(i .lt. swlast .and. ub .ge. swstak (i)))goto 23019
call synerr (21Hduplicate case label.)
23019 continue
j = swlast
23021 if (.not.(j .gt. i))goto 23023
swstak (j+2) = swstak (j-1)
23022 j = j - 1
goto 23021
23023 continue
swstak (i) = lb
swstak (i + 1) = ub
swstak (i + 2) = l
swstak (swtop + 1) = swstak (swtop + 1) + 1
swlast = swlast + 3
if (.not.(t .eq. 58))goto 23024
goto 23005
23024 continue
if (.not.(t .ne. 44))goto 23026
call synerr (20Hillegal case syntax.)
23026 continue
23025 continue
goto 23004
23005 continue
goto 23003
23002 continue
t = gnbtok (tok, 100)
if (.not.(swstak (swtop + 2) .ne. 0))goto 23028
call error (38Hmultiple defaults in switch statement.)
goto 23029
23028 continue
swstak (swtop + 2) = l
23029 continue
23003 continue
if (.not.(t .eq. -1))goto 23030
call synerr (15Hunexpected EOF.)
goto 23031
23030 continue
if (.not.(t .ne. 58))goto 23032
call error (39Hmissing colon in case or default label.)
23032 continue
23031 continue
xfer = 0
call outcon (l)
call indent (1)
return
end
c logic0 logical_column
|
