Difficulties with C FFI & writing a concurrent stack

[Vanessa McHale]

Hi all,

I am trying to write a concurrent stack. Code is below:

%{
#include <stdatomic.h>
#include <stdlib.h>

struct stack_t {
    void *value;
    struct stack_t *next;
};

void __cats_new(struct stack_t *st) {
    st->value = NULL;
    st->next = NULL;
}

void __cats_push(struct stack_t *st, void *val) {
    for (;;) {
        struct stack_t old_st = *st;
        struct stack_t new_st = {val, &old_st};
        if (atomic_compare_exchange_strong(st, &old_st, new_st))
            return;
    }
}

// ignore ABA problem
void *__cats_pop(struct stack_t *st) {
    for (;;) {
        if (st->next == NULL)
            return NULL;
        struct stack_t *old_st = st;
        struct stack_t xs1 = *(st->next);
        void *x = st->value;
        if (atomic_compare_exchange_strong(st, old_st, xs1))
            return x;
    }
}

atstype_boxed pop_ats(atstype_ref st) { return __cats_pop(st); }

atsvoid_t0ype new_ats(atstype_ref st) { __cats_new(st); }

atsvoid_t0ype push_ats(atstype_ref st, atstype_var val) {
    __cats_push(st, val);
}
%}

typedef stack_t(a: t@ype+) = $extype "struct stack_t"

extern
fun new {a:t@ype+}(&stack_t(a)? >> _) : void =
  "ext#new_ats"

extern
fun push {a:t@ype+}(&stack_t(a) >> _, a) : void =
  "ext#push_ats"

extern
fun pop {a:t@ype+}(&stack_t(a) >> _) : Option(a) =
  "ext#pop_ats"

fn print_str(x : string) : void =
  println!(x)

implement main0 (argc, argv) =
  let
    var st: stack_t(string)
    val () = new(st)
    val () = push(st, "res")
    val () = push(st, "res2")
    val- Some (x) = pop(st)
    val () = print_str(x)
  in end

(This compiles with gcc; I can run it with patscc simple.dats -latomic ;
./a.out)

Unfortunately, it immediately segfaults. I know that the offending line
is the

val () = print_str(x)

because removing it makes the program run fine.

I tried writing an equivalent program in C, viz.

#include <stdio.h>

int main(int argc, char *argv[]) {

    struct stack_t *st;

    __cats_push(st, "res");
    __cats_push(st, "res2");

    char *res;

    res = __cats_pop(st);
    printf("%s\n", res);

    res = __cats_pop(st);
    printf("%s\n", res);
}

...which works as expected. So I believe I am misunderstanding how ATS
handles FFI and how structures exist in memory. 

Any insight is appreciated!

Thanks,
Vanessa

[gmhwxi]

Each occurrence of {a:t@ype+} should be changed to {a:type}. E.g.,

extern
fun pop {a:t@ype+}(&stack_t(a) >> _) : Option(a) =
  "ext#pop_ats"

should be changed to

extern
fun pop {a:type}(&stack_t(a) >> _) : Option(a) = "ext#pop_ats"

[Vanessa McHale]

Thanks for the response!

Unfortunately I still get trouble, viz.

...

atstype_boxed pop_ats(atstype_ref st) { return __cats_pop(st); }

atsvoid_t0ype new_ats(atstype_ref st) { __cats_new(st); }

atsvoid_t0ype push_ats(atstype_ref st, atstype_boxed val) {
    __cats_push(st, val);
}
%}

typedef stack_t(a: type) = $extype "struct stack_t"

extern
fun new {a:type}(&stack_t(a)? >> _) : void =
  "ext#new_ats"

extern
fun push {a:type}(&stack_t(a) >> _, a) : void =
  "ext#push_ats"

extern

fun pop {a:type}(&stack_t(a) >> _) : Option(a) =
  "ext#pop_ats"

fn print_str(x : string) : void =
  println!(x)

...

leads to a segfault as before.

Cheers,
Vanessa

[Hongwei Xi]

Took a closer look.

'atstype_var' should be changed to 'atstype_boxed'.

The real problem is due to 'pop' being given an incorrect type.

I tried the following type to make the code work:

  extern
  fun pop {a:type}(&stack_t(a) >> _) : (a) = "ext#pop_ats"

To mix C with ATS can be difficult. In particular, there is not much

documentation to help.

If you want Option(a) as the return type of 'pop', 'return x' in __cats_pop

needs to be changed to 'return __cats_some(x)' where '__cats_some' can

be implemented as follows:

extern
fun
none{a:type}(): Option(a) = "__cats_none"
extern
fun
some{a:type}(x:a): Option(a) = "__cats_some"

implement none() = None()
implement some(x) = Some(x)

Frankly speaking, without documentation, I don't feel that ATS2 is ready

for you to do what you wanted here.

--
You received this message because you are subscribed to the Google Groups "ats-lang-users" group.
To unsubscribe from this group and stop receiving emails from it, send an email to ats-lang-user...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/ats-lang-users/2b564e10-e652-47d9-a6b5-61b3b27499d0%40googlegroups.com.

[Vanessa McHale]

Oh, you're right! I can get the demo working now :)

Thanks again,
Vanessa

To unsubscribe from this group and stop receiving emails from it, send an email to ats-lan...@googlegroups.com.