1 /* lnkfsl.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static integer c__0 = 0;
11
12 /* $Procedure LNKFSL ( LNK, free sublist of a list ) */
lnkfsl_(integer * head,integer * tail,integer * pool)13 /* Subroutine */ int lnkfsl_(integer *head, integer *tail, integer *pool)
14 {
15 integer node, prev, next;
16 extern /* Subroutine */ int chkin_(char *, ftnlen);
17 integer count;
18 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
19 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
20 ftnlen);
21
22 /* $ Abstract */
23
24 /* Free a specified sublist in a list. */
25
26 /* $ Disclaimer */
27
28 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
29 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
30 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
31 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
32 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
33 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
34 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
35 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
36 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
37 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
38
39 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
40 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
41 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
42 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
43 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
44 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
45
46 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
47 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
48 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
49 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
50
51 /* $ Required_Reading */
52
53 /* LNK */
54
55 /* $ Keywords */
56
57 /* LIST */
58
59 /* $ Declarations */
60 /* $ Brief_I/O */
61
62 /* Variable I/O Description */
63 /* -------- --- -------------------------------------------------- */
64 /* HEAD, */
65 /* TAIL I Head and tail nodes of a sublist to be freed. */
66 /* POOL I-O A doubly linked list pool. */
67
68 /* $ Detailed_Input */
69
70 /* HEAD, */
71 /* TAIL are, respectively, the head and tail nodes of a */
72 /* sublist to be extracted. */
73
74 /* POOL is a doubly linked list pool. */
75
76 /* $ Detailed_Output */
77
78 /* POOL is the input pool, with the following */
79 /* modifications: */
80
81 /* -- All of the nodes of the sublist bounded by */
82 /* HEAD and by TAIL have now been returned to */
83 /* the free list. */
84
85 /* If on input, HEAD was preceded by the node */
86 /* PREV, and tail was followed by the node */
87 /* NEXT, then on output */
88
89 /* -- The successor of PREV is NEXT. */
90 /* -- The predecessor of NEXT is PREV. */
91
92
93 /* $ Parameters */
94
95 /* LBPOOL is the lower bound of the column indices of the POOL */
96 /* array. The columns indexed LBPOOL to 0 are reserved */
97 /* as a control area for the pool. */
98
99 /* $ Exceptions */
100
101 /* 1) If either of HEAD or TAIL are not valid node numbers, the */
102 /* error SPICE(INVALIDNODE) will be signalled. POOL will not be */
103 /* modified. */
104
105 /* 2) If either of HEAD or TAIL are valid node numbers but are */
106 /* not allocated, the error SPICE(UNALLOCATEDNODE) will be */
107 /* signalled. POOL will not be modified. */
108
109 /* 3) If TAIL cannot be reached by forward traversal of the list */
110 /* containing HEAD, the error SPICE(INVALIDSUBLIST) is signalled. */
111 /* POOL will not be modified. */
112
113 /* $ Files */
114
115 /* None. */
116
117 /* $ Particulars */
118
119 /* Deleting a sublist from a list returns all of the nodes in */
120 /* the sublist to the free list. */
121
122 /* To remove a sublist from a list and retain the sublist */
123 /* as a second list, use the routine LNKXSL ( LNK, extract */
124 /* sublist ). */
125
126 /* $ Examples */
127
128 /* 1) Let POOL be a doubly linked list pool containing the list */
129
130 /* 1002 <--> 3 <--> 7 <--> 88 <--> 2 */
131
132 /* To delete the sublist */
133
134 /* 3 <--> 7 <--> 88 */
135
136 /* the call */
137
138 /* CALL LNKFSL ( 3, 88, POOL ) */
139
140 /* can be used. The resulting list will be: */
141
142 /* 1002 <--> 2 */
143
144 /* The nodes 3, 7, and 88 will now be on the free list. */
145
146
147
148 /* 2) Let POOL be a doubly linked list pool containing the list */
149
150 /* 1002 <--> 3 <--> 7 <--> 88 <--> 2 */
151
152 /* To free the entire list, the call */
153
154 /* CALL LNKFSL ( 1002, 2, POOL ) */
155
156 /* should be used. */
157
158
159 /* $ Restrictions */
160
161 /* Linked list pools must be initialized via the routine */
162 /* LNKINI. Failure to initialize a linked list pool */
163 /* will almost certainly lead to confusing results. */
164
165 /* $ Literature_References */
166
167 /* None. */
168
169 /* $ Author_and_Institution */
170
171 /* N.J. Bachman (JPL) */
172 /* W.L. Taber (JPL) */
173
174 /* $ Version */
175
176 /* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */
177
178 /* -& */
179 /* $ Index_Entries */
180
181 /* free sublist of linked list */
182
183 /* -& */
184
185 /* Local parameters */
186
187
188 /* The control area contains 3 elements. They are: */
189
190 /* The "size" of the pool, that is, the number */
191 /* of nodes in the pool. */
192
193 /* The number of free nodes in the pool. */
194
195 /* The "free pointer," which is the column index of the first free */
196 /* node. */
197
198 /* Parameters defining the row and column indices of these control */
199 /* elements are given below. */
200
201
202 /* Each assigned node consists of a backward pointer and a forward */
203 /* pointer. */
204
205 /* +-------------+ +-------------+ +-------------+ */
206 /* | forward--> | | forward--> | | forward--> | */
207 /* +-------------+ ... +-------------+ ... +-------------+ */
208 /* | <--backward | | <--backward | | <--backward | */
209 /* +-------------+ +-------------+ +-------------+ */
210
211 /* node 1 node I node SIZE */
212
213
214
215
216 /* Free nodes say that that's what they are. The way they say it */
217 /* is by containing the value FREE in their backward pointers. */
218 /* Needless to say, FREE is a value that cannot be a valid pointer. */
219
220
221 /* Local variables */
222
223
224 /* HEAD and TAIL must be valid node numbers. These nodes */
225 /* must be allocated as well. */
226
227 if (*head < 1 || *head > pool[10] || *tail < 1 || *tail > pool[10]) {
228 chkin_("LNKFSL", (ftnlen)6);
229 setmsg_("HEAD was #. TAIL was #. Valid range is 1 to #.", (ftnlen)47)
230 ;
231 errint_("#", head, (ftnlen)1);
232 errint_("#", tail, (ftnlen)1);
233 errint_("#", &pool[10], (ftnlen)1);
234 sigerr_("SPICE(INVALIDNODE)", (ftnlen)18);
235 chkout_("LNKFSL", (ftnlen)6);
236 return 0;
237 } else if (pool[(*head << 1) + 11] == 0 || pool[(*tail << 1) + 11] == 0) {
238 chkin_("LNKFSL", (ftnlen)6);
239 setmsg_("Node HEAD: node number = #; backward pointer = #; forward "
240 "pointer = #. Node TAIL: node number = #; backward pointer = "
241 "#; forward pointer = #. (\"FREE\" is #)", (ftnlen)157);
242 errint_("#", head, (ftnlen)1);
243 errint_("#", &pool[(*head << 1) + 11], (ftnlen)1);
244 errint_("#", &pool[(*head << 1) + 10], (ftnlen)1);
245 errint_("#", tail, (ftnlen)1);
246 errint_("#", &pool[(*tail << 1) + 11], (ftnlen)1);
247 errint_("#", &pool[(*tail << 1) + 10], (ftnlen)1);
248 errint_("#", &c__0, (ftnlen)1);
249 sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22);
250 chkout_("LNKFSL", (ftnlen)6);
251 return 0;
252 }
253
254 /* Starting at HEAD, search forward, looking for TAIL (apologies to */
255 /* ZZ Top). Count the nodes in the sublist, while we're at it. */
256
257 count = 1;
258 node = *head;
259 while(node != *tail && node > 0) {
260 ++count;
261 node = pool[(node << 1) + 10];
262 }
263
264 /* If we didn't find TAIL, that's an error. */
265
266 if (node != *tail) {
267 chkin_("LNKFSL", (ftnlen)6);
268 setmsg_("Node # cannot be found by forward traversal, starting at no"
269 "de #.", (ftnlen)64);
270 errint_("#", tail, (ftnlen)1);
271 errint_("#", head, (ftnlen)1);
272 sigerr_("SPICE(INVALIDSUBLIST)", (ftnlen)21);
273 chkout_("LNKFSL", (ftnlen)6);
274 return 0;
275 }
276
277 /* We reached TAIL. Extract the sublist between HEAD and TAIL */
278 /* inclusive. */
279
280
281 /* Find the predecessor of HEAD and the successor of TAIL. */
282
283 prev = pool[(*head << 1) + 11];
284 next = pool[(*tail << 1) + 10];
285
286 /* If the input list did not start with HEAD, then we must update */
287 /* the forward pointer of the tail node, as well as the backward */
288 /* pointer of the head node, of the sublist that preceded HEAD. */
289
290 if (prev > 0) {
291
292 /* Update the forward pointer of PREV with the forward pointer of */
293 /* TAIL. */
294
295 /* If TAIL had a successor, the predecessor of HEAD will now */
296 /* point forward to it. If TAIL was the tail of the input list, */
297 /* the forward pointer of TAIL was the negative of the head of */
298 /* the input list---this is the correct forward pointer for the */
299 /* predecessor of HEAD in this case, since the predecessor of */
300 /* HEAD will become the tail of the main list after the sublist */
301 /* ranging from HEAD to TAIL is removed. */
302
303 pool[(prev << 1) + 10] = next;
304
305 /* If TAIL is the tail of the input list, we must update the */
306 /* backward pointer of the head of the input list to point to */
307 /* the negative of the new tail of the list, which now is PREV. */
308
309 if (next <= 0) {
310
311 /* In this case, we can read off the number of the head */
312 /* node from NEXT: it is just -NEXT. */
313
314 pool[(-next << 1) + 11] = -prev;
315 }
316 }
317
318 /* The portion of the input list that preceded HEAD (if such */
319 /* portion existed) has now been taken care of. */
320
321 /* We now must perform the analogous updates to the portion of */
322 /* the input list that followed TAIL. */
323
324 /* If the input list did not end with TAIL, then we must update */
325 /* the backward pointer of the head node, as well as the forward */
326 /* pointer of the tail node, of the sublist that followed TAIL. */
327
328 if (next > 0) {
329
330 /* Update the backward pointer of NEXT with the backward pointer */
331 /* of HEAD. */
332
333 /* If HEAD had a predecessor, the successor of TAIL will now */
334 /* point backward to it. If HEAD was the head of the input list, */
335 /* the backward pointer of HEAD was the negative of the tail of */
336 /* the input list---this is the correct backward pointer for the */
337 /* successor of TAIL in this case, since the successor of TAIL */
338 /* will become the head of the main list after the sublist */
339 /* ranging from HEAD to TAIL is removed. */
340
341 pool[(next << 1) + 11] = prev;
342
343 /* If HEAD is the head of the input list, we must update the */
344 /* forward pointer of the tail of the input list to point to */
345 /* the negative of the new head of the list, which now is NEXT. */
346
347 if (prev <= 0) {
348
349 /* In this case, we can read off the number of the tail */
350 /* node from PREV: it is just -PREV. */
351
352 pool[(-prev << 1) + 10] = -next;
353 }
354 }
355
356 /* The portion of the input list that followed TAIL (if such */
357 /* portion existed) has now been taken care of. */
358
359
360 /* Set the backward pointers of the freed nodes to FREE. */
361
362 node = *head;
363 while(node != next) {
364 pool[(node << 1) + 11] = 0;
365 node = pool[(node << 1) + 10];
366 }
367
368 /* Return the sublist to the free list. Update the free node */
369 /* count. */
370
371 pool[(*tail << 1) + 10] = pool[8];
372 pool[8] = *head;
373 pool[11] += count;
374 return 0;
375 } /* lnkfsl_ */
376
377