cell_t *invoke(cell_t *fun, cell_t *args, environ_t *env) { int argslen, paramlen; environ_t *new_env; function_t *func = fun->slot2.fun; cell_t *ret; cell_t *code; handle_t *hc; argslen = proper_list_length(args,0); paramlen = proper_list_length(func->param_list, 0); if (argslen != paramlen) return NULL; /* error */ create_empty_environment(&new_env); extend(func->lexical_env, new_env, func->param_list, args); code = func->code; hc = handle_push(code); while (NULL != code && !NILP(code)) { ret = evaluate(CAR(code), new_env); // code handled code = handle_get(hc); code = CDR(code); handle_set(hc, code); } handle_pop(hc); return ret; }
static DBusHandlerResult message_cb(DBusConnection *conn, DBusMessage *msg, void *user_data) { pa_dbusobj_server_lookup *sl = user_data; pa_assert(conn); pa_assert(msg); pa_assert(sl); /* pa_log("Got message! type = %s path = %s iface = %s member = %s dest = %s", dbus_message_type_to_string(dbus_message_get_type(msg)), dbus_message_get_path(msg), dbus_message_get_interface(msg), dbus_message_get_member(msg), dbus_message_get_destination(msg)); */ if (dbus_message_get_type(msg) != DBUS_MESSAGE_TYPE_METHOD_CALL) return DBUS_HANDLER_RESULT_NOT_YET_HANDLED; if (dbus_message_is_method_call(msg, DBUS_INTERFACE_INTROSPECTABLE, "Introspect") || (!dbus_message_get_interface(msg) && dbus_message_has_member(msg, "Introspect"))) return handle_introspect(conn, msg, sl); if (dbus_message_is_method_call(msg, DBUS_INTERFACE_PROPERTIES, "Get") || (!dbus_message_get_interface(msg) && dbus_message_has_member(msg, "Get"))) return handle_get(conn, msg, sl); if (dbus_message_is_method_call(msg, DBUS_INTERFACE_PROPERTIES, "Set") || (!dbus_message_get_interface(msg) && dbus_message_has_member(msg, "Set"))) return handle_set(conn, msg, sl); if (dbus_message_is_method_call(msg, DBUS_INTERFACE_PROPERTIES, "GetAll") || (!dbus_message_get_interface(msg) && dbus_message_has_member(msg, "GetAll"))) return handle_get_all(conn, msg, sl); return DBUS_HANDLER_RESULT_NOT_YET_HANDLED; }
cell_t *evargs(cell_t *args, environ_t *env) { #define MAX_LISP_ARGS 16 handle_t *harray[MAX_LISP_ARGS]; int length; int i; cell_t *tmp, *head = nil_cell, *tail = nil_cell; handle_t *hhandle, *thandle; if ((length = proper_list_length(args, 0)) < 0) return NULL; /* error */ if (length > MAX_LISP_ARGS) return NULL; /* can only handle 16 args atm */ for (i = 0; i < length; i++, args = CDR(args)) { harray[i] = handle_push(CAR(args)); } for (i = 0; i < length; i++) { cell_t *t = handle_get(harray[i]); handle_set(harray[i], evaluate(t, env)); // everything handled } hhandle = handle_push(head); thandle = handle_push(tail); for (i = length - 1; i >= 0; i--) { tmp = new(cell_t); // head and tail protected by handles head = handle_get(hhandle); tail = handle_get(thandle); tail = head; head = handle_get(harray[i]); CONS(tmp, head, tail); head = tmp; handle_set(hhandle, head); handle_set(thandle, tail); } handle_pop(thandle); handle_pop(hhandle); for (i = length - 1; i >= 0; i--) { handle_pop(harray[i]); } return head; }
virtual status visit(const set &node) { return handle_set(node); }
void server_main (void) { static char status; static int zignal; char ch; int i = 0; unsigned int len; CORE_ADDR mem_addr; zignal = valgrind_wait (&status); if (VG_MINIMAL_SETJMP(toplevel)) { dlog(0, "error caused VG_MINIMAL_LONGJMP to server_main\n"); } while (1) { unsigned char sig; int packet_len; int new_packet_len = -1; if (resume_reply_packet_needed) { /* Send the resume reply to reply to last GDB resume request. */ resume_reply_packet_needed = False; prepare_resume_reply (own_buf, status, zignal); putpkt (own_buf); } /* If we our status is terminal (exit or fatal signal) get out as quickly as we can. We won't be able to handle any request anymore. */ if (status == 'W' || status == 'X') { return; } packet_len = getpkt (own_buf); if (packet_len <= 0) break; i = 0; ch = own_buf[i++]; switch (ch) { case 'Q': handle_set (own_buf, &new_packet_len); break; case 'q': handle_query (own_buf, &new_packet_len); break; case 'd': /* set/unset debugging is done through valgrind debug level. */ own_buf[0] = '\0'; break; case 'D': reset_valgrind_sink("gdb detaching from process"); /* When detaching or kill the process, gdb expects to get an packet OK back. Any other output will make gdb believes detach did not work. */ write_ok (own_buf); putpkt (own_buf); remote_finish (reset_after_error); remote_open (VG_(clo_vgdb_prefix)); myresume (0, 0); resume_reply_packet_needed = False; return; case '!': /* We can not use the extended protocol with valgrind, because we can not restart the running program. So return unrecognized. */ own_buf[0] = '\0'; break; case '?': prepare_resume_reply (own_buf, status, zignal); break; case 'H': if (own_buf[1] == 'c' || own_buf[1] == 'g' || own_buf[1] == 's') { unsigned long gdb_id, thread_id; gdb_id = strtoul (&own_buf[2], NULL, 16); thread_id = gdb_id_to_thread_id (gdb_id); if (thread_id == 0) { write_enn (own_buf); break; } if (own_buf[1] == 'g') { general_thread = thread_id; set_desired_inferior (1); } else if (own_buf[1] == 'c') { cont_thread = thread_id; } else if (own_buf[1] == 's') { step_thread = thread_id; } write_ok (own_buf); } else { /* Silently ignore it so that gdb can extend the protocol without compatibility headaches. */ own_buf[0] = '\0'; } break; case 'g': set_desired_inferior (1); registers_to_string (own_buf); break; case 'G': set_desired_inferior (1); registers_from_string (&own_buf[1]); write_ok (own_buf); break; case 'P': { int regno; char *regbytes; Bool mod; ThreadState *tst; regno = strtol(&own_buf[1], NULL, 16); regbytes = strchr(&own_buf[0], '=') + 1; set_desired_inferior (1); tst = (ThreadState *) inferior_target_data (current_inferior); /* Only accept changing registers in "runnable state3. In fact, it would be ok to change most of the registers except a few "sensitive" registers such as the PC, SP, BP. We assume we do not need to very specific here, and that we can just refuse all of these. */ if (tst->status == VgTs_Runnable || tst->status == VgTs_Yielding) { supply_register_from_string (regno, regbytes, &mod); write_ok (own_buf); } else { /* at least from gdb 6.6 onwards, an E. error reply is shown to the user. So, we do an error msg which both is accepted by gdb as an error msg and is readable by the user. */ VG_(sprintf) (own_buf, "E.\n" "ERROR changing register %s regno %d\n" "gdb commands changing registers (pc, sp, ...) (e.g. 'jump',\n" "set pc, calling from gdb a function in the debugged process, ...)\n" "can only be accepted if the thread is VgTs_Runnable or VgTs_Yielding state\n" "Thread status is %s\n", find_register_by_number (regno)->name, regno, VG_(name_of_ThreadStatus)(tst->status)); if (VG_(clo_verbosity) > 1) VG_(umsg) ("%s\n", own_buf); } break; } case 'm': decode_m_packet (&own_buf[1], &mem_addr, &len); if (valgrind_read_memory (mem_addr, mem_buf, len) == 0) convert_int_to_ascii (mem_buf, own_buf, len); else write_enn (own_buf); break; case 'M': decode_M_packet (&own_buf[1], &mem_addr, &len, mem_buf); if (valgrind_write_memory (mem_addr, mem_buf, len) == 0) write_ok (own_buf); else write_enn (own_buf); break; case 'X': if (decode_X_packet (&own_buf[1], packet_len - 1, &mem_addr, &len, mem_buf) < 0 || valgrind_write_memory (mem_addr, mem_buf, len) != 0) write_enn (own_buf); else write_ok (own_buf); break; case 'C': convert_ascii_to_int (own_buf + 1, &sig, 1); if (target_signal_to_host_p (sig)) zignal = target_signal_to_host (sig); else zignal = 0; set_desired_inferior (0); myresume (0, zignal); return; // return control to valgrind case 'S': convert_ascii_to_int (own_buf + 1, &sig, 1); if (target_signal_to_host_p (sig)) zignal = target_signal_to_host (sig); else zignal = 0; set_desired_inferior (0); myresume (1, zignal); return; // return control to valgrind case 'c': set_desired_inferior (0); myresume (0, 0); return; // return control to valgrind case 's': set_desired_inferior (0); myresume (1, 0); return; // return control to valgrind case 'Z': { char *lenptr; char *dataptr; CORE_ADDR addr = strtoul (&own_buf[3], &lenptr, 16); int zlen = strtol (lenptr + 1, &dataptr, 16); char type = own_buf[1]; if (type < '0' || type > '4') { /* Watchpoint command type unrecognized. */ own_buf[0] = '\0'; } else { int res; res = valgrind_insert_watchpoint (type, addr, zlen); if (res == 0) write_ok (own_buf); else if (res == 1) /* Unsupported. */ own_buf[0] = '\0'; else write_enn (own_buf); } break; } case 'z': { char *lenptr; char *dataptr; CORE_ADDR addr = strtoul (&own_buf[3], &lenptr, 16); int zlen = strtol (lenptr + 1, &dataptr, 16); char type = own_buf[1]; if (type < '0' || type > '4') { /* Watchpoint command type unrecognized. */ own_buf[0] = '\0'; } else { int res; res = valgrind_remove_watchpoint (type, addr, zlen); if (res == 0) write_ok (own_buf); else if (res == 1) /* Unsupported. */ own_buf[0] = '\0'; else write_enn (own_buf); } break; } case 'k': kill_request("Gdb request to kill this process\n"); break; case 'T': { unsigned long gdb_id, thread_id; gdb_id = strtoul (&own_buf[1], NULL, 16); thread_id = gdb_id_to_thread_id (gdb_id); if (thread_id == 0) { write_enn (own_buf); break; } if (valgrind_thread_alive (thread_id)) write_ok (own_buf); else write_enn (own_buf); break; } case 'R': /* Restarting the inferior is only supported in the extended protocol. => It is a request we don't understand. Respond with an empty packet so that gdb knows that we don't support this request. */ own_buf[0] = '\0'; break; case 'v': /* Extended (long) request. */ handle_v_requests (own_buf, &status, &zignal); break; default: /* It is a request we don't understand. Respond with an empty packet so that gdb knows that we don't support this request. */ own_buf[0] = '\0'; break; } if (new_packet_len != -1) putpkt_binary (own_buf, new_packet_len); else putpkt (own_buf); if (status == 'W') VG_(umsg) ("\nChild exited with status %d\n", zignal); if (status == 'X') VG_(umsg) ("\nChild terminated with signal = 0x%x (%s)\n", target_signal_to_host (zignal), target_signal_to_name (zignal)); if (status == 'W' || status == 'X') { VG_(umsg) ("Process exiting\n"); VG_(exit) (0); } } /* We come here when getpkt fails => close the connection, and re-open. Then return control to valgrind. We return the control to valgrind as we assume that the connection was closed due to vgdb having finished to execute a command. */ if (VG_(clo_verbosity) > 1) VG_(umsg) ("Remote side has terminated connection. " "GDBserver will reopen the connection.\n"); remote_finish (reset_after_error); remote_open (VG_(clo_vgdb_prefix)); myresume (0, 0); resume_reply_packet_needed = False; return; }