Hi Bil,
I stumbled upon a case where s7 is segfaulting.
See the attached files.
g++ -o main ./main.cpp s7.o -ldl -I.
./main 1000 # ok
./main 10000 # seg fault
Thanks,
Christos
#include <stdlib.h>
#include <vector>
#include <stdio.h>
#include "s7.h"
#include <cassert>
struct Node {
int gc_loc;
s7_scheme* sc;
s7_pointer data;
~Node() {
s7_gc_unprotect_at(sc, gc_loc);
}
};
typedef std::vector<Node *> Vec;
int g_type;
#define HELP_make_vec "(make-vec)"
s7_pointer scm_make_vec(s7_scheme* sc, s7_pointer args) {
Vec* vec = new Vec;
return s7_make_c_object(sc, g_type, vec);
}
void bind_make_vec(s7_scheme* sc, s7_pointer env) {
s7_define(sc, env, s7_make_symbol(sc, "make-vec"),
s7_make_function(sc, "make-vec",
scm_make_vec,
0, 0, false, // req, opt, rest?
HELP_make_vec)
);
}
#define HELP_push_bang "(push! vec item)"
s7_pointer scm_push_bang(s7_scheme* sc, s7_pointer args) {
Vec* vec = (Vec*)s7_c_object_value(s7_car(args));
s7_pointer item = s7_cadr(args);
Node* node = new Node;
node->sc = sc;
node->gc_loc = s7_gc_protect(sc, item);
node->data = item;
vec->push_back(node);
return s7_nil(sc);
}
void bind_push_bang(s7_scheme* sc, s7_pointer env) {
s7_define(sc, env, s7_make_symbol(sc, "push!"),
s7_make_function(sc, "push!",
scm_push_bang,
2, 0, false, // req, opt, rest?
HELP_push_bang)
);
}
s7_pointer free_vec(s7_scheme* sc, s7_pointer obj) {
Vec* vec = (Vec*)s7_c_object_value(obj);
printf("vec dtor..\n");
int count = 0;
for(Node* node : *vec) {
count++;
// printf("deleting node\n");
delete node;
}
delete vec;
printf(" deleted %d items\n", count);
return s7_nil(sc);
}
int main(int argc, char** argv) {
printf("hi there\n");
s7_scheme* sc = s7_init();
assert(argc == 2);
int count = atoi(argv[1]);
s7_define_variable(sc, "c/count", s7_make_integer(sc, count));
g_type = s7_make_c_type(sc, "<vec>");
s7_c_type_set_gc_free(sc, g_type, free_vec);
bind_make_vec(sc, s7_nil(sc));
bind_push_bang(sc, s7_nil(sc));
s7_load(sc, "main.scm");
s7_free(sc);
return 0;
}
(define range
(let ((+documentation+ "(range n (start 0) (step 1)) returns a list counting from start for n:\n\
(iota 3) -> '(0 1 2)"))
(lambda* (n (start 0) (step 1))
(if (or (not (integer? n))
(< n 0))
(error 'wrong-type-arg "iota length ~A should be a non-negative integer" n))
(let ((lst (make-list n)))
(do ((p lst (cdr p))
(i start (+ i step)))
((null? p) lst)
(set! (car p) i))))))
(define vec (make-vec))
(for-each (lambda (i)
(push! vec (inlet :i i)))
(range c/count))
_______________________________________________
Cmdist mailing list
[email protected]
https://cm-mail.stanford.edu/mailman/listinfo/cmdist
