aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--backend/Clean System Files/backend_library4
-rw-r--r--backendC/CleanCompilerSources/backend.c334
-rw-r--r--backendC/CleanCompilerSources/backend.h19
-rw-r--r--backendC/backend.link4
4 files changed, 345 insertions, 16 deletions
diff --git a/backend/Clean System Files/backend_library b/backend/Clean System Files/backend_library
index acb9521..6f8e0c7 100644
--- a/backend/Clean System Files/backend_library
+++ b/backend/Clean System Files/backend_library
@@ -31,8 +31,12 @@ BEMatchNode
BETupleSelectNode
BEIfNode
BEGuardNode
+BESetNodeDefRefCounts
+BEAddNodeIdsRefCounts
BESwitchNode
BECaseNode
+BEEnterLocalScope
+BELeaveLocalScope
BEPushNode
BEDefaultNode
BESelectorNode
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index 74d36a0..d830ccc 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -27,6 +27,10 @@
# include <limits.h>
+# if 1
+# include "dbprint.h"
+# endif
+
void
BEGetVersion (int *current, int *oldestDefinition, int *oldestImplementation)
{
@@ -1369,6 +1373,181 @@ BEGuardNode (BENodeP cond, BENodeDefP thenNodeDefs, BEStrictNodeIdP thenStricts,
return (node);
} /* BEGuardNode */
+static NodeIdRefCountListP
+NewRefCount (NodeIdRefCountListP next, NodeIdP nodeId, int ref_count)
+{
+ NodeIdRefCountListP newRefCount;
+
+ newRefCount = ConvertAllocType (NodeIdRefCountListS);
+
+ newRefCount->nrcl_next = next;
+ newRefCount->nrcl_node_id = nodeId;
+ newRefCount->nrcl_ref_count = ref_count;
+
+ return (newRefCount);
+} /* NewRefCount */
+
+/* +++ dynamic allocation */
+# define kMaxScope 1000
+static int gCurrentScope = 0;
+static NodeIdRefCountListP gRefCountLists [kMaxScope];
+static NodeIdRefCountListP gRefCountList;
+
+# define nid_ref_count_sign nid_scope
+
+
+static void
+AddRefCount (NodeIdP nodeId)
+{
+ gRefCountList = NewRefCount (gRefCountList, nodeId, 0);
+} /* AddRefCount */
+
+void
+BESetNodeDefRefCounts (BENodeP lhs)
+{
+ ArgP arg;
+
+ gRefCountList = NULL;
+
+ Assert (lhs->node_kind == NormalNode);
+
+ for (arg = lhs->node_arguments; arg != NULL; arg = arg->arg_next)
+ {
+ NodeP node;
+ NodeIdP nodeId;
+
+ node = arg->arg_node;
+
+ Assert (node->node_kind == NodeIdNode);
+ Assert (node->node_arguments == NULL);
+
+ nodeId = node->node_node_id;
+
+ nodeId->nid_mark |= NID_ALIAS_MARK_MASK;
+ AddRefCount (nodeId);
+ }
+} /* BESetNodeDefRefCounts */
+
+void
+BEAddNodeIdsRefCounts (int sequenceNumber, BESymbolP symbol, BENodeIdListP nodeIds)
+{
+ NodeIdP nodeId;
+
+ nodeId = gCurrentNodeIds [sequenceNumber];
+
+ Assert (nodeId != NULL);
+ if (nodeId->nid_mark & NID_ALIAS_MASK)
+ {
+ nodeId = nodeId->nid_forward_node_id;
+ Assert (nodeId != NULL);
+ }
+
+ Assert (nodeId != NULL);
+
+ if ((nodeId->nid_mark & NID_ALIAS_MARK_MASK)
+ &&
+ (symbol->symb_kind == tuple_symb
+ || (symbol->symb_kind == definition && symbol->symb_def->sdef_kind == RECORDTYPE)))
+ {
+ NodeP node;
+ ArgP arg, args;
+ NodeIdListElement nodeIdList;
+
+ node = nodeId->nid_node;
+
+ if (node == NULL)
+ {
+ NodeIdP nid;
+
+ nodeIdList = nodeIds;
+
+ nid = nodeIdList->nidl_node_id;
+
+ nid->nid_mark |= NID_ALIAS_MARK_MASK;
+
+ args = BEArgs (BENodeIdNode (nid, NULL), NULL);;
+
+ for (nodeIdList = nodeIdList->nidl_next, arg = args;
+ nodeIdList != NULL;
+ nodeIdList = nodeIdList->nidl_next, arg = arg->arg_next)
+ {
+ nid = nodeIdList->nidl_node_id;
+
+ nid->nid_mark |= NID_ALIAS_MARK_MASK;
+ arg->arg_next = BEArgs (BENodeIdNode (nid, NULL), NULL);
+ }
+
+ nodeId->nid_node = BENormalNode (symbol, args);
+ }
+ else
+ {
+ Assert (node->node_symbol == symbol);
+
+ arg = node->node_arguments;
+ for (nodeIdList = nodeIds; nodeIdList != NULL && arg != NULL;
+ nodeIdList = nodeIdList->nidl_next, arg = arg->arg_next)
+ {
+ Assert (arg->arg_node->node_kind == NodeIdNode);
+
+ nodeId = nodeIdList->nidl_node_id;
+
+ nodeId->nid_mark |= NID_ALIAS_MASK;
+ nodeId->nid_forward_node_id = arg->arg_node->node_node_id;
+ nodeIdList->nidl_node_id = nodeId->nid_forward_node_id;
+ }
+
+ Assert (nodeIdList == NULL && arg == NULL);
+ }
+ }
+
+ for (; nodeIds; nodeIds=nodeIds->nidl_next)
+ {
+ NodeIdP nodeId;
+
+ nodeId = nodeIds->nidl_node_id;
+
+ Assert (nodeId != NULL);
+ if (nodeId->nid_mark & NID_ALIAS_MASK)
+ {
+ nodeId = nodeId->nid_forward_node_id;
+ Assert (nodeId != NULL);
+ }
+
+ Assert (nodeId != NULL);
+ AddRefCount (nodeId);
+ Assert (nodeId->nid_ref_count_sign == -1);
+ }
+} /* BEAddNodeIdsRefCounts */
+
+static NodeIdRefCountListP
+CopyRefCountList (NodeIdRefCountListP refCount)
+{
+ NodeIdRefCountListP first, copy;
+
+ first = NULL;
+ copy = NULL;
+ for (; refCount != NULL; refCount = refCount->nrcl_next)
+ {
+ NodeIdP nodeId;
+ NodeIdRefCountListP new;
+
+ nodeId = refCount->nrcl_node_id;
+
+ Assert (nodeId->nid_ref_count_sign == -1);
+
+ new = NewRefCount (NULL, nodeId, refCount->nrcl_ref_count);
+
+ if (copy == NULL)
+ first = new;
+ else
+ copy->nrcl_next = new;
+
+ copy = new;
+ }
+
+ return (first);
+} /* CopyRefCountList */
+
BENodeP
BESwitchNode (BENodeIdP nodeId, BEArgP cases)
{
@@ -1381,17 +1560,68 @@ BESwitchNode (BENodeIdP nodeId, BEArgP cases)
switchNode->node_arity = 1;
switchNode->node_arguments = cases;
switchNode->node_annotation = NoAnnot;
+
+ Assert (nodeId->nid_ref_count_sign == -1);
return (switchNode);
} /* BESwitchNode */
+void
+BEEnterLocalScope (void)
+{
+ NodeIdRefCountListP refCount;
+
+ gRefCountList = CopyRefCountList (gRefCountList);
+
+ for (refCount = gRefCountList; refCount != NULL; refCount = refCount->nrcl_next)
+ {
+ NodeIdP nodeId;
+
+ nodeId = refCount->nrcl_node_id;
+
+ Assert (nodeId->nid_ref_count_sign == -1);
+
+ refCount->nrcl_ref_count = nodeId->nid_refcount;
+ nodeId->nid_refcount = -1;
+ }
+
+ Assert (gCurrentScope < kMaxScope);
+ gRefCountLists [gCurrentScope++] = gRefCountList;
+} /* BEEnterLocalScope */
+
+void
+BELeaveLocalScope (BENodeP node)
+{
+ NodeIdRefCountListP refCount;
+
+ Assert (gCurrentScope > 0);
+ gRefCountList = gRefCountLists [--gCurrentScope];
+
+ for (refCount = gRefCountList; refCount != NULL; refCount = refCount->nrcl_next)
+ {
+ NodeIdP nodeId;
+ int count;
+
+ nodeId = refCount->nrcl_node_id;
+
+ Assert (nodeId->nid_ref_count_sign == -1);
+
+ count = refCount->nrcl_ref_count;
+ refCount->nrcl_ref_count = nodeId->nid_refcount;
+ nodeId->nid_refcount += count + 1;
+ }
+
+ Assert (node->node_kind == CaseNode || node->node_kind == DefaultNode);
+ node->node_node_id_ref_counts = gRefCountList;
+} /* BELeaveLocalScope */
+
BENodeP
BECaseNode (int symbolArity, BESymbolP symbol, BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node)
{
NodeP caseNode;
caseNode = ConvertAllocType (NodeS);
-
+
caseNode->node_kind = CaseNode;
caseNode->node_symbol = symbol;
caseNode->node_arity = symbolArity;
@@ -1417,9 +1647,8 @@ BEDefaultNode (BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node)
defaultNode->node_arity = 1;
defaultNode->node_arguments = NewArgument (node);
- defaultNode->node_su.su_u.u_case = ConvertAllocType (CaseNodeContentsS);
+ defaultNode->node_su.su_u.u_case = ConvertAllocType (CaseNodeContentsS);
defaultNode->node_strict_node_ids = strictNodeIds;
-
defaultNode->node_node_id_ref_counts = NULL;
return (defaultNode);
@@ -1429,7 +1658,7 @@ BENodeP
BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds)
{
NodeP pushNode;
-
+
pushNode = ConvertAllocType (NodeS);
pushNode->node_kind = PushNode;
@@ -1438,7 +1667,22 @@ BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds
pushNode->node_record_symbol= symbol;
pushNode->node_node_ids = nodeIds;
pushNode->node_number = 0;
+/*
+ for (; nodeIds; nodeIds=nodeIds->nidl_next)
+ {
+ NodeIdP nodeId;
+
+ nodeId = nodeIds->nidl_node_id;
+
+ Assert (nodeId->nid_ref_count_sign == -1);
+ nodeId->nid_refcount++;
+ }
+*/
+ Assert (arguments->arg_node->node_kind == NodeIdNode);
+ Assert (arguments->arg_node->node_node_id->nid_ref_count_sign == -1);
+ arguments->arg_node->node_node_id->nid_refcount++;
+
return (pushNode);
} /* BEPushNode */
@@ -1521,9 +1765,6 @@ BEArgs (BENodeP node, BEArgP nextArgs)
return (arg);
} /* BEArgs */
-
-# define nid_ref_count_sign nid_scope
-
void
BEDeclareNodeId (int sequenceNumber, int lhsOrRhs, CleanString name)
{
@@ -1557,12 +1798,10 @@ BEDeclareNodeId (int sequenceNumber, int lhsOrRhs, CleanString name)
newNodeId->nid_node = NULL;
newNodeId->nid_state.state_kind = 0;
newNodeId->nid_mark = 0;
- newNodeId->nid_mark2 = 0;
+ newNodeId->nid_mark2 = 0;
newNodeId->nid_ref_count_sign = lhsOrRhs==BELhsNodeId ? -1 : 1;
newNodeId->nid_refcount = 0;
-/* RWS test ... */
newNodeId->nid_ref_count_copy = 0;
-/* ... test */
gCurrentNodeIds [sequenceNumber] = newNodeId;
} /* BEDeclareNodeId */
@@ -1589,6 +1828,14 @@ BENodeId (int sequenceNumber)
Assert (nodeId != NULL);
+ if (nodeId->nid_mark & NID_ALIAS_MASK)
+ {
+ nodeId = nodeId->nid_forward_node_id;
+ Assert (nodeId != NULL);
+ }
+
+ Assert (nodeId != NULL);
+
nodeId->nid_refcount += nodeId->nid_ref_count_sign;
return (nodeId);
@@ -1609,8 +1856,8 @@ BEWildCardNodeId (void)
newNodeId->nid_node = NULL;
newNodeId->nid_state.state_kind = 0;
newNodeId->nid_mark = 0;
- newNodeId->nid_mark2 = 0;
- newNodeId->nid_ref_count_sign = 0;
+ newNodeId->nid_mark2 = 0;
+ newNodeId->nid_ref_count_sign = -1;
newNodeId->nid_refcount = -1;
return (newNodeId);
@@ -1704,6 +1951,65 @@ BENoStrictNodeIds (void)
return (NULL);
} /* BENoStrictNodeIds */
+static NodeDefP
+CollectNodeNodeDefs (NodeP node, NodeDefP defs)
+{
+ switch (node->node_kind)
+ {
+ case NormalNode:
+ {
+ ArgP arg;
+
+ for (arg = node->node_arguments; arg != NULL; arg = arg->arg_next)
+ defs = CollectNodeNodeDefs (arg->arg_node, defs);
+ }
+ break;
+ case NodeIdNode:
+ {
+ NodeIdP nodeId;
+
+ nodeId = node->node_node_id;
+ if (nodeId->nid_node != NULL && !(nodeId->nid_mark & NID_VERIFY_MASK))
+ {
+ NodeDefP nodeDef;
+
+ nodeId->nid_mark |= NID_VERIFY_MASK;
+
+ nodeDef = ConvertAllocType (NodeDefS);
+
+ nodeDef->def_id = nodeId;
+ nodeDef->def_node = nodeId->nid_node;
+ nodeDef->def_next = defs;
+
+ nodeId->nid_node_def = nodeDef;
+
+ defs = CollectNodeNodeDefs (nodeId->nid_node, nodeDef);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+
+ return (defs);
+} /* CollectNodeNodeDefs */
+
+static NodeDefP
+CollectNodeDefs (NodeP node, NodeDefP defs)
+{
+ NodeDefP def;
+
+ for (def = defs; def != NULL; def = def->def_next)
+ def->def_id->nid_mark |= NID_VERIFY_MASK;
+
+ defs = CollectNodeNodeDefs (node, defs);
+
+ for (def = defs; def != NULL; def = def->def_next)
+ def->def_id->nid_mark &= ~NID_VERIFY_MASK;
+
+ return (defs);
+} /* CollectNodeDefs */
+
BERuleAltP
BERuleAlt (int line, BENodeDefP lhsDefs, BENodeP lhs, BENodeDefP rhsDefs, BEStrictNodeIdP rhsStrictNodeIds, BENodeP rhs)
{
@@ -1712,7 +2018,7 @@ BERuleAlt (int line, BENodeDefP lhsDefs, BENodeP lhs, BENodeDefP rhsDefs, BEStri
alt = ConvertAllocType (RuleAltS);
alt->alt_lhs_root = lhs;
- alt->alt_lhs_defs = lhsDefs;
+ alt->alt_lhs_defs = CollectNodeDefs (lhs, lhsDefs);
alt->alt_rhs_root = rhs;
alt->alt_rhs_defs = rhsDefs;
alt->alt_line = line;
@@ -1737,7 +2043,7 @@ BECodeAlt (int line, BENodeDefP lhsDefs, BENodeP lhs, BECodeBlockP codeBlock)
alt = ConvertAllocType (RuleAltS);
alt->alt_lhs_root = lhs;
- alt->alt_lhs_defs = lhsDefs;
+ alt->alt_lhs_defs = CollectNodeDefs (lhs, lhsDefs);
alt->alt_rhs_code = codeBlock;
alt->alt_rhs_defs = NULL;
alt->alt_line = line;
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index 70d9e2a..0411868 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -1,7 +1,7 @@
/* version info */
// increment this for every release
-# define kBEVersionCurrent 0x02000207
+# define kBEVersionCurrent 0x02000208
// change this to the same value as kBEVersionCurrent if the new release is not
// upward compatible (for example when a function is added)
@@ -9,7 +9,7 @@
// change this to the same value as kBEVersionCurrent if the new release is not
// downward compatible (for example when a function is removed)
-# define kBEVersionOldestImplementation 0x02000206
+# define kBEVersionOldestImplementation 0x02000208
# define kBEDebug 1
@@ -86,6 +86,9 @@ Clean (:: BEStringListP :== CPtr)
typedef struct node_id_list_element *BENodeIdListP;
Clean (:: BENodeIdListP :== CPtr)
+typedef struct node_id_ref_count_list *BENodeIdRefCountListP;
+Clean (:: BENodeIdRefCountListP :== CPtr)
+
/* constants */
/*
# define kIclModuleIndex 0
@@ -259,12 +262,24 @@ Clean (BEIfNode :: BENodeP BENodeP BENodeP BackEnd -> (BENodeP, BackEnd))
BENodeP BEGuardNode (BENodeP cond, BENodeDefP thenNodeDefs, BEStrictNodeIdP thenStricts, BENodeP then, BENodeDefP elseNodeDefs, BEStrictNodeIdP elseStricts, BENodeP elsje);
Clean (BEGuardNode :: BENodeP BENodeDefP BEStrictNodeIdP BENodeP BENodeDefP BEStrictNodeIdP BENodeP BackEnd -> (BENodeP, BackEnd))
+void BESetNodeDefRefCounts (BENodeP lhs);
+Clean (BESetNodeDefRefCounts :: BENodeP BackEnd -> BackEnd)
+
+void BEAddNodeIdsRefCounts (int sequenceNumber, BESymbolP symbol, BENodeIdListP nodeIds);
+Clean (BEAddNodeIdsRefCounts :: Int BESymbolP BENodeIdListP BackEnd -> BackEnd)
+
BENodeP BESwitchNode (BENodeIdP nodeId, BEArgP caseNode);
Clean (BESwitchNode :: BENodeIdP BEArgP BackEnd -> (BENodeP, BackEnd))
BENodeP BECaseNode (int symbolArity, BESymbolP symbol, BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node);
Clean (BECaseNode :: Int BESymbolP BENodeDefP BEStrictNodeIdP BENodeP BackEnd -> (BENodeP, BackEnd))
+void BEEnterLocalScope (void);
+Clean (BEEnterLocalScope :: BackEnd -> BackEnd)
+
+void BELeaveLocalScope (BENodeP node);
+Clean (BELeaveLocalScope :: BENodeP BackEnd -> BackEnd)
+
BENodeP BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds);
Clean (BEPushNode :: Int BESymbolP BEArgP BENodeIdListP BackEnd -> (BENodeP, BackEnd))
diff --git a/backendC/backend.link b/backendC/backend.link
index 566768a..36e0664 100644
--- a/backendC/backend.link
+++ b/backendC/backend.link
@@ -30,8 +30,12 @@
/EXPORT: BETupleSelectNode
/EXPORT: BEIfNode
/EXPORT: BEGuardNode
+/EXPORT: BESetNodeDefRefCounts
+/EXPORT: BEAddNodeIdsRefCounts
/EXPORT: BESwitchNode
/EXPORT: BECaseNode
+/EXPORT: BEEnterLocalScope
+/EXPORT: BELeaveLocalScope
/EXPORT: BEPushNode
/EXPORT: BEDefaultNode
/EXPORT: BESelectorNode
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-07 14:08:12 +0000