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; }
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; }
/* Return a new port of type PORT_TYPE. */ static inline SCM make_port (scm_t_bits port_type) { SCM port; char *c_buffer; scm_t_port *c_port; c_buffer = scm_gc_calloc (PORT_BUFFER_SIZE, "custom-port-buffer"); port = scm_new_port_table_entry (port_type); /* Associate C_BUFFER with PORT, for test purposes. */ SCM_SETSTREAM (port, (scm_t_bits) c_buffer); /* Use C_BUFFER as PORT's internal buffer. */ c_port = SCM_PTAB_ENTRY (port); c_port->read_pos = c_port->read_buf = (unsigned char *) c_buffer; c_port->read_end = (unsigned char *) c_buffer + PORT_BUFFER_SIZE; c_port->read_buf_size = PORT_BUFFER_SIZE; /* Mark PORT as open and readable. */ SCM_SET_CELL_TYPE (port, port_type | SCM_OPN | SCM_RDNG); return port; }
SCM make_graph(void) { SCM retval; struct tf_graph_t *self = (struct tf_graph_t *)scm_gc_calloc(sizeof(struct tf_graph_t), "make-graph"); SCM_NEWSMOB(retval, tf_graph_tag, self); self->graph = TF_NewGraph(); return retval; }
SCM make_llvm_module_base(void) { SCM retval; struct llvm_module_t *self; self = (struct llvm_module_t *)scm_gc_calloc(sizeof(struct llvm_module_t), "llvm"); SCM_NEWSMOB(retval, llvm_module_tag, self); self->module = LLVMModuleCreateWithName("aiscm"); return retval; }
SCM llvm_build_phi(SCM scm_function, SCM scm_type) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, result); int type = scm_to_int(scm_type); result->value = LLVMBuildPhi(function->builder, llvm_type(type), "x"); return retval; }
SCM llvm_get_param(SCM scm_function, SCM scm_index) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); int index = scm_to_int(scm_index); struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, result); result->value = LLVMGetParam(function->function, index); return retval; }
SCM make_llvm_constant(SCM scm_type, SCM scm_value) { SCM retval; struct llvm_value_t *self; self = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, self); int type = scm_to_int(scm_type); self->value = scm_to_llvm_value(type, scm_value); return retval; }
SCM llvm_build_unary(LLVMValueRef (*build_unary)(LLVMBuilderRef, LLVMValueRef, const char*), SCM scm_function, SCM scm_value) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_value_t *value = get_llvm_value(scm_value); struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, result); result->value = (*build_unary)(function->builder, value->value, "x"); return retval; }
SCM llvm_build_float_cmp(SCM scm_function, SCM scm_predicate, SCM scm_value_a, SCM scm_value_b) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_value_t *value_a = get_llvm_value(scm_value_a); struct llvm_value_t *value_b = get_llvm_value(scm_value_b); struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, result); result->value = LLVMBuildFCmp(function->builder, scm_to_int(scm_predicate), value_a->value, value_b->value, "x"); return retval; }
SCM make_llvm_basic_block(SCM scm_function, SCM scm_name) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_basic_block_t *self; self = (struct llvm_basic_block_t *)scm_gc_calloc(sizeof(struct llvm_basic_block_t), "llvm basic block"); SCM_NEWSMOB(retval, llvm_basic_block_tag, self); char *name = scm_to_locale_string(scm_name); self->basic_block = LLVMAppendBasicBlock(function->function, name); free(name); return retval; }
SCM tf_add_input_list(SCM scm_description, SCM scm_inputs) { struct tf_description_t *self = get_tf_description(scm_description); int num_inputs = scm_ilength(scm_inputs); TF_Output *inputs = (TF_Output *)scm_gc_calloc(sizeof(struct TF_Output) * num_inputs, "tf-add-input-list"); for (int i=0; i<num_inputs; i++) { inputs[i] = get_tf_output(scm_car(scm_inputs))->output; scm_inputs = scm_cdr(scm_inputs); }; TF_AddInputList(self->description, inputs, num_inputs); return SCM_UNDEFINED; }
SCM llvm_build_load(SCM scm_function, SCM scm_type, SCM scm_address) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, result); struct llvm_value_t *address = get_llvm_value(scm_address); int type = scm_to_int(scm_type); LLVMValueRef pointer = LLVMBuildIntToPtr(function->builder, address->value, LLVMPointerType(llvm_type(type), 0), "x"); result->value = LLVMBuildLoad(function->builder, pointer, "x"); return retval; }
SCM make_description(SCM scm_graph, SCM scm_op, SCM scm_name) { SCM retval; struct tf_graph_t *graph = get_tf_graph(scm_graph); struct tf_description_t *self = (struct tf_description_t *)scm_gc_calloc(sizeof(struct tf_description_t), "make-description"); SCM_NEWSMOB(retval, tf_description_tag, self); char *op = scm_to_locale_string(scm_op); char *name = scm_to_locale_string(scm_name); self->description = TF_NewOperation(graph->graph, op, name); free(name); free(op); return retval; }
SCM llvm_build_select(SCM scm_function, SCM scm_condition, SCM scm_value_if, SCM scm_value_else) { SCM retval; struct llvm_value_t *self; self = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value"); SCM_NEWSMOB(retval, llvm_value_tag, self); struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_value_t *condition = get_llvm_value(scm_condition); struct llvm_value_t *value_if = get_llvm_value(scm_value_if ); struct llvm_value_t *value_else = get_llvm_value(scm_value_else); self->value = LLVMBuildSelect(function->builder, condition->value, value_if->value, value_else->value, "x"); return retval; }
SCM make_tf_session(SCM scm_graph) { SCM retval; struct tf_session_t *self = (struct tf_session_t *)scm_gc_calloc(sizeof(struct tf_session_t), "make-tf-session"); SCM_NEWSMOB(retval, tf_session_tag, self); self->graph = get_tf_graph(scm_graph); TF_SessionOptions *options = TF_NewSessionOptions(); self->session = TF_NewSession(self->graph->graph, options, status()); TF_DeleteSessionOptions(options); if (TF_GetCode(_status) != TF_OK) scm_misc_error("make-tf-session", TF_Message(_status), SCM_EOL); return retval; }
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 make_llvm_function(SCM scm_llvm, SCM scm_return_type, SCM scm_name, SCM scm_argument_types) { SCM retval; struct llvm_module_t *llvm = get_llvm(scm_llvm); struct llvm_function_t *self; self = (struct llvm_function_t *)scm_gc_calloc(sizeof(struct llvm_function_t), "llvm function"); SCM_NEWSMOB(retval, llvm_function_tag, self); self->builder = LLVMCreateBuilder(); char *name = scm_to_locale_string(scm_name); self->function = LLVMAddFunction(llvm->module, name, function_type(scm_return_type, scm_argument_types)); LLVMSetFunctionCallConv(self->function, LLVMCCallConv); free(name); return retval; }
SCM make_tensor(SCM scm_type, SCM scm_shape, SCM scm_size, SCM scm_source) { SCM retval; struct tf_tensor_t *self = (struct tf_tensor_t *)scm_gc_calloc(sizeof(struct tf_tensor_t), "make-tensor"); SCM_NEWSMOB(retval, tf_tensor_tag, self); int type = scm_to_int(scm_type); int num_dims = scm_to_int(scm_length(scm_shape)); int64_t *dims = scm_gc_malloc_pointerless(sizeof(int64_t) * num_dims, "make-tensor"); int count = 1; for (int i=0; i<num_dims; i++) { dims[i] = scm_to_int(scm_car(scm_shape)); count = count * dims[i]; scm_shape = scm_cdr(scm_shape); }; if (type == TF_STRING) { SCM* pointer = scm_to_pointer(scm_source); size_t encoded_size = 0; for (int i=0; i<count; i++) { encoded_size += TF_StringEncodedSize(scm_c_string_length(*pointer)) + 8; pointer++; }; self->tensor = TF_AllocateTensor(type, dims, num_dims, encoded_size); int64_t *offsets = TF_TensorData(self->tensor); int offset = 0; void *result = offsets + count; pointer = scm_to_pointer(scm_source); encoded_size = encoded_size - count * sizeof(int64_t); for (int i=0; i<count; i++) { char *str = scm_to_locale_string(*pointer); int len = TF_StringEncodedSize(scm_c_string_length(*pointer)); *offsets++ = offset; TF_StringEncode(str, scm_c_string_length(*pointer), result, encoded_size, status()); free(str); if (TF_GetCode(_status) != TF_OK) scm_misc_error("make-tensor", TF_Message(_status), SCM_EOL); offset += len; encoded_size -= len; result += len; pointer++; }; } else { self->tensor = TF_AllocateTensor(type, dims, num_dims, scm_to_int(scm_size)); memcpy(TF_TensorData(self->tensor), scm_to_pointer(scm_source), scm_to_int(scm_size)); }; return retval; }
SCM llvm_build_call(SCM scm_function, SCM scm_llvm, SCM scm_return_type, SCM scm_function_name, SCM scm_argument_types, SCM scm_values) { SCM retval; struct llvm_function_t *function = get_llvm_function(scm_function); struct llvm_module_t *llvm = get_llvm(scm_llvm); char *function_name = scm_to_locale_string(scm_function_name); LLVMValueRef function_pointer = LLVMAddFunction(llvm->module, function_name, function_type(scm_return_type, scm_argument_types)); free(function_name); // LLVMAddFunctionAttr(function_pointer, LLVMExternalLinkage); int n_values = scm_ilength(scm_values); LLVMValueRef *values = scm_gc_malloc_pointerless(n_values * sizeof(LLVMValueRef), "llvm-build-call"); for (int i=0; i<n_values; i++) { values[i] = get_llvm_value(scm_car(scm_values))->value; scm_values = scm_cdr(scm_values); }; struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvmvalue"); SCM_NEWSMOB(retval, llvm_value_tag, result); result->value = LLVMBuildCall(function->builder, function_pointer, values, n_values, "x"); return retval; }
SCM tf_finish_operation(SCM scm_description, SCM scm_n_outputs) { SCM retval = SCM_EOL; struct tf_description_t *self = get_tf_description(scm_description); int n_outputs = scm_to_int(scm_n_outputs); TF_Operation *operation = TF_FinishOperation(self->description, status()); if (TF_GetCode(_status) != TF_OK) scm_misc_error("tf-finish-operation", TF_Message(_status), SCM_EOL); for (int i=n_outputs-1; i>=0; i--) { SCM element; struct tf_output_t *output = (struct tf_output_t *)scm_gc_calloc(sizeof(struct tf_output_t), "tf-finish-operation"); SCM_NEWSMOB(element, tf_output_tag, output); output->output.oper = operation; output->output.index = i; retval = scm_cons(element, retval); }; if (n_outputs == 1) retval = scm_car(retval); return retval; }
SCM tf_graph_operation_by_name_(SCM scm_graph, SCM scm_name) { struct tf_graph_t *graph = get_tf_graph(scm_graph); char *name = scm_to_locale_string(scm_name); TF_Operation *operation = TF_GraphOperationByName(graph->graph, name); free(name); if (!operation) scm_misc_error("tf-graph-operation-by-name_", "Operation '~a' not found", scm_list_1(scm_name)); SCM retval = SCM_EOL; int noutputs = TF_OperationNumOutputs(operation); for (int i=noutputs-1; i>=0; i--) { SCM element; struct tf_output_t *output = (struct tf_output_t *)scm_gc_calloc(sizeof(struct tf_output_t), "tf-graph-operation-by-name_"); SCM_NEWSMOB(element, tf_output_tag, output); output->output.oper = operation; output->output.index = i; retval = scm_cons(element, retval); }; if (noutputs == 1) retval = scm_car(retval); return retval; }
SCM make_ffmpeg_output(SCM scm_file_name, SCM scm_format_name, SCM scm_video_parameters, SCM scm_have_video, SCM scm_audio_parameters, SCM scm_have_audio, 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; const char *format_name = NULL; if (!scm_is_false(scm_format_name)) { format_name = scm_to_locale_string(scm_symbol_to_string(scm_format_name)); scm_dynwind_free(format_name); }; #ifdef HAVE_AVFORMAT_ALLOC_OUTPUT_CONTEXT2 err = avformat_alloc_output_context2(&self->fmt_ctx, NULL, format_name, file_name); if (!self->fmt_ctx) { ffmpeg_destroy(retval); scm_misc_error("make-ffmpeg-output", "Error initializing output format for file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err))); }; #else AVOutputFormat *format; if (format_name) format = av_guess_format(format_name, NULL, NULL); else format = av_guess_format(NULL, file_name, NULL); if (!format) { ffmpeg_destroy(retval); scm_misc_error("make-ffmpeg-output", "Unable to determine file format for file '~a'", scm_list_1(scm_file_name)); }; self->fmt_ctx = avformat_alloc_context(); if (!self->fmt_ctx) { ffmpeg_destroy(retval); scm_misc_error("make-ffmpeg-output", "Error initializing output format for file '~a'", scm_list_1(scm_file_name)); }; self->fmt_ctx->oformat = format; strncpy(self->fmt_ctx->filename, file_name, sizeof(self->fmt_ctx->filename)); #endif char have_video = scm_is_true(scm_have_video); if (have_video) { // Open codec and video stream enum AVCodecID video_codec_id = self->fmt_ctx->oformat->video_codec; AVCodec *video_encoder = find_encoder(retval, video_codec_id, "video"); AVStream *video_stream = open_output_stream(retval, video_encoder, &self->video_stream_idx, "video", scm_file_name); // Get video parameters SCM scm_shape = scm_car(scm_video_parameters); SCM scm_frame_rate = scm_cadr(scm_video_parameters); SCM scm_video_bit_rate = scm_caddr(scm_video_parameters); SCM scm_aspect_ratio = scm_cadddr(scm_video_parameters); // Configure the output video codec self->video_codec_ctx = configure_output_video_codec(video_stream, video_codec_id, scm_video_bit_rate, scm_shape, scm_frame_rate, scm_aspect_ratio); // Some formats want stream headers to be separate. if (self->fmt_ctx->oformat->flags & AVFMT_GLOBALHEADER) self->video_codec_ctx->flags |= AV_CODEC_FLAG_GLOBAL_HEADER; // Open output video codec open_codec(retval, self->video_codec_ctx, video_encoder, "video", scm_file_name); // Allocate frame self->video_target_frame = allocate_output_video_frame(retval, self->video_codec_ctx); }; char have_audio = scm_is_true(scm_have_audio); if (have_audio) { // Open audio codec and stream enum AVCodecID audio_codec_id = self->fmt_ctx->oformat->audio_codec; AVCodec *audio_encoder = find_encoder(retval, audio_codec_id, "audio"); AVStream *audio_stream = open_output_stream(retval, audio_encoder, &self->audio_stream_idx, "audio", scm_file_name); // Get audio parameters SCM scm_select_rate = scm_car(scm_audio_parameters); SCM scm_channels = scm_cadr(scm_audio_parameters); SCM scm_audio_bit_rate = scm_caddr(scm_audio_parameters); SCM scm_select_format = scm_cadddr(scm_audio_parameters); // Configure the output audio codec self->audio_codec_ctx = configure_output_audio_codec(retval, audio_stream, audio_codec_id, scm_select_rate, scm_channels, scm_audio_bit_rate, scm_select_format); // Some formats want stream headers to be separate. if (self->fmt_ctx->oformat->flags & AVFMT_GLOBALHEADER) self->audio_codec_ctx->flags |= AV_CODEC_FLAG_GLOBAL_HEADER; // Open output audio codec open_codec(retval, self->audio_codec_ctx, audio_encoder, "audio", scm_file_name); // Allocate audio frame self->audio_target_frame = allocate_output_audio_frame(retval, self->audio_codec_ctx, self->audio_codec_ctx->sample_fmt); self->audio_packed_frame = allocate_output_audio_frame(retval, self->audio_codec_ctx, av_get_packed_sample_fmt(self->audio_codec_ctx->sample_fmt)); // Initialise audio buffer ringbuffer_init(&self->audio_buffer, 1024); }; if (scm_is_true(scm_debug)) av_dump_format(self->fmt_ctx, 0, file_name, 1); // Open the output file if needed if (!(self->fmt_ctx->oformat->flags & AVFMT_NOFILE)) { int err = avio_open(&self->fmt_ctx->pb, file_name, AVIO_FLAG_WRITE); if (err < 0) { ffmpeg_destroy(retval); scm_misc_error("make-ffmpeg-output", "Could not open '~a': ~a", scm_list_2(scm_file_name, get_error_text(err))); } self->output_file = 1; } // Write video file header err = avformat_write_header(self->fmt_ctx, NULL); if (err < 0) { ffmpeg_destroy(retval); scm_misc_error("make-ffmpeg-output", "Error writing header of video '~a': ~a", scm_list_2(scm_file_name, get_error_text(err))); }; self->header_written = 1; scm_dynwind_end(); return retval; }