Scratch RISC-V subset emulator programs

calc.c

void writestr(char *);
void writenum(int);
int readchar(void);
void writechar(int);
int isdigit(int c);

void
main(void)
{
	int stack[30];
	int k = 0;

	writestr("RPN calculator\n");
	while (1) {
		int c = readchar();
		int negnum = 0;

existingchar:
		if (isdigit(c)) {
			int n = 0;
			while (isdigit(c)) {
				n = 10*n + c - '0';
				c = readchar();
			}
			stack[k++] = negnum ? -n : n;
			goto existingchar;
		} else if (c == '+') {
			stack[k - 2] = stack[k - 2] + stack[k - 1];
			k--;
		} else if (c == '-') {
			c = readchar();
			if (isdigit(c)) {
				negnum = 1;
			} else {
				stack[k - 2] = stack[k - 2] - stack[k - 1];
				k--;
			}
			goto existingchar;
		} else if (c == '*') {
			stack[k - 2] = stack[k - 2] * stack[k - 1];
			k--;
		} else if (c == '/') {
			stack[k - 2] = stack[k - 2] / stack[k - 1];
			k--;
		} else if (c == 'R') {
			stack[k - 2] = stack[k - 2] % stack[k - 1];
			k--;
		} else if (c == '\n') {
			while (k > 0) {
				writenum(stack[--k]);
				writechar('\n');
			}
		}
	}
}

int
isdigit(int c)
{
	return c >= '0' && c <= '9';
}

fib.c

int readnum(void);
void writenum(int x);
int readchar(void);
int fib(int n);

void
main(void)
{
	writenum(fib(readnum()));
}

int
fib(int n)
{
	if (n == 0) return 0;
	if (n == 1) return 1;
	return fib(n - 1) + fib(n - 2);
}

/* Also swallows following character */
int
readnum(void)
{
	int c = readchar();
	int negnum = 0;
	int n = 0;

	if (c == '-') negnum = 1;
	do {
		n = 10*n + c - '0';
		c = readchar();
	} while (c >= '0' && c <= '9');
	return negnum ? -n : n;
}

lib.s

	uart = 0x10000000
	plic = 0xc000000
	.text
	.globl	_start
_start:
	li	sp,0x1200
	li	t1,1
	li	t2,uart+1
	sb	t1,(t2)
	li	t1,0x400
	li	t2,plic+0x2000
	sw	t1,(t2)
	call	main
	ebreak
	.globl	writestr
writestr:
	addi	sp,sp,-16
	sw	ra,12(sp)
	mv	t1,a0
1:
	lbu	a0,(t1)
	beqz	a0,2f
	call	writechar
	addi	t1,t1,1
	j	1b
2:
	lw	ra,12(sp)
	addi	sp,sp,16
	ret
	.globl	writenum
writenum:
	addi	sp,sp,-16
	sw	ra,12(sp)
	mv	t1,a0
	bgez	t1,1f
	li	a0,'-'
	call	writechar
	neg	t1,t1
1:
	li	t2,10
	li	t3,1
2:
	mul	t4,t2,t3
	bgt	t4,t1,3f
	mv	t3,t4
	j	2b
3:
	div	a1,t1,t3
	rem	a0,a1,t2
	addi	a0,a0,'0'
	call	writechar
	div	t3,t3,t2
	bgtz	t3,3b
	lw	ra,12(sp)
	addi	sp,sp,16
	ret
	.globl	readchar
readchar:
	lla	t5,charin
	lbu	a0,(t5)
	beqz	a0,1f
	sb	x0,(t5)
	ret
1:
	li	t5,uart+5
	lbu	t6,(t5)
	andi	t6,t6,1
	bnez	t6,2f
	wfi
	j	1b
2:
	li	t5,uart+0
	lbu	a0,(t5)
	ret
	.globl	peekchar
peekchar:
	lla	t4,charin
	lbu	a0,(t4)
	bnez	a0,3f
