aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp10
-rw-r--r--model.cpp4
-rw-r--r--model.h3
-rw-r--r--parser.cpp4
-rw-r--r--types.cpp13
-rw-r--r--types.h2
6 files changed, 32 insertions, 4 deletions
diff --git a/builtin.cpp b/builtin.cpp
index 6eb0c0f..b983167 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -954,7 +954,10 @@ BUILTIN_PROC_DEF(pair_set_car) {
ARGS_EXACTLY_TWO;
if (!args->car->is_pair_obj())
throw TokenError("pair", RUN_ERR_WRONG_TYPE);
- TO_PAIR(args->car)->car = TO_PAIR(args->cdr)->car;
+ Pair *p = TO_PAIR(args->car);
+ gc.expose(p->car);
+ p->car = TO_PAIR(args->cdr)->car;
+ gc.attach(p->car);
return unspec_obj;
}
@@ -962,7 +965,10 @@ BUILTIN_PROC_DEF(pair_set_cdr) {
ARGS_EXACTLY_TWO;
if (!args->car->is_pair_obj())
throw TokenError("pair", RUN_ERR_WRONG_TYPE);
- TO_PAIR(args->car)->cdr = TO_PAIR(args->cdr)->car;
+ Pair *p = TO_PAIR(args->car);
+ gc.expose(p->cdr);
+ p->cdr = TO_PAIR(args->cdr)->car;
+ gc.attach(p->cdr);
return unspec_obj;
}
diff --git a/model.cpp b/model.cpp
index cb3d5c6..416c583 100644
--- a/model.cpp
+++ b/model.cpp
@@ -27,6 +27,10 @@ bool FrameObj::is_parse_bracket() {
EvalObj::EvalObj(int _otype) : FrameObj(CLS_EVAL_OBJ), otype(_otype) {}
+bool EvalObj::is_container() {
+ return otype & CLS_CONTAINER;
+}
+
void EvalObj::prepare(Pair *pc) {}
bool EvalObj::is_simple_obj() {
diff --git a/model.h b/model.h
index 1ace1c9..9ccdf20 100644
--- a/model.h
+++ b/model.h
@@ -92,6 +92,7 @@ class EvalObj : public FrameObj {
bool is_prom_obj();
/** Check if the object is a vector */
bool is_vect_obj();
+ bool is_container();
int get_otype();
virtual void prepare(Pair *pc);
/** Any EvalObj has its external representation */
@@ -106,6 +107,8 @@ class Container: public EvalObj {
public:
size_t gc_refs;
Container(int otype);
+ virtual void gc_decrement() = 0;
+ virtual void gc_trigger(EvalObj ** &tail) = 0;
};
/** @class RetAddr
diff --git a/parser.cpp b/parser.cpp
index c53ec14..a8577d3 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -190,7 +190,9 @@ Pair *ASTGenerator::absorb(Tokenizor *tk) {
TO_PAIR(lst)->cdr != empty_list)
throw NormalError(PAR_ERR_IMPROPER_PAIR);
improper = true;
- lst = TO_PAIR(lst)->car;
+ Pair *_lst = TO_PAIR(lst);
+ lst = _lst->car;
+ delete _lst;
}
else
{
diff --git a/types.cpp b/types.cpp
index 7988c59..edeeb99 100644
--- a/types.cpp
+++ b/types.cpp
@@ -27,11 +27,22 @@ Pair::~Pair() {
gc.expose(cdr);
}
+void Pair::gc_decrement() {
+ if (car->is_container())
+ static_cast<Container*>(car)->gc_refs--;
+ if (cdr->is_container())
+ static_cast<Container*>(cdr)->gc_refs--;
+}
+
+void Pair::gc_trigger(EvalObj ** &tail) {
+ *tail++ = car;
+ *tail++ = cdr;
+}
+
ReprCons *Pair::get_repr_cons() {
return new PairReprCons(this, this);
}
-
ParseBracket::ParseBracket(unsigned char _btype) :
FrameObj(CLS_SIM_OBJ | CLS_PAR_BRA), btype(_btype) {}
diff --git a/types.h b/types.h
index 93dac66..f76a0cc 100644
--- a/types.h
+++ b/types.h
@@ -53,6 +53,8 @@ class Pair : public Container {/*{{{*/
Pair(EvalObj *car, EvalObj *cdr); /**< Create a Pair (car . cdr) */
~Pair();
ReprCons *get_repr_cons();
+ void gc_decrement();
+ void gc_trigger(EvalObj ** &tail);
};/*}}}*/
/** @class EmptyList