From de71bc79e468ef5812b2b7ed950aeffa3af93f93 Mon Sep 17 00:00:00 2001 From: Zak Yani Star Fenton Date: Sun, 8 Jun 2025 20:10:15 +1000 Subject: [PATCH] Initial git commit of legacy userland including some extras but excluding others, based on latest version in my fossil repository with the LICENSE clarified. --- LICENSE | 25 + cat.c | 43 + drives.c | 81 + echo.c | 19 + forktest.c | 94 ++ grep.c | 107 ++ grind.c | 351 +++++ init.c | 57 + initcode.S | 29 + kill.c | 17 + ln.c | 15 + ls.c | 92 ++ mkdir.c | 23 + printf.c | 168 +++ rm.c | 23 + scm.c | 4115 +++++++++++++++++++++++++++++++++++++++++++++++++++ sh.c | 500 +++++++ stressfs.c | 49 + thrdtest.c | 112 ++ ulib.c | 162 ++ umalloc.c | 90 ++ user.h | 63 + user.ld | 39 + usertests.c | 3118 ++++++++++++++++++++++++++++++++++++++ usys.pl | 45 + wc.c | 55 + zombie.c | 14 + 27 files changed, 9506 insertions(+) create mode 100644 LICENSE create mode 100644 cat.c create mode 100644 drives.c create mode 100644 echo.c create mode 100644 forktest.c create mode 100644 grep.c create mode 100644 grind.c create mode 100644 init.c create mode 100644 initcode.S create mode 100644 kill.c create mode 100644 ln.c create mode 100644 ls.c create mode 100644 mkdir.c create mode 100644 printf.c create mode 100644 rm.c create mode 100644 scm.c create mode 100644 sh.c create mode 100644 stressfs.c create mode 100644 thrdtest.c create mode 100644 ulib.c create mode 100644 umalloc.c create mode 100644 user.h create mode 100644 user.ld create mode 100644 usertests.c create mode 100755 usys.pl create mode 100644 wc.c create mode 100644 zombie.c diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5593f74 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +Files marked NEW CODE can be attributed just to Zak's copyright with the same license, other files will either have their own information or are to be taken under the full license including the xv6 copyright statement: + +Copyright (c) 2024, 2025 Zak Yani Star Fenton +Copyright (c) 2006-2024 Frans Kaashoek, Robert Morris, Russ Cox, + Massachusetts Institute of Technology + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + diff --git a/cat.c b/cat.c new file mode 100644 index 0000000..6d873a9 --- /dev/null +++ b/cat.c @@ -0,0 +1,43 @@ +#include "kernel/types.h" +#include "kernel/fcntl.h" +#include "user/user.h" + +char buf[512]; + +void +cat(int fd) +{ + int n; + + while((n = read(fd, buf, sizeof(buf))) > 0) { + if (write(1, buf, n) != n) { + fprintf(2, "cat: write error\n"); + exit(1); + } + } + if(n < 0){ + fprintf(2, "cat: read error\n"); + exit(1); + } +} + +int +main(int argc, char *argv[]) +{ + int fd, i; + + if(argc <= 1){ + cat(0); + exit(0); + } + + for(i = 1; i < argc; i++){ + if((fd = open(argv[i], O_RDONLY)) < 0){ + fprintf(2, "cat: cannot open %s\n", argv[i]); + exit(1); + } + cat(fd); + close(fd); + } + exit(0); +} diff --git a/drives.c b/drives.c new file mode 100644 index 0000000..61bf625 --- /dev/null +++ b/drives.c @@ -0,0 +1,81 @@ +// This is NEW CODE to demonstrate the drvinf syscall by printing convenient +// information about drives to the console. +#include +#include "../kernel/syscdefs.h" + +#define DRIVE_SEARCH_MAX 1000 + +// Inline definition of the syscall +int drvinf(int drivenumber, struct __syscdefs_driveinfo* structure); + +#define SIZEOUTPUTLENGTH 40 +#define KB 1024ULL +#define MB (KB*1024) +#define GB (MB*1024) +#define TB (GB*1024) + +void formatsizevalue(char* output, long long value) { + int ntb = value/TB; + value -= ntb*TB; + int ngb = value/GB; + value -= ngb*GB; + int nmb = value/MB; + value -= nmb*MB; + int nkb = value/KB; + value -= nkb*KB; + int nb = (int) value; // The remainder is any leftover bytes + if (ntb > 0) { + if (nb > 0) { + snprintf(output, SIZEOUTPUTLENGTH, "%dTB %dGB %dMB %dKB %d bytes", ntb, ngb, nmb, nkb, nb); + } else { + snprintf(output, SIZEOUTPUTLENGTH, "%dTB %dGB %dMB %dKB", ntb, ngb, nmb, nkb); + } + } else if (ngb > 0) { + if (nb > 0) { + snprintf(output, SIZEOUTPUTLENGTH, "%dGB %dMB %dKB %d bytes", ngb, nmb, nkb, nb); + } else { + snprintf(output, SIZEOUTPUTLENGTH, "%dGB %dMB %dKB", ngb, nmb, nkb); + } + } else if (nmb > 0) { + if (nb > 0) { + snprintf(output, SIZEOUTPUTLENGTH, "%dMB %dKB %d bytes", nmb, nkb, nb); + } else { + snprintf(output, SIZEOUTPUTLENGTH, "%dMB %dKB", nmb, nkb); + } + } else if (nkb > 0) { + if (nb > 0) { + snprintf(output, SIZEOUTPUTLENGTH, "%dKB %d bytes", nkb, nb); + } else { + snprintf(output, SIZEOUTPUTLENGTH, "%dKB", nkb); + } + } else { + snprintf(output, SIZEOUTPUTLENGTH, "%d bytes", nb); + } +} + + char totalbuf[SIZEOUTPUTLENGTH]; + char freebuf[SIZEOUTPUTLENGTH]; + +void printinfo(struct __syscdefs_driveinfo* info) { + //printf("[#%d] %s: %d * %lld, %lld free [%s]\n", info->drivenumber, info->name, info->blocksize, info->totalblocks, info->freedatablocks, info->fsname); + + formatsizevalue(totalbuf, info->blocksize * info->totalblocks); + formatsizevalue(freebuf, info->blocksize * info->freedatablocks); + printf("[#%d] %s:\t%s total\t%s free\t[%s]\n", info->drivenumber, info->name, totalbuf, freebuf, info->fsname); +} + +int main(int argc, char** argv) { + struct __syscdefs_driveinfo info; + //int isfirst = 1; + for (int i = 0; i < DRIVE_SEARCH_MAX; i++) { + int result = drvinf(i, &info); + if (result >= 0) { + /*if (isfirst) { + isfirst = 0; + } else { + printf("\n"); + }*/ + printinfo(&info); + } + } +} diff --git a/echo.c b/echo.c new file mode 100644 index 0000000..3f19cd7 --- /dev/null +++ b/echo.c @@ -0,0 +1,19 @@ +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" + +int +main(int argc, char *argv[]) +{ + int i; + + for(i = 1; i < argc; i++){ + write(1, argv[i], strlen(argv[i])); + if(i + 1 < argc){ + write(1, " ", 1); + } else { + write(1, "\n", 1); + } + } + exit(0); +} diff --git a/forktest.c b/forktest.c new file mode 100644 index 0000000..762cda5 --- /dev/null +++ b/forktest.c @@ -0,0 +1,94 @@ +// Test that fork fails gracefully. +// Tiny executable so that the limit can be filling the proc table. + +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" + +// N should be set HIGHER than the limit! +#define N 10000 + +void +print(const char *s) +{ + write(1, s, strlen(s)); +} + +void printdec(unsigned int i) { + if (i == 0) { + print("0"); + return; + } + char foo[11]; + int idx = 10; + while (i > 0) { + idx--; + foo[idx] = '0' + (i%10); + i /= 10; + } + foo[10] = 0; + print(foo+idx); +} + +void +forktest(void) +{ + int n, pid; + + print("fork test\n"); + + //print("testing printdec(12345)="); printdec(12345); print("\n"); + print("attempting to fork up to N="); printdec(N); print(" processes...\n"); + + for(n=0; n 0; n--){ + if(wait(0) < 0){ + print("wait stopped early\n"); + exit(1); + } + } + + if(wait(0) != -1){ + print("wait got too many\n"); + exit(1); + } + + print("fork test OK\n"); +} + +int +main(void) +{ + forktest(); + exit(0); +} diff --git a/grep.c b/grep.c new file mode 100644 index 0000000..6c33766 --- /dev/null +++ b/grep.c @@ -0,0 +1,107 @@ +// Simple grep. Only supports ^ . * $ operators. + +#include "kernel/types.h" +#include "kernel/stat.h" +#include "kernel/fcntl.h" +#include "user/user.h" + +char buf[1024]; +int match(char*, char*); + +void +grep(char *pattern, int fd) +{ + int n, m; + char *p, *q; + + m = 0; + while((n = read(fd, buf+m, sizeof(buf)-m-1)) > 0){ + m += n; + buf[m] = '\0'; + p = buf; + while((q = strchr(p, '\n')) != 0){ + *q = 0; + if(match(pattern, p)){ + *q = '\n'; + write(1, p, q+1 - p); + } + p = q+1; + } + if(m > 0){ + m -= p - buf; + memmove(buf, p, m); + } + } +} + +int +main(int argc, char *argv[]) +{ + int fd, i; + char *pattern; + + if(argc <= 1){ + fprintf(2, "usage: grep pattern [file ...]\n"); + exit(1); + } + pattern = argv[1]; + + if(argc <= 2){ + grep(pattern, 0); + exit(0); + } + + for(i = 2; i < argc; i++){ + if((fd = open(argv[i], O_RDONLY)) < 0){ + printf("grep: cannot open %s\n", argv[i]); + exit(1); + } + grep(pattern, fd); + close(fd); + } + exit(0); +} + +// Regexp matcher from Kernighan & Pike, +// The Practice of Programming, Chapter 9, or +// https://www.cs.princeton.edu/courses/archive/spr09/cos333/beautiful.html + +int matchhere(char*, char*); +int matchstar(int, char*, char*); + +int +match(char *re, char *text) +{ + if(re[0] == '^') + return matchhere(re+1, text); + do{ // must look at empty string + if(matchhere(re, text)) + return 1; + }while(*text++ != '\0'); + return 0; +} + +// matchhere: search for re at beginning of text +int matchhere(char *re, char *text) +{ + if(re[0] == '\0') + return 1; + if(re[1] == '*') + return matchstar(re[0], re+2, text); + if(re[0] == '$' && re[1] == '\0') + return *text == '\0'; + if(*text!='\0' && (re[0]=='.' || re[0]==*text)) + return matchhere(re+1, text+1); + return 0; +} + +// matchstar: search for c*re at beginning of text +int matchstar(int c, char *re, char *text) +{ + do{ // a * matches zero or more instances + if(matchhere(re, text)) + return 1; + }while(*text!='\0' && (*text++==c || c=='.')); + return 0; +} + diff --git a/grind.c b/grind.c new file mode 100644 index 0000000..453f7bf --- /dev/null +++ b/grind.c @@ -0,0 +1,351 @@ +// +// run random system calls in parallel forever. +// + +#include "kernel/param.h" +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" +#include "kernel/fs.h" +#include "kernel/fcntl.h" +#include "kernel/syscall.h" +#include "kernel/memlayout.h" +#include "kernel/riscv.h" + +// from FreeBSD. +int +do_rand(unsigned long *ctx) +{ +/* + * Compute x = (7^5 * x) mod (2^31 - 1) + * without overflowing 31 bits: + * (2^31 - 1) = 127773 * (7^5) + 2836 + * From "Random number generators: good ones are hard to find", + * Park and Miller, Communications of the ACM, vol. 31, no. 10, + * October 1988, p. 1195. + */ + long hi, lo, x; + + /* Transform to [1, 0x7ffffffe] range. */ + x = (*ctx % 0x7ffffffe) + 1; + hi = x / 127773; + lo = x % 127773; + x = 16807 * lo - 2836 * hi; + if (x < 0) + x += 0x7fffffff; + /* Transform to [0, 0x7ffffffd] range. */ + x--; + *ctx = x; + return (x); +} + +unsigned long rand_next = 1; + +int +rand(void) +{ + return (do_rand(&rand_next)); +} + +void +go(int which_child) +{ + int fd = -1; + static char buf[999]; + char *break0 = sbrk(0); + uint64 iters = 0; + + mkdir("grindir"); + if(chdir("grindir") != 0){ + printf("grind: chdir grindir failed\n"); + exit(1); + } + chdir("/"); + + while(1){ + iters++; + if((iters % 500) == 0) + write(1, which_child?"B":"A", 1); + int what = rand() % 23; + if(what == 1){ + close(open("grindir/../a", O_CREATE|O_RDWR)); + } else if(what == 2){ + close(open("grindir/../grindir/../b", O_CREATE|O_RDWR)); + } else if(what == 3){ + unlink("grindir/../a"); + } else if(what == 4){ + if(chdir("grindir") != 0){ + printf("grind: chdir grindir failed\n"); + exit(1); + } + unlink("../b"); + chdir("/"); + } else if(what == 5){ + close(fd); + fd = open("/grindir/../a", O_CREATE|O_RDWR); + } else if(what == 6){ + close(fd); + fd = open("/./grindir/./../b", O_CREATE|O_RDWR); + } else if(what == 7){ + write(fd, buf, sizeof(buf)); + } else if(what == 8){ + read(fd, buf, sizeof(buf)); + } else if(what == 9){ + mkdir("grindir/../a"); + close(open("a/../a/./a", O_CREATE|O_RDWR)); + unlink("a/a"); + } else if(what == 10){ + mkdir("/../b"); + close(open("grindir/../b/b", O_CREATE|O_RDWR)); + unlink("b/b"); + } else if(what == 11){ + unlink("b"); + link("../grindir/./../a", "../b"); + } else if(what == 12){ + unlink("../grindir/../a"); + link(".././b", "/grindir/../a"); + } else if(what == 13){ + int pid = fork(); + if(pid == 0){ + exit(0); + } else if(pid < 0){ + printf("grind: fork failed\n"); + exit(1); + } + wait(0); + } else if(what == 14){ + int pid = fork(); + if(pid == 0){ + fork(); + fork(); + exit(0); + } else if(pid < 0){ + printf("grind: fork failed\n"); + exit(1); + } + wait(0); + } else if(what == 15){ + sbrk(6011); + } else if(what == 16){ + if(sbrk(0) > break0) + sbrk(-(sbrk(0) - break0)); + } else if(what == 17){ + int pid = fork(); + if(pid == 0){ + close(open("a", O_CREATE|O_RDWR)); + exit(0); + } else if(pid < 0){ + printf("grind: fork failed\n"); + exit(1); + } + if(chdir("../grindir/..") != 0){ + printf("grind: chdir failed\n"); + exit(1); + } + kill(pid); + wait(0); + } else if(what == 18){ + int pid = fork(); + if(pid == 0){ + kill(getpid()); + exit(0); + } else if(pid < 0){ + printf("grind: fork failed\n"); + exit(1); + } + wait(0); + } else if(what == 19){ + int fds[2]; + if(pipe(fds) < 0){ + printf("grind: pipe failed\n"); + exit(1); + } + int pid = fork(); + if(pid == 0){ + fork(); + fork(); + if(write(fds[1], "x", 1) != 1) + printf("grind: pipe write failed\n"); + char c; + if(read(fds[0], &c, 1) != 1) + printf("grind: pipe read failed\n"); + exit(0); + } else if(pid < 0){ + printf("grind: fork failed\n"); + exit(1); + } + close(fds[0]); + close(fds[1]); + wait(0); + } else if(what == 20){ + int pid = fork(); + if(pid == 0){ + unlink("a"); + mkdir("a"); + chdir("a"); + unlink("../a"); + fd = open("x", O_CREATE|O_RDWR); + unlink("x"); + exit(0); + } else if(pid < 0){ + printf("grind: fork failed\n"); + exit(1); + } + wait(0); + } else if(what == 21){ + unlink("c"); + // should always succeed. check that there are free i-nodes, + // file descriptors, blocks. + int fd1 = open("c", O_CREATE|O_RDWR); + if(fd1 < 0){ + printf("grind: create c failed\n"); + exit(1); + } + if(write(fd1, "x", 1) != 1){ + printf("grind: write c failed\n"); + exit(1); + } + struct stat st; + if(fstat(fd1, &st) != 0){ + printf("grind: fstat failed\n"); + exit(1); + } + if(st.size != 1){ + printf("grind: fstat reports wrong size %d\n", (int)(st.size)); + exit(1); + } + if(st.ino > 200){ + printf("grind: fstat reports crazy i-number %d\n", st.ino); + exit(1); + } + close(fd1); + unlink("c"); + } else if(what == 22){ + // echo hi | cat + int aa[2], bb[2]; + if(pipe(aa) < 0){ + fprintf(2, "grind: pipe failed\n"); + exit(1); + } + if(pipe(bb) < 0){ + fprintf(2, "grind: pipe failed\n"); + exit(1); + } + int pid1 = fork(); + if(pid1 == 0){ + close(bb[0]); + close(bb[1]); + close(aa[0]); + close(1); + if(dup(aa[1]) != 1){ + fprintf(2, "grind: dup failed\n"); + exit(1); + } + close(aa[1]); + char *args[3] = { "echo", "hi", 0 }; + exec("grindir/../echo", args); + fprintf(2, "grind: echo: not found\n"); + exit(2); + } else if(pid1 < 0){ + fprintf(2, "grind: fork failed\n"); + exit(3); + } + int pid2 = fork(); + if(pid2 == 0){ + close(aa[1]); + close(bb[0]); + close(0); + if(dup(aa[0]) != 0){ + fprintf(2, "grind: dup failed\n"); + exit(4); + } + close(aa[0]); + close(1); + if(dup(bb[1]) != 1){ + fprintf(2, "grind: dup failed\n"); + exit(5); + } + close(bb[1]); + char *args[2] = { "cat", 0 }; + exec("/cat", args); + fprintf(2, "grind: cat: not found\n"); + exit(6); + } else if(pid2 < 0){ + fprintf(2, "grind: fork failed\n"); + exit(7); + } + close(aa[0]); + close(aa[1]); + close(bb[1]); + char buf[4] = { 0, 0, 0, 0 }; + read(bb[0], buf+0, 1); + read(bb[0], buf+1, 1); + read(bb[0], buf+2, 1); + close(bb[0]); + int st1, st2; + wait(&st1); + wait(&st2); + if(st1 != 0 || st2 != 0 || strcmp(buf, "hi\n") != 0){ + printf("grind: exec pipeline failed %d %d \"%s\"\n", st1, st2, buf); + exit(1); + } + } + } +} + +void +iter() +{ + unlink("a"); + unlink("b"); + + int pid1 = fork(); + if(pid1 < 0){ + printf("grind: fork failed\n"); + exit(1); + } + if(pid1 == 0){ + rand_next ^= 31; + go(0); + exit(0); + } + + int pid2 = fork(); + if(pid2 < 0){ + printf("grind: fork failed\n"); + exit(1); + } + if(pid2 == 0){ + rand_next ^= 7177; + go(1); + exit(0); + } + + int st1 = -1; + wait(&st1); + if(st1 != 0){ + kill(pid1); + kill(pid2); + } + int st2 = -1; + wait(&st2); + + exit(0); +} + +int +main() +{ + while(1){ + int pid = fork(); + if(pid == 0){ + iter(); + exit(0); + } + if(pid > 0){ + wait(0); + } + sleep(20); + rand_next += 1; + } +} diff --git a/init.c b/init.c new file mode 100644 index 0000000..5d239f6 --- /dev/null +++ b/init.c @@ -0,0 +1,57 @@ +// init: The initial user-level program + +#include "kernel/types.h" +#include "kernel/stat.h" +#include "kernel/sched.h" +#include "kernel/fs.h" +#include "kernel/file.h" +#include "user/user.h" +#include "kernel/fcntl.h" + +char *argv[2];// = { "sh", 0 }; + +int +main(void) +{ + int pid, wpid; + + argv[0] = "sh"; + argv[1] = (void*) 0UL; + + if(open("console", O_RDWR) < 0){ + mknod("console", CONSOLE, 0); + open("console", O_RDWR); + } + dup(0); // stdout + dup(0); // stderr + + for(;;){ + printf("init: starting sh\n"); + pid = fork(); + if(pid < 0){ + printf("init: fork failed\n"); + exit(1); + } + if(pid == 0){ + prio(getpid(), 4, 0); + exec("sh", argv); + printf("init: exec sh failed\n"); + exit(1); + } + + for(;;){ + // this call to wait() returns if the shell exits, + // or if a parentless process exits. + wpid = wait((int *) 0); + if(wpid == pid){ + // the shell exited; restart it. + break; + } else if(wpid < 0){ + printf("init: wait returned an error\n"); + exit(1); + } else { + // it was a parentless process; do nothing. + } + } + } +} diff --git a/initcode.S b/initcode.S new file mode 100644 index 0000000..31b4ae2 --- /dev/null +++ b/initcode.S @@ -0,0 +1,29 @@ +// Initial process that execs /init. +// This code runs in user space. + +#include + +// exec(init, argv) +.globl start +start: + la a0, init + la a1, argv + addi a2, a1, 8 + li a7, SYS_execve + ecall + +// for(;;) exit(); +exit: + li a7, SYS_exit + ecall + jal exit + +// char init[] = "/init\0"; +init: + .string "/init\0" + +// char *argv[] = { init, 0 }; +.p2align 3 +argv: + .quad init + .quad 0 diff --git a/kill.c b/kill.c new file mode 100644 index 0000000..1b0253b --- /dev/null +++ b/kill.c @@ -0,0 +1,17 @@ +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" + +int +main(int argc, char **argv) +{ + int i; + + if(argc < 2){ + fprintf(2, "usage: kill pid...\n"); + exit(1); + } + for(i=1; i= path && *p != '/'; p--) + ; + p++; + + // Return blank-padded name. + if(strlen(p) >= 32) + return p; + memmove(buf, p, strlen(p)); + memset(buf+strlen(p), ' ', 32-strlen(p)); + return buf; +} + +// Syscall to get dirents in standardised format +int lsdir(int fd, void* buff, int sz); + +void +ls(char *path) +{ + char buf[512], *p; + int fd; + fsformat_dirent_v1_t de; + struct stat st; + + if((fd = open(path, O_RDONLY)) < 0){ + fprintf(2, "ls: cannot open %s\n", path); + return; + } + + if(fstat(fd, &st) < 0){ + fprintf(2, "ls: cannot stat %s\n", path); + close(fd); + return; + } + + switch(st.type){ + case T_DEVICE: + case T_FILE: + printf("%s %d %d %d\n", fmtname(path), st.type, st.ino, (int) (st.size)); + break; + + case T_DIR: + if(strlen(path) + 1 + FSFORMAT_NAMESIZE_NEW + 1 > 512 /*sizeof buf*/){ + printf("ls: path too long\n"); + break; + } + strcpy(buf, path); + p = buf+strlen(buf); + *p++ = '/'; + while(lsdir(fd, &de, sizeof(fsformat_dirent_v1_t /*de*/)) == sizeof(fsformat_dirent_v1_t /*de*/)){ + if(de.datainode == 0) + continue; + memmove(p, de.filename, FSFORMAT_NAMESIZE_NEW); + p[FSFORMAT_NAMESIZE_NEW] = 0; + if(stat(buf, &st) < 0){ + printf("ls: cannot stat %s\n", buf); + continue; + } + printf("%s %d %d %d\n", fmtname(buf), st.type, st.ino, (int) (st.size)); + } + break; + } + close(fd); +} + +int +main(int argc, char *argv[]) +{ + int i; + + if(argc < 2){ + ls("."); + exit(0); + } + for(i=1; i +#endif + +static char digits[] = "0123456789ABCDEF"; + +static void +putc(int fd, char c) +{ + write(fd, &c, 1); +} + +static void +printint(int fd, int xx, int base, int sgn) +{ + char buf[16]; + int i, neg; + uint x; + + neg = 0; + if(sgn && xx < 0){ + neg = 1; + x = -xx; + } else { + x = xx; + } + + i = 0; + do{ + buf[i++] = digits[x % base]; + }while((x /= base) != 0); + if(neg) + buf[i++] = '-'; + + while(--i >= 0) + putc(fd, buf[i]); +} + +static void +printptr(int fd, uint64 x) { + int i; + putc(fd, '0'); + putc(fd, 'x'); + for (i = 0; i < (sizeof(uint64) * 2); i++, x <<= 4) + putc(fd, digits[x >> (sizeof(uint64) * 8 - 4)]); +} + +// Print to the given fd. Only understands %d, %x, %p, %s. +void +vprintf(int fd, const char *fmt, va_list ap) +{ + char *s; + int c0, c1, c2, i, state; + + state = 0; + for(i = 0; fmt[i]; i++){ + c0 = fmt[i] & 0xff; + if(state == 0){ + if(c0 == '%'){ + state = '%'; + } else { + putc(fd, c0); + } + } else if(state == '%'){ + c1 = c2 = 0; + if(c0) c1 = fmt[i+1] & 0xff; + if(c1) c2 = fmt[i+2] & 0xff; + if(c0 == 'd'){ + printint(fd, va_arg(ap, int), 10, 1); + } else if(c0 == 'l' && c1 == 'd'){ + printint(fd, va_arg(ap, uint64), 10, 1); + i += 1; + } else if(c0 == 'l' && c1 == 'l' && c2 == 'd'){ + printint(fd, va_arg(ap, uint64), 10, 1); + i += 2; + } else if(c0 == 'u'){ + printint(fd, va_arg(ap, int), 10, 0); + } else if(c0 == 'l' && c1 == 'u'){ + printint(fd, va_arg(ap, uint64), 10, 0); + i += 1; + } else if(c0 == 'l' && c1 == 'l' && c2 == 'u'){ + printint(fd, va_arg(ap, uint64), 10, 0); + i += 2; + } else if(c0 == 'x'){ + printint(fd, va_arg(ap, int), 16, 0); + } else if(c0 == 'l' && c1 == 'x'){ + printint(fd, va_arg(ap, uint64), 16, 0); + i += 1; + } else if(c0 == 'l' && c1 == 'l' && c2 == 'x'){ + printint(fd, va_arg(ap, uint64), 16, 0); + i += 2; + } else if(c0 == 'p'){ + printptr(fd, va_arg(ap, uint64)); + } else if(c0 == 's'){ + if((s = va_arg(ap, char*)) == 0) + s = "(null)"; + write(fd, s, strlen(s)); + //for(; *s; s++) + // putc(fd, *s); + } else if(c0 == '%'){ + putc(fd, '%'); + } else { + // Unknown % sequence. Print it to draw attention. + putc(fd, '%'); + putc(fd, c0); + } + +#if 0 + if(c == 'd'){ + printint(fd, va_arg(ap, int), 10, 1); + } else if(c == 'l') { + printint(fd, va_arg(ap, uint64), 10, 0); + } else if(c == 'x') { + printint(fd, va_arg(ap, int), 16, 0); + } else if(c == 'p') { + printptr(fd, va_arg(ap, uint64)); + } else if(c == 's'){ + s = va_arg(ap, char*); + if(s == 0) + s = "(null)"; + while(*s != 0){ + putc(fd, *s); + s++; + } + } else if(c == 'c'){ + putc(fd, va_arg(ap, uint)); + } else if(c == '%'){ + putc(fd, c); + } else { + // Unknown % sequence. Print it to draw attention. + putc(fd, '%'); + putc(fd, c); + } +#endif + state = 0; + } + } +} + +void +#ifdef _ZCC +__classic_call +#endif +fprintf(int fd, const char *fmt, ...) +{ + va_list ap; + + va_start(ap, fmt); + vprintf(fd, fmt, ap); +} + +void +#ifdef _ZCC +__classic_call +#endif +printf(const char *fmt, ...) +{ + va_list ap; + + va_start(ap, fmt); + vprintf(1, fmt, ap); +} diff --git a/rm.c b/rm.c new file mode 100644 index 0000000..26b8f1f --- /dev/null +++ b/rm.c @@ -0,0 +1,23 @@ +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" + +int +main(int argc, char *argv[]) +{ + int i; + + if(argc < 2){ + fprintf(2, "Usage: rm files...\n"); + exit(1); + } + + for(i = 1; i < argc; i++){ + if(unlink(argv[i]) < 0){ + fprintf(2, "rm: %s failed to delete\n", argv[i]); + break; + } + } + + exit(0); +} diff --git a/scm.c b/scm.c new file mode 100644 index 0000000..3107989 --- /dev/null +++ b/scm.c @@ -0,0 +1,4115 @@ +/* KScheme, a BRUTAL EDIT of MiniScheme, by Zak Fenton MMXX + * CHANGES from Mini-Scheme 0.85 to KScheme 0.1: + * - Fixed up some old-style C code that modern/C++ compilers complain about (mostly changes to function definitions, now compiles in Visual Studio 2019) + * - Removed copyrighted parts of init.scm (assuming the sections with copyright notices aren't covered by the public domain dedication in this file) + * - Made partly embeddable (all globals now stored in a struct passed between each function, each function now has kscm_ prefix with an extra underscore + * for most of them to indicate that it's part of a private API for now) + * - Changed name (Mini-Scheme -> KScheme, as in "kernel scheme") + * - Maybe more features coming... + * + * ---------- Mini-Scheme Interpreter Version 0.85 ---------- + * + * coded by Atsushi Moriwaki (11/5/1989) + * + * E-MAIL : moriwaki@kurims.kurims.kyoto-u.ac.jp + * + * THIS SOFTWARE IS IN THE PUBLIC DOMAIN + * ------------------------------------ + * This software is completely free to copy, modify and/or re-distribute. + * But I would appreciate it if you left my name on the code as the author. + * + */ + /*-- + * + * This version has been modified by Chris Pressey. + * current version is 0.85p1 (as yet unreleased) + * + * This version has been modified by R.C. Secrist. + * + * Mini-Scheme is now maintained by Akira KIDA. + * + * This is a revised and modified version by Akira KIDA. + * current version is 0.85k4 (15 May 1994) + * + * Please send suggestions, bug reports and/or requests to: + * + *-- + */ +#define KSCM_PLATFORM_BSD +//#define KSCM_PLUSPLUS +// If KSCM_CONFIG_USE_PRECISE is defined, overflow detection will occur in basic math functions +#define KSCM_CONFIG_USE_PRECISE +// This just allows unsafe legacy C functions in Visual Studio. It should be disabled and fixed properly but not the highest priority. +#define _CRT_SECURE_NO_WARNINGS + +#ifdef KSCM_PLUSPLUS +extern "C" { +#endif + /* + * Here is System declaration. + * Please define exactly one symbol in the following section. + */ + /* #define LSC */ /* LightSpeed C for Macintosh */ + /* #define LSC4 */ /* THINK C version 4.0 for Macintosh */ + /* #define MPW2 */ /* Macintosh Programmer's Workshop v2.0x */ + /* #define KSCM_PLATFORM_BSD */ /* 4.x KSCM_PLATFORM_BSD */ + /* #define MSC */ /* Microsoft C Compiler v.4.00 - 7.00 */ + /* #define KSCM_PLATFORM_TURBOC */ /* Turbo C compiler v.2.0, or TC++ 1.0 */ + /* #define SYSV */ /* System-V, or POSIX */ + /* #define KSCM_PLATFORM_VAXC */ /* VAX/VMS KSCM_PLATFORM_VAXC 2.x or later */ /* (automatic) */ + +#ifdef __BORLANDC__ /* Borland C++ - MS-DOS */ +#define KSCM_PLATFORM_TURBOC +#endif + +#ifdef __TURBOC__ /* Turbo C V1.5 - MS-DOS */ +#define KSCM_PLATFORM_TURBOC +#endif + +#ifdef mips /* DECstation running OSF/1 */ +#define KSCM_PLATFORM_BSD +#endif + +#ifdef __osf__ /* Alpha AXP running OSF/1 */ +#define KSCM_PLATFORM_BSD +#endif + +#ifdef __DECC /* Alpha AXP running VMS */ +#define KSCM_PLATFORM_VAXC +#endif + +#ifdef _AIX /* RS/6000 running AIX */ +#define KSCM_PLATFORM_BSD +#endif + +/* + * Define or undefine following symbols as you need. + */ +// #define VERBOSE /* define this if you want verbose GC */ +#define KSCM_CONFIG_AVOID_HACK_LOOP /* define this if your compiler is poor + * enougth to complain "do { } while (0)" + * construction. + */ +//#define KSCM_CONFIG_USE_SETJMP /* undef this if you do not want to use setjmp() */ +#define KSCM_CONFIG_USE_QQUOTE /* undef this if you do not need quasiquote */ +#define KSCM_CONFIG_USE_MACRO /* undef this if you do not need macro */ +#define KSCM_CONFIG_USE_PERSIST /* undef this if you do not need persistence */ +#define KSCM_CONFIG_USE_PRECISE /* undef this if you do not need overflow detection and precise integer size */ +#define KSCM_CONFIG_USE_STRUCTS /* undef this if you do not need additional structure types (buffers & abstractions) */ +#define KSCM_CONFIG_USE_FLOATS /* undef this if you do not need floating-point functionality (i.e. undefine this if you're running in kernel mode) */ +#define KSCM_CONFIG_USE_OBJECTS /* undef this if you do not need object-oriented/vector features (these are handy but may complicate simple implementations) */ +#define KSCM_CONFIG_USE_UTF8 /* undef this if you do not need Unicode support */ +//#define KSCM_CONFIG_USE_CONSOLE /* undef this if you do not need extended console functions. */ + +#ifdef KSCM_CONFIG_USE_CONSOLE +#include +#include +#include +#include +#include +#include +#endif + +#define KSCM_CONFIG_MAXLOADS 20 /* the maximum depth of the load stack */ + +#ifdef KSCM_CONFIG_USE_PRECISE +#include +#endif + +#ifdef KSCM_CONFIG_USE_QQUOTE + /*-- + * If your machine can't support "forward single quotation character" + * i.e., '`', you may have trouble to use backquote. + * So use '^' in place of '`'. + */ +# define BACKQUOTE '`' +#endif + + /* + * Basic memory allocation units + */ + +#ifdef KSCM_PLATFORM_TURBOC /* rcs */ +#define KSCM_CONFIG_CELL_SEGSIZE 2048 +#define KSCM_CONFIG_CELL_NSEGMENT 100 +#define KSCM_CONFIG_STR_SEGSIZE 2048 +#define KSCM_CONFIG_STR_NSEGMENT 100 +#else +#define KSCM_CONFIG_CELL_SEGSIZE 10000 /* # of cells in one segment */ +#define KSCM_CONFIG_CELL_NSEGMENT 100 /* # of segments for cells */ +#define KSCM_CONFIG_STR_SEGSIZE 10000 /* bytes of one string segment */ +#define KSCM_CONFIG_STR_NSEGMENT 10000 /* # of segments for strings */ +#endif + +#define KSCM_CONFIG_BANNER "Hello, This is KScheme (kscm) 0.3, based on Mini-Scheme Interpreter Version 0.85p1.\n" + +#define KSCM_CONFIG_PERSIST_MAGIC "KSCM" +#define KSCM_CONFIG_PERSIST_VERSION 2 + +#include +#include +#include +#ifdef KSCM_CONFIG_USE_SETJMP +#include +#endif + + + /* System dependency */ +#ifdef LSC +#include +#include +#define malloc(x) NewPtr((long)(x)) +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 5 +#endif + +#ifdef LSC4 +#include +#include +#define malloc(x) NewPtr((long)(x)) +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 5 +#endif + +#ifdef MPW2 +#include +#include +#define malloc(x) NewPtr((long)(x)) +#define KSCM_CONFIG_PROMPT "> [enter at next line]\n" +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 5 +#endif + +#ifdef KSCM_PLATFORM_BSD +#include +#include +#include +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 10 +#endif + +// Old definition, no detection +#ifdef MSC +#include +#include +#include +#include +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 3 +#endif + +#ifdef KSCM_PLATFORM_TURBOC +#include +#include +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 3 +#endif + +// Old definition, no detection +#ifdef SYSV +#include +#include +#if __STDC__ +# include +#endif +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 10 +#endif + +#ifdef KSCM_PLATFORM_VAXC +#include +#include +#define KSCM_CONFIG_PROMPT "> " +#define KSCM_CONFIG_INITFILE "init.scm" +#define KSCM_CONFIG_FIRST_CELLSEGS 10 +#endif + +#ifdef __GNUC__ +/* + * If we use gcc, KSCM_CONFIG_AVOID_HACK_LOOP is unnecessary + */ +#undef KSCM_CONFIG_AVOID_HACK_LOOP +#endif + +#ifndef KSCM_CONFIG_FIRST_CELLSEGS +#error Please define your system type. + /* + * We refrain this to raise an error anyway even if on pre-ANSI system. + */ +error Please define your system type. +#endif + + +/* ========== Evaluation Cycle ========== */ + +/* operator code */ +#define KSCM_OP_LOAD 0 +#define KSCM_OP_T0LVL 1 +#define KSCM_OP_T1LVL 2 +#define KSCM_OP_READ 3 +#define KSCM_OP_VALUEPRINT 4 +#define KSCM_OP_EVAL 5 +#define KSCM_OP_E0ARGS 6 +#define KSCM_OP_E1ARGS 7 +#define KSCM_OP_APPLY 8 +#define KSCM_OP_DOMACRO 9 + +#define KSCM_OP_LAMBDA 10 +#define KSCM_OP_QUOTE 11 +#define KSCM_OP_DEF0 12 +#define KSCM_OP_DEF1 13 +#define KSCM_OP_BEGIN 14 +#define KSCM_OP_IF0 15 +#define KSCM_OP_IF1 16 +#define KSCM_OP_SET0 17 +#define KSCM_OP_SET1 18 +#define KSCM_OP_LET0 19 +#define KSCM_OP_LET1 20 +#define KSCM_OP_LET2 21 +#define KSCM_OP_LET0AST 22 +#define KSCM_OP_LET1AST 23 +#define KSCM_OP_LET2AST 24 +#define KSCM_OP_LET0REC 25 +#define KSCM_OP_LET1REC 26 +#define KSCM_OP_LET2REC 27 +#define KSCM_OP_COND0 28 +#define KSCM_OP_COND1 29 +#define KSCM_OP_DELAY 30 +#define KSCM_OP_AND0 31 +#define KSCM_OP_AND1 32 +#define KSCM_OP_OR0 33 +#define KSCM_OP_OR1 34 +#define KSCM_OP_C0STREAM 35 +#define KSCM_OP_C1STREAM 36 +#define KSCM_OP_0MACRO 37 +#define KSCM_OP_1MACRO 38 +#define KSCM_OP_CASE0 39 +#define KSCM_OP_CASE1 40 +#define KSCM_OP_CASE2 41 + +#define KSCM_OP_PEVAL 42 +#define KSCM_OP_PAPPLY 43 +#define KSCM_OP_CONTINUATION 44 +#define KSCM_OP_ADD 45 +#define KSCM_OP_SUB 46 +#define KSCM_OP_MUL 47 +#define KSCM_OP_DIV 48 +#define KSCM_OP_REM 49 +#define KSCM_OP_CAR 50 +#define KSCM_OP_CDR 51 +#define KSCM_OP_CONS 52 +#define KSCM_OP_SETCAR 53 +#define KSCM_OP_SETCDR 54 +#define KSCM_OP_NOT 55 +#define KSCM_OP_BOOL 56 +#define KSCM_OP_NULL 57 +#define KSCM_OP_ZEROP 58 +#define KSCM_OP_POSP 59 +#define KSCM_OP_NEGP 60 +#define KSCM_OP_NEQ 61 +#define KSCM_OP_LESS 62 +#define KSCM_OP_GRE 63 +#define KSCM_OP_LEQ 64 +#define KSCM_OP_GEQ 65 +#define KSCM_OP_SYMBOL 66 +#define KSCM_OP_NUMBER 67 +#define KSCM_OP_STRING 68 +#define KSCM_OP_PROC 69 +#define KSCM_OP_PAIR 70 +#define KSCM_OP_EQ 71 +#define KSCM_OP_EQV 72 +#define KSCM_OP_FORCE 73 +#define KSCM_OP_WRITE 74 +#define KSCM_OP_DISPLAY 75 +#define KSCM_OP_NEWLINE 76 +#define KSCM_OP_ERR0 77 +#define KSCM_OP_ERR1 78 +#define KSCM_OP_REVERSE 79 +#define KSCM_OP_APPEND 80 +#define KSCM_OP_PUT 81 +#define KSCM_OP_GET 82 +#define KSCM_OP_QUIT 83 +#define KSCM_OP_GC 84 +#define KSCM_OP_GCVERB 85 +#define KSCM_OP_NEWSEGMENT 86 + +#define KSCM_OP_RDSEXPR 87 +#define KSCM_OP_RDLIST 88 +#define KSCM_OP_RDDOT 89 +#define KSCM_OP_RDQUOTE 90 +#define KSCM_OP_RDQQUOTE 91 +#define KSCM_OP_RDUNQUOTE 92 +#define KSCM_OP_RDUQTSP 93 + +#define KSCM_OP_P0LIST 94 +#define KSCM_OP_P1LIST 95 + +#define KSCM_OP_LIST_LENGTH 96 +#define KSCM_OP_ASSQ 97 +#define KSCM_OP_PRINT_WIDTH 98 +#define KSCM_OP_P0_WIDTH 99 +#define KSCM_OP_P1_WIDTH 100 +#define KSCM_OP_GET_CLOSURE 101 +#define KSCM_OP_CLOSUREP 102 +#define KSCM_OP_MACROP 103 + +#define KSCM_OP_STRCAT 104 +#define KSCM_OP_STRLEN 105 +#define KSCM_OP_STRGET 106 +#define KSCM_OP_SAVE_STATE 107 +#define KSCM_OP_RESUME_STATE 108 +#define KSCM_OP_BUFFER 109 +#define KSCM_OP_BUFFER_NEW 110 +#define KSCM_OP_BUFFER_LEN 111 +#define KSCM_OP_BUFFER_GET 112 +#define KSCM_OP_BUFFER_SET 113 +#define KSCM_OP_ABSTRACTION 114 +#define KSCM_OP_ABSTRACTION_NEW 115 +#define KSCM_OP_ABSTRACTION_TYPE 116 +#define KSCM_OP_ABSTRACTION_VALUE 117 +#define KSCM_OP_OBJECT 118 +#define KSCM_OP_OBJECT_NEW 119 +#define KSCM_OP_OBJECT_LEN 120 +#define KSCM_OP_OBJECT_GET 121 +#define KSCM_OP_OBJECT_SET 122 +#define KSCM_OP_OBJECT_RETYPE 123 +#define KSCM_OP_SYMBOL_TO_STRING 124 +#define KSCM_OP_BUFFER_LOAD 125 +#define KSCM_OP_BUFFER_SAVE 126 +#define KSCM_OP_CONSOLE_MODE 127 +#define KSCM_OP_CONSOLE_NEXT 128 +#define KSCM_OP_CONSOLE_POLL 129 +#define KSCM_OP_CONSOLE_WIDTH 130 +#define KSCM_OP_CONSOLE_HEIGHT 131 + +#define KSCM_TOK_LPAREN 0 +#define KSCM_TOK_RPAREN 1 +#define KSCM_TOK_DOT 2 +#define KSCM_TOK_ATOM 3 +#define KSCM_TOK_QUOTE 4 +#define KSCM_TOK_COMMENT 5 +#define KSCM_TOK_DQUOTE 6 +#ifdef KSCM_CONFIG_USE_QQUOTE +# define KSCM_TOK_BQUOTE 7 +# define KSCM_TOK_COMMA 8 +# define KSCM_TOK_ATMARK 9 +#endif +#define KSCM_TOK_SHARP 10 + +typedef struct kscm kscm_t; + +/* cell structure */ +struct kscm_cell { + unsigned long _flag; // TODO: This should probably always be 32-bit + union { + struct { + char* _svalue; + short _keynum; + } _string; + struct { + long _ivalue; // TODO: This should probably always be 32-bit, i.e. representing a flexible "small int" value + } _number; + struct { + struct kscm_cell* _car; + struct kscm_cell* _cdr; + } _cons; +#ifdef KSCM_CONFIG_USE_STRUCTS + struct { + unsigned long _length; + unsigned char* _data; + } _buffer; +#endif +#ifdef KSCM_CONFIG_USE_FLOATS + struct { + double _dvalue; + } _float64; +#endif +#ifdef KSCM_CONFIG_USE_OBJECTS + struct { + struct kscm_cell* _type; + long _count; + long _gccount; + struct kscm_cell** _elements; + } _objx; +#endif + } _object; +}; + +typedef struct kscm_cell* kscm_object_t; + +typedef struct kscm_gcstate kscm_gcstate_t; +struct kscm_gcstate { + kscm_object_t object; + size_t offset; +}; + +#define KSCM_PERSIST_TINT32 1 +#define KSCM_PERSIST_TSTRING 2 +#define KSCM_PERSIST_TSYMBOL 3 +#define KSCM_PERSIST_TPAIR 4 +#define KSCM_PERSIST_TPROC 5 +#define KSCM_PERSIST_TCLOSURE 6 +#define KSCM_PERSIST_TSYNTAX 7 +#define KSCM_PERSIST_TCONTINUATION 8 +#define KSCM_PERSIST_TBUFFER 9 +#define KSCM_PERSIST_TABSTRACTION 10 +#define KSCM_PERSIST_TOBJX 11 +#define KSCM_PERSIST_TFLOAT32_RESERVED 12 +#define KSCM_PERSIST_TFLOAT64 13 +#define KSCM_PERSIST_TUINT64_RESERVED 14 +#define KSCM_PERSIST_TINT64_RESERVED 15 + +#define KSCM_T_STRING 1 /* 0000000000000001 */ +#define KSCM_T_NUMBER 2 /* 0000000000000010 */ +#define KSCM_T_SYMBOL 4 /* 0000000000000100 */ +#define KSCM_T_SYNTAX 8 /* 0000000000001000 */ +#define KSCM_T_PROC 16 /* 0000000000010000 */ +#define KSCM_T_PAIR 32 /* 0000000000100000 */ +#define KSCM_T_CLOSURE 64 /* 0000000001000000 */ +#define KSCM_T_CONTINUATION 128 /* 0000000010000000 */ +#ifdef KSCM_CONFIG_USE_MACRO +# define KSCM_T_MACRO 256/* 0000000100000000 */ +#endif +#define KSCM_T_PROMISE 512 /* 0000001000000000 */ +#define KSCM_T_BUFFER 1024/* 0000010000000000 */ +#define KSCM_T_ABSTRACTION 2048/* 0000100000000000 */ +#define KSCM_T_OBJX 4096/* 0001000000000000 */ +#define KSCM_T_FLOAT64 8192/* 0010000000000000 */ +#define KSCM_T_ATOM 16384 /* 0100000000000000 */ /* only for gc */ +#define KSCM_CLRATOM 49151 /* 1011111111111111 */ /* only for gc */ +#define KSCM_MARK 32768 /* 1000000000000000 */ +#define KSCM_UNMARK 32767 /* 0111111111111111 */ + +/* macros for cell operations */ +#define kscm__type(kscm,p) ((p)->_flag) + +#define kscm__isstring(kscm,p) (kscm__type(kscm, p)&KSCM_T_STRING) +#define kscm__strvalue(kscm,p) ((p)->_object._string._svalue) +#define kscm__keynum(kscm,p) ((p)->_object._string._keynum) + +#define kscm__isnumber(kscm,p) (kscm__type(kscm, p)&KSCM_T_NUMBER) +#define kscm__ivalue(kscm,p) ((p)->_object._number._ivalue) + +#ifdef KSCM_CONFIG_USE_FLOATS +#define kscm__isfloat64(kscm,p) (kscm__type(kscm, p)&KSCM_T_FLOAT64) +#define kscm__dvalue(kscm,p) ((p)->_object._float64._dvalue) +#endif + +#define kscm__ispair(kscm,p) (kscm__type(kscm,p)&KSCM_T_PAIR) +#define kscm__car(kscm,p) (p)->_object._cons._car +#define kscm__cdr(kscm,p) (p)->_object._cons._cdr + +#define kscm__issymbol(kscm,p) (kscm__type(kscm, p)&KSCM_T_SYMBOL) +#define kscm__symname(kscm,p) kscm__strvalue(kscm, kscm__car(kscm, p)) +#define kscm__hasprop(kscm,p) (kscm__type(kscm, p)&KSCM_T_SYMBOL) +#define kscm__symprop(kscm,p) kscm__cdr(kscm, p) + +#define kscm__issyntax(kscm,p) (kscm__type(kscm, p)&KSCM_T_SYNTAX) +#define kscm__isproc(kscm,p) (kscm__type(kscm, p)&KSCM_T_PROC) +#define kscm__syntaxname(kscm,p) kscm__strvalue(kscm, kscm__car(kscm, p)) +#define kscm__syntaxnum(kscm,p) kscm__keynum(kscm, kscm__car(kscm, p)) +#define kscm__procnum(kscm,p) kscm__ivalue(kscm, p) + +#define kscm__isclosure(kscm,p) (kscm__type(kscm, p)&KSCM_T_CLOSURE) +#ifdef KSCM_CONFIG_USE_MACRO +# define kscm__ismacro(kscm,p) (kscm__type(kscm, p)&KSCM_T_MACRO) +#endif +#define kscm__closure_code(kscm,p) kscm__car(kscm, p) +#define kscm__closure_env(kscm,p) kscm__cdr(kscm, p) + +#define kscm__iscontinuation(kscm,p) (kscm__type(kscm, p)&KSCM_T_CONTINUATION) +#define kscm__cont_dump(kscm,p) kscm__cdr(kscm, p) + +#define kscm__ispromise(kscm,p) (kscm__type(kscm,p)&KSCM_T_PROMISE) +#define kscm__setpromise(kscm,p) kscm__type(kscm,p) |= KSCM_T_PROMISE + +#ifdef KSCM_CONFIG_USE_STRUCTS +#define kscm__isbuffer(kscm,p) (kscm__type(kscm,p)&KSCM_T_BUFFER) +#define kscm__isabstraction(kscm,p) (kscm__type(kscm,p)&KSCM_T_ABSTRACTION) +#endif + +#ifdef KSCM_CONFIG_USE_OBJECTS +#define kscm__isobjx(kscm,p) (kscm__type(kscm,p)&KSCM_T_OBJX) +#endif + +#define kscm__isatom(kscm,p) (kscm__type(kscm,p)&KSCM_T_ATOM) +#define kscm__setatom(kscm,p) kscm__type(kscm,p) |= KSCM_T_ATOM +#define kscm__clratom(kscm,p) kscm__type(kscm,p) &= KSCM_CLRATOM + +#define kscm__ismark(kscm,p) (kscm__type(kscm, p)&KSCM_MARK) +#define kscm__setmark(kscm,p) kscm__type(kscm, p) |= KSCM_MARK +#define kscm__clrmark(kscm,p) kscm__type(kscm, p) &= KSCM_UNMARK + +#define kscm__caar(kscm, p) kscm__car(kscm, kscm__car(kscm, p)) +#define kscm__cadr(kscm, p) kscm__car(kscm, kscm__cdr(kscm, p)) +#define kscm__cdar(kscm, p) kscm__cdr(kscm, kscm__car(kscm, p)) +#define kscm__cddr(kscm, p) kscm__cdr(kscm, kscm__cdr(kscm, p)) +#define kscm__cadar(kscm, p) kscm__car(kscm, kscm__cdr(kscm, kscm__car(kscm, p))) +#define kscm__caddr(kscm, p) kscm__car(kscm, kscm__cdr(kscm, kscm__cdr(kscm, p))) +#define kscm__cadaar(kscm, p) kscm__car(kscm, kscm__cdr(kscm, kscm__car(kscm, kscm__car(kscm, p)))) +#define kscm__cadddr(kscm, p) kscm__car(kscm, kscm__cdr(kscm, kscm__cdr(kscm, kscm__cdr(kscm, p)))) +#define kscm__cddddr(kscm, p) kscm__cdr(kscm, kscm__cdr(kscm, kscm__cdr(kscm, kscm__cdr(kscm, p)))) + +#define LINESIZE 1024 + +struct kscm { + /* arrays for segments */ + kscm_object_t* cell_seg; + int last_cell_seg;// = -1; + int gcstate_max; + kscm_gcstate_t* gcstate; + //char* str_seg[KSCM_CONFIG_STR_NSEGMENT]; + //int str_seglast;// = -1; + + /* We use 4 registers (actually, some more registers are used internally). */ + kscm_object_t args; /* register for arguments of function */ + kscm_object_t envir; /* stack register for current environment */ + kscm_object_t code; /* register for current code */ + kscm_object_t dump; /* stack register for next evaluation */ + + /* The VM is currently single-threaded, but to facilitate compatibility with future/other versions + * some information is associated with the "main thread" as though it were one thread in a multi-threaded + * environment. + */ + int _threadstate; + kscm_object_t _threadname; + kscm_object_t _threadopts; + kscm_object_t _threadobject; + + /* Right now, the state format just contains the number of bytes per reference (either 4 or 8). */ + int _stateformat; + + //struct kscm_cell _NIL; + kscm_object_t NIL;// = &_NIL; /* special cell representing empty cell */ + //struct kscm_cell _T; + kscm_object_t T;// = &_T; /* special cell representing #t */ + //struct kscm_cell _F; + kscm_object_t F;// = &_F; /* special cell representing #f */ + kscm_object_t oblist;// = &_NIL; /* pointer to symbol table */ + kscm_object_t global_env; /* pointer to global environment */ + + /* global pointers to special symbols */ + kscm_object_t LAMBDA; /* pointer to syntax lambda */ + kscm_object_t QUOTE; /* pointer to syntax quote */ + +#ifdef KSCM_CONFIG_USE_QQUOTE + kscm_object_t QQUOTE; /* pointer to symbol quasiquote */ + kscm_object_t UNQUOTE; /* pointer to symbol unquote */ + kscm_object_t UNQUOTESP; /* pointer to symbol unquote-splicing */ + +#endif + + kscm_object_t free_cell;// = &_NIL; /* pointer to top of free cells */ + long fcells;// = 0; /* # of free cells */ + + //FILE* infp; /* input file */ + FILE* inputs[KSCM_CONFIG_MAXLOADS]; + int inputtop; // = 0; (TODO: Remove the other initialisers - assume calloc or similar clears memory prior during manual initialisation) + FILE* outfp; /* output file */ + +#ifdef KSCM_CONFIG_USE_SETJMP + jmp_buf error_jmp; + +#endif + char gc_verbose; /* if gc_verbose is not zero, print gc status */ + int quiet;// = 0; /* if not zero, print KSCM_CONFIG_BANNER, KSCM_CONFIG_PROMPT, results */ + int all_errors_fatal;// = 0; /* if not zero, every error is a FatalError */ + + FILE* tmpfp; + int tok; + int print_flag; + kscm_object_t value; + short _operator; + + char linebuff[LINESIZE]; + char strbuff[256]; + char* currentline;// = linebuff; + char* endline;// = linebuff; +}; + +/* allocate new cell segment */ +int kscm__alloc_cellseg(kscm_t *kscm, int n) +{ + /*register*/ kscm_object_t p; + /*register*/ long i; + /*register*/ int k; + + for (k = 0; k < n; k++) { + if (kscm->last_cell_seg >= (KSCM_CONFIG_CELL_NSEGMENT - 1)) + return k; + p = (kscm_object_t)calloc(1,KSCM_CONFIG_CELL_SEGSIZE * sizeof(struct kscm_cell)); + if (p == (kscm_object_t)0) + return k; + kscm->last_cell_seg++; + kscm->cell_seg[kscm->last_cell_seg] = p; + kscm->fcells += KSCM_CONFIG_CELL_SEGSIZE; + + for (i = 0; i < KSCM_CONFIG_CELL_SEGSIZE; i++) { + kscm__type(kscm, p+i) = 0; + kscm__car(kscm, p+i) = kscm->NIL; + kscm__cdr(kscm, p+i) = kscm->free_cell; + kscm->free_cell = p+i; + //p++; + } + + //for (i = 0; i < (KSCM_CONFIG_CELL_SEGSIZE - 1); i++/*, p++*/) { + /* kscm__type(kscm, p) = 0; + kscm__car(kscm, p) = kscm->NIL; + kscm__cdr(kscm, p) = (p + 1); + + //fprintf(stderr, "Added cell %d @ %lx %lx %lx\n", i, kscm__cdr(kscm, p), (p + 1), kscm->NIL); + p++; + } + kscm__type(kscm, p) = 0; + kscm__car(kscm, p) = kscm->NIL; + kscm__cdr(kscm, p) = kscm->free_cell; + kscm->free_cell = kscm->cell_seg[kscm->last_cell_seg];*/ + } + return n; +} + +/* allocate new string segment */ +/*int kscm__alloc_strseg(kscm_t* kscm, int n) +{ + register char* p; + register long i; + register int k; + + for (k = 0; k < n; k++) { + if (kscm->str_seglast >= KSCM_CONFIG_STR_NSEGMENT) + return k; + p = (char*)malloc(KSCM_CONFIG_STR_SEGSIZE * sizeof(char)); + if (p == (char*)0) + return k; + kscm->str_seg[++kscm->str_seglast] = p; + for (i = 0; i < KSCM_CONFIG_STR_SEGSIZE; i++) + *p++ = (char)(-1); + } + return n; +}*/ + +void kscm__fatal_error(kscm_t* kscm, const char* msg, const char* a, const char* b, const char* c); +void kscm__error(kscm_t* kscm, const char* msg, const char* a, const char* b, const char* c); +void kscm__init_globals(kscm_t* kscm); +kscm_object_t kscm__mk_string(kscm_t* kscm, const char* str); + +struct kscm_cell _NIL; +struct kscm_cell _T; +struct kscm_cell _F; + +/* initialization of Mini-Scheme */ +void kscm__init_scheme(kscm_t* kscm) +{ + memset(&_NIL, 0, sizeof(struct kscm_cell)); + memset(&_T, 0, sizeof(struct kscm_cell)); + memset(&_F, 0, sizeof(struct kscm_cell)); + + /*register*/ kscm_object_t i; + + kscm->last_cell_seg = -1; + //kscm->str_seglast = -1; + kscm->NIL = &_NIL; + kscm->T = &_T; + kscm->F = &_F; + kscm->oblist = &_NIL; + kscm->free_cell = &_NIL; + + fprintf(stderr, "Initialising scheme...\n"); + + if (kscm__alloc_cellseg(kscm, KSCM_CONFIG_FIRST_CELLSEGS) != KSCM_CONFIG_FIRST_CELLSEGS) + kscm__fatal_error(kscm, "Unable to allocate initial cell segments", NULL, NULL, NULL); + /*if (!kscm__alloc_strseg(kscm, 1)) + kscm__fatal_error(kscm, "Unable to allocate initial string segments", NULL, NULL, NULL);*/ +#ifdef VERBOSE + kscm->gc_verbose = 1; +#else + kscm->gc_verbose = 0; +#endif + kscm->_stateformat = 4; + kscm->_threadstate = 1; + kscm->_threadobject = kscm->NIL; + fprintf(stderr, "Initialising strings...\n"); + kscm->_threadname = kscm__mk_string(kscm, "main"); + fprintf(stderr, "Initialising strings...\n"); + kscm->_threadopts = kscm__mk_string(kscm, ""); + fprintf(stderr, "Initialising globals...\n"); + kscm__init_globals(kscm); +} + +void kscm__gc(kscm_t* kscm,/* register*/ kscm_object_t a, /*register*/ kscm_object_t b); + +/* get new cell. parameter a, b is marked by gc. */ +kscm_object_t kscm__get_cell(kscm_t* kscm, /*register*/ kscm_object_t a, /*register*/ kscm_object_t b) +{ + // return calloc(1,sizeof(struct kscm_cell)); +//#if 0 + /*register*/ kscm_object_t x; + //fprintf(stderr, "A\n"); + if (kscm->free_cell == kscm->NIL) { + //fprintf(stderr, "B\n"); + kscm__gc(kscm, a, b); + if (kscm->free_cell == kscm->NIL) { + //fprintf(stderr, "C\n"); +#ifdef KSCM_CONFIG_USE_SETJMP + if (!kscm__alloc_cellseg(kscm, 1)) { + //fprintf(stderr, "D\n"); + kscm->args = kscm->envir = kscm->code = kscm->dump = kscm->NIL; + kscm__gc(kscm, kscm->NIL, kscm->NIL); + if (kscm->free_cell != kscm->NIL) { + kscm__error(kscm, "run out of cells --- rerurn to top level", NULL, NULL, NULL); + } else { + kscm__fatal_error(kscm, "run out of cells --- unable to recover cells", NULL, NULL, NULL); + } + } +#else + if (!kscm__alloc_cellseg(kscm, 1)) { + //fprintf(stderr, "E\n"); + kscm__fatal_error(kscm, "run out of cells --- unable to recover cells", NULL, NULL, NULL); + } +#endif + } + } + //fprintf(stderr, "F\n"); + x = kscm->free_cell; + //fprintf(stderr, "G %lx\n", x); + //fprintf(stderr, "G %lx\n", kscm__cdr(kscm, x)); + kscm->free_cell = kscm__cdr(kscm, x); + //fprintf(stderr, "H\n"); + kscm->fcells--; + //fprintf(stderr, "I\n"); + return x; +//#endif +} + +/* get new cons cell */ +kscm_object_t kscm__cons(kscm_t* kscm, register kscm_object_t a, register kscm_object_t b) +{ + register kscm_object_t x = kscm__get_cell(kscm, a, b); + + kscm__type(kscm, x) = KSCM_T_PAIR; + kscm__car(kscm, x) = a; + kscm__cdr(kscm, x) = b; + return (x); +} + +/* get number atom */ +kscm_object_t kscm__mk_number(kscm_t* kscm, register long num) +{ + register kscm_object_t x = kscm__get_cell(kscm, kscm->NIL, kscm->NIL); + + kscm__type(kscm, x) = (KSCM_T_NUMBER | KSCM_T_ATOM); + kscm__ivalue(kscm, x) = num; + return (x); +} + +#ifdef KSCM_CONFIG_USE_FLOATS +kscm_object_t kscm__mk_float64(kscm_t* kscm, double value) { + kscm_object_t x = kscm__get_cell(kscm, kscm->NIL, kscm->NIL); + + kscm__type(kscm, x) = (KSCM_T_FLOAT64 | KSCM_T_ATOM); + x->_object._float64._dvalue = value; + + return x; +} +#endif + +/* allocate name to string area */ +//char* kscm__store_string(kscm_t* kscm, const char *name) +//{ +// register char* q = NULL; +// register short i; +// long len, remain; +// +// /* first check name has already listed */ +// for (i = 0; i <= kscm->str_seglast; i++) +// for (q = kscm->str_seg[i]; *q != (char)(-1); ) { +// if (!strcmp(q, name)) +// goto FOUND; +// while (*q++) +// ; /* get next string */ +// } +// len = strlen(name) + 2; +// // TODO: Replace legacy types, it's starting to get ugly. -Zak +// remain = (long long)KSCM_CONFIG_STR_SEGSIZE - ((long long)q - (long long)kscm->str_seg[kscm->str_seglast]); +// if (remain < len) { +// if (!kscm__alloc_strseg(kscm, 1)) +// kscm__fatal_error(kscm, "run out of string area", NULL, NULL, NULL); +// q = kscm->str_seg[kscm->str_seglast]; +// /*if ((long long)KSCM_CONFIG_STR_SEGSIZE - ((long long)q - (long long)kscm->str_seg[kscm->str_seglast])) { +// fprintf(stderr, "String in question's total length is %d", len); +// kscm__fatal_error(kscm, "string too big", NULL, NULL, NULL); +// }*/ +// } +// strcpy(q, name); +//FOUND: +// return (q); +//} + +/* get new string */ +kscm_object_t kscm__mk_string(kscm_t* kscm, const char *str) +{ + /*register*/ kscm_object_t x = kscm__get_cell(kscm, kscm->NIL, kscm->NIL); + #ifdef __WIN32 + kscm__strvalue(kscm, x) = _strdup(str);//kscm__store_string(kscm, str); + #else + kscm__strvalue(kscm, x) = strdup(str);//kscm__store_string(kscm, str); + #endif + kscm__type(kscm, x) = (KSCM_T_STRING | KSCM_T_ATOM); + kscm__keynum(kscm, x) = (short)(-1); + return (x); +} + +/* get new symbol */ +kscm_object_t kscm__mk_symbol(kscm_t* kscm, const char *name) +{ + register kscm_object_t x; + + /* fisrt check oblist */ + for (x = kscm->oblist; x != kscm->NIL; x = kscm__cdr(kscm, x)) + if (!strcmp(name, kscm__symname(kscm, kscm__car(kscm, x)))) + break; + + if (x != kscm->NIL) + return (kscm__car(kscm, x)); + else { + x = kscm__cons(kscm, kscm__mk_string(kscm, name), kscm->NIL); + kscm__type(kscm, x) = KSCM_T_SYMBOL; + kscm->oblist = kscm__cons(kscm, x, kscm->oblist); + return (x); + } +} + +#ifdef KSCM_CONFIG_USE_STRUCTS +kscm_object_t kscm__mk_buffer(kscm_t* kscm, long len) { + void* d = calloc(1, len); + if (d == NULL) { + return kscm->NIL; + } + kscm_object_t result = kscm__get_cell(kscm, kscm->NIL, kscm->NIL); + kscm__type(kscm, result) = (KSCM_T_BUFFER | KSCM_T_ATOM); + result->_object._buffer._length = len; + result->_object._buffer._data = (unsigned char*) d; + return result; +} +kscm_object_t kscm__mk_abstraction(kscm_t* kscm, register kscm_object_t a, register kscm_object_t b) +{ + register kscm_object_t x = kscm__get_cell(kscm, a, b); + + kscm__type(kscm, x) = KSCM_T_ABSTRACTION; + kscm__car(kscm, x) = a; + kscm__cdr(kscm, x) = b; + return (x); +} +#endif + +#ifdef KSCM_CONFIG_USE_OBJECTS +kscm_object_t kscm__mk_objx(kscm_t* kscm, kscm_object_t typ, long len) { + void* d = calloc(sizeof(kscm_object_t), len); + if (d == NULL) { + return kscm->NIL; + } + kscm_object_t result = kscm__get_cell(kscm, typ, kscm->NIL); + kscm__type(kscm, result) = KSCM_T_OBJX; + result->_object._objx._type = typ; + result->_object._objx._count = len; + result->_object._objx._elements = (kscm_object_t*)d; + long i; + for (i = 0; i < len; i++) { + result->_object._objx._elements[i] = kscm->NIL; + } + return result; +} +#endif + +#ifdef KSCM_CONFIG_USE_PRECISE +int kscm__safedigit(kscm_t* kscm, int base, char d) { + if (base <= 10) { + if (d >= '0' && d < '0' + base) { + return d - '0'; + } + else { + return -1; + } + } + else if (base == 16) { + if (d >= '0' && d < '0' + 10) { + return d - '0'; + } + else if (d >= 'a' && d < 'a' + 6) { + return 10 + (d - 'a'); + } + else if (d >= 'A' && d < 'A' + 6) { + return 10 + (d - 'A'); + } + else { + return -1; + } + } + else { + return -1; + } +} +kscm_object_t kscm__mk_safenum(kscm_t* kscm, int base, const char* src) { + char c; + const char* p; + int32_t v = 0; + int negate = 0; + p = src; + if (p[0] == '-') { + negate = 1; + p++; + } + else if (p[0] == '+') { + p++; + } + if (kscm__safedigit(kscm, base, p[0]) < 0) { + return kscm->F; + } + while (kscm__safedigit(kscm, base, p[0]) >= 0) { + int64_t lv = ((int64_t)v) * base + kscm__safedigit(kscm, base, p[0]); + v = (int32_t)lv; + //printf("Adding digit %d to get %d\n", kscm__safedigit(kscm, base, p[0]), v); + if (((int64_t)v) != lv) { + return kscm->F; + } + p++; + } + + if (negate) { + v = -v; + } + + return kscm__mk_number(kscm, v); +} +#endif + +/* make symbol or number atom from string */ +kscm_object_t kscm__mk_atom(kscm_t* kscm, const char *q) +{ + char c; + const char *p; + + p = q; + if (!isdigit(c = *p++)) { + if ((c != '+' && c != '-') || !isdigit(*p)) + return (kscm__mk_symbol(kscm, q)); + } +#ifdef KSCM_CONFIG_USE_FLOATS + bool isFloat = false; + bool hasE = false; + bool hasESign = false; + char prev = ' '; + for (; (c = *p) != 0; ++p) { + if (!isdigit(c)) { + if (!isFloat && c == '.') { + isFloat = true; + } + else if (isFloat && !hasE && (c == 'e' || c == 'E')) { + hasE = true; + } + else if (isFloat && hasE && (prev == 'e' || prev == 'E') && (c == '+' || c == '-')) { + hasESign = true; + } + else { + return (kscm__mk_symbol(kscm, q)); + } + } + prev = c; + } + if (isFloat) { + return kscm__mk_float64(kscm, atof(q)); + } +#else + for (; (c = *p) != 0; ++p) + if (!isdigit(c)) + return (kscm__mk_symbol(kscm, q)); +#endif +#ifdef KSCM_CONFIG_USE_PRECISE + kscm_object_t result = kscm__mk_safenum(kscm, 10, q); + if (result == kscm->F) { + //fprintf(stderr, "WARNING: Math overflow in '%s'\n", q); + result = kscm__cons(kscm, kscm__mk_symbol(kscm, "parse-number"), kscm__cons(kscm, kscm__mk_string(kscm, q), kscm->NIL)); + } + return result; +#else + return (kscm__mk_number(kscm, atol(q))); +#endif +} + +/* make constant */ +kscm_object_t kscm__mk_const(kscm_t* kscm, const char *name) +{ + long x; + char tmp[256]; + + if (!strcmp(name, "t")) + return (kscm->T); + else if (!strcmp(name, "f")) + return (kscm->F); + else if (*name == 'o') {/* #o (octal) */ + sprintf(tmp, "0%s", /*&name[1]*/ name+1); + fprintf(stderr, "TODO: Octal parsing!\n"); exit(-1); + //sscanf(tmp, "%lo", (unsigned long int*) & x); + return (kscm__mk_number(kscm, x)); + } + else if (*name == 'd') { /* #d (decimal) */ + x = atoll(name+1); //sscanf(&name[1], "%ld", &x); + return (kscm__mk_number(kscm, x)); + } + else if (*name == 'x') { /* #x (hex) */ + sprintf(tmp, "0x%s", &name[1]); + fprintf(stderr, "TODO: Hex parsing!\n"); exit(-1); + //sscanf(tmp, "%lx", (unsigned long int*) & x); + return (kscm__mk_number(kscm, x)); + } + else + return (kscm->NIL); +} + + +/* ========== garbage collector ========== */ + +/*-- + * We use algorithm E (Kunuth, The Art of Computer Programming Vol.1, + * sec.3.5) for marking. + * + * NOTE: The implementation is complicated a bit when using object-oriented/vector extensions. + * I've decided to just use recursive marking in this case, but I've added some documentation to + * the original algorithm as well in case anyone wants to update it. + */ +#ifdef KSCM_CONFIG_USE_OBJECTS +#define KSCM_GC_MAXREC 100000 +void kscm__fastmark(kscm_t* kscm, kscm_object_t root) { + int stacklevel = 0; + + kscm->gcstate[stacklevel].object = root; + kscm->gcstate[stacklevel].offset = 0; + + while (stacklevel >= 0) { + kscm_object_t a = kscm->gcstate[stacklevel].object; + long o = kscm->gcstate[stacklevel].offset; + + if (o == 0) { + if (kscm__ismark(kscm, a)) { + stacklevel--; + continue; + } + + kscm__setmark(kscm, a); + + if (kscm__isatom(kscm, a)) { + stacklevel--; + continue; + } + } + + kscm->gcstate[stacklevel].offset = o + 1; + + if (stacklevel + 1 >= kscm->gcstate_max) { + fprintf(stderr, "ERROR: Garbage collection stack limit reached! Current limit is set at %d!\n", kscm->gcstate_max); + exit(-1); + } + + if (kscm__isobjx(kscm, a)) { + if (o == 0) { + stacklevel++; + kscm->gcstate[stacklevel].object = a->_object._objx._type; + kscm->gcstate[stacklevel].offset = 0; + } else if (o - 1 >= a->_object._objx._count) { + stacklevel--; + continue; + } else { + stacklevel++; + kscm->gcstate[stacklevel].object = a->_object._objx._elements[o-1]; + kscm->gcstate[stacklevel].offset = 0; + } + } else { /* Is pair or pair-like abstraction*/ + if (o == 0) { + stacklevel++; + kscm->gcstate[stacklevel].object = kscm__car(kscm, a); + kscm->gcstate[stacklevel].offset = 0; + } else if (o == 1) { + stacklevel++; + kscm->gcstate[stacklevel].object = kscm__cdr(kscm, a); + kscm->gcstate[stacklevel].offset = 0; + } else { + stacklevel--; + continue; + } + } + + } +} +void kscm__recursivemark(kscm_t* kscm, kscm_object_t a, int recursionlevel) { + printf("Recursion=%d\n", recursionlevel); + if (recursionlevel > KSCM_GC_MAXREC) { + fprintf(stderr, "WARNING: Garbage collector is recursing like a motherfucker\n"); + recursionlevel = 0; // We just reset it though, the warning should be enough to show if it's becoming a problem + } + + if (kscm__ismark(kscm, a)) { + return; + } + + kscm__setmark(kscm, a); + + if (kscm__isatom(kscm, a)) { + return; + } + + if (kscm__isobjx(kscm, a)) { + kscm__recursivemark(kscm, a->_object._objx._type, recursionlevel + 1); + int i; + for (i = 0; i < a->_object._objx._count; i++) { + //printf("Recursively marking object at index %d\n", i); + kscm__recursivemark(kscm, a->_object._objx._elements[i], recursionlevel + 1); + } + } else { /* Is pair or pair-like abstraction*/ + kscm__recursivemark(kscm, kscm__car(kscm, a), recursionlevel + 1); + kscm__recursivemark(kscm, kscm__cdr(kscm, a), recursionlevel + 1); + } +} +void kscm__mark(kscm_t* kscm, kscm_object_t a) { + //kscm__recursivemark(kscm, a, 1); + kscm__fastmark(kscm, a); +} +#else +void kscm__mark(kscm_t* kscm, kscm_object_t a) +{ + register kscm_object_t t; /* Used to track the previous object. This object will in turn be used to track it's previous. */ + register kscm_object_t q; /* Used as a temporary value to hold our subreferences. */ + register kscm_object_t p; /* Points to the current object. */ + +/* E1: Start of algorithm. Reset t and p. */ +E1: t = (kscm_object_t)0; + p = a; +/* E2: Start by marking p (i.e. marking it as "keep this cell"). */ +E2: kscm__setmark(kscm, p); +/* E3: Check type. If it's an atom (not built out of references to other cells) we can skip marking references. */ +E3: if (kscm__isatom(kscm, p)) +goto E6; +/* E4: Mark first reference ("car" or equivalent) if it's not already marked. */ +E4: + q = kscm__car(kscm, p); + if (q && !kscm__ismark(kscm, q)) { + kscm__setatom(kscm, p); + kscm__car(kscm, p) = t; + t = p; + p = q; + goto E2; + } +/* E5: Mark second/nth references if they're not already marked. */ +E5: q = kscm__cdr(kscm, p); +if (q && !kscm__ismark(kscm, q)) { + kscm__cdr(kscm, p) = t; + t = p; + p = q; + goto E2; +} +/* E6: This object is now fully marked. If there's no previous object, we can just return. Otherwise, + * we reload the previous object (and set the new previous to the one stored in "car" or equivalent), + * and continue marking it's subreferences. + */ +E6: if (!t) +return; +q = t; +if (kscm__isatom(kscm, q)) { + kscm__clratom(kscm, q); + t = kscm__car(kscm, q); + kscm__car(kscm, q) = p; + p = q; + goto E5; +} +else { + t = kscm__cdr(kscm, q); + kscm__cdr(kscm, q) = p; + p = q; + goto E6; +} +} +#endif + + +/* garbage collection. parameter a, b is marked. */ +void kscm__gc(kscm_t* kscm, /*register*/ kscm_object_t a, /*register*/ kscm_object_t b) +{ + /*register*/ kscm_object_t p; + /*register*/ short i; + /*register*/ long j; + + if (kscm->gc_verbose) + printf("gc..."); + + /* mark system globals */ + kscm__mark(kscm, kscm->oblist); + kscm__mark(kscm, kscm->global_env); + + /* mark current registers */ + kscm__mark(kscm, kscm->args); + kscm__mark(kscm, kscm->envir); + kscm__mark(kscm, kscm->code); + kscm__mark(kscm, kscm->dump); + + /* mark thread values (this implementation is single-threaded but we keep them anyway) */ + kscm__mark(kscm, kscm->_threadname); + kscm__mark(kscm, kscm->_threadopts); + kscm__mark(kscm, kscm->_threadobject); + + /* mark variables a, b */ + kscm__mark(kscm, a); + kscm__mark(kscm, b); + + /* garbage collect */ + kscm__clrmark(kscm, kscm->NIL); + kscm->fcells = 0; + kscm->free_cell = kscm->NIL; + for (i = 0; i <= kscm->last_cell_seg; i++) { + j = 0; + for (/*j = 0,*/ p = kscm->cell_seg[i]; j < KSCM_CONFIG_CELL_SEGSIZE; j++/*, p++*/) { + if (kscm__ismark(kscm, p)) + kscm__clrmark(kscm, p); + else { + if (kscm__isstring(kscm, p)) { + if (p->_object._string._svalue != NULL) { + free(p->_object._string._svalue); + } + } +#ifdef KSCM_CONFIG_USE_STRUCTS + if (kscm__isbuffer(kscm, p)) { + if (p->_object._buffer._data != NULL) { + //fprintf(stderr, "Freeing a buffer of %d length\n", p->_object._buffer._length); + free(p->_object._buffer._data); + p->_object._buffer._data = NULL; + } + } +#endif +#ifdef KSCM_CONFIG_USE_OBJECTS + if (kscm__isobjx(kscm, p)) { + if (p->_object._objx._elements != NULL) { + free(p->_object._objx._elements); + p->_object._objx._elements = NULL; + } + } +#endif + // TODO: Should probably clear the whole structure before setting defaults or adding to free list + // (this could help avoid bugs if larger-than-pair structures aren't cleared or reset properly elsewhere) + kscm__type(kscm, p) = 0; + kscm__cdr(kscm, p) = kscm->free_cell; + kscm__car(kscm, p) = kscm->NIL; + kscm->free_cell = p; + kscm->fcells++; + } + p = p + 1; + } + } + + if (kscm->gc_verbose) + printf(" done %ld cells are recovered.\n", kscm->fcells); +} + + +/* ========== Rootines for Reading ========== */ + +/* get new character from input file */ +int kscm__inchar(kscm_t* kscm) +{ + if (kscm->currentline >= kscm->endline) { /* input buffer is empty */ + if (feof(kscm->inputs[kscm->inputtop])) { + fclose(kscm->inputs[kscm->inputtop]); + if (kscm->inputtop > 0) { // return to outer input + kscm->inputs[kscm->inputtop] = NULL; + kscm->inputtop--; + if (kscm->inputs[kscm->inputtop] == stdin) { + if (!kscm->quiet) + {printf(KSCM_CONFIG_PROMPT);fflush(stdout);} + } + } + else { // go back to the top-level + kscm->inputs[kscm->inputtop] = stdin; + if (!kscm->quiet) + {printf(KSCM_CONFIG_PROMPT);fflush(stdout);} + } + } + strcpy(kscm->linebuff, "\n"); // TODO: Why's this here? -Zak. + if (fgets(kscm->currentline = kscm->linebuff, LINESIZE, kscm->inputs[kscm->inputtop]) == NULL) + if (kscm->inputs[kscm->inputtop] == stdin) { + if (!kscm->quiet) + fprintf(stderr, "Good-bye\n"); + exit(0); + } + kscm->endline = kscm->linebuff + strlen(kscm->linebuff); + } + return (*kscm->currentline++); +} + +/* clear input buffer */ +void kscm__clearinput(kscm_t* kscm) +{ + kscm->currentline = kscm->endline = kscm->linebuff; +} + +/* back to standard input */ +void kscm__resetinput(kscm_t* kscm) +{ + /*if (kscm->inputs[kscm->inputtop] != stdin) { + fclose(kscm->inputs[kscm->inputtop]); + kscm->inputs[kscm->inputtop] = stdin; + }*/ + while (kscm->inputtop > 0 || kscm->inputs[kscm->inputtop] != stdin) { + fclose(kscm->inputs[kscm->inputtop]); + if (kscm->inputtop > 0) { // return to outer input + kscm->inputs[kscm->inputtop] = NULL; + kscm->inputtop--; + } + else { // go back to the top-level + kscm->inputs[kscm->inputtop] = stdin; + if (!kscm->quiet) + {printf(KSCM_CONFIG_PROMPT);fflush(stdout);} + } + } + kscm__clearinput(kscm); +} + +/* back character to input buffer */ +void kscm__backchar(kscm_t* kscm) +{ + kscm->currentline--; +} + +int kscm__isdelim(kscm_t* kscm, const char* s, char c); + +/* read chacters to delimiter */ +char* kscm__readstr(kscm_t* kscm, const char *delim) +{ + char* p = kscm->strbuff; + + while (kscm__isdelim(kscm, delim, (*p++ = kscm__inchar(kscm)))) + ; + kscm__backchar(kscm); + *--p = '\0'; + return (kscm->strbuff); +} + +/* read string expression "xxx...xxx" */ +char* kscm__readstrexp(kscm_t* kscm) +{ + char c, * p = kscm->strbuff; + + for (;;) { + if ((c = kscm__inchar(kscm)) != '"') + *p++ = c; + else if (p > kscm->strbuff&&* (p - 1) == '\\') + *(p - 1) = '"'; + else { + *p = '\0'; + return (kscm->strbuff); + } + } +} + +/* check c is delimiter */ +int kscm__isdelim(kscm_t* kscm, const char *s, char c) +{ + while (*s) + if (*s++ == c) + return (0); + return (1); +} + +/* skip white characters */ +void kscm__skipspace(kscm_t* kscm) +{ + while (isspace(kscm__inchar(kscm))) + ; + kscm__backchar(kscm); +} + +/* get token */ +int kscm__token(kscm_t* kscm) +{ + kscm__skipspace(kscm); + switch (kscm__inchar(kscm)) { + case '(': + return (KSCM_TOK_LPAREN); + case ')': + return (KSCM_TOK_RPAREN); + case '.': + return (KSCM_TOK_DOT); + case '\'': + return (KSCM_TOK_QUOTE); + case ';': + return (KSCM_TOK_COMMENT); + case '"': + return (KSCM_TOK_DQUOTE); +#ifdef KSCM_CONFIG_USE_QQUOTE + case BACKQUOTE: + return (KSCM_TOK_BQUOTE); + case ',': + if (kscm__inchar(kscm) == '@') + return (KSCM_TOK_ATMARK); + else { + kscm__backchar(kscm); + return (KSCM_TOK_COMMA); + } +#endif + case '#': + return (KSCM_TOK_SHARP); + default: + kscm__backchar(kscm); + return (KSCM_TOK_ATOM); + } +} + +/* ========== Rootines for Printing ========== */ +#define kscm__ok_abbrev(kscm,x) (kscm__ispair(kscm, x) && kscm__cdr(kscm, x) == kscm->NIL) + +void kscm__strunquote(kscm_t* kscm, char *p, const char *s) +{ + *p++ = '"'; + for (; *s; ++s) { + if (*s == '"') { + *p++ = '\\'; + *p++ = '"'; + } + else if (*s == '\n') { + *p++ = '\\'; + *p++ = 'n'; + } + else + *p++ = *s; + } + *p++ = '"'; + *p = '\0'; +} + + +/* print atoms */ +int kscm__printatom(kscm_t* kscm, kscm_object_t l, int f) +{ + char *p = NULL; + + if (l == kscm->NIL) + p = (char*)(void*)"()"; + else if (l == kscm->T) + p = (char*)(void*)"#t"; + else if (l == kscm->F) + p = (char*)(void*)"#f"; + else if (kscm__isnumber(kscm, l)) { + p = kscm->strbuff; + sprintf(p, "%ld", kscm__ivalue(kscm, l)); + } + else if (kscm__isfloat64(kscm, l)) { + p = kscm->strbuff; + sprintf(p, "%f", l->_object._float64._dvalue); + } + else if (kscm__isstring(kscm, l)) { + if (!f) + p = kscm__strvalue(kscm, l); + else { + p = kscm->strbuff; + kscm__strunquote(kscm, p, kscm__strvalue(kscm, l)); + } + } + else if (kscm__issymbol(kscm, l)) + p = kscm__symname(kscm, l); + else if (kscm__isproc(kscm, l)) { + p = kscm->strbuff; + sprintf(p, "#", kscm__procnum(kscm, l)); +#ifdef KSCM_CONFIG_USE_MACRO + } + else if (kscm__ismacro(kscm, l)) { + p = (char*)(void*)"#"; +#endif +#ifdef KSCM_CONFIG_USE_STRUCTS + } + else if (kscm__isbuffer(kscm, l)) { + p = (char*)(void*)"#"; + } + else if (kscm__isabstraction(kscm, l)) { + p = (char*)(void*)"#"; +#endif +#ifdef KSCM_CONFIG_USE_OBJECTS + } + else if (kscm__isobjx(kscm, l)) { + p = (char*)(void*)"#"; +#endif + } + else if (kscm__isclosure(kscm, l)) + p = (char*)(void*)"#"; + else if (kscm__iscontinuation(kscm, l)) + p = (char*)(void*)"#"; + if (f < 0) + return strlen(p); + fputs(p, kscm->outfp); + return 0; +} + + +/* ========== Rootines for Evaluation Cycle ========== */ + +/* make closure. c is code. e is environment */ +kscm_object_t kscm__mk_closure(kscm_t* kscm, register kscm_object_t c, register kscm_object_t e) +{ + register kscm_object_t x = kscm__get_cell(kscm, c, e); + + kscm__type(kscm, x) = KSCM_T_CLOSURE; + kscm__car(kscm, x) = c; + kscm__cdr(kscm, x) = e; + return (x); +} + +/* make continuation. */ +kscm_object_t kscm__mk_continuation(kscm_t* kscm, register kscm_object_t d) +{ + register kscm_object_t x = kscm__get_cell(kscm, kscm->NIL, d); + + kscm__type(kscm, x) = KSCM_T_CONTINUATION; + kscm__cont_dump(kscm, x) = d; + return (x); +} + +/* reverse list -- make new cells */ +kscm_object_t kscm__reverse(kscm_t* kscm, register kscm_object_t a) /* a must be checked by gc */ +{ + register kscm_object_t p = kscm->NIL; + + for (; kscm__ispair(kscm, a); a = kscm__cdr(kscm, a)) + p = kscm__cons(kscm, kscm__car(kscm, a), p); + return (p); +} + +/* reverse list --- no make new cells */ +kscm_object_t kscm__non_alloc_rev(kscm_t* kscm, kscm_object_t term, kscm_object_t list) +{ + register kscm_object_t p = list, result = term, q; + + while (p != kscm->NIL) { + q = kscm__cdr(kscm, p); + kscm__cdr(kscm, p) = result; + result = p; + p = q; + } + return (result); +} + +/* append list -- make new cells */ +kscm_object_t kscm__append(kscm_t* kscm, register kscm_object_t a, register kscm_object_t b) +{ + register kscm_object_t p = b, q; + + if (a != kscm->NIL) { + a = kscm__reverse(kscm, a); + while (a != kscm->NIL) { + q = kscm__cdr(kscm, a); + kscm__cdr(kscm, a) = p; + p = a; + a = q; + } + } + return (p); +} + +/* equivalence of atoms */ +int kscm__eqv(kscm_t* kscm, register kscm_object_t a, register kscm_object_t b) +{ + if (kscm__isstring(kscm, a)) { + if (kscm__isstring(kscm, b)) + return (!strcmp(kscm__strvalue(kscm, a), kscm__strvalue(kscm, b))); + else + return (0); + } + else if (kscm__isnumber(kscm, a)) { + if (kscm__isnumber(kscm, b)) + return (kscm__ivalue(kscm, a) == kscm__ivalue(kscm, b)); + else + return (0); + } + else + return (a == b); +} + +/* true or false value macro */ +#define kscm__istrue(kscm,p) ((p) != kscm->NIL && (p) != kscm->F) +#define kscm__isfalse(kscm,p) ((p) == kscm->NIL || (p) == kscm->F) + +/* Error macro */ +#ifdef KSCM_CONFIG_AVOID_HACK_LOOP +# define KSCM__BEGIN { +# define KSCM__END } +#else +/* + * I believe this is better, but some compiler complains.... + */ +# define KSCM__BEGIN do { +# define KSCM__END } while (0) +#endif + +#define kscm__error_0(kscm,s) KSCM__BEGIN \ + kscm->args = kscm__cons(kscm, kscm__mk_string(kscm, (s)), kscm->NIL); \ + kscm->_operator = (short)KSCM_OP_ERR0; \ + return kscm->T; KSCM__END + +#define kscm__error_1(kscm,s, a) KSCM__BEGIN \ + kscm->args = kscm__cons(kscm, (a), kscm->NIL); \ + kscm->args = kscm__cons(kscm, kscm__mk_string(kscm, (s)), kscm->args); \ + kscm->_operator = (short)KSCM_OP_ERR0; \ + return kscm->T; KSCM__END + + /* control macros for Eval_Cycle */ +#define kscm__s_goto(kscm,a) KSCM__BEGIN \ + kscm->_operator = (short)(a); \ + return kscm->T; KSCM__END + +#define kscm__s_save(kscm,a, b, c) do{ \ + kscm->dump = kscm__cons(kscm, kscm->envir, kscm__cons(kscm, (c), kscm->dump)); \ + kscm->dump = kscm__cons(kscm, (b), kscm->dump); \ + kscm->dump = kscm__cons(kscm, kscm__mk_number(kscm, (long)(a)), kscm->dump);}while(0) + + +#define kscm__s_return(kscm,a) KSCM__BEGIN \ + kscm->value = (a); \ + kscm->_operator = kscm__ivalue(kscm, kscm__car(kscm, kscm->dump)); \ + kscm->args = kscm__cadr(kscm, kscm->dump); \ + kscm->envir = kscm__caddr(kscm, kscm->dump); \ + kscm->code = kscm__cadddr(kscm, kscm->dump); \ + kscm->dump = kscm__cddddr(kscm, kscm->dump); \ + return kscm->T; KSCM__END + +#define kscm__s_retbool(kscm,tf) kscm__s_return(kscm, (tf) ? kscm->T : kscm->F) + + + +kscm_object_t kscm__opexe_0(kscm_t* kscm, register short op) +{ + register kscm_object_t x; + register kscm_object_t y = NULL; + + switch (op) { + case KSCM_OP_LOAD: /* load */ + if (!kscm__isstring(kscm, kscm__car(kscm, kscm->args))) { + kscm__error_0(kscm, "load -- argument is not string"); + } + if (kscm->inputtop + 1 >= KSCM_CONFIG_MAXLOADS) { + kscm__error_0(kscm, "load -- depth of loaded files has reached the KSCM_CONFIG_MAXLOADS value"); + } + if ((kscm->inputs[kscm->inputtop + 1] = fopen(kscm__strvalue(kscm, kscm__car(kscm, kscm->args)), "r")) == NULL) { + //kscm->inputs[kscm->inputtop] = stdin; + kscm__error_1(kscm, "Unable to open", kscm__car(kscm, kscm->args)); + } + kscm->inputtop++; + if (!kscm->quiet) + fprintf(kscm->outfp, "loading %s", kscm__strvalue(kscm, kscm__car(kscm, kscm->args))); + kscm__s_goto(kscm, KSCM_OP_T0LVL); + + case KSCM_OP_T0LVL: /* top level */ + if (!kscm->quiet) + fprintf(kscm->outfp, "\n"); + kscm->dump = kscm->NIL; + kscm->envir = kscm->global_env; + kscm__s_save(kscm, KSCM_OP_VALUEPRINT, kscm->NIL, kscm->NIL); + kscm__s_save(kscm, KSCM_OP_T1LVL, kscm->NIL, kscm->NIL); + if (kscm->inputs[kscm->inputtop] == stdin && !kscm->quiet) + {printf(KSCM_CONFIG_PROMPT);fflush(stdout);} + kscm__s_goto(kscm, KSCM_OP_READ); + + case KSCM_OP_T1LVL: /* top level */ + kscm->code = kscm->value; + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_READ: /* read */ + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + + case KSCM_OP_VALUEPRINT: /* print evalution result */ + kscm->print_flag = 1; + kscm->args = kscm->value; + if (kscm->quiet) { + kscm__s_goto(kscm, KSCM_OP_T0LVL); + } + else { + kscm__s_save(kscm, KSCM_OP_T0LVL, kscm->NIL, kscm->NIL); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + + case KSCM_OP_EVAL: /* main part of evalution */ + if (kscm__issymbol(kscm, kscm->code)) { /* symbol */ + for (x = kscm->envir; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + for (y = kscm__car(kscm, x); y != kscm->NIL; y = kscm__cdr(kscm, y)) + if (kscm__caar(kscm, y) == kscm->code) + break; + if (y != kscm->NIL) + break; + } + if (x != kscm->NIL) { + kscm__s_return(kscm, kscm__cdar(kscm, y)); + } + else { + kscm__error_1(kscm, "Unbounded variable", kscm->code); + } + } + else if (kscm__ispair(kscm, kscm->code)) { + if (kscm__issyntax(kscm, x = kscm__car(kscm, kscm->code))) { /* SYNTAX */ + kscm->code = kscm__cdr(kscm, kscm->code); + kscm__s_goto(kscm, kscm__syntaxnum(kscm, x)); + } + else {/* first, eval top element and eval arguments */ +#ifdef KSCM_CONFIG_USE_MACRO + kscm__s_save(kscm, KSCM_OP_E0ARGS, kscm->NIL, kscm->code); +#else + s_save(kscm, KSCM_OP_E1ARGS, kscm->NIL, cdr(code)); +#endif + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + } + else { + kscm__s_return(kscm, kscm->code); + } + +#ifdef KSCM_CONFIG_USE_MACRO + case KSCM_OP_E0ARGS: /* eval arguments */ + if (kscm__ismacro(kscm, kscm->value)) { /* macro expansion */ + kscm__s_save(kscm, KSCM_OP_DOMACRO, kscm->NIL, kscm->NIL); + kscm->args = kscm__cons(kscm, kscm->code, kscm->NIL); + kscm->code = kscm->value; + kscm__s_goto(kscm, KSCM_OP_APPLY); + } + else { + kscm->code = kscm__cdr(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_E1ARGS); + } +#endif + + case KSCM_OP_E1ARGS: /* eval arguments */ + kscm->args = kscm__cons(kscm, kscm->value, kscm->args); + if (kscm__ispair(kscm, kscm->code)) { /* continue */ + kscm__s_save(kscm, KSCM_OP_E1ARGS, kscm->args, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + else { /* end */ + kscm->args = kscm__reverse(kscm, kscm->args); + kscm->code = kscm__car(kscm, kscm->args); + kscm->args = kscm__cdr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_APPLY); + } + + case KSCM_OP_APPLY: /* apply 'code' to 'args' */ + if (kscm__isproc(kscm, kscm->code)) { + kscm__s_goto(kscm, kscm__procnum(kscm, kscm->code)); /* PROCEDURE */ + } + else if (kscm__isclosure(kscm, kscm->code)) { /* CLOSURE */ + /* make environment */ + kscm->envir = kscm__cons(kscm, kscm->NIL, kscm__closure_env(kscm, kscm->code)); + y = kscm->args; + for (x = kscm__car(kscm, kscm__closure_code(kscm, kscm->code))/*, y = kscm->args*/; + kscm__ispair(kscm, x); x = kscm__cdr(kscm, x)/*, y = kscm__cdr(kscm, y)*/) { + if (y == kscm->NIL) { + kscm__error_0(kscm, "Few arguments"); + } + else { + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm__car(kscm, x), kscm__car(kscm, y)), kscm__car(kscm, kscm->envir)); + } + y = kscm__cdr(kscm, y); + } + if (x == kscm->NIL) { + /*-- + * if (y != kscm->NIL) { + * Error_0("Many arguments"); + * } + */ + } + else if (kscm__issymbol(kscm, x)) + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, x, y), kscm__car(kscm, kscm->envir)); + else { + kscm__error_0(kscm, "Syntax error in closure"); + } + kscm->code = kscm__cdr(kscm, kscm__closure_code(kscm, kscm->code)); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_BEGIN); + } + else if (kscm__iscontinuation(kscm, kscm->code)) { /* CONTINUATION */ + kscm->dump = kscm__cont_dump(kscm, kscm->code); + kscm__s_return(kscm, kscm->args != kscm->NIL ? kscm__car(kscm, kscm->args) : kscm->NIL); + } + else { + kscm__error_0(kscm, "Illegal function"); + } + +#ifdef KSCM_CONFIG_USE_MACRO + case KSCM_OP_DOMACRO: /* do macro */ + kscm->code = kscm->value; + kscm__s_goto(kscm, KSCM_OP_EVAL); +#endif + + case KSCM_OP_LAMBDA: /* lambda */ + kscm__s_return(kscm, kscm__mk_closure(kscm, kscm->code, kscm->envir)); + + case KSCM_OP_QUOTE: /* quote */ + kscm__s_return(kscm, kscm__car(kscm, kscm->code)); + + case KSCM_OP_DEF0: /* define */ + if (kscm__ispair(kscm, kscm__car(kscm, kscm->code))) { + x = kscm__caar(kscm, kscm->code); + kscm->code = kscm__cons(kscm, kscm->LAMBDA, kscm__cons(kscm, kscm__cdar(kscm, kscm->code), kscm__cdr(kscm, kscm->code))); + } + else { + x = kscm__car(kscm, kscm->code); + kscm->code = kscm__cadr(kscm, kscm->code); + } + if (!kscm__issymbol(kscm, x)) { + kscm__error_0(kscm, "Variable is not symbol"); + } + kscm__s_save(kscm, KSCM_OP_DEF1, kscm->NIL, x); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_DEF1: /* define */ + for (x = kscm__car(kscm, kscm->envir); x != kscm->NIL; x = kscm__cdr(kscm, x)) + if (kscm__caar(kscm, x) == kscm->code) + break; + if (x != kscm->NIL) + kscm__cdar(kscm, x) = kscm->value; + else + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm->code, kscm->value), kscm__car(kscm, kscm->envir)); + kscm__s_return(kscm, kscm->code); + + case KSCM_OP_SET0: /* set! */ + kscm__s_save(kscm, KSCM_OP_SET1, kscm->NIL, kscm__car(kscm, kscm->code)); + kscm->code = kscm__cadr(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_SET1: /* set! */ + for (x = kscm->envir; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + for (y = kscm__car(kscm, x); y != kscm->NIL; y = kscm__cdr(kscm, y)) + if (kscm__caar(kscm, y) == kscm->code) + break; + if (y != kscm->NIL) + break; + } + if (x != kscm->NIL) { + kscm__cdar(kscm, y) = kscm->value; + kscm__s_return(kscm, kscm->value); + } + else { + kscm__error_1(kscm, "Unbounded variable", kscm->code); + } + + case KSCM_OP_BEGIN: /* begin */ + if (!kscm__ispair(kscm, kscm->code)) { + kscm__s_return(kscm, kscm->code); + } + if (kscm__cdr(kscm, kscm->code) != kscm->NIL) { + kscm__s_save(kscm, KSCM_OP_BEGIN, kscm->NIL, kscm__cdr(kscm, kscm->code)); + } + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_IF0: /* if */ + kscm__s_save(kscm, KSCM_OP_IF1, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_IF1: /* if */ + if (kscm__istrue(kscm, kscm->value)) + kscm->code = kscm__car(kscm, kscm->code); + else + kscm->code = kscm__cadr(kscm, kscm->code); /* (if #f 1) ==> () because + * car(kscm->NIL) = kscm->NIL */ + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_LET0: /* let */ + kscm->args = kscm->NIL; + kscm->value = kscm->code; + kscm->code = kscm__issymbol(kscm, kscm__car(kscm, kscm->code)) ? kscm__cadr(kscm, kscm->code) : kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_LET1); + + case KSCM_OP_LET1: /* let (caluculate parameters) */ + kscm->args = kscm__cons(kscm, kscm->value, kscm->args); + if (kscm__ispair(kscm, kscm->code)) { /* continue */ + kscm__s_save(kscm, KSCM_OP_LET1, kscm->args, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__cadar(kscm, kscm->code); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + else { /* end */ + kscm->args = kscm__reverse(kscm, kscm->args); + kscm->code = kscm__car(kscm, kscm->args); + kscm->args = kscm__cdr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_LET2); + } + + case KSCM_OP_LET2: /* let */ + kscm->envir = kscm__cons(kscm, kscm->NIL, kscm->envir); + y = kscm->args; + for (x = kscm__issymbol(kscm, kscm__car(kscm, kscm->code)) ? kscm__cadr(kscm, kscm->code) : kscm__car(kscm, kscm->code)/*, y = kscm->args*/; + y != kscm->NIL; x = kscm__cdr(kscm, x)/*, y = kscm__cdr(kscm, y)*/) + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm__caar(kscm, x), kscm__car(kscm, y)), kscm__car(kscm, kscm->envir)); + y = kscm__cdr(kscm, y); + if (kscm__issymbol(kscm, kscm__car(kscm, kscm->code))) { /* named let */ + kscm->args = kscm->NIL; + for (x = kscm__cadr(kscm, kscm->code) /*, kscm->args = kscm->NIL*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) + kscm->args = kscm__cons(kscm, kscm__caar(kscm, x), kscm->args); + x = kscm__mk_closure(kscm, kscm__cons(kscm, kscm__reverse(kscm, kscm->args), kscm__cddr(kscm, kscm->code)), kscm->envir); + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm__car(kscm, kscm->code), x), kscm__car(kscm, kscm->envir)); + kscm->code = kscm__cddr(kscm, kscm->code); + kscm->args = kscm->NIL; + } + else { + kscm->code = kscm__cdr(kscm, kscm->code); + kscm->args = kscm->NIL; + } + kscm__s_goto(kscm, KSCM_OP_BEGIN); + + case KSCM_OP_LET0AST: /* let* */ + if (kscm__car(kscm, kscm->code) == kscm->NIL) { + kscm->envir = kscm__cons(kscm, kscm->NIL, kscm->envir); + kscm->code = kscm__cdr(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_BEGIN); + } + kscm__s_save(kscm, KSCM_OP_LET1AST, kscm__cdr(kscm, kscm->code), kscm__car(kscm, kscm->code)); + kscm->code = kscm__cadaar(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_LET1AST: /* let* (make new frame) */ + kscm->envir = kscm__cons(kscm, kscm->NIL, kscm->envir); + kscm__s_goto(kscm, KSCM_OP_LET2AST); + + case KSCM_OP_LET2AST: /* let* (caluculate parameters) */ + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm__caar(kscm, kscm->code), kscm->value), kscm__car(kscm, kscm->envir)); + kscm->code = kscm__cdr(kscm, kscm->code); + if (kscm__ispair(kscm, kscm->code)) { /* continue */ + kscm__s_save(kscm, KSCM_OP_LET2AST, kscm->args, kscm->code); + kscm->code = kscm__cadar(kscm, kscm->code); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + else { /* end */ + kscm->code = kscm->args; + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_BEGIN); + } + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; +} + + +kscm_object_t kscm__opexe_1(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y; + + switch (op) { + case KSCM_OP_LET0REC: /* letrec */ + kscm->envir = kscm__cons(kscm, kscm->NIL, kscm->envir); + kscm->args = kscm->NIL; + kscm->value = kscm->code; + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_LET1REC); + + case KSCM_OP_LET1REC: /* letrec (caluculate parameters) */ + kscm->args = kscm__cons(kscm, kscm->value, kscm->args); + if (kscm__ispair(kscm, kscm->code)) { /* continue */ + kscm__s_save(kscm, KSCM_OP_LET1REC, kscm->args, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__cadar(kscm, kscm->code); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + else { /* end */ + kscm->args = kscm__reverse(kscm, kscm->args); + kscm->code = kscm__car(kscm, kscm->args); + kscm->args = kscm__cdr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_LET2REC); + } + + case KSCM_OP_LET2REC: /* letrec */ + y = kscm->args; + for (x = kscm__car(kscm, kscm->code)/*, y = kscm->args*/; y != kscm->NIL; x = kscm__cdr(kscm, x)/*, y = kscm__cdr(kscm, y)*/) { + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm__caar(kscm, x), kscm__car(kscm, y)), kscm__car(kscm, kscm->envir)); + y = kscm__cdr(kscm, y); + } + kscm->code = kscm__cdr(kscm, kscm->code); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_BEGIN); + + case KSCM_OP_COND0: /* cond */ + if (!kscm__ispair(kscm, kscm->code)) { + kscm__error_0(kscm, "Syntax error in cond"); + } + kscm__s_save(kscm, KSCM_OP_COND1, kscm->NIL, kscm->code); + kscm->code = kscm__caar(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_COND1: /* cond */ + if (kscm__istrue(kscm, kscm->value)) { + if ((kscm->code = kscm__cdar(kscm, kscm->code)) == kscm->NIL) { + kscm__s_return(kscm, kscm->value); + } + kscm__s_goto(kscm, KSCM_OP_BEGIN); + } + else { + if ((kscm->code = kscm__cdr(kscm, kscm->code)) == kscm->NIL) { + kscm__s_return(kscm, kscm->NIL); + } + else { + kscm__s_save(kscm, KSCM_OP_COND1, kscm->NIL, kscm->code); + kscm->code = kscm__caar(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + } + + case KSCM_OP_DELAY: /* delay */ + x = kscm__mk_closure(kscm, kscm__cons(kscm, kscm->NIL, kscm->code), kscm->envir); + kscm__setpromise(kscm, x); + kscm__s_return(kscm, x); + + case KSCM_OP_AND0: /* and */ + if (kscm->code == kscm->NIL) { + kscm__s_return(kscm, kscm->T); + } + kscm__s_save(kscm, KSCM_OP_AND1, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_AND1: /* and */ + if (kscm__isfalse(kscm, kscm->value)) { + kscm__s_return(kscm, kscm->value); + } + else if (kscm->code == kscm->NIL) { + kscm__s_return(kscm, kscm->value); + } + else { + kscm__s_save(kscm, KSCM_OP_AND1, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + + case KSCM_OP_OR0: /* or */ + if (kscm->code == kscm->NIL) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_save(kscm, KSCM_OP_OR1, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_OR1: /* or */ + if (kscm__istrue(kscm, kscm->value)) { + kscm__s_return(kscm, kscm->value); + } + else if (kscm->code == kscm->NIL) { + kscm__s_return(kscm, kscm->value); + } + else { + kscm__s_save(kscm, KSCM_OP_OR1, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + + case KSCM_OP_C0STREAM: /* cons-stream */ + kscm__s_save(kscm, KSCM_OP_C1STREAM, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_C1STREAM: /* cons-stream */ + kscm->args = kscm->value; /* save value to register args for gc */ + x = kscm__mk_closure(kscm, kscm__cons(kscm, kscm->NIL, kscm->code), kscm->envir); + kscm__setpromise(kscm, x); + kscm__s_return(kscm, kscm__cons(kscm, kscm->args, x)); + +#ifdef KSCM_CONFIG_USE_MACRO + case KSCM_OP_0MACRO: /* macro */ + x = kscm__car(kscm, kscm->code); + kscm->code = kscm__cadr(kscm, kscm->code); + if (!kscm__issymbol(kscm, x)) { + kscm__error_0(kscm, "Variable is not symbol"); + } + kscm__s_save(kscm, KSCM_OP_1MACRO, kscm->NIL, x); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_1MACRO: /* macro */ + kscm__type(kscm, kscm->value) |= KSCM_T_MACRO; + for (x = kscm__car(kscm, kscm->envir); x != kscm->NIL; x = kscm__cdr(kscm, x)) + if (kscm__caar(kscm, x) == kscm->code) + break; + if (x != kscm->NIL) + kscm__cdar(kscm, x) = kscm->value; + else + kscm__car(kscm, kscm->envir) = kscm__cons(kscm, kscm__cons(kscm, kscm->code, kscm->value), kscm__car(kscm, kscm->envir)); + kscm__s_return(kscm, kscm->code); +#endif + + case KSCM_OP_CASE0: /* case */ + kscm__s_save(kscm, KSCM_OP_CASE1, kscm->NIL, kscm__cdr(kscm, kscm->code)); + kscm->code = kscm__car(kscm, kscm->code); + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_CASE1: /* case */ + for (x = kscm->code; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + if (!kscm__ispair(kscm, y = kscm__caar(kscm, x))) + break; + for (; y != kscm->NIL; y = kscm__cdr(kscm, y)) + if (kscm__eqv(kscm, kscm__car(kscm, y), kscm->value)) + break; + if (y != kscm->NIL) + break; + } + if (x != kscm->NIL) { + if (kscm__ispair(kscm, kscm__caar(kscm, x))) { + kscm->code = kscm__cdar(kscm, x); + kscm__s_goto(kscm, KSCM_OP_BEGIN); + } + else {/* else */ + kscm__s_save(kscm, KSCM_OP_CASE2, kscm->NIL, kscm__cdar(kscm, x)); + kscm->code = kscm__caar(kscm, x); + kscm__s_goto(kscm, KSCM_OP_EVAL); + } + } + else { + kscm__s_return(kscm, kscm->NIL); + } + + case KSCM_OP_CASE2: /* case */ + if (kscm__istrue(kscm, kscm->value)) { + kscm__s_goto(kscm, KSCM_OP_BEGIN); + } + else { + kscm__s_return(kscm, kscm->NIL); + } + case KSCM_OP_PAPPLY: /* apply */ + kscm->code = kscm__car(kscm, kscm->args); + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_APPLY); + + case KSCM_OP_PEVAL: /* eval */ + kscm->code = kscm__car(kscm, kscm->args); + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_EVAL); + + case KSCM_OP_CONTINUATION: /* call-with-current-continuation */ + kscm->code = kscm__car(kscm, kscm->args); + kscm->args = kscm__cons(kscm, kscm__mk_continuation(kscm, kscm->dump), kscm->NIL); + kscm__s_goto(kscm, KSCM_OP_APPLY); + + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; +} + + +kscm_object_t kscm__opexe_2(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y; +#ifdef KSCM_CONFIG_USE_PRECISE + int32_t v; +#else + register long v; +#endif + + switch (op) { + case KSCM_OP_ADD: /* + */ + v = 0; + for (x = kscm->args/*, v = 0*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + if (!kscm__isnumber(kscm, kscm__car(kscm, x))) { + kscm__s_retbool(kscm, 0); + } +#ifdef KSCM_CONFIG_USE_PRECISE + int64_t lv = ((int64_t)v) + ((int64_t)kscm__ivalue(kscm, kscm__car(kscm, x))); + v = (int32_t)lv; + if (((int64_t)v) != lv) { + kscm__s_retbool(kscm, 0); + } +#else + v += kscm__ivalue(kscm, kscm__car(kscm, x)); +#endif + } + kscm__s_return(kscm, kscm__mk_number(kscm, v)); + + case KSCM_OP_SUB: /* - */ + v = v = kscm__ivalue(kscm, kscm__car(kscm, kscm->args)); + for (x = kscm__cdr(kscm, kscm->args)/*, v = kscm__ivalue(kscm, kscm__car(kscm, kscm->args))*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + if (!kscm__isnumber(kscm, kscm__car(kscm, x))) { + kscm__s_retbool(kscm, 0); + } +#ifdef KSCM_CONFIG_USE_PRECISE + int64_t lv = ((int64_t)v) - ((int64_t)kscm__ivalue(kscm, kscm__car(kscm, x))); + v = (int32_t)lv; + if (((int64_t)v) != lv) { + kscm__s_retbool(kscm, 0); + } +#else + v -= kscm__ivalue(kscm, kscm__car(kscm, x)); +#endif + } + kscm__s_return(kscm, kscm__mk_number(kscm, v)); + + case KSCM_OP_MUL: /* * */ + v = 1; + for (x = kscm->args/*, v = 1*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + if (!kscm__isnumber(kscm, kscm__car(kscm, x))) { + kscm__s_retbool(kscm, 0); + } +#ifdef KSCM_CONFIG_USE_PRECISE + int64_t lv = ((int64_t)v) * ((int64_t)kscm__ivalue(kscm, kscm__car(kscm, x))); + v = (int32_t)lv; + if (((int64_t)v) != lv) { + kscm__s_retbool(kscm, 0); + } +#else + v *= kscm__ivalue(kscm, kscm__car(kscm, x)); +#endif + } + kscm__s_return(kscm, kscm__mk_number(kscm, v)); + + case KSCM_OP_DIV: /* / */ + v = kscm__ivalue(kscm, kscm__car(kscm, kscm->args)); + for (x = kscm__cdr(kscm, kscm->args)/*, v = kscm__ivalue(kscm, kscm__car(kscm, kscm->args))*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + if (!kscm__isnumber(kscm, kscm__car(kscm, x))) { + kscm__s_retbool(kscm, 0); + } + if (kscm__ivalue(kscm, kscm__car(kscm, x)) != 0) + v /= kscm__ivalue(kscm, kscm__car(kscm, x)); + else { +#ifdef KSCM_CONFIG_USE_PRECISE + kscm__s_retbool(kscm, 0); +#else + kscm__error_0(kscm, "Divided by zero"); +#endif + } + } + kscm__s_return(kscm, kscm__mk_number(kscm, v)); + + case KSCM_OP_REM: /* remainder */ + v = kscm__ivalue(kscm, kscm__car(kscm, kscm->args)); + for (x = kscm__cdr(kscm, kscm->args)/*, v = kscm__ivalue(kscm, kscm__car(kscm, kscm->args))*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) { + if (!kscm__isnumber(kscm, kscm__car(kscm, x))) { + kscm__s_retbool(kscm, 0); + } + if (kscm__ivalue(kscm, kscm__car(kscm, x)) != 0) + v %= kscm__ivalue(kscm, kscm__car(kscm, x)); + else { +#ifdef KSCM_CONFIG_USE_PRECISE + kscm__s_retbool(kscm, 0); +#else + kscm__error_0(kscm, "Divided by zero"); +#endif + } + } + kscm__s_return(kscm, kscm__mk_number(kscm, v)); + + case KSCM_OP_CAR: /* car */ + if (kscm__ispair(kscm, kscm__car(kscm, kscm->args))) { + kscm__s_return(kscm, kscm__caar(kscm, kscm->args)); + } + else { + kscm__error_0(kscm, "Unable to car for non-cons cell"); + } + + case KSCM_OP_CDR: /* cdr */ + if (kscm__ispair(kscm, kscm__car(kscm, kscm->args))) { + kscm__s_return(kscm, kscm__cdar(kscm, kscm->args)); + } + else { + kscm__error_0(kscm, "Unable to cdr for non-cons cell"); + } + + case KSCM_OP_CONS: /* cons */ + kscm__cdr(kscm, kscm->args) = kscm__cadr(kscm, kscm->args); + kscm__s_return(kscm, kscm->args); + + case KSCM_OP_SETCAR: /* set-car! */ + if (kscm__ispair(kscm, kscm__car(kscm, kscm->args))) { + kscm__caar(kscm, kscm->args) = kscm__cadr(kscm, kscm->args); + kscm__s_return(kscm, kscm__car(kscm, kscm->args)); + } + else { + kscm__error_0(kscm, "Unable to set-car! for non-cons cell"); + } + + case KSCM_OP_SETCDR: /* set-cdr! */ + if (kscm__ispair(kscm, kscm__car(kscm, kscm->args))) { + kscm__cdar(kscm, kscm->args) = kscm__cadr(kscm, kscm->args); + kscm__s_return(kscm, kscm__car(kscm, kscm->args)); + } + else { + kscm__error_0(kscm, "Unable to set-cdr! for non-cons cell"); + } + + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; +} + + +kscm_object_t kscm__opexe_3(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y; + + switch (op) { + case KSCM_OP_NOT: /* not */ + kscm__s_retbool(kscm, kscm__isfalse(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_BOOL: /* boolean? */ + kscm__s_retbool(kscm, kscm__car(kscm, kscm->args) == kscm->F || kscm__car(kscm, kscm->args) == kscm->T); + case KSCM_OP_NULL: /* null? */ + kscm__s_retbool(kscm, kscm__car(kscm, kscm->args) == kscm->NIL); + case KSCM_OP_ZEROP: /* zero? */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) == 0); + case KSCM_OP_POSP: /* positive? */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) > 0); + case KSCM_OP_NEGP: /* negative? */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) < 0); + case KSCM_OP_NEQ: /* = */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) == kscm__ivalue(kscm, kscm__cadr(kscm, kscm->args))); + case KSCM_OP_LESS: /* < */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) < kscm__ivalue(kscm, kscm__cadr(kscm, kscm->args))); + case KSCM_OP_GRE: /* > */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) > kscm__ivalue(kscm, kscm__cadr(kscm, kscm->args))); + case KSCM_OP_LEQ: /* <= */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) <= kscm__ivalue(kscm, kscm__cadr(kscm, kscm->args))); + case KSCM_OP_GEQ: /* >= */ + kscm__s_retbool(kscm, kscm__ivalue(kscm, kscm__car(kscm, kscm->args)) >= kscm__ivalue(kscm, kscm__cadr(kscm, kscm->args))); + case KSCM_OP_SYMBOL: /* symbol? */ + kscm__s_retbool(kscm, kscm__issymbol(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_NUMBER: /* number? */ + kscm__s_retbool(kscm, kscm__isnumber(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_STRING: /* string? */ + kscm__s_retbool(kscm, kscm__isstring(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_PROC: /* procedure? */ + /*-- + * continuation should be procedure by the example + * (call-with-current-continuation procedure?) ==> #t + * in R^3 report sec. 6.9 + */ + kscm__s_retbool(kscm, kscm__isproc(kscm, kscm__car(kscm, kscm->args)) || kscm__isclosure(kscm, kscm__car(kscm, kscm->args)) + || kscm__iscontinuation(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_PAIR: /* pair? */ + kscm__s_retbool(kscm, kscm__ispair(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_EQ: /* eq? */ + kscm__s_retbool(kscm, kscm__car(kscm, kscm->args) == kscm__cadr(kscm, kscm->args)); + case KSCM_OP_EQV: /* eqv? */ + kscm__s_retbool(kscm, kscm__eqv(kscm, kscm__car(kscm, kscm->args), kscm__cadr(kscm, kscm->args))); + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; +} + + +kscm_object_t kscm__opexe_4(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y; + + switch (op) { + case KSCM_OP_FORCE: /* force */ + kscm->code = kscm__car(kscm, kscm->args); + if (kscm__ispromise(kscm, kscm->code)) { + kscm->args = kscm->NIL; + kscm__s_goto(kscm, KSCM_OP_APPLY); + } + else { + kscm__s_return(kscm, kscm->code); + } + + case KSCM_OP_WRITE: /* write */ + kscm->print_flag = 1; + kscm->args = kscm__car(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + + case KSCM_OP_DISPLAY: /* display */ + kscm->print_flag = 0; + kscm->args = kscm__car(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + + case KSCM_OP_NEWLINE: /* newline */ + fprintf(kscm->outfp, "\n"); + kscm__s_return(kscm, kscm->T); + + case KSCM_OP_ERR0: /* error */ + if (!kscm__isstring(kscm, kscm__car(kscm, kscm->args))) { + kscm__error_0(kscm, "error -- first argument must be string"); + } + kscm->tmpfp = kscm->outfp; + kscm->outfp = stderr; + if (kscm->all_errors_fatal) { + kscm__fatal_error(kscm, kscm__strvalue(kscm, kscm__car(kscm, kscm->args)), NULL, NULL, NULL); + } + fprintf(kscm->outfp, "Error: "); + fprintf(kscm->outfp, "%s", kscm__strvalue(kscm, kscm__car(kscm, kscm->args))); + kscm->args = kscm__cdr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_ERR1); + + case KSCM_OP_ERR1: /* error */ + fprintf(kscm->outfp, " "); + if (kscm->args != kscm->NIL) { + kscm__s_save(kscm, KSCM_OP_ERR1, kscm__cdr(kscm, kscm->args), kscm->NIL); + kscm->args = kscm__car(kscm, kscm->args); + kscm->print_flag = 1; + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + else { + fprintf(kscm->outfp, "\n"); + kscm__resetinput(kscm); + kscm->outfp = kscm->tmpfp; + kscm__s_goto(kscm, KSCM_OP_T0LVL); + } + + case KSCM_OP_REVERSE: /* reverse */ + kscm__s_return(kscm, kscm__reverse(kscm, kscm__car(kscm, kscm->args))); + + case KSCM_OP_APPEND: /* append */ + kscm__s_return(kscm, kscm__append(kscm, kscm__car(kscm, kscm->args), kscm__cadr(kscm, kscm->args))); + + case KSCM_OP_PUT: /* put */ + if (!kscm__hasprop(kscm, kscm__car(kscm, kscm->args)) || !kscm__hasprop(kscm, kscm__cadr(kscm, kscm->args))) { + kscm__error_0(kscm, "Illegal use of put"); + } + y = kscm__cadr(kscm, kscm->args); + for (x = kscm__symprop(kscm, kscm__car(kscm, kscm->args))/*, y = kscm__cadr(kscm, kscm->args)*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) + if (kscm__caar(kscm, x) == y) + break; + if (x != kscm->NIL) + kscm__cdar(kscm, x) = kscm__caddr(kscm, kscm->args); + else + kscm__symprop(kscm, kscm__car(kscm, kscm->args)) = kscm__cons(kscm, kscm__cons(kscm, y, kscm__caddr(kscm, kscm->args)), + kscm__symprop(kscm, kscm__car(kscm, kscm->args))); + kscm__s_return(kscm, kscm->T); + + case KSCM_OP_GET: /* get */ + if (!kscm__hasprop(kscm, kscm__car(kscm, kscm->args)) || !kscm__hasprop(kscm, kscm__cadr(kscm, kscm->args))) { + kscm__error_0(kscm, "Illegal use of get"); + } + y = kscm__cadr(kscm, kscm->args); + for (x = kscm__symprop(kscm, kscm__car(kscm, kscm->args))/*, y = kscm__cadr(kscm, kscm->args)*/; x != kscm->NIL; x = kscm__cdr(kscm, x)) + if (kscm__caar(kscm, x) == y) + break; + if (x != kscm->NIL) { + kscm__s_return(kscm, kscm__cdar(kscm, x)); + } + else { + kscm__s_return(kscm, kscm->NIL); + } + + case KSCM_OP_QUIT: /* quit */ + return (kscm->NIL); + + case KSCM_OP_GC: /* gc */ + kscm__gc(kscm, kscm->NIL, kscm->NIL); + kscm__s_return(kscm, kscm->T); + + case KSCM_OP_GCVERB: /* gc-verbose */ + { int was = kscm->gc_verbose; + + kscm->gc_verbose = (kscm__car(kscm, kscm->args) != kscm->F); + kscm__s_retbool(kscm, was); + } + + case KSCM_OP_NEWSEGMENT: /* new-segment */ + if (!kscm__isnumber(kscm, kscm__car(kscm, kscm->args))) { + kscm__error_0(kscm, "new-segment -- argument must be number"); + } + fprintf(kscm->outfp, "allocate %d new segments\n", + kscm__alloc_cellseg(kscm, (int)kscm__ivalue(kscm, kscm__car(kscm, kscm->args)))); + kscm__s_return(kscm, kscm->T); + } +} + + +kscm_object_t kscm__opexe_5(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y; + + switch (op) { + /* ========== reading part ========== */ + case KSCM_OP_RDSEXPR: + switch (kscm->tok) { + case KSCM_TOK_COMMENT: + while (kscm__inchar(kscm) != '\n') + ; + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + case KSCM_TOK_LPAREN: + kscm->tok = kscm__token(kscm); + if (kscm->tok == KSCM_TOK_RPAREN) { + kscm__s_return(kscm, kscm->NIL); + } + else if (kscm->tok == KSCM_TOK_DOT) { + kscm__error_0(kscm, "syntax error -- illegal dot expression"); + } + else { + kscm__s_save(kscm, KSCM_OP_RDLIST, kscm->NIL, kscm->NIL); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + } + case KSCM_TOK_QUOTE: + kscm__s_save(kscm, KSCM_OP_RDQUOTE, kscm->NIL, kscm->NIL); + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); +#ifdef KSCM_CONFIG_USE_QQUOTE + case KSCM_TOK_BQUOTE: + kscm__s_save(kscm, KSCM_OP_RDQQUOTE, kscm->NIL, kscm->NIL); + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + case KSCM_TOK_COMMA: + kscm__s_save(kscm, KSCM_OP_RDUNQUOTE, kscm->NIL, kscm->NIL); + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + case KSCM_TOK_ATMARK: + kscm__s_save(kscm, KSCM_OP_RDUQTSP, kscm->NIL, kscm->NIL); + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); +#endif + case KSCM_TOK_ATOM: + kscm__s_return(kscm, kscm__mk_atom(kscm, kscm__readstr(kscm, "();\t\n "))); + case KSCM_TOK_DQUOTE: + kscm__s_return(kscm, kscm__mk_string(kscm, kscm__readstrexp(kscm))); + case KSCM_TOK_SHARP: + if ((x = kscm__mk_const(kscm, kscm__readstr(kscm, "();\t\n "))) == kscm->NIL) { + kscm__error_0(kscm, "Undefined sharp expression"); + } + else { + kscm__s_return(kscm, x); + } + default: + kscm__error_0(kscm, "syntax error -- illegal token"); + } + break; + + case KSCM_OP_RDLIST: + kscm->args = kscm__cons(kscm, kscm->value, kscm->args); + kscm->tok = kscm__token(kscm); + if (kscm->tok == KSCM_TOK_COMMENT) { + while (kscm__inchar(kscm) != '\n') + ; + kscm->tok = kscm__token(kscm); + } + if (kscm->tok == KSCM_TOK_RPAREN) { + kscm__s_return(kscm, kscm__non_alloc_rev(kscm, kscm->NIL, kscm->args)); + } + else if (kscm->tok == KSCM_TOK_DOT) { + kscm__s_save(kscm, KSCM_OP_RDDOT, kscm->args, kscm->NIL); + kscm->tok = kscm__token(kscm); + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + } + else { + kscm__s_save(kscm, KSCM_OP_RDLIST, kscm->args, kscm->NIL);; + kscm__s_goto(kscm, KSCM_OP_RDSEXPR); + } + + case KSCM_OP_RDDOT: + if (kscm__token(kscm) != KSCM_TOK_RPAREN) { + kscm__error_0(kscm, "syntax error -- illegal dot expression"); + } + else { + kscm__s_return(kscm, kscm__non_alloc_rev(kscm, kscm->value, kscm->args)); + } + + case KSCM_OP_RDQUOTE: + kscm__s_return(kscm, kscm__cons(kscm, kscm->QUOTE, kscm__cons(kscm, kscm->value, kscm->NIL))); + +#ifdef KSCM_CONFIG_USE_QQUOTE + case KSCM_OP_RDQQUOTE: + kscm__s_return(kscm, kscm__cons(kscm, kscm->QQUOTE, kscm__cons(kscm, kscm->value, kscm->NIL))); + + case KSCM_OP_RDUNQUOTE: + kscm__s_return(kscm, kscm__cons(kscm, kscm->UNQUOTE, kscm__cons(kscm, kscm->value, kscm->NIL))); + + case KSCM_OP_RDUQTSP: + kscm__s_return(kscm, kscm__cons(kscm, kscm->UNQUOTESP, kscm__cons(kscm, kscm->value, kscm->NIL))); +#endif + + /* ========== printing part ========== */ + case KSCM_OP_P0LIST: + if (!kscm__ispair(kscm, kscm->args)) { + kscm__printatom(kscm, kscm->args, kscm->print_flag); + kscm__s_return(kscm, kscm->T); + } + else if (kscm__car(kscm, kscm->args) == kscm->QUOTE && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + fprintf(kscm->outfp, "'"); + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + else if (kscm__car(kscm, kscm->args) == kscm->QQUOTE && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + fprintf(kscm->outfp, "`"); + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + else if (kscm__car(kscm, kscm->args) == kscm->UNQUOTE && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + fprintf(kscm->outfp, ","); + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + else if (kscm__car(kscm, kscm->args) == kscm->UNQUOTESP && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + fprintf(kscm->outfp, ",@"); + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + else { + fprintf(kscm->outfp, "("); + kscm__s_save(kscm, KSCM_OP_P1LIST, kscm__cdr(kscm, kscm->args), kscm->NIL); + kscm->args = kscm__car(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + + case KSCM_OP_P1LIST: + if (kscm__ispair(kscm, kscm->args)) { + kscm__s_save(kscm, KSCM_OP_P1LIST, kscm__cdr(kscm, kscm->args), kscm->NIL); + fprintf(kscm->outfp, " "); + kscm->args = kscm__car(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0LIST); + } + else { + if (kscm->args != kscm->NIL) { + fprintf(kscm->outfp, " . "); + kscm__printatom(kscm, kscm->args, kscm->print_flag); + } + fprintf(kscm->outfp, ")"); + kscm__s_return(kscm, kscm->T); + } + + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + + } + return kscm->T; +} + + +kscm_object_t kscm__opexe_6(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y; + register long v; + static long w; + char buffer[32]; + + switch (op) { + case KSCM_OP_LIST_LENGTH: /* list-length */ /* a.k */ + v = 0; + for (x = kscm__car(kscm, kscm->args)/*, v = 0*/; kscm__ispair(kscm, x); x = kscm__cdr(kscm, x)) + ++v; + kscm__s_return(kscm, kscm__mk_number(kscm, v)); + + case KSCM_OP_ASSQ: /* assq */ /* a.k */ + x = kscm__car(kscm, kscm->args); + for (y = kscm__cadr(kscm, kscm->args); kscm__ispair(kscm, y); y = kscm__cdr(kscm, y)) { + if (!kscm__ispair(kscm, kscm__car(kscm, y))) { + kscm__error_0(kscm, "Unable to handle non pair element"); + } + if (x == kscm__caar(kscm, y)) + break; + } + if (kscm__ispair(kscm, y)) { + kscm__s_return(kscm, kscm__car(kscm, y)); + } + else { + kscm__s_return(kscm, kscm->F); + } + + case KSCM_OP_PRINT_WIDTH: /* print-width */ /* a.k */ + w = 0; + kscm->args = kscm__car(kscm, kscm->args); + kscm->print_flag = -1; + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + + case KSCM_OP_P0_WIDTH: + if (!kscm__ispair(kscm, kscm->args)) { + w += kscm__printatom(kscm, kscm->args, kscm->print_flag); + kscm__s_return(kscm, kscm__mk_number(kscm, w)); + } + else if (kscm__car(kscm, kscm->args) == kscm->QUOTE + && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + ++w; + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + } + else if (kscm__car(kscm, kscm->args) == kscm->QQUOTE + && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + ++w; + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + } + else if (kscm__car(kscm, kscm->args) == kscm->UNQUOTE + && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + ++w; + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + } + else if (kscm__car(kscm, kscm->args) == kscm->UNQUOTESP + && kscm__ok_abbrev(kscm, kscm__cdr(kscm, kscm->args))) { + w += 2; + kscm->args = kscm__cadr(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + } + else { + ++w; + kscm__s_save(kscm, KSCM_OP_P1_WIDTH, kscm__cdr(kscm, kscm->args), kscm->NIL); + kscm->args = kscm__car(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + } + + case KSCM_OP_P1_WIDTH: + if (kscm__ispair(kscm, kscm->args)) { + kscm__s_save(kscm, KSCM_OP_P1_WIDTH, kscm__cdr(kscm, kscm->args), kscm->NIL); + ++w; + kscm->args = kscm__car(kscm, kscm->args); + kscm__s_goto(kscm, KSCM_OP_P0_WIDTH); + } + else { + if (kscm->args != kscm->NIL) + w += 3 + kscm__printatom(kscm, kscm->args, kscm->print_flag); + ++w; + kscm__s_return(kscm, kscm__mk_number(kscm, w)); + } + + case KSCM_OP_GET_CLOSURE: /* get-closure-code */ /* a.k */ + kscm->args = kscm__car(kscm, kscm->args); + if (kscm->args == kscm->NIL) { + kscm__s_return(kscm, kscm->F); + } + else if (kscm__isclosure(kscm, kscm->args)) { + kscm__s_return(kscm, kscm__cons(kscm, kscm->LAMBDA, kscm__closure_code(kscm, kscm->value))); +#ifdef KSCM_CONFIG_USE_MACRO + } + else if (kscm__ismacro(kscm, kscm->args)) { + kscm__s_return(kscm, kscm__cons(kscm, kscm->LAMBDA, kscm__closure_code(kscm, kscm->value))); +#endif + } + else { + kscm__s_return(kscm, kscm->F); + } + case KSCM_OP_CLOSUREP: /* closure? */ + /* + * Note, macro object is also a closure. + * Therefore, (closure? <#MACRO>) ==> #t + */ + if (kscm__car(kscm, kscm->args) == kscm->NIL) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_retbool(kscm, kscm__isclosure(kscm, kscm__car(kscm, kscm->args))); +#ifdef KSCM_CONFIG_USE_MACRO + case KSCM_OP_MACROP: /* macro? */ + if (kscm__car(kscm, kscm->args) == kscm->NIL) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_retbool(kscm, kscm__ismacro(kscm, kscm__car(kscm, kscm->args))); +#endif + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; /* NOTREACHED */ +} + +#ifdef KSCM_CONFIG_USE_PERSIST +unsigned int kscm_get_persistent_address(kscm_t* kscm, kscm_object_t obj) { + int i; + if (obj == kscm->NIL) { + return 0; + } else if (obj == kscm->F) { + return 1; + } else if (obj == kscm->T) { + return 2; + } + + uintptr_t addr = (uintptr_t)obj; + //fprintf(stderr, "addr is %d\n", addr); + for (i = 0; i <= kscm->last_cell_seg; i++) { + uintptr_t segaddr = (uintptr_t)(kscm->cell_seg[i]); + //fprintf(stderr, "segaddr %d is %d\n", i, segaddr); + if (segaddr != 0 && addr >= segaddr && addr < segaddr + (KSCM_CONFIG_CELL_SEGSIZE * sizeof(struct kscm_cell))) { + //fprintf(stderr, "it's in here!\n"); + int segment = i + 1; + uintptr_t offset = addr - segaddr; + if ((offset % sizeof(struct kscm_cell))) { + return -1; + } + int index = offset / sizeof(struct kscm_cell); + return (segment * KSCM_CONFIG_CELL_SEGSIZE) + index; + } + } + + return -1; +} +int kscm__fwrite_byte(kscm_t* kscm, FILE* f, char val) { + fputc(val, f); + return 1; +} +int kscm__fwrite_int(kscm_t* kscm, FILE* f, int val) { + //fprintf(stderr, "writing %x %x %x %x\n", val & 0xFF, (val >> 8) & 0xFF, (val >> 16) & 0xFF, (val >> 24) & 0xFF); + fputc((val & 0xFF), f); + fputc(((val >> 8) & 0xFF), f); + fputc(((val >> 16) & 0xFF), f); + fputc(((val >> 24) & 0xFF), f); + return 4; +} +int kscm__fwrite_strl(kscm_t* kscm, FILE* f, const char* str, int len) { + if (str == NULL) { + return kscm__fwrite_int(kscm, f, 0); + } + int written = kscm__fwrite_int(kscm, f, len); + if (written != 4) { + return written; + } + int i; + for (i = 0; i < len; i++) { + fputc(str[i], f); + written++; + } + return written; +} +int kscm__fwrite_str(kscm_t* kscm, FILE* f, const char* str) { + return kscm__fwrite_strl(kscm, f, str, strlen(str)); +} + +int kscm_save_state(kscm_t* kscm, const char* filename, const char* opts) { + if (filename == NULL || strlen(filename) < 1) { + fprintf(stderr, "Filename expected\n"); + return -1; + } + FILE* f = fopen(filename, "wb"); + if (f == NULL) { + fprintf(stderr, "Failed to open '%s' for writing\n", filename); + return -1; // Not saved + } + fprintf(stderr, "Saving state to '%s' opts '%s'...\n", filename, opts); + + kscm__fwrite_str(kscm, f, KSCM_CONFIG_PERSIST_MAGIC); + //fclose(f); if (1) return 0; + kscm__fwrite_int(kscm, f, KSCM_CONFIG_PERSIST_VERSION); + + // Bytes per id (higher bits may be reused later for flags) + kscm__fwrite_int(kscm, f, kscm->_stateformat); + + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->NIL)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->F)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->T)); + + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->oblist)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->global_env)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->LAMBDA)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->QUOTE)); + + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->QQUOTE)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->UNQUOTE)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->UNQUOTESP)); + + /* NOTE: The format has been reorganised (as of "version 2" of the format) to allow for + * multithreading, which isn't supported on this implementation, but now thread-specific + * data is stored separately. + */ + /* Begin by writing the number of threads (always 1, for now). */ + kscm__fwrite_int(kscm, f, 1); + kscm__fwrite_int(kscm, f, kscm->_threadstate); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->_threadname)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->_threadopts)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->_threadobject)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->args)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->envir)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->code)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->dump)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->value)); + kscm__fwrite_int(kscm, f, kscm->_operator); + + //fprintf(stderr, "Persistent addresses: ->T=%d ->F=%d ->NIL=%d\n", kscm_get_persistent_address(kscm, kscm->T), kscm_get_persistent_address(kscm, kscm->F), kscm_get_persistent_address(kscm, kscm->NIL)); + + //fprintf(stderr, "Persistent addresses: ->args=%d ->envir=%d ->code=%d ->dump=%d\n", kscm_get_persistent_address(kscm, kscm->args), kscm_get_persistent_address(kscm, kscm->envir), kscm_get_persistent_address(kscm, kscm->code), kscm_get_persistent_address(kscm, kscm->dump)); + + int s; + for (s = 0; s <= kscm->last_cell_seg; s++) { + fprintf(stderr, "."); + int i; + for (i = 0; i < KSCM_CONFIG_CELL_SEGSIZE; i++) { + kscm_object_t obj = (kscm->cell_seg[s])+i;//&(kscm->cell_seg[s][i]); + if (obj->_flag == 0) { // free ? + //fprintf(stderr, "Object at %d:%d is free\n", s, i); + } + else { + fprintf(stderr, "Object at %d:%d is non-free\n", s, i); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, obj)); + if (kscm__isnumber(kscm, obj)) { + if (!kscm__isatom(kscm, obj)) { + fprintf(stderr, "int isn't atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TINT32); + kscm__fwrite_int(kscm, f, kscm__ivalue(kscm, obj)); + } + else if (kscm__issymbol(kscm, obj)) { + if (kscm__isatom(kscm, obj)) { + fprintf(stderr, "symbol is atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, kscm__issyntax(kscm, obj) ? KSCM_PERSIST_TSYNTAX : KSCM_PERSIST_TSYMBOL); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__car(kscm, obj))); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__cdr(kscm, obj))); + } + else if (kscm__isstring(kscm, obj)) { + if (!kscm__isatom(kscm, obj)) { + fprintf(stderr, "string isn't atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TSTRING); + kscm__fwrite_int(kscm, f, obj->_object._string._keynum); + kscm__fwrite_str(kscm, f, kscm__strvalue(kscm, obj)); + } + else if (kscm__ispair(kscm, obj)) { + if (kscm__isatom(kscm, obj)) { + fprintf(stderr, "pair is atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TPAIR); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__car(kscm, obj))); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__cdr(kscm, obj))); + } + else if (kscm__isproc(kscm, obj)) { + if (!kscm__isatom(kscm, obj)) { + fprintf(stderr, "proc isn't atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TPROC); + kscm__fwrite_int(kscm, f, kscm__ivalue(kscm, obj)); + } + else if (kscm__isclosure(kscm, obj)) { + if (kscm__isatom(kscm, obj)) { + fprintf(stderr, "closure is atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TCLOSURE); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__car(kscm, obj))); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__cdr(kscm, obj))); + } + else if (kscm__iscontinuation(kscm, obj)) { + if (kscm__isatom(kscm, obj)) { + fprintf(stderr, "closure is atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TCONTINUATION); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__car(kscm, obj))); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__cdr(kscm, obj))); + } +#ifdef KSCM_CONFIG_USE_STRUCTS + else if (kscm__isabstraction(kscm, obj)) { + if (kscm__isatom(kscm, obj)) { + fprintf(stderr, "abstraction is atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TABSTRACTION); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__car(kscm, obj))); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm__cdr(kscm, obj))); + } + else if (kscm__isbuffer(kscm, obj)) { + if (!kscm__isatom(kscm, obj)) { + fprintf(stderr, "buffer isn't atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TBUFFER); + kscm__fwrite_strl(kscm, f, (const char*)(obj->_object._buffer._data), obj->_object._buffer._length); + } +#endif +#ifdef KSCM_CONFIG_USE_FLOATS + else if (kscm__isfloat64(kscm, obj)) { + double tmp = obj->_object._float64._dvalue; + char* bytes = (char*)(void*)(&tmp) /*obj->_object._float64._dvalue*/; + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TFLOAT64); + // NOTE: This assumes floating-point endian is the same on all platforms + kscm__fwrite_byte(kscm, f, bytes[0]); + kscm__fwrite_byte(kscm, f, bytes[1]); + kscm__fwrite_byte(kscm, f, bytes[2]); + kscm__fwrite_byte(kscm, f, bytes[3]); + kscm__fwrite_byte(kscm, f, bytes[4]); + kscm__fwrite_byte(kscm, f, bytes[5]); + kscm__fwrite_byte(kscm, f, bytes[6]); + kscm__fwrite_byte(kscm, f, bytes[7]); + } +#endif +#ifdef KSCM_CONFIG_USE_OBJECTS + else if (kscm__isobjx(kscm, obj)) { + if (kscm__isatom(kscm, obj)) { + fprintf(stderr, "object is atom\n"); + exit(-1); + } + kscm__fwrite_byte(kscm, f, KSCM_PERSIST_TOBJX); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, obj->_object._objx._type)); + kscm__fwrite_int(kscm, f, obj->_object._objx._count); + int i; + for (i = 0; i < obj->_object._objx._count; i++) { + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, obj->_object._objx._elements[i])); + } + } +#endif + else { + fprintf(stderr, "Object at %d:%d is non-free but unknown type: %d\n", s, i, obj->_flag); + return -1; // Not saved + } + } + } + } + + kscm__fwrite_int(kscm, f, 0); // Zero address to indicate end of objects + kscm__fwrite_int(kscm, f, 0); // Additional zero to indicate no additional data (may be extended in future versions) + fclose(f); + + fprintf(stderr, "\n"); + + return 0; // Saved +} + +int kscm__fread_byte(kscm_t* kscm, FILE* f, char* result) { + int r = fgetc(f); + *result = r; + return 1; +} +int kscm__fread_int(kscm_t* kscm, FILE* f, int* result) { + *result = 0; + *result |= (fgetc(f) & 0xff); + *result |= (fgetc(f) & 0xff) << 8; + *result |= (fgetc(f) & 0xff) << 16; + *result |= (fgetc(f) & 0xff) << 24; + return 4; +} +int kscm__fread_str(kscm_t* kscm, FILE* f, const char** result) { + int len; + if (kscm__fread_int(kscm, f, &len) != 4) { + *result = NULL; + return 0; + } + //fprintf(stderr, "Got length %d\n", len); + if (len > 1000) { + *result = NULL; + return 0; + } + *result = (const char*) calloc(len + 1, 1); + if (*result == NULL) { + return 0; + } + int i; + for (i = 0; i < len; i++) { + ((* (char**)result)[i]) = (char)fgetc(f); + } + return len; +} + +kscm_object_t kscm_get_object_address(kscm_t* kscm, int persistent_address) { + if (persistent_address == 0) { + return kscm->NIL; + } else if (persistent_address == 1) { + return kscm->F; + } else if (persistent_address == 2) { + return kscm->T; + } + int idx = persistent_address % KSCM_CONFIG_CELL_SEGSIZE; + int segnum = persistent_address / KSCM_CONFIG_CELL_SEGSIZE; + if (segnum < 1) { + return NULL; + } + segnum--; + if (segnum >= KSCM_CONFIG_CELL_NSEGMENT) { + return NULL; + } + while (segnum > kscm->last_cell_seg) { + kscm->last_cell_seg++; + kscm->cell_seg[kscm->last_cell_seg] = (kscm_object_t) calloc(KSCM_CONFIG_CELL_SEGSIZE, sizeof(struct kscm_cell)); + } + return kscm->cell_seg[segnum] + idx; //&kscm->cell_seg[segnum][idx]; +} + +int kscm_resume_state(kscm_t* kscm, const char* filename, const char* opts) { + if (filename == NULL || strlen(filename) < 1) { + fprintf(stderr, "Filename expected\n"); + return -1; + } + FILE* f = fopen(filename, "rb"); + if (f == NULL) { + fprintf(stderr, "Failed to open '%s' for reading\n", filename); + return -1; // Not saved + } + fprintf(stderr, "Reading state from '%s' opts '%s'...\n", filename, opts); + + const char* tmpstr; + int tmpint; + kscm__fread_str(kscm, f, &tmpstr); + + if (tmpstr == NULL || strcmp(tmpstr, KSCM_CONFIG_PERSIST_MAGIC) != 0) { + fprintf(stderr, "Failed to read '%s': Bad magic string\n", filename); + free((void*)tmpstr); + return -1; + } + free((void*)tmpstr); + kscm__fread_int(kscm, f, &tmpint); + if (tmpint != KSCM_CONFIG_PERSIST_VERSION) { + fprintf(stderr, "Failed to read '%s': Bad version number, expected %d but got %d\n", filename, KSCM_CONFIG_PERSIST_VERSION, tmpint); + return -1; + } + kscm__fread_int(kscm, f, &tmpint); + if (tmpint != 4) { + fprintf(stderr, "Failed to read '%s': Bad format options, expected 4 but got %d\n", filename, tmpint); + return -1; + } + kscm->_stateformat = tmpint; + kscm__fread_int(kscm, f, &tmpint); + if (tmpint != 0) { + fprintf(stderr, "Failed to read '%s': Bad NIL index, expected %d but got %d\n", filename, 0, tmpint); + return -1; + } + kscm__fread_int(kscm, f, &tmpint); + if (tmpint != 1) { + fprintf(stderr, "Failed to read '%s': Bad F index, expected %d but got %d\n", filename, 1, tmpint); + return -1; + } + kscm__fread_int(kscm, f, &tmpint); + if (tmpint != 2) { + fprintf(stderr, "Failed to read '%s': Bad T index, expected %d but got %d\n", filename, 2, tmpint); + return -1; + } + + kscm__fread_int(kscm, f, &tmpint); + kscm->oblist = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->global_env = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->LAMBDA = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->QUOTE = kscm_get_object_address(kscm, tmpint); + + kscm__fread_int(kscm, f, &tmpint); + kscm->QQUOTE = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->UNQUOTE = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->UNQUOTESP = kscm_get_object_address(kscm, tmpint); + + kscm__fread_int(kscm, f, &tmpint); + if (tmpint != 1) { + fprintf(stderr, "Failed to read '%s': Bad number of threads, this VM only supports 1 thread but got %d\n", filename, tmpint); + return -1; + } + /* + + kscm__fwrite_int(kscm, f, 1); + kscm__fwrite_int(kscm, f, kscm->_threadstate); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->_threadname)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->_threadopts)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->_threadobject)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->args)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->envir)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->code)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->dump)); + kscm__fwrite_int(kscm, f, kscm_get_persistent_address(kscm, kscm->value)); + kscm__fwrite_int(kscm, f, kscm->_operator); + */ + + kscm__fread_int(kscm, f, &tmpint); + kscm->_threadstate = tmpint; + kscm__fread_int(kscm, f, &tmpint); + kscm->_threadname = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->_threadopts = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->_threadobject = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->args = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->envir = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->code = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->dump = kscm_get_object_address(kscm, tmpint); + + /* At least for the main thread, the value/operator options are discarded. */ + kscm__fread_int(kscm, f, &tmpint); + kscm__fread_int(kscm, f, &tmpint); + kscm->value = kscm->NIL; //kscm_get_object_address(kscm, tmpint); + kscm->_operator = 0; + + //fprintf(stderr, "Persistent addresses: ->T=%d ->F=%d ->NIL=%d\n", kscm_get_persistent_address(kscm, kscm->T), kscm_get_persistent_address(kscm, kscm->F), kscm_get_persistent_address(kscm, kscm->NIL)); + + //fprintf(stderr, "Persistent addresses: ->args=%d ->envir=%d ->code=%d ->dump=%d\n", kscm_get_persistent_address(kscm, kscm->args), kscm_get_persistent_address(kscm, kscm->envir), kscm_get_persistent_address(kscm, kscm->code), kscm_get_persistent_address(kscm, kscm->dump)); + + /* Clear all of the cell memory. Any new blocks that get automatically allocated will be cleared upon allocation. */ + int i; + for (i = 0; i <= kscm->last_cell_seg; i++) { + memset(kscm->cell_seg[i], 0, sizeof(struct kscm_cell) * KSCM_CONFIG_CELL_SEGSIZE); + } + + int objid; + do { + if (kscm__fread_int(kscm, f, &objid) != 4) { + fprintf(stderr, "WTFERR1\n"); + exit(-1); + return -1; + } + if (objid == 0) break; + + kscm_object_t obj = kscm_get_object_address(kscm, objid); + if (obj == NULL) { + fprintf(stderr, "WTFERR2\n"); + exit(-1); + return -1; + } + char typ = 0; + if (kscm__fread_byte(kscm, f, &typ) != 1) { + fprintf(stderr, "WTFERR3\n"); + exit(-1); + return -1; + } + fprintf(stderr, "Got type %d\n", typ); + const char* tmpstr; + switch (typ) { + case KSCM_PERSIST_TINT32: + obj->_flag = KSCM_T_NUMBER | KSCM_T_ATOM; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._number._ivalue = tmpint; + break; + case KSCM_PERSIST_TSTRING: + obj->_flag = KSCM_T_STRING | KSCM_T_ATOM; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._string._keynum = tmpint; + tmpint = kscm__fread_str(kscm, f, &tmpstr); + if (tmpint < 0) { + fprintf(stderr, "WTFERR4\n"); + exit(-1); + return -1; + } + //fprintf(stderr, "Got str len %d '%s'\n", tmpint, tmpstr); + #ifdef __WIN32 + obj->_object._string._svalue = _strdup(tmpstr);//kscm__store_string(kscm, tmpstr); + #else + obj->_object._string._svalue = strdup(tmpstr);//kscm__store_string(kscm, tmpstr); + #endif + free((void*)tmpstr); + break; + case KSCM_PERSIST_TSYMBOL: + obj->_flag = KSCM_T_SYMBOL; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._car = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._cdr = kscm_get_object_address(kscm, tmpint); + break; + case KSCM_PERSIST_TPAIR: + obj->_flag = KSCM_T_PAIR; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._car = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._cdr = kscm_get_object_address(kscm, tmpint); + break; + case KSCM_PERSIST_TPROC: + obj->_flag = KSCM_T_PROC | KSCM_T_ATOM; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._number._ivalue = tmpint; + break; + case KSCM_PERSIST_TCLOSURE: + obj->_flag = KSCM_T_CLOSURE; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._car = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._cdr = kscm_get_object_address(kscm, tmpint); + break; + case KSCM_PERSIST_TSYNTAX: + obj->_flag = KSCM_T_SYMBOL | KSCM_T_SYNTAX; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._car = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._cdr = kscm_get_object_address(kscm, tmpint); + break; + case KSCM_PERSIST_TCONTINUATION: + obj->_flag = KSCM_T_CONTINUATION; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._car = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._cdr = kscm_get_object_address(kscm, tmpint); + break; +#ifdef KSCM_CONFIG_USE_STRUCTS + case KSCM_PERSIST_TABSTRACTION: + obj->_flag = KSCM_T_ABSTRACTION; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._car = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._cons._cdr = kscm_get_object_address(kscm, tmpint); + break; + case KSCM_PERSIST_TBUFFER: + obj->_flag = KSCM_T_BUFFER | KSCM_T_ATOM; + tmpint = kscm__fread_str(kscm, f, &tmpstr); + obj->_object._buffer._length = tmpint; + if (tmpint < 0) { + fprintf(stderr, "WTFERR4\n"); + exit(-1); + return -1; + } + //fprintf(stderr, "Got str len %d '%s'\n", tmpint, tmpstr); + obj->_object._buffer._data = (unsigned char*) tmpstr; //kscm__store_string(kscm, tmpstr); + //free((void*)tmpstr); + break; +#endif +#ifdef KSCM_CONFIG_USE_FLOATS + case KSCM_PERSIST_TFLOAT64: { + obj->_flag = KSCM_T_FLOAT64 | KSCM_T_ATOM; + double tmp; + char* bytes = (char*)(void*)&tmp; //obj->_object._float64._dvalue; + kscm__fread_byte(kscm, f, &bytes[0]); + kscm__fread_byte(kscm, f, &bytes[1]); + kscm__fread_byte(kscm, f, &bytes[2]); + kscm__fread_byte(kscm, f, &bytes[3]); + kscm__fread_byte(kscm, f, &bytes[4]); + kscm__fread_byte(kscm, f, &bytes[5]); + kscm__fread_byte(kscm, f, &bytes[6]); + kscm__fread_byte(kscm, f, &bytes[7]); + obj->_object._float64._dvalue = tmp; + } break; +#endif +#ifdef KSCM_CONFIG_USE_STRUCTS + case KSCM_PERSIST_TOBJX: + obj->_flag = KSCM_T_OBJX; + kscm__fread_int(kscm, f, &tmpint); + obj->_object._objx._type = kscm_get_object_address(kscm, tmpint); + kscm__fread_int(kscm, f, &tmpint); + obj->_object._objx._count = tmpint; + obj->_object._objx._elements = (kscm_object_t*) calloc(sizeof(kscm_object_t), obj->_object._objx._count); + // TODO Check non-null (ideally check size is sane before attempting to allocate/fill) + for (i = 0; i < obj->_object._objx._count; i++) { + kscm__fread_int(kscm, f, &tmpint); + obj->_object._objx._elements[i] = kscm_get_object_address(kscm, tmpint); + } + break; +#endif + default: + fprintf(stderr, "Unknown object type #%d\n", typ); + exit(1); + if (1) return 0; + } + } while (objid != 0); + + kscm->free_cell = kscm->NIL; + kscm->fcells = 0; + return 0; // Resumed +} +/* From ifdef KSCM_CONFIG_USE_PERSIST */ +#endif + +kscm_object_t kscm__opexe_7(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y, z; + char* str1; + char* str2; + char* str3; + register long v; + static long w; + + switch (op) { + case KSCM_OP_STRCAT: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + if (!kscm__isstring(kscm, x) || !kscm__isstring(kscm, y)) { + kscm__s_retbool(kscm, 0); + } + str1 = kscm__strvalue(kscm, x); + str2 = kscm__strvalue(kscm, y); + str3 = (char*)calloc(strlen(str1) + strlen(str2) + 1, 1); + if (str3 == NULL) { + kscm__s_retbool(kscm, 0); + } + strcat(str3, str1); + strcat(str3, str2); + z = kscm__mk_string(kscm, str3); + free(str3); + kscm__s_return(kscm, z); + case KSCM_OP_STRLEN: + x = kscm__car(kscm, kscm->args); + if (!kscm__isstring(kscm, x)) { + kscm__s_retbool(kscm, 0); + } + str1 = kscm__strvalue(kscm, x); + kscm__s_return(kscm, kscm__mk_number(kscm, strlen(str1))); + case KSCM_OP_STRGET: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + if (!kscm__isstring(kscm, x) || !kscm__isnumber(kscm, y)) { + kscm__s_retbool(kscm, 0); + } + str1 = kscm__strvalue(kscm, x); + v = kscm__ivalue(kscm, y); + if (v < 0 || v >= strlen(str1)) { + kscm__s_retbool(kscm, 0); + } + kscm__s_return(kscm, kscm__mk_number(kscm, ((int)(str1[v])) & 0xFF)); +#ifdef KSCM_CONFIG_USE_PERSIST + case KSCM_OP_SAVE_STATE: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + str1 = kscm__strvalue(kscm, x); + str2 = kscm__strvalue(kscm, y); + if (kscm_save_state(kscm, str1, str2) == 0) { + kscm__s_return(kscm, kscm__mk_symbol(kscm, "saved")); + } else { + kscm__s_retbool(kscm, 0); + } + case KSCM_OP_RESUME_STATE: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + str1 = kscm__strvalue(kscm, x); + str2 = kscm__strvalue(kscm, y); + if (kscm_resume_state(kscm, str1, str2) == 0) { + kscm__s_return(kscm, kscm__mk_symbol(kscm, "resumed")); + } else { + kscm__s_retbool(kscm, 0); + } +#endif +#ifdef KSCM_CONFIG_USE_STRUCTS + case KSCM_OP_BUFFER: + kscm__s_retbool(kscm, kscm__isbuffer(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_BUFFER_NEW: + x = kscm__car(kscm, kscm->args); + if (kscm__isstring(kscm, x)) { + const char* strval = kscm__strvalue(kscm, x); + size_t slen = strlen(strval); + y = kscm__mk_buffer(kscm, slen); + size_t iter; + for (iter = 0; iter < slen; iter++) { + y->_object._buffer._data[iter] = strval[iter]; + } + kscm__s_return(kscm, y); + } else if (!kscm__isnumber(kscm, x)) { + kscm__s_return(kscm, kscm->NIL); + } + kscm__s_return(kscm, kscm__mk_buffer(kscm, kscm__ivalue(kscm, x))); + case KSCM_OP_BUFFER_LEN: + x = kscm__car(kscm, kscm->args); + if (!kscm__isbuffer(kscm, x)) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_return(kscm, kscm__mk_number(kscm, x->_object._buffer._length)); + case KSCM_OP_BUFFER_GET: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + if (!kscm__isbuffer(kscm, x) || !kscm__isnumber(kscm, y)) { + kscm__s_return(kscm, kscm->F); + } + v = kscm__ivalue(kscm, y); + if (v < 0 || v >= x->_object._buffer._length) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_return(kscm, kscm__mk_number(kscm, ((long)(x->_object._buffer._data[v])) & 0xFF)); + case KSCM_OP_BUFFER_SET: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + z = kscm__caddr(kscm, kscm->args); + if (!kscm__isbuffer(kscm, x) || !kscm__isnumber(kscm, y) || !kscm__isnumber(kscm, z)) { + kscm__s_return(kscm, kscm->F); + } + v = kscm__ivalue(kscm, y); + if (v < 0 || v >= x->_object._buffer._length) { + kscm__s_return(kscm, kscm->F); + } + x->_object._buffer._data[v] = (unsigned char)kscm__ivalue(kscm, z); + kscm__s_return(kscm, kscm->T); + case KSCM_OP_BUFFER_LOAD: + kscm__s_return(kscm, kscm__mk_string(kscm, "TODO")); + case KSCM_OP_BUFFER_SAVE: + kscm__s_return(kscm, kscm__mk_string(kscm, "TODO")); + case KSCM_OP_ABSTRACTION: + kscm__s_retbool(kscm, kscm__isabstraction(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_ABSTRACTION_NEW: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + kscm__s_return(kscm, kscm__mk_abstraction(kscm, x, y)); + case KSCM_OP_ABSTRACTION_TYPE: + x = kscm__car(kscm, kscm->args); +#ifdef KSCM_CONFIG_USE_OBJECTS + if (kscm__isobjx(kscm, x)) { + kscm__s_return(kscm, x->_object._objx._type); + } +#endif + if (!kscm__isabstraction(kscm, x)) { + kscm__s_retbool(kscm, 0); + } + kscm__s_return(kscm, kscm__car(kscm, x)); + case KSCM_OP_ABSTRACTION_VALUE: + x = kscm__car(kscm, kscm->args); + if (!kscm__isabstraction(kscm, x)) { + kscm__s_retbool(kscm, 0); + } + kscm__s_return(kscm, kscm__cdr(kscm, x)); +#endif +#ifdef KSCM_CONFIG_USE_OBJECTS + case KSCM_OP_OBJECT: + kscm__s_retbool(kscm, kscm__isobjx(kscm, kscm__car(kscm, kscm->args))); + case KSCM_OP_OBJECT_NEW: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + if (!kscm__isnumber(kscm, y)) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_return(kscm, kscm__mk_objx(kscm, x, kscm__ivalue(kscm, y))); + case KSCM_OP_OBJECT_LEN: + x = kscm__car(kscm, kscm->args); + if (!kscm__isobjx(kscm, x)) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_return(kscm, kscm__mk_number(kscm, x->_object._objx._count)); + case KSCM_OP_OBJECT_GET: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + if (!kscm__isobjx(kscm, x) || !kscm__isnumber(kscm, y)) { + kscm__s_return(kscm, kscm->F); + } + v = kscm__ivalue(kscm, y); + if (v < 0 || v >= x->_object._objx._count) { + kscm__s_return(kscm, kscm->F); + } + kscm__s_return(kscm, x->_object._objx._elements[v]); + case KSCM_OP_OBJECT_SET: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + z = kscm__caddr(kscm, kscm->args); + if (!kscm__isobjx(kscm, x) || !kscm__isnumber(kscm, y)) { + kscm__s_return(kscm, kscm->F); + } + v = kscm__ivalue(kscm, y); + if (v < 0 || v >= x->_object._objx._count) { + kscm__s_return(kscm, kscm->F); + } + x->_object._objx._elements[v] = z; + kscm__s_return(kscm, kscm->T); + case KSCM_OP_OBJECT_RETYPE: + x = kscm__car(kscm, kscm->args); + y = kscm__cadr(kscm, kscm->args); + if (!kscm__isobjx(kscm, x)) { + kscm__s_return(kscm, kscm->F); + } + x->_object._objx._type = y; + kscm__s_return(kscm, kscm->T); +#endif + case KSCM_OP_SYMBOL_TO_STRING: +#ifdef KSCM_CONFIG_USE_STRUCTS + /* We handle buffer->string in the same function if structs are enabled. */ + if (kscm__isbuffer(kscm, kscm__car(kscm, kscm->args))) { + x = kscm__car(kscm, kscm->args); + char* tmp_buffer = (char*) calloc(x->_object._buffer._length, 1); + if (tmp_buffer == NULL) { + kscm__s_return(kscm, kscm->NIL); + } + size_t iter; + for (iter = 0; iter < x->_object._buffer._length; iter++) { + tmp_buffer[iter] = x->_object._buffer._data[iter]; + } + /* Note: All the messaround above was only to keep the string-creation API consistent. + * It would be easy to optimise the buffer->string case by creating the string object manually. + */ + y = kscm__mk_string(kscm, tmp_buffer); + free(tmp_buffer); + kscm__s_return(kscm, y); + } +#endif + if (kscm__issymbol(kscm, kscm__car(kscm, kscm->args))) { + x = kscm__caar(kscm, kscm->args); + kscm__s_return(kscm, x); + } + else { + kscm__s_return(kscm, kscm->F); + } + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; /* NOTREACHED */ +} + +kscm_object_t kscm__opexe_8(kscm_t* kscm, register short op) +{ + register kscm_object_t x, y, z; + char* str1; + char* str2; + char* str3; + register long v; + static long w; + #ifdef KSCM_CONFIG_USE_CONSOLE + struct winsize ws; + int fd; + #endif + + switch (op) { + #ifdef KSCM_CONFIG_USE_CONSOLE + case KSCM_OP_CONSOLE_MODE: + x = kscm__mk_string(kscm, ttyname(STDIN_FILENO)); + kscm__s_return(kscm, x); + case KSCM_OP_CONSOLE_WIDTH: + case KSCM_OP_CONSOLE_HEIGHT: + str1 = ttyname(STDIN_FILENO); // NOTE: "/dev/tty" may work if this isn't available! + fd = open(str1, O_RDWR); + if (fd < 0) { + kscm__error_0(kscm, "Failed to open console device"); + } + /* Get window size of terminal. */ + if (ioctl(fd, TIOCGWINSZ, &ws) < 0) { + kscm__error_0(kscm, "Failed to get console info"); + } + close(fd); + if (op == KSCM_OP_CONSOLE_WIDTH) { + kscm__s_return(kscm, kscm__mk_number(kscm, ws.ws_row)); + } else { + kscm__s_return(kscm, kscm__mk_number(kscm, ws.ws_row)); + } + #else + case KSCM_OP_CONSOLE_MODE: + kscm__s_return(kscm, kscm->F); + #endif + /* + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_MODE); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_NEXT); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_POLL); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_WIDTH); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_HEIGHT); + */ + default: + sprintf(kscm->strbuff, "%d is illegal operator", kscm->_operator); + kscm__error_0(kscm, kscm->strbuff); + } + return kscm->T; /* NOTREACHED */ +} + +typedef kscm_object_t(*kscm_dispatchf_t)(kscm_t* kscm, register short op); + +kscm_dispatchf_t kscm__shared_dispatch_table[256]; + +void kscm__eval_set(kscm_t* kscm, kscm_dispatchf_t func, int tag) { + kscm__shared_dispatch_table[tag] = func; +} + +void kscm__eval_setup(kscm_t* kscm) { + if (kscm__shared_dispatch_table[KSCM_OP_LOAD] == &kscm__opexe_0) { + return; + } + + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LOAD); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_T0LVL); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_T1LVL); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_READ); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_VALUEPRINT); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_EVAL); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_E0ARGS); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_E1ARGS); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_APPLY); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_DOMACRO); +// + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LAMBDA); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_QUOTE); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_DEF0); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_DEF1); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_BEGIN); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_IF0); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_IF1); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_SET0); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_SET1); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LET0); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LET1); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LET2); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LET0AST); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LET1AST); + kscm__eval_set(kscm, &kscm__opexe_0, KSCM_OP_LET2AST); +// + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_LET0REC); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_LET1REC); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_LET2REC); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_COND0); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_COND1); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_DELAY); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_AND0); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_AND1); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_OR0); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_OR1); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_C0STREAM); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_C1STREAM); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_0MACRO); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_1MACRO); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_CASE0); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_CASE1); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_CASE2); +// + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_PEVAL); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_PAPPLY); + kscm__eval_set(kscm, &kscm__opexe_1, KSCM_OP_CONTINUATION); +// + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_ADD); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_SUB); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_MUL); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_DIV); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_REM); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_CAR); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_CDR); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_CONS); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_SETCAR); + kscm__eval_set(kscm, &kscm__opexe_2, KSCM_OP_SETCDR); +// + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_NOT); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_BOOL); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_NULL); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_ZEROP); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_POSP); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_NEGP); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_NEQ); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_LESS); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_GRE); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_LEQ); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_GEQ); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_SYMBOL); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_NUMBER); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_STRING); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_PROC); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_PAIR); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_EQ); + kscm__eval_set(kscm, &kscm__opexe_3, KSCM_OP_EQV); +// + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_FORCE); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_WRITE); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_DISPLAY); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_NEWLINE); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_ERR0); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_ERR1); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_REVERSE); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_APPEND); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_PUT); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_GET); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_QUIT); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_GC); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_GCVERB); + kscm__eval_set(kscm, &kscm__opexe_4, KSCM_OP_NEWSEGMENT); +// + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDSEXPR); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDLIST); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDDOT); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDQUOTE); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDQQUOTE); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDUNQUOTE); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_RDUQTSP); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_P0LIST); + kscm__eval_set(kscm, &kscm__opexe_5, KSCM_OP_P1LIST); +// + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_LIST_LENGTH); + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_ASSQ); + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_PRINT_WIDTH); + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_P0_WIDTH); + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_P1_WIDTH); + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_GET_CLOSURE); + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_CLOSUREP); +//#ifdef KSCM_CONFIG_USE_MACRO + kscm__eval_set(kscm, &kscm__opexe_6, KSCM_OP_MACROP); +//#endif Removed ifdef to keep ordering consistent. -Zak. + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_STRCAT); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_STRLEN); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_STRGET); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_SAVE_STATE); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_RESUME_STATE); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER_NEW); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER_LEN); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER_GET); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER_SET); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_ABSTRACTION); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_ABSTRACTION_NEW); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_ABSTRACTION_TYPE); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_ABSTRACTION_VALUE); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_OBJECT); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_OBJECT_NEW); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_OBJECT_LEN); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_OBJECT_GET); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_OBJECT_SET); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_OBJECT_RETYPE); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_SYMBOL_TO_STRING); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER_LOAD); + kscm__eval_set(kscm, &kscm__opexe_7, KSCM_OP_BUFFER_SAVE); + + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_MODE); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_NEXT); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_POLL); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_WIDTH); + kscm__eval_set(kscm, &kscm__opexe_8, KSCM_OP_CONSOLE_HEIGHT); +} + +/* These and the commented-out parts of kscm__eval_cycle can be re-enabled if you need to make sure the interpreter is running. +int fixme_reccheck = 0; +int fixme_ops = 0; +*/ +/* kernel of this intepreter */ +kscm_object_t kscm__eval_cycle(kscm_t* kscm, register short op) +{ + kscm__eval_setup(kscm); + /*fixme_reccheck++; + if (fixme_reccheck > 1) { + fprintf(stderr, "Warning reccheck=%d\n", fixme_reccheck); + }*/ + kscm->_operator = op; + for (;;) { + kscm_object_t(*func)(kscm_t* kscm, register short op) = kscm__shared_dispatch_table[kscm->_operator]; + if (func == NULL) { + fprintf(stderr, "Error! Opcode %d leads to NULL!\n", kscm->_operator); + exit(-1); + } + if (/*(*kscm__shared_dispatch_table[kscm->_operator])*/ func(kscm, kscm->_operator) == kscm->NIL) { + //fixme_reccheck--; + return kscm->NIL; + } + /*if ((fixme_ops % 1000) == 0) { + fprintf(stderr, "Just did op %d\n", fixme_ops); + } + fixme_ops++;*/ + } +} + +/* ========== Initialization of internal keywords ========== */ + +void kscm__mk_syntax(kscm_t* kscm, unsigned short op, const char *name) +{ + kscm_object_t x; + + x = kscm__cons(kscm, kscm__mk_string(kscm, name), kscm->NIL); + kscm__type(kscm, x) = (KSCM_T_SYNTAX | KSCM_T_SYMBOL); + kscm__syntaxnum(kscm, x) = op; + kscm->oblist = kscm__cons(kscm, x, kscm->oblist); +} + +void kscm__mk_proc(kscm_t* kscm, unsigned short op, const char *name) +{ + kscm_object_t x, y; + + x = kscm__mk_symbol(kscm, name); + y = kscm__get_cell(kscm, kscm->NIL, kscm->NIL); + kscm__type(kscm, y) = (KSCM_T_PROC | KSCM_T_ATOM); + kscm__ivalue(kscm, y) = (long)op; + kscm__car(kscm, kscm->global_env) = kscm__cons(kscm, kscm__cons(kscm, x, y), kscm__car(kscm, kscm->global_env)); +} + + +void kscm__init_vars_global(kscm_t* kscm) +{ + kscm_object_t x; + + /* init input/output file */ + kscm->inputs[kscm->inputtop] = stdin; + kscm->outfp = stdout; + /* init kscm->NIL */ + kscm__type(kscm, kscm->NIL) = (KSCM_T_ATOM | KSCM_MARK); + kscm__car(kscm, kscm->NIL) = kscm__cdr(kscm, kscm->NIL) = kscm->NIL; + /* init T */ + kscm__type(kscm, kscm->T) = (KSCM_T_ATOM | KSCM_MARK); + kscm__car(kscm, kscm->T) = kscm__cdr(kscm, kscm->T) = kscm->T; + /* init F */ + kscm__type(kscm, kscm->F) = (KSCM_T_ATOM | KSCM_MARK); + kscm__car(kscm, kscm->F) = kscm__cdr(kscm, kscm->F) = kscm->F; + /* init global_env */ + kscm->global_env = kscm__cons(kscm, kscm->NIL, kscm->NIL); + /* init else */ + x = kscm__mk_symbol(kscm, "else"); + kscm__car(kscm, kscm->global_env) = kscm__cons(kscm, kscm__cons(kscm, x, kscm->T), kscm__car(kscm, kscm->global_env)); +} + + +void kscm__init_syntax(kscm_t* kscm) +{ + /* init syntax */ + kscm__mk_syntax(kscm, KSCM_OP_LAMBDA, "lambda"); + kscm__mk_syntax(kscm, KSCM_OP_QUOTE, "quote"); + kscm__mk_syntax(kscm, KSCM_OP_DEF0, "define"); + kscm__mk_syntax(kscm, KSCM_OP_IF0, "if"); + kscm__mk_syntax(kscm, KSCM_OP_BEGIN, "begin"); + kscm__mk_syntax(kscm, KSCM_OP_SET0, "set!"); + kscm__mk_syntax(kscm, KSCM_OP_LET0, "let"); + kscm__mk_syntax(kscm, KSCM_OP_LET0AST, "let*"); + kscm__mk_syntax(kscm, KSCM_OP_LET0REC, "letrec"); + kscm__mk_syntax(kscm, KSCM_OP_COND0, "cond"); + kscm__mk_syntax(kscm, KSCM_OP_DELAY, "delay"); + kscm__mk_syntax(kscm, KSCM_OP_AND0, "and"); + kscm__mk_syntax(kscm, KSCM_OP_OR0, "or"); + kscm__mk_syntax(kscm, KSCM_OP_C0STREAM, "cons-stream"); +#ifdef KSCM_CONFIG_USE_MACRO + kscm__mk_syntax(kscm, KSCM_OP_0MACRO, "macro"); +#endif + kscm__mk_syntax(kscm, KSCM_OP_CASE0, "case"); +} + + +void kscm__init_procs(kscm_t* kscm) +{ + /* init procedure */ + kscm__mk_proc(kscm, KSCM_OP_PEVAL, "eval"); + kscm__mk_proc(kscm, KSCM_OP_PAPPLY, "apply"); + kscm__mk_proc(kscm, KSCM_OP_CONTINUATION, "call-with-current-continuation"); + kscm__mk_proc(kscm, KSCM_OP_FORCE, "force"); + kscm__mk_proc(kscm, KSCM_OP_CAR, "car"); + kscm__mk_proc(kscm, KSCM_OP_CDR, "cdr"); + kscm__mk_proc(kscm, KSCM_OP_CONS, "cons"); + kscm__mk_proc(kscm, KSCM_OP_SETCAR, "set-car!"); + kscm__mk_proc(kscm, KSCM_OP_SETCDR, "set-cdr!"); + kscm__mk_proc(kscm, KSCM_OP_ADD, "+"); + kscm__mk_proc(kscm, KSCM_OP_SUB, "-"); + kscm__mk_proc(kscm, KSCM_OP_MUL, "*"); + kscm__mk_proc(kscm, KSCM_OP_DIV, "/"); + kscm__mk_proc(kscm, KSCM_OP_REM, "remainder"); + kscm__mk_proc(kscm, KSCM_OP_NOT, "not"); + kscm__mk_proc(kscm, KSCM_OP_BOOL, "boolean?"); + kscm__mk_proc(kscm, KSCM_OP_SYMBOL, "symbol?"); + kscm__mk_proc(kscm, KSCM_OP_NUMBER, "number?"); + kscm__mk_proc(kscm, KSCM_OP_STRING, "string?"); + kscm__mk_proc(kscm, KSCM_OP_PROC, "procedure?"); + kscm__mk_proc(kscm, KSCM_OP_PAIR, "pair?"); + kscm__mk_proc(kscm, KSCM_OP_EQV, "eqv?"); + kscm__mk_proc(kscm, KSCM_OP_EQ, "eq?"); + kscm__mk_proc(kscm, KSCM_OP_NULL, "null?"); + kscm__mk_proc(kscm, KSCM_OP_ZEROP, "zero?"); + kscm__mk_proc(kscm, KSCM_OP_POSP, "positive?"); + kscm__mk_proc(kscm, KSCM_OP_NEGP, "negative?"); + kscm__mk_proc(kscm, KSCM_OP_NEQ, "="); + kscm__mk_proc(kscm, KSCM_OP_LESS, "<"); + kscm__mk_proc(kscm, KSCM_OP_GRE, ">"); + kscm__mk_proc(kscm, KSCM_OP_LEQ, "<="); + kscm__mk_proc(kscm, KSCM_OP_GEQ, ">="); + kscm__mk_proc(kscm, KSCM_OP_READ, "read"); + kscm__mk_proc(kscm, KSCM_OP_WRITE, "write"); + kscm__mk_proc(kscm, KSCM_OP_DISPLAY, "display"); + kscm__mk_proc(kscm, KSCM_OP_NEWLINE, "newline"); + kscm__mk_proc(kscm, KSCM_OP_LOAD, "load"); + kscm__mk_proc(kscm, KSCM_OP_ERR0, "error"); + kscm__mk_proc(kscm, KSCM_OP_REVERSE, "reverse"); + kscm__mk_proc(kscm, KSCM_OP_APPEND, "append"); + kscm__mk_proc(kscm, KSCM_OP_PUT, "put"); + kscm__mk_proc(kscm, KSCM_OP_GET, "get"); + kscm__mk_proc(kscm, KSCM_OP_GC, "gc"); + kscm__mk_proc(kscm, KSCM_OP_GCVERB, "gc-verbose"); + kscm__mk_proc(kscm, KSCM_OP_NEWSEGMENT, "new-segment"); + kscm__mk_proc(kscm, KSCM_OP_LIST_LENGTH, "list-length"); /* a.k */ + kscm__mk_proc(kscm, KSCM_OP_ASSQ, "assq"); /* a.k */ + kscm__mk_proc(kscm, KSCM_OP_PRINT_WIDTH, "print-width"); /* a.k */ + kscm__mk_proc(kscm, KSCM_OP_GET_CLOSURE, "get-closure-code"); /* a.k */ + kscm__mk_proc(kscm, KSCM_OP_CLOSUREP, "closure?"); /* a.k */ +#ifdef KSCM_CONFIG_USE_MACRO + kscm__mk_proc(kscm, KSCM_OP_MACROP, "macro?"); /* a.k */ +#endif + kscm__mk_proc(kscm, KSCM_OP_STRCAT, "string-cat"); + kscm__mk_proc(kscm, KSCM_OP_STRLEN, "string-length"); + kscm__mk_proc(kscm, KSCM_OP_STRGET, "string-get"); +#ifdef KSCM_CONFIG_USE_PERSIST + kscm__mk_proc(kscm, KSCM_OP_SAVE_STATE, "save-state"); + kscm__mk_proc(kscm, KSCM_OP_RESUME_STATE, "resume-state"); +#endif +#ifdef KSCM_CONFIG_USE_STRUCTS + kscm__mk_proc(kscm, KSCM_OP_BUFFER, "buffer?"); + kscm__mk_proc(kscm, KSCM_OP_BUFFER_NEW, "buffer-new"); + kscm__mk_proc(kscm, KSCM_OP_BUFFER_LEN, "buffer-length"); + kscm__mk_proc(kscm, KSCM_OP_BUFFER_GET, "buffer-get"); + kscm__mk_proc(kscm, KSCM_OP_BUFFER_SET, "buffer-set!"); + kscm__mk_proc(kscm, KSCM_OP_ABSTRACTION, "abstraction?"); + kscm__mk_proc(kscm, KSCM_OP_ABSTRACTION_NEW, "abstraction-new"); + kscm__mk_proc(kscm, KSCM_OP_ABSTRACTION_TYPE, "abstraction-type"); + kscm__mk_proc(kscm, KSCM_OP_ABSTRACTION_VALUE, "abstraction-value"); + kscm__mk_proc(kscm, KSCM_OP_BUFFER_LOAD, "buffer-load"); + kscm__mk_proc(kscm, KSCM_OP_BUFFER_SAVE, "buffer-save"); + + kscm__mk_proc(kscm, KSCM_OP_CONSOLE_MODE, "console-mode"); + kscm__mk_proc(kscm, KSCM_OP_CONSOLE_NEXT, "console-next"); + kscm__mk_proc(kscm, KSCM_OP_CONSOLE_POLL, "console-poll"); + kscm__mk_proc(kscm, KSCM_OP_CONSOLE_WIDTH, "console-width"); + kscm__mk_proc(kscm, KSCM_OP_CONSOLE_HEIGHT, "console-height"); +#endif +#ifdef KSCM_CONFIG_USE_OBJECTS + kscm__mk_proc(kscm, KSCM_OP_OBJECT, "object?"); + kscm__mk_proc(kscm, KSCM_OP_OBJECT_NEW, "object-new"); + kscm__mk_proc(kscm, KSCM_OP_OBJECT_LEN, "object-length"); + kscm__mk_proc(kscm, KSCM_OP_OBJECT_GET, "object-get"); + kscm__mk_proc(kscm, KSCM_OP_OBJECT_SET, "object-set!"); + kscm__mk_proc(kscm, KSCM_OP_OBJECT_RETYPE, "object-retype!"); + /* NOTE: There is no object-type function, the abstraction-type function handles all custom-typed values. */ +#endif + kscm__mk_proc(kscm, KSCM_OP_SYMBOL_TO_STRING, "symbol->string"); + kscm__mk_proc(kscm, KSCM_OP_QUIT, "quit"); +} + + +/* initialize several globals */ +void kscm__init_globals(kscm_t* kscm) +{ + kscm__init_vars_global(kscm); + kscm__init_syntax(kscm); + kscm__init_procs(kscm); + /* intialization of global pointers to special symbols */ + kscm->LAMBDA = kscm__mk_symbol(kscm, "lambda"); + kscm->QUOTE = kscm__mk_symbol(kscm, "quote"); +#ifdef KSCM_CONFIG_USE_QQUOTE + kscm->QQUOTE = kscm__mk_symbol(kscm, "quasiquote"); + kscm->UNQUOTE = kscm__mk_symbol(kscm, "unquote"); + kscm->UNQUOTESP = kscm__mk_symbol(kscm, "unquote-splicing"); +#endif + +} + +/* ========== Error ========== */ + +void kscm__fatal_error(kscm_t* kscm, const char *fmt, const char *a, const char *b, const char *c) +{ + fprintf(stderr, "Fatal error: "); + fprintf(stderr, fmt, a, b, c); + fprintf(stderr, "\n"); + exit(1); +} + +#ifdef KSCM_CONFIG_USE_SETJMP +void kscm__error(kscm_t* kscm, const char *fmt, const char *a, const char *b, const char *c) +{ + fprintf(stderr, "Error: "); + fprintf(stderr, fmt, a, b, c); + fprintf(stderr, "\n"); + kscm__resetinput(kscm); + longjmp(kscm->error_jmp, KSCM_OP_T0LVL); +} + +#endif + +/* ========== Main ========== */ + +#ifdef CMDLINE +int main(int argc, char **argv) +#else +int main() +#endif +{ + short i; + short op = (short)KSCM_OP_LOAD; + +#ifdef CMDLINE + for (i = 1; i < argc; i++) { + if (strcmp(argv[i], "-e") == 0) { + all_errors_fatal = 1; + } + else if (strcmp(argv[i], "-q") == 0) { + quiet = 1; + } + } +#endif + + kscm_t* kscm = (kscm_t*) calloc(1, sizeof(kscm_t)); + kscm->cell_seg = calloc(KSCM_CONFIG_CELL_NSEGMENT, sizeof(kscm_object_t)); + kscm->gcstate = calloc(4000, sizeof(kscm_gcstate_t)); + kscm->gcstate_max = 4000; + + if (!kscm->quiet) + printf(KSCM_CONFIG_BANNER); + kscm__init_scheme(kscm); + kscm->args = kscm__cons(kscm, kscm__mk_string(kscm, KSCM_CONFIG_INITFILE), kscm->NIL); +#ifdef KSCM_CONFIG_USE_SETJMP + op = setjmp(kscm->error_jmp); +#endif + kscm__eval_cycle(kscm, op); + exit(0); +} + +#ifdef KSCM_PLUSPLUS +} +#endif diff --git a/sh.c b/sh.c new file mode 100644 index 0000000..a5bf893 --- /dev/null +++ b/sh.c @@ -0,0 +1,500 @@ +// Shell. + +#include "kernel/types.h" +#include "user/user.h" +#include "kernel/fcntl.h" + +// Parsed command representation +#define EXEC 1 +#define REDIR 2 +#define PIPE 3 +#define LIST 4 +#define BACK 5 + +#define MAXARGS 10 + +struct cmd { + int type; +}; + +struct execcmd { + int type; + char *argv[MAXARGS]; + char *eargv[MAXARGS]; +}; + +struct redircmd { + int type; + struct cmd *cmd; + char *file; + char *efile; + int mode; + int fd; +}; + +struct pipecmd { + int type; + struct cmd *left; + struct cmd *right; +}; + +struct listcmd { + int type; + struct cmd *left; + struct cmd *right; +}; + +struct backcmd { + int type; + struct cmd *cmd; +}; + +int fork1(void); // Fork but panics on failure. +void panic(char*); +struct cmd *parsecmd(char*); +#ifdef _ZCC +void runcmd(struct cmd*); +#else +void runcmd(struct cmd*) __attribute__((noreturn)); +#endif + +// Execute cmd. Never returns. +void +runcmd(struct cmd *cmd) +{ + int p[2]; + struct backcmd *bcmd; + struct execcmd *ecmd; + struct listcmd *lcmd; + struct pipecmd *pcmd; + struct redircmd *rcmd; + + if(cmd == 0) + exit(1); + + + switch(cmd->type){ + case EXEC: + ecmd = (struct execcmd*)cmd; + if(ecmd->argv[0] == 0) + exit(1); + exec(ecmd->argv[0], ecmd->argv); + fprintf(2, "exec %s failed\n", ecmd->argv[0]); + break; + + case REDIR: + rcmd = (struct redircmd*)cmd; + close(rcmd->fd); + if(open(rcmd->file, rcmd->mode) < 0){ + fprintf(2, "open %s failed\n", rcmd->file); + exit(1); + } + runcmd(rcmd->cmd); + break; + + case LIST: + lcmd = (struct listcmd*)cmd; + if(fork1() == 0) + runcmd(lcmd->left); + wait(0); + runcmd(lcmd->right); + break; + + case PIPE: + pcmd = (struct pipecmd*)cmd; + if(pipe(p) < 0) + panic("pipe"); + if(fork1() == 0){ + close(1); + dup(p[1]); + close(p[0]); + close(p[1]); + runcmd(pcmd->left); + } + if(fork1() == 0){ + close(0); + dup(p[0]); + close(p[0]); + close(p[1]); + runcmd(pcmd->right); + } + close(p[0]); + close(p[1]); + wait(0); + wait(0); + break; + + case BACK: + bcmd = (struct backcmd*)cmd; + if(fork1() == 0) + runcmd(bcmd->cmd); + break; + + default: + panic("runcmd"); + } + exit(0); +} + +int +getcmd(char *buf, int nbuf) +{ + write(2, "$ ", 2); + memset(buf, 0, nbuf); + gets(buf, nbuf); + if(buf[0] == 0) // EOF + return -1; + return 0; +} + +int +main(void) +{ + /*static*/ char buf[100]; + int fd; + + // Ensure that three file descriptors are open. + while((fd = open("console", O_RDWR)) >= 0){ + if(fd >= 3){ + close(fd); + break; + } + } + + // Read and run input commands. + while(getcmd(buf, 100 /*sizeof(buf)*/) >= 0){ + if(buf[0] == 'c' && buf[1] == 'd' && buf[2] == ' '){ + // Chdir must be called by the parent, not the child. + buf[strlen(buf)-1] = 0; // chop \n + if(chdir(buf+3) < 0) + fprintf(2, "cannot cd %s\n", buf+3); + continue; + } + if(fork1() == 0) + runcmd(parsecmd(buf)); + wait(0); + } + exit(0); +} + +void +panic(char *s) +{ + fprintf(2, "%s\n", s); + exit(1); +} + +int +fork1(void) +{ + int pid; + + pid = fork(); + if(pid == -1) + panic("fork"); + return pid; +} + +//PAGEBREAK! +// Constructors + +struct cmd* +execcmd(void) +{ + struct execcmd *cmd; + + cmd = malloc(sizeof(struct execcmd /**cmd*/)); + memset(cmd, 0, sizeof(struct execcmd /**cmd*/)); + cmd->type = EXEC; + return (struct cmd*)cmd; +} + +struct cmd* +redircmd(struct cmd *subcmd, char *file, char *efile, int mode, int fd) +{ + struct redircmd *cmd; + + cmd = malloc(sizeof(struct redircmd /**cmd*/)); + memset(cmd, 0, sizeof(struct redircmd /**cmd*/)); + cmd->type = REDIR; + cmd->cmd = subcmd; + cmd->file = file; + cmd->efile = efile; + cmd->mode = mode; + cmd->fd = fd; + return (struct cmd*)cmd; +} + +struct cmd* +pipecmd(struct cmd *left, struct cmd *right) +{ + struct pipecmd *cmd; + + cmd = malloc(sizeof(struct pipecmd /**cmd*/)); + memset(cmd, 0, sizeof(struct pipecmd /**cmd*/)); + cmd->type = PIPE; + cmd->left = left; + cmd->right = right; + return (struct cmd*)cmd; +} + +struct cmd* +listcmd(struct cmd *left, struct cmd *right) +{ + struct listcmd *cmd; + + cmd = malloc(sizeof(struct listcmd /**cmd*/)); + memset(cmd, 0, sizeof(struct listcmd /**cmd*/)); + cmd->type = LIST; + cmd->left = left; + cmd->right = right; + return (struct cmd*)cmd; +} + +struct cmd* +backcmd(struct cmd *subcmd) +{ + struct backcmd *cmd; + + cmd = malloc(sizeof(struct backcmd /**cmd*/)); + memset(cmd, 0, sizeof(struct backcmd /**cmd*/)); + cmd->type = BACK; + cmd->cmd = subcmd; + return (struct cmd*)cmd; +} +//PAGEBREAK! +// Parsing + +int +gettoken(char **ps, char *es, char **q, char **eq) +{ + const char* whitespace = " \t\r\n\v"; + const char* symbols = "<|>&;()"; + char *s; + int ret; + + s = *ps; + while(s < es && strchr(whitespace, *s)) + s++; + if(q) + *q = s; + ret = *s; + switch(*s){ + case 0: + break; + case '|': + case '(': + case ')': + case ';': + case '&': + case '<': + s++; + break; + case '>': + s++; + if(*s == '>'){ + ret = '+'; + s++; + } + break; + default: + ret = 'a'; + while(s < es && !strchr(whitespace, *s) && !strchr(symbols, *s)) + s++; + break; + } + if(eq) + *eq = s; + + while(s < es && strchr(whitespace, *s)) + s++; + *ps = s; + return ret; +} + +int +peek(char **ps, char *es, char *toks) +{ + const char* whitespace = " \t\r\n\v"; + char *s; + + s = *ps; + while(s < es && strchr(whitespace, *s)) + s++; + *ps = s; + return *s && strchr(toks, *s); +} + +struct cmd *parseline(char**, char*); +struct cmd *parsepipe(char**, char*); +struct cmd *parseexec(char**, char*); +struct cmd *nulterminate(struct cmd*); + +struct cmd* +parsecmd(char *s) +{ + char *es; + struct cmd *cmd; + + es = s + strlen(s); + cmd = parseline(&s, es); + peek(&s, es, ""); + if(s != es){ + fprintf(2, "leftovers: %s\n", s); + panic("syntax"); + } + nulterminate(cmd); + return cmd; +} + +struct cmd* +parseline(char **ps, char *es) +{ + struct cmd *cmd; + + cmd = parsepipe(ps, es); + while(peek(ps, es, "&")){ + gettoken(ps, es, 0, 0); + cmd = backcmd(cmd); + } + if(peek(ps, es, ";")){ + gettoken(ps, es, 0, 0); + cmd = listcmd(cmd, parseline(ps, es)); + } + return cmd; +} + +struct cmd* +parsepipe(char **ps, char *es) +{ + struct cmd *cmd; + + cmd = parseexec(ps, es); + if(peek(ps, es, "|")){ + gettoken(ps, es, 0, 0); + cmd = pipecmd(cmd, parsepipe(ps, es)); + } + return cmd; +} + +struct cmd* +parseredirs(struct cmd *cmd, char **ps, char *es) +{ + int tok; + char *q, *eq; + + while(peek(ps, es, "<>")){ + tok = gettoken(ps, es, 0, 0); + if(gettoken(ps, es, &q, &eq) != 'a') + panic("missing file for redirection"); + switch(tok){ + case '<': + cmd = redircmd(cmd, q, eq, O_RDONLY, 0); + break; + case '>': + cmd = redircmd(cmd, q, eq, O_WRONLY|O_CREATE|O_TRUNC, 1); + break; + case '+': // >> + cmd = redircmd(cmd, q, eq, O_WRONLY|O_CREATE, 1); + break; + } + } + return cmd; +} + +struct cmd* +parseblock(char **ps, char *es) +{ + struct cmd *cmd; + + if(!peek(ps, es, "(")) + panic("parseblock"); + gettoken(ps, es, 0, 0); + cmd = parseline(ps, es); + if(!peek(ps, es, ")")) + panic("syntax - missing )"); + gettoken(ps, es, 0, 0); + cmd = parseredirs(cmd, ps, es); + return cmd; +} + +struct cmd* +parseexec(char **ps, char *es) +{ + char *q, *eq; + int tok, argc; + struct execcmd *cmd; + struct cmd *ret; + + if(peek(ps, es, "(")) + return parseblock(ps, es); + + ret = execcmd(); + cmd = (struct execcmd*)ret; + + argc = 0; + ret = parseredirs(ret, ps, es); + while(!peek(ps, es, "|)&;")){ + if((tok=gettoken(ps, es, &q, &eq)) == 0) + break; + if(tok != 'a') + panic("syntax"); + cmd->argv[argc] = q; + cmd->eargv[argc] = eq; + argc++; + if(argc >= MAXARGS) + panic("too many args"); + ret = parseredirs(ret, ps, es); + } + cmd->argv[argc] = 0; + cmd->eargv[argc] = 0; + + return ret; +} + +// NUL-terminate all the counted strings. +struct cmd* +nulterminate(struct cmd *cmd) +{ + int i; + struct backcmd *bcmd; + struct execcmd *ecmd; + struct listcmd *lcmd; + struct pipecmd *pcmd; + struct redircmd *rcmd; + + if(cmd == 0) + return 0; + + switch(cmd->type){ + case EXEC: + ecmd = (struct execcmd*)cmd; + for(i=0; ecmd->argv[i]; i++) + *ecmd->eargv[i] = 0; + break; + + case REDIR: + rcmd = (struct redircmd*)cmd; + nulterminate(rcmd->cmd); + *rcmd->efile = 0; + break; + + case PIPE: + pcmd = (struct pipecmd*)cmd; + nulterminate(pcmd->left); + nulterminate(pcmd->right); + break; + + case LIST: + lcmd = (struct listcmd*)cmd; + nulterminate(lcmd->left); + nulterminate(lcmd->right); + break; + + case BACK: + bcmd = (struct backcmd*)cmd; + nulterminate(bcmd->cmd); + break; + } + return cmd; +} diff --git a/stressfs.c b/stressfs.c new file mode 100644 index 0000000..247a7a5 --- /dev/null +++ b/stressfs.c @@ -0,0 +1,49 @@ +// Demonstrate that moving the "acquire" in iderw after the loop that +// appends to the idequeue results in a race. + +// For this to work, you should also add a spin within iderw's +// idequeue traversal loop. Adding the following demonstrated a panic +// after about 5 runs of stressfs in QEMU on a 2.1GHz CPU: +// for (i = 0; i < 40000; i++) +// asm volatile(""); + +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" +#include "kernel/fs.h" +#include "kernel/fcntl.h" + +int +main(int argc, char *argv[]) +{ + int fd, i; + char path[] = "stressfs0"; + char data[512]; + + printf("stressfs starting\n"); + memset(data, 'a', sizeof(data)); + + for(i = 0; i < 4; i++) + if(fork() > 0) + break; + + printf("write %d\n", i); + + path[8] += i; + fd = open(path, O_CREATE | O_RDWR); + for(i = 0; i < 20; i++) +// printf(fd, "%d\n", i); + write(fd, data, sizeof(data)); + close(fd); + + printf("read\n"); + + fd = open(path, O_RDONLY); + for (i = 0; i < 20; i++) + read(fd, data, sizeof(data)); + close(fd); + + wait(0); + + exit(0); +} diff --git a/thrdtest.c b/thrdtest.c new file mode 100644 index 0000000..e75f683 --- /dev/null +++ b/thrdtest.c @@ -0,0 +1,112 @@ +// Test that thrd succeeds or fails gracefully. +// This file was modified from the xv6-based forktest.c +// Tiny executable so that the limit can be filling the proc table. + +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" + +// N should be set HIGHER than the limit! +#define N 10 + +void +print(const char *s) +{ + write(1, s, strlen(s)); +} + +void printdec(unsigned int i) { + if (i == 0) { + print("0"); + return; + } + char foo[11]; + int idx = 10; + while (i > 0) { + idx--; + foo[idx] = '0' + (i%10); + i /= 10; + } + foo[10] = 0; + print(foo+idx); +} + +void thrdf(uint64 thrdnum) { + print("Hello from thread #"); printdec((int)thrdnum); print("\n"); + int i, j, ch, pr; + pr = 7-(getpid() % 4); + ch = '0'+pr; + prio(getpid(), pr, 4); + //sleep(1); + for (i = 0; i < 100; i++) { + for (j = 0; j < 256; j++) { + ch++; + } + char str[2]; + str[0] = (char)ch; + str[1] = 0; + print(str); + } + exit(0); +} + +void +thrdtest(void) +{ + int n, pid; + + print("thrd test\n"); + + print("thrdf is at "); printdec((int)(uint64)&thrdf); print("\n"); + //print("testing printdec(12345)="); printdec(12345); print("\n"); + print("attempting to launch up to N="); printdec(N); print(" processes in the same address space...\n"); + + for(n=0; n 0; n--){ + if(wait(0) < 0){ + print("wait stopped early\n"); + exit(1); + } + } + + if(wait(0) != -1){ + print("wait got too many\n"); + exit(1); + } + + print("\nthrd() test OK\n"); +} + +int +main(void) +{ + thrdtest(); + exit(0); +} diff --git a/ulib.c b/ulib.c new file mode 100644 index 0000000..28fb841 --- /dev/null +++ b/ulib.c @@ -0,0 +1,162 @@ +//#include "kernel/types.h" +// Avoid reimplementing optimisations to string routines everywhere +#include "kernel/string.c" + +#include "kernel/stat.h" +#include "kernel/fcntl.h" +#include "user/user.h" + +// +// wrapper so that it's OK if main() does not call exit(). +// +void +start() +{ + extern int main(); + main(); + exit(0); +} + +// exec() now needs to be implemented on top of execve() +// but for now we can just pass a single NULL in the env array +int exec(const char* name, char** argv) { + char* envpointers[1]; + envpointers[0] = (void*)0ULL; + return execve(name, argv, envpointers); +} + +/* +char* +strcpy(char *s, const char *t) +{ + char *os; + + os = s; + while((*s++ = *t++) != 0) + ; + return os; +} + +int +strcmp(const char *p, const char *q) +{ + while(*p && *p == *q) + p++, q++; + return (uchar)*p - (uchar)*q; +} + +uint +strlen(const char *s) +{ + int n; + + for(n = 0; s[n]; n++) + ; + return n; +} + +void* +memset(void *dst, int c, uint n) +{ + char *cdst = (char *) dst; + int i; + for(i = 0; i < n; i++){ + cdst[i] = c; + } + return dst; +} + +char* +strchr(const char *s, char c) +{ + for(; *s; s++) + if(*s == c) + return (char*)s; + return 0; +} +*/ + +char* +gets(char *buf, int max) +{ + int i, cc; + char c; + + for(i=0; i+1 < max; ){ + cc = read(0, &c, 1); + if(cc < 1) + break; + buf[i++] = c; + if(c == '\n' || c == '\r') + break; + } + buf[i] = '\0'; + return buf; +} + +int +stat(const char *n, struct stat *st) +{ + int fd; + int r; + + fd = open(n, O_RDONLY); + if(fd < 0) + return -1; + r = fstat(fd, st); + close(fd); + return r; +} + +/* +int +atoi(const char *s) +{ + int n; + + n = 0; + while('0' <= *s && *s <= '9') + n = n*10 + *s++ - '0'; + return n; +} + +void* +memmove(void *vdst, const void *vsrc, int n) +{ + char *dst; + const char *src; + + dst = vdst; + src = vsrc; + if (src > dst) { + while(n-- > 0) + *dst++ = *src++; + } else { + dst += n; + src += n; + while(n-- > 0) + *--dst = *--src; + } + return vdst; +} + +int +memcmp(const void *s1, const void *s2, uint n) +{ + const char *p1 = s1, *p2 = s2; + while (n-- > 0) { + if (*p1 != *p2) { + return *p1 - *p2; + } + p1++; + p2++; + } + return 0; +} + +void * +memcpy(void *dst, const void *src, uint n) +{ + return memmove(dst, src, n); +} +*/ diff --git a/umalloc.c b/umalloc.c new file mode 100644 index 0000000..2092a32 --- /dev/null +++ b/umalloc.c @@ -0,0 +1,90 @@ +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" +#include "kernel/param.h" + +// Memory allocator by Kernighan and Ritchie, +// The C programming Language, 2nd ed. Section 8.7. + +typedef long Align; + +union header { + struct { + union header *ptr; + uint size; + } s; + Align x; +}; + +typedef union header Header; + +static Header base; +static Header *freep; + +void +free(void *ap) +{ + Header *bp, *p; + + bp = (Header*)ap - 1; + for(p = freep; !(bp > p && bp < p->s.ptr); p = p->s.ptr) + if(p >= p->s.ptr && (bp > p || bp < p->s.ptr)) + break; + if(bp + bp->s.size == p->s.ptr){ + bp->s.size += p->s.ptr->s.size; + bp->s.ptr = p->s.ptr->s.ptr; + } else + bp->s.ptr = p->s.ptr; + if(p + p->s.size == bp){ + p->s.size += bp->s.size; + p->s.ptr = bp->s.ptr; + } else + p->s.ptr = bp; + freep = p; +} + +static Header* +morecore(uint nu) +{ + char *p; + Header *hp; + + if(nu < 4096) + nu = 4096; + p = sbrk(nu * sizeof(Header)); + if(p == (char*)-1) + return 0; + hp = (Header*)p; + hp->s.size = nu; + free((void*)(hp + 1)); + return freep; +} + +void* +malloc(uint nbytes) +{ + Header *p, *prevp; + uint nunits; + + nunits = (nbytes + sizeof(Header) - 1)/sizeof(Header) + 1; + if((prevp = freep) == 0){ + base.s.ptr = freep = prevp = &base; + base.s.size = 0; + } + for(p = prevp->s.ptr; ; prevp = p, p = p->s.ptr){ + if(p->s.size >= nunits){ + if(p->s.size == nunits) + prevp->s.ptr = p->s.ptr; + else { + p->s.size -= nunits; + p += p->s.size; + p->s.size = nunits; + } + freep = prevp; + return (void*)(p + 1); + } + if(p == freep) + if((p = morecore(nunits)) == 0) + return 0; + } +} diff --git a/user.h b/user.h new file mode 100644 index 0000000..69ede52 --- /dev/null +++ b/user.h @@ -0,0 +1,63 @@ +struct stat; + +// system calls +int fork(void); +#ifdef _ZCC +int exit(int); +#else +int exit(int) __attribute__((noreturn)); +#endif +int wait(int*); +int pipe(int*); +int write(int, const void*, int); +int read(int, void*, int); +int close(int); +int kill(int); +int execve(const char*, char**, char**); // New/modified system call +int open(const char*, int); +int mknod(const char*, short, short); +int unlink(const char*); +int fstat(int fd, struct stat*); +int link(const char*, const char*); +int mkdir(const char*); +int chdir(const char*); +int dup(int); +int getpid(void); +char* sbrk(int); +int sleep(int); +int uptime(void); +// New system call, set priority +// first implementation only works/worked on current pid +int prio(int pid, int newprio, int newlimit); +// Set processor affinity, pid must be current pid and range must be 0 for now +int affin(int pid, int range, uint64 mask); +// New system call, start thread +// Typedef for the thread function +typedef void (*thrd_fnc_t)(uint64 arg); +// Less-typesafe version: int thrd(int pid, uint64 fnc, uint64 stk, uint64 arg); +int thrd(int frompid, thrd_fnc_t fnc, void* stk, uint64 arg); + +// ulib.c +int exec(const char*, char**); // Now implemented on top of execve +int stat(const char*, struct stat*); +char* strcpy(char*, const char*); +void *memmove(void*, const void*, uint); +char* strchr(const char*, int c); +int strcmp(const char*, const char*); +#ifdef _ZCC +void __classic_call fprintf(int, const char*, ...); +void __classic_call printf(const char*, ...); +#else +void fprintf(int, const char*, ...) __attribute__ ((format (printf, 2, 3))); +void printf(const char*, ...) __attribute__ ((format (printf, 1, 2))); +#endif +char* gets(char*, int max); +long int strlen(const char*); +void* memset(void*, int, long int); +int atoi(const char*); +int memcmp(const void *, const void *, uint); +void *memcpy(void *, const void *, long int); + +// umalloc.c +void* malloc(uint); +void free(void*); diff --git a/user.ld b/user.ld new file mode 100644 index 0000000..3da93e0 --- /dev/null +++ b/user.ld @@ -0,0 +1,39 @@ +OUTPUT_ARCH( "riscv" ) + +SECTIONS +{ + . = 0x0; + + .text : { + *(.text .text.*) + } + + .rodata : { + . = ALIGN(16); + *(.srodata .srodata.*) /* do not need to distinguish this from .rodata */ + . = ALIGN(16); + *(.rodata .rodata.*) + } + + .eh_frame : { + *(.eh_frame) + *(.eh_frame.*) + } + + . = ALIGN(0x1000); + .data : { + . = ALIGN(16); + *(.sdata .sdata.*) /* do not need to distinguish this from .data */ + . = ALIGN(16); + *(.data .data.*) + } + + .bss : { + . = ALIGN(16); + *(.sbss .sbss.*) /* do not need to distinguish this from .bss */ + . = ALIGN(16); + *(.bss .bss.*) + } + + PROVIDE(end = .); +} diff --git a/usertests.c b/usertests.c new file mode 100644 index 0000000..801d694 --- /dev/null +++ b/usertests.c @@ -0,0 +1,3118 @@ +#include "kernel/param.h" +#include "kernel/types.h" +#include "kernel/stat.h" +#include "user/user.h" +#include "kernel/fs.h" +#include "kernel/fcntl.h" +#include "kernel/syscall.h" +#include "kernel/memlayout.h" +#include "kernel/riscv.h" + +// +// Tests xv6 system calls. usertests without arguments runs them all +// and usertests runs test. The test runner creates for +// each test a process and based on the exit status of the process, +// the test runner reports "OK" or "FAILED". Some tests result in +// kernel printing usertrap messages, which can be ignored if test +// prints "OK". +// + +#define BUFSZ ((MAXOPBLOCKS+2)*BSIZE) + +char buf[BUFSZ]; + +// +// Section with tests that run fairly quickly. Use -q if you want to +// run just those. With -q usertests also runs the ones that take a +// fair of time. +// + +// what if you pass ridiculous pointers to system calls +// that read user memory with copyin? +void +copyin(char *s) +{ + uint64 addrs[] = { 0x80000000ULL, 0x3fffffe000ULL, 0x3ffffff000ULL, 0x4000000000ULL, + 0xffffffffffffffffULL }; + + for(int ai = 0; ai < 5 /*sizeof(addrs)/sizeof(addrs[0])*/; ai++){ + uint64 addr = addrs[ai]; + + int fd = open("copyin1", O_CREATE|O_WRONLY); + if(fd < 0){ + printf("open(copyin1) failed\n"); + exit(1); + } + int n = write(fd, (void*)addr, 8192); + if(n >= 0){ + printf("write(fd, %p, 8192) returned %d, not -1\n", (void*)addr, n); + exit(1); + } + close(fd); + unlink("copyin1"); + + n = write(1, (char*)addr, 8192); + if(n > 0){ + printf("write(1, %p, 8192) returned %d, not -1 or 0\n", (void*)addr, n); + exit(1); + } + + int fds[2]; + if(pipe(fds) < 0){ + printf("pipe() failed\n"); + exit(1); + } + n = write(fds[1], (char*)addr, 8192); + if(n > 0){ + printf("write(pipe, %p, 8192) returned %d, not -1 or 0\n", (void*)addr, n); + exit(1); + } + close(fds[0]); + close(fds[1]); + } +} + +// what if you pass ridiculous pointers to system calls +// that write user memory with copyout? +void +copyout(char *s) +{ + uint64 addrs[] = { 0LL, 0x80000000ULL, 0x3fffffe000ULL, 0x3ffffff000ULL, 0x4000000000ULL, + 0xffffffffffffffffULL }; + + for(int ai = 0; ai < 5 /*sizeof(addrs)/sizeof(addrs[0])*/; ai++){ + uint64 addr = addrs[ai]; + + int fd = open("README", 0); + if(fd < 0){ + printf("open(README) failed\n"); + exit(1); + } + int n = read(fd, (void*)addr, 8192); + if(n > 0){ + printf("read(fd, %p, 8192) returned %d, not -1 or 0\n", (void*)addr, n); + exit(1); + } + close(fd); + + int fds[2]; + if(pipe(fds) < 0){ + printf("pipe() failed\n"); + exit(1); + } + n = write(fds[1], "x", 1); + if(n != 1){ + printf("pipe write failed\n"); + exit(1); + } + n = read(fds[0], (void*)addr, 8192); + if(n > 0){ + printf("read(pipe, %p, 8192) returned %d, not -1 or 0\n", (void*)addr, n); + exit(1); + } + close(fds[0]); + close(fds[1]); + } +} + +// what if you pass ridiculous string pointers to system calls? +void +copyinstr1(char *s) +{ + uint64 addrs[] = { 0x80000000ULL, 0x3fffffe000ULL, 0x3ffffff000ULL, 0x4000000000ULL, + 0xffffffffffffffffULL }; + + for(int ai = 0; ai < 5 /*sizeof(addrs)/sizeof(addrs[0])*/; ai++){ + uint64 addr = addrs[ai]; + + int fd = open((char *)addr, O_CREATE|O_WRONLY); + if(fd >= 0){ + printf("open(%p) returned %d, not -1\n", (void*)addr, fd); + exit(1); + } + } +} + +// what if a string system call argument is exactly the size +// of the kernel buffer it is copied into, so that the null +// would fall just beyond the end of the kernel buffer? +void +copyinstr2(char *s) +{ + char b[MAXPATH+1]; + + for(int i = 0; i < MAXPATH; i++) + b[i] = 'x'; + b[MAXPATH] = '\0'; + + int ret = unlink(b); + if(ret != -1){ + printf("unlink(%s) returned %d, not -1\n", b, ret); + exit(1); + } + + int fd = open(b, O_CREATE | O_WRONLY); + if(fd != -1){ + printf("open(%s) returned %d, not -1\n", b, fd); + exit(1); + } + + ret = link(b, b); + if(ret != -1){ + printf("link(%s, %s) returned %d, not -1\n", b, b, ret); + exit(1); + } + + char *args[] = { "xx", 0 }; + ret = exec(b, args); + if(ret != -1){ + printf("exec(%s) returned %d, not -1\n", b, fd); + exit(1); + } + + int pid = fork(); + if(pid < 0){ + printf("fork failed\n"); + exit(1); + } + if(pid == 0){ + static char big[PGSIZE+1]; + for(int i = 0; i < PGSIZE; i++) + big[i] = 'x'; + big[PGSIZE] = '\0'; + char *args2[] = { big, big, big, 0 }; + ret = exec("echo", args2); + if(ret != -1){ + printf("exec(echo, BIG) returned %d, not -1\n", fd); + exit(1); + } + exit(747); // OK + } + + int st = 0; + wait(&st); + if(st != 747){ + printf("exec(echo, BIG) succeeded, should have failed\n"); + exit(1); + } +} + +// what if a string argument crosses over the end of last user page? +void +copyinstr3(char *s) +{ + sbrk(8192); + uint64 top = (uint64) sbrk(0); + if((top % PGSIZE) != 0){ + sbrk(PGSIZE - (top % PGSIZE)); + } + top = (uint64) sbrk(0); + if(top % PGSIZE){ + printf("oops\n"); + exit(1); + } + + char *b = (char *) (top - 1); + *b = 'x'; + + int ret = unlink(b); + if(ret != -1){ + printf("unlink(%s) returned %d, not -1\n", b, ret); + exit(1); + } + + int fd = open(b, O_CREATE | O_WRONLY); + if(fd != -1){ + printf("open(%s) returned %d, not -1\n", b, fd); + exit(1); + } + + ret = link(b, b); + if(ret != -1){ + printf("link(%s, %s) returned %d, not -1\n", b, b, ret); + exit(1); + } + + char *args[] = { "xx", 0 }; + ret = exec(b, args); + if(ret != -1){ + printf("exec(%s) returned %d, not -1\n", b, fd); + exit(1); + } +} + +// See if the kernel refuses to read/write user memory that the +// application doesn't have anymore, because it returned it. +void +rwsbrk() +{ + int fd, n; + + uint64 a = (uint64) sbrk(8192); + + if(a == 0xffffffffffffffffULL) { + printf("sbrk(rwsbrk) failed\n"); + exit(1); + } + + if ((uint64) sbrk(-8192) == 0xffffffffffffffffULL) { + printf("sbrk(rwsbrk) shrink failed\n"); + exit(1); + } + + fd = open("rwsbrk", O_CREATE|O_WRONLY); + if(fd < 0){ + printf("open(rwsbrk) failed\n"); + exit(1); + } + n = write(fd, (void*)(a+4096), 1024); + if(n >= 0){ + printf("write(fd, %p, 1024) returned %d, not -1\n", (void*)a+4096, n); + exit(1); + } + close(fd); + unlink("rwsbrk"); + + fd = open("README", O_RDONLY); + if(fd < 0){ + printf("open(rwsbrk) failed\n"); + exit(1); + } + n = read(fd, (void*)(a+4096), 10); + if(n >= 0){ + printf("read(fd, %p, 10) returned %d, not -1\n", (void*)a+4096, n); + exit(1); + } + close(fd); + + exit(0); +} + +// test O_TRUNC. +void +truncate1(char *s) +{ + char buf[32]; + + unlink("truncfile"); + int fd1 = open("truncfile", O_CREATE|O_WRONLY|O_TRUNC); + write(fd1, "abcd", 4); + close(fd1); + + int fd2 = open("truncfile", O_RDONLY); + int n = read(fd2, buf, sizeof(buf)); + if(n != 4){ + printf("%s: read %d bytes, wanted 4\n", s, n); + exit(1); + } + + fd1 = open("truncfile", O_WRONLY|O_TRUNC); + + int fd3 = open("truncfile", O_RDONLY); + n = read(fd3, buf, sizeof(buf)); + if(n != 0){ + printf("aaa fd3=%d\n", fd3); + printf("%s: read %d bytes, wanted 0\n", s, n); + exit(1); + } + + n = read(fd2, buf, sizeof(buf)); + if(n != 0){ + printf("bbb fd2=%d\n", fd2); + printf("%s: read %d bytes, wanted 0\n", s, n); + exit(1); + } + + write(fd1, "abcdef", 6); + + n = read(fd3, buf, sizeof(buf)); + if(n != 6){ + printf("%s: read %d bytes, wanted 6\n", s, n); + exit(1); + } + + n = read(fd2, buf, sizeof(buf)); + if(n != 2){ + printf("%s: read %d bytes, wanted 2\n", s, n); + exit(1); + } + + unlink("truncfile"); + + close(fd1); + close(fd2); + close(fd3); +} + +// write to an open FD whose file has just been truncated. +// this causes a write at an offset beyond the end of the file. +// such writes fail on xv6 (unlike POSIX) but at least +// they don't crash. +void +truncate2(char *s) +{ + unlink("truncfile"); + + int fd1 = open("truncfile", O_CREATE|O_TRUNC|O_WRONLY); + write(fd1, "abcd", 4); + + int fd2 = open("truncfile", O_TRUNC|O_WRONLY); + + int n = write(fd1, "x", 1); + if(n != -1){ + printf("%s: write returned %d, expected -1\n", s, n); + exit(1); + } + + unlink("truncfile"); + close(fd1); + close(fd2); +} + +void +truncate3(char *s) +{ + int pid, xstatus; + + close(open("truncfile", O_CREATE|O_TRUNC|O_WRONLY)); + + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + + if(pid == 0){ + for(int i = 0; i < 100; i++){ + char buf[32]; + int fd = open("truncfile", O_WRONLY); + if(fd < 0){ + printf("%s: open failed\n", s); + exit(1); + } + int n = write(fd, "1234567890", 10); + if(n != 10){ + printf("%s: write got %d, expected 10\n", s, n); + exit(1); + } + close(fd); + fd = open("truncfile", O_RDONLY); + read(fd, buf, sizeof(buf)); + close(fd); + } + exit(0); + } + + for(int i = 0; i < 150; i++){ + int fd = open("truncfile", O_CREATE|O_WRONLY|O_TRUNC); + if(fd < 0){ + printf("%s: open failed\n", s); + exit(1); + } + int n = write(fd, "xxx", 3); + if(n != 3){ + printf("%s: write got %d, expected 3\n", s, n); + exit(1); + } + close(fd); + } + + wait(&xstatus); + unlink("truncfile"); + exit(xstatus); +} + + +// does chdir() call iput(p->cwd) in a transaction? +void +iputtest(char *s) +{ + if(mkdir("iputdir") < 0){ + printf("%s: mkdir failed\n", s); + exit(1); + } + if(chdir("iputdir") < 0){ + printf("%s: chdir iputdir failed\n", s); + exit(1); + } + if(unlink("../iputdir") < 0){ + printf("%s: unlink ../iputdir failed\n", s); + exit(1); + } + if(chdir("/") < 0){ + printf("%s: chdir / failed\n", s); + exit(1); + } +} + +// does exit() call iput(p->cwd) in a transaction? +void +exitiputtest(char *s) +{ + int pid, xstatus; + + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid == 0){ + if(mkdir("iputdir") < 0){ + printf("%s: mkdir failed\n", s); + exit(1); + } + if(chdir("iputdir") < 0){ + printf("%s: child chdir failed\n", s); + exit(1); + } + if(unlink("../iputdir") < 0){ + printf("%s: unlink ../iputdir failed\n", s); + exit(1); + } + exit(0); + } + wait(&xstatus); + exit(xstatus); +} + +// does the error path in open() for attempt to write a +// directory call iput() in a transaction? +// needs a hacked kernel that pauses just after the namei() +// call in sys_open(): +// if((ip = namei(path)) == 0) +// return -1; +// { +// int i; +// for(i = 0; i < 10000; i++) +// yield(); +// } +void +openiputtest(char *s) +{ + int pid, xstatus; + + if(mkdir("oidir") < 0){ + printf("%s: mkdir oidir failed\n", s); + exit(1); + } + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid == 0){ + int fd = open("oidir", O_RDWR); + if(fd >= 0){ + printf("%s: open directory for write succeeded\n", s); + exit(1); + } + exit(0); + } + sleep(1); + if(unlink("oidir") != 0){ + printf("%s: unlink failed\n", s); + exit(1); + } + wait(&xstatus); + exit(xstatus); +} + +// simple file system tests + +void +opentest(char *s) +{ + int fd; + + fd = open("echo", 0); + if(fd < 0){ + printf("%s: open echo failed!\n", s); + exit(1); + } + close(fd); + fd = open("doesnotexist", 0); + if(fd >= 0){ + printf("%s: open doesnotexist succeeded!\n", s); + exit(1); + } +} + +void +writetest(char *s) +{ + int fd; + int i; + enum { N=100, SZ=10 }; + + fd = open("small", O_CREATE|O_RDWR); + if(fd < 0){ + printf("%s: error: creat small failed!\n", s); + exit(1); + } + for(i = 0; i < N; i++){ + if(write(fd, "aaaaaaaaaa", SZ) != SZ){ + printf("%s: error: write aa %d new file failed\n", s, i); + exit(1); + } + if(write(fd, "bbbbbbbbbb", SZ) != SZ){ + printf("%s: error: write bb %d new file failed\n", s, i); + exit(1); + } + } + close(fd); + fd = open("small", O_RDONLY); + if(fd < 0){ + printf("%s: error: open small failed!\n", s); + exit(1); + } + i = read(fd, buf, N*SZ*2); + if(i != N*SZ*2){ + printf("%s: read failed\n", s); + exit(1); + } + close(fd); + + if(unlink("small") < 0){ + printf("%s: unlink small failed\n", s); + exit(1); + } +} + +void +writebig(char *s) +{ + int i, fd, n; + + fd = open("big", O_CREATE|O_RDWR); + if(fd < 0){ + printf("%s: error: creat big failed!\n", s); + exit(1); + } + + for(i = 0; i < MAXFILE; i++){ + ((int*)buf)[0] = i; + if(write(fd, buf, BSIZE) != BSIZE){ + printf("%s: error: write big file failed i=%d\n", s, i); + exit(1); + } + } + + close(fd); + + fd = open("big", O_RDONLY); + if(fd < 0){ + printf("%s: error: open big failed!\n", s); + exit(1); + } + + n = 0; + for(;;){ + i = read(fd, buf, BSIZE); + if(i == 0){ + if(n != MAXFILE){ + printf("%s: read only %d blocks from big", s, n); + exit(1); + } + break; + } else if(i != BSIZE){ + printf("%s: read failed %d\n", s, i); + exit(1); + } + if(((int*)buf)[0] != n){ + printf("%s: read content of block %d is %d\n", s, + n, ((int*)buf)[0]); + exit(1); + } + n++; + } + close(fd); + if(unlink("big") < 0){ + printf("%s: unlink big failed\n", s); + exit(1); + } +} + +// many creates, followed by unlink test +void +createtest(char *s) +{ + int i, fd; + enum { N=52 }; + + char name[3]; + name[0] = 'a'; + name[2] = '\0'; + for(i = 0; i < N; i++){ + name[1] = '0' + i; + fd = open(name, O_CREATE|O_RDWR); + close(fd); + } + name[0] = 'a'; + name[2] = '\0'; + for(i = 0; i < N; i++){ + name[1] = '0' + i; + unlink(name); + } +} + +void dirtest(char *s) +{ + if(mkdir("dir0") < 0){ + printf("%s: mkdir failed\n", s); + exit(1); + } + + if(chdir("dir0") < 0){ + printf("%s: chdir dir0 failed\n", s); + exit(1); + } + + if(chdir("..") < 0){ + printf("%s: chdir .. failed\n", s); + exit(1); + } + + if(unlink("dir0") < 0){ + printf("%s: unlink dir0 failed\n", s); + exit(1); + } +} + +void +exectest(char *s) +{ + int fd, xstatus, pid; + char *echoargv[] = { "echo", "OK", 0 }; + char buf[3]; + + unlink("echo-ok"); + pid = fork(); + if(pid < 0) { + printf("%s: fork failed\n", s); + exit(1); + } + if(pid == 0) { + close(1); + fd = open("echo-ok", O_CREATE|O_WRONLY); + if(fd < 0) { + printf("%s: create failed\n", s); + exit(1); + } + if(fd != 1) { + printf("%s: wrong fd\n", s); + exit(1); + } + if(exec("echo", echoargv) < 0){ + printf("%s: exec echo failed\n", s); + exit(1); + } + // won't get to here + } + if (wait(&xstatus) != pid) { + printf("%s: wait failed!\n", s); + } + if(xstatus != 0) + exit(xstatus); + + fd = open("echo-ok", O_RDONLY); + if(fd < 0) { + printf("%s: open failed\n", s); + exit(1); + } + if (read(fd, buf, 2) != 2) { + printf("%s: read failed\n", s); + exit(1); + } + unlink("echo-ok"); + if(buf[0] == 'O' && buf[1] == 'K') + exit(0); + else { + printf("%s: wrong output\n", s); + exit(1); + } + +} + +// simple fork and pipe read/write + +void +pipe1(char *s) +{ + int fds[2], pid, xstatus; + int seq, i, n, cc, total; + enum { N=5, SZ=1033 }; + + if(pipe(fds) != 0){ + printf("%s: pipe() failed\n", s); + exit(1); + } + pid = fork(); + seq = 0; + if(pid == 0){ + close(fds[0]); + for(n = 0; n < N; n++){ + for(i = 0; i < SZ; i++) + buf[i] = seq++; + if(write(fds[1], buf, SZ) != SZ){ + printf("%s: pipe1 oops 1\n", s); + exit(1); + } + } + exit(0); + } else if(pid > 0){ + close(fds[1]); + total = 0; + cc = 1; + while((n = read(fds[0], buf, cc)) > 0){ + for(i = 0; i < n; i++){ + if((buf[i] & 0xff) != (seq++ & 0xff)){ + printf("%s: pipe1 oops 2\n", s); + return; + } + } + total += n; + cc = cc * 2; + if(cc > sizeof(buf)) + cc = sizeof(buf); + } + if(total != N * SZ){ + printf("%s: pipe1 oops 3 total %d\n", s, total); + exit(1); + } + close(fds[0]); + wait(&xstatus); + exit(xstatus); + } else { + printf("%s: fork() failed\n", s); + exit(1); + } +} + + +// test if child is killed (status = -1) +void +killstatus(char *s) +{ + int xst; + + for(int i = 0; i < 100; i++){ + int pid1 = fork(); + if(pid1 < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid1 == 0){ + while(1) { + getpid(); + } + exit(0); + } + sleep(1); + kill(pid1); + wait(&xst); + if(xst != -1) { + printf("%s: status should be -1\n", s); + exit(1); + } + } + exit(0); +} + +// meant to be run w/ at most two CPUs +void +preempt(char *s) +{ + int pid1, pid2, pid3; + int pfds[2]; + + pid1 = fork(); + if(pid1 < 0) { + printf("%s: fork failed", s); + exit(1); + } + if(pid1 == 0) + for(;;) + ; + + pid2 = fork(); + if(pid2 < 0) { + printf("%s: fork failed\n", s); + exit(1); + } + if(pid2 == 0) + for(;;) + ; + + pipe(pfds); + pid3 = fork(); + if(pid3 < 0) { + printf("%s: fork failed\n", s); + exit(1); + } + if(pid3 == 0){ + close(pfds[0]); + if(write(pfds[1], "x", 1) != 1) + printf("%s: preempt write error", s); + close(pfds[1]); + for(;;) + ; + } + + close(pfds[1]); + if(read(pfds[0], buf, sizeof(buf)) != 1){ + printf("%s: preempt read error", s); + return; + } + close(pfds[0]); + printf("kill... "); + kill(pid1); + kill(pid2); + kill(pid3); + printf("wait... "); + wait(0); + wait(0); + wait(0); +} + +// try to find any races between exit and wait +void +exitwait(char *s) +{ + int i, pid; + + for(i = 0; i < 100; i++){ + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid){ + int xstate; + if(wait(&xstate) != pid){ + printf("%s: wait wrong pid\n", s); + exit(1); + } + if(i != xstate) { + printf("%s: wait wrong exit status\n", s); + exit(1); + } + } else { + exit(i); + } + } +} + +// try to find races in the reparenting +// code that handles a parent exiting +// when it still has live children. +void +reparent(char *s) +{ + int master_pid = getpid(); + for(int i = 0; i < 200; i++){ + int pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid){ + if(wait(0) != pid){ + printf("%s: wait wrong pid\n", s); + exit(1); + } + } else { + int pid2 = fork(); + if(pid2 < 0){ + kill(master_pid); + exit(1); + } + exit(0); + } + } + exit(0); +} + +// what if two children exit() at the same time? +void +twochildren(char *s) +{ + for(int i = 0; i < 1000; i++){ + int pid1 = fork(); + if(pid1 < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid1 == 0){ + exit(0); + } else { + int pid2 = fork(); + if(pid2 < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid2 == 0){ + exit(0); + } else { + wait(0); + wait(0); + } + } + } +} + +// concurrent forks to try to expose locking bugs. +void +forkfork(char *s) +{ + enum { N=2 }; + + for(int i = 0; i < N; i++){ + int pid = fork(); + if(pid < 0){ + printf("%s: fork failed", s); + exit(1); + } + if(pid == 0){ + for(int j = 0; j < 200; j++){ + int pid1 = fork(); + if(pid1 < 0){ + exit(1); + } + if(pid1 == 0){ + exit(0); + } + wait(0); + } + exit(0); + } + } + + int xstatus; + for(int i = 0; i < N; i++){ + wait(&xstatus); + if(xstatus != 0) { + printf("%s: fork in child failed", s); + exit(1); + } + } +} + +void +forkforkfork(char *s) +{ + unlink("stopforking"); + + int pid = fork(); + if(pid < 0){ + printf("%s: fork failed", s); + exit(1); + } + if(pid == 0){ + while(1){ + int fd = open("stopforking", 0); + if(fd >= 0){ + exit(0); + } + if(fork() < 0){ + close(open("stopforking", O_CREATE|O_RDWR)); + } + } + + exit(0); + } + + sleep(20); // two seconds + close(open("stopforking", O_CREATE|O_RDWR)); + wait(0); + sleep(10); // one second +} + +// regression test. does reparent() violate the parent-then-child +// locking order when giving away a child to init, so that exit() +// deadlocks against init's wait()? also used to trigger a "panic: +// release" due to exit() releasing a different p->parent->lock than +// it acquired. +void +reparent2(char *s) +{ + for(int i = 0; i < 800; i++){ + int pid1 = fork(); + if(pid1 < 0){ + printf("fork failed\n"); + exit(1); + } + if(pid1 == 0){ + fork(); + fork(); + exit(0); + } + wait(0); + } + + exit(0); +} + +// allocate all mem, free it, and allocate again +void +mem(char *s) +{ + void *m1, *m2; + int pid; + + if((pid = fork()) == 0){ + m1 = 0; + while((m2 = malloc(10001)) != 0){ + *(char**)m2 = m1; + m1 = m2; + } + while(m1){ + m2 = *(char**)m1; + free(m1); + m1 = m2; + } + m1 = malloc(1024*20); + if(m1 == 0){ + printf("%s: couldn't allocate mem?!!\n", s); + exit(1); + } + free(m1); + exit(0); + } else { + int xstatus; + wait(&xstatus); + if(xstatus == -1){ + // probably page fault, so might be lazy lab, + // so OK. + exit(0); + } + exit(xstatus); + } +} + +// More file system tests + +// two processes write to the same file descriptor +// is the offset shared? does inode locking work? +void +sharedfd(char *s) +{ + int fd, pid, i, n, nc, np; + enum { N = 1000, SZ=10}; + char buf[SZ]; + + unlink("sharedfd"); + fd = open("sharedfd", O_CREATE|O_RDWR); + if(fd < 0){ + printf("%s: cannot open sharedfd for writing", s); + exit(1); + } + pid = fork(); + memset(buf, pid==0?'c':'p', sizeof(buf)); + for(i = 0; i < N; i++){ + if(write(fd, buf, sizeof(buf)) != sizeof(buf)){ + printf("%s: write sharedfd failed\n", s); + exit(1); + } + } + if(pid == 0) { + exit(0); + } else { + int xstatus; + wait(&xstatus); + if(xstatus != 0) + exit(xstatus); + } + + close(fd); + fd = open("sharedfd", 0); + if(fd < 0){ + printf("%s: cannot open sharedfd for reading\n", s); + exit(1); + } + nc = np = 0; + while((n = read(fd, buf, sizeof(buf))) > 0){ + for(i = 0; i < sizeof(buf); i++){ + if(buf[i] == 'c') + nc++; + if(buf[i] == 'p') + np++; + } + } + close(fd); + unlink("sharedfd"); + if(nc == N*SZ && np == N*SZ){ + exit(0); + } else { + printf("%s: nc/np test fails\n", s); + exit(1); + } +} + +// four processes write different files at the same +// time, to test block allocation. +void +fourfiles(char *s) +{ + int fd, pid, i, j, n, total, pi; + char *names[] = { "f0", "f1", "f2", "f3" }; + char *fname; + enum { N=12, NCHILD=4, SZ=500 }; + + for(pi = 0; pi < NCHILD; pi++){ + fname = names[pi]; + unlink(fname); + + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + + if(pid == 0){ + fd = open(fname, O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: create failed\n", s); + exit(1); + } + + memset(buf, '0'+pi, SZ); + for(i = 0; i < N; i++){ + if((n = write(fd, buf, SZ)) != SZ){ + printf("write failed %d\n", n); + exit(1); + } + } + exit(0); + } + } + + int xstatus; + for(pi = 0; pi < NCHILD; pi++){ + wait(&xstatus); + if(xstatus != 0) + exit(xstatus); + } + + for(i = 0; i < NCHILD; i++){ + fname = names[i]; + fd = open(fname, 0); + total = 0; + while((n = read(fd, buf, sizeof(buf))) > 0){ + for(j = 0; j < n; j++){ + if(buf[j] != '0'+i){ + printf("%s: wrong char\n", s); + exit(1); + } + } + total += n; + } + close(fd); + if(total != N*SZ){ + printf("wrong length %d\n", total); + exit(1); + } + unlink(fname); + } +} + +// four processes create and delete different files in same directory +void +createdelete(char *s) +{ + enum { N = 20, NCHILD=4 }; + int pid, i, fd, pi; + char name[32]; + + for(pi = 0; pi < NCHILD; pi++){ + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + + if(pid == 0){ + name[0] = 'p' + pi; + name[2] = '\0'; + for(i = 0; i < N; i++){ + name[1] = '0' + i; + fd = open(name, O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: create failed\n", s); + exit(1); + } + close(fd); + if(i > 0 && (i % 2 ) == 0){ + name[1] = '0' + (i / 2); + if(unlink(name) < 0){ + printf("%s: unlink failed\n", s); + exit(1); + } + } + } + exit(0); + } + } + + int xstatus; + for(pi = 0; pi < NCHILD; pi++){ + wait(&xstatus); + if(xstatus != 0) + exit(1); + } + + name[0] = name[1] = name[2] = 0; + for(i = 0; i < N; i++){ + for(pi = 0; pi < NCHILD; pi++){ + name[0] = 'p' + pi; + name[1] = '0' + i; + fd = open(name, 0); + if((i == 0 || i >= N/2) && fd < 0){ + printf("%s: oops createdelete %s didn't exist\n", s, name); + exit(1); + } else if((i >= 1 && i < N/2) && fd >= 0){ + printf("%s: oops createdelete %s did exist\n", s, name); + exit(1); + } + if(fd >= 0) + close(fd); + } + } + + for(i = 0; i < N; i++){ + for(pi = 0; pi < NCHILD; pi++){ + name[0] = 'p' + pi; + name[1] = '0' + i; + unlink(name); + } + } +} + +// can I unlink a file and still read it? +void +unlinkread(char *s) +{ + enum { SZ = 5 }; + int fd, fd1; + + fd = open("unlinkread", O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: create unlinkread failed\n", s); + exit(1); + } + write(fd, "hello", SZ); + close(fd); + + fd = open("unlinkread", O_RDWR); + if(fd < 0){ + printf("%s: open unlinkread failed\n", s); + exit(1); + } + if(unlink("unlinkread") != 0){ + printf("%s: unlink unlinkread failed\n", s); + exit(1); + } + + fd1 = open("unlinkread", O_CREATE | O_RDWR); + write(fd1, "yyy", 3); + close(fd1); + + if(read(fd, buf, sizeof(buf)) != SZ){ + printf("%s: unlinkread read failed", s); + exit(1); + } + if(buf[0] != 'h'){ + printf("%s: unlinkread wrong data\n", s); + exit(1); + } + if(write(fd, buf, 10) != 10){ + printf("%s: unlinkread write failed\n", s); + exit(1); + } + close(fd); + unlink("unlinkread"); +} + +void +linktest(char *s) +{ + enum { SZ = 5 }; + int fd; + + unlink("lf1"); + unlink("lf2"); + + fd = open("lf1", O_CREATE|O_RDWR); + if(fd < 0){ + printf("%s: create lf1 failed\n", s); + exit(1); + } + if(write(fd, "hello", SZ) != SZ){ + printf("%s: write lf1 failed\n", s); + exit(1); + } + close(fd); + + if(link("lf1", "lf2") < 0){ + printf("%s: link lf1 lf2 failed\n", s); + exit(1); + } + unlink("lf1"); + + if(open("lf1", 0) >= 0){ + printf("%s: unlinked lf1 but it is still there!\n", s); + exit(1); + } + + fd = open("lf2", 0); + if(fd < 0){ + printf("%s: open lf2 failed\n", s); + exit(1); + } + if(read(fd, buf, sizeof(buf)) != SZ){ + printf("%s: read lf2 failed\n", s); + exit(1); + } + close(fd); + + if(link("lf2", "lf2") >= 0){ + printf("%s: link lf2 lf2 succeeded! oops\n", s); + exit(1); + } + + unlink("lf2"); + if(link("lf2", "lf1") >= 0){ + printf("%s: link non-existent succeeded! oops\n", s); + exit(1); + } + + if(link(".", "lf1") >= 0){ + printf("%s: link . lf1 succeeded! oops\n", s); + exit(1); + } +} + +// test concurrent create/link/unlink of the same file +void +concreate(char *s) +{ + enum { N = 40 }; + char file[3]; + int i, pid, n, fd; + char fa[N]; + struct { + ushort inum; + char name[DIRSIZ]; + } de; + + file[0] = 'C'; + file[2] = '\0'; + for(i = 0; i < N; i++){ + file[1] = '0' + i; + unlink(file); + pid = fork(); + if(pid && (i % 3) == 1){ + link("C0", file); + } else if(pid == 0 && (i % 5) == 1){ + link("C0", file); + } else { + fd = open(file, O_CREATE | O_RDWR); + if(fd < 0){ + printf("concreate create %s failed\n", file); + exit(1); + } + close(fd); + } + if(pid == 0) { + exit(0); + } else { + int xstatus; + wait(&xstatus); + if(xstatus != 0) + exit(1); + } + } + + memset(fa, 0, sizeof(fa)); + fd = open(".", 0); + n = 0; + while(read(fd, &de, sizeof(de)) > 0){ + if(de.inum == 0) + continue; + if(de.name[0] == 'C' && de.name[2] == '\0'){ + i = de.name[1] - '0'; + if(i < 0 || i >= sizeof(fa)){ + printf("%s: concreate weird file %s\n", s, de.name); + exit(1); + } + if(fa[i]){ + printf("%s: concreate duplicate file %s\n", s, de.name); + exit(1); + } + fa[i] = 1; + n++; + } + } + close(fd); + + if(n != N){ + printf("%s: concreate not enough files in directory listing\n", s); + exit(1); + } + + for(i = 0; i < N; i++){ + file[1] = '0' + i; + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(((i % 3) == 0 && pid == 0) || + ((i % 3) == 1 && pid != 0)){ + close(open(file, 0)); + close(open(file, 0)); + close(open(file, 0)); + close(open(file, 0)); + close(open(file, 0)); + close(open(file, 0)); + } else { + unlink(file); + unlink(file); + unlink(file); + unlink(file); + unlink(file); + unlink(file); + } + if(pid == 0) + exit(0); + else + wait(0); + } +} + +// another concurrent link/unlink/create test, +// to look for deadlocks. +void +linkunlink(char *s) +{ + int pid, i; + + unlink("x"); + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + + unsigned int x = (pid ? 1 : 97); + for(i = 0; i < 100; i++){ + x = x * 1103515245 + 12345; + if((x % 3) == 0){ + close(open("x", O_RDWR | O_CREATE)); + } else if((x % 3) == 1){ + link("cat", "x"); + } else { + unlink("x"); + } + } + + if(pid) + wait(0); + else + exit(0); +} + + +void +subdir(char *s) +{ + int fd, cc; + + unlink("ff"); + if(mkdir("dd") != 0){ + printf("%s: mkdir dd failed\n", s); + exit(1); + } + + fd = open("dd/ff", O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: create dd/ff failed\n", s); + exit(1); + } + write(fd, "ff", 2); + close(fd); + + if(unlink("dd") >= 0){ + printf("%s: unlink dd (non-empty dir) succeeded!\n", s); + exit(1); + } + + if(mkdir("/dd/dd") != 0){ + printf("%s: subdir mkdir dd/dd failed\n", s); + exit(1); + } + + fd = open("dd/dd/ff", O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: create dd/dd/ff failed\n", s); + exit(1); + } + write(fd, "FF", 2); + close(fd); + + fd = open("dd/dd/../ff", 0); + if(fd < 0){ + printf("%s: open dd/dd/../ff failed\n", s); + exit(1); + } + cc = read(fd, buf, sizeof(buf)); + if(cc != 2 || buf[0] != 'f'){ + printf("%s: dd/dd/../ff wrong content\n", s); + exit(1); + } + close(fd); + + if(link("dd/dd/ff", "dd/dd/ffff") != 0){ + printf("%s: link dd/dd/ff dd/dd/ffff failed\n", s); + exit(1); + } + + if(unlink("dd/dd/ff") != 0){ + printf("%s: unlink dd/dd/ff failed\n", s); + exit(1); + } + if(open("dd/dd/ff", O_RDONLY) >= 0){ + printf("%s: open (unlinked) dd/dd/ff succeeded\n", s); + exit(1); + } + + if(chdir("dd") != 0){ + printf("%s: chdir dd failed\n", s); + exit(1); + } + if(chdir("dd/../../dd") != 0){ + printf("%s: chdir dd/../../dd failed\n", s); + exit(1); + } + if(chdir("dd/../../../dd") != 0){ + printf("%s: chdir dd/../../../dd failed\n", s); + exit(1); + } + if(chdir("./..") != 0){ + printf("%s: chdir ./.. failed\n", s); + exit(1); + } + + fd = open("dd/dd/ffff", 0); + if(fd < 0){ + printf("%s: open dd/dd/ffff failed\n", s); + exit(1); + } + if(read(fd, buf, sizeof(buf)) != 2){ + printf("%s: read dd/dd/ffff wrong len\n", s); + exit(1); + } + close(fd); + + if(open("dd/dd/ff", O_RDONLY) >= 0){ + printf("%s: open (unlinked) dd/dd/ff succeeded!\n", s); + exit(1); + } + + if(open("dd/ff/ff", O_CREATE|O_RDWR) >= 0){ + printf("%s: create dd/ff/ff succeeded!\n", s); + exit(1); + } + if(open("dd/xx/ff", O_CREATE|O_RDWR) >= 0){ + printf("%s: create dd/xx/ff succeeded!\n", s); + exit(1); + } + if(open("dd", O_CREATE) >= 0){ + printf("%s: create dd succeeded!\n", s); + exit(1); + } + if(open("dd", O_RDWR) >= 0){ + printf("%s: open dd rdwr succeeded!\n", s); + exit(1); + } + if(open("dd", O_WRONLY) >= 0){ + printf("%s: open dd wronly succeeded!\n", s); + exit(1); + } + if(link("dd/ff/ff", "dd/dd/xx") == 0){ + printf("%s: link dd/ff/ff dd/dd/xx succeeded!\n", s); + exit(1); + } + if(link("dd/xx/ff", "dd/dd/xx") == 0){ + printf("%s: link dd/xx/ff dd/dd/xx succeeded!\n", s); + exit(1); + } + if(link("dd/ff", "dd/dd/ffff") == 0){ + printf("%s: link dd/ff dd/dd/ffff succeeded!\n", s); + exit(1); + } + if(mkdir("dd/ff/ff") == 0){ + printf("%s: mkdir dd/ff/ff succeeded!\n", s); + exit(1); + } + if(mkdir("dd/xx/ff") == 0){ + printf("%s: mkdir dd/xx/ff succeeded!\n", s); + exit(1); + } + if(mkdir("dd/dd/ffff") == 0){ + printf("%s: mkdir dd/dd/ffff succeeded!\n", s); + exit(1); + } + if(unlink("dd/xx/ff") == 0){ + printf("%s: unlink dd/xx/ff succeeded!\n", s); + exit(1); + } + if(unlink("dd/ff/ff") == 0){ + printf("%s: unlink dd/ff/ff succeeded!\n", s); + exit(1); + } + if(chdir("dd/ff") == 0){ + printf("%s: chdir dd/ff succeeded!\n", s); + exit(1); + } + if(chdir("dd/xx") == 0){ + printf("%s: chdir dd/xx succeeded!\n", s); + exit(1); + } + + if(unlink("dd/dd/ffff") != 0){ + printf("%s: unlink dd/dd/ff failed\n", s); + exit(1); + } + if(unlink("dd/ff") != 0){ + printf("%s: unlink dd/ff failed\n", s); + exit(1); + } + if(unlink("dd") == 0){ + printf("%s: unlink non-empty dd succeeded!\n", s); + exit(1); + } + if(unlink("dd/dd") < 0){ + printf("%s: unlink dd/dd failed\n", s); + exit(1); + } + if(unlink("dd") < 0){ + printf("%s: unlink dd failed\n", s); + exit(1); + } +} + +// test writes that are larger than the log. +void +bigwrite(char *s) +{ + int fd, sz; + + unlink("bigwrite"); + for(sz = 499; sz < (MAXOPBLOCKS+2)*BSIZE; sz += 471){ + fd = open("bigwrite", O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: cannot create bigwrite\n", s); + exit(1); + } + int i; + for(i = 0; i < 2; i++){ + int cc = write(fd, buf, sz); + if(cc != sz){ + printf("%s: write(%d) ret %d\n", s, sz, cc); + exit(1); + } + } + close(fd); + unlink("bigwrite"); + } +} + + +void +bigfile(char *s) +{ + enum { N = 20, SZ=600 }; + int fd, i, total, cc; + + unlink("bigfile.dat"); + fd = open("bigfile.dat", O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: cannot create bigfile", s); + exit(1); + } + for(i = 0; i < N; i++){ + memset(buf, i, SZ); + if(write(fd, buf, SZ) != SZ){ + printf("%s: write bigfile failed\n", s); + exit(1); + } + } + close(fd); + + fd = open("bigfile.dat", 0); + if(fd < 0){ + printf("%s: cannot open bigfile\n", s); + exit(1); + } + total = 0; + for(i = 0; ; i++){ + cc = read(fd, buf, SZ/2); + if(cc < 0){ + printf("%s: read bigfile failed\n", s); + exit(1); + } + if(cc == 0) + break; + if(cc != SZ/2){ + printf("%s: short read bigfile\n", s); + exit(1); + } + if(buf[0] != i/2 || buf[SZ/2-1] != i/2){ + printf("%s: read bigfile wrong data\n", s); + exit(1); + } + total += cc; + } + close(fd); + if(total != N*SZ){ + printf("%s: read bigfile wrong total\n", s); + exit(1); + } + unlink("bigfile.dat"); +} + +void +fourteen(char *s) +{ + int fd; + + // DIRSIZ is 14. + + if(mkdir("12345678901234") != 0){ + printf("%s: mkdir 12345678901234 failed\n", s); + exit(1); + } + if(mkdir("12345678901234/123456789012345") != 0){ + printf("%s: mkdir 12345678901234/123456789012345 failed\n", s); + exit(1); + } + fd = open("123456789012345/123456789012345/123456789012345", O_CREATE); + if(fd < 0){ + printf("%s: create 123456789012345/123456789012345/123456789012345 failed\n", s); + exit(1); + } + close(fd); + fd = open("12345678901234/12345678901234/12345678901234", 0); + if(fd < 0){ + printf("%s: open 12345678901234/12345678901234/12345678901234 failed\n", s); + exit(1); + } + close(fd); + + if(mkdir("12345678901234/12345678901234") == 0){ + printf("%s: mkdir 12345678901234/12345678901234 succeeded!\n", s); + exit(1); + } + if(mkdir("123456789012345/12345678901234") == 0){ + printf("%s: mkdir 12345678901234/123456789012345 succeeded!\n", s); + exit(1); + } + + // clean up + unlink("123456789012345/12345678901234"); + unlink("12345678901234/12345678901234"); + unlink("12345678901234/12345678901234/12345678901234"); + unlink("123456789012345/123456789012345/123456789012345"); + unlink("12345678901234/123456789012345"); + unlink("12345678901234"); +} + +void +rmdot(char *s) +{ + if(mkdir("dots") != 0){ + printf("%s: mkdir dots failed\n", s); + exit(1); + } + if(chdir("dots") != 0){ + printf("%s: chdir dots failed\n", s); + exit(1); + } + if(unlink(".") == 0){ + printf("%s: rm . worked!\n", s); + exit(1); + } + if(unlink("..") == 0){ + printf("%s: rm .. worked!\n", s); + exit(1); + } + if(chdir("/") != 0){ + printf("%s: chdir / failed\n", s); + exit(1); + } + if(unlink("dots/.") == 0){ + printf("%s: unlink dots/. worked!\n", s); + exit(1); + } + if(unlink("dots/..") == 0){ + printf("%s: unlink dots/.. worked!\n", s); + exit(1); + } + if(unlink("dots") != 0){ + printf("%s: unlink dots failed!\n", s); + exit(1); + } +} + +void +dirfile(char *s) +{ + int fd; + + fd = open("dirfile", O_CREATE); + if(fd < 0){ + printf("%s: create dirfile failed\n", s); + exit(1); + } + close(fd); + if(chdir("dirfile") == 0){ + printf("%s: chdir dirfile succeeded!\n", s); + exit(1); + } + fd = open("dirfile/xx", 0); + if(fd >= 0){ + printf("%s: create dirfile/xx succeeded!\n", s); + exit(1); + } + fd = open("dirfile/xx", O_CREATE); + if(fd >= 0){ + printf("%s: create dirfile/xx succeeded!\n", s); + exit(1); + } + if(mkdir("dirfile/xx") == 0){ + printf("%s: mkdir dirfile/xx succeeded!\n", s); + exit(1); + } + if(unlink("dirfile/xx") == 0){ + printf("%s: unlink dirfile/xx succeeded!\n", s); + exit(1); + } + if(link("README", "dirfile/xx") == 0){ + printf("%s: link to dirfile/xx succeeded!\n", s); + exit(1); + } + if(unlink("dirfile") != 0){ + printf("%s: unlink dirfile failed!\n", s); + exit(1); + } + + fd = open(".", O_RDWR); + if(fd >= 0){ + printf("%s: open . for writing succeeded!\n", s); + exit(1); + } + fd = open(".", 0); + if(write(fd, "x", 1) > 0){ + printf("%s: write . succeeded!\n", s); + exit(1); + } + close(fd); +} + +// test that iput() is called at the end of _namei(). +// also tests empty file names. +void +iref(char *s) +{ + int i, fd; + + for(i = 0; i < NINODE + 1; i++){ + if(mkdir("irefd") != 0){ + printf("%s: mkdir irefd failed\n", s); + exit(1); + } + if(chdir("irefd") != 0){ + printf("%s: chdir irefd failed\n", s); + exit(1); + } + + mkdir(""); + link("README", ""); + fd = open("", O_CREATE); + if(fd >= 0) + close(fd); + fd = open("xx", O_CREATE); + if(fd >= 0) + close(fd); + unlink("xx"); + } + + // clean up + for(i = 0; i < NINODE + 1; i++){ + chdir(".."); + unlink("irefd"); + } + + chdir("/"); +} + +// test that fork fails gracefully +// the forktest binary also does this, but it runs out of proc entries first. +// inside the bigger usertests binary, we run out of memory first. +void +forktest(char *s) +{ + enum{ N = 1000 }; + int n, pid; + + for(n=0; n 0; n--){ + if(wait(0) < 0){ + printf("%s: wait stopped early\n", s); + exit(1); + } + } + + if(wait(0) != -1){ + printf("%s: wait got too many\n", s); + exit(1); + } +} + +void +sbrkbasic(char *s) +{ + enum { TOOMUCH=1024*1024*1024}; + int i, pid, xstatus; + char *c, *a, *b; + + // does sbrk() return the expected failure value? + pid = fork(); + if(pid < 0){ + printf("fork failed in sbrkbasic\n"); + exit(1); + } + if(pid == 0){ + a = sbrk(TOOMUCH); + if(a == (char*)0xffffffffffffffffL){ + // it's OK if this fails. + exit(0); + } + + for(b = a; b < a+TOOMUCH; b += 4096){ + *b = 99; + } + + // we should not get here! either sbrk(TOOMUCH) + // should have failed, or (with lazy allocation) + // a pagefault should have killed this process. + exit(1); + } + + wait(&xstatus); + if(xstatus == 1){ + printf("%s: too much memory allocated!\n", s); + exit(1); + } + + // can one sbrk() less than a page? + a = sbrk(0); + for(i = 0; i < 5000; i++){ + b = sbrk(1); + if(b != a){ + printf("%s: sbrk test failed %d %p %p\n", s, i, a, b); + exit(1); + } + *b = 1; + a = b + 1; + } + pid = fork(); + if(pid < 0){ + printf("%s: sbrk test fork failed\n", s); + exit(1); + } + c = sbrk(1); + c = sbrk(1); + if(c != a + 1){ + printf("%s: sbrk test failed post-fork\n", s); + exit(1); + } + if(pid == 0) + exit(0); + wait(&xstatus); + exit(xstatus); +} + +void +sbrkmuch(char *s) +{ + enum { BIG=100*1024*1024 }; + char *c, *oldbrk, *a, *lastaddr, *p; + uint64 amt; + + oldbrk = sbrk(0); + + // can one grow address space to something big? + a = sbrk(0); + amt = BIG - (uint64)a; + p = sbrk(amt); + if (p != a) { + printf("%s: sbrk test failed to grow big address space; enough phys mem?\n", s); + exit(1); + } + + // touch each page to make sure it exists. + char *eee = sbrk(0); + for(char *pp = a; pp < eee; pp += 4096) + *pp = 1; + + lastaddr = (char*) (BIG-1); + *lastaddr = 99; + + // can one de-allocate? + a = sbrk(0); + c = sbrk(-PGSIZE); + if(c == (char*)0xffffffffffffffffL){ + printf("%s: sbrk could not deallocate\n", s); + exit(1); + } + c = sbrk(0); + if(c != a - PGSIZE){ + printf("%s: sbrk deallocation produced wrong address, a %p c %p\n", s, a, c); + exit(1); + } + + // can one re-allocate that page? + a = sbrk(0); + c = sbrk(PGSIZE); + if(c != a || sbrk(0) != a + PGSIZE){ + printf("%s: sbrk re-allocation failed, a %p c %p\n", s, a, c); + exit(1); + } + if(*lastaddr == 99){ + // should be zero + printf("%s: sbrk de-allocation didn't really deallocate\n", s); + exit(1); + } + + a = sbrk(0); + c = sbrk(-(sbrk(0) - oldbrk)); + if(c != a){ + printf("%s: sbrk downsize failed, a %p c %p\n", s, a, c); + exit(1); + } +} + +// can we read the kernel's memory? +void +kernmem(char *s) +{ + char *a; + int pid; + + for(a = (char*)(KERNBASE); a < (char*) (KERNBASE+2000000); a += 50000){ + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid == 0){ + printf("%s: oops could read %p = %x\n", s, a, *a); + exit(1); + } + int xstatus; + wait(&xstatus); + if(xstatus != -1) // did kernel kill child? + exit(1); + } +} + +// user code should not be able to write to addresses above MAXVA. +void +MAXVAplus(char *s) +{ + volatile uint64 a = MAXVA; + for( ; a != 0; a <<= 1){ + int pid; + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid == 0){ + *(char*)a = 99; + printf("%s: oops wrote %p\n", s, (void*)a); + exit(1); + } + int xstatus; + wait(&xstatus); + if(xstatus != -1) // did kernel kill child? + exit(1); + } +} + +// if we run the system out of memory, does it clean up the last +// failed allocation? +void +sbrkfail(char *s) +{ + enum { BIG=100*1024*1024 }; + int i, xstatus; + int fds[2]; + char scratch; + char *c, *a; + int pids[10]; + int pid; + + if(pipe(fds) != 0){ + printf("%s: pipe() failed\n", s); + exit(1); + } + for(i = 0; i < 10 /*sizeof(pids)/sizeof(pids[0])*/; i++){ + if((pids[i] = fork()) == 0){ + // allocate a lot of memory + sbrk(BIG - (uint64)sbrk(0)); + write(fds[1], "x", 1); + // sit around until killed + for(;;) sleep(1000); + } + if(pids[i] != -1) + read(fds[0], &scratch, 1); + } + + // if those failed allocations freed up the pages they did allocate, + // we'll be able to allocate here + c = sbrk(PGSIZE); + for(i = 0; i < 10 /*sizeof(pids)/sizeof(pids[0])*/; i++){ + if(pids[i] == -1) + continue; + kill(pids[i]); + wait(0); + } + if(c == (char*)0xffffffffffffffffUL){ + printf("%s: failed sbrk leaked memory\n", s); + exit(1); + } + + // test running fork with the above allocated page + pid = fork(); + if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + if(pid == 0){ + // allocate a lot of memory. + // this should produce a page fault, + // and thus not complete. + a = sbrk(0); + sbrk(10*BIG); + int n = 0; + for (i = 0; i < 10*BIG; i += PGSIZE) { + n += *(a+i); + } + // print n so the compiler doesn't optimize away + // the for loop. + printf("%s: allocate a lot of memory succeeded %d\n", s, n); + exit(1); + } + wait(&xstatus); + if(xstatus != -1 && xstatus != 2) + exit(1); +} + + +// test reads/writes from/to allocated memory +void +sbrkarg(char *s) +{ + char *a; + int fd, n; + + a = sbrk(PGSIZE); + fd = open("sbrk", O_CREATE|O_WRONLY); + unlink("sbrk"); + if(fd < 0) { + printf("%s: open sbrk failed\n", s); + exit(1); + } + if ((n = write(fd, a, PGSIZE)) < 0) { + printf("%s: write sbrk failed\n", s); + exit(1); + } + close(fd); + + // test writes to allocated memory + a = sbrk(PGSIZE); + if(pipe((int *) a) != 0){ + printf("%s: pipe() failed\n", s); + exit(1); + } +} + +void +validatetest(char *s) +{ + int hi; + uint64 p; + + hi = 1100*1024; + for(p = 0; p <= (uint)hi; p += PGSIZE){ + // try to crash the kernel by passing in a bad string pointer + if(link("nosuchfile", (char*)p) != -1){ + printf("%s: link should not succeed\n", s); + exit(1); + } + } +} + +// does uninitialized data start out zero? +char uninit[10000]; +void +bsstest(char *s) +{ + int i; + + for(i = 0; i < sizeof(uninit); i++){ + if(uninit[i] != '\0'){ + printf("%s: bss test failed\n", s); + exit(1); + } + } +} + +// does exec return an error if the arguments +// are larger than a page? or does it write +// below the stack and wreck the instructions/data? +void +bigargtest(char *s) +{ + int pid, fd, xstatus; + + unlink("bigarg-ok"); + pid = fork(); + if(pid == 0){ + static char *args[MAXARG]; + int i; + char big[400]; + memset(big, ' ', sizeof(big)); + big[sizeof(big)-1] = '\0'; + for(i = 0; i < MAXARG-1; i++) + args[i] = big; + args[MAXARG-1] = 0; + // this exec() should fail (and return) because the + // arguments are too large. + exec("echo", args); + fd = open("bigarg-ok", O_CREATE); + close(fd); + exit(0); + } else if(pid < 0){ + printf("%s: bigargtest: fork failed\n", s); + exit(1); + } + + wait(&xstatus); + if(xstatus != 0) + exit(xstatus); + fd = open("bigarg-ok", 0); + if(fd < 0){ + printf("%s: bigarg test failed!\n", s); + exit(1); + } + close(fd); +} + +// what happens when the file system runs out of blocks? +// answer: balloc panics, so this test is not useful. +void +fsfull() +{ + int nfiles; + int fsblocks = 0; + + printf("fsfull test\n"); + + for(nfiles = 0; ; nfiles++){ + char name[64]; + name[0] = 'f'; + name[1] = '0' + nfiles / 1000; + name[2] = '0' + (nfiles % 1000) / 100; + name[3] = '0' + (nfiles % 100) / 10; + name[4] = '0' + (nfiles % 10); + name[5] = '\0'; + printf("writing %s\n", name); + int fd = open(name, O_CREATE|O_RDWR); + if(fd < 0){ + printf("open %s failed\n", name); + break; + } + int total = 0; + while(1){ + int cc = write(fd, buf, BSIZE); + if(cc < BSIZE) + break; + total += cc; + fsblocks++; + } + printf("wrote %d bytes\n", total); + close(fd); + if(total == 0) + break; + } + + while(nfiles >= 0){ + char name[64]; + name[0] = 'f'; + name[1] = '0' + nfiles / 1000; + name[2] = '0' + (nfiles % 1000) / 100; + name[3] = '0' + (nfiles % 100) / 10; + name[4] = '0' + (nfiles % 10); + name[5] = '\0'; + unlink(name); + nfiles--; + } + + printf("fsfull test finished\n"); +} + +void argptest(char *s) +{ + int fd; + fd = open("init", O_RDONLY); + if (fd < 0) { + printf("%s: open failed\n", s); + exit(1); + } + read(fd, sbrk(0) - 1, -1); + close(fd); +} + +// check that there's an invalid page beneath +// the user stack, to catch stack overflow. +void +stacktest(char *s) +{ + int pid; + int xstatus; + + pid = fork(); + if(pid == 0) { + char *sp = (char *) r_sp(); + sp -= USERSTACK*PGSIZE; + // the *sp should cause a trap. + printf("%s: stacktest: read below stack %d\n", s, *sp); + exit(1); + } else if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + wait(&xstatus); + if(xstatus == -1) // kernel killed child? + exit(0); + else + exit(xstatus); +} + +// check that writes to a few forbidden addresses +// cause a fault, e.g. process's text and TRAMPOLINE. +void +nowrite(char *s) +{ + int pid; + int xstatus; + uint64 addrs[] = { 0, 0x80000000ULL, 0x3fffffe000ULL, 0x3ffffff000ULL, 0x4000000000ULL, + 0xffffffffffffffffULL }; + + for(int ai = 0; ai < 5 /*sizeof(addrs)/sizeof(addrs[0])*/; ai++){ + pid = fork(); + if(pid == 0) { + volatile int *addr = (int *) addrs[ai]; + *addr = 10; + printf("%s: write to %p did not fail!\n", s, addr); + exit(0); + } else if(pid < 0){ + printf("%s: fork failed\n", s); + exit(1); + } + wait(&xstatus); + if(xstatus == 0){ + // kernel did not kill child! + exit(1); + } + } + exit(0); +} + +// regression test. copyin(), copyout(), and copyinstr() used to cast +// the virtual page address to uint, which (with certain wild system +// call arguments) resulted in a kernel page faults. +void *big = (void*) 0xeaeb0b5b00002f5e; +void +pgbug(char *s) +{ + char *argv[1]; + argv[0] = 0; + exec(big, argv); + pipe(big); + + exit(0); +} + +// regression test. does the kernel panic if a process sbrk()s its +// size to be less than a page, or zero, or reduces the break by an +// amount too small to cause a page to be freed? +void +sbrkbugs(char *s) +{ + int pid = fork(); + if(pid < 0){ + printf("fork failed\n"); + exit(1); + } + if(pid == 0){ + int sz = (uint64) sbrk(0); + // free all user memory; there used to be a bug that + // would not adjust p->sz correctly in this case, + // causing exit() to panic. + sbrk(-sz); + // user page fault here. + exit(0); + } + wait(0); + + pid = fork(); + if(pid < 0){ + printf("fork failed\n"); + exit(1); + } + if(pid == 0){ + int sz = (uint64) sbrk(0); + // set the break to somewhere in the very first + // page; there used to be a bug that would incorrectly + // free the first page. + sbrk(-(sz - 3500)); + exit(0); + } + wait(0); + + pid = fork(); + if(pid < 0){ + printf("fork failed\n"); + exit(1); + } + if(pid == 0){ + // set the break in the middle of a page. + sbrk((10*4096 + 2048) - (uint64)sbrk(0)); + + // reduce the break a bit, but not enough to + // cause a page to be freed. this used to cause + // a panic. + sbrk(-10); + + exit(0); + } + wait(0); + + exit(0); +} + +// if process size was somewhat more than a page boundary, and then +// shrunk to be somewhat less than that page boundary, can the kernel +// still copyin() from addresses in the last page? +void +sbrklast(char *s) +{ + uint64 top = (uint64) sbrk(0); + if((top % 4096) != 0) + sbrk(4096 - (top % 4096)); + sbrk(4096); + sbrk(10); + sbrk(-20); + top = (uint64) sbrk(0); + char *p = (char *) (top - 64); + p[0] = 'x'; + p[1] = '\0'; + int fd = open(p, O_RDWR|O_CREATE); + write(fd, p, 1); + close(fd); + fd = open(p, O_RDWR); + p[0] = '\0'; + read(fd, p, 1); + if(p[0] != 'x') + exit(1); +} + + +// does sbrk handle signed int32 wrap-around with +// negative arguments? +void +sbrk8000(char *s) +{ + sbrk(0x80000004); + volatile char *top = sbrk(0); + *(top-1) = *(top-1) + 1; +} + + + +// regression test. test whether exec() leaks memory if one of the +// arguments is invalid. the test passes if the kernel doesn't panic. +void +badarg(char *s) +{ + for(int i = 0; i < 50000; i++){ + char *argv[2]; + argv[0] = (char*)0xffffffff; + argv[1] = 0; + exec("echo", argv); + } + + exit(0); +} + +struct test { + void (*f)(char *); + char *s; +} quicktests[] = { + {copyin, "copyin"}, + {copyout, "copyout"}, + {copyinstr1, "copyinstr1"}, + {copyinstr2, "copyinstr2"}, + {copyinstr3, "copyinstr3"}, + {rwsbrk, "rwsbrk" }, + {truncate1, "truncate1"}, + {truncate2, "truncate2"}, + {truncate3, "truncate3"}, + {openiputtest, "openiput"}, + {exitiputtest, "exitiput"}, + {iputtest, "iput"}, + {opentest, "opentest"}, + {writetest, "writetest"}, + {writebig, "writebig"}, + {createtest, "createtest"}, + {dirtest, "dirtest"}, + {exectest, "exectest"}, + {pipe1, "pipe1"}, + {killstatus, "killstatus"}, + {preempt, "preempt"}, + {exitwait, "exitwait"}, + {reparent, "reparent" }, + {twochildren, "twochildren"}, + {forkfork, "forkfork"}, + {forkforkfork, "forkforkfork"}, + {reparent2, "reparent2"}, + {mem, "mem"}, + {sharedfd, "sharedfd"}, + {fourfiles, "fourfiles"}, + {createdelete, "createdelete"}, + {unlinkread, "unlinkread"}, + {linktest, "linktest"}, + {concreate, "concreate"}, + {linkunlink, "linkunlink"}, + {subdir, "subdir"}, + {bigwrite, "bigwrite"}, + {bigfile, "bigfile"}, + {fourteen, "fourteen"}, + {rmdot, "rmdot"}, + {dirfile, "dirfile"}, + {iref, "iref"}, + {forktest, "forktest"}, + {sbrkbasic, "sbrkbasic"}, + {sbrkmuch, "sbrkmuch"}, + {kernmem, "kernmem"}, + {MAXVAplus, "MAXVAplus"}, + {sbrkfail, "sbrkfail"}, + {sbrkarg, "sbrkarg"}, + {validatetest, "validatetest"}, + {bsstest, "bsstest"}, + {bigargtest, "bigargtest"}, + {argptest, "argptest"}, + {stacktest, "stacktest"}, + {nowrite, "nowrite"}, + {pgbug, "pgbug" }, + {sbrkbugs, "sbrkbugs" }, + {sbrklast, "sbrklast"}, + {sbrk8000, "sbrk8000"}, + {badarg, "badarg" }, + + { 0, 0}, +}; + +// +// Section with tests that take a fair bit of time +// + +// directory that uses indirect blocks +void +bigdir(char *s) +{ + enum { N = 500 }; + int i, fd; + char name[10]; + + unlink("bd"); + + fd = open("bd", O_CREATE); + if(fd < 0){ + printf("%s: bigdir create failed\n", s); + exit(1); + } + close(fd); + + for(i = 0; i < N; i++){ + name[0] = 'x'; + name[1] = '0' + (i / 64); + name[2] = '0' + (i % 64); + name[3] = '\0'; + if(link("bd", name) != 0){ + printf("%s: bigdir i=%d link(bd, %s) failed\n", s, i, name); + exit(1); + } + } + + unlink("bd"); + for(i = 0; i < N; i++){ + name[0] = 'x'; + name[1] = '0' + (i / 64); + name[2] = '0' + (i % 64); + name[3] = '\0'; + if(unlink(name) != 0){ + printf("%s: bigdir unlink failed", s); + exit(1); + } + } +} + +// concurrent writes to try to provoke deadlock in the virtio disk +// driver. +void +manywrites(char *s) +{ + int nchildren = 4; + int howmany = 30; // increase to look for deadlock + + for(int ci = 0; ci < nchildren; ci++){ + int pid = fork(); + if(pid < 0){ + printf("fork failed\n"); + exit(1); + } + + if(pid == 0){ + char name[3]; + name[0] = 'b'; + name[1] = 'a' + ci; + name[2] = '\0'; + unlink(name); + + for(int iters = 0; iters < howmany; iters++){ + for(int i = 0; i < ci+1; i++){ + int fd = open(name, O_CREATE | O_RDWR); + if(fd < 0){ + printf("%s: cannot create %s\n", s, name); + exit(1); + } + int sz = sizeof(buf); + int cc = write(fd, buf, sz); + if(cc != sz){ + printf("%s: write(%d) ret %d\n", s, sz, cc); + exit(1); + } + close(fd); + } + unlink(name); + } + + unlink(name); + exit(0); + } + } + + for(int ci = 0; ci < nchildren; ci++){ + int st = 0; + wait(&st); + if(st != 0) + exit(st); + } + exit(0); +} + +// regression test. does write() with an invalid buffer pointer cause +// a block to be allocated for a file that is then not freed when the +// file is deleted? if the kernel has this bug, it will panic: balloc: +// out of blocks. assumed_free may need to be raised to be more than +// the number of free blocks. this test takes a long time. +void +badwrite(char *s) +{ + int assumed_free = 600; + + unlink("junk"); + for(int i = 0; i < assumed_free; i++){ + int fd = open("junk", O_CREATE|O_WRONLY); + if(fd < 0){ + printf("open junk failed\n"); + exit(1); + } + write(fd, (char*)0xffffffffffL, 1); + close(fd); + unlink("junk"); + } + + int fd = open("junk", O_CREATE|O_WRONLY); + if(fd < 0){ + printf("open junk failed\n"); + exit(1); + } + if(write(fd, "x", 1) != 1){ + printf("write failed\n"); + exit(1); + } + close(fd); + unlink("junk"); + + exit(0); +} + +// test the exec() code that cleans up if it runs out +// of memory. it's really a test that such a condition +// doesn't cause a panic. +void +execout(char *s) +{ + for(int avail = 0; avail < 15; avail++){ + int pid = fork(); + if(pid < 0){ + printf("fork failed\n"); + exit(1); + } else if(pid == 0){ + // allocate all of memory. + while(1){ + uint64 a = (uint64) sbrk(4096); + if(a == 0xffffffffffffffffLL) + break; + *(char*)(a + 4096 - 1) = 1; + } + + // free a few pages, in order to let exec() make some + // progress. + for(int i = 0; i < avail; i++) + sbrk(-4096); + + close(1); + char *args[] = { "echo", "x", 0 }; + exec("echo", args); + exit(0); + } else { + wait((int*)0); + } + } + + exit(0); +} + +// can the kernel tolerate running out of disk space? +void +diskfull(char *s) +{ + int fi; + int done = 0; + + unlink("diskfulldir"); + + for(fi = 0; done == 0 && '0' + fi < 0177; fi++){ + char name[32]; + name[0] = 'b'; + name[1] = 'i'; + name[2] = 'g'; + name[3] = '0' + fi; + name[4] = '\0'; + unlink(name); + int fd = open(name, O_CREATE|O_RDWR|O_TRUNC); + if(fd < 0){ + // oops, ran out of inodes before running out of blocks. + printf("%s: could not create file %s\n", s, name); + done = 1; + break; + } + for(int i = 0; i < MAXFILE; i++){ + char buf[BSIZE]; + if(write(fd, buf, BSIZE) != BSIZE){ + done = 1; + close(fd); + break; + } + } + close(fd); + } + + // now that there are no free blocks, test that dirlink() + // merely fails (doesn't panic) if it can't extend + // directory content. one of these file creations + // is expected to fail. + int nzz = 128; + for(int i = 0; i < nzz; i++){ + char name[32]; + name[0] = 'z'; + name[1] = 'z'; + name[2] = '0' + (i / 32); + name[3] = '0' + (i % 32); + name[4] = '\0'; + unlink(name); + int fd = open(name, O_CREATE|O_RDWR|O_TRUNC); + if(fd < 0) + break; + close(fd); + } + + // this mkdir() is expected to fail. + if(mkdir("diskfulldir") == 0) + printf("%s: mkdir(diskfulldir) unexpectedly succeeded!\n", s); + + unlink("diskfulldir"); + + for(int i = 0; i < nzz; i++){ + char name[32]; + name[0] = 'z'; + name[1] = 'z'; + name[2] = '0' + (i / 32); + name[3] = '0' + (i % 32); + name[4] = '\0'; + unlink(name); + } + + for(int i = 0; '0' + i < 0177; i++){ + char name[32]; + name[0] = 'b'; + name[1] = 'i'; + name[2] = 'g'; + name[3] = '0' + i; + name[4] = '\0'; + unlink(name); + } +} + +void +outofinodes(char *s) +{ + int nzz = 32*32; + for(int i = 0; i < nzz; i++){ + char name[32]; + name[0] = 'z'; + name[1] = 'z'; + name[2] = '0' + (i / 32); + name[3] = '0' + (i % 32); + name[4] = '\0'; + unlink(name); + int fd = open(name, O_CREATE|O_RDWR|O_TRUNC); + if(fd < 0){ + // failure is eventually expected. + break; + } + close(fd); + } + + for(int i = 0; i < nzz; i++){ + char name[32]; + name[0] = 'z'; + name[1] = 'z'; + name[2] = '0' + (i / 32); + name[3] = '0' + (i % 32); + name[4] = '\0'; + unlink(name); + } +} + +struct test slowtests[] = { + {bigdir, "bigdir"}, + {manywrites, "manywrites"}, + {badwrite, "badwrite" }, + {execout, "execout"}, + {diskfull, "diskfull"}, + {outofinodes, "outofinodes"}, + + { 0, 0}, +}; + +// +// drive tests +// + +// run each test in its own process. run returns 1 if child's exit() +// indicates success. +int +run(void f(char *), char *s) { + int pid; + int xstatus; + + printf("test %s: ", s); + if((pid = fork()) < 0) { + printf("runtest: fork error\n"); + exit(1); + } + if(pid == 0) { + f(s); + exit(0); + } else { + wait(&xstatus); + if(xstatus != 0) + printf("FAILED\n"); + else + printf("OK\n"); + return xstatus == 0; + } +} + +int +runtests(struct test *tests, char *justone, int continuous) { + for (struct test *t = tests; t->s != 0; t++) { + if((justone == 0) || strcmp(t->s, justone) == 0) { + if(!run(t->f, t->s)){ + if(continuous != 2){ + printf("SOME TESTS FAILED\n"); + return 1; + } + } + } + } + return 0; +} + + +// +// use sbrk() to count how many free physical memory pages there are. +// touches the pages to force allocation. +// because out of memory with lazy allocation results in the process +// taking a fault and being killed, fork and report back. +// +int +countfree() +{ + int fds[2]; + + if(pipe(fds) < 0){ + printf("pipe() failed in countfree()\n"); + exit(1); + } + + int pid = fork(); + + if(pid < 0){ + printf("fork failed in countfree()\n"); + exit(1); + } + + if(pid == 0){ + close(fds[0]); + + while(1){ + uint64 a = (uint64) sbrk(4096); + if(a == 0xffffffffffffffff){ + break; + } + + // modify the memory to make sure it's really allocated. + *(char *)(a + 4096 - 1) = 1; + + // report back one more page. + if(write(fds[1], "x", 1) != 1){ + printf("write() failed in countfree()\n"); + exit(1); + } + } + + exit(0); + } + + close(fds[1]); + + int n = 0; + while(1){ + char c; + int cc = read(fds[0], &c, 1); + if(cc < 0){ + printf("read() failed in countfree()\n"); + exit(1); + } + if(cc == 0) + break; + n += 1; + } + + close(fds[0]); + wait((int*)0); + + return n; +} + +int +drivetests(int quick, int continuous, char *justone) { + do { + printf("usertests starting\n"); + int free0 = countfree(); + int free1 = 0; + if (runtests(quicktests, justone, continuous)) { + if(continuous != 2) { + return 1; + } + } + if(!quick) { + if (justone == 0) + printf("usertests slow tests starting\n"); + if (runtests(slowtests, justone, continuous)) { + if(continuous != 2) { + return 1; + } + } + } + if((free1 = countfree()) < free0) { + printf("FAILED -- lost some free pages %d (out of %d)\n", free1, free0); + if(continuous != 2) { + return 1; + } + } + } while(continuous); + return 0; +} + +int +main(int argc, char *argv[]) +{ + int continuous = 0; + int quick = 0; + char *justone = 0; + + if(argc == 2 && strcmp(argv[1], "-q") == 0){ + quick = 1; + } else if(argc == 2 && strcmp(argv[1], "-c") == 0){ + continuous = 1; + } else if(argc == 2 && strcmp(argv[1], "-C") == 0){ + continuous = 2; + } else if(argc == 2 && argv[1][0] != '-'){ + justone = argv[1]; + } else if(argc > 1){ + printf("Usage: usertests [-c] [-C] [-q] [testname]\n"); + exit(1); + } + if (drivetests(quick, continuous, justone)) { + exit(1); + } + printf("ALL TESTS PASSED\n"); + exit(0); +} diff --git a/usys.pl b/usys.pl new file mode 100755 index 0000000..b7ab009 --- /dev/null +++ b/usys.pl @@ -0,0 +1,45 @@ +#!/usr/bin/perl -w + +# Generate usys.S, the stubs for syscalls. + +print "// generated by usys.pl - do not edit\n"; + +print "#include \"kernel/syscall.h\"\n"; + +sub entry { + my $name = shift; + print ".global $name\n"; + print "${name}:\n"; + print " li a7, SYS_${name}\n"; + print " ecall\n"; + print " ret\n"; +} + +entry("fork"); +entry("exit"); +entry("wait"); +entry("pipe"); +entry("read"); +entry("write"); +entry("close"); +entry("kill"); +entry("execve"); # modified by Zak, replaces exec() which can work on top +entry("open"); +entry("mknod"); +entry("unlink"); +entry("fstat"); +entry("link"); +entry("mkdir"); +entry("chdir"); +entry("dup"); +entry("getpid"); +entry("sbrk"); +entry("sleep"); +entry("uptime"); +entry("prio"); # new syscall, set priority and limit +entry("affin"); # new syscall, set processor affinity +entry("thrd"); # new syscall, launch thread +entry("drvinf"); # new syscall, get drive info +entry("lsdir"); # new syscall, read directory in standardised form +entry("kqueue1"); # new syscall, allocate kqueue +entry("kevent"); # new syscall, wait for events or modify a kqueue diff --git a/wc.c b/wc.c new file mode 100644 index 0000000..d8f3b2a --- /dev/null +++ b/wc.c @@ -0,0 +1,55 @@ +#include "kernel/types.h" +#include "kernel/stat.h" +#include "kernel/fcntl.h" +#include "user/user.h" + +char buf[512]; + +void +wc(int fd, char *name) +{ + int i, n; + int l, w, c, inword; + + l = w = c = 0; + inword = 0; + while((n = read(fd, buf, sizeof(buf))) > 0){ + for(i=0; i 0) + sleep(5); // Let child exit before parent. + exit(0); +}