// File: /workspace/github_c_makefile_star2_O2/BernardTatin[P]s7sh/s7.c
// Function: g_setter
static s7_pointer g_setter(s7_scheme *sc, s7_pointer args)
                {
#define H_setter "(setter obj env) returns the setter associated with obj"
#define Q_setter s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->not_symbol, sc->is_procedure_symbol), sc->T, sc->is_let_symbol)
                    s7_pointer p, e;

                    p = car(args);
                    if (is_pair(cdr(args)))
                    {
                        e = cadr(args);
                        if (!((is_let(e)) || (e == sc->rootlet) || (e == sc->nil)))
                            return(wrong_type_argument(sc, sc->setter_symbol, 2, e, T_LET));
                    }
                    else e = sc->envir;

                    switch (type(p))
                    {
                        case T_MACRO:   case T_MACRO_STAR:
                        case T_BACRO:   case T_BACRO_STAR:
                        case T_CLOSURE: case T_CLOSURE_STAR:
                            if (is_any_procedure(closure_setter(p)))                /* setter already known */
                                return(closure_setter(p));
                            if (!closure_no_setter(p))
                            {
                                s7_pointer f;
                                f = funclet_entry(sc, p, sc->local_setter_symbol); /* look for +setter+, save value as closure_setter(p) */
                                if (f)
                                {
                                    if (f == sc->F)
                                    {
                                        closure_set_no_setter(p);
                                        return(sc->F);
                                    }
                                    if (!is_any_procedure(f))
                                        return(s7_wrong_type_arg_error(sc, "setter", 0, p, "a procedure or a reasonable facsimile thereof"));
                                    closure_set_setter(p, f);
                                    return(f);
                                }
                                /* we used to search for setter here, but that can find the built-in setter causing an infinite loop (maybe check for that??) */
                                closure_set_no_setter(p);
                            }
                            return(sc->F);

                        case T_C_FUNCTION:
                        case T_C_FUNCTION_STAR:
                        case T_C_ANY_ARGS_FUNCTION:
                        case T_C_OPT_ARGS_FUNCTION:
                        case T_C_RST_ARGS_FUNCTION:
                            return(c_function_setter(p));

                        case T_C_MACRO:
                            return(c_macro_setter(p));

                        case T_GOTO:
                        case T_CONTINUATION:
                            return(sc->F);

                        case T_C_OBJECT:
                            check_method(sc, p, sc->setter_symbol, args);
                            if  (c_object_set(sc, p) != fallback_set)
                                return(sc->c_object_set_function);      /* for example ((setter obj) obj 0 1.0) if s7test block */
                            /* this could wrap the setter as an s7_function giving p's class-name etc */
                            return(sc->F);

                        case T_LET:
                            check_method(sc, p, sc->setter_symbol, args);
                            return(slot_value(global_slot(sc->let_set_symbol)));

                        case T_ITERATOR:
                            if (is_any_closure(iterator_sequence(p)))
                                return(closure_setter(iterator_sequence(p)));
                            return(sc->F);                            /* (set! (iter) val) doesn't fit the other setters */

                        case T_PAIR:
                            return(slot_value(global_slot(sc->list_set_symbol)));

                        case T_HASH_TABLE:
                            return(slot_value(global_slot(sc->hash_table_set_symbol)));

                        case T_STRING:
                            return(slot_value(global_slot(sc->string_set_symbol)));

                        case T_BYTE_VECTOR:
                            return(slot_value(global_slot(sc->byte_vector_set_symbol)));

                        case T_VECTOR:
                            return(slot_value(global_slot(sc->vector_set_symbol)));

                        case T_INT_VECTOR:
                            return(slot_value(global_slot(sc->int_vector_set_symbol)));

                        case T_FLOAT_VECTOR:
                            return(slot_value(global_slot(sc->float_vector_set_symbol)));

                        case T_SLOT:
                            if (slot_has_setter(p))
                                return(slot_setter(p));
                            return(sc->F);

                        case T_SYMBOL:                             /* (setter symbol env) */
                            {
                                s7_pointer sym, slot;
                                sym = car(args);
                                if (is_keyword(sym))
                                    return(sc->F);

                                if ((e == sc->rootlet) || (e == sc->nil))
                                    slot = global_slot(sym);
                                else
                                {
                                    s7_pointer old_e;
                                    old_e = sc->envir;
                                    sc->envir = e;
                                    slot = symbol_to_slot(sc, sym);
                                    sc->envir = old_e;
                                }
                                if (!is_slot(slot))
                                    return(sc->F);

                                if (slot_has_setter(slot))
                                    return(slot_setter(slot));
                                return(sc->F);
                            }
                    }
                    return(s7_wrong_type_arg_error(sc, "setter", 0, p, "something that might have a setter"));
                }

