1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 
  7 
  8 /*  DESCRIPTION
  9 
 10        This module implements collection_manager_$modify (cm_modify$cm_modify),
 11    collection_manager_$modify_in_ci_buffer (cm_modify$buffered) and
 12    collection_manager_$modify_unprotected (cm_modify$unprotected), and
 13    implements entries internal to collection_manager_.
 14 
 15         This module takes the element value pointed to by p_element_ptr and puts it in
 16    the location described by p_element_id. An element must already be
 17    allocated at that location. In the simple case where both the old value is
 18    stored as a single datum and the new value can be stored as a single datum,
 19    the following attempts are made to store the new value in the old element's
 20    control interval: (1) exactly replace the contents if there is no change in
 21    length - do not change any other information; (2) store the new value in the
 22    same place as the old if no more bytes are required to do so; (3) store the
 23    new value in the free pool and remove the old; (4) compact the control
 24    interval if there is enough overall free space to store the new value, and
 25    store the new value in the newly-enlarged free pool; (5) if Ordered ESM,
 26    return dm_error_$long_element; else store value in another control interval
 27    and store in this control interval a continued_datum pointing to where the
 28    value is actually stored.
 29 
 30         The following entry points exist:
 31    $cm_modify: Called externally (via collection_manager_ transfer
 32    vector).  This is the main entry.
 33 
 34    $unprotected: Called externally. This entry requires the new value be
 35    identical in length to the old value. The file_manager_$raw_put entry is
 36    used to put the new value, thereby not obtaining an exclusive lock on the
 37    control interval. The new and old values must also be single datum elements.
 38 
 39    $buffered: Called externally. This entry operates on a control interval
 40    buffer (set up by collection_manager_$setup_buffered_ci) and copies data
 41    info the buffer directly rather than use file_manager_.
 42 
 43    $info, $unprotected_info, $buffered_info: Called internally by another
 44    collection_manager_ module which must have set up opening information on
 45    which this entry relies. In all other respects, identical to their
 46    corresponding entry.
 47 
 48         Internal subroutines which detect an error situation return to the
 49    external caller via the ERROR_RETURN subroutine. This subroutine sets the
 50    output error code (p_code), cleans up (via FINISH) and transfers to the
 51    RETURN label preceding the return statement in the main procedure.  For
 52    this reason, there are no error code checks following calls to internal
 53    subroutines.
 54 */
 55 
 56 /* HISTORY:
 57 Written by Matthew Pierret.
 58 Modified:
 59 03/26/82 by Matthew Pierret: Fixed bug that tested for beginning of element
 60             incorrectly. Also added check for the collection id to which
 61             the control interval belongs.
 62 04/07/82 by Matthew Pierret: Added calculation of maximum space available.
 63 04/27/82 by Matthew Pierret: Changed calling sequence of cm_compact_and_add.
 64 05/10/82 by Lindsey Spratt:  Changed division to calculate length_in_bytes to
 65             use precision and scale of (35,18) instead of (17, 2).  The
 66             length_in_bytes was one short when the length_in_bits was not a
 67             multiple of the number of bits per byte. Changed the test which
 68             decides whether to use put_datum_in_place or put_datum_in_pool to
 69             take into account the datum_header length.
 70 05/11/82 by Lindsey Spratt:  Changed the calculation of
 71             p_maximum_space_available to adjust for the datum header length
 72             when adding in the length of the element attempting to be "put",
 73             but for which there was insufficient room.
 74 06/15/82 by Matthew Pierret: Changed to deal with only complete elements.
 75             cm_put_element_portion has been written to handle element portions.
 76             Changed to bci_header, dm_cm_basic_ci.incl.pl1.
 77 06/21/82 by Matthew Pierret: Changed to use cm_compact.
 78 08/04/82 by Matthew Pierret: Changed to use bit(36)aligned collection id.
 79 09/10/82 by Matthew Pierret: Changed to call cm_compact with element_id.index
 80             equal to 0, meaning do not leave room for a new slot.
 81 09/21/82 by Lindsey Spratt:  Changed to call cm_compact$replacement, which
 82             frees the storage associated with the datum at p_element_id.  This
 83             storage was not being freed.  This is done instead of the previous
 84             technique of using a 0 index.
 85 10/03/82 by Matthew Pierret:  Added opening info, $info entry.
 86             Added support for multi-datum elements.
 87             Changed calculation of p_maximum_space_available to include
 88             scatterred free space. Previously ony the free pool was being
 89             considered.
 90 11/18/82 by Lindsey Spratt: Changed to set element_id_string to p_element_id,
 91             and changed all of the uses of p_element_id to element_id_string.
 92 12/01/82 by Lindsey Spratt: Changed to always get the cd_datum_header if the
 93             is_continued flag is on, and set the continuation variable.
 94 12/02/82 by Lindsey Spratt:  Fixed to add the old storage for the datum to the
 95             pool_free_space only if the old storage starts at the
 96             start_of_used_space, as recorded in the bci_header.
 97 01/06/83 by Matthew Pierret: Added $buffered and $buffered_info entries. These
 98             entries accept a pointer to a control interval buffer, and access
 99             the control interval buffer rather than have file_manager_ access
100             the control interval in the file.
101 01/12/83 by Lindsey Spratt:  Added declarations of put_into_ci_buffer and
102             sys_info$max_seg_size.  Fixed declaration of dm_error_$no_element,
103             also fixed dcl of p_continuation in an internal proc (was bit(1),
104             is now bit(36)).  Corrected to use BASIC_CI_LAYOUT_1.
105 01/27/83 by Matthew Pierret: Upgraded to CM_INFO_VERSION_2. Changed to use
106             cm_bet_bci_header$slot instead of cm_get_header_and_slot.
107             Changed to use dm_error_$ci_not_in_collection instead of
108             $ci_in_wrong_collection. Changed to use addcharno.
109             Removed put_element label. Changed calling sequence to
110             cm_recursive_put, adding element_id_string. This is so that
111             cm_recursive_put knows the orignin of the element.
112 04/27/83 by Matthew Pierret:  Added $unprotected("" _info) entries which do
113             not obtain an exclusive lock to update the datum contents.  This
114             is used for heavily updated and non-critical elements.  The old
115             and new elements must be identical in size, so that only the
116             contents themselves are changed, avoiding messing up a reader of
117             the control interval header.  Also, only single datum elements are
118             supported.
119                  Also changed to call ERROR_RETURN whenever an error is
120             detected, even if in an interal subroutine.  Callers of internal
121             subroutines can assume that if the caller is returned to, no error
122             has occurred.
123 04/28/83 by Matthew Pierret:  Fixed bug in cm_put_element introduced in last
124             collection_manager_ installation.  A wrong variable was being set,
125             leaving the correct one uninitialized.
126 05/02/83 by Matthew Pierret:  Changed to not allow buffered puts to use
127             SIMPLE_REPLACE_DATUM_CONTENTS, since that routine updates the file
128             directly.  The previous action caused buffered elements to become
129             inconsistent, particularly the branch_ci_header in index
130             collections.
131 05/04/83 by Matthew Pierret:  Fixed use of addcharno (was adding one char too
132             many).
133 04/13/84 by Matthew Pierret:  Changed declaration of p_element_length to
134             correctly be fixed bin (35) instead of (17).
135 05/21/84 by Matthew Pierret:  Renamed include file dm_cm_esm_info to
136             dm_esm_info.
137 06/01/84 by Matthew Pierret:  Changed to reset datum_slot.offset_in_bytes
138             after calling cm_compact$replacement.  The value is used in the
139             call to cm_put_datum_in_pool to determine if the existing datum is
140             the first datum past the pool and can therefore be partially
141             re-used.  A compaction removes the existing datum's storage, so
142             is invalid to try to re-use it.
143 06/12/84 by Matthew Pierret:  Changed name of module from cm_put_element to
144             cm_modify.  Switched length/ptr parameter pairs to ptr/length.
145 10/02/84 by Matthew Pierret:  Changed byte length calculations to use the
146             function bytes<-divide(bits+BITS_PER_BYTE-1,BITS_PER_BYTE,17,0)
147             instead of ceil(divide(bits,BITS_PER_BYTE,35,18)), the former being
148             more efficient.  Changed SETUP_HEADER_AND_SLOT into the pair
149             GET_SLOT_FROM_BUFFER and GET_HEADER_AND_SLOT_FROM_FILE.  Changed
150             subroutines to follow the variable name prefixing convention.
151             Changed the continuation variable to continuation_datum_id.
152             Fixed to set the element_length_in_bits to the full length of the
153             element (current_element_length_in_bits) isntead of the length of
154             the first datum (datum_slot.length_in_bits).  Removed the declared
155             but un-used variables BYTES_PER_WORD and sys_info$max_seg_size.
156             Changed to only check the ci version once and to use the
157             standard sub_err_ calling sequence.
158 02/27/85 by Matthew C. Pierret:  Changed to use
159             cm_compact$buffered_replacement instead of cm_compact$replacement
160             if entered through the buffered entry (is_buffered equals "1"b).
161 */
162 ^L
163 /* format: style2,ind3 */
164 
165 cm_modify:
166    proc (p_file_opening_id, p_collection_id, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available,
167         p_code);
168 
169 
170 /* START OF DECLARATIONS */
171 /* Parameter */
172 
173       dcl     p_ci_buffer_ptr        ptr parameter;
174       dcl     p_cm_info_ptr          ptr parameter;
175       dcl     p_file_opening_id      bit (36) aligned parameter;
176       dcl     p_collection_id        bit (36) aligned parameter;
177       dcl     p_element_length       fixed bin (35) parameter;
178       dcl     p_element_ptr          ptr parameter;
179       dcl     p_element_id           bit (36) aligned parameter;
180       dcl     p_maximum_space_available
181                                      fixed bin (35) parameter;
182       dcl     p_code                 fixed bin (35) parameter;
183 
184 /* Automatic */
185 
186       dcl     1 automatic_bci_header aligned like bci_header;
187       dcl     1 automatic_datum_slot aligned like datum_slot;
188       dcl     continuation_datum_id  bit (36) aligned init ("0"b);
189       dcl     (current_element_length_in_bits, element_length_in_bits, header_space_required, old_datum_length_in_bytes,
190               pool_free_bytes, remaining_length_in_bits, total_free_bytes, code)
191                                      fixed bin (35) init (0);
192       dcl     (element_length_in_bytes, remaining_length_in_bytes)
193                                      fixed bin (17) init (0);
194 
195       dcl     (using_ordered_esm, is_buffered, is_unprotected)
196                                      bit (1) aligned init ("0"b);
197 
198 /* Based */
199 /* Builtin */
200 
201       dcl     (addcharno, addr, unspec, divide, null)
202                                      builtin;
203 
204 /* Controlled */
205 /* Constant */
206 
207       dcl     myname                 init ("cm_modify") char (32) varying internal static options (constant);
208       dcl     BITS_PER_BYTE          fixed bin init (9) int static options (constant);
209       dcl     END_OF_ELEMENT         fixed bin init (-1) int static options (constant);
210 
211 /* Entry */
212 
213       dcl     file_manager_$get      entry (bit (36) aligned, fixed bin (27), ptr, fixed bin (35));
214       dcl     file_manager_$put      entry (bit (36) aligned, fixed bin (27), ptr, fixed bin (35));
215       dcl     file_manager_$raw_put  entry (bit (36) aligned, fixed bin (27), ptr, fixed bin (35));
216       dcl     file_manager_$simple_get
217                                      entry (bit (36) aligned, fixed bin (27), fixed bin (21), ptr, fixed bin (21),
218                                      fixed bin (35));
219       dcl     sub_err_               entry options (variable);
220 
221 /* External */
222 
223       dcl     (
224               dm_error_$bad_element_length,
225               dm_error_$ci_not_in_collection,
226               dm_error_$long_element,
227               dm_error_$no_element,
228               dm_error_$unimplemented_ci_version,
229               error_table_$unimplemented_version
230               )                      fixed bin (35) ext;
231 
232 /* END OF DECLARATIONS */
233 ^L
234 /* format: ^indblkcom,indcomtxt */
235 
236       is_unprotected = "0"b;
237       is_buffered = "0"b;
238       unspec (automatic_bci_header) = ""b;
239       unspec (automatic_datum_slot) = ""b;
240       bci_header_ptr = addr (automatic_bci_header);
241       datum_slot_ptr = addr (automatic_datum_slot);
242       go to NO_INFO_JOIN;
243 
244 buffered:
245    entry (p_ci_buffer_ptr, p_file_opening_id, p_collection_id, p_element_ptr, p_element_length, p_element_id,
246         p_maximum_space_available, p_code);
247 
248       is_buffered = "1"b;
249       bci_header_ptr = p_ci_buffer_ptr;
250       call CHECK_CI_VERSION ((bci_header.layout_type));
251       goto NO_INFO_JOIN;
252 
253 unprotected:
254    entry (p_file_opening_id, p_collection_id, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available,
255         p_code);
256 
257       is_unprotected = "1"b;
258       is_buffered = "0"b;
259       unspec (automatic_bci_header) = ""b;
260       unspec (automatic_datum_slot) = ""b;
261       bci_header_ptr = addr (automatic_bci_header);
262       datum_slot_ptr = addr (automatic_datum_slot);
263       go to NO_INFO_JOIN;
264 
265 
266 NO_INFO_JOIN:
267       code = 0;
268       call cm_opening_info$get (p_file_opening_id, p_collection_id, cm_info_ptr, code);
269       if code ^= 0
270       then call ERROR_RETURN (code);
271 
272       go to JOIN;
273 
274 
275 info:
276    entry (p_cm_info_ptr, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available, p_code);
277 
278       is_unprotected = "0"b;
279       is_buffered = "0"b;
280       unspec (automatic_bci_header) = ""b;
281       unspec (automatic_datum_slot) = ""b;
282       bci_header_ptr = addr (automatic_bci_header);
283       datum_slot_ptr = addr (automatic_datum_slot);
284       cm_info_ptr = p_cm_info_ptr;
285       go to JOIN;
286 
287 /* ******************** Not currently used ********************
288 
289    buffered_info:
290    entry (p_cm_info_ptr, p_ci_buffer_ptr, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available,
291    p_code);
292 
293    is_unprotected = "0"b;
294    is_buffered = "1"b;
295    cm_info_ptr = p_cm_info_ptr;
296    bci_header_ptr = p_ci_buffer_ptr;
297    call CHECK_CI_VERSION (bci_header.layout_type);
298 
299    go to JOIN;
300 
301    ** ************************************************************ */
302 
303 unprotected_info:
304    entry (p_cm_info_ptr, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available, p_code);
305 
306       is_unprotected = "1"b;
307       is_buffered = "0"b;
308       unspec (automatic_bci_header) = ""b;
309       unspec (automatic_datum_slot) = ""b;
310       bci_header_ptr = addr (automatic_bci_header);
311       datum_slot_ptr = addr (automatic_datum_slot);
312       cm_info_ptr = p_cm_info_ptr;
313       goto JOIN;
314 %page;
315 JOIN:
316       call CHECK_VERSION (cm_info.version, CM_INFO_VERSION_2, "cm_info");
317       collection_header_ptr = cm_info.header_ptr;
318       call CHECK_VERSION (collection_header.version, COLLECTION_HEADER_VERSION_2, "collection_header");
319 
320       p_code, code = 0;
321       p_maximum_space_available = -1;
322 
323       element_id_string = p_element_id;
324 
325       if collection_header.element_storage_method = ORDERED_ELEMENT_STORAGE_METHOD
326       then using_ordered_esm = "1"b;
327       else using_ordered_esm = "0"b;
328 
329       if is_buffered
330       then call GET_SLOT_FROM_BUFFER (element_id.index, bci_header_ptr, datum_slot_ptr);
331       else call GET_HEADER_AND_SLOT_FROM_FILE (cm_info.file_oid, element_id_string, bci_header_ptr, datum_slot_ptr);
332       if bci_header.collection_id ^= cm_info.collection_id
333       then call ERROR_RETURN (dm_error_$ci_not_in_collection);
334 
335 /**** Get the length of the existing element (current_element_length_in_bits). */
336 
337       if datum_slot.flags.is_continued
338       then if is_buffered
339            then call GET_DATUM_HEADER_VALUES_FROM_BUFFER (bci_header_ptr, datum_slot.offset_in_bytes,
340                      current_element_length_in_bits, continuation_datum_id);
341            else call GET_DATUM_HEADER_VALUES_FROM_FILE (cm_info.file_oid, (element_id.control_interval_id),
342                      (datum_slot.offset_in_bytes), current_element_length_in_bits, continuation_datum_id);
343       else current_element_length_in_bits = datum_slot.length_in_bits;
344 
345 /**** Get the length of the new element (element_length_in_bits). */
346 
347       if p_element_length ^= END_OF_ELEMENT
348       then element_length_in_bits = p_element_length;
349       else element_length_in_bits = current_element_length_in_bits;
350 
351       if element_length_in_bits < 1
352       then call ERROR_RETURN (dm_error_$bad_element_length);
353 
354       if ^datum_slot.flags.is_continued & element_length_in_bits = current_element_length_in_bits & ^is_buffered
355       then
356 SIMPLE_REPLACE:
357          do;
358 
359          /*** The length of the old and new elements are the same.  This means that only the
360               datum contents need to be changed, and the contents can be changed in place.
361               This special-case replacement can be done quickly. */
362 
363             call SIMPLE_REPLACE_DATUM_CONTENTS (cm_info.file_oid, (element_id.control_interval_id), p_element_ptr,
364                  element_length_in_bits, (datum_slot.offset_in_bytes), is_unprotected);
365 
366          end SIMPLE_REPLACE;
367       else if is_unprotected & (element_length_in_bits ^= current_element_length_in_bits | datum_slot.flags.is_continued)
368       then
369 GENERAL_REPLACE_UNPROTECTED:
370          call ERROR_RETURN (dm_error_$bad_element_length);
371       else
372 GENERAL_REPLACE:
373          do;
374 
375          /*** More work may be necessary than simply changing the contents of
376               the datum which holds the element. */
377 
378             remaining_length_in_bits = element_length_in_bits;
379                                                             /* Length of portion of element not yet re-written. */
380          /*** Determine the amount of free space in bytes in this control
381               interval. */
382 
383             call cm_determine_free_space$all (bci_header_ptr, 0, total_free_bytes, pool_free_bytes);
384 
385          /*** Record the length of the existing datum. This is needed to accurately determine
386               the effective free space (total_free_bytes + old_datum_length_in_bytes)
387               and to determine the change in free space caused by replacing the datum. */
388 
389             old_datum_length_in_bytes = divide (datum_slot.length_in_bits + BITS_PER_BYTE - 1, BITS_PER_BYTE, 17, 0);
390 
391             total_free_bytes = total_free_bytes + old_datum_length_in_bytes;
392 
393          /*** If the old datum was allocated at the beginning of the used space, then its
394               old storage space is available as part of the free pool (cm_put_datum_in_pool
395               is capable of recovering this space).  Otherwise,  the only way to recover the
396               old storage for the datum is to compact the control interval. */
397 
398             if datum_slot.offset_in_bytes = bci_header.start_of_used_space
399             then pool_free_bytes = pool_free_bytes + old_datum_length_in_bytes;
400 
401             if datum_slot.flags.is_continued
402             then
403                do;
404 
405                /*** The existing element is a multi-datum element. Put the new value from
406                     rightmost datum of the element to the leftmost. */
407 
408                   call cm_recursive_modify (cm_info_ptr, element_id_string, p_element_ptr, remaining_length_in_bits,
409                        total_free_bytes, continuation_datum_id, code);
410                   if code ^= 0
411                   then call ERROR_RETURN (code);
412 
413                end;
414 
415             if remaining_length_in_bits >= MINIMUM_MAXIMUM_DATUM_CONTENTS_LENGTH_IN_BITS
416             then
417                do;
418 
419                /*** As it is not possible, by convention, for the first datum of an element
420                     to be maximum-sized, maximum-sized datums must be allocated to hold the
421                     tail of the element.  If part of the tail has already been put by
422                     cm_recursive_modify, that part is ignored because remaining_length_in_bits
423                     was decremented.   */
424 
425                   call cm_put_overlength_tail (cm_info_ptr, p_element_ptr, remaining_length_in_bits,
426                        continuation_datum_id, code);
427                   if code ^= 0
428                   then call ERROR_RETURN (code);
429                end;
430 
431          /*** Now all of the element except for a less-than maximum-sized datum has
432               been stored.  If the remainder is too big to fit in this control interval,
433               store it in another control interval and leave an indirect in this
434               control interval. */
435 
436             if continuation_datum_id ^= "0"b
437             then header_space_required = CD_DATUM_HEADER_LENGTH_IN_BYTES;
438 
439             remaining_length_in_bytes = divide (remaining_length_in_bits + BITS_PER_BYTE - 1, BITS_PER_BYTE, 17, 0);
440 
441             if remaining_length_in_bytes + header_space_required <= old_datum_length_in_bytes
442             then
443 PUT_IN_PLACE:
444                do;
445 
446                /*** The remainder can be placed where the old datum is. */
447 
448                   if is_buffered
449                   then if continuation_datum_id = "0"b
450                        then call cm_put_datum_in_place$buffered (bci_header_ptr, p_element_ptr, remaining_length_in_bits,
451                                  datum_slot_ptr, code);
452                        else call cm_put_datum_in_place$buffered_continued (bci_header_ptr, p_element_ptr,
453                                  remaining_length_in_bits, datum_slot_ptr, element_length_in_bits, continuation_datum_id,
454                                  code);
455 
456                   else if continuation_datum_id = "0"b
457                   then call cm_put_datum_in_place (cm_info.file_oid, element_id_string, p_element_ptr,
458                             remaining_length_in_bits, datum_slot_ptr, bci_header_ptr, code);
459                   else call cm_put_datum_in_place$continued (cm_info.file_oid, element_id_string, p_element_ptr,
460                             remaining_length_in_bits, datum_slot_ptr, bci_header_ptr, element_length_in_bits,
461                             continuation_datum_id, code);
462 
463                end PUT_IN_PLACE;
464             else
465 PUT_IN_POOL:
466                do;
467 
468                /*** The remainder is too large to be stored in the space which the old value
469                     currently occupies. Find another place in the control interval to put the
470                     new value. */
471 
472                   if remaining_length_in_bits > (total_free_bytes - header_space_required) * BITS_PER_BYTE
473                   then
474                      do;
475 
476                      /*** The remainder won't fit in this control interval.  Allocate another
477                           datum in which to store the remainder. */
478 
479                         if using_ordered_esm
480                         then call ERROR_RETURN (dm_error_$long_element);
481 
482                         call cm_put_cn_datum (cm_info_ptr, p_element_ptr, remaining_length_in_bits,
483                              (continuation_datum_id), continuation_datum_id, code);
484                         if code ^= 0
485                         then call ERROR_RETURN (code);
486 
487                         remaining_length_in_bits = 0;
488                         header_space_required = CD_DATUM_HEADER_LENGTH_IN_BYTES;
489 
490                      end;
491 
492                /*** The remainder can be placed in this control interval.  Try to put it
493                     in the place it previously occupied.  Otherwise, compact the control
494                     interval and place it in the pool. */
495 
496                   if remaining_length_in_bits > (pool_free_bytes - header_space_required) * BITS_PER_BYTE
497                   then
498                      do;
499 
500                         if is_buffered
501                         then call cm_compact$buffered_replacement (bci_header_ptr, (bci_header.number_of_datums),
502                                   element_id_string, code);
503                         else call cm_compact$replacement (cm_info.file_oid, (bci_header.number_of_datums),
504                                   element_id_string, bci_header_ptr, code);
505                         if code ^= 0
506                         then call ERROR_RETURN (code);
507                         datum_slot.offset_in_bytes = 0;     /* The compaction removed the storage taken up by the element. */
508                      end;
509 
510                   if continuation_datum_id = "0"b
511                   then
512                      do;
513 
514                         datum_slot.flags.is_continued = "0"b;
515 
516                         if is_buffered
517                         then call cm_put_datum_in_pool$buffered (bci_header_ptr, p_element_ptr, remaining_length_in_bits,
518                                   datum_slot_ptr, code);
519                         else call cm_put_datum_in_pool (cm_info.file_oid, element_id_string, p_element_ptr,
520                                   remaining_length_in_bits, datum_slot_ptr, bci_header_ptr, code);
521 
522                      end;
523                   else
524                      do;
525 
526                         datum_slot.flags.is_continued = "1"b;
527 
528                         if is_buffered
529                         then call cm_put_datum_in_pool$buffered_continued (bci_header_ptr, p_element_ptr,
530                                   remaining_length_in_bits, datum_slot_ptr, element_length_in_bits, continuation_datum_id,
531                                   code);
532                         else call cm_put_datum_in_pool$continued (cm_info.file_oid, element_id_string, p_element_ptr,
533                                   remaining_length_in_bits, datum_slot_ptr, bci_header_ptr, element_length_in_bits,
534                                   continuation_datum_id, code);
535 
536                      end;
537 
538                end PUT_IN_POOL;
539 
540             if code ^= 0
541             then call ERROR_RETURN (code);
542 
543          end GENERAL_REPLACE;
544 
545 /**** Successful return. */
546 
547       call FINISH ();
548 RETURN:                                                     /* Transferred to from ERROR_RETURN. */
549       return;
550 
551 %page;
552 CHECK_VERSION:
553    proc (p_received_version, p_expected_version, p_structure_name);
554       dcl     p_received_version     char (8) aligned;
555       dcl     p_expected_version     char (8) aligned;
556       dcl     p_structure_name       char (*);
557 
558       if p_received_version ^= p_expected_version
559       then call sub_err_ (error_table_$unimplemented_version, myname, ACTION_CANT_RESTART, null, 0,
560                 "^/Expected version ^a of the ^a structure.
561 Received version ^a instead.", p_expected_version, p_structure_name, p_received_version);
562 
563    end CHECK_VERSION;
564 
565 
566 CHECK_CI_VERSION:
567    proc (p_given_version);
568 
569       dcl     p_given_version        char (4) aligned;
570 
571       if p_given_version ^= BASIC_CI_LAYOUT_1
572       then call sub_err_ (dm_error_$unimplemented_ci_version, myname, ACTION_CANT_RESTART, null, 0,
573                 "^/Expected version ""^4a"" control interval; received ""^4a"".", BASIC_CI_LAYOUT_1, p_given_version);
574 
575       return;
576 
577    end CHECK_CI_VERSION;
578 %page;
579 FINISH:
580    proc ();
581 
582 
583       if p_code = 0 | p_code = dm_error_$long_element
584       then p_maximum_space_available =
585                 BITS_PER_BYTE * (total_free_bytes - header_space_required) - remaining_length_in_bits;
586 
587       return;
588 
589    end FINISH;
590 
591 ERROR_RETURN:
592    proc (er_p_code);
593 
594       dcl     er_p_code              fixed bin (35);
595 
596       p_code = er_p_code;
597       call FINISH ();
598       goto RETURN;
599 
600    end ERROR_RETURN;
601 %page;
602 SIMPLE_REPLACE_DATUM_CONTENTS:
603    proc (srdc_p_file_opening_id, srdc_p_control_interval_id, srdc_p_datum_contents_ptr, srdc_p_datum_contents_length,
604         srdc_p_datum_contents_offset, srdc_p_is_unprotected);
605 
606       dcl     (
607               srdc_p_file_opening_id bit (36) aligned,
608               srdc_p_control_interval_id
609                                      fixed bin (27),
610               srdc_p_datum_contents_length
611                                      fixed bin (35),
612               srdc_p_datum_contents_ptr
613                                      ptr,
614               srdc_p_datum_contents_offset
615                                      fixed bin (17),
616               srdc_p_is_unprotected  bit (1) aligned
617               )                      parameter;
618       dcl     srdc_code              fixed bin (35) init (0);
619       dcl     1 srdc_ci_part         aligned,
620                 2 number_of_parts    fixed bin (17) init (1),
621                 2 part               (1) like ci_parts.part;
622 
623       srdc_ci_part.part (1).offset_in_bytes = srdc_p_datum_contents_offset;
624       srdc_ci_part.part (1).length_in_bytes =
625            divide (srdc_p_datum_contents_length + BITS_PER_BYTE - 1, BITS_PER_BYTE, 17, 0);
626       srdc_ci_part.part (1).local_ptr = srdc_p_datum_contents_ptr;
627 
628       if srdc_p_is_unprotected
629       then call file_manager_$raw_put (srdc_p_file_opening_id, srdc_p_control_interval_id, addr (srdc_ci_part), srdc_code)
630                 ;
631       else call file_manager_$put (srdc_p_file_opening_id, srdc_p_control_interval_id, addr (srdc_ci_part), srdc_code);
632 
633       if srdc_code ^= 0
634       then call ERROR_RETURN (srdc_code);
635 
636       return;
637 
638    end SIMPLE_REPLACE_DATUM_CONTENTS;
639 %page;
640 GET_SLOT_FROM_BUFFER:
641    proc (gs_p_slot_index, gs_p_bci_ptr, gs_p_slot_ptr);
642 
643       dcl     gs_p_slot_index        fixed bin (12) uns unal parameter;
644       dcl     gs_p_bci_ptr           ptr parameter;
645       dcl     gs_p_slot_ptr          ptr parameter;
646 
647       if gs_p_slot_index > gs_p_bci_ptr -> basic_control_interval.header.number_of_datums | gs_p_slot_index <= 0
648       then call ERROR_RETURN (dm_error_$no_element);
649       else gs_p_slot_ptr = addr (gs_p_bci_ptr -> basic_control_interval.datum_position_table (gs_p_slot_index));
650 
651    end GET_SLOT_FROM_BUFFER;
652 
653 
654 GET_HEADER_AND_SLOT_FROM_FILE:
655    proc (ghs_p_file_oid, ghs_p_element_id, ghs_p_bci_header_ptr, ghs_p_slot_ptr);
656 
657       dcl     ghs_p_file_oid         bit (36) aligned parameter;
658       dcl     ghs_p_element_id       bit (36) aligned parameter;
659       dcl     ghs_p_bci_header_ptr   ptr parameter;
660       dcl     ghs_p_slot_ptr         ptr parameter;
661 
662       dcl     ghs_code               fixed bin (35) init (0);
663 
664       call cm_get_bci_header$slot (ghs_p_file_oid, ghs_p_bci_header_ptr, ghs_p_slot_ptr, ghs_p_element_id, ghs_code);
665       if ghs_code ^= 0
666       then call ERROR_RETURN (ghs_code);
667       else call CHECK_CI_VERSION (ghs_p_bci_header_ptr -> bci_header.layout_type);
668 
669       return;
670 
671    end GET_HEADER_AND_SLOT_FROM_FILE;
672 %page;
673 GET_DATUM_HEADER_VALUES_FROM_FILE:
674    proc (gdf_p_file_oid, gdf_p_ci_number, gdf_p_datum_offset, gdf_p_full_length, gdf_p_continuation_datum_id);
675 
676       dcl     gdf_p_file_oid         bit (36) aligned parameter;
677       dcl     gdf_p_ci_number        fixed bin (27) parameter;
678       dcl     gdf_p_datum_offset     fixed bin (21) parameter;
679       dcl     gdf_p_full_length      fixed bin (35) parameter;
680       dcl     gdf_p_continuation_datum_id
681                                      bit (36) aligned parameter;
682 
683       dcl     gdf_code               fixed bin (35) init (0);
684       dcl     1 gdf_continued_datum_header
685                                      aligned like continued_datum.header;
686 
687       call file_manager_$simple_get (gdf_p_file_oid, gdf_p_ci_number, gdf_p_datum_offset,
688            addr (gdf_continued_datum_header), (CD_DATUM_HEADER_LENGTH_IN_BYTES), gdf_code);
689       if gdf_code ^= 0
690       then call ERROR_RETURN (gdf_code);
691 
692       gdf_p_full_length = gdf_continued_datum_header.full_length;
693       gdf_p_continuation_datum_id = unspec (gdf_continued_datum_header.continuation);
694 
695       return;
696 
697    end GET_DATUM_HEADER_VALUES_FROM_FILE;
698 %page;
699 GET_DATUM_HEADER_VALUES_FROM_BUFFER:
700    proc (gdb_p_ci_ptr, gdb_p_datum_offset, gdb_p_full_length, gdb_p_continuation_datum_id);
701 
702       dcl     gdb_p_ci_ptr           ptr parameter;
703       dcl     gdb_p_datum_offset     fixed bin (15) uns unal parameter;
704       dcl     gdb_p_full_length      fixed bin (35) parameter;
705       dcl     gdb_p_continuation_datum_id
706                                      bit (36) aligned parameter;
707 
708       dcl     gdb_datum_ptr          ptr;
709 
710       gdb_datum_ptr = addcharno (gdb_p_ci_ptr, gdb_p_datum_offset);
711 
712       gdb_p_full_length = gdb_datum_ptr -> continued_datum.full_length;
713       gdb_p_continuation_datum_id = unspec (gdb_datum_ptr -> continued_datum.continuation);
714 
715       return;
716 
717    end GET_DATUM_HEADER_VALUES_FROM_BUFFER;
718 %page;
719 %include dm_cm_info;
720 %page;
721 %include dm_cm_collection_header;
722 %page;
723 %include dm_cm_basic_ci;
724 %page;
725 %include dm_cm_basic_ci_const;
726 %page;
727 %include dm_cm_datum;
728 %page;
729 %include dm_cm_datum_constants;
730 %page;
731 %include dm_ci_parts;
732 %page;
733 %include dm_element_id;
734 %page;
735 %include dm_esm_info;
736 %page;
737 %include dm_cm_entry_dcls;
738 %page;
739 %include sub_err_flags;
740 
741    end cm_modify;