diff --git a/runtime/ikarus b/runtime/ikarus index a533502..085e629 100755 Binary files a/runtime/ikarus and b/runtime/ikarus differ diff --git a/runtime/ikarus-collect.c b/runtime/ikarus-collect.c index faebc94..c2e92d0 100644 --- a/runtime/ikarus-collect.c +++ b/runtime/ikarus-collect.c @@ -11,7 +11,7 @@ #include #define forward_ptr ((ikp)-1) -#define DEBUG_STACK 0 +//#define DEBUG_STACK 0 #define minimum_heap_size (pagesize * 1024 * 4) #define maximum_heap_size (pagesize * 1024 * 8) #define minimum_stack_size (pagesize * 128) @@ -231,7 +231,7 @@ gc_tconc_push(gc_t* gc, ikp tcbucket){ } } -static ikp add_object(gc_t* gc, ikp x); +static ikp add_object(gc_t* gc, ikp x, char* caller); static void collect_stack(gc_t*, ikp top, ikp base); static void collect_loop(gc_t*); static void fix_weak_pointers(gc_t*); @@ -306,8 +306,8 @@ ik_collect(int req, ikpcb* pcb){ */ scan_dirty_pages(&gc); collect_stack(&gc, pcb->frame_pointer, pcb->frame_base - wordsize); - pcb->next_k = add_object(&gc, pcb->next_k); - pcb->oblist = add_object(&gc, pcb->oblist); + pcb->next_k = add_object(&gc, pcb->next_k, "main"); + pcb->oblist = add_object(&gc, pcb->oblist, "main"); /* now we trace all live objects */ collect_loop(&gc); @@ -539,7 +539,7 @@ static void collect_stack(gc_t* gc, ikp top, ikp end){ } ikp base = top + framesize - wordsize; while(base > top){ - ikp new_obj = add_object(gc,ref(base,0)); + ikp new_obj = add_object(gc,ref(base,0), "frame"); ref(base,0) = new_obj; base -= wordsize; } @@ -552,14 +552,17 @@ static void collect_stack(gc_t* gc, ikp top, ikp end){ int i; for(i=0; ip; ikp q = qu->q; while(p < q){ - ref(p,0) = add_object(gc, ref(p,0)); + ref(p,0) = add_object(gc, ref(p,0), "loop"); p += (2*wordsize); } qupages_t* next = qu->next; @@ -907,7 +909,7 @@ collect_loop(gc_t* gc){ ikp p = qu->p; ikp q = qu->q; while(p < q){ - ref(p,0) = add_object(gc, ref(p,0)); + ref(p,0) = add_object(gc, ref(p,0), "pending"); p += wordsize; } qupages_t* next = qu->next; @@ -946,7 +948,7 @@ collect_loop(gc_t* gc){ do{ meta->aq = q; while(p < q){ - ref(p,0) = add_object(gc, ref(p,0)); + ref(p,0) = add_object(gc, ref(p,0), "rem"); p += (2*wordsize); } p = meta->aq; @@ -963,7 +965,7 @@ collect_loop(gc_t* gc){ do{ meta->aq = q; while(p < q){ - ref(p,0) = add_object(gc, ref(p,0)); + ref(p,0) = add_object(gc, ref(p,0), "rem2"); p += wordsize; } p = meta->aq; @@ -1102,7 +1104,7 @@ scan_dirty_pointers_page(gc_t* gc, int page_idx, int mask){ if(is_fixnum(x) || (tagof(x) == immediate_tag)){ /* do nothing */ } else { - ikp y = add_object(gc, x); + ikp y = add_object(gc, x, "nothing"); segment_vec = gc->segment_vector; ref(p, 0) = y; card_d = card_d | segment_vec[page_index(y)]; @@ -1151,7 +1153,7 @@ scan_dirty_code_page(gc_t* gc, int page_idx, unsigned int mask){ if(is_fixnum(r) || (tagof(r) == immediate_tag)){ /* do nothing */ } else { - r = add_object(gc, r); + r = add_object(gc, r, "nothing2"); segment_vec = gc->segment_vector; code_d = code_d | segment_vec[page_index(r)]; } @@ -1186,7 +1188,7 @@ scan_dirty_weak_pointers_page(gc_t* gc, int page_idx, int mask){ if(is_fixnum(x) || tagof(x) == immediate_tag){ /* do nothing */ } else { - ikp y = add_object(gc, x); + ikp y = add_object(gc, x, "nothing3"); ref(p, wordsize) = y; } p += (2*wordsize); diff --git a/runtime/ikarus-runtime.c b/runtime/ikarus-runtime.c index eb87f56..85c5696 100644 --- a/runtime/ikarus-runtime.c +++ b/runtime/ikarus-runtime.c @@ -488,6 +488,115 @@ ikp ik_open_file(ikp str, ikp flagptr){ return fix(fd); } + +/* + #include + #include + int + stat(const char *path, struct stat *sb); +ERRORS + Stat() and lstat() will fail if: + [ENOTDIR] A component of the path prefix is not a directory. + [ENAMETOOLONG] A component of a pathname exceeded {NAME_MAX} charac- + ters, or an entire path name exceeded {PATH_MAX} char- + acters. + [ENOENT] The named file does not exist. + [EACCES] Search permission is denied for a component of the + path prefix. + [ELOOP] Too many symbolic links were encountered in translat- + ing the pathname. + [EFAULT] Sb or name points to an invalid address. + [EIO] An I/O error occurred while reading from or writing to + the file system. +*/ +ikp +ikrt_file_exists(ikp filename){ + char* str = string_data(filename); + struct stat sb; + int st = stat(str, &sb); + if(st == 0){ + /* success */ + return true_object; + } else { + int err = errno; + if(err == ENOENT){ + return false_object; + } + else if(err == ENOTDIR){ + return fix(1); + } + else if(err == ENAMETOOLONG){ + return fix(2); + } + else if(err == EACCES){ + return fix(3); + } + else if(err == ELOOP){ + return fix(4); + } + else if(err == EFAULT){ + return fix(5); + } + else if(err == EIO){ + return fix(6); + } + else { + return fix(-1); + } + } +} + + +/* + [ENOTDIR] A component of the path prefix is not a directory. + [ENAMETOOLONG] A component of a pathname exceeded {NAME_MAX} charac- + ters, or an entire path name exceeded {PATH_MAX} char- + acters. + [ENOENT] The named file does not exist. + [EACCES] Search permission is denied for a component of the + path prefix. + [EACCES] Write permission is denied on the directory containing + the link to be removed. + [ELOOP] Too many symbolic links were encountered in translat- + ing the pathname. + [EPERM] The named file is a directory and the effective user + ID of the process is not the super-user. + [EPERM] The directory containing the file is marked sticky, + and neither the containing directory nor the file to + be removed are owned by the effective user ID. + [EBUSY] The entry to be unlinked is the mount point for a + mounted file system. + [EIO] An I/O error occurred while deleting the directory + entry or deallocating the inode. + [EROFS] The named file resides on a read-only file system. + [EFAULT] Path points outside the process's allocated address + space. +*/ + + +ikp +ikrt_delete_file(ikp filename){ + char* str = string_data(filename); + int err = unlink(str); + if(err == 0){ + return 0; + } + switch (err){ + case ENOTDIR: return fix(1); + case ENAMETOOLONG: return fix(2); + case ENOENT: return fix(3); + case EACCES: return fix(4); + case ELOOP: return fix(5); + case EPERM: return fix(6); + case EBUSY: return fix(7); + case EIO: return fix(8); + case EROFS: return fix(9); + case EFAULT: return fix(10); + } + return fix(-1); +} + + ikp ik_close(ikp fd){ int err = close(unfix(fd)); if(err != 0){ diff --git a/src/ikarus.boot b/src/ikarus.boot index 739e9d1..779e8d5 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.boot.back b/src/ikarus.boot.back index ff79ab8..c76236a 100644 Binary files a/src/ikarus.boot.back and b/src/ikarus.boot.back differ diff --git a/src/libposix.ss b/src/libposix.ss index 0c4c6a9..6e80eef 100644 --- a/src/libposix.ss +++ b/src/libposix.ss @@ -21,3 +21,48 @@ (error 'system "failed") rv)))) +(primitive-set! 'file-exists? + (lambda (x) + (unless (string? x) + (error 'file-exists? "filename ~s is not a string" x)) + (let ([v (foreign-call "ikrt_file_exists" x)]) + (cond + [(boolean? v) v] + [else + (error 'file-exists? + (case v + [(1) "the path ~s contains a non-directory"] + [(2) "the path ~s is too long"] + [(3) "the path ~s is not accessible"] + [(4) "the path ~s contains too many symbolic links"] + [(5) "internal access error while accessing ~s"] + [(6) "IO error encountered while accessing ~s"] + [else "Unknown error in ~s"]) + x)])))) + +(primitive-set! 'delete-file + (lambda (x) + (unless (string? x) + (error 'delete-file "filename ~s is not a string" x)) + (let ([v (foreign-call "ikrt_delete_file" x)]) + (case v + [(0) (void)] + [else + (error 'delete-file + (case v + [(1) "the path ~s contains a non-directory"] + [(2) "the path ~s is too long"] + [(3) "the file ~s does not exist"] + [(4) "the path ~s is not accessible"] + [(5) "the path ~s contains too many symbolic links"] + [(6) "you do not have permissions to delete ~s"] + [(7) "device ~s is busy"] + [(8) "IO error encountered while deleting ~s"] + [(9) "~s is in a read-only file system"] + [(10) "internal access error while deleting ~s"] + [else "Unknown error while deleting ~s"]) + x)])))) + + + + diff --git a/src/makefile.ss b/src/makefile.ss index 16c1c96..a08a9d7 100644 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -108,6 +108,7 @@ with-output-to-file call-with-output-file with-input-from-file call-with-input-file date-string + file-exists? delete-file + - add1 sub1 * expt number? positive? negative? zero? number->string logand