1:
	li	t5,uart+5
	lbu	t6,(t5)
	andi	t6,t6,1
	bnez	t6,2f
	wfi
	j	1b
2:
	li	t5,uart+0
	lbu	a0,(t5)
	sb	a0,(t4)
3:
	ret
	.globl	writechar
writechar:
	li	t5,uart+0
	sb	a0,(t5)
	ret
charin:
	.space	1

Makefile

AS=riscv32-elf-as
CC=riscv32-elf-gcc
LD=riscv32-elf-ld
OBJCOPY=riscv32-elf-objcopy

LDFLAGS=-T riscv.ld
ASFLAGS=-march=rv32imfd
CFLAGS=$(ASFLAGS) -O2

.SUFFIXES: .s .S .txt

all: lib.o calc.txt

.o.txt:
	$(LD) $(LDFLAGS) -o $* lib.o $<
	$(OBJCOPY) -O binary $* $*.bin
	xxd -p $*.bin | tr -d "\n" | sed "s/.\{2\}/&\n/g" | sed "s/^/0x/g" >$@

.s.o:
	$(AS) $(ASFLAGS) -o $@ $<

.S.o:
	$(CC) $(ASFLAGS) -c -o $@ $<

riscv.ld

SECTIONS {
	 . = 0;
	 .text : { *(.text) *(.rodata) *(.data) *(.bss) }
	 /DISCARD/ : { *(.comment) }
}

scheme.S

# A simple Scheme interpreter
# With a SICP-esque Cheney's algorithm garbage collector

#define TAG_PAIR	0
#define TAG_FIXNUM	1
#define TAG_PROCEDURE	2
#define TAG_SYMBOL	3

#define REG_FROMSPACE	s1
#define REG_TOSPACE	s2
#define REG_FREE	s3
#define REG_ENV		s4
#define TOP_OF_STACK	0x1200
#define SPACE_SIZE	0x600

#define OBARRAY		TOP_OF_STACK + 2*SPACE_SIZE
#define SYMBOL_LENGTH	16

#define BROKEN_HEART	4
#define TRUE		7
#define FALSE		3

#define NUM_PRIMITIVES	15

# Every stack frame reachable by GC must have no dead values.
#define ZEROFRAME		\
	sw	x0,8(sp);	\
	sw	x0,4(sp);	\
	sw	x0,(sp)

	.text
	.globl	main
main:
	li	REG_TOSPACE,TOP_OF_STACK
	addi	REG_FROMSPACE,REG_TOSPACE,SPACE_SIZE
	mv	REG_FREE,sp
	addi	sp,sp,-16
	sw	ra,12(sp)
	lla	a0,str_msg
	call	writestr
	call	init_eval
	call	make_initial_environment
1:
	li	a0,'>'
	call	writechar
	call	read
	sw	REG_ENV,8(sp)
	call	eval
	lw	REG_ENV,8(sp)
	call	write
	li	a0,'\n'
	call	writechar
	j	1b

error:
	call	writestr
	li	a0,'\n'
	call	writechar
	li	sp,TOP_OF_STACK - 16
	lw	REG_ENV,8(sp)
	j	1b


# Initial environment and primitives

	.globl	make_initial_environment
make_initial_environment:
	addi	sp,sp,-16
	sw	ra,12(sp)
	lla	a0,prim_names
	li	t0,NUM_PRIMITIVES
	li	t1,0
1:
	beqz	t0,4f
	sw	t1,8(sp)
	sw	t0,4(sp)
	sw	a0,(sp)
	call	intern
	lw	a1,8(sp)
	call	cons
	mv	t1,a0
	lw	a0,(sp)
2:
	lbu	t2,(a0)
	beqz	t2,3f
	addi	a0,a0,1
	j	2b
3:
	lw	t0,4(sp)
	addi	a0,a0,1
	addi	t0,t0,-1
	j	1b
