1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 /* format: off */
  7 
  8 
  9 
 10 /*   This is the main level procedure called by ssu_ to implement the
 11      linus apply request. Description and usage follows.
 12 
 13      Description:
 14 
 15      This request allows a user to edit the current query or a new query
 16      through use of apply.
 17 
 18      Usage: apply {-new | -old} command_line
 19 
 20      The control argument -new specifies that the user should start off with
 21      an empty query. The control argument -old specifies that the user should
 22      use the existing query. -old is the default.
 23 
 24      Both parameters are passed to this request by ssu_.
 25 
 26      Known Bugs:
 27 
 28      Other Problems:
 29 
 30      History:
 31 
 32      Written - Al Dupuis - August 1983
 33 
 34 */
 35 %page;
 36 linus_apply: proc (
 37 
 38           sci_ptr_parm,   /* input: ptr to the subsystem control info structure */
 39           lcb_ptr_parm    /* input: ptr to the linus control block info structure */
 40                          );
 41 
 42 dcl sci_ptr_parm ptr parm;
 43 dcl lcb_ptr_parm ptr parm;
 44 
 45 /*
 46      Mainline Processing Overview:
 47 
 48      (1) Check to make sure a data base is open. Process control args.
 49 
 50      (2) Get the subroutine to apply the query.
 51 */
 52 
 53           call initialize;
 54 
 55           if new_or_old_query_flag | lcb.liocb_ptr = null then
 56                call linus_query_mgr$initialize_query_file (lcb_ptr);
 57 
 58           call linus_query_mgr$get (lcb_ptr, query_segment_ptr, query_segment_length, code);
 59           if code ^= 0 & code ^= linus_error_$no_current_query
 60           then call ssu_$abort_line (sci_ptr, code);
 61 
 62           call ssu_$apply_request_util (sci_ptr, first_command_argument, query_segment_ptr, query_segment_length, new_length);
 63 
 64           call linus_query_mgr$put (lcb_ptr, query_segment_ptr, new_length, code);
 65           if code ^= 0
 66           then call ssu_$abort_line (sci_ptr, code);
 67 
 68           return;
 69 ^L
 70 initialize: proc;
 71 
 72 
 73           sci_ptr = sci_ptr_parm;
 74           lcb_ptr = lcb_ptr_parm;
 75 
 76           if lcb.db_index = 0
 77           then call ssu_$abort_line (sci_ptr, linus_error_$no_db);
 78 
 79           new_or_old_query_flag = OFF;
 80 
 81           call ssu_$arg_count (sci_ptr, number_of_args_supplied);
 82 
 83           first_command_argument = 0;
 84           do current_arg_number = 1 to number_of_args_supplied while (first_command_argument = 0);
 85                call ssu_$arg_ptr (sci_ptr, current_arg_number, arg_ptr, arg_length);
 86                if arg = "-new"
 87                then new_or_old_query_flag = ON;
 88                else if arg = "-old"
 89                     then new_or_old_query_flag = OFF;
 90                     else do;
 91                          first_command_argument = current_arg_number;
 92                          return;
 93                     end;
 94           end;
 95           call ssu_$abort_line (sci_ptr, 0, "Usage: apply {-new | -old} command_line");
 96 
 97           return;
 98 
 99      end initialize;
100 ^L
101 dcl OFF bit (1) aligned static internal options (constant) init ("0"b);
102 dcl ON bit (1) aligned static internal options (constant) init ("1"b);
103 
104 dcl addr builtin;
105 dcl arg char (arg_length) based (arg_ptr);
106 dcl arg_length fixed bin (21);
107 dcl arg_ptr ptr;
108 
109 dcl code fixed bin (35);
110 dcl current_arg_number fixed bin;
111 
112 dcl first_command_argument fixed bin;
113 dcl fixed builtin;
114 
115 dcl linus_error_$no_current_query fixed bin(35) ext static;
116 dcl linus_error_$no_db fixed bin(35) ext static;
117 dcl linus_query_mgr$get entry (ptr, ptr, fixed bin(21), fixed bin(35));
118 dcl linus_query_mgr$initialize_query_file entry (ptr);
119 dcl linus_query_mgr$put entry (ptr, ptr, fixed bin(21), fixed bin(35));
120 
121 dcl new_length fixed bin (21);
122 dcl new_or_old_query_flag bit (1) aligned;
123 dcl null builtin;
124 dcl number_of_args_supplied fixed bin;
125 
126 dcl query_segment_ptr ptr;
127 dcl query_segment_length fixed bin (21);
128 
129 dcl rel builtin;
130 
131 dcl sci_ptr ptr;
132 dcl ssu_$abort_line entry() options(variable);
133 dcl ssu_$arg_count entry (ptr, fixed bin);
134 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21));
135 dcl ssu_$apply_request_util entry (ptr, fixed bin, ptr, fixed bin(21), fixed bin(21));
136 dcl sys_info$max_seg_size fixed bin(35) ext static;
137 %page;
138 %include linus_lcb;
139 
140 
141 
142      end linus_apply;