1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 %skip(3);
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59 %page;
60 linus_write: proc (
61
62 sci_ptr_parm,
63 lcb_ptr_parm
64 );
65 %skip(3);
66 dcl sci_ptr_parm ptr parm;
67 dcl lcb_ptr_parm ptr parm;
68 %skip(3);
69
70
71
72
73
74
75
76
77
78 %skip(3);
79 call initialize;
80 call process_args;
81 call linus_create_data_file (lcb_ptr, addr (data_file_info));
82 %skip(1);
83 return;
84 %page;
85 initialize: proc;
86 %skip(3);
87 sci_ptr = sci_ptr_parm;
88 lcb_ptr = lcb_ptr_parm;
89 %skip(1);
90 unspec (data_file_info) = OFF;
91 data_file_info.column_delimiter = BLANK;
92 data_file_info.row_delimiter = NEWLINE;
93 data_file_info.flags.truncate_file = ON;
94 data_file_info.trace_every_n_tuples = linus_data_$trace_every_n_tuples;
95 %skip(1);
96 call ssu_$arg_count (sci_ptr, number_of_args_supplied);
97 if number_of_args_supplied = 0
98 then call ssu_$abort_line (sci_ptr, error_table_$noarg,
99 "An output file pathname must be supplied.");
100 %skip(1);
101 call ssu_$arg_ptr (sci_ptr, 1, arg_ptr, arg_length);
102 data_file_info.output_file_pathname = arg;
103 %skip(1);
104 return;
105 %skip(1);
106 end initialize;
107 %page;
108 process_args: proc;
109
110 do current_arg_number = 2 to number_of_args_supplied;
111
112 call ssu_$arg_ptr (sci_ptr, current_arg_number, arg_ptr, arg_length);
113
114 if arg = "-extend"
115 then data_file_info.flags.truncate_file = OFF;
116 else if arg = "-truncate" | arg = "-tc"
117 then data_file_info.flags.truncate_file = ON;
118 else if arg = "-no_progress" | arg = "-npg"
119 then do;
120 data_file_info.flags.tracing = OFF;
121 data_file_info.trace_every_n_tuples = linus_data_$trace_every_n_tuples;
122 end;
123 else if arg = "-progress" | arg = "-pg"
124 then call setup_tracing;
125 else if arg = "-column_delimiter" | arg = "-cdm"
126 | arg = "-delimiter" | arg = "-dm" | arg = "-row_delimiter" | arg = "-rdm"
127 then call setup_delimiter;
128 else call ssu_$abort_line (sci_ptr, error_table_$badopt,
129 "^a is not a valid control argument.", arg);
130 end;
131
132 return;
133 %page;
134 setup_delimiter: proc;
135
136 if current_arg_number + 1 > number_of_args_supplied
137 then call ssu_$abort_line (sci_ptr, error_table_$inconsistent,
138 "^/^[-row_delimiter^;-column_delimiter^] must be followed by a delimiter.",
139 (arg = "-row_delimiter" | arg = "-rdm"));
140
141 current_arg_number = current_arg_number + 1;
142 call ssu_$arg_ptr (sci_ptr, current_arg_number, arg_ptr, arg_length);
143 if arg_length ^= 1
144 then call ssu_$abort_line (sci_ptr, 0,
145 "The specified delimiter ""^a"" is not a single ascii character.", arg);
146 if (arg = "-row_delimiter" | arg = "-rdm")
147 then data_file_info.row_delimiter = arg;
148 else data_file_info.column_delimiter = arg;
149
150 return;
151
152 end setup_delimiter;
153 %page;
154 setup_tracing: proc;
155
156 data_file_info.tracing = ON;
157
158 if current_arg_number + 1 > number_of_args_supplied
159 then return;
160
161 call ssu_$arg_ptr (sci_ptr, current_arg_number + 1, arg_ptr, arg_length);
162 if verify (arg, "01234546789") = 0
163 then do;
164 data_file_info.trace_every_n_tuples = convert (data_file_info.trace_every_n_tuples, arg);
165 current_arg_number = current_arg_number + 1;
166 end;
167
168 return;
169
170 end setup_tracing;
171
172 end process_args;
173 %page;
174 dcl BLANK char (1) static internal options (constant) init (" ");
175 %skip(1);
176 dcl NEWLINE char (1) static internal options (constant) init ("
177 ");
178 %skip(1);
179 dcl OFF bit (1) aligned static internal options (constant) init ("0"b);
180 dcl ON bit (1) aligned static internal options (constant) init ("1"b);
181 %skip(1);
182 dcl addr builtin;
183 dcl arg char (arg_length) based (arg_ptr);
184 dcl arg_length fixed bin (21);
185 dcl arg_ptr ptr;
186 %skip(1);
187 dcl current_arg_number fixed bin;
188 %skip(1);
189 dcl error_table_$badopt fixed bin(35) ext static;
190 dcl error_table_$inconsistent fixed bin(35) ext static;
191 dcl error_table_$noarg fixed bin(35) ext static;
192 %skip(1);
193 dcl lcb_ptr ptr;
194 dcl linus_create_data_file entry (ptr, ptr);
195 dcl linus_data_$trace_every_n_tuples fixed bin (35) external static;
196 %skip(1);
197 dcl number_of_args_supplied fixed bin;
198 %skip(1);
199 dcl sci_ptr ptr;
200 dcl ssu_$abort_line entry() options(variable);
201 dcl ssu_$arg_count entry (ptr, fixed bin);
202 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21));
203 %skip(1);
204 dcl unspec builtin;
205 %page;
206 %include linus_data_file_info;
207 %skip(3);
208 end linus_write;