4:
	sw	t1,8(sp)
	lla	t0,prim_addrs
	li	t1,NUM_PRIMITIVES
	li	a1,0
1:
	beqz	t1,2f
	lw	a0,(t0)
	ori	a0,a0,TAG_PROCEDURE
	sw	t1,4(sp)
	sw	t0,(sp)
	call	cons
	lw	t0,(sp)
	lw	t1,4(sp)
	mv	a1,a0
	addi	t0,t0,4
	addi	t1,t1,-1
	j	1b
2:
	lw	a0,8(sp)
	call	cons
	li	a1,0
	call	cons
	mv	REG_ENV,a0
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

#define CHECK_PAIR(x)			\
	beqz	x,1f;			\
	andi	t0,x,3;			\
	beqz	t0,2f;			\
1:					\
	lla	a0,str_type_pair;	\
	tail	error;			\
2:

#define CHECK_FIXNUM(x) 		\
	andi	t0,x,3;			\
	li	t1,TAG_FIXNUM;		\
	beq	t0,t1,1f;		\
	lla	a0,str_type_fixnum;	\
	tail	error;			\
1:

#define DYADIC_ARGS		\
	lw	t0,4(a0);	\
	lw	a1,(t0);	\
	lw	a0,(a0)

prim_eq:
	DYADIC_ARGS
Lcmp:
	bne	a0,a1,1f
	li	a0,TRUE
	ret
1:
	li	a0,FALSE
	ret

prim_numberp:
	lw	a0,(a0)
	andi	a0,a0,3
	li	t0,TAG_FIXNUM
	bne	a0,t0,1f
	li	a0,TRUE
	ret
1:
	li	a0,FALSE
	ret

prim_num_eql:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	j	Lcmp

prim_lt:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	slt	a0,a0,a1
	slli	a0,a0,2
	addi	a0,a0,FALSE
	ret

prim_add:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	xori	a1,a1,TAG_FIXNUM
	add	a0,a0,a1
	ret

prim_sub:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	xori	a1,a1,TAG_FIXNUM
	sub	a0,a0,a1
	ret

prim_mul:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	xori	a0,a0,TAG_FIXNUM
	srai	a1,a1,2
	mul	a0,a0,a1
	ori	a0,a0,TAG_FIXNUM
	ret

prim_quotient:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	srai	a0,a0,2
	srai	a1,a1,2
	div	a0,a0,a1
	slli	a0,a0,2
	ori	a0,a0,TAG_FIXNUM
	ret

prim_remainder:
	DYADIC_ARGS
	CHECK_FIXNUM(a0)
	CHECK_FIXNUM(a1)
	srai	a0,a0,2
	srai	a1,a1,2
	rem	a0,a0,a1
	slli	a0,a0,2
	ori	a0,a0,TAG_FIXNUM
	ret

prim_pairp:
	lw	a0,(a0)
	andi	t0,a0,3
	bnez	t0,1f
	beqz	a0,1f
	li	a0,TRUE
	ret
1:
	li	a0,FALSE
	ret

prim_cons:
	lw	t0,4(a0)
	lw	t0,(t0)
	sw	t0,4(a0)
	ret

prim_car:
	lw	a0,(a0)
	CHECK_PAIR(a0)
	lw	a0,(a0)
	ret

prim_cdr:
	lw	a0,(a0)
	CHECK_PAIR(a0)
	lw	a0,4(a0)
	ret

prim_symbolp:
	lw	a0,(a0)
	andi	t0,a0,3
	li	t1,TAG_SYMBOL
	bne	t0,t1,1f
	li	t0,TRUE
	beq	a0,t0,1f
	li	t0,FALSE
	beq	a0,t0,1f
	li	a0,TRUE
	ret
1:
	li	a0,FALSE
	ret

prim_procedurep:
	lw	a0,(a0)
	andi	t0,a0,3
	li	t1,TAG_PROCEDURE
	bne	t0,t1,1f
	li	a0,TRUE
	ret
