1 /* ***********************************************************
  2    *                                                         *
  3    *                                                         *
  4    * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  5    *                                                         *
  6    *                                                         *
  7    *********************************************************** */
  8 
  9 /* ******************************************************
 10    *                                                    *
 11    *                                                    *
 12    * Copyright (c) 1972 by Massachusetts Institute of   *
 13    * Technology and Honeywell Information Systems, Inc. *
 14    *                                                    *
 15    *                                                    *
 16    ****************************************************** */
 17 
 18 linus_dtt:
 19      proc (sci_ptr, lcb_ptr);
 20 
 21 
 22 /* DESCRIPTION:
 23 
 24    Temporary tables are defined by calling dsl_define_temp_rel.  This procedure
 25    will  identify  key columns and insert a "*" in the select_info structure as
 26    required.
 27 
 28 
 29 
 30    HISTORY:
 31 
 32    77-06-01 J. C. C. Jagernauth: Initially written.
 33 
 34    80-04-14  Rickie  E.   Brinegar:  Modified  to  use  a  work area defined on
 35    lcb.linus_area_ptr instead of getting system free area.
 36 
 37    80-12-02 Rickie E.  Brinegar: Entry points db_on and db_off added.
 38 
 39    81-02-05  Rickie  E.  Brinegar: Changed to check the temporary relation name
 40    against the permanent relation names and to not allow the temporary relation
 41    name to duplicate a permanent relation name.
 42 
 43    81-02-17  Rickie  E.  Brinegar: Added return statement for main entry.  This
 44    had been neglected when the db_(on off) entry points were added.
 45 
 46    81-02-20  Rickie E.  Brinegar: Changed the calls to mdb_display_value_ to be
 47    calls  to  mdb_display_data_value$ptr.   The  latter  allows  more  than 256
 48    characters to be displayed.
 49 
 50    81-07-15 Rickie E. Brinegar: Removed useless cleanup condition handler.
 51 
 52    81-10-09 Rickie E.  Brinegar: Modified to look for a the key attribute name
 53    with  a  space  concatenated on the end of it to guarantee that it does not
 54    put  the astericks in the middle of another string.  This is in response to
 55    TR11720.
 56 
 57    81-11-13 Rickie E. Brinegar: Added the timing of the dsl entries.
 58 
 59    82-02-10 Paul W. Benjamin: ssu_ conversion
 60 
 61    83-08-30  Bert Moberg:  Added call to linus_translate_query$auto if no current
 62    select expression is available
 63 
 64 */
 65 ^L
 66 %include linus_lcb;
 67 %page;
 68 %include linus_char_argl;
 69 %page;
 70 %include linus_select_info;
 71 %page;
 72 %include linus_arg_list;
 73 %page;
 74 %include mdbm_arg_list;
 75 %page;
 76 %include linus_temp_tab_names;
 77 ^L
 78           dcl     sci_ptr                ptr;               /* for ssu_ */
 79 
 80           dcl     KEY                    char (1) options (constant) int static init ("*");
 81 
 82           dcl     sel_items              char (select_info.sel_items_len)
 83                                          based (select_info.sel_items_ptr);
 84           dcl     table_name             char (char_argl.arg.arg_len (1))
 85                                          based (char_argl.arg.arg_ptr (1));
 86           dcl     temp_char              char (mrds_data_$max_token_size + 1) varying;
 87           dcl     tmp_char               char (char_argl.arg.arg_len (i))
 88                                          based (char_argl.arg.arg_ptr (i));
 89 
 90           dcl     1 arg_len_bits         based,
 91                     2 pad                bit (12) unal,
 92                     2 length             bit (24);          /* Length of argument for arg_list */
 93 
 94           dcl     (test, val_key)        bit (1);
 95 
 96           dcl     debug_switch           bit (1) int static init ("0"b);
 97 
 98           dcl     (
 99                   e_ptr                  init (null),
100                   env_ptr                init (null),
101                   rslt_ptr               init (null)
102                   )                      ptr;
103 
104           dcl     (addr, char, fixed, index, length, null, rel, rtrim, substr, vclock)
105                                          builtin;
106 
107           dcl     cleanup                condition;
108 
109           dcl     (code, icode, rel_index, out_code) fixed bin (35);
110 
111           dcl     (curr_pos, desc, i, l) fixed bin;
112 
113           dcl     initial_mrds_vclock    float bin (63);
114 
115           dcl     (
116                   linus_data_$dtt_id,
117                   linus_error_$dtt_key_select,
118                   linus_error_$dtt_max_tabs,
119                   linus_error_$dtt_no_key,
120                   linus_error_$dtt_not_valid,
121                   linus_error_$no_db,
122                   linus_error_$no_input_arg,
123                   linus_error_$table_exist,
124                   mrds_data_$max_temp_rels,
125                   mrds_data_$max_token_size,
126                   mrds_error_$undef_rel,
127                   sys_info$max_seg_size
128                   )                      fixed bin (35) ext;
129 
130           dcl     cu_$generate_call      entry (entry, ptr);
131           dcl     dsl_$define_temp_rel   entry options (variable);
132           dcl     dsl_$get_rslt_info
133                                          entry (fixed bin (35), char (*), ptr, ptr, fixed bin (35));
134           dcl     ioa_                   entry options (variable);
135           dcl     linus_convert_code     entry (fixed bin (35), fixed bin (35), fixed bin (35));
136           dcl     linus_translate_query$auto       entry (ptr, ptr);
137           dcl     mdb_display_data_value$ptr entry (ptr, ptr);
138           dcl     ssu_$abort_line        entry options (variable);
139           dcl     ssu_$arg_count         entry (ptr, fixed bin);
140           dcl     ssu_$arg_ptr           entry (ptr, fixed bin, ptr, fixed bin (21));
141           dcl     work_area              area (sys_info$max_seg_size) based (lcb.linus_area_ptr);
142 ^L
143           val_key = "0"b;
144           al_ptr, ca_ptr, char_ptr = null;
145 
146           icode, code = 0;
147 
148           if lcb.db_index = 0 then
149                call error (linus_error_$no_db, "");
150           else do;
151                     call ssu_$arg_count (sci_ptr, nargs_init);
152                     if nargs_init = 0
153                     then call error (linus_error_$no_input_arg, "");
154                end;
155           allocate char_argl in (lcb.static_area);
156           on cleanup begin;
157                     if ca_ptr ^= null
158                     then free char_argl;
159                end;
160           do i = 1 to nargs_init;
161                call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i));
162           end;
163           if char_argl.nargs <= 1 then
164                call error (linus_error_$dtt_no_key, "");
165           if lcb.si_ptr = null then call linus_translate_query$auto (sci_ptr, lcb_ptr); /* try translating it */
166           if lcb.si_ptr = null then return; /* No good?  Oh, well */
167           si_ptr = lcb.si_ptr;                              /* Activate select_info structure */
168           if ^select_info.se_flags.val_dtt then
169                call error (linus_error_$dtt_not_valid, "");
170           if lcb.timing_mode then
171                initial_mrds_vclock = vclock;
172           call
173                dsl_$get_rslt_info (lcb.db_index, table_name, lcb.linus_area_ptr,
174                rslt_ptr, icode);
175           if lcb.timing_mode then
176                lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock;
177           if icode = 0 then
178                icode = linus_error_$table_exist;
179           if icode ^= mrds_error_$undef_rel then
180                call error (icode, table_name);
181           do i = 2 to char_argl.nargs;
182                if char_argl.arg_len (i) > mrds_data_$max_token_size then
183                     call
184                          error (linus_error_$dtt_key_select,
185                          "^/" || tmp_char || " is longer than "
186                          || char (mrds_data_$max_token_size) || " characters.");
187                temp_char = rtrim (tmp_char) || " ";
188                curr_pos = 1;
189                test = "0"b;
190                do while (curr_pos <= select_info.sel_items_len & ^test);
191                     curr_pos = index (sel_items, temp_char);
192                     if curr_pos > 0 then do;
193                               curr_pos = curr_pos + length (temp_char) - 2; /* -1 for the added space and
194                                                                 -1 for the add producing a value one to large */
195                               val_key = "1"b;
196                               test = "1"b;
197                               if select_info.sel_items_len > curr_pos then
198                                    sel_items = /* replace the blank following the attribute */
199                                         substr (sel_items, 1, curr_pos) || KEY
200                                         || substr (sel_items, curr_pos + 2);
201                               else sel_items = substr (sel_items, 1, curr_pos) || KEY;
202                          end;
203                     else call error (linus_error_$dtt_key_select, "^/" || tmp_char);
204                end;
205           end;
206 
207           if ^val_key then
208                call error (linus_error_$dtt_key_select, "");
209 
210           rel_index = 0;                                    /* Init for mrds define temp rel */
211           if lcb.ttn_ptr ^= null then do;
212                     ttn_ptr = lcb.ttn_ptr;
213                     do l = 1 to mrds_data_$max_temp_rels;
214                          if temp_tab_names (l) = table_name then
215                               rel_index = l;                /* redefine temporary tables */
216                     end;
217                end;
218           else do;
219                     allocate temp_tab_names in (lcb.static_area);
220                     lcb.ttn_ptr = ttn_ptr;
221                     do i = 1 to mrds_data_$max_temp_rels;
222                          temp_tab_names (i) = "";
223                     end;
224                end;
225           desc = 4 + select_info.nsevals;                   /* There are 4 (+ se_vals) arguments in the call
226            to define temp rel */
227           num_ptrs = desc * 2;                              /* Number of pointers in arg_list */
228           allocate arg_list in (work_area);                 /* System standard arg_list */
229           arg_list.arg_des_ptr (desc) = addr (icode);       /* Pointer to return code */
230           n_chars_init = 1;                                 /* Number to allocate */
231           allocate char_desc in (work_area);                /* Character descriptors */
232 
233           arg_list.arg_des_ptr (num_ptrs) = addr (char_desc.fb_desc);
234                                                             /* Return code descriptor */
235           arg_list.arg_des_ptr (1) = addr (lcb.db_index);   /* Data base index */
236           arg_list.arg_des_ptr (desc + 1) = addr (char_desc.fb_desc);
237                                                             /* Data base index descriptor */
238           arg_list.arg_count, arg_list.desc_count = num_ptrs; /* Initialize argument list header */
239           arg_list.code = 4;
240           arg_list.pad = 0;
241 
242 /* Fill in remainder of arg_list */
243           char_desc.arr.var (1) = addr (select_info.se_len) -> arg_len_bits.length;
244                                                             /* Get length of selection expression */
245           arg_list.arg_des_ptr (2) = select_info.se_ptr;    /* Pointer to selection expression */
246           arg_list.arg_des_ptr (desc + 2) = addr (char_desc.arr (1));
247                                                             /* Selection expression descriptor */
248           arg_list.arg_des_ptr (desc - 1) = addr (rel_index); /* Index returned by define_temp_rel */
249           arg_list.arg_des_ptr (num_ptrs - 1) = addr (char_desc.fb_desc);
250                                                             /* Index descriptor */
251           if select_info.nsevals ^= 0 then
252                do l = 1 to select_info.nsevals;
253                     arg_list.arg_des_ptr (2 + l) = select_info.se_vals.arg_ptr (l);
254                     arg_list.arg_des_ptr (2 + l + desc) = select_info.se_vals.desc_ptr (l);
255                end;
256 
257           if debug_switch then do;
258                     call ioa_ ("Selection expression:");
259                     call
260                          mdb_display_data_value$ptr (select_info.se_ptr,
261                          addr (char_desc.arr (1)));
262                end;
263 
264           if lcb.timing_mode then
265                initial_mrds_vclock = vclock;
266           call cu_$generate_call (dsl_$define_temp_rel, al_ptr); /* Call define_temp_rel */
267           if lcb.timing_mode then
268                lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock;
269           if rel_index > mrds_data_$max_temp_rels then
270                call error (linus_error_$dtt_max_tabs, "");
271           if icode = 0 then
272                temp_tab_names (rel_index) = table_name;     /* Save temporary table name */
273           else call error (icode, "");
274           do i = 2 to char_argl.nargs;
275                if char_argl.arg_len (i) > mrds_data_$max_token_size then
276                     call
277                          error (linus_error_$dtt_key_select,
278                          "^/" || tmp_char || " is longer than "
279                          || char (mrds_data_$max_token_size) || " characters.");
280                temp_char = rtrim (tmp_char) || "*";
281                curr_pos = 1;
282                test = "0"b;
283                curr_pos = index (sel_items, temp_char);
284                if curr_pos > 0 then do;
285                          curr_pos = curr_pos + length (temp_char) - 2; /* -1 for the added "*" and
286                                                                 -1 for the add producing a value one to large */
287                          if select_info.sel_items_len > curr_pos then
288                               sel_items = /* replace the "*" following the attribute */
289                                    substr (sel_items, 1, curr_pos) || " "
290                                    || substr (sel_items, curr_pos + 2);
291                          else sel_items = substr (sel_items, 1, curr_pos) || " ";
292                     end;
293                else call error (linus_error_$dtt_key_select, "^/" || tmp_char);
294           end;
295 
296           if ca_ptr ^= null
297           then free char_argl;
298           return;
299 ^L
300 db_on:
301      entry;
302 
303 /* Usage:
304 
305    linus_dtt$db_on
306 
307    Turns on a switch which cause the value of the current selection
308    expression to be displayed at the terminal.
309 */
310 
311           debug_switch = "1"b;
312           return;
313 ^K
314 db_off:
315      entry;
316 
317 /* Usage:
318 
319    linus_dtt$db_off
320 
321    Turns off the switch shich causes the value of the current
322    selection expression to be displayed at the terminal.
323 */
324 
325           debug_switch = "0"b;
326           return;
327 ^L
328 error:
329      proc (err_code, string);
330 
331           dcl     err_code               fixed bin (35);
332           dcl     string                 char (*);
333 
334           if ca_ptr ^= null
335           then free char_argl;
336           call linus_convert_code (err_code, out_code, linus_data_$dtt_id);
337           call ssu_$abort_line (sci_ptr, out_code, string);
338 
339      end error;
340 
341      end linus_dtt;