// File: /workspace/github_c_makefile_star2_O3/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 0x3fb26
movq 0x8(%rax), %rcx
cmpb $0x1c, (%rcx)
je 0x3fb2a
cmpq 0x150(%rbx), %rcx
je 0x3fb2a
cmpq 0x110(%rbx), %rcx
je 0x3fb2a
movq 0x14a0(%rbx), %rax
movq 0x8(%rax), %rsi
movq 0x106e5b(%rip), %rdx    # 0x146960
movq 0x140(%rbx), %r8
movq 0x10b02d(%rip), %r9     # 0x14ab40
movq %rbx, %rdi
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
jmp 0xa4e4
movq 0x8(%rbx), %rcx
movzbl (%r14), %eax
decl %eax
cmpl $0x32, %eax
ja 0x3fd21
leaq 0xc7a28(%rip), %rdx     # 0x107568
movslq (%rdx,%rax,4), %rax
addq %rdx, %rax
jmpq *%rax
movq 0x20(%r14), %rax
cmpb $0x27, (%rax)
ja 0x3fd86
movq (%r14), %r15
btl $0x12, %r15d
jb 0x3fd6e
movq 0x16d0(%rbx), %rdx
movq %rbx, %rdi
movq %r14, %rsi
callq 0x3e86d
testq %rax, %rax
je 0x3fd3d
cmpq 0x120(%rbx), %rax
je 0x3fd3d
cmpb $0x27, (%rax)
jbe 0x3fdad
movq %rax, 0x20(%r14)
jmp 0x3fd86
movq 0x8(%r14), %rax
movq 0x30(%rax), %rax
jmp 0x3fd86
testb $0x4, 0x2(%r14)
je 0x3fd6e
movq 0x28(%r14), %rax
jmp 0x3fd86
movq 0xf70(%rbx), %rax
jmp 0x3fd7e
movq 0x8(%r14), %rax
movzbl (%rax), %ecx
leaq 0x113007(%rip), %rdx    # 0x152be0
cmpb $0x1, (%rcx,%rdx)
jne 0x3fd6e
movq 0x20(%rax), %rax
jmp 0x3fd86
movq 0x1550(%rbx), %rax
jmp 0x3fd7e
testb $0x40, 0x3(%r14)
je 0x3fd49
cmpb $0x1, 0x24c(%rbx)
jne 0x3fd49
movq %rbx, %rdi
movq %r14, %rsi
callq 0x8a63
movq 0x14a0(%rbx), %rdx
movq %rbx, %rdi
movq %rax, %rsi
callq 0x89ff
cmpq 0x128(%rbx), %rax
je 0x3fd49
movq %rax, %r12
movq %rbx, %rdi
movq %r15, %rsi
callq 0x42f69
movq %rbx, %rdi
movq %r12, %rsi
jmp 0x3fca6
testb $0x40, 0x3(%r14)
je 0x3fd77
cmpb $0x1, 0x24c(%rbx)
jne 0x3fd77
movq %rbx, %rdi
movq %r14, %rsi
callq 0x8a63
movq 0x14a0(%rbx), %rdx
movq %rbx, %rdi
movq %rax, %rsi
callq 0x89ff
cmpq 0x128(%rbx), %rax
je 0x3fd77
movq %rax, %r14
movq %rbx, %rdi
movq %r15, %rsi
callq 0x42f69
movq %rbx, %rdi
movq %r14, %rsi
movq %rax, %rdx
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
jmp 0xaee6
movq 0x1260(%rbx), %rax
jmp 0x3fd7e
testb $-0x80, 0x6(%r14)
jne 0x3fda1
cmpq 0x150(%rbx), %rcx
je 0x3fd92
cmpq 0x110(%rbx), %rcx
je 0x3fd92
movq 0x8(%rbx), %r15
movq %rcx, 0x8(%rbx)
movq %rcx, %rdi
movq %r14, %rsi
callq 0xbe33
movq %r15, 0x8(%rbx)
jmp 0x3fd96
movq 0x1668(%rbx), %rax
jmp 0x3fd7e
movq 0xfb0(%rbx), %rax
jmp 0x3fd7e
movq 0xc38(%rbx), %rax
jmp 0x3fd7e
leaq 0xd75c4(%rip), %rsi     # 0x1172ec
leaq 0xd7595(%rip), %r8      # 0x1172c4
jmp 0x3fdbb
movq 0xef8(%rbx), %rax
jmp 0x3fd7e
orq $0x40000, %r15          # imm = 0x40000
movq %r15, (%r14)
jmp 0x3fd6e
movq 0x8d8(%rbx), %rax
movq 0x8(%r14), %rcx
movq (%rax,%rcx,8), %rax
leaq -0xd50(%rip), %rcx      # 0x3f00f
cmpq %rcx, 0x50(%rax)
je 0x3fd6e
movq 0x1ed0(%rbx), %rax
jmp 0x3fd86
movq 0x120(%rbx), %rax
jmp 0x3fd86
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 0x3fda1
testb $0x4, 0x2(%rax)
jne 0x3fdd3
addq $0x120, %rbx            # imm = 0x120
movq (%rbx), %rax
jmp 0x3fd86
leaq 0xd7538(%rip), %rsi     # 0x1172ec
leaq 0xd74db(%rip), %r8      # 0x117296
movq %rbx, %rdi
xorl %edx, %edx
movq %r14, %rcx
addq $0x8, %rsp
popq %rbx
popq %r12
popq %r14
popq %r15
jmp 0xd4e5
addq $0x28, %rax
movq %rax, %rbx
jmp 0x3fda8