diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 186db514e6..7f3cc52498 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,10 +1,8 @@ - plugin should not exit jEdit on fatal errors - auto insert USE: - add a socket timeout -- read# and eof - don't allow multiple reads on the same port - multiple tasks should be able to write to the same port -- prettyprinting an empty vector - jvm factor -- still supporting httpd? - make inferior.factor nicer to use @@ -47,7 +45,6 @@ - accept multi-line input in listener - gc call in the middle of some ops might affect callstack - better i/o scheduler -- better error reporting + JVM compiler: diff --git a/build.xml b/build.xml index df4322733e..4ee51f0313 100644 --- a/build.xml +++ b/build.xml @@ -48,6 +48,7 @@ + diff --git a/factor/FactorLib.java b/factor/FactorLib.java index de6791b8d2..4776ca0eac 100644 --- a/factor/FactorLib.java +++ b/factor/FactorLib.java @@ -222,7 +222,7 @@ public class FactorLib int read = 0; while((read = in.read(bytes,offset,count - offset)) > 0) offset += read; - return new String(bytes,"ASCII"); + return new String(bytes,0,offset,"ASCII"); } //}}} //{{{ readCount() method @@ -234,6 +234,6 @@ public class FactorLib int read = 0; while((read = in.read(chars,offset,count - offset)) > 0) offset += read; - return new String(chars); + return new String(chars,0,offset); } //}}} } diff --git a/library/platform/jvm/parser.factor b/library/platform/jvm/parser.factor index 119cfa9032..8755de0790 100644 --- a/library/platform/jvm/parser.factor +++ b/library/platform/jvm/parser.factor @@ -38,6 +38,9 @@ USE: strings : run-file ( path -- ) parse-file call ; +: ( path -- stream ) + f ; + : parse-resource* ( resource -- list ) dup swap "resource:" swap cat2 swap parse-stream ; diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index 340c6a3c79..432fc170fe 100644 --- a/library/platform/native/boot-stage2.factor +++ b/library/platform/native/boot-stage2.factor @@ -71,6 +71,13 @@ USE: stdio "/library/platform/native/parser.factor" "/library/platform/native/parse-syntax.factor" "/library/platform/native/parse-stream.factor" + "/library/platform/native/unparser.factor" + "/library/format.factor" + "/library/styles.factor" + "/library/vocabulary-style.factor" + "/library/prettyprint.factor" + "/library/debugger.factor" + "/library/platform/native/debugger.factor" "/library/platform/native/init.factor" "/library/math/math.factor" diff --git a/library/platform/native/debugger.factor b/library/platform/native/debugger.factor index 150dda66af..3665e718fa 100644 --- a/library/platform/native/debugger.factor +++ b/library/platform/native/debugger.factor @@ -40,38 +40,65 @@ USE: strings USE: unparser USE: vectors -: kernel-error? ( obj -- ? ) - dup cons? [ car fixnum? ] [ drop f ] ifte ; +: expired-port-error ( obj -- ) + "Expired port: " write . ; -: ?vector-nth ( n vec -- obj ) - over [ - dup >r vector-length min 0 max r> vector-nth - ] [ - 2drop f - ] ifte ; +: undefined-word-error ( obj -- ) + "Undefined word: " write . ; -: error# ( n -- str ) +: type-check-error ( list -- ) + "Type check error" print + uncons car dup "Object: " write . + "Object type: " write type-of type-name print + "Expected type: " write type-name print ; + +: array-range-error ( list -- ) + "Array range check error" print + unswons "Object: " write . + uncons car "Maximum index: " write . + "Requested index: " write . ; + +: io-error ( list -- ) + "I/O error in kernel function " write + unswons write ": " write car print ; + +: numerical-comparison-error ( list -- ) + "Cannot compare " write unswons unparse write + " with " write unparse print ; + +: float-format-error ( list -- ) + "Invalid floating point literal format: " write car . ; + +: signal-error ( obj -- ) + "Operating system signal " write . ; + +: io-task-twice-error ( obj -- ) + "Attempting to perform two simulatenous I/O operations on " + write . ; + +: no-io-tasks-error ( obj -- ) + "No I/O tasks" print ; + +: kernel-error. ( obj n -- str ) { - "Expired port: " - "Undefined word: " - "Type check: " - "Array range check: " - "Underflow" - "I/O error: " - "Overflow" - "Incomparable types: " - "Float format: " - "Signal " - "Adding I/O task twice on port: " - "No I/O tasks" - } ?vector-nth ; + expired-port-error + undefined-word-error + type-check-error + array-range-error + io-error + numerical-comparison-error + float-format-error + signal-error + io-task-twice-error + no-io-tasks-error + } vector-nth execute ; -: ?kernel-error ( cons -- error# param ) - dup cons? [ uncons dup cons? [ car ] when ] [ f ] ifte ; - -: kernel-error. ( error -- ) - ?kernel-error swap error# dup "" ? write - dup [ . ] [ drop terpri ] ifte ; +: kernel-error? ( obj -- ? ) + dup cons? [ uncons cons? swap fixnum? and ] [ drop f ] ifte ; : error. ( error -- str ) - dup kernel-error? [ kernel-error. ] [ . ] ifte ; + dup kernel-error? [ + uncons car swap kernel-error. + ] [ + dup string? [ print ] [ . ] ifte + ] ifte ; diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor index 4af76d5f29..1eef3d7f44 100644 --- a/library/platform/native/kernel.factor +++ b/library/platform/native/kernel.factor @@ -82,23 +82,26 @@ USE: vectors [ drop t ] [ ( return the object ) ] ] cond ; -: class-of ( obj -- name ) +: type-name ( n -- str ) [ - [ fixnum? ] [ drop "fixnum" ] - [ bignum? ] [ drop "bignum" ] - [ ratio? ] [ drop "ratio" ] - [ float? ] [ drop "float" ] - [ complex? ] [ drop "complex" ] - [ cons? ] [ drop "cons" ] - [ word? ] [ drop "word" ] - [ f = ] [ drop "f" ] - [ t = ] [ drop "t" ] - [ vector? ] [ drop "vector" ] - [ string? ] [ drop "string" ] - [ sbuf? ] [ drop "sbuf" ] - [ port? ] [ drop "port" ] - [ drop t ] [ drop "unknown" ] - ] cond ; + [ 0 | "fixnum" ] + [ 1 | "word" ] + [ 2 | "cons" ] + [ 4 | "ratio" ] + [ 5 | "complex" ] + [ 6 | "f" ] + [ 7 | "t" ] + [ 9 | "vector" ] + [ 10 | "string" ] + [ 11 | "sbuf" ] + [ 12 | "port" ] + [ 13 | "bignum" ] + [ 14 | "float" ] + [ 100 | "fixnum/bignum" ] + [ 101 | "fixnum/bignum/ratio" ] + [ 102 | "fixnum/bignum/ratio/float" ] + [ 103 | "fixnum/bignum/ratio/float/complex" ] + ] assoc ; : toplevel ( -- ) init-namespaces diff --git a/library/platform/native/unparser.factor b/library/platform/native/unparser.factor index d2da4e845d..0ba07c9d7d 100644 --- a/library/platform/native/unparser.factor +++ b/library/platform/native/unparser.factor @@ -122,5 +122,5 @@ USE: words [ float? ] [ unparse-float fix-float ] [ complex? ] [ unparse-complex ] [ string? ] [ unparse-str ] - [ drop t ] [ <% "#<" % class-of % ">" % %> ] + [ drop t ] [ <% "#<" % type-of type-name % ">" % %> ] ] cond ; diff --git a/library/prettyprint.factor b/library/prettyprint.factor index 90fe96c610..8f6b8a1308 100644 --- a/library/prettyprint.factor +++ b/library/prettyprint.factor @@ -130,8 +130,12 @@ DEFER: prettyprint* #! Pretty-print a vector, without { and }. [ [ prettyprint-element ] vector-each ] check-recursion ; -: prettyprint-{} ( indent list -- indent ) - swap prettyprint-{ swap prettyprint-vector prettyprint-} ; +: prettyprint-{} ( indent vector -- indent ) + dup vector-length 0 = [ + drop "{ }" write + ] [ + swap prettyprint-{ swap prettyprint-vector prettyprint-} + ] ifte ; : trim-newline ( str -- str ) dup ends-with-newline? dup [ nip ] [ drop ] ifte ; diff --git a/library/test/io/io.factor b/library/test/io/io.factor index 43a4f7edcc..7554acec8f 100644 --- a/library/test/io/io.factor +++ b/library/test/io/io.factor @@ -23,3 +23,9 @@ USE: test ] [ "/library/test/io/mac-os-eol.txt" lines-test ] unit-test + +[ + "This is a line.\rThis is another line.\r" +] [ + 500 "/library/test/io/mac-os-eol.txt" fread# +] unit-test diff --git a/library/test/threads.factor b/library/test/threads.factor index 25e00c45fc..14f9b116ed 100644 --- a/library/test/threads.factor +++ b/library/test/threads.factor @@ -1,11 +1,16 @@ IN: scratchpad USE: namespaces +USE: stdio USE: test USE: threads ! This only tests co-operative threads in CFactor. +! It won't give intended results in Java (or in CFactor if +! we ever get preemptive threads). 3 "x" set [ yield 2 "x" set ] in-thread [ 2 ] [ yield "x" get ] unit-test + +[ flush ] in-thread flush diff --git a/native/complex.c b/native/complex.c index 19c5c81167..b838e136d2 100644 --- a/native/complex.c +++ b/native/complex.c @@ -162,26 +162,29 @@ CELL divfloat_complex(CELL x, CELL y) return possibly_complex(divfloat(r,mag),divfloat(i,mag)); } +#define INCOMPARABLE(x,y) general_error(ERROR_INCOMPARABLE, \ + tag_cons(cons(tag_complex(x),tag_complex(y)))); + CELL less_complex(CELL x, CELL y) { - general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y))); + INCOMPARABLE(x,y); return F; } CELL lesseq_complex(CELL x, CELL y) { - general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y))); + INCOMPARABLE(x,y); return F; } CELL greater_complex(CELL x, CELL y) { - general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y))); + INCOMPARABLE(x,y); return F; } CELL greatereq_complex(CELL x, CELL y) { - general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y))); + INCOMPARABLE(x,y); return F; } diff --git a/native/error.h b/native/error.h index 5d6b0878b9..6430778cd4 100644 --- a/native/error.h +++ b/native/error.h @@ -2,14 +2,12 @@ #define ERROR_UNDEFINED_WORD (1<<3) #define ERROR_TYPE (2<<3) #define ERROR_RANGE (3<<3) -#define ERROR_UNDERFLOW (4<<3) -#define ERROR_IO (5<<3) -#define ERROR_OVERFLOW (6<<3) -#define ERROR_INCOMPARABLE (7<<3) -#define ERROR_FLOAT_FORMAT (8<<3) -#define ERROR_SIGNAL (9<<3) -#define ERROR_IO_TASK_TWICE (10<<3) -#define ERROR_IO_TASK_NONE (11<<3) +#define ERROR_IO (4<<3) +#define ERROR_INCOMPARABLE (5<<3) +#define ERROR_FLOAT_FORMAT (6<<3) +#define ERROR_SIGNAL (7<<3) +#define ERROR_IO_TASK_TWICE (8<<3) +#define ERROR_IO_TASK_NONE (9<<3) void fatal_error(char* msg, CELL tagged); void critical_error(char* msg, CELL tagged);