1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 
  7 
  8 /* DESCRIPTION
  9 
 10         This module implements collection_manager_$put.
 11 
 12         This module is a transfer vector of sorts for routines which put
 13    an element.  Two things determine the proper routine to invoke: the Element
 14    Storage Method used by the collection and the entry through which this
 15    routine was invoked.  The ESM is determined by looking in the
 16    collection_header.  The $info and $buffered_info entries are passed the
 17    collection_header as part of the cm_info structure; The other entries get
 18    the collection_header by setting up a cm_info structure
 19    (cm_opening_info$get).  If entered through one of the buffered entries,
 20    this is a "buffered allocation".  Buffered puts are only supported for
 21    ordered ESM collections.
 22 
 23         If Ordered ESM is in force, p_element_id contains the control
 24    interval/slot number to put; if Basic ESM, p_element_id holds ci/slot
 25    of the "related" element (see the documentation for explanation of related
 26    element).  If BESM, a free slot is looked for; if OESM slots to the right
 27    of the specified slot are shifted over one.  An optimization exists which
 28    should be implemented in the next phase which will keep track of whether a
 29    free slot exists in a ci.
 30 
 31 
 32    ***** NOTE: The term "put" was previously referred to as "allocate" *****
 33    ***** "Put" means to allocate space for a new element, and put the  *****
 34    ***** value of the element in that space.                           *****
 35 */
 36 
 37 /* HISTORY:
 38 Written by Matthew C Pierret.
 39 Modified:
 40 03/23/82 by Matthew Pierret: Added "header" entry to allow collection manager
 41             routines to supply the collmgr_header.  This saves a get of that
 42             structure and assures that all modules are working on the same copy
 43             of the structure.
 44 04/07/82 by Matthew Pierret: Added calculation of maxim space available.
 45                  Added following logic: If the requested control
 46             interval is 0 but the requested collection is not the header
 47             collection (meaning that no particular control interval is
 48             requested) then check the last_used_ci for the collection. If
 49             non-zero, then set element_id.control_interval_id to be the
 50             last_used_ci. If zero, then allocate a new control interval and set
 51             element_id.control_interval_id to be the new control interval.
 52             This is done for Basic ESM only. It is an error for such a situation
 53             to occur using Ordered ESM
 54 04/17/82 by Matthew Pierret: Removed call to cm_get_header_and_slot. This is
 55             now done at a later stage for each control interval attempted.
 56             This approach helps eliminate inconsistencies between the ci
 57             header this routine looks at and the one its subroutines look at.
 58 06/08/82 by Matthew Pierret: Changed to use collection_header instead of
 59             collmgr_header.collection (). Also made calculation of maximum
 60             free space take datum header into account, returning only the
 61             largest element acceptable instead of the largest datum.
 62 06/15/82 by Matthew Pierret: Changed to use bci_header, dm_cm_basic_ci.incl.
 63 08/03/82 by Matthew Pierret: Changed to use last_control_interval in calling
 64             sequence to cm_allocate_basic_element.
 65 09/07/82 by Matthew Pierret: Fixed p_code/code bug in call to cm_get_element.
 66 11/09/82 by Matthew Pierret: Added opening info. Moved calculation of free
 67             space into lower routines.
 68 01/07/83 by Matthew Pierret: Added $buffered and $buffered_info entries.
 69             Basic ESM still does not support buffered allocation.
 70 01/07/83 by Matthew Pierret: Fixed bug which set bci_header_ptr to the addr of
 71             a local automatic_bci_header even if p_ci_buffer_ptr was supplied.
 72 02/02/83 by Matthew Pierret: Upgraded to CM_INFO_VERSION_2.
 73 05/21/84 by Matthew Pierret: Renamed include file dm_cm_esm_info to dm_esm_info
 74 10/03/84 by Matthew Pierret: Removed un-used constants. Added unspec builtin.
 75             Removed unnecessary calls-by-value to CHECK_VERSION.  Changed to
 76             use the standard sub_err_ action flags and to use the code
 77             dm_error_$unimplemented_esm instead of 0 in sub_err_ call
 78             reporting that the Basic ESM cannot use the buffered access method.
 79 */
 80 ^L
 81 
 82 /* format: style2,ind3 */
 83 
 84 cm_put:
 85    proc (p_file_opening_id, p_collection_id, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available,
 86         p_code);
 87 
 88 
 89 /* START OF DECLARATIONS */
 90 /* Parameter */
 91 
 92       dcl     p_cm_info_ptr          ptr;
 93       dcl     p_ci_buffer_ptr        ptr;
 94       dcl     p_file_opening_id      bit (36) aligned;
 95       dcl     p_collection_id        bit (36) aligned;
 96       dcl     p_element_length       fixed bin (35);
 97       dcl     p_element_ptr          ptr;
 98       dcl     p_element_id           bit (36) aligned;
 99       dcl     p_maximum_space_available
