-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathop_codes_m.f90
238 lines (211 loc) · 10.6 KB
/
op_codes_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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
module OP_CODES_M
! Table describing op codes and pseudo-op codes. We could put in the
! letters and numbers from BCD_TO_ASCII, but we assume they are
! mapped to the same upper-case ASCII letters and to the same numbers.
use BCD_TO_ASCII_M, M => BCD_TO_ASCII
implicit NONE
private
public :: INIT_OP_CODES
type, public :: OP_CODE_T
character(5) :: OP ! Columns 16-20 of input
character :: MachineOp ! Blank for pseudo op
! 'p' for "use as previous" if current blank
character(2) :: A ! For A, B, D: REQ => Required
character :: B ! OPT => Optional PRO => Prohibited
! For A, if the second character is not blank,
! it's used for the third character of the A
! address (unit), the first operand is
! required but used for the B operand, and the
! second operand is prohibited.
character :: D ! D-modifier if not OPT, PRO or REQ
end type OP_CODE_T
character, public :: OPT
character, public :: PRO
character, public :: REQ
type(op_code_t), public :: OP_CODES(0:128)
character(5), parameter, public :: Sentnl = "#####" ! end of the table
contains
subroutine Init_Op_Codes ( Do_1440 )
logical, intent(in) :: Do_1440 ! Initialize 1440 op codes
OPT = m(64)
PRO = m(65)
REQ = m(66)
! For the case when CC 16-18 are blank, OP in 19, D in 20
op_codes(0) = &
! OP MachineOp A B D
& op_code_t(" ", " ", OPT, OPT, OPT)
! Declarative codes:
op_codes(1:6) = (/ &
! OP MachineOp A B D
& op_code_t("DA ", " ", REQ, PRO, PRO), &
& op_code_t("DC ", "p", REQ, PRO, PRO), &
& op_code_t("DCW ", "p", REQ, PRO, PRO), &
& op_code_t("DS ", "p", REQ, PRO, PRO), &
& op_code_t("DSA ", "p", REQ, PRO, PRO), &
& op_code_t("EQU ", "p", REQ, PRO, PRO) /)
! Imperative codes -- Arithmetic
op_codes(7:12) = (/ &
! OP MachineOp A B D
& op_code_t("A ", "A", OPT, OPT, PRO), &
& op_code_t("D ", m(b_percnt), OPT, OPT, PRO), &
& op_code_t("M ", m(b_at), OPT, OPT, PRO), &
& op_code_t("S ", "S", OPT, OPT, PRO), &
& op_code_t("ZA ", m(b_qmark), OPT, OPT, PRO), &
& op_code_t("ZS ", m(b_bang), OPT, OPT, PRO) /)
! Imperative codes -- Data Control
op_codes(13:27) = (/ &
! OP MachineOp A B D
& op_code_t("MBC ", "M", OPT, OPT, "B"), &
& op_code_t("MBD ", "M", OPT, OPT, "D"), &
& op_code_t("MCE ", "E", OPT, OPT, PRO), &
& op_code_t("MCS ", "Z", OPT, OPT, PRO), &
& op_code_t("MIZ ", "X", OPT, OPT, PRO), &
& op_code_t("MLC ", "M", OPT, OPT, OPT), &
& op_code_t("MCW ", "M", OPT, OPT, OPT), &
& op_code_t("MLCWA", "L", OPT, OPT, OPT), &
& op_code_t("LCA ", "L", OPT, OPT, OPT), &
& op_code_t("MLNS ", "D", OPT, OPT, PRO), &
& op_code_t("MN ", "D", OPT, OPT, PRO), &
& op_code_t("MLZS ", "Y", OPT, OPT, PRO), &
& op_code_t("MZ ", "Y", OPT, OPT, PRO), &
& op_code_t("MRCM ", "P", OPT, OPT, OPT), &
& op_code_t("MCM ", "P", OPT, OPT, OPT) /)
! Imperative codes -- Logic
op_codes(28:48) = (/ &
! OP MachineOp A B D
& op_code_t("B ", "B", OPT, OPT, OPT), &
& op_code_t("BAV ", "B", REQ, PRO, "Z"), &
& op_code_t("BBE ", "W", REQ, REQ, REQ), &
& op_code_t("BC9 ", "B", REQ, PRO, "9"), &
& op_code_t("BCV ", "B", REQ, PRO, m(b_at)), &
& op_code_t("BE ", "B", REQ, PRO, "S"), &
& op_code_t("BEF ", "B", REQ, PRO, "K"), &
& op_code_t("BER ", "B", REQ, PRO, "L"), &
& op_code_t("BH ", "B", REQ, PRO, "U"), &
& op_code_t("BIN ", "B", REQ, PRO, REQ), &
& op_code_t("BL ", "B", REQ, PRO, "T"), &
& op_code_t("BLC ", "B", REQ, PRO, "A"), &
& op_code_t("BM ", "V", REQ, REQ, "K"), &
& op_code_t("BPCB ", "B", REQ, PRO, "R"), &
& op_code_t("BPB ", "B", REQ, PRO, "P"), &
& op_code_t("BU ", "B", REQ, PRO, m(b_slash)), &
& op_code_t("BW ", "V", OPT, REQ, "1"), &
& op_code_t("BWZ ", "V", OPT, REQ, REQ), &
& op_code_t("BCE ", "B", OPT, REQ, REQ), &
& op_code_t("BSS ", "B", REQ, PRO, REQ), &
& op_code_t("C ", "C", OPT, OPT, PRO) /)
! Imperative codes -- Input/Output Commands
! A is the device code here
op_codes(49:89) = (/ &
! OP MachineOp A B D
& op_code_t("BSP ", "U", "U", PRO, "B"), &
& op_code_t("CU ", "U", "U", PRO, REQ), &
& op_code_t("DCR ", "U", "F", PRO, "D"), &
& op_code_t("ECR ", "U", "F", PRO, "E"), &
& op_code_t("LU ", "L", REQ, REQ, REQ), &
& op_code_t("MU ", "M", REQ, REQ, REQ), &
& op_code_t("P ", "4", OPT, PRO, PRO), &
& op_code_t("PCB ", "4", OPT, PRO, "C"), &
& op_code_t("R ", "1", OPT, PRO, PRO), &
& op_code_t("RCB ", "1", OPT, PRO, "C"), &
& op_code_t("RD ", "M", "D", REQ, "R"), &
& op_code_t("RDT ", "M", "D", REQ, "R"), &
& op_code_t("RDTW ", "L", "D", REQ, "R"), &
& op_code_t("RDW ", "L", "D", REQ, "R"), &
& op_code_t("RF ", "4", REQ, PRO, "R"), &
& op_code_t("RP ", "5", OPT, PRO, PRO), &
& op_code_t("RT ", "M", "U", REQ, "R"), &
& op_code_t("RTB ", "M", "B", REQ, "R"), &
& op_code_t("RTW ", "L", "U", REQ, "R"), &
& op_code_t("RWD ", "U", "U", PRO, "R"), &
& op_code_t("RWU ", "U", "U", PRO, "U"), &
& op_code_t("SD ", "M", "D", REQ, "R"), &
& op_code_t("SKP ", "U", "U", PRO, "E"), &
& op_code_t("SPF ", "9", OPT, PRO, PRO), &
& op_code_t("SRF ", "8", OPT, PRO, PRO), &
& op_code_t("W ", "2", OPT, PRO, PRO), &
& op_code_t("WD ", "M", "D", REQ, "W"), &
& op_code_t("WDC ", "M", "D", REQ, "W"), &
& op_code_t("WDCW ", "L", "D", REQ, "W"), &
& op_code_t("WDT ", "M", "D", REQ, "W"), &
& op_code_t("WDTW ", "L", "D", REQ, "W"), &
& op_code_t("WDW ", "L", "D", REQ, "W"), &
& op_code_t("WM ", "2", OPT, PRO, m(b_square)), &
& op_code_t("WP ", "6", OPT, PRO, PRO), &
& op_code_t("WR ", "3", OPT, PRO, PRO), &
& op_code_t("WRF ", "6", OPT, PRO, "R"), &
& op_code_t("WRP ", "7", OPT, PRO, PRO), &
& op_code_t("WT ", "M", "U", REQ, "W"), &
& op_code_t("WTB ", "M", "B", REQ, "W"), &
& op_code_t("WTM ", "U", "U", PRO, "M"), &
& op_code_t("WTW ", "L", "U", REQ, "W") /)
! Imperative codes -- Miscellaneous
op_codes(90:101) = (/ &
! OP MachineOp A B D
& op_code_t("CC ", "F", PRO, PRO, OPT), &
& op_code_t("CCB ", "F", REQ, PRO, OPT), &
& op_code_t("CS ", m(b_slash), OPT, OPT, PRO), &
& op_code_t("CW ", m(b_square), OPT, OPT, PRO), &
& op_code_t("H ", m(b_decimal), OPT, OPT, PRO), &
& op_code_t("MA ", m(b_hash), OPT, OPT, PRO), &
& op_code_t("NOP ", "N", OPT, OPT, OPT), &
& op_code_t("SAR ", "Q", OPT, PRO, PRO), &
& op_code_t("SBR ", "H", OPT, OPT, PRO), &
& op_code_t("SS ", "K", PRO, PRO, OPT), &
& op_code_t("SSB ", "K", REQ, PRO, OPT), &
& op_code_t("SW ", m(b_comma), OPT, OPT, PRO) /)
! Control codes
op_codes(102:119) = (/ &
! OP MachineOp A B D
& op_code_t(" ", " ", REQ, PRO, PRO), &
& op_code_t("ALTER", " ", REQ, PRO, PRO), &
& op_code_t("CALL ", " ", REQ, OPT, OPT), &
& op_code_t("CHAIN", " ", REQ, PRO, PRO), &
& op_code_t("CTL ", " ", REQ, PRO, PRO), &
& op_code_t("DELET", " ", REQ, PRO, PRO), &
& op_code_t("END ", " ", REQ, PRO, PRO), &
& op_code_t("ENT ", " ", REQ, PRO, PRO), &
& op_code_t("EX ", " ", REQ, PRO, PRO), &
& op_code_t("INCLD", " ", REQ, PRO, PRO), &
& op_code_t("INSER", " ", REQ, PRO, PRO), &
& op_code_t("JOB ", " ", REQ, PRO, PRO), &
& op_code_t("LC ", " ", REQ, PRO, PRO), &
& op_code_t("LTORG", " ", REQ, PRO, PRO), &
& op_code_t("ORG ", " ", REQ, PRO, PRO), &
& op_code_t("SFX ", " ", REQ, PRO, PRO), &
& op_code_t("XFR ", " ", REQ, PRO, PRO), &
& op_code_t(sentnl, " ", PRO, PRO, PRO) /) ! A sentinel
op_codes(120:)%op = sentnl
if ( do_1440 ) call insert_1440 ( (/ &
& op_code_t("R ", "M", "G", REQ, "R"), &
& op_code_t("PS ", "M", "G", REQ, "P"), &
& op_code_t("P ", "M", "G", REQ, "G"), &
& op_code_t("PSK ", "M", "G", REQ, "C"), &
& op_code_t("W ", "M", "Y1", REQ, "W"), &
& op_code_t("WS ", "M", "Y1", REQ, "S"), &
& op_code_t("WCP ", "M", "T0", REQ, "W"), &
& op_code_t("RCP ", "M", "T0", REQ, "R") /) )
contains
subroutine Insert_1440 ( codes )
! Scan the op_codes array for any codes that have the same op
! component value as an element of codes. If one is found,
! replace it. Otherwise, put the one from codes at the end and
! move the sentinel down one.
type(op_code_t), intent(in) :: Codes(:)
integer :: I, J
do i = 1, size(codes)
do j = 1, size(op_codes)
if ( codes(i)%op == op_codes(j)%op ) then
op_codes(j) = codes(i)
exit
end if
if ( op_codes(j)%op == sentnl ) then
op_codes(j+1) = op_codes(j)
op_codes(j) = codes(i)
exit
end if
end do
end do
end subroutine Insert_1440
end subroutine Init_Op_Codes
end module OP_CODES_M