working on native run-file

TODO.FACTOR.txt

@@ -1,22 +1,20 @@
-contains ==> contains?
+- prettyprint-1
-
+- {...} vectors
-.s: needs nreverse
+- better .s
-
+- parsing should be parsing
-{...} vectors
+- telnetd: listening on a socket
-better .s
+- vocab inspecting ==> worddef>list, assumes . on a list works
+- need hashtable inspection too
+- describe-word
+- clone-sbuf
+- contains ==> contains?
+- telnetd: send errors on socket
+- native 'see'
 
 + native:
 
-- .s shows fixnums as chars
 - partition, sort
-- describe-word
+- inspector: sort
-- need hashtable inspection too
-- clone-sbuf
-- parsing should be parsing
-- inspector:
-       sort
-           partition
-- vocab inspecting ==> worddef>list, assumes . on a list works
 
 + interactive:
 
@@ -62,6 +60,7 @@ better .s
 
 + httpd:
 
+- use catch
 - httpd: don't flush so much
 - log with date
 - log user agent

build.xml

@@ -21,18 +21,11 @@
 			compress="true"
 		>
 			<fileset dir=".">
-				<include name="factor/*.java"/>
-				<include name="factor/**/*.java"/>
 				<include name="factor/*.class"/>
-				<include name="factor/*.factor"/>
-				<include name="factor/*.fasl"/>
-				<include name="factor/**/*.factor"/>
 				<include name="factor/**/*.class"/>
 				<include name="library/**/*.factor"/>
-				<include name="org/**/*.java"/>
 				<include name="org/**/*.class"/>
 				<include name="*.factor"/>
-				<include name="*.lsa"/>
 				<include name="Factor.manifest"/>
 			</fileset>
 		</jar>
@@ -40,7 +33,6 @@
 	<target name="clean" description="Clean old stuff.">
 		<delete>
 			<fileset dir="." includes="**/*.class"/>
-			<fileset dir="." includes="**/*.fasl"/>
 			<fileset dir="." includes="**/*~" defaultexcludes="no"/>
 			<fileset dir="." includes="**/#*#" defaultexcludes="no"/>
 			<fileset dir="." includes="**/*.rej"/>

library/platform/native/cross-compiler.factor

@@ -50,8 +50,10 @@ DEFER: str=
 DEFER: str-hashcode
 
 IN: io-internals
+DEFER: open-file
 DEFER: read-line-8
 DEFER: write-8
+DEFER: close
 
 IN: words
 DEFER: <word>
@@ -131,8 +133,10 @@ IN: cross-compiler
         eq?
         getenv
         setenv
+        open-file
         read-line-8
         write-8
+        close
         garbage-collection
         save-image
         datastack

library/platform/native/errors.factor

@@ -76,6 +76,6 @@ DEFER: default-error-handler
 
 : init-errors ( -- )
     64 <vector> set-catchstack*
-    [ 1 exit* ] >c
+    [ 1 exit* ] >c ( last resort )
     [ default-error-handler ] >c
     [ throw ] 5 setenv ( kernel calls on error ) ;

library/platform/native/parse-stream.factor

@@ -39,7 +39,7 @@ USE: streams
     "line-number" succ@ ;
 
 : (parse-stream) ( -- )
-    next-line [ (parse) (parse-stream) ] when* ;
+    next-line [ print (parse-stream) ] when* ;
 
 : parse-stream ( name stream -- )
     <namespace> [
@@ -52,3 +52,9 @@ USE: streams
             "parse-stream" get fclose rethrow
         ] catch
     ] bind ;
+
+: parse-file ( file -- code )
+    "r" <file-stream> parse-stream ;
+
+: run-file ( file -- )
+    parse-file call ;

library/platform/native/prettyprint.factor

@@ -35,9 +35,14 @@ USE: vocabularies
 USE: words
 
 : see ( word -- )
