1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) BULL HN Information Systems Inc., 1990   *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Bull Inc., 1987                *
   6         *                                                         *
   7         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   8         *                                                         *
   9         *********************************************************** */
  10 
  11 /* format: off */
  12 
  13 /* The Multics standard abbreviation processor */
  14 
  15 /* Created:  February 1982 by G. Palter based on various previous versions */
  16 /****^  HISTORY COMMENTS:
  17   1) change(86-05-01,Gilcrease), approve(86-05-10,MCR7409),
  18      audit(86-08-01,GWMay), install(86-08-04,MR12.0-1112):
  19      (old history comments)
  20 
  21      Modified: 7 March 1982 to insure that set_profile_ptr is quick, move
  22      special requests check into standard request checking code, and add the
  23      following warning
  24 
  25      Modified: 12 March 1982 by G. Palter to set the bit count on the profile
  26      segment after an add request
  27 
  28      Modified: 18 March 1982 by G. Palter to terminate the old profile when
  29      appropriate after a ".u" request
  30 
  31      Modified: 30 July 1982 by G. Palter to make abbrev as an active function
  32      return true/flase if expansion is enabled/disabled, respectively
  33 
  34      Modified: April 1983 by G. Palter for version 1.2:
  35       (1) Added initial support for multiple character break sequences and
  36           defined "::" as a break sequence;
  37       (2) Added the ".rename" request to allow users to rename old
  38           abbreviations whose names contain "::"
  39 
  40      Modified: 29 February 1984 by G. Palter for version 1.2a which fixes the
  41      following bugs:
  42       #0052: If abbrev has to reinitialize the default profile, it will
  43              erroneously state that it created the profile.  In addition,
  44              abbrev will always initiate the default profile twice.
  45       #0053: If the last character of the line to be expanded is the first
  46              character of a multi-character break sequence, abbrev will loop
  47              indefinitely
  48 
  49      Modified: January 1983 by G. Palter for version 3.0:
  50       (1) Added the ".edit" request to allow editing the definition of an
  51           abbreviation using qedx_;
  52       (2) Added the ".switch_on" and ".switch_off" requests to manipulate an
  53           abbreviation's beginning-of-line switch;
  54       (3) Renamed the ".call_debug" request to ".debug" and the ".call_probe"
  55           request to ".probe" (Version 2 was the "Goldman" abbrev which lived
  56           in EXL on MIT and System-M for many, many years)
  57   2) change(86-05-01,Gilcrease), approve(86-05-10,MCR7409),
  58      audit(86-08-01,GWMay), install(86-08-04,MR12.0-1112):
  59      (more old history comments)
  60 
  61      Modified: March 1983 by G. Palter for version 3.1:
  62       (1) Changed the ".edit" request to print the abbreviation's definition
  63           and a prompt before invoking qedx_ and to query if overwriting an
  64           existing abbreviation (if not the "default pathname");
  65       (2) Added the ".escape" request and the "-escape" abbrev control
  66           argument to set the character used to identify abbrev request lines;
  67       (3) Added the "-on", "-off", and "-profile" control arguments for
  68           compatibility with the standard abbrev subsystem request
  69 
  70      Modified: 6 August 1985 by G. Palter for version 3.1a which fixes the
  71      following bugs:
  72       #0092: If the ".use" request is used in a subsystem which is using the
  73              same profile as Multics command level, abbrev will incorrectly
  74              terminate the profile which will cause subsequent command lines
  75              to fault until the ".quit" request is issued.
  76       #0107: If the new name given for an abbreviation by the ".rename"
  77              request is too long (i.e., more than 8 characters), the error
  78              message printed by abbrev includes 32 random characters instead
  79              of the supplied name
  80   3) change(86-05-01,Gilcrease), approve(86-05-10,MCR7409),
  81      audit(86-08-01,GWMay), install(86-08-04,MR12.0-1112):
  82      Call ioa_ rather than com_err_ on "Profile create" message.
  83      (command_environment 123), and implement .?  request, install version
  84      3.1a abbrev.
  85   4) change(86-05-17,GDixon), approve(86-05-17,MCR7357),
  86      audit(86-07-10,Farley), install(86-07-18,MR12.0-1098):
  87      Change call to tct_ to reference find_char_$first_in_table instead.  The
  88      tct_ subroutines were renamed.
  89   5) change(86-10-10,Gilcrease), approve(87-02-27,MCR7626),
  90      audit(87-03-09,Parisek), install(87-03-20,MR12.1-1005):
  91      Add version 2 list requests.
  92   6) change(87-06-20,Gilcrease), approve(87-07-15,MCR7738),
  93      audit(87-07-16,Parisek), install(87-07-17,MR12.1-1042):
  94      Fix bug in .lx request.
  95   7) change(87-07-01,GWMay), approve(87-07-01,MCR7730), audit(87-08-10,JRGray),
  96      install(87-09-10,MR12.1-1104):
  97      Added the pipe token combination ";|" and the left bracket "[" to the
  98      list of beginning of line breaks. Fixed a minor bug with the .lx
  99      request.
 100   8) change(87-10-16,TLNguyen), approve(87-10-16,MCR7778),
 101      audit(87-12-02,Farley), install(87-12-07,MR12.2-1009):
 102      - Make the abbrev .use request strip one level of quotes from the
 103        pathname, if specified.
 104 
 105      - Add the new entry point named abbrev_$expand_line which will be like
 106        the "abbrev_$expanded_line" current entry point;  however, this new
 107        entry point will have one new argument to say what kind of abbrevs
 108        to expand.  This argument can be EXPAND_BOL_ONLY (1), or
 109        EXPAND_INTERNAL_ONLY (2), or EXPAND_BOTH (3).  For solving the
 110        TR #14559, the EXPAND_INTERNAL_ONLY (2)  constant will be used.
 111 
 112      - Clear out errors found at run time after compiled with
 113        -prefix size,strg,strz,subrg.
 114   9) change(90-03-15,Vu), approve(90-03-15,MCR8161), audit(90-03-19,Kallstrom),
 115      install(90-04-12,MR12.4-1002):
 116      The abbrev command .lx should not limit its argument's length.
 117                                                    END HISTORY COMMENTS */
 118 
 119 /*  Note: In order to insure that the main path through the command/request line expander does not entail the overhead of
 120    calls to non-quick procedures, two internal procedures, set_profile_ptr and lookup_abbrev, are duplicated.  One version
 121    appears either in the expand_line procedure or as a top-level internal procedure; the other version appears as an
 122    internal procedure of the begin block in the process_request_line internal procedure.  Anyone modifying either of these
 123    two procedures should be certain to modify both copies of the procedure.  (An attempt will be made at a future date to
 124    eliminate the need for two copies of these procedures)   */
 125 
 126 /* format: on,style4,delnl,insnl,ifthenstmt,ifthen */
 127 
 128 
 129 abbrev:
 130 ab:
 131      procedure () options (variable);
 132 
 133 
 134 /* Parameters */
 135 
 136 dcl  P_code fixed binary (35) parameter;
 137 
 138 dcl  P_command_processor entry (pointer, fixed binary (21), fixed binary (35)) variable parameter;
 139                                                             /* set_cp: the command processor to always invoke */
 140 
 141 dcl  P_breaks character (*) parameter;                      /* set_break, reset_break: the break chars to add/delete */
 142 
 143 dcl  P_abbrev_type fixed bin;                               /* = 1 expand beginning-of-line (bol) abbrevs only.
 144                                                                = 2 expand internal (non-bol) abbrevs only.
 145                                                                = 3 expand both bol and non-bol abbrevs */
 146 
 147 dcl  P_input_line_ptr pointer parameter;                    /* abbrev_processor, expanded_line: -> line to expand */
 148 dcl  P_input_line_lth fixed binary (21) parameter;          /* abbrev_processor, expanded_line: length of the line */
 149 
 150 dcl  P_subsystem_name character (*) parameter;              /* subsys_process_line: name of the subsystem */
 151 dcl  P_sci_ptr pointer parameter;                           /* subsys_process_line: -> the subsystem's control data */
 152 dcl  P_execute_request entry () variable parameter;         /* subsys_process_line: entry to invoke a single request */
 153 dcl  P_subsys_cp_info_ptr pointer parameter;                /* subsys_process_line: -> data of subsys request processor */
 154 dcl  P_subsys_cp entry (character (*), pointer, entry, pointer, character (*), fixed binary (35)) variable parameter;
 155                                                             /* subsys_process_line: the subsystem request processor */
 156 dcl  P_default_profile_ptr pointer parameter;               /* subsys_process_line: -> default profile segment */
 157 dcl  P_profile_ptr pointer parameter;                       /* subsys_process_line: -> current profile segment */
 158 dcl  P_request_line character (*) parameter;                /* subsys_process_line: the request line itself */
 159 
 160 dcl  P_workspace_ptr pointer parameter;                     /* expanded_line: -> buffer where expansion is placed */
 161 dcl  P_workspace_lth fixed binary (21) parameter;           /* expanded_line: length of the buffer */
 162 dcl  P_output_line_ptr pointer parameter;                   /* expanded_line: set -> the expansion */
 163 dcl  P_output_line_lth fixed binary (21) parameter;         /* expanded_line: set to length of the expansion */
 164 
 165 
 166 /* Local copies of parameters */
 167 
 168 dcl  abbrev_type fixed bin;                                 /* = 1 expand beginning-of-line (bol) abbrevs only.
 169                                                                = 2 expand internal (non-bol) abbrevs only.
 170                                                                = 3 expand both bol and non-bol abbrevs */
 171 
 172 dcl  input_line character (input_line_lth) based (input_line_ptr);
 173 dcl  input_line_lth fixed binary (21);
 174 dcl  input_line_ptr pointer;
 175 
 176 dcl  P_output_line character (P_output_line_lth) based (P_output_line_ptr);
 177 
 178 dcl  code fixed binary (35);
 179 
 180 
 181 /* Remaining declarations */
 182 
 183 dcl  system_area area based (system_area_ptr);
 184 dcl  system_area_ptr pointer;
 185 
 186 dcl  expanded_line character (expanded_line_lth) based (expanded_line_ptr);
 187 dcl  expanded_line_lth fixed binary (21);
 188 dcl  expanded_line_ptr pointer;
 189 
 190 dcl  expansion_stack_space_lth fixed binary (21);
 191 dcl  expansion_stack_space_ptr pointer;
 192 dcl  extended_stack bit (1) aligned;                        /* ON => expansion is in the stack extension */
 193 
 194 dcl  expansion_temp_segment character (4 * sys_info$max_seg_size) based (expansion_temp_segment_ptr);
 195 dcl  expansion_temp_segment_ptr pointer;
 196 dcl  used_temp_segment bit (1) aligned;                     /* ON => expansion is in a temporary segment */
 197 
 198 dcl  based_word fixed binary (35) based;
 199 
 200 dcl  (subsystem_entry, return_expansion, allow_request_lines, have_return_code, null_line) bit (1) aligned;
 201 
 202 dcl  start fixed binary (21);
 203 
 204 dcl  cp_variable entry (pointer, fixed binary (21), fixed binary (35)) variable;
 205 
 206 dcl  ABBREV character (32) static options (constant) initial ("abbrev");
 207 
 208 dcl  EXPAND_BOL_ONLY fixed bin static options (constant) initial (1);
 209                                                             /* expand beginning-of-line (bol) abbrevs only */
 210 dcl  EXPAND_INTERNAL_ONLY fixed bin static options (constant) initial (2);
 211                                                             /* expand internal (non-bol) abbrevs only */
 212 dcl  EXPAND_BOTH fixed bin static options (constant) initial (3);
 213                                                             /* expand both bol and non-bol abbrevs */
 214 
 215 dcl  MAX_STACK_EXTENSION fixed binary (18) static options (constant) initial (16384);
 216                                                             /* grow the stack no more than 16K characters */
 217 
 218 dcl  WHITE_SPACE character (4) static options (constant) initial ("   ^K^L");                                                     /* SP HT VT FF */
 219 
 220 dcl  WHITE_SPACE_AND_NL character (5) static options (constant) initial ("      ^K^L
 221 ");                                                         /* SP HT VT FF NL */
 222 
 223 dcl  DEFAULT_ABBREV_ESCAPE_CHARACTER character (1) static options (constant) initial (".");
 224 
 225 dcl  DEFAULT_BREAKS character (21) static options (constant) initial ("
 226 ^K^L ""$'().:;<>[]`{|}");                                   /* HT NL VT FF SP QUOTE, etc: must be in collating sequence */
 227 
 228 dcl  SP character (1) static options (constant) initial (" ");
 229 dcl  NL character (1) static options (constant) initial ("
 230 ");
 231 dcl  LEFT_BRACKET character (1) static options (constant) initial ("[");
 232 dcl  SEMICOLON character (1) static options (constant) initial (";");
 233 dcl  VERTICAL_BAR character (1) static options (constant) initial ("|");
 234 dcl  QUOTE character (1) static options (constant) initial ("""");
 235 
 236 dcl  abbrev_data_$version character (32) unaligned external;
 237 dcl  abbrev_data_$default_breaks_list bit (36) aligned external;
 238 dcl  abbrev_data_$default_breaks_tct_table character (512) unaligned external;
 239 
 240 /* format: off */
 241 dcl (error_table_$badopt, error_table_$bad_segment, error_table_$bad_subr_arg, error_table_$command_line_overflow,
 242      error_table_$moderr, error_table_$noarg, error_table_$noentry, error_table_$not_act_fnc,
 243      error_table_$request_not_recognized, error_table_$unbalanced_quotes, error_table_$unimplemented_version)
 244           fixed binary (35) external;
 245 /* format: on */
 246 
 247 dcl  sys_info$max_seg_size fixed binary (19) external;
 248 
 249 dcl  active_fnc_err_$suppress_name entry () options (variable);
 250 dcl  com_err_ entry () options (variable);
 251 dcl  com_err_$suppress_name entry () options (variable);
 252 dcl  command_processor_ entry (pointer, fixed binary (21), fixed binary (35));
 253 dcl  command_query_$yes_no entry () options (variable);
 254 dcl  cu_$af_return_arg_rel entry (fixed binary, pointer, fixed binary (21), fixed binary (35), pointer);
 255 dcl  cu_$arg_list_ptr entry () returns (pointer);
 256 dcl  cu_$arg_ptr_rel entry (fixed binary, pointer, fixed binary (21), fixed binary (35), pointer);
 257 dcl  cu_$cp entry (pointer, fixed binary (21), fixed binary (35));
 258 dcl  cu_$get_command_processor entry (entry (pointer, fixed binary (21), fixed binary (35)));
 259 dcl  cu_$grow_stack_frame entry (fixed binary (18), pointer, fixed binary (35));
 260 dcl  cu_$set_command_processor entry (entry (pointer, fixed binary (21), fixed binary (35)));
 261 dcl  cu_$shrink_stack_frame entry (pointer, fixed binary (35));
 262 dcl  debug entry () options (variable);
 263 dcl  expand_pathname_$add_suffix entry (character (*), character (*), character (*), character (*), fixed binary (35));
 264 dcl  probe entry () options (variable);
 265 dcl  get_system_free_area_ entry () returns (pointer);
 266 dcl  get_temp_segment_ entry (character (*), pointer, fixed binary (35));
 267 dcl  hcs_$fs_get_mode entry (pointer, fixed binary (5), fixed binary (35));
 268 dcl  hcs_$fs_get_path_name entry (pointer, character (*), fixed binary, character (*), fixed binary (35));
 269 dcl  initiate_file_ entry (character (*), character (*), bit (*), pointer, fixed binary (24), fixed binary (35));
 270 dcl  initiate_file_$create
 271           entry (character (*), character (*), bit (*), pointer, bit (1) aligned, fixed binary (24), fixed binary (35));
 272 dcl  ioa_ entry () options (variable);
 273 dcl  ioa_$nnl entry () options (variable);
 274 dcl  pathname_ entry (character (*), character (*)) returns (character (168));
 275 dcl  qedx_ entry (pointer, fixed binary (35));
 276 dcl  release_temp_segment_ entry (character (*), pointer, fixed binary (35));
 277 dcl  sort_items_$char entry (pointer, fixed binary (24));
 278 dcl  terminate_file_ entry (pointer, fixed binary (24), bit (*), fixed binary (35));
 279 dcl  find_char_$first_in_table entry (char (*), char (512) aligned) returns (fixed bin (21)) reducible;
 280 dcl  user_info_ entry (character (*));
 281 dcl  user_info_$homedir entry (character (*));
 282 
 283 dcl  cleanup condition;
 284 
 285 dcl  (addcharno, addr, after, baseptr, before, codeptr, currentsize, divide, fixed, hbound, high, index, lbound, length,
 286      low, ltrim, max, mod, null, pointer, rank, rel, reverse, rtrim, search, string, substr, verify) builtin;
 287 %page;
 288 /* State of abbreviation processing in this process */
 289 
 290 dcl  first_call bit (1) aligned static initial ("1"b);
 291 
 292 dcl  1 abbrev_state aligned static,
 293        2 command_processor entry (pointer, fixed binary (21), fixed binary (35)) variable,
 294        2 previous_command_processor entry (pointer, fixed binary (21), fixed binary (35)) variable,
 295        2 profile_ptr pointer,                               /* -> profile in use at command level */
 296        2 remembered_line,                                   /* data about the last expansion we did ... */
 297          3 remembered_line_buffer_ptr pointer,              /* ... -> buffer used to hold the lines */
 298          3 remembered_line_buffer_lth fixed binary (21),    /* ... length of the buffer */
 299          3 remembered_line_lth fixed binary (21),           /* ... length of line currently saved therein */
 300        2 escape_character character (1) aligned,            /* character used to trigger request line processing */
 301        2 flags,
 302          3 set_cp bit (1) unaligned,                        /* ON => we have established ourselves as the CP */
 303          3 set_cp_explicit bit (1) unaligned,               /* ON => abbrev_$set_cp was called */
 304          3 remember_lines bit (1) unaligned,                /* ON => remember last expanded line */
 305          3 default_breaks bit (1) unaligned,                /* ON => using default break characters */
 306          3 pad bit (32) unaligned,
 307        2 breaks_info,                                       /* data used to find break sequences ... */
 308          3 user_breaks character (128) varying,             /* ... 1st characters of all sequences if not default */
 309          3 tct_table character (512),                       /* ... used to search for above sequences if not default */
 310          3 breaks_list_ptr pointer;                         /* ... -> breaks_list defining the sequences */
 311 
 312 dcl  abbrev_state_tct_table_as_binary (0:511) fixed binary (9) unaligned unsigned based (addr (abbrev_state.tct_table));
 313 
 314 dcl  1 breaks_list aligned based (abbrev_state.breaks_list_ptr),
 315        2 n_break_sequences fixed binary,                    /* # of distinct break sequences */
 316        2 break_strings_lth fixed binary,                    /* combined length of all break sequences */
 317        2 break_sequences (breaks_list_n_break_sequences refer (breaks_list.n_break_sequences)),
 318          3 start fixed binary,                              /* ... index in break_strings where this sequence starts */
 319          3 lth fixed binary,                                /* ... how long this sequence actually is */
 320        2 break_strings character (breaks_list_break_strings_lth refer (breaks_list.break_strings_lth)) unaligned;
 321 dcl  (breaks_list_n_break_sequences, breaks_list_break_strings_lth) fixed binary;
 322 
 323 dcl  remembered_line_buffer character (abbrev_state.remembered_line_buffer_lth)
 324           based (abbrev_state.remembered_line_buffer_ptr);
 325 dcl  remembered_line character (abbrev_state.remembered_line_lth) based (abbrev_state.remembered_line_buffer_ptr);
 326 
 327 dcl  debug_entry_variable entry () options (variable) variable static;
 328 dcl  probe_entry_variable entry () options (variable) variable static;
 329 %page;
 330 dcl  abbrev_rqd (87) char (72) static options (constant)    /* For the .? abbrev request */
 331           init (".",                                        /* Three lines of print, 3rd line */
 332           "   displays the current version of abbrev.",     /* "" if not needed */
 333           "",                                               /* ( as for this "." request) */
 334           ".? <request1>...<requestN>", "   describes the function and usage of the given abbrev control",
 335           "   request(s). If none are given, all abbrev requests are described.", ".<SP>LINE",
 336                                                             /* can't be individually displayed */
 337           "   passes LINE directly to the current command processor without", "   expanding any embedded abbreviations.",
 338           ".a name LINE, .af name LINE", "   adds LINE as the definition of a new abbreviation with the given",
 339           "   name to the current profile.  '.af' adds with no query.", ".ab name LINE, .abf name LINE",
 340           "   adds LINE as the definition of a new abbreviation with the given",
 341           "   name to the current profile.  '.abf' adds with no query.", ".debug", "   invokes debug.", "",
 342           ".delete names, .dl names, .d names", "   deletes the given abbreviations from the current profile.", "",
 343           ".edit name", "   invokes the qedx editor to edit the given abbreviation's", "   definition.",
 344           ".escape {STR}, .esc {STR}", "   changes the escape character which is used to indicate that a",
 345           "   command line is actually an abbrev request line. ", ".forget, .f", "   disables remember mode. ", "",
 346           ".l {names}", "   displays the names, switches, and definitions of the given",
 347           "   abbreviations in alphabetic order.", ".la STRs",
 348           "   displays the names, switches, and definitions of any abbreviations",
 349           "   whose name starts with one of the given strings.", ".lab STRs, .la^b STRs",
 350           "   displays beginning-line (.lab) or not-beginning-line (.la^b)",
 351           "   information for abbreviations beginning with STRs.", ".lb {names}",
 352           "   displays information on beginning-of-line abbreviations which",
 353           "   match {names}, or if no {names}, all bol abreviations.", ".l^b {names}",
 354           "   displays information on not-beginning-of-line abbreviations which",
 355           "   which match {name}, or if no {names}, all not-bol abbreviaions.", ".ls STRs",
 356           "   displays the names, switches, and definitions of any abbreviations", "   which contain STRs.",
 357           ".lsb STRs, .ls^b STRs", "   displays beginning-of-line (.lsb) or not-beginning-of-line ",
 358           "   information of abbreviations which contain STRs.", ".lx STRs",
 359           "   displays information of abbreviation expansions which contain", "   STRs.", ".lxb STRs, .lx^b STRs",
 360           "   displays information of beginning-line abbreviation expansions",
 361           "   (.lxb) or not-beginning-line (.lx^b) containing STRs.", ".probe", "   invokes probe.", "", ".profile, .p",
 362           "   prints the pathname of the profile segment presently being used to", "   expand abbreviations.",
 363           ".quit, .q", "   disables abbreviation processing of subsequent command lines.", "", ".remember, .r",
 364           "   enables remember mode.  In remember mode, abbrev saves the expansion",
 365           "   of the last line that it has processed.  See the '.show' request.",
 366           ".rename old_name1 new_name1 ..., .rn old_name1 new_name1...",
 367           "   renames the given abbreviations.  If an abbreviation is already",
 368           "   defined, abbrev will query for permission to replace it.", ".show {LINE}, .s {LINE}",
 369           "   if LINE is given, displays the expansion of that line without",
 370           "   executing it.  If LINE is not given, displays the last line expanded.",
 371           ".switch_on switch_name names, .swn switch_name names",
 372           "   turns on the given switch in the definitions of the given",
 373           "   abbreviations.  See the 'abbrev' online help file for more details.",
 374           ".switch_off switch_name names, .swf switch_name names",
 375           "   turns off the given switch in the definitions of the given",
 376           "   abbreviations. See the 'abbrev' online help file for more details.", ".terminate_process",
 377           "   causes a fatal process error.  This request is intended for use ",
 378           "   only under special conditions. See the 'abbrev' online help file.", ".use {path}, .u {path}",
 379           "   changes the pathname of the profile segment.  The 'profile' suffix",
 380           "   is assumed.  If no {path} given, the default profile is used.");
 381 
 382 dcl  ard (46) char (19) varying static options (constant) init
 383                                                             /* control request literals table */
 384           (".", ".?", ". ", ".a", ".af", ".ab", ".abf", ".debug", ".delete", ".dl", ".d", ".edit", ".escape", ".esc",
 385           ".forget", ".f", ".l", ".la", ".lab", ".la^b", ".lb", ".l^b", ".ls", ".lsb", ".ls^b", ".lx", ".lxb", ".lx^b",
 386           ".probe", ".profile", ".p", ".quit", ".q", ".remember", ".r", ".rename", ".rn", ".show", ".s", ".switch_on",
 387           ".swn", ".switch_off", ".swf", ".terminate_process", ".use", ".u");
 388 
 389 dcl  ardx (46) fixed bin static options (constant) init     /* corresponding index into abbrev_rqd table */
 390           (1, 4, 7, 10, 10, 13, 13, 16, 19, 19, 19, 22, 25, 25, 28, 28, 31, 34, 37, 37, 40, 43, 46, 49, 49, 52, 55, 55,
 391           58, 61, 61, 64, 64, 67, 67, 70, 70, 73, 73, 76, 76, 79, 79, 82, 85, 85);
 392 %page;
 393 
 394 
 395 %page;
 396 /* abbrev command/AF:  As a command, establishes ourself as the command processor; as an active function, returns
 397    true/false if command line expansion is enabled/disabled, respectively.  If enabling abbrev and there was a previous
 398    call to set_cp_explicit, assume that the caller always wants us to call whatever command processor he provided */
 399 
 400 /* abbrev: ab: entry () options (variable); */
 401 
 402           if first_call then                                /* be sure static is setup */
 403                call initialize_abbrev_state ();
 404 
 405           call process_abbrev_command_or_af (cu_$arg_list_ptr ());
 406 
 407           return;
 408 
 409 
 410 
 411 /* Does the actual work of the abbrev command/AF to keep the main stack frame as small as possible */
 412 
 413 process_abbrev_command_or_af:
 414      procedure (p_argument_list) options (non_quick);
 415 
 416 dcl  p_argument_list pointer parameter;
 417 
 418 dcl  argument character (argument_lth) unaligned based (argument_ptr);
 419 dcl  argument_ptr pointer;
 420 dcl  argument_lth fixed binary (21);
 421 dcl  (n_arguments, argument_idx) fixed binary;
 422 
 423 dcl  return_string character (return_string_max_lth) varying based (return_string_ptr);
 424 dcl  return_string_max_lth fixed binary (21);
 425 dcl  return_string_ptr pointer;
 426 
 427 dcl  active_function bit (1) aligned;
 428 
 429 dcl  enable_abbrev bit (1) aligned;
 430 dcl  new_escape_character character (1) aligned;
 431 
 432 dcl  new_profile_dirname character (168);
 433 dcl  new_profile_ename character (32);
 434 dcl  new_profile_ptr pointer;
 435 dcl  created_here bit (1) aligned;
 436 dcl  try_to_create bit (1);
 437 
 438 
 439           call cu_$af_return_arg_rel (n_arguments, return_string_ptr, return_string_max_lth, code, p_argument_list);
 440 
 441           if code = 0 then active_function = "1"b;
 442 
 443           else if code = error_table_$not_act_fnc then active_function = "0"b;
 444 
 445           else do;                                          /* something wrong with the argument list header */
 446                call com_err_ (code, ABBREV);
 447                return;
 448           end;
 449 
 450 
 451           if active_function then do;                       /* tell user if abbrev is on/off */
 452                if n_arguments = 0 then                      /* ... but only if properly invoked */
 453                     if abbrev_state.set_cp then
 454                          return_string = "true";
 455                     else return_string = "false";
 456 
 457                else call active_fnc_err_$suppress_name (0, ABBREV, "Usage:  [^a]", ABBREV);
 458 
 459                return;
 460           end;
 461 
 462 
 463 /* Here iff invoked as a command */
 464 
 465           enable_abbrev = "1"b;                             /* turn abbreviation processing on by default */
 466           new_escape_character = abbrev_state.escape_character;
 467 
 468           new_profile_ptr = null ();                        /* for cleanup handler */
 469           created_here = "0"b;
 470 
 471           on condition (cleanup)
 472                begin;
 473                if new_profile_ptr ^= null () then
 474                     if created_here then
 475                          call terminate_file_ (new_profile_ptr, 0, TERM_FILE_DELETE, (0));
 476                     else call terminate_file_ (new_profile_ptr, 0, TERM_FILE_TERM, (0));
 477           end;
 478 
 479 
 480           do argument_idx = 1 to n_arguments;
 481 
 482                call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code, p_argument_list);
 483                if code ^= 0 then do;
 484                     call com_err_ (code, ABBREV, "Fetching argument #^d.", argument_idx);
 485                     go to RETURN_FROM_ABBREV_COMMAND;
 486                end;
 487 
 488                if index (argument, "-") = 1 then            /* a control argument ... */
 489                     if argument = "-on" then enable_abbrev = "1"b;
 490                     else if argument = "-off" then enable_abbrev = "0"b;
 491 
 492                     else if (argument = "-escape") | (argument = "-esc") then
 493                          if argument_idx = n_arguments then do;
 494                               call com_err_ (error_table_$noarg, ABBREV, "Escape character after ""^a"".", argument);
 495                               go to RETURN_FROM_ABBREV_COMMAND;
 496                          end;
 497                          else do;                           /* ... there is something following it */
 498                               argument_idx = argument_idx + 1;
 499                               call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code, p_argument_list);
 500                               if code ^= 0 then do;
 501                                    call com_err_ (code, ABBREV, "Fetching argument #^d.", argument_idx);
 502                                    go to RETURN_FROM_ABBREV_COMMAND;
 503                               end;
 504                               if length (rtrim (argument)) > length (abbrev_state.escape_character) then do;
 505                                    call com_err_ (0, ABBREV,
 506                                         "The escape sequence must be a single character; not ""^a"".", argument);
 507                                    go to RETURN_FROM_ABBREV_COMMAND;
 508                               end;
 509                               new_escape_character = argument;
 510                          end;
 511 
 512                     else if (argument = "-profile") | (argument = "-pf") then
 513                          if argument_idx = n_arguments then do;
 514                               call com_err_ (error_table_$noarg, ABBREV, "Profile pathname after ""^a"".", argument);
 515                               go to RETURN_FROM_ABBREV_COMMAND;
 516                          end;
 517                          else do;
 518                               argument_idx = argument_idx + 1;
 519                               call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code, p_argument_list);
 520                               if code ^= 0 then do;
 521                                    call com_err_ (code, ABBREV, "Fetching argument #^d.", argument_idx);
 522                                    go to RETURN_FROM_ABBREV_COMMAND;
 523                               end;
 524                               call expand_pathname_$add_suffix (argument, "profile", new_profile_dirname,
 525                                    new_profile_ename, code);
 526                               if code ^= 0 then do;
 527                                    call com_err_ (code, ABBREV, "^a", argument);
 528                                    go to RETURN_FROM_ABBREV_COMMAND;
 529                               end;
 530                               if new_profile_ptr ^= null () then
 531                                    if created_here then     /* ... there was a previous use of -profile ... */
 532                                         call terminate_file_ (new_profile_ptr, 0, TERM_FILE_DELETE, (0));
 533                                    else call terminate_file_ (new_profile_ptr, 0, TERM_FILE_TERM, (0));
 534                               created_here = "0"b;
 535                               call initiate_file_ (new_profile_dirname, new_profile_ename, R_ACCESS, new_profile_ptr, (0),
 536                                    code);
 537                               if code ^= 0 then             /* couldn't find it */
 538                                    if code = error_table_$noentry then do;
 539                                         call command_query_$yes_no (try_to_create, 0, ABBREV, "",
 540                                              "Profile ^a not found.  Do you want to create it?",
 541                                              pathname_ (new_profile_dirname, new_profile_ename));
 542                                         if try_to_create then
 543                                              call initiate_file_$create (new_profile_dirname, new_profile_ename,
 544                                                   RW_ACCESS, new_profile_ptr, created_here, (0), code);
 545                                         else go to RETURN_FROM_ABBREV_COMMAND;
 546                                                             /* user doesn't want to try */
 547                                    end;
 548                               if new_profile_ptr = null () then do;
 549                                    call com_err_ (code, ABBREV, "^a", pathname_ (new_profile_dirname, new_profile_ename));
 550                                    go to RETURN_FROM_ABBREV_COMMAND;
 551                               end;
 552                          end;
 553 
 554                     else do;
 555                          call com_err_ (error_table_$badopt, ABBREV, """^a""", argument);
 556                          go to RETURN_FROM_ABBREV_COMMAND;
 557                     end;
 558 
 559                else do;
 560                     call com_err_$suppress_name (0, ABBREV, "Usage:  ^a {-control_args}", ABBREV);
 561                     go to RETURN_FROM_ABBREV_COMMAND;
 562                end;
 563           end;
 564 
 565 
 566 /* Here iff all arguments are OK: enable/disable abbrev and switch profiles as requested */
 567 
 568           abbrev_state.escape_character = new_escape_character;
 569 
 570           if enable_abbrev then                             /* turn on abbreviation processing ... */
 571                if ^abbrev_state.set_cp then do;             /* ... if it wasn't already in use */
 572                     call cu_$get_command_processor (cp_variable);
 573                     if cp_variable ^= abbrev_processor then do;
 574                                                             /* ... avoid infinite recursion if we're already enabled */
 575                          abbrev_state.previous_command_processor = cp_variable;
 576                          if ^abbrev_state.set_cp_explicit then abbrev_state.command_processor = cp_variable;
 577                                                             /* ... don't override the explicitly set processor */
 578                          call cu_$set_command_processor (abbrev_processor);
 579                          abbrev_state.set_cp = "1"b;        /* ... have set ourselves up now */
 580                     end;
 581                end;
 582 
 583                else ;                                       /* ... it was already on so this is a no-op */
 584 
 585           else do;                                          /* turn abbrev off ... */
 586                if abbrev_state.set_cp then do;              /* ... and we are the command processor */
 587                     call cu_$set_command_processor (abbrev_state.previous_command_processor);
 588                     abbrev_state.set_cp = "0"b;
 589                end;
 590                if abbrev_state.profile_ptr ^= null () then  /* ... don't need it any more */
 591                     call terminate_file_ (abbrev_state.profile_ptr, 0, TERM_FILE_TERM, (0));
 592           end;
 593 
 594           if new_profile_ptr ^= null () then do;            /* switch to the requested profile */
 595                if abbrev_state.profile_ptr ^= null () then
 596                     call terminate_file_ (abbrev_state.profile_ptr, 0, TERM_FILE_TERM, (0));
 597                abbrev_state.profile_ptr, ap_ptr = new_profile_ptr;
 598                new_profile_ptr = null ();                   /* avoid accidently terminating what is now the profile */
 599                expansion_temp_segment_ptr = null ();        /* in case initialize_profile fails ... */
 600                have_return_code = "0"b;                     /* ... */
 601                call initialize_profile (^created_here, created_here);
 602           end;
 603 
 604 RETURN_FROM_ABBREV_COMMAND:
 605           if new_profile_ptr ^= null () then
 606                if created_here then
 607                     call terminate_file_ (new_profile_ptr, 0, TERM_FILE_DELETE, (0));
 608                else call terminate_file_ (new_profile_ptr, 0, TERM_FILE_TERM, (0));
 609 
 610           return;
 611 
 612      end process_abbrev_command_or_af;
 613 %page;
 614 /* Return the current version of abbrev for use by use_exl_abbrev */
 615 
 616 get_version:
 617      entry () returns (character (32));
 618 
 619           return (abbrev_data_$version);
 620 %page;
 621 /* Provide an explicit entry for abbrev to use as the command processor: overrides whatever entry the abbrev command
 622    establishes as the previous command processor */
 623 
 624 set_cp:
 625      entry (P_command_processor);
 626 
 627           if first_call then call initialize_abbrev_state ();
 628 
 629           if codeptr (P_command_processor) = null () then   /* use the default command processor */
 630                abbrev_state.command_processor = command_processor_;
 631           else abbrev_state.command_processor = P_command_processor;
 632 
 633           abbrev_state.set_cp_explicit = "1"b;              /* override the abbrev command */
 634 
 635           return;
 636 %page;
 637 /* Adds the given characters as break characters */
 638 
 639 set_break:
 640      entry (P_breaks);
 641 
 642           if first_call then call initialize_abbrev_state ();
 643 
 644           call add_breaks (P_breaks);
 645 
 646           return;
 647 
 648 
 649 
 650 /* Do the actual work in an internal procedure to save space on the main procedure's stack */
 651 
 652 add_breaks:
 653      procedure (p_breaks) options (non_quick);
 654 
 655 dcl  p_breaks character (*) parameter;
 656 dcl  current_breaks character (128) varying;
 657 dcl  break_character character (1) aligned;
 658 dcl  (idx, jdx) fixed binary (21);
 659 dcl  added bit (1) aligned;
 660 
 661           if abbrev_state.default_breaks then               /* everything but "::" due to deficiencies of the interface */
 662                current_breaks = before (DEFAULT_BREAKS, ":") || after (DEFAULT_BREAKS, ":");
 663           else current_breaks = abbrev_state.user_breaks;
 664 
 665           do idx = 1 to length (p_breaks);
 666                break_character = substr (p_breaks, idx, 1);
 667                if break_character <= high (1) then do;      /* only if it's ASCII ... */
 668                     added = "0"b;
 669                     do jdx = 1 to length (current_breaks) while (^added);
 670                          if substr (current_breaks, jdx, 1) = break_character then added = "1"b;
 671                          else if substr (current_breaks, jdx, 1) > break_character then do;
 672                               current_breaks =
 673                                    substr (current_breaks, 1, (jdx - 1)) || break_character
 674                                    || substr (current_breaks, jdx);
 675                               added = "1"b;
 676                          end;
 677                     end;
 678                     if ^added then                          /* wasn't added in the middle: stick it on the end */
 679                          current_breaks = current_breaks || break_character;
 680                end;
 681           end;
 682 
 683           call set_user_breaks (current_breaks);
 684 
 685           return;
 686 
 687      end add_breaks;
 688 %page;
 689 /* Deletes the given characters from the list of break characters */
 690 
 691 reset_break:
 692      entry (P_breaks);
 693 
 694           if first_call then call initialize_abbrev_state ();
 695 
 696           call delete_breaks (P_breaks);
 697 
 698           return;
 699 
 700 
 701 
 702 /* Do the actual work in an internal procedure to save space on the main procedure's stack */
 703 
 704 delete_breaks:
 705      procedure (p_breaks) options (non_quick);
 706 
 707 dcl  p_breaks character (*) parameter;
 708 dcl  current_breaks character (128) varying;
 709 dcl  break_character character (1) aligned;
 710 dcl  (idx, jdx) fixed binary (21);
 711 dcl  deleted bit (1) aligned;
 712 
 713           if abbrev_state.default_breaks then               /* everything but "::" due to deficiencies of the interface */
 714                current_breaks = before (DEFAULT_BREAKS, ":") || after (DEFAULT_BREAKS, ":");
 715           else current_breaks = abbrev_state.user_breaks;
 716 
 717           do idx = 1 to length (p_breaks);
 718                break_character = substr (p_breaks, idx, 1);
 719                deleted = "0"b;
 720                do jdx = 1 to length (current_breaks) while (^deleted);
 721                     if substr (current_breaks, jdx, 1) = break_character then do;
 722                          current_breaks = substr (current_breaks, 1, (jdx - 1)) || substr (current_breaks, (jdx + 1));
 723                          deleted = "1"b;
 724                     end;
 725                end;
 726           end;
 727 
 728           call set_user_breaks (current_breaks);            /* still not the default: build the appropriate TCT table */
 729 
 730           return;
 731 
 732      end delete_breaks;
 733 %page;
 734 /* Sets the break sequences used by abbrev to the individual characters in the supplied string */
 735 
 736 set_user_breaks:
 737      procedure (p_new_breaks) options (non_quick);
 738 
 739 dcl  p_new_breaks character (128) varying parameter;
 740 dcl  idx fixed binary;
 741 
 742           system_area_ptr = get_system_free_area_ ();
 743 
 744           if ^abbrev_state.default_breaks then free breaks_list in (system_area);
 745 
 746           breaks_list_n_break_sequences, breaks_list_break_strings_lth = length (p_new_breaks);
 747           allocate breaks_list in (system_area) set (abbrev_state.breaks_list_ptr);
 748                                                             /* nothing but single character break sequences */
 749 
 750           abbrev_state.user_breaks, breaks_list.break_strings = p_new_breaks;
 751 
 752           abbrev_state.tct_table = low (length (abbrev_state.tct_table));
 753 
 754           do idx = 1 to length (abbrev_state.user_breaks);
 755                abbrev_state_tct_table_as_binary (rank (substr (abbrev_state.user_breaks, idx, 1))) = idx;
 756                breaks_list.break_sequences (idx).start = idx;
 757                breaks_list.break_sequences (idx).lth = 1;
 758           end;
 759 
 760           abbrev_state.default_breaks = "0"b;               /* no longer using the default */
 761 
 762           return;
 763 
 764      end set_user_breaks;
 765 %page;
 766 /* Initialize abbrev's internal state */
 767 
 768 initialize_abbrev_state:
 769      procedure () /* options (quick) */;
 770 
 771           code = codeptr (debug) -> based_word;             /* snap the links */
 772           debug_entry_variable = debug;
 773 
 774           code = codeptr (probe) -> based_word;             /* ... in case the linker gets wedged */
 775           probe_entry_variable = probe;
 776 
 777           string (abbrev_state.flags) = ""b;                /* turn them all off ... */
 778           abbrev_state.default_breaks = "1"b;               /* ... except that we use the default breaks */
 779 
 780           abbrev_state.profile_ptr = null ();
 781 
 782           abbrev_state.remembered_line_buffer_ptr = null ();
 783           abbrev_state.remembered_line_buffer_lth, abbrev_state.remembered_line_lth = 0;
 784 
 785           abbrev_state.escape_character = DEFAULT_ABBREV_ESCAPE_CHARACTER;
 786 
 787           abbrev_state.tct_table = abbrev_data_$default_breaks_tct_table;
 788           abbrev_state.breaks_list_ptr = addr (abbrev_data_$default_breaks_list);
 789 
 790           first_call = "0"b;
 791 
 792           return;
 793 
 794      end initialize_abbrev_state;
 795 %page;
 796 /* Command processor interface: called via cu_$cp to process a command line */
 797 
 798 abbrev_:
 799 abbrev_processor:
 800      entry (P_input_line_ptr, P_input_line_lth, P_code);
 801 
 802           abbrev_type = EXPAND_BOTH;
 803 
 804           input_line_ptr = P_input_line_ptr;
 805           input_line_lth = P_input_line_lth;
 806 
 807           subsystem_entry = "0"b;
 808           return_expansion = "0"b;
 809           allow_request_lines, have_return_code = "1"b;
 810 
 811           go to EXPAND_COMMON;
 812 
 813 
 814 
 815 /* Subsystem request processor interface: called directly by ssu_$listen to expand and execute a subsystem request line */
 816 
 817 subsys_process_line:
 818      entry (P_subsystem_name, P_sci_ptr, P_execute_request, P_subsys_cp_info_ptr, P_subsys_cp, P_default_profile_ptr,
 819           P_profile_ptr, P_request_line, P_code);
 820 
 821           abbrev_type = EXPAND_BOTH;
 822 
 823           input_line_ptr = addr (P_request_line);
 824           input_line_lth = length (P_request_line);
 825 
 826           subsystem_entry = "1"b;
 827           return_expansion = "0"b;
 828           allow_request_lines, have_return_code = "1"b;
 829 
 830           go to EXPAND_COMMON;
 831 
 832 
 833 /* Expand only a selected abbrev type and return it to the caller */
 834 
 835 abbrev_$expand_line:
 836      entry (P_abbrev_type, P_input_line_ptr, P_input_line_lth, P_workspace_ptr, P_workspace_lth, P_output_line_ptr,
 837           P_output_line_lth);
 838 
 839           abbrev_type = P_abbrev_type;
 840           goto EXPANDED_LINE;
 841 
 842 
 843 /* Expand a line and return it to the caller */
 844 
 845 abbrev_$expanded_line:                                      /* avoids PL/I naming rules */
 846      entry (P_input_line_ptr, P_input_line_lth, P_workspace_ptr, P_workspace_lth, P_output_line_ptr, P_output_line_lth);
 847 
 848           abbrev_type = EXPAND_BOTH;
 849 
 850 EXPANDED_LINE:
 851           input_line_ptr = P_input_line_ptr;
 852           input_line_lth = P_input_line_lth;
 853 
 854           subsystem_entry = "0"b;
 855           return_expansion = "1"b;
 856           allow_request_lines, have_return_code = "0"b;
 857 
 858           go to EXPAND_COMMON;
 859 
 860 
 861 /* Actual expansion starts here */
 862 
 863 EXPAND_COMMON:
 864           if first_call then call initialize_abbrev_state ();
 865 
 866           if ^abbrev_state.set_cp & ^abbrev_state.set_cp_explicit then
 867                call cu_$get_command_processor (abbrev_state.command_processor);
 868                                                             /* no one had yet set a command processor to call */
 869 
 870           code = 0;                                         /* assume success */
 871 
 872           system_area_ptr = get_system_free_area_ ();
 873 
 874           extended_stack, used_temp_segment, null_line = "0"b;
 875           expansion_stack_space_lth = 0;                    /* haven't extended the stack ... */
 876           expansion_temp_segment_ptr = null ();             /* ... or used a temp seg yet */
 877 
 878           if input_line_lth = 0 then do;                    /* special case zero-length lines: avoids faults... */
 879                null_line = "1"b;                            /* don't remember this line if in ".r" mode */
 880 EXPANSION_IS_INPUT_LINE:
 881                expanded_line_ptr = input_line_ptr;
 882                expanded_line_lth = input_line_lth;
 883                go to EXPANSION_COMPLETED;
 884           end;
 885 
 886           start = verify (input_line, WHITE_SPACE_AND_NL);  /* "strip" leading white space */
 887 
 888           if start = 0 then do;                             /* all whitespace ... */
 889                null_line = "1"b;
 890                go to EXPANSION_IS_INPUT_LINE;
 891           end;
 892 
 893 
 894 /* format: off */
 895 
 896 /* Check for the ".." escape here as the user might have changed the escape character:
 897       "..": pass the rest of the line to the current command processor; this request allows typeahead of command lines
 898       when one isn't sure if a subsystem or Multics proper will read the line in question */
 899 
 900 /* format: on */
 901 
 902           if allow_request_lines & ^subsystem_entry then    /* only if we'll call cu_$cp eventually ... */
 903                if input_line_lth > (start + 1) then         /* ... and there's enough on the line to allow ".." ... */
 904                     if substr (input_line, start, 2) = ".." then do;
 905                          call cu_$cp (addcharno (input_line_ptr, (start + 1)), (input_line_lth - start - 1), code);
 906                          go to RETURN_FROM_ABBREV_PROCESSOR;/* ... reflect execution's error code to caller */
 907                     end;
 908 
 909 
 910 /* Check for and process abbrev request lines */
 911 
 912           if (substr (input_line, start, 1) = abbrev_state.escape_character) then
 913                                                             /* a request line ... */
 914                if allow_request_lines then do;              /* ... and request lines are OK */
 915                     call process_request_line ();
 916                     code = 0;                               /* requests ALWAYS "work" */
 917                     go to RETURN_FROM_ABBREV_PROCESSOR;
 918                end;
 919 
 920                else go to EXPANSION_IS_INPUT_LINE;          /* ... no request lines: just give it back */
 921 
 922 
 923 /* Non-request line: expand the line, remember it (if appropriate), and execute/return it */
 924 
 925           call set_profile_ptr (return_expansion);          /* will need the profile for certain now */
 926 
 927           if return_expansion & (ap_ptr = null ()) then     /* no profile to expand the line with ... */
 928                go to EXPANSION_IS_INPUT_LINE;
 929 
 930           on condition (cleanup)
 931                begin;
 932                if expansion_temp_segment_ptr ^= null () then
 933                     call release_temp_segment_ (ABBREV, expansion_temp_segment_ptr, (0));
 934           end;
 935 
 936           call expand_line (abbrev_type, start);            /* grows our stack frame */
 937 
 938 EXPANSION_COMPLETED:
 939           if return_expansion then do;                      /* expanded_line entry ... */
 940                if expanded_line_lth <= P_workspace_lth then /* ... fits into caller's buffer */
 941                     P_output_line_ptr = P_workspace_ptr;
 942                else allocate expanded_line in (system_area) set (P_output_line_ptr);
 943                P_output_line_lth = expanded_line_lth;
 944                P_output_line = expanded_line;
 945                go to RETURN_FROM_ABBREV_PROCESSOR;
 946           end;
 947 
 948           if abbrev_state.remember_lines & ^null_line then do;
 949                if abbrev_state.remembered_line_buffer_lth < expanded_line_lth then do;
 950                     if abbrev_state.remembered_line_buffer_ptr ^= null () then
 951                          free remembered_line_buffer in (system_area);
 952                     abbrev_state.remembered_line_buffer_lth = 128 * divide (expanded_line_lth + 127, 128, 21, 0);
 953                     allocate remembered_line_buffer in (system_area) set (abbrev_state.remembered_line_buffer_ptr);
 954                end;
 955                abbrev_state.remembered_line_lth = expanded_line_lth;
 956                remembered_line = expanded_line;
 957           end;
 958 
 959           if subsystem_entry then
 960                call P_subsys_cp (P_subsystem_name, P_sci_ptr, P_execute_request, P_subsys_cp_info_ptr, expanded_line,
 961                     code);
 962           else call abbrev_state.command_processor (expanded_line_ptr, expanded_line_lth, code);
 963 
 964 
 965 RETURN_FROM_ABBREV_PROCESSOR:
 966           if expansion_temp_segment_ptr ^= null () then
 967                call release_temp_segment_ (ABBREV, expansion_temp_segment_ptr, (0));
 968 
 969           if have_return_code then                          /* let the caller know how we did */
 970                P_code = code;
 971 
 972           return;
 973 %page;
 974 /* Returns the pathname of a profile */
 975 
 976 profile_pathname:
 977      procedure () returns (character (168)) options (non_quick);
 978 
 979 dcl  profile_dirname character (168);
 980 dcl  profile_ename character (32);
 981 
 982           call hcs_$fs_get_path_name (ap_ptr, profile_dirname, (0), profile_ename, (0));
 983 
 984           return (pathname_ (profile_dirname, profile_ename));
 985 
 986      end profile_pathname;
 987 
 988 
 989 
 990 /* Aborts abbrev with the given error message: if command level is using the profile identified by ap_ptr, abbreviation
 991    processing is turned off as this entry is only called when said profile is unusable */
 992 
 993 abort_abbrev_processor:
 994      procedure (p_code, p_message, p_pathname) options (non_quick);
 995 
 996 dcl  p_code fixed binary (35) parameter;
 997 dcl  (p_message, p_pathname) character (*) parameter;
 998 
 999           if ap_ptr = abbrev_state.profile_ptr then do;     /* command level was using this profile */
1000                if abbrev_state.set_cp then do;              /* ... and we are the command processor */
1001                     call cu_$set_command_processor (abbrev_state.previous_command_processor);
1002                     abbrev_state.set_cp = "0"b;
1003                end;
1004                if ap_ptr ^= null () then                    /* ... don't need it any more */
1005                     call terminate_file_ (ap_ptr, 0, TERM_FILE_TERM, (0));
1006                abbrev_state.profile_ptr = null ();          /* ... no longer have a profile */
1007           end;
1008 
1009           call com_err_ (p_code, ABBREV, p_message, p_pathname);
1010 
1011           code = p_code;                                    /* make sure right error gets back to caller */
1012 
1013           go to RETURN_FROM_ABBREV_PROCESSOR;
1014 
1015      end abort_abbrev_processor;
1016 %page;
1017 /* Sets ap_ptr to locate the proper profile to be used for expansion in this case: initializes the profile if necessary;
1018    two versions of this procedure exist to insure that this one is quick */
1019 
1020 set_profile_ptr:
1021      procedure (p_dont_create_profile) /* options (quick) */;
1022 
1023 dcl  p_dont_create_profile bit (1) aligned;
1024 
1025           ap_ptr = null ();                                 /* start somewhere */
1026 
1027           if subsystem_entry then                           /* subsystems use arbitrary profiles */
1028                if (P_default_profile_ptr = null ()) & (P_profile_ptr = null ()) then
1029                                                             /* ... use same profile as Multics command level */
1030                     if abbrev_state.profile_ptr = null () then
1031                          call get_default_profile (p_dont_create_profile);
1032                                                             /* ... need not succeed if called at expanded_line entry */
1033                     else ap_ptr = abbrev_state.profile_ptr;
1034 
1035                else do;                                     /* subsystem supplied the profile */
1036                     if P_profile_ptr ^= null () then
1037                          ap_ptr = P_profile_ptr;
1038                     else ap_ptr = P_default_profile_ptr;
1039                     call initialize_profile ("1"b, "0"b);   /* ... make sure it's good */
1040                end;
1041 
1042           else do;                                          /* command level invocation */
1043                if abbrev_state.profile_ptr = null () then
1044                     call get_default_profile (p_dont_create_profile);
1045                                                             /* ... need not succeed if called at expanded_line entry */
1046                else ap_ptr = abbrev_state.profile_ptr;
1047           end;
1048 
1049           return;
1050 
1051      end set_profile_ptr;
1052 %page;
1053 /* Sets the profile used by Multics command level to the default profile segment (Person.profile in the home directory):
1054    creates the profile if request or prints an error message and disables abbrev processing if invoked to expand and
1055    execute a command/request line */
1056 
1057 get_default_profile:
1058      procedure (p_dont_create_profile) options (non_quick);
1059 
1060 dcl  p_dont_create_profile bit (1) aligned parameter;
1061 dcl  profile_dirname character (168);
1062 dcl  (profile_ename, person_id) character (32);
1063 dcl  created_here bit (1) aligned;
1064 
1065           call user_info_ (person_id);
1066           call user_info_$homedir (profile_dirname);
1067 
1068           profile_ename = rtrim (person_id) || ".profile";
1069 
1070           created_here = "0"b;
1071 
1072           call initiate_file_ (profile_dirname, profile_ename, R_ACCESS, abbrev_state.profile_ptr, (0), code);
1073 
1074           if code = error_table_$noentry then               /* not found ... */
1075                if p_dont_create_profile then
1076                     return;                                 /* ... but that's OK */
1077                else do;                                     /* ... must be able to create it */
1078                     call initiate_file_$create (profile_dirname, profile_ename, RW_ACCESS, abbrev_state.profile_ptr,
1079                          created_here, (0), code);
1080                     if code ^= 0 then
1081                          call abort_abbrev_processor (code, "Profile ^a could not be created.",
1082                               pathname_ (profile_dirname, profile_ename));
1083                end;
1084 
1085           else if code ^= 0 then                            /* wrong access, etc... */
1086                call abort_abbrev_processor (code, "^a", pathname_ (profile_dirname, profile_ename));
1087 
1088           ap_ptr = abbrev_state.profile_ptr;                /* got it */
1089 
1090           call initialize_profile ("1"b, created_here);     /* make sure it's OK */
1091 
1092           return;
1093 
1094      end get_default_profile;
1095 %page;
1096 /* Insure that a profile segment has been properly initialized */
1097 
1098 initialize_profile:
1099      procedure (p_announce, p_created_or_initialized) options (non_quick);
1100 
1101 dcl  p_announce bit (1) aligned parameter;
1102 dcl  p_created_or_initialized bit (1) aligned parameter;
1103 dcl  profile_mode fixed binary (5);
1104 
1105           if abbrev_profile.version > 127 then              /* older style: garbage collection will fix it */
1106                call compact_profile ();
1107 
1108           call hcs_$fs_get_mode (ap_ptr, profile_mode, code);
1109           if code ^= 0 then                                 /* have to be able to determine our access */
1110                call abort_abbrev_processor (code, "Can not determine access to profile ^a", profile_pathname ());
1111 
1112           if abbrev_profile.next_free = 0 then              /* freshly created profile */
1113                if (profile_mode = RW_ACCESS_BIN) | (profile_mode = REW_ACCESS_BIN) then do;
1114                     if p_announce then
1115                          call ioa_ ("^a: Profile ^a ^[created^;initialized^].", ABBREV, profile_pathname (),
1116                               p_created_or_initialized);
1117                     abbrev_profile.version = ABBREV_PROFILE_VERSION_1;
1118                     abbrev_profile.next_free = fixed (rel (addr (abbrev_profile.data_space)), 18, 0);
1119                     call terminate_file_ (ap_ptr, (36 * abbrev_profile.next_free), TERM_FILE_TRUNC_BC, (0));
1120                end;                                         /* truncate and set bit count in case it contained garbage */
1121 
1122                else call abort_abbrev_processor (error_table_$moderr, "Can not complete initialization of profile ^a",
1123                          profile_pathname ());
1124 
1125           else if abbrev_profile.version = 0 then           /* simple upgrade to version 1 */
1126                if (profile_mode = RW_ACCESS_BIN) | (profile_mode = REW_ACCESS_BIN) then
1127                     abbrev_profile.version = ABBREV_PROFILE_VERSION_1;
1128 
1129           return;
1130 
1131      end initialize_profile;
1132 %page;
1133 /* Expands a line: if any expansion actually occurs, the caller's stack frame is expanded to hold the result; if the
1134    expanded string exceeds 16K characters, it is placed in a temporary segment instead */
1135 
1136 expand_line:
1137      procedure (p_abbrev_type, p_start) /* options (quick) */;
1138 
1139 dcl  p_abbrev_type fixed bin;                               /* get the type of abbreviations to expand */
1140 dcl  p_start fixed binary (21) parameter;                   /* where in line to start expansion */
1141 
1142 dcl  abbrev_name character (8) aligned;
1143 dcl  break_character character (1) aligned;
1144 dcl  (recognize_bol_abbrevs, need_break_sequence, found_end) bit (1) aligned;
1145 dcl  (start, last_copied_idx, last_expanded_idx, last_quote_idx, break_idx, idx) fixed binary (21);
1146 dcl  break_lth fixed binary;
1147 
1148           expanded_line_ptr = input_line_ptr;               /* assume we don't have to copy/expand it at all */
1149           expanded_line_lth = input_line_lth;
1150 
1151           last_copied_idx = 0;                              /* haven't copied any of the line yet */
1152           last_expanded_idx = 0;
1153 
1154           recognize_bol_abbrevs = "1"b;
1155 
1156           start = p_start;
1157 
1158           do while (start <= input_line_lth);
1159 
1160                begin;
1161 
1162 dcl  rest_of_line character (input_line_lth - start + 1) unaligned defined (input_line) position (start);
1163 
1164                     need_break_sequence = "1"b;             /* find next break sequence */
1165                     break_idx, break_lth = 0;               /* no break sequence yet */
1166                     do while (need_break_sequence & (break_idx <= length (rest_of_line)));
1167                          begin;
1168 dcl  rest_of_rest_of_line character (length (rest_of_line) - break_idx) unaligned defined (input_line)
1169           position (start + break_idx);
1170                               if abbrev_state.default_breaks then
1171                                    idx = search (rest_of_rest_of_line, DEFAULT_BREAKS);
1172                               else idx = find_char_$first_in_table (rest_of_rest_of_line, abbrev_state.tct_table);
1173                          end;
1174                          if idx = 0 then                    /* no more break sequences present */
1175                               break_idx = length (rest_of_line) + 1;
1176                          else do;                           /* a possibility */
1177                               break_idx = break_idx + idx;
1178                               break_character = substr (rest_of_line, break_idx, 1);
1179                                                             /* format: off */
1180                               do idx = abbrev_state_tct_table_as_binary (rank (break_character))
1181                                         to breaks_list.n_break_sequences
1182                                         while (need_break_sequence &
1183                                                (substr (breaks_list.break_strings,
1184                                                         breaks_list.break_sequences (idx).start, 1) =
1185                                                 break_character));
1186                                    if (break_idx + breaks_list.break_sequences (idx).lth - 1) <= length (rest_of_line) then
1187                                         if substr (rest_of_line, break_idx, breaks_list.break_sequences (idx).lth) =
1188                                            substr (breaks_list.break_strings, breaks_list.break_sequences (idx).start,
1189                                                    breaks_list.break_sequences (idx).lth)
1190                                         then do;            /* found it */
1191                                              need_break_sequence = "0"b;
1192                                              break_lth = breaks_list.break_sequences (idx).lth;
1193                                         end;
1194                               end;                          /* format: on */
1195                          end;
1196                     end;
1197 
1198                     if break_idx > 1 then do;               /* check for an abbreviation */
1199                          if break_idx <= (length (ape.name) + 1) then do;
1200                               abbrev_name = substr (rest_of_line, 1, (break_idx - 1));
1201                               ape_ptr = lookup_abbrev ();
1202                               if ape_ptr ^= null () then    /* found one */
1203                                    if (recognize_bol_abbrevs & ape.bol & (p_abbrev_type ^= EXPAND_INTERNAL_ONLY))
1204                                         | (^ape.bol & (p_abbrev_type ^= EXPAND_BOL_ONLY)) then do;
1205                                         begin;
1206 dcl  uncopied_text character (start - last_copied_idx - 1) unaligned defined (input_line) position (last_copied_idx + 1);
1207                                              call make_space (length (uncopied_text) + ape.value_lth);
1208                                              expanded_line_lth = expanded_line_lth + length (uncopied_text);
1209                                              substr (expanded_line, (last_expanded_idx + 1), length (uncopied_text)) =
1210                                                   uncopied_text;
1211                                              last_expanded_idx = last_expanded_idx + length (uncopied_text);
1212                                              last_copied_idx = last_copied_idx + length (uncopied_text);
1213                                         end;                /* just copied in the previously uncopied text */
1214 
1215                                         expanded_line_lth = expanded_line_lth + ape.value_lth;
1216                                         substr (expanded_line, (last_expanded_idx + 1), ape.value_lth) = ape.value;
1217                                         last_expanded_idx = last_expanded_idx + ape.value_lth;
1218                                         expanded_line_lth = last_expanded_idx;
1219                                         last_copied_idx = last_copied_idx + break_idx - 1;
1220                                    end;                     /* just "copied" in the abbrev */
1221                          end;
1222                          recognize_bol_abbrevs = "0"b;      /* not anymore */
1223                     end;
1224                end;
1225 
1226                start = start + break_idx + break_lth - 1;   /* to character after the break sequence */
1227 
1228                if start <= input_line_lth then do;          /* something left on line: check special characters */
1229 
1230                     if ape_ptr ^= null () then do;
1231                          if substr (ltrim (reverse (expanded_line)), 1, length (SEMICOLON)) = SEMICOLON
1232                               | substr (ltrim (reverse (expanded_line)), 1, length (LEFT_BRACKET)) = LEFT_BRACKET
1233                               | substr (ltrim (reverse (expanded_line)), 1, length (VERTICAL_BAR || SEMICOLON))
1234                               = VERTICAL_BAR || SEMICOLON then
1235                               recognize_bol_abbrevs = "1"b;
1236                     end;
1237 
1238                     if (start - 1) > 0 then                 /* ... don't reference off the end */
1239                          break_character = substr (input_line, (start - 1), 1);
1240                     else break_character = SP;              /* ... assume a space before the line */
1241                     if (break_character = NL) | (break_character = SEMICOLON) | (break_character = LEFT_BRACKET) then
1242                          recognize_bol_abbrevs = "1"b;
1243                     else if (break_character = VERTICAL_BAR) then do;
1244                          if substr (input_line, (start - length (SEMICOLON || VERTICAL_BAR)), length (SEMICOLON))
1245                               = SEMICOLON then
1246                               recognize_bol_abbrevs = "1"b;
1247                     end;
1248 
1249                     else recognize_bol_abbrevs = recognize_bol_abbrevs & (index (WHITE_SPACE, break_character) ^= 0);
1250                     if break_character = QUOTE then do;
1251                          begin;
1252 dcl  rest_of_line character (input_line_lth - start + 1) unaligned defined (input_line) position (start);
1253                               found_end = "0"b;             /* a quoted string: ignore everything inside it */
1254                               last_quote_idx = 0;
1255                               do while (^found_end);
1256                                    begin;
1257 dcl  rest_of_rest_of_line character (length (rest_of_line) - last_quote_idx) unaligned defined (input_line)
1258           position (start + last_quote_idx);
1259                                         idx = index (rest_of_rest_of_line, QUOTE);
1260                                         if idx = 0 then idx = length (rest_of_rest_of_line) + 1;
1261                                         if (idx + 1) <= length (rest_of_rest_of_line) then
1262                                              if substr (rest_of_rest_of_line, (idx + 1), 1) = QUOTE then
1263                                                   last_quote_idx = last_quote_idx + idx + 1;
1264                                              else do;
1265                                                   last_quote_idx = last_quote_idx + idx;
1266                                                   found_end = "1"b;
1267                                              end;
1268                                         else do;            /* unbalanced quotes */
1269                                              last_quote_idx = length (rest_of_line) + 1;
1270                                              found_end = "1"b;
1271                                         end;
1272                                    end;
1273                               end;
1274                          end;
1275                          start = start + last_quote_idx;
1276                     end;
1277                end;
1278           end;
1279 
1280           if extended_stack | used_temp_segment then do;    /* had to copy user's input */
1281                begin;
1282 dcl  uncopied_text character (input_line_lth - last_copied_idx) unaligned defined (input_line)
1283           position (last_copied_idx + 1);
1284                     call make_space (length (uncopied_text));
1285 
1286                     expanded_line_lth = expanded_line_lth + length (uncopied_text);
1287                     substr (expanded_line, (last_expanded_idx + 1), length (uncopied_text)) = uncopied_text;
1288                     last_expanded_idx = last_expanded_idx + length (uncopied_text);
1289                end;
1290                expanded_line_lth = last_expanded_idx;
1291           end;
1292 
1293           return;
1294 %page;
1295 /* Searches the profile for an abbreviation (internal to expand_line): two versions of this procedure exist to insure that
1296    this one is quick */
1297 
1298 lookup_abbrev:
1299           procedure () returns (pointer) /* options (quick) */;
1300 
1301 dcl  offset fixed binary (18);
1302 
1303                do offset = abbrev_profile.hash_table (rank (substr (abbrev_name, 1, 1))) repeat (ape.next)
1304                     while (offset ^= 0);
1305                     ape_ptr = pointer (ap_ptr, offset);
1306                     if ape.name = abbrev_name then return (ape_ptr);
1307                end;
1308 
1309                return (null ());                            /* here iff not found */
1310 
1311           end lookup_abbrev;
1312 %page;
1313 /* Insures that there is sufficient room either in the stack extension or in the temporary segment to add the requested
1314    number of characters to the current expansion of the command/request line (internal to expand_line) */
1315 
1316 make_space:
1317           procedure (p_amount) /* options (quick) */;
1318 
1319 dcl  p_amount fixed binary (21) parameter;
1320 dcl  extension_ptr pointer;
1321 dcl  new_size fixed binary (21);
1322 dcl  amount_to_grow fixed binary (18);
1323 
1324                new_size = last_expanded_idx + p_amount;
1325 
1326                if (new_size <= MAX_STACK_EXTENSION) & ^used_temp_segment then
1327                     if new_size > expansion_stack_space_lth then do;
1328                          amount_to_grow =                   /* double extension or enough room to cover the new piece */
1329                               16 * divide ((max (expansion_stack_space_lth, p_amount) + 63), 64, 18, 0);
1330                          call cu_$grow_stack_frame (amount_to_grow, extension_ptr, code);
1331                          if code ^= 0 then go to USE_TEMP_SEGMENT;
1332                          if ^extended_stack then do;        /* first time: don't set these variables unless ... */
1333                               extended_stack = "1"b;        /* ... cu_$grow_stack_frame succeeds */
1334                               expansion_stack_space_ptr, expanded_line_ptr = extension_ptr;
1335                               expanded_line_lth = 0;
1336                          end;
1337                          expansion_stack_space_lth = expansion_stack_space_lth + (4 * amount_to_grow);
1338                     end;
1339                     else ;                                  /* already using stack extension and its still big enough */
1340 
1341                else if new_size <= length (expansion_temp_segment) then
1342 USE_TEMP_SEGMENT:                                           /* try to use a segment for the expansion */
1343                     if ^used_temp_segment then do;          /* ... first time: get the segment ... */
1344                          call get_temp_segment_ (ABBREV, expansion_temp_segment_ptr, code);
1345                          if code ^= 0 then go to RETURN_FROM_ABBREV_PROCESSOR;
1346                          if extended_stack then do;         /* ... and copy whatever was on the stack */
1347                               substr (expansion_temp_segment_ptr -> expanded_line, 1, last_expanded_idx) =
1348                                    substr (expansion_stack_space_ptr -> expanded_line, 1, last_expanded_idx);
1349                               call cu_$shrink_stack_frame (expansion_stack_space_ptr, (0));
1350                               extended_stack = "0"b;
1351                          end;
1352                          expanded_line_ptr = expansion_temp_segment_ptr;
1353                          used_temp_segment = "1"b;
1354                     end;
1355                     else ;                                  /* already using the temporary segment */
1356 
1357                else do;                                     /* expansion won't fit into a segment */
1358                     code = error_table_$command_line_overflow;
1359                     go to RETURN_FROM_ABBREV_PROCESSOR;
1360                end;
1361 
1362                return;
1363 
1364           end make_space;
1365 
1366      end;
1367 %page;
1368 /* Process an abbrev request line */
1369 
1370 process_request_line:
1371      procedure () options (non_quick);
1372 
1373 dcl  profile_dirname character (168);
1374 dcl  (request_name, token, profile_ename) character (32);
1375 dcl  new_escape_character character (1) aligned;
1376 dcl  used fixed binary (21);
1377 
1378 
1379           start = start + 1;                                /* pass over the request character */
1380 
1381           input_line_lth = length (rtrim (input_line, WHITE_SPACE_AND_NL));
1382                                                             /* strip trailing whitespace */
1383 
1384           begin;
1385 
1386 dcl  request_line character (input_line_lth - start + 1) unaligned defined (input_line) position (start);
1387                                                             /* the request line (without the request character) */
1388 
1389 
1390 /* Self-identify request ("."): not accepted in subsystems where there is usually a "." request which identifies the
1391    subsystem itself */
1392 
1393                if length (request_line) = 0 then
1394                     if subsystem_entry then do;
1395                          null_line = "1"b;                  /* don't bother to remember this request line */
1396                          go to EXPANSION_IS_INPUT_LINE;
1397                     end;
1398                     else do;
1399                          call ioa_ ("^a ^a", ABBREV, abbrev_data_$version);
1400                          return;
1401                     end;
1402 
1403 
1404 /* Quit abbrev: doesn't require the profile to exist; not accepted in subsystems */
1405 
1406                if (request_line = "quit") | (request_line = "q") then do;
1407                     if subsystem_entry then
1408                          call com_err_ (0, ABBREV, """^aq"" is not valid within subsystems.",
1409                               abbrev_state.escape_character);
1410                     else do;                                /* Multics command level */
1411                          if abbrev_state.set_cp then do;    /* ... we were the command processor: reset it */
1412                               call cu_$set_command_processor (abbrev_state.previous_command_processor);
1413                               abbrev_state.set_cp = "0"b;
1414                          end;
1415                          if abbrev_state.profile_ptr ^= null () then
1416                               call terminate_file_ (abbrev_state.profile_ptr, 0, TERM_FILE_TERM, (0));
1417                     end;                                    /* ... and we no longer know where the profile is */
1418                     return;
1419                end;
1420 
1421 
1422 /* ". ": pass the rest of the line to the previous command processor without expansion or remembering */
1423 
1424                if substr (request_line, 1, 1) = " " then
1425                     begin;
1426 dcl  rest_of_line character (length (request_line) - 1) unaligned defined (input_line) position (start + 1);
1427                     if subsystem_entry then
1428                          call P_subsys_cp (P_subsystem_name, P_sci_ptr, P_execute_request, P_subsys_cp_info_ptr,
1429                               rest_of_line, code);
1430                     else call abbrev_state.command_processor (addr (rest_of_line), length (rest_of_line), code);
1431                     go to RETURN_FROM_ABBREV_PROCESSOR;     /* reflect execution's error code to caller */
1432                end;
1433 
1434 
1435 /* Remaining requests use the parsed version of the request line */
1436 
1437                used = 0;                                    /* haven't look at the line yet */
1438 
1439                request_name = get_token ();                 /* get the request name */
1440 
1441                if (request_name = "use") | (request_name = "u") then do;
1442                     call do_use_request ();                 /* switch profiles */
1443                     return;
1444                end;
1445 
1446                else if request_name = "terminate_process" then do;
1447                     call validate_no_arguments ("terminate_process");
1448                     code = pointer (baseptr (-2), "400000"b3) -> based_word;
1449                end;                                         /* terminates the process without prejudice */
1450 
1451                else if request_name = "debug" then do;
1452                     call validate_no_arguments ("debug");
1453                     call ioa_ ("debug:");
1454                     call debug_entry_variable ();           /* invokes debug in a possibly damaged process */
1455                     return;
1456                end;
1457 
1458                else if request_name = "probe" then do;
1459                     call validate_no_arguments ("probe");
1460                     call probe_entry_variable ();           /* invokes probe in a possibly damaged process */
1461                     return;
1462                end;
1463 
1464                else if request_name = "?" then do;          /* display request list */
1465                     call do_help_request ();
1466                     return;
1467                end;
1468                call set_profile_ptr ("0"b);                 /* all other requests require that the profile exist */
1469 
1470 
1471 /* Print the pathname of the current profile */
1472 
1473                if (request_name = "profile") | (request_name = "p") then do;
1474                     call validate_no_arguments ("p");       /* use short name for compatibility with documentation */
1475                     call hcs_$fs_get_path_name (ap_ptr, profile_dirname, (0), profile_ename, (0));
1476                     call ioa_ ("^a", pathname_ (profile_dirname, profile_ename));
1477                end;
1478 
1479 
1480 /* Set/reset remember mode: in remember mode, abbrev will save the expansion of the last command/request line executed */
1481 
1482                else if (request_name = "remember") | (request_name = "r") then do;
1483                     call validate_no_arguments ("r");
1484                     abbrev_state.remember_lines = "1"b;     /* just set the flag */
1485                end;
1486 
1487                else if (request_name = "forget") | (request_name = "f") then do;
1488                     call validate_no_arguments ("f");
1489                     abbrev_state.remember_lines = "0"b;     /* stop remembering and get rid of old remembered line ... */
1490                     if abbrev_state.remembered_line_buffer_ptr ^= null () then
1491                          free remembered_line_buffer in (system_area);
1492                     abbrev_state.remembered_line_buffer_ptr = null ();
1493                     abbrev_state.remembered_line_buffer_lth, abbrev_state.remembered_line_lth = 0;
1494                end;
1495 
1496 
1497 /* Set the escape character which is the trigger for request lines */
1498 
1499                else if (request_name = "escape") | (request_name = "esc") then do;
1500                     token = get_token ();                   /* is there a new request character? */
1501                     if token ^= "" then                     /* ... yes: make sure it's not too long */
1502                          if length (rtrim (token)) > length (abbrev_state.escape_character) then
1503                               call com_err_ (0, ABBREV, "The escape sequence must be a single character; not ""^a"".",
1504                                    token);
1505                          else do;                           /* ... length is OK */
1506                               new_escape_character = substr (token, 1, 1);
1507                               token = get_token ();
1508                               if token = "" then            /* ... nothing else on the line */
1509                                    abbrev_state.escape_character = new_escape_character;
1510                               else call com_err_ (0, ABBREV, "Only one escape character may be specified. ""^a""", token);
1511                          end;
1512                     else call ioa_ ("Abbrev escape character: ^a", abbrev_state.escape_character);
1513                end;
1514 
1515 
1516 /* Following requests are all complex enough that they are each implemented as separate internal procedures */
1517 
1518                else if (request_name = "show") | (request_name = "s") then call do_show_request ();
1519                                                             /* show an expansion */
1520 
1521                else if (request_name = "l") | (request_name = "la") | (request_name = "lab") | (request_name = "la^b")
1522                     | (request_name = "lb") | (request_name = "l^b") | (request_name = "ls") | (request_name = "lsb")
1523                     | (request_name = "ls^b") | (request_name = "lx") | (request_name = "lxb") | (request_name = "lx^b")
1524                     then
1525                     call do_list_request ();                /* list one or more abbrev definitions */
1526 
1527                else if (request_name = "a") | (request_name = "af") | (request_name = "ab") | (request_name = "abf") then
1528                     call do_add_request ();                 /* define a new abbreviation */
1529 
1530                else if (request_name = "delete") | (request_name = "dl") | (request_name = "d") then
1531                     call do_delete_request ();              /* delete one or more abbreviations */
1532 
1533                else if (request_name = "rename") | (request_name = "rn") then call do_rename_request ();
1534                                                             /* rename one or more abbreviations */
1535 
1536                else if request_name = "edit" then call do_edit_request ();
1537 
1538 /* edit the definition of an abbreviation */
1539 
1540                else if (request_name = "switch_on") | (request_name = "swn") then call do_switch_request ("1"b);
1541                                                             /* turn on switches for one or more abbreviations */
1542 
1543                else if (request_name = "switch_off") | (request_name = "swf") then call do_switch_request ("0"b);
1544                                                             /* turn off switches for one or more abbreviations */
1545 
1546 
1547 /* Here iff the request is not recognized */
1548 
1549                else call com_err_ (error_table_$request_not_recognized, ABBREV, """^a^a""", abbrev_state.escape_character,
1550                          request_name);
1551 
1552                return;
1553 %page;
1554 /* Switch to another profile (internal to process_request_line begin block): if no profile pathname is given, reverts to
1555    the default profile; otherwise, the given pathname is abbrev expanded (if possible) before we actually try to use it as
1556    a convenience */
1557 
1558 do_use_request:
1559      procedure ();
1560 
1561 dcl  expanded_pathname_buffer character (256);
1562 dcl  expanded_pathname character (expanded_pathname_lth) based (expanded_pathname_ptr);
1563 dcl  expanded_pathname_lth fixed binary (21);
1564 dcl  expanded_pathname_ptr pointer;
1565 
1566 dcl  new_profile_dirname character (168);
1567 dcl  (new_profile_ename) character (32);
1568 
1569 dcl  new_profile_ptr pointer;
1570 
1571 dcl  created_here bit (1) aligned;
1572 dcl  try_to_create bit (1);                                 /* command_query_$yes_no is declared wrong... */
1573 
1574 
1575           call skip_whitespace ();                          /* find start of pathname */
1576 
1577           begin;
1578 
1579 dcl  original_pathname character (length (request_line) - used) unaligned defined (input_line) position (start + used);
1580 
1581                new_profile_ptr = null ();                   /* haven't gotten it yet */
1582 
1583                call set_profile_ptr ("1"b);                 /* try to get the current profile */
1584 
1585                if original_pathname = "" then do;           /* reset to default profile */
1586                     call terminate_old_profile ();
1587                     if subsystem_entry then                 /* ... reset to default for this invocation */
1588                          P_profile_ptr = null ();
1589                     else call get_default_profile ("1"b);
1590                     return;
1591                end;
1592 
1593                if abbrev_state.profile_ptr = null () then do;
1594                     expanded_pathname_ptr = addr (original_pathname);
1595                     expanded_pathname_lth = length (original_pathname);
1596                end;
1597 
1598                else call abbrev_$expand_line (EXPAND_INTERNAL_ONLY, addr (original_pathname), length (original_pathname),
1599                          addr (expanded_pathname_buffer), length (expanded_pathname_buffer), expanded_pathname_ptr,
1600                          expanded_pathname_lth);
1601 
1602                if substr (expanded_pathname, 1, length (QUOTE)) = QUOTE then
1603                     if substr (expanded_pathname, expanded_pathname_lth, length (QUOTE)) = QUOTE then
1604                          expanded_pathname = substr (expanded_pathname, 2, expanded_pathname_lth - 2);
1605                                                             /* remove one level of quotes */
1606                     else do;
1607                          call com_err_ (error_table_$unbalanced_quotes, ABBREV, expanded_pathname);
1608                          return;
1609                     end;
1610                else ;
1611 
1612                call expand_pathname_$add_suffix (expanded_pathname, "profile", new_profile_dirname, new_profile_ename,
1613                     code);
1614                if code ^= 0 then                            /* before we release the storage */
1615                     call com_err_ (code, ABBREV, "^a", expanded_pathname);
1616                if (expanded_pathname_ptr ^= addr (original_pathname))
1617                     & (expanded_pathname_ptr ^= addr (expanded_pathname_buffer)) then
1618                     free expanded_pathname in (system_area);
1619                if code ^= 0 then return;                    /* ... message already printed */
1620 
1621                created_here = "0"b;                         /* assume we find it */
1622 
1623                call initiate_file_ (new_profile_dirname, new_profile_ename, R_ACCESS, new_profile_ptr, (0), code);
1624                if code ^= 0 then
1625                     if code = error_table_$noentry then do;
1626                          call command_query_$yes_no (try_to_create, 0, ABBREV, "",
1627                               "Profile ^a not found.  Do you want to create it?",
1628                               pathname_ (new_profile_dirname, new_profile_ename));
1629                          if try_to_create then
1630                               call initiate_file_$create (new_profile_dirname, new_profile_ename, RW_ACCESS,
1631                                    new_profile_ptr, created_here, (0), code);
1632                          else return;                       /* user doesn't want to try */
1633                     end;
1634 
1635                if code ^= 0 then do;
1636                     call com_err_ (code, ABBREV, "^a", pathname_ (new_profile_dirname, new_profile_ename));
1637                     return;                                 /* couldn't switch ... */
1638                end;
1639 
1640                call terminate_old_profile ();
1641 
1642                if subsystem_entry then                      /* change this invocation's profile */
1643                     P_profile_ptr, ap_ptr = new_profile_ptr;
1644                else abbrev_state.profile_ptr, ap_ptr = new_profile_ptr;
1645                                                             /* change command level's profile */
1646                call initialize_profile (^created_here, created_here);
1647 
1648                return;
1649           end;
1650 
1651 
1652 
1653 /* Terminate the old profile segment (internal to do_use_request) */
1654 
1655 terminate_old_profile:
1656           procedure ();
1657 
1658                if ap_ptr ^= null () then                    /* terminate the old profile ... */
1659                     if subsystem_entry then                 /* ... but only if not the subsystem's default profile */
1660                          if (ap_ptr ^= P_default_profile_ptr)
1661                               & ((P_default_profile_ptr ^= null ())
1662                               | ((P_default_profile_ptr = null ()) & (P_profile_ptr ^= null ()))) then
1663                               call terminate_file_ (ap_ptr, 0, TERM_FILE_TERM, (0));
1664                          else ;
1665 
1666                     else call terminate_file_ (ap_ptr, 0, TERM_FILE_TERM, (0));
1667 
1668                return;
1669 
1670           end terminate_old_profile;
1671 
1672      end do_use_request;
1673 %page;
1674 /* Show an expansion (internal to process_request_line begin block): if anything else is present on the line, expand it;
1675    otherwise, show the last expansion if remember mode is set */
1676 
1677 do_show_request:
1678      procedure ();
1679 
1680 dcl  result_line character (result_line_lth) based (result_line_ptr);
1681 dcl  result_line_lth fixed binary (21);
1682 dcl  result_line_ptr pointer;
1683 
1684           call skip_whitespace ();                          /* skip to request line (if any) */
1685 
1686           if used < length (request_line) then
1687                begin;
1688 dcl  rest_of_line character (length (request_line) - used) unaligned defined (input_line) position (start + used);
1689                call abbrev_$expanded_line (addr (rest_of_line), length (rest_of_line), null (), 0, result_line_ptr,
1690                     result_line_lth);
1691                call ioa_ ("^a", result_line);
1692                free result_line in (system_area);           /* guarenteed to have been allocated */
1693           end;
1694 
1695           else if abbrev_state.remember_lines then
1696                if abbrev_state.remembered_line_lth > 0 then
1697                     call ioa_$nnl ("^a^[^/^]", remembered_line,
1698                          (substr (remembered_line, abbrev_state.remembered_line_lth, 1) ^= NL));
1699                else call com_err_ (0, ABBREV, "Nothing has been remembered yet.");
1700 
1701           else call com_err_ (0, ABBREV, "Remember mode is not enabled.");
1702 
1703           return;
1704 
1705      end do_show_request;
1706 %page;
1707 /* List one or more abbreviation definitions (internal to process_request_line begin block): options are to list all
1708    abbrevs, specific abbrevs, or all abbrevs which start with a given character sequence */
1709 
1710 do_list_request:
1711      procedure ();
1712 
1713 dcl  1 list aligned based (list_segment_ptr),
1714        2 n_abbrevs fixed binary,
1715        2 pad bit (36),
1716        2 abbrevs (0 refer (list.n_abbrevs)) like lae;
1717 dcl  list_segment_ptr pointer;
1718 
1719 dcl  1 lae aligned based,
1720        2 name character (8),
1721        2 ptr pointer;
1722 
1723 dcl  1 list_sort_list aligned based (list_sort_list_ptr),
1724        2 n fixed binary,
1725        2 ptrs (0 refer (list.n_abbrevs)) pointer unaligned;
1726 dcl  list_sort_list_ptr pointer;
1727 
1728 dcl  offset fixed binary (18);
1729 dcl  (hash_slot, previous_n_abbrevs, token_lth, idx) fixed binary;
1730 dcl  exact_match bit (1) aligned;
1731 dcl  (la, ls, lx, bol, nbol) bit (1);
1732 dcl  emessage char (64);
1733 
1734 
1735           call skip_whitespace ();                          /* ".la" requires some arguments */
1736           if used = length (request_line) & request_name ^= "l" & request_name ^= "lb" & request_name ^= "l^b" then do;
1737                call com_err_ (0, ABBREV, " Usage:  ^a^a STRs", abbrev_state.escape_character, request_name);
1738                go to RETURN_FROM_PROCESS_REQUEST_LINE;
1739           end;
1740 
1741           call get_temp_segment_ (ABBREV, list_segment_ptr, code);
1742           if code ^= 0 then do;
1743                call com_err_ (code, ABBREV, "Getting sorting space for listing abbreviations.");
1744                go to RETURN_FROM_PROCESS_REQUEST_LINE;
1745           end;
1746 
1747           on condition (cleanup)
1748                begin;
1749                if list_segment_ptr ^= null () then call release_temp_segment_ (ABBREV, list_segment_ptr, (0));
1750           end;
1751 
1752           exact_match = request_name = "l" | request_name = "lb" | request_name = "l^b";
1753           la = substr (request_name, 1, 2) = "la";
1754           ls = substr (request_name, 1, 2) = "ls";
1755           lx = substr (request_name, 1, 2) = "lx";
1756           bol = index (request_name, "b") ^= 0 & index (request_name, "^") = 0;
1757           nbol = index (request_name, "b") ^= 0 & index (request_name, "^") ^= 0;
1758 
1759           if exact_match & (used = length (request_line)) then do;
1760                list.n_abbrevs = 0;                          /* list all abbreviations */
1761                do hash_slot = lbound (abbrev_profile.hash_table, 1) to hbound (abbrev_profile.hash_table, 1);
1762                     do offset = abbrev_profile.hash_table (hash_slot) repeat (ape.next) while (offset ^= 0);
1763                          ape_ptr = pointer (ap_ptr, offset);
1764                          if ape.name ^= "" then do;
1765                               if request_name = "l" then call set_list_entry ();
1766                               if request_name = "lb" then do;
1767                                    if ape.bol then call set_list_entry ();
1768                               end;
1769                               if request_name = "l^b" then do;
1770                                    if ^ape.bol then call set_list_entry ();
1771                               end;
1772                          end;
1773                     end;
1774                end;
1775                if list.n_abbrevs = 0 then do;
1776                     call com_err_ (0, ABBREV, "No abbreviations defined.");
1777                     go to RETURN_FROM_PROCESS_REQUEST_LINE;
1778                end;                                         /* cleanup handler gets the temp segment */
1779           end;
1780 
1781           else if exact_match then do;                      /* list explicit abbreviations */
1782                list.n_abbrevs = 0;
1783                do token = get_token () repeat (get_token ()) while (token ^= "");
1784                     if length (rtrim (token)) > length (ape.name) then
1785                          call com_err_ (0, ABBREV, "Maximum length of an abbreviation name is ^d characters. ""^a""",
1786                               length (ape.name), token);
1787                     else do;
1788                          ape_ptr = lookup_abbrev (token);
1789                          if ape_ptr = null () then          /* not found */
1790                               call com_err_ (0, ABBREV, """^a"" is not defined.", token);
1791                          else do;
1792                               if request_name = "l" then call set_list_entry ();
1793                               if request_name = "lb" then do;
1794                                    if ape.bol then call set_list_entry ();
1795                               end;
1796                               if request_name = "l^b" then do;
1797                                    if ^ape.bol then call set_list_entry ();
1798                               end;
1799                          end;
1800                     end;
1801                end;
1802                if list.n_abbrevs = 0 then go to RETURN_FROM_PROCESS_REQUEST_LINE;
1803           end;                                              /* didn't find any at all */
1804 
1805           else do;                                          /* list all abbreviations starting with the given string */
1806                list.n_abbrevs = 0;
1807                do token = get_token () repeat (get_token ()) while (token ^= "");
1808                     previous_n_abbrevs = list.n_abbrevs;
1809                     token_lth = length (rtrim (token));
1810                     if (token_lth > length (ape.name)) & ^lx then
1811                          call com_err_ (0, ABBREV, "Maximum length of an abbreviation name is ^d characters. ""^a""",
1812                               length (ape.name), token);
1813                     else do;
1814                          do hash_slot = lbound (abbrev_profile.hash_table, 1) to hbound (abbrev_profile.hash_table, 1);
1815                               do offset = abbrev_profile.hash_table (hash_slot) repeat (ape.next) while (offset ^= 0);
1816                                    ape_ptr = pointer (ap_ptr, offset);
1817                                    if ape.name ^= "" then do;
1818                                         if ^bol & ^nbol then call set_list_entry ();
1819                                         if bol & ape.bol then call set_list_entry ();
1820                                         else if nbol & ^ape.bol then call set_list_entry ();
1821                                    end;
1822                               end;
1823                          end;
1824                          if previous_n_abbrevs = list.n_abbrevs then do;
1825                               emessage = "";
1826                               if la then emessage = "No abbreviations defined which start with";
1827                               else if lx then emessage = "No abbreviation expansions defined which contain";
1828                               else emessage = "No abbreviations defined which contain";
1829                               call com_err_ (0, ABBREV, "^a ""^a"".", emessage, token);
1830                          end;
1831                     end;
1832                end;
1833                if list.n_abbrevs = 0 then go to RETURN_FROM_PROCESS_REQUEST_LINE;
1834           end;
1835 
1836           list_sort_list_ptr = pointer (list_segment_ptr, currentsize (list));
1837           list_sort_list.n = list.n_abbrevs;
1838 
1839           do idx = 1 to list_sort_list.n;
1840                list_sort_list.ptrs (idx) = addr (list.abbrevs (idx).name);
1841           end;
1842 
1843           call sort_items_$char (list_sort_list_ptr, length (ape.name));
1844 
1845           do idx = 1 to list_sort_list.n;
1846                ape_ptr = list_sort_list.ptrs (idx) -> lae.ptr;
1847                call ioa_ ("^[b^;^x^]^x^a^12t^a", ape.bol, ape.name, ape.value);
1848           end;
1849 
1850           call release_temp_segment_ (ABBREV, list_segment_ptr, (0));
1851 
1852           return;
1853 
1854 set_list_entry:
1855           proc ();
1856 
1857                if ^ls & ^lx & ^la then go to set_entry;
1858                if la then do;
1859                     if token = substr (ape.name, 1, token_lth) then go to set_entry;
1860                     return;
1861                end;
1862                if ls then do;
1863                     if index (ape.name, substr (token, 1, token_lth)) ^= 0 then go to set_entry;
1864                     return;
1865                end;
1866                if lx then do;
1867                     if index (ape.value, substr (token, 1, token_lth)) ^= 0 then go to set_entry;
1868                     return;
1869                end;
1870 set_entry:
1871                list.n_abbrevs, idx = list.n_abbrevs + 1;
1872                list.abbrevs (idx).name = ape.name;
1873                list.abbrevs (idx).ptr = ape_ptr;
1874 
1875                return;
1876 
1877           end set_list_entry;
1878 
1879      end do_list_request;
1880 %page;
1881 /* Defines a new abbreviation (internal to process_request_line begin block): if the abbreviation is already defined and
1882    the user did not explicitly request to overwrite it, ask the user if they wish to redefine the abbreviation */
1883 
1884 do_add_request:
1885      procedure ();
1886 
1887 dcl  last_ape_ptr pointer;
1888 dcl  abbrev_name character (32);
1889 dcl  (old_size, hash_slot) fixed binary (18);
1890 dcl  (force, bol) bit (1) aligned;
1891 dcl  add_it bit (1);
1892 
1893           if ^write_access () then do;
1894                call com_err_ (error_table_$moderr, ABBREV, "Can not add abbreviations to profile ^a", profile_pathname ())
1895                     ;
1896                go to RETURN_FROM_PROCESS_REQUEST_LINE;
1897           end;
1898 
1899           token = get_token ();                             /* pick up name of the abbreviation */
1900 
1901           if token = "" then do;                            /* no abbreviation */
1902 PRINT_ADD_REQUEST_USAGE:
1903                call com_err_ (0, ABBREV, " Usage:  ^a^a name expansion", abbrev_state.escape_character, request_name);
1904                go to RETURN_FROM_PROCESS_REQUEST_LINE;
1905           end;
1906 
1907           abbrev_name = token;                              /* save it */
1908           if ^validate_abbrev_name (abbrev_name) then go to RETURN_FROM_PROCESS_REQUEST_LINE;
1909 
1910           call skip_whitespace ();                          /* find the definition */
1911           if used = length (request_line) then go to PRINT_ADD_REQUEST_USAGE;
1912 
1913           force = (request_name = "af") | (request_name = "abf");
1914           bol = (request_name = "ab") | (request_name = "abf");
1915 
1916           begin;
1917 
1918 dcl  definition character (length (request_line) - used) unaligned defined (input_line) position (start + used);
1919 
1920                ape_ptr = lookup_abbrev (abbrev_name);       /* see if it's already defined */
1921 
1922                if ape_ptr ^= null () then                   /* already defined ... */
1923                     if force then do;                       /* ... and the user wants it redefined */
1924 OVERWRITE_PREVIOUS_DEFINITION:
1925                          if ape.value_lth >= length (definition) then do;
1926                               old_size = currentsize (ape); /* ... enough room in old entry for new definition */
1927                               ape.bol = bol;                /* ... redefinition could change this value */
1928                               ape.value_lth = length (definition);
1929                               ape.value = definition;
1930                               abbrev_profile.garbage = abbrev_profile.garbage + old_size - currentsize (ape);
1931                          end;
1932                          else do;                           /* ... not enough room: delete it and add to the end */
1933                               ape.name = "";
1934                               abbrev_profile.garbage = abbrev_profile.garbage + currentsize (ape);
1935                               go to CREATE_NEW_DEFINITION;
1936                          end;
1937                     end;
1938 
1939                     else do;                                /* ... user didn't know it: ask them about it */
1940                          call command_query_$yes_no (add_it, 0, ABBREV, "",
1941                               "Abbreviation is already defined as:^/^3x^[b^;^x^]^x^a^15t^a^/Do you wish to redefine it?",
1942                               ape.bol, ape.name, ape.value);
1943                          if add_it then go to OVERWRITE_PREVIOUS_DEFINITION;
1944                     end;                                    /* if answer is no we fall through and do nothing */
1945 
1946                else do;                                     /* brand new abbreviation ... */
1947 CREATE_NEW_DEFINITION:
1948                     ape_ptr = pointer (ap_ptr, abbrev_profile.next_free);
1949                     substr (ape.name, 1, length (ape.name)) = substr (abbrev_name, 1, length (ape.name));
1950                     ape.next = 0;                           /* last abbreviation in this bucket */
1951                     string (ape.flags) = ""b;
1952                     ape.bol = bol;
1953                     ape.value_lth = length (definition);
1954                     ape.value = definition;
1955                     abbrev_profile.next_free = abbrev_profile.next_free + currentsize (ape);
1956                     hash_slot = rank (substr (abbrev_name, 1, 1));
1957                     if abbrev_profile.hash_table (hash_slot) = 0 then
1958                          abbrev_profile.hash_table (hash_slot) = fixed (rel (ape_ptr), 18, 0);
1959                     else do;                                /* add to end of the chain */
1960                          do last_ape_ptr = pointer (ap_ptr, abbrev_profile.hash_table (hash_slot))
1961                               repeat (pointer (ap_ptr, last_ape_ptr -> ape.next)) while (last_ape_ptr -> ape.next ^= 0);
1962                          end;
1963                          last_ape_ptr -> ape.next = fixed (rel (ape_ptr), 18, 0);
1964                     end;
1965                end;
1966           end;
1967 
1968           call compact_profile_if_needed ("1"b);
1969 
1970           return;
1971 
1972      end do_add_request;
1973 %page;
1974 /* Deletes one or more abbreviation definitions (internal to process_request_line begin block) */
1975 
1976 do_delete_request:
1977      procedure ();
1978 
1979           if ^write_access () then do;
1980                call com_err_ (error_table_$moderr, ABBREV, "Can not delete abbreviations from profile ^a",
1981                     profile_pathname ());
1982                go to RETURN_FROM_PROCESS_REQUEST_LINE;
1983           end;
1984 
1985           call skip_whitespace ();                          /* make sure there are some abbreviations to delete */
1986           if used = length (request_line) then do;
1987                call com_err_ (0, ABBREV, " Usage:  ^ad names", abbrev_state.escape_character);
1988                go to RETURN_FROM_PROCESS_REQUEST_LINE;
1989           end;
1990 
1991           do token = get_token () repeat (get_token ()) while (token ^= "");
1992                if length (rtrim (token)) > length (ape.name) then
1993                     call com_err_ (0, ABBREV, "Maximum length of an abbreviation name is ^d characters. ""^a""",
1994                          length (ape.name), token);
1995                else do;                                     /* abbreviation name is the right length at least */
1996                     ape_ptr = lookup_abbrev (token);
1997                     if ape_ptr = null () then
1998                          call com_err_ (0, ABBREV, """^a"" is not defined.", token);
1999                     else do;                                /* found it... */
2000                          ape.name = "";                     /* ... mark it as deleted */
2001                          abbrev_profile.garbage = abbrev_profile.garbage + currentsize (ape);
2002                     end;
2003                end;
2004           end;
2005 
2006           call compact_profile_if_needed ("0"b);
2007 
2008           return;
2009 
2010      end do_delete_request;
2011 %page;
2012 /* Renames one or more abbreviations */
2013 
2014 do_rename_request:
2015      procedure ();
2016 
2017 dcl  (old_abbrev_name, new_abbrev_name) character (32);
2018 dcl  (old_ape_ptr, new_ape_ptr, the_ape_ptr, prior_ape_ptr) pointer;
2019 dcl  rename_it bit (1);
2020 dcl  (old_hash_slot, new_hash_slot) fixed binary;
2021 
2022           if ^write_access () then do;
2023                call com_err_ (error_table_$moderr, ABBREV, "Can not rename abbreviations in profile ^a.",
2024                     profile_pathname ());
2025                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2026           end;
2027 
2028           old_abbrev_name = get_token ();
2029 
2030           if old_abbrev_name = "" then do;                  /* nothing given at all ... */
2031                call com_err_ (0, ABBREV, "Usage:  ^arename old_name1 new_name1 {... old_nameN new_nameN}",
2032                     abbrev_state.escape_character);
2033                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2034           end;
2035 
2036           do while (old_abbrev_name ^= "");                 /* as long as there's at least one name */
2037 
2038                new_abbrev_name = get_token ();
2039                if new_abbrev_name = "" then do;             /* odd number of arguments */
2040                     call com_err_ (error_table_$noarg, ABBREV, "New name for abbreviation ""^a"".", old_abbrev_name);
2041                     go to RETURN_FROM_PROCESS_REQUEST_LINE;
2042                end;
2043 
2044                old_ape_ptr = lookup_abbrev (old_abbrev_name);
2045 
2046                if old_ape_ptr ^= null () then               /* really is something to rename */
2047                     if validate_abbrev_name (new_abbrev_name) then do;
2048                          new_ape_ptr = lookup_abbrev (new_abbrev_name);
2049 
2050                          if new_ape_ptr = null () then do;  /* new name not yet used ... */
2051 RENAME_THE_OLD_ABBREVIATION:                                /* ... OK to rename */
2052                               old_hash_slot = rank (substr (old_abbrev_name, 1, 1));
2053                               new_hash_slot = rank (substr (new_abbrev_name, 1, 1));
2054                               if old_hash_slot = new_hash_slot then
2055                                    /*** same hash for both names: just rename it */
2056                                    substr (old_ape_ptr -> ape.name, 1, length (old_ape_ptr -> ape.name)) =
2057                                         substr (new_abbrev_name, 1, length (old_ape_ptr -> ape.name));
2058                               else do;
2059                                    /*** different hash: splice the abbrev out of the old chain ... */
2060                                    prior_ape_ptr = null ();
2061                                    do the_ape_ptr = pointer (ap_ptr, abbrev_profile.hash_table (old_hash_slot))
2062                                         repeat (pointer (ap_ptr, the_ape_ptr -> ape.next))
2063                                         while ((the_ape_ptr ^= old_ape_ptr) & (the_ape_ptr -> ape.next ^= 0));
2064                                         prior_ape_ptr = the_ape_ptr;
2065                                    end;
2066                                    if the_ape_ptr ^= old_ape_ptr then
2067                                         call abort_abbrev_processor (error_table_$bad_segment, "^a", profile_pathname ());
2068                                    if prior_ape_ptr = null () then
2069                                         abbrev_profile.hash_table (old_hash_slot) = old_ape_ptr -> ape.next;
2070                                    else prior_ape_ptr -> ape.next = old_ape_ptr -> ape.next;
2071                                    /*** ... and add it to the end of its new chain */
2072                                    substr (old_ape_ptr -> ape.name, 1, length (old_ape_ptr -> ape.name)) =
2073                                         substr (new_abbrev_name, 1, length (old_ape_ptr -> ape.name));
2074                                    old_ape_ptr -> ape.next = 0;
2075                                    if abbrev_profile.hash_table (new_hash_slot) = 0 then
2076                                         abbrev_profile.hash_table (new_hash_slot) = fixed (rel (old_ape_ptr), 18, 0);
2077                                    else do;
2078                                         do prior_ape_ptr = pointer (ap_ptr, abbrev_profile.hash_table (new_hash_slot))
2079                                              repeat (pointer (ap_ptr, prior_ape_ptr -> ape.next))
2080                                              while (prior_ape_ptr -> ape.next ^= 0);
2081                                         end;
2082                                         prior_ape_ptr -> ape.next = fixed (rel (old_ape_ptr), 18, 0);
2083                                    end;
2084                               end;
2085                          end;
2086 
2087                          else do;                           /* new name already used: get permission to redefine */
2088                               call command_query_$yes_no (rename_it, 0, ABBREV, "",
2089                                    "Abbreviation is already defined as:^/^3x^[b^;^x^]^x^a^15t^a^/Do you wish to redefine it by renaming:^/^3x^[b^;^x^]^x^a^15t^a^/to ""^a""?",
2090                                    new_ape_ptr -> ape.bol, new_ape_ptr -> ape.name, new_ape_ptr -> ape.value,
2091                                    old_ape_ptr -> ape.bol, old_ape_ptr -> ape.name, old_ape_ptr -> ape.value,
2092                                    new_ape_ptr -> ape.name);
2093                               if rename_it then do;         /* ... delete the old definition */
2094                                    new_ape_ptr -> ape.name = "";
2095                                    abbrev_profile.garbage = abbrev_profile.garbage + currentsize (new_ape_ptr -> ape);
2096                                    go to RENAME_THE_OLD_ABBREVIATION;
2097                               end;
2098                          end;                               /* ... a no falls through to do next rename (if any) */
2099                     end;
2100 
2101                     else ;                                  /* validate_abbrev_name has already complained */
2102 
2103                else call com_err_ (0, ABBREV, """^a"" is not defined.", old_abbrev_name);
2104 
2105                old_abbrev_name = get_token ();
2106           end;
2107 
2108           call compact_profile_if_needed ("0"b);
2109 
2110           return;
2111 
2112      end do_rename_request;
2113 %page;
2114 /* Edits the definition of one or more abbreviations (internal to process_request_line begin block) via qedx_ */
2115 
2116 do_edit_request:
2117      procedure ();
2118 
2119 dcl  1 local_qi aligned,                                    /* data to invoke the editor */
2120        2 header like qedx_info.header,
2121        2 buffer like qedx_info.buffers;
2122 dcl  initial_abbrev_name character (32);
2123 
2124 
2125           if ^write_access () then do;
2126                call com_err_ (error_table_$moderr, ABBREV, "Can not edit abbreviations in profile ^a.",
2127                     profile_pathname ());
2128                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2129           end;
2130 
2131 
2132 /* Parse arguments: exactly one allowed -- the name of an existing abbreviation */
2133 
2134           initial_abbrev_name = get_token ();               /* get name of abbreviation to start editing */
2135 
2136           if initial_abbrev_name = "" then do;
2137 PRINT_EDIT_REQUEST_USAGE:
2138                call com_err_ (0, ABBREV, "Usage:  ^aedit name", abbrev_state.escape_character);
2139                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2140           end;
2141 
2142           token = get_token ();                             /* shouldn't be anything else... */
2143           if token ^= "" then go to PRINT_EDIT_REQUEST_USAGE;
2144 
2145           if ^validate_abbrev_name (initial_abbrev_name) then go to RETURN_FROM_PROCESS_REQUEST_LINE;
2146                                                             /* invalid name */
2147 
2148           ape_ptr = lookup_abbrev (initial_abbrev_name);
2149           if ape_ptr = null () then do;                     /* the abbreviation must exist */
2150                call com_err_ (0, ABBREV, """^a"" is not defined.", initial_abbrev_name);
2151                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2152           end;
2153 
2154 
2155 /* Print the abbreviation's definition and the editor prompt */
2156 
2157           call ioa_ ("^[b^;^x^]^x^a^12t^a", ape.bol, ape.name, ape.value);
2158           call ioa_ ("Edit:");
2159 
2160 
2161 /* Setup and invoke the editor */
2162 
2163           local_qi.version = QEDX_INFO_VERSION_1;
2164           local_qi.editor_name = ABBREV;
2165           local_qi.buffer_io = abbrev_io;                   /* we will read/write definitions directly */
2166 
2167           string (local_qi.header.flags) = ""b;
2168           local_qi.query_if_modified, local_qi.caller_does_io = "1"b;
2169 
2170           local_qi.n_buffers = 1;
2171           local_qi.buffer_name = "0";                       /* buffer "0": the default buffer */
2172           local_qi.buffer_pathname = initial_abbrev_name;   /* ... fill it with definition user wants edited */
2173           string (local_qi.buffer.flags) = ""b;             /* ... let the caller switch abbreviations */
2174 
2175           call qedx_ (addr (local_qi), (0));                /* do it */
2176 
2177           return;                                           /* needn't check the code */
2178 %page;
2179 /* Read/write an abbreviation's definition to the editor's buffer (internal to do_edit_request) */
2180 
2181 abbrev_io:
2182           procedure (p_qbii_ptr, p_ok);
2183 
2184 dcl  p_qbii_ptr pointer parameter;
2185 dcl  p_ok bit (1) aligned parameter;
2186 
2187 dcl  1 qbii aligned based (qbii_ptr) like qedx_buffer_io_info;
2188 dcl  qbii_value character (qbii.buffer_lth) based (qbii.buffer_ptr);
2189 dcl  last_ape_ptr pointer;
2190 dcl  (old_size, hash_slot) fixed binary (18);
2191 dcl  bol bit (1) aligned;
2192 dcl  redefine_it bit (1);
2193 
2194 
2195                qbii_ptr = p_qbii_ptr;
2196 
2197                if qbii.version ^= QEDX_BUFFER_IO_INFO_VERSION_1 then do;
2198                     call com_err_ (error_table_$unimplemented_version, ABBREV, "Buffer I/O from qedx_.");
2199                     p_ok = "0"b;
2200                end;
2201 
2202 
2203                else if qbii.direction = QEDX_READ_FILE then do;
2204 
2205 /* Fetch abbreviation definition from profile */
2206 
2207                     if validate_abbrev_name (rtrim (qbii.pathname)) then do;
2208                          ape_ptr = lookup_abbrev (rtrim (qbii.pathname));
2209 
2210                          if ape_ptr ^= null () then         /* ... it exists */
2211                               if (ape.value_lth + 1) <= qbii.buffer_max_lth then do;
2212                                    qbii.buffer_lth = ape.value_lth;
2213                                    qbii_value = ape.value;
2214                                    if substr (qbii_value, qbii.buffer_lth, 1) ^= NL then do;
2215                                         qbii.buffer_lth = qbii.buffer_lth + 1;
2216                                         substr (qbii_value, qbii.buffer_lth, 1) = NL;
2217                                    end;
2218                                    p_ok = "1"b;             /* ... success */
2219                               end;
2220 
2221                               else do;                      /* ... won't fit */
2222                                    call com_err_ (0, qbii.editor_name,
2223                                         "Definition of ""^a"" is too large for the editor.", qbii.pathname);
2224                                    p_ok = "0"b;
2225                               end;
2226 
2227                          else do;                           /* ... no such abbreviation */
2228                               call com_err_ (0, qbii.editor_name, """^a"" is not defined.", qbii.pathname);
2229                               p_ok = "0"b;
2230                          end;
2231                     end;
2232 
2233                     else p_ok = "0"b;                       /* ... illegal abbreviation name */
2234                end;
2235 
2236 
2237                else if qbii.direction = QEDX_WRITE_FILE then do;
2238 
2239 /* Write the editor's buffer as the definition of an abbreviation: if the abbreviation doesn't already exist, it will be
2240    created as an expand-anywhere abbrevation */
2241 
2242                     if validate_abbrev_name (rtrim (qbii.pathname)) then do;
2243                          if substr (qbii_value, qbii.buffer_lth, 1) = NL then qbii.buffer_lth = qbii.buffer_lth - 1;
2244                                                             /* strip trailing newline added for convenience */
2245 
2246                          ape_ptr = lookup_abbrev (rtrim (qbii.pathname));
2247 
2248                          if ape_ptr ^= null () then do;     /* already defined ... */
2249                               bol = ape.bol;                /* ... in case we have to move it elsewhere */
2250 
2251                               if ^qbii.default_pathname then do;
2252                                                             /* ... not the abbrev being edited by default: query ... */
2253                                    call command_query_$yes_no (redefine_it, 0, ABBREV, "",
2254                                         "Abbreviation is already defined as:^/^3x^[b^;^x^]^x^a^15t^a^/Do you wish to redefine it?",
2255                                         ape.bol, ape.name, ape.value);
2256                                    if ^redefine_it then do; /* ... ... user didn't realize and didn't mean it */
2257                                         p_ok = "0"b;
2258                                         return;
2259                                    end;
2260                               end;                          /* ... ...user says it's OK anyway */
2261 
2262                               if ape.value_lth >= qbii.buffer_lth then do;
2263                                    old_size = currentsize (ape);
2264                                    ape.value_lth = qbii.buffer_lth;
2265                                    ape.value = qbii_value;
2266                                    abbrev_profile.garbage = abbrev_profile.garbage + old_size - currentsize (ape);
2267                               end;
2268                               else do;                      /* ... not enough room: delete it and add to the end */
2269                                    ape.name = "";
2270                                    abbrev_profile.garbage = abbrev_profile.garbage + currentsize (ape);
2271                                    go to CREATE_NEW_DEFINITION;
2272                               end;
2273                          end;
2274 
2275                          else do;                           /* ... brand new abbreviation ... */
2276                               bol = "0"b;                   /* ... defaults to anywhere on line expansion */
2277 CREATE_NEW_DEFINITION:
2278                               ape_ptr = pointer (ap_ptr, abbrev_profile.next_free);
2279                               substr (ape.name, 1, length (ape.name)) = substr (qbii.pathname, 1, length (ape.name));
2280                               ape.next = 0;                 /* ... last abbreviation in this bucket */
2281                               string (ape.flags) = ""b;
2282                               ape.bol = bol;
2283                               ape.value_lth = qbii.buffer_lth;
2284                               ape.value = qbii_value;
2285                               abbrev_profile.next_free = abbrev_profile.next_free + currentsize (ape);
2286                               hash_slot = rank (substr (qbii.pathname, 1, 1));
2287                               if abbrev_profile.hash_table (hash_slot) = 0 then
2288                                    abbrev_profile.hash_table (hash_slot) = fixed (rel (ape_ptr), 18, 0);
2289                               else do;                      /* ... add to end of the chain */
2290                                    do last_ape_ptr = pointer (ap_ptr, abbrev_profile.hash_table (hash_slot))
2291                                         repeat (pointer (ap_ptr, last_ape_ptr -> ape.next))
2292                                         while (last_ape_ptr -> ape.next ^= 0);
2293                                    end;
2294                                    last_ape_ptr -> ape.next = fixed (rel (ape_ptr), 18, 0);
2295                               end;
2296                          end;
2297 
2298                          call compact_profile_if_needed ("1"b);
2299 
2300                          p_ok = "1"b;                       /* success */
2301                     end;
2302 
2303                     else p_ok = "0"b;                       /* ... illegal abbreviation name */
2304                end;
2305 
2306 
2307                else do;                                     /* will never get here, but ... */
2308                     call com_err_ (error_table_$bad_subr_arg, qbii.editor_name, "Buffer operation type ^d.",
2309                          qbii.direction);
2310                     p_ok = "0"b;
2311                end;
2312 
2313                return;
2314 
2315           end abbrev_io;
2316 
2317      end do_edit_request;
2318 %page;
2319 /* Turns the specified switch of one or more abbreviations on or off (internal to process_request_line begin block) */
2320 
2321 do_switch_request:
2322      procedure (p_switch_value);
2323 
2324 dcl  p_switch_value bit (1) aligned parameter;              /* new value for the switch */
2325 
2326 dcl  (request_name, the_switch, abbrev_name) character (32);
2327 dcl  switch_idx fixed binary;
2328 dcl  (have_switch, first_abbrev) bit (1) aligned;
2329 
2330 /* format: off */
2331 dcl  SWITCH_NAMES (1, 2) character (32) static options (constant) initial (
2332           "beginning_of_line",          "bol");
2333 /* format: on */
2334 
2335           if ^write_access () then do;
2336                call com_err_ (error_table_$moderr, ABBREV, "Can not change abbreviation switches in profile ^a.",
2337                     profile_pathname ());
2338                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2339           end;
2340 
2341           if p_switch_value then
2342                request_name = "switch_on";
2343           else request_name = "switch_off";
2344 
2345 
2346 /* Get the name of the switch */
2347 
2348           the_switch = get_token ();
2349 
2350           if the_switch = "" then do;
2351 PRINT_SWITCH_REQUEST_USAGE:
2352                call com_err_ (0, ABBREV, "Usage:  ^a^a switch_name abbrev_names", abbrev_state.escape_character,
2353                     request_name);
2354                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2355           end;
2356 
2357           have_switch = "0"b;                               /* let's lookup the name */
2358           switch_idx = 0;
2359 
2360           do while (^have_switch & (switch_idx < hbound (SWITCH_NAMES, 1)));
2361                switch_idx = switch_idx + 1;                 /* ... PL/I do loop would do an extra increment */
2362                if (the_switch = SWITCH_NAMES (switch_idx, 1)) | (the_switch = SWITCH_NAMES (switch_idx, 2)) then
2363                     have_switch = "1"b;                     /* ... a good name */
2364           end;
2365 
2366           if ^have_switch then do;                          /* foo */
2367                call com_err_ (0, ABBREV, "Unrecognized switch name.  ""^a""", the_switch);
2368                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2369           end;
2370 
2371 
2372 /* Now do it to the switch for the specified abbreviations */
2373 
2374           first_abbrev = "1"b;                              /* for error message (later) */
2375 
2376           abbrev_name = "foo";                              /* PL/I lacks do until */
2377 
2378           do while (abbrev_name ^= "");                     /* while there are names left on the request line ... */
2379                abbrev_name = get_token ();                  /* next abbreviation please */
2380 
2381                if abbrev_name ^= "" then do;
2382                     first_abbrev = "0"b;                    /* won't need a Usage message anymore */
2383 
2384                     if validate_abbrev_name (abbrev_name) then do;
2385                          ape_ptr = lookup_abbrev (abbrev_name);
2386 
2387                          if ape_ptr ^= null () then do;
2388                               go to SET_SWITCH (switch_idx);
2389 
2390 SET_SWITCH (1):                                             /* beginning of line */
2391                               ape.bol = p_switch_value;
2392                               go to PROCEED_WITH_NEXT_ABBREVIATION;
2393 
2394 PROCEED_WITH_NEXT_ABBREVIATION:
2395                          end;
2396 
2397                          else call com_err_ (0, ABBREV, """^a"" is not defined.", abbrev_name);
2398                     end;
2399                end;
2400           end;
2401 
2402           if first_abbrev then go to PRINT_SWITCH_REQUEST_USAGE;
2403 
2404           return;
2405 
2406      end do_switch_request;
2407 %page;
2408 /* Returns "1"b if the user has effective write access to the profile (internal to process_request_line begin block) */
2409 
2410 write_access:
2411      procedure () returns (bit (1) aligned);
2412 
2413 dcl  profile_mode fixed binary (5);
2414 
2415           call hcs_$fs_get_mode (ap_ptr, profile_mode, code);
2416           if code ^= 0 then do;
2417                call com_err_ (code, ABBREV, "Can not determine access to profile ^a", profile_pathname ());
2418                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2419           end;
2420 
2421           return ((profile_mode = RW_ACCESS_BIN) | (profile_mode = REW_ACCESS_BIN));
2422 
2423      end write_access;
2424 
2425 
2426 
2427 /* Validates that the given abbreviation name is legal */
2428 
2429 validate_abbrev_name:
2430      procedure (p_abbrev_name) returns (bit (1) aligned);
2431 
2432 dcl  p_abbrev_name character (32) parameter;                /* the candidate abbreviation name */
2433 dcl  abbrev_name character (32) varying;
2434 dcl  idx fixed binary;
2435 
2436           if length (rtrim (p_abbrev_name)) > length (ape.name) then do;
2437                call com_err_ (0, ABBREV, "Maximum length of an abbreviation name is ^d characters. ""^a""",
2438                     length (ape.name), p_abbrev_name);
2439                return ("0"b);
2440           end;
2441 
2442           abbrev_name = rtrim (p_abbrev_name);              /* copy it to strip trailing whitespace */
2443 
2444           do idx = 1 to breaks_list.n_break_sequences;
2445                begin;
2446 dcl  break_sequence character (breaks_list.break_sequences (idx).lth) unaligned
2447           defined (breaks_list.break_strings) position (breaks_list.break_sequences (idx).start);
2448                     if index (abbrev_name, break_sequence) ^= 0 then do;
2449                          call com_err_ (0, ABBREV, "Abbreviation names may not contain break sequences. ^a in ""^a""",
2450                               break_sequence, abbrev_name);
2451                          return ("0"b);
2452                     end;
2453                end;
2454           end;
2455 
2456           return ("1"b);                                    /* it's OK */
2457 
2458      end validate_abbrev_name;
2459 %page;
2460 /* Skips to next non-white character in the request line (internal to process_request_line begin block) */
2461 
2462 skip_whitespace:
2463      procedure ();
2464 
2465 dcl  idx fixed binary (21);
2466 
2467           idx = verify (substr (request_line, (used + 1)), WHITE_SPACE_AND_NL);
2468 
2469           if idx = 0 then                                   /* rest of the line is whitespace */
2470                used = length (request_line);
2471           else used = used + idx - 1;                       /* found something */
2472 
2473           return;
2474 
2475      end skip_whitespace;
2476 
2477 
2478 
2479 /* Returns the next token in the request line; tokens are delimited by whitespace (internal to process_request_line begin
2480    block) */
2481 
2482 get_token:
2483      procedure () returns (character (32));
2484 
2485 dcl  (token_start, token_lth, idx) fixed binary (21);
2486 
2487           call skip_whitespace ();                          /* skip any leading whitespace */
2488 
2489           if used = length (request_line) then              /* nothing left ... */
2490                return ("");
2491 
2492           idx = search (substr (request_line, (used + 1)), WHITE_SPACE);
2493           if idx = 0 then                                   /* rest of the line is the token */
2494                idx = length (request_line) - used + 1;
2495 
2496           token_start = used + 1;
2497           token_lth = idx - 1;
2498 
2499           used = used + token_lth;                          /* update amount we've looked at */
2500 
2501           return (substr (request_line, token_start, token_lth));
2502 
2503      end get_token;
2504 %page;
2505 /* Sets ap_ptr to locate the proper profile to be used for expansion in this case (internal to process_request_line begin
2506    block): initializes the profile if necessary; two versions of this procedure exist to insure that the one used during
2507    command/request line expansion is quick */
2508 
2509 set_profile_ptr:
2510      procedure (p_dont_create_profile) /* options (quick) */;
2511 
2512 dcl  p_dont_create_profile bit (1) aligned;
2513 
2514           ap_ptr = null ();                                 /* start somewhere */
2515 
2516           if subsystem_entry then                           /* subsystems use arbitrary profiles */
2517                if (P_default_profile_ptr = null ()) & (P_profile_ptr = null ()) then
2518                                                             /* ... use same profile as Multics command level */
2519                     if abbrev_state.profile_ptr = null () then
2520                          call get_default_profile (p_dont_create_profile);
2521                                                             /* ... need not succeed if called at expanded_line entry */
2522                     else ap_ptr = abbrev_state.profile_ptr;
2523 
2524                else do;                                     /* subsystem supplied the profile */
2525                     if P_profile_ptr ^= null () then
2526                          ap_ptr = P_profile_ptr;
2527                     else ap_ptr = P_default_profile_ptr;
2528                     call initialize_profile ("1"b, "0"b);   /* ... make sure it's good */
2529                end;
2530 
2531           else do;                                          /* command level invocation */
2532                if abbrev_state.profile_ptr = null () then
2533                     call get_default_profile (p_dont_create_profile);
2534                                                             /* ... need not succeed if called at expanded_line entry */
2535                else ap_ptr = abbrev_state.profile_ptr;
2536           end;
2537 
2538           return;
2539 
2540      end set_profile_ptr;
2541 
2542 
2543 
2544 /* Searches the profile for an abbreviation (internal to process_request_line begin block): two versions of this procedure
2545    exist to insure that the one used by the expand_line procedure is quick */
2546 
2547 lookup_abbrev:
2548      procedure (p_name) returns (pointer) /* options (quick) */;
2549 
2550 dcl  p_name character (32) parameter;
2551 dcl  offset fixed binary (18);
2552 
2553           do offset = abbrev_profile.hash_table (rank (substr (p_name, 1, 1))) repeat (ape.next) while (offset ^= 0);
2554                ape_ptr = pointer (ap_ptr, offset);
2555                if ape.name = p_name then return (ape_ptr);
2556           end;
2557 
2558           return (null ());                                 /* here iff not found */
2559 
2560      end lookup_abbrev;
2561 %page;
2562 /* Validates that the remainder of the request line is blank and prints an error if it isn't (internal to
2563    process_request_line begin block) */
2564 
2565 validate_no_arguments:
2566      procedure (p_request_name);
2567 
2568 dcl  p_request_name character (*) parameter;
2569 
2570           call skip_whitespace ();
2571 
2572           if used ^= length (request_line) then do;
2573                call com_err_ (0, ABBREV, "The ""^a^a"" request does not accept arguments.", abbrev_state.escape_character,
2574                     p_request_name);
2575                go to RETURN_FROM_PROCESS_REQUEST_LINE;
2576           end;
2577 
2578           return;
2579 
2580      end validate_no_arguments;
2581 
2582 
2583 
2584 /* Compact the profile if needed (internal to process_request_line begin block) */
2585 
2586 compact_profile_if_needed:
2587      procedure (p_set_bit_count);
2588 
2589 dcl  p_set_bit_count bit (1) aligned parameter;
2590 
2591           if (((4 * abbrev_profile.garbage) > abbrev_profile.next_free) | (abbrev_profile.garbage > 512))
2592                & (abbrev_profile.garbage > mod (abbrev_profile.next_free, 1024)) then
2593                call compact_profile ();                     /* compact at 25% or half page wasted but only if the
2594                                                                compaction will make it shorter */
2595 
2596           else if p_set_bit_count then                      /* caller added something to the end: be sure bit count OK */
2597                call terminate_file_ (ap_ptr, (36 * abbrev_profile.next_free), TERM_FILE_BC, (0));
2598 
2599           return;
2600 
2601      end compact_profile_if_needed;
2602 %page;
2603 do_help_request:
2604      proc ();                                               /* The ? (help) request */
2605 
2606 dcl  (element, ndx) fixed binary;
2607 
2608           call skip_whitespace ();
2609 
2610           if used = length (request_line) then do;          /* No requests, do all */
2611                call ioa_ ("Abbrev requests:");
2612                do element = 1 to hbound (abbrev_rqd, 1);
2613                     call display_help_line (abbrev_rqd (element));
2614                end;
2615           end;
2616 
2617           else do token = get_token () repeat (get_token ()) while (token ^= "");
2618                                                             /* request(s) */
2619                do element = 1 to hbound (ard, 1);
2620                     if ard (element) = rtrim (token) then go to found_request;
2621                end;
2622                call com_err_ (0, ABBREV, """^a"" is not a legal abbrev request.", token);
2623                go to end_request_lookup;
2624 found_request:
2625                element = ardx (element);
2626                do ndx = 0 to 2;
2627                     call display_help_line (abbrev_rqd (element + ndx));
2628                end;
2629 end_request_lookup:
2630           end;
2631 
2632           return;
2633 
2634 display_help_line:
2635           proc (display_line);
2636 
2637 dcl  display_line char (*) parameter;
2638 
2639                if display_line ^= "" then call ioa_ ("^a", display_line);
2640 
2641                return;
2642 
2643           end display_help_line;
2644 
2645      end do_help_request;
2646 
2647           end;
2648 
2649 RETURN_FROM_PROCESS_REQUEST_LINE:
2650           return;
2651 %page;
2652 %include qedx_info;
2653 %page;
2654 %include qedx_buffer_io_info;
2655 
2656      end process_request_line;
2657 %page;
2658 /* Garbage collect a profile */
2659 
2660 compact_profile:
2661      procedure () options (non_quick);
2662 
2663 dcl  1 new_profile aligned based (new_profile_ptr) like abbrev_profile;
2664 dcl  new_profile_ptr pointer;
2665 
2666 dcl  new_profile_words (new_profile.next_free) bit (36) aligned based (new_profile_ptr);
2667 
2668 dcl  1 new_ape aligned based (new_ape_ptr),
2669        2 header like ape.header,
2670        2 value character (0 refer (new_ape.value_lth));
2671 dcl  new_ape_ptr pointer;
2672 
2673 dcl  1 old_profile aligned based (old_profile_ptr) like abbrev_profile;
2674 dcl  1 old_old_profile aligned based (old_profile_ptr),     /* prior version */
2675        2 next_free fixed binary (18),
2676        2 pad (3) bit (36),
2677        2 hash_table (4:127) fixed binary (18);
2678 dcl  old_profile_ptr pointer;
2679 
2680 dcl  1 old_ape aligned based (old_ape_ptr),
2681        2 header like ape.header,
2682        2 value character (0 refer (old_ape.value_lth));
2683 dcl  old_ape_ptr pointer;
2684 
2685 dcl  old_style_profile bit (1) aligned;
2686 dcl  old_profile_mode fixed binary (5);
2687 dcl  (hash_slot, lower_hash_bound) fixed binary;
2688 dcl  (first_offset, old_offset) fixed binary (18);
2689 dcl  last_new_ape_ptr pointer;
2690 
2691 
2692           old_profile_ptr = ap_ptr;
2693           old_style_profile = (old_profile.version > 127);
2694 
2695           call hcs_$fs_get_mode (old_profile_ptr, old_profile_mode, code);
2696           if code ^= 0 then
2697                call abort_abbrev_processor (code, "Can not determine access to profile ^a", profile_pathname ());
2698 
2699           if (old_profile_mode ^= RW_ACCESS_BIN) & (old_profile_mode ^= REW_ACCESS_BIN) then
2700                if old_style_profile then                    /* can't upgrade an old profile: can't use it */
2701                     call abort_abbrev_processor (error_table_$moderr, "Can not upgrade profile ^a to current version.",
2702                          profile_pathname ());
2703                else return;                                 /* can't garbage collect it: doesn't matter */
2704 
2705           call get_temp_segment_ (ABBREV, new_profile_ptr, code);
2706           if code ^= 0 then return;
2707 
2708           on condition (cleanup)
2709                begin;
2710                if new_profile_ptr ^= null () then call release_temp_segment_ (ABBREV, new_profile_ptr, code);
2711           end;
2712 
2713           new_profile.version = ABBREV_PROFILE_VERSION_1;
2714           new_profile.next_free = fixed (rel (addr (new_profile.data_space)), 18, 0);
2715 
2716           if old_style_profile then                         /* get right lower bound; upper bounds are the same */
2717                lower_hash_bound = lbound (old_old_profile.hash_table, 1);
2718           else lower_hash_bound = lbound (old_profile.hash_table, 1);
2719 
2720           do hash_slot = lower_hash_bound to hbound (new_profile.hash_table, 1);
2721                last_new_ape_ptr = null ();
2722                if old_style_profile then                    /* get starting offset */
2723                     first_offset = old_old_profile.hash_table (hash_slot);
2724                else first_offset = old_profile.hash_table (hash_slot);
2725                do old_offset = first_offset repeat (old_ape.next) while (old_offset ^= 0);
2726                     old_ape_ptr = pointer (old_profile_ptr, old_offset);
2727                     if old_ape.name ^= "" then do;          /* copy only if not deleted */
2728                          new_ape_ptr = pointer (new_profile_ptr, new_profile.next_free);
2729                          new_ape.header = old_ape.header;   /* makes refer extents work */
2730                          new_ape.next = 0;                  /* but no forward thread yet */
2731                          new_ape.value = old_ape.value;
2732                          new_profile.next_free = new_profile.next_free + currentsize (new_ape);
2733                          if last_new_ape_ptr = null () then /* first entry in this hash slot */
2734                               new_profile.hash_table (hash_slot) = fixed (rel (new_ape_ptr), 18, 0);
2735                          else last_new_ape_ptr -> new_ape.next = fixed (rel (new_ape_ptr), 18, 0);
2736                          last_new_ape_ptr = new_ape_ptr;
2737                     end;
2738                end;
2739           end;
2740 
2741           old_profile_ptr -> new_profile_words = new_profile_ptr -> new_profile_words;
2742                                                             /* put the new one in place */
2743           call terminate_file_ (old_profile_ptr, (36 * new_profile.next_free), TERM_FILE_TRUNC_BC, (0));
2744 
2745           call release_temp_segment_ (ABBREV, new_profile_ptr, (0));
2746 
2747           return;
2748 
2749      end compact_profile;
2750 %page;
2751 %include "_abbrev_profile";
2752 %page;
2753 %include access_mode_values;
2754 
2755 %include terminate_file;
2756 
2757      end abbrev;