1 /* ***********************************************************
  2    *                                                         *
  3    *                                                         *
  4    * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  5    *                                                         *
  6    *                                                         *
  7    *********************************************************** */
  8 
  9 /* ******************************************************
 10    *                                                    *
 11    *                                                    *
 12    * Copyright (c) 1972 by Massachusetts Institute of   *
 13    * Technology and Honeywell Information Systems, Inc. *
 14    *                                                    *
 15    *                                                    *
 16    ****************************************************** */
 17 
 18 linus_lila:
 19      proc (sci_ptr_parm, lcb_ptr_parm);
 20 %skip(3);
 21 dcl lcb_ptr_parm ptr parm;
 22 dcl sci_ptr_parm ptr parm;
 23 %skip(1);
 24 
 25 /* DESCRIPTION:
 26 
 27    This  procedure  functions  as  an  extremely  simple-minded editor, used in
 28    entering  and  manipulating  lila  expressions.  This editor looks very much
 29    like  a  subset  of  the editor in the basic system, and uses a vfile_ keyed
 30    sequential  file  to  hold the text.  The contents of this file are retained
 31    from one invocation of lila to the next, and the file is refreshed only if a
 32    -new control argument is specified in the LINUS "lila" request or the LILA
 33    "new" request is specified.
 34 
 35    HISTORY:
 36 
 37    77-04-01 J. A. Weeldreyer: Initially written.
 38 
 39    79-12-04 Rickie E.  Brinegar: Modified to return to linus request level when
 40    a macro is invoked with too few arguments.
 41 
 42    80-04-12  Rickie  E.  Brinegar: Modified to use linus_define_area instead of
 43    get_system_free_area_.
 44 
 45    81-02-03  Rickie E.  Brinegar: removed unreferenced variable sex.  Added rel
 46    builtin to the declarations.
 47 
 48    81-04-10 Rickie E.  Brinegar: changed linus version number from 2 to 3.0.
 49 
 50    81-07-14 Rickie E. Brinegar: added conversion condition trap.
 51 
 52    81-10-07     Rickie    E.     Brinegar:    changed    linus_translate    to
 53    linus_lila_translate to make it a LILA module as only LILA calls it.
 54 
 55    81-11-06  Rickie  E.   Brinegar:  Removed the calls to linus_free_se as the
 56    allocation of the selection expression is now in the lila temporary segment
 57    instead of the lcb.static area.
 58 
 59    82-01-29  DJ  Schimke:  Implemented  build mode (automatic line numbering).
 60    Added build,  last_line_num,  and  write_line  (pulled  from  process_line)
 61    internal procedures.  This is in response to PFS 4.9.5 for MR10.
 62 
 63    82-02-01  DJ Schimke: Added "new" request to delete the existing LILA file.
 64    This was added to compliment the build request.
 65 
 66    82-02-03  DJ  Schimke:  Added  "list_requests" and "?" requests to help the
 67    user.  Changed the inv_lila_req error message to inform the user about "?".
 68    Added "sv" short name to save request for convenience.
 69 
 70    82-02-08  Paul W. Benjamin:  Conversion of LINUS (not lila) to ssu_.
 71 
 72    82-06-22  DJ  Schimke: Changed lila to not abort the linus invocation when
 73    the get_line calls return a linus_err_$no_macro_arg error code.
 74 
 75    82-08-30  DJ Schimke: Modified lila build mode prompt to contain an asterisk
 76    at the end rather than a space if the line which is being input will
 77    overwrite an existing text line. Also improved the build (request & ctl_arg)
 78    parameter processing code to eliminate a logic error and clean it up.
 79 
 80    82-12-06  DJ Schimke: Modified lila to not prompt if the prompt string is
 81    just blanks (null character string). Also added the -prompt and -no_prompt
 82    control args which override the currrent subsystem prompting flag.
 83    Fixes an annoying problem when using the new exec_com facility in linus.
 84 
 85    83-02-10  DJ Schimke: Removed a call to linus_canon which was meant to be
 86    removed as part of the ssu conversion. Because the calling sequence for
 87    linus_canon was changed as part of the ssu conversion, we were getting fault
 88    tag 1 errors.The linus_invoke_ module calls linus_canon to expand macro args
 89    so this module no longer needs to worry about them.
 90 
 91    83-03-24  DJ Schimke: Added code to set lcb.si_ptr to null when a user tries
 92    to proc with a null lila file.
 93 
 94    83-08-23  Al Dupuis: Added the initialize_lila_file entry as part of the
 95    input_query work. The main entry point used to use sci_ptr and lcb_ptr
 96    as parms instead of the automatic ptrs they should have been, so I
 97    changed it so the parms are now declared explicitely and moved to the
 98    auto ptrs.
 99 
100    83-08-30 Bert Moberg: Added code for the translate_query request work.
101 
102 */
103 ^L
104 %include linus_lcb;
105 %page;
106 %include linus_char_argl;
107 %page;
108 %include linus_rel_array;
109 ^L
110           dcl     sci_ptr                ptr;               /* for ssu_ */
111 
112           dcl     (
113                   nread,                                    /* number of chars in input line */
114                   rec_len,                                  /* no. of chars in lila record */
115                   read_len
116                   )                      fixed bin (21);    /* no. of chars read from lila file */
117 
118           dcl     cmd_len                fixed bin;
119 
120           dcl     (
121                   ref_ptr                init (null),       /* referencing ptr for calls */
122                   ica_ptr                init (null),       /* ptr to char_argl for invoke */
123                   acmd_ptr               init (null),       /* for escaping to command processor */
124                   siocb_ptr              init (null),       /* save iocb pointer */
125                   env_ptr                init (null)
126                   )                      ptr;               /* sink for environment ptr */
127 
128           dcl     (
129                   code,                                     /* status code */
130                   icode
131                   )                      fixed bin (35);    /* internal status code */
132 
133           dcl     aligned_cmd            char (cmd_len) based (acmd_ptr);
134           dcl     arg                    char (char_argl.arg.arg_len (arg_index))
135                                          based (char_argl.arg.arg_ptr (arg_index));
136                                                             /* input arg */
137           dcl     arg_index              fixed bin;         /* arg index */
138           dcl     atd                    char (173);        /* save attach desc */
139           dcl     build_increment        fixed bin;         /* current increment */
140           dcl     build_mode             bit (1);           /* on if in build mode */
141           dcl     next_build_line        pic "9999";        /* next automatic line number*/
142           dcl     chars                  (nread) char (1) unal based (lcb.rb_ptr);
143                                                             /* another version of request */
144           dcl     control_arg            bit (1) unal;      /* control arg flag */
145           dcl     done                   bit (1) unal;      /* completion flag */
146           dcl     lila_prompt_flag       bit (1) unal;      /* -prompt/-no_prompt flag */
147           dcl     i                      fixed bin;         /* index for do */
148           dcl     key                    pic "9999";        /* line number */
149           dcl     key_var                char (256) var;    /* var. version of line no. */
150           dcl     parameter              fixed bin;         /* parameter to request or control arg */
151           dcl     parameter_number       fixed bin;         /* parameter index */
152           dcl     prompt_char            char (32) varying
153                                          based (lcb.lila_promp_chars_ptr);
154           dcl     req_index              fixed bin (17);    /* loop index */
155           dcl     request                char (nread) based (lcb.rb_ptr);
156                                                             /* input line */
157           dcl     request_count          fixed bin init (11) int static options (constant);
158           dcl     1 request_table        (request_count) aligned, /* table of requests and short names */
159                                                             /*  Must be changed whenever requests are added. */
160                     2 name               char (15) var
161                                          init (".", "?", "build", "execute", "invoke",
162                                          "list_requests", "list", "new", "proc", "quit",
163                                          "save"),
164                     2 short              char (5) var
165                                          init ("", "", "", "e", "i", "lr", "ls", "", "",
166                                          "q", "sv"),
167                     2 summary            char (60) var
168                                          init ("Print the current lila status.",
169                                          "List all lila request names.",
170                                          "Enter build mode to insert/overwrite text.",
171                                          "Execute a Multics command line.",
172                                          "Invoke the specified Linus macro.",
173                                          "List brief information on lila requests.",
174                                          "List the current file.",
175                                          "Delete all text from the current lila file.",
176                                          "Process the current lila file.", "Leave LILA.",
177                                          "Save the current text into the specified linus macro."
178                                          );
179           dcl     token                  char (15) var;     /* first token in lila line */
180           dcl     work_area              area (sys_info$max_seg_size)
181                                          based (lcb.lila_area_ptr);
182 
183           dcl     1 list_buf             aligned,
184                     2 key                char (4) unal,
185                     2 data               char (256) unal;
186 
187           dcl     WHT_SPC                char (3) int static options (constant) init ("
188           ");                                               /* NL, SP, HT */
189           dcl     NO_KILL                fixed bin (35) int static options (constant)
190                                          init (0);
191           dcl     KILL                   fixed bin (35) int static options (constant)
192                                          init (1);
193           dcl     NL                     char (1) int static options (constant) init ("
194 ");
195           dcl     BOF                    fixed bin int static options (constant) init (-1);
196           dcl     KSU                    fixed bin int static options (constant) init (10);
197           dcl     SO                     fixed bin int static options (constant) init (2);
198 
199           dcl     (
200                   error_table_$end_of_info,
201                   error_table_$no_record,
202                   linus_data_$lila_id,
203                   linus_error_$bad_stmt_no,
204                   linus_error_$build_overflow,
205                   linus_error_$conv,
206                   linus_error_$integer_too_large,
207                   linus_error_$integer_too_small,
208                   linus_error_$inv_arg,
209                   linus_error_$inv_lila_req,
210                   linus_error_$no_db,
211                   linus_error_$no_lila_data,
212                   linus_error_$no_macro_arg,
213                   linus_error_$no_path,
214                   linus_error_$nonex_del,
215                   linus_error_$non_integer,
216                   linus_error_$bad_num_args,
217                   sys_info$max_seg_size
218                   )                      ext fixed bin (35);
219 
220           dcl     (
221                   iox_$user_input,
222                   iox_$user_output
223                   )                      ptr ext;
224 
225           dcl     (cleanup, conversion)
226                                          condition;
227 
228           dcl     (addr, after, bin, char, divide, before, fixed, index, length, ltrim,
229                   mod, null, rel, rtrim, search, substr, string, verify)
230                                          builtin;
231 
232 /* Multics Subroutines */
233 
234           dcl     cu_$cp                 entry (ptr, fixed bin, fixed bin (35));
235           dcl     cu_$decode_entry_value
236                                          entry (entry, ptr, ptr);
237           dcl     cv_dec_check_          entry (char (*), fixed bin (35))
238                                          returns (fixed bin (35));
239           dcl     ioa_                   entry options (variable);
240           dcl     ioa_$ioa_switch        entry options (variable);
241           dcl     ioa_$nnl               entry options (variable);
242           dcl     iox_$attach_name       entry (char (*), ptr, char (*), ptr,
243                                          fixed bin (35));
244           dcl     iox_$close             entry (ptr, fixed bin (35));
245           dcl     iox_$delete_record     entry (ptr, fixed bin (35));
246           dcl     iox_$detach_iocb       entry (ptr, fixed bin (35));
247           dcl     iox_$get_line          entry (ptr, ptr, fixed bin (21), fixed bin (21),
248                                          fixed bin (35));
249           dcl     iox_$open              entry (ptr, fixed bin, bit (1) aligned,
250                                          fixed bin (35));
251           dcl     iox_$position          entry (ptr, fixed bin, fixed bin (21),
252                                          fixed bin (35));
253           dcl     iox_$read_key          entry (ptr, char (256) var, fixed bin (21),
254                                          fixed bin (35));
255           dcl     iox_$read_record       entry (ptr, ptr, fixed bin (21), fixed bin (21),
256                                          fixed bin (35));
257           dcl     iox_$rewrite_record    entry (ptr, ptr, fixed bin (21), fixed bin (35));
258           dcl     iox_$seek_key          entry (ptr, char (256) var, fixed bin (21),
259                                          fixed bin (35));
260           dcl     iox_$write_record      entry (ptr, ptr, fixed bin (21), fixed bin (35));
261           dcl     get_pdir_              entry returns (char (168));
262           dcl     ssu_$abort_line        entry options (variable);
263           dcl     ssu_$abort_subsystem   entry options (variable);
264           dcl     ssu_$arg_count         entry (ptr, fixed bin);
265           dcl     ssu_$arg_ptr           entry (ptr, fixed bin, ptr, fixed bin (21));
266           dcl     ssu_$execute_line      entry (ptr, ptr, fixed bin (21), fixed bin (35));
267           dcl     unique_chars_          entry (bit (*)) returns (char (15));
268 
269 /* LINUS/MRDS Subroutines */
270 
271           dcl     linus_convert_code     entry (fixed bin (35), fixed bin (35),
272                                          fixed bin (35));
273           dcl     linus_invoke$pop_all
274                                          entry (ptr, fixed bin (35));
275           dcl     linus_print_error      entry (fixed bin (35), char (*));
276           dcl     linus_translate_query$proc
277                                          entry (ptr, fixed bin (35));
278 ^L
279           sci_ptr = sci_ptr_parm;
280           lcb_ptr = lcb_ptr_parm;
281           build_mode = "0"b;                                /* initialize */
282           lila_prompt_flag = lcb.prompt_flag;
283           ica_ptr, siocb_ptr = null;
284           call cu_$decode_entry_value (linus_lila, ref_ptr, env_ptr);
285                                                             /* for later calls */
286 
287           on cleanup call tidy_up;
288           on conversion call error (linus_error_$conv, "", NO_KILL);
289 
290           ca_ptr = null;
291           if lcb.db_index = 0 then
292                call error (linus_error_$no_db, "", NO_KILL);
293 
294           call ssu_$arg_count (sci_ptr, nargs_init);
295 
296           if nargs_init ^= 0                                /* if have arg */
297           then do;
298                     allocate char_argl in (lcb.static_area);
299                     do i = 1 to nargs_init;
300                          call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i));
301                     end;
302                     do arg_index = 1 to char_argl.nargs;    /* request arg loop */
303                          if arg = "-new"
304                          then do;                           /* if -new, must start with new file */
305                                    if lcb.liocb_ptr = null  /* no old file */
306                                    then call init_lila_file;/* just make new one */
307                                    else if lcb.lila_count > 0
308                                    then call delete_old_file; /* delete old data */
309                               end;                          /* -new */
310 
311                          else if arg = "-no_prompt"
312                          then lila_prompt_flag = "0"b;      /* if -no_prompt */
313 
314                          else if arg = "-prompt"
315                          then lila_prompt_flag = "1"b;      /* if -prompt */
316 
317                          else if arg = "-build"
318                          then do;                           /* if -build */
319                                    build_increment = lcb.build_increment; /* default */
320                                    next_build_line = 0;     /* init */
321 
322                                    parameter_number = 1;
323                                    control_arg = "0"b;
324                                    do while ((arg_index + 1 <= char_argl.nargs) & (^control_arg));
325                                         arg_index = arg_index + 1; /* look at next arg */
326                                         parameter = cv_dec_check_ (arg, code);
327                                         if code ^= 0
328                                         then do;
329                                                   control_arg = "1"b;
330                                                   arg_index = arg_index - 1;
331                                              end;
332                                         else do;            /* have parameters */
333                                                   if (parameter < 1)
334                                                   then call error (linus_error_$integer_too_small, arg, NO_KILL);
335                                                   if (parameter > 9999)
336                                                   then call error (linus_error_$integer_too_large, arg, NO_KILL);
337 
338                                                   if parameter_number = 1
339                                                   then next_build_line = parameter;
340                                                   else if parameter_number = 2
341                                                   then build_increment = parameter;
342                                                   else call error (linus_error_$bad_num_args, "^/""-build"" allows a maximum of two parameters. " || arg, NO_KILL); /* no third parameter allowed */
343 
344                                                   parameter_number = parameter_number + 1;
345                                              end;           /* have parameters */
346                                    end;                     /* do while */
347                                    build_mode = "1"b;
348                               end;                          /* if -build */
349 
350                          else call error (linus_error_$inv_arg, arg, NO_KILL);
351                     end;                                    /* request loop */
352                end;                                         /* if have arg */
353 
354           if build_mode
355                then call set_build_start ("0"b);
356 
357           if lcb.liocb_ptr = null then /* if no lila file
358 
359 */
360                call init_lila_file;                         /* make one */
361 
362           done = "0"b;                                      /* init completion flag */
363           code = 0;
364 
365           do while (^done);                                 /* until user types end */
366 
367                if build_mode then
368                     call build;                             /* building */
369 
370                if lila_prompt_flag then do;                 /* if prompting */
371                          if lcb.is_ptr = iox_$user_input
372                               & prompt_char ^= "" then
373                               call ioa_$nnl ("^a ", prompt_char);
374                     end;
375 
376                call iox_$get_line (iox_$user_input, lcb.rb_ptr, lcb.rb_len, nread, icode);
377                                                             /* read next line */
378 
379                if icode = linus_error_$no_macro_arg then /* if no_macro arg */
380                     call error (icode, "reading LILA build text", NO_KILL);
381                else if icode ^= 0 then /* if other error */
382                     call error (icode, "reading LILA text", KILL);
383                else call process_line;                      /* if OK */
384                if lcb.is_ptr ^= iox_$user_input & code ^= 0 then
385                     do;
386                          call linus_invoke$pop_all (lcb_ptr, icode);
387                          call tidy_up;
388                     end;
389 
390           end;                                              /* main LILA loop */
391 
392           code = 0;
393 exit:
394           if ca_ptr ^= null
395           then free char_argl;
396           if code ^= 0
397           then call ssu_$abort_subsystem (sci_ptr, code);
398           return;
399 %page;
400 initialize_lila_file: entry (
401 
402           lcb_ptr_parm        /* input: ptr to the linus control block */
403                            );
404 %skip(3);
405           lcb_ptr = lcb_ptr_parm;
406           sci_ptr = lcb.subsystem_control_info_ptr;
407           if lcb.liocb_ptr = null ()
408           then call init_lila_file;
409           else call delete_old_file;
410           lcb.lila_chars = 0;
411           lcb.lila_count = 0;
412 %skip(1);
413           return;
414 ^L
415 error:
416      proc (icode, msg, fatal_flag);
417 
418 /* Error procedure, calls convert_code and print_error and then returns. */
419 
420           dcl     (ucode, icode, fatal_flag)
421                                          fixed bin (35);
422           dcl     msg                    char (*);
423 
424           if lcb.is_ptr ^= iox_$user_input then
425                call linus_invoke$pop_all (lcb_ptr, code);
426           call linus_convert_code (icode, ucode, linus_data_$lila_id);
427           code = fatal_flag;
428           call tidy_up;
429           if fatal_flag = NO_KILL
430           then call ssu_$abort_line (sci_ptr, ucode, msg);
431           else call ssu_$abort_subsystem (sci_ptr, ucode, msg);
432 
433 
434      end error;
435 ^L
436 tidy_up:
437      proc;
438 
439 /* procedure to clean up if interrupted */
440 
441           if (icode ^= 0 | code ^= 0) & ^lcb.prompt_flag then
442                call linus_print_error (0, "Returning to linus request level.");
443           if ca_ptr ^= null
444           then free char_argl;
445           if siocb_ptr ^= null then
446                do;                                          /* if open save switch */
447                     call iox_$close (siocb_ptr, icode);
448                     call iox_$detach_iocb (siocb_ptr, icode);
449                end;
450 
451      end tidy_up;
452 ^L
453 process_line:
454      proc;
455 
456 /* Procedure to process a LILA input line */
457 
458           dcl     (i, j)                 fixed bin;
459 
460           i = verify (request, WHT_SPC);                    /* search for first data */
461           if i <= 0 then
462                return;                                      /* was null line */
463           j = search (substr (request, i), WHT_SPC);        /* look for end of token */
464           if j <= 0 then
465                j = nread - i + 1;                           /* was at end of request */
466           else j = j - 1;
467 
468           token = substr (request, i, j);                   /* isolate line no. or request */
469           if token >= "0" & token <= "9999" then
470                do;                                          /* token may be number */
471                     if verify (token, "0123456789") ^= 0 /* if not really numeric */
472                          | length (token) > 4 then
473                          do;                                /* or too many digits */
474                               call linus_print_error (linus_error_$bad_stmt_no, (token));
475                               return;
476                          end;
477                     key = fixed (token);                    /* canonize to 4 digits */
478                     i = i + j;                              /*  first char beyond stmt no. */
479                     j = verify (substr (request, i), WHT_SPC); /* search for data following stmt no. */
480                     if j <= 0 then
481                          do;                                /* no more data, is delete */
482                               call iox_$seek_key (lcb.liocb_ptr, (key), rec_len, icode);
483                                                             /* find the line */
484                               if icode ^= 0 then /* if not found */
485                                    call linus_print_error (linus_error_$nonex_del, (token));
486                               else
487                                    do;                      /* found the line, delete it */
488                                         lcb.si_ptr = null;  /* force new proc */
489                                         call iox_$delete_record (lcb.liocb_ptr, icode);
490                                         if icode ^= 0 then /* problems */
491                                              call error (icode, "", KILL);
492                                         lcb.lila_chars = lcb.lila_chars - rec_len;
493                                                             /* decr. char count */
494                                         lcb.lila_count = lcb.lila_count - 1; /* decrement line count */
495                                    end;                     /* line deletion */
496                          end;                               /* delete operation */
497                     else call write_line ((key), addr (chars (i)), nread - i + 1);
498                                                             /* source line specified */
499                end;                                         /* if key is possible number */
500 
501           else if token = "." then /* user wants reassurance */
502                call ioa_ ("linus version ^a (lila)", lcb.linus_version);
503 
504           else if token = "list" | token = "ls" then
505                do;                                          /* user wants list of file */
506                     if lcb.lila_count <= 0 then /* no lines in file */
507                          call linus_print_error (linus_error_$no_lila_data, request);
508                     else call list_file (iox_$user_output); /* there is data, list it */
509                end;                                         /* list command */
510 
511           else if token = "proc" then
512                do;                                          /* user wants to translate */
513                     call linus_translate_query$proc (lcb_ptr, code); /* create MRDS selection expression */
514                     if code ^= 0 then go to exit;
515                end;                                         /* processing end */
516 
517           else if token = "quit" | token = "q" then
518                done = "1"b;
519 
520           else if token = "invoke" | token = "i" then
521                do;                                          /* process invoke request */
522                     call ssu_$execute_line (sci_ptr, lcb.rb_ptr, nread, icode);
523                     if icode ^= 0 then
524                          go to exit;
525                     ica_ptr = null;
526                end;                                         /* invoke */
527 
528           else if token = "save" | token = "sv" then
529                do;                                          /* process save */
530                     if lcb.lila_count <= 0 then
531                          call linus_print_error (linus_error_$no_lila_data, request);
532                     else
533                          do;                                /* if have lines to save */
534                               call get_token;
535                               if j > 0 then
536                                    do;                      /* if path supplied */
537                                         if substr (request, i + j - 6, 6) = ".linus" then
538                                              /* if suffix spec. */
539                                              atd = "vfile_ " || substr (request, i, j);
540                                         else atd = "vfile_ " || substr (request, i, j)
541                                                   || ".linus";
542                                         call
543                                              iox_$attach_name (unique_chars_ ("0"b)
544                                              || ".lila_save", siocb_ptr, atd, ref_ptr, icode);
545                                         if icode ^= 0 then
546                                              call soft_error (icode, atd);
547                                         call iox_$open (siocb_ptr, SO, "0"b, icode);
548                                         if icode ^= 0 then
549                                              call soft_error (icode, atd);
550                                         call list_file (siocb_ptr); /* list into save file */
551                                         call iox_$close (siocb_ptr, icode);
552                                         if icode ^= 0 then
553                                              call soft_error (icode, atd);
554                                         call iox_$detach_iocb (siocb_ptr, icode);
555                                         if icode ^= 0 then
556                                              call soft_error (icode, atd);
557                                         siocb_ptr = null;
558                                    end;                     /* if path supplied */
559                               else call soft_error (linus_error_$no_path, (token));
560                          end;                               /* if have lines to save */
561                end;                                         /* save */
562           else if token = "e" | token = "execute" | index (token, "..") = 1 then
563                do;
564                     cmd_len = nread;
565                     allocate aligned_cmd in (work_area);
566                     if index (token, "..") = 1 then
567                          token = "..";
568                     aligned_cmd = ltrim (after (request, rtrim (token)));
569                     call cu_$cp (acmd_ptr, cmd_len, icode);
570                     acmd_ptr = null;
571                end;
572 
573           else if token = "build"
574           then
575                do;                                          /* build request */
576                     build_increment = lcb.build_increment;  /* default */
577                     next_build_line = 0;                    /* init */
578                     call get_token;
579                     parameter_number = 1;
580                     do while (j > 0);                       /* while we have parameters */
581                          parameter = cv_dec_check_ (substr (request, i, j), code);
582                          if code ^= 0
583                          then call soft_error (linus_error_$non_integer, substr (request, i, j));
584                          if (parameter < 1)
585                          then call soft_error (linus_error_$integer_too_small, substr (request, i, j));
586                          if (parameter > 9999)
587                          then call soft_error (linus_error_$integer_too_large, substr (request, i, j));
588 
589                          if parameter_number = 1
590                          then next_build_line = parameter;
591                          else if parameter_number = 2
592                          then build_increment = parameter;
593                          else call soft_error (linus_error_$bad_num_args, "^/""build"" allows a maximum of two parameters. " || substr (request, i, j)); /* no third parameter allowed */
594                          call get_token;
595                          parameter_number = parameter_number + 1;
596                     end;                                    /* have parameters */
597                     build_mode = "1"b;
598                     call set_build_start ("1"b);
599                end;                                         /* build request */
600 
601           else if token = "new" then
602                do;                                          /* new file request */
603                     if lcb.lila_count > 0 then
604                          call delete_old_file;              /* delete old text file */
605                end;
606 
607           else if token = "?" then
608                do;                                          /* list requests */
609                     call ioa_ ("^/Available lila requests:^/"); /* in 3 columns */
610                     do req_index = 1 to divide (request_count, 3, 17) * 3 by 3;
611                          call
612                               ioa_ (
613                               "^a^[^s^;, ^a^]^[^25t^a^[^s^;, ^a^]^[^50t^a^[^s^;, ^a^]^]^]",
614                               request_table.name (req_index),
615                               (request_table.short (req_index) = ""),
616                               request_table.short (req_index),
617                               (req_index + 1 <= request_count),
618                               request_table.name (req_index + 1),
619                               (request_table.short (req_index + 1) = ""),
620                               request_table.short (req_index + 1),
621                               (req_index + 2 <= request_count),
622                               request_table.name (req_index + 2),
623                               (request_table.short (req_index + 2) = ""),
624                               request_table.short (req_index + 2));
625                     end;
626                     if mod (request_count, 3) = 2 then
627                          call
628                               ioa_ ("^a^[^s^;, ^a^]^25t^a^[^s^;, ^a^]",
629                               request_table.name (req_index),
630                               (request_table.short (req_index) = ""),
631                               request_table.short (req_index),
632                               request_table.name (req_index + 1),
633                               (request_table.short (req_index + 1) = ""),
634                               request_table.short (req_index + 1));
635 
636                     if mod (request_count, 3) = 1 then
637                          call
638                               ioa_ ("^a^[^s^;, ^a^]", request_table.name (req_index),
639                               (request_table.short (req_index) = ""),
640                               request_table.short (req_index));
641 
642                     call
643                          ioa_ (
644                          "^/Type ""list_requests"" for a short description of the requests.^/"
645                          );
646                end;
647 
648           else if token = "list_requests" | token = "lr" then
649                do;                                          /* list requests briefly */
650                     call ioa_ ("^/Summary of lila requests:");
651                     call
652                          ioa_ (
653                          "^/Use "".. COMMAND_LINE"" to escape a command line to Multics.^/")
654                          ;
655                     do req_index = 1 to request_count;
656                          call
657                               ioa_ ("^a^[^s^;, ^a^]^20t^a", request_table.name (req_index),
658                               (request_table.short (req_index) = ""),
659                               request_table.short (req_index),
660                               request_table.summary (req_index));
661                     end;
662                     call
663                          ioa_ (
664                          "^/Type ""help"" at LINUS request level for more information.^/");
665                end;
666 
667           else /* invalid LILA request */
668                call linus_print_error (linus_error_$inv_lila_req, ("  bad request: " || token));
669 
670 list_file:
671      proc (iocb_ptr);
672 
673 /* Procedure to write the LILA file to a stream file */
674 
675           dcl     iocb_ptr               ptr;
676 
677           call iox_$position (lcb.liocb_ptr, BOF, 0, icode);/* to start of file */
678           if icode ^= 0 then
679                call error (icode, "", KILL);
680           do while (icode = 0);                             /* read and print each line */
681                string (list_buf) = " ";                     /* clear the print line */
682                call iox_$read_key (lcb.liocb_ptr, key_var, rec_len, icode);
683                if icode = 0 then
684                     do;
685                          call
686                               iox_$read_record (lcb.liocb_ptr, addr (list_buf.data),
687                               rec_len, read_len, icode);
688                          if icode = 0 then
689                               do;
690                                    list_buf.key = key_var;
691                                    call
692                                         ioa_$ioa_switch (iocb_ptr, "^a",
693                                         before (string (list_buf), NL));
694                               end;                          /* printing line */
695                     end;                                    /* reading line data */
696           end;                                              /* loop through file */
697           if icode ^= error_table_$end_of_info then
698                call error (icode, "", KILL);
699 
700      end list_file;
701 
702 get_token:
703      proc;
704 
705 /* Procedure to get index and length of next token in request */
706 
707           i = i + j;                                        /* first char past token */
708           if i <= nread then
709                do;                                          /* if still within request */
710                     j = verify (substr (request, i), WHT_SPC); /* first char of next token */
711                     if j > 0 then
712                          do;                                /* if found another token */
713                               i = i + j - 1;                /* ditto */
714                               j = search (substr (request, i), WHT_SPC); /* get length */
715                               if j <= 0 then
716                                    j = nread - i + 1;
717                               else j = j - 1;
718                          end;                               /* if found another token */
719                end;                                         /* if still within request */
720           else j = 0;
721 
722      end get_token;
723 
724 soft_error:
725      proc (cd, msg);
726 
727 /* Procedure to fail very softly */
728 
729           dcl     (cd, ucd)              fixed bin (35);
730           dcl     msg                    char (*);
731 
732           call linus_convert_code (cd, ucd, linus_data_$lila_id);
733           call linus_print_error (ucd, msg);
734           go to pl_exit;
735 
736      end soft_error;
737 
738 pl_exit:
739      end process_line;
740 ^L
741 init_lila_file:
742      proc;
743 
744 /* Procedure to create and init a keyed seq. file to contain lila statements. */
745 
746           lcb.lila_fn = unique_chars_ ("0"b) || ".lila";    /* name of file */
747           call
748                iox_$attach_name (unique_chars_ ("0"b) || ".lila_switch",
749                lcb.liocb_ptr,
750                "vfile_ " || before (get_pdir_ (), " ") || ">" || lcb.lila_fn, ref_ptr,
751                icode);
752           if icode ^= 0 then
753                call error (icode, "", KILL);
754           call iox_$open (lcb.liocb_ptr, KSU, "0"b, icode);
755           if icode ^= 0 then
756                call error (icode, "", KILL);
757           else
758                do;                                          /* init */
759                     call write_line ((1), addr (chars (1)), 0);
760                     call delete_old_file;
761                end;
762 
763      end init_lila_file;
764 ^L
765 delete_old_file:
766      proc;
767 
768 /* Procedure to delete existing lines from a lila file */
769 
770           lcb.si_ptr = null;                                /* force new proc */
771           call iox_$position (lcb.liocb_ptr, BOF, 0, icode);/* start from BOF */
772           if icode ^= 0 then
773                call error (icode, "", KILL);
774 
775           do while (icode = 0);                             /* delete all lines */
776                call iox_$delete_record (lcb.liocb_ptr, icode);
777           end;
778 
779           if icode ^= error_table_$no_record then
780                call error (icode, "", KILL);
781           lcb.lila_chars, lcb.lila_count = 0;               /* indicate true line and char count */
782 
783      end delete_old_file;
784 
785 write_line:
786      proc (source_key, source_ptr, source_len);
787 
788 /* procedure to insert a new lila source line  */
789 /*   (or replace an old lila source line)      */
790 
791           dcl     source_key             pic "9999" parameter; /* line number */
792           dcl     source_ptr             ptr parameter;     /* ptr to input string */
793           dcl     source_len             fixed bin (21) parameter; /* length of input string */
794 
795           lcb.si_ptr = null;                                /* force new proc */
796           call iox_$seek_key (lcb.liocb_ptr, (source_key), rec_len, icode);
797                                                             /* see if line exists */
798           if icode = 0 then
799                do;                                          /* line exists, change it */
800                     call
801                          iox_$rewrite_record (lcb.liocb_ptr, source_ptr, source_len,
802                          icode);
803                     if icode ^= 0 then
804                          call error (icode, "", KILL);
805                     lcb.lila_chars = lcb.lila_chars - rec_len + source_len;
806                end;                                         /* changing line */
807           else if icode = error_table_$no_record then
808                do;                                          /* is new line, write it */
809                     call
810                          iox_$write_record (lcb.liocb_ptr, source_ptr, source_len, icode);
811                     if icode ^= 0 then
812                          call error (icode, "", KILL);
813                     lcb.lila_chars = lcb.lila_chars + source_len;
814                     lcb.lila_count = lcb.lila_count + 1;    /* increment line count */
815                end;                                         /* writing new line */
816           else call error (icode, "", KILL);                /* problems */
817 
818 
819      end write_line;
820 
821 build:
822      proc;
823 
824 /* procedure to handle input during "build" */
825 
826           do while (build_mode);
827 
828                if lcb.is_ptr = iox_$user_input
829                then do;                                     /* prompt */
830                          call iox_$seek_key (lcb.liocb_ptr, (next_build_line), rec_len, icode);
831                          if icode = 0
832                          then call ioa_$nnl ("^a*", next_build_line); /* line exists */
833                          else call ioa_$nnl ("^a ", next_build_line);
834                     end;
835 
836                call iox_$get_line (iox_$user_input, lcb.rb_ptr, lcb.rb_len, nread, icode);
837                                                             /* read next line */
838 
839                if icode = linus_error_$no_macro_arg then /* if no_macro arg */
840                     call error (icode, "reading build text", NO_KILL);
841 
842                else if icode ^= 0 then /* if other error */
843                     call error (icode, "reading build text", KILL);
844 
845                if verify (request, WHT_SPC) > 0 then
846                     do;                                     /* wasn't null line */
847                          if substr (request, 1, nread - 1) = "." then
848                               build_mode = "0"b;            /* done */
849 
850                          else
851                               do;                           /* build input line */
852                                    nread = nread + 1;
853                                    request = " " || substr (request, 1, nread - 1);
854                                    call
855                                         write_line ((next_build_line), addr (chars (1)), nread);
856                                                             /* write the line */
857                                    if next_build_line + build_increment > 9999 then
858                                         do;                 /* line number grew too big */
859                                              build_mode = "0"b; /* must stop */
860                                              call
861                                                   linus_print_error (linus_error_$build_overflow,
862                                                   char (next_build_line + build_increment));
863                                         end;
864                                    else next_build_line = next_build_line + build_increment;
865                                                             /* increment automatic line */
866 
867                               end;                          /* build input line */
868 
869                     end;
870           end;
871 
872      end build;
873 
874 last_line_num:
875      proc returns (pic "9999");
876 
877 /* Procedure to return the last (largest) line number in the current lila */
878 /* selection expression.                                                  */
879 
880           dcl     line_number            pic "9999";
881           dcl     line_number_key        char (256) var;
882           dcl     EOF                    fixed bin int static options (constant) init (+1);
883 
884           if lcb.lila_count = 0 then
885                line_number = 0;
886           else
887                do;
888                     call iox_$position (lcb.liocb_ptr, EOF, 0, icode);
889                     if icode ^= 0 then
890                          call error (icode, "", NO_KILL);
891 
892                     call iox_$position (lcb.liocb_ptr, 0, -1, icode);
893                     if icode ^= 0 then
894                          call error (icode, "", NO_KILL);
895 
896                     call iox_$read_key (lcb.liocb_ptr, line_number_key, rec_len, icode);
897                     if icode ^= 0 then
898                          call error (icode, "", NO_KILL);
899                     line_number = bin (line_number_key);
900                end;
901           return (line_number);
902      end last_line_num;
903 
904 set_build_start:
905  proc (request);
906 
907  dcl request bit(1) unal parm;
908 
909  if next_build_line = 0
910       then do;
911       next_build_line = last_line_num ();
912 
913       if next_build_line + build_increment <= 9999
914            then next_build_line = next_build_line + build_increment;   /* default start is offset from current largest line num */
915       else do;                                              /* error */
916            build_mode = "0"b;
917            if ^request
918                 then call error (0, "The build increment (" || ltrim (char (build_increment))
919                 || ") is too large.", NO_KILL);
920            call linus_print_error (linus_error_$integer_too_large, "The build increment (" || ltrim (char (build_increment))
921                 || ") is too large.");
922            return;
923            end;
924       end;
925  end set_build_start;
926 
927      end linus_lila;