1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
   4         *                                                         *
   5         * Copyright (c) 1972 by Massachusetts Institute of        *
   6         * Technology and Honeywell Information Systems, Inc.      *
   7         *                                                         *
   8         *********************************************************** */
   9 
  10 
  11 
  12 /****^  HISTORY COMMENTS:
  13   1) change(86-01-13,Dupuis), approve(86-01-13,MCR7188), audit(86-07-23,GWMay),
  14      install(86-07-29,MR12.0-1106):
  15      Added call to ssu_$get_area and ssu_$release_area to have a general
  16      freeing area around for linus work, and renamed sfr_ptr to
  17      force_retrieve_scope_ptr.
  18   2) change(86-01-13,Dupuis), approve(86-05-23,MCR7404), audit(86-07-23,GWMay),
  19      install(86-07-29,MR12.0-1106):
  20      Changed version from 4.4. to 4.5 and removed the blast message. This new
  21      version makes the assign_values, del_scope, list_scope,
  22      list_values, open, and set_scope requests available as active requests.
  23      It also provides a new "opened_database" active request.
  24                                                    END HISTORY COMMENTS */
  25 
  26 
  27 linus:
  28      proc;
  29 
  30 /*  DESCRIPTION:
  31 
  32    This  is  the  top  level  procedure of the LINUS subsystem.  This procedure
  33    does initialization, calls ssu_ to handle the request, and does termination.
  34 
  35 
  36 
  37    HISTORY:
  38 
  39    77-04-01 J. A. Weeldreyer: Initially written.
  40 
  41    78-11-01  J.   C.   C.  Jagernauth: Modified to prevent quote stripping when
  42    modify is requested.
  43 
  44    78-09-01 J. C. C. Jagernauth: Modified for MR7.0.
  45 
  46    80-01-07 Rickie E. Brinegar: Modified to  use linus_invoke$pop_all.
  47 
  48    80-01-28  Rickie  E.   Brinegar:  Modified to return to command level on the
  49    cleanup condition.
  50 
  51    80-04-12  Rickie  E.  Brinegar: Modified to use linus_define_area instead of
  52    get_system_free_area_.
  53 
  54    80-06-01  Jim  Gray:  Modified  to  take out free of variable in non-freeing
  55    area,  and  to  fix  quit handling so that a database open by linus, but not
  56    closed by it, would not blow linus of the water, upon quitting.
  57 
  58    80-10-28 Rickie E. Brinegar: short name cls added to create_list.
  59 
  60    80-10-31 Rickie E. Brinegar: short name dl added to delete.
  61 
  62    80-11-03 Jim Gray: Modified to change delete_$ptr to hcs_$delentry_seg calls
  63    for performance.
  64 
  65    80-11-10  Jim Gray: Modified to change delete_$path to hcs_$del_dir_tree and
  66    hcs_$delentry_file calls in order to improve performance.
  67 
  68    81-02-03  Rickie E.  Brinegar: Modified to use the corrected linus_rel_array
  69    include  file.   The unused declarations of delect_$(path ptr) were removed,
  70    and the rel builtin was added to the declarations.
  71 
  72    81-02-24   Rickie  E.   Brinegar:  Removed  the  linus_set  entry  from  the
  73    declarations   and   set   up   the   LINUS   set   request   to   call  the
  74    linus_assign_values  entry instead of the linus_set entry.  This permits the
  75    set  request  to  make  use  of  the  improvements made to the assign_values
  76    request.
  77 
  78    81-04-10  Rickie  E.   Brinegar:  Changed the linus version number from 2 to
  79    3.0.
  80 
  81    81-04-22  Rickie  E.  Brinegar: In one place, lcb.is_ptr (the pointer to the
  82    input  stream)  was  being  used  instead of lcb.ivs_ptr (the pointer to the
  83    invoke  stack).   This  was  causing  fatal process errors as pointed out in
  84    TR9545.  This has now been corrected.
  85 
  86    81-05-12  Rickie  E.   Brinegar:  Modified the sub_error_ handler to replace
  87    "read_attr",  "modify_attr",  "append_tuple",  and  "delete_tuple" with "r",
  88    "m",  "s",  and  "d"  respectively in sub_error_info.info_string.  This will
  89    keep the scope terminology in LINUS consistent.
  90 
  91    81-07-07  Rickie  E.   Brinegar: Changed calls to release_area_ to calls to
  92    release_temp_segment_.   This  was  done as a result of TR10233.  LINUS and
  93    MRDS were not correctly freeing temporary segments.
  94 
  95    81-07-13 Rickie E. Brinegar: Added a conversion condition trap.
  96 
  97    81-09-17 Rickie E.  Brinegar: Changed the checkin for a token starting with
  98    ".."  to insure that the token was atleast two characters long before doing
  99    a substr.  Corrected the order in which char_argl.nargs is incremented when
 100    processing  the -argument control argument to increment nargs before making
 101    an assignment to the structure that depends on nargs as a limit.
 102 
 103    81-09-28 Davids: modified the  if  statement  that  controled  skipping  of
 104    double  quotes  in  the  get_token proc. Also declared q_flag in that proc.
 105    This stops a subscriptrange condition from sometimes occuring.
 106 
 107    81-11-12  Rickie  E.  Brinegar: Added code to keep track of and display the
 108    virtual  cpu  seconds  used to determine what a request has been asked, how
 109    much  time was spent in executing the request, broken down by how much time
 110    was spent in LINUS and how much time was spent in MRDS.
 111 
 112    82-01-29  David J. Schimke:  Added code to initialize two new variables
 113    (build_increment and build_start) in the linus control block.  This is part
 114    of the implementation of the build mode for lila.
 115 
 116    82-02-04  Paul W. Benjamin:  ssu_ conversion.  Roughly 25% of the code
 117    removed, the functionality being supplied by ssu_.  The invoke request has
 118    been retained.  The intent is to supply an exec_com request as well, but
 119    that implementation is not part of this change.
 120 
 121    82-06-24 Al Dupuis: Added code to place sci_ptr in
 122    lcb.subsystem_control_info_ptr, and call to ssu_$get_invocation_level to
 123    stuff it in lcb.subsystem_invocation_level.
 124 
 125    82-08-26 DJ Schimke: Added code to set report_control_info_ptr and
 126    table_control_info_ptr to null on linus initiation.  Added code to
 127    tidy_up procedure to call linus_table$terminate if table_control_info_ptr
 128    is not null and to call linus_options$terminate if report_control_info_ptr
 129    is not null.
 130 
 131    82-10-18  David J. Schimke:  Added code to replace the ssu_$abort_line
 132    procedure with a linus_abort_line procedure which calls linus_convert_code
 133    before calling the standard abort_line procedure. Also fixed a bug which
 134    left the lcb lying around after linus terminated.
 135 
 136    82-10-27  David J. Schimke:  Modified the way linus controls the iteration
 137    to use the new ssu_$set_request_processor_options.  Deleted the replacement
 138    procedures: execute_line, evaluate_active_string, invoke_request and
 139    unknown_request which were used to implement the original iteration control
 140    under ssu_.  This also changed the way linus turned on the optional abbrev
 141    processing as this feature is also now part of the request processor
 142    options.  Added code to execute a subsystem start_up exec_com using
 143    ssu_$execute_start_up.  Added "-start_up", "-no_startup", "-no_start_up"
 144    and "-ns".
 145 
 146    82-11-10 Al Dupuis: Changed linus version from 4.0 to 4.1. The major changes
 147    made from 4.0 to 4.1 were the inclusion of the report generator, the
 148    self-identify request, and the linus_abort_line procedure.
 149 
 150    83-02-23  David J. Schimke:  Deleted code in tidy_up internal procedure
 151    that tried to free the char_argl and macro_request areas after the lcb was
 152    already deleted. These were both allocated in the lcb.static area. Also
 153    deleted the timer_print call just before the linus exit, since the lcb is
 154    always gone by that time and lcb.timing_mode couldn't be checked anyway.
 155 
 156    83-04-07 DJ Schimke: Added code to set temp_seg_info_ptr to null on linus
 157    initiation and to call linus_temp_seg_mgr$terminate in tidy_up if it is not
 158    null.
 159 
 160    83-04-13 DJ Schimke: Added code to check icode and call com_err_ after calls
 161    to the various termination entry points so errors can be detected.
 162 
 163    83-05-09 DJ Schimke: Added call to requote_string_ to protect command line
 164    macro arguments from quote stripping. This is in response to TR 15139. Also
 165    fixed the calls to com_err_ after termination entrys. The com_err_ calls
 166    were not in do groups so they were reporting the last error redundantly.
 167 
 168 
 169    83-06-06 Bertley G. Moberg:  Added support for -print_search_order and
 170    -no_optimize
 171 
 172    83-06-13 Al Dupuis: Changed linus version from 4.1 to 4.2. The change
 173    made from 4.1 to 4.2 was the inclusion of the report writer display
 174    request's scrolling feature and a call to ssu_$print_blast to announce
 175    new features.
 176 
 177    83-08-18 Al Dupuis: Changed version from 4.2 to 4.3. The chaneg made from
 178    4.2 to 4.3 was the inclusion of new report writer features suggested by
 179    GM and Ford during the report writer controlled release exposure period.
 180 
 181    83-08-26 Al Dupuis: Added code to get a temp segment for storing the
 182    query as it is being passed around between different requests and
 183    subroutines (i.e. qedx, print_query, save_query, linus_get_query,
 184    linus_put_query, etc. Added code to release the temp segment at termination.
 185 
 186    83-10-03 Al Dupuis: Changed version from 4.3 to 4.4. Version 4.4 is the
 187    first version of the report writer that will go to general release, and also
 188    includes the input_query, print_query, etc. requests, as well as the
 189    write_data_file and store_from_data_file requests.
 190 
 191    83-11-04 Al Dupuis: Rewrote the sub_error_ handler.
 192 
 193    84-11-05 Al Dupuis: Added call to ssu_$add_request_table and
 194                        ssu_$add_info_dir.
 195 */
 196 %page;
 197 %include condition_info;
 198 %page;
 199 %include condition_info_header;
 200 ^L
 201 %include linus_lcb;
 202 %page;
 203 %include cp_character_types;
 204 %page;
 205 %include definition;
 206 %page;
 207 %include linus_char_argl;
 208 %page;
 209 %include linus_rel_array;
 210 %page;
 211 %include object_info;
 212 %page;
 213 %include ssu_prompt_modes;
 214 %page;
 215 %include ssu_rp_options;
 216 %page;
 217 %include sub_error_info;
 218 ^L
 219           dcl     sci_ptr                ptr;               /* used in all ssu calls */
 220 
 221           dcl     (
 222                   i,
 223                   j,
 224                   nargs                                     /* no. of args in linus command */
 225                   )                      fixed bin;
 226 
 227           dcl     (
 228                   acc_ptr                init (null),       /* pointer to acc string */
 229                   arg_ptr                init (null),       /* ptr to arg list to request processor */
 230                   ctl_ptr                init (null),
 231                   d_ptr                  init (null),       /* pointer to a defn. block */
 232                   ent_ptr                init (null),       /*  ptr to request processor entry */
 233                   lb_ptr                 init (null),       /* pointer to base of linus_builtin_ */
 234                   ptr_sink               init (null)        /* sink for envir. ptr */
 235                   )                      ptr;
 236 
 237           dcl     code                   fixed bin (35);    /* status code from subroutines */
 238 
 239           dcl     (
 240                   initial_linus_vclock,                     /* keep track of the initial vclock values */
 241                   initial_mrds_vclock
 242                   )                      float bin (63) int static; /* needs changed if linus allows recursion */
 243 
 244           dcl     ab                     bit (1);           /* user wants abbrevs */
 245           dcl     bit18                  bit (18) based;    /* template */
 246           dcl     ctl_arg                char (ctl_len) based (ctl_ptr);
 247           dcl     ctl_len                fixed bin (21);    /* length of control arg */
 248           dcl     dname                  char (168);        /* for calls to expand_pathname_ */
 249           dcl     ename                  char (32);         /*   & hcs_$initiate */
 250           dcl     function_entry         entry variable;
 251           dcl     function_name          char (32) varying;
 252           dcl     highest_numbered_subsystem_invocation fixed bin; /* for call to ssu_, unused at present */
 253           dcl     lb_bc                  fixed bin (24);    /* bit count of builtin seg */
 254           dcl     lb_type                fixed bin (2);     /* seg type code for linus_builtin_ */
 255           dcl     macro_request          char (macro_rq_len) based (macro_rq_ptr); /* macro request string */
 256           dcl     macro_rq_len           fixed bin (21);    /* length of macro request string */
 257           dcl     macro_rq_ptr           ptr;               /* pointer to macro request string */
 258           dcl     pf_arg_len             fixed bin (21);    /* length of profile arg */
 259           dcl     pf_arg_ptr             ptr;               /* ptr to profile arg */
 260           dcl     req_buf                char (linus_data_$req_buf_len); /* the request buffer */
 261           dcl     rq_arg_len             fixed bin (21);    /* length of request arg */
 262           dcl     rq_arg_ptr             ptr;               /* ptr to request arg */
 263           dcl     start_up               bit (1);           /* execute start_up */
 264           dcl     lila_prompt_char       char (32) varying based (lcb.lila_promp_chars_ptr);
 265           dcl     1 local_rpo            aligned like rp_options;
 266           dcl     ptr_desc               bit (36) init ("100110100000000000000000000000000000"b);
 267           dcl     fixed_bin_35_desc      bit (36) init ("100000110000000000000000000000100011"b);
 268 
 269           dcl     1 obj_info             aligned like object_info;
 270 
 271           dcl     1 acc                  aligned based (acc_ptr), /* template for acc string */
 272                     2 len                fixed bin (8) unal,
 273                     2 string             char (0 refer (acc.len)) unal;
 274 
 275           dcl     recursed               bit (1) int static init ("0"b); /* flag to tell us if this is second time around */
 276           dcl     RW                     fixed bin (5) int static options (constant) init (01010b);
 277           dcl     WHITESPACE_OR_QUOTE    char (7) int static options (constant) init ("   ^K^L^M
 278 """);
 279           dcl     LAST_POSITION_IN_THE_TABLE fixed bin internal static options (constant) init (9999);
 280           dcl     my_name                char (5) int static options (constant) init ("linus");
 281 
 282           dcl     (
 283                   SEG                    init ("011"b),
 284                   TEXT                   init ("000"b)
 285                   )                      bit (3) int static options (constant);
 286 
 287           dcl     (
 288                   error_table_$badopt,
 289                   error_table_$inconsistent,
 290                   error_table_$notadir,
 291                   error_table_$noentry,
 292                   linus_data_$max_range_items,
 293                   linus_data_$req_buf_len,
 294                   linus_data_$req_proc_id,
 295                   linus_error_$abort,
 296                   linus_error_$bad_builtin_obj,
 297                   linus_error_$conv,
 298                   linus_error_$dup_ctl_args,
 299                   linus_error_$inval_ctl_arg,
 300                   linus_error_$recursed,
 301                   linus_error_$too_few_ctl_args,
 302                   linus_rq_table_$linus_rq_table_,
 303                   ssu_et_$request_line_aborted,
 304                   ssu_et_$subsystem_aborted,
 305                   sys_info$max_seg_size
 306                   )                      ext fixed bin (35);
 307 
 308           dcl     ssu_info_directories_$standard_requests char (168) external;
 309           dcl     ssu_request_tables_$standard_requests bit(36) aligned external;
 310 
 311 
 312           dcl     iox_$user_input        ptr ext static;
 313 
 314           dcl     (cleanup, conversion, sub_error_) condition;
 315 
 316           dcl     (addr, addrel, empty, fixed, null, ptr, rank, rel,
 317                    rtrim, search, substr, vclock) builtin;
 318 
 319 /* Multics Subroutines */
 320 
 321           dcl     com_err_               entry options (variable);
 322           dcl     continue_to_signal_    entry (fixed bin(35));
 323           dcl     cu_$arg_count          entry (fixed bin);
 324           dcl     cu_$arg_ptr            entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 325           dcl     cu_$decode_entry_value entry (entry, ptr, ptr);
 326           dcl     cv_entry_              entry (char (*), ptr, fixed bin (35)) returns (entry);
 327           dcl     expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*),
 328                                          fixed bin (35));
 329           dcl     find_condition_info_   entry (ptr, ptr, fixed bin(35));
 330           dcl     get_pdir_              entry returns (char (168));
 331           dcl     hcs_$del_dir_tree      entry (char (*), char (*), fixed bin (35));
 332           dcl     hcs_$delentry_file     entry (char (*), char (*), fixed bin (35));
 333           dcl     hcs_$delentry_seg      entry (ptr, fixed bin (35)); /* deletes segs without ref names */
 334           dcl     hcs_$initiate          entry (char (*), char (*), char (*), fixed bin (1),
 335                                          fixed bin (2), ptr, fixed bin (35));
 336           dcl     hcs_$make_seg
 337                                          entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35))
 338                                          ;
 339           dcl     hcs_$status_mins
 340                                          entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
 341           dcl     ioa_                   entry options (variable);
 342           dcl     iox_$close             entry (ptr, fixed bin (35));
 343           dcl     iox_$detach_iocb       entry (ptr, fixed bin (35));
 344           dcl     iox_$destroy_iocb      entry (ptr, fixed bin (35));
 345           dcl     object_info_$brief     entry (ptr, fixed bin (24), ptr, fixed bin (35));
 346           dcl     release_temp_segment_  entry (char (*), ptr, fixed bin (35));
 347           dcl     requote_string_        entry (char(*)) returns(char(*));
 348           dcl     ssu_$add_info_dir      entry (ptr, char(*), fixed bin, fixed bin(35));
 349           dcl     ssu_$add_request_table entry (ptr, ptr, fixed bin, fixed bin(35));
 350           dcl     ssu_$create_invocation entry (char (*), char (*), ptr, ptr, char (*), ptr,
 351                                          fixed bin (35));
 352           dcl     ssu_$destroy_invocation entry (ptr);
 353           dcl     ssu_$execute_line      entry (ptr, ptr, fixed bin (21), fixed bin (35));
 354           dcl     ssu_$execute_start_up  entry () options (variable);
 355           dcl     ssu_$get_area          entry (ptr, ptr, char(*), ptr);
 356           dcl     ssu_$get_info_ptr      entry (ptr) returns (ptr);
 357           dcl     ssu_$get_invocation_count entry (ptr, fixed bin, fixed bin);
 358           dcl     ssu_$get_procedure     entry (ptr, char (*), entry, fixed bin (35));
 359           dcl     ssu_$get_request_processor_options
 360                                          entry (ptr, char(8), ptr, fixed bin(35));
 361           dcl     ssu_$listen            entry (ptr, ptr, fixed bin (35));
 362           dcl     ssu_$print_message     entry options (variable);
 363           dcl     ssu_$release_area      entry (ptr, ptr);
 364           dcl     ssu_$set_ec_suffix     entry (ptr, char (32));
 365           dcl     ssu_$set_procedure     entry (ptr, char (*), entry, fixed bin (35));
 366           dcl     ssu_$set_prompt        entry (ptr, char (64) varying);
 367           dcl     ssu_$set_prompt_mode   entry (ptr, bit (*));
 368           dcl     ssu_$set_request_processor_options
 369                                          entry (ptr, ptr, fixed bin(35));
 370           dcl     unique_chars_          entry (bit (*)) returns (char (15));
 371 
 372 /* LINUS/MRDS Subroutines */
 373 
 374           dcl     linus_abort_line       entry() options(variable);
 375           dcl     linus_convert_code     entry (fixed bin (35), fixed bin (35), fixed bin (35));
 376           dcl     linus_invoke$pop_all   entry (ptr, fixed bin (35));
 377           dcl     linus_invoke$pop_all_on_pi entry (ptr);
 378           dcl     linus_thread_fn_list
 379                                          entry (ptr, entry, char (168) varying, char (32) varying,
 380                                          fixed bin (35));
 381           dcl     linus_builtin_         entry;
 382           dcl     linus_define_area      entry (ptr, char (6), fixed bin (35));
 383           dcl     linus_options$terminate entry (ptr, fixed bin (35));
 384           dcl     linus_table$terminate  entry (ptr, fixed bin (35));
 385           dcl     linus_temp_seg_mgr$get_segment
 386                                          entry (ptr, char(*), char(*), ptr, fixed bin(35));
 387           dcl     linus_temp_seg_mgr$release_segment
 388                                          entry (ptr, char(*), ptr, fixed bin(35));
 389           dcl     linus_temp_seg_mgr$terminate
 390                                          entry (ptr, fixed bin(35));
 391           dcl     dsl_$close             entry options (variable);
 392 ^L
 393           sci_ptr = null;
 394           lcb_ptr = null;
 395           if recursed then do;                              /* if this is second time around */
 396                     call com_err_ (linus_error_$recursed, my_name);
 397                     return;
 398                end;
 399           else do;
 400                     on cleanup call tidy_up;                /* so we leave no traces */
 401                     recursed = "1"b;                        /* remember we have arrived */
 402                end;
 403 
 404           arg_ptr, ca_ptr, ent_ptr = null;                  /* initialize */
 405           macro_rq_ptr, pf_arg_ptr, rq_arg_ptr = null;
 406           ab = "0"b;
 407           start_up = "1"b;                                  /* execute start_up by default */
 408 
 409           call
 410                hcs_$make_seg ("", unique_chars_ ("0"b) || ".lcb", "", RW, ptr_sink,
 411                code);                                       /* make an LCB */
 412           if ptr_sink = null then
 413                call error (code, "^/Creating LINUS Control Block");
 414 
 415           ptr_sink -> lcb.linus_area_ptr, ptr_sink -> lcb.lila_area_ptr,
 416                ptr_sink -> lcb.i_o_area_ptr = null;
 417 
 418           ptr_sink -> lcb.lila_count, ptr_sink -> lcb.lila_chars,
 419                ptr_sink -> lcb.curr_lv_val_offset, ptr_sink -> lcb.curr_lit_offset,
 420                ptr_sink -> lcb.db_index = 0;                /* initialize the LCB */
 421           ptr_sink -> lcb.request_time, ptr_sink -> lcb.mrds_time = 0;
 422           ptr_sink -> lcb.prompt_flag = "1"b;               /* default to prompt mode */
 423           ptr_sink -> lcb.test_flag = "0"b;                 /* default is not test mode */
 424           ptr_sink -> lcb.pso_flag = "0"b;                  /* default is to not print search order */
 425           ptr_sink -> lcb.no_ot_flag = "0"b;                /* default is to optimize */
 426           ptr_sink -> lcb.cal_ptr, ptr_sink -> lcb.ttn_ptr, ptr_sink -> lcb.si_ptr,
 427                ptr_sink -> lcb.force_retrieve_scope_info_ptr, ptr_sink -> lcb.setfi_ptr,
 428                ptr_sink -> lcb.sclfi_ptr, ptr_sink -> lcb.lv_ptr,
 429                ptr_sink -> lcb.lvv_ptr, ptr_sink -> lcb.ivs_ptr,
 430                ptr_sink -> lcb.lit_ptr, ptr_sink -> lcb.liocb_ptr = null;
 431           ptr_sink -> lcb.is_ptr = iox_$user_input;         /* init pointer to input stream */
 432           ptr_sink -> lcb.rb_len = linus_data_$req_buf_len;
 433           ptr_sink -> lcb.lila_fn = "";
 434           ptr_sink -> lcb.static_area = empty;
 435 
 436           ptr_sink -> lcb.build_increment = 10;
 437           ptr_sink -> lcb.build_start = 10;
 438 
 439           ptr_sink -> lcb.linus_version = "4.5";            /* SET LINUS VERSION */
 440           ptr_sink -> lcb.iteration = "0"b;
 441           ptr_sink -> lcb.report_control_info_ptr = null;
 442           ptr_sink -> lcb.table_control_info_ptr = null;
 443           ptr_sink -> lcb.temp_seg_info_ptr = null;
 444           ptr_sink -> lcb.query_temp_segment_ptr = null;
 445           ptr_sink -> lcb.general_work_area_ptr = null;
 446 
 447           lcb_ptr = ptr_sink;
 448           ptr_sink = null;
 449 
 450           call ssu_$create_invocation ("linus", (lcb.linus_version), lcb_ptr,
 451                addr (linus_rq_table_$linus_rq_table_), ">doc>ss>linus", sci_ptr, code);
 452           if code ^= 0
 453           then call error (code, "");
 454           call ssu_$add_request_table (sci_ptr,
 455                addr (ssu_request_tables_$standard_requests), LAST_POSITION_IN_THE_TABLE, code);
 456           if code ^= 0
 457           then call error (code, "Unable to add the ssu_ standard requests.");
 458           call ssu_$add_info_dir (sci_ptr, ssu_info_directories_$standard_requests, LAST_POSITION_IN_THE_TABLE, code);
 459           if code ^= 0
 460           then call error (code, "Unable to add the ssu_ standard request info segs.");
 461 
 462           lcb.subsystem_control_info_ptr = sci_ptr;
 463           call ssu_$get_invocation_count (sci_ptr, lcb.subsystem_invocation_level,
 464                highest_numbered_subsystem_invocation);
 465 
 466           allocate lila_prompt_char in (lcb.static_area) set (lcb.lila_promp_chars_ptr);
 467           lila_prompt_char = "->";
 468 
 469           num_of_rels_init = linus_data_$max_range_items;
 470           allocate linus_rel_array in (lcb.static_area);
 471           lcb.rel_array_ptr = linus_rel_array_ptr;
 472           linus_rel_array.num_of_rels = 0;
 473 
 474           call cu_$decode_entry_value (linus_builtin_, lb_ptr, ptr_sink);
 475                                                             /* get pointer to linus_builtin_ object */
 476           if lb_ptr ^= null then do;                        /* if found segment */
 477                     lb_ptr = ptr (lb_ptr, 0);               /* point to base of seg */
 478                     call hcs_$status_mins (lb_ptr, lb_type, lb_bc, code);
 479                                                             /* get bit count */
 480                     if code ^= 0 then
 481                          call error (linus_error_$bad_builtin_obj, "");
 482                     call object_info_$brief (lb_ptr, lb_bc, addr (obj_info), code);
 483                                                             /* get object data */
 484                     if code ^= 0 then
 485                          call error (linus_error_$bad_builtin_obj, "");
 486 
 487                     do d_ptr = addrel (obj_info.defp, obj_info.defp -> bit18)
 488                          /* search for class 3 defn for linus_builtin_ */
 489                          repeat addrel (obj_info.defp, d_ptr -> definition.value)
 490                          while (addrel (obj_info.defp, d_ptr -> definition.symbol)
 491                          -> acc.string ^= "linus_builtin_"
 492                          & addrel (obj_info.defp, d_ptr -> definition.forward) -> bit18
 493                          ^= "0"b);
 494                     end;
 495                     if addrel (obj_info.defp, d_ptr -> definition.symbol) -> acc.string
 496                          ^= "linus_builtin_" then
 497                          call error (linus_error_$bad_builtin_obj, "");
 498 
 499                     do d_ptr = addrel (obj_info.defp, d_ptr -> definition.segname)
 500                          /* look through entry points in this block */
 501                          repeat addrel (obj_info.defp, d_ptr -> definition.forward)
 502                          while (d_ptr -> definition.class ^= SEG
 503                          & d_ptr -> definition.forward ^= "0"b);
 504                          if d_ptr -> definition.class = TEXT
 505                               & ^d_ptr -> definition.flags.ignore
 506                               & d_ptr -> definition.flags.entry then do; /* if external entry point */
 507                                    acc_ptr = addrel (obj_info.defp, d_ptr -> definition.symbol);
 508                                                             /* point to entry name */
 509                                    if substr (acc.string, acc.len - 4, 5) = "_calc" then do;
 510                                                             /* if calc entry */
 511                                              function_name = substr (acc.string, 1, acc.len - 5);
 512                                              function_entry =
 513                                                   cv_entry_ ("linus_builtin_$" || acc.string, null, code);
 514                                              if code ^= 0 then
 515                                                   call
 516                                                        error (code,
 517                                                        "^/Converting builtin entry: " || function_name);
 518                                              call
 519                                                   linus_thread_fn_list (lcb_ptr, function_entry,
 520                                                   "linus_builtin_", function_name, code); /* thread function info into list */
 521                                              if code ^= 0 then
 522                                                   call error (code, "");
 523                                         end;                /* if true function entry */
 524                               end;                          /* if text entry */
 525                     end;                                    /* entry point loop */
 526                end;                                         /* if builtin segment found */
 527 
 528           if lcb.setfi_ptr = null then /* if did not find any builtins */
 529                call error (linus_error_$bad_builtin_obj, "");
 530 
 531           lcb.rb_ptr = addr (req_buf);
 532 
 533           on conversion call error (linus_error_$conv, ""); /* print error and reset for next request */
 534 
 535 /* set up pi handler */
 536           call ssu_$set_procedure (sci_ptr, "program_interrupt", linus_invoke$pop_all_on_pi, code);
 537           if code ^= 0
 538           then call error (code, "");
 539 
 540           call cu_$arg_count (nargs);                       /* see if we have args */
 541 
 542           do i = 1 to nargs;
 543                call cu_$arg_ptr (i, ctl_ptr, ctl_len, code);
 544                if code ^= 0 then
 545                     call error (code, ctl_arg);
 546 
 547                if ctl_arg = "-set_linus_prompt_string" | ctl_arg = "-slups" | ctl_arg = "-prompt"
 548                then do;
 549                          if i >= nargs then
 550                               call
 551                                    error (linus_error_$too_few_ctl_args,
 552                                    "^2/-set_linus_prompt_string requires a parameter");
 553                          i = i + 1;
 554                          call cu_$arg_ptr (i, ctl_ptr, ctl_len, code);
 555                          if code ^= 0 then
 556                               call error (code, ctl_arg);
 557                          call ssu_$set_prompt (sci_ptr, (ctl_arg));
 558                     end;
 559                else if ctl_arg = "-set_lila_prompt_string" | ctl_arg = "-slaps"
 560                then do;
 561                          if i >= nargs then
 562                               call
 563                                    error (linus_error_$too_few_ctl_args,
 564                                    "^2/-set_lila_prompt_string requires a parameter");
 565                          i = i + 1;
 566                          call cu_$arg_ptr (i, ctl_ptr, ctl_len, code);
 567                          if code ^= 0 then
 568                               call error (code, ctl_arg);
 569                          lila_prompt_char = ctl_arg;
 570                     end;
 571                else if ctl_arg = "-no_prompt" | ctl_arg = "-npmt" then do;
 572                          lcb.prompt_flag = "0"b;
 573                          call ssu_$set_prompt_mode (sci_ptr, DONT_PROMPT);
 574                     end;
 575                else if ctl_arg = "-print_search_order" | ctl_arg = "-pso"
 576                     then lcb.pso_flag = "1"b;
 577                else if ctl_arg = "-no_optimize" | ctl_arg = "-no_ot"
 578                     then lcb.no_ot_flag = "1"b;
 579                else if ctl_arg = "-abbrev" | ctl_arg = "-ab"
 580                then ab = "1"b;
 581                else if ctl_arg = "-no_abbrev" | ctl_arg = "-nab"
 582                then ab = "0"b;
 583                else if ctl_arg = "-profile" | ctl_arg = "-pf"
 584                then do;
 585                          if i >= nargs
 586                          then call error (linus_error_$too_few_ctl_args,
 587                                    "^2/-profile requires a parameter");
 588                          i = i + 1;
 589                          call cu_$arg_ptr (i, pf_arg_ptr, pf_arg_len, code);
 590                          if code ^= 0
 591                          then call error (code, ctl_arg);
 592                          ab = "1"b;
 593                     end;
 594                else if ctl_arg = "-request" | ctl_arg = "-rq"
 595                then do;
 596                          if ca_ptr ^= null
 597                          then call error (error_table_$inconsistent,
 598                                    "^2/A LINUS macro cannot be specified in addition to -request.");
 599                          if i >= nargs
 600                          then call error (linus_error_$too_few_ctl_args,
 601                                    "^2/-request requires a parameter");
 602                          i = i + 1;
 603                          call cu_$arg_ptr (i, rq_arg_ptr, rq_arg_len, code);
 604                          if code ^= 0
 605                          then call error (code, ctl_arg);
 606                     end;
 607                else if ctl_arg = "-iteration" | ctl_arg = "-it"
 608                     then lcb.iteration = "1"b;
 609                else if ctl_arg = "-no_iteration" | ctl_arg = "-nit"
 610                     then lcb.iteration = "0"b;
 611                else if ctl_arg = "-start_up" | ctl_arg = "-su"
 612                     then start_up = "1"b;
 613                else if ctl_arg = "-no_startup" | ctl_arg = "-no_start_up"
 614                     | ctl_arg = "-ns" | ctl_arg = "-nsu" then start_up = "0"b;
 615                else if ctl_arg = "-arguments" | ctl_arg = "-ag" then do;
 616                          if ca_ptr = null then
 617                               call
 618                                    error (linus_error_$inval_ctl_arg,
 619                                    "^2/A macro_name must be given before the -arguments control argument is vaild."
 620                                    );
 621 
 622                          if i >= nargs then
 623                               call
 624                                    error (linus_error_$too_few_ctl_args,
 625                                    "^2/-arguments requires at least one parameter");
 626                          i = i + 1;
 627                          j = 2;
 628                          do while (i ^> nargs);
 629                               char_argl.nargs = char_argl.nargs + 1;
 630                               call
 631                                    cu_$arg_ptr (i, char_argl.arg.arg_ptr (j),
 632                                    char_argl.arg.arg_len (j), code); /* put arg info into structure */
 633                               if code ^= 0 then
 634                                    call error (code, "macro argument");
 635                               i = i + 1;
 636                               j = j + 1;
 637                          end;
 638                     end;
 639                else if substr (ctl_arg, 1, 1) ^= "-" then do;
 640                          if ca_ptr ^= null then
 641                               call
 642                                    error (linus_error_$dup_ctl_args,
 643                                    "^2/Only one macro path may be given: " || ctl_arg);
 644                          if rq_arg_ptr ^= null
 645                          then call error (error_table_$inconsistent,
 646                                    "^2/A LINUS macro cannot be specified in addition to -request.");
 647                          nargs_init = nargs - i + 1;
 648                          if nargs_init > 1 then
 649                               nargs_init = nargs_init - 1;
 650                          allocate char_argl in (lcb.static_area);
 651                          char_argl.nargs = 1;
 652                          char_argl.arg.arg_ptr (1) = ctl_ptr;
 653                          char_argl.arg.arg_len (1) = ctl_len;
 654                     end;
 655                else call error (error_table_$badopt, ctl_arg);
 656           end;                                              /* if macro args */
 657 
 658           call ssu_$set_ec_suffix (sci_ptr, "lec");         /* setup for exec_coms */
 659 
 660 /* The pre_request_line and post_request_line procedures may be replaced
 661    for timing mode where we have pre- and post- request procedures. The
 662    procedures that we will replace them with are in this module and we
 663    need to get the default procedures because they will be used when
 664    timing is turned off.*/
 665 
 666           call ssu_$get_procedure (sci_ptr, "pre_request_line", lcb.ssu_pre_request_line, code);
 667           if code ^= 0
 668           then call error (code, "");
 669 
 670           call ssu_$get_procedure (sci_ptr, "post_request_line", lcb.ssu_post_request_line, code);
 671           if code ^= 0
 672           then call error (code, "");
 673 
 674 /* Setup linus_abort_line as replacement for the standard abort_line.
 675    Save the abort_line procedure, first, because linus_abort_line will
 676    call the standard ssu_abort_line. */
 677 
 678           call ssu_$get_procedure (sci_ptr, "abort_line", lcb.ssu_abort_line, code);
 679           if code ^= 0
 680           then call error (code, "");
 681 
 682           call ssu_$set_procedure (sci_ptr, "abort_line", linus_abort_line, code);
 683           if code ^= 0
 684           then call error (code, "");
 685 
 686 /* Get the request_processor options so we can set up for abbrev processing
 687    and iteration. Linus iteration is off by default but ssu_ defaults to on. */
 688 
 689           call ssu_$get_request_processor_options (sci_ptr, RP_OPTIONS_VERSION_1, addr(local_rpo), code);
 690           if code ^= 0 then call error (code, "");
 691 
 692           if ^lcb.iteration                                 /* don't interpret parens */
 693           then do;                                          /* as causing iteration */
 694                local_rpo.language_info.non_standard_language = "1"b;
 695                local_rpo.language_info.character_types (rank ("(")) = NORMAL_CHARACTER;
 696                local_rpo.language_info.character_types (rank (")")) = NORMAL_CHARACTER;
 697                end;
 698 
 699           if ab = "1"b                                      /* user wants abbrevs */
 700           then do;
 701                     if pf_arg_ptr ^= null                   /* user specified a profile */
 702                     then do;
 703                               ctl_len = pf_arg_len;
 704                               ctl_ptr = pf_arg_ptr;
 705                               call expand_pathname_$add_suffix (ctl_arg, "profile", dname, ename, code);
 706                               if code ^= 0
 707                               then call error (code, ctl_arg);
 708                               call hcs_$initiate (dname, ename, "", 0, 0, local_rpo.abbrev_info.default_profile_ptr, code);
 709                               if local_rpo.abbrev_info.default_profile_ptr = null
 710                               then call error (code, rtrim (dname) || ">" || ename);
 711                          end;
 712 
 713                     local_rpo.abbrev_info.expand_request_lines = "1"b;
 714                end;
 715 
 716           call ssu_$set_request_processor_options (sci_ptr, addr(local_rpo), code);
 717           if code ^= 0 then call error (code, "");
 718 
 719           if ca_ptr ^= null then do;                        /* macro given */
 720                     macro_rq_len = 6 + char_argl.nargs;
 721                     do i = 1 to char_argl.nargs;
 722                          macro_rq_len = macro_rq_len + char_argl.arg.arg_len (i) + 1;
 723                     end;
 724                     macro_rq_len = macro_rq_len * 2 +2;     /* allow room for requoting */
 725                     allocate macro_request in (lcb.static_area);
 726                     macro_request = "invoke";
 727                     do i = 1 to char_argl.nargs;
 728                          ctl_ptr = char_argl.arg.arg_ptr (i);
 729                          ctl_len = char_argl.arg.arg_len (i);
 730                          if ctl_len = 0
 731                               then macro_request = rtrim(macro_request) || " """"";
 732                          else if search (ctl_arg, WHITESPACE_OR_QUOTE) ^= 0
 733                               then call requote_arg (ctl_arg);
 734                          else macro_request = rtrim(macro_request) || " " || ctl_arg;
 735                     end;
 736                     free char_argl;
 737                     call ssu_$execute_line (sci_ptr, macro_rq_ptr, macro_rq_len, code); /* set up to take input from macro */
 738                     free macro_request;
 739                     if code = ssu_et_$subsystem_aborted
 740                     then do;
 741                               call tidy_up;
 742                               goto exit;
 743                          end;
 744                     else if code ^= 0 & code ^= ssu_et_$request_line_aborted
 745                     then do;
 746                               call error (linus_error_$abort, "");
 747                               return;
 748                          end;
 749                end;
 750 
 751           on sub_error_ call sub_error_handler;
 752 
 753           call linus_define_area (lcb.lila_area_ptr, "LILA", code);
 754           if code ^= 0 then
 755                call error (code, "");
 756 
 757           call linus_define_area (lcb.linus_area_ptr, "LINUS", code);
 758           if code ^= 0
 759           then call error (code, "");
 760 
 761           call linus_temp_seg_mgr$get_segment (lcb_ptr, "LINUS", "",
 762                lcb.query_temp_segment_ptr, code);
 763           if code ^= 0
 764           then call error (code, "^/While trying to aquire a temp segment for the query.");
 765           call ssu_$get_area (sci_ptr, null, "general use area", lcb.general_work_area_ptr);
 766 
 767 
 768           if start_up
 769                then do;
 770                call ssu_$execute_start_up (sci_ptr, code);
 771                if code ^= 0 & code ^= error_table_$noentry
 772                     then call error (code, "While executing start_up");
 773                end;
 774 
 775           initial_linus_vclock = vclock;
 776           lcb.request_time, lcb.mrds_time = 0;
 777 
 778           if rq_arg_ptr ^= null                             /* execute the -rq stuff */
 779           then do;
 780                     call ssu_$execute_line (sci_ptr, rq_arg_ptr, rq_arg_len, code);
 781                     if code = ssu_et_$subsystem_aborted
 782                     then do;
 783                               call tidy_up;
 784                               goto exit;
 785                          end;
 786                     else if code ^= 0                       /* nonfatal */
 787                     then call ssu_$print_message (sci_ptr, code);
 788                end;
 789 
 790 listen:
 791           call ssu_$listen (sci_ptr, iox_$user_input, code);
 792           if code ^= ssu_et_$subsystem_aborted
 793           then call error (linus_error_$abort, "");         /* if fatal error in handler */
 794           call tidy_up;
 795 
 796 exit:
 797           return;
 798 ^L
 799 timer_print:
 800      proc;
 801 
 802           call
 803                ioa_ ("^/LINUS time^13t= ^10.3f" || "^/MRDS time^13t= ^10.3f"
 804                || "^/Total time^13t= ^10.3f^/",
 805                lcb.request_time / 1000000, lcb.mrds_time / 1000000,
 806                (lcb.request_time + lcb.mrds_time) / 1000000);
 807           lcb.request_time, lcb.mrds_time = 0;
 808 
 809      end timer_print;
 810 ^L
 811 tidy_up:
 812      proc;
 813 
 814 /* Procedure to clean up loose ends */
 815 
 816           dcl     icode                  fixed bin (35);
 817           dcl     temp_index             fixed bin (35);    /* temp storage for database index */
 818 
 819           if lcb.general_work_area_ptr ^= null
 820           then call ssu_$release_area (sci_ptr, lcb.general_work_area_ptr);
 821 
 822           if sci_ptr ^= null                                /* if there is an ssu_ invocation */
 823           then call ssu_$destroy_invocation (sci_ptr);
 824 
 825           if lcb_ptr ^= null then do;                       /* if we have a LCB */
 826 
 827                     if lcb.is_ptr ^= iox_$user_input
 828                     then do;                                /* if we were in macro */
 829                               lcb.prompt_flag = "0"b;       /* make sure pop doesn't try and call ssu_! */
 830                               call linus_invoke$pop_all (lcb_ptr, icode);
 831                          end;
 832                     if lcb.db_index ^= 0 then do;           /* if a data base open, close it */
 833                               temp_index = lcb.db_index;
 834                               lcb.db_index = 0;
 835                               on sub_error_ ;
 836                               if lcb.timing_mode then
 837                                    initial_mrds_vclock = vclock;
 838                               call dsl_$close (temp_index, icode);
 839                               if lcb.timing_mode then
 840                                    lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock;
 841                               revert sub_error_;
 842                          end;
 843 
 844                     if lcb.liocb_ptr ^= null then do;       /* clean up the lila file */
 845                               call iox_$close (lcb.liocb_ptr, icode);
 846                               call iox_$detach_iocb (lcb.liocb_ptr, icode);
 847                               call iox_$destroy_iocb (lcb.liocb_ptr, icode);
 848                               lcb.liocb_ptr = null;
 849                               call hcs_$del_dir_tree (get_pdir_ (), lcb.lila_fn, icode);
 850                               if icode = error_table_$notadir | icode = 0 then
 851                                    call hcs_$delentry_file (get_pdir_ (), lcb.lila_fn, icode);
 852 
 853                          end;                               /* cleaning up lila file */
 854                     if lcb.linus_area_ptr ^= null then do;
 855                               call
 856                                    release_temp_segment_ ("LINUS.LINUS.area", lcb.linus_area_ptr,
 857                                    icode);
 858                               if icode ^= 0 then
 859                                    call com_err_ (icode, my_name);
 860                               lcb.linus_area_ptr = null;
 861                          end;
 862                     if lcb.lila_area_ptr ^= null then do;
 863                               call
 864                                    release_temp_segment_ ("LINUS.LILA.area", lcb.lila_area_ptr,
 865                                    icode);
 866                               if icode ^= 0 then
 867                                    call com_err_ (icode, my_name);
 868                               lcb.lila_area_ptr = null;
 869                          end;
 870                     if lcb.i_o_area_ptr ^= null then do;
 871                               call
 872                                    release_temp_segment_ ("LINUS.I_O_.area", lcb.i_o_area_ptr,
 873                                    icode);
 874                               if icode ^= 0 then
 875                                    call com_err_ (icode, my_name);
 876                               lcb.i_o_area_ptr = null;
 877                          end;
 878                     if lcb.table_control_info_ptr ^= null
 879                     then do;
 880                        call linus_table$terminate (lcb_ptr, icode);
 881                        if icode ^= 0 then
 882                           call com_err_ (icode, my_name);
 883                        end;
 884                     if lcb.report_control_info_ptr ^= null
 885                     then do;
 886                        call linus_options$terminate (lcb_ptr, icode);
 887                        if icode ^= 0 then
 888                           call com_err_ (icode, my_name);
 889                        end;
 890                     if lcb.query_temp_segment_ptr ^= null
 891                     then do;
 892                          call linus_temp_seg_mgr$release_segment (lcb_ptr,
 893                               "LINUS", lcb.query_temp_segment_ptr, icode);
 894                          if icode ^= 0
 895                          then call com_err_ (icode, my_name);
 896                          else;
 897                     end;
 898                     if lcb.temp_seg_info_ptr ^= null
 899                     then do;
 900                        call linus_temp_seg_mgr$terminate (lcb_ptr, icode);
 901                        if icode ^= 0 then
 902                           call com_err_ (icode, my_name);
 903                        end;
 904                     if lcb_ptr ^= null then do;
 905                               call hcs_$delentry_seg (lcb_ptr, icode); /* delete the LCB */
 906                               if icode ^= 0 then
 907                                    call com_err_ (icode, my_name);
 908                               lcb_ptr = null;
 909                          end;
 910                     else if ptr_sink ^= null then do;
 911                               call hcs_$delentry_seg (ptr_sink, icode);
 912                               if icode ^= 0 then
 913                                    call com_err_ (icode, my_name);
 914                               ptr_sink = null;
 915                          end;
 916 
 917 
 918                end;                                         /* if we had an LCB */
 919 
 920           recursed = "0"b;                                  /* so we can be called again */
 921 
 922      end tidy_up;
 923 ^L
 924 error:
 925      proc (icode, msg_str);
 926 
 927 /* Error procedure, prints a message and cleans up */
 928 
 929           dcl     (icode, user_code)     fixed bin (35);
 930           dcl     msg_str                char (*);
 931 
 932           call linus_convert_code (icode, user_code, linus_data_$req_proc_id);
 933           call com_err_ (user_code, my_name, msg_str);
 934           call tidy_up;
 935           go to exit;
 936 
 937      end error;
 938 ^L
 939 requote_arg:
 940      proc(arg);
 941      dcl arg char(*) parm;
 942      macro_request = rtrim(macro_request) || " " || requote_string_(arg);
 943 end requote_arg;
 944 %page;
 945 sub_error_handler: proc;
 946 %skip(1);
 947 /*
 948      Find the sub_error_info structure and if it wasn't mrds that
 949      signalled it then continue to signal. Change appropriate mrds_error_
 950      codes to linus_error_ codes and print the message. Do a non-local goto
 951      so the current request will have its cleanup handler invoked but won't
 952      print the error message we just printed.
 953 */
 954 %skip(1);
 955 dcl 1 local_condition_info like condition_info;
 956 dcl seh_code fixed bin (35);
 957 %skip(1);
 958           condition_info_ptr = addr (local_condition_info);
 959           condition_info.version = condition_info_version_1;
 960           call find_condition_info_ (null (), condition_info_ptr, seh_code);
 961           if seh_code ^= 0
 962           then do;
 963                call tidy_up;
 964                goto exit;
 965           end;
 966 %skip(1);
 967           sub_error_info_ptr = condition_info.info_ptr;
 968           if substr (sub_error_info.name, 1, 9) ^= "mrds_dsl_"
 969           & substr (sub_error_info.name, 1, 3) ^= "mu_"
 970           & substr (sub_error_info.name, 1, 4) ^= "mus_"
 971           then do;
 972                call continue_to_signal_ (seh_code);
 973                return;
 974           end;
 975 %skip(1);
 976           call linus_convert_code (sub_error_info.header.status_code, seh_code,
 977                linus_data_$req_proc_id);
 978           call ssu_$print_message (sci_ptr, seh_code, sub_error_info.header.info_string);
 979 %skip(1);
 980           goto listen;
 981 %skip(1);
 982      end sub_error_handler;
 983 ^L
 984 pre_request_line:
 985      entry (bv_sci_ptr);
 986 
 987 /* This procedure is called prior to the execution of a request line.  If the
 988    user has enabled timing mode, it initializes some timers and returns.
 989 */
 990           dcl     bv_sci_ptr             ptr parameter;
 991 
 992           lcb_ptr = ssu_$get_info_ptr (bv_sci_ptr);
 993           if ^lcb.timing_mode
 994           then return;
 995           lcb.mrds_time = 0;
 996           initial_linus_vclock = vclock;
 997           return;
 998 
 999 post_request_line:
1000      entry (bv_sci_ptr);
1001 
1002 /* This procedure is called after a request line has been executed.  If the
1003    user has timing mode on, it diddles some timers, prints some statistics
1004    and returns.
1005 */
1006 
1007           lcb_ptr = ssu_$get_info_ptr (bv_sci_ptr);
1008           if ^lcb.timing_mode
1009           then return;
1010           if lcb.request_time = -1                          /* user just turned on timing */
1011           then do;
1012                     lcb.request_time = 0;
1013                     return;
1014                end;
1015           lcb.request_time = vclock - initial_linus_vclock - lcb.mrds_time;
1016           call timer_print;
1017           return;
1018 
1019      end linus;
1020