1:
	li	a0,FALSE
	ret


# Evaluator

#define SYM_QUOTE	(OBARRAY | TAG_SYMBOL)
#define SYM_LAMBDA	SYM_QUOTE + SYMBOL_LENGTH
#define SYM_IF		SYM_LAMBDA + SYMBOL_LENGTH
#define SYM_COND	SYM_IF + SYMBOL_LENGTH
#define SYM_LET		SYM_COND + SYMBOL_LENGTH
#define SYM_DEFINE	SYM_LET + SYMBOL_LENGTH
#define SYM_OK		SYM_DEFINE + SYMBOL_LENGTH

	.globl	init_eval
init_eval:
	addi	sp,sp,-16
	sw	ra,12(sp)
	lla	a0,str_quote
	call	intern
	lla	a0,str_lambda
	call	intern
	lla	a0,str_if
	call	intern
	lla	a0,str_cond
	call	intern
	lla	a0,str_let
	call	intern
	lla	a0,str_define
	call	intern
	lla	a0,str_ok
	call	intern
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

	.globl	eval
eval:
	andi	t0,a0,3
	bnez	t0,1f
	beqz	a0,2f
	j	Leval_pair
1:
	li	t1,TAG_FIXNUM
	beq	t0,t1,Leval_self_evaluating
	li	t1,TAG_SYMBOL
	bne	t0,t1,2f
	li	t0,TRUE
	beq	a0,t0,Leval_self_evaluating
	li	t0,FALSE
	beq	a0,t0,Leval_self_evaluating
	j	Leval_variable
2:
	lla	a0,str_bad_exp
	tail	error

Leval_self_evaluating:
	ret

Leval_variable:
	tail	lookup

Leval_pair:
	lw	t0,(a0)
	li	t1,SYM_QUOTE
	beq	t0,t1,Leval_quote
	li	t1,SYM_LAMBDA
	beq	t0,t1,Leval_lambda
	li	t1,SYM_IF
	beq	t0,t1,Leval_if
	li	t1,SYM_DEFINE
	beq	t0,t1,Leval_define
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
	lw	a0,4(a0)
	sw	t0,8(sp)
	call	eval_arguments
	sw	a0,4(sp)
	lw	a0,8(sp)
	call	eval
	lw	a1,4(sp)
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	apply

Leval_quote:
	lw	a0,4(a0)
	lw	a0,(a0)
	ret

Leval_lambda:
	lw	t0,4(a0)
	lw	a0,(t0)
	lw	t0,4(t0)
	lw	a1,(t0)
	tail	make_procedure

Leval_if:
	addi	sp,sp,-16
	sw	ra,12(sp)
	ZEROFRAME
	lw	t0,4(a0)
	lw	a0,(t0)
	lw	t0,4(t0)
	sw	t0,8(sp)
	call	eval
	lw	t0,8(sp)
	li	t1,FALSE
	beq	a0,t1,Leval_alt
	j	Leval_conseq
Leval_alt:
	lw	t0,4(t0)
Leval_conseq:
	lw	a0,(t0)
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	eval

Leval_define:
	addi	sp,sp,-16
	sw	ra,12(sp)
	ZEROFRAME
	lw	t0,4(a0)
	lw	t1,(t0)
	andi	t2,t1,3
	bnez	t2,1f
	lw	t2,(t1)
	lw	a0,4(t1)
	lw	a1,4(t0)
	sw	t2,8(sp)
	call	cons
	mv	a1,a0
	li	a0,SYM_LAMBDA
	call	cons
	j	2f
1:
	lw	t0,4(t0)
	lw	a0,(t0)
	sw	t1,8(sp)
2:
	call	eval
	mv	a1,a0
	lw	a0,8(sp)
	call	add_binding
	lw	ra,12(sp)
	li	a0,SYM_OK
	addi	sp,sp,16
	ret

