Start working on reference for runtime environment

This commit is contained in:
Dane Johnson 2025-08-28 09:06:22 -05:00
parent 3166108e4e
commit 31c529e83a
8 changed files with 219 additions and 49 deletions

3
reference/.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
*.o
scheme
scheme.exe

View File

@ -1,6 +1,5 @@
CFLAGS=-g
all: gctest
all: scheme
gctest: gc.o
$(CC) $(CFLAGS) -o $@ $<
scheme: gc.o runtime.o

27
reference/common.h Normal file
View File

@ -0,0 +1,27 @@
#ifndef _COMMON_H_
#define _COMMON_H_
#define SIZE 1024
#define BROKEN_HEART 1
#define CONS 2
#define INTEGER 3
#define SYMBOL 4
#define BYE 5
typedef struct box_t {
char type;
union {
int integer;
char* symbol;
struct cons_t* cons;
};
} box_t;
typedef struct cons_t {
box_t car;
box_t cdr;
} cons_t;
extern cons_t *the_empty_list;
#endif // _COMMON_H_

View File

@ -1,11 +1,12 @@
// Cheney style stop and copy garbage collector
#include "gc.h"
cons_t *the_empty_list = NULL;
static cons_t *old, *new, *scanptr, *freeptr, *eom, *root;
static cons_t *the_empty_list = NULL;
size_t tos;
void init() {
void gc_init() {
old = calloc(sizeof(cons_t), SIZE);
freeptr = old;
eom = old + (SIZE / 2);
@ -61,28 +62,3 @@ void relocate(cons_t* cons) {
move(cons->car);
move(cons->cdr);
}
int main() {
init();
// Simulate running linear fibonnaci
root->car.type = INTEGER;
root->car.integer = 1;
root->cdr.type = CONS;
root->cdr.cons = alloc();
root->cdr.cons->car.type = INTEGER;
root->cdr.cons->car.integer = 0;
root->cdr.cons->cdr.type = CONS;
root->cdr.cons->cdr.cons = the_empty_list;
for (size_t i = 0; i < 29; i++) {
cons_t *cons = alloc();
cons->car.type = INTEGER;
cons->car.integer = root->car.integer + root->cdr.cons->car.integer;
cons->cdr.type = CONS;
cons->cdr.cons = root;
root->cdr.cons = the_empty_list;
root = cons;
};
printf("%d\n", root->car.integer); // 832040, and we've definitely run gc a few times
}

View File

@ -1,28 +1,16 @@
#ifndef _GC_H_
#define _GC_H_
#include <stdint.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "common.h"
#define SIZE 8
#define BROKEN_HEART 1
#define CONS 2
#define INTEGER 3
typedef struct box_t {
char type;
union {
int integer;
struct cons_t* cons;
};
} box_t;
typedef struct cons_t {
box_t car;
box_t cdr;
} cons_t;
void init();
void gc_init();
cons_t *alloc();
void gc_run();
void gc_loop();
void relocate(cons_t*);
#endif // _GC_H_

135
reference/runtime.c Normal file
View File

@ -0,0 +1,135 @@
#include "runtime.h"
box_t cons(box_t car, box_t cdr) {
cons_t* kons = alloc();
kons->car = car;
kons->cdr = cdr;
box_t box;
box.type = CONS;
box.cons = kons;
return box;
}
void chomp_ws() {
char c = getchar();
for(;;) {
if (c == ' ' || c == '\t' || c == '\n' || c == '\r') {
c = getchar();
} else {
ungetchar(c);
break;
}
}
}
box_t read_integer() {
char buf[256];
size_t i = 0;
char next = getchar();
while(isdigit(next)) {
buf[i] = next;
next = getchar();
i++;
}
ungetchar(next);
buf[i] = 0;
box_t res;
res.type = INTEGER;
res.integer = atoi(buf);
chomp_ws();
return res;
}
box_t read_symbol() {
char buf[256];
size_t i = 0;
char next = getchar();
while (isalpha(next)) { // Totally insufficent but we'll look into it later
buf[i] = next;
next = getchar();
i++;
}
ungetchar(next);
buf[i] = 0;
box_t res;
char *str = strndup(buf, i);
res.type = SYMBOL;
res.symbol = str;
chomp_ws(); // Clean up whitespace afterwards
return res;
}
box_t read_list() {
char c = getchar();
box_t val;
if (c == ')') {
chomp_ws();
val.type = CONS;
val.cons = the_empty_list;
return val;
} else {
ungetchar(c);
box_t car = read();
box_t cdr = read_list();
return cons(car, cdr);
}
}
box_t read() {
chomp_ws();
char next = getchar();
if (next == '(') {
chomp_ws();
return read_list();
} else if (isdigit(next)) {
ungetchar(next);
return read_integer();
} else if (isalpha(next) || ispunct(next)) {
ungetchar(next);
return read_symbol();
} else if (next == EOF) {
box_t bye;
bye.type = BYE;
return bye;
} else {
fprintf(stderr, "Bad input");
exit(1);
}
}
void scm_print_cons(box_t exp) {
printf("(");
while(exp.type = CONS && exp.cons != the_empty_list) {
scm_print(exp.cons->car);
if (exp.cons->cdr.cons != the_empty_list) {
printf(" ");
}
exp = exp.cons->cdr;
}
if (exp.cons == the_empty_list) {
printf(")");
} else {
printf(". ");
scm_print(exp);
printf(")");
}
}
void scm_print(box_t exp) {
switch (exp.type) {
case INTEGER:
printf("%d", exp.integer);
break;
case SYMBOL:
printf("%s", exp.symbol);
break;
case CONS:
scm_print_cons(exp);
break;
}
}
box_t eval(box_t exp) {
return exp;
}

17
reference/runtime.h Normal file
View File

@ -0,0 +1,17 @@
#ifndef _RUNTIME_H_
#define _RUNTIME_H_
#include <stdlib.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include "common.h"
#include "gc.h"
#define ungetchar(X) ungetc(X, stdin)
box_t read();
box_t eval(box_t);
void scm_print(box_t);
#endif // _RUNTIME_H_

25
reference/scheme.c Normal file
View File

@ -0,0 +1,25 @@
#include "gc.h"
#include "runtime.h"
void prompt() {
printf("> ");
}
int repl() {
box_t res;
do {
prompt();
box_t in = read();
res = eval(in);
scm_print(res);
printf("\n");
} while (res.type != BYE);
return 0;
}
int main() {
gc_init();
return repl();
}