it boots!

cvs
Slava Pestov 2004-07-31 20:11:30 +00:00
parent de95f233de
commit ccdbccc139
8 changed files with 18 additions and 6 deletions

View File

@ -2,6 +2,7 @@
ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ] ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ]
- fixup-words is crusty
- decide if overflow is a fatal error - decide if overflow is a fatal error
- f >n: crashes - f >n: crashes
- typecases: type error reporting bad - typecases: type error reporting bad

View File

@ -130,7 +130,7 @@ USE: words
! Eg : foo [ 5 | foo ] ; ! Eg : foo [ 5 | foo ] ;
: fixup-word-later ( word -- ) : fixup-word-later ( word -- )
image vector-length cons "word-fixups" cons@ ; image vector-length cons "word-fixups" get vector-push ;
: fixup-word ( where word -- ) : fixup-word ( where word -- )
dup pooled-object dup [ dup pooled-object dup [
@ -140,7 +140,7 @@ USE: words
] ifte ; ] ifte ;
: fixup-words ( -- ) : fixup-words ( -- )
"word-fixups" get [ unswons fixup-word ] each ; "word-fixups" get [ unswons fixup-word ] vector-each ;
: 'word ( word -- pointer ) : 'word ( word -- pointer )
dup pooled-object dup [ dup pooled-object dup [
@ -148,7 +148,7 @@ USE: words
] [ ] [
drop drop
! Remember where we are, and add the reference later ! Remember where we are, and add the reference later
fixup-word-later f dup fixup-word-later
] ifte ; ] ifte ;
( Conses ) ( Conses )
@ -318,6 +318,10 @@ IN: cross-compiler
300000 <vector> "image" set 300000 <vector> "image" set
521 <hashtable> "objects" set 521 <hashtable> "objects" set
namespace-buckets <hashtable> "vocabularies" set namespace-buckets <hashtable> "vocabularies" set
! Note that this is a vector that we can side-effect,
! since ; ends up using this variable from nested
! parser namespaces.
1000 <vector> "word-fixups" set
begin call end begin call end
"image" get "image" get
] bind ; ] bind ;

View File

@ -136,6 +136,6 @@ USE: strings
[ [
interpreter-loop interpreter-loop
] [ ] [
default-error-handler suspend [ default-error-handler suspend ] when*
] catch ] catch
] when ; ] when ;

View File

@ -70,8 +70,11 @@ USE: vocabularies
: describe-namespace ( namespace -- ) : describe-namespace ( namespace -- )
[ vars-values ] bind describe-assoc ; [ vars-values ] bind describe-assoc ;
: ?unparse ( obj -- str )
dup string? [ unparse ] unless ;
: describe-hashtable ( hashtables -- ) : describe-hashtable ( hashtables -- )
hash>alist describe-assoc ; hash>alist [ unswons ?unparse swons ] inject describe-assoc ;
: describe ( obj -- ) : describe ( obj -- )
[ [

View File

@ -29,6 +29,8 @@ IN: cross-compiler
USE: lists USE: lists
USE: namespaces USE: namespaces
USE: parser USE: parser
USE: prettyprint
USE: stack
: cross-compile-resource ( resource -- ) : cross-compile-resource ( resource -- )
<namespace> [ <namespace> [

View File

@ -31,7 +31,7 @@ typedef unsigned char BYTE;
#define BYTES 1 #define BYTES 1
/* Memory heap size */ /* Memory heap size */
#define DEFAULT_ARENA (4 * 1024 * 1024) #define DEFAULT_ARENA (128 * 1024 * 1024)
#define STACK_SIZE 1024 #define STACK_SIZE 1024
#include "error.h" #include "error.h"

View File

@ -115,6 +115,7 @@ void primitive_write_fd_8(void)
switch(type) switch(type)
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
case BIGNUM_TYPE:
write_fd_char_8(h,to_fixnum(text)); write_fd_char_8(h,to_fixnum(text));
break; break;
case STRING_TYPE: case STRING_TYPE:

View File

@ -37,6 +37,7 @@ CELL allot(CELL a)
} }
else if(active->here > active->alarm) else if(active->here > active->alarm)
{ {
printf("GC\n");
/* Execute the 'garbage-collection' word */ /* Execute the 'garbage-collection' word */
cpush(env.cf); cpush(env.cf);
env.cf = env.user[GC_ENV]; env.cf = env.user[GC_ENV];