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 
 19 linus_dltt:
 20      proc (sci_ptr, lcb_ptr);
 21 
 22 
 23 /* DESCRIPTION:
 24 
 25    Temporary  tables  are  deleted  by  calling  dsl_define_temp_rel  with  the
 26    negative value of the temporary table index.
 27 
 28 
 29 
 30    HISTORY:
 31 
 32    77-06-01 J. C. C. Jagernauth: Initially written.
 33 
 34    80-03-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-03-25 Rickie   E.  Brinegar: Modified from linus_dtt to linus_dltt.
 38 
 39    81-02-03  Rickie  E.   Brinegar: Modified to return a zero return code after
 40    printing  an error message.  This prevents blowing away the user when he/she
 41    attempts to delete a temp table which does not exist.
 42 
 43    81-11-13 Rickie E. Brinegar: Added timing of call to dsl_$define_temp_rel.
 44 
 45    82-02-10 Paul W. Benjamin: ssu_ conversion
 46 
 47 */
 48 ^L
 49 %include linus_lcb;
 50 %page;
 51 %include linus_char_argl;
 52 %page;
 53 %include linus_select_info;
 54 %page;
 55 %include linus_arg_list;
 56 %page;
 57 %include mdbm_arg_list;
 58 %page;
 59 %include linus_temp_tab_names;
 60 ^L
 61           dcl     sci_ptr                ptr;               /* for ssu_ */
 62 
 63           dcl     table_name             char (char_argl.arg.arg_len (1))
 64                                          based (char_argl.arg.arg_ptr (1));
 65 
 66           dcl     (
 67                   e_ptr                  init (null),
 68                   env_ptr                init (null)
 69                   )                      ptr;
 70 
 71           dcl     cleanup                condition;
 72 
 73           dcl     (addr, fixed, null, rel, vclock) builtin;
 74 
 75           dcl     (icode, code, out_code) fixed bin (35);
 76 
 77           dcl     (i, l)                 fixed bin;
 78 
 79           dcl     initial_mrds_vclock    float bin (63);
 80 
 81           dcl     (
 82                   linus_data_$dltt_id,
 83                   linus_error_$no_db,
 84                   linus_error_$no_input_arg,
 85                   linus_error_$no_temp_tables,
 86                   linus_error_$undef_temp_table,
 87                   mrds_data_$max_temp_rels,
 88                   sys_info$max_seg_size
 89                   )                      fixed bin (35) ext;
 90 
 91           dcl     rel_index              fixed bin (35);
 92 
 93           dcl     dsl_$define_temp_rel   entry options (variable);
 94           dcl     linus_convert_code     entry (fixed bin (35), fixed bin (35), fixed bin (35));
 95           dcl     ssu_$abort_line        entry options (variable);
 96           dcl     ssu_$arg_count         entry (ptr, fixed bin);
 97           dcl     ssu_$arg_ptr           entry (ptr, fixed bin, ptr, fixed bin (21));
 98 ^L
 99           ca_ptr = null;
100 
101           icode, code = 0;
102 
103           if lcb.db_index = 0 then
104                call error (linus_error_$no_db, "");
105           else do;
106                     call ssu_$arg_count (sci_ptr, nargs_init);
107                     if nargs_init = 0
108                     then call error (linus_error_$no_input_arg, "");
109                end;
110 
111           rel_index = 0;                                    /* Init for mrds define temp rel */
112           if lcb.ttn_ptr = null then
113                call error (linus_error_$no_temp_tables, "");
114           ttn_ptr = lcb.ttn_ptr;
115           allocate char_argl in (lcb.static_area);
116           on cleanup begin;
117                     if ca_ptr ^= null
118                     then free char_argl;
119                end;
120           do i = 1 to nargs_init;
121                call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i));
122           end;
123           i = 0;
124           do l = 1 to mrds_data_$max_temp_rels while (i = 0);
125                if temp_tab_names (l) = table_name then do;
126                          rel_index = 0 - l;                 /* redefine temporary tables */
127                          i = 1;
128                     end;
129           end;
130           l = l - i;                                        /* If I found it, then I am 1 (or i) beyond where I found it, so adjust */
131           if rel_index ^< 0 | l > mrds_data_$max_temp_rels then
132                call error (linus_error_$undef_temp_table, table_name);
133           if lcb.timing_mode then
134                initial_mrds_vclock = vclock;
135           call dsl_$define_temp_rel (lcb.db_index, "", rel_index, code);
136           if lcb.timing_mode then
137                lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock;
138           if code ^= 0 then
139                call error (code, "");
140           temp_tab_names (l) = "";
141 
142 exit:
143           if ca_ptr ^= null
144           then free char_argl;
145           return;
146 ^L
147 
148 
149 error:
150      proc (err_code, string);
151 
152           dcl     err_code               fixed bin (35);
153           dcl     string                 char (*);
154 
155           if ca_ptr ^= null
156           then free char_argl;
157           call linus_convert_code (err_code, out_code, linus_data_$dltt_id);
158           call ssu_$abort_line (sci_ptr, out_code, string);
159 
160      end error;
161 
162      end linus_dltt;