1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) BULL HN Information Systems Inc., 1990   *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Bull Inc., 1988                *
   6         *                                                         *
   7         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   8         *                                                         *
   9         *********************************************************** */
  10 
  11 
  12 linus_table:
  13    proc;
  14 
  15 /*
  16      This module retrieves the data from the database and loads
  17      it into the "table" for processing by the display request.
  18      The module also keeps information about the current table
  19      in the table_info structure.
  20 
  21      Known Bugs:
  22 
  23      Other Problems:
  24 
  25      History:
  26 
  27      Written - March 1983 - Dave Schimke
  28 
  29 
  30    83-08-30  Bert Moberg:  Added call to linus_translate_query$auto if no current
  31    select expression is available
  32 
  33    83-09-09  Al Dupuis: Added translate_query entrypoint. Took the call to
  34    linus_translate_query$auto from the info entrypoint and added it to the
  35    new entrypoint.
  36 
  37    83-09-19 Al Dupuis: Added get_row entrypoint. This is a simple entrypoint
  38    for requests like write, who need to just have one row retrieved and then
  39    dispose of it when they call back for another row.
  40 
  41    83-09-27 Al Dupuis: Added info_for_store entrypoint. This entrypoint
  42    allocates and fills in the table_info structure for the table named
  43    by the caller.
  44 
  45    83-09-27 Al Dupuis: Added store_row entrypoint. This entrypoint
  46    stores a single row into the table named by the caller.
  47 
  48    84-08-07 John Hergert: Fixed bug in load_table_info that was causing
  49    the value table_info.columns.column_length to be loaded with
  50    seemingly random values when evaluating mrds items.
  51 */
  52 
  53 /****^  HISTORY COMMENTS:
  54   1) change(88-05-09,Dupuis), approve(88-07-13,MCR7905), audit(88-07-14,Blair),
  55      install(88-07-26,MR12.2-1068):
  56      Added an extra check to the code that determined if column names should be
  57      qualified. It was forgetting to check for the case when there were
  58      different row designators used on one table.
  59   2) change(90-04-30,Leskiw), approve(90-10-05,MCR8202),
  60      audit(90-10-11,Bubric), install(90-10-14,MR12.4-1039):
  61      Changed calls to assign_round_ from assign_ so that data is rounded.
  62                                                    END HISTORY COMMENTS */
  63 
  64 
  65 %page;
  66 /* format: style3,ind3 */
  67 /* parameters */
  68       dcl     caller_area_ptr_parm   ptr parm;
  69       dcl     code_parm              fixed bin (35) parm;   /* These parameters are      */
  70       dcl     keep_from_row_parm     fixed bin (35) parm;   /* described at each         */
  71       dcl     lcb_ptr_parm           ptr parm;              /* entry where they are used */
  72       dcl     permanent_table_parm
  73                                      bit (1) aligned parm;
  74       dcl     row_count_specified_parm
  75                                      fixed bin (35) parm;
  76       dcl     row_count_actual_parm
  77                                      fixed bin (35) parm;
  78       dcl     row_value_ptr_parm     ptr unaligned parm;
  79       dcl     sort_info_ptr_parm     ptr parm;
  80       dcl     table_info_ptr_parm    ptr parm;
  81       dcl     table_name_parm        char (30) parm;
  82       dcl     temp_directory_parm    char (168) var parm;
  83 
  84 %skip(3);
  85       lcb_ptr = lcb_ptr_parm;
  86       call ssu_$abort_line (lcb.subsystem_control_info_ptr, 0,
  87          "This is not a valid entrypoint.");
  88 %page;
  89 
  90 async_retrieval:
  91    entry (lcb_ptr_parm,                                     /* input: linus control block */
  92       code_parm);                                           /* output: status code */
  93 
  94 
  95 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  96 /*                                                                                      */
  97 /* This entry point is called by the linus requests that do                             */
  98 /* retrievals from the database: linus_assign_values.pl1,                               */
  99 /* linus_create_list.pl1, linus_eval_set_func.pl1, linus_modify.pl1,                    */
 100 /* linus_print.pl1, linus_report.pl1, and linus_write.pl1.                              */
 101 /* The entry point sets the retrieval indentifier so incremental                        */
 102 /* retrievals can determine that their "-another" selection is                          */
 103 /* no longer valid.                                                                     */
 104 /*                                                                                      */
 105 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 106 
 107       code_parm = 0;
 108       lcb_ptr = lcb_ptr_parm;
 109 
 110       if lcb.table_control_info_ptr = null () then
 111            return;
 112 
 113       call initialize;
 114 
 115       if table_ip = null () then
 116            return;
 117 
 118       table_info.retrieval_identifier, table_control_info.retrieval_id =
 119          table_control_info.retrieval_id + 1;
 120 
 121       return;                                               /* end async_retrieval */
 122 
 123 %page;
 124 db_on:
 125    entry;
 126 
 127 
 128 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 129 /*                                                                                      */
 130 /* This entrypoint turns on a switch which causes the value of                          */
 131 /* the current selection expression to be displayed at the terminal.                    */
 132 /*                                                                                      */
 133 /*    Usage:                                                                            */
 134 /*    linus_table$db_on                                                                 */
 135 /*                                                                                      */
 136 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 137 
 138 
 139       debug_switch = "1"b;
 140       return;
 141 
 142 %page;
 143 db_off:
 144    entry;
 145 
 146 
 147 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 148 /*                                                                                      */
 149 /* This entrypoint turns off the switch which causes the value of                       */
 150 /* the current selection expression to be displayed at the terminal.                    */
 151 /*                                                                                      */
 152 /*    Usage:                                                                            */
 153 /*    linus_table$db_off                                                                */
 154 /*                                                                                      */
 155 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 156 
 157 
 158       debug_switch = "0"b;
 159       return;
 160 
 161 %page;
 162 delete_table:
 163    entry (lcb_ptr_parm,                                     /* input: linus control block */
 164       code_parm);                                           /* output: status code */
 165 
 166 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 167 /*                                                                                      */
 168 /* This entry point deletes the current table. It is called from                        */
 169 /* linus_display to conserve space when the table is known to be                        */
 170 /* invalid and we will need to rebuild it.                                              */
 171 /*                                                                                      */
 172 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 173 
 174 
 175       lcb_ptr = lcb_ptr_parm;
 176       code_parm = 0;
 177 
 178       call initialize;
 179       call cleanup_table;
 180 
 181       code_parm = icode;
 182       return;                                               /* end linus_table_$delete_table */
 183 
 184 %page;
 185 get_row: entry (
 186 
 187           lcb_ptr_parm,       /* input: ptr to linus control block */
 188           row_value_ptr_parm, /* output: packed ptr to the row */
 189           code_parm           /* output: success or failure */
 190               );
 191 
 192           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 193           /*                                                                                        */
 194           /* This entry point gets a single row from the data base and loads it into the table.     */
 195           /* The parm row_value_ptr_parm describes where the row has been placed, and can be used   */
 196           /* with the row_value character string to do substr's to access the individual columns.   */
 197           /* The table_info, table_control_info, and row_ptrs variables below are set to 1 so that  */
 198           /* the newly retrieved row is always placed in the second slot in the table.              */
 199           /*                                                                                        */
 200           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 201 
 202 
 203           lcb_ptr = lcb_ptr_parm;
 204           row_value_ptr_parm = null;
 205           code_parm = 0;
 206 %skip(1);
 207           call initialize;
 208           if select_info.set_fn
 209           then do;
 210                code_parm = mrds_error_$tuple_not_found;
 211                return;
 212           end;
 213           call prepare_to_load_rows;
 214           call retrieve_another;
 215           if icode ^= 0
 216           then do;
 217                code_parm = icode;
 218                return;
 219           end;
 220           table_control_info.current_seg_row_count = 1;
 221           table_info.row_count = 1;
 222           call load_one_row;
 223           row_value_ptr_parm = row_value_p;
 224           row_ptrs.number_of_ptrs_this_seg = 1;
 225 %skip(1);
 226           return;
 227 %page;
 228 info:
 229    entry (lcb_ptr_parm,                                     /* input: pointer to linus control_block */
 230       table_info_ptr_parm,                                  /* output: pointer to the table_info structure */
 231       code_parm);                                           /* output: status code */
 232 
 233 
 234 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 235 /*                                                                                      */
 236 /* This entrypoint is called by the linus_options subroutine to                         */
 237 /* return information on the current state of the display table.                        */
 238 /*                                                                                      */
 239 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 240 
 241 
 242       table_info_ptr_parm = null ();
 243       code_parm, icode = 0;
 244       lcb_ptr = lcb_ptr_parm;
 245 
 246       call initialize;
 247 
 248       if lcb.si_ptr = null then
 249            icode = linus_error_$no_lila_expr_processed;
 250       else
 251          do;
 252             si_ptr = lcb.si_ptr;
 253             call load_table_info;
 254             table_info_ptr_parm = table_control_info.table_info_ptr;
 255          end;
 256 
 257       code_parm = icode;
 258       return;                                               /* end linus_table$info */
 259 %page;
 260 info_for_store: entry (
 261 
 262           lcb_ptr_parm,         /* input: ptr to linus control block */
 263           table_name_parm,      /* input: name of relation */
 264           caller_area_ptr_parm, /* input: ptr to caller specified area */
 265           table_info_ptr_parm,  /* output: points to table_info structure */
 266           code_parm             /* output: success or failure */
 267                      );
 268 %skip(1);
 269 
 270           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 271           /*                                                                                        */
 272           /* This entrypoint is called to provide a table_info structure for a named table. The     */
 273           /* structure store_args is also allocated and filled in for future calls to dsl_$store.   */
 274           /* The caller is responsible for freeing both of these structures when finished with      */
 275           /* them.                                                                                  */
 276           /*                                                                                        */
 277           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 278 %skip(1);
 279           lcb_ptr = lcb_ptr_parm;
 280           work_area_p = caller_area_ptr_parm;
 281 %skip(1);
 282           call load_table_info_for_store (table_name_parm, table_info_ptr_parm, code_parm);
 283 %skip(1);
 284           return;
 285 %page;
 286 new_table:
 287    entry (lcb_ptr_parm,                                     /* input: pointer to linus control block */
 288       temp_directory_parm,                                  /* input: workspace for the table */
 289       permanent_table_parm,                                 /* input: "1"b = permanent */
 290       code_parm /* output: status code */);
 291 
 292 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 293 /*                                                                                      */
 294 /* This entrypoint is called by the display request to initialize                       */
 295 /* the display table. It takes care of:                                                 */
 296 /*     1) initializing the table info                                                   */
 297 /*     2) creating the table                                                            */
 298 /*     3) retrieving the first row from the database                                    */
 299 /*     4) loading the first row into the table                                          */
 300 /*                                                                                      */
 301 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 302 
 303       lcb_ptr = lcb_ptr_parm;
 304       code_parm, icode = 0;
 305 
 306       call initialize;
 307 
 308       table_control_info.temp_directory = temp_directory_parm;
 309       table_control_info.flags.permanent = permanent_table_parm;
 310 
 311       if lcb.si_ptr = null then call linus_translate_query$auto (sci_ptr, lcb_ptr); /* try translating it */
 312       if lcb.si_ptr = null then
 313          do;
 314             icode = linus_error_$no_lila_expr_processed;
 315             goto NEW_TABLE_EXIT;
 316          end;
 317 
 318       si_ptr = lcb.si_ptr;                                  /* select_info */
 319       sci_ptr = lcb.subsystem_control_info_ptr;             /* ssu_ */
 320 
 321       if ^select_info.se_flags.val_ret then
 322          do;
 323             icode = linus_error_$ret_not_valid;
 324             goto NEW_TABLE_EXIT;
 325          end;
 326 
 327       if table_control_info.msf_seg_count ^= 0 then do;
 328             call cleanup_table;
 329             if icode ^= 0 then
 330                  goto NEW_TABLE_EXIT;
 331             call initialize;
 332          end;
 333 
 334       call load_table_info;
 335       if icode ^= 0 then
 336            goto NEW_TABLE_EXIT;
 337 
 338       table_control_info.incremental_retrieval_arg_ptr = null ();
 339       table_info.row_count = 0;
 340       table_control_info.flags.sorted = "0"b;
 341 
 342       if select_info.prior_sf_ptr ^= null then
 343            call linus_eval_set_func (lcb_ptr, select_info.prior_sf_ptr, icode);
 344                                                             /* evaluate prior set functions */
 345       if icode ^= 0 & icode ^= mrds_error_$tuple_not_found then
 346          do;
 347             icode = icode;
 348             goto NEW_TABLE_EXIT;
 349          end;
 350 
 351       if select_info.set_fn                                 /* set function to be applied */ then
 352            call linus_eval_set_func (lcb_ptr, select_info.user_item.item_ptr (1),
 353               icode);
 354       else call retrieve_new;                               /* or retrieve */
 355 
 356       if icode = 0 then
 357          do;
 358             call create_table;
 359 
 360             allocate char_output_string in (work_area) set (char_string_ptr);
 361             table_control_info.char_output_string_ptr = char_string_ptr;
 362             call prepare_to_load_rows;
 363             call load_one_row;
 364          end;
 365 
 366 NEW_TABLE_EXIT:
 367       code_parm = icode;
 368       return;                                               /* end linus_table$new_table */
 369 
 370 %page;
 371 load_rows:
 372    entry (lcb_ptr_parm,                                     /* input: pointer to linus control_block */
 373       row_count_specified_parm,                             /* input: number of rows to load into the display table. */
 374       row_count_actual_parm,                                /* output: actual number of rows loaded into the display table. */
 375       keep_from_row_parm,                                   /* input: (disposable table) discard only rows prior to this row number */
 376       code_parm);                                           /* output: status code */
 377 
 378 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 379 /*                                                                                      */
 380 /* This entrypoint loads N rows into the display table making N                         */
 381 /* retrieves from the database. It is called by the linus_display                       */
 382 /* subroutine.                                                                          */
 383 /*                                                                                      */
 384 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 385 
 386 
 387       lcb_ptr = lcb_ptr_parm;
 388       code_parm, icode, row_count_actual_parm = 0;
 389       row_count_specified = row_count_specified_parm;
 390       keep_from_row = keep_from_row_parm;
 391 
 392       call initialize;
 393 
 394       if select_info.set_fn then
 395          do;                                                /* can only apply set function once */
 396             icode = mrds_error_$tuple_not_found;
 397             goto LOAD_ROWS_EXIT;
 398          end;
 399 
 400       call prepare_to_load_rows;
 401 
 402       do row_index = 1 to row_count_specified while (icode = 0);
 403          call retrieve_another;
 404          if icode = 0 then
 405             do;
 406                call load_one_row;
 407                row_count_actual_parm = row_count_actual_parm + 1;
 408             end;
 409       end;
 410 
 411 LOAD_ROWS_EXIT:
 412       code_parm = icode;
 413       return;                                               /* end linus_table$load_rows */
 414 
 415 %page;
 416 load_table:
 417    entry (lcb_ptr_parm,                                     /* input: pointer to linus control_block */
 418       code_parm);                                           /* output: status code */
 419 
 420 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 421 /*                                                                                      */
 422 /* This entrypoint loads rows into the display table until no more                      */
 423 /* rows are available from the database. It is called by the linus_display              */
 424 /* subroutine.                                                                          */
 425 /*                                                                                      */
 426 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 427 
 428 
 429       lcb_ptr = lcb_ptr_parm;
 430       code_parm, icode = 0;
 431 
 432       call initialize;
 433 
 434       if select_info.set_fn then
 435            goto LOAD_TABLE_EXIT;                            /* can only apply set function once */
 436 
 437       call prepare_to_load_rows;
 438 
 439       do while (icode = 0);
 440          call retrieve_another;
 441          if icode = 0 then
 442               call load_one_row;
 443       end;
 444 
 445 LOAD_TABLE_EXIT:
 446       if icode ^= mrds_error_$tuple_not_found then
 447            code_parm = icode;
 448       return;                                               /* end linus_table$load_table */
 449 
 450 %page;
 451 sort:
 452    entry (lcb_ptr_parm,                                     /* input: pointer to linus control_block */
 453       sort_info_ptr_parm,                                   /* input: how to sort the table */
 454       code_parm);                                           /* output: status code */
 455 
 456 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 457 /*                                                                                      */
 458 /* This entrypoint is called by the display request to sort the current                 */
 459 /* table. It sorts the table by:                                                        */
 460 /* 1) loading the ss_info structure to describe the sort.                               */
 461 /* 2) allocating and loading the sort_input structure to describe the current table.    */
 462 /* 3) allocating the sort output structure for sort_seg_$linus_table.                   */
 463 /* 4) calling sort_seg_$linus_table.                                                    */
 464 /* 5) transforming the sort_output into the row_segs_info structure.                    */
 465 /* 6) freeing the sort_input and sort_output^H structures.                                */
 466 /*                                                                                      */
 467 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 468 
 469       lcb_ptr = lcb_ptr_parm;
 470       sort_info_ptr = sort_info_ptr_parm;
 471       ss_info_ptr, sort_desc_array_ptr, sort_input_ptr, sort_output_ptr = null;
 472       code_parm = 0;
 473 
 474       call initialize;
 475 
 476       if table_control_info.component_ptrs_ptr = null () then
 477          do;
 478             icode = error_table_$no_table;
 479             goto SORT_EXIT;
 480          end;
 481 
 482       ss_field_count = sort_info.number_of_columns_to_sort;
 483       allocate ss_info in (info_area) set (ss_info_ptr);
 484       allocate sort_desc_array in (info_area);
 485 
 486       ss_info.header.version = SS_info_version_1;
 487       ss_info.header.block_size = 1;
 488       ss_info.header.duplicate_mode = SS_duplicates;
 489       ss_info.header.mbz1 = 0;
 490       ss_info.header.delim.type = SS_length;
 491       ss_info.header.delim.number = table_info.row_value_length;
 492 
 493       do item_index = 1 to ss_field_count;
 494          ss_info.field.from.type (item_index) = SS_index;
 495          ss_info.field.from.number (item_index) =
 496             table_info.columns
 497             .column_index (sort_info.columns.number (item_index));
 498          ss_info.field.to.type (item_index) = SS_length;
 499          ss_info.field.to.number (item_index) =
 500             table_info.columns
 501             .column_length (sort_info.columns.number (item_index));
 502 
 503          ss_info.field.modes.descending (item_index) =
 504             sort_info.columns.modes.descending (item_index);
 505          ss_info.field.modes.non_case_sensitive (item_index) =
 506             sort_info.columns.modes.non_case_sensitive (item_index);
 507          desc_ptr = addr (table_info.columns.column_data_type (sort_info.columns.number (item_index)));
 508          sort_desc_array (item_index) = desc_ptr;
 509          ss_info.field.modes.numeric (item_index)
 510             = mdbm_util_$number_data_class (desc_ptr);
 511       end;
 512 
 513       allocate sort_input in (info_area) set (sort_input_ptr);
 514       sort_input.sorted = table_control_info.flags.sorted;
 515       do item_index = 1 to row_segs_info.number_of_seg_ptrs;
 516          sort_input.segment_ptr (item_index) =
 517             row_segs_info.seg_ptr (item_index);
 518       end;
 519       do item_index = 1 to table_control_info.msf_seg_count;
 520          sort_input.component_ptr (item_index) =
 521             component_ptr (item_index);
 522       end;
 523       allocate sort_output in (info_area) set (sort_output_ptr);
 524       do item_index = 1 to sort_output.number_of_segs;
 525          call linus_temp_seg_mgr$get_segment (lcb_ptr, my_name,
 526             table_control_info.temp_directory, temp_ptr, icode);
 527          if icode ^= 0 then
 528             call ssu_$abort_line (icode, "While getting a new row_ptr_seg.");
 529          sort_output.seg_ptr (item_index) = temp_ptr;
 530       end;
 531       call sort_seg_$linus_table (lcb_ptr, my_name, ss_info_ptr,
 532          linus_temp_seg_mgr$get_segment, linus_temp_seg_mgr$release_segment,
 533          table_control_info.temp_directory, sort_input_ptr,
 534          sort_desc_array, sort_output_ptr, icode);
 535       if icode = 0 then
 536          do;
 537             table_control_info.flags.sorted = "1"b;         /* mark this table sorted */
 538 
 539             do item_index = 1 to row_segs_info.number_of_seg_ptrs;
 540                call linus_temp_seg_mgr$release_segment (lcb_ptr, my_name,
 541                   (row_segs_info.seg_ptr (item_index)), icode);
 542             end;
 543             row_segs_info.number_of_seg_ptrs = sort_output.number_of_segs; /* transform output into row_segs_info */
 544             do item_index = 1 to sort_output.number_of_segs;
 545                row_segs_info.seg_ptr (item_index) =
 546                   sort_output.seg_ptr (item_index);
 547             end;
 548          end;
 549       else do item_index = 1 to sort_output.number_of_segs; /* must clean up */
 550             call linus_temp_seg_mgr$release_segment (lcb_ptr, my_name,
 551                (sort_output.seg_ptr (item_index)), icode);
 552          end;
 553 
 554 SORT_EXIT:
 555       if ss_info_ptr ^= null then free ss_info;
 556       if sort_desc_array_ptr ^= null then free sort_desc_array;
 557       if sort_input_ptr ^= null then free sort_input;
 558       if sort_output_ptr ^= null then free sort_output;
 559 
 560       code_parm = icode;
 561       return;                                               /* end linus_table$sort */
 562 
 563 %page;
 564 store_row: entry (
 565 
 566           lcb_ptr_parm,        /* input: ptr to the linus control block */
 567           table_info_ptr_parm, /* input: ptr to the table_info structure */
 568           row_value_ptr_parm,  /* input: ptr to the row value */
 569           code_parm            /* output: success or failure */
 570                 );
 571 %skip(1);
 572           lcb_ptr = lcb_ptr_parm;
 573 
 574           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 575           /*                                                                                        */
 576           /* This entrypoint is called to store a row. The table_info structure used by this        */
 577           /* entrypoint should have been generated earlier by the info_for_store entrypoint.        */
 578           /*                                                                                        */
 579           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 580 
 581 
 582           call store_the_row (table_info_ptr_parm, row_value_ptr_parm, code_parm);
 583 %skip(1);
 584           return;
 585 %page;
 586 terminate:
 587    entry (lcb_ptr_parm,                                     /* input: pointer to linus control_block */
 588       code_parm);                                           /* output: status code */
 589 
 590 
 591 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 592 /*                                                                                      */
 593 /* This entry is called by the linus terminate procedure                                */
 594 /* when a "quit" request or the linus cleanup handler                                   */
 595 /* is executed. It cleans up all table work areas.                                      */
 596 /*                                                                                      */
 597 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 598 
 599 
 600       lcb_ptr = lcb_ptr_parm;
 601       code_parm = 0;
 602 
 603       if lcb.table_control_info_ptr = null then return;
 604 
 605       table_control_ip = lcb.table_control_info_ptr;
 606       table_ip = table_control_info.table_info_ptr;
 607       component_ptrs_p = table_control_info.component_ptrs_ptr;
 608 
 609       if table_ip ^= null then
 610            row_segs_ip = table_info.row_segs_info_ptr;
 611       else row_segs_ip = null;
 612 
 613 
 614       call cleanup_table;
 615 
 616       if table_control_info.info_area_ptr ^= null () then
 617          do;
 618             info_area_p = table_control_info.info_area_ptr;
 619             call release_area_ (info_area_p);
 620             call linus_temp_seg_mgr$release_segment (lcb_ptr, "linus_table$info",
 621                table_control_info.info_area_ptr, icode);
 622          end;
 623 
 624       lcb.table_control_info_ptr = null ();
 625       code_parm = icode;
 626       return;                                               /* end linus_table$terminate */
 627 
 628 %page;
 629 translate_query:
 630    entry (lcb_ptr_parm,                                     /* input: pointer to linus control_block */
 631       table_info_ptr_parm,                                  /* output: pointer to the table_info structure */
 632       code_parm);                                           /* output: status code */
 633 
 634 
 635 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 636 /*                                                                                      */
 637 /* This entrypoint is called by the linus display request to                            */
 638 /* return information on the current state of the display                               */
 639 /* table and to translate the current query.                                            */
 640 /*                                                                                      */
 641 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 642 
 643 
 644       table_info_ptr_parm = null ();
 645       code_parm, icode = 0;
 646       lcb_ptr = lcb_ptr_parm;
 647 
 648       call initialize;
 649 
 650       if lcb.si_ptr = null then call linus_translate_query$auto (sci_ptr, lcb_ptr); /* try translating it */
 651       if lcb.si_ptr = null then
 652            icode = linus_error_$no_lila_expr_processed;
 653       else
 654          do;
 655             si_ptr = lcb.si_ptr;
 656             call load_table_info;
 657             table_info_ptr_parm = table_control_info.table_info_ptr;
 658          end;
 659 
 660       code_parm = icode;
 661       return;                                               /* end linus_table$translate_query */
 662 
 663 %page;
 664 /* internal procedures */
 665 
 666 append_row:
 667    proc;
 668 
 669 /* Do we need another msf component for another row of data? */
 670 /* If this component is full or this is the first call...    */
 671       if (table_control_info.current_seg_row_count >=
 672          table_control_info.max_number_of_rows_per_seg) |
 673          (table_control_info.msf_seg_count = 0)
 674       then call get_next_component;
 675 
 676 /* Now do we have room for another pointer in the current ptr seg? */
 677 
 678       if table_info.row_segs_info_ptr = null then
 679            call load_row_info;                              /* create row info */
 680       else row_segs_ip = table_info.row_segs_info_ptr;
 681 
 682       if row_segs_info.number_of_seg_ptrs = 0 then
 683            call get_ptr_seg (row_ptrs_p);
 684       else row_ptrs_p =
 685               row_segs_info.seg_ptr (row_segs_info.number_of_seg_ptrs);
 686 
 687       if row_ptrs.number_of_ptrs_this_seg
 688          = row_segs_info.max_number_of_ptrs_per_seg then
 689            call get_ptr_seg (row_ptrs_p);                   /* need another seg for ptrs!! */
 690 
 691       row_value_p =
 692          addr (component_value (table_control_info.current_seg_row_count + 1));
 693       row_ptrs.number_of_ptrs_this_seg = row_ptrs.number_of_ptrs_this_seg + 1;
 694       row_ptrs.row_value_ptr (row_ptrs.number_of_ptrs_this_seg) = row_value_p;
 695 
 696    end append_row;
 697 
 698 %page;
 699 calc_len:
 700    proc (descriptor_parm, length_parm);
 701 
 702 /* Calculate the length of a print field given a descriptor */
 703 
 704       dcl     descriptor_parm        bit (36) parm;
 705       dcl     fixed_bin_11_ovrly     fixed bin (11) unal based;
 706       dcl     length_parm            fixed bin (21) parm;
 707 
 708       desc_ptr = addr (descriptor_parm);                    /* Point to descriptor */
 709       prec_len = fixed (descriptor.size.precision);
 710       if mdbm_util_$binary_data_class (desc_ptr) then
 711            length_parm = divide(prec_len, 3, 21) + 5;                 /* binary */
 712       else if mdbm_util_$number_data_class (desc_ptr) then
 713            length_parm = prec_len + 3;                      /* decimal */
 714       else if mdbm_util_$string_data_class (desc_ptr) then
 715            length_parm =
 716               fixed (descriptor.size.scale || descriptor.size.precision);
 717       else length_parm = 20;
 718       if mdbm_util_$number_data_class (desc_ptr) then
 719          do;
 720             if mdbm_util_$fixed_data_class (desc_ptr) then
 721                do;                                          /* fixed */
 722                   scale_len =
 723                      addr (descriptor.size.scale) -> fixed_bin_11_ovrly;
 724                                                             /* get signed scale */
 725                   if (scale_len < 0) | (scale_len > 0 & prec_len < scale_len)
 726                   then length_parm =
 727                           length_parm + ceil (log10 (abs (scale_len)));
 728                                                             /* largest scale will be f-128 to f+127 */
 729                end;
 730             else length_parm = length_parm + 5;             /* float */
 731          end;
 732       if mdbm_util_$complex_data_class (desc_ptr) then
 733            length_parm = length_parm * 2;
 734    end calc_len;
 735 
 736 %page;
 737 create_table:
 738    proc;
 739 
 740       table_control_info.table_msf = unique_chars_ ("0"b) || ".LINUS.table";
 741 
 742       if table_control_info.temp_directory = "" then
 743            table_control_info.temp_directory = get_pdir_ ();
 744 
 745       call msf_manager_$open (table_control_info.temp_directory,
 746          table_control_info.table_msf, table_control_info.fcb_ptr, icode);
 747 
 748       if icode = error_table_$noentry then
 749            icode = 0;
 750       if icode ^= 0 then
 751            call ssu_$abort_line (sci_ptr, icode, "^/While opening ^a>^a",
 752               table_control_info.temp_directory, table_control_info.table_msf);
 753 
 754       table_control_info.current_seg_row_count = 0;
 755       if table_control_info.component_ptrs_ptr = null then
 756          do;                                                /* need to create the structure */
 757             table_control_info.max_number_of_components = ROW_SEG_INCREASE;
 758             allocate component_ptr in (work_area) set (component_ptrs_p);
 759             table_control_info.component_ptrs_ptr = component_ptrs_p;
 760          end;
 761    end create_table;
 762 
 763 %page;
 764 cleanup_table:
 765    proc;
 766 
 767       icode = 0;
 768       table_control_info.current_component_ptr = null;
 769       table_control_info.current_seg_row_count = 0;
 770 
 771       if table_control_info.fcb_ptr ^= null then
 772          do;
 773             call msf_manager_$close (table_control_info.fcb_ptr);
 774             component_ptr (*) = null;
 775             table_control_info.component_ptrs_ptr = null;
 776 
 777             call delete_$path (table_control_info.temp_directory, table_control_info.table_msf, DELETE_SEG_SW, my_name, icode);
 778             if icode ^= 0 then
 779                  call ssu_$print_message (icode, "While deleting table msf");
 780 
 781             table_control_info.msf_seg_count = 0;
 782          end;
 783       if row_segs_ip ^= null then
 784          do;                                                /* clean_up row segs info */
 785             if row_segs_info.number_of_seg_ptrs ^= 0 then
 786                do item_index = 1 to row_segs_info.number_of_seg_ptrs;
 787                   if row_segs_info.seg_ptr (item_index) ^= null then
 788                        call linus_temp_seg_mgr$release_segment (lcb_ptr, my_name,
 789                           (row_segs_info.seg_ptr (item_index)), icode);
 790                   if icode ^= 0 then
 791                        call ssu_$print_message (icode, "While deleting table row seg ptr ^d.", item_index);
 792                end;
 793             table_control_info.row_info_ptr, table_info.row_segs_info_ptr,
 794                row_segs_ip = null;
 795          end;
 796 
 797       if table_control_info.work_area_ptr ^= null () then
 798          do;
 799             work_area_p = table_control_info.work_area_ptr;
 800             call release_area_ (work_area_p);
 801             call linus_temp_seg_mgr$release_segment (lcb_ptr, my_name,
 802                table_control_info.work_area_ptr, icode);
 803             if icode ^= 0 then
 804                  call ssu_$print_message (icode, "While releasing table work area.");
 805          end;
 806 
 807    end cleanup_table;
 808 
 809 %page;
 810 get_next_component:
 811    proc;
 812       if table_control_info.msf_seg_count + 1 >
 813          table_control_info.max_number_of_components then do; /* need to expand the structure */
 814             table_control_info.max_number_of_components =
 815                ROW_SEG_INCREASE + table_control_info.msf_seg_count;
 816             allocate new_component_ptr in (work_area) set (new_component_ptrs_p);
 817             new_component_ptrs_p -> component_ptr = component_ptr;
 818             table_control_info.component_ptrs_ptr,
 819                component_ptrs_p = new_component_ptrs_p;
 820          end;
 821 
 822       call msf_manager_$get_ptr (table_control_info.fcb_ptr,
 823          table_control_info.msf_seg_count, CREATE,
 824          table_control_info.current_component_ptr, bit_count, icode);
 825                                                             /* actually getting the (seg_count - 1)th component (1st seg is 0) */
 826 
 827       if icode ^= 0 then
 828            call ssu_$abort_line (sci_ptr, icode,
 829               "^/While creating ^[a component of ^]^a>^a", (table_control_info.msf_seg_count > 0),
 830               table_control_info.temp_directory, table_control_info.table_msf);
 831 
 832       table_control_info.msf_seg_count =
 833          table_control_info.msf_seg_count + 1;
 834       component_ptr (table_control_info.msf_seg_count) =
 835          table_control_info.current_component_ptr;
 836       table_control_info.current_seg_row_count = 0;
 837 
 838    end get_next_component;
 839 
 840 %page;
 841 get_ptr_seg:
 842    proc (seg_ptr_parm);
 843       dcl     seg_ptr_parm           ptr parm;
 844 
 845       call linus_temp_seg_mgr$get_segment (lcb_ptr, my_name,
 846          table_control_info.temp_directory, seg_ptr_parm, icode);
 847       if icode ^= 0 then
 848            call ssu_$abort_line (icode, "While getting a new row_ptr_seg.");
 849 
 850       if row_segs_info.number_of_seg_ptrs = row_segs_info.max_number_of_seg_ptrs
 851       then call load_row_info;                              /* need to grow structure */
 852 
 853       row_segs_info.number_of_seg_ptrs = row_segs_info.number_of_seg_ptrs + 1;
 854       row_segs_info.seg_ptr (row_segs_info.number_of_seg_ptrs) = seg_ptr_parm;
 855       seg_ptr_parm -> row_ptrs.number_of_ptrs_this_seg = 0;
 856    end get_ptr_seg;
 857 
 858 %page;
 859 initialize:
 860    proc;
 861 
 862 
 863 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 864 /*                                                                                      */
 865 /* Make sure everything is ready. Set automatic pointers and                            */
 866 /* initialize common structures.                                                        */
 867 /*                                                                                      */
 868 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 869 
 870 
 871       sci_ptr = lcb.subsystem_control_info_ptr;
 872       if lcb.table_control_info_ptr = null () then
 873          do;                                                /* init control structure */
 874             allocate table_control_info in (lcb.static_area)
 875                set (table_control_ip);
 876 
 877             lcb.table_control_info_ptr = table_control_ip;
 878          end;
 879       else table_control_ip = lcb.table_control_info_ptr;
 880 
 881       work_area_p = table_control_info.work_area_ptr;
 882       if work_area_p = null () then
 883          do;
 884             call linus_temp_seg_mgr$get_segment (lcb_ptr, my_name,
 885                table_control_info.temp_directory, work_area_p, icode);
 886             if icode ^= 0 then
 887                  call ssu_$abort_line (sci_ptr, icode,
 888                     "While getting table work area temp seg.");
 889             call mdbm_util_$mu_define_area (work_area_p, (sys_info$max_seg_size),
 890                "work_area", EXTENSIBLE, NO_FREEING, NO_ZERO_ON_ALLOC,
 891                NO_ZERO_ON_FREE, icode);
 892             if icode ^= 0 then
 893                  call ssu_$abort_line (sci_ptr, icode,
 894                     "While getting table work area.");
 895             table_control_info.work_area_ptr = work_area_p;
 896          end;
 897 
 898       info_area_p = table_control_info.info_area_ptr;
 899       if info_area_p = null () then
 900          do;
 901             call linus_temp_seg_mgr$get_segment (lcb_ptr, "linus_table$info",
 902                table_control_info.temp_directory, info_area_p, icode);
 903             if icode ^= 0 then
 904                  call ssu_$abort_line (sci_ptr, icode,
 905                     "While getting table info area temp seg.");
 906             call mdbm_util_$mu_define_area (info_area_p, (sys_info$max_seg_size),
 907                "table.info", EXTENSIBLE, FREEING, NO_ZERO_ON_ALLOC,
 908                NO_ZERO_ON_FREE, icode);
 909             if icode ^= 0 then
 910                  call ssu_$abort_line (sci_ptr, icode,
 911                     "While getting table info area.");
 912             table_control_info.info_area_ptr = info_area_p;
 913          end;
 914 
 915       table_ip = table_control_info.table_info_ptr;
 916       if table_ip ^= null then
 917            row_segs_ip = table_info.row_segs_info_ptr;
 918       else row_segs_ip = null;
 919       component_ptrs_p = table_control_info.component_ptrs_ptr;
 920 
 921       si_ptr = lcb.si_ptr;                                  /* select_info ptr */
 922    end initialize;
 923 
 924 %page;
 925 load_one_row:
 926    proc;
 927 
 928       call append_row;                                      /* adjust row_ptr */
 929 
 930       do item_index = 1 to table_info.column_count;
 931          char_output_string = "";
 932          if ^select_info.set_fn & select_info.user_item.item_type (item_index) = MRDS then
 933             do;
 934                user_item_ptr = select_info.user_item.item_ptr (item_index);
 935                                                             /* init user item structure */
 936 
 937                call assign_round_ (char_string_ptr, target_type,
 938                   (table_info.columns.column_length (item_index)),
 939                   user_item.arg_ptr, user_item.assn_type, user_item.assn_len);
 940             end;
 941 
 942          else
 943             do;                                             /* Evaluate expression */
 944                if select_info.user_item.item_type (item_index) = EXPR then
 945                   do;
 946                      call linus_eval_expr (lcb_ptr,
 947                         select_info.user_item.item_ptr (item_index), si_ptr,
 948                         caller, item_index, icode);
 949                      if icode ^= 0 then
 950                           return;
 951                   end;
 952 
 953                if mdbm_util_$number_data_class (
 954                   addr (select_info.user_item.rslt_desc (item_index))) then
 955                   do;                                       /* this is really an expr
 956                                                                -- not char or string scalar function */
 957                      if mdbm_util_$complex_data_class (
 958                         addr (select_info.user_item.rslt_desc (item_index)))
 959                      then call assign_round_ (expr_results_ptr, cmpx_float_dec_type,
 960                              float_dec_len,
 961                              select_info.user_item.rslt_assn_ptr (item_index),
 962                              select_info.user_item.rslt_assn_type (item_index),
 963                              select_info.user_item.rslt_assn_len (item_index));
 964 
 965                      else call assign_round_ (expr_results_ptr, float_dec_type,
 966                              float_dec_len,
 967                              select_info.user_item.rslt_assn_ptr (item_index),
 968                              select_info.user_item.rslt_assn_type (item_index),
 969                              select_info.user_item.rslt_assn_len (item_index));
 970 
 971                      call ioa_$rsnnl (IOARS_STRING, char_output_string, (0),
 972                         expr_results);                      /* convert to a character string */
 973                   end;
 974                else /* output result of non-arithmetic scalar function */
 975                     call assign_round_ (char_string_ptr, target_type,
 976                        (table_info.columns.column_length (item_index)),
 977                        select_info.user_item.rslt_assn_ptr (item_index),
 978                        select_info.user_item.rslt_assn_type (item_index),
 979                        select_info.user_item.rslt_assn_len (item_index));
 980 
 981             end;
 982          substr (row_value, table_info.columns (item_index).column_index,
 983             table_info.columns (item_index).column_length) = char_output_string;
 984       end;
 985       table_info.row_count = table_info.row_count + 1;
 986       table_control_info.current_seg_row_count =
 987          table_control_info.current_seg_row_count + 1;
 988 
 989    end load_one_row;
 990 
 991 %page;
 992 load_row_info:
 993    proc;
 994       if table_info.row_segs_info_ptr = null then
 995          do;                                                /* need to create the row info structure */
 996             rsi_init_max_number_of_seg_ptrs = ROW_SEG_INCREASE;
 997             allocate row_segs_info in (work_area) set (row_segs_ip);
 998             table_info.row_segs_info_ptr = row_segs_ip;
 999             row_segs_info.max_number_of_ptrs_per_seg =
