diff --git a/extlib/benz/vm.c b/extlib/benz/vm.c index 23b3f26e..5faa602b 100644 --- a/extlib/benz/vm.c +++ b/extlib/benz/vm.c @@ -26,12 +26,12 @@ pic_get_proc(pic_state *pic) * I int *, bool * int with exactness * f double * float * F double *, bool * float with exactness - * s pic_str ** string object + * c char * char * z char ** c string + * s pic_str ** string object * m pic_sym ** symbol * v pic_vec ** vector object * b pic_blob ** bytevector object - * c char * char * l struct pic_proc ** lambda object * p struct pic_port ** port object * d struct pic_dict ** dictionary object @@ -186,17 +186,17 @@ pic_get_args(pic_state *pic, const char *format, ...) } break; } - case 's': { - pic_str **str; + case 'c': { + char *k; pic_value v; - str = va_arg(ap, pic_str **); + k = va_arg(ap, char *); v = GET_OPERAND(pic,i); - if (pic_str_p(v)) { - *str = pic_str_ptr(v); + if (pic_char_p(v)) { + *k = pic_char(v); } else { - pic_errorf(pic, "pic_get_args: expected string, but got ~s", v); + pic_errorf(pic, "pic_get_args: expected char, but got ~s", v); } break; } @@ -214,132 +214,33 @@ pic_get_args(pic_state *pic, const char *format, ...) } break; } - case 'm': { - pic_sym **m; - pic_value v; - m = va_arg(ap, pic_sym **); - v = GET_OPERAND(pic,i); - if (pic_sym_p(v)) { - *m = pic_sym_ptr(v); +#define PTR_CASE(c, type, ctype) \ + case c: { \ + ctype *ptr; \ + pic_value v; \ + \ + ptr = va_arg(ap, ctype *); \ + v = GET_OPERAND(pic, i); \ + if (pic_## type ##_p(v)) { \ + *ptr = pic_## type ##_ptr(v); \ + } \ + else { \ + pic_errorf(pic, "pic_get_args: expected " #type ", but got ~s", v); \ + } \ + break; \ } - else { - pic_errorf(pic, "pic_get_args: expected symbol, but got ~s", v); - } - break; - } - case 'v': { - struct pic_vector **vec; - pic_value v; - vec = va_arg(ap, struct pic_vector **); - v = GET_OPERAND(pic,i); - if (pic_vec_p(v)) { - *vec = pic_vec_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args: expected vector, but got ~s", v); - } - break; - } - case 'b': { - struct pic_blob **b; - pic_value v; + PTR_CASE('s', str, pic_str *) + PTR_CASE('m', sym, pic_sym *) + PTR_CASE('v', vec, pic_vec *) + PTR_CASE('b', blob, pic_blob *) + PTR_CASE('l', proc, struct pic_proc *) + PTR_CASE('p', port, struct pic_port *) + PTR_CASE('d', dict, struct pic_dict *) + PTR_CASE('r', record, struct pic_record *) + PTR_CASE('e', error, struct pic_error *) - b = va_arg(ap, struct pic_blob **); - v = GET_OPERAND(pic,i); - if (pic_blob_p(v)) { - *b = pic_blob_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args: expected bytevector, but got ~s", v); - } - break; - } - case 'c': { - char *k; - pic_value v; - - k = va_arg(ap, char *); - v = GET_OPERAND(pic,i); - if (pic_char_p(v)) { - *k = pic_char(v); - } - else { - pic_errorf(pic, "pic_get_args: expected char, but got ~s", v); - } - break; - } - case 'l': { - struct pic_proc **l; - pic_value v; - - l = va_arg(ap, struct pic_proc **); - v = GET_OPERAND(pic,i); - if (pic_proc_p(v)) { - *l = pic_proc_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args, expected procedure, but got ~s", v); - } - break; - } - case 'p': { - struct pic_port **p; - pic_value v; - - p = va_arg(ap, struct pic_port **); - v = GET_OPERAND(pic,i); - if (pic_port_p(v)) { - *p = pic_port_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args, expected port, but got ~s", v); - } - break; - } - case 'd': { - struct pic_dict **d; - pic_value v; - - d = va_arg(ap, struct pic_dict **); - v = GET_OPERAND(pic,i); - if (pic_dict_p(v)) { - *d = pic_dict_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args, expected dictionary, but got ~s", v); - } - break; - } - case 'r': { - struct pic_record **r; - pic_value v; - - r = va_arg(ap, struct pic_record **); - v = GET_OPERAND(pic,i); - if (pic_record_p(v)) { - *r = pic_record_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args: expected record, but got ~s", v); - } - break; - } - case 'e': { - struct pic_error **e; - pic_value v; - - e = va_arg(ap, struct pic_error **); - v = GET_OPERAND(pic,i); - if (pic_error_p(v)) { - *e = pic_error_ptr(v); - } - else { - pic_errorf(pic, "pic_get_args, expected error"); - } - break; - } default: pic_errorf(pic, "pic_get_args: invalid argument specifier '%c' given", c); }