eval_arguments:
	addi	sp,sp,-16
	sw	ra,12(sp)
	sw	x0,(sp)
	mv	t0,a0
	li	t1,0
1:
	beqz	t0,2f
	sw	t0,8(sp)
	sw	t1,4(sp)
	sw	REG_ENV,(sp)
	lw	a0,(t0)
	call	eval
	lw	REG_ENV,(sp)
	lw	a1,4(sp)
	call	cons
	mv	t1,a0
	lw	t0,8(sp)
	lw	t0,4(t0)
	j	1b
2:
	mv	a0,t1
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	nreverse


# Procedures and environments

	.globl	make_procedure
make_procedure:
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
	call	cons
	mv	a1,a0
	mv	a0,REG_ENV
	call	cons
	ori	a0,a0,TAG_PROCEDURE
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

	.globl	apply
apply:
	andi	t0,a0,3
	li	t1,TAG_PROCEDURE
	bne	t0,t1,Lnot_proc
	xori	t0,a0,TAG_PROCEDURE
	li	t1,TOP_OF_STACK
	blt	t0,t1,Lapply_primitive
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
	sw	t0,8(sp)
	lw	t0,4(t0)
	lw	a0,(t0)
	call	cons
	lw	t0,8(sp)
	lw	a1,(t0)
	call	cons
	mv	REG_ENV,a0
	lw	t0,8(sp)
	lw	t0,4(t0)
	lw	a0,4(t0)
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	eval
Lapply_primitive:
	mv	a0,a1
	jr	(t0)
Lnot_proc:
	lla	a0,str_not_proc
	tail	error

	.globl	lookup
lookup:
	mv	t0,REG_ENV
Lframe:
	beqz	t0,Lunbound
	lw	t1,(t0)
	lw	t2,(t1)
	lw	t3,4(t1)
1:
	beqz	t2,3f
	lw	t4,(t2)
	beq	t4,a0,2f
	lw	t2,4(t2)
	lw	t3,4(t3)
	j	1b
2:
	lw	a0,(t3)
	ret
3:
	lw	t0,4(t0)
	j	Lframe
Lunbound:
	lla	a0,str_unbound
	tail	error

	.globl	add_binding
add_binding:
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
	lw	t0,(REG_ENV)
	sw	a1,8(sp)
	lw	a1,(t0)
	call	cons
	lw	t0,(REG_ENV)
	sw	a0,(t0)
	lw	a0,8(sp)
	lw	a1,4(t0)
	call	cons
	lw	t0,(REG_ENV)
	sw	a0,4(t0)
	lw	ra,12(sp)
	addi	sp,sp,16
	ret


# Reader and symbols

	.globl	read
read:
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
Lwhitespace:
	call	readchar
	li	t1,' '
	beq	a0,t1,Lwhitespace
	li	t1,'\n'
	beq	a0,t1,Lwhitespace
	li	t1,'0'
	blt	a0,t1,1f
	li	t1,'9'
	li	t2,0
	ble	a0,t1,Lread_num
1:
	li	t1,'+'
	bne	a0,t1,2f
	mv	t0,a0
	call	peekchar
	mv	t1,a0
	mv	a0,t0
	li	t2,'0'
	blt	t1,t2,2f
	li	t2,'9'
	bgt	t1,t2,Lread_symbol
	call	readchar
	li	t2,0
	j	Lread_num
2:
	li	t1,'-'
	bne	a0,t1,3f
	mv	t0,a0
	call	peekchar
	mv	t1,a0
	mv	a0,t0
	li	t2,'0'
	blt	t1,t2,3f
	li	t2,'9'
	bgt	t1,t2,Lread_symbol
	call	readchar
	li	t2,1
	j	Lread_num
3:
	li	t1,'A'
	blt	a0,t1,4f
	li	t1,'Z'
	ble	a0,t1,Lread_symbol
4:
	lla	t1,ext_alph_chars
