public output_procedure_port(procedure p, procedure f, procedure c)
: base(new MemoryStream(), foreign.getbytes( "string" ))
{
proc = p;
flushproc = f;
closeproc = c;
}
public generic(int index, int arity, int size, procedure proc)
{
this.index = index;
this.eval = unspecified._unspecified;
this.arity = arity;
this.env = new Object[size];
this.proc = proc;
}
public static Object __EVMEANING_ADDRESS_REF( procedure f )
{
return f.funcall0();
}
public static Object[] sort_vector( Object[] v, procedure p )
{
int n = v.Length;
for ( int incr= n/2 ; incr != 0 ; incr/=2 )
for ( int i= incr ; i<n ; ++i )
for ( int j= i-incr ; j >= 0 ; j-= incr )
if (p.funcall2( v[j], v[j+incr] ) != bbool.faux)
break;
else
{
Object tmp = v[j + incr];
v[j + incr]= v[j];
v[j]= tmp;
}
return v;
}
public static Object PROCEDURE_SET( procedure p, int i, Object o )
{
p.env[i]= o;
return unspecified._unspecified;
}
public static int PROCEDURE_LENGTH( procedure p )
{
return p.env.Length;
}
public static Object PROCEDURE_ATTR_SET(procedure p, Object v)
{
p.eval = v;
return v;
}
public static int PROCEDURE_ARITY( procedure p )
{
return p.arity;
}
public static procedure buildproc( procedure p, int i, int a, int n )
{
p.index= i;
p.arity= a;
p.env= new Object[n];
return p;
}
public static Object bgl_time( procedure p )
{
bgldynamic env = BGL_CURRENT_DYNAMIC_ENV();
DateTime start = DateTime.Now;
TimeSpan duration;
Object res;
res = p.funcall0();
duration = DateTime.Now - start;
env.mvalues_number = 4;
env.mvalues_values[ 1 ] = BINT( duration.Milliseconds );
env.mvalues_values[ 2 ] = BINT( 0 );
env.mvalues_values[ 3 ] = BINT( 0 );
return res;
}
public static byte[] bgl_procedure_entry_to_string(procedure p)
{
fail( "procedure-entry->string", "not impleemented", p );
return getbytes( "" );
}
public static Object bgl_open_output_procedure(procedure p,
procedure f,
procedure c,
byte[] buf)
{
return new output_procedure_port(p, f, c);
}
public static Object bgl_open_input_procedure( procedure p, byte[] b )
{
return new input_procedure_port( p, b );
}
public static Object bgl_open_input_gzip_port( procedure p, input_port n, byte[] b )
{
return new input_gzip_port( p, n, b );
}
public static procedure bgl_make_generic( procedure p )
{
return new generic( p.index, p.arity, 3, p );
}
public static void INPUT_PORT_CHOOK_SET(input_port o, procedure p)
{
o.chook = p;
}
public static void OUTPUT_PORT_CHOOK_SET(output_port o, procedure p)
{
o.chook = p;
}
public static Object call_cc( procedure p )
{
exit saved= (exit)bgldynamic.abgldynamic.get().exitd_top;
exit me= (exit) setexit();
Object r;
PUSH_EXIT( me, 1 );
try
{
if (PROCEDURE_CORRECT_ARITYP( p, 1 ))
{
r= p.funcall1( new callcc() );
bgldynamic.abgldynamic.get().exitd_top= saved;
}
else
{
r= null;
fail( "call/cc", "Wrong arity", p );
}
}
catch (bexception x)
{
r= debug_handler( x, me );
bgldynamic.abgldynamic.get().exitd_top= saved;
}
return r;
}
public static Object PROCEDURE_ATTR(procedure p)
{
return p.eval;
}
public static Object eval_apply( procedure fun,
Object list )
{
return fun.apply( list );
}
public static bool PROCEDURE_CORRECT_ARITYP( procedure p, int i )
{
int arity = p.arity;
return ((arity == i) || ((arity < 0) && (-i-1 <= arity)));
}
public static Object eval_funcall_0( procedure fun )
{
return fun.funcall0();
}
public static Object PROCEDURE_REF( procedure p, int i )
{
return p.env[i];
}
public static Object eval_funcall_1( procedure fun,
Object a0 )
{
return fun.funcall1( a0 );
}
// CARE ?!?!
public static Object PUSH_BEFORE( procedure p )
{
return null;
}
public static Object eval_funcall_2( procedure fun,
Object a0,
Object a1 )
{
return fun.funcall2( a0, a1 );
}
public static void BGL_CURRENT_DISPLAY_SET(procedure disp)
{
bgldynamic.abgldynamic.get().current_display=disp;
}
public static Object eval_funcall_3( procedure fun,
Object a0,
Object a1,
Object a2 )
{
return fun.funcall3( a0, a1, a2 );
}
public static Object __EVMEANING_ADDRESS_SET( procedure f,
Object v )
{
f.funcall1( v );
return unspecified._unspecified;
}
public static Object eval_funcall_4( procedure fun,
Object a0,
Object a1,
Object a2,
Object a3 )
{
return fun.funcall4( a0, a1, a2, a3 );
}
