const ACTION: PRC_ARGS is action "PRC_ARGS";
const ACTION: PRC_BLOCK is action "PRC_BLOCK";
const ACTION: PRC_BLOCK_CATCH_ALL is action "PRC_BLOCK";
const ACTION: PRC_BLOCK_OTHERWISE is action "PRC_BLOCK";
const ACTION: PRC_CASE is action "PRC_CASE";
const ACTION: PRC_CASE_DEF is action "PRC_CASE_DEF";
const ACTION: PRC_CASE_HASHSET is action "PRC_CASE_HASHSET";
const ACTION: PRC_CASE_HASHSET_DEF is action "PRC_CASE_HASHSET_DEF";
const ACTION: PRC_CPY is action "PRC_CPY";
const ACTION: PRC_DYNAMIC is action "PRC_DYNAMIC";
const ACTION: PRC_EXIT is action "PRC_EXIT";
const ACTION: PRC_FOR_DOWNTO is action "PRC_FOR_DOWNTO";
const ACTION: PRC_FOR_DOWNTO_STEP is action "PRC_FOR_DOWNTO_STEP";
const ACTION: PRC_FOR_TO is action "PRC_FOR_TO";
const ACTION: PRC_FOR_TO_STEP is action "PRC_FOR_TO_STEP";
const ACTION: PRC_HEAPSTAT is action "PRC_HEAPSTAT";
const ACTION: PRC_HSIZE is action "PRC_HSIZE";
const ACTION: PRC_IF is action "PRC_IF";
const ACTION: PRC_IF_ELSIF is action "PRC_IF_ELSIF";
const ACTION: PRC_LINE is action "PRC_LINE";
const ACTION: PRC_NOOP is action "PRC_NOOP";
const ACTION: PRC_RAISE is action "PRC_RAISE";
const ACTION: PRC_REPEAT is action "PRC_REPEAT";
const ACTION: PRC_REPEAT_NOOP is action "PRC_REPEAT_NOOP";
const ACTION: PRC_RETURN is action "PRC_RETURN";
const ACTION: PRC_WHILE is action "PRC_WHILE";
const ACTION: PRC_WHILE_NOOP is action "PRC_WHILE_NOOP";
var reference: currentProfiledFunction is NIL;
const proc: prc_prototypes (inout file: c_prog) is func
begin
declareExtern(c_prog, "genericType hshIdxDefault0 (const const_hashType, const genericType, intType, compareType);");
declareExtern(c_prog, "void heapStatistic (void);");
end func;
const proc: process_statements (in expr_type: statements, inout expr_type: c_expr) is func
begin
c_expr.currentFile := statements.currentFile;
c_expr.currentLine := statements.currentLine;
if statements.temp_num <> 0 then
appendWithDiagnostic(statements.temp_decls, c_expr);
appendWithDiagnostic(statements.temp_assigns, c_expr);
c_expr.expr &:= statements.expr;
appendWithDiagnostic(statements.temp_frees, c_expr);
else
c_expr.expr &:= statements.expr;
end if;
end func;
const proc: process_statements (in expr_type: condition, in expr_type: statements, inout expr_type: c_expr) is func
begin
c_expr.currentFile := statements.currentFile;
c_expr.currentLine := statements.currentLine;
if statements.temp_decls <> "" or condition.temp_decls <> "" then
appendWithDiagnostic(statements.temp_decls, c_expr);
if condition.temp_decls <> "" then
appendWithDiagnostic(condition.temp_frees, c_expr);
appendWithDiagnostic(condition.temp_to_null, c_expr);
end if;
appendWithDiagnostic(statements.temp_assigns, c_expr);
c_expr.expr &:= statements.expr;
appendWithDiagnostic(statements.temp_frees, c_expr);
else
c_expr.expr &:= statements.expr;
end if;
end func;
const proc: process_else (in reference: else_part, in boolean: insertKeyword,
inout expr_type: c_expr) is func
local
var category: functionCategory is category.value;
var ref_list: params is ref_list.EMPTY;
var reference: function is NIL;
var expr_type: c_param2 is expr_type.value;
var string: action_name is "";
begin
if category(else_part) = MATCHOBJECT then
params := getValue(else_part, ref_list);
function := params[1];
params := params[2 ..];
functionCategory := category(function);
if functionCategory = CONSTENUMOBJECT then
process_call_by_name_expr(params[2], c_param2);
if insertKeyword then
c_expr.expr &:= "else {\n";
end if;
process_statements(c_param2, c_expr);
if insertKeyword then
c_expr.expr &:= "}\n";
end if;
elsif functionCategory = ACTOBJECT then
if insertKeyword then
c_expr.expr &:= "else\n";
end if;
c_expr.currentFile := file(else_part);
c_expr.currentLine := line(else_part);
process_action(function, params, c_expr);
else
c_expr.expr &:= "/*!!! ";
c_expr.expr &:= str(functionCategory);
c_expr.expr &:= " ";
c_expr.expr &:= str(function);
c_expr.expr &:= " !!!*/";
end if;
else
c_expr.expr &:= "/*!! ";
c_expr.expr &:= str(category(else_part));
c_expr.expr &:= " ";
c_expr.expr &:= str(else_part);
c_expr.expr &:= " !!*/";
end if
end func;
const proc: process_const_prc_if (in boolean: condition, in reference: statement,
inout expr_type: c_expr) is func
local
var expr_type: c_statement is expr_type.value;
begin
incr(countOptimizations);
if condition then
c_expr.expr &:= "/* Optimized: if TRUE */ {\n";
process_call_by_name_expr(statement, c_statement);
process_statements(c_statement, c_expr);
c_expr.expr &:= "}\n";
else
c_expr.expr &:= "/* Optimized: if FALSE */\n";
end if;
end func;
const proc: process (PRC_IF, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var reference: evaluatedParam is NIL;
var expr_type: c_condition is expr_type.value;
var expr_type: c_statement is expr_type.value;
var string: statementFile is "";
var integer: statementLine is 0;
begin
if getConstant(params[2], ENUMLITERALOBJECT, evaluatedParam) then
process_const_prc_if(getValue(evaluatedParam, boolean), params[4], c_expr);
else
process_expr(params[2], c_condition);
process_call_by_name_expr(params[4], c_statement);
if c_condition.temp_num <> 0 then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
end if;
statementFile := c_expr.currentFile;
statementLine := c_expr.currentLine;
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (";
c_expr.expr &:= c_condition.expr;
if endsWith(c_expr.expr, "\n") then
setDiagnosticLine(c_expr);
end if;
c_expr.expr &:= ") {\n";
process_statements(c_statement, c_expr);
c_expr.expr &:= "}\n";
if c_condition.temp_num <> 0 then
c_expr.currentFile := statementFile;
c_expr.currentLine := statementLine;
appendWithDiagnostic(c_condition.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end if;
end func;
const proc: process_const_prc_if_elsif (in boolean: condition, in reference: thenPart,
in reference: elsePart, inout expr_type: c_expr) is func
local
var expr_type: c_then_part is expr_type.value;
var expr_type: c_else_part is expr_type.value;
begin
incr(countOptimizations);
c_expr.expr &:= "/* Optimized: if ";
c_expr.expr &:= str(condition);
c_expr.expr &:= " */ {\n";
if condition then
process_call_by_name_expr(thenPart, c_then_part);
process_statements(c_then_part, c_expr);
else
process_else(elsePart, FALSE, c_else_part);
process_statements(c_else_part, c_expr);
end if;
c_expr.expr &:= "}\n";
end func;
const proc: process (PRC_IF_ELSIF, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var reference: evaluatedParam is NIL;
var expr_type: c_condition is expr_type.value;
var expr_type: c_then_part is expr_type.value;
var expr_type: c_else_part is expr_type.value;
var string: statementFile is "";
var integer: statementLine is 0;
begin
if getConstant(params[2], ENUMLITERALOBJECT, evaluatedParam) then
process_const_prc_if_elsif(getValue(evaluatedParam, boolean),
params[4], params[5], c_expr);
else
process_expr(params[2], c_condition);
process_call_by_name_expr(params[4], c_then_part);
c_else_part.temp_num := c_condition.temp_num;
process_else(params[5], TRUE, c_else_part);
if c_else_part.temp_num <> 0 then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_else_part.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
appendWithDiagnostic(c_else_part.temp_assigns, c_expr);
end if;
statementFile := c_expr.currentFile;
statementLine := c_expr.currentLine;
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (";
c_expr.expr &:= c_condition.expr;
if endsWith(c_expr.expr, "\n") then
setDiagnosticLine(c_expr);
end if;
c_expr.expr &:= ") {\n";
process_statements(c_then_part, c_expr);
c_expr.expr &:= "} ";
c_expr.expr &:= c_else_part.expr;
if c_else_part.temp_num <> 0 then
c_expr.currentFile := statementFile;
c_expr.currentLine := statementLine;
appendWithDiagnostic(c_condition.temp_frees, c_expr);
appendWithDiagnostic(c_else_part.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end if;
end func;
const proc: process_const_prc_if_noop (in boolean: condition, in reference: statement,
inout expr_type: c_expr) is func
local
var expr_type: c_statement is expr_type.value;
begin
incr(countOptimizations);
if condition then
c_expr.expr &:= "/* Optimized: elsif TRUE */\n";
else
c_expr.expr &:= "/* Optimized: elsif FALSE */ {\n";
if category(statement) = MATCHOBJECT and
length(getValue(statement, ref_list)) = 3 and
category(getValue(statement, ref_list)[1]) = CONSTENUMOBJECT and
category(getValue(statement, ref_list)[3]) = CALLOBJECT then
process_expr(getValue(statement, ref_list)[3], c_statement);
else
process_call_by_name_expr(statement, c_statement);
end if;
process_statements(c_statement, c_expr);
c_expr.expr &:= "}\n";
end if;
end func;
const proc: process (PRC_IF_NOOP, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var reference: evaluatedParam is NIL;
var expr_type: c_condition is expr_type.value;
var expr_type: c_else_part is expr_type.value;
var string: statementFile is "";
var integer: statementLine is 0;
begin
if getConstant(params[2], ENUMLITERALOBJECT, evaluatedParam) then
process_const_prc_if_noop(getValue(evaluatedParam, boolean),
params[4], c_expr);
else
process_expr(params[2], c_condition);
c_else_part.temp_num := c_condition.temp_num;
process_else(params[4], TRUE, c_else_part);
if c_else_part.temp_num <> 0 then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_else_part.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
appendWithDiagnostic(c_else_part.temp_assigns, c_expr);
end if;
statementFile := c_expr.currentFile;
statementLine := c_expr.currentLine;
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (";
c_expr.expr &:= c_condition.expr;
if endsWith(c_expr.expr, "\n") then
setDiagnosticLine(c_expr);
end if;
c_expr.expr &:= ") { /* noop */ } ";
c_expr.expr &:= c_else_part.expr;
if c_else_part.temp_num <> 0 then
c_expr.currentFile := statementFile;
c_expr.currentLine := statementLine;
appendWithDiagnostic(c_condition.temp_frees, c_expr);
appendWithDiagnostic(c_else_part.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end if;
end func;
const proc: process (PRC_WHILE, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var expr_type: c_condition is expr_type.value;
var expr_type: c_statement is expr_type.value;
var string: statementFile is "";
var integer: statementLine is 0;
begin
c_condition.temp_num := c_expr.temp_num;
process_call_by_name_expr(params[2], c_condition);
c_statement.temp_num := c_condition.temp_num;
process_call_by_name_expr(params[4], c_statement);
c_expr.temp_num := c_statement.temp_num;
if c_condition.temp_decls <> "" then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
end if;
statementFile := c_expr.currentFile;
statementLine := c_expr.currentLine;
setDiagnosticLine(c_expr);
c_expr.expr &:= "while (";
c_expr.expr &:= c_condition.expr;
c_expr.expr &:= ") {\n";
process_statements(c_condition, c_statement, c_expr);
c_expr.expr &:= "}\n";
if c_condition.temp_decls <> "" then
c_expr.currentFile := statementFile;
c_expr.currentLine := statementLine;
appendWithDiagnostic(c_condition.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end func;
const proc: process (PRC_WHILE_NOOP, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var expr_type: c_condition is expr_type.value;
begin
c_condition.temp_num := c_expr.temp_num;
process_call_by_name_expr(params[2], c_condition);
c_expr.temp_num := c_condition.temp_num;
if c_condition.temp_decls <> "" then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
end if;
setDiagnosticLine(c_expr);
c_expr.expr &:= "while (";
c_expr.expr &:= c_condition.expr;
c_expr.expr &:= ") {\n";
c_expr.expr &:= "}\n";
if c_condition.temp_decls <> "" then
c_expr.currentFile := file(params[2]);
c_expr.currentLine := line(params[2]);
appendWithDiagnostic(c_condition.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end func;
const proc: process (PRC_REPEAT, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var expr_type: c_condition is expr_type.value;
var expr_type: c_statement is expr_type.value;
begin
c_condition.temp_num := c_expr.temp_num;
process_call_by_name_expr(params[4], c_condition);
c_statement.temp_num := c_condition.temp_num;
process_call_by_name_expr(params[2], c_statement);
c_expr.temp_num := c_statement.temp_num;
if c_condition.temp_decls <> "" then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
end if;
setDiagnosticLine(c_expr);
c_expr.expr &:= "do {\n";
process_statements(c_condition, c_statement, c_expr);
c_expr.expr &:= diagnosticLine(params[4]);
c_expr.expr &:= "} while (!(";
c_expr.expr &:= c_condition.expr;
c_expr.expr &:= "));\n";
if c_condition.temp_decls <> "" then
c_expr.currentFile := file(params[4]);
c_expr.currentLine := line(params[4]);
appendWithDiagnostic(c_condition.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end func;
const proc: process (PRC_REPEAT_NOOP, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var expr_type: c_condition is expr_type.value;
begin
c_condition.temp_num := c_expr.temp_num;
process_call_by_name_expr(params[3], c_condition);
c_expr.temp_num := c_condition.temp_num;
if c_condition.temp_decls <> "" then
c_expr.expr &:= "{\n";
appendWithDiagnostic(c_condition.temp_decls, c_expr);
appendWithDiagnostic(c_condition.temp_assigns, c_expr);
end if;
setDiagnosticLine(c_expr);
c_expr.expr &:= "do {\n";
c_expr.expr &:= diagnosticLine(params[3]);
c_expr.expr &:= "} while (!(";
c_expr.expr &:= c_condition.expr;
c_expr.expr &:= "));\n";
if c_condition.temp_decls <> "" then
c_expr.currentFile := file(params[3]);
c_expr.currentLine := line(params[3]);
appendWithDiagnostic(c_condition.temp_frees, c_expr);
c_expr.expr &:= "}\n";
end if;
end func;
const proc: processFuncValue (in string: valueName, in type: genericFuncType,
in reference: closure, inout expr_type: c_expr) is forward;
const proc: process (PRC_RETURN, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var string: valueName is "";
begin
create_name(params[2], objNumber(params[2]), valueName);
processFuncValue(valueName, resultType(getType(function)), params[2], c_expr);
c_expr.result_expr := c_expr.expr;
end func;
const func boolean: varChangedInStatements (in reference: variable,
in reference: statements) is func
result
var boolean: varChangedInStatements is FALSE;
local
var category: currCategory is category.value;
var reference: function is NIL;
var ref_list: actualParams is ref_list.EMPTY;
var ref_list: formalParams is ref_list.EMPTY;
var integer: index is 0;
var reference: actualParam is NIL;
var reference: formalParam is NIL;
begin
currCategory := category(statements);
if currCategory = CALLOBJECT or currCategory = MATCHOBJECT then
actualParams := getValue(statements, ref_list);
function := actualParams[1];
actualParams := actualParams[2 ..];
formalParams := formalParams(function);
for actualParam range actualParams do
incr(index);
if actualParam = variable then
formalParam := formalParams[index];
if category(formalParam) = REFPARAMOBJECT and isVar(formalParam) then
varChangedInStatements := TRUE;
end if;
elsif category(actualParam) = CALLOBJECT or category(actualParam) = MATCHOBJECT then
varChangedInStatements := varChangedInStatements or
varChangedInStatements(variable, actualParam);
end if;
end for;
end if;
end func;
const proc: process_prc_for (in reference: variable, in reference: startExpr,
in reference: endExpr, in reference: incrStep, in reference: statements,
in boolean: for_to, inout expr_type: c_expr) is func
local
var expr_type: c_start_expr is expr_type.value;
var reference: evaluatedParam is NIL;
var string: start_name is "";
var string: end_name is "";
var string: step_name is "";
var boolean: constant_start_value is FALSE;
var integer: start_value is 0;
var boolean: constant_end_value is FALSE;
var integer: end_value is 0;
var boolean: raises_exception is FALSE;
var intRange: variableRange is intRange.value;
var expr_type: statement is expr_type.value;
begin
if getConstant(startExpr, INTOBJECT, evaluatedParam) then
constant_start_value := TRUE;
start_value := getValue(evaluatedParam, integer);
start_name := integerLiteral(start_value);
else
start_name := defineForStartVariable("intType", "start_", startExpr, statement);
end if;
if getConstant(endExpr, INTOBJECT, evaluatedParam) then
constant_end_value := TRUE;
end_value := getValue(evaluatedParam, integer);
end_name := integerLiteral(end_value);
else
end_name := defineTempConstant("intType", "end_", endExpr, statement);
end if;
if incrStep <> NIL then
if getConstant(incrStep, INTOBJECT, evaluatedParam) then
step_name := integerLiteral(getValue(evaluatedParam, integer));
else
step_name := defineTempConstant("intType", "step_", incrStep, statement);
end if;
end if;
if for_loop_variable_check and incrStep = NIL then
if constant_end_value then
if for_to then
if end_value = integer.last then
warning(DOES_RAISE, "RANGE_ERROR", c_expr);
statement.expr &:= raiseError("RANGE_ERROR");
raises_exception := TRUE;
end if;
else
if end_value = integer.first then
warning(DOES_RAISE, "RANGE_ERROR", c_expr);
statement.expr &:= raiseError("RANGE_ERROR");
raises_exception := TRUE;
end if;
end if;
else
incr(countRangeChecks);
statement.expr &:= "if (rngChk(";
statement.expr &:= end_name;
statement.expr &:= "==";
if for_to then
statement.expr &:= integerLiteral(integer.last);
else
statement.expr &:= integerLiteral(integer.first);
end if;
statement.expr &:= "))";
statement.expr &:= raiseError("RANGE_ERROR");
end if;
end if;
if not raises_exception then
statement.expr &:= "for (";
process_expr(variable, statement);
statement.expr &:= "=";
statement.expr &:= start_name;
statement.expr &:= "; ";
process_expr(variable, statement);
if for_to then
statement.expr &:= "<=";
else
statement.expr &:= ">=";
end if;
statement.expr &:= end_name;
statement.expr &:= "; (";
process_expr(variable, statement);
if for_to then
if incrStep = NIL then
statement.expr &:= ")++) {\n";
else
statement.expr &:= ")+=";
statement.expr &:= step_name;
statement.expr &:= ") {\n";
end if;
else
if incrStep = NIL then
statement.expr &:= ")--) {\n";
else
statement.expr &:= ")-=";
statement.expr &:= step_name;
statement.expr &:= ") {\n";
end if;
end if;
if category(variable) = LOCALVOBJECT and
(constant_start_value or constant_end_value) and
not varChangedInStatements(variable, statements) then
if constant_start_value then
if for_to then
variableRange.minValue := start_value;
else
variableRange.maxValue := start_value;
end if;
end if;
if constant_end_value then
if for_to then
variableRange.maxValue := end_value;
else
variableRange.minValue := end_value;
end if;
end if;
intRangeOfVariable @:= [variable] variableRange;
process_call_by_name_expr(statements, statement);
excl(intRangeOfVariable, variable);
else
process_call_by_name_expr(statements, statement);
end if;
statement.expr &:= "}\n";
end if;
doLocalDeclsOfStatement(statement, c_expr);
end func;
const proc: process (PRC_FOR_DOWNTO, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
process_prc_for(params[2], params[4], params[6], NIL, params[8], FALSE, c_expr);
end func;
const proc: process (PRC_FOR_DOWNTO_STEP, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
process_prc_for(params[2], params[4], params[6], params[8], params[10], FALSE, c_expr);
end func;
const proc: process (PRC_FOR_TO, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
process_prc_for(params[2], params[4], params[6], NIL, params[8], TRUE, c_expr);
end func;
const proc: process (PRC_FOR_TO_STEP, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
process_prc_for(params[2], params[4], params[6], params[8], params[10], TRUE, c_expr);
end func;
const proc: process_bitset (in bitset: currentSet, in string: diagnosticLine,
inout expr_type: c_expr) is func
local
var integer: number is 0;
begin
for number range currentSet do
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "case ";
c_expr.expr &:= str(number);
c_expr.expr &:= ":\n";
end for;
end func;
const type: allWhenValuesType is hash [reference] bitset;
const proc: process_case_labels (in reference: whenExpression,
in reference: caseLabelExpression, inout allWhenValuesType: allWhenValues,
inout expr_type: c_expr) is func
local
var reference: caseLabels is NIL;
var category: labelCategory is category.value;
var bitset: currentWhenValues is bitset.EMPTY_SET;
var reference: whenReference is NIL;
var bitset: whenValues is bitset.EMPTY_SET;
begin
caseLabels := evaluate(prog, caseLabelExpression);
labelCategory := category(caseLabels);
if labelCategory = SETOBJECT then
currentWhenValues := getValue(caseLabels, bitset);
if currentWhenValues = bitset.EMPTY_SET then
error(EMPTY_WHEN_SET, whenExpression);
else
for whenValues key whenReference range allWhenValues do
if whenValues & currentWhenValues <> bitset.EMPTY_SET then
error(WHEN_OVERLAPPING, whenValues & currentWhenValues,
whenExpression);
error(WHEN_PREVIOUS, whenValues & currentWhenValues,
whenReference);
end if;
end for;
end if;
process_bitset(currentWhenValues,
diagnosticLine(whenExpression), c_expr);
allWhenValues @:= [whenExpression] currentWhenValues;
else
c_expr.expr &:= "/* case ";
c_expr.expr &:= str(labelCategory);
c_expr.expr &:= " */";
end if;
end func;
const proc: process_when (in reference: when_expr,
inout allWhenValuesType: allWhenValues, inout expr_type: c_expr) is func
local
var ref_list: params is ref_list.EMPTY;
begin
params := getValue(when_expr, ref_list);
params := params[2 ..];
process_case_labels(when_expr, params[2], allWhenValues, c_expr);
process_call_by_name_expr(params[4], c_expr);
setDiagnosticLine(c_expr);
c_expr.expr &:= "break;\n";
if length(params) >= 5 then
process_when(params[5], allWhenValues, c_expr);
end if;
end func;
const proc: generate_switch (in reference: controlExpr,
inout expr_type: c_expr) is func
local
var type: controlExprType is void;
begin
setDiagnosticLine(c_expr);
c_expr.expr &:= "switch (";
controlExprType := getExprResultType(controlExpr);
if controlExprType in typeCategory and
typeCategory[controlExprType] = CHAROBJECT then
c_expr.expr &:= "(scharType)(";
process_expr(controlExpr, c_expr);
c_expr.expr &:= ")";
elsif ccConf.SWITCH_WORKS_FOR_INT64TYPE then
process_expr(controlExpr, c_expr);
else
c_expr.expr &:= "(int32Type)(";
process_expr(controlExpr, c_expr);
c_expr.expr &:= ")";
end if;
c_expr.expr &:= ") {\n";
end func;
const proc: process (PRC_CASE, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var allWhenValuesType: allWhenValues is allWhenValuesType.value;
begin
generate_switch(params[2], c_expr);
process_when(params[4], allWhenValues, c_expr);
c_expr.expr &:= "}\n";
end func;
const proc: process (PRC_CASE_DEF, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var allWhenValuesType: allWhenValues is allWhenValuesType.value;
begin
generate_switch(params[2], c_expr);
process_when(params[4], allWhenValues, c_expr);
c_expr.expr &:= "default:\n";
process_call_by_name_expr(params[7], c_expr);
c_expr.expr &:= "break;\n";
c_expr.expr &:= "}\n";
end func;
const type: caseTableType is array reference;
const type: allCaseTablesType is array caseTableType;
var allCaseTablesType: case_table is [0 .. -1] times 0 times NIL;
const proc: process_hashcode (in reference: current_object, inout expr_type: c_expr) is forward;
const proc: object_address (in reference: current_object, inout expr_type: c_expr) is forward;
const func reference: compareObj (in reference: current_object) is func
result
var reference: keyCompare is NIL;
local
var ref_list: param_list is ref_list.EMPTY;
begin
param_list := make_list(current_object);
param_list &:= make_list(current_object);
param_list &:= make_list(syobject(prog, "compare"));
keyCompare := matchExpr(prog, param_list);
keyCompare := getValue(keyCompare, ref_list)[1];
end func;
const proc: process_case_labels (in integer: numOfCaseStmt, in integer: numOfWhenPart,
in reference: whenExpression, in reference: caseLabelExpression,
inout expr_type: c_expr) is func
local
var reference: caseLabels is NIL;
var category: labelCategory is category.value;
var bitset: currentWhenValues is bitset.EMPTY_SET;
begin
caseLabels := evaluate(prog, caseLabelExpression);
labelCategory := category(caseLabels);
if labelCategory = HASHOBJECT then
case_table[numOfCaseStmt] &:= caseLabels;
c_expr.expr &:= diagnosticLine(whenExpression);
c_expr.expr &:= "case ";
c_expr.expr &:= str(numOfWhenPart);
c_expr.expr &:= ":\n";
else
c_expr.expr &:= "/* case ";
c_expr.expr &:= str(labelCategory);
c_expr.expr &:= " */";
end if;
end func;
const proc: process_when (in integer: numOfCaseStmt, in integer: numOfWhenPart,
in reference: when_expr, inout expr_type: c_expr) is func
local
var ref_list: params is ref_list.EMPTY;
begin
params := getValue(when_expr, ref_list);
params := params[2 ..];
process_case_labels(numOfCaseStmt, numOfWhenPart, when_expr, params[2], c_expr);
process_call_by_name_expr(params[4], c_expr);
setDiagnosticLine(c_expr);
c_expr.expr &:= "break;\n";
if length(params) >= 5 then
process_when(numOfCaseStmt, succ(numOfWhenPart), params[5], c_expr);
end if;
end func;
const proc: process (PRC_CASE_HASHSET, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var integer: numOfCaseStmt is 0;
var reference: switchValue is NIL;
var expr_type: statement is expr_type.value;
begin
case_table &:= 0 times NIL;
numOfCaseStmt := maxIdx(case_table);
switchValue := getParameterAsVariable(params[2], statement);
statement.expr &:= diagnosticLine(c_expr);
statement.expr &:= "switch (";
if not ccConf.SWITCH_WORKS_FOR_INT64TYPE then
statement.expr &:= "(int32Type) ";
end if;
statement.expr &:= "hshIdxDefault0(caseLabels[";
statement.expr &:= str(numOfCaseStmt);
statement.expr &:= "], ";
if isNormalVariable(params[2]) then
getGenericValue(switchValue, statement);
else
getGenericValueOfVariableObject(switchValue, statement);
end if;
statement.expr &:= ", ";
process_hashcode(switchValue, statement);
statement.expr &:= ", ";
object_address(compareObj(params[2]), statement);
statement.expr &:= ")) {\n";
process_when(numOfCaseStmt, 1, params[4], statement);
setDiagnosticLine(statement);
statement.expr &:= "}\n";
doLocalDeclsOfStatement(statement, c_expr);
end func;
const proc: process (PRC_CASE_HASHSET_DEF, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var integer: numOfCaseStmt is 0;
var reference: switchValue is NIL;
var expr_type: statement is expr_type.value;
begin
case_table &:= 0 times NIL;
numOfCaseStmt := maxIdx(case_table);
switchValue := getParameterAsVariable(params[2], statement);
statement.expr &:= diagnosticLine(c_expr);
statement.expr &:= "switch (";
if not ccConf.SWITCH_WORKS_FOR_INT64TYPE then
statement.expr &:= "(int32Type) ";
end if;
statement.expr &:= "hshIdxDefault0(caseLabels[";
statement.expr &:= str(numOfCaseStmt);
statement.expr &:= "], ";
if isNormalVariable(params[2]) then
getGenericValue(switchValue, statement);
else
getGenericValueOfVariableObject(switchValue, statement);
end if;
statement.expr &:= ", ";
process_hashcode(switchValue, statement);
statement.expr &:= ", ";
object_address(compareObj(params[2]), statement);
statement.expr &:= ")) {\n";
process_when(numOfCaseStmt, 1, params[4], statement);
statement.expr &:= diagnosticLine(params[7]);
statement.expr &:= "default:\n";
process_call_by_name_expr(params[7], statement);
setDiagnosticLine(statement);
statement.expr &:= "break;\n";
setDiagnosticLine(statement);
statement.expr &:= "}\n";
doLocalDeclsOfStatement(statement, c_expr);
end func;
const proc: process (PRC_BLOCK, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var reference: current_catch is NIL;
var ref_list: catch_expr is ref_list.EMPTY;
var reference: catch_value is NIL;
begin
setDiagnosticLine(c_expr);
c_expr.expr &:= "{\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "int fail_value;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos++;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (unlikely(catch_stack_pos >= max_catch_stack)) {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= " resize_catch_stack();\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (likely((fail_value = do_setjmp(catch_stack[catch_stack_pos])) == 0)) {\n";
increaseLevelOfCatchedExceptions(params[4]);
process_call_by_name_expr(params[2], c_expr);
decreaseLevelOfCatchedExceptions(params[4]);
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos--;\n";
current_catch := params[4];
catch_expr := getValue(current_catch, ref_list);
c_expr.expr &:= diagnosticLine(current_catch);
c_expr.expr &:= "} else {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos--;\n";
while current_catch <> NIL and
category(current_catch) = MATCHOBJECT and
length(catch_expr) >= 5 do
catch_value := catch_expr[3];
checkWarning(CATCH_WITH_SUPPRESSED_CHECK, str(catch_value), current_catch);
c_expr.expr &:= diagnosticLine(current_catch);
c_expr.expr &:= "if (";
process_expr(catch_value, c_expr);
c_expr.expr &:= " == fail_value - 1) {\n";
process_call_by_name_expr(catch_expr[5], c_expr);
if length(catch_expr) >= 6 then
c_expr.expr &:= diagnosticLine(current_catch);
c_expr.expr &:= "} else\n";
current_catch := catch_expr[6];
catch_expr := getValue(current_catch, ref_list);
else
incr(c_expr.currentLine);
setDiagnosticLine(c_expr);
c_expr.expr &:= "} else {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= " rtlRaiseError(fail_value, error_file, error_line);\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
current_catch := NIL;
end if;
end while;
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
end func;
const proc: process (PRC_BLOCK_CATCH_ALL, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
setDiagnosticLine(c_expr);
c_expr.expr &:= "{\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "int fail_value;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos++;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (unlikely(catch_stack_pos >= max_catch_stack)) {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= " resize_catch_stack();\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (likely((fail_value = do_setjmp(catch_stack[catch_stack_pos])) == 0)) {\n";
incr(catchAllExceptionsLevel);
process_call_by_name_expr(params[2], c_expr);
decr(catchAllExceptionsLevel);
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos--;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "} else {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos--;\n";
checkWarning(CATCH_OTHERWISE_WITH_SUPPRESSED_CHECK, params[6]);
process_call_by_name_expr(params[6], c_expr);
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
end func;
const proc: process (PRC_BLOCK_OTHERWISE, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
local
var reference: current_catch is NIL;
var ref_list: catch_expr is ref_list.EMPTY;
var reference: catch_value is NIL;
begin
setDiagnosticLine(c_expr);
c_expr.expr &:= "{\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "int fail_value;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos++;\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (unlikely(catch_stack_pos >= max_catch_stack)) {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= " resize_catch_stack();\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "if (likely((fail_value = do_setjmp(catch_stack[catch_stack_pos])) == 0)) {\n";
increaseLevelOfCatchedExceptions(params[4]);
incr(catchAllExceptionsLevel);
process_call_by_name_expr(params[2], c_expr);
decreaseLevelOfCatchedExceptions(params[4]);
decr(catchAllExceptionsLevel);
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos--;\n";
current_catch := params[4];
catch_expr := getValue(current_catch, ref_list);
c_expr.expr &:= diagnosticLine(current_catch);
c_expr.expr &:= "} else {\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "catch_stack_pos--;\n";
while current_catch <> NIL and
category(current_catch) = MATCHOBJECT and
length(catch_expr) >= 5 do
catch_value := catch_expr[3];
checkWarning(CATCH_WITH_SUPPRESSED_CHECK, str(catch_value), current_catch);
c_expr.expr &:= diagnosticLine(current_catch);
c_expr.expr &:= "if (";
process_expr(catch_value, c_expr);
c_expr.expr &:= " == fail_value - 1) {\n";
process_call_by_name_expr(catch_expr[5], c_expr);
if length(catch_expr) >= 6 then
c_expr.expr &:= diagnosticLine(current_catch);
c_expr.expr &:= "} else\n";
current_catch := catch_expr[6];
catch_expr := getValue(current_catch, ref_list);
else
incr(c_expr.currentLine);
setDiagnosticLine(c_expr);
c_expr.expr &:= "} else {\n";
checkWarning(CATCH_OTHERWISE_WITH_SUPPRESSED_CHECK, params[7]);
process_call_by_name_expr(params[7], c_expr);
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
current_catch := NIL;
end if;
end while;
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
setDiagnosticLine(c_expr);
c_expr.expr &:= "}\n";
end func;
const proc: process_func_call (in reference: function,
in ref_list: actual_params, inout expr_type: c_expr) is forward;
const proc: process (PRC_DYNAMIC, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
process_func_call(function, params, c_expr);
end func;
const proc: process (PRC_EXIT, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
setDiagnosticLine(c_expr);
c_expr.expr &:= "doExit(";
process_expr(params[1], c_expr);
c_expr.expr &:= ");\n";
end func;
const proc: process (PRC_HEAPSTAT, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
compDataLibraryUsed := TRUE;
setDiagnosticLine(c_expr);
c_expr.expr &:= "heapStatistic();\n";
end func;
const proc: process (PRC_HSIZE, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
c_expr.expr &:= "heapsize()";
end func;
const proc: process (PRC_LINE, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
c_expr.expr &:= integerLiteral(c_expr.currentLine);
end func;
const proc: process_prc_semicol (in ref_list: params, inout expr_type: c_expr) is func
local
var reference: statement is NIL;
var ref_list: semicolParams is ref_list.EMPTY;
var boolean: finished is FALSE;
begin
process_call_by_name_expr(params[1], c_expr);
statement := params[3];
repeat
if category(statement) = CALLOBJECT then
semicolParams := getValue(statement, ref_list);
if length(semicolParams) = 4 and
category(semicolParams[1]) = ACTOBJECT and
str(getValue(semicolParams[1], ACTION)) = "PRC_NOOP" and
str(semicolParams[3]) = ";" then
process_call_by_name_expr(semicolParams[2], c_expr);
statement := semicolParams[4];
else
process_call_by_name_expr(statement, c_expr);
finished := TRUE;
end if;
else
process_call_by_name_expr(statement, c_expr);
finished := TRUE;
end if;
until finished;
end func;
const proc: do_noop_param (in reference: formal_param, in reference: actual_param,
inout expr_type: c_expr) is func
local
var category: paramCategory is category.value;
var type: object_type is void;
begin
paramCategory := category(actual_param);
if paramCategory <> SYMBOLOBJECT and
category(formal_param) <> SYMBOLOBJECT then
object_type := getType(formal_param);
if isFunc(object_type) or isVarfunc(object_type) then
c_expr.expr &:= "/*expression*/";
else
c_expr.expr &:= "/* ";
c_expr.expr &:= str(paramCategory);
if paramCategory = MATCHOBJECT then
paramCategory := category(getValue(actual_param, ref_list)[1]);
c_expr.expr &:= " ";
c_expr.expr &:= str(paramCategory);
if paramCategory = ACTOBJECT then
c_expr.expr &:= " ";
c_expr.expr &:= str(getValue(getValue(actual_param, ref_list)[1], ACTION));
end if
end if;
c_expr.expr &:= " */";
getAnyParamToExpr(actual_param, c_expr);
c_expr.expr &:= ";";
end if;
else
c_expr.expr &:= "/*";
c_expr.expr &:= str(actual_param);
c_expr.expr &:= "*/";
end if;
end func;
const proc: noop_params (in ref_list: formal_params,
in ref_list: actual_params, inout expr_type: c_expr) is func
local
var integer: number is 0;
begin
for number range 1 to length(formal_params) do
if number <= length(actual_params) then
do_noop_param(formal_params[number], actual_params[number], c_expr);
end if;
end for;
end func;
const proc: process_prc_other_noop (in reference: function, in ref_list: params,
inout expr_type: c_expr) is func
begin
c_expr.expr &:= "/*noop*/";
noop_params(formalParams(function), params, c_expr);
c_expr.expr &:= "\n";
end func;
const proc: process (PRC_NOOP, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
if length(params) = 3 and str(params[2]) = ";" then
process_prc_semicol(params, c_expr);
else
process_prc_other_noop(function, params, c_expr);
end if;
end func;
const proc: process (PRC_ARGS, in reference: function, in ref_list: params,
inout expr_type: c_expr) is func
begin
c_expr.expr &:= "(";
c_expr.expr &:= type_name(resultType(getType(function)));
c_expr.expr &:= ")(arg_v)";
end func;
const proc: process (PRC_CPY, in reference: function, in ref_list: params,
inout expr_type: c_expr) is func
local
var category: paramCategory is category.value;
var string: valueName is "";
begin
setDiagnosticLine(c_expr);
if category(params[1]) = REFPARAMOBJECT and
params[1] in inlineParam and
inlineParam[params[1]][1].paramValue <> NIL then
process_expr(inlineParam[params[1]][1].paramValue, c_expr);
else
process_expr(params[1], c_expr);
end if;
c_expr.expr &:= " = ";
if isVar(params[3]) then
c_expr.expr &:= "o_";
create_name(params[3], c_expr.expr);
elsif getType(params[1]) = resultType(getType(params[3])) then
process_expr(params[3], c_expr);
elsif getType(params[1]) = getType(params[3]) then
create_name(params[3], objNumber(params[3]), valueName);
processFuncValue(valueName, getType(params[3]), params[3], c_expr);
else
paramCategory := category(params[3]);
if paramCategory = MATCHOBJECT or paramCategory = CALLOBJECT or
paramCategory = BLOCKOBJECT then
create_name(params[3], objNumber(params[3]), valueName);
processFuncValue(valueName, getType(params[3]), params[3], c_expr);
else
c_expr.expr &:= "o_";
create_name(params[3], c_expr.expr);
end if;
end if;
c_expr.expr &:= ";\n";
end func;
const proc: process (PRC_RAISE, in reference: function,
in ref_list: params, inout expr_type: c_expr) is func
begin
if profile_function and catchAllExceptionsLevel = 0 and
(str(params[2]) not in catchExceptionLevel or catchExceptionLevel[str(params[2])] = 0) then
c_expr.expr &:= "profile[";
c_expr.expr &:= str(objNumber(currentProfiledFunction));
c_expr.expr &:= "].depth--;\n";
c_expr.expr &:= "if (profile[";
c_expr.expr &:= str(objNumber(currentProfiledFunction));
c_expr.expr &:= "].depth == 0) {\n";
c_expr.expr &:= " profile[";
c_expr.expr &:= str(objNumber(currentProfiledFunction));
c_expr.expr &:= "].time += timMicroSec();\n";
c_expr.expr &:= "}\n";
end if;
setDiagnosticLine(c_expr);
c_expr.expr &:= "rtlRaiseError(";
getAnyParamToExpr(params[2], c_expr);
c_expr.expr &:= "+1, ";
c_expr.expr &:= sourceNameString(c_expr.currentFile);
c_expr.expr &:= ", ";
c_expr.expr &:= str(c_expr.currentLine);
c_expr.expr &:= ");\n";
end func;