// File: /workspace/github_c_makefile_star2_O1/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 %rbp
pushq %r15
pushq %r14
pushq %r12
pushq %rbx
movq %rsi, %r15
movq %rdi, %rbx
movq 0x8(%rsi), %r14
movq 0x10(%rsi), %rax
cmpb $0x1, (%rax)
jne 0x42260
movq 0x8(%rax), %rcx
cmpb $0x1c, (%rcx)
je 0x42264
cmpq 0x150(%rbx), %rcx
je 0x42264
cmpq 0x110(%rbx), %rcx
je 0x42264
movq 0x14a0(%rbx), %rax
movq 0x8(%rax), %rsi
movq 0x10c71e(%rip), %rdx    # 0x14e960
movq 0x140(%rbx), %r8
movq 0x1108f0(%rip), %r9     # 0x152b40
movq %rbx, %rdi
popq %rbx
popq %r12
popq %r14
popq %r15
popq %rbp
jmp 0xb31d
movq 0x8(%rbx), %rcx
movzbl (%r14), %eax
decl %eax
cmpl $0x32, %eax
ja 0x42471
leaq 0xce33e(%rip), %rdx     # 0x1105b8
movslq (%rdx,%rax,4), %rax
addq %rdx, %rax
jmpq *%rax
movq 0x20(%r14), %rax
cmpb $0x27, (%rax)
ja 0x42542
movq (%r14), %r12
btl $0x12, %r12d
jb 0x4253b
movq 0x16d0(%rbx), %rdx
movq %rbx, %rdi
movq %r14, %rsi
callq 0x40e7b
movq %rax, %r15
testq %rax, %rax
je 0x424e1
cmpq 0x120(%rbx), %r15
je 0x424ed
cmpb $0x27, (%r15)
jbe 0x4251b
movq %r15, 0x20(%r14)
movq %r15, %rax
jmp 0x42536
movq 0x8(%r14), %rax
movq 0x30(%rax), %rax
jmp 0x42542
testb $0x4, 0x2(%r14)
je 0x4253b
movq 0x28(%r14), %rax
jmp 0x42542
movq 0xf70(%rbx), %rax
jmp 0x424d7
movq 0x8(%r14), %rax
movzbl (%rax), %ecx
leaq 0x1188c6(%rip), %rdx    # 0x15abe0
cmpb $0x1, (%rcx,%rdx)
jne 0x4253b
movq 0x20(%rax), %rax
jmp 0x42542
movq 0x1550(%rbx), %rax
jmp 0x424d7
movb $0x1, %bpl
testb $0x40, 0x3(%r14)
je 0x4249d
cmpb $0x1, 0x24c(%rbx)
jne 0x4249d
movq %rbx, %rdi
movq %r14, %rsi
callq 0x9a55
movq 0x14a0(%rbx), %rdx
movq %rbx, %rdi
movq %rax, %rsi
callq 0x99ef
cmpq 0x128(%rbx), %rax
je 0x4249d
movq %rax, %r12
movq %rbx, %rdi
movq %r15, %rsi
callq 0x45a8d
movq %rbx, %rdi
movq %r12, %rsi
movq %rax, %rdx
callq 0xbd41
xorl %ebp, %ebp
jmp 0x4249d
movb $0x1, %bpl
testb $0x40, 0x3(%r14)
je 0x424cb
cmpb $0x1, 0x24c(%rbx)
jne 0x424cb
movq %rbx, %rdi
movq %r14, %rsi
callq 0x9a55
movq 0x14a0(%rbx), %rdx
movq %rbx, %rdi
movq %rax, %rsi
callq 0x99ef
cmpq 0x128(%rbx), %rax
je 0x424cb
movq %rax, %r14
movq %rbx, %rdi
movq %r15, %rsi
callq 0x45a8d
movq %rbx, %rdi
movq %r14, %rsi
movq %rax, %rdx
callq 0xbd41
xorl %ebp, %ebp
jmp 0x424cb
movq 0x1260(%rbx), %rax
jmp 0x424d7
testb $-0x80, 0x6(%r14)
jne 0x4250f
cmpq 0x150(%rbx), %rcx
je 0x42500
cmpq 0x110(%rbx), %rcx
je 0x42500
movq 0x8(%rbx), %r15
movq %rcx, 0x8(%rbx)
movq %rbx, %rdi
movq %r14, %rsi
callq 0xccb2
movq %r15, 0x8(%rbx)
jmp 0x42504
movq 0x1668(%rbx), %rax
jmp 0x424d7
movq 0xfb0(%rbx), %rax
jmp 0x424d7
movq 0xc38(%rbx), %rax
jmp 0x424d7
leaq 0xddd64(%rip), %rsi     # 0x1201dc
leaq 0xddd35(%rip), %r8      # 0x1201b4
movq %rbx, %rdi
xorl %edx, %edx
movq %r14, %rcx
popq %rbx
popq %r12
popq %r14
popq %r15
popq %rbp
jmp 0xe25f
movq 0xef8(%rbx), %rax
jmp 0x424d7
testb %bpl, %bpl
je 0x42542
movq 0x8d8(%rbx), %rax
movq 0x8(%r14), %rcx
movq (%rax,%rcx,8), %rax
leaq -0xdf6(%rip), %rcx      # 0x416c6
cmpq %rcx, 0x50(%rax)
je 0x4253b
movq 0x1ed0(%rbx), %rax
jmp 0x42542
testb %bpl, %bpl
je 0x42542
movq 0x1240(%rbx), %rax
movq 0x10(%rax), %rax
movq 0x10(%rax), %rax
jmp 0x42542
orq $0x40000, %r12          # imm = 0x40000
movq %r12, (%r14)
jmp 0x42536
orq $0x40000, %r12          # imm = 0x40000
movq %r12, (%r14)
movq 0x120(%rbx), %rax
jmp 0x42536
movq 0x10(%r14), %rax
cmpb $0x20, (%rax)
jne 0x4250f
testb $0x4, 0x2(%rax)
jne 0x4254b
addq $0x120, %rbx            # imm = 0x120
movq (%rbx), %rax
jmp 0x42542
leaq 0xddcba(%rip), %rsi     # 0x1201dc
leaq 0xddc5d(%rip), %r8      # 0x120186
movq %rbx, %rdi
xorl %edx, %edx
movq %r14, %rcx
callq 0xe25f
testq %r15, %r15
jne 0x42542
movq 0x120(%rbx), %rax
popq %rbx
popq %r12
popq %r14
popq %r15
popq %rbp
retq
addq $0x28, %rax
movq %rax, %rbx
jmp 0x42516