// Assembly:
pushq %r15
pushq %r14
pushq %r12
pushq %rbx
pushq %rax
movq %rsi, %r15
movq %rdi, %rbx
movq 0x8(%rsi), %r14
movq 0x10(%rsi), %rax
cmpb $0x1, (%rax)
jne 0x3262d
movq 0x8(%rax), %rcx
cmpb $0x1c, (%rcx)
je 0x32631
cmpq 0x150(%rbx), %rcx
je 0x32631
cmpq 0x110(%rbx), %rcx
je 0x32631
movq 0x14a0(%rbx), %rax
movq 0x8(%rax), %rsi
movq 0xe3354(%rip), %rdx     # 0x115960
movq 0x140(%rbx), %r8
movq 0xe7526(%rip), %r9      # 0x119b40
movq %rbx, %rdi
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
jmp 0x9bbb
movq 0x8(%rbx), %rcx
movzbl (%r14), %eax
decl %eax
cmpl $0x32, %eax
ja 0x32828
leaq 0xa0f41(%rip), %rdx     # 0xd3588
movslq (%rdx,%rax,4), %rax
addq %rdx, %rax
jmpq *%rax
movq 0x20(%r14), %rax
cmpb $0x27, (%rax)
ja 0x3288d
movq (%r14), %r15
btl $0x12, %r15d
jb 0x32875
movq 0x16d0(%rbx), %rdx
movq %rbx, %rdi
movq %r14, %rsi
callq 0x31541
testq %rax, %rax
je 0x32844
cmpq 0x120(%rbx), %rax
je 0x32844
cmpb $0x27, (%rax)
jbe 0x328b4
movq %rax, 0x20(%r14)
jmp 0x3288d
movq 0x8(%r14), %rax
movq 0x30(%rax), %rax
jmp 0x3288d
testb $0x4, 0x2(%r14)
je 0x32875
movq 0x28(%r14), %rax
jmp 0x3288d
movq 0xf70(%rbx), %rax
jmp 0x32885
movq 0x8(%r14), %rax
movzbl (%rax), %ecx
leaq 0xef500(%rip), %rdx     # 0x121be0
cmpb $0x1, (%rcx,%rdx)
jne 0x32875
movq 0x20(%rax), %rax
jmp 0x3288d
movq 0x1550(%rbx), %rax
jmp 0x32885
testb $0x40, 0x3(%r14)
je 0x32850
cmpb $0x1, 0x24c(%rbx)
jne 0x32850
movq %rbx, %rdi
movq %r14, %rsi
callq 0x88f3
movq 0x14a0(%rbx), %rdx
movq %rbx, %rdi
movq %rax, %rsi
callq 0x888f
cmpq 0x128(%rbx), %rax
je 0x32850
movq %rax, %r12
movq %rbx, %rdi
movq %r15, %rsi
callq 0x35492
movq %rbx, %rdi
movq %r12, %rsi
jmp 0x327ad
testb $0x40, 0x3(%r14)
je 0x3287e
cmpb $0x1, 0x24c(%rbx)
jne 0x3287e
movq %rbx, %rdi
movq %r14, %rsi
callq 0x88f3
movq 0x14a0(%rbx), %rdx
movq %rbx, %rdi
movq %rax, %rsi
callq 0x888f
cmpq 0x128(%rbx), %rax
je 0x3287e
movq %rax, %r14
movq %rbx, %rdi
movq %r15, %rsi
callq 0x35492
movq %rbx, %rdi
movq %r14, %rsi
movq %rax, %rdx
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
jmp 0xa34c
movq 0x1260(%rbx), %rax
jmp 0x32885
testb $-0x80, 0x6(%r14)
jne 0x328a8
cmpq 0x150(%rbx), %rcx
je 0x32899
cmpq 0x110(%rbx), %rcx
je 0x32899
movq 0x8(%rbx), %r15
movq %rcx, 0x8(%rbx)
movq %rbx, %rdi
movq %r14, %rsi
callq 0xb00b
movq %r15, 0x8(%rbx)
jmp 0x3289d
movq 0x1668(%rbx), %rax
jmp 0x32885
movq 0xfb0(%rbx), %rax
jmp 0x32885
movq 0xc38(%rbx), %rax
jmp 0x32885
leaq 0xb0a5d(%rip), %rsi     # 0xe328c
leaq 0xb0a2e(%rip), %r8      # 0xe3264
jmp 0x328c2
movq 0xef8(%rbx), %rax
jmp 0x32885
orq $0x40000, %r15          # imm = 0x40000
movq %r15, (%r14)
jmp 0x32875
movq 0x8d8(%rbx), %rax
movq 0x8(%r14), %rcx
movq (%rax,%rcx,8), %rax
leaq -0xc0d(%rip), %rcx      # 0x31c59
cmpq %rcx, 0x50(%rax)
je 0x32875
movq 0x1ed0(%rbx), %rax
jmp 0x3288d
movq 0x120(%rbx), %rax
jmp 0x3288d
movq 0x1240(%rbx), %rax
movq 0x10(%rax), %rax
movq 0x10(%rax), %rax
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
retq
movq 0x10(%r14), %rax
cmpb $0x20, (%rax)
jne 0x328a8
testb $0x4, 0x2(%rax)
jne 0x328da
addq $0x120, %rbx            # imm = 0x120
movq (%rbx), %rax
jmp 0x3288d
leaq 0xb09d1(%rip), %rsi     # 0xe328c
leaq 0xb0974(%rip), %r8      # 0xe3236
movq %rbx, %rdi
xorl %edx, %edx
movq %r14, %rcx
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
jmp 0xc2b0
addq $0x28, %rax
movq %rax, %rbx
jmp 0x328af