File: misc.c

package info (click to toggle)
neko 1.8.1-6
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 2,116 kB
  • sloc: ansic: 16,707; makefile: 125; sh: 37; xml: 4
file content (226 lines) | stat: -rwxr-xr-x 6,438 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
/* ************************************************************************ */
/*																			*/
/*  Neko Standard Library													*/
/*  Copyright (c)2005 Motion-Twin											*/
/*																			*/
/* 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 or the LICENSE file for more details.		*/
/*																			*/
/* ************************************************************************ */
#include <neko_vm.h>

/**
	<doc>
	<h1>Misc</h1>
	<p>
	Misc. functions for different usages.
	</p>
	</doc>
**/

/**
	float_bytes : number -> bigendian:bool -> string
	<doc>Returns the 4 bytes representation of the number as an IEEE 32-bit float</doc>
**/
static value float_bytes( value n, value be ) {
	float f;
	val_check(n,number);
	val_check(be,bool);
	f = (float)val_number(n);
	if( neko_is_big_endian() != val_bool(be) ) {
		char *c = (char*)&f;
		char tmp;
		tmp = c[0];	c[0] = c[3]; c[3] = tmp;
		tmp = c[1];	c[1] = c[2]; c[2] = tmp;
	}
	return copy_string((char *)&f,4);
}

/**
	double_bytes : number -> bigendian:bool -> string
	<doc>Returns the 8 bytes representation of the number as an IEEE 64-bit float</doc>
**/
static value double_bytes( value n, value be ) {
	double f;
	val_check(n,number);
	val_check(be,bool);
	f = (double)val_number(n);
	if( neko_is_big_endian() != val_bool(be) ) {
		char *c = (char*)&f;
		char tmp;
		tmp = c[0]; c[0] = c[7]; c[7] = tmp;
		tmp = c[1];	c[1] = c[6]; c[6] = tmp;
		tmp = c[2]; c[2] = c[5]; c[5] = tmp;
		tmp = c[3];	c[3] = c[4]; c[4] = tmp;
	}
	return copy_string((char*)&f,8);
}

/**
	float_of_bytes : string -> bigendian:bool -> float
	<doc>Returns a float from a 4 bytes IEEE 32-bit representation</doc>
**/
static value float_of_bytes( value s, value be ) {
	float f;
	val_check(s,string);
	val_check(be,bool);
	if( val_strlen(s) != 4 )
		neko_error();
	f = *(float*)val_string(s);
	if( neko_is_big_endian() != val_bool(be) ) {
		char *c = (char*)&f;
		char tmp;
		tmp = c[0];	c[0] = c[3]; c[3] = tmp;
		tmp = c[1];	c[1] = c[2]; c[2] = tmp;
	}
	return alloc_float(f);
}

/**
	double_of_bytes : string -> bigendian:bool -> float
	<doc>Returns a float from a 8 bytes IEEE 64-bit representation</doc>
**/
static value double_of_bytes( value s, value be ) {
	double f;
	val_check(s,string);
	val_check(be,bool);
	if( val_strlen(s) != 8 )
		neko_error();
	f = *(double*)val_string(s);
	if( neko_is_big_endian() != val_bool(be) ) {
		char *c = (char*)&f;
		char tmp;
		tmp = c[0]; c[0] = c[7]; c[7] = tmp;
		tmp = c[1];	c[1] = c[6]; c[6] = tmp;
		tmp = c[2]; c[2] = c[5]; c[5] = tmp;
		tmp = c[3];	c[3] = c[4]; c[4] = tmp;
	}
	return alloc_float(f);
}

/**
	run_gc : major:bool -> void
	<doc>Run the Neko garbage collector</doc>
**/
static value run_gc( value b ) {
	val_check(b,bool);
	if( val_bool(b) )
		neko_gc_major();
	else
		neko_gc_loop();
	return val_null;
}

/**
	gc_stats : void -> { heap => int, free => int }
	<doc>Return the size of the GC heap and the among of free space, in bytes</doc>
**/
static value gc_stats() {
	int heap, free;
	value o;
	neko_gc_stats(&heap,&free);
	o = alloc_object(NULL);
	alloc_field(o,val_id("heap"),alloc_int(heap));
	alloc_field(o,val_id("free"),alloc_int(free));
	return o;
}

/**
	enable_jit : ?bool -> ?bool
	<doc>Enable or disable the JIT. Calling enable_jit(null) tells if JIT is enabled or not</doc>
**/
static value enable_jit( value b ) {
	if( val_is_null(b) )
		return alloc_bool(neko_vm_jit(neko_vm_current(),-1));
	val_check(b,bool);
	neko_vm_jit(neko_vm_current(),val_bool(b));
	return val_null;
}

/**
	test : void -> void
	<doc>The test function, to check that library is reachable and correctly linked</doc>
**/
static value test() {
	val_print(alloc_string("Calling a function inside std library...\n"));
	return val_null;
}

/**
	print_redirect : function:1? -> void
	<doc>
	Set a redirection function for all printed values. 
	Setting it to null will cancel the redirection and restore previous printer.
	</doc>
**/

static void print_callback( const char *s, int size, void *f ) {	
	val_call1(f,copy_string(s,size));
}

static value print_redirect( value f ) {
	neko_vm *vm = neko_vm_current();
	if( val_is_null(f) ) {
		neko_vm_redirect(vm,NULL,NULL);
		return val_null;
	}
	val_check_function(f,1);
	neko_vm_redirect(vm,print_callback,f);
	return val_null;
}

/**
	set_trusted : bool -> void
	<doc>
	Change the trusted mode of the VM.
	This can optimize some operations such as module loading by turning off some checks.
	</doc>
**/
static value set_trusted( value b ) {
	val_check(b,bool);
	neko_vm_trusted(neko_vm_current(),val_bool(b));
	return val_null;
}

/**
	same_closure : any -> any -> bool
	<doc>
	Compare two functions by checking that they refer to the same implementation and that their environments contains physically equal values.
	</doc>
**/
static value same_closure( value _f1, value _f2 ) {
	vfunction *f1 = (vfunction*)_f1;
	vfunction *f2 = (vfunction*)_f2;
	int i;
	if( !val_is_function(f1) || !val_is_function(f2) )
		return val_false;
	if( f1 == f2 )
		return val_true;
	if( f1->nargs != f2->nargs || f1->addr != f2->addr || f1->module != f2->module || val_array_size(f1->env) != val_array_size(f2->env) )
		return val_false;
	for(i=0;i<val_array_size(f1->env);i++)
		if( val_array_ptr(f1->env)[i] != val_array_ptr(f2->env)[i] )
			return val_false;
	return val_true;
}

DEFINE_PRIM(float_bytes,2);
DEFINE_PRIM(double_bytes,2);
DEFINE_PRIM(float_of_bytes,2);
DEFINE_PRIM(double_of_bytes,2);
DEFINE_PRIM(run_gc,1);
DEFINE_PRIM(gc_stats,0);
DEFINE_PRIM(enable_jit,1);
DEFINE_PRIM(test,0);
DEFINE_PRIM(print_redirect,1);
DEFINE_PRIM(set_trusted,1);
DEFINE_PRIM(same_closure,2);

/* ************************************************************************ */