Trailing-Edge
-
PDP-10 Archives
-
BB-H348C-RM_1982
-
swskit-v21/listings/tkb-vnp/pchn.bpt
There are no other files named pchn.bpt in the archive.
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
1 !<SAUTER.TKB20>PCHN.BLI.13, 16-Dec-78 10:52:10, Edit by SROBINSON
2 !<SAUTER.TKB20>PCHN.BLI.12, 17-Nov-78 17:20:55, Edit by SROBINSON
3 !<SAUTER.TKB20>PCHN.BLI.9, 17-Nov-78 16:10:41, Edit by SROBINSON
4 MODULE PCHN ( ! PROCESS CHAINED BLOCKS
5 IDENT = 'X0.1-3A'
6 ) =
7 BEGIN
8 !
9 !
10 !
11 ! COPYRIGHT (C) 1978 BY
12 ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
13 !
14 !
15 ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
16 ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
17 ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
18 ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
19 ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
20 ! TRANSFERRED.
21 !
22 !
23 ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
24 ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
25 ! CORPORATION.
26 !
27 ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
28 ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
29 !
30
31 !++
32 ! FACILITY: TKB-20 AND VNP-20
33 !
34 ! ABSTRACT:
35 !
36 !
37 ! THIS MODULE DOES PROCESSING OF BLOCKS THAT HAVE BEEN
38 ! CHAINED TOGETHER USING CHAIN BLOCKS.
39 !
40 !
41 ! ENVIRONMENT: TOPS-20 USER MODE
42 !
43 ! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
44 !
45 ! MODIFIED BY:
46 !
47 ! Scott G. Robinson, 17-NOV-78 : VERSION X0.1-2A
48 ! - Fix BLD_CHAIN (et al) to remove ROOT_BLOCK so
49 ! macro expansion will not occur with library file
50 !
51 ! Scott G. Robinson, 16-DEC-78 : VERSION X0.1-3A
52 ! - Add new routine DEL_PTRS which frees storage held by
53 ! pointer blocks
54 !
55 ! , : VERSION
56 ! 01 -
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
57 !--
58
59 !<BLF/PAGE>
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
60 !
61 ! TABLE OF CONTENTS:
62 !
63
64 FORWARD ROUTINE
65 ADD_POINTER : NOVALUE, !PUT NEXT POINTER IN NON-FULL CHAIN BLOCK
66 INIT_CHAIN : NOVALUE, !CREATE A NEW CHAIN BLOCK
67 BLD_CHAIN, !ADD POINTER TO CHAIN (GLOBAL)
68 FND_CHAIN, !FIND A CHAINED BLOCK
69 DEL_PTRS : NOVALUE; !DELETE CHAIN BLOCKS
70
71 !
72 ! INCLUDE FILES:
73 !
74
75 LIBRARY 'VNP-LIB.L36';
76
77 !REQUIRE 'BLOCKH.REQ'; !PREPARE TO DEFINE STORAGE BLOCKS
78 !REQUIRE 'CHAIN.REQ'; !DEFINE CHAIN BLOCK
79 !REQUIRE 'ANYBLK.REQ'; !DEFINE GENERIC BLOCK
80 !REQUIRE 'BLOCKT.REQ'; !END OF DEFINING BLOCKS
81 !
82 ! MACROS:
83 !
84 ! NONE
85 !
86 ! EQUATED SYMBOLS:
87 !
88 ! NONE
89 !
90 ! OWN STORAGE:
91 !
92 ! NONE
93 !
94 ! EXTERNAL REFERENCES:
95 !
96
97 EXTERNAL ROUTINE
98 ERRMSG, !PRINT AN ERROR MESSAGE
99 GETBLK, !GET A BLOCK FROM FREE STORAGE
100 FREBLK; !RETURN A BLOCK TO FREE STORAGE
101
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
102 ROUTINE ADD_POINTER (POINTER, ADDRESS) : NOVALUE =
103
104 !++
105 ! FUNCTIONAL DESCRIPTION:
106 !
107 !
108 ! ADD AN ADDRESS TO A CHAIN BLOCK. THERE MUST BE ROOM.
109 !
110 !
111 ! FORMAL PARAMETERS:
112 !
113 ! POINTER - POINTER TO THE CHAIN BLOCK
114 ! ADDRESS - THE ADDRESS TO BE ADDED
115 !
116 ! IMPLICIT INPUTS:
117 !
118 ! NONE
119 !
120 ! IMPLICIT OUTPUTS:
121 !
122 ! NONE
123 !
124 ! ROUTINE VALUE:
125 !
126 ! NONE
127 !
128 ! SIDE EFFECTS
129 !
130 ! THE CONTENTS OF THE CHAIN BLOCK IS MODIFIED
131 !
132 !--
133
134 BEGIN
135
136 LOCAL
137 PTRS,
138 BITPOS;
139
140 MAP
141 POINTER : REF CHAIN_BLOCK;
142
143 STRUCTURE
144 POINTERS [LOCN] =
145 (POINTERS + (LOCN/%BPVAL))<(LOCN MOD %BPVAL), %BPADDR>;
146
147 !
148 PTRS = .POINTER [NUM_CHAIN_PTRS];
149 BITPOS = ((%FIELDEXPAND (CHAIN_PTRS, 0)*%BPVAL) + %FIELDEXPAND (CHAIN_PTRS, 1)) + (.PTRS*%BPADDR);
150 POINTERS [.POINTER, .BITPOS] = .ADDRESS;
151 POINTER [NUM_CHAIN_PTRS] = .PTRS + 1;
152 END;
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
153 ROUTINE INIT_CHAIN (POINTER, SUB_TYPE, UPPER_BLOCK) : NOVALUE =
154
155 !++
156 ! FUNCTIONAL DESCRIPTION:
157 !
158 ! INITIALIZE A CHAIN BLOCK
159 !
160 ! FORMAL PARAMETERS:
161 !
162 ! POINTER - POINTER TO THE CHAIN BLOCK TO BE INITIALIZED
163 ! SUB_TYPE - TYPE OF BLOCK THAT THIS CHAIN BLOCK POINTS TO
164 ! UPPER_BLOCK - POINTER TO THE BLOCK THAT POINTS TO THIS CHAIN BLOCK
165 !
166 ! IMPLICIT INPUTS:
167 !
168 ! NONE
169 !
170 ! IMPLICIT OUTPUTS:
171 !
172 ! NONE
173 !
174 ! ROUTINE VALUE:
175 !
176 ! NONE
177 !
178 ! SIDE EFFECTS
179 !
180 ! NONE
181 !
182 !--
183
184 BEGIN
185
186 MAP
187 POINTER : REF CHAIN_BLOCK;
188
189 !
190 POINTER [NUM_CHAIN_PTRS] = 0;
191 POINTER [CHAIN_STYPE] = .SUB_TYPE;
192 POINTER [CHAIN_BACK] = .UPPER_BLOCK;
193 END;
194
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
195 GLOBAL ROUTINE BLD_CHAIN (ROOT_BLOCK_PTR, FIRST_CHAIN, NEW_BLOCK) = !BUILD A CHAIN
196
197 !++
198 ! FUNCTIONAL DESCRIPTION:
199 !
200 ! BLD_CHAIN APPENDS A POINTER TO A (POSSIBLY EMPTY) LIST
201 ! OF POINTERS. THIS PERMITS A FIELD IN A BLOCK TO POINT
202 ! TO A LOT OF OTHER BLOCKS. BLD_CHAIN WILL OBTAIN SPACE
203 ! FROM THE FREE LIST IF NECESSARY TO HOLD THE POINTERS.
204 !
205 ! FORMAL PARAMETERS:
206 !
207 ! ROOT_BLOCK_PTR - BLOCK THAT POINTS
208 ! FIRST_CHAIN - OLD CONTENTS OF POINTER CELL
209 ! NEW_BLOCK - POINTER TO BE ADDED TO THE LIST
210 !
211 ! IMPLICIT INPUTS:
212 !
213 ! NONE
214 !
215 ! IMPLICIT OUTPUTS:
216 !
217 ! NONE
218 !
219 ! ROUTINE VALUE:
220 !
221 ! NEW CONTENTS OF POINTER CELL, OR 0 IF OUT OF STORAGE.
222 !
223 ! SIDE EFFECTS
224 !
225 ! MAY OBTAIN STORAGE FROM FREE STORAGE LIST
226 !
227 !--
228
229 BEGIN
230
231 BIND
232 ROUTINE_NAME = UPLIT (%ASCIZ'BUILD_CHAIN');
233
234 LOCAL
235 LAST_PTR : REF CHAIN_BLOCK,
236 NEXT_PTR : REF CHAIN_BLOCK;
237
238 MAP
239 FIRST_CHAIN : REF CHAIN_BLOCK,
240 ROOT_BLOCK_PTR : REF ANY_BLOCK,
241 NEW_BLOCK : REF ANY_BLOCK;
242
243 IF (.FIRST_CHAIN EQL 0)
244 THEN
245
246 IF ((NEXT_PTR = GETBLK (CHAIN_TYP, CHAIN_LEN)) EQL 0)
247 THEN
248 ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
249 ELSE
250 BEGIN !NO OLD CHAIN AND WE HAVE STORAGE
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
251 INIT_CHAIN (.NEXT_PTR, .NEW_BLOCK [ANY_TYPE], .ROOT_BLOCK_PTR);
252 ADD_POINTER (.NEXT_PTR, .NEW_BLOCK);
253 NEXT_PTR [CHAIN_NEXT] = .NEXT_PTR;
254 NEXT_PTR [CHAIN_PREV] = .NEXT_PTR;
255 .NEXT_PTR
256 END
257
258 ELSE
259 BEGIN !THERE IS ALREADY A CHAIN BLOCK
260 LAST_PTR = .FIRST_CHAIN [CHAIN_PREV]; !POINT TO LAST CHAIN BLOCK
261
262 IF (.LAST_PTR [NUM_CHAIN_PTRS] LSS MAX_CHAIN_PTRS)
263 THEN
264 ADD_POINTER (.LAST_PTR, .NEW_BLOCK) !SIMPLE CASE
265 ELSE
266 BEGIN !LAST CHAIN BLOCK FULL, GET NEW ONE.
267
268 IF ((NEXT_PTR = GETBLK (CHAIN_TYP, CHAIN_LEN)) EQL 0)
269 THEN
270 ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
271 ELSE
272 BEGIN ! WE HAVE STORAGE
273 INIT_CHAIN (.NEXT_PTR, .NEW_BLOCK [ANY_TYPE], .ROOT_BLOCK_PTR);
274 ADD_POINTER (.NEXT_PTR, .NEW_BLOCK);
275 NEXT_PTR [CHAIN_PREV] = .LAST_PTR;
276 FIRST_CHAIN [CHAIN_PREV] = .NEXT_PTR;
277 NEXT_PTR [CHAIN_NEXT] = .FIRST_CHAIN;
278 LAST_PTR [CHAIN_NEXT] = .NEXT_PTR;
279 END; ! OF HAVING STORAGE
280
281 END; ! OF NEEDING A NEW CHAIN BLOCK
282
283 .FIRST_CHAIN
284 END ! OF ALREADY HAVE A CHAIN
285 END; ! OF ROUTINE BLD_CHAIN
286
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
287 GLOBAL ROUTINE FND_CHAIN (CHAIN_PTR, SELECTOR, SELARG) = !FIND A BLOCK IN A CHAIN
288
289 !++
290 ! FUNCTIONAL DESCRIPTION:
291 !
292 ! FND_CHAIN SEARCHES THE BLOCKS OF A CHAIN FOR THE FIRST
293 ! ONE ACCEPTABLE TO THE SELECTOR SUBROUTINE.
294 !
295 ! FORMAL PARAMETERS:
296 !
297 ! CHAIN_PTR - POINTER TO THE INITIAL CHAIN BLOCK, OR 0 IF NONE.
298 ! SELECTOR - SUBROUTINE TO SELECT A SUITABLE BLOCK
299 ! SELARG - ARGUMENT TO GIVE TO SELECTOR SUBROUTINE
300 !
301 ! IMPLICIT INPUTS:
302 !
303 ! NONE
304 !
305 ! IMPLICIT OUTPUTS:
306 !
307 ! NONE
308 !
309 ! ROUTINE VALUE:
310 !
311 ! 0 IF NO CHAIN BLOCKS OR NONE ARE ACCEPTABLE TO THE
312 ! SELECTOR SUBROUTINE. OTHERWISE THE VALUE RETURNED
313 ! IS THE NON-ZERO VALUE RETURNED BY THE SELECTOR
314 ! SUBROUTINE WHEN FIRST PRESENTED WITH AN ACCEPTABLE
315 ! BLOCK.
316 !
317 ! SIDE EFFECTS
318 !
319 ! THE SELECTOR SUBROUTINE MAY HAVE SIDE EFFECTS.
320 !
321 !--
322
323 BEGIN
324
325 STRUCTURE
326 POINTERS [LOCN] =
327 (POINTERS + (LOCN/%BPVAL))<(LOCN MOD %BPVAL), %BPADDR>;
328
329 LOCAL
330 BIT_POSITION,
331 SBRVAL,
332 CHAINP : REF CHAIN_BLOCK,
333 NCP,
334 CPINX,
335 BLOCKP : REF ANY_BLOCK;
336
337 !
338
339 IF ((CHAINP = .CHAIN_PTR) EQL 0)
340 THEN
341 0
342 ELSE
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
343 BEGIN
344 !
345
346 DO
347 BEGIN
348 NCP = .CHAINP [NUM_CHAIN_PTRS];
349 CPINX = 0;
350
351 DO
352 BEGIN
353 BIT_POSITION = ((%FIELDEXPAND (CHAIN_PTRS, 0)*%BPVAL) + %FIELDEXPAND (CHAIN_PTRS, 1)) + (
354 .CPINX*%BPADDR);
355 BLOCKP = .POINTERS [.CHAINP, .BIT_POSITION];
356 SBRVAL = (.SELECTOR) (.BLOCKP, .SELARG);
357 CPINX = .CPINX + 1;
358 END
359 UNTIL ((.CPINX EQL .NCP) OR (.SBRVAL NEQ 0));
360
361 CHAINP = .CHAINP [CHAIN_NEXT];
362 END
363 UNTIL ((.CHAINP EQL .CHAIN_PTR) OR (.SBRVAL NEQ 0));
364
365 .SBRVAL
366 END
367
368 END; ! OF ROUTINE FND_CHAIN
369
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
370 GLOBAL ROUTINE DEL_PTRS (CHAIN_PTR) : NOVALUE = !DELETE CHAIN BLOCKS
371
372 !++
373 ! FUNCTIONAL DESCRIPTION:
374 !
375 ! FREE MEMORY HELD FOR CHAIN BLOCKS.
376 !
377 ! FORMAL PARAMETERS:
378 !
379 ! CHAIN_PTR - ADDRESS OF FIRST CHAIN BLOCK
380 !
381 ! IMPLICIT INPUTS:
382 !
383 ! NONE
384 !
385 ! IMPLICIT OUTPUTS:
386 !
387 ! NONE
388 !
389 ! ROUTINE VALUE:
390 !
391 ! NONE
392 !
393 ! SIDE EFFECTS:
394 !
395 ! SOME MEMORY MAY BE RETURNED TO THE FREE POOL
396 !
397 !--
398
399 BEGIN
400
401 LOCAL
402 CHAINP : REF CHAIN_BLOCK,
403 NEXT_BLOCK;
404
405 IF ((CHAINP = .CHAIN_PTR) NEQ 0)
406 THEN
407 BEGIN
408
409 DO
410 BEGIN
411 NEXT_BLOCK = .CHAINP [CHAIN_NEXT];
412 FREBLK (.CHAINP);
413 CHAINP = .NEXT_BLOCK;
414 END
415 UNTIL (.CHAINP EQL .CHAIN_PTR)
416
417 END;
418
419 END; !OF DEL_PTRS
420
421 END
422
423 ELUDOM
424 ! Local Modes:
425 ! Comment Start:!
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
426 ! Comment Column:36
427 ! Auto Save Mode:2
428 ! Mode:Fundamental
429 ! END:
DSK:PCHN.XRF[4,31] 31-Aug-79 14:49
ADDRESS 102 150
ADD_POINTER 65 102* 252 264 274
ANY_BLOCK 240 241 335
ANY_TYPE 251 273
BITPOS 138 149# 150
BIT_POSITION 330 353# 355
BLD_CHAIN 67 195*
BLOCKP 335 355# 356
CHAINP 332 339# 348 355 361# 363 402
405# 411 412 413# 415
CHAIN_BACK 192
CHAIN_BLOCK 141 187 235 236 239 332 402
CHAIN_LEN 246 268
CHAIN_NEXT 253 277 278 361 411
CHAIN_PREV 254 260 275 276
CHAIN_PTR 287 339 363 370 405 415
CHAIN_PTRS 149 353
CHAIN_STYPE 191
CHAIN_TYP 246 268
CPINX 334 349# 354 357# 359
DEL_PTRS 69 370*
ERRMSG 98* 248 270
FIRST_CHAIN 195 239 243 260 276# 277 283
FND_CHAIN 68 287*
FREBLK 100 412
GETBLK 99 246 268
INIT_CHAIN 66 153* 251 273
LAST_PTR 235 260# 262 264 275 278#
LOCN 144 145 326 327
MAX_CHAIN_PTRS 262
NCP 333 348# 359
NEW_BLOCK 195 241 251 252 264 273 274
NEXT_BLOCK 403 411# 413
NEXT_PTR 236 246# 251 252 253# 254# 255
268# 273 274 275# 276 277# 278
NUM_CHAIN_PTRS 148 151 190 262 348
PCHN 4#
POINTER 102 141 148 150 151# 153 187
190# 191# 192#
POINTERS 144# 145 150# 326# 327 355
PTRS 137 148# 149 151
ROOT_BLOCK_PTR 195 240 251 273
ROUTINE_NAME 232# 248 270
SBRVAL 331 356# 359 363 365
SELARG 287 356
SELECTOR 287 356
SUB_TYPE 153 191
UPPER_BLOCK 153 192