var boolean_type_hash: flist_declared is boolean_type_hash.EMPTY_HASH;
var typeReferenceHash: destrFunction is typeReferenceHash.EMPTY_HASH;
var boolean_type_hash: destr_declared is boolean_type_hash.EMPTY_HASH;
var boolean_type_hash: destr_prototype_declared is boolean_type_hash.EMPTY_HASH;
var string_type_hash: parametersOfHshDestr is string_type_hash.EMPTY_HASH;
const set of category: simpleValueType is {
BOOLOBJECT, ENUMOBJECT, INTOBJECT, FLOATOBJECT, CHAROBJECT,
SOCKETOBJECT, REFOBJECT, TYPEOBJECT, ACTOBJECT, BLOCKOBJECT};
const integer: ARRAY_FREELIST_LIMIT is 64;
const proc: process_destr_declaration (in type: object_type,
inout expr_type: c_expr) is forward;
const proc: process_destr_call (in type: object_type,
in string: param_b, inout string: expr) is forward;
const proc: declare_free_list (in type: object_type, in string: diagnosticLine,
inout expr_type: c_expr) is func
begin
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static freeListElemType flist_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= "=NULL;\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static unsigned int flist_allowed_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= "=1;\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static boolType flist_was_full_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= "=0;\n\n";
flist_declared @:= [object_type] TRUE;
end func;
const proc: define_array_size_variable (in type: object_type, inout expr_type: c_expr) is func
begin
c_expr.expr &:= "memSizeType size = (uintType)(";
if object_type in array_minIdx then
if object_type in array_maxIdx then
c_expr.expr &:= integerLiteral(array_maxIdx[object_type] - array_minIdx[object_type] + 1);
else
c_expr.expr &:= "b->max_position - ";
if array_minIdx[object_type] = integer.first then
c_expr.expr &:= integerLiteral(array_minIdx[object_type]);
c_expr.expr &:= " + 1";
else
c_expr.expr &:= integerLiteral(pred(array_minIdx[object_type]));
end if;
end if;
else
c_expr.expr &:= "b->max_position - b->min_position + 1";
end if;
c_expr.expr &:= ");\n";
end func;
const func string: process_arr_free (in type: object_type, in string: variableName,
in boolean: useFreelist, in string: diagnosticLine) is func
result
var string: freeExpr is "";
begin
if useFreelist then
freeExpr &:= "if (flist_allowed_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= ">0) {\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "((freeListElemType)(";
freeExpr &:= variableName;
freeExpr &:= "))->next = flist_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= ";\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "flist_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= " = (freeListElemType)(";
freeExpr &:= variableName;
freeExpr &:= ");\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "flist_allowed_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= "--;\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "} else {\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "arrFree((arrayType)(";
freeExpr &:= variableName;
freeExpr &:= "));\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "flist_was_full_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= "=1;\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "}\n";
else
freeExpr &:= "arrFree((arrayType)(";
freeExpr &:= variableName;
freeExpr &:= "));\n";
end if;
end func;
const proc: process_arr_destr_declaration (in type: object_type,
inout expr_type: c_expr) is func
local
var string: diagnosticLine is "";
var string: select_value is "";
var boolean: useFreelist is FALSE;
begin
if object_type in destrFunction then
diagnosticLine := diagnosticLine(destrFunction[object_type]);
end if;
select_value := select_value_from_rtlObjectStruct(array_element[object_type]);
process_destr_declaration(array_element[object_type], c_expr);
if fixArrayFreelist and
object_type in array_minIdx and object_type in array_maxIdx and
array_maxIdx[object_type] -
array_minIdx[object_type] < ARRAY_FREELIST_LIMIT then
useFreelist := TRUE;
if object_type not in flist_declared then
declare_free_list(object_type, diagnosticLine, c_expr);
end if;
end if;
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static void destr_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= " (const_";
c_expr.expr &:= type_name(object_type);
c_expr.expr &:= " b)\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "{\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "if (b != NULL) {\n";
if array_element[object_type] not in typeCategory or
typeCategory[array_element[object_type]] not in simpleValueType then
c_expr.expr &:= diagnosticLine;
define_array_size_variable(object_type, c_expr);
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "while (size != 0) {\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "size--;\n";
c_expr.expr &:= diagnosticLine;
process_destr_call(array_element[object_type],
"b->arr[size]" & select_value, c_expr.expr);
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
end if;
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= process_arr_free(object_type, "b", useFreelist, diagnosticLine);
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= noDiagnosticLine;
c_expr.expr &:= "\n";
destr_declared @:= [object_type] TRUE;
end func;
const func string: process_sct_free (in type: object_type, in string: variableName,
in string: diagnosticLine) is func
result
var string: freeExpr is "";
begin
if structFreelist then
freeExpr &:= "if (flist_allowed_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= ">0) {\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "((freeListElemType)(";
freeExpr &:= variableName;
freeExpr &:= "))->next = flist_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= ";\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "flist_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= " = (freeListElemType)(";
freeExpr &:= variableName;
freeExpr &:= ");\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "flist_allowed_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= "--;\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "} else {\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "free((void *)(";
freeExpr &:= variableName;
freeExpr &:= "));\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "flist_was_full_";
freeExpr &:= str(typeNumber(object_type));
freeExpr &:= "=1;\n";
freeExpr &:= diagnosticLine;
freeExpr &:= "}\n";
else
freeExpr &:= "free((void *)(";
freeExpr &:= variableName;
freeExpr &:= "));\n";
end if;
end func;
const proc: process_sct_destr_declaration (in type: object_type,
inout expr_type: c_expr) is func
local
var string: diagnosticLine is "";
var integer: structSize is 0;
var integer: elementIndex is 0;
var string: select_value is "";
begin
if object_type in destrFunction then
diagnosticLine := diagnosticLine(destrFunction[object_type]);
end if;
if object_type in struct_size then
structSize := struct_size[object_type];
end if;
for elementIndex range 0 to pred(structSize) do
process_destr_declaration(struct_element_type[object_type][elementIndex], c_expr);
end for;
if structFreelist and object_type not in flist_declared then
declare_free_list(object_type, diagnosticLine, c_expr);
end if;
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static void destr_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= " (";
c_expr.expr &:= type_name(object_type);
c_expr.expr &:= " b)\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "{\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "if (b != NULL && b->usage_count != 0) {\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "b->usage_count--;\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "if (b->usage_count == 0) {\n";
for elementIndex range 0 to pred(structSize) do
select_value := select_value_from_rtlObjectStruct(struct_element_type[object_type][elementIndex]);
c_expr.expr &:= diagnosticLine;
process_destr_call(struct_element_type[object_type][elementIndex],
"b->stru[" & str(elementIndex) & "]" & select_value, c_expr.expr);
end for;
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= process_sct_free(object_type, "b", diagnosticLine);
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}}\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= noDiagnosticLine;
c_expr.expr &:= "\n";
destr_declared @:= [object_type] TRUE;
end func;
const proc: process_hsh_destr_declaration (in type: object_type,
inout expr_type: c_expr) is func
local
var string: diagnosticLine is "";
begin
if object_type in destrFunction then
diagnosticLine := diagnosticLine(destrFunction[object_type]);
end if;
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static void destr_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= " (const_";
c_expr.expr &:= type_name(object_type);
c_expr.expr &:= " b)\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "{\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "hshDestr(b";
c_expr.expr &:= parametersOfHshDestr[object_type];
c_expr.expr &:= ");\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= noDiagnosticLine;
c_expr.expr &:= "\n";
destr_declared @:= [object_type] TRUE;
end func;
const proc: process_itf_destr_declaration (in type: object_type,
inout expr_type: c_expr) is func
local
var string: diagnosticLine is "";
var type: interfaceType is void;
var type: implementationType is void;
var boolean: isDerived is FALSE;
var bitset: typeNumUsed is bitset.value;
begin
if object_type in destrFunction then
diagnosticLine := diagnosticLine(destrFunction[object_type]);
end if;
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "static void destr_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= " (";
c_expr.expr &:= type_name(object_type);
c_expr.expr &:= " b)\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "{\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "if (b != NULL) {\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "if (b->usage_count >= 2) {\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "b->usage_count--;\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "} else if (b->usage_count != 0) {\n";
c_expr.expr &:= diagnosticLine;
interfaceType := object_type;
c_expr.expr &:= "switch (b->type_num) {\n";
repeat
if interfaceType in implements then
for implementationType range implements[interfaceType] do
if typeNumber(implementationType) not in typeNumUsed then
c_expr.expr &:= "case ";
c_expr.expr &:= str(typeNumber(implementationType));
c_expr.expr &:= "/*";
c_expr.expr &:= str(implementationType);
c_expr.expr &:= "*/";
c_expr.expr &:= ": ";
c_expr.expr &:= diagnosticLine;
process_destr_declaration(implementationType, global_c_expr);
process_destr_call(implementationType, "b", c_expr.expr);
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "break;\n";
incl(typeNumUsed, typeNumber(implementationType));
end if;
end for;
end if;
isDerived := isDerived(interfaceType);
if isDerived then
interfaceType := meta(interfaceType);
end if;
until not isDerived;
c_expr.expr &:= "default:";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "raiseError(ACTION_ERROR);\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= diagnosticLine;
c_expr.expr &:= "}\n";
c_expr.expr &:= noDiagnosticLine;
c_expr.expr &:= "\n";
destr_declared @:= [object_type] TRUE;
end func;
const proc: process_itf_destr_prototype (in type: object_type,
inout expr_type: c_expr) is func
begin
if object_type not in destr_prototype_declared then
c_expr.expr &:= "static void destr_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= " (";
c_expr.expr &:= type_name(object_type);
c_expr.expr &:= ");\n\n";
destr_prototype_declared @:= [object_type] TRUE;
end if;
end func;
const proc: declare_destr_prototype (in type: object_type,
inout expr_type: c_expr) is func
begin
if object_type not in destr_prototype_declared then
declare_type_if_necessary(object_type, c_expr);
c_expr.expr &:= "static void destr_";
c_expr.expr &:= str(typeNumber(object_type));
c_expr.expr &:= " (const_";
c_expr.expr &:= type_name(object_type);
c_expr.expr &:= ");\n\n";
destr_prototype_declared @:= [object_type] TRUE;
end if;
end func;
const proc: process_destr_declaration (in type: object_type,
inout expr_type: c_expr) is func
begin
if object_type not in destr_declared then
if object_type in typeCategory then
case typeCategory[object_type] of
when {ARRAYOBJECT}:
if object_type in array_element then
process_arr_destr_declaration(object_type, c_expr);
else
declare_destr_prototype(object_type, c_expr);
end if;
when {STRUCTOBJECT}:
process_sct_destr_declaration(object_type, c_expr);
when {HASHOBJECT}:
if object_type in parametersOfHshDestr then
process_hsh_destr_declaration(object_type, c_expr);
else
declare_destr_prototype(object_type, c_expr);
end if;
when {INTERFACEOBJECT}:
process_itf_destr_prototype(object_type, c_expr);
otherwise:
destr_declared @:= [object_type] TRUE;
end case;
else
declare_destr_prototype(object_type, c_expr);
end if;
end if;
end func;
const proc: declare_missing_destr_declarations (inout expr_type: c_expr) is func
local
var type: object_type is void;
begin
for key object_type range destr_prototype_declared do
process_destr_declaration(object_type, c_expr);
end for;
for key object_type range destr_prototype_declared do
if object_type in typeCategory and typeCategory[object_type] = INTERFACEOBJECT then
process_itf_destr_declaration(object_type, c_expr);
end if;
end for;
end func;
const set of category: destrNecessary is {
BIGINTOBJECT, STRIOBJECT, BSTRIOBJECT, FILEOBJECT, SETOBJECT,
REFLISTOBJECT, WINOBJECT, POINTLISTOBJECT, PROCESSOBJECT, PROGOBJECT,
DATABASEOBJECT, SQLSTMTOBJECT, ARRAYOBJECT, HASHOBJECT, STRUCTOBJECT};
const proc: process_destr_call (in type: object_type,
in string: param_b, inout string: expr) is func
begin
if object_type in typeCategory then
case typeCategory[object_type] of
when simpleValueType: noop;
when {BIGINTOBJECT}: expr &:= "bigDestr(" & param_b & ");\n";
when {STRIOBJECT}: expr &:= "strDestr(" & param_b & ");\n";
when {BSTRIOBJECT}: expr &:= "bstDestr(" & param_b & ");\n";
when {FILEOBJECT}: expr &:= "filDestr(" & param_b & ");\n";
when {SETOBJECT}: expr &:= "setDestr(" & param_b & ");\n";
when {POLLOBJECT}: expr &:= "polDestr(" & param_b & ");\n";
when {REFLISTOBJECT}: expr &:= "rflDestr(" & param_b & ");\n";
when {WINOBJECT}: expr &:= "drwDestr(" & param_b & ");\n";
when {POINTLISTOBJECT}: expr &:= "bstDestr(" & param_b & ");\n";
when {PROCESSOBJECT}: expr &:= "pcsDestr(" & param_b & ");\n";
when {PROGOBJECT}: expr &:= "prgDestr(" & param_b & ");\n";
when {DATABASEOBJECT}: expr &:= "sqlDestrDb(" & param_b & ");\n";
when {SQLSTMTOBJECT}: expr &:= "sqlDestrStmt(" & param_b & ");\n";
when {ARRAYOBJECT, HASHOBJECT, STRUCTOBJECT, INTERFACEOBJECT}:
expr &:= "destr_";
expr &:= str(typeNumber(object_type));
expr &:= "(";
expr &:= param_b;
expr &:= ");\n";
end case;
else
expr &:= "destr_";
expr &:= str(typeNumber(object_type));
expr &:= "((";
expr &:= type_name(object_type);
expr &:= ")(";
expr &:= param_b;
expr &:= "));\n";
end if;
end func;