1 " ***********************************************************
2 " * *
3 " * Copyright, C Honeywell Bull Inc., 1988 *
4 " * *
5 " * Copyright, C Honeywell Information Systems Inc., 1982 *
6 " * *
7 " * Copyright c 1972 by Massachusetts Institute of *
8 " * Technology and Honeywell Information Systems, Inc. *
9 " * *
10 " ***********************************************************
11 name utils_
12 " utils, utility machine language programs for alm.
13
14 "NOTE: segdefs are used rather than entrys where possible to speed up execution.
15 "the routines defined by segdefs must not use the linkage section, as lp may not be
16 "properly set
17
18 " Last modified on 11/12/72 at 02:01:23 by R F Mabee. Fixed short return for followon.
19 " on 07/25/72 at 08:44:38 by R F Mabee. Added utils_$compare_acc to compare ACC strings.
20 " on 03/04/72 at 20:49:26 by R F Mabee. Made opcode field 10 bits in makins.
21 " by RHG on 22 Sept 1970 to fix bug in upkflg
22 " by RHG on 17 Sept 1970 to delete
23 " unnecessary entries and change "entry" to "segdef" where possible
24
25
26 " basic shift and logical operations.
27
28
29
30 segdef and
31 and: null
32 ldq ap|2,*
33 anq ap|4,*
34 tra store_6-*,ic
35
36
37 segdef ls left shift operator.
38 ls: null
39 ldq ap|2,* get word,
40 lda ap|4,* and shift,
41 qls 0,al then shift,
42 tra store_6-*,ic
43
44
45
46
47 segdef rs right shift operator.
48 rs: null
49 ldq ap|2,* get word,
50 lda ap|4,* and shift,
51 qrl 0,al then shift,
52 tra store_6-*,ic
53
54
55
56
57 segdef or or operator
58 or: null
59 ldq ap|2,* get a operand
60 orq ap|4,* or in b operand
61 store_6: stq ap|6,*
62 utils_short_return:
63 short_return
64
65
66
67
68 " make external address subroutine.
69
70 segdef exadrs define entry.
71 exadrs: null
72 lda ap|4,* get displacement,
73 lrl 15 and position.
74 lda ap|2,* get base register,
75 lrl 3+18 and position,
76 tra store_6-*,ic
77
78
79
80
81 " get symbol character count from symbol first word.
82
83
84 entry nswrds define entry.
85 nswrds: null
86 ldq ap|2,* get first word of ASCII string or relative ptr into free_ segment
87 cmpq =1,du string has value in left part of Q-reg
88 trc have_string-*,ic
89 have_ptr: ldq <eb_data_>|lavptr,*ql load first word of ASCII string
90 have_string:
91 null
92 qrl 3*9+2 position character count,
93 adq =1,dl and form word count
94 stq ap|4,*
95 tra utils_short_return-*,ic then return to caller.
96
97
98
99
100 " make instruction from its five fields.
101
102
103 segdef makins define entry.
104 makins: null
105 lda ap|6,*
106 ana =o777400,dl isolate 10-bit opcode field.
107 ora ap|10,* insert modifier,
108 lrl 6 ..
109 ora ap|8,* insert b29,
110 lrl 18-6 ..
111 lda ap|4,* insert displacement,
112 lrl 15 ..
113 canq =o1000,dl test b29.
114 tze bypass-*,ic skip if zero,
115 lda ap|2,* insert base,
116 bypass: lrl 3 else, take high bits of displacement.
117 stq ap|12,* store answer.
118 tra utils_short_return-*,ic then return to caller.
119
120
121
122
123 " pack and unpack routines for table flags.
124
125 entry pckflg word define entry.
126 pckflg: null
127 eax7 -36 set x7
128 eppbp <eb_data_>|flgvec
129 pklp: lda bp|36,7 insert flag vector word
130 lrl 1 shift into assembled word
131 stz bp|36,7 clear the flag
132 adx7 =1,du decrement index into flag vector
133 tnz pklp-*,ic loop if more to do.
134 stq ap|2,* all done, save flags,
135 tra utils_short_return-*,ic and return to caller.
136
137
138
139
140 entry upkflg word define entry.
141 upkflg: null
142 eax7 36 initialize loop control
143 eppbp <eb_data_>|flgvec
144 ldq ap|2,* get packed word
145 loopbk: lda =0,dl clear the A-reg
146 lls 1 shift in bit of packed word
147 orsa bp|-1,7 store bit into word vector
148 sbx7 =1,du bump loop control
149 tnz loopbk-*,ic go back if more to do
150 tra utils_short_return-*,ic else, return to caller
151
152
153
154
155 " put character routine, ascii.
156
157
158 segdef putach wordcharnochar define entry.
159 putach: null
160 lda ap|6,* get the character
161 lxl0 ap|4,* get the character position
162 xec als-1,0 position the character
163 eppbp ap|2,* get a pointer to the word
164 xec stba-1,0 store the character
165 tra utils_short_return-*,ic
166
167 als: als 27
168 als 18
169 als 9
170 nop 0,du
171
172 stba: stba bp|0,40
173 stba bp|0,20
174 stba bp|0,10
175 stba bp|0,04
176
177
178
179
180 " exit and close-out routines, terminate run.
181
182
183 entry abort utils$abort entry point.
184 abort: tra <prnter_>|abort1 have prnter_ give abort message and abort.
185
186
187 " compare_acc compares two ACC format strings in alphabetic collating
188 " sequence. It returns as a result: zero if the two strings are
189 " identical, a negative number if the first is less, or a positive
190 " number if the second is less.
191 " Its arguments are offsets into the scratch segment.
192
193 entry compare_acc
194 temp temp
195 compare_acc:
196 save " result = compare_acc name_rel_1 name_rel_2;
197 lda ap|2,*
198 ldq ap|4,*
199 eppbp <eb_data_>|lavptr,*
200 eppap bp|0,al " ap points to base of first ACC string.
201 eppbp bp|0,ql " and bp points to base of second.
202
203 lda bp|0
204 ana =o000137137137 " Compare first word without case bits.
205 sta temp
206 lda ap|0
207 ana =o000137137137
208 sba temp
209 tnz comp_done
210
211 " First three letters the same, start full check.
212
213 lda bp|0
214 arl 29 " Length in words minus one.
215 sta temp
216 lda ap|0
217 arl 29
218 cmpa temp
219 tmi 2,ic
220 lda temp " The length of the shorter one.
221 ada 1,dl " Get full word count.
222
223 eppap ap|0,al " Add length to pointers, put negative length in xr0.
224 eppbp bp|0,al " This is so one register can double as index and counter.
225 neg 0,dl " bp|0,0 is now the base of the ACC string.
226 eax0 0,al
227
228 " Now look at rest of words, ignoring case bits.
229
230 eax1 0,0
231 comp_l1: adx1 1,du
232 tpl comp_d1
233
234 lda bp|0,1
235 ana =o137137137137
236 sta temp
237 lda ap|0,1
238 ana =o137137137137
239 sba temp
240 tnz comp_done
241 tra comp_l1
242 comp_d1:
243
244 " Now there is no difference except possibly case bits, so check them.
245 " First word first.
246
247 lda bp|0,0
248 ana =o000777777777
249 sta temp
250 lda ap|0,0
251 ana =o000777777777
252 sba temp
253 tnz comp_done
254
255 " Run over rest of words again.
256
257 eax1 0,0
258 comp_l2: adx1 1,du
259 tpl comp_d2
260
261 lda ap|0,1
262 sba bp|0,1
263 tnz comp_done
264 tra comp_l2
265 comp_d2:
266
267 " Now the only possible difference is in the lengths.
268
269 lda ap|0,0
270 sba bp|0,0
271 comp_done:
272 eppap sp|26,*
273 sta ap|6,*
274 return
275
276 end