/* * mzcrypto: crypto library for mzscheme * Copyright (C) 2007 Dimitris Vyzovitis * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, * USA */ #include "escheme.h" #ifdef MZ_PRECISE_GC START_XFORM_SKIP; #endif static Scheme_Object* offset_ptr( int argc, Scheme_Object** argv ) { Scheme_Object* o; o = scheme_malloc_tagged( sizeof(Scheme_Simple_Object) ); o->type = scheme_cpointer_type; SCHEME_CPTR_VAL(o) = SCHEME_BYTE_STR_VAL( argv[1] ) + SCHEME_INT_VAL( argv[2] ); SCHEME_CPTR_TYPE(o) = argv[0]; return o; } #ifdef MZ_PRECISE_GC END_XFORM_SKIP; #endif Scheme_Object* scheme_reload( Scheme_Env* env ) { Scheme_Env* module; module = scheme_primitive_module( scheme_intern_symbol( "_compat" ), env ); scheme_add_global( "offset-ptr", scheme_make_prim_w_arity( offset_ptr, "offset-ptr", 3, 3 ), module ); scheme_finish_primitive_module( module ); return scheme_void; } Scheme_Object* scheme_initialize( Scheme_Env* env ) { return scheme_reload( env ); } Scheme_Object* scheme_module_name() { return scheme_intern_symbol( "_compat" ); }