1000                sys_info$max_seg_size - 1;
1001             row_segs_info.number_of_seg_ptrs = 0;
1002          end;
1003 
1004       else
1005          do;                                                /* need to expand the row info structure */
1006             rsi_init_max_number_of_seg_ptrs,
1007                row_segs_info.max_number_of_seg_ptrs =
1008                ROW_SEG_INCREASE + row_segs_info.number_of_seg_ptrs;
1009             allocate new_row_segs_info in (work_area) set (new_row_segs_ip);
1010             new_row_segs_ip -> row_segs_info = row_segs_info;
1011             row_segs_ip, table_info.row_segs_info_ptr = new_row_segs_ip;
1012          end;
1013       table_control_info.row_info_ptr = row_segs_ip;        /* save for synchronization over table_info reinitialization */
1014    end load_row_info;
1015 
1016 %page;
1017 load_table_info:
1018    proc;
1019 
1020 /* Is the old table information still valid? */
1021 
1022       if table_control_info.table_info_ptr ^= null () then
1023            if table_control_info.selection_expression_identifier
1024               = lcb.selection_expression_identifier then
1025                 return;
1026 
1027 /* No, we need to calculate and load table_info. */
1028 /* Get a new table_info structure. */
1029 
1030       if table_control_info.table_info_ptr ^= null then
1031            free table_info;
1032       ti_init_column_count = select_info.n_user_items;
1033       allocate table_info in (info_area) set (table_ip);
1034       table_control_info.table_info_ptr = table_ip;         /* save the ptr */
1035 
1036 /* initialization */
1037 
1038       expression_count = 0;
1039       linus_rel_array_ptr = lcb.rel_array_ptr;
1040 
1041 /* init table_info */
1042 
1043       table_info.retrieval_identifier, table_control_info.retrieval_id =
1044          table_control_info.retrieval_id + 1;
1045       table_info.row_segs_info_ptr = table_control_info.row_info_ptr;
1046 
1047       table_info.maximum_column_value_length = 1;
1048       table_info.maximum_column_name_length = 0;
1049       table_info.columns.column_name = "";
1050       table_info.store_args_ptr = null;
1051 
1052 /* Try to set unique names for each MRDS item */
1053 /* If more than 1 table (relation) is selected, include the table name. */
1054 
1055       if linus_rel_array.num_of_rels > 1 | select_uses_different_row_designators () then
1056          do row_index = 1 to table_info.column_count;
1057             if (select_info.user_item.item_type (row_index) = MRDS) then
1058                  table_info.columns.column_name (row_index) =
1059                     rtrim (select_info.user_item.table_name (row_index))
1060                     || "." || select_info.user_item.name (row_index);
1061          end;
1062 
1063 /* Fill in the rest of the column specific data. */
1064 
1065       do item_index = 1 to table_info.column_count;         /* column data */
1066          if ^select_info.set_fn & select_info.user_item.item_type (item_index) = MRDS then
1067             do;                                             /* MRDS item */
1068 
1069                if (table_info.columns.column_name (item_index) = "") then
1070                     table_info.columns.column_name (item_index) =
1071                        select_info.user_item.name (item_index);
1072 
1073                user_item_ptr = select_info.user_item.item_ptr (item_index);
1074                call calc_len ((user_item.desc),
1075                   table_info.columns.column_length (item_index));
1076 
1077                table_info.columns.column_data_type (item_index) =
1078                   user_item.desc;
1079             end;
1080 
1081          else
1082             do;                                             /* Expression or Function */
1083                expression_count = expression_count + 1;
1084                table_info.columns.column_name (item_index) =
1085                   "e" || ltrim (char (expression_count));
1086 
1087                if mdbm_util_$number_data_class (
1088                addr (select_info.user_item.rslt_desc (item_index)))
1089                then do;
1090                     table_info.columns.column_length (item_index) =
1091                          DEFAULT_EXPR_SIZE;
1092                     table_info.columns.column_data_type (item_index) =
1093                          FIXED_DEC_14_3_DESC;
1094                end;
1095                else do;
1096                     table_info.columns.column_length (item_index) =
1097                          select_info.user_item.rslt_assn_len (item_index);
1098                     table_info.columns.column_data_type (item_index) =
1099                          select_info.user_item.rslt_desc (item_index);
1100                end;
1101             end;
1102 
1103          table_info.maximum_column_value_length =
1104             max (table_info.maximum_column_value_length,
1105             table_info.columns.column_length (item_index));
1106          table_info.maximum_column_name_length =
1107             max (table_info.maximum_column_name_length,
1108             length (table_info.columns.column_name (item_index)));
1109          if item_index ^= 1 then
1110               table_info.columns (item_index).column_index =
1111                  table_info.columns (item_index - 1).column_length
1112                  + table_info.columns (item_index - 1).column_index;
1113          else table_info.columns (1).column_index = 1;
1114 
1115       end;                                                  /* column data */
1116 
1117 /* If duplicates from the same table exist, add numeric suffixes. */
1118 
1119       do row_index = 1 to table_info.column_count;
1120          do item_index = row_index + 1 to table_info.column_count;
1121             duplicate_count = 1;
1122             if (table_info.columns.column_name (row_index)
1123                = table_info.columns.column_name (item_index)) then
1124                do loop_index = 1 to table_info.column_count;
1125                   if (select_info.user_item.name (row_index)
1126                      = select_info.user_item.name (loop_index))
1127                      & (select_info.user_item.table_name (row_index)
1128                      = select_info.user_item.table_name (loop_index)) then
1129                      do;
1130                         table_info.columns.column_name (loop_index) =
1131                            rtrim (table_info.columns.column_name (loop_index))
1132                            || "." || ltrim (char (duplicate_count));
1133                         duplicate_count = duplicate_count + 1;
1134                      end;
1135                end;
1136          end;
1137       end;
1138       table_info.row_value_length = sum (table_info.columns.column_length (*));
1139       table_control_info.max_number_of_rows_per_seg =
1140          divide ((sys_info$max_seg_size * 4), table_info.row_value_length, 10);
1141       table_control_info.selection_expression_identifier =
1142          lcb.selection_expression_identifier;
1143    end load_table_info;
1144 %page;
1145 load_table_info_for_store: proc (
1146 
1147           ltifs_table_name_parm,     /* input: name of table for info */
1148           ltifs_table_info_ptr_parm, /* output: points to table_info structure */
1149           ltifs_code_parm            /* output: success or failure */
1150                                 );
1151 %skip(1);
1152 dcl ltifs_code_parm fixed bin (35) parm;
1153 dcl ltifs_current_index fixed bin (21);
1154 dcl ltifs_found_the_relation bit (1) aligned;
1155 dcl ltifs_loop fixed bin;
1156 dcl ltifs_relation_index fixed bin (35);
1157 dcl ltifs_table_name char (30);
1158 dcl ltifs_table_name_parm char (30) parm;
1159 dcl ltifs_table_info_ptr_parm ptr parm;
1160 %skip(1);
1161           ltifs_table_name = ltifs_table_name_parm;
1162           ltifs_table_info_ptr_parm = null;
1163           ltifs_code_parm = 0;
1164 %skip(1);
1165           if lcb.db_index = 0
1166           then do;
1167                ltifs_code_parm = linus_error_$no_db;
1168                return;
1169           end;
1170 %skip(1);
1171           if lcb.timing_mode
1172           then initial_vclock = vclock;
1173 %skip(1);
1174           call dsl_$get_rslt_info (lcb.db_index, ltifs_table_name,
1175                work_area_p, rslt_ptr, ltifs_code_parm);
1176           if ltifs_code_parm ^= 0
1177           then do;
1178                ltifs_found_the_relation = "0"b;
1179                if lcb.ttn_ptr ^= null
1180                then do;
1181                     ttn_ptr = lcb.ttn_ptr;
1182                     do ltifs_loop = 1 to mrds_data_$max_temp_rels
1183                          while (^ltifs_found_the_relation);
1184                          if ltifs_table_name = temp_tab_names (ltifs_loop)
1185                          then do;
1186                               ltifs_found_the_relation = "1"b;
1187                               ltifs_relation_index = ltifs_loop;
1188                          end;
1189                     end;
1190                end;
1191                if ltifs_found_the_relation
1192                then call dsl_$get_temp_info (lcb.db_index, ltifs_relation_index,
1193                     work_area_p, rslt_ptr, ltifs_code_parm);
1194                else;
1195           end;
1196 %skip(1);
1197           if lcb.timing_mode
1198           then lcb.mrds_time = lcb.mrds_time + vclock - initial_vclock;
1199           if ltifs_code_parm ^= 0
1200           then return;
1201 %skip(1);
1202           ti_init_column_count = rslt_info.num_attr;
1203           allocate table_info in (work_area) set (table_ip);
1204           table_info.retrieval_identifier = 0;
1205           table_info.row_count = 0;
1206           table_info.row_segs_info_ptr = null;
1207           table_info.store_args_ptr = null;
1208 %skip(1);
1209           table_info.maximum_column_name_length = 0;
1210           table_info.maximum_column_value_length = 0;
1211           table_info.row_value_length = 0;
1212           ltifs_current_index = 1;
1213 %skip(1);
1214           do ltifs_loop = 1 to ti_init_column_count;
1215                table_info.columns.column_name (ltifs_loop)
1216                     = rtrim (rslt_info.attr (ltifs_loop).attr_name);
1217                table_info.maximum_column_name_length
1218                     = max (length (table_info.columns.column_name (ltifs_loop)),
1219                     table_info.maximum_column_name_length);
1220                table_info.columns.column_data_type (ltifs_loop)
1221                     = rslt_info.attr (ltifs_loop).descriptor;
1222                call calc_len ((table_info.columns.column_data_type (ltifs_loop)),
1223                     table_info.columns.column_length (ltifs_loop));
1224                table_info.maximum_column_value_length
1225                     = max (table_info.columns.column_length (ltifs_loop),
1226                     table_info.maximum_column_value_length);
1227                table_info.row_value_length = table_info.row_value_length
1228                     + table_info.columns.column_length (ltifs_loop);
1229                table_info.columns.column_index (ltifs_loop) = ltifs_current_index;
1230                ltifs_current_index = ltifs_current_index
1231                     + table_info.columns.column_length (ltifs_loop);
1232           end;
1233           free rslt_info;
1234 %skip(1);
1235           /* Add extra args and descriptors for db index, relation name, and error code. */
1236 %skip(1);
1237           arg_list_arg_count = table_info.column_count + 3;
1238           init_number_of_descriptors = arg_list_arg_count;
1239 %skip(1);
1240           allocate store_args in (work_area) set (store_ap);
1241           store_args.table_name = ltifs_table_name;
1242           store_args.header.pad1 = "0"b;
1243           store_args.header.call_type = Interseg_call_type;
1244           store_args.header.desc_count = store_args.header.arg_count;
1245           store_args.header.pad2 = "0"b;
1246 %skip(1);
1247           /* Init descriptors and set db index, table name, and code. */
1248 %skip(1);
1249           unspec (store_args.argument_list_descriptors) = "0"b;
1250           store_args.argument_list_descriptors (*).flag = "1"b;
1251           store_args.argument_list_descriptors (1).type = real_fix_bin_1_dtype;
1252           store_args.argument_list_descriptors (1).size = 35;
1253           store_args.argument_list_descriptors (2).type = char_dtype;
1254           store_args.argument_list_descriptors (2).size = length (store_args.table_name);
1255           store_args.argument_list_descriptors (arg_list_arg_count).type = real_fix_bin_1_dtype;
1256           store_args.argument_list_descriptors (arg_list_arg_count).size = 35;
1257 %skip(1);
1258           /* Fill in arg and desc ptrs for db index, table name, and code. */
1259 %skip(1);
1260           store_args.arg_ptrs (1) = addr (lcb.db_index);
1261           store_args.desc_ptrs (1) = addr (store_args.argument_list_descriptors (1));
1262           store_args.arg_ptrs (2) = addr (store_args.table_name);
1263           store_args.desc_ptrs (2) = addr (store_args.argument_list_descriptors (2));
1264           store_args.arg_ptrs (arg_list_arg_count) = addr (store_args.error_code);
1265           store_args.desc_ptrs (arg_list_arg_count) = addr (store_args.argument_list_descriptors (arg_list_arg_count));
1266 %skip(1);
1267           /* Fill in desc ptrs for column values after setting them.
1268              arg ptrs are filled in when store takes place. */
1269 %skip(1);
1270           do ltifs_loop = 3 to table_info.column_count + 2;
1271                store_args.arg_ptrs (ltifs_loop) = null;
1272                store_args.argument_list_descriptors (ltifs_loop).type = char_dtype;
1273                store_args.argument_list_descriptors (ltifs_loop).size
1274                     = table_info.columns.column_length (ltifs_loop - 2);
1275                store_args.desc_ptrs (ltifs_loop)
1276                     = addr (store_args.argument_list_descriptors (ltifs_loop));
1277           end;
1278 %skip(1);
1279           table_info.store_args_ptr = store_ap;
1280           ltifs_table_info_ptr_parm = table_ip;
1281 %skip(1);
1282           return;
1283 %skip(1);
1284      end load_table_info_for_store;
1285 %page;
1286 prepare_to_load_rows:
1287    proc;
1288       caller = 1;                                           /* for linus_eval_expr */
1289       cmpx_float_dec_type = 24;
1290       arg_descriptor_ptr = addr (FLOAT_DEC_59_DESC);
1291       float_dec_len = arg_descriptor.size;
1292       float_dec_type = 2 * arg_descriptor.type;
1293       expr_results_ptr = addr (expr_results);
1294 
1295       if ^select_info.set_fn then
1296          do;                                                /* extra setup for "-another" */
1297             retrieval_arg_list_ptr = table_control_info.incremental_retrieval_arg_ptr;
1298             retrieve_code_ptr = retrieval_arg_list.arg_ptrs (retrieval_arg_list.arg_count);
1299          end;
1300       char_string_ptr = table_control_info.char_output_string_ptr;
1301 
1302    end prepare_to_load_rows;
1303 
1304 %page;
1305 retrieve_another:
1306    proc;
1307       if lcb.timing_mode then
1308            initial_mrds_vclock = vclock;
1309 
1310       call cu_$generate_call (dsl_$retrieve, retrieval_arg_list_ptr); /* Retrieve "-another" */
1311       icode = retrieve_code;
1312 
1313       if lcb.timing_mode then
1314            lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock;
1315    end retrieve_another;
1316 
1317 %page;
1318 retrieve_new:
1319    proc;
1320 
1321 /* This procedure does the first retrieval from the currently
1322    open  database and sets up for subsequent retrievals using
1323    the "-another" selection expression.  */
1324 
1325 
1326 
1327 /* assure that the arg_list is new */
1328 
1329       n_chars_init = 1;
1330       allocate char_desc in (work_area);
1331       arg_list_arg_count = select_info.n_mrds_items + 3 + select_info.nsevals;
1332                                                             /* Offset for descriptors */
1333       allocate retrieval_arg_list in (work_area) set (retrieval_arg_list_ptr);                      /* System standard argument list */
1334       retrieval_arg_list.header.pad1 = "0"b;
1335       retrieval_arg_list.header.call_type = Interseg_call_type;
1336       retrieval_arg_list.header.desc_count = retrieval_arg_list.arg_count;
1337       retrieval_arg_list.header.pad2 = "0"b;
1338       allocate retrieve_code in (work_area) set (retrieve_code_ptr);
1339                                                             /* Code returned by generated call to dsl_$retrieve */
1340       retrieval_arg_list.arg_ptrs (arg_list_arg_count) = retrieve_code_ptr;
1341       retrieval_arg_list.desc_ptrs (arg_list_arg_count) = addr (char_desc.fb_desc);
1342 
1343                                                             /* DB index */
1344       retrieval_arg_list.arg_ptrs (1) = addr (lcb.db_index);
1345       retrieval_arg_list.desc_ptrs (1) = addr (char_desc.fb_desc);
1346 
1347                                         /* selection expression */
1348       char_desc.arr.var (1) = addr (select_info.se_len) -> arg_len_bits.len;
1349       retrieval_arg_list.arg_ptrs (2) = select_info.se_ptr;
1350       retrieval_arg_list.desc_ptrs (2) = addr (char_desc.arr (1));
1351 
1352 /* Fill in rest of standard arg_list */
1353 
1354 /* First the selection expression values for substitution. */
1355       if select_info.nsevals ^= 0 then
1356          do item_index = 1 to select_info.nsevals;
1357             retrieval_arg_list.arg_ptrs (item_index + 2) =
1358                select_info.se_vals.arg_ptr (item_index);
1359             retrieval_arg_list.desc_ptrs (item_index + 2) =
1360                select_info.se_vals.desc_ptr (item_index);
1361          end;
1362 
1363 /* Then the retrieved attribute values. */
1364       item_index = 1;
1365       do loop_index = 3 + select_info.nsevals
1366          to 2 + select_info.n_mrds_items + select_info.nsevals;
1367                                                             /* Use pointers and descriptors from select_info structure */
1368          retrieval_arg_list.arg_ptrs (loop_index) =
1369             select_info.mrds_item.arg_ptr (item_index);
1370          retrieval_arg_list.desc_ptrs (loop_index) =
1371             addr (select_info.mrds_item.desc (item_index));
1372          if mdbm_util_$varying_data_class (
1373             addr (select_info.mrds_item.desc (item_index))) then
1374             do;
1375                temp_ptr = select_info.mrds_item.arg_ptr (item_index);
1376                retrieval_arg_list.arg_ptrs (loop_index) = addrel (temp_ptr, 1);
1377             end;
1378          item_index = item_index + 1;
1379       end;
1380 
1381       if debug_switch then
1382          do;
1383             call ioa_ ("Selection expression:");
1384             call mdb_display_data_value$ptr (select_info.se_ptr,
1385                addr (char_desc.arr (1)));
1386          end;                                               /* if debug_switch */
1387 
1388       if lcb.timing_mode then
1389            initial_vclock = vclock;
1390 
1391       call cu_$generate_call (dsl_$retrieve, retrieval_arg_list_ptr); /* Call retrieve */
1392       icode = retrieve_code;
1393 
1394       if lcb.timing_mode then
1395            lcb.mrds_time = lcb.mrds_time + vclock - initial_vclock;
1396 
1397 /* Insure that we are now set up for -another processing */
1398 
1399       retrieval_arg_list.arg_ptrs (2) = addr (ANOTHER);
1400       char_desc.arr (1).var = ANOTHER_LEN;
1401 
1402       table_control_info.incremental_retrieval_arg_ptr = retrieval_arg_list_ptr;
1403       table_control_info.incremental_retrieval_char_ptr = char_ptr;
1404       return;
1405    end retrieve_new;
1406 %page;
1407 select_uses_different_row_designators: proc () returns (bit (1) aligned);
1408 
1409 dcl sudrd_loop fixed bin;
1410 
1411       do sudrd_loop = 2 to select_info.n_user_items;
1412            if select_info.user_item.table_name (1) ^= select_info.user_item.table_name (sudrd_loop)
1413            then return ("1"b);
1414       end;
1415 
1416       return ("0"b);
1417 
1418  end select_uses_different_row_designators;
1419 %page;
1420 store_the_row: proc (
1421 
1422           str_table_info_ptr_parm, /* input: ptr to the table_info structure */
1423           str_row_value_ptr_parm,  /* input: ptr to the row value */
1424           str_code_parm            /* output: success or failure */
1425                     );
1426 %skip(1);
1427 dcl str_code_parm fixed bin (35) parm;
1428 dcl str_descriptor_ptr ptr;
1429 dcl str_current_column_number fixed bin;
1430 dcl str_loop fixed bin;
1431 dcl str_row_value char (table_info.row_value_length) based (str_row_value_ptr);
1432 dcl str_row_value_as_an_array (table_info.row_value_length) char (1) based (str_row_value_ptr);
1433 dcl str_row_value_ptr ptr;
1434 dcl str_row_value_ptr_parm ptr unaligned parm;
1435 dcl str_table_info_ptr_parm ptr parm;
1436 %skip(1);
1437           table_ip = str_table_info_ptr_parm;
1438           str_row_value_ptr = str_row_value_ptr_parm;
1439           str_code_parm = 0;
1440           store_ap = table_info.store_args_ptr;
1441 %skip(1);
1442           do str_loop = 3 to table_info.column_count + 2;
1443                str_current_column_number = str_loop - 2;
1444                store_args.arg_ptrs (str_loop) = addr (str_row_value_as_an_array
1445                     (table_info.columns (str_current_column_number).column_index));
1446                str_descriptor_ptr = addr (table_info.columns.column_data_type (str_current_column_number));
1447                if str_descriptor_ptr -> arg_descriptor.type = bit_dtype
1448                then substr (str_row_value,
1449                     table_info.columns.column_index (str_current_column_number),
1450                     table_info.columns.column_length (str_current_column_number))
1451                     = translate (substr (str_row_value,
1452                     table_info.columns.column_index (str_current_column_number),
1453                     table_info.columns.column_length (str_current_column_number)), CHARACTER_ZERO, BLANK);
1454                else if str_descriptor_ptr -> arg_descriptor.type = varying_bit_dtype
1455                     | str_descriptor_ptr -> arg_descriptor.type = varying_char_dtype
1456                     then store_args.argument_list_descriptors (str_loop).size
1457                          = length (rtrim (substr (str_row_value,
1458                          table_info.columns.column_index (str_current_column_number),
1459                          table_info.columns.column_length (str_current_column_number))));
1460                     else;
1461           end;
1462 %skip(1);
1463           call cu_$generate_call (dsl_$store, addr (store_args.header));
1464           str_code_parm = store_args.error_code;
1465 %skip(1);
1466           return;
1467 %skip(1);
1468      end store_the_row;
1469 %skip(1);
1470 ^L
1471 %include access_mode_values;
1472 %page;
1473 %include arg_descriptor;
1474 %page;
1475 %include arg_list;
1476 %page;
1477 %include linus_arg_list;
1478 %page;
1479 %include linus_char_argl;
1480 %page;
1481 %include linus_lcb;
1482 %page;
1483 %include linus_rel_array;
1484 %page;
1485 %include linus_select_info;
1486 %page;
1487 %include linus_sort_info;
1488 %page;
1489 %include linus_table_control;
1490 %page;
1491 %include linus_table_info;
1492 %page;
1493 %include linus_temp_tab_names;
1494 %page;
1495 %include mdbm_descriptor;
1496 %page;
1497 %include mrds_rslt_info;
1498 %page;
1499 %include sort_seg_info;
1500 %page;
1501 %include std_descriptor_types;
1502 ^L
1503 
1504 /* Based */
1505 
1506       dcl     1 arg_len_bits         based,
1507                 2 pad                bit (12) unal,
1508                 2 len                bit (24);              /* Length of argument to be passed in arg_list */
1509       dcl     char_output_string     char (table_info.maximum_column_value_length)
1510                                      based (char_string_ptr) varying;
1511       dcl     component_ptr          (table_control_info.max_number_of_components) ptr based (component_ptrs_p);
1512       dcl     new_component_ptr      (table_control_info.max_number_of_components) ptr based (new_component_ptrs_p);
1513       dcl     component_value        (table_control_info.max_number_of_rows_per_seg)
1514                                      char (table_info.row_value_length)
1515                                      based (table_control_info.current_component_ptr);
1516       dcl     sort_desc_array        (sort_info.number_of_columns_to_sort) ptr based (sort_desc_array_ptr);
1517       dcl     info_area              area (sys_info$max_seg_size) based (info_area_p);
1518       dcl     1 new_row_segs_info    like row_segs_info based (new_row_segs_ip);
1519       dcl     retrieve_code          fixed bin (35) based (retrieve_code_ptr);
1520 
1521       dcl 1 retrieval_arg_list aligned based (retrieval_arg_list_ptr),
1522             2 header like arg_list.header,
1523             2 arg_ptrs (arg_list_arg_count refer (retrieval_arg_list.header.arg_count)) ptr,
1524             2 desc_ptrs (arg_list_arg_count refer (retrieval_arg_list.header.arg_count)) ptr;
1525       dcl retrieval_arg_list_ptr ptr;
1526 
1527       dcl     1 sort_input           aligned based (sort_input_ptr),
1528                 2 number_of_ptr_segments
1529                                      fixed bin,
1530                 2 number_of_components
1531                                      fixed bin,
1532                 2 sorted             bit (1),
1533                 2 segment_ptr        (row_segs_info
1534                                      .number_of_seg_ptrs
1535                                      refer (sort_input.number_of_ptr_segments))
1536                                      ptr unal init (null),
1537                 2 component_ptr      (table_control_info
1538                                      .msf_seg_count
1539                                      refer (sort_input.number_of_components)) ptr
1540                                      unal init (null);
1541 
1542       dcl     1 sort_output          based (sort_output_ptr),
1543                 2 number_of_segs     fixed bin,
1544                 2 seg_ptr            (row_segs_info
1545                                      .number_of_seg_ptrs
1546                                      refer (sort_output.number_of_segs)) ptr unal
1547                                      init (null);
1548 
1549       dcl     1 user_item            aligned based (user_item_ptr), /* valid when mrds item = user item */
1550                 2 arg_ptr            ptr,
1551                 2 bit_len            fixed bin (35),
1552                 2 desc               bit (36),
1553                 2 assn_type          fixed bin,
1554                 2 assn_len           fixed bin (35);
1555       dcl     work_area              area (sys_info$max_seg_size) based (work_area_p);
1556 
1557 /* Automatic */
1558 
1559       dcl     arg_list_arg_count     fixed bin (17) unsigned unaligned;
1560       dcl     bit_count              fixed bin (24);
1561       dcl     caller                 fixed bin;
1562       dcl     char_string_ptr        ptr;
1563       dcl     component_ptrs_p       ptr init (null);
1564       dcl     cmpx_float_dec_type    fixed bin;
1565       dcl     duplicate_count        fixed bin;
1566       dcl     expr_results           float dec (59);
1567       dcl     expr_results_ptr       ptr;
1568       dcl     expression_count       fixed bin;
1569       dcl     float_dec_len          fixed bin (35);
1570       dcl     float_dec_type         fixed bin;
1571       dcl     icode                  fixed bin (35);
1572       dcl     info_area_p            ptr init (null);
1573       dcl     initial_mrds_vclock    float bin (63);
1574       dcl     initial_vclock         float bin (63);
1575       dcl     item_index             fixed bin;
1576       dcl     keep_from_row          fixed bin (35);
1577       dcl     loop_index             fixed bin;
1578       dcl     my_name                char (11) init ("linus_table");
1579       dcl     new_component_ptrs_p
1580                                      ptr init (null);
1581       dcl     new_row_segs_ip        ptr init (null);
1582       dcl     prec_len               fixed bin;
1583       dcl     retrieve_code_ptr      ptr;
1584       dcl     row_count_specified    fixed bin;
1585       dcl     row_index              fixed bin;
1586       dcl     scale_len              fixed bin (11);
1587       dcl     sci_ptr                ptr;                   /* for ssu_ */
1588       dcl     sort_desc_array_ptr    ptr;
1589       dcl     sort_input_ptr         ptr;
1590       dcl     sort_output_ptr        ptr;
1591       dcl     target_type            fixed bin init (44);   /* char * 2 */
1592       dcl     temp_ptr               ptr init (null);
1593       dcl     user_item_ptr          ptr init (null);
1594       dcl     work_area_p            ptr init (null);
1595 
1596 /* Builtins */
1597 
1598       dcl     abs                    builtin;
1599       dcl     addr                   builtin;
1600       dcl     addrel                 builtin;
1601       dcl     ceil                   builtin;
1602       dcl     char                   builtin;
1603       dcl     divide                 builtin;
1604       dcl     fixed                  builtin;
1605       dcl     length                 builtin;
1606       dcl     log10                  builtin;
1607       dcl     ltrim                  builtin;
1608       dcl     max                    builtin;
1609       dcl     null                   builtin;
1610       dcl     rel                    builtin;
1611       dcl     rtrim                  builtin;
1612       dcl     substr                 builtin;
1613       dcl     sum                    builtin;
1614       dcl     translate              builtin;
1615       dcl     unspec                 builtin;
1616       dcl     vclock                 builtin;
1617 
1618 /* Conditions */
1619 
1620 /* Static */
1621 
1622       dcl     debug_switch           bit (1) int static init ("0"b);
1623                                                             /* Constants */
1624 
1625       dcl     ANOTHER                char (8) int static options (constant)
1626                                      init ("-another");
1627       dcl     ANOTHER_LEN            bit (24) init ("000000000000000000001000"b)
1628                                      int static options (constant);
1629       dcl     BLANK                  char (1) internal static options (constant) init (" ");
1630       dcl     CHARACTER_ZERO         char (1) internal static options (constant) init ("0");
1631       dcl     CREATE                 bit (1) int static options (constant) init ("1"b);
1632       dcl     DEFAULT_EXPR_SIZE      fixed bin (5) int static options (constant)
1633                                      init (17);
1634       dcl     DELETE_SEG_SW          bit (6) int static options (constant)
1635                                      init ("100100"b);
1636       dcl     EXPR                   fixed bin (2) int static options (constant)
1637                                      init (2);
1638       dcl     EXTENSIBLE             bit (1) aligned int static options (constant)
1639                                      init ("1"b);
1640       dcl     FIXED_DEC_14_3_DESC    bit (36) int static options (constant)
1641                                      init ("110101110000000000000011000000001110"b);
1642       dcl     FLOAT_DEC_59_DESC      bit (36) int static options (constant)
1643                                      init ("100101000000000000000000000000111011"b);
1644       dcl     FREEING                bit (1) aligned int static options (constant)
1645                                      init ("0"b);
1646       dcl     IOARS_STRING           char (8) int static options (constant) init ("^.3f");
1647       dcl     MRDS                   fixed bin (2) int static options (constant)
1648                                      init (1);
1649       dcl     NO_FREEING             bit (1) aligned int static options (constant)
1650                                      init ("1"b);
1651       dcl     NO_ZERO_ON_ALLOC       bit (1) aligned int static options (constant)
1652                                      init ("0"b);
1653       dcl     NO_ZERO_ON_FREE        bit (1) aligned int static options (constant)
1654                                      init ("0"b);
1655       dcl     ROW_SEG_INCREASE       fixed bin int static options (constant) init (10);
1656 
1657 /* External */
1658 
1659       dcl     error_table_$noentry
1660                                      fixed bin (35) ext;
1661       dcl     error_table_$no_table
1662                                      fixed bin (35) ext;
1663       dcl     linus_error_$no_lila_expr_processed
1664                                      fixed bin (35) ext;
1665       dcl     linus_error_$ret_not_valid
1666                                      fixed bin (35) ext;
1667       dcl     linus_error_$no_db     fixed bin(35) ext static;
1668       dcl     mrds_data_$max_temp_rels
1669                                      fixed bin (35) ext static;
1670       dcl     mrds_error_$tuple_not_found
1671                                      fixed bin (35) ext;
1672       dcl     sys_info$max_seg_size
1673                                      fixed bin (35) ext;
1674 
1675 /* Entries */
1676 
1677       dcl     assign_round_          entry (ptr, fixed bin, fixed bin (35), ptr,
1678                                      fixed bin, fixed bin (35));
1679       dcl     cu_$generate_call      entry (entry, ptr);
1680       dcl     dsl_$get_rslt_info     entry (fixed bin(35), char(*), ptr, ptr, fixed bin(35));
1681       dcl     dsl_$get_temp_info     entry (fixed bin(35), fixed bin(35), ptr, ptr, fixed bin(35));
1682       dcl     dsl_$retrieve          entry options (variable);
1683       dcl     dsl_$store             entry() options(variable);
1684       dcl     get_pdir_              entry () returns (char (168));
1685       dcl     delete_$path           entry (char (*), char (*), bit (6), char (*), fixed bin (35));
1686       dcl     ioa_                   entry options (variable);
1687       dcl     ioa_$rsnnl             entry options (variable);
1688       dcl     linus_eval_expr        entry (ptr, ptr, ptr, fixed bin, fixed bin,
1689                                      fixed bin (35));
1690       dcl     linus_eval_set_func    entry (ptr, ptr, fixed bin (35));
1691       dcl     linus_temp_seg_mgr$get_segment
1692                                      entry (ptr, char (*), char (*), ptr,
1693                                      fixed bin (35));
1694       dcl     linus_temp_seg_mgr$release_segment
1695                                      entry (ptr, char (*), ptr, fixed bin (35));
1696       dcl     linus_translate_query$auto  entry (ptr, ptr);
1697       dcl     mdbm_util_$binary_data_class
1698                                      entry (ptr) returns (bit (1) aligned);
1699       dcl     mdbm_util_$complex_data_class
1700                                      entry (ptr) returns (bit (1) aligned);
1701       dcl     mdbm_util_$fixed_data_class
1702                                      entry (ptr) returns (bit (1) aligned);
1703       dcl     mdbm_util_$number_data_class
1704                                      entry (ptr) returns (bit (1) aligned);
1705       dcl     mdbm_util_$string_data_class
1706                                      entry (ptr) returns (bit (1) aligned);
1707       dcl     mdbm_util_$varying_data_class
1708                                      entry (ptr) returns (bit (1) aligned);
1709       dcl     mdb_display_data_value$ptr
1710                                      entry (ptr, ptr);
1711       dcl     mdbm_util_$mu_define_area
1712                                      entry (ptr, fixed bin (18), char (11),
1713                                      bit (1) aligned, bit (1) aligned, bit (1) aligned,
1714                                      bit (1) aligned, fixed bin (35));
1715       dcl     msf_manager_$close     entry (ptr);
1716       dcl     msf_manager_$get_ptr
1717                                      entry (ptr, fixed bin, bit (1), ptr,
1718                                      fixed bin (24), fixed bin (35));
1719       dcl     msf_manager_$open      entry (char (*), char (*), ptr, fixed bin (35));
1720       dcl     release_area_          entry (ptr);
1721       dcl     sort_seg_$linus_table
1722                                      entry (ptr, char (*), ptr, entry, entry, char (*),
1723                                      ptr, (*) ptr, ptr, fixed bin (35));
1724       dcl     ssu_$abort_line        entry options (variable);
1725       dcl     ssu_$print_message     entry () options (variable);
1726       dcl     unique_chars_          entry (bit (*)) returns (char (15));
1727 
1728    end linus_table;