literal table should be reset on warm boot

diff --git a/library/bootstrap/init-stage2.factor b/library/bootstrap/init-stage2.factor
index 515e2dee8c88c88893ef567c2c23ab590e0a1d82..0bd93a7895121e8f949f92ece462cf252f74b811 100644 (file)
--- a/library/bootstrap/init-stage2.factor
+++ b/library/bootstrap/init-stage2.factor
@@ -44,6 +44,7 @@ USE: words
 USE: unparser
 USE: kernel-internals
 USE: console
+USE: assembler
 
 : default-cli-args
     #! Some flags are *on* by default, unless user specifies
@@ -58,7 +59,7 @@ USE: console
 : warm-boot ( -- )
     #! A fully bootstrapped image has this as the boot
     #! quotation.
-    boot
+    init-assembler
     init-error-handler
     init-random
     default-cli-args
@@ -69,6 +70,7 @@ USE: console
     [ "shells" ] search execute ;
 
 [
+    boot
     warm-boot
     garbage-collection
     run-user-init
@@ -76,60 +78,21 @@ USE: console
     0 exit* 
 ] set-boot
 
-init-error-handler
-
-! An experiment gone wrong...
-
-! : usage+ ( key -- )
-!     dup "usages" word-property
-!     [ succ ] [ 1 ] ifte*
-!     "usages" set-word-property ;
-! 
-! GENERIC: count-usages ( quot -- )
-! M: object count-usages drop ;
-! M: word count-usages usage+ ;
-! M: cons count-usages unswons count-usages count-usages ;
-! 
-! : tally-usages ( -- )
-!     [ f "usages" set-word-property ] each-word
-!     [ word-parameter count-usages ] each-word ;
-! 
-! : auto-inline ( count -- )
-!     #! Automatically inline all words called less than a count
-!     #! number of times.
-!     [
-!         2dup "usages" word-property dup 0 ? >= [
-!             t "inline" set-word-property
-!         ] [
-!             drop
-!         ] ifte
-!     ] each-word drop ;
-
-! "Counting word usages..." print
-! tally-usages
-! 
-! "Automatically inlining words called " write
-! auto-inline-count unparse write
-! " or less times..." print
-! auto-inline-count auto-inline
-
-default-cli-args
-parse-command-line
-
-os "win32" = "compile" get and [
-    "kernel32" "kernel32.dll" "stdcall" add-library
-    "user32"   "user32.dll"   "stdcall" add-library
-    "gdi32"    "gdi32.dll"    "stdcall" add-library
-    "winsock"  "ws2_32.dll"   "stdcall" add-library
-    "mswsock"  "mswsock.dll"  "stdcall" add-library
-    "libc"     "msvcrt.dll"   "cdecl"   add-library
-    "sdl"      "SDL.dll"      "cdecl"   add-library
-    "sdl-gfx"  "SDL_gfx.dll"  "cdecl"   add-library
+warm-boot
+
+os "win32" = [
+    "kernel32" "kernel32.dll" "stdcall"  add-library
+    "user32"   "user32.dll"   "stdcall"  add-library
+    "gdi32"    "gdi32.dll"    "stdcall"  add-library
+    "winsock"  "ws2_32.dll"   "stdcall"  add-library
+    "mswsock"  "mswsock.dll"  "stdcall"  add-library
+    "libc"     "msvcrt.dll"   "cdecl"    add-library
+    "sdl"      "SDL.dll"      "cdecl"    add-library
+    "sdl-gfx"  "SDL_gfx.dll"  "cdecl"    add-library
+    ! FIXME: KLUDGE to get FFI-based IO going in Windows.
+    "/library/bootstrap/win32-io.factor" run-resource
 ] when
 
-! FIXME: KLUDGE to get FFI-based IO going in Windows.
-os "win32" = [ "/library/bootstrap/win32-io.factor" run-resource ] when
-
 "Compiling system..." print
 "compile" get [ compile-all ] when
 

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index e49e5750b5addbbbbd74ec2586f3baea47335c91..2017b45a2359a66f52c538b7e12a9d1a7f298d70 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -85,7 +85,7 @@ vocabularies get [
     [[ "math-internals" "(fraction>)" ]]
     [[ "parser" "str>float" ]]
     [[ "unparser" "(unparse-float)" ]]
-    [[ "math-internals" "(rect>)" ]]
+    [[ "math-internals" "<complex>" ]]
     [[ "math-internals" "fixnum=" ]]
     [[ "math-internals" "fixnum+" ]]
     [[ "math-internals" "fixnum-" ]]

diff --git a/library/compiler/assembler.factor b/library/compiler/assembler.factor
index 83e65b299ad0ce26ac5bc2a5cf4db484365642cc..54d0229fa1ece0bf58a539d591d56c2b8a282a10 100644 (file)
--- a/library/compiler/assembler.factor
+++ b/library/compiler/assembler.factor
@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -69,4 +69,5 @@ SYMBOL: interned-literals
     compiled-offset 0 compile-cell
     compiled-offset 0 compile-cell ;
 
-global [ <namespace> interned-literals set ] bind
+: init-assembler ( -- )
+    global [ <namespace> interned-literals set ] bind ;

diff --git a/library/math/complex.factor b/library/math/complex.factor
index fdc482fe03b40083edf8023b4d6f1f6189d6738e..99551d4a6f0c60b1fef69154f8453a140d0a4898 100644 (file)
--- a/library/math/complex.factor
+++ b/library/math/complex.factor
@@ -28,12 +28,18 @@
 IN: errors
 DEFER: throw
 
-IN: math
+IN: math-internals
 USE: generic
 USE: kernel
 USE: kernel-internals
 USE: math
-USE: math-internals
+
+: (rect>) ( xr xi -- x )
+    #! Does not perform a check that the arguments are reals.
+    #! Do not use in your own code.
+    dup 0 number= [ drop ] [ <complex> ] ifte ; inline
+
+IN: math
 
 GENERIC: real ( #{ re im }# -- re )
 M: real real ;
@@ -45,7 +51,7 @@ M: complex imaginary 1 slot %real ;
 
 : rect> ( xr xi -- x )
     over real? over real? and [
-        dup 0 number= [ drop ] [ (rect>) ] ifte
+        (rect>)
     ] [
         "Complex number must have real components" throw drop
     ] ifte ; inline
@@ -80,17 +86,17 @@ M: complex number= ( x y -- ? )
 : *re ( x y -- xr*yr xi*ri ) 2>rect * >r * r> ; inline
 : *im ( x y -- xi*yr xr*yi ) 2>rect >r * swap r> * ; inline
 
-M: complex + 2>rect + >r + r> rect> ;
-M: complex - 2>rect - >r - r> rect> ;
-M: complex * ( x y -- x*y ) 2dup *re - -rot *im + rect> ;
+M: complex + 2>rect + >r + r> (rect>) ;
+M: complex - 2>rect - >r - r> (rect>) ;
+M: complex * ( x y -- x*y ) 2dup *re - -rot *im + (rect>) ;
 
 : abs^2 ( x -- y ) >rect sq swap sq + ; inline
 : complex/ ( x y -- r i m )
     #! r = xr*yr+xi*yi, i = xi*yr-xr*yi, m = yr*yr+yi*yi
     dup abs^2 >r 2dup *re + -rot *im - r> ; inline
 
-M: complex / ( x y -- x/y ) complex/ tuck / >r / r> rect> ;
-M: complex /f ( x y -- x/y ) complex/ tuck /f >r /f r> rect> ;
+M: complex / ( x y -- x/y ) complex/ tuck / >r / r> (rect>) ;
+M: complex /f ( x y -- x/y ) complex/ tuck /f >r /f r> (rect>) ;
 
 M: complex abs ( z -- |z| ) >rect mag2 ;
 

diff --git a/library/primitives.factor b/library/primitives.factor
index 9847467c24d18eae5761926d3b61fb36bbf998ce..b37e757da99f68d0efe888135993db517e8e16ee 100644 (file)
--- a/library/primitives.factor
+++ b/library/primitives.factor
@@ -81,7 +81,7 @@ USE: words
     [ (fraction>)            [ [ integer integer ] [ rational ] ] ]
     [ str>float              [ [ string ] [ float ] ] ]
     [ (unparse-float)        [ [ float ] [ string ] ] ]
-    [ (rect>)                [ [ real real ] [ number ] ] ]
+    [ <complex>              [ [ real real ] [ number ] ] ]
     [ fixnum=                [ [ fixnum fixnum ] [ boolean ] ] ]
     [ fixnum+                [ [ fixnum fixnum ] [ integer ] ] ]
     [ fixnum-                [ [ fixnum fixnum ] [ integer ] ] ]

diff --git a/native/types.c b/native/types.c
index 4f31e6e39d798e116adc8e4138c6ca726e14e4fb..ffc559340a841bc25359dcb6f56e9d399d5a36f8 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -1,16 +1,5 @@
 #include "factor.h"
 
-/*
- * It is up to the caller to fill in the object's fields in a meaningful
- * fashion!
- */
-void* allot_object(CELL type, CELL length)
-{
-       CELL* object = allot(length);
-       *object = tag_header(type);
-       return object;
-}
-
 CELL object_size(CELL pointer)
 {
        CELL size;

diff --git a/native/types.h b/native/types.h
index 5660a1ea5e17a91fa8189f23533bccb20af889f8..8dddd2165227905f2f8849924f6e056b542ccb0d 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -82,8 +82,17 @@ INLINE void type_check(CELL type, CELL tagged)
 
        type_error(type,tagged);
 }
+/*
+ * It is up to the caller to fill in the object's fields in a meaningful
+ * fashion!
+ */
+INLINE void* allot_object(CELL type, CELL length)
+{
+       CELL* object = allot(length);
+       *object = tag_header(type);
+       return object;
+}
 
-void* allot_object(CELL type, CELL length);
 CELL untagged_object_size(CELL pointer);
 CELL object_size(CELL pointer);
 void primitive_type(void);