5:
	lbu	t2,(t1)
	beqz	t2,6f
	beq	a0,t2,Lread_symbol
	addi	t1,t1,1
	j	5b
6:
	li	t1,'('
	beq	a0,t1,Lread_list
	li	t1,'\''
	beq	a0,t1,Lread_quote
	li	t1,'#'
	beq	a0,t1,Lread_hash
Lunexpected_char:
	lla	a0,str_bad_read
	tail	error

Lread_num:
	addi	t0,a0,-'0'
1:
	call	peekchar
	li	t1,'0'
	blt	a0,t1,2f
	li	t1,'9'
	bgt	a0,t1,2f
	call	readchar
	addi	a0,a0,-'0'
	li	t1,10
	mul	t0,t0,t1
	add	t0,t0,a0
	j	1b
2:
	mv	a0,t0
	beqz	t2,3f
	neg	a0,a0
3:
	slli	a0,a0,2
	ori	a0,a0,TAG_FIXNUM
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

Lread_symbol:
	addi	sp,sp,-16
	sb	a0,(sp)
	addi	t0,sp,1
1:
	call	peekchar
	li	t1,'A'
	blt	a0,t1,2f
	li	t1,'Z'
	ble	a0,t1,Lconsume
2:
	li	t1,'0'
	blt	a0,t1,3f
	li	t1,'9'
	ble	a0,t1,Lconsume
3:
	lla	t1,ext_alph_chars
4:
	lbu	t2,(t1)
	beqz	t2,5f
	beq	a0,t2,Lconsume
	addi	t1,t1,1
	j	4b
Lconsume:
	call	readchar
	sb	a0,(t0)
	addi	t0,t0,1
	j	1b
5:
	sb	x0,(t0)
	mv	a0,sp
	call	intern
	lw	ra,28(sp)
	addi	sp,sp,32
	ret

Lread_list:
	li	t0,0
1:
	sw	t0,8(sp)
	call	peekchar
	li	t1,')'
	beq	a0,t1,2f
	call	read
	lw	a1,8(sp)
	call	cons
	mv	t0,a0
	j	1b
2:
	call	readchar
	lw	a0,8(sp)
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	nreverse

Lread_quote:
	call	read
	li	a1,0
	call	cons
	sw	a0,8(sp)
	lla	a0,str_quote
	call	intern
	lw	a1,8(sp)
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	cons

Lread_hash:
	call	readchar
	li	t0,'T'
	bne	a0,t0,1f
	li	a0,TRUE
	j	2f
1:
	li	t0,'F'
	bne	a0,t0,Lunexpected_char
	li	a0,FALSE
2:
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

	.globl	intern
intern:
	mv	a1,a0
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
	li	a0,OBARRAY
1:
	lw	t0,(a0)
	beqz	t0,3f
	sw	a0,8(sp)
	sw	a1,4(sp)
	call	str_eql
	bnez	a0,2f
	lw	a0,8(sp)
	lw	a1,4(sp)
	addi	a0,a0,SYMBOL_LENGTH
	j	1b
2:
	lw	a0,8(sp)
	ori	a0,a0,TAG_SYMBOL
	lw	ra,12(sp)
	addi	sp,sp,16
	ret
3:
	sw	a0,8(sp)
	call	str_cpy
	lw	a0,8(sp)
	ori	a0,a0,TAG_SYMBOL
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

str_eql:
	lbu	t0,(a0)
	lbu	t1,(a1)
	bne	t0,t1,2f
	beqz	t0,1f
	addi	a0,a0,1
	addi	a1,a1,1
	j	str_eql
1:
	li	a0,1
	ret
2:
	li	a0,0
	ret

str_cpy:
	lbu	t0,(a1)
	beqz	t0,1f
	sb	t0,(a0)
	addi	a0,a0,1
	addi	a1,a1,1
	j	str_cpy
1:
	ret


# Printer

	.globl	write
