Cell* platform_eval(Cell* expr) {
char* buf=malloc(BUFSZ);
int i = 0;
Cell* res = (Cell*)alloc_nil();
Cell* c;
int tag;
if (!expr || expr->tag!=TAG_CONS) {
printf("[platform_eval] error: no expr given.\r\n");
return NULL;
}
while (expr && (c = car(expr))) {
tag = compile_for_platform(c, &res);
if (tag) {
/*printf("~~ expr %d res: %p\r\n",i,res);
lisp_write(res, buf, 512);
printf("~> %s\r\n",buf);*/
} else {
lisp_write(c, buf, BUFSZ);
printf("[platform_eval] stopped at expression %d: %s\r\n",i,buf);
break;
}
// TOOD: when to free the code blocks? -> when no bound lambdas involved
i++;
expr = cdr(expr);
}
free(buf);
return res;
}
Cell* mouse_open(Cell* cpath) {
if (!cpath || cpath->tag!=TAG_STR) {
printf("[usbmouse] open error: non-string path given\r\n");
return alloc_nil();
}
return alloc_int(1);
}
Cell* reader_end_list(Cell* cell, ReaderState* rs) {
if (rs->level<1) {
rs->state = PST_ERR_UNEXP_CLOSING_BRACE;
return cell;
}
rs->level--;
rs->stack--;
if (cell->addr) cell->next = alloc_nil();
cell = *rs->stack;
Cell* tmpc = cell;
cell = reader_next_list_cell(cell, rs);
rs->state = PST_ATOM;
return cell;
}
Cell* fatfs_open(Cell* cpath) {
printf("[fatfs_open] called\r\n");
if (!cpath || cpath->tag!=TAG_STR) {
printf("[fatfs_open] error: non-string path given\r\n");
return alloc_nil();
}
char* path = cpath->ar.addr;
if (!strncmp(path,"/sd/",4)) {
char* filename = NULL;
if (strlen(path)>4) {
filename = path+4;
}
if (filename) {
// look for the file
printf("FAT looking for %s...\r\n",filename);
FILINFO nfo;
FRESULT rc = f_stat(filename, &nfo);
if (rc) {
printf("Failed to stat file %s: %u\r\n", filename, rc);
return alloc_int(0);
}
FIL fp;
rc = f_open(&fp, filename, FA_READ);
if (rc) {
printf("Failed to open file %s: %u\r\n", filename, rc);
return alloc_int(0);
}
printf("filesize: %d\r\n",nfo.fsize);
return alloc_int(nfo.fsize);
} else {
// directory
return alloc_int(1);
}
}
return alloc_int(0);
}
Cell* fbfs_read(Cell* stream) {
Stream* s = (Stream*)stream->ar.addr;
char* path = s->path->ar.addr;
if (!strcmp(path+12,"/width")) {
return alloc_int(WIDTH);
}
else if (!strcmp(path+12,"/height")) {
return alloc_int(HEIGHT);
}
else if (!strcmp(path+12,"/depth")) {
return alloc_int(BPP);
}
else if (!strcmp(path+12,"/")) {
return
alloc_cons(alloc_string_copy("/width"),
alloc_cons(alloc_string_copy("/height"),
alloc_cons(alloc_string_copy("/depth"),alloc_nil())));
}
else {
return alloc_int(0);
}
}
val_t error(const char *err) {
// TODO
return alloc_nil();
}
Cell* mouse_mmap(Cell* arg) {
return alloc_nil();
}
Cell* posixfs_mmap(Cell* arg) {
return alloc_nil();
}
Cell* posixfs_open(Cell* cpath) {
char* path;
_file_cell = alloc_nil();
if (!cpath || cpath->tag!=TAG_STR) {
printf("[posixfs] open error: non-string path given\r\n");
return _file_cell;
}
path = cpath->ar.addr;
if (!strncmp(path,"/sd/",4)) {
char* name = NULL;
char* filename = NULL;
if (strlen(path)>4) {
filename = path+4;
}
if (!filename || !filename[0]) filename = ".";
printf("filename: %s\r\n",filename);
if (filename) {
struct stat src_stat;
DIR* dirp;
int f;
off_t len;
if (stat(filename, &src_stat)) {
_file_cell = alloc_string_copy("<file not found>");
return _file_cell;
}
len = src_stat.st_size;
if ((dirp = opendir(filename))) {
struct dirent *dp;
Cell* nl = alloc_string_copy("\n");
_file_cell = alloc_string_copy("");
do {
if ((dp = readdir(dirp)) != NULL) {
printf("dp: |%s|\r\n",dp->d_name);
_file_cell = alloc_concat(_file_cell,alloc_concat(alloc_string_copy(dp->d_name),nl));
}
} while (dp != NULL);
return _file_cell;
}
f = open(filename, O_RDONLY);
if (f>-1) {
Cell* res;
int read_len;
printf("[posixfs] trying to read file of len %d...\r\n",len);
res = alloc_num_bytes(len);
read_len = read(f, res->ar.addr, len);
close(f);
// TODO: close?
_file_cell = res;
return res;
} else {
// TODO should return error
printf("[posixfs] could not open file :(\r\n");
_file_cell = alloc_string_copy("<error: couldn't open file.>"); // FIXME hack
return _file_cell;
}
_file_cell = alloc_string_copy("<error: file not found.>");
return _file_cell;
} else {
// TODO dir
}
}
return _file_cell;
}
Cell* reader_next_list_cell(Cell* cell, ReaderState* rs) {
cell->next = alloc_nil();
cell = cell->next;
rs->state = PST_ATOM;
return cell;
}
ReaderState* read_char(char c, ReaderState* rs) {
Cell* cell = rs->cell;
Cell* new_cell;
if (!cell) {
// make a root
cell = alloc_nil();
cell->next = alloc_nil();
*rs->stack = cell;
}
if (rs->state == PST_ATOM) {
if (c==' ' || c==13 || c==10) {
// skip whitespace
} else if (c==';') {
// comment
rs->state = PST_COMMENT;
} else if (c>='0' && c<='9') {
rs->state = PST_NUM;
rs->valuestate = VST_DEFAULT;
new_cell = alloc_int(0);
new_cell->value = c-'0';
cell->addr = new_cell;
} else if (c=='(') {
// start list
new_cell = alloc_nil();
cell->addr = new_cell;
*rs->stack = cell;
cell = new_cell;
rs->stack++;
rs->level++;
rs->state = PST_ATOM;
} else if (c==')') {
// end of list
cell = reader_end_list(cell, rs);
} else if (c=='[') {
// bytes (hex notation)
rs->state = PST_BYTES;
rs->sym_len = 0;
new_cell = alloc_bytes();
cell->addr = new_cell;
} else if (c=='"') {
// string
rs->state = PST_STR;
rs->sym_len = 0;
new_cell = alloc_string();
cell->addr = new_cell;
} else {
// symbol
rs->state = PST_SYM;
rs->sym_len = 1;
new_cell = alloc_sym(0);
new_cell->addr = cell_malloc(SYM_INIT_BUFFER_SIZE);
memset(new_cell->addr, 0, SYM_INIT_BUFFER_SIZE);
((char*)new_cell->addr)[0] = c;
new_cell->size = SYM_INIT_BUFFER_SIZE; // buffer space
cell->addr = new_cell;
}
} else if (rs->state == PST_COMMENT) {
//printf("c[%c]\n",c);
if (c=='\n' || c=='0') {
rs->state = PST_ATOM;
}
} else if (rs->state == PST_NUM || rs->state == PST_NUM_NEG) {
if (c>='0' && c<='9' || ((rs->valuestate == VST_HEX && c>='a' && c<='f'))) {
// build number
Cell* vcell = (Cell*)cell->addr;
int mul = 10;
if (rs->valuestate == VST_HEX) mul = 16;
int d = 0;
if (c>='a') {
d = 10+(c-'a');
} else {
d = c-'0';
}
if (rs->state == PST_NUM_NEG) {
vcell->value = vcell->value*mul - d;
} else {
vcell->value = vcell->value*mul + d;
}
} else if (c==' ' || c==13 || c==10) {
cell = reader_next_list_cell(cell, rs);
} else if (c==')') {
cell = reader_end_list(cell, rs);
} else if (c=='x') {
rs->valuestate = VST_HEX;
} else {
rs->state = PST_ERR_UNEXP_JUNK_IN_NUMBER;
}
} else if (rs->state == PST_SYM || rs->state == PST_STR) {
int append = 0;
if (rs->state == PST_STR) {
if (c=='"') {
// string is over
Cell* vcell = (Cell*)cell->addr;
vcell->size = (rs->sym_len);
cell = reader_next_list_cell(cell, rs);
} else {
append = 1;
}
}
else {
if (c==')') {
cell = reader_end_list(cell, rs);
} else if (c==' ' || c==13 || c==10) {
cell = reader_next_list_cell(cell, rs);
} else if (rs->state == PST_SYM && (c>='0' && c<='9')) {
Cell* vcell = (Cell*)cell->addr;
// detect negative number
if (((char*)vcell->addr)[0] == '-') {
// we're actually not a symbol, correct the cell.
rs->state = PST_NUM_NEG;
vcell->tag = TAG_INT;
vcell->value = -(c-'0');
}
} else {
append = 1;
}
}
if (append) {
// build symbol/string
Cell* vcell = (Cell*)cell->addr;
int idx = rs->sym_len;
rs->sym_len++;
if (rs->sym_len>=vcell->size-1) {
// grow buffer
vcell->addr = cell_realloc(vcell->addr, vcell->size, 2*vcell->size);
memset(vcell->addr+vcell->size, 0, vcell->size);
vcell->size = 2*vcell->size;
}
((char*)vcell->addr)[idx] = c;
}
} else if (rs->state == PST_BYTES) {
if (c==']') {
Cell* vcell = (Cell*)cell->addr;
vcell->size = (rs->sym_len)/2;
cell = reader_next_list_cell(cell, rs);
} else if ((c>='0' && c<='9') || (c>='a' && c<='f') || (c>='A' && c<='F')) {
int n = c;
if (n>='a') n-=('a'-'9'-1); // hex 'a' to 10 offset
if (n>='A') n-=('A'-'9'-1); // hex 'a' to 10 offset
n-='0'; // char to value
Cell* vcell = (Cell*)cell->addr;
int idx = rs->sym_len;
rs->sym_len++;
if (rs->sym_len>=(vcell->size/2)-1) {
// grow buffer
vcell->addr = cell_realloc(vcell->addr, vcell->size, 2*vcell->size); // TODO: check the math
memset(vcell->addr+vcell->size, 0, vcell->size);
vcell->size = 2*vcell->size;
}
if (idx%2==0) { // even digit
((byte*)vcell->addr)[idx/2] = n<<4; // high nybble
} else { // odd digit
((byte*)vcell->addr)[idx/2] |= n;
}
} else if (c==' ' || c==13 || c==10) {
// skip
} else {
rs->state = PST_ERR_UNEXP_JUNK_IN_BYTES;
}
}
rs->cell = cell;
return rs;
}
