static AVFrame *allocate_output_video_frame(SCM scm_self, AVCodecContext *video_context)
{
AVFrame *retval = allocate_frame(scm_self);
int width = video_context->width;
int height = video_context->height;
retval->format = PIX_FMT;
retval->width = width;
retval->height = height;
#ifdef HAVE_AV_FRAME_GET_BUFFER
int err = av_frame_get_buffer(retval, 32);
if (err < 0) {
ffmpeg_destroy(scm_self);
scm_misc_error("allocate-output-frame", "Error allocating frame buffer: ~a",
scm_list_1(get_error_text(err)));
};
#else
int size = avpicture_get_size(PIX_FMT, width, height);
uint8_t *frame_buffer = (uint8_t *)av_malloc(size);
if (!frame_buffer) {
ffmpeg_destroy(scm_self);
scm_misc_error("allocate-output-video-frame", "Error allocating video frame memory", SCM_EOL);
};
avpicture_fill((AVPicture *)retval, frame_buffer, PIX_FMT, width, height);
#endif
return retval;
}
SCM tf_graph_import_(SCM scm_graph, SCM scm_file_name)
{
struct tf_graph_t *graph = get_tf_graph(scm_graph);
char *file_name = scm_to_locale_string(scm_file_name);
FILE *file = fopen(file_name, "r");
free(file_name);
if (!file)
scm_misc_error("tf-graph-import_", strerror(errno), SCM_EOL);
int fd = fileno(file);
struct stat st;
fstat(fd, &st);
size_t size = st.st_size;
TF_Buffer *buffer = TF_NewBuffer();
void *data = scm_gc_malloc(size, "tf-graph-import_");
fread(data, size, 1, file);
buffer->data = data;
buffer->length = size;
fclose(file);
TF_ImportGraphDefOptions* opts = TF_NewImportGraphDefOptions();
TF_GraphImportGraphDef(graph->graph, buffer, opts, status());
TF_DeleteImportGraphDefOptions(opts);
TF_DeleteBuffer(buffer);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-graph-import_", TF_Message(_status), SCM_EOL);
return SCM_UNDEFINED;
}
static AVFrame *allocate_output_audio_frame(SCM scm_self, AVCodecContext *audio_codec, enum AVSampleFormat sample_fmt)
{
AVFrame *retval = allocate_frame(scm_self);
retval->format = sample_fmt;
retval->channel_layout = audio_codec->channel_layout;
retval->sample_rate = audio_codec->sample_rate;
if (audio_codec->codec->capabilities & AV_CODEC_CAP_VARIABLE_FRAME_SIZE)
retval->nb_samples = 2 * AV_INPUT_BUFFER_MIN_SIZE;
else
retval->nb_samples = audio_codec->frame_size;
#ifdef HAVE_AV_FRAME_GET_BUFFER
int err = av_frame_get_buffer(retval, 0);
if (err < 0) {
ffmpeg_destroy(scm_self);
scm_misc_error("allocate-output-audio-frame", "Error allocating audio frame memory", SCM_EOL);
};
#else
int channels = av_get_channel_layout_nb_channels(retval->channel_layout);
int err = av_samples_alloc(retval->data, &retval->linesize[0], channels, retval->nb_samples, retval->format, 0);
// TODO: need av_freep?
if (err < 0) {
ffmpeg_destroy(scm_self);
scm_misc_error("allocate-output-audio-frame", "Could not allocate audio buffer", SCM_EOL);
};
#endif
return retval;
}
static char*
map_file_contents (int fd, size_t len, int *is_read_only)
#define FUNC_NAME "load-thunk-from-file"
{
char *data;
#ifdef HAVE_SYS_MMAN_H
data = mmap (NULL, len, PROT_READ, MAP_PRIVATE, fd, 0);
if (data == MAP_FAILED)
SCM_SYSERROR;
*is_read_only = 1;
#else
if (lseek (fd, 0, SEEK_START) < 0)
{
int errno_save = errno;
(void) close (fd);
errno = errno_save;
SCM_SYSERROR;
}
/* Given that we are using the read fallback, optimistically assume
that the .go files were made with 8-byte alignment.
alignment. */
data = malloc (end);
if (!data)
{
(void) close (fd);
scm_misc_error (FUNC_NAME, "failed to allocate ~A bytes",
scm_list_1 (scm_from_size_t (end)));
}
if (full_read (fd, data, end) != end)
{
int errno_save = errno;
(void) close (fd);
errno = errno_save;
if (errno)
SCM_SYSERROR;
scm_misc_error (FUNC_NAME, "short read while loading objcode",
SCM_EOL);
}
/* If our optimism failed, fall back. */
{
unsigned alignment = sniff_elf_alignment (data, end);
if (alignment != 8)
{
char *copy = copy_and_align_elf_data (data, end, alignment);
free (data);
data = copy;
}
}
*is_read_only = 0;
#endif
return data;
}
static void
ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
size_t write_buf_size, const char *func_name)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
gdb_assert (read_buf_size >= min_memory_port_buf_size
&& read_buf_size <= max_memory_port_buf_size);
gdb_assert (write_buf_size >= min_memory_port_buf_size
&& write_buf_size <= max_memory_port_buf_size);
/* First check if the port is unbuffered. */
if (pt->read_buf == &pt->shortbuf)
{
gdb_assert (pt->write_buf == &pt->shortbuf);
scm_misc_error (func_name, _("port is unbuffered: ~a"),
scm_list_1 (port));
}
/* Next check if anything is buffered. */
if (read_buf_size != pt->read_buf_size
&& pt->read_end != pt->read_buf)
{
scm_misc_error (func_name, _("read buffer not empty: ~a"),
scm_list_1 (port));
}
if (write_buf_size != pt->write_buf_size
&& pt->write_pos != pt->write_buf)
{
scm_misc_error (func_name, _("write buffer not empty: ~a"),
scm_list_1 (port));
}
/* Now we can update the buffer sizes, but only if the size has changed. */
if (read_buf_size != pt->read_buf_size)
{
iomem->read_buf_size = read_buf_size;
pt->read_buf_size = read_buf_size;
xfree (pt->read_buf);
pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size);
pt->read_pos = pt->read_end = pt->read_buf;
}
if (write_buf_size != pt->write_buf_size)
{
iomem->write_buf_size = write_buf_size;
pt->write_buf_size = write_buf_size;
xfree (pt->write_buf);
pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size);
pt->write_pos = pt->write_buf;
pt->write_end = pt->write_buf + pt->write_buf_size;
}
}
static SCM
gdbscm_register_breakpoint_x (SCM self)
{
breakpoint_smob *bp_smob
= bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
volatile struct gdb_exception except;
/* We only support registering breakpoints created with make-breakpoint. */
if (!bp_smob->is_scheme_bkpt)
scm_misc_error (FUNC_NAME, _("not a Scheme breakpoint"), SCM_EOL);
if (bpscm_is_valid (bp_smob))
scm_misc_error (FUNC_NAME, _("breakpoint is already registered"), SCM_EOL);
pending_breakpoint_scm = self;
TRY_CATCH (except, RETURN_MASK_ALL)
{
char *location = bp_smob->spec.location;
int internal = bp_smob->spec.is_internal;
switch (bp_smob->spec.type)
{
case bp_breakpoint:
{
create_breakpoint (get_current_arch (),
location, NULL, -1, NULL,
0,
0, bp_breakpoint,
0,
AUTO_BOOLEAN_TRUE,
&bkpt_breakpoint_ops,
0, 1, internal, 0);
break;
}
case bp_watchpoint:
{
enum target_hw_bp_type access_type = bp_smob->spec.access_type;
if (access_type == hw_write)
watch_command_wrapper (location, 0, internal);
else if (access_type == hw_access)
awatch_command_wrapper (location, 0, internal);
else if (access_type == hw_read)
rwatch_command_wrapper (location, 0, internal);
else
gdb_assert_not_reached ("invalid access type");
break;
}
default:
gdb_assert_not_reached ("invalid breakpoint type");
}
}
SCM make_ffmpeg_input(SCM scm_file_name, SCM scm_debug)
{
SCM retval;
struct ffmpeg_t *self;
scm_dynwind_begin(0);
const char *file_name = scm_to_locale_string(scm_file_name);
scm_dynwind_free(file_name);
self = (struct ffmpeg_t *)scm_gc_calloc(sizeof(struct ffmpeg_t), "ffmpeg");
self->video_stream_idx = -1;
self->audio_stream_idx = -1;
SCM_NEWSMOB(retval, ffmpeg_tag, self);
int err;
err = avformat_open_input(&self->fmt_ctx, file_name, NULL, NULL);
if (err < 0) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-input", "Error opening file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err)));
};
err = avformat_find_stream_info(self->fmt_ctx, NULL);
if (err < 0) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-input", "No stream information in file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err)));
};
// TODO: only open desired streams
// Open video stream
self->video_stream_idx = av_find_best_stream(self->fmt_ctx, AVMEDIA_TYPE_VIDEO, -1, -1, NULL, 0);
if (self->video_stream_idx >= 0)
self->video_codec_ctx = open_decoder(retval, scm_file_name, video_stream(self), "video");
// Open audio stream
self->audio_stream_idx = av_find_best_stream(self->fmt_ctx, AVMEDIA_TYPE_AUDIO, -1, -1, NULL, 0);
if (self->audio_stream_idx >= 0)
self->audio_codec_ctx = open_decoder(retval, scm_file_name, audio_stream(self), "audio");
// Print debug information
if (scm_is_true(scm_debug)) av_dump_format(self->fmt_ctx, 0, file_name, 0);
// Allocate input frames
self->video_target_frame = allocate_frame(retval);
self->audio_target_frame = allocate_frame(retval);
// Initialise data packet
av_init_packet(&self->pkt);
self->pkt.data = NULL;
self->pkt.size = 0;
scm_dynwind_end();
return retval;
}
SCM tf_run(SCM scm_session, SCM scm_input, SCM scm_output)
{
SCM retval;
if (scm_is_true(scm_list_p(scm_output))) {
struct tf_session_t *session = get_tf_session(scm_session);
int ninputs = scm_ilength(scm_input);
TF_Output *inputs = scm_gc_malloc(sizeof(TF_Output) * ninputs, "tf-run");
TF_Tensor **input_values = scm_gc_malloc(sizeof(TF_Tensor *) * ninputs, "tf-run");
for (int i=0; i<ninputs; i++) {
memcpy(&inputs[i], &get_tf_output(scm_caar(scm_input))->output, sizeof(TF_Output));
input_values[i] = get_tf_tensor(scm_cdar(scm_input))->tensor;
scm_input = scm_cdr(scm_input);
};
int noutputs = scm_ilength(scm_output);
TF_Output *output = scm_gc_malloc(sizeof(TF_Output) * noutputs, "tf-run");
TF_Tensor **output_values = scm_gc_malloc(sizeof(TF_Tensor *) * noutputs, "tf-run");
for (int i=0; i<noutputs; i++) {
output[i] = get_tf_output(scm_car(scm_output))->output;
scm_output = scm_cdr(scm_output);
};
TF_SessionRun(session->session, NULL, inputs, input_values, ninputs, output, output_values, noutputs, NULL, 0, NULL, status());
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-run", TF_Message(_status), SCM_EOL);
retval = SCM_EOL;
for (int i=noutputs-1; i>=0; i--) {
SCM element;
struct tf_tensor_t *result = (struct tf_tensor_t *)scm_gc_calloc(sizeof(struct tf_tensor_t), "make-tensor");
SCM_NEWSMOB(element, tf_tensor_tag, result);
result->tensor = output_values[i];
retval = scm_cons(element, retval);
};
} else
retval = scm_car(tf_run(scm_session, scm_input, scm_list_1(scm_output)));
return retval;
}
SCM ffmpeg_decode_audio_video(SCM scm_self)
{
SCM retval = SCM_BOOL_F;
struct ffmpeg_t *self = get_self(scm_self);
if (!is_input_context(self))
scm_misc_error("ffmpeg-decode-audio/video", "Attempt to read frame from FFmpeg output video", SCM_EOL);
while (scm_is_false(retval)) {
if (packet_empty(self)) read_packet(self);
int reading_cache = packet_empty(self);
if (self->pkt.stream_index == self->audio_stream_idx) {
av_frame_unref(self->audio_target_frame);
retval = decode_audio(self, &self->pkt, self->audio_target_frame);
} else if (self->pkt.stream_index == self->video_stream_idx) {
av_frame_unref(self->video_target_frame);
retval = decode_video(self, &self->pkt, self->video_target_frame);
} else
consume_packet_data(&self->pkt, self->pkt.size);
if (scm_is_false(retval) && reading_cache) break;
};
return retval;
}
SCM tf_add_gradient_(SCM scm_graph, SCM scm_expression, SCM scm_variables)
{
SCM retval;
if (scm_is_true(scm_list_p(scm_variables))) {
struct tf_graph_t *graph = get_tf_graph(scm_graph);
struct tf_output_t *expression = get_tf_output(scm_expression);
int nvariables = scm_ilength(scm_variables);
TF_Output *variables = scm_gc_calloc(sizeof(TF_Output) * nvariables, "tf-add-gradient_");
for (int i=0; i<nvariables; i++) {
variables[i] = get_tf_output(scm_car(scm_variables))->output;
scm_variables = scm_cdr(scm_variables);
};
TF_Output *output = scm_gc_calloc(sizeof(TF_Output) * nvariables, "tf-add-gradient_");
TF_AddGradients(graph->graph, &expression->output, 1, variables, nvariables, NULL, status(), output);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-add-gradient_", TF_Message(_status), SCM_EOL);
retval = SCM_EOL;
for (int i=nvariables-1; i>=0; i--) {
SCM element;
struct tf_output_t *result = scm_gc_calloc(sizeof(struct tf_output_t), "tf-add-gradient_");
SCM_NEWSMOB(element, tf_output_tag, result);
result->output = output[i];
retval = scm_cons(element, retval);
};
} else
retval = scm_car(tf_add_gradient_(scm_graph, scm_expression, scm_list_1(scm_variables)));
return retval;
}
GList *
gnc_scm_list_to_glist(SCM rest)
{
GList *result = NULL;
SCM scm_item;
SWIG_GetModule(NULL); /* Work-around for SWIG bug. */
SCM_ASSERT(scm_is_list(rest), rest, SCM_ARG1, "gnc_scm_list_to_glist");
while (!scm_is_null(rest))
{
void *item;
scm_item = SCM_CAR(rest);
rest = SCM_CDR(rest);
if (scm_item == SCM_BOOL_F)
{
result = g_list_prepend(result, NULL);
}
else
{
if (!SWIG_IsPointer(scm_item))
scm_misc_error("gnc_scm_list_to_glist",
"Item in list not a wcp.", scm_item);
item = (void *)SWIG_PointerAddress(scm_item);
result = g_list_prepend(result, item);
}
}
return g_list_reverse(result);
}
/* Function to set the UI Value for a particular option */
static gboolean
owner_set_value (GNCOption *option, gboolean use_default,
GtkWidget *widget, SCM value)
{
GncOwner owner_def;
GncOwner *owner;
if (!SWIG_IsPointer (value))
scm_misc_error("business_options:owner_set_value",
"SCM is not a wrapped pointer.", value);
owner = SWIG_MustGetPtr(value, SWIG_TypeQuery("_p__gncOwner"), 1, 0);
/* XXX: should we verify that the owner type is correct? */
if (!owner)
{
owner_def.type = get_owner_type_from_option (option);
owner_def.owner.undefined = NULL;
owner = &owner_def;
}
widget = gnc_option_get_gtk_widget (option);
gnc_owner_set_owner (widget, owner);
return FALSE;
}
static SCM
load_thunk_from_fd_using_read (int fd)
#define FUNC_NAME "load-thunk-from-disk"
{
char *data;
size_t len;
struct stat st;
int ret;
ret = fstat (fd, &st);
if (ret < 0)
SCM_SYSERROR;
len = st.st_size;
data = scm_gc_malloc_pointerless (len, "objcode");
if (full_read (fd, data, len) != len)
{
int errno_save = errno;
(void) close (fd);
errno = errno_save;
if (errno)
SCM_SYSERROR;
scm_misc_error (FUNC_NAME, "short read while loading objcode",
SCM_EOL);
}
(void) close (fd);
return load_thunk_from_memory (data, len);
}
void
scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
scm_i_jmp_buf *current_registers)
{
SCM cont;
scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
scm_t_bits *prompt;
scm_t_dynstack_prompt_flags flags;
scm_t_ptrdiff fp_offset, sp_offset;
union scm_vm_stack_element *fp, *sp;
scm_t_uint32 *ip;
scm_i_jmp_buf *registers;
size_t i;
prompt = scm_dynstack_find_prompt (dynstack, tag,
&flags, &fp_offset, &sp_offset, &ip,
®isters);
if (!prompt)
scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
fp = vp->stack_top - fp_offset;
sp = vp->stack_top - sp_offset;
/* Only reify if the continuation referenced in the handler. */
if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
cont = SCM_BOOL_F;
else
{
scm_t_dynstack *captured;
captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
cont = reify_partial_continuation (vp, fp, sp, ip, registers, captured,
current_registers);
}
/* Unwind. */
scm_dynstack_unwind (dynstack, prompt);
/* Restore VM regs */
vp->fp = fp;
vp->sp = sp - n - 1;
vp->ip = ip;
/* Since we're jumping down, we should always have enough space. */
if (vp->sp < vp->stack_limit)
abort ();
/* Push vals */
vp->sp[n].as_scm = cont;
for (i = 0; i < n; i++)
vp->sp[n - i - 1].as_scm = argv[i];
/* Jump! */
SCM_I_LONGJMP (*registers, 1);
/* Shouldn't get here */
abort ();
}
static AVCodec *find_encoder(SCM scm_self, enum AVCodecID codec_id, const char *output_type)
{
if (codec_id == AV_CODEC_ID_NONE) {// TODO: test (needs wav or mp3 container selection above first)
ffmpeg_destroy(scm_self);
scm_misc_error("make-ffmpeg-output", "File format does not support ~a encoding",
scm_list_1(scm_from_locale_string(output_type)));
};
AVCodec *retval = avcodec_find_encoder(codec_id);// TODO: autodetect or select video codec
if (!retval) {
ffmpeg_destroy(scm_self);
scm_misc_error("make-ffmpeg-output", "Error finding encoder for codec '~a'",
scm_list_1(scm_from_locale_string(avcodec_descriptor_get(codec_id)->name)));
};
return retval;
}
static void
sysdep_dynl_unlink (void *handle, const char *subr)
{
if (lt_dlclose ((lt_dlhandle) handle))
{
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
}
}
SCM
python_import(SCM smodulename)
{
if (!SCM_STRINGP(smodulename)) {
scm_wrong_type_arg("python-import",SCM_ARG1,smodulename);
}
else {
char *mname = scm_to_locale_string(smodulename);
PyObject *pmodule = PyImport_ImportModule(mname);
PyObject *pexception = PyErr_Occurred();
if (pexception) {
PyObject *prepr = PyObject_Repr(pexception);
Py_XDECREF(pmodule);
PyErr_Clear();
SCM smname = scm_list_1(scm_mem2string(mname,strlen(mname)));
free(mname);
if (NULL == prepr) {
scm_misc_error("python-import", // NOT COVERED BY TESTS
"Python exception during module ~A import - could not be identified",
smname);
}
else {
int strlength = PyString_Size(prepr);
char *pstr = PyString_AsString(prepr);
SCM slist = scm_list_2(SCM_CAR(smname),scm_mem2string(pstr,strlength));
Py_DECREF(prepr);
scm_misc_error("python-import",
"Python exception during module ~A import: ~A",
slist);
}
}
// OK, exception did not occur. Do we have a module?
if (NULL == pmodule) {
SCM slist = scm_list_1(scm_mem2string(mname,strlen(mname)));
free(mname);
scm_misc_error("python-eval","could not import module ~S",
slist);
}
free(mname);
SCM smodule = wrap_pyobject(pmodule);
Py_DECREF(pmodule); // wrap_pyobject did Py_INCREF
return(smodule);
}
}
static SCM decode_video(struct ffmpeg_t *self, AVPacket *pkt, AVFrame *frame)
{
int got_frame;
int len = avcodec_decode_video2(self->video_codec_ctx, frame, &got_frame, pkt);
if (len < 0)
scm_misc_error("ffmpeg-decode-audio/video", "Error decoding frame: ~a", scm_list_1(get_error_text(len)));
consume_packet_data(pkt, pkt->size);
return got_frame ? list_timestamped_video(self, frame) : SCM_BOOL_F;
}
SCM tf_graph_export_(SCM scm_graph, SCM scm_file_name)
{
struct tf_graph_t *graph = get_tf_graph(scm_graph);
TF_Buffer *buffer = TF_NewBuffer();
TF_GraphToGraphDef(graph->graph, buffer, status());
if (TF_GetCode(_status) != TF_OK) {
TF_DeleteBuffer(buffer);
scm_misc_error("tf-graph-export_", TF_Message(_status), SCM_EOL);
};
char *file_name = scm_to_locale_string(scm_file_name);
FILE *file = fopen(file_name, "w");
free(file_name);
if (!file)
scm_misc_error("tf-graph-export_", strerror(errno), SCM_EOL);
fwrite(buffer->data, buffer->length, 1, file);
fclose(file);
TF_DeleteBuffer(buffer);
return SCM_UNDEFINED;
}
static AVFrame *allocate_frame(SCM scm_self)
{
AVFrame *retval = av_frame_alloc();
if (!retval) {
ffmpeg_destroy(scm_self);
scm_misc_error("allocate-frame", "Error allocating frame", SCM_EOL);
};
memset(retval, 0, sizeof(AVFrame));
return retval;
}
SCM ffmpeg_seek(SCM scm_self, SCM scm_position)
{
struct ffmpeg_t *self = get_self(scm_self);
if (!is_input_context(self))
scm_misc_error("ffmpeg-seek", "Attempt to seek in FFmpeg output video", SCM_EOL);
int64_t position = (int64_t)(scm_to_double(scm_position) * AV_TIME_BASE);
av_seek_frame(self->fmt_ctx, -1, position, AVSEEK_FLAG_ANY);// TODO: check error
return scm_position;
}
static void make_frame_writable(AVFrame *frame)
{
#ifdef HAVE_AV_FRAME_MAKE_WRITABLE
// Make frame writeable
int err = av_frame_make_writable(frame);
if (err < 0)
scm_misc_error("make-frame-writable", "Error making frame writeable: ~a",
scm_list_1(get_error_text(err)));
#endif
}
void
scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item)
{
scm_t_bits tag = SCM_DYNSTACK_TAG (item);
scm_t_dynstack_item_type type = SCM_DYNSTACK_TAG_TYPE (tag);
scm_t_bits flags = SCM_DYNSTACK_TAG_FLAGS (tag);
size_t len = SCM_DYNSTACK_TAG_LEN (tag);
switch (type)
{
case SCM_DYNSTACK_TYPE_FRAME:
if (!(flags & SCM_F_DYNSTACK_FRAME_REWINDABLE))
scm_misc_error ("scm_dynstack_wind_1",
"cannot invoke continuation from this context",
SCM_EOL);
break;
case SCM_DYNSTACK_TYPE_UNWINDER:
break;
case SCM_DYNSTACK_TYPE_REWINDER:
WINDER_PROC (item) (WINDER_DATA (item));
break;
case SCM_DYNSTACK_TYPE_WITH_FLUID:
scm_swap_fluid (WITH_FLUID_FLUID (item),
WITH_FLUID_VALUE_BOX (item),
SCM_I_CURRENT_THREAD->dynamic_state);
break;
case SCM_DYNSTACK_TYPE_PROMPT:
/* see vm_reinstate_partial_continuation */
break;
case SCM_DYNSTACK_TYPE_DYNWIND:
scm_call_0 (DYNWIND_ENTER (item));
break;
case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (item),
scm_set_current_dynamic_state
(scm_variable_ref (DYNAMIC_STATE_STATE_BOX (item))));
break;
case SCM_DYNSTACK_TYPE_NONE:
default:
abort ();
}
{
scm_t_bits *words = push_dynstack_entry (dynstack, type, flags, len);
copy_scm_t_bits (words, item, len);
}
}
static void
st_end_input (SCM port, int offset)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
if (pt->read_pos - pt->read_buf < offset)
scm_misc_error ("st_end_input", "negative position", SCM_EOL);
pt->write_pos = (unsigned char *) (pt->read_pos = pt->read_pos - offset);
pt->rw_active = SCM_PORT_NEITHER;
}
SCM tf_set_attr_tensor(SCM scm_description, SCM scm_name, SCM scm_value)
{
struct tf_description_t *self = get_tf_description(scm_description);
struct tf_tensor_t *value = get_tf_tensor(scm_value);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrTensor(self->description, name, value->tensor, status());
free(name);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-set-attr-tensor", TF_Message(_status), SCM_EOL);
return SCM_UNDEFINED;
}
static void *
sysdep_dynl_value (const char *symb, void *handle, const char *subr)
{
void *fptr;
fptr = lt_dlsym ((lt_dlhandle) handle, symb);
if (!fptr)
scm_misc_error (subr, "Symbol not found: ~a",
scm_list_1 (scm_from_locale_string (symb)));
return fptr;
}
SCM llvm_verify_module(SCM scm_llvm)
{
struct llvm_module_t *llvm = get_llvm(scm_llvm);
char *error = NULL;
if (LLVMVerifyModule(llvm->module, LLVMPrintMessageAction, &error)) {
SCM scm_error = scm_from_locale_string(error);
LLVMDisposeMessage(error);
scm_misc_error("verify-module", "Module is not valid: ~a", scm_list_1(scm_error));
};
return SCM_UNSPECIFIED;
}
static AVCodecContext *open_codec(SCM scm_self, AVCodecContext *codec_ctx, AVCodec *codec,
const char *media_type, SCM scm_file_name)
{
int err = avcodec_open2(codec_ctx, codec, NULL);
if (err < 0) {
ffmpeg_destroy(scm_self);
scm_misc_error("open-codec", "Failed to open ~a codec for file '~a'",
scm_list_2(scm_from_locale_string(media_type), scm_file_name));
};
return codec_ctx;
}
static scm_t_ptrdiff
find_prompt (SCM key)
{
scm_t_ptrdiff fp_offset;
if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
NULL, &fp_offset, NULL, NULL, NULL))
scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
scm_list_1 (key));
return fp_offset;
}
static AVCodecContext *open_decoder(SCM scm_self, SCM scm_file_name,
AVStream *stream, const char *media_type)
{
AVCodecContext *dec_ctx = stream->codec;
AVCodec *decoder = avcodec_find_decoder(dec_ctx->codec_id);
if (!decoder) {
ffmpeg_destroy(scm_self);
scm_misc_error("open-codec", "Failed to find ~a codec for file '~a'",
scm_list_2(scm_from_locale_string(media_type), scm_file_name));
};
return open_codec(scm_self, dec_ctx, decoder, media_type, scm_file_name);
}
