1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35 %page;
36 linus_apply: proc (
37
38 sci_ptr_parm,
39 lcb_ptr_parm
40 );
41
42 dcl sci_ptr_parm ptr parm;
43 dcl lcb_ptr_parm ptr parm;
44
45
46
47
48
49
50
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;