From 620d7ef6b19e41faef5f92f98c1fa4e298d681fe Mon Sep 17 00:00:00 2001
From: Omar Rizwan <omar@omar.website>
Date: Sun, 5 Feb 2023 19:48:43 -0500
Subject: c-statements: More handle cleanup. Animal test works

Main bug was setting up rtype with ckalloc instead of Tcl_NewObj,
which resulted in weird refcount reuse behavior.
---
 lib/c.tcl             |  4 ++--
 play/c-statements.tcl | 11 +++++++----
 2 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/lib/c.tcl b/lib/c.tcl
index 27b7a2cb..39e2fdd3 100644
--- a/lib/c.tcl
+++ b/lib/c.tcl
@@ -254,7 +254,7 @@ namespace eval c {
 
                 variable rtypes
                 rtype $type {
-                    $robj = ckalloc(sizeof(struct Tcl_Obj));
+                    $robj = Tcl_NewObj();
                     $robj->bytes = NULL;
                     $robj->typePtr = &$[set rtype]_ObjType;
                     $robj->internalRep.otherValuePtr = ckalloc(sizeof($[set rtype]));
@@ -363,7 +363,7 @@ namespace eval c {
                 # puts "=====================\n$sourcecode\n====================="
 
                 set cfd [file tempfile cfile cfile.c]; puts $cfd $sourcecode; close $cfd
-                exec cc -Wall -g -shared -fsanitize=address -fPIC {*}$cflags $cfile -o [file rootname $cfile][info sharedlibextension]
+                exec cc -Wall -g -shared -fPIC {*}$cflags $cfile -o [file rootname $cfile][info sharedlibextension]
                 load [file rootname $cfile][info sharedlibextension] cfile
             }
             ::proc import {scc sname as dest} {
diff --git a/play/c-statements.tcl b/play/c-statements.tcl
index 27cd5e1b..d4b27bb3 100644
--- a/play/c-statements.tcl
+++ b/play/c-statements.tcl
@@ -85,12 +85,12 @@ namespace eval statement {
     proc clause {stmt} { dict get $stmt clause }
     proc parentMatchIds {stmt} {
         concat {*}[lmap edge [dict get $stmt edges] {expr {
-            [dict get $edge type] == 1 ? [list [dict get $edge match idx] true] : [continue]
+            [dict get $edge type] == 1 ? [list [dict get $edge match] true] : [continue]
         }}]
     }
     proc childMatchIds {stmt} {
         concat {*}[lmap edge [dict get $stmt edges] {expr {
-            [dict get $edge type] == 2 ? [list [dict get $edge match idx] true] : [continue]
+            [dict get $edge type] == 2 ? [list [dict get $edge match] true] : [continue]
         }}]
     }
     namespace ensemble create
@@ -170,7 +170,7 @@ namespace eval Statements { ;# singleton Statement store
         return matchId;
     }
     proc addMatch {parentMatchIds} {
-        addMatchImpl [llength $parentMatchIds] [lmap id $parentMatchIds {list idx $id}]
+        addMatchImpl [llength $parentMatchIds] $parentMatchIds
     }
 
     $cc proc addImpl {Tcl_Interp* interp
@@ -265,7 +265,7 @@ namespace eval Statements { ;# singleton Statement store
             int id; Tcl_GetIntFromObj(interp, ids[i], &id);
             Tcl_Obj* match = unifyImpl(interp, pattern, statements[id].clause);
             if (match != NULL) {
-                Tcl_DictObjPut(interp, match, Tcl_ObjPrintf("__matcheeId"), Tcl_NewIntObj(id));
+                Tcl_DictObjPut(interp, match, Tcl_ObjPrintf("__matcheeId"), Tcl_ObjPrintf("idx %d", id));
                 matches[matchcount++] = match;
             }
         }
@@ -327,6 +327,7 @@ namespace eval Statements { ;# singleton Statement store
     proc dot {} {
         set dot [list]
         dict for {id stmt} [all] {
+            set id [dict get $id idx]
             puts [statement short $stmt]
 
             lappend dot "subgraph cluster_$id {"
@@ -340,6 +341,7 @@ namespace eval Statements { ;# singleton Statement store
             lappend dot "s$id \[label=\"s$id: $label\"\];"
 
             dict for {matchId _} [statement parentMatchIds $stmt] {
+                set matchId [dict get $matchId idx]
                 set parents [lmap edge [dict get [matchDeref [matchGet [list idx $matchId]]] edges] {expr {
                     [dict get $edge type] == 1 ? "s[dict get $edge statement idx]" : [continue]
                 }}]
@@ -350,6 +352,7 @@ namespace eval Statements { ;# singleton Statement store
             lappend dot "}"
 
             dict for {childId _} [statement childMatchIds $stmt] {
+                set childId [dict get $childId idx]
                 lappend dot "s$id -> m$childId;"
             }
         }
-- 
cgit v1.2.3