nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Change bytecode from 'frame' vars to 'transient' values. 

Each transient identifies the value of the corresponding previous bytecode.
This change (a) frees up many bytecodes formerly used by the conditional
expression (if c t f); (b) regularizes the bytecode by always placing opcodes
before operands; and (c) causes the bytecode to conform to the Single Static
Assignment (SSA) form preferred by e.g. LLVM.

Includes updates to the hand-assembled files (*.rla) and the bytecode compiler.
This commit is contained in:
Jesse D. McDonald 2011-04-10 13:50:11 -05:00
parent 6da373201c
commit be48535995
34 changed files with 820 additions and 882 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
builtin.c
View File

@ -135,14 +135,14 @@ static void bi_string_to_number(interp_state_t *state)
value_t rval;
str = value_to_string(CAR(state->argv.value));
num = strtol(str, &end, 0);
free(str);
num = (fixnum_t)strtoll(str, &end, 0);
if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num))
rval = fixnum_value(num);
else
rval = FALSE_VALUE;
free(str);
interp_return_values(state, cons(rval, NIL));
}

14
builtin.h
View File

@ -25,19 +25,17 @@
/* Lambda: Instances of this structure are fundamental callable objects. */
#define LAMBDA_SLOT_GLOBAL_VARS 0
#define LAMBDA_SLOT_INSTANCE_VARS 1
#define LAMBDA_SLOT_FRAME_VARS 2
#define LAMBDA_SLOT_BYTE_CODE 3
#define LAMBDA_SLOT_TAIL_CALL 4
#define LAMBDA_SLOTS 5
#define LAMBDA_SLOT_BYTE_CODE 2
#define LAMBDA_SLOT_TAIL_CALL 3
#define LAMBDA_SLOTS 4
/* Template: Instances of this structure describe what a LAMBDA
* will look like when instanciated with the 'lambda' bytecode. */
#define TEMPLATE_SLOT_GLOBAL_VARS 0
#define TEMPLATE_SLOT_INSTANCE_VARS 1
#define TEMPLATE_SLOT_FRAME_VARS 2
#define TEMPLATE_SLOT_BYTE_CODE 3
#define TEMPLATE_SLOT_TAIL_CALL 4
#define TEMPLATE_SLOTS 5
#define TEMPLATE_SLOT_BYTE_CODE 2
#define TEMPLATE_SLOT_TAIL_CALL 3
#define TEMPLATE_SLOTS 4
value_t get_lambda_type(void);
value_t get_template_type(void);

310
doc/bytecode.txt
View File

@ -1,171 +1,164 @@
top:
00xxxxxx out in in: expression
01xxxxxx in in in: statement
1xxxxxxx out in in: conditional
expression: up to 64, 1 out, 2 in
00000000 out sub in: unary-expr
00xxxxxx out in in: binary-expr, x > 1
unary-expr: up to 255, 1 out, 1 in
00 invalid / permanently reserved
expression: up to 256, 3 in, no prefix
00 sub in in: binary-expr
01 (set! out in)
02 (set! out (unbox in))
03 (set! out (car in))
04 (set! out (cdr in))
05 (set! out (weak-unbox in))
10 (if in1 in2 in3) ; in3 if in1 == #f, in2 otherwise
08 (set! out (boolean? in)) ; value => bool
09 (set! out (fixnum? in)) ; value => bool
0a (set! out (box? in)) ; value => bool
0b (set! out (pair? in)) ; value => bool
0c (set! out (vector? in)) ; value => bool
0d (set! out (byte-string? in)) ; value => bool
0e (set! out (struct? in)) ; value => bool
0f (set! out (float? in)) ; value => bool
10 (set! out (builtin? in)) ; value => bool
11 (set! out (weak-box? in)) ; value => bool
20 (vector-set! in1 in2 in3) ; vector n value, 0 <= n < nelem; ==> in3
21 (byte-string-set! in1 in2 in3) ; string n value, 0 <= n < nbytes; ==> in3
22 (struct-set! in1 in2 in3) ; struct n value, 0 <= n < nslots; ==> in3
18 (set! out (make-box in)) ; value => box
19 (set! out (make-struct in)) ; metastruct => struct
1a (set! out (make-float in)) ; fixnum => float
1b (set! out (make-lambda in)) ; template-or-lambda => lambda
1c (set! out (make-weak-box in)) ; value => weak-box
binary-expr: up to 256, 2 in, prefix = 00
00 sub in: unary-expr
20 (set! out (not in)) ; if in == #f then #t else #f
21 (set! out (bit-not in)) ; one's complement / bitwise negation
22 (set! out (fix- in)) ; two's complement / arithmetic negation
23 (set! out (float- in)) ; floating-point negation
01 (eq? in1 in2) ; any values; superset of fix=
02 (cons in1 in2) ; car cdr
03 (make-vector in1 in2) ; nelem iv, nelem >= 0
04 (make-byte-string in1 in2) ; nbytes iv, nbytes >= 0
05 (vector-ref in1 in2) ; vector n, 0 <= n < nelem
06 (byte-string-ref in1 in2) ; string n, 0 <= n < nbytes
07 (struct-ref in1 in2) ; struct n, 0 <= n < nslots
28 (set! out (vector-size in))
29 (set! out (byte-string-size in))
2a (set! out (struct-nslots in))
2b (set! out (struct-type in))
2c (set! out (hash-value in))
08 (fix+ in1 in2)
09 (fix- in1 in2)
0a (fix* in1 in2)
0b (fix/ in1 in2)
0c (fix% in1 in2)
0d (fix< in1 in2) ; == (fix> in2 in1)
0e (fix>= in1 in2) ; == (fix<= in2 in1)
10 (bit-and in1 in2)
11 (bit-or in1 in2)
12 (bit-xor in1 in2)
14 (fix<< in1 in2) ; logical/arithmetic left-shift (2*x) w/ overflow into sign
15 (fix>> in1 in2) ; arithmetic right-shift (x/2)
16 (fix>>> in1 in2) ; logical right-shift; sign becomes zero (+)
18 (float+ in1 in2)
19 (float- in1 in2)
1a (float* in1 in2)
1b (float/ in1 in2)
1c (float= in1 in2)
1d (float< in1 in2) ; == (float> in2 in1)
1e (float>= in1 in2) ; == (float<= in2 in1)
20 (atan2 in1 in2) ; float float
21 (pow in1 in2) ; float float
22 (ldexp in1 in2) ; float fixnum
23 (fmod in1 in2) ; float float
24 (hypot in1 in2) ; float float
25 (jn in1 in2) ; fixnum float
26 (yn in1 in2) ; fixnum float
27 (nextafter in1 in2) ; float float
28 (remainder in1 in2) ; float float
29 (scalb in1 in2) ; float float
30 (kind-of? in1 in2) ; value struct-type ==> boolean
31 (byte-string= in1 in2)
32 (byte-string< in1 in2) ; == (byte-string> in2 in1)
33 (byte-string>= in1 in2) ; == (byte-string<= in2 in1)
50 (set-box! in1 in2) ; box value ==> in2
51 (set-car! in1 in2) ; pair value ==> in2
52 (set-cdr! in1 in2) ; pair value ==> in2
70 (tail-call-if in1 in2) ; flag byte-string, perform tail call (in2) if in1 != #f
unary-expr: up to 256, 1 in, prefix = 00 00
00 (fatal-error in) ; signal fatal error; annotated with 'in' if non-nil
01 (unbox in)
02 (weak-unbox in)
03 (car in)
04 (cdr in)
08 (boolean? in) ; value ==> bool
09 (fixnum? in) ; value ==> bool
0a (box? in) ; value ==> bool
0b (pair? in) ; value ==> bool
0c (vector? in) ; value ==> bool
0d (byte-string? in) ; value ==> bool
0e (struct? in) ; value ==> bool
0f (float? in) ; value ==> bool
10 (builtin? in) ; value ==> bool
11 (weak-box? in) ; value ==> bool
18 (make-box in) ; value ==> box
19 (make-struct in) ; metastruct ==> struct
1a (make-float in) ; fixnum ==> float
1b (make-lambda in) ; template-or-lambda ==> lambda
1c (make-weak-box in) ; value ==> weak-box
20 (not in) ; if in == #f then #t else #f
21 (bit-not in) ; one's complement / bitwise negation
22 (fix- in) ; two's complement / arithmetic negation
23 (float- in) ; floating-point negation
28 (vector-size in)
29 (byte-string-size in)
2a (struct-nslots in)
2b (struct-type in)
2c (hash-value in)
; ISO C floating-point
30 (set! out (acos in))
31 (set! out (asin in))
32 (set! out (atan in))
33 (set! out (cos in))
34 (set! out (sin in))
35 (set! out (tan in))
36 (set! out (cosh in))
37 (set! out (sinh in))
38 (set! out (tanh in))
39 (set! out (exp in))
3a (set! out (frexp in)) ; float => (float . fixnum)
3b (set! out (log in)) ; base e
3c (set! out (log10 in))
3d (set! out (modf in)) ; float => (float . float)
3e (set! out (sqrt in))
3f (set! out (ceil in))
40 (set! out (fabs in))
41 (set! out (floor in))
30 (acos in)
31 (asin in)
32 (atan in)
33 (cos in)
34 (sin in)
35 (tan in)
36 (cosh in)
37 (sinh in)
38 (tanh in)
39 (exp in)
3a (frexp in) ; float ==> (float . fixnum)
3b (log in) ; base e
3c (log10 in)
3d (modf in) ; float ==> (float . float)
3e (sqrt in)
3f (ceil in)
40 (fabs in)
41 (floor in)
; SVID & X/Open
50 (set! out (erf in))
51 (set! out (erfc in))
; (set! out (gamma in)) ; obsolete
52 (set! out (j0 in))
53 (set! out (j1 in))
54 (set! out (lgamma in)) ; float => (float . fixnum), actually lgamma_r
55 (set! out (y0 in))
56 (set! out (y1 in))
50 (erf in)
51 (erfc in)
; (gamma in) ; obsolete
52 (j0 in)
53 (j1 in)
54 (lgamma in) ; float ==> (float . fixnum), actually lgamma_r
55 (y0 in)
56 (y1 in)
; SVID & XPG 4.2/5
57 (set! out (asinh in))
58 (set! out (acosh in))
59 (set! out (atanh in))
5a (set! out (cbrt in))
5b (set! out (logb in))
57 (asinh in)
58 (acosh in)
59 (atanh in)
5a (cbrt in)
5b (logb in)
; XPG 4.2/5
5c (set! out (expm1 in))
5d (set! out (ilogb in))
5e (set! out (log1p in))
; (set! out (rint in)) ; implies changing rounding mode; use floor or ceil
5c (expm1 in)
5d (ilogb in)
5e (log1p in)
; (rint in) ; implies changing rounding mode; use floor or ceil
; C99
70 (set! out (normal? in))
71 (set! out (finite? in))
72 (set! out (subnormal? in))
73 (set! out (infinite? in))
74 (set! out (nan? in))
binary-expr: up to 63 (01..3f), 1 out, 2 in
00 unary-expr
01 (set! out (eq? in1 in2)) ; any values; superset of fix=
02 (set! out (cons in1 in2)) ; car cdr
03 (set! out (make-vector in1 in2)) ; nelem iv, nelem >= 0
04 (set! out (make-byte-string in1 in2)) ; nbytes iv, nbytes >= 0
05 (set! out (vector-ref in1 in2)) ; vector n, 0 <= n < nelem
06 (set! out (byte-string-ref in1 in2)) ; string n, 0 <= n < nbytes
07 (set! out (struct-ref in1 in2)) ; struct n, 0 <= n < nslots
08 (set! out (fix+ in1 in2))
09 (set! out (fix- in1 in2))
0a (set! out (fix* in1 in2))
0b (set! out (fix/ in1 in2))
0c (set! out (fix% in1 in2))
0d (set! out (fix< in1 in2)) ; == (fix> in2 in1)
0e (set! out (fix>= in1 in2)) ; == (fix<= in2 in1)
10 (set! out (bit-and in1 in2))
11 (set! out (bit-or in1 in2))
12 (set! out (bit-xor in1 in2))
14 (set! out (fix<< in1 in2)) ; arithmetic left-shift (2*x) w/ overflow into sign
15 (set! out (fix>> in1 in2)) ; arithmetic right-shift (x/2)
16 (set! out (fix>>> in1 in2)) ; logical right-shift; sign becomes zero (+)
18 (set! out (float+ in1 in2))
19 (set! out (float- in1 in2))
1a (set! out (float* in1 in2))
1b (set! out (float/ in1 in2))
1c (set! out (float= in1 in2))
1d (set! out (float< in1 in2)) ; == (float> in2 in1)
1e (set! out (float>= in1 in2)) ; == (float<= in2 in1)
20 (set! out (atan2 in1 in2)) ; float float
21 (set! out (pow in1 in2)) ; float float
22 (set! out (ldexp in1 in2)) ; float fixnum
23 (set! out (fmod in1 in2)) ; float float
24 (set! out (hypot in1 in2)) ; float float
25 (set! out (jn in1 in2)) ; fixnum float
26 (set! out (yn in1 in2)) ; fixnum float
27 (set! out (nextafter in1 in2)) ; float float
28 (set! out (remainder in1 in2)) ; float float
29 (set! out (scalb in1 in2)) ; float float
30 (set! out (kind-of? in1 in2)) ; value struct-type
31 (set! out (byte-string= in1 in2))
32 (set! out (byte-string< in1 in2)) ; == (byte-string> in2 in1)
33 (set! out (byte-string>= in1 in2)) ; == (byte-string<= in2 in1)
conditional: 1 out, 3 in
; 0x80 <= AA <= 0xf7 (f0-f119)
AA (set! AA (if in1 in2 in3)) ; in3 if in1 == #f, in2 otherwise
statement: up to 64 (40..7f), 3 in
; unary statements
40 (goto-end-if in1)
41 (goto-end-unless in1)
; binary statements
50 (set-box! in1 in2) ; box value
51 (set-car! in1 in2) ; pair value
52 (set-cdr! in1 in2) ; pair value
; ternary statements
60 (vector-set! in1 in2 in3) ; vector n value, 0 <= n < nelem
61 (byte-string-set! in1 in2 in3) ; string n value, 0 <= n < nbytes
62 (struct-set! in1 in2 in3) ; struct n value, 0 <= n < nslots
70 (normal? in)
71 (finite? in)
72 (subnormal? in)
73 (infinite? in)
74 (nan? in)
in:
nil (00000000) [g0, always NIL]
gN (00NNNNNN) [global, N < 64]
iN (01NNNNNN) [instance, N < 64]
fN (1NNNNNNN) [frame, N < 120]
-- (1111100N) [reserved, N < 2]
tN (0NNNNNNN) [transient, 0 <= N < 128, one for each prior expression]
gN (10NNNNNN) [global, 0 <= N < 64]
iN (110NNNNN) [instance, 0 <= N < 32]
iN (1110NNNN) [instance, 32 <= N < 48]
#f (11110000) [constant]
undef (11110001) [constant]
nil (11110010) [constant]
-- (1111xxxx) [reserved, 2 <= x < 10]
self (11111010) [current lambda]
argv (11111011) [argument list]
kw-args (11111100) [keyword arguments] (sorted)
@ -173,21 +166,16 @@ in:
ctx (11111110) [dynamic context]
k (11111111) [continuation]
out:
fN (1NNNNNNN) [0 <= N < 120]
lambda:[
global: vector of immutable values (g1..gN); shared between instances (lambdas)
instance: vector of immutable values (i0..iN); shared between frames (calls)
frame: number of frame variables; initially #<undefined>
global: vector of immutable values (g0..gN); shared between instances (lambdas)
instance: vector of immutable values (i0..iN); shared between calls
code: byte-string containing sequence of 4-byte instruction words
tail-call: byte-string of in-refs: (target argv kw-args kw-vals ctx k)
]
template:[
global: linked
instance: byte-string of in-refs. to parent instance/frame slots
frame: copied verbatim
instance: byte-string of in-refs. to parent instance/transient slots
code: linked
tail-call: linked
]
@ -234,7 +222,7 @@ call-with-continuation-prompt:
((meta-continuation) result))))))]))
parameterize:
Call thunk with 'k' and updated context.
New context includes (parameter => value) association.
Call thunk with 'k' and updated context. (No change to original context.)
New context includes (parameter ==> value) association.
# vim:set sw=2 expandtab tw=0:

