Merge branch 'master' of git://factorcode.org/git/factor
commit
cc05a90900
|
@ -652,10 +652,10 @@ M: ppc %alien-callback ( quot -- )
|
|||
|
||||
M: ppc %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
13 3 MR ;
|
||||
15 3 MR ;
|
||||
|
||||
M: ppc %alien-indirect ( -- )
|
||||
13 MTLR BLRL ;
|
||||
15 MTLR BLRL ;
|
||||
|
||||
M: ppc %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
|
@ -713,3 +713,4 @@ USE: vocabs.loader
|
|||
} cond
|
||||
|
||||
"complex-double" c-type t >>return-in-registers? drop
|
||||
"bool" c-type 4 >>size 4 >>align drop
|
|
@ -0,0 +1,4 @@
|
|||
IN: io.backend.windows.privileges.tests
|
||||
USING: io.backend.windows.privileges tools.test ;
|
||||
|
||||
[ [ ] with-privileges ] must-infer
|
|
@ -1,12 +1,13 @@
|
|||
USING: io.backend kernel continuations sequences
|
||||
system vocabs.loader combinators ;
|
||||
system vocabs.loader combinators fry ;
|
||||
IN: io.backend.windows.privileges
|
||||
|
||||
HOOK: set-privilege io-backend ( name ? -- ) inline
|
||||
HOOK: set-privilege io-backend ( name ? -- )
|
||||
|
||||
: with-privileges ( seq quot -- )
|
||||
over [ [ t set-privilege ] each ] curry compose
|
||||
swap [ [ f set-privilege ] each ] curry [ ] cleanup ; inline
|
||||
[ '[ _ [ t set-privilege ] each @ ] ]
|
||||
[ drop '[ _ [ f set-privilege ] each ] ]
|
||||
2bi [ ] cleanup ; inline
|
||||
|
||||
{
|
||||
{ [ os winnt? ] [ "io.backend.windows.nt.privileges" require ] }
|
||||
|
|
|
@ -35,6 +35,9 @@ SYMBOL: unique-retries
|
|||
: random-name ( -- string )
|
||||
unique-length get [ random-ch ] "" replicate-as ;
|
||||
|
||||
: retry ( quot: ( -- ? ) n -- )
|
||||
swap [ drop ] prepose attempt-all ; inline
|
||||
|
||||
: (make-unique-file) ( path prefix suffix -- path )
|
||||
'[
|
||||
_ _ _ random-name glue append-path
|
||||
|
|
|
@ -42,7 +42,7 @@ IN: io.launcher.windows.nt.tests
|
|||
console-vm "-run=listener" 2array >>command
|
||||
+closed+ >>stdin
|
||||
+stdout+ >>stderr
|
||||
ascii [ input-stream get contents ] with-process-reader
|
||||
ascii [ contents ] with-process-reader
|
||||
] unit-test
|
||||
|
||||
: launcher-test-path ( -- str )
|
||||
|
@ -85,7 +85,7 @@ IN: io.launcher.windows.nt.tests
|
|||
<process>
|
||||
console-vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
ascii <process-reader> lines first
|
||||
ascii <process-reader> stream-lines first
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
|
@ -97,7 +97,7 @@ IN: io.launcher.windows.nt.tests
|
|||
launcher-test-path [
|
||||
<process>
|
||||
console-vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
ascii <process-reader> stream-contents
|
||||
] with-directory eval( -- alist )
|
||||
|
||||
os-envs =
|
||||
|
@ -109,7 +109,7 @@ IN: io.launcher.windows.nt.tests
|
|||
console-vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
os-envs >>environment
|
||||
ascii <process-reader> contents
|
||||
ascii <process-reader> stream-contents
|
||||
] with-directory eval( -- alist )
|
||||
|
||||
os-envs =
|
||||
|
@ -120,7 +120,7 @@ IN: io.launcher.windows.nt.tests
|
|||
<process>
|
||||
console-vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
ascii <process-reader> contents
|
||||
ascii <process-reader> stream-contents
|
||||
] with-directory eval( -- alist )
|
||||
|
||||
"A" swap at
|
||||
|
@ -132,7 +132,7 @@ IN: io.launcher.windows.nt.tests
|
|||
console-vm "-script" "env.factor" 3array >>command
|
||||
{ { "USERPROFILE" "XXX" } } >>environment
|
||||
+prepend-environment+ >>environment-mode
|
||||
ascii <process-reader> contents
|
||||
ascii <process-reader> stream-contents
|
||||
] with-directory eval( -- alist )
|
||||
|
||||
"USERPROFILE" swap at "XXX" =
|
||||
|
|
|
@ -5,8 +5,6 @@ random sequences sets combinators.short-circuit math.bitwise
|
|||
math math.order ;
|
||||
IN: math.miller-rabin
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: >odd ( n -- int ) 0 set-bit ; foldable
|
||||
|
||||
: >even ( n -- int ) 0 clear-bit ; foldable
|
||||
|
@ -15,7 +13,7 @@ IN: math.miller-rabin
|
|||
|
||||
: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ;
|
||||
|
||||
TUPLE: positive-even-expected n ;
|
||||
<PRIVATE
|
||||
|
||||
:: (miller-rabin) ( n trials -- ? )
|
||||
n 1 - :> n-1
|
||||
|
|
|
@ -23,7 +23,13 @@ IN: tools.deploy.shaker
|
|||
|
||||
: strip-init-hooks ( -- )
|
||||
"Stripping startup hooks" show
|
||||
{ "cpu.x86" "command-line" "libc" "system" "environment" }
|
||||
{
|
||||
"command-line"
|
||||
"cpu.x86"
|
||||
"environment"
|
||||
"libc"
|
||||
"alien.strings"
|
||||
}
|
||||
[ init-hooks get delete-at ] each
|
||||
deploy-threads? get [
|
||||
"threads" init-hooks get delete-at
|
||||
|
@ -36,8 +42,12 @@ IN: tools.deploy.shaker
|
|||
"io.backend" init-hooks get delete-at
|
||||
] when
|
||||
strip-dictionary? [
|
||||
"compiler.units" init-hooks get delete-at
|
||||
"vocabs.cache" init-hooks get delete-at
|
||||
{
|
||||
"compiler.units"
|
||||
"vocabs"
|
||||
"vocabs.cache"
|
||||
"source-files.errors"
|
||||
} [ init-hooks get delete-at ] each
|
||||
] when ;
|
||||
|
||||
: strip-debugger ( -- )
|
||||
|
@ -260,21 +270,20 @@ IN: tools.deploy.shaker
|
|||
compiler.errors:compiler-errors
|
||||
definition-observers
|
||||
interactive-vocabs
|
||||
layouts:num-tags
|
||||
layouts:num-types
|
||||
layouts:tag-mask
|
||||
layouts:tag-numbers
|
||||
layouts:type-numbers
|
||||
lexer-factory
|
||||
print-use-hook
|
||||
root-cache
|
||||
source-files.errors:error-types
|
||||
source-files.errors:error-observers
|
||||
vocabs:dictionary
|
||||
vocabs:load-vocab-hook
|
||||
vocabs:vocab-observers
|
||||
word
|
||||
parser-notes
|
||||
} %
|
||||
|
||||
{ } { "layouts" } strip-vocab-globals %
|
||||
|
||||
{ } { "math.partial-dispatch" } strip-vocab-globals %
|
||||
|
||||
{ } { "peg" } strip-vocab-globals %
|
||||
|
|
|
@ -79,7 +79,6 @@ $nl
|
|||
{ $subsection continue-with }
|
||||
"Continuations as control-flow:"
|
||||
{ $subsection attempt-all }
|
||||
{ $subsection retry }
|
||||
{ $subsection with-return }
|
||||
"Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
|
||||
{ $subsection "continuations.private" } ;
|
||||
|
@ -232,21 +231,6 @@ HELP: attempt-all
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: retry
|
||||
{ $values
|
||||
{ "quot" quotation } { "n" integer }
|
||||
}
|
||||
{ $description "Tries the quotation up to " { $snippet "n" } " times until it returns true. Retries the quotation if an exception is thrown or if the quotation returns " { $link f } ". The quotation is expected to have side effects that may fail, such as generating a random name for a new file until successful." }
|
||||
{ $examples
|
||||
"Try to get a 0 as a random number:"
|
||||
{ $unchecked-example "USING: continuations math prettyprint random ;"
|
||||
"[ 5 random 0 = ] 5 retry"
|
||||
"t"
|
||||
}
|
||||
} ;
|
||||
|
||||
{ attempt-all retry } related-words
|
||||
|
||||
HELP: return
|
||||
{ $description "Returns early from a quotation by reifying the continuation captured by " { $link with-return } " ; execution is resumed starting immediately after " { $link with-return } "." } ;
|
||||
|
||||
|
|
|
@ -155,8 +155,6 @@ ERROR: attempt-all-error ;
|
|||
] { } make peek swap [ rethrow ] when
|
||||
] if ; inline
|
||||
|
||||
: retry ( quot: ( -- ? ) n -- ) swap [ drop ] prepose attempt-all ; inline
|
||||
|
||||
TUPLE: condition error restarts continuation ;
|
||||
|
||||
C: <condition> condition ( error restarts cc -- condition )
|
||||
|
|
|
@ -1,15 +1,15 @@
|
|||
USING: tools.deploy.config ;
|
||||
H{
|
||||
{ deploy-name "Hello world (console)" }
|
||||
{ deploy-c-types? f }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-ui? f }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-compiler? f }
|
||||
{ deploy-unicode? f }
|
||||
{ deploy-ui? f }
|
||||
{ deploy-compiler? t }
|
||||
{ deploy-name "Hello world (console)" }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-word-defs? f }
|
||||
{ deploy-threads? f }
|
||||
{ "stop-after-last-window?" t }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-math? f }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-word-defs? f }
|
||||
{ deploy-c-types? f }
|
||||
{ "stop-after-last-window?" t }
|
||||
}
|
||||
|
|
|
@ -25,7 +25,7 @@ M: image <image-gadget>
|
|||
|
||||
M: string <image-gadget> load-image <image-gadget> ;
|
||||
|
||||
M: pathname <image-gadget> load-image <image-gadget> ;
|
||||
M: pathname <image-gadget> string>> load-image <image-gadget> ;
|
||||
|
||||
: image-window ( object -- ) <image-gadget> "Image" open-window ;
|
||||
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel calendar io.directories io.encodings.utf8
|
||||
io.files io.launcher mason.child mason.cleanup mason.common
|
||||
mason.help mason.release mason.report mason.email mason.notify
|
||||
namespaces prettyprint ;
|
||||
io.files io.launcher namespaces prettyprint mason.child mason.cleanup
|
||||
mason.common mason.help mason.release mason.report mason.email
|
||||
mason.notify ;
|
||||
IN: mason.build
|
||||
|
||||
QUALIFIED: continuations
|
||||
|
@ -19,7 +19,10 @@ QUALIFIED: continuations
|
|||
|
||||
: begin-build ( -- )
|
||||
"factor" [ git-id ] with-directory
|
||||
[ "git-id" to-file ] [ notify-begin-build ] bi ;
|
||||
[ "git-id" to-file ]
|
||||
[ current-git-id set ]
|
||||
[ notify-begin-build ]
|
||||
tri ;
|
||||
|
||||
: build ( -- )
|
||||
create-build-dir
|
||||
|
|
|
@ -4,9 +4,12 @@ USING: kernel namespaces sequences splitting system accessors
|
|||
math.functions make io io.files io.pathnames io.directories
|
||||
io.directories.hierarchy io.launcher io.encodings.utf8 prettyprint
|
||||
combinators.short-circuit parser combinators calendar
|
||||
calendar.format arrays mason.config locals system debugger ;
|
||||
calendar.format arrays mason.config locals system debugger fry
|
||||
continuations ;
|
||||
IN: mason.common
|
||||
|
||||
SYMBOL: current-git-id
|
||||
|
||||
ERROR: output-process-error output process ;
|
||||
|
||||
M: output-process-error error.
|
||||
|
@ -35,15 +38,19 @@ M: unix really-delete-tree delete-tree ;
|
|||
<process>
|
||||
swap >>command
|
||||
15 minutes >>timeout
|
||||
+closed+ >>stdin
|
||||
try-output-process ;
|
||||
|
||||
: retry ( n quot -- )
|
||||
'[ drop @ f ] attempt-all drop ; inline
|
||||
|
||||
:: upload-safely ( local username host remote -- )
|
||||
[let* | temp [ remote ".incomplete" append ]
|
||||
scp-remote [ { username "@" host ":" temp } concat ]
|
||||
scp [ scp-command get ]
|
||||
ssh [ ssh-command get ] |
|
||||
{ scp local scp-remote } short-running-process
|
||||
{ ssh host "-l" username "mv" temp remote } short-running-process
|
||||
5 [ { scp local scp-remote } short-running-process ] retry
|
||||
5 [ { ssh host "-l" username "mv" temp remote } short-running-process ] retry
|
||||
] ;
|
||||
|
||||
: eval-file ( file -- obj )
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
IN: mason.email.tests
|
||||
USING: mason.email mason.common mason.config namespaces tools.test ;
|
||||
|
||||
[ "mason on linux-x86-64: error" ] [
|
||||
[ "mason on linux-x86-64: 12345 -- error" ] [
|
||||
[
|
||||
"linux" target-os set
|
||||
"x86.64" target-cpu set
|
||||
"12345" current-git-id set
|
||||
status-error subject prefix-subject
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces accessors combinators make smtp debugger
|
||||
prettyprint io io.streams.string io.encodings.utf8 io.files io.sockets
|
||||
mason.common mason.platform mason.config ;
|
||||
prettyprint sequences io io.streams.string io.encodings.utf8 io.files
|
||||
io.sockets mason.common mason.platform mason.config ;
|
||||
IN: mason.email
|
||||
|
||||
: prefix-subject ( str -- str' )
|
||||
|
@ -18,11 +18,11 @@ IN: mason.email
|
|||
send-email ;
|
||||
|
||||
: subject ( status -- str )
|
||||
{
|
||||
[ current-git-id get 7 short head " -- " ] dip {
|
||||
{ status-clean [ "clean" ] }
|
||||
{ status-dirty [ "dirty" ] }
|
||||
{ status-error [ "error" ] }
|
||||
} case ;
|
||||
} case 3append ;
|
||||
|
||||
: email-report ( report status -- )
|
||||
[ "text/html" ] dip subject email-status ;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.directories io.files io.launcher kernel make
|
||||
mason.common mason.config mason.platform namespaces prettyprint
|
||||
sequences ;
|
||||
namespaces prettyprint sequences mason.common mason.config
|
||||
mason.platform ;
|
||||
IN: mason.release.branch
|
||||
|
||||
: branch-name ( -- string ) "clean-" platform append ;
|
||||
|
@ -21,7 +21,7 @@ IN: mason.release.branch
|
|||
] { } make ;
|
||||
|
||||
: push-to-clean-branch ( -- )
|
||||
push-to-clean-branch-cmd short-running-process ;
|
||||
5 [ push-to-clean-branch-cmd short-running-process ] retry ;
|
||||
|
||||
: upload-clean-image-cmd ( -- args )
|
||||
[
|
||||
|
@ -36,7 +36,7 @@ IN: mason.release.branch
|
|||
] { } make ;
|
||||
|
||||
: upload-clean-image ( -- )
|
||||
upload-clean-image-cmd short-running-process ;
|
||||
5 [ upload-clean-image-cmd short-running-process ] retry ;
|
||||
|
||||
: (update-clean-branch) ( -- )
|
||||
"factor" [
|
||||
|
|
|
@ -12,7 +12,7 @@ IN: mason.report
|
|||
target-cpu get
|
||||
host-name
|
||||
build-dir
|
||||
"git-id" eval-file
|
||||
current-git-id get
|
||||
[XML
|
||||
<h1>Build report for <->/<-></h1>
|
||||
<table>
|
||||
|
|
|
@ -26,6 +26,9 @@ short-url "SHORT_URLS" {
|
|||
: random-url ( -- string )
|
||||
1 6 [a,b] random [ letter-bank random ] "" replicate-as ;
|
||||
|
||||
: retry ( quot: ( -- ? ) n -- )
|
||||
swap [ drop ] prepose attempt-all ; inline
|
||||
|
||||
: insert-short-url ( short-url -- short-url )
|
||||
'[ _ dup random-url >>short insert-tuple ] 10 retry ;
|
||||
|
||||
|
|
|
@ -24,10 +24,7 @@ void iterate_callstack(cell top, cell bottom, CALLSTACK_ITER iterator)
|
|||
|
||||
void iterate_callstack_object(callstack *stack, CALLSTACK_ITER iterator)
|
||||
{
|
||||
cell top = (cell)FIRST_STACK_FRAME(stack);
|
||||
cell bottom = top + untag_fixnum(stack->length);
|
||||
|
||||
iterate_callstack(top,bottom,iterator);
|
||||
iterate_callstack((cell)stack->top(),(cell)stack->bottom(),iterator);
|
||||
}
|
||||
|
||||
callstack *allot_callstack(cell size)
|
||||
|
@ -75,7 +72,7 @@ PRIMITIVE(callstack)
|
|||
size = 0;
|
||||
|
||||
callstack *stack = allot_callstack(size);
|
||||
memcpy(FIRST_STACK_FRAME(stack),top,size);
|
||||
memcpy(stack->top(),top,size);
|
||||
dpush(tag<callstack>(stack));
|
||||
}
|
||||
|
||||
|
@ -84,7 +81,7 @@ PRIMITIVE(set_callstack)
|
|||
callstack *stack = untag_check<callstack>(dpop());
|
||||
|
||||
set_callstack(stack_chain->callstack_bottom,
|
||||
FIRST_STACK_FRAME(stack),
|
||||
stack->top(),
|
||||
untag_fixnum(stack->length),
|
||||
memcpy);
|
||||
|
||||
|
@ -173,12 +170,11 @@ PRIMITIVE(callstack_to_array)
|
|||
dpush(tag<array>(frames));
|
||||
}
|
||||
|
||||
stack_frame *innermost_stack_frame(callstack *callstack)
|
||||
stack_frame *innermost_stack_frame(callstack *stack)
|
||||
{
|
||||
stack_frame *top = FIRST_STACK_FRAME(callstack);
|
||||
cell bottom = (cell)top + untag_fixnum(callstack->length);
|
||||
|
||||
stack_frame *frame = (stack_frame *)bottom - 1;
|
||||
stack_frame *top = stack->top();
|
||||
stack_frame *bottom = stack->bottom();
|
||||
stack_frame *frame = bottom - 1;
|
||||
|
||||
while(frame >= top && frame_successor(frame) >= top)
|
||||
frame = frame_successor(frame);
|
||||
|
|
|
@ -6,8 +6,6 @@ inline static cell callstack_size(cell size)
|
|||
return sizeof(callstack) + size;
|
||||
}
|
||||
|
||||
#define FIRST_STACK_FRAME(stack) (stack_frame *)((stack) + 1)
|
||||
|
||||
typedef void (*CALLSTACK_ITER)(stack_frame *frame);
|
||||
|
||||
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
|
||||
|
|
|
@ -3,6 +3,21 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
static relocation_type relocation_type_of(relocation_entry r)
|
||||
{
|
||||
return (relocation_type)((r & 0xf0000000) >> 28);
|
||||
}
|
||||
|
||||
static relocation_class relocation_class_of(relocation_entry r)
|
||||
{
|
||||
return (relocation_class)((r & 0x0f000000) >> 24);
|
||||
}
|
||||
|
||||
static cell relocation_offset_of(relocation_entry r)
|
||||
{
|
||||
return (r & 0x00ffffff);
|
||||
}
|
||||
|
||||
void flush_icache_for(code_block *block)
|
||||
{
|
||||
flush_icache((cell)block,block->size);
|
||||
|
@ -125,11 +140,11 @@ void *get_rel_symbol(array *literals, cell index)
|
|||
cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
array *literals = untag<array>(compiled->literals);
|
||||
cell offset = REL_OFFSET(rel) + (cell)compiled->xt();
|
||||
cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
|
||||
|
||||
#define ARG array_nth(literals,index)
|
||||
|
||||
switch(REL_TYPE(rel))
|
||||
switch(relocation_type_of(rel))
|
||||
{
|
||||
case RT_PRIMITIVE:
|
||||
return (cell)primitives[untag_fixnum(ARG)];
|
||||
|
@ -174,7 +189,7 @@ void iterate_relocations(code_block *compiled, relocation_iterator iter)
|
|||
{
|
||||
relocation_entry rel = relocation->data<relocation_entry>()[i];
|
||||
iter(rel,index,compiled);
|
||||
index += number_of_parameters(REL_TYPE(rel));
|
||||
index += number_of_parameters(relocation_type_of(rel));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -217,25 +232,25 @@ void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
|||
store_address_2_2((cell *)offset,absolute_value);
|
||||
break;
|
||||
case RC_ABSOLUTE_PPC_2:
|
||||
store_address_masked((cell *)offset,absolute_value,REL_ABSOLUTE_PPC_2_MASK,0);
|
||||
store_address_masked((cell *)offset,absolute_value,rel_absolute_ppc_2_mask,0);
|
||||
break;
|
||||
case RC_RELATIVE_PPC_2:
|
||||
store_address_masked((cell *)offset,relative_value,REL_RELATIVE_PPC_2_MASK,0);
|
||||
store_address_masked((cell *)offset,relative_value,rel_relative_ppc_2_mask,0);
|
||||
break;
|
||||
case RC_RELATIVE_PPC_3:
|
||||
store_address_masked((cell *)offset,relative_value,REL_RELATIVE_PPC_3_MASK,0);
|
||||
store_address_masked((cell *)offset,relative_value,rel_relative_ppc_3_mask,0);
|
||||
break;
|
||||
case RC_RELATIVE_ARM_3:
|
||||
store_address_masked((cell *)offset,relative_value - sizeof(cell) * 2,
|
||||
REL_RELATIVE_ARM_3_MASK,2);
|
||||
rel_relative_arm_3_mask,2);
|
||||
break;
|
||||
case RC_INDIRECT_ARM:
|
||||
store_address_masked((cell *)offset,relative_value - sizeof(cell),
|
||||
REL_INDIRECT_ARM_MASK,0);
|
||||
rel_indirect_arm_mask,0);
|
||||
break;
|
||||
case RC_INDIRECT_ARM_PC:
|
||||
store_address_masked((cell *)offset,relative_value - sizeof(cell) * 2,
|
||||
REL_INDIRECT_ARM_MASK,0);
|
||||
rel_indirect_arm_mask,0);
|
||||
break;
|
||||
default:
|
||||
critical_error("Bad rel class",klass);
|
||||
|
@ -245,12 +260,12 @@ void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
|||
|
||||
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
if(REL_TYPE(rel) == RT_IMMEDIATE)
|
||||
if(relocation_type_of(rel) == RT_IMMEDIATE)
|
||||
{
|
||||
cell offset = REL_OFFSET(rel) + (cell)(compiled + 1);
|
||||
cell offset = relocation_offset_of(rel) + (cell)(compiled + 1);
|
||||
array *literals = untag<array>(compiled->literals);
|
||||
fixnum absolute_value = array_nth(literals,index);
|
||||
store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
|
||||
store_address_in_code_block(relocation_class_of(rel),offset,absolute_value);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -297,14 +312,14 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp
|
|||
tagged<byte_array>(compiled->relocation).untag_check();
|
||||
#endif
|
||||
|
||||
store_address_in_code_block(REL_CLASS(rel),
|
||||
REL_OFFSET(rel) + (cell)compiled->xt(),
|
||||
store_address_in_code_block(relocation_class_of(rel),
|
||||
relocation_offset_of(rel) + (cell)compiled->xt(),
|
||||
compute_relocation(rel,index,compiled));
|
||||
}
|
||||
|
||||
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
relocation_type type = REL_TYPE(rel);
|
||||
relocation_type type = relocation_type_of(rel);
|
||||
if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
|
||||
relocate_code_block_step(rel,index,compiled);
|
||||
}
|
||||
|
@ -369,7 +384,7 @@ void mark_stack_frame_step(stack_frame *frame)
|
|||
/* Mark code blocks executing in currently active stack frames. */
|
||||
void mark_active_blocks(context *stacks)
|
||||
{
|
||||
if(collecting_gen == TENURED)
|
||||
if(collecting_gen == data->tenured())
|
||||
{
|
||||
cell top = (cell)stacks->callstack_top;
|
||||
cell bottom = (cell)stacks->callstack_bottom;
|
||||
|
@ -410,7 +425,7 @@ void mark_object_code_block(object *object)
|
|||
/* Perform all fixups on a code block */
|
||||
void relocate_code_block(code_block *compiled)
|
||||
{
|
||||
compiled->last_scan = NURSERY;
|
||||
compiled->last_scan = data->nursery();
|
||||
compiled->needs_fixup = false;
|
||||
iterate_relocations(compiled,relocate_code_block_step);
|
||||
flush_icache_for(compiled);
|
||||
|
@ -480,7 +495,7 @@ code_block *add_code_block(
|
|||
|
||||
/* compiled header */
|
||||
compiled->type = type;
|
||||
compiled->last_scan = NURSERY;
|
||||
compiled->last_scan = data->nursery();
|
||||
compiled->needs_fixup = true;
|
||||
compiled->relocation = relocation.value();
|
||||
|
||||
|
@ -499,7 +514,7 @@ code_block *add_code_block(
|
|||
|
||||
/* next time we do a minor GC, we have to scan the code heap for
|
||||
literals */
|
||||
last_code_heap_scan = NURSERY;
|
||||
last_code_heap_scan = data->nursery();
|
||||
|
||||
return compiled;
|
||||
}
|
||||
|
|
|
@ -51,17 +51,14 @@ enum relocation_class {
|
|||
RC_INDIRECT_ARM_PC
|
||||
};
|
||||
|
||||
#define REL_ABSOLUTE_PPC_2_MASK 0xffff
|
||||
#define REL_RELATIVE_PPC_2_MASK 0xfffc
|
||||
#define REL_RELATIVE_PPC_3_MASK 0x3fffffc
|
||||
#define REL_INDIRECT_ARM_MASK 0xfff
|
||||
#define REL_RELATIVE_ARM_3_MASK 0xffffff
|
||||
static const cell rel_absolute_ppc_2_mask = 0xffff;
|
||||
static const cell rel_relative_ppc_2_mask = 0xfffc;
|
||||
static const cell rel_relative_ppc_3_mask = 0x3fffffc;
|
||||
static const cell rel_indirect_arm_mask = 0xfff;
|
||||
static const cell rel_relative_arm_3_mask = 0xffffff;
|
||||
|
||||
/* code relocation table consists of a table of entries for each fixup */
|
||||
typedef u32 relocation_entry;
|
||||
#define REL_TYPE(r) (relocation_type)(((r) & 0xf0000000) >> 28)
|
||||
#define REL_CLASS(r) (relocation_class)(((r) & 0x0f000000) >> 24)
|
||||
#define REL_OFFSET(r) ((r) & 0x00ffffff)
|
||||
|
||||
void flush_icache_for(code_block *compiled);
|
||||
|
||||
|
|
|
@ -22,9 +22,9 @@ void new_heap(heap *heap, cell size)
|
|||
|
||||
static void add_to_free_list(heap *heap, free_heap_block *block)
|
||||
{
|
||||
if(block->size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
|
||||
if(block->size < free_list_count * block_size_increment)
|
||||
{
|
||||
int index = block->size / BLOCK_SIZE_INCREMENT;
|
||||
int index = block->size / block_size_increment;
|
||||
block->next_free = heap->free.small_blocks[index];
|
||||
heap->free.small_blocks[index] = block;
|
||||
}
|
||||
|
@ -45,7 +45,7 @@ void build_free_list(heap *heap, cell size)
|
|||
|
||||
clear_free_list(heap);
|
||||
|
||||
size = (size + BLOCK_SIZE_INCREMENT - 1) & ~(BLOCK_SIZE_INCREMENT - 1);
|
||||
size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
|
||||
|
||||
heap_block *scan = first_block(heap);
|
||||
free_heap_block *end = (free_heap_block *)(heap->seg->start + size);
|
||||
|
@ -101,9 +101,9 @@ static free_heap_block *find_free_block(heap *heap, cell size)
|
|||
{
|
||||
cell attempt = size;
|
||||
|
||||
while(attempt < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
|
||||
while(attempt < free_list_count * block_size_increment)
|
||||
{
|
||||
int index = attempt / BLOCK_SIZE_INCREMENT;
|
||||
int index = attempt / block_size_increment;
|
||||
free_heap_block *block = heap->free.small_blocks[index];
|
||||
if(block)
|
||||
{
|
||||
|
@ -156,7 +156,7 @@ static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cel
|
|||
/* Allocate a block of memory from the mark and sweep GC heap */
|
||||
heap_block *heap_allot(heap *heap, cell size)
|
||||
{
|
||||
size = (size + BLOCK_SIZE_INCREMENT - 1) & ~(BLOCK_SIZE_INCREMENT - 1);
|
||||
size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
|
||||
|
||||
free_heap_block *block = find_free_block(heap,size);
|
||||
if(block)
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
#define FREE_LIST_COUNT 16
|
||||
#define BLOCK_SIZE_INCREMENT 32
|
||||
static const cell free_list_count = 16;
|
||||
static const cell block_size_increment = 32;
|
||||
|
||||
struct heap_free_list {
|
||||
free_heap_block *small_blocks[FREE_LIST_COUNT];
|
||||
free_heap_block *small_blocks[free_list_count];
|
||||
free_heap_block *large_blocks;
|
||||
};
|
||||
|
||||
|
|
|
@ -18,12 +18,12 @@ void reset_retainstack()
|
|||
rs = rs_bot - sizeof(cell);
|
||||
}
|
||||
|
||||
#define RESERVED (64 * sizeof(cell))
|
||||
static const cell stack_reserved = (64 * sizeof(cell));
|
||||
|
||||
void fix_stacks()
|
||||
{
|
||||
if(ds + sizeof(cell) < ds_bot || ds + RESERVED >= ds_top) reset_datastack();
|
||||
if(rs + sizeof(cell) < rs_bot || rs + RESERVED >= rs_top) reset_retainstack();
|
||||
if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
|
||||
if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
|
||||
}
|
||||
|
||||
/* called before entry into foreign C code. Note that ds and rs might
|
||||
|
|
|
@ -27,7 +27,7 @@ inline static void check_call_site(cell return_address)
|
|||
#endif
|
||||
}
|
||||
|
||||
#define B_MASK 0x3fffffc
|
||||
static const cell b_mask = 0x3fffffc;
|
||||
|
||||
inline static void *get_call_target(cell return_address)
|
||||
{
|
||||
|
|
|
@ -9,15 +9,15 @@ bool performing_gc;
|
|||
bool performing_compaction;
|
||||
cell collecting_gen;
|
||||
|
||||
/* if true, we collecting AGING space for the second time, so if it is still
|
||||
full, we go on to collect TENURED */
|
||||
/* if true, we collecting aging space for the second time, so if it is still
|
||||
full, we go on to collect tenured */
|
||||
bool collecting_aging_again;
|
||||
|
||||
/* in case a generation fills up in the middle of a gc, we jump back
|
||||
up to try collecting the next generation. */
|
||||
jmp_buf gc_jmp;
|
||||
|
||||
gc_stats stats[MAX_GEN_COUNT];
|
||||
gc_stats stats[max_gen_count];
|
||||
u64 cards_scanned;
|
||||
u64 decks_scanned;
|
||||
u64 card_scan_time;
|
||||
|
@ -36,7 +36,7 @@ data_heap *old_data_heap;
|
|||
void init_data_gc()
|
||||
{
|
||||
performing_gc = false;
|
||||
last_code_heap_scan = NURSERY;
|
||||
last_code_heap_scan = data->nursery();
|
||||
collecting_aging_again = false;
|
||||
}
|
||||
|
||||
|
@ -66,11 +66,11 @@ static bool should_copy_p(object *untagged)
|
|||
{
|
||||
if(in_zone(newspace,untagged))
|
||||
return false;
|
||||
if(collecting_gen == TENURED)
|
||||
if(collecting_gen == data->tenured())
|
||||
return true;
|
||||
else if(HAVE_AGING_P && collecting_gen == AGING)
|
||||
return !in_zone(&data->generations[TENURED],untagged);
|
||||
else if(collecting_gen == NURSERY)
|
||||
else if(data->have_aging_p() && collecting_gen == data->aging())
|
||||
return !in_zone(&data->generations[data->tenured()],untagged);
|
||||
else if(collecting_gen == data->nursery())
|
||||
return in_zone(&nursery,untagged);
|
||||
else
|
||||
{
|
||||
|
@ -186,19 +186,19 @@ static void copy_gen_cards(cell gen)
|
|||
|
||||
/* if we are collecting the nursery, we care about old->nursery pointers
|
||||
but not old->aging pointers */
|
||||
if(collecting_gen == NURSERY)
|
||||
if(collecting_gen == data->nursery())
|
||||
{
|
||||
mask = CARD_POINTS_TO_NURSERY;
|
||||
mask = card_points_to_nursery;
|
||||
|
||||
/* after the collection, no old->nursery pointers remain
|
||||
anywhere, but old->aging pointers might remain in tenured
|
||||
space */
|
||||
if(gen == TENURED)
|
||||
unmask = CARD_POINTS_TO_NURSERY;
|
||||
if(gen == data->tenured())
|
||||
unmask = card_points_to_nursery;
|
||||
/* after the collection, all cards in aging space can be
|
||||
cleared */
|
||||
else if(HAVE_AGING_P && gen == AGING)
|
||||
unmask = CARD_MARK_MASK;
|
||||
else if(data->have_aging_p() && gen == data->aging())
|
||||
unmask = card_mark_mask;
|
||||
else
|
||||
{
|
||||
critical_error("bug in copy_gen_cards",gen);
|
||||
|
@ -208,20 +208,20 @@ static void copy_gen_cards(cell gen)
|
|||
/* if we are collecting aging space into tenured space, we care about
|
||||
all old->nursery and old->aging pointers. no old->aging pointers can
|
||||
remain */
|
||||
else if(HAVE_AGING_P && collecting_gen == AGING)
|
||||
else if(data->have_aging_p() && collecting_gen == data->aging())
|
||||
{
|
||||
if(collecting_aging_again)
|
||||
{
|
||||
mask = CARD_POINTS_TO_AGING;
|
||||
unmask = CARD_MARK_MASK;
|
||||
mask = card_points_to_aging;
|
||||
unmask = card_mark_mask;
|
||||
}
|
||||
/* after we collect aging space into the aging semispace, no
|
||||
old->nursery pointers remain but tenured space might still have
|
||||
pointers to aging space. */
|
||||
else
|
||||
{
|
||||
mask = CARD_POINTS_TO_AGING;
|
||||
unmask = CARD_POINTS_TO_NURSERY;
|
||||
mask = card_points_to_aging;
|
||||
unmask = card_points_to_nursery;
|
||||
}
|
||||
}
|
||||
else
|
||||
|
@ -366,8 +366,8 @@ static cell copy_next_from_aging(cell scan)
|
|||
{
|
||||
obj++;
|
||||
|
||||
cell tenured_start = data->generations[TENURED].start;
|
||||
cell tenured_end = data->generations[TENURED].end;
|
||||
cell tenured_start = data->generations[data->tenured()].start;
|
||||
cell tenured_end = data->generations[data->tenured()].end;
|
||||
|
||||
cell newspace_start = newspace->start;
|
||||
cell newspace_end = newspace->end;
|
||||
|
@ -421,17 +421,17 @@ static cell copy_next_from_tenured(cell scan)
|
|||
|
||||
void copy_reachable_objects(cell scan, cell *end)
|
||||
{
|
||||
if(collecting_gen == NURSERY)
|
||||
if(collecting_gen == data->nursery())
|
||||
{
|
||||
while(scan < *end)
|
||||
scan = copy_next_from_nursery(scan);
|
||||
}
|
||||
else if(HAVE_AGING_P && collecting_gen == AGING)
|
||||
else if(data->have_aging_p() && collecting_gen == data->aging())
|
||||
{
|
||||
while(scan < *end)
|
||||
scan = copy_next_from_aging(scan);
|
||||
}
|
||||
else if(collecting_gen == TENURED)
|
||||
else if(collecting_gen == data->tenured())
|
||||
{
|
||||
while(scan < *end)
|
||||
scan = copy_next_from_tenured(scan);
|
||||
|
@ -443,12 +443,12 @@ static void begin_gc(cell requested_bytes)
|
|||
{
|
||||
if(growing_data_heap)
|
||||
{
|
||||
if(collecting_gen != TENURED)
|
||||
if(collecting_gen != data->tenured())
|
||||
critical_error("Invalid parameters to begin_gc",0);
|
||||
|
||||
old_data_heap = data;
|
||||
set_data_heap(grow_data_heap(old_data_heap,requested_bytes));
|
||||
newspace = &data->generations[TENURED];
|
||||
newspace = &data->generations[data->tenured()];
|
||||
}
|
||||
else if(collecting_accumulation_gen_p())
|
||||
{
|
||||
|
@ -491,12 +491,12 @@ static void end_gc(cell gc_elapsed)
|
|||
if(collecting_accumulation_gen_p())
|
||||
{
|
||||
/* all younger generations except are now empty.
|
||||
if collecting_gen == NURSERY here, we only have 1 generation;
|
||||
if collecting_gen == data->nursery() here, we only have 1 generation;
|
||||
old-school Cheney collector */
|
||||
if(collecting_gen != NURSERY)
|
||||
reset_generations(NURSERY,collecting_gen - 1);
|
||||
if(collecting_gen != data->nursery())
|
||||
reset_generations(data->nursery(),collecting_gen - 1);
|
||||
}
|
||||
else if(collecting_gen == NURSERY)
|
||||
else if(collecting_gen == data->nursery())
|
||||
{
|
||||
nursery.here = nursery.start;
|
||||
}
|
||||
|
@ -504,7 +504,7 @@ static void end_gc(cell gc_elapsed)
|
|||
{
|
||||
/* all generations up to and including the one
|
||||
collected are now empty */
|
||||
reset_generations(NURSERY,collecting_gen);
|
||||
reset_generations(data->nursery(),collecting_gen);
|
||||
}
|
||||
|
||||
collecting_aging_again = false;
|
||||
|
@ -534,17 +534,17 @@ void garbage_collection(cell gen,
|
|||
{
|
||||
/* We have no older generations we can try collecting, so we
|
||||
resort to growing the data heap */
|
||||
if(collecting_gen == TENURED)
|
||||
if(collecting_gen == data->tenured())
|
||||
{
|
||||
growing_data_heap = true;
|
||||
|
||||
/* see the comment in unmark_marked() */
|
||||
unmark_marked(&code);
|
||||
}
|
||||
/* we try collecting AGING space twice before going on to
|
||||
collect TENURED */
|
||||
else if(HAVE_AGING_P
|
||||
&& collecting_gen == AGING
|
||||
/* we try collecting aging space twice before going on to
|
||||
collect tenured */
|
||||
else if(data->have_aging_p()
|
||||
&& collecting_gen == data->aging()
|
||||
&& !collecting_aging_again)
|
||||
{
|
||||
collecting_aging_again = true;
|
||||
|
@ -575,7 +575,7 @@ void garbage_collection(cell gen,
|
|||
{
|
||||
code_heap_scans++;
|
||||
|
||||
if(collecting_gen == TENURED)
|
||||
if(collecting_gen == data->tenured())
|
||||
free_unmarked(&code,(heap_iterator)update_literal_and_word_references);
|
||||
else
|
||||
copy_code_heap_roots();
|
||||
|
@ -595,7 +595,7 @@ void garbage_collection(cell gen,
|
|||
|
||||
void gc()
|
||||
{
|
||||
garbage_collection(TENURED,false,0);
|
||||
garbage_collection(data->tenured(),false,0);
|
||||
}
|
||||
|
||||
PRIMITIVE(gc)
|
||||
|
@ -610,7 +610,7 @@ PRIMITIVE(gc_stats)
|
|||
cell i;
|
||||
u64 total_gc_time = 0;
|
||||
|
||||
for(i = 0; i < MAX_GEN_COUNT; i++)
|
||||
for(i = 0; i < max_gen_count; i++)
|
||||
{
|
||||
gc_stats *s = &stats[i];
|
||||
result.add(allot_cell(s->collections));
|
||||
|
@ -635,8 +635,7 @@ PRIMITIVE(gc_stats)
|
|||
|
||||
void clear_gc_stats()
|
||||
{
|
||||
int i;
|
||||
for(i = 0; i < MAX_GEN_COUNT; i++)
|
||||
for(cell i = 0; i < max_gen_count; i++)
|
||||
memset(&stats[i],0,sizeof(gc_stats));
|
||||
|
||||
cards_scanned = 0;
|
||||
|
@ -683,7 +682,7 @@ PRIMITIVE(become)
|
|||
|
||||
VM_C_API void minor_gc()
|
||||
{
|
||||
garbage_collection(NURSERY,false,0);
|
||||
garbage_collection(data->nursery(),false,0);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -24,10 +24,10 @@ void gc();
|
|||
|
||||
inline static bool collecting_accumulation_gen_p()
|
||||
{
|
||||
return ((HAVE_AGING_P
|
||||
&& collecting_gen == AGING
|
||||
return ((data->have_aging_p()
|
||||
&& collecting_gen == data->aging()
|
||||
&& !collecting_aging_again)
|
||||
|| collecting_gen == TENURED);
|
||||
|| collecting_gen == data->tenured());
|
||||
}
|
||||
|
||||
void copy_handle(cell *handle);
|
||||
|
@ -39,7 +39,7 @@ void garbage_collection(volatile cell gen,
|
|||
/* We leave this many bytes free at the top of the nursery so that inline
|
||||
allocation (which does not call GC because of possible roots in volatile
|
||||
registers) does not run out of memory */
|
||||
#define ALLOT_BUFFER_ZONE 1024
|
||||
static const cell allot_buffer_zone = 1024;
|
||||
|
||||
inline static object *allot_zone(zone *z, cell a)
|
||||
{
|
||||
|
@ -63,11 +63,11 @@ inline static object *allot_object(header header, cell size)
|
|||
|
||||
object *obj;
|
||||
|
||||
if(nursery.size - ALLOT_BUFFER_ZONE > size)
|
||||
if(nursery.size - allot_buffer_zone > size)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + ALLOT_BUFFER_ZONE + size > nursery.end)
|
||||
garbage_collection(NURSERY,false,0);
|
||||
if(nursery.here + allot_buffer_zone + size > nursery.end)
|
||||
garbage_collection(data->nursery(),false,0);
|
||||
|
||||
cell h = nursery.here;
|
||||
nursery.here = h + align8(size);
|
||||
|
@ -77,20 +77,20 @@ inline static object *allot_object(header header, cell size)
|
|||
tenured space */
|
||||
else
|
||||
{
|
||||
zone *tenured = &data->generations[TENURED];
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
gc();
|
||||
tenured = &data->generations[TENURED];
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
garbage_collection(TENURED,true,size);
|
||||
tenured = &data->generations[TENURED];
|
||||
garbage_collection(data->tenured(),true,size);
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
obj = allot_zone(tenured,size);
|
||||
|
|
|
@ -26,10 +26,10 @@ cell init_zone(zone *z, cell size, cell start)
|
|||
|
||||
void init_card_decks()
|
||||
{
|
||||
cell start = align(data->seg->start,DECK_SIZE);
|
||||
allot_markers_offset = (cell)data->allot_markers - (start >> CARD_BITS);
|
||||
cards_offset = (cell)data->cards - (start >> CARD_BITS);
|
||||
decks_offset = (cell)data->decks - (start >> DECK_BITS);
|
||||
cell start = align(data->seg->start,deck_size);
|
||||
allot_markers_offset = (cell)data->allot_markers - (start >> card_bits);
|
||||
cards_offset = (cell)data->cards - (start >> card_bits);
|
||||
decks_offset = (cell)data->decks - (start >> deck_bits);
|
||||
}
|
||||
|
||||
data_heap *alloc_data_heap(cell gens,
|
||||
|
@ -37,9 +37,9 @@ data_heap *alloc_data_heap(cell gens,
|
|||
cell aging_size,
|
||||
cell tenured_size)
|
||||
{
|
||||
young_size = align(young_size,DECK_SIZE);
|
||||
aging_size = align(aging_size,DECK_SIZE);
|
||||
tenured_size = align(tenured_size,DECK_SIZE);
|
||||
young_size = align(young_size,deck_size);
|
||||
aging_size = align(aging_size,deck_size);
|
||||
tenured_size = align(tenured_size,deck_size);
|
||||
|
||||
data_heap *data = (data_heap *)safe_malloc(sizeof(data_heap));
|
||||
data->young_size = young_size;
|
||||
|
@ -58,42 +58,42 @@ data_heap *alloc_data_heap(cell gens,
|
|||
return NULL; /* can't happen */
|
||||
}
|
||||
|
||||
total_size += DECK_SIZE;
|
||||
total_size += deck_size;
|
||||
|
||||
data->seg = alloc_segment(total_size);
|
||||
|
||||
data->generations = (zone *)safe_malloc(sizeof(zone) * data->gen_count);
|
||||
data->semispaces = (zone *)safe_malloc(sizeof(zone) * data->gen_count);
|
||||
|
||||
cell cards_size = total_size >> CARD_BITS;
|
||||
cell cards_size = total_size >> card_bits;
|
||||
data->allot_markers = (cell *)safe_malloc(cards_size);
|
||||
data->allot_markers_end = data->allot_markers + cards_size;
|
||||
|
||||
data->cards = (cell *)safe_malloc(cards_size);
|
||||
data->cards_end = data->cards + cards_size;
|
||||
|
||||
cell decks_size = total_size >> DECK_BITS;
|
||||
cell decks_size = total_size >> deck_bits;
|
||||
data->decks = (cell *)safe_malloc(decks_size);
|
||||
data->decks_end = data->decks + decks_size;
|
||||
|
||||
cell alloter = align(data->seg->start,DECK_SIZE);
|
||||
cell alloter = align(data->seg->start,deck_size);
|
||||
|
||||
alloter = init_zone(&data->generations[TENURED],tenured_size,alloter);
|
||||
alloter = init_zone(&data->semispaces[TENURED],tenured_size,alloter);
|
||||
alloter = init_zone(&data->generations[data->tenured()],tenured_size,alloter);
|
||||
alloter = init_zone(&data->semispaces[data->tenured()],tenured_size,alloter);
|
||||
|
||||
if(data->gen_count == 3)
|
||||
{
|
||||
alloter = init_zone(&data->generations[AGING],aging_size,alloter);
|
||||
alloter = init_zone(&data->semispaces[AGING],aging_size,alloter);
|
||||
alloter = init_zone(&data->generations[data->aging()],aging_size,alloter);
|
||||
alloter = init_zone(&data->semispaces[data->aging()],aging_size,alloter);
|
||||
}
|
||||
|
||||
if(data->gen_count >= 2)
|
||||
{
|
||||
alloter = init_zone(&data->generations[NURSERY],young_size,alloter);
|
||||
alloter = init_zone(&data->semispaces[NURSERY],0,alloter);
|
||||
alloter = init_zone(&data->generations[data->nursery()],young_size,alloter);
|
||||
alloter = init_zone(&data->semispaces[data->nursery()],0,alloter);
|
||||
}
|
||||
|
||||
if(data->seg->end - alloter > DECK_SIZE)
|
||||
if(data->seg->end - alloter > deck_size)
|
||||
critical_error("Bug in alloc_data_heap",alloter);
|
||||
|
||||
return data;
|
||||
|
@ -141,12 +141,12 @@ void clear_allot_markers(cell from, cell to)
|
|||
/* NOTE: reverse order due to heap layout. */
|
||||
card *first_card = addr_to_allot_marker((object *)data->generations[to].start);
|
||||
card *last_card = addr_to_allot_marker((object *)data->generations[from].end);
|
||||
memset(first_card,INVALID_ALLOT_MARKER,last_card - first_card);
|
||||
memset(first_card,invalid_allot_marker,last_card - first_card);
|
||||
}
|
||||
|
||||
void reset_generation(cell i)
|
||||
{
|
||||
zone *z = (i == NURSERY ? &nursery : &data->generations[i]);
|
||||
zone *z = (i == data->nursery() ? &nursery : &data->generations[i]);
|
||||
|
||||
z->here = z->start;
|
||||
if(secure_gc)
|
||||
|
@ -169,11 +169,11 @@ void reset_generations(cell from, cell to)
|
|||
void set_data_heap(data_heap *data_)
|
||||
{
|
||||
data = data_;
|
||||
nursery = data->generations[NURSERY];
|
||||
nursery = data->generations[data->nursery()];
|
||||
init_card_decks();
|
||||
clear_cards(NURSERY,TENURED);
|
||||
clear_decks(NURSERY,TENURED);
|
||||
clear_allot_markers(NURSERY,TENURED);
|
||||
clear_cards(data->nursery(),data->tenured());
|
||||
clear_decks(data->nursery(),data->tenured());
|
||||
clear_allot_markers(data->nursery(),data->tenured());
|
||||
}
|
||||
|
||||
void init_data_heap(cell gens,
|
||||
|
@ -298,7 +298,7 @@ PRIMITIVE(data_room)
|
|||
cell gen;
|
||||
for(gen = 0; gen < data->gen_count; gen++)
|
||||
{
|
||||
zone *z = (gen == NURSERY ? &nursery : &data->generations[gen]);
|
||||
zone *z = (gen == data->nursery() ? &nursery : &data->generations[gen]);
|
||||
a.add(tag_fixnum((z->end - z->here) >> 10));
|
||||
a.add(tag_fixnum((z->size) >> 10));
|
||||
}
|
||||
|
@ -314,7 +314,7 @@ cell heap_scan_ptr;
|
|||
/* Disables GC and activates next-object ( -- obj ) primitive */
|
||||
void begin_scan()
|
||||
{
|
||||
heap_scan_ptr = data->generations[TENURED].start;
|
||||
heap_scan_ptr = data->generations[data->tenured()].start;
|
||||
gc_off = true;
|
||||
}
|
||||
|
||||
|
@ -328,7 +328,7 @@ cell next_object()
|
|||
if(!gc_off)
|
||||
general_error(ERROR_HEAP_SCAN,F,F,NULL);
|
||||
|
||||
if(heap_scan_ptr >= data->generations[TENURED].here)
|
||||
if(heap_scan_ptr >= data->generations[data->tenured()].here)
|
||||
return F;
|
||||
|
||||
object *obj = (object *)heap_scan_ptr;
|
||||
|
|
|
@ -34,20 +34,22 @@ struct data_heap {
|
|||
|
||||
cell *decks;
|
||||
cell *decks_end;
|
||||
|
||||
/* the 0th generation is where new objects are allocated. */
|
||||
cell nursery() { return 0; }
|
||||
|
||||
/* where objects hang around */
|
||||
cell aging() { return gen_count - 2; }
|
||||
|
||||
/* the oldest generation */
|
||||
cell tenured() { return gen_count - 1; }
|
||||
|
||||
bool have_aging_p() { return gen_count > 2; }
|
||||
};
|
||||
|
||||
extern data_heap *data;
|
||||
|
||||
/* the 0th generation is where new objects are allocated. */
|
||||
#define NURSERY 0
|
||||
/* where objects hang around */
|
||||
#define AGING (data->gen_count-2)
|
||||
#define HAVE_AGING_P (data->gen_count>2)
|
||||
/* the oldest generation */
|
||||
#define TENURED (data->gen_count-1)
|
||||
|
||||
#define MIN_GEN_COUNT 1
|
||||
#define MAX_GEN_COUNT 3
|
||||
static const cell max_gen_count = 3;
|
||||
|
||||
inline static bool in_zone(zone *z, object *pointer)
|
||||
{
|
||||
|
|
16
vm/image.cpp
16
vm/image.cpp
|
@ -31,7 +31,7 @@ static void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
|
|||
|
||||
clear_gc_stats();
|
||||
|
||||
zone *tenured = &data->generations[TENURED];
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
fixnum bytes_read = fread((void*)tenured->start,1,h->data_size,file);
|
||||
|
||||
|
@ -92,10 +92,10 @@ bool save_image(const vm_char *filename)
|
|||
return false;
|
||||
}
|
||||
|
||||
zone *tenured = &data->generations[TENURED];
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
h.magic = IMAGE_MAGIC;
|
||||
h.version = IMAGE_VERSION;
|
||||
h.magic = image_magic;
|
||||
h.version = image_version;
|
||||
h.data_relocation_base = tenured->start;
|
||||
h.data_size = tenured->here - tenured->start;
|
||||
h.code_relocation_base = code.seg->start;
|
||||
|
@ -165,7 +165,7 @@ static void data_fixup(cell *cell)
|
|||
if(immediate_p(*cell))
|
||||
return;
|
||||
|
||||
zone *tenured = &data->generations[TENURED];
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
*cell += (tenured->start - data_relocation_base);
|
||||
}
|
||||
|
||||
|
@ -271,7 +271,7 @@ void relocate_data()
|
|||
data_fixup(&bignum_pos_one);
|
||||
data_fixup(&bignum_neg_one);
|
||||
|
||||
zone *tenured = &data->generations[TENURED];
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
for(relocating = tenured->start;
|
||||
relocating < tenured->here;
|
||||
|
@ -313,10 +313,10 @@ void load_image(vm_parameters *p)
|
|||
if(fread(&h,sizeof(image_header),1,file) != 1)
|
||||
fatal_error("Cannot read image header",0);
|
||||
|
||||
if(h.magic != IMAGE_MAGIC)
|
||||
if(h.magic != image_magic)
|
||||
fatal_error("Bad image: magic number check failed",h.magic);
|
||||
|
||||
if(h.version != IMAGE_VERSION)
|
||||
if(h.version != image_version)
|
||||
fatal_error("Bad image: version number check failed",h.version);
|
||||
|
||||
load_data_heap(file,&h,p);
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
#define IMAGE_MAGIC 0x0f0e0d0c
|
||||
#define IMAGE_VERSION 4
|
||||
static const cell image_magic = 0x0f0e0d0c;
|
||||
static const cell image_version = 4;
|
||||
|
||||
struct image_header {
|
||||
cell magic;
|
||||
|
|
|
@ -23,8 +23,15 @@ inline static cell align(cell a, cell b)
|
|||
return (a + (b-1)) & ~(b-1);
|
||||
}
|
||||
|
||||
#define align8(a) align(a,8)
|
||||
#define align_page(a) align(a,getpagesize())
|
||||
inline static cell align8(cell a)
|
||||
{
|
||||
return align(a,8);
|
||||
}
|
||||
|
||||
inline static cell align_page(cell a)
|
||||
{
|
||||
return align(a,getpagesize());
|
||||
}
|
||||
|
||||
#define WORD_SIZE (signed)(sizeof(cell)*8)
|
||||
|
||||
|
@ -297,12 +304,6 @@ struct dll : public object {
|
|||
void *dll;
|
||||
};
|
||||
|
||||
struct callstack : public object {
|
||||
static const cell type_number = CALLSTACK_TYPE;
|
||||
/* tagged */
|
||||
cell length;
|
||||
};
|
||||
|
||||
struct stack_frame
|
||||
{
|
||||
void *xt;
|
||||
|
@ -310,6 +311,15 @@ struct stack_frame
|
|||
cell size;
|
||||
};
|
||||
|
||||
struct callstack : public object {
|
||||
static const cell type_number = CALLSTACK_TYPE;
|
||||
/* tagged */
|
||||
cell length;
|
||||
|
||||
stack_frame *top() { return (stack_frame *)(this + 1); }
|
||||
stack_frame *bottom() { return (stack_frame *)((cell)(this + 1) + untag_fixnum(length)); }
|
||||
};
|
||||
|
||||
struct tuple : public object {
|
||||
static const cell type_number = TUPLE_TYPE;
|
||||
/* tagged layout */
|
||||
|
|
39
vm/math.cpp
39
vm/math.cpp
|
@ -24,8 +24,8 @@ PRIMITIVE(fixnum_divint)
|
|||
fixnum y = untag_fixnum(dpop()); \
|
||||
fixnum x = untag_fixnum(dpeek());
|
||||
fixnum result = x / y;
|
||||
if(result == -FIXNUM_MIN)
|
||||
drepl(allot_integer(-FIXNUM_MIN));
|
||||
if(result == -fixnum_min)
|
||||
drepl(allot_integer(-fixnum_min));
|
||||
else
|
||||
drepl(tag_fixnum(result));
|
||||
}
|
||||
|
@ -34,9 +34,9 @@ PRIMITIVE(fixnum_divmod)
|
|||
{
|
||||
cell y = ((cell *)ds)[0];
|
||||
cell x = ((cell *)ds)[-1];
|
||||
if(y == tag_fixnum(-1) && x == tag_fixnum(FIXNUM_MIN))
|
||||
if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
|
||||
{
|
||||
((cell *)ds)[-1] = allot_integer(-FIXNUM_MIN);
|
||||
((cell *)ds)[-1] = allot_integer(-fixnum_min);
|
||||
((cell *)ds)[0] = tag_fixnum(0);
|
||||
}
|
||||
else
|
||||
|
@ -50,9 +50,20 @@ PRIMITIVE(fixnum_divmod)
|
|||
* If we're shifting right by n bits, we won't overflow as long as none of the
|
||||
* high WORD_SIZE-TAG_BITS-n bits are set.
|
||||
*/
|
||||
#define SIGN_MASK(x) ((x) >> (WORD_SIZE - 1))
|
||||
#define BRANCHLESS_MAX(x,y) ((x) - (((x) - (y)) & SIGN_MASK((x) - (y))))
|
||||
#define BRANCHLESS_ABS(x) ((x ^ SIGN_MASK(x)) - SIGN_MASK(x))
|
||||
static inline fixnum sign_mask(fixnum x)
|
||||
{
|
||||
return x >> (WORD_SIZE - 1);
|
||||
}
|
||||
|
||||
static inline fixnum branchless_max(fixnum x, fixnum y)
|
||||
{
|
||||
return (x - ((x - y) & sign_mask(x - y)));
|
||||
}
|
||||
|
||||
static inline fixnum branchless_abs(fixnum x)
|
||||
{
|
||||
return (x ^ sign_mask(x)) - sign_mask(x);
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_shift)
|
||||
{
|
||||
|
@ -63,14 +74,14 @@ PRIMITIVE(fixnum_shift)
|
|||
return;
|
||||
else if(y < 0)
|
||||
{
|
||||
y = BRANCHLESS_MAX(y,-WORD_SIZE + 1);
|
||||
y = branchless_max(y,-WORD_SIZE + 1);
|
||||
drepl(tag_fixnum(x >> -y));
|
||||
return;
|
||||
}
|
||||
else if(y < WORD_SIZE - TAG_BITS)
|
||||
{
|
||||
fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
|
||||
if(!(BRANCHLESS_ABS(x) & mask))
|
||||
if(!(branchless_abs(x) & mask))
|
||||
{
|
||||
drepl(tag_fixnum(x << y));
|
||||
return;
|
||||
|
@ -226,7 +237,7 @@ cell unbox_array_size()
|
|||
case FIXNUM_TYPE:
|
||||
{
|
||||
fixnum n = untag_fixnum(dpeek());
|
||||
if(n >= 0 && n < (fixnum)ARRAY_SIZE_MAX)
|
||||
if(n >= 0 && n < (fixnum)array_size_max)
|
||||
{
|
||||
dpop();
|
||||
return n;
|
||||
|
@ -236,7 +247,7 @@ cell unbox_array_size()
|
|||
case BIGNUM_TYPE:
|
||||
{
|
||||
bignum * zero = untag<bignum>(bignum_zero);
|
||||
bignum * max = cell_to_bignum(ARRAY_SIZE_MAX);
|
||||
bignum * max = cell_to_bignum(array_size_max);
|
||||
bignum * n = untag<bignum>(dpeek());
|
||||
if(bignum_compare(n,zero) != bignum_comparison_less
|
||||
&& bignum_compare(n,max) == bignum_comparison_less)
|
||||
|
@ -248,7 +259,7 @@ cell unbox_array_size()
|
|||
}
|
||||
}
|
||||
|
||||
general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(ARRAY_SIZE_MAX),NULL);
|
||||
general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(array_size_max),NULL);
|
||||
return 0; /* can't happen */
|
||||
}
|
||||
|
||||
|
@ -428,7 +439,7 @@ VM_C_API void box_unsigned_cell(cell cell)
|
|||
|
||||
VM_C_API void box_signed_8(s64 n)
|
||||
{
|
||||
if(n < FIXNUM_MIN || n > FIXNUM_MAX)
|
||||
if(n < fixnum_min || n > fixnum_max)
|
||||
dpush(tag<bignum>(long_long_to_bignum(n)));
|
||||
else
|
||||
dpush(tag_fixnum(n));
|
||||
|
@ -450,7 +461,7 @@ VM_C_API s64 to_signed_8(cell obj)
|
|||
|
||||
VM_C_API void box_unsigned_8(u64 n)
|
||||
{
|
||||
if(n > FIXNUM_MAX)
|
||||
if(n > fixnum_max)
|
||||
dpush(tag<bignum>(ulong_long_to_bignum(n)));
|
||||
else
|
||||
dpush(tag_fixnum(n));
|
||||
|
|
11
vm/math.hpp
11
vm/math.hpp
|
@ -5,10 +5,9 @@ extern cell bignum_zero;
|
|||
extern cell bignum_pos_one;
|
||||
extern cell bignum_neg_one;
|
||||
|
||||
#define cell_MAX (cell)(-1)
|
||||
#define FIXNUM_MAX (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1)
|
||||
#define FIXNUM_MIN (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)))
|
||||
#define ARRAY_SIZE_MAX ((cell)1 << (WORD_SIZE - TAG_BITS - 2))
|
||||
static const fixnum fixnum_max = (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1);
|
||||
static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
|
||||
static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
|
||||
|
||||
PRIMITIVE(fixnum_add);
|
||||
PRIMITIVE(fixnum_subtract);
|
||||
|
@ -45,7 +44,7 @@ PRIMITIVE(byte_array_to_bignum);
|
|||
|
||||
inline static cell allot_integer(fixnum x)
|
||||
{
|
||||
if(x < FIXNUM_MIN || x > FIXNUM_MAX)
|
||||
if(x < fixnum_min || x > fixnum_max)
|
||||
return tag<bignum>(fixnum_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
|
@ -53,7 +52,7 @@ inline static cell allot_integer(fixnum x)
|
|||
|
||||
inline static cell allot_cell(cell x)
|
||||
{
|
||||
if(x > (cell)FIXNUM_MAX)
|
||||
if(x > (cell)fixnum_max)
|
||||
return tag<bignum>(cell_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
|
|
|
@ -12,24 +12,24 @@ VM_C_API factor::cell decks_offset;
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* if CARD_POINTS_TO_NURSERY is set, CARD_POINTS_TO_AGING must also be set. */
|
||||
#define CARD_POINTS_TO_NURSERY 0x80
|
||||
#define CARD_POINTS_TO_AGING 0x40
|
||||
#define CARD_MARK_MASK (CARD_POINTS_TO_NURSERY | CARD_POINTS_TO_AGING)
|
||||
/* if card_points_to_nursery is set, card_points_to_aging must also be set. */
|
||||
static const cell card_points_to_nursery = 0x80;
|
||||
static const cell card_points_to_aging = 0x40;
|
||||
static const cell card_mark_mask = (card_points_to_nursery | card_points_to_aging);
|
||||
typedef u8 card;
|
||||
|
||||
#define CARD_BITS 8
|
||||
#define CARD_SIZE (1<<CARD_BITS)
|
||||
#define ADDR_CARD_MASK (CARD_SIZE-1)
|
||||
static const cell card_bits = 8;
|
||||
static const cell card_size = (1<<card_bits);
|
||||
static const cell addr_card_mask = (card_size-1);
|
||||
|
||||
inline static card *addr_to_card(cell a)
|
||||
{
|
||||
return (card*)(((cell)(a) >> CARD_BITS) + cards_offset);
|
||||
return (card*)(((cell)(a) >> card_bits) + cards_offset);
|
||||
}
|
||||
|
||||
inline static cell card_to_addr(card *c)
|
||||
{
|
||||
return ((cell)c - cards_offset) << CARD_BITS;
|
||||
return ((cell)c - cards_offset) << card_bits;
|
||||
}
|
||||
|
||||
inline static cell card_offset(card *c)
|
||||
|
@ -39,48 +39,48 @@ inline static cell card_offset(card *c)
|
|||
|
||||
typedef u8 card_deck;
|
||||
|
||||
#define DECK_BITS (CARD_BITS + 10)
|
||||
#define DECK_SIZE (1<<DECK_BITS)
|
||||
#define ADDR_DECK_MASK (DECK_SIZE-1)
|
||||
static const cell deck_bits = (card_bits + 10);
|
||||
static const cell deck_size = (1<<deck_bits);
|
||||
static const cell addr_deck_mask = (deck_size-1);
|
||||
|
||||
inline static card_deck *addr_to_deck(cell a)
|
||||
{
|
||||
return (card_deck *)(((cell)a >> DECK_BITS) + decks_offset);
|
||||
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
|
||||
}
|
||||
|
||||
inline static cell deck_to_addr(card_deck *c)
|
||||
{
|
||||
return ((cell)c - decks_offset) << DECK_BITS;
|
||||
return ((cell)c - decks_offset) << deck_bits;
|
||||
}
|
||||
|
||||
inline static card *deck_to_card(card_deck *d)
|
||||
{
|
||||
return (card *)((((cell)d - decks_offset) << (DECK_BITS - CARD_BITS)) + cards_offset);
|
||||
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
|
||||
}
|
||||
|
||||
#define INVALID_ALLOT_MARKER 0xff
|
||||
static const cell invalid_allot_marker = 0xff;
|
||||
|
||||
extern cell allot_markers_offset;
|
||||
|
||||
inline static card *addr_to_allot_marker(object *a)
|
||||
{
|
||||
return (card *)(((cell)a >> CARD_BITS) + allot_markers_offset);
|
||||
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
|
||||
}
|
||||
|
||||
/* the write barrier must be called any time we are potentially storing a
|
||||
pointer from an older generation to a younger one */
|
||||
inline static void write_barrier(object *obj)
|
||||
{
|
||||
*addr_to_card((cell)obj) = CARD_MARK_MASK;
|
||||
*addr_to_deck((cell)obj) = CARD_MARK_MASK;
|
||||
*addr_to_card((cell)obj) = card_mark_mask;
|
||||
*addr_to_deck((cell)obj) = card_mark_mask;
|
||||
}
|
||||
|
||||
/* we need to remember the first object allocated in the card */
|
||||
inline static void allot_barrier(object *address)
|
||||
{
|
||||
card *ptr = addr_to_allot_marker(address);
|
||||
if(*ptr == INVALID_ALLOT_MARKER)
|
||||
*ptr = ((cell)address & ADDR_CARD_MASK);
|
||||
if(*ptr == invalid_allot_marker)
|
||||
*ptr = ((cell)address & addr_card_mask);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue