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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56 plus: proc;
57
58 dcl op char(8) var,
59 (number1,number2) float dec(59),
60 prec_fixed fixed bin,
61 result char(72) varying,
62 code fixed bin(35),
63 not_active_function bit(1),
64 (i,count) fixed bin,
65 get_arg variable entry(fixed bin,ptr,fixed bin,fixed bin(35)),
66 (ap,ap1) ptr,
67 (al,al1) fixed bin,
68 answer char(al1) varying based(ap1),
69 arg char(al) based(ap),
70 (mod,max,min,fixed,string,trunc,floor,ceil) builtin,
71 (conversion, overflow, underflow, zerodivide) condition;
72
73 dcl BASE_10 fixed bin int static options (constant) init (10);
74
75 dcl (cu_$arg_ptr,cu_$af_arg_ptr,cu_$af_return_arg) entry(fixed bin,ptr,fixed bin,fixed bin(35)),
76 cu_$arg_count entry returns(fixed bin),
77 cv_condition_$display entry (char(*), char(32) var),
78 cv_fixed_point_string_ entry (char(*), fixed bin, bit(*), fixed bin(35)) returns(float dec(59)),
79 move_r_or_t_ entry(float dec(59), float dec(59), fixed bin),
80 numeric_to_ascii_ entry(float dec(59),fixed bin,char(72) varying),
81 (ioa_,com_err_,active_fnc_err_) options(variable),
82 gripe entry variable options(variable);
83
84 dcl (error_table_$not_act_fnc,
85 error_table_$wrong_no_of_args) fixed bin(35) ext static;
86
87 dcl 1 op_type,
88 2 multi bit(1) unaligned,
89 2 unary bit(1) unaligned;
90 %page;
91 op = "plus";
92 string(op_type) = "11"b;
93 goto join;
94
95 minus: entry;
96
97 op = "minus";
98 string(op_type) = "00"b;
99 goto join;
100
101 times: entry;
102
103 op = "times";
104 string(op_type) = "11"b;
105 goto join;
106
107 divide: entry;
108
109 op = "divide";
110 string(op_type) = "00"b;
111 goto join;
112
113 quotient: entry;
114
115 op = "quotient";
116 string(op_type) = "00"b;
117 goto join;
118
119 mod: entry;
120
121 op = "mod";
122 string(op_type) = "00"b;
123 goto join;
124
125 max: entry;
126
127 op = "max";
128 string(op_type) = "10"b;
129 goto join;
130
131 min: entry;
132
133 op = "min";
134 string(op_type) = "10"b;
135 goto join;
136
137 trunc: entry;
138
139 op = "trunc";
140 string(op_type) = "01"b;
141 goto join;
142
143 floor: entry;
144
145 op = "floor";
146 string(op_type) = "01"b;
147 goto join;
148
149 ceil: entry;
150
151 op = "ceil";
152 string(op_type) = "01"b;
153 goto join;
154
155 round: entry;
156
157 op = "round";
158 string(op_type) = "00"b;
159 goto join;
160 %page;
161 join: call cu_$af_return_arg(count,ap1,al1,code);
162
163 not_active_function = code = error_table_$not_act_fnc;
164
165 if not_active_function
166 then do;
167 count = cu_$arg_count();
168 get_arg = cu_$arg_ptr;
169 gripe = com_err_;
170 code = 0;
171 end;
172 else do;
173 if code ^= 0 then go to simple_err;
174
175 get_arg = cu_$af_arg_ptr;
176 gripe = active_fnc_err_;
177 end;
178
179 if count = 0 then do;
180 if op = "plus" | op = "minus" then number1 = 0;
181 else if op = "times" then number1 = 1;
182 else go to wrong_args;
183 go to output;
184 end;
185
186 if (count ^= 1 & unary & ^ multi)
187 | (count < 2 & ^ unary & op ^= "minus")
188 | (count > 2 & ^ multi)
189 then do;
190 wrong_args: code = error_table_$wrong_no_of_args;
191 simple_err: call gripe (code, op);
192 go to exit;
193 end;
194
195 on overflow goto too_big;
196 on underflow goto too_small;
197 on zerodivide goto zero_divide;
198
199 on conversion begin;
200 call cv_condition_$display( (op), "" );
201 goto exit;
202 end;
203
204 call get_arg(1,ap,al,code);
205 if code ^= 0 then do;
206 call gripe(code, op, "Numeric argument.");
207 goto exit;
208 end;
209
210 number1 = cv_fixed_point_string_( arg, BASE_10, FIXED_POINT_SIG_EXP_CONVERT_DEC, code );
211
212 if count = 1 & op = "minus" then number1 = -number1;
213
214 if unary
215 then do;
216 if op = "trunc" then number1 = trunc(number1);
217 if op = "floor" then number1 = floor(number1);
218 if op = "ceil" then number1 = ceil(number1);
219 end;
220
221 do i = 2 to count;
222 call get_arg(i,ap,al,code);
223 if code ^= 0 then do;
224 call gripe(code, op, "Second numeric argument.");
225 goto exit;
226 end;
227
228 number2 = cv_fixed_point_string_( arg, BASE_10, FIXED_POINT_SIG_EXP_CONVERT_DEC, code );
229
230 if op = "plus" then number1 = number1 + number2;
231 if op = "minus" then number1 = number1 - number2;
232 if op = "times" then number1 = number1 * number2;
233 if op = "divide" then number1 = trunc (number1 / number2);
234 if op = "quotient" then number1 = number1 / number2;
235 if op = "mod" then number1 = mod(number1, number2);
236 if op = "max" then number1 = max(number1, number2);
237 if op = "min" then number1 = min(number1, number2);
238 if op = "round" then do;
239
240 number2 = abs(trunc(number2));
241 number2 = min(59.0, number2);
242 prec_fixed = number2;
243
244
245 if prec_fixed > 0 then do;
246 number2 = number1;
247 call move_r_or_t_(number1, number2, prec_fixed);
248 end;
249 end;
250 end;
251
252 output:
253 call numeric_to_ascii_(number1,0,result);
254 if substr (result, 1, 1) = "0" & length (result) > 60 then do;
255 result = substr (result, 1, length (result) - 1);
256 end;
257
258 if not_active_function then call ioa_(result);
259 else answer = result;
260
261 return;
262
263 zero_divide:
264 call gripe(0,op,"Attempt to divide by zero.");
265 goto exit;
266
267 too_big:
268 call gripe(0,op,"Exponent overflow");
269 goto exit;
270
271 too_small:
272 call gripe(0,op,"Exponent underflow");
273 goto exit;
274
275 exit: return;
276 %page;
277 %include cv_fixed_point_string_;
278
279 end plus;
280