/// Returns the build log.
std::string build_log() const
{
device device = get_devices()[0];
size_t size = 0;
cl_int ret = clGetProgramBuildInfo(m_program,
device.id(),
CL_PROGRAM_BUILD_LOG,
0,
0,
&size);
if(ret != CL_SUCCESS){
BOOST_THROW_EXCEPTION(runtime_exception(ret));
}
std::string value(size - 1, 0);
ret = clGetProgramBuildInfo(m_program,
device.id(),
CL_PROGRAM_BUILD_LOG,
size,
&value[0],
0);
if(ret != CL_SUCCESS){
BOOST_THROW_EXCEPTION(runtime_exception(ret));
}
return value;
}
/*
* (set-video-mode <width> <height> <bits per pixel>?) or
* (set-video-mode <width> <height> <bits per pixel> <mode flags>+)
*
* where <symbols> are:
* swsurface
* hwsurface
* asyncblit
* anyformat
* hwpalette
* doublebuf
* fullscreen
* opengl
* openglblit
* resizable
* noframe
*
*/
cons_t* set_video_mode(cons_t* p, environment_t*)
{
assert_length_min(p, 2);
assert_type(INTEGER, car(p));
assert_type(INTEGER, cadr(p));
// dimension
int x = car(p)->integer;
int y = cadr(p)->integer;
// default values
int bits = 32;
uint32_t mode = 0;
///////////////////
raise(runtime_exception("Testing"));
///////////////////
// bits per pixel
if ( integerp(caddr(p)) )
bits = caddr(p)->integer;
// options
cons_t *opts = symbolp(caddr(p))? cddr(p) :
symbolp(cadddr(p))? cdddr(p) : nil();;
for ( cons_t *s = opts; !nullp(s); s = cdr(s) ) {
assert_type(SYMBOL, car(s));
std::string sym = symbol_name(s);
int size = sizeof(sdl_flags) / sizeof(key_value_t<std::string, uint32_t>);
for ( int n=0; n < size; ++n )
if ( sym == sdl_flags[n].key ) {
///////////////////
printf("flag %s\n", sym.c_str());
printf("value %d and %d\n", sdl_flags[n].value, SDL_HWSURFACE);
///////////////////
mode |= sdl_flags[n].value;
goto NEXT_FLAG;
}
raise(runtime_exception("Unknown SDL video mode flag: " + sym));
NEXT_FLAG:
continue;
}
mode = SDL_HWSURFACE;
///////////////////
printf("video mode\n"); fflush(stdout);
///////////////////
SDL_Surface *screen = SDL_SetVideoMode(x, y, bits, mode);
if ( screen == NULL )
raise(runtime_exception(SDL_GetError()));
return pointer(new pointer_t("sdl-surface", (void*)screen));
}
/* 128 -> 64/64 unsigned division */
uint64_t HELPER(divu64)(CPUS390XState *env, uint64_t ah, uint64_t al,
uint64_t b)
{
uint64_t ret;
/* Signal divide by zero. */
if (b == 0) {
runtime_exception(env, PGM_FIXPT_DIVIDE, GETPC());
}
if (ah == 0) {
/* 64 -> 64/64 case */
env->retxl = al % b;
ret = al / b;
} else {
/* ??? Move i386 idivq helper to host-utils. */
#if HOST_LONG_BITS == 64 && defined(__GNUC__)
/* assuming 64-bit hosts have __uint128_t */
__uint128_t a = ((__uint128_t)ah << 64) | al;
__uint128_t q = a / b;
env->retxl = a % b;
ret = q;
if (ret != q) {
runtime_exception(env, PGM_FIXPT_DIVIDE, GETPC());
}
#else
/* 32-bit hosts would need special wrapper functionality - just abort if
we encounter such a case; it's very unlikely anyways. */
cpu_abort(env, "128 -> 64/64 division not implemented\n");
#endif
}
return ret;
}
/*
* Returns a void pointer to the data the cell holds,
* whose data type must be compatible with `type`.
*/
static void* make_arg(ffi_type *type, cons_t* val)
{
if ( type == &ffi_type_uint ||
type == &ffi_type_sint )
{
if ( !integerp(val) )
raise(runtime_exception("Argument must be an integer"));
return static_cast<void*>(&val->number.integer);
}
if ( type == &ffi_type_pointer ) {
if ( stringp(val) ) return static_cast<void*>(&val->string);
if ( pointerp(val) ) return &val->pointer->value;
if ( integerp(val) ) return &val->number.integer;
if ( realp(val) ) return &val->number.real;
raise(runtime_exception(format(
"Unsupported pointer type %s", to_s(type_of(val)).c_str())));
}
const std::string expect = ffi_type_name(type),
given = to_s(type_of(val));
raise(runtime_exception(format(
"Foreign function wants %s but input data was %s, "
"which we don't know how to convert.",
indef_art("'"+expect+"'").c_str(),
indef_art("'"+given+"'").c_str())));
return NULL;
}
/// Partitions the device into multiple sub-devices according to
/// \p properties.
///
/// \opencl_version_warning{1,2}
std::vector<device>
partition(const cl_device_partition_property *properties) const
{
// get sub-device count
uint_ count = 0;
int_ ret = clCreateSubDevices(m_id, properties, 0, 0, &count);
if(ret != CL_SUCCESS){
BOOST_THROW_EXCEPTION(runtime_exception(ret));
}
// get sub-device ids
std::vector<cl_device_id> ids(count);
ret = clCreateSubDevices(m_id, properties, count, &ids[0], 0);
if(ret != CL_SUCCESS){
BOOST_THROW_EXCEPTION(runtime_exception(ret));
}
// convert ids to device objects
std::vector<device> devices(count);
for(size_t i = 0; i < count; i++){
devices[i] = device(ids[i], false);
}
return devices;
}
cons_t* proc_expt(cons_t* p, environment_t*)
{
assert_length(p, 2);
cons_t *base = car(p),
*expn = cadr(p);
assert_number(base);
assert_number(expn);
bool exact = integerp(base) && integerp(expn);
if ( exact ) {
int a = base->number.integer,
n = expn->number.integer,
r = a;
// Per definition
if ( n == 0 )
return integer(1);
if ( n < 0 )
raise(runtime_exception("Negative exponents not implemented"));
// This is a slow version
// TODO: Implement O(log n) version
while ( n-- > 1 )
r *= a;
return integer(r);
}
// Floating point exponentiation
real_t a = number_to_real(base),
n = number_to_real(expn),
r = a;
if ( n == 0.0 )
return real(1.0);
if ( n < 0.0 )
raise(runtime_exception("Negative exponents not implemented"));
while ( floor(n) > 1.0 ) {
r *= a;
n -= 1.0;
}
if ( n > 1.0 )
raise(runtime_exception("Fractional exponents not supported"));
// TODO: Compute r^n, where n is in [0..1)
return real(r);
}
/*
* (set-video-mode <width> <height> <bits per pixel>?) or
* (set-video-mode <width> <height> <bits per pixel> <mode flags>+)
*
* where <symbols> are:
* swsurface
* hwsurface
* asyncblit
* anyformat
* hwpalette
* doublebuf
* fullscreen
* opengl
* openglblit
* resizable
* noframe
*
*/
cons_t* set_video_mode(cons_t* p, environment_t*)
{
assert_length_min(p, 2);
assert_type(INTEGER, car(p));
assert_type(INTEGER, cadr(p));
// dimension
int x = intval(car(p));
int y = intval(cadr(p));
// default values
int bits = 32;
uint32_t mode = 0;
// bits per pixel
if ( length(p) > 2 && integerp(caddr(p)) )
bits = intval(caddr(p));
// mode options
if ( length(p) > 3 ) {
cons_t *opts = symbolp(caddr(p))? cddr(p) :
symbolp(cadddr(p))? cdddr(p) : nil();;
DPRINT(opts);
for ( cons_t *s = opts; !nullp(s); s = cdr(s) ) {
assert_type(SYMBOL, car(s));
std::string sym = symbol_name(car(s));
for ( size_t n=0; n < num_sdl_flags; ++n )
if ( sym == sdl_flags[n].key ) {
mode |= sdl_flags[n].value;
goto NEXT_FLAG;
}
raise(runtime_exception("Unknown SDL video mode flag: " + sym));
NEXT_FLAG:
continue;
}
}
SDL_Surface *screen = SDL_SetVideoMode(x, y, bits, mode);
if ( screen == NULL )
raise(runtime_exception(SDL_GetError()));
return pointer(
new pointer_t("sdl-surface",
reinterpret_cast<void*>(screen)));
}
file_stream::file_stream(const string & fname, gsgl::flags_t mode)
: data_object(), fname(fname), fp(0), mode(mode)
{
string mode_string;
if (mode & FILE_OPEN_READ)
{
if (mode & FILE_OPEN_WRITE)
{
if (mode & FILE_OPEN_APPEND)
mode_string = L"a+";
else
mode_string = L"w+";
}
else
{
mode_string = L"r+";
}
}
else if (mode & FILE_OPEN_WRITE)
{
if (mode & FILE_OPEN_APPEND)
mode_string = L"a";
else
mode_string = L"w";
}
else
{
throw runtime_exception(L"invalid file open mode %ls opening %ls", mode_string.w_string(), fname.w_string());
}
if (mode & FILE_OPEN_BINARY && mode & FILE_OPEN_TEXT)
throw runtime_exception(L"You cannot open a file in both text and binary mode.");
if (mode & FILE_OPEN_BINARY)
mode_string.append(L"b");
else if (mode & FILE_OPEN_TEXT)
mode_string.append(L"t");
FILE *f = ::fopen(fname.c_string(), mode_string.c_string());
if (f && !::ferror(f))
{
fp = f;
}
else
{
throw runtime_exception(L"Unable to open %ls: %hs", fname.w_string(), strerror(errno));
}
} // file_stream::file_stream()
extern "C" cons_t* proc_deactivate_signal(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_type(INTEGER, car(p));
integer_t sig = car(p)->number.integer;
if ( sig<0 || sig > SIGHANDLERS )
raise(runtime_exception(format("Invalid signal: %d", sig)));
if ( SIG_ERR == set_handler(sig, NULL) )
raise(runtime_exception(strerror(errno)));
return nil();
}
/*
* (initialize) ==> nothing
*/
cons_t* initialize(cons_t*, environment_t*)
{
if ( SDL_Init(SDL_INIT_VIDEO) != 0 )
raise(runtime_exception(SDL_GetError()));
return unspecified();
}
environment_t* import_library(const std::string& name)
{
load_library_index();
environment_t* r = null_environment();
/*
* This library needs special treatment; all other libraries depend on it
* to load dynamic shared object files.
*/
if ( name == "(unix dlopen)" ) {
import_unix_dlopen(r);
return r;
}
/*
* TODO: This lookup is O(n^2)-slow, but it will run so seldomly that it really
* doesn't matter. Can be done in O(n log n) or O(1) time, but at a cost
* of algorithmic complexity.
*/
for ( library_map_t* lib = library_map;
lib->library_name != NULL; ++lib )
{
if ( name == lib->library_name ) {
import_scheme_file(r, lib->source_file);
return r;
}
}
raise(runtime_exception("Unknown library: " + name));
return NULL;
}
static environment_t* import_set(cons_t* p)
{
std::string s = symbol_name(car(p));
/*
* Each import set can be either of:
*/
// (rename <import set> (<identifier1> <identifier2>) ...)
if ( s == "rename" )
return rename(import_set(cadr(p)), cddr(p));
// (prefix <import set> <identifier>)
else if ( s == "prefix" )
return prefix(import_set(cadr(p)), caddr(p));
// (only <import set> <identifier> ...)
else if ( s == "only" )
return only(import_set(cadr(p)), cddr(p));
// (except <import set> <identifier> ...)
else if ( s == "except" )
return except(import_set(cadr(p)), cddr(p));
// <library name>
else if ( !s.empty() )
return import_library(sprint(p));
raise(runtime_exception("Unknown import set: " + sprint(p)));
return NULL;
}
/// Builds the program with \p options.
cl_int build(const std::string &options = std::string())
{
const char *options_string = 0;
if(!options.empty()){
options_string = options.c_str();
}
cl_int ret = clBuildProgram(m_program, 0, 0, options_string, 0, 0);
#ifdef BOOST_COMPUTE_DEBUG_KERNEL_COMPILATION
if(ret != CL_SUCCESS){
// print the error, source code and build log
std::cerr << "Boost.Compute: "
<< "kernel compilation failed (" << ret << ")\n"
<< "--- source ---\n"
<< source()
<< "\n--- build log ---\n"
<< build_log()
<< std::endl;
}
#endif
if(ret != CL_SUCCESS){
BOOST_THROW_EXCEPTION(runtime_exception(ret));
}
return ret;
}
cons_t* proc_add(cons_t *p, environment_t* env)
{
/*
* Integers have an IDENTITY, so we can do this,
* but a more correct approach would be to take
* the value of the FIRST number we find and
* return that.
*/
rational_t sum;
sum.numerator = 0;
sum.denominator = 1;
bool exact = true;
for ( ; !nullp(p); p = cdr(p) ) {
cons_t *i = listp(p)? car(p) : p;
if ( integerp(i) ) {
if ( !i->number.exact ) exact = false;
sum += i->number.integer;
} else if ( rationalp(i) ) {
if ( !i->number.exact ) exact = false;
sum += i->number.rational;
} else if ( realp(i) ) {
// automatically convert; perform rest of computation in floats
exact = false;
return proc_addf(cons(real(sum), p), env);
} else
raise(runtime_exception(
"Cannot add integer with " + to_s(type_of(i)) + ": " + sprint(i)));
}
return rational(sum, exact);
}
/*
* (make-type (<type1> <type2>) size alignment)
*/
cons_t* proc_make_type(cons_t* p, environment_t*)
{
cons_t *types = car(p),
*size = cadr(p),
*align = caddr(p);
assert_length(p, 3);
assert_type(PAIR, types);
assert_type(INTEGER, size);
assert_type(INTEGER, align);
const size_t ntypes = length(types);
if ( ntypes == 0 )
raise(runtime_exception("No types given"));
ffi_type *t = new ffi_type();
t->size = size->number.integer;
t->alignment = align->number.integer;
t->elements = new ffi_type*[1+ntypes];
t->elements[ntypes] = NULL;
p = types;
for ( size_t n=0; n<ntypes; ++n ) {
t->elements[n] = parse_ffi_type(car(p));
p = cdr(p);
}
return pointer(tag_ffi_type, t);
}
cons_t* proc_env_assign(cons_t* p, environment_t*)
{
assert_length(p, 3);
assert_type(ENVIRONMENT, car(p));
assert_type(SYMBOL, cadr(p));
const std::string name = symbol_name(cadr(p));
environment_t *e = car(p)->environment;
cons_t *value = caddr(p);
if ( value == NULL )
raise(runtime_exception(
"Symbol is not bound in any environment: " + name));
environment_t *i = e;
// search for definition and set if found
for ( ; i != NULL; i = i->outer ) {
if ( i->symbols.find(name) != i->symbols.end() ) {
i->symbols[name] = value;
return nil();
}
}
// only set if NOT found
if ( i == NULL )
e->define(name, value);
return nil();
}
cons_t* proc_mul(cons_t *p, environment_t *env)
{
rational_t product;
product.numerator = 1;
product.denominator = 1;
bool exact = true;
for ( ; !nullp(p); p = cdr(p) ) {
cons_t *i = listp(p)? car(p) : p;
if ( integerp(i) ) {
product *= i->number.integer;
if ( !i->number.exact ) exact = false;
} else if ( rationalp(i) ) {
if ( !i->number.exact ) exact = false;
product *= i->number.rational;
} else if ( realp(i) ) {
// automatically convert; perform rest of computation in floats
exact = false;
return proc_mulf(cons(real(product), p), env);
} else
raise(runtime_exception("Cannot multiply integer with " + to_s(type_of(i)) + ": " + sprint(i)));
}
return rational(product, exact);
}
/// Creates a new OpenGL texture object in \p context for \p texture
/// with \p flags.
///
/// \see_opencl_ref{clCreateFromGLTexture}
opengl_texture(const context &context,
GLenum texture_target,
GLint miplevel,
GLuint texture,
cl_mem_flags flags = read_write)
{
cl_int error = 0;
#ifdef CL_VERSION_1_2
m_mem = clCreateFromGLTexture(context,
flags,
texture_target,
miplevel,
texture,
&error);
#else
m_mem = clCreateFromGLTexture2D(context,
flags,
texture_target,
miplevel,
texture,
&error);
#endif
if(!m_mem){
BOOST_THROW_EXCEPTION(runtime_exception(error));
}
}
extern "C" cons_t* proc_signal(cons_t* p, environment_t*)
{
assert_length(p, 2);
assert_type(INTEGER, car(p));
assert_type(CLOSURE, cadr(p));
integer_t sig = car(p)->number.integer;
closure_t* func = cadr(p)->closure;
if ( sig<0 || sig > SIGHANDLERS )
raise(runtime_exception(format("Invalid signal: %d", sig)));
if ( SIG_ERR == set_handler(sig, func) )
raise(runtime_exception(format("signal: %s", strerror(errno))));
return nil();
}
texture *font_impl::get_glyph(const wchar_t ch) const
{
shared_pointer<texture> tex = glyph_textures[ch];
if (!tex.ptr())
{
int minx, maxx, miny, maxy, advance;
if (TTF_GlyphMetrics(static_cast<TTF_Font *>(ttf_font_ptr), ch, &minx, &maxx, &miny, &maxy, &advance) == -1)
throw runtime_exception(L"Error getting glyph metrics: %hs", TTF_GetError());
SDL_Color c;
c.r = static_cast<Uint8>(fg[color::COMPONENT_RED] * 255.0f);
c.g = static_cast<Uint8>(fg[color::COMPONENT_GREEN] * 255.0f);
c.b = static_cast<Uint8>(fg[color::COMPONENT_BLUE] * 255.0f);
SDL_Surface *surf1 = TTF_RenderGlyph_Blended(static_cast<TTF_Font *>(ttf_font_ptr), ch, c);
SDL_Surface *surf2 = SDL_CreateRGBSurface(SDL_SWSURFACE, nearest_power_2(minx + surf1->w), texture_height, 32, surf1->format->Rmask, surf1->format->Gmask, surf1->format->Bmask, surf1->format->Amask);
if (!surf2)
throw runtime_exception(L"Unable to create SDL surface: %hs", SDL_GetError());
SDL_Rect dest;
dest.x = minx > 0 ? minx : 0;
dest.y = (surf2->h - font_height) + (font_ascent - maxy);
dest.w = surf1->w;
dest.h = surf1->h;
clear_pixel_alpha(surf2);
src_alpha_blit(surf1, surf2, dest.x, dest.y);
string glyph_id = string::format(L"%ls %d: %lc", face.w_string(), size, ch);
tex = new texture(FONT_TEXTURE_CATEGORY, surf2, texture::TEXTURE_ENV_REPLACE | texture::TEXTURE_WRAP_CLAMP | texture::TEXTURE_FILTER_LINEAR, texture::TEXTURE_COLORMAP, glyph_id.w_string());
glyph_textures[ch] = tex;
glyph_pct_x[ch] = static_cast<float>(advance) / static_cast<float>(surf2->w);
glyph_pct_y[ch] = static_cast<float>(font_height) / static_cast<float>(surf2->h);
glyph_widths[ch] = static_cast<float>(advance);
SDL_FreeSurface(surf2);
SDL_FreeSurface(surf1);
}
return tex.ptr();
} // font_impl::get_glyph()
/**
* In case BOOST_COMPUTE_USE_OFFLINE_CACHE macro is defined,
* the compiled binary is stored for reuse in the offline cache located in
* $HOME/.boost_compute on UNIX-like systems and in %APPDATA%/boost_compute
* on Windows.
*/
static program build_with_source(
const std::string &source,
const context &context,
const std::string &options = std::string()
)
{
#ifdef BOOST_COMPUTE_USE_OFFLINE_CACHE
// Get hash string for the kernel.
std::string hash;
{
device d(context.get_device());
platform p(d.get_info<cl_platform_id>(CL_DEVICE_PLATFORM));
std::ostringstream src;
src << "// " << p.name() << " v" << p.version() << "\n"
<< "// " << context.get_device().name() << "\n"
<< "// " << options << "\n\n"
<< source;
hash = detail::sha1(src.str());
}
// Try to get cached program binaries:
try {
boost::optional<program> prog = load_program_binary(hash, context);
if (prog) {
prog->build(options);
return *prog;
}
} catch (...) {
// Something bad happened. Fallback to normal compilation.
}
// Cache is apparently not available. Just compile the sources.
#endif
const char *source_string = source.c_str();
cl_int error = 0;
cl_program program_ = clCreateProgramWithSource(context,
uint_(1),
&source_string,
0,
&error);
if(!program_){
BOOST_THROW_EXCEPTION(runtime_exception(error));
}
program prog(program_, false);
prog.build(options);
#ifdef BOOST_COMPUTE_USE_OFFLINE_CACHE
// Save program binaries for future reuse.
save_program_binary(hash, prog);
#endif
return prog;
}
void shader_program::load()
{
if (!opengl_id)
{
opengl_id = glCreateProgram(); CHECK_GL_ERRORS();
if (!opengl_id && opengl_id != GL_INVALID_VALUE)
throw runtime_exception(L"Unable to create shader program.");
// compile shaders
for (list<shader_base *>::iterator i = shaders.iter(); i.is_valid(); ++i)
{
(*i)->compile();
}
// add shaders
for (list<shader_base *>::iterator i = shaders.iter(); i.is_valid(); ++i)
{
glAttachShader(opengl_id, (*i)->get_id()); CHECK_GL_ERRORS();
}
// validate
int len, status;
smart_pointer<char, true> buf(new char[INFO_BUF_SIZE]);
glValidateProgram(opengl_id); //CHECK_GL_ERRORS();
glGetProgramiv(opengl_id, GL_VALIDATE_STATUS, &status);
if (status == GL_FALSE)
{
glGetProgramInfoLog(opengl_id, INFO_BUF_SIZE, &len, buf);
throw runtime_exception(string(buf).w_string());
}
// link
glLinkProgram(opengl_id); //CHECK_GL_ERRORS();
glGetProgramiv(opengl_id, GL_LINK_STATUS, &status);
if (!status)
{
glGetProgramInfoLog(opengl_id, INFO_BUF_SIZE, &len, buf);
throw runtime_exception(string(buf).w_string());
}
}
} // shader_program::load()
static void handle_run_simulation(button *b)
{
simulation_tab *stab = dynamic_cast<simulation_tab *>(b->get_parent());
if (!stab)
throw internal_exception(__FILE__, __LINE__, L"Run Simulation button is not correctly parented.");
// create new simulation if necessary
config_record *sim_rec = stab->current_sim_record;
if (!sim_rec)
{
string fname = get_temp_sim_fname();
if (file::exists(fname))
file::remove(fname);
// initialize file
{
file f(fname);
smart_pointer<ft_stream> s(f.open_text(io::FILE_OPEN_WRITE));
*s << L"<simulation name=\"Running Simulation\"></simulation>";
}
sim_rec = new config_record(fname);
}
// insert time node if necessary
config_record & time_param = sim_rec->get_child(L"start_time");
if (time_param.get_text().is_empty())
{
time_param.get_text() = string::format(L"%f", stab->get_time_box()->get_jdn());
}
// insert view node if necessary
config_record & view_param = sim_rec->get_child(L"viewpoint");
if (view_param.get_text().is_empty())
{
node *n = reinterpret_cast<node *>(stab->get_view_box()->get_scenery_box()->get_selected_node()->get_user_data());
assert(n);
view_param[L"parent"] = n->get_name();
}
// save simulation record, and run
string fname = sim_rec->get_file().get_full_path();
sim_rec->save();
delete sim_rec;
sim_rec = 0;
periapsis_app *app = dynamic_cast<periapsis_app *>(application::global_instance());
if (app)
{
app->load_and_run_simulation(fname, app->get_sim_context(), app->get_draw_context());
}
else
{
throw runtime_exception(L"You cannot run a Periapsis simulation within a different application!");
}
} // handle_run_simulation()
/* 64/64 -> 64 signed division */
int64_t HELPER(divs64)(CPUS390XState *env, int64_t a, int64_t b)
{
/* Catch divide by zero, and non-representable quotient (MIN / -1). */
if (b == 0 || (b == -1 && a == (1ll << 63))) {
runtime_exception(env, PGM_FIXPT_DIVIDE, GETPC());
}
env->retxl = a % b;
return a / b;
}
float font_impl::calc_width(const string & str) const
{
int w, h;
if (TTF_SizeUTF8(static_cast<TTF_Font *>(ttf_font_ptr), str.c_string(), &w, &h) != -1)
return static_cast<float>(w);
else
throw runtime_exception(L"%hs", TTF_GetError());
} // font_impl::calc_width()
cons_t* proc_modulo(cons_t* p, environment_t*)
{
assert_length(p, 2);
cons_t *a = car(p),
*b = cadr(p);
assert_type(INTEGER, a);
assert_type(INTEGER, b);
if ( b->number.integer == 0 )
raise(runtime_exception("Division by zero"));
if ( b->number.integer < 0 )
raise(runtime_exception("Negative modulus operations not implemented")); // TODO
return integer(a->number.integer % b->number.integer);
}
rational_t operator/(const rational_t& n, const rational_t& d)
{
if ( d.numerator == 0 )
raise(runtime_exception("Division by zero"));
rational_t q(n);
q /= d;
return q;
}
/* 64/32 -> 32 unsigned division */
uint64_t HELPER(divu32)(CPUS390XState *env, uint64_t a, uint64_t b64)
{
uint32_t ret, b = b64;
uint64_t q;
if (b == 0) {
runtime_exception(env, PGM_FIXPT_DIVIDE, GETPC());
}
ret = q = a / b;
env->retxl = a % b;
/* Catch non-representable quotient. */
if (ret != q) {
runtime_exception(env, PGM_FIXPT_DIVIDE, GETPC());
}
return ret;
}
integer_t to_i(const char* s, int radix)
{
if ( s == NULL )
raise(runtime_exception("Cannot convert NULL to INTEGER"));
int has_sign = (char_in(*s, "+-"));
int sign = (s[0]=='-'? -1 : 1);
return sign * atoi(has_sign + s, radix);
}
cons_t* proc_env_parent(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_type(ENVIRONMENT, car(p));
if ( car(p)->environment->outer == NULL )
raise(runtime_exception("Environment has no parent"));
return environment(car(p)->environment->outer);
}
