literal table should be reset on warm boot
Slava Pestov
parent
3617093ba5
commit
0270b62ce5
|
|
@ -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
|
||||
warm-boot
|
||||
|
||||
! 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
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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-" ]]
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ] ] ]
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in New Issue