Skip to content

Instantly share code, notes, and snippets.

@jeandrek
Last active January 20, 2022 00:51
Show Gist options
  • Save jeandrek/9c3bcb07cb7a5f61a79dec860bf9188a to your computer and use it in GitHub Desktop.
Save jeandrek/9c3bcb07cb7a5f61a79dec860bf9188a to your computer and use it in GitHub Desktop.
Scratch RISC-V subset emulator programs
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';
}
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;
}
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
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 $@ $<
SECTIONS {
. = 0;
.text : { *(.text) *(.rodata) *(.data) *(.bss) }
/DISCARD/ : { *(.comment) }
}
# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment