Compare commits
2 Commits
31c529e83a
...
330aca002f
Author | SHA1 | Date | |
---|---|---|---|
330aca002f | |||
d109b6f374 |
@ -1,5 +1,5 @@
|
||||
CFLAGS=-g
|
||||
|
||||
all: scheme
|
||||
|
||||
scheme: gc.o runtime.o
|
||||
CFLAGS=-g
|
||||
|
||||
all: scheme
|
||||
|
||||
scheme: gc.o runtime.o
|
@ -1,64 +1,64 @@
|
||||
// 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;
|
||||
size_t tos;
|
||||
|
||||
void gc_init() {
|
||||
old = calloc(sizeof(cons_t), SIZE);
|
||||
freeptr = old;
|
||||
eom = old + (SIZE / 2);
|
||||
new = eom + 1;
|
||||
root = alloc();
|
||||
}
|
||||
|
||||
cons_t *alloc() {
|
||||
if (freeptr < eom) {
|
||||
cons_t *retval = freeptr;
|
||||
freeptr++;
|
||||
return retval;
|
||||
} else {
|
||||
gc_run();
|
||||
return alloc();
|
||||
}
|
||||
}
|
||||
|
||||
void gc_run() {
|
||||
freeptr = new;
|
||||
scanptr = new;
|
||||
// Relocate root
|
||||
relocate(root);
|
||||
// Enter the main GC loop
|
||||
gc_loop();
|
||||
// Flip old and new;
|
||||
cons_t *temp = old;
|
||||
old = new;
|
||||
new = temp;
|
||||
}
|
||||
|
||||
void gc_loop() {
|
||||
while (scanptr < freeptr) {
|
||||
relocate(scanptr);
|
||||
scanptr++;
|
||||
}
|
||||
}
|
||||
|
||||
void move(box_t box) {
|
||||
if (box.type == CONS && box.cons != the_empty_list) {
|
||||
if (box.cons->car.type == BROKEN_HEART) {
|
||||
box.cons = box.cons->cdr.cons;
|
||||
} else {
|
||||
memcpy(freeptr, box.cons, sizeof(cons_t));
|
||||
box.cons->car.type = BROKEN_HEART;
|
||||
box.cons->cdr.cons = freeptr;
|
||||
freeptr++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void relocate(cons_t* cons) {
|
||||
move(cons->car);
|
||||
move(cons->cdr);
|
||||
}
|
||||
// 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;
|
||||
size_t tos;
|
||||
|
||||
void gc_init() {
|
||||
old = calloc(sizeof(cons_t), SIZE);
|
||||
freeptr = old;
|
||||
eom = old + (SIZE / 2);
|
||||
new = eom + 1;
|
||||
root = alloc();
|
||||
}
|
||||
|
||||
cons_t *alloc() {
|
||||
if (freeptr < eom) {
|
||||
cons_t *retval = freeptr;
|
||||
freeptr++;
|
||||
return retval;
|
||||
} else {
|
||||
gc_run();
|
||||
return alloc();
|
||||
}
|
||||
}
|
||||
|
||||
void gc_run() {
|
||||
freeptr = new;
|
||||
scanptr = new;
|
||||
// Relocate root
|
||||
relocate(root);
|
||||
// Enter the main GC loop
|
||||
gc_loop();
|
||||
// Flip old and new;
|
||||
cons_t *temp = old;
|
||||
old = new;
|
||||
new = temp;
|
||||
}
|
||||
|
||||
void gc_loop() {
|
||||
while (scanptr < freeptr) {
|
||||
relocate(scanptr);
|
||||
scanptr++;
|
||||
}
|
||||
}
|
||||
|
||||
void move(box_t box) {
|
||||
if (box.type == CONS && box.cons != the_empty_list) {
|
||||
if (box.cons->car.type == BROKEN_HEART) {
|
||||
box.cons = box.cons->cdr.cons;
|
||||
} else {
|
||||
memcpy(freeptr, box.cons, sizeof(cons_t));
|
||||
box.cons->car.type = BROKEN_HEART;
|
||||
box.cons->cdr.cons = freeptr;
|
||||
freeptr++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void relocate(cons_t* cons) {
|
||||
move(cons->car);
|
||||
move(cons->cdr);
|
||||
}
|
@ -1,16 +1,16 @@
|
||||
#ifndef _GC_H_
|
||||
#define _GC_H_
|
||||
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include "common.h"
|
||||
|
||||
void gc_init();
|
||||
cons_t *alloc();
|
||||
void gc_run();
|
||||
void gc_loop();
|
||||
void relocate(cons_t*);
|
||||
|
||||
#endif // _GC_H_
|
||||
#ifndef _GC_H_
|
||||
#define _GC_H_
|
||||
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include "common.h"
|
||||
|
||||
void gc_init();
|
||||
cons_t *alloc();
|
||||
void gc_run();
|
||||
void gc_loop();
|
||||
void relocate(cons_t*);
|
||||
|
||||
#endif // _GC_H_
|
@ -1,135 +0,0 @@
|
||||
#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;
|
||||
}
|
@ -1,17 +0,0 @@
|
||||
#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_
|
@ -1,25 +0,0 @@
|
||||
|
||||
#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();
|
||||
}
|
@ -1,9 +1,7 @@
|
||||
(define-module (scmvm)
|
||||
#:use-module (scmvm vm)
|
||||
#:use-module (scmvm assembler)
|
||||
#:use-module (scmvm debugger)
|
||||
#:use-module (ice-9 ports)
|
||||
#:export (read-all-instructions instructions-from-file))
|
||||
#:export (read-all-instructions
|
||||
instructions-from-file))
|
||||
|
||||
(define (read-all-instructions)
|
||||
(let ([inst (read)])
|
||||
|
@ -1,4 +1,4 @@
|
||||
(define-module (scmvm assembler)
|
||||
(define-module (scmvm language assembler)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (scmvm vm)
|
||||
#:use-module (rnrs bytevectors)
|
@ -1,8 +0,0 @@
|
||||
(use-modules (scmvm)
|
||||
(scmvm vm)
|
||||
(scmvm assembler)
|
||||
(scmvm debugger))
|
||||
|
||||
(define my-instructions (instructions-from-file "./asm/runtime.scm"))
|
||||
(define my-debugger (make-debugger my-instructions))
|
||||
(define my-vm (debugger-vm my-debugger))
|
Loading…
Reference in New Issue
Block a user