blob: 86088dddb947e144cd25792223cf06da38d415de (
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
|
#-h- swend 2714 local 12/01/80 15:55:07
# swend - finish off switch statement; generate dispatch code
include defs
subroutine swend (lab)
integer lab
include COMMON_BLOCKS
integer lb, ub, n, i, j, swn
string sif "if ("
string slt ".lt.1.or."
string sgt ".gt."
string sgoto "goto ("
string seq ".eq."
string sge ".ge."
string sle ".le."
string sand ".and."
swn = swvstk(swvlev) #get switch variable number, SWnnnn
swvlev = max(0, swvlev - 1)
lb = swstak (swtop + 3)
ub = swstak (swlast - 2)
n = swstak (swtop + 1)
call outgo (lab + 1) # terminate last case
if (swstak (swtop + 2) == 0)
swstak (swtop + 2) = lab + 1 # default default label
xfer = NO
call indent (-1)
call outcon (lab) # L continue
call indent (1)
if (n >= CUTOFF & ub - lb + 1 < DENSITY * n) { # output branch table
if (lb != 1) { # L Innn=Innn-lb+1
call outtab
call swvar (swn)
call outch (EQUALS)
call swvar (swn)
if (lb < 1)
call outch (PLUS)
call outnum (-lb + 1)
call outdon
}
if (swinrg == NO) {
call outtab # if (Innn.lt.1.or.Innn.gt.ub-lb+1)goto default
call outstr (sif)
call swvar (swn)
call outstr (slt)
call swvar (swn)
call outstr (sgt)
call outnum (ub - lb + 1)
call outch (RPAREN)
call outch (BLANK)
call outgo (swstak (swtop + 2))
}
call outtab # goto (....),Innn
call outstr (sgoto)
j = lb
for (i = swtop + 3; i < swlast; i = i + 3) {
for ( ; j < swstak (i); j = j + 1) { # fill in vacancies
call outnum (swstak (swtop + 2))
call outch (COMMA)
}
for (j = swstak (i + 1) - swstak (i); j >= 0; j = j - 1)
call outnum (swstak (i + 2)) # fill in range
j = swstak (i + 1) + 1
if (i < swlast - 3)
call outch (COMMA)
}
call outch (RPAREN)
call outch (COMMA)
call swvar (swn)
call outdon
}
else if (n > 0) { # output linear search form
for (i = swtop + 3; i < swlast; i = i + 3) {
call outtab # if (Innn
call outstr (sif)
call swvar (swn)
if (swstak (i) == swstak (i+1)) {
call outstr (seq) # .eq....
call outnum (swstak (i))
}
else {
call outstr (sge) # .ge.lb.and.Innn.le.ub
call outnum (swstak (i))
call outstr (sand)
call swvar (swn)
call outstr (sle)
call outnum (swstak (i + 1))
}
call outch (RPAREN) # ) goto ...
call outch (BLANK)
call outgo (swstak (i + 2))
}
if (lab + 1 != swstak (swtop + 2))
call outgo (swstak (swtop + 2))
}
call indent (-1)
call outcon (lab + 1) # L+1 continue
swlast = swtop # pop switch stack
swtop = swstak (swtop)
swinrg = NO
return
end
|