write:
	addi	sp,sp,-16
	ZEROFRAME
	sw	ra,12(sp)
	andi	t0,a0,3
	bnez	t0,1f
	beqz	a0,Lwrite_empty_list
	j	Lwrite_pair
1:
	li	t1,TAG_FIXNUM
	beq	t0,t1,Lwrite_fixnum
	li	t1,TAG_PROCEDURE
	beq	t0,t1,Lwrite_procedure
	li	t0,TRUE
	beq	a0,t0,Lwrite_true
	li	t0,FALSE
	beq	a0,t0,Lwrite_false
	j	Lwrite_symbol
Lwrite_empty_list:
	li	a0,'('
	call	writechar
	li	a0,')'
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	writechar
Lwrite_true:
	li	a0,'#'
	call	writechar
	li	a0,'t'
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	writechar
Lwrite_false:
	li	a0,'#'
	call	writechar
	li	a0,'f'
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	writechar
Lwrite_pair:
	lw	t0,(a0)
	sw	a0,8(sp)
	li	a0,'('
	call	writechar
	lw	a0,8(sp)
Lnext_element:
	lw	t0,(a0)
	lw	t1,4(a0)
	mv	a0,t0
	sw	t1,8(sp)
	call	write
	lw	t1,8(sp)
	beqz	t1,Lend_of_list
	li	a0,' '
	call	writechar
	lw	a0,8(sp)
	andi	t0,a0,3
	beqz	t0,Lnext_element
	sw	a0,8(sp)
	li	a0,'.'
	call	writechar
	li	a0,' '
	call	writechar
	lw	a0,8(sp)
	call	write
Lend_of_list:
	li	a0,')'
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	writechar
Lwrite_fixnum:
	srai	a0,a0,2
	addi	sp,sp,16
	tail	writenum
Lwrite_procedure:
	li	t0,TOP_OF_STACK
	blt	a0,t0,Lwrite_primitive
	xori	t0,a0,TAG_PROCEDURE
	sw	t0,8(sp)
	lla	a0,str_proc
	call	writestr
	lw	t0,8(sp)
	lw	t0,4(t0)
	lw	a0,(t0)
	call	write
	li	a0,']'
	lw	ra,12(sp)
	addi	sp,sp,16
	tail	writechar
Lwrite_primitive:
	sw	a0,8(sp)
	lla	a0,str_prim
	addi	sp,sp,16
	tail	writestr
Lwrite_symbol:
	xori	a0,a0,TAG_SYMBOL
	addi	sp,sp,16
	tail	writestr


# Lists

	.globl nreverse
nreverse:
	li	t0,0
1:
	beqz	a0,2f
	lw	t1,4(a0)
	sw	t0,4(a0)
	mv	t0,a0
	mv	a0,t1
	j	1b
2:
	mv	a0,t0
	ret


# Allocation and garbage collector

	.globl	cons
cons:
	mv	t0,REG_TOSPACE
	addi	t0,t0,SPACE_SIZE
	beq	REG_FREE,t0,2f
1:
	mv	t0,REG_FREE
	addi	REG_FREE,REG_FREE,8
	sw	a0,(t0)
	sw	a1,4(t0)
	mv	a0,t0
	ret
2:
	addi	sp,sp,-16
	sw	ra,12(sp)
	sw	x0,(sp)
	sw	a0,8(sp)
	sw	a1,4(sp)
	call	gc
	lw	a1,4(sp)
	lw	a0,8(sp)
	mv	t0,REG_TOSPACE
	addi	t0,t0,SPACE_SIZE
	beq	REG_FREE,t0,Lout_of_mem
	lw	ra,12(sp)
	addi	sp,sp,16
	j	1b
Lout_of_mem:
	lla	a0,str_out_of_mem
	tail	error

