-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathpass_2_m.f90
203 lines (192 loc) · 7.09 KB
/
pass_2_m.f90
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
module pass_2_m
! Resolve unresolved EQU's or ORG's
use ERROR_M, only: DO_ERROR, ErrCode
use FLAGS, only: TRACES
use IO_UNITS, only: U_SCRATCH, FMT_S
use LITERALS_M, only: LITERALS, PROCESS_LTORG
use OPERAND_M, only: K_ACTUAL, K_ASTERISK, K_DEVICE, K_SYMBOLIC, &
& OPERANDS, X00
use SYMTAB_M, only: REF, SYMBOLS
implicit NONE
private
public :: Pass_2
contains
subroutine Pass_2 ( Rel )
logical, intent(in) :: Rel ! Saw relocatable location counters in pass 1
logical :: Change ! A symbol got changed -- another pass
! could be fruitful
integer :: IxLab ! Index in Symbols of a label
integer :: LC ! Current location counter
character(80) :: LINE ! Input line
integer :: New_Value ! Usually operand(*)%addr or symbols()%value
integer :: Num_Operands ! in the scratch record
integer :: P ! Program counter
integer :: P_DA ! P as of beginning of processing of DA
integer :: P_IN ! P from the input
integer :: P_OFFSET ! Either 0 or width-1
logical :: UNDEF ! An EQU or ORG is undefined
character(5) :: WHY ! Code for scratch record
integer :: WIDTH ! of the code generated from a scratch record
lc = 0
do
if ( scan(traces,'P2') /= 0 ) print *, 'Rewind the scratch file'
rewind ( u_scratch )
p = 333
change = .false.
undef = .false.
do
read ( u_scratch, fmt_s, end=300 ) why, line, ixLab, p_in, lc, width, &
& errCode, num_operands, operands(1:num_operands)
if ( line(6:6) == '*' ) cycle
if ( why == 'LITS' ) then
! Process the lits in all location counters
call process_ltorg ( p, -1, .false., 'Pass 2.1', up_to=width )
cycle
end if
if ( why == 'MACRO' ) cycle
if ( p_in >= 0 ) p = p_in
if ( line(16:18) == 'LTO' .or. line(16:18) == 'ORG' ) then
if ( ixlab > 0 ) then
if ( symbols(ixlab)%value <= ref ) then
if ( p >= 0 ) then
symbols(ixlab)%value = p
change = .true.
else
undef = .true.
end if
end if
end if
select case ( operands(1)%kind )
case ( k_actual )
p = operands(1)%addr
case ( k_asterisk )
if ( p_in >= 0 ) p = p_in
if ( p < 0 ) undef = .true.
case ( k_symbolic )
p = symbols(operands(1)%addr)%value
if ( p < 0 ) undef = .true.
end select
if ( operands(1)%offset == x00 ) then
p = p + 99
p = p - mod(p,100)
else
p = p + operands(1)%offset
end if
if ( line(16:18) == 'LTO' ) &
& call process_ltorg ( p, lc, .false., 'Pass 2.1', up_to=width )
else if ( line(16:18) == 'END' .or. line(16:18) == 'EX' ) then
if ( p_in >= 0 ) p = p_in
else if ( line(16:18) == 'EQU' ) then
! symbols(ixLab)%index doesn't need to be set again
if ( ixlab > 0 ) then
if ( symbols(ixLab)%value <= ref ) then
if ( operands(1)%kind == k_asterisk ) then
if ( p >= 0 ) then
change = .true.
symbols(ixLab)%value = p - 1 + operands(1)%offset
else
undef = .true.
end if
else if ( operands(1)%kind == k_symbolic ) then
new_value = symbols(operands(1)%addr)%value
if ( new_value > ref ) then
change = .true.
symbols(ixLab)%value = new_value + operands(1)%offset
symbols(ixLab)%lc = symbols(operands(1)%addr)%lc
else
undef = .true.
end if
end if
else if ( operands(1)%kind == k_device ) then
symbols(ixLab)%dev = operands(1)%label
end if
end if
else
if ( p_in >= 0 ) p = p_in
select case ( why )
case ( ' ', 'GEN ' )
p_da = p ! In case next is FIELD or SBFLD
if ( ixlab > 0 ) then
p_offset = 0
if ( line(16:18) == 'DC ' .or. line(16:18) == 'DCW' .or. &
& line(16:18) == 'DSA' ) p_offset = width - 1
if ( symbols(ixlab)%value <= ref ) then
if ( p >= 0 ) then
change = .true.
symbols(ixlab)%value = p + p_offset
else
undef = .true.
end if
end if
end if
if ( ixlab >= 0 ) p = p + width
case ( 'FIELD', 'SBFLD' )
if ( ixlab > 0 ) then
if ( symbols(ixLab)%value <= ref ) then
if ( p >= 0 ) then
if ( why == 'SUB' ) then
new_value = operands(1)%addr
else
new_value = operands(2)%addr
end if
change = .true.
symbols(ixLab)%value = p_da + new_value - 1
else
undef = .true.
end if
end if
end if
case ( 'AREA', 'LIT', 'ADCON' )
if ( ixlab > 0 ) then ! an area-defining lit -- in the symbol table
if ( symbols(ixlab)%value <= ref ) then
if ( p >= 0 ) then
change = .true.
symbols(ixlab)%value = p + width - 1
else
undef = .true.
end if
end if
else if ( ixlab < 0 ) then ! in the literal table
if ( literals(-ixlab)%addr < 0 ) then
if ( p >= 0 ) then
change = .true.
literals(-ixlab)%addr = p + width - 1
else
undef = .true.
end if
end if
end if
if ( literals(operands(1)%addr)%addr <= ref ) then
if ( p >= 0 ) then
change = .true.
literals(operands(1)%addr)%addr = p + width - 1
else
undef = .true.
end if
end if
if ( num_operands == 2 ) then
if ( symbols(operands(1)%addr)%value <= ref ) then
if ( p >= 0 ) then
change = .true.
symbols(operands(1)%addr)%value = p + width - 1
else
undef = .true.
end if
end if
end if
if ( p_in <= 0 ) p = p + width
end select
end if
if ( index(traces,'2') /= 0 ) &
& print '(i6,1x,a5,1x,a)', p, why, trim(line)
end do
300 continue
if ( .not. undef ) exit
if ( .not. change ) then
if ( .not. rel ) call do_error ( 'Undefined or unresolvable symbols' )
exit
end if
end do
end subroutine Pass_2
end module pass_2_m
!>> 2011-09-03 Don't need to rewind at the end of the loop