8
gc.c
View File

@ -1534,6 +1534,10 @@ static void _fprint_value(FILE *f, value_t v, seen_value_t *seen)
{
fputs("#<undefined>", f);
}
else if (v == END_PROGRAM)
{
fputs("#<endp>", f);
}
else if (is_fixnum(v))
{
fprintf(f, "%lld", (long long int)get_fixnum(v));
@ -1693,8 +1697,8 @@ void fprint_gc_stats(FILE *f)
ns2sec(gc_stats.gen[1].total_ns) / gc_stats.gen[1].passes,
ns2sec(gc_stats.gen[1].max_ns));
fprintf(f, "GC: The Gen-1 soft-limit peaked at %d bytes out of %d allocated.\n",
(int)gc_stats.gen1_high_water, (int)gc_gen1_max_size);
fprintf(f, "GC: The Gen-1 soft-limit peaked at %lld bytes out of %lld allocated.\n",
(long long)gc_stats.gen1_high_water, (long long)gc_gen1_max_size);
}
else
{

2
gc.h
View File

@ -194,7 +194,7 @@ typedef struct gc_stats
nsec_t max_gen1_ns;
llsize_t total_freed;
} gen[2];
size_t gen1_high_water;
llsize_t gen1_high_water;
} gc_stats_t;
extern gc_stats_t gc_stats;

587
interp.c
View File