gc:
	addi	sp,sp,-16
	sw	ra,12(sp)
	lla	a0,str_gc
	call	writestr
	mv	t0,REG_FROMSPACE
	mv	REG_FROMSPACE,REG_TOSPACE
	mv	REG_TOSPACE,t0
	mv	REG_FREE,t0
	mv	a0,REG_ENV
	call	relocate
	mv	REG_ENV,a0
	addi	t1,sp,16
	li	t2,TOP_OF_STACK
Ltraverse_stack:
	beq	t1,t2,Lgc_loop
	lw	a0,(t1)
	blt	a0,t2,1f
	call	relocate
	sw	a0,(t1)
1:
	addi	t1,t1,4
	j	Ltraverse_stack
Lgc_loop:
	beq	t0,REG_FREE,1f
	lw	t1,(t0)
	lw	t2,4(t0)
	mv	a0,t1
	call	relocate
	sw	a0,(t0)
	mv	a0,t2
	call	relocate
	sw	a0,4(t0)
	addi	t0,t0,8
	j	Lgc_loop
1:
	lw	ra,12(sp)
	addi	sp,sp,16
	ret

relocate:
	beqz	a0,1f
	andi	t5,a0,3
	beqz	t5,Lrelocate_pair
	li	t6,TAG_PROCEDURE
	beq	t5,t6,Lrelocate_procedure
1:
	ret
Lrelocate_procedure:
	li	t5,TOP_OF_STACK
	blt	a0,t5,1f
	addi	sp,sp,-16
	sw	ra,12(sp)
	xori	a0,a0,TAG_PROCEDURE
	call	relocate
	ori	a0,a0,TAG_PROCEDURE
	lw	ra,12(sp)
	addi	sp,sp,16
1:
	ret
Lrelocate_pair:
	lw	t5,(a0)
	lw	t6,4(a0)
	li	a1,BROKEN_HEART
	beq	t5,a1,Lfound_broken_heart
	sw	t5,(REG_FREE)
	sw	t6,4(REG_FREE)
	mv	t5,REG_FREE
	addi	REG_FREE,REG_FREE,8
	sw	a1,(a0)
	sw	t5,4(a0)
	mv	a0,t5
	ret
Lfound_broken_heart:
	mv	a0,t6
	ret

ext_alph_chars:	.string	"!$%&*+-./:<=>?@^_~"
str_msg:	.string	"Scheme interpreter\n"
str_quote:	.string	"QUOTE"
str_lambda:	.string	"LAMBDA"
str_if:		.string	"IF"
str_cond:	.string	"COND"
str_let:	.string	"LET"
str_define:	.string	"DEFINE"
str_ok:		.string	"OK"
str_prim:	.string	"#[primitive]"
str_proc:	.string "#[procedure "
str_gc:		.string	"GC cycle\n"
str_bad_read:	.string	"Unexpected character"
str_bad_exp:	.string	"Unknown expression type"
str_unbound:	.string	"Unbound variable"
str_not_proc:	.string	"Not a procedure"
str_out_of_mem:	.string	"Out of memory"
str_type_pair:	.string	"Expected a pair"
str_type_fixnum:.string	"Expected a fixnum"
prim_names:
	.string	"EQ?"
	.string	"NUMBER?"
	.string	"="
	.string	"<"
	.string	"+"
	.string	"-"
	.string	"*"
	.string	"QUOTIENT"
	.string	"REMAINDER"
	.string	"PAIR?"
	.string	"CONS"
	.string	"CAR"
	.string	"CDR"
	.string	"SYMBOL?"
	.string	"PROCEDURE?"
	.align	2
prim_addrs:
	.word	prim_eq
	.word	prim_numberp
	.word	prim_num_eql
	.word	prim_lt
	.word	prim_add
	.word	prim_sub
	.word	prim_mul
	.word	prim_quotient
	.word	prim_remainder
	.word	prim_pairp
	.word	prim_cons
	.word	prim_car
	.word	prim_cdr
	.word	prim_symbolp
	.word	prim_procedurep