+    !!! Ugh!
     intern dup compound? [
         0 swap dup word-parameter
-        prettyprint-:;
+        [
+            [ prettyprint-: ] dip prettyprint-word
+            dup prettyprint-newline
+        ] dip
+        prettyprint-list prettyprint-;
         prettyprint-newline
     ] [
         dup primitive? [

library/platform/native/stream.factor

@@ -26,8 +26,10 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 IN: streams
+USE: combinators
 USE: io-internals
 USE: kernel
+USE: stack
 USE: namespaces
 
 : <native-stream> ( in out -- stream )
@@ -41,7 +43,15 @@ USE: namespaces
         [ "out" get write-8 ] "fwrite" set
         ( -- string )
         [ "in" get read-line-8 ] "freadln" set
+        ( -- )
+        [
+            "in" get [ close ] when*
+            "out" get [ close ] when*
+        ] "fclose" set
     ] extend ;
 
+: <file-stream> ( path mode -- stream )
+    open-file dup <native-stream> ;
+
 : init-stdio ( -- )
     stdin stdout <native-stream> "stdio" set ;

native/factor.h

@@ -1,6 +1,7 @@
 #ifndef __FACTOR_H__
 #define __FACTOR_H__
 
+#include <errno.h>
 #include <setjmp.h>
 #include <stdbool.h>
 #include <stdio.h>

native/io.c

@@ -9,6 +9,17 @@ void init_io(void)
 
 #define LINE_SIZE 80
 
+void primitive_open_file(void)
+{
+	char* mode = to_c_string(untag_string(env.dt));
+	char* path = to_c_string(untag_string(dpop()));
+	printf("fopen %s %s\n",path,mode);
+	FILE* file = fopen(path,mode);
+	if(file == 0)
+		printf("error %d\n",errno);
+	env.dt = handle(file);
+}
+
 /* read a line of ASCII text. */
 void primitive_read_line_8(void)
 {
@@ -56,3 +67,9 @@ void primitive_write_8(void)
 	for(i = 0; i < strlen; i++)
 		putc(string_nth(str,i),file);
 }
+
+void primitive_close(void)
+{
+	HANDLE* h = untag_handle(env.dt);
+	fclose((FILE*)h->object);
+}

native/io.h

@@ -1,3 +1,5 @@
 void init_io(void);
+void primitive_open_file(void);
 void primitive_read_line_8(void);
 void primitive_write_8(void);
+void primitive_close(void);

native/primitives.c

@@ -68,16 +68,18 @@ XT primitives[] = {
 	primitive_eq,                           /* 64 */
 	primitive_getenv,                       /* 65 */
 	primitive_setenv,                       /* 66 */
-	primitive_read_line_8,                  /* 67 */
+	primitive_open_file,                    /* 67 */
-	primitive_write_8,                      /* 68 */
+	primitive_read_line_8,                  /* 68 */
-	primitive_gc,                           /* 69 */
+	primitive_write_8,                      /* 69 */
-	primitive_save_image,                   /* 70 */
+	primitive_close,                        /* 70 */
-	primitive_datastack,                    /* 71 */
+	primitive_gc,                           /* 71 */
-	primitive_callstack,                    /* 72 */
+	primitive_save_image,                   /* 72 */
-	primitive_set_datastack,                /* 73 */
+	primitive_datastack,                    /* 73 */
-	primitive_set_callstack,                /* 74 */
+	primitive_callstack,                    /* 74 */
-	primitive_handlep,                      /* 75 */
+	primitive_set_datastack,                /* 75 */
-	primitive_exit                          /* 76 */
+	primitive_set_callstack,                /* 76 */
+	primitive_handlep,                      /* 77 */
+	primitive_exit                          /* 78 */
 };
 
 CELL primitive_to_xt(CELL primitive)

native/primitives.h

@@ -1,5 +1,5 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 77
+#define PRIMITIVE_COUNT 79
 
 CELL primitive_to_xt(CELL primitive);