1
2(********************************************************************)
3(*                                                                  *)
4(*  bin_act.s7i   Generate code for bin32 and bin64 actions.        *)
5(*  Copyright (C) 1990 - 1994, 2004 - 2017  Thomas Mertes           *)
6(*                                                                  *)
7(*  This file is part of the Seed7 compiler.                        *)
8(*                                                                  *)
9(*  This program is free software; you can redistribute it and/or   *)
10(*  modify it under the terms of the GNU General Public License as  *)
11(*  published by the Free Software Foundation; either version 2 of  *)
12(*  the License, or (at your option) any later version.             *)
13(*                                                                  *)
14(*  This program is distributed in the hope that it will be useful, *)
15(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
16(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
17(*  GNU General Public License for more details.                    *)
18(*                                                                  *)
19(*  You should have received a copy of the GNU General Public       *)
20(*  License along with this program; if not, write to the           *)
21(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
22(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
23(*                                                                  *)
24(********************************************************************)
25
26
27const ACTION: BIN_AND                 is action "BIN_AND";
28const ACTION: BIN_AND_ASSIGN          is action "BIN_AND_ASSIGN";
29const ACTION: BIN_BIG                 is action "BIN_BIG";
30const ACTION: BIN_BINARY              is action "BIN_BINARY";
31const ACTION: BIN_CARD                is action "BIN_CARD";
32const ACTION: BIN_CMP                 is action "BIN_CMP";
33const ACTION: BIN_GET_BINARY_FROM_SET is action "BIN_GET_BINARY_FROM_SET";
34const ACTION: BIN_LSHIFT              is action "BIN_LSHIFT";
35const ACTION: BIN_LSHIFT_ASSIGN       is action "BIN_LSHIFT_ASSIGN";
36const ACTION: BIN_N_BYTES_BE          is action "BIN_N_BYTES_BE";
37const ACTION: BIN_N_BYTES_LE          is action "BIN_N_BYTES_LE";
38const ACTION: BIN_OR                  is action "BIN_OR";
39const ACTION: BIN_OR_ASSIGN           is action "BIN_OR_ASSIGN";
40const ACTION: BIN_radix               is action "BIN_radix";
41const ACTION: BIN_RADIX               is action "BIN_RADIX";
42const ACTION: BIN_RSHIFT              is action "BIN_RSHIFT";
43const ACTION: BIN_RSHIFT_ASSIGN       is action "BIN_RSHIFT_ASSIGN";
44const ACTION: BIN_STR                 is action "BIN_STR";
45const ACTION: BIN_XOR                 is action "BIN_XOR";
46const ACTION: BIN_XOR_ASSIGN          is action "BIN_XOR_ASSIGN";
47
48
49const proc: bin_prototypes (inout file: c_prog) is func
50
51  begin
52    declareExtern(c_prog, "uintType    setToUInt (const const_setType, const intType);");
53    declareExtern(c_prog, "intType     uintCard (uintType);");
54    declareExtern(c_prog, "intType     uintCmp (uintType, uintType);");
55    declareExtern(c_prog, "intType     uintCmpGeneric (const genericType, const genericType);");
56    declareExtern(c_prog, "striType    uintNBytesBe (uintType, intType);");
57    declareExtern(c_prog, "striType    uintNBytesLe (uintType, intType);");
58    declareExtern(c_prog, "striType    uintRadix (uintType, intType, boolType);");
59    declareExtern(c_prog, "striType    uintRadixPow2 (uintType, int, int, boolType);");
60    declareExtern(c_prog, "striType    uintStr (uintType);");
61  end func;
62
63
64const proc: process (BIN_AND, in reference: function,
65    in ref_list: params, inout expr_type: c_expr) is func
66
67  begin
68    c_expr.expr &:= "(";
69    process_expr(params[1], c_expr);
70    c_expr.expr &:= ") & (";
71    process_expr(params[3], c_expr);
72    c_expr.expr &:= ")";
73  end func;
74
75
76const proc: process (BIN_AND_ASSIGN, in reference: function,
77    in ref_list: params, inout expr_type: c_expr) is func
78
79  local
80    var expr_type: statement is expr_type.value;
81  begin
82    process_expr(params[1], statement);
83    statement.expr &:= "&=";
84    process_expr(params[3], statement);
85    statement.expr &:= ";\n";
86    doLocalDeclsOfStatement(statement, c_expr);
87  end func;
88
89
90const proc: process (BIN_BIG, in reference: function,
91    in ref_list: params, inout expr_type: c_expr) is func
92
93  begin
94    prepare_bigint_result(c_expr);
95    c_expr.result_expr := "bigFromUInt64(";
96    getAnyParamToResultExpr(params[1], c_expr);
97    c_expr.result_expr &:= ")";
98  end func;
99
100
101const proc: optimize_bin_binary_of_big_mod (in reference: param1,
102    in reference: dividend, in bigInteger: divisor,
103    inout expr_type: c_expr) is func
104
105  local
106    var addSubBigListType: addSubParamList is addSubBigListType.value;
107  begin
108    if divisor > 0_ and log2(divisor) <= 64_ and
109        2_ ** ord(log2(divisor)) = divisor then
110      if evaluate_const_expr >= 2 then
111        generateAddSubParamList(addSubParamList, dividend);
112        evaluateConstants(addSubParamList);
113        c_expr.expr &:= "(";
114        optimizeAddSubList(addSubParamList, divisor, c_expr);
115        c_expr.expr &:= ")";
116      else
117        c_expr.expr &:= "bigLowerBits64(";
118        getAnyParamToExpr(dividend, c_expr);
119        c_expr.expr &:= ")";
120      end if;
121      if log2(divisor) < 64_ then
122        c_expr.expr &:= "&";
123        c_expr.expr &:= integerLiteral(ord(pred(divisor)));
124      end if;
125    else
126      c_expr.expr &:= "bigToUInt64(";
127      getAnyParamToExpr(param1, c_expr);
128      c_expr.expr &:= ")";
129    end if;
130  end func;
131
132
133const proc: process (BIN_BINARY, in reference: function,
134    in ref_list: params, inout expr_type: c_expr) is func
135
136  local
137    var reference: evaluatedParam is NIL;
138  begin
139    if evaluate_const_expr >= 1 and
140        isActionExpression(params[1], "BIG_MOD") and
141        getConstant(getActionParameter(params[1], 3),
142                    BIGINTOBJECT, evaluatedParam) then
143      optimize_bin_binary_of_big_mod(params[1],
144          getActionParameter(params[1], 1),
145          getValue(evaluatedParam, bigInteger), c_expr);
146    else
147      c_expr.expr &:= "bigToUInt64(";
148      getAnyParamToExpr(params[1], c_expr);
149      c_expr.expr &:= ")";
150    end if;
151  end func;
152
153
154const proc: process (BIN_CARD, in reference: function,
155    in ref_list: params, inout expr_type: c_expr) is func
156
157  begin
158    c_expr.expr &:= "uintCard(";
159    process_expr(params[1], c_expr);
160    c_expr.expr &:= ")";
161  end func;
162
163
164const proc: process (BIN_CMP, in reference: function,
165    in ref_list: params, inout expr_type: c_expr) is func
166
167  local
168    var string: number1_name is "";
169    var string: number2_name is "";
170  begin
171    if inlineFunctions then
172      c_expr.expr &:= "(";
173      number1_name := getParameterAsVariable("uintType", "num1_", params[1], c_expr);
174      number2_name := getParameterAsVariable("uintType", "num2_", params[2], c_expr);
175      c_expr.expr &:= number1_name;
176      c_expr.expr &:= "<";
177      c_expr.expr &:= number2_name;
178      c_expr.expr &:= "? -1 : ";
179      c_expr.expr &:= number1_name;
180      c_expr.expr &:= ">";
181      c_expr.expr &:= number2_name;
182      c_expr.expr &:= ")";
183    else
184      c_expr.expr &:= "uintCmp(";
185      process_expr(params[1], c_expr);
186      c_expr.expr &:= ", ";
187      process_expr(params[2], c_expr);
188      c_expr.expr &:= ")";
189    end if;
190  end func;
191
192
193const proc: process (BIN_GET_BINARY_FROM_SET, in reference: function,
194    in ref_list: params, inout expr_type: c_expr) is func
195
196  begin
197    c_expr.expr &:= "setToUInt(";
198    getAnyParamToExpr(params[1], c_expr);
199    c_expr.expr &:= ", ";
200    process_expr(params[2], c_expr);
201    c_expr.expr &:= ")";
202  end func;
203
204
205const proc: process_const_bin_lshift (in reference: number, in integer: lshift,
206    inout expr_type: c_expr) is func
207
208  begin
209    if lshift < 0 or lshift >= ccConf.INTTYPE_SIZE then
210      incr(countOptimizations);
211      warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr);
212      c_expr.expr &:= intRaiseError("OVERFLOW_ERROR");
213    else
214      c_expr.expr &:= "(intType)((uintType)(";
215      process_expr(number, c_expr);
216      c_expr.expr &:= ") << ";
217      c_expr.expr &:= integerLiteral(lshift);
218      c_expr.expr &:= ")";
219    end if;
220  end func;
221
222
223const proc: process (BIN_LSHIFT, in reference: function,
224    in ref_list: params, inout expr_type: c_expr) is func
225
226  local
227    var reference: evaluatedParam is NIL;
228    var string: lshift_name is "";
229  begin
230    if getConstant(params[3], INTOBJECT, evaluatedParam) then
231      process_const_bin_lshift(params[1], getValue(evaluatedParam, integer), c_expr);
232    elsif check_int_shift_overflow then
233      incr(countOverflowChecks);
234      c_expr.expr &:= "(";
235      lshift_name := getParameterAsVariable("intType", "lshift_", params[3], c_expr);
236      c_expr.expr &:= "ovfChk(";
237      checkRangeFromZero(lshift_name, integerLiteral(ccConf.INTTYPE_SIZE), c_expr);
238      c_expr.expr &:= ")?";
239      c_expr.expr &:= intRaiseError("OVERFLOW_ERROR");
240      c_expr.expr &:= ":(intType)((uintType)(";
241      process_expr(params[1], c_expr);
242      c_expr.expr &:= ") << ";
243      c_expr.expr &:= lshift_name;
244      c_expr.expr &:= "))";
245    else
246      c_expr.expr &:= "(intType)((uintType)(";
247      process_expr(params[1], c_expr);
248      c_expr.expr &:= ") << (";
249      process_expr(params[3], c_expr);
250      c_expr.expr &:= "))";
251    end if;
252  end func;
253
254
255const proc: process_const_bin_lshift_assign (in reference: variable, in integer: lshift,
256    inout expr_type: c_expr) is func
257
258  local
259    var string: variable_name is "";
260    var expr_type: statement is expr_type.value;
261  begin
262    if lshift < 0 or lshift >= ccConf.INTTYPE_SIZE then
263      incr(countOptimizations);
264      setDiagnosticLine(c_expr);
265      warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr);
266      c_expr.expr &:= raiseError("OVERFLOW_ERROR");
267      c_expr.expr &:= "\n";
268    else
269      variable_name := getParameterAsReference("intType", "tmp_", variable, statement);
270      statement.expr &:= variable_name;
271      statement.expr &:= "=(intType)((uintType)(";
272      statement.expr &:= variable_name;
273      statement.expr &:= ") << ";
274      statement.expr &:= integerLiteral(lshift);
275      statement.expr &:= ");\n";
276      doLocalDeclsOfStatement(statement, c_expr);
277    end if;
278  end func;
279
280
281const proc: process (BIN_LSHIFT_ASSIGN, in reference: function,
282    in ref_list: params, inout expr_type: c_expr) is func
283
284  local
285    var reference: evaluatedParam is NIL;
286    var expr_type: statement is expr_type.value;
287    var string: variable_name is "";
288    var string: lshift_name is "";
289  begin
290    if getConstant(params[3], INTOBJECT, evaluatedParam) then
291      process_const_bin_lshift_assign(params[1], getValue(evaluatedParam, integer), c_expr);
292    elsif check_int_shift_overflow then
293      incr(countOverflowChecks);
294      variable_name := getParameterAsReference("intType", "tmp_", params[1], statement);
295      lshift_name := getParameterAsVariable("intType", "tmp_", params[3], statement);
296      statement.expr &:= "ovfChk(";
297      checkRangeFromZero(lshift_name, integerLiteral(ccConf.INTTYPE_SIZE), statement);
298      statement.expr &:= ")?";
299      statement.expr &:= intRaiseError("OVERFLOW_ERROR");
300      statement.expr &:= ":(";
301      statement.expr &:= variable_name;
302      statement.expr &:= "=(intType)((uintType)(";
303      statement.expr &:= variable_name;
304      statement.expr &:= ") << ";
305      statement.expr &:= lshift_name;
306      statement.expr &:= "));\n";
307      doLocalDeclsOfStatement(statement, c_expr);
308    else
309      variable_name := getParameterAsReference("intType", "tmp_", params[1], statement);
310      statement.expr &:= variable_name;
311      statement.expr &:= "=(intType)((uintType)(";
312      statement.expr &:= variable_name;
313      statement.expr &:= ") << (";
314      process_expr(params[3], statement);
315      statement.expr &:= "));\n";
316      doLocalDeclsOfStatement(statement, c_expr);
317    end if;
318  end func;
319
320
321const proc: process_const_bin_n_bytes_be (in reference: number,
322    in integer: length, inout expr_type: c_expr) is func
323
324  local
325    var reference: evaluatedNumber is NIL;
326    var integer: numberValue is 0;
327    var string: buffer_name is "";
328    var string: number_name is "";
329    var integer: index is 0;
330  begin
331    if length <= 0 then
332      incr(countOptimizations);
333      warning(DOES_RAISE, "RANGE_ERROR", c_expr);
334      c_expr.expr &:= strRaiseError("RANGE_ERROR");
335    elsif getConstant(number, INTOBJECT, evaluatedNumber) then
336      incr(countOptimizations);
337      numberValue := getValue(evaluatedNumber, integer);
338      if length < 8 and (numberValue >= 2 ** (8 * length) or numberValue < 0) then
339        warning(DOES_RAISE, "RANGE_ERROR", c_expr);
340        c_expr.expr &:= strRaiseError("RANGE_ERROR");
341      else
342        c_expr.expr &:= stringLiteral(bytes(bin64(numberValue), BE, length));
343      end if;
344    elsif ccConf.ALLOW_STRITYPE_SLICES and length <= 8 then
345      incr(countOptimizations);
346      incr(c_expr.temp_num);
347      buffer_name := "buffer_" & str(c_expr.temp_num);
348      c_expr.temp_decls &:= "union {\n";
349      c_expr.temp_decls &:= "  struct striStruct striBuf;\n";
350      c_expr.temp_decls &:= "  char charBuf[SIZ_STRI(";
351      c_expr.temp_decls &:= str(length);
352      c_expr.temp_decls &:= ")];\n";
353      c_expr.temp_decls &:= "} ";
354      c_expr.temp_decls &:= buffer_name;
355      c_expr.temp_decls &:= ";\n";
356      c_expr.expr &:= "(";
357      number_name := getParameterAsVariable("intType", "tmp_", number, c_expr);
358      if function_range_check and length < 8 then
359        c_expr.expr &:= "rngChk(";
360        c_expr.expr &:= "(uintType)";
361        c_expr.expr &:= number_name;
362        c_expr.expr &:= ">(uintType)";
363        c_expr.expr &:= integerLiteral(pred(2 ** (8 * length)));
364        c_expr.expr &:= ")?";
365        c_expr.expr &:= strRaiseError("RANGE_ERROR");
366        c_expr.expr &:= ":(";
367      end if;
368      c_expr.expr &:= buffer_name;
369      c_expr.expr &:= ".striBuf.size=";
370      c_expr.expr &:= str(length);
371      c_expr.expr &:= ",";
372      c_expr.expr &:= buffer_name;
373      c_expr.expr &:= ".striBuf.mem=";
374      c_expr.expr &:= buffer_name;
375      c_expr.expr &:= ".striBuf.mem1,";
376      for index range 1 to length do
377        c_expr.expr &:= buffer_name;
378        c_expr.expr &:= ".striBuf.mem1[";
379        c_expr.expr &:= str(pred(index));
380        c_expr.expr &:= "]=(strElemType)(";
381        if index <> length then
382          c_expr.expr &:= "((uintType)(";
383          c_expr.expr &:= number_name;
384          c_expr.expr &:= ")>>";
385          c_expr.expr &:= str(8 * (length - index));
386        else
387          c_expr.expr &:= "(uintType)(";
388          c_expr.expr &:= number_name;
389        end if;
390        c_expr.expr &:= ")";
391        if index <> 1 then
392          c_expr.expr &:= "&255";
393        end if;
394        c_expr.expr &:= "),";
395      end for;
396      c_expr.expr &:= "&";
397      c_expr.expr &:= buffer_name;
398      c_expr.expr &:= ".striBuf";
399      if function_range_check and length < 8 then
400        c_expr.expr &:= ")";
401      end if;
402      c_expr.expr &:= ")";
403    else
404      prepare_stri_result(c_expr);
405      c_expr.result_expr := "uintNBytesBe(";
406      getStdParamToResultExpr(number, c_expr);
407      c_expr.result_expr &:= ", ";
408      c_expr.result_expr &:= integerLiteral(length);
409      c_expr.result_expr &:= ")";
410    end if;
411  end func;
412
413
414const proc: process (BIN_N_BYTES_BE, in reference: function,
415    in ref_list: params, inout expr_type: c_expr) is func
416
417  local
418    var reference: evaluatedLength is NIL;
419  begin
420    if inlineFunctions and
421        getConstant(params[3], INTOBJECT, evaluatedLength) then
422      process_const_bin_n_bytes_be(params[1],
423          getValue(evaluatedLength, integer), c_expr);
424    else
425      prepare_stri_result(c_expr);
426      c_expr.result_expr := "uintNBytesBe(";
427      getStdParamToResultExpr(params[1], c_expr);
428      c_expr.result_expr &:= ", ";
429      getStdParamToResultExpr(params[3], c_expr);
430      c_expr.result_expr &:= ")";
431    end if;
432  end func;
433
434
435const proc: process_const_bin_n_bytes_le (in reference: number,
436    in integer: length, inout expr_type: c_expr) is func
437
438  local
439    var reference: evaluatedNumber is NIL;
440    var integer: numberValue is 0;
441    var string: buffer_name is "";
442    var string: number_name is "";
443    var integer: index is 0;
444  begin
445    if length <= 0 then
446      incr(countOptimizations);
447      warning(DOES_RAISE, "RANGE_ERROR", c_expr);
448      c_expr.expr &:= strRaiseError("RANGE_ERROR");
449    elsif getConstant(number, INTOBJECT, evaluatedNumber) then
450      incr(countOptimizations);
451      numberValue := getValue(evaluatedNumber, integer);
452      if length < 8 and (numberValue >= 2 ** (8 * length) or numberValue < 0) then
453        warning(DOES_RAISE, "RANGE_ERROR", c_expr);
454        c_expr.expr &:= strRaiseError("RANGE_ERROR");
455      else
456        c_expr.expr &:= stringLiteral(bytes(bin64(numberValue), LE, length));
457      end if;
458    elsif ccConf.ALLOW_STRITYPE_SLICES and length <= 8 then
459      incr(countOptimizations);
460      incr(c_expr.temp_num);
461      buffer_name := "buffer_" & str(c_expr.temp_num);
462      c_expr.temp_decls &:= "union {\n";
463      c_expr.temp_decls &:= "  struct striStruct striBuf;\n";
464      c_expr.temp_decls &:= "  char charBuf[SIZ_STRI(";
465      c_expr.temp_decls &:= str(length);
466      c_expr.temp_decls &:= ")];\n";
467      c_expr.temp_decls &:= "} ";
468      c_expr.temp_decls &:= buffer_name;
469      c_expr.temp_decls &:= ";\n";
470      c_expr.expr &:= "(";
471      number_name := getParameterAsVariable("intType", "tmp_", number, c_expr);
472      if function_range_check and length < 8 then
473        c_expr.expr &:= "rngChk(";
474        c_expr.expr &:= "(uintType)";
475        c_expr.expr &:= number_name;
476        c_expr.expr &:= ">(uintType)";
477        c_expr.expr &:= integerLiteral(pred(2 ** (8 * length)));
478        c_expr.expr &:= ")?";
479        c_expr.expr &:= strRaiseError("RANGE_ERROR");
480        c_expr.expr &:= ":(";
481      end if;
482      c_expr.expr &:= buffer_name;
483      c_expr.expr &:= ".striBuf.size=";
484      c_expr.expr &:= str(length);
485      c_expr.expr &:= ",";
486      c_expr.expr &:= buffer_name;
487      c_expr.expr &:= ".striBuf.mem=";
488      c_expr.expr &:= buffer_name;
489      c_expr.expr &:= ".striBuf.mem1,";
490      for index range 1 to length do
491        c_expr.expr &:= buffer_name;
492        c_expr.expr &:= ".striBuf.mem1[";
493        c_expr.expr &:= str(pred(index));
494        c_expr.expr &:= "]=(strElemType)(";
495        if index <> 1 then
496          c_expr.expr &:= "((uintType)(";
497          c_expr.expr &:= number_name;
498          c_expr.expr &:= ")>>";
499          c_expr.expr &:= str(8 * pred(index));
500        else
501          c_expr.expr &:= "(uintType)(";
502          c_expr.expr &:= number_name;
503        end if;
504        c_expr.expr &:= ")";
505        if index <> length then
506          c_expr.expr &:= "&255";
507        end if;
508        c_expr.expr &:= "),";
509      end for;
510      c_expr.expr &:= "&";
511      c_expr.expr &:= buffer_name;
512      c_expr.expr &:= ".striBuf";
513      if function_range_check and length < 8 then
514        c_expr.expr &:= ")";
515      end if;
516      c_expr.expr &:= ")";
517    else
518      prepare_stri_result(c_expr);
519      c_expr.result_expr := "uintNBytesLe(";
520      getStdParamToResultExpr(number, c_expr);
521      c_expr.result_expr &:= ", ";
522      c_expr.result_expr &:= integerLiteral(length);
523      c_expr.result_expr &:= ")";
524    end if;
525  end func;
526
527
528const proc: process (BIN_N_BYTES_LE, in reference: function,
529    in ref_list: params, inout expr_type: c_expr) is func
530
531  local
532    var reference: evaluatedLength is NIL;
533  begin
534    if inlineFunctions and
535        getConstant(params[3], INTOBJECT, evaluatedLength) then
536      process_const_bin_n_bytes_le(params[1],
537          getValue(evaluatedLength, integer), c_expr);
538    else
539      prepare_stri_result(c_expr);
540      c_expr.result_expr := "uintNBytesLe(";
541      getStdParamToResultExpr(params[1], c_expr);
542      c_expr.result_expr &:= ", ";
543      getStdParamToResultExpr(params[3], c_expr);
544      c_expr.result_expr &:= ")";
545    end if;
546  end func;
547
548
549const proc: process (BIN_OR, in reference: function,
550    in ref_list: params, inout expr_type: c_expr) is func
551
552  begin
553    c_expr.expr &:= "(";
554    process_expr(params[1], c_expr);
555    c_expr.expr &:= ") | (";
556    process_expr(params[3], c_expr);
557    c_expr.expr &:= ")";
558  end func;
559
560
561const proc: process (BIN_OR_ASSIGN, in reference: function,
562    in ref_list: params, inout expr_type: c_expr) is func
563
564  local
565    var expr_type: statement is expr_type.value;
566  begin
567    process_expr(params[1], statement);
568    statement.expr &:= "|=";
569    process_expr(params[3], statement);
570    statement.expr &:= ";\n";
571    doLocalDeclsOfStatement(statement, c_expr);
572  end func;
573
574
575const proc: process_bin_str (in reference: param1, inout expr_type: c_expr) is func
576
577  begin
578    prepare_stri_result(c_expr);
579    c_expr.result_expr := "uintStr(";
580    getStdParamToResultExpr(param1, c_expr);
581    c_expr.result_expr &:= ")";
582  end func;
583
584
585const proc: process_const_bin_radix (in reference: param1, in integer: base,
586    in boolean: upperCase, inout expr_type: c_expr) is func
587
588  begin
589    if base < 2 or base > 36 then
590      incr(countOptimizations);
591      warning(DOES_RAISE, "RANGE_ERROR", c_expr);
592      c_expr.expr &:= strRaiseError("RANGE_ERROR");
593    elsif base = 10 then
594      incr(countOptimizations);
595      process_bin_str(param1, c_expr);
596    elsif 2 ** log2(base) = base then
597      incr(countOptimizations);
598      prepare_stri_result(c_expr);
599      c_expr.result_expr := "uintRadixPow2(";
600      getStdParamToResultExpr(param1, c_expr);
601      c_expr.result_expr &:= ",";
602      c_expr.result_expr &:= integerLiteral(log2(base));
603      c_expr.result_expr &:= ",";
604      c_expr.result_expr &:= integerLiteral(pred(base));
605      c_expr.result_expr &:= ",";
606      c_expr.result_expr &:= str(ord(upperCase));
607      c_expr.result_expr &:= ")";
608    else
609      prepare_stri_result(c_expr);
610      c_expr.result_expr := "uintRadix(";
611      getStdParamToResultExpr(param1, c_expr);
612      c_expr.result_expr &:= ", ";
613      c_expr.result_expr &:= integerLiteral(base);
614      c_expr.result_expr &:= ",";
615      c_expr.result_expr &:= str(ord(upperCase));
616      c_expr.result_expr &:= ")";
617    end if;
618  end func;
619
620
621const proc: process_bin_radix (in ref_list: params, in boolean: upperCase,
622    inout expr_type: c_expr) is func
623
624  local
625    var reference: evaluatedParam is NIL;
626  begin
627    if getConstant(params[3], INTOBJECT, evaluatedParam) then
628      process_const_bin_radix(params[1], getValue(evaluatedParam, integer),
629          upperCase, c_expr);
630    else
631      prepare_stri_result(c_expr);
632      c_expr.result_expr := "uintRadix(";
633      getStdParamToResultExpr(params[1], c_expr);
634      c_expr.result_expr &:= ", ";
635      getStdParamToResultExpr(params[3], c_expr);
636      c_expr.result_expr &:= ",";
637      c_expr.result_expr &:= str(ord(upperCase));
638      c_expr.result_expr &:= ")";
639    end if;
640  end func;
641
642
643const proc: process (BIN_radix, in reference: function,
644    in ref_list: params, inout expr_type: c_expr) is func
645
646  begin
647    process_bin_radix(params, FALSE, c_expr);
648  end func;
649
650
651const proc: process (BIN_RADIX, in reference: function,
652    in ref_list: params, inout expr_type: c_expr) is func
653
654  begin
655    process_bin_radix(params, TRUE, c_expr);
656  end func;
657
658
659const proc: process_const_bin_rshift (in reference: number, in integer: rshift,
660    inout expr_type: c_expr) is func
661
662  begin
663    if rshift < 0 or rshift >= ccConf.INTTYPE_SIZE then
664      incr(countOptimizations);
665      warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr);
666      c_expr.expr &:= intRaiseError("OVERFLOW_ERROR");
667    else
668      c_expr.expr &:= "(intType)((uintType)(";
669      process_expr(number, c_expr);
670      c_expr.expr &:= ") >> ";
671      c_expr.expr &:= integerLiteral(rshift);
672      c_expr.expr &:= ")";
673    end if;
674  end func;
675
676
677const proc: process (BIN_RSHIFT, in reference: function,
678    in ref_list: params, inout expr_type: c_expr) is func
679
680  local
681    var reference: evaluatedParam is NIL;
682    var string: rshift_name is "";
683  begin
684    if getConstant(params[3], INTOBJECT, evaluatedParam) then
685      process_const_bin_rshift(params[1], getValue(evaluatedParam, integer), c_expr);
686    elsif check_int_shift_overflow then
687      incr(countOverflowChecks);
688      c_expr.expr &:= "(";
689      rshift_name := getParameterAsVariable("intType", "rshift_", params[3], c_expr);
690      c_expr.expr &:= "ovfChk(";
691      checkRangeFromZero(rshift_name, integerLiteral(ccConf.INTTYPE_SIZE), c_expr);
692      c_expr.expr &:= ")?";
693      c_expr.expr &:= intRaiseError("OVERFLOW_ERROR");
694      c_expr.expr &:= ":(intType)((uintType)(";
695      process_expr(params[1], c_expr);
696      c_expr.expr &:= ") >> ";
697      c_expr.expr &:= rshift_name;
698      c_expr.expr &:= "))";
699    else
700      c_expr.expr &:= "(intType)((uintType)(";
701      process_expr(params[1], c_expr);
702      c_expr.expr &:= ") >> (";
703      process_expr(params[3], c_expr);
704      c_expr.expr &:= "))";
705    end if;
706  end func;
707
708
709const proc: process_const_bin_rshift_assign (in reference: variable, in integer: rshift,
710    inout expr_type: c_expr) is func
711
712  local
713    var string: variable_name is "";
714    var expr_type: statement is expr_type.value;
715  begin
716    if rshift < 0 or rshift >= ccConf.INTTYPE_SIZE then
717      incr(countOptimizations);
718      setDiagnosticLine(c_expr);
719      warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr);
720      c_expr.expr &:= raiseError("OVERFLOW_ERROR");
721      c_expr.expr &:= "\n";
722    else
723      variable_name := getParameterAsReference("intType", "tmp_", variable, statement);
724      statement.expr &:= variable_name;
725      statement.expr &:= "=(intType)((uintType)(";
726      statement.expr &:= variable_name;
727      statement.expr &:= ") >> ";
728      statement.expr &:= integerLiteral(rshift);
729      statement.expr &:= ");\n";
730      doLocalDeclsOfStatement(statement, c_expr);
731    end if;
732  end func;
733
734
735const proc: process (BIN_RSHIFT_ASSIGN, in reference: function,
736    in ref_list: params, inout expr_type: c_expr) is func
737
738  local
739    var reference: evaluatedParam is NIL;
740    var expr_type: statement is expr_type.value;
741    var string: variable_name is "";
742    var string: rshift_name is "";
743  begin
744    if getConstant(params[3], INTOBJECT, evaluatedParam) then
745      process_const_bin_rshift_assign(params[1], getValue(evaluatedParam, integer), c_expr);
746    elsif check_int_shift_overflow then
747      incr(countOverflowChecks);
748      variable_name := getParameterAsReference("intType", "tmp_", params[1], statement);
749      rshift_name := getParameterAsVariable("intType", "tmp_", params[3], statement);
750      statement.expr &:= "ovfChk(";
751      checkRangeFromZero(rshift_name, integerLiteral(ccConf.INTTYPE_SIZE), statement);
752      statement.expr &:= ")?";
753      statement.expr &:= intRaiseError("OVERFLOW_ERROR");
754      statement.expr &:= ":(";
755      statement.expr &:= variable_name;
756      statement.expr &:= "=(intType)((uintType)(";
757      statement.expr &:= variable_name;
758      statement.expr &:= ") >> ";
759      statement.expr &:= rshift_name;
760      statement.expr &:= "));\n";
761      doLocalDeclsOfStatement(statement, c_expr);
762    else
763      variable_name := getParameterAsReference("intType", "tmp_", params[1], statement);
764      statement.expr &:= variable_name;
765      statement.expr &:= "=(intType)((uintType)(";
766      statement.expr &:= variable_name;
767      statement.expr &:= ") >> (";
768      process_expr(params[3], statement);
769      statement.expr &:= "));\n";
770      doLocalDeclsOfStatement(statement, c_expr);
771    end if;
772  end func;
773
774
775const proc: process (BIN_STR, in reference: function,
776    in ref_list: params, inout expr_type: c_expr) is func
777
778  begin
779    process_bin_str(params[1], c_expr);
780  end func;
781
782
783const proc: process (BIN_XOR, in reference: function,
784    in ref_list: params, inout expr_type: c_expr) is func
785
786  begin
787    c_expr.expr &:= "(";
788    process_expr(params[1], c_expr);
789    c_expr.expr &:= ") ^ (";
790    process_expr(params[3], c_expr);
791    c_expr.expr &:= ")";
792  end func;
793
794
795const proc: process (BIN_XOR_ASSIGN, in reference: function,
796    in ref_list: params, inout expr_type: c_expr) is func
797
798  local
799    var expr_type: statement is expr_type.value;
800  begin
801    process_expr(params[1], statement);
802    statement.expr &:= "^=";
803    process_expr(params[3], statement);
804    statement.expr &:= ";\n";
805    doLocalDeclsOfStatement(statement, c_expr);
806  end func;
807