100                                      fixed bin (35);
101       dcl     p_code                 fixed bin (35);
102 
103 /* Automatic */
104 
105       dcl     1 automatic_bci_header aligned like bci_header;
106       dcl     element_length_in_bits fixed bin (35);
107       dcl     is_buffered            bit (1) aligned init ("0"b);
108 
109 /* Based */
110 /* Builtin */
111 
112       dcl     (addr, null, unspec)   builtin;
113 
114 /* Controlled */
115 /* Constant */
116 
117       dcl     myname                 init ("cm_put") char (32) varying int static options (constant);
118 
119 /* Entry */
120 
121       dcl     sub_err_               entry () options (variable);
122 
123 /* External */
124 
125       dcl     dm_error_$unimplemented_esm
126                                      ext fixed bin (35);
127       dcl     error_table_$unimplemented_version
128                                      ext fixed bin (35);
129 
130 
131 /* END OF DECLARATIONS */
132 ^L
133       unspec (automatic_bci_header) = "0"b;
134       bci_header_ptr = addr (automatic_bci_header);
135 
136       goto NO_INFO_JOIN;
137 
138 buffered:
139    entry (p_ci_buffer_ptr, p_file_opening_id, p_collection_id, p_element_ptr, p_element_length, p_element_id,
140         p_maximum_space_available, p_code);
141 
142       is_buffered = "1"b;
143       bci_header_ptr = p_ci_buffer_ptr;
144 
145 NO_INFO_JOIN:
146       call cm_opening_info$get (p_file_opening_id, p_collection_id, cm_info_ptr, p_code);
147       if p_code ^= 0
148       then return;
149 
150       goto JOIN;
151 
152 
153 info:
154    entry (p_cm_info_ptr, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available, p_code);
155 
156       cm_info_ptr = p_cm_info_ptr;
157       unspec (automatic_bci_header) = "0"b;
158       bci_header_ptr = addr (automatic_bci_header);
159 
160       goto JOIN;
161 
162 /********************* Not yet used. ********************
163 
164 buffered_info:
165    entry (p_cm_info_ptr, p_ci_buffer_ptr, p_element_ptr, p_element_length, p_element_id, p_maximum_space_available,
166       p_code);
167 
168       is_buffered = "1"b;
169       cm_info_ptr = p_cm_info_ptr;
170       bci_header_ptr = p_ci_buffer_ptr;
171 
172       goto JOIN;
173 
174 ************************************************************ */
175 %page;
176 
177 JOIN:
178       call CHECK_VERSION ("cm_info", cm_info.version, CM_INFO_VERSION_2);
179 
180       collection_header_ptr = cm_info.header_ptr;
181 
182       call CHECK_VERSION ("collection_header", collection_header.version, COLLECTION_HEADER_VERSION_2);
183 
184       p_code = 0;
185       p_maximum_space_available = -1;
186 
187       element_id_string = p_element_id;
188 
189       if collection_header.flags.fixed_size_elements
190       then element_length_in_bits = collection_header.maximum_element_size;
191       else element_length_in_bits = p_element_length;
192 
193       if collection_header.element_storage_method = ORDERED_ELEMENT_STORAGE_METHOD
194       then if is_buffered
195            then call cm_put_ordered_element$buffered (cm_info_ptr, bci_header_ptr, element_length_in_bits, p_element_ptr,
196                      element_id_string, p_maximum_space_available, p_code);
197            else call cm_put_ordered_element (cm_info_ptr, bci_header_ptr, element_length_in_bits, p_element_ptr,
198                      element_id_string, p_maximum_space_available, p_code);
199 
200       else if is_buffered
201       then call sub_err_ (dm_error_$unimplemented_esm, myname, ACTION_CANT_RESTART, null, 0,
202                 "Buffered element allocation is not supported for collections using the^/Basic element storage method.");
203       else call cm_put_basic_element (cm_info_ptr, bci_header_ptr, element_length_in_bits, p_element_ptr,
204                 element_id_string, p_maximum_space_available, p_code);
205 
206 
207       if p_code = 0
208       then p_element_id = element_id_string;
209 
210 
211       return;                                               /* Effective end of cm_put */
212 
213 %page;
214 CHECK_VERSION:
215    proc (p_structure_name, p_given_version, p_correct_version);
216 
217       dcl     p_structure_name       char (*);
218       dcl     p_given_version        char (8) aligned;
219       dcl     p_correct_version      char (8) aligned;
220 
221       if p_given_version ^= p_correct_version
222       then call sub_err_ (error_table_$unimplemented_version, myname, ACTION_CANT_RESTART, null, 0,
223                 "^/Expected version ""^8a"" of ^a structure; received ""^8a"".", p_correct_version, p_structure_name,
224                 p_given_version);
225 
226       return;
227 
228    end CHECK_VERSION;
229 %page;
230 %include dm_cm_info;
231 %page;
232 %include dm_cm_basic_ci;
233 %page;
234 %include dm_cm_collection_header;
235 %page;
236 %include dm_esm_info;
237 %page;
238 %include dm_element_id;
239 %page;
240 %include dm_cm_entry_dcls;
241 %page;
242 %include sub_err_flags;
243 
244    end cm_put;