1 /* dasrcr.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 logical c_false = FALSE_;
11 static integer c__3 = 3;
12 static integer c__256 = 256;
13
14 /* $Procedure DASRCR ( DAS, remove comment records ) */
dasrcr_(integer * handle,integer * n)15 /* Subroutine */ int dasrcr_(integer *handle, integer *n)
16 {
17 /* Initialized data */
18
19 static integer next[3] = { 2,3,1 };
20 static integer prev[3] = { 3,1,2 };
21
22 /* System generated locals */
23 integer i__1, i__2, i__3;
24
25 /* Builtin functions */
26 integer s_rnge(char *, integer, char *, integer);
27
28 /* Local variables */
29 integer base;
30 char recc[1024];
31 doublereal recd[128];
32 integer free, reci[256], lrec, nrec, unit, type__;
33 extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *,
34 integer *, ftnlen);
35 integer i__;
36 extern /* Subroutine */ int chkin_(char *, ftnlen);
37 integer ncomc;
38 extern /* Subroutine */ int maxai_(integer *, integer *, integer *,
39 integer *);
40 integer ncomr, lword;
41 extern logical failed_(void);
42 extern /* Subroutine */ int cleari_(integer *, integer *), dasioc_(char *,
43 integer *, integer *, char *, ftnlen, ftnlen), dasiod_(char *,
44 integer *, integer *, doublereal *, ftnlen);
45 integer dirrec[256];
46 extern /* Subroutine */ int dashfs_(integer *, integer *, integer *,
47 integer *, integer *, integer *, integer *, integer *, integer *),
48 dasioi_(char *, integer *, integer *, integer *, ftnlen),
49 dassih_(integer *, char *, ftnlen);
50 integer lastla[3];
51 extern /* Subroutine */ int daswbr_(integer *);
52 integer lindex;
53 extern /* Subroutine */ int dasufs_(integer *, integer *, integer *,
54 integer *, integer *, integer *, integer *, integer *, integer *);
55 integer lastrc[3], nshift;
56 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
57 ftnlen);
58 integer lastwd[3], nresvc;
59 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
60 integer *, ftnlen);
61 extern logical return_(void);
62 integer nresvr, loc, pos;
63
64 /* $ Abstract */
65
66 /* Decrease the size of the comment area in a DAS file to reclaim */
67 /* space freed by the removal of a specified number of comment */
68 /* records. */
69
70 /* $ Disclaimer */
71
72 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
73 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
74 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
75 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
76 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
77 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
78 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
79 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
80 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
81 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
82
83 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
84 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
85 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
86 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
87 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
88 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
89
90 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
91 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
92 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
93 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
94
95 /* $ Required_Reading */
96
97 /* DAS */
98
99 /* $ Keywords */
100
101 /* DAS */
102 /* FILES */
103 /* UTILITY */
104
105 /* $ Declarations */
106 /* $ Brief_I/O */
107
108 /* Variable I/O Description */
109 /* -------- --- -------------------------------------------------- */
110 /* HANDLE I A DAS file handle. */
111 /* N I Number of comment records to remove. */
112
113 /* $ Detailed_Input */
114
115 /* HANDLE is the handle of an existing DAS file opened for */
116 /* comment area modification by DASOPC. */
117
118 /* N is the number of records to remove from the end of */
119 /* the comment area. of the specified file. If NCOMR */
120 /* is the number of comment records present in the */
121 /* file on input, then on output the number of comment */
122 /* records will be MAX ( 0, NCOMR - N ). */
123
124 /* $ Detailed_Output */
125
126 /* None. See $Particulars for a description of the effect of this */
127 /* routine. */
128
129 /* $ Parameters */
130
131 /* None. */
132
133 /* $ Exceptions */
134
135 /* 1) If the input handle is invalid, the error will be diagnosed by */
136 /* routines called by this routine. */
137
138 /* 2) If an I/O error occurs during the removal process, the error */
139 /* will be diagnosed by routines called by this routine. The */
140 /* DAS file will probably be corrupted in this case. */
141
142 /* $ Files */
143
144 /* See the description of the argument HANDLE in $Detailed_Input. */
145
146 /* $ Particulars */
147
148 /* This routine is used to reclaim freed space in the comment area */
149 /* of a DAS file subsequent to removal of comments from the file. */
150 /* Any existing directory records and data records will be shifted */
151 /* up by N records. */
152
153 /* This routine updates the file record of the specified DAS file */
154 /* to reflect the addition of records to the file's comment area. */
155 /* Also, the file summary obtainable from DASHFS will be updated to */
156 /* reflect the addition of comment records. */
157
158 /* The disk space occupied by the specified DAS file will not */
159 /* decrease as a result of calling this routine, but the number of */
160 /* records occupied by meaningful data will decrease. The useful */
161 /* records in the file can be copied by DAS routines to create a */
162 /* new, smaller file which contains only the meaningful data. */
163
164 /* This routine may be used only on existing DAS files opened by */
165 /* DASOPC. */
166
167 /* The association of DAS logical addresses and data within the */
168 /* specified file will remain unaffected by use of this routine. */
169
170 /* Normally, SPICELIB applications will not call this routine */
171 /* directly, but will remove comments by calling DASRC. */
172
173 /* This routine has an inverse DASACR, which appends a specified */
174 /* number of records to the end of the comment area. */
175
176 /* $ Examples */
177
178
179 /* C */
180 /* C Open an existing DAS file for modification of */
181 /* C the comment area. We'll presume that the file */
182 /* C contains 20 comment records. */
183 /* C */
184 /* CALL DASOPC ( DAS, HANDLE ) */
185
186 /* C */
187 /* C Remove the last 10 comment records from the file. */
188 /* C */
189 /* CALL DASRCR ( HANDLE, 10 ) */
190
191 /* C */
192 /* C Close the file. */
193 /* C */
194 /* CALL DASCLS ( HANDLE ) */
195
196
197 /* $ Restrictions */
198
199 /* 1) The DAS file must have a binary file format native to the host */
200 /* system. */
201
202 /* $ Literature_References */
203
204 /* None. */
205
206 /* $ Author_and_Institution */
207
208 /* N.J. Bachman (JPL) */
209 /* W.L. Taber (JPL) */
210
211 /* $ Version */
212
213 /* - SPICELIB Version 1.2.0, 05-FEB-2015 (NJB) */
214
215 /* Updated to support integration with the handle */
216 /* manager subsystem. */
217
218 /* Cleaned up use of unnecessary variables and unneeded */
219 /* declarations. */
220
221 /* - SPICELIB Version 1.0.0, 15-NOV-1992 (NJB) (WLT) */
222
223 /* -& */
224 /* $ Index_Entries */
225
226 /* remove comment records from a DAS file */
227
228 /* -& */
229
230 /* SPICELIB functions */
231
232
233 /* Local parameters */
234
235
236 /* Words per data record, for each data type: */
237
238
239 /* Data type parameters */
240
241
242 /* Directory pointer location (forward): */
243
244
245 /* Location of first type descriptor */
246
247
248 /* Local variables */
249
250
251 /* Saved variables */
252
253
254 /* NEXT and PREV map the DAS data type codes to their */
255 /* successors and predecessors, respectively. */
256
257
258 /* Initial values */
259
260
261 /* Standard SPICE error handling. */
262
263 if (return_()) {
264 return 0;
265 }
266 chkin_("DASRCR", (ftnlen)6);
267
268 /* Make sure this DAS file is open for writing. Signal an error if */
269 /* not. */
270
271 dassih_(handle, "WRITE", (ftnlen)5);
272
273 /* Get the logical unit for this DAS file. */
274
275 zzddhhlu_(handle, "DAS", &c_false, &unit, (ftnlen)3);
276 if (failed_()) {
277 chkout_("DASRCR", (ftnlen)6);
278 return 0;
279 }
280
281 /* It's a mistake to use a negative value of N. */
282
283 if (*n < 0) {
284 setmsg_("Number of comment records to remove must be non-negative. "
285 "Actual number requested was #.", (ftnlen)89);
286 errint_("#", n, (ftnlen)1);
287 sigerr_("SPICE(DASINVALIDCOUNT)", (ftnlen)22);
288 chkout_("DASRCR", (ftnlen)6);
289 return 0;
290 }
291
292 /* Before doing anything to the file, make sure that the DASRWR */
293 /* data buffers do not contain any updated records for this file. */
294 /* All of the record numbers that pertain to this file and remain */
295 /* in the DASRWR buffers will be invalidated after this routine */
296 /* returns. */
297
298 /* DASWBR flushes buffered records to the file. */
299
300 daswbr_(handle);
301
302 /* Grab the file summary for this DAS file. Find the number of */
303 /* reserved records and the number of the first free record. */
304
305 dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
306 lastwd);
307
308 /* Determine the size of the record shift we'll actually perform. */
309
310 nshift = min(*n,ncomr);
311
312 /* Find the record and word positions LREC and LWORD of the last */
313 /* descriptor in the file. */
314
315 maxai_(lastrc, &c__3, &lrec, &loc);
316 lword = 0;
317 for (i__ = 1; i__ <= 3; ++i__) {
318 if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc",
319 i__1, "dasrcr_", (ftnlen)353)] == lrec && lastwd[(i__2 = i__
320 - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dasrc"
321 "r_", (ftnlen)353)] > lword) {
322 lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
323 "lastwd", i__1, "dasrcr_", (ftnlen)356)];
324 }
325 }
326
327 /* LREC and LWORD are now the record and word index of the last */
328 /* descriptor in the file. If LREC is zero, there are no directories */
329 /* in the file yet. However, even DAS files that don't contain any */
330 /* data have their first directory records zeroed out, and this */
331 /* should remain true after the removal of the comment records. */
332
333 if (lrec == 0) {
334
335 /* Just write the zero-filled record to record number */
336
337 /* NRESVR + NCOMR + 2 - NSHIFT */
338
339 cleari_(&c__256, dirrec);
340 i__1 = nresvr + ncomr + 2 - nshift;
341 dasioi_("WRITE", &unit, &i__1, dirrec, (ftnlen)5);
342 } else {
343
344 /* There really is stuff to move. For each directory record, */
345 /* move the record and then all of the records described by that */
346 /* record. We start at the beginning of the data area and move */
347 /* downwards in the file as we go. */
348
349 nrec = nresvr + ncomr + 2;
350 while(nrec <= lrec && nrec != 0) {
351
352 /* Read the current directory record and move it. */
353
354 dasioi_("READ", &unit, &nrec, dirrec, (ftnlen)4);
355 i__1 = nrec - nshift;
356 dasioi_("WRITE", &unit, &i__1, dirrec, (ftnlen)5);
357
358 /* For each descriptor in the current directory, move the */
359 /* cluster of data records it refers to. */
360
361 /* Find the data type, size, and base record number of the */
362 /* first cluster described by the current directory. Also */
363 /* find the index within the directory of the directory's */
364 /* last descriptor. */
365
366 type__ = dirrec[8];
367 base = nrec + 1;
368 if (nrec == lrec) {
369 lindex = lword;
370 } else {
371 lindex = 256;
372 }
373
374 /* We'll now traverse the directory in forward order, keeping */
375 /* track of cluster sizes and types as we go. */
376
377 /* POS will be the index of the descriptor of the current */
378 /* cluster. */
379
380 pos = 10;
381 while(pos <= lindex) {
382 if (pos > 10) {
383
384 /* We'll need to determine the type of the current */
385 /* cluster. If the descriptor contains a positive */
386 /* value, the data type of the cluster it refers to is */
387 /* the successor of the previous type, according to our */
388 /* ordering of types. */
389
390 if (dirrec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 :
391 s_rnge("dirrec", i__1, "dasrcr_", (ftnlen)431)] >
392 0) {
393 type__ = next[(i__1 = type__ - 1) < 3 && 0 <= i__1 ?
394 i__1 : s_rnge("next", i__1, "dasrcr_", (
395 ftnlen)432)];
396 } else {
397 type__ = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ?
398 i__1 : s_rnge("prev", i__1, "dasrcr_", (
399 ftnlen)434)];
400 }
401
402 /* Update the cluster base record number. */
403
404 base += (i__2 = dirrec[(i__1 = pos - 2) < 256 && 0 <=
405 i__1 ? i__1 : s_rnge("dirrec", i__1, "dasrcr_", (
406 ftnlen)440)], abs(i__2));
407 }
408
409 /* BASE and TYPE now are correctly set for the current */
410 /* cluster. Move the cluster. */
411
412 i__3 = base + (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 <=
413 i__1 ? i__1 : s_rnge("dirrec", i__1, "dasrcr_", (
414 ftnlen)448)], abs(i__2)) - 1;
415 for (i__ = base; i__ <= i__3; ++i__) {
416 if (type__ == 1) {
417 dasioc_("READ", &unit, &i__, recc, (ftnlen)4, (ftnlen)
418 1024);
419 i__1 = i__ - nshift;
420 dasioc_("WRITE", &unit, &i__1, recc, (ftnlen)5, (
421 ftnlen)1024);
422 } else if (type__ == 2) {
423 dasiod_("READ", &unit, &i__, recd, (ftnlen)4);
424 i__1 = i__ - nshift;
425 dasiod_("WRITE", &unit, &i__1, recd, (ftnlen)5);
426 } else {
427 dasioi_("READ", &unit, &i__, reci, (ftnlen)4);
428 i__1 = i__ - nshift;
429 dasioi_("WRITE", &unit, &i__1, reci, (ftnlen)5);
430 }
431 }
432
433 /* The next descriptor to look at is the next one in the */
434 /* current directory. */
435
436 ++pos;
437 }
438
439 /* Find the next directory record. */
440
441 nrec = dirrec[0];
442 }
443 }
444
445 /* Update the file summary. The number of comment records and the */
446 /* number of the first free record have been decremented by NSHIFT. */
447 /* The numbers of the records containing the last descriptor of each */
448 /* type have been decremented by NSHIFT only if they were non-zero. */
449
450
451 /* The call to DASUFS will update the file record as well as the */
452 /* file summary. */
453
454 ncomr -= nshift;
455 free -= nshift;
456 for (i__ = 1; i__ <= 3; ++i__) {
457 if (lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc",
458 i__3, "dasrcr_", (ftnlen)501)] != 0) {
459 lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc",
460 i__3, "dasrcr_", (ftnlen)502)] = lastrc[(i__1 = i__ - 1)
461 < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", i__1, "dasrcr_"
462 , (ftnlen)502)] - nshift;
463 }
464 }
465 dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
466 lastwd);
467 chkout_("DASRCR", (ftnlen)6);
468 return 0;
469 } /* dasrcr_ */
470
471