run-file works again

TODO.FACTOR.txt

@@ -3,8 +3,6 @@
 - image output
 - 32-bit and 64-bit "bignums"
 - floats
-- file i/o using fds
-- handle expiry over image load/save
 - i/o error handling
 - {...} vectors
 - parsing should be parsing

library/init.factor

@@ -85,13 +85,9 @@ USE: strings
 : init-interpreter ( -- )
     #! If we're run stand-alone, start the interpreter on stdio.
     "interactive" get [
-        [
+        [ "top-level-continuation" set ] callcc0
-            [ "top-level-continuation" set ] callcc0
 
-            interpreter-loop
+        interpreter-loop
-        ] [
-            [ default-error-handler ] when*
-        ] catch
     ] [
         f "top-level-continuation" set
     ] ifte ;

library/platform/native/image.factor

@@ -50,7 +50,7 @@ USE: words
 : emit ( cell -- ) image vector-push ;
 : fixup ( value offset -- ) image set-vector-nth ;
 
-!!! Object memory
+( Object memory )
 
 : image-magic HEX: 0f0e0d0c ;
 : image-version 0 ;
@@ -73,7 +73,7 @@ USE: words
 : immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
 : >header ( id -- tagged ) header-tag immediate ;
 
-!!! Image header
+( Image header )
 
 : header ( -- )
     image-magic emit
@@ -88,13 +88,13 @@ USE: words
 : heap-size-offset 5 ;
 : header-size      6 ;
 
-!!! Top of heap pointer
+( Top of heap pointer )
 
 : here ( -- size ) image vector-length header-size - cell * ;
 : here-as ( tag -- pointer ) here swap bitor ;
 : pad ( -- ) here 8 mod 4 = [ 0 emit ] when ;
 
-!!! Remember what objects we've compiled
+( Remember what objects we've compiled )
 
 : pooled-object ( object -- pointer )
     "objects" get hash ;
@@ -102,11 +102,11 @@ USE: words
 : pool-object ( object pointer -- )
     swap "objects" get set-hash ;
 
-!!! Fixnums
+( Fixnums )
 
 : 'fixnum ( n -- tagged ) fixnum-tag immediate ;
 
-!!! Special objects
+( Special objects )
 
 ! Padded with fixnums for 8-byte alignment
 
@@ -114,12 +114,12 @@ USE: words
 : t, object-tag here-as "t" set 7 >header emit 0 'fixnum emit ;
 : empty, 8 >header emit 0 'fixnum emit ;
 
-!!! Beginning of the image
+( Beginning of the image )
 ! The image proper begins with the header, then EMPTY, F, T
 
 : begin ( -- ) header empty, f, t, ;
 
-!!! Words
+( Words )
 
 : word, ( -- pointer ) word-tag here-as xt-tag emit ;
 
@@ -151,14 +151,14 @@ USE: words
         fixup-word-later f
     ] ifte ;
 
-!!! Conses
+( Conses )
 
 DEFER: '
 
 : cons, ( -- pointer ) cons-tag here-as ;
 : 'cons ( c -- tagged ) uncons ' swap ' cons, -rot emit emit ;
 
-!!! Strings
+( Strings )
 
 : pack ( n n -- ) 16 shift< bitor emit ;
 
@@ -195,7 +195,7 @@ DEFER: '
         drop dup string, dup >r pool-object r>
     ] ifte ;
 
-!!! Word definitions
+( Word definitions )
 
 IN: namespaces
 
@@ -237,7 +237,7 @@ IN: cross-compiler
 : primitive, ( word primitive -- ) f (worddef,) ;
 : compound, ( word definition -- ) 1 swap (worddef,) ;
 
-!!! Arrays and vectors
+( Arrays and vectors )
 
 : 'array ( list -- untagged )
     [ ' ] inject
@@ -255,7 +255,7 @@ IN: cross-compiler
     emit ( array ptr )
     pad r> ;
 
-!!! Cross-compile a reference to an object
+( Cross-compile a reference to an object )
 
 : ' ( obj -- pointer )
     [
@@ -270,7 +270,7 @@ IN: cross-compiler
         [ drop t  ] [ "Cannot cross-compile: " swap cat2 throw ]
     ] cond ;
 
-!!! End of the image
+( End of the image )
 
 : (set-boot) ( quot -- ) ' boot-quot-offset fixup ;
 : (set-global) ( namespace -- ) ' global-offset fixup ;
@@ -282,7 +282,7 @@ IN: cross-compiler
 
 : end ( -- ) global, fixup-words here heap-size-offset fixup ;
 
-!!! Image output
+( Image output )
 
 : byte0 ( num -- byte ) 24 shift> HEX: ff bitand ;
 : byte1 ( num -- byte ) 16 shift> HEX: ff bitand ;

library/platform/native/parse-stream.factor

@@ -64,7 +64,7 @@ USE: streams
 
 : parse-stream ( name stream -- code )
     <namespace> [
-        >r init-parser r> [ room. (parse) ] read-lines nreverse
+        >r init-parser r> [ (parse) ] read-lines nreverse
     ] bind ;
 
 : parse-file ( file -- code )

native/factor.h

@@ -37,19 +37,19 @@
 #include "gc.h"
 #include "types.h"
 #include "array.h"
+#include "handle.h"
+#include "fixnum.h"
+#include "string.h"
 #include "fd.h"
 #include "file.h"
-#include "fixnum.h"
 #include "cons.h"
 #include "word.h"
 #include "run.h"
-#include "handle.h"
 #include "image.h"
 #include "primitives.h"
 #include "vector.h"
 #include "socket.h"
 #include "stack.h"
-#include "string.h"
 #include "sbuf.h"
 #include "relocate.h"
 

native/fd.c

@@ -14,12 +14,21 @@ void primitive_close_fd(void)
 	env.dt = dpop();
 }
 
+int fill_buffer(HANDLE* h, int fd, STRING* buf)
+{
+	int amount = read(fd,buf + 1,buf->capacity * 2);
+
+	h->buf_fill = (amount < 0 ? 0 : amount);
+	h->buf_pos = 0;
+
+	return amount;
+}
+
 void primitive_read_line_fd_8(void)
 {
 	HANDLE* h = untag_handle(HANDLE_FD,env.dt);
 	int fd = h->object;
 
-	int amount;
 	int i;
 	int ch;
 
@@ -36,20 +45,17 @@ void primitive_read_line_fd_8(void)
 	{
 		if(h->buf_pos >= h->buf_fill)
 		{
-			amount = read(fd,buf + 1,buf->capacity * 2);
+			if(fill_buffer(h,fd,buf) <= 0)
-			
-			if(amount <= 0) /* error or EOF */
 			{
 				if(line->top == 0)
+				{
 					/* didn't read anything before EOF */
 					env.dt = F;
+				}
 				else
 					env.dt = tag_object(line);
 				return;
 			}
-
-			h->buf_fill = amount;
-			h->buf_pos = 0;
 		}
 
 		for(i = h->buf_pos; i < h->buf_fill; i++)
@@ -64,6 +70,9 @@ void primitive_read_line_fd_8(void)
 			else
 				set_sbuf_nth(line,line->top,ch);
 		}
+		
+		/* We've reached the end of the above loop */
+		h->buf_pos = h->buf_fill;
 	}
 }
 

native/fd.h

@@ -2,6 +2,7 @@
 #define BUF_SIZE 1024
 
 void primitive_close_fd(void);
+int fill_buffer(HANDLE* h, int fd, STRING* buf);
 void primitive_read_line_fd_8(void);
 void primitive_write_fd_8(void);
 void primitive_flush_fd(void);