@ -18,9 +18,6 @@
/* Shorthand for frequently-used fields */
#define _LAMBDA_SLOT(v,s) _SLOT_VALUE(LAMBDA, v, s)
#define ST1 (state->in1.value)
#define ST2 (state->in2.value)
#define ST3 (state->in3.value)
/*
* Local helper routines
@ -42,13 +39,11 @@ static void translate_callable(interp_state_t *state);
static void run_byte_code(interp_state_t *state);
static void perform_tail_call(interp_state_t *state);
static value_t eval_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2);
static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uint8_t in);
static value_t get_input(const interp_state_t *state, fixnum_t in);
static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint32_t in3);
static value_t get_input(const interp_state_t *state, fixnum_t var);
static void set_output(const interp_state_t *state, fixnum_t var, value_t val);
static value_t eval_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint8_t in3);
static value_t eval_binary_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2);
static value_t eval_unary_expression(interp_state_t *state, uint8_t code, uint8_t in);
static void register_state(interp_state_t *state, value_t lambda, value_t argv);
static void unregister_state(interp_state_t *state);
@ -76,48 +71,50 @@ value_t run_interpreter(value_t lambda, value_t argv)
* Now 'lambda' really is a lambda structure instance (or builtin).
*/
state.ntransients = 0;
#if 0
fflush(stdout);
fputc('\n', stderr);
fputs("LAMBDA: ", stderr); fprint_value(stderr, state.lambda.value); fputc('\n', stderr);
fputs("ARGLIST: ", stderr); fprint_value(stderr, state.argv.value); fputc('\n', stderr);
fputs("CONTEXT: ", stderr); fprint_value(stderr, state.ctx.value); fputc('\n', stderr);
fputs("CONT'N: ", stderr); fprint_value(stderr, state.k.value); fputc('\n', stderr);
fputc('\n', stderr);
fflush(stderr);
#endif
if (is_builtin_fn(state.lambda.value))
{
/* Builtin functions replace the byte-code and tail-call
* steps; they also do not require frame variables. */
state.nframe = 0;
/* Builtin functions replace the byte-code and tail-call steps. */
_get_builtin_fn(state.lambda.value)(&state);
}
else
{
release_assert(get_struct(state.lambda.value)->immutable);
state.nframe = get_fixnum(_LAMBDA_SLOT(state.lambda.value, FRAME_VARS));
release_assert((0 <= state.nframe) && (state.nframe <= 120));
state.globals.value = _LAMBDA_SLOT(state.lambda.value, GLOBAL_VARS);
state.instances.value = _LAMBDA_SLOT(state.lambda.value, INSTANCE_VARS);
state.byte_code.value = _LAMBDA_SLOT(state.lambda.value, BYTE_CODE);
state.tail_call.value = _LAMBDA_SLOT(state.lambda.value, TAIL_CALL);
release_assert(get_vector(state.globals.value)->immutable);
release_assert(get_vector(state.instances.value)->immutable);
release_assert((state.byte_code.value == FALSE_VALUE) ||
get_byte_string(state.byte_code.value)->immutable);
release_assert(get_byte_string(state.tail_call.value)->immutable);
run_byte_code(&state);
perform_tail_call(&state);
}
/* Clear (used) frame-variable slots so they can be GC'd. */
for (fixnum_t i = 0; i < state.nframe; ++i)
_get_vector(state.frame.value)->elements[i] = UNDEFINED;
/* Clear (used) transient slots so they can be GC'd. */
for (int i = 0; i < state.ntransients; ++i)
_get_vector(state.transients.value)->elements[i] = UNDEFINED;
/* Clear temporaries. */
state.in1.value = UNDEFINED;
state.in2.value = UNDEFINED;
state.in3.value = UNDEFINED;
state.globals.value = UNDEFINED;
state.instances.value = UNDEFINED;
state.byte_code.value = UNDEFINED;
state.tail_call.value = UNDEFINED;
if (run_finalizers)
{
@ -231,7 +228,6 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
/* All but the instance variables are just shallow-copied. */
ls->slots[LAMBDA_SLOT_GLOBAL_VARS] = ts->slots[TEMPLATE_SLOT_GLOBAL_VARS];
ls->slots[LAMBDA_SLOT_FRAME_VARS] = ts->slots[TEMPLATE_SLOT_FRAME_VARS];
ls->slots[LAMBDA_SLOT_BYTE_CODE] = ts->slots[TEMPLATE_SLOT_BYTE_CODE];
ls->slots[LAMBDA_SLOT_TAIL_CALL] = ts->slots[TEMPLATE_SLOT_TAIL_CALL];
ls->immutable = true;
@ -268,262 +264,299 @@ static void translate_callable(interp_state_t *state)
static void run_byte_code(interp_state_t *state)
{
gc_root_t bc_root;
register_gc_root(&bc_root, _LAMBDA_SLOT(state->lambda.value, BYTE_CODE));
if (bc_root.value != FALSE_VALUE)
if (state->byte_code.value != FALSE_VALUE)
{
release_assert(get_byte_string(bc_root.value)->immutable);
release_assert((_get_byte_string(bc_root.value)->size % 4) == 0);
uint8_t byte_code[4*128];
int nwords;
for (size_t offset = 0; (offset+3) < _get_byte_string(bc_root.value)->size; offset += 4)
{
uint32_t word;
uint8_t *bytes = (uint8_t*)&word;
byte_string_t *s = get_byte_string(state->byte_code.value);
release_assert(s->immutable);
release_assert(s->size <= sizeof byte_code);
release_assert((s->size % 4) == 0);
word = *(uint32_t*)(_get_byte_string(bc_root.value)->bytes + offset);
switch (bytes[0])
{
bool cond;
case 0x00 ... 0x3f: /* expression */
set_output(state, bytes[1], eval_expression(state, bytes[0], bytes[2], bytes[3]));
break;
case 0x40 ... 0x41: /* goto-end-if, goto-end-unless */
cond = _get_boolean(get_input(state, bytes[1]));
if ((bytes[0] & 1) ? !cond : cond)
{
goto break_for_loop;
}
break;
case 0x42 ... 0x7f: /* statement */
run_statement(state, bytes[0], bytes[1], bytes[2], bytes[3]);
break;
case 0x80 ... 0xff: /* conditional */
set_output(state, bytes[0],
get_input(state, _get_boolean(get_input(state, bytes[1]))
? bytes[2] : bytes[3]));
break;
}
}
break_for_loop:;
/* Copy byte code to temporary buffer for faster access. */
nwords = s->size / 4;
memcpy(byte_code, s->bytes, s->size);
}
unregister_gc_root(&bc_root);
for (int word = 0; word < nwords; ++word)
{
const uint8_t *bytes = &byte_code[4 * word];
value_t result;
if (bytes[0] == 0x00 && bytes[1] == 0x70) /* (tail-call-if cond tail-call) */
{
/* Must handle this here, as it may end the loop. */
if (_get_boolean(get_input(state, bytes[2])))
{
value_t tc = get_input(state, bytes[3]);
if (tc != FALSE_VALUE) state->tail_call.value = tc;
nwords = word + 1;
}
result = UNDEFINED;
}
else
{
result = eval_expression(state, bytes[0], bytes[1], bytes[2], bytes[3]);
}
#if 0
fflush(stdout);
fprintf(stderr, "t%02d: (%02d) \\x%02x\\x%02x\\x%02x\\x%02x => ",
state->ntransients, word, bytes[0], bytes[1], bytes[2], bytes[3]);
fprint_value(stderr, result);
fputc('\n', stderr);
fflush(stderr);
#endif
_get_vector(state->transients.value)->elements[state->ntransients++] = result;
WRITE_BARRIER(state->transients.value);
}
}
}
static value_t eval_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint8_t in3)
{
if (code == 0x00)
{
return eval_binary_expression(state, in1, in2, in3);
}
else
{
value_t v1 = get_input(state, in1);
value_t v2 = get_input(state, in2);
value_t v3 = get_input(state, in3);
switch (code)
{
case 0x10:
return _get_boolean(v1) ? v2 : v3;
case 0x20:
vector_set(v1, get_fixnum(v2), v3);
return UNDEFINED;
case 0x21:
byte_string_set(v1, get_fixnum(v2), (char)get_fixnum(v3));
return UNDEFINED;
case 0x22:
struct_set(v1, get_fixnum(v2), v3);
return UNDEFINED;
default:
release_assert(NOTREACHED("Invalid ternary byte-code!"));
return UNDEFINED;
}
}
}
static void perform_tail_call(interp_state_t *state)
{
gc_root_t new_lambda, new_argv, new_kw_args, new_kw_vals, new_ctx, new_k;
value_t tail_call = _LAMBDA_SLOT(state->lambda.value, TAIL_CALL);
uint8_t bytes[6];
gc_root_t root;
value_t new_lambda, new_argv, new_kw_args, new_kw_vals, new_ctx, new_k;
release_assert(get_byte_string(tail_call)->immutable);
release_assert(_get_byte_string(tail_call)->size == 6);
release_assert(get_byte_string(state->tail_call.value)->immutable);
release_assert(_get_byte_string(state->tail_call.value)->size == 6);
memcpy(bytes, _get_byte_string(state->tail_call.value)->bytes, 6);
register_gc_root(&new_lambda, get_input(state, _get_byte_string(tail_call)->bytes[0]));
register_gc_root(&new_argv, get_input(state, _get_byte_string(tail_call)->bytes[1]));
register_gc_root(&new_kw_args, get_input(state, _get_byte_string(tail_call)->bytes[2]));
register_gc_root(&new_kw_vals, get_input(state, _get_byte_string(tail_call)->bytes[3]));
register_gc_root(&new_ctx, get_input(state, _get_byte_string(tail_call)->bytes[4]));
register_gc_root(&new_k, get_input(state, _get_byte_string(tail_call)->bytes[5]));
register_gc_root(&root, make_lambda(state, get_input(state, bytes[0])));
new_k = make_lambda(state, get_input(state, bytes[5]));
new_lambda = root.value;
unregister_gc_root(&root);
/* If new lambda or continuation is a template, instantiate it here */
new_lambda.value = make_lambda(state, new_lambda.value);
new_k.value = make_lambda(state, new_k.value);
new_argv = get_input(state, bytes[1]);
new_kw_args = get_input(state, bytes[2]);
new_kw_vals = get_input(state, bytes[3]);
new_ctx = get_input(state, bytes[4]);
/* Transfer control to new function */
state->lambda.value = new_lambda.value;
state->argv.value = new_argv.value;
state->kw_args.value = new_kw_args.value;
state->kw_vals.value = new_kw_vals.value;
state->ctx.value = new_ctx.value;
state->k.value = new_k.value;
unregister_gc_root(&new_lambda);
unregister_gc_root(&new_argv);
unregister_gc_root(&new_kw_args);
unregister_gc_root(&new_kw_vals);
unregister_gc_root(&new_ctx);
unregister_gc_root(&new_k);
/* Transfer control to new function; must be after last get_input() */
state->lambda.value = new_lambda;
state->argv.value = new_argv;
state->kw_args.value = new_kw_args;
state->kw_vals.value = new_kw_vals;
state->ctx.value = new_ctx;
state->k.value = new_k;
}
static value_t eval_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2)
static value_t eval_binary_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2)
{
if (code != 0x00)
if (code == 0x00)
{
ST1 = get_input(state, in1);
ST2 = get_input(state, in2);
return eval_unary_expression(state, in1, in2);
}
else
{
value_t v1 = get_input(state, in1);
value_t v2 = get_input(state, in2);
switch (code)
{
case 0x00: return eval_unary_expression(state, in1, in2);
case 0x01: return boolean_value(ST1 == ST2);
case 0x02: return cons(ST1, ST2);
case 0x03: return make_vector(get_fixnum(ST1), ST2);
case 0x04: return make_byte_string(get_fixnum(ST1), (char)get_fixnum(ST2));
case 0x05: return vector_ref(ST1, get_fixnum(ST2));
case 0x06: return fixnum_value(byte_string_ref(ST1, get_fixnum(ST2)));
case 0x07: return struct_ref(ST1, get_fixnum(ST2));
case 0x08: return fixnum_value(get_fixnum(ST1) + get_fixnum(ST2));
case 0x09: return fixnum_value(get_fixnum(ST1) - get_fixnum(ST2));
case 0x0a: return fixnum_value(get_fixnum(ST1) * get_fixnum(ST2));
case 0x0b: return fixnum_value(get_fixnum(ST1) / get_fixnum(ST2));
case 0x0c: return fixnum_value(get_fixnum(ST1) % get_fixnum(ST2));
case 0x0d: return boolean_value(get_fixnum(ST1) < get_fixnum(ST2));
case 0x0e: return boolean_value(get_fixnum(ST1) >= get_fixnum(ST2));
case 0x10: return fixnum_value(get_fixnum(ST1) & get_fixnum(ST2));
case 0x11: return fixnum_value(get_fixnum(ST1) | get_fixnum(ST2));
case 0x12: return fixnum_value(get_fixnum(ST1) ^ get_fixnum(ST2));
case 0x14: return fixnum_value(get_fixnum(ST1) << get_fixnum(ST2));
case 0x15: return fixnum_value(get_fixnum(ST1) >> get_fixnum(ST2));
case 0x16: return fixnum_value((unsigned long)get_fixnum(ST1) >> get_fixnum(ST2));
case 0x18: return make_float(get_float(ST1) + get_float(ST2));
case 0x19: return make_float(get_float(ST1) - get_float(ST2));
case 0x1a: return make_float(get_float(ST1) * get_float(ST2));
case 0x1b: return make_float(get_float(ST1) / get_float(ST2));
case 0x1c: return boolean_value(get_float(ST1) == get_float(ST2));
case 0x1d: return boolean_value(get_float(ST1) < get_float(ST2));
case 0x1e: return boolean_value(get_float(ST1) >= get_float(ST2));
case 0x20: return make_float(atan2(get_float(ST1), get_float(ST2)));
case 0x21: return make_float(pow(get_float(ST1), get_float(ST2)));
case 0x22: return make_float(ldexp(get_float(ST1), get_fixnum(ST2)));
case 0x23: return make_float(fmod(get_float(ST1), get_float(ST2)));
case 0x24: return make_float(hypot(get_float(ST1), get_float(ST2)));
case 0x25: return make_float(jn(get_fixnum(ST1), get_float(ST2)));
case 0x26: return make_float(yn(get_fixnum(ST1), get_float(ST2)));
case 0x27: return make_float(nextafter(get_float(ST1), get_float(ST2)));
case 0x28: return make_float(remainder(get_float(ST1), get_float(ST2)));
case 0x29: return make_float(scalb(get_float(ST1), get_float(ST2)));
case 0x30: return boolean_value(struct_is_a(ST1, ST2));
case 0x31: return boolean_value(byte_string_cmp(ST1, ST2) == 0);
case 0x32: return boolean_value(byte_string_cmp(ST1, ST2) < 0);
case 0x33: return boolean_value(byte_string_cmp(ST1, ST2) >= 0);
default: release_assert(NOTREACHED("Invalid byte-code!"));
}
case 0x01: return boolean_value(v1 == v2);
case 0x02: return cons(v1, v2);
case 0x03: return make_vector(get_fixnum(v1), v2);
case 0x04: return make_byte_string(get_fixnum(v1), (char)get_fixnum(v2));
case 0x05: return vector_ref(v1, get_fixnum(v2));
case 0x06: return fixnum_value(byte_string_ref(v1, get_fixnum(v2)));
case 0x07: return struct_ref(v1, get_fixnum(v2));
case 0x08: return fixnum_value(get_fixnum(v1) + get_fixnum(v2));
case 0x09: return fixnum_value(get_fixnum(v1) - get_fixnum(v2));
case 0x0a: return fixnum_value(get_fixnum(v1) * get_fixnum(v2));
case 0x0b: return fixnum_value(get_fixnum(v1) / get_fixnum(v2));
case 0x0c: return fixnum_value(get_fixnum(v1) % get_fixnum(v2));
case 0x0d: return boolean_value(get_fixnum(v1) < get_fixnum(v2));
case 0x0e: return boolean_value(get_fixnum(v1) >= get_fixnum(v2));
case 0x10: return fixnum_value(get_fixnum(v1) & get_fixnum(v2));
case 0x11: return fixnum_value(get_fixnum(v1) | get_fixnum(v2));
case 0x12: return fixnum_value(get_fixnum(v1) ^ get_fixnum(v2));
case 0x14: return fixnum_value(get_fixnum(v1) << get_fixnum(v2));
case 0x15: return fixnum_value(get_fixnum(v1) >> get_fixnum(v2));
case 0x16: return fixnum_value((unsigned long)get_fixnum(v1) >> get_fixnum(v2));
case 0x18: return make_float(get_float(v1) + get_float(v2));
case 0x19: return make_float(get_float(v1) - get_float(v2));
case 0x1a: return make_float(get_float(v1) * get_float(v2));
case 0x1b: return make_float(get_float(v1) / get_float(v2));
case 0x1c: return boolean_value(get_float(v1) == get_float(v2));
case 0x1d: return boolean_value(get_float(v1) < get_float(v2));
case 0x1e: return boolean_value(get_float(v1) >= get_float(v2));
case 0x20: return make_float(atan2(get_float(v1), get_float(v2)));
case 0x21: return make_float(pow(get_float(v1), get_float(v2)));
case 0x22: return make_float(ldexp(get_float(v1), get_fixnum(v2)));
case 0x23: return make_float(fmod(get_float(v1), get_float(v2)));
case 0x24: return make_float(hypot(get_float(v1), get_float(v2)));
case 0x25: return make_float(jn(get_fixnum(v1), get_float(v2)));
case 0x26: return make_float(yn(get_fixnum(v1), get_float(v2)));
case 0x27: return make_float(nextafter(get_float(v1), get_float(v2)));
case 0x28: return make_float(remainder(get_float(v1), get_float(v2)));
case 0x29: return make_float(scalb(get_float(v1), get_float(v2)));
case 0x30: return boolean_value(struct_is_a(v1, v2));
case 0x31: return boolean_value(byte_string_cmp(v1, v2) == 0);
case 0x32: return boolean_value(byte_string_cmp(v1, v2) < 0);
case 0x33: return boolean_value(byte_string_cmp(v1, v2) >= 0);
case 0x50:
get_box(v1)->value = v2;
WRITE_BARRIER(v1);
return UNDEFINED;
case 0x51:
get_pair(v1)->car = v2;
WRITE_BARRIER(v1);
return UNDEFINED;
case 0x52:
get_pair(v1)->cdr = v2;
WRITE_BARRIER(v1);
return UNDEFINED;
default:
release_assert(NOTREACHED("Invalid binary byte-code!"));
return UNDEFINED;
}
}
}
static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uint8_t in)
static value_t eval_unary_expression(interp_state_t *state, uint8_t code, uint8_t in)
{
release_assert(subcode != 0);
ST1 = get_input(state, in);
value_t v1 = get_input(state, in);
switch (subcode)
switch (code)
{
case 0x01: return ST1;
case 0x02: return get_box(ST1)->value;
case 0x03: return get_pair(ST1)->car;
case 0x04: return get_pair(ST1)->cdr;
case 0x05: return get_weak_box(ST1)->value;
case 0x08: return boolean_value(is_boolean(ST1));
case 0x09: return boolean_value(is_fixnum(ST1));
case 0x0a: return boolean_value(is_box(ST1));
case 0x0b: return boolean_value(is_pair(ST1));
case 0x0c: return boolean_value(is_vector(ST1));
case 0x0d: return boolean_value(is_byte_string(ST1));
case 0x0e: return boolean_value(is_struct(ST1));
case 0x0f: return boolean_value(is_float(ST1));
case 0x10: return boolean_value(is_builtin_fn(ST1));
case 0x11: return boolean_value(is_weak_box(ST1));
case 0x18: return make_box(ST1);
case 0x19: return make_struct(ST1);
case 0x1a: return make_float((native_float_t)get_fixnum(ST1));
case 0x1b: return make_lambda(state, ST1);
case 0x1c: return make_weak_box(ST1);
case 0x20: return boolean_value(!_get_boolean(ST1));
case 0x21: return fixnum_value(~get_fixnum(ST1));
case 0x22: return fixnum_value(-get_fixnum(ST1));
case 0x23: return make_float(-get_float(ST1));
case 0x28: return fixnum_value(get_vector(ST1)->size);
case 0x29: return fixnum_value(get_byte_string(ST1)->size);
case 0x2a: return fixnum_value(get_struct(ST1)->nslots);
case 0x2b: return get_struct(ST1)->type;
case 0x2c: return get_hash_value(ST1);
case 0x30: return make_float(acos(get_float(ST1)));
case 0x31: return make_float(asin(get_float(ST1)));
case 0x32: return make_float(atan(get_float(ST1)));
case 0x33: return make_float(cos(get_float(ST1)));
case 0x34: return make_float(sin(get_float(ST1)));
case 0x35: return make_float(tan(get_float(ST1)));
case 0x36: return make_float(cosh(get_float(ST1)));
case 0x37: return make_float(sinh(get_float(ST1)));
case 0x38: return make_float(tanh(get_float(ST1)));
case 0x39: return make_float(exp(get_float(ST1)));
case 0x00:
release_assert(NOTREACHED("Fatal error detected."));
return UNDEFINED;
case 0x01: return get_box(v1)->value;
case 0x02: return get_weak_box(v1)->value;
case 0x03: return get_pair(v1)->car;
case 0x04: return get_pair(v1)->cdr;
case 0x08: return boolean_value(is_boolean(v1));
case 0x09: return boolean_value(is_fixnum(v1));
case 0x0a: return boolean_value(is_box(v1));
case 0x0b: return boolean_value(is_pair(v1));
case 0x0c: return boolean_value(is_vector(v1));
case 0x0d: return boolean_value(is_byte_string(v1));
case 0x0e: return boolean_value(is_struct(v1));
case 0x0f: return boolean_value(is_float(v1));
case 0x10: return boolean_value(is_builtin_fn(v1));
case 0x11: return boolean_value(is_weak_box(v1));
case 0x18: return make_box(v1);
case 0x19: return make_struct(v1);
case 0x1a: return make_float((native_float_t)get_fixnum(v1));
case 0x1b: return make_lambda(state, v1);
case 0x1c: return make_weak_box(v1);
case 0x20: return boolean_value(!_get_boolean(v1));
case 0x21: return fixnum_value(~get_fixnum(v1));
case 0x22: return fixnum_value(-get_fixnum(v1));
case 0x23: return make_float(-get_float(v1));
case 0x28: return fixnum_value(get_vector(v1)->size);
case 0x29: return fixnum_value(get_byte_string(v1)->size);
case 0x2a: return fixnum_value(get_struct(v1)->nslots);
case 0x2b: return get_struct(v1)->type;
case 0x2c: return get_hash_value(v1);
case 0x30: return make_float(acos(get_float(v1)));
case 0x31: return make_float(asin(get_float(v1)));
case 0x32: return make_float(atan(get_float(v1)));
case 0x33: return make_float(cos(get_float(v1)));
case 0x34: return make_float(sin(get_float(v1)));
case 0x35: return make_float(tan(get_float(v1)));
case 0x36: return make_float(cosh(get_float(v1)));
case 0x37: return make_float(sinh(get_float(v1)));
case 0x38: return make_float(tanh(get_float(v1)));
case 0x39: return make_float(exp(get_float(v1)));
case 0x3a: {
int exp;
ST2 = make_float(frexp(get_float(ST1), &exp));
return cons(ST2, fixnum_value(exp));
value_t v2 = make_float(frexp(get_float(v1), &exp));
return cons(v2, fixnum_value(exp));
}
case 0x3b: return make_float(log(get_float(ST1)));
case 0x3c: return make_float(log10(get_float(ST1)));
case 0x3b: return make_float(log(get_float(v1)));
case 0x3c: return make_float(log10(get_float(v1)));
case 0x3d: {
double integral_part;
ST2 = make_float(modf(get_float(ST1), &integral_part));
ST3 = make_float(integral_part);
return cons(ST2, ST3);
gc_root_t rv2;
value_t v3;
register_gc_root(&rv2, make_float(modf(get_float(v1), &integral_part)));
v3 = make_float(integral_part);
unregister_gc_root(&rv2);
return cons(rv2.value, v3);
}
case 0x3e: return make_float(sqrt(get_float(ST1)));
case 0x3f: return make_float(ceil(get_float(ST1)));
case 0x40: return make_float(fabs(get_float(ST1)));
case 0x41: return make_float(floor(get_float(ST1)));
case 0x50: return make_float(erf(get_float(ST1)));
case 0x51: return make_float(erfc(get_float(ST1)));
case 0x52: return make_float(j0(get_float(ST1)));
case 0x53: return make_float(j1(get_float(ST1)));
case 0x3e: return make_float(sqrt(get_float(v1)));
case 0x3f: return make_float(ceil(get_float(v1)));
case 0x40: return make_float(fabs(get_float(v1)));
case 0x41: return make_float(floor(get_float(v1)));
case 0x50: return make_float(erf(get_float(v1)));
case 0x51: return make_float(erfc(get_float(v1)));
case 0x52: return make_float(j0(get_float(v1)));
case 0x53: return make_float(j1(get_float(v1)));
case 0x54: {
int signgamp;
ST2 = make_float(lgamma_r(get_float(ST1), &signgamp));
return cons(ST2, fixnum_value(signgamp));
}
case 0x55: return make_float(y0(get_float(ST1)));
case 0x56: return make_float(y1(get_float(ST1)));
case 0x57: return make_float(asinh(get_float(ST1)));
case 0x58: return make_float(acosh(get_float(ST1)));
case 0x59: return make_float(atanh(get_float(ST1)));
case 0x5a: return make_float(cbrt(get_float(ST1)));
case 0x5b: return make_float(logb(get_float(ST1)));
case 0x5c: return make_float(expm1(get_float(ST1)));
case 0x5d: return make_float(ilogb(get_float(ST1)));
case 0x5e: return make_float(log1p(get_float(ST1)));
case 0x70: return boolean_value(isnormal(get_float(ST1)));
case 0x71: return boolean_value(isfinite(get_float(ST1)));
case 0x72: return boolean_value(fpclassify(get_float(ST1)) == FP_SUBNORMAL);
case 0x73: return boolean_value(isinf(get_float(ST1)));
case 0x74: return boolean_value(isnan(get_float(ST1)));
default: release_assert(NOTREACHED("Invalid unary sub-bytecode."));
value_t v2 = make_float(lgamma_r(get_float(v1), &signgamp));
return cons(v2, fixnum_value(signgamp));
}
case 0x55: return make_float(y0(get_float(v1)));
case 0x56: return make_float(y1(get_float(v1)));
case 0x57: return make_float(asinh(get_float(v1)));
case 0x58: return make_float(acosh(get_float(v1)));
case 0x59: return make_float(atanh(get_float(v1)));
case 0x5a: return make_float(cbrt(get_float(v1)));
case 0x5b: return make_float(logb(get_float(v1)));
case 0x5c: return make_float(expm1(get_float(v1)));
case 0x5d: return make_float(ilogb(get_float(v1)));
case 0x5e: return make_float(log1p(get_float(v1)));
case 0x70: return boolean_value(isnormal(get_float(v1)));
case 0x71: return boolean_value(isfinite(get_float(v1)));
case 0x72: return boolean_value(fpclassify(get_float(v1)) == FP_SUBNORMAL);
case 0x73: return boolean_value(isinf(get_float(v1)));
case 0x74: return boolean_value(isnan(get_float(v1)));
default:
release_assert(NOTREACHED("Invalid unary bytecode."));
return UNDEFINED;
}
static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint32_t in3)
{
ST1 = get_input(state, in1);
if (code >= 0x50)
{
ST2 = get_input(state, in2);
}
if (code >= 0x60)
{
ST3 = get_input(state, in3);
}
switch (code)
{
/* 0x40 and 0x41 (goto-end-if, goto-end-unless) are handled by run_byte_code() directly. */
case 0x50: get_box(ST1)->value = ST2; WRITE_BARRIER(ST1); break;
case 0x51: get_pair(ST1)->car = ST2; WRITE_BARRIER(ST1); break;
case 0x52: get_pair(ST1)->cdr = ST2; WRITE_BARRIER(ST1); break;
case 0x60: vector_set(ST1, get_fixnum(ST2), ST3); break;
case 0x61: byte_string_set(ST1, get_fixnum(ST2), (char)get_fixnum(ST3)); break;
case 0x62: struct_set(ST1, get_fixnum(ST2), ST3); break;
default: release_assert(NOTREACHED("Invalid statement bytecode."));
}
}
/*
@ -532,67 +565,45 @@ static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint
*/
static value_t get_input(const interp_state_t *state, fixnum_t var)
{
release_assert((var >= 0) && (var <= 255));
switch (var)
{
case 0:
return NIL;
case 1 ... 63:
case 0x00 ... 0x7f:
{
vector_t *vec = _get_vector(state->transients.value);
release_assert(var < state->ntransients);
return vec->elements[var];
}
case 0x80 ... 0xbf:
{
vector_t *vec = _get_vector(state->globals.value);
var -= 1;
var -= 0x80;
release_assert(var < vec->size);
return vec->elements[var];
}
case 64 ... 127:
case 0xc0 ... 0xef:
{
vector_t *vec = _get_vector(state->instances.value);
var -= 64;
var -= 0xc0;
release_assert(var < vec->size);
return vec->elements[var];
}
case 128 ... 247:
{
vector_t *vec = _get_vector(state->frame.value);
var -= 128;
case 0xf0: return FALSE_VALUE;
case 0xf1: return NIL;
case 0xf2: return UNDEFINED;
/* 0xf3 through 0xf9 are reserved */
case 0xfa: return state->lambda.value;
case 0xfb: return state->argv.value;
case 0xfc: return state->kw_args.value;
case 0xfd: return state->kw_vals.value;
case 0xfe: return state->ctx.value;
case 0xff: return state->k.value;
release_assert(var < state->nframe);
return vec->elements[var];
}
/* 248 ... 249 are reserved */
case 250:
return state->lambda.value;
case 251:
return state->argv.value;
case 252:
return state->kw_args.value;
case 253:
return state->kw_vals.value;
case 254:
return state->ctx.value;
case 255:
return state->k.value;
default:
release_assert(NOTREACHED("Invalid input code."));
return UNDEFINED;
}
}
static void set_output(const interp_state_t *state, fixnum_t var, value_t val)
{
vector_t *vec = _get_vector(state->frame.value);
/* Only frame variables can be output targets for bytecode instructions. */
release_assert((var >= 128) && (var <= 255));
var -= 128;
release_assert(var < state->nframe);
vec->elements[var] = val;
WRITE_BARRIER(state->frame.value);
}
static void register_state(interp_state_t *state, value_t lambda, value_t argv)
{
register_gc_root(&state->lambda, lambda);
@ -604,10 +615,10 @@ static void register_state(interp_state_t *state, value_t lambda, value_t argv)
register_gc_root(&state->globals, UNDEFINED);
register_gc_root(&state->instances, UNDEFINED);
register_gc_root(&state->frame, make_vector(120, UNDEFINED));
register_gc_root(&state->in1, UNDEFINED);
register_gc_root(&state->in2, UNDEFINED);
register_gc_root(&state->in3, UNDEFINED);
register_gc_root(&state->byte_code, UNDEFINED);
register_gc_root(&state->tail_call, UNDEFINED);
register_gc_root(&state->transients, make_vector(128, UNDEFINED));
}
static void unregister_state(interp_state_t *state)
@ -621,10 +632,10 @@ static void unregister_state(interp_state_t *state)
unregister_gc_root(&state->globals);
unregister_gc_root(&state->instances);
unregister_gc_root(&state->frame);
unregister_gc_root(&state->in1);
unregister_gc_root(&state->in2);
unregister_gc_root(&state->in3);
unregister_gc_root(&state->byte_code);
unregister_gc_root(&state->tail_call);
unregister_gc_root(&state->transients);
}
/* vim:set sw=2 expandtab: */

15
interp.h
View File

@ -6,18 +6,19 @@
typedef struct interp_state
{
gc_root_t lambda;
gc_root_t globals;
gc_root_t instances;
gc_root_t frame;
gc_root_t argv;
gc_root_t kw_args;
gc_root_t kw_vals;
gc_root_t ctx;
gc_root_t k;
gc_root_t in1;
gc_root_t in2;
gc_root_t in3;
fixnum_t nframe;
gc_root_t globals;
gc_root_t instances;
gc_root_t byte_code;
gc_root_t tail_call;
gc_root_t transients;
int ntransients;
} interp_state_t;
void interpreter_init(void);

33
libcompiler/mapper.scm
View File

@ -12,7 +12,10 @@
[unused-g-vars global-variables]
[i-vars '()])
(define (add-g-var value)
(let ([value (cond [(and (pair? value) (eq? (first value) 'quote)) (second value)]
(cond
[(or (eq? value #f) (equal? value '(quote #f))) '#%f]
[(equal? value '(quote ())) '#%nil]
[else (let ([value (cond [(and (pair? value) (eq? (first value) 'quote)) (second value)]
[(symbol? value) `(#%builtin ,(symbol->string value))]
[else value])])
(let/cc return
@ -22,9 +25,9 @@
(let ([g-var (first unused-g-vars)])
(set! unused-g-vars (cdr unused-g-vars))
(set! g-vars (append g-vars (list value)))
g-var))))
g-var)))]))
(let* ([free-vars (filter frame/instance-variable? (free-variables bind))]
(let* ([free-vars (filter transient/instance-variable? (free-variables bind))]
[var-map (for/list ([free-var (in-list free-vars)]
[inst-var (in-list instance-variables)])
(set! i-vars (append i-vars (list free-var)))
@ -33,11 +36,25 @@
(set! bind `(#%bind ,(subst* var-map (second bind))
,@(map sv* (cddr bind)))))
(for ([bound-var (in-list (second bind))]
[frame-var (in-list frame-variables)])
(define (sv form) (subst-var bound-var frame-var form))
(set! bind `(#%bind ,(subst bound-var frame-var (second bind))
,@(map sv (cddr bind)))))
(let* ([var-map (map (lambda (v) (list v '#%undef)) (second bind))]
[exprs (for/list ([expr (in-list (cddr bind))]
[tvar (in-list transient-variables)])
(if (and (pair? expr) (eq? (first expr) '#%set!))
(let ([var (second expr)]
[newexpr `(#%set! ,tvar ,(subst-var* var-map (third expr)))])
(set! var-map (map (lambda (vm)
(if (eq? (first vm) var)
(list var tvar)
vm))
var-map))
(when (simple-value? (third newexpr))
(set! newexpr `(#%set! ,tvar (#%if #%f #%undef ,(third newexpr)))))
newexpr)
`(#%set! ,tvar ,(subst-var* var-map expr))))])
(set! bind `(#%bind ,(for/list ([s (in-list (cddr bind))]
[v (in-list transient-variables)])
v)
,@exprs)))
(set! bind (map-form bind
#:lambda (lambda (recurse op inner-g-vars i-vars bind)

84
libcompiler/primitives.scm
View File

@ -1,29 +1,27 @@
#lang scheme/base
(provide unary-value-primitives
binary-value-primitives
unary-statement-primitives
binary-statement-primitives
ternary-statement-primitives
value-primitives
statement-primitives
(provide unary-primitives
binary-primitives
ternary-primitives
side-effect-primitive?
all-primitives
transient-variables
global-variables
instance-variables
frame-variables
special-variables
global-variable?
instance-variable?
frame-variable?
transient-variable?
special-variable?
frame/instance-variable?
transient/instance-variable?
machine-variable?)
(define unary-value-primitives
'((#%unbox #x02 unbox)
(define unary-primitives
'((#%fatal-error #x00 fatal-error)
(#%unbox #x01 unbox)
(#%weak-unbox #x02 weak-unbox)
(#%car #x03 car)
(#%cdr #x04 cdr)
(#%weak-unbox #x05 weak-unbox)
(#%boolean? #x08 boolean?)
(#%fixnum? #x09 fixnum?)
(#%box? #x0a box?)
@ -87,7 +85,7 @@
(#%infinite? #x73 infinite?)
(#%nan? #x74 nan?)))
(define binary-value-primitives
(define binary-primitives
'((#%eq? #x01 eq?)
(#%cons #x02 cons)
(#%make-vector #x03 make-vector)
@ -128,62 +126,54 @@
(#%kind-of? #x30 kind-of?)
(#%byte-string= #x31 byte-string=)
(#%byte-string< #x32 byte-string<)
(#%byte-string>= #x33 byte-string>=)))
(define unary-statement-primitives
'((#%goto-end-if #x40 #f)
(#%goto-end-unless #x41 #f)))
(define binary-statement-primitives
'((#%set-box! #x50 set-box!)
(#%byte-string>= #x33 byte-string>=)
(#%set-box! #x50 set-box!)
(#%set-car! #x51 set-car!)
(#%set-cdr! #x52 set-cdr!)))
(#%set-cdr! #x52 set-cdr!)
(#%tail-call-if #x70 tail-call-if)))
(define ternary-statement-primitives
'((#%vector-set! #x60 vector-set!)
(#%byte-string-set! #x61 byte-string-set!)
(#%struct-set! #x62 struct-set!)))
(define value-primitives
(append unary-value-primitives
binary-value-primitives
'((#%if #f #f))))
(define statement-primitives
(append unary-statement-primitives
binary-statement-primitives
ternary-statement-primitives))
(define ternary-primitives
'((#%if #x10 if)
(#%vector-set! #x20 vector-set!)
(#%byte-string-set! #x21 byte-string-set!)
(#%struct-set! #x22 struct-set!)))
(define all-primitives
(append value-primitives statement-primitives))
(append unary-primitives
binary-primitives
ternary-primitives))
(define (side-effect-primitive? sym)
(memq sym '(#%byte-string-set! #%fatal-error #%set-box! #%set-car!
#%set-cdr! #%struct-set! #%tail-call-if #%vector-set!)))
(define global-variables
(for/list ([i (in-range 1 64)])
(for/list ([i (in-range 0 64)])
(string->uninterned-symbol (string-append "#%g" (number->string i)))))
(define instance-variables
(for/list ([i (in-range 0 64)])
(string->uninterned-symbol (string-append "#%i" (number->string i)))))
(define frame-variables
(for/list ([i (in-range 0 120)])
(string->uninterned-symbol (string-append "#%f" (number->string i)))))
(define transient-variables
(for/list ([i (in-range 0 128)])
(string->uninterned-symbol (string-append "#%t" (number->string i)))))
(define special-variables
'(#%nil #%self #%argv #%kw-args #%kw-vals #%ctx #%k))
'(#%f #%nil #%undef #%self #%argv #%kw-args #%kw-vals #%ctx #%k))
(define (global-variable? var) (and (memq var global-variables) #t))
(define (instance-variable? var) (and (memq var instance-variables) #t))
(define (frame-variable? var) (and (memq var frame-variables) #t))
(define (transient-variable? var) (and (memq var transient-variables) #t))
(define (special-variable? var) (and (memq var special-variables) #t))
(define (frame/instance-variable? var)
(or (frame-variable? var)
(define (transient/instance-variable? var)
(or (transient-variable? var)
(instance-variable? var)))
(define (machine-variable? var)
(or (special-variable? var)
(frame/instance-variable? var)
(transient/instance-variable? var)
(global-variable? var)))
; vim:set sw=2 expandtab:

5
libcompiler/simplifier.scm
View File

@ -83,8 +83,7 @@
#:value-list same-form
#:primitive same-form
#:simple (lambda (recurse kind form) form)
#:literal (lambda (recurse kind form)
(if (equal? form '(quote ())) '#%nil form))
#:literal (lambda (recurse kind form) form)
#:other simplify-complex-form))
(define (body->forms body)
@ -491,7 +490,7 @@
(#%set! ,k-argv (#%cons ,k #%nil))
(#%tail-call ,x ,k-argv #%nil #%nil ,ctx ,k))))]
; keep all other forms with side-effects as-is
[(? statement-form?) (cons subform after)]
[(? side-effect-form?) (cons subform after)]
; discard any form without side-effects
[_ after]))
`(#%bind ,(second flat-bind)

22
libcompiler/utilities.scm
View File

@ -14,9 +14,8 @@
literal-value?
simple-value?
value-form?
statement-form?
side-effect-form?
primitive-form?
pure-form?
bind-form?
traverse-form
map-form
@ -113,28 +112,23 @@
(literal-value? form)))
; A value-form is any simple form which can appear on the right-hand side of a (set! ...).
; If there are any side-effect they occur before the variable is updated.
; If there are any side-effects they occur before the variable is updated.
(define (value-form? form)
(define complex-values '(#%bind #%lambda #%apply #%call/cc #%values #%value-list))
(or (simple-value? form)
(memq (first form) complex-values)
(memq (first form) (map first value-primitives))))
(memq (first form) (map first all-primitives))))
; A statement-form is any simple form which has, or may have, side-effects.
(define (statement-form? form)
(define complex-statements '(#%set! #%apply #%call/cc #%tail-call))
; A side-effect-form is any simple form which has, or may have, side-effects.
(define (side-effect-form? form)
(define complex-side-effects '(#%set! #%apply #%call/cc #%tail-call))
(and (not (simple-value? form))
(or (memq (first form) complex-statements)
(memq (first form) (map first statement-primitives)))))
(or (memq (first form) complex-side-effects)
(side-effect-primitive? (first form)))))
(define (primitive-form? form)
(and (pair? form) (memq (first form) (map first all-primitives))))
; A pure form is any form known to be free of side-effects.
(define (pure-form? form)
(and (value-form? form)
(not (statement-form? form))))
(define (bind-form? form)
(and (pair? form) (eq? (first form) '#%bind)))

79
libcompiler/writer.scm
View File

@ -123,21 +123,21 @@
(let-values ([(line col pos) (port-next-location (current-output-port))])
(parameterize ([current-indent col])
(write-string "#@\"")
(if (eq? (first (first forms)) '#%tail-call)
(if (eq? (first (third (first forms))) '#%tail-call)
(begin
(write-char #\")
(write-tail-call (first forms)))
(write-tail-call (third (first forms))))
(let iter ([forms forms])
(map (lambda (x) (write-hex-char x))
(statement->code (car forms)))
(if (eq? (first (second forms)) '#%tail-call)
(if (eq? (first (third (second forms))) '#%tail-call)
(begin
(if (verbose-rla?)
(begin
(write-string "\"; ")
(write (car forms)))
(write (first forms)))
(write-char #\"))
(write-tail-call (second forms)))
(write-tail-call (third (second forms))))
(begin
(when (verbose-rla?)
(write-string "\\; ")
@ -181,8 +181,6 @@
(opt-new-line))
(write-string ")")))
(req-new-line)
(write-rla-val (length (second (fourth value))))
(req-new-line)
(write-rla-bytecode+tail-call (cddr (fourth value))))
(opt-new-line))
(write-string ")")))
@ -252,56 +250,39 @@
[else (error "Don't know how to write Rosella syntax for:" value)]))
(define (variable->code var)
(or (and (eq? var '#%nil) #x00)
(or (let ([index (find var transient-variables)])
(and index (+ #x00 index)))
(let ([index (find var global-variables)])
(and index (+ #x01 index)))
(let ([index (find var instance-variables)])
(and index (+ #x40 index)))
(let ([index (find var frame-variables)])
(and index (+ #x80 index)))
(let ([index (find var instance-variables)])
(and index (+ #xc0 index)))
(let ([index (find var '(#%f #%nil #%undef))])
(and index (+ #xf0 index)))
(let ([index (find var '(#%self #%argv #%kw-args #%kw-vals #%ctx #%k))])
(and index (+ #xfa index)))
(error "No bytecode for variable:" var)))
(define (statement->code form)
(if (eq? (first form) '#%set!)
(let ([out (variable->code (second form))]
[value (third form)])
(cond
[(machine-variable? value)
(list #x00 out #x01 (variable->code value))]
[(eq? (length (cdr value)) 1)
(let ([item (assoc (first value) unary-value-primitives)])
(unless item (error "Invalid unary value primitive:" value))
(list #x00 out (second item) (variable->code (second value))))]
[(eq? (length (cdr value)) 2)
(let ([item (assoc (first value) binary-value-primitives)])
(unless item (error "Invalid binary value primitive:" value))
(list* (second item) out (map variable->code (cdr value))))]
[else
(unless (and (eq? (first value) '#%if)
(eq? (length (cdr value)) 3))
(error "Invalid ternary primitive:" form))
(list* out (map variable->code (cdr value)))]))
(case (length (cdr form))
[(1) (let ([item (assoc (first form) unary-statement-primitives)])
(unless item (error "Invalid unary statement primitive:" form))
(list (second item)
(variable->code (second form))
(let ([vform (third form)]) ; (#%set! #%tNN vform)
(case (length (cdr vform))
[(1) (let ([item (assoc (first vform) unary-primitives)])
(or item (error "Invalid unary primitive:" vform))
(list #x00
#x00
#x00))]
[(2) (let ([item (assoc (first form) binary-statement-primitives)])
(unless item (error "Invalid binary statement primitive:" form))
(second item)
(variable->code (second vform))))]
[(2) (let ([item (assoc (first vform) binary-primitives)])
(or item (error "Invalid binary primitive:" vform))
(list #x00
(second item)
(variable->code (second vform))
(variable->code (third vform))))]
[(3) (let ([item (assoc (first vform) ternary-primitives)])
(or item (error "Invalid ternary primitive:" vform))
(list (second item)
(variable->code (second form))
(variable->code (third form))
#x00))]
[(3) (let ([item (assoc (first form) ternary-statement-primitives)])
(unless item (error "Invalid ternary statement primitive:" form))
(list (second item)
(variable->code (second form))
(variable->code (third form))
(variable->code (fourth form))))]
[else (error "Unsupported form:" form)])))
(variable->code (second vform))
(variable->code (third vform))
(variable->code (fourth vform))))]
[else (error "Unsupported form:" vform)])))
; vim:set sw=2 expandtab:

18
src/examples/annotated-structs.rla
View File

@ -21,32 +21,26 @@
)
#@#2=#S(#=1
(#="lambda")
8
4
#f
#@"annotated-lambda"
#@#(
"global-vars"
"instance-vars"
"frame-vars"
"byte-code"
"tail-call"
"arg-list"
"context"
"continuation"
)
)
)
#@#S(#=2
#@#(("OK") #f)
#@#(("OK"))
#@#()
0
#@""
#@"\xff\x01\x00\x00\x02\x02"
#f
#@"\xff\x80\xf1\xf1\xf0\xf0"
)
)
#@#()
0
#@""
#@"\x02\xfd\xfe\xff"
#f
#@"\x81\xfb\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=3 expandtab:

10
src/examples/factorial.rla
View File

@ -19,14 +19,12 @@
#i"../lib/math/fact.rla"
)
#@"\xfe\xff" ; ctx k
0
#@""
#@"\x01\xfb\x00\x00\x40\x41"
#f
#@"\x80\xfb\xf1\xf1\xc0\xc1"
)
)
#@#()
0
#@""
#@"\x01\xfb\x00\x00\xfe\x02"
#f
#@"\x80\xfb\xf1\xf1\xfe\x81"
)
; vim:set syntax= sw=2 expandtab:

17
src/examples/test-and.rla
View File

@ -8,16 +8,15 @@
#@#(
#i"../lib/primitive/and.rla"
(
#@#S(#="lambda" #@#(( 3) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#((#t) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#(( 4) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#((#f) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#(( 5) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#(( 3)) #0=#@#() #f #1=#@"\xff\x80\xf1\xf1\xf0\xf0")
#@#S(#="lambda" #@#((#t)) #=0 #f #=1)
#@#S(#="lambda" #@#(( 4)) #=0 #f #=1)
#@#S(#="lambda" #@#((#f)) #=0 #f #=1)
#@#S(#="lambda" #@#(( 5)) #=0 #f #=1)
)
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#=0
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

7
src/examples/test-append.rla
View File

@ -1,13 +1,12 @@
#@#S(#="lambda"
; (define (test-append)
; (append '(1 2 3) (4 5) (6 7 8 9)))
; (append '(1 2 3) '(4 5) '(6 7 8 9)))
#@#(
#i"../lib/primitive/append.rla"
((1 2 3) (4 5) (6 7 8 9))
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

20
src/examples/test-foldl.rla
View File

@ -7,23 +7,21 @@
#@#S(#="lambda"
; (define (+ x y)
; (fix+ x y))
#@#(#f)
#@#()
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x81\x04\xfb\; (set! f1 (cdr argv))
\x00\x81\x03\x81\; (set! f1 (car f1))
\x08\x80\x80\x81\; (set! f0 (fix+ f0 f1))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\xff\x80\x00\x00\x01\x01"
#@#()
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (set! t0 (car t1))
\x00\x08\x00\x02\; (set! t3 (fix+ t0 t2))
\x00\x02\x03\xf1"; (set! t4 (cons t3 nil))
#@"\xff\x04\xf1\xf1\xf0\xf0"
)
0
(2 3 4 5)
)
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

20
src/examples/test-foldr.rla
View File

@ -7,23 +7,21 @@
#@#S(#="lambda"
; (define (+ x y)
; (fix+ x y))
#@#(#f)
#@#()
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x81\x04\xfb\; (set! f1 (cdr argv))
\x00\x81\x03\x81\; (set! f1 (car f1))
\x08\x80\x80\x81\; (set! f0 (fix+ f0 f1))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\xff\x80\x00\x00\x01\x01"
#@#()
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (set! t0 (car t1))
\x00\x08\x00\x02\; (set! t3 (fix+ t0 t2))
\x00\x02\x03\xf1"; (set! t4 (cons t3 nil))
#@"\xff\x04\xf1\xf1\xf0\xf0"
)
0
(2 3 4 5)
)
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

5
src/examples/test-list.rla
View File

@ -6,8 +6,7 @@
(1 2 3 4 5)
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

5
src/examples/test-map.rla
View File

@ -9,8 +9,7 @@
)
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

15
src/examples/test-or.rla
View File

@ -8,16 +8,15 @@
#@#(
#i"../lib/primitive/or.rla"
(
#@#S(#="lambda" #@#((#f) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#(( 3) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#((#f) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#((#t) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#((#f) #f) #@#() 0 #@"" #@"\xff\x01\x00\x00\x02\x02")
#@#S(#="lambda" #@#((#f)) #0=#@#() #f #1=#@"\xff\x80\xf1\xf1\xf0\xf0")
#@#S(#="lambda" #@#(( 3)) #=0 #f #=1)
#@#S(#="lambda" #@#((#f)) #=0 #f #=1)
#@#S(#="lambda" #@#((#t)) #=0 #f #=1)
#@#S(#="lambda" #@#((#f)) #=0 #f #=1)
)
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

5
src/examples/test-reverse.rla
View File

@ -6,8 +6,7 @@
((2 3 4 5))
)
#@#()
0
#@""
#@"\x01\x02\x00\x00\xfe\xff"
#f
#@"\x80\x81\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

38
src/lib/math/fact.rla
View File

@ -13,11 +13,10 @@
1
#@#S(#="lambda"
; (lambda _ 1)
#@#((1) #f)
#@#((1))
#@#()
0
#@""
#@"\xff\x01\x00\x00\x02\x02"
#f
#@"\xff\x80\xf1\xf1\xf0\xf0"
)
#@#S(#="template"
; (let [n]
@ -33,28 +32,25 @@
; (let/cc k
; (lambda (m)
; (k (* n m)))))
#@#(#f)
#@"\x40\xff" ; i0 k
1
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x0a\x80\x40\x80\; (set! f0 (fix* i0 f0))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\x41\x80\x00\x00\x01\x01"
#@#()
#@"\xc0\xff" ; i0 k
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x0a\xc0\x00\; (set! t1 (fix* i0 t0))
\x00\x02\x01\xf1"; (set! t2 (cons t1 nil))
#@"\xc1\x02\xf1\xf1\xf0\xf0"
)
#=0 ; fact
)
#@"\x80"
1
#@"\x09\x80\x40\x01\; (set! f0 (fix- i0 g1))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\x03\x80\x00\x00\xfe\x02"
#@"\x00"
#@"\x00\x09\xc0\x80\; (set! t0 (fix- i0 g0))
\x00\x02\x00\xf1"; (set! t1 (cons t0 nil))
#@"\x82\x01\xf1\xf1\xfe\x81"
)
)
#@#()
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x0d\x81\x80\x01\; (set! f1 (fix< f0 g1))
\x81\x81\x02\x03"; (set! f1 (if f1 g2 g3))
#@"\x81\x00\x00\x00\xfe\xff"
#@"\x00\x00\x03\xfb\; (set! f0 (car argv))
\x00\x0d\x00\x80\; (set! f1 (fix< t0 g0))
\x10\x01\x81\x82"; (set! f1 (if t1 g1 g2))
#@"\x02\xf1\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

21
src/lib/primitive/acons.rla
View File

@ -1,17 +1,16 @@
#@#S(#="lambda"
; (define (acons a b lst)
; (cons a (cons b lst)))
#@#(#f)
#@#()
3
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x82\x04\xfb\; (set! f2 (cdr argv))
\x00\x81\x03\x82\; (set! f1 (car f2))
\x00\x82\x04\x82\; (set! f2 (cdr f2))
\x00\x82\x03\x82\; (set! f2 (car f2))
\x02\x81\x81\x82\; (set! f1 (cons f1 f2))
\x02\x80\x80\x81\; (set! f0 (cons f0 f1))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\xff\x80\x00\x00\x01\x01"
#@#()
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (car t1))
\x00\x00\x04\x01\; (set! t3 (cdr t1))
\x00\x00\x03\x03\; (set! t4 (car t2))
\x00\x02\x02\x04\; (set! t5 (cons t2 t4))
\x00\x02\x00\x05\; (set! t6 (cons t0 t5))
\x00\x02\x06\xf1"; (set! t7 (cons t6 nil))
#@"\xff\x07\xf1\xf1\xf0\xf0"
)
; vim:set syntax= sw=2 expandtab:

28
src/lib/primitive/and.rla
View File

@ -24,27 +24,23 @@
#@#S(#="template"
; (lambda (x)
; ((if x k2 k) x))
#@#(#f)
#@"\x40\xff" ; i0 k
1
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x80\x80\x41\x40"; (set! f0 (if f0 i1 i0))
#@"\x80\xfb\x00\x00\x01\x01"
#@#()
#@"\xc0\xff" ; i0 k
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x10\x00\xc1\xc0"; (set! t1 (if t0 i1 i0))
#@"\x01\xfb\xf1\xf1\xf0\xf0"
)
)
#@"\xff" ; k
1
#@"\x00\x80\x03\xfb"; (set! f0 (car argv))
#@"\x80\x00\x00\x00\xfe\x01"
#@"\x00\x00\x03\xfb"; (set! t0 (car argv))
#@"\x00\xf1\xf1\xf1\xfe\x80"
)
#t
)
#@#()
2
#@"\x02\x80\xfb\x00\; (set! f0 (cons argv nil))
\x02\x80\x03\x80\; (set! f0 (cons g3 f0))
\x00\x81\x1b\x02\; (set! f1 (lambda g2))
\x02\x80\x81\x80"; (set! f0 (cons f1 f0))
#@"\x01\x80\x00\x00\xfe\xff"
#@"\x00\x02\xfb\xf1\; (set! t0 (cons argv nil))
\x00\x02\xf0\x00\; (set! t1 (cons g2 t0))
\x00\x00\x1b\x81\; (set! t2 (lambda g1))
\x00\x02\x02\x01"; (set! t3 (cons t2 t1))
#@"\x80\x03\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

24
src/lib/primitive/append.rla
View File

@ -15,21 +15,19 @@
#i"cons.rla"
)
#@#()
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x02\x81\x80\x00\; (set! f1 (cons f0 nil))
\x00\x80\x04\xfb\; (set! f0 (cdr argv))
\x00\x80\x03\x80\; (set! f0 (car f0))
\x02\x81\x80\x81\; (set! f1 (cons f0 f1))
\x02\x81\x02\x81"; (set! f1 (cons g2 f1))
#@"\x01\x81\x00\x00\xfe\xff"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x02\x00\xf1\; (set! t1 (cons t0 nil))
\x00\x00\x04\xfb\; (set! t2 (cdr argv))
\x00\x00\x03\x02\; (set! t3 (car t2))
\x00\x02\x03\x01\; (set! t4 (cons t3 t1))
\x00\x02\x81\x04"; (set! t5 (cons g1 t4))
#@"\x80\x05\xf1\xf1\xfe\xff"
)
)
#@#()
1
#@"\x02\x80\xfb\x00\; (set! f0 (cons argv nil))
\x02\x80\x00\x80\; (set! f0 (cons nil f0))
\x02\x80\x02\x80"; (set! f0 (cons g2 f0))
#@"\x01\x80\x00\x00\xfe\xff"
#@"\x00\x02\xfb\xf1\; (set! t0 (cons argv nil))
\x00\x02\xf1\x00\; (set! t1 (cons nil t0))
\x00\x02\x81\x01"; (set! t2 (cons g1 t1))
#@"\x80\x02\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

15
src/lib/primitive/cons.rla
View File

@ -1,14 +1,13 @@
#@#S(#="lambda"
; (define (cons x y)
; (builtin-cons x y))
#@#(#f)
#@#()
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x81\x04\xfb\; (set! f1 (cdr argv))
\x00\x81\x03\x81\; (set! f1 (car f1))
\x02\x80\x80\x81\; (set! f0 (cons f0 f1))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\xff\x80\x00\x00\x01\x01"
#@#()
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (car t1))
\x00\x02\x00\x02\; (set! t3 (cons t0 t2))
\x00\x02\x03\xf1"; (set! t4 (cons t3 nil))
#@"\xff\x04\xf1\xf1\xf0\xf0"
)
; vim:set syntax= sw=2 expandtab:

57
src/lib/primitive/foldl.rla
View File

@ -25,45 +25,32 @@
; (lambda (new-init)
; (k (foldl fn new-init (cdr lst))))
#@#(#=0)
#@"\x40\x41\x42\xfe\xff" ; i0 i1 i2 ctx k
2
#@"\x00\x80\x04\x42\; (set! f0 (cdr i2))
\x02\x80\x80\x00\; (set! f0 (cons f0 nil))
\x00\x81\x03\xfb\; (set! f1 (car argv))
\x02\x80\x81\x80\; (set! f0 (cons f1 f0))
\x02\x80\x40\x80"; (set! f0 (cons i0 f0))
#@"\x01\x80\x00\x00\x43\x44"
#@"\xc0\xc1\xc2\xfe\xff" ; i0 i1 i2 ctx k
#@"\x00\x00\x04\xc2\; (set! t0 (cdr i2))
\x00\x02\x00\xf1\; (set! t1 (cons t0 nil))
\x00\x00\x03\xfb\; (set! t2 (car argv))
\x00\x02\x02\x01\; (set! t3 (cons t2 t1))
\x00\x02\xc0\x03"; (set! t4 (cons i0 t3))
#@"\x80\x04\xf1\xf1\xc3\xc4"
)
)
#@"\x80\x81\x82" ; f0=fn f1=init f2=lst
2
#@"\x02\x80\x41\x00\; (set! f0 (cons i1 nil))
\x00\x81\x03\x42\; (set! f1 (car i2))
\x02\x80\x81\x80"; (set! f0 (cons f1 f0))
#@"\x40\x80\x00\x00\xfe\x01"
)
#@#S(#="template"
; (lambda () init)
#@#(#f)
#@"\x81" ; f1
1
#@"\x02\x80\x40\x00"; (set! f0 (cons i0 nil))
#@"\xff\x80\x00\x00\x01\x01"
#@"\x00\x02\x04" ; t0=fn t2=init t4=lst
#@"\x00\x02\xc1\xf1\; (set! t0 (cons i1 nil))
\x00\x00\x03\xc2\; (set! t1 (car i2))
\x00\x02\x01\x00"; (set! t2 (cons t1 t0))
#@"\xc0\x02\xf1\xf1\xfe\x80"
)
#@"\x80\xf1\xf1\xf1\xfe\xff"
)
#@#()
6
#@"\x00\x80\x03\xfb\; (set! f0 (car argv)) ; f0=fn
\x00\x82\x04\xfb\; (set! f2 (cdr argv))
\x00\x81\x03\x82\; (set! f1 (car f2)) ; f1=init
\x00\x82\x04\x82\; (set! f2 (cdr f2))
\x00\x82\x03\x82\; (set! f2 (car f2)) ; f2=lst
\x00\x84\x01\x01\; (set! f4 g1)
\x00\x85\x01\x00\; (set! f5 nil)
\x00\x83\x0b\x82\; (set! f3 (pair? f2))
\x40\x83\x00\x00\; (goto-end-if f3)
\x00\x84\x01\xff\; (set! f4 k)
\x02\x85\x81\x00"; (set! f5 (cons f1 nil))
#@"\x84\x85\x00\x00\xfe\xff"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv)) ; t0=fn
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (car t1)) ; t2=init
\x00\x00\x04\x01\; (set! t3 (cdr t1))
\x00\x00\x03\x03\; (set! t4 (car t3)) ; t4=lst
\x00\x00\x0b\x04\; (set! t5 (pair? t4))
\x00\x70\x05\x81\; (set! t6 (tail-call-if t5 g1))
\x00\x02\x02\xf1"; (set! t7 (cons t2 nil))
#@"\xff\x07\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

49
src/lib/primitive/foldr.rla
View File

@ -26,38 +26,33 @@
#@#S(#="template"
; (lambda (v) (k (fn lstcar v)))
#@#()
#@"\x40\x81\xfe\xff" ; i0 f1 ctx k
1
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x02\x80\x80\x00\; (set! f0 (cons f0 nil))
\x02\x80\x41\x80"; (set! f0 (cons i1 f0))
#@"\x40\x80\x00\x00\x42\x43"
#@"\xc0\x01\xfe\xff" ; i0 f1 ctx k
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x02\x00\xf1\; (set! t1 (cons t0 nil))
\x00\x02\xc1\x01"; (set! t2 (cons i1 t1))
#@"\xc0\x02\xf1\xf1\xc2\xc3"
)
#=0 ; foldr
)
#@"\x80\x81\x82" ; f0=fn f1=init f2=lst
3
#@"\x00\x80\x04\x42\; (set! f0 (cdr i2))
\x00\x81\x03\x42\; (set! f1 (car i2))
\x02\x82\x80\x00\; (set! f2 (cons f0 nil))
\x02\x82\x41\x82\; (set! f2 (cons i1 f2))
\x02\x82\x40\x82"; (set! f2 (cons i0 f2))
#@"\x02\x82\x00\x00\xfe\x01"
#@"\x00\x02\x04" ; t0=fn t2=init t4=lst
#@"\x00\x00\x04\xc2\; (set! t0 (cdr i2))
\x00\x00\x03\xc2\; (set! t1 (car i2))
\x00\x02\x00\xf1\; (set! t2 (cons t0 nil))
\x00\x02\xc1\x02\; (set! t3 (cons i1 t2))
\x00\x02\xc0\x03"; (set! t4 (cons i0 t3))
#@"\x81\x04\xf1\xf1\xfe\x80"
)
#@"\x80\xf1\xf1\xf1\xfe\xff"
)
#@#()
6
#@"\x00\x80\x03\xfb\; (set! f0 (car argv)) ; f0=fn
\x00\x82\x04\xfb\; (set! f2 (cdr argv))
\x00\x81\x03\x82\; (set! f1 (car f2)) ; f1=init
\x00\x82\x04\x82\; (set! f2 (cdr f2))
\x00\x82\x03\x82\; (set! f2 (car f2)) ; f2=lst
\x00\x84\x01\x01\; (set! f4 g1)
\x00\x85\x01\x00\; (set! f5 nil)
\x00\x83\x0b\x82\; (set! f3 (pair? f2))
\x40\x83\x00\x00\; (goto-end-if f3)
\x00\x84\x01\xff\; (set! f4 k)
\x02\x85\x81\x00"; (set! f5 (cons f1 nil))
#@"\x84\x85\x00\x00\xfe\xff"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv)) ; t0=fn
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (car t1)) ; t2=init
\x00\x00\x04\x01\; (set! t3 (cdr t1))
\x00\x00\x03\x03\; (set! t4 (car t3)) ; t4=lst
\x00\x00\x0b\x04\; (set! t5 (pair? t4))
\x00\x70\x05\x81\; (set! t6 (tail-call-if t5 g1)
\x00\x02\x02\xf1"; (set! t7 (cons t2 nil))
#@"\xff\x07\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

9
src/lib/primitive/list.rla
View File

@ -7,10 +7,9 @@
#i"cons.rla"
)
#@#()
1
#@"\x02\x80\xfb\x00\; (set! f0 (cons argv nil))
\x02\x80\x00\x80\; (set! f0 (cons nil f0))
\x02\x80\x02\x80"; (set! f0 (cons g2 f0))
#@"\x01\x80\x00\x00\xfe\xff"
#@"\x00\x02\xfb\xf1\; (set! t0 (cons argv nil))
\x00\x02\xf1\x00\; (set! t1 (cons nil t0))
\x00\x02\x81\x01"; (set! t2 (cons g1 t1))
#@"\x80\x02\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

52
src/lib/primitive/map.rla
View File

@ -16,44 +16,40 @@
#@#S(#="template"
; (lambda (y)
; (k (cons y rlst)))
#@#(#f)
#@"\x81\xff" ; f1 k
1
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x02\x80\x80\x40\; (set! f0 (cons f0 i0))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\x41\x80\x00\x00\x01\x01"
#@#()
#@"\x02\xff" ; t2 k
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x02\x00\xc0\; (set! t1 (cons t0 i0))
\x00\x02\x01\xf1"; (set! t2 (cons t1 nil))
#@"\xc1\x02\xf1\xf1\xf0\xf0"
)
)
#@"\x80"
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x81\x04\xfb\; (set! f1 (cdr argv))
\x00\x81\x03\x81\; (set! f1 (car f1))
\x00\x81\x1b\x01\; (set! f1 (lambda g1))
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
#@"\x40\x80\x00\x00\xfe\x81"
#@"\x00"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (car t1))
\x00\x00\x1b\x80\; (set! t3 (lambda g0))
\x00\x02\x00\xf1"; (set! t4 (cons t0 nil))
#@"\xc0\x04\xf1\xf1\xfe\x03"
)
#@#S(#="template"
; (lambda (rlst)
; (k (reverse rlst)))
#@#(#i"reverse.rla")
#@"\xfe\xff" ; ctx k
0
#@""
#@"\x01\xfb\x00\x00\x40\x41"
#f
#@"\x80\xfb\xf1\xf1\xc0\xc1"
)
)
#@#()
4
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x81\x04\xfb\; (set! f1 (cdr argv))
\x00\x81\x03\x81\; (set! f1 (car f1))
\x02\x82\x81\x00\; (set! f2 (cons f1 nil))
\x02\x82\x00\x82\; (set! f2 (cons nil f2))
\x00\x83\x1b\x02\; (set! f3 (lambda g2))
\x02\x82\x83\x82\; (set! f2 (cons f3 f2))
\x00\x83\x1b\x03"; (set! f3 (lambda g3))
#@"\x01\x82\x00\x00\xfe\x83"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x04\xfb\; (set! t1 (cdr argv))
\x00\x00\x03\x01\; (set! t2 (car t1))
\x00\x02\x02\xf1\; (set! t3 (cons t2 nil))
\x00\x02\xf1\x03\; (set! t4 (cons nil t3))
\x00\x00\x1b\x81\; (set! t5 (lambda g1))
\x00\x02\x05\x04\; (set! t6 (cons t5 t4))
\x00\x00\x1b\x82"; (set! t7 (lambda g2))
#@"\x80\x06\xf1\xf1\xfe\x07"
)
; vim:set syntax= sw=2 expandtab:

30
src/lib/primitive/or.rla
View File

@ -24,28 +24,24 @@
#@#S(#="template"
; (lambda (x)
; ((if x k2 k) x))
#@#(#f)
#@"\x40\xff" ; i0 k
1
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x80\x80\x40\x41"; (set! f0 (if f0 i0 i1))
#@"\x80\xfb\x00\x00\x01\x01"
#@#()
#@"\xc0\xff" ; i0 k
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x10\x00\xc0\xc1"; (set! t1 (if t0 i0 i1))
#@"\x01\xfb\xf1\xf1\xf0\xf0"
)
)
#@"\xff" ; k
2
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x00\x81\x1b\x01"; (set! f1 (lambda g1))
#@"\x80\x00\x00\x00\xfe\x81"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x00\x1b\x80"; (set! t1 (lambda g0))
#@"\x00\xf1\xf1\xf1\xfe\x01"
)
#f
)
#@#()
2
#@"\x02\x80\xfb\x00\; (set! f0 (cons argv nil))
\x02\x80\x03\x80\; (set! f0 (cons g3 f0))
\x00\x81\x1b\x02\; (set! f1 (lambda g2))
\x02\x80\x81\x80"; (set! f0 (cons f1 f0))
#@"\x01\x80\x00\x00\xfe\xff"
#@"\x00\x02\xfb\xf1\; (set! t0 (cons argv nil))
\x00\x02\xf0\x00\; (set! t1 (cons #f t0))
\x00\x00\x1b\x81\; (set! t2 (lambda g1))
\x00\x02\x02\x01"; (set! t3 (cons t2 t1))
#@"\x80\x03\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

11
src/lib/primitive/reverse.rla
View File

@ -7,11 +7,10 @@
#i"cons.rla"
)
#@#()
1
#@"\x00\x80\x03\xfb\; (set! f0 (car argv))
\x02\x80\x80\x00\; (set! f0 (cons f0 nil))
\x02\x80\x00\x80\; (set! f0 (cons nil f0))
\x02\x80\x02\x80"; (set! f0 (cons g2 f0))
#@"\x01\x80\x00\x00\xfe\xff"
#@"\x00\x00\x03\xfb\; (set! t0 (car argv))
\x00\x02\x00\xf1\; (set! t1 (cons t0 nil))
\x00\x02\xf1\x01\; (set! t2 (cons nil t1))
\x00\x02\x81\x02"; (set! t3 (cons g1 t2))
#@"\x80\x03\xf1\xf1\xfe\xff"
)
; vim:set syntax= sw=2 expandtab:

23
src/lib/primitives.rls
View File

@ -1,10 +1,10 @@
; Function forms of built-in primitives
; Unary value primitives; no side effects
(define (unbox x) (unbox x))
(define (weak-unbox x) (weak-unbox x))
(define (car x) (car x))
(define (cdr x) (cdr x))
(define (weak-unbox x) (weak-unbox x))
(define (boolean? x) (boolean? x))
(define (fixnum? x) (fixnum? x))
(define (box? x) (box? x))
@ -15,19 +15,24 @@
(define (float? x) (float? x))
(define (builtin? x) (builtin? x))
(define (weak-box? x) (weak-box? x))
(define (make-box x) (make-box x))
(define (make-struct x) (make-struct x))
(define (make-float x) (make-float x))
(define (make-weak-box x) (make-weak-box x))
(define (not x) (not x))
(define (bit-not x) (bit-not x))
(define (fix- x) (fix- x))
(define (float- x) (float- x))
(define (vector-size x) (vector-size x))
(define (byte-string-size x) (byte-string-size x))
(define (struct-nslots x) (struct-nslots x))
(define (struct-type x) (struct-type x))
(define (hash-value x) (hash-value x))
(define (acos x) (acos x))
(define (asin x) (asin x))
(define (atan x) (atan x))
@ -61,20 +66,23 @@
(define (expm1 x) (expm1 x))
(define (ilogb x) (ilogb x))
(define (log1p x) (log1p x))
(define (normal? x) (normal? x))
(define (finite? x) (finite? x))
(define (subnormal? x) (subnormal? x))
(define (infinite? x) (infinite? x))
(define (nan? x) (nan? x))
; Binary value primitives; no side effects
(define (eq? x y) (eq? x y))
(define (cons x y) (cons x y))
(define (make-vector x y) (make-vector x y))
(define (make-byte-string x y) (make-byte-string x y))
(define (vector-ref x y) (vector-ref x y))
(define (byte-string-ref x y) (byte-string-ref x y))
(define (struct-ref x y) (struct-ref x y))
(define (fix+ x y) (fix+ x y))
(define (fix- x y) (fix- x y))
(define (fix* x y) (fix* x y))
@ -85,12 +93,14 @@
(define (fix> x y) (fix> x y))
(define (fix>= x y) (fix>= x y))
(define (fix<= x y) (fix<= x y))
(define (bit-and x y) (bit-and x y))
(define (bit-or x y) (bit-or x y))
(define (bit-xor x y) (bit-xor x y))
(define (fix<< x y) (fix<< x y))
(define (fix>> x y) (fix>> x y))
(define (fix>>> x y) (fix>>> x y))
(define (float+ x y) (float+ x y))
(define (float- x y) (float- x y))
(define (float* x y) (float* x y))
@ -100,6 +110,7 @@
(define (float> x y) (float> x y))
(define (float>= x y) (float>= x y))
(define (float<= x y) (float<= x y))
(define (atan2 x y) (atan2 x y))
(define (pow x y) (pow x y))
(define (ldexp x y) (ldexp x y))
@ -110,19 +121,21 @@
(define (nextafter x y) (nextafter x y))
(define (remainder x y) (remainder x y))
(define (scalb x y) (scalb x y))
(define (kind-of? x y) (kind-of? x y))
(define (byte-string= x y) (byte-string= x y))
(define (byte-string< x y) (byte-string< x y))
(define (byte-string> x y) (byte-string> x y))
(define (byte-string>= x y) (byte-string>= x y))
(define (byte-string<= x y) (byte-string<= x y))
; Binary statement primitives
(define (set-box! x y) (set-box! x y))
(define (set-car! x y) (set-car! x y))
(define (set-cdr! x y) (set-cdr! x y))
; Ternary statement primitives
(define (if x y z) (if x y z))
(define (vector-set! x y z) (vector-set! x y z))
(define (byte-string-set! x y z) (byte-string-set! x y z))
(define (struct-set! x y z) (struct-set! x y z))