1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  6         *                                                         *
  7         *********************************************************** */
  8 /* Question asking utility for bootload command environment */
  9 /* This is like a VERY simple command_query_ */
 10 /* BIM 10/82 */
 11 /* Modified by Keith Loepere in 8/83 for new bce switches */
 12 
 13 /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */
 14 
 15 /* declare bce_query entry options (variable) */
 16 /* call bce_query (answer, cs, arg1, arg2, arg3, ...) */
 17 /* Where:             */
 18 /*         answer   (Output) is a NONvarying string */
 19 /*         cs       (Input) is the control string */
 20 /*         argN     (Input) are the ioa args */
 21 
 22 /* If only one argument is given, then this is equivalent to get_line */
 23 /* The entry bce_query$get_line is a direct way of asking for that */
 24 
 25 /* declare bce_query$yes_no entry options (variable) */
 26 /* call bce_query$yes_no (yes_or_no, cs, arg1, ..., argN) */
 27 
 28 /* declare bce_query$get_line entry (char (*)); */
 29 /* call bce_query$get_line (response); */
 30 
 31 bce_query:
 32      procedure (Answer) /* options (variable) */;
 33 
 34 declare  arg_count_                       entry returns (fixed bin);
 35 declare  cu_$arg_list_ptr                 entry returns (pointer);
 36 declare  ioa_$general_rs                  entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
 37                                           bit (1) aligned);
 38 declare  bce_data$error_put_chars         ext entry (ptr, ptr, fixed bin, fixed bin (35)) variable;
 39 declare  bce_data$get_line                ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)) variable;
 40 
 41 declare  Answer                           char (*);
 42 declare  Yes_No                           bit (1);
 43 
 44 declare  requery                          char (25) static options (constant) init ("Please answer yes or no: ");
 45 
 46 declare  buffer                           char (256);
 47 declare  used                             fixed bin (21);
 48 declare  yes_no                           bit (1);
 49 declare  just_get                         bit (1) aligned;
 50 declare  n_read                           fixed bin;
 51 declare  (substr, length, addr)           builtin;
 52 
 53 declare  arg_list_ptr                     pointer;
 54 %page;
 55 
 56           yes_no = "0"b;
 57           just_get = (arg_count_ () < 2);
 58           go to COMMON;
 59 
 60 
 61 get_line:
 62      entry (Answer);
 63 
 64           yes_no = "0"b;
 65           just_get = "1"b;
 66           go to COMMON;
 67 
 68 yes_no:
 69      entry (Yes_No);
 70 
 71           yes_no = "1"b;
 72           just_get = (arg_count_ () < 2);
 73 
 74 COMMON:
 75           arg_list_ptr = cu_$arg_list_ptr ();
 76           if ^just_get
 77           then do;
 78                buffer = "";
 79                call ioa_$general_rs (arg_list_ptr, 2, 3, buffer, used, "0"b, "0"b);
 80                call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (buffer), (used), (0));
 81           end;
 82 
 83           buffer = "";                                      /* wont hurt if ^yes_no */
 84 
 85           if yes_no
 86           then do while (buffer = "");
 87                call bce_data$get_line (addr (bce_data$get_line), addr (buffer), length (buffer), n_read, (0));
 88                buffer = substr (buffer, 1, n_read - 1 /* strip NL*/);
 89                if buffer = "yes" | buffer = "y"
 90                then go to RETURN_YES;
 91                else if buffer = "no" | buffer = "n"
 92                then go to RETURN_NO;
 93                call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (requery), length (requery), (0));
 94                buffer = "";
 95           end;
 96 
 97 /* Here on only if ^yes_no */
 98 
 99           Answer = "";
100           buffer = "";
101           call bce_data$get_line (addr (bce_data$get_line), addr (buffer), length (buffer), n_read, (0));
102           Answer = substr (buffer, 1, n_read - 1 /* strip NL */);
103           return;
104 
105 RETURN_YES:
106           Yes_No = "1"b;
107           return;
108 RETURN_NO:
109           Yes_No = "0"b;
110           return;
111      end bce_query;