var type: catchExceptionLevelType is hash [string] integer;
var catchExceptionLevelType: catchExceptionLevel is catchExceptionLevelType.value;
var integer: catchAllExceptionsLevel is 0;
const proc: increaseLevelOfCatchedExceptions (in var reference: current_catch) is func
local
var ref_list: catch_expr is ref_list.EMPTY;
var string: exceptionName is "";
begin
catch_expr := getValue(current_catch, ref_list);
while current_catch <> NIL and
category(current_catch) = MATCHOBJECT and
length(catch_expr) >= 5 do
exceptionName := str(catch_expr[3]);
if exceptionName in catchExceptionLevel then
incr(catchExceptionLevel[exceptionName]);
else
catchExceptionLevel @:= [exceptionName] 0;
end if;
if length(catch_expr) >= 6 then
current_catch := catch_expr[6];
catch_expr := getValue(current_catch, ref_list);
else
current_catch := NIL;
end if;
end while;
end func;
const proc: decreaseLevelOfCatchedExceptions (in var reference: current_catch) is func
local
var ref_list: catch_expr is ref_list.EMPTY;
var string: exceptionName is "";
begin
catch_expr := getValue(current_catch, ref_list);
while current_catch <> NIL and
category(current_catch) = MATCHOBJECT and
length(catch_expr) >= 5 do
exceptionName := str(catch_expr[3]);
if exceptionName in catchExceptionLevel then
decr(catchExceptionLevel[exceptionName]);
else
raise RANGE_ERROR;
end if;
if length(catch_expr) >= 6 then
current_catch := catch_expr[6];
catch_expr := getValue(current_catch, ref_list);
else
current_catch := NIL;
end if;
end while;
end func;
const func string: raiseError (in string: exceptionName) is func
result
var string: expr is "";
begin
expr &:= "raiseError(";
expr &:= exceptionName;
expr &:= ");\n";
end func;
const func string: intRaiseError (in string: exceptionName) is func
result
var string: expr is "";
begin
expr &:= "intRaiseError(";
expr &:= exceptionName;
expr &:= ")";
end func;
const func string: bigRaiseError (in string: exceptionName) is func
result
var string: expr is "";
begin
expr &:= "bigRaiseError(";
expr &:= exceptionName;
expr &:= ")";
end func;
const func string: strRaiseError (in string: exceptionName) is func
result
var string: expr is "";
begin
expr &:= "strRaiseError(";
expr &:= exceptionName;
expr &:= ")";
end func;
const func string: refRaiseError (in string: exceptionName) is func
result
var string: expr is "";
begin
expr &:= "refRaiseError(";
expr &:= exceptionName;
expr &:= ")";
end func;
const proc: writeLine (in string: fileName, in integer: fileLine) is func
local
const integer: bufferSize is 4096;
var file: sourceFile is STD_NULL;
var string: buffer is "";
var integer: lineNumber is 1;
var integer: startPos is 1;
var integer: endPos is 0;
var integer: pos is 1;
begin
sourceFile := open(fileName, "r");
if sourceFile <> STD_NULL then
repeat
buffer := gets(sourceFile, bufferSize);
pos := pos(buffer, '\n');
while pos <> 0 and lineNumber < fileLine do
incr(lineNumber);
startPos := succ(pos);
pos := pos(buffer, '\n', startPos);
end while;
until lineNumber = fileLine or buffer = "";
if lineNumber = fileLine then
if pos <> 0 then
if pos > 1 and buffer[pred(pos)] = '\r' then
writeln(buffer[startPos .. pos - 2]);
else
writeln(buffer[startPos .. pred(pos)]);
end if;
else
if length(buffer) > 1 and
buffer[length(buffer)] = '\r' then
write(buffer[startPos .. pred(length(buffer))]);
else
write(buffer[startPos ..]);
end if;
repeat
buffer := gets(sourceFile, bufferSize);
pos := pos(buffer, '\n');
if pos = 0 then
if length(buffer) > 1 and
buffer[length(buffer)] = '\r' then
write(buffer[startPos .. pred(length(buffer))]);
else
write(buffer[startPos ..]);
end if;
end if;
until pos <> 0 or buffer = "";
if pos <> 0 then
if pos > 1 and buffer[pred(pos)] = '\r' then
writeln(buffer[.. pos - 2]);
else
writeln(buffer[.. pred(pos)]);
end if;
end if;
end if;
end if;
close(sourceFile);
end if;
end func;
const proc: warning (COMPARISON_RESULT_CONSTANT, in string: comparisonName,
in boolean: comparisonResult, in expr_type: c_expr) is func
begin
if warning_level >= 2 then
writeln("*** " <& c_expr.currentFile <& "(" <& c_expr.currentLine <&
"): Comparison with " <& comparisonName <&
" always evaluates to " <& comparisonResult <& ".");
writeLine(c_expr.currentFile, c_expr.currentLine);
writeln;
end if;
end func;
const proc: warning (DOES_RAISE, in string: exceptionName, in expr_type: c_expr) is func
begin
if warning_level >= 2 then
writeln("*** " <& c_expr.currentFile <& "(" <& c_expr.currentLine <&
"): Expression raises " <& exceptionName <& ".");
writeLine(c_expr.currentFile, c_expr.currentLine);
writeln;
end if;
end func;
const proc: checkWarning (CATCH_WITH_SUPPRESSED_CHECK, in string: exceptionName, in reference: place) is func
begin
if warning_level >= 1 and
((not (string_index_check and bstring_index_check and array_index_check) and exceptionName = "INDEX_ERROR") or
(not integer_division_check and exceptionName = "NUMERIC_ERROR") or
(not integer_overflow_check and exceptionName = "OVERFLOW_ERROR") or
(not (function_range_check and conversion_range_check) and exceptionName = "RANGE_ERROR")) then
writeln("*** " <& sourceNameString(file(place)) <& "(" <& line(place) <&
"): Catch of " <& exceptionName <& " although the checks are suppressed.");
writeLine(file(place), line(place));
writeln;
end if;
end func;
const proc: checkWarning (CATCH_OTHERWISE_WITH_SUPPRESSED_CHECK, in reference: place) is func
local
var array string: exceptionNameList is 0 times "";
var integer: index is 0;
begin
if warning_level >= 2 then
if not (string_index_check and bstring_index_check and array_index_check) then
exceptionNameList &:= "INDEX_ERROR";
end if;
if not integer_division_check then
exceptionNameList &:= "NUMERIC_ERROR";
end if;
if not integer_overflow_check then
exceptionNameList &:= "OVERFLOW_ERROR";
end if;
if not (function_range_check and conversion_range_check) then
exceptionNameList &:= "RANGE_ERROR";
end if;
if length(exceptionNameList) <> 0 then
write("*** " <& sourceNameString(file(place)) <& "(" <& line(place) <&
"): Catch of otherwise although the checks for ");
for index range 1 to pred(length(exceptionNameList)) do
if index <> 1 then
write(", ");
end if;
write(exceptionNameList[index]);
end for;
if length(exceptionNameList) >= 2 then
write(" and ");
end if;
write(exceptionNameList[length(exceptionNameList)]);
writeln(" are suppressed.");
writeLine(file(place), line(place));
writeln;
end if;
end if;
end func;
const proc: error (WHEN_OVERLAPPING, in bitset: overlappingWhenValues,
in reference: current_expression) is func
begin
if warning_level >= 1 then
writeln("*** " <& file(current_expression) <& "(" <& line(current_expression) <&
"): Duplicate when values " <& overlappingWhenValues <& ".");
writeLine(file(current_expression), line(current_expression));
writeln;
end if;
end func;
const proc: error (WHEN_PREVIOUS, in bitset: overlappingWhenValues,
in reference: current_expression) is func
begin
if warning_level >= 1 then
writeln("*** " <& file(current_expression) <& "(" <& line(current_expression) <&
"): Previous usage of " <& overlappingWhenValues <& ".");
writeLine(file(current_expression), line(current_expression));
writeln;
end if;
end func;
const proc: error (EMPTY_WHEN_SET, in reference: current_expression) is func
begin
if warning_level >= 1 then
writeln("*** " <& file(current_expression) <& "(" <& line(current_expression) <&
"): When set is empty.");
writeLine(file(current_expression), line(current_expression));
writeln;
end if;
end func;
const proc: error (VARIABLE_WHEN, in reference: current_expression) is func
begin
if warning_level >= 1 then
writeln("*** " <& file(current_expression) <& "(" <& line(current_expression) <&
"): When value must be constant.");
writeLine(file(current_expression), line(current_expression));
writeln;
end if;
end func;
const proc: error (VARIABLE_USED_FOR_TWO_INOUT_PARAMETERS, in reference: currentVariable,
in reference: inoutParam, in expr_type: c_expr) is func
begin
if warning_level >= 2 then
writeln("*** " <& c_expr.currentFile <& "(" <& c_expr.currentLine <&
"): The variable " <& literal(str(currentVariable)) <&
" is used for two or more inout-parameters (" <& str(inoutParam) <& ").");
writeLine(c_expr.currentFile, c_expr.currentLine);
writeln;
end if;
end func;
const proc: error (VARIABLE_USED_AS_INOUT_AND_REF_PARAMETER, in reference: currentVariable,
in reference: inoutParam, in reference: refParam, in expr_type: c_expr) is func
begin
if warning_level >= 2 then
writeln("*** " <& c_expr.currentFile <& "(" <& c_expr.currentLine <&
"): The variable " <& literal(str(currentVariable)) <&
" is used as inout-parameter (" <& str(inoutParam) <&
") and ref-parameter (" <& str(refParam) <& ").");
writeLine(c_expr.currentFile, c_expr.currentLine);
writeln;
end if;
end func;
const proc: error (FORWARD_CALLED, in reference: current_expression,
in reference: function) is func
begin
if warning_level >= 1 then
writeln("*** " <& file(current_expression) <& "(" <& line(current_expression) <&
"): Forward defined function called.");
writeLine(file(current_expression), line(current_expression));
writeln;
writeln("*** " <& file(function) <& "(" <& line(function) <&
"): Forward definition of the called function.");
writeLine(file(function), line(function));
writeln;
end if;
end func;
const proc: checkRangeFromZero (in string: number_name, in string: beyond,
inout expr_type: c_expr) is func
begin
if ccConf.TWOS_COMPLEMENT_INTTYPE then
c_expr.expr &:= "(uintType)";
c_expr.expr &:= number_name;
c_expr.expr &:= ">=(uintType)";
c_expr.expr &:= beyond;
else
c_expr.expr &:= number_name;
c_expr.expr &:= "<0||";
c_expr.expr &:= number_name;
c_expr.expr &:= ">=";
c_expr.expr &:= beyond;
end if;
end func;