From ac4141695381147d5aef180e9841a5dba6340120 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 15:18:54 -0500
Subject: [PATCH 001/266] create words for c-types
---
basis/alien/arrays/arrays.factor | 38 ++---
basis/alien/c-types/c-types.factor | 159 +++++++++++++--------
basis/alien/parser/parser.factor | 8 +-
basis/alien/prettyprint/prettyprint.factor | 16 ++-
basis/alien/structs/structs.factor | 2 +-
basis/alien/syntax/syntax.factor | 9 +-
6 files changed, 146 insertions(+), 86 deletions(-)
diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index 64827ec139..86d6c2d49b 100755
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -22,15 +22,15 @@ M: array c-type-align first c-type-align ;
M: array c-type-stack-align? drop f ;
-M: array unbox-parameter drop "void*" unbox-parameter ;
+M: array unbox-parameter drop void* unbox-parameter ;
-M: array unbox-return drop "void*" unbox-return ;
+M: array unbox-return drop void* unbox-return ;
-M: array box-parameter drop "void*" box-parameter ;
+M: array box-parameter drop void* box-parameter ;
-M: array box-return drop "void*" box-return ;
+M: array box-return drop void* box-return ;
-M: array stack-size drop "void*" stack-size ;
+M: array stack-size drop void* stack-size ;
M: array c-type-boxer-quot
unclip
@@ -50,7 +50,7 @@ M: value-type c-type-setter ( type -- quot )
'[ @ swap @ _ memcpy ] ;
PREDICATE: string-type < pair
- first2 [ "char*" = ] [ word? ] bi* and ;
+ first2 [ char* = ] [ word? ] bi* and ;
M: string-type c-type ;
@@ -59,37 +59,37 @@ M: string-type c-type-class drop object ;
M: string-type c-type-boxed-class drop object ;
M: string-type heap-size
- drop "void*" heap-size ;
+ drop void* heap-size ;
M: string-type c-type-align
- drop "void*" c-type-align ;
+ drop void* c-type-align ;
M: string-type c-type-stack-align?
- drop "void*" c-type-stack-align? ;
+ drop void* c-type-stack-align? ;
M: string-type unbox-parameter
- drop "void*" unbox-parameter ;
+ drop void* unbox-parameter ;
M: string-type unbox-return
- drop "void*" unbox-return ;
+ drop void* unbox-return ;
M: string-type box-parameter
- drop "void*" box-parameter ;
+ drop void* box-parameter ;
M: string-type box-return
- drop "void*" box-return ;
+ drop void* box-return ;
M: string-type stack-size
- drop "void*" stack-size ;
+ drop void* stack-size ;
M: string-type c-type-rep
drop int-rep ;
M: string-type c-type-boxer
- drop "void*" c-type-boxer ;
+ drop void* c-type-boxer ;
M: string-type c-type-unboxer
- drop "void*" c-type-unboxer ;
+ drop void* c-type-unboxer ;
M: string-type c-type-boxer-quot
second '[ _ alien>string ] ;
@@ -103,6 +103,8 @@ M: string-type c-type-getter
M: string-type c-type-setter
drop [ set-alien-cell ] ;
-{ "char*" utf8 } "char*" typedef
-"char*" "uchar*" typedef
+{ char* utf8 } char* typedef
+char* uchar* typedef
+char char* "pointer-c-type" set-word-prop
+uchar uchar* "pointer-c-type" set-word-prop
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index b177ab35d4..2d53e01f0f 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -5,7 +5,7 @@ namespaces make parser sequences strings words splitting math.parser
cpu.architecture alien alien.accessors alien.strings quotations
layouts system compiler.units io io.files io.encodings.binary
io.streams.memory accessors combinators effects continuations fry
-classes vocabs vocabs.loader ;
+classes vocabs vocabs.loader vocabs.parser ;
IN: alien.c-types
DEFER: <int>
@@ -40,6 +40,11 @@ global [
ERROR: no-c-type name ;
+PREDICATE: c-type-word < word
+ "c-type" word-prop ;
+
+UNION: c-type-name string c-type-word ;
+
: (c-type) ( name -- type/f )
c-types get-global at dup [
dup string? [ (c-type) ] when
@@ -48,35 +53,48 @@ ERROR: no-c-type name ;
! C type protocol
GENERIC: c-type ( name -- type ) foldable
-: resolve-pointer-type ( name -- name )
+: parse-c-type-name ( name -- word/string )
+ [ search ] keep or ;
+
+GENERIC: resolve-pointer-type ( name -- c-type )
+
+M: word resolve-pointer-type
+ dup "pointer-c-type" word-prop
+ [ ] [ drop void* ] ?if c-type ;
+M: string resolve-pointer-type
c-types get at dup string?
- [ "*" append ] [ drop "void*" ] if
+ [ "*" append ] [ drop void* ] if
c-type ;
: resolve-typedef ( name -- type )
- dup string? [ c-type ] when ;
+ dup c-type-name? [ c-type ] when ;
: parse-array-type ( name -- array )
"[" split unclip
- [ [ "]" ?tail drop string>number ] map ] dip prefix ;
+ [ [ "]" ?tail drop string>number ] map ] dip
+ parse-c-type-name prefix ;
+
+: parse-c-type ( string -- array )
+ {
+ { [ CHAR: ] over member? ] [ parse-array-type ] }
+ { [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] }
+ { [ dup c-types get at ] [ dup c-types get at resolve-typedef ] }
+ { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
+ [ no-c-type ]
+ } cond ;
M: string c-type ( name -- type )
- CHAR: ] over member? [
- parse-array-type
- ] [
- dup c-types get at [
- resolve-typedef
- ] [
- "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
- ] ?if
- ] if ;
+ parse-c-type ;
+
+M: word c-type
+ "c-type" word-prop resolve-typedef ;
! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the
! size facilitates some optimizations.
GENERIC: heap-size ( type -- size ) foldable
-M: string heap-size c-type heap-size ;
+M: c-type-name heap-size c-type heap-size ;
M: abstract-c-type heap-size size>> ;
@@ -92,7 +110,7 @@ GENERIC: c-direct-array-constructor ( c-type -- word )
GENERIC: <c-array> ( len c-type -- array )
-M: string <c-array>
+M: c-type-name <c-array>
c-array-constructor execute( len -- array ) ; inline
GENERIC: (c-array) ( len c-type -- array )
@@ -102,7 +120,7 @@ M: string (c-array)
GENERIC: <c-direct-array> ( alien len c-type -- array )
-M: string <c-direct-array>
+M: c-type-name <c-direct-array>
c-direct-array-constructor execute( alien len -- array ) ; inline
: malloc-array ( n type -- alien )
@@ -115,67 +133,67 @@ GENERIC: c-type-class ( name -- class )
M: abstract-c-type c-type-class class>> ;
-M: string c-type-class c-type c-type-class ;
+M: c-type-name c-type-class c-type c-type-class ;
GENERIC: c-type-boxed-class ( name -- class )
M: abstract-c-type c-type-boxed-class boxed-class>> ;
-M: string c-type-boxed-class c-type c-type-boxed-class ;
+M: c-type-name c-type-boxed-class c-type c-type-boxed-class ;
GENERIC: c-type-boxer ( name -- boxer )
M: c-type c-type-boxer boxer>> ;
-M: string c-type-boxer c-type c-type-boxer ;
+M: c-type-name c-type-boxer c-type c-type-boxer ;
GENERIC: c-type-boxer-quot ( name -- quot )
M: abstract-c-type c-type-boxer-quot boxer-quot>> ;
-M: string c-type-boxer-quot c-type c-type-boxer-quot ;
+M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ;
GENERIC: c-type-unboxer ( name -- boxer )
M: c-type c-type-unboxer unboxer>> ;
-M: string c-type-unboxer c-type c-type-unboxer ;
+M: c-type-name c-type-unboxer c-type c-type-unboxer ;
GENERIC: c-type-unboxer-quot ( name -- quot )
M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ;
-M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
+M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ;
GENERIC: c-type-rep ( name -- rep )
M: c-type c-type-rep rep>> ;
-M: string c-type-rep c-type c-type-rep ;
+M: c-type-name c-type-rep c-type c-type-rep ;
GENERIC: c-type-getter ( name -- quot )
M: c-type c-type-getter getter>> ;
-M: string c-type-getter c-type c-type-getter ;
+M: c-type-name c-type-getter c-type c-type-getter ;
GENERIC: c-type-setter ( name -- quot )
M: c-type c-type-setter setter>> ;
-M: string c-type-setter c-type c-type-setter ;
+M: c-type-name c-type-setter c-type c-type-setter ;
GENERIC: c-type-align ( name -- n )
M: abstract-c-type c-type-align align>> ;
-M: string c-type-align c-type c-type-align ;
+M: c-type-name c-type-align c-type c-type-align ;
GENERIC: c-type-stack-align? ( name -- ? )
M: c-type c-type-stack-align? stack-align?>> ;
-M: string c-type-stack-align? c-type c-type-stack-align? ;
+M: c-type-name c-type-stack-align? c-type c-type-stack-align? ;
: c-type-box ( n type -- )
[ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
@@ -189,29 +207,29 @@ GENERIC: box-parameter ( n ctype -- )
M: c-type box-parameter c-type-box ;
-M: string box-parameter c-type box-parameter ;
+M: c-type-name box-parameter c-type box-parameter ;
GENERIC: box-return ( ctype -- )
M: c-type box-return f swap c-type-box ;
-M: string box-return c-type box-return ;
+M: c-type-name box-return c-type box-return ;
GENERIC: unbox-parameter ( n ctype -- )
M: c-type unbox-parameter c-type-unbox ;
-M: string unbox-parameter c-type unbox-parameter ;
+M: c-type-name unbox-parameter c-type unbox-parameter ;
GENERIC: unbox-return ( ctype -- )
M: c-type unbox-return f swap c-type-unbox ;
-M: string unbox-return c-type unbox-return ;
+M: c-type-name unbox-return c-type unbox-return ;
GENERIC: stack-size ( type -- size ) foldable
-M: string stack-size c-type stack-size ;
+M: c-type-name stack-size c-type stack-size ;
M: c-type stack-size size>> cell align ;
@@ -269,7 +287,15 @@ M: memory-stream stream-read
\ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
] [ ] make ;
-: typedef ( old new -- ) c-types get set-at ;
+GENERIC: typedef ( old new -- )
+
+PREDICATE: typedef-word < c-type-word
+ "c-type" word-prop c-type-name? ;
+
+M: string typedef ( old new -- ) c-types get set-at ;
+M: word typedef ( old new -- )
+ [ name>> typedef ]
+ [ swap "c-type" set-word-prop ] 2bi ;
TUPLE: long-long-type < c-type ;
@@ -303,8 +329,8 @@ M: long-long-type box-return ( type -- )
: define-primitive-type ( type name -- )
[ typedef ]
- [ define-deref ]
- [ define-out ]
+ [ name>> define-deref ]
+ [ name>> define-out ]
tri ;
: malloc-file-contents ( path -- alien len )
@@ -313,17 +339,30 @@ M: long-long-type box-return ( type -- )
: if-void ( type true false -- )
pick "void" = [ drop nip call ] [ nip call ] if ; inline
+SYMBOLS:
+ char uchar
+ short ushort
+ int uint
+ long ulong
+ longlong ulonglong
+ float double
+ void* bool ;
+
CONSTANT: primitive-types
{
- "char" "uchar"
- "short" "ushort"
- "int" "uint"
- "long" "ulong"
- "longlong" "ulonglong"
- "float" "double"
- "void*" "bool"
+ char uchar
+ short ushort
+ int uint
+ long ulong
+ longlong ulonglong
+ float double
+ void* bool
}
+SYMBOLS:
+ ptrdiff_t intptr_t size_t
+ char* uchar* ;
+
[
<c-type>
c-ptr >>class
@@ -335,7 +374,7 @@ CONSTANT: primitive-types
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer
"alien_offset" >>unboxer
- "void*" define-primitive-type
+ \ void* define-primitive-type
<long-long-type>
integer >>class
@@ -346,7 +385,7 @@ CONSTANT: primitive-types
8 >>align
"box_signed_8" >>boxer
"to_signed_8" >>unboxer
- "longlong" define-primitive-type
+ \ longlong define-primitive-type
<long-long-type>
integer >>class
@@ -357,7 +396,7 @@ CONSTANT: primitive-types
8 >>align
"box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
- "ulonglong" define-primitive-type
+ \ ulonglong define-primitive-type
<c-type>
integer >>class
@@ -368,7 +407,7 @@ CONSTANT: primitive-types
bootstrap-cell >>align
"box_signed_cell" >>boxer
"to_fixnum" >>unboxer
- "long" define-primitive-type
+ \ long define-primitive-type
<c-type>
integer >>class
@@ -379,7 +418,7 @@ CONSTANT: primitive-types
bootstrap-cell >>align
"box_unsigned_cell" >>boxer
"to_cell" >>unboxer
- "ulong" define-primitive-type
+ \ ulong define-primitive-type
<c-type>
integer >>class
@@ -390,7 +429,7 @@ CONSTANT: primitive-types
4 >>align
"box_signed_4" >>boxer
"to_fixnum" >>unboxer
- "int" define-primitive-type
+ \ int define-primitive-type
<c-type>
integer >>class
@@ -401,7 +440,7 @@ CONSTANT: primitive-types
4 >>align
"box_unsigned_4" >>boxer
"to_cell" >>unboxer
- "uint" define-primitive-type
+ \ uint define-primitive-type
<c-type>
fixnum >>class
@@ -412,7 +451,7 @@ CONSTANT: primitive-types
2 >>align
"box_signed_2" >>boxer
"to_fixnum" >>unboxer
- "short" define-primitive-type
+ \ short define-primitive-type
<c-type>
fixnum >>class
@@ -423,7 +462,7 @@ CONSTANT: primitive-types
2 >>align
"box_unsigned_2" >>boxer
"to_cell" >>unboxer
- "ushort" define-primitive-type
+ \ ushort define-primitive-type
<c-type>
fixnum >>class
@@ -434,7 +473,7 @@ CONSTANT: primitive-types
1 >>align
"box_signed_1" >>boxer
"to_fixnum" >>unboxer
- "char" define-primitive-type
+ \ char define-primitive-type
<c-type>
fixnum >>class
@@ -445,7 +484,7 @@ CONSTANT: primitive-types
1 >>align
"box_unsigned_1" >>boxer
"to_cell" >>unboxer
- "uchar" define-primitive-type
+ \ uchar define-primitive-type
<c-type>
[ alien-unsigned-1 c-bool> ] >>getter
@@ -454,7 +493,7 @@ CONSTANT: primitive-types
1 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
- "bool" define-primitive-type
+ \ bool define-primitive-type
<c-type>
float >>class
@@ -467,7 +506,7 @@ CONSTANT: primitive-types
"to_float" >>unboxer
float-rep >>rep
[ >float ] >>unboxer-quot
- "float" define-primitive-type
+ \ float define-primitive-type
<c-type>
float >>class
@@ -480,10 +519,10 @@ CONSTANT: primitive-types
"to_double" >>unboxer
double-rep >>rep
[ >float ] >>unboxer-quot
- "double" define-primitive-type
+ \ double define-primitive-type
- "long" "ptrdiff_t" typedef
- "long" "intptr_t" typedef
- "ulong" "size_t" typedef
+ \ long \ ptrdiff_t typedef
+ \ long \ intptr_t typedef
+ \ ulong \ size_t typedef
] with-compilation-unit
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 19ab08c03c..f855378890 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -5,12 +5,18 @@ parser sequences splitting words fry locals lexer namespaces
summary math ;
IN: alien.parser
+: scan-c-type ( -- c-type )
+ scan dup "{" =
+ [ drop \ } parse-until >array ]
+ [ parse-c-type ] if ;
+
: normalize-c-arg ( type name -- type' name' )
[ length ]
[
[ CHAR: * = ] trim-head
[ length - CHAR: * <array> append ] keep
- ] bi ;
+ ] bi
+ [ parse-c-type ] dip ;
: parse-arglist ( parameters return -- types effect )
[
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 0ffd5023a7..6201f1e245 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators alien alien.strings alien.syntax
-math.parser prettyprint.backend prettyprint.custom
-prettyprint.sections ;
+USING: kernel combinators alien alien.strings alien.c-types
+alien.syntax math.parser prettyprint.backend prettyprint.custom
+prettyprint.sections definitions see see.private ;
IN: alien.prettyprint
M: alien pprint*
@@ -13,3 +13,13 @@ M: alien pprint*
} cond ;
M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
+
+M: c-type-word definer drop \ C-TYPE: f ;
+M: c-type-word definition drop f ;
+
+M: typedef-word see-class*
+ <colon
+ \ TYPEDEF: pprint-word
+ dup "typedef" word-prop pprint-word
+ pprint-word
+ block> ;
diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index a80adf5137..1558748164 100755
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -13,7 +13,7 @@ M: struct-type c-type ;
M: struct-type c-type-stack-align? drop f ;
: if-value-struct ( ctype true false -- )
- [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
+ [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
M: struct-type unbox-parameter
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index e8206c6968..040c6b0787 100644
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -19,18 +19,21 @@ SYNTAX: FUNCTION:
(FUNCTION:) define-declared ;
SYNTAX: TYPEDEF:
- scan scan typedef ;
+ scan-c-type CREATE typedef ;
SYNTAX: C-STRUCT:
- scan current-vocab parse-definition define-struct ; deprecated
+ CREATE current-vocab parse-definition define-struct ; deprecated
SYNTAX: C-UNION:
- scan parse-definition define-union ; deprecated
+ CREATE parse-definition define-union ; deprecated
SYNTAX: C-ENUM:
";" parse-tokens
[ [ create-in ] dip define-constant ] each-index ;
+SYNTAX: C-TYPE:
+ "Primitive C type definition not supported" throw ;
+
ERROR: no-such-symbol name library ;
: address-of ( name library -- value )
From 35b76b83afd7f353d22a9ac7dcbe86caca9e276f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 16:08:42 -0500
Subject: [PATCH 002/266] convert compiler cpu backends to use c-type words
---
basis/alien/c-types/c-types.factor | 34 ++++++++++++----------
basis/alien/prettyprint/prettyprint.factor | 12 ++++++--
basis/cpu/ppc/ppc.factor | 2 +-
basis/cpu/x86/64/unix/unix.factor | 9 +++---
basis/cpu/x86/64/winnt/winnt.factor | 8 ++---
basis/cpu/x86/x86.factor | 1 +
6 files changed, 38 insertions(+), 28 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 2d53e01f0f..553ff26443 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -5,9 +5,19 @@ namespaces make parser sequences strings words splitting math.parser
cpu.architecture alien alien.accessors alien.strings quotations
layouts system compiler.units io io.files io.encodings.binary
io.streams.memory accessors combinators effects continuations fry
-classes vocabs vocabs.loader vocabs.parser ;
+classes vocabs vocabs.loader vocabs.parser words.symbol ;
+QUALIFIED: math
IN: alien.c-types
+SYMBOLS:
+ char uchar
+ short ushort
+ int uint
+ long ulong
+ longlong ulonglong
+ float double
+ void* bool ;
+
DEFER: <int>
DEFER: *char
@@ -78,7 +88,7 @@ M: string resolve-pointer-type
{
{ [ CHAR: ] over member? ] [ parse-array-type ] }
{ [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] }
- { [ dup c-types get at ] [ dup c-types get at resolve-typedef ] }
+ { [ dup c-types get at ] [ c-types get at resolve-typedef ] }
{ [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
[ no-c-type ]
} cond ;
@@ -294,8 +304,9 @@ PREDICATE: typedef-word < c-type-word
M: string typedef ( old new -- ) c-types get set-at ;
M: word typedef ( old new -- )
+ [ nip define-symbol ]
[ name>> typedef ]
- [ swap "c-type" set-word-prop ] 2bi ;
+ [ swap "c-type" set-word-prop ] 2tri ;
TUPLE: long-long-type < c-type ;
@@ -339,15 +350,6 @@ M: long-long-type box-return ( type -- )
: if-void ( type true false -- )
pick "void" = [ drop nip call ] [ nip call ] if ; inline
-SYMBOLS:
- char uchar
- short ushort
- int uint
- long ulong
- longlong ulonglong
- float double
- void* bool ;
-
CONSTANT: primitive-types
{
char uchar
@@ -496,8 +498,8 @@ SYMBOLS:
\ bool define-primitive-type
<c-type>
- float >>class
- float >>boxed-class
+ math:float >>class
+ math:float >>boxed-class
[ alien-float ] >>getter
[ [ >float ] 2dip set-alien-float ] >>setter
4 >>size
@@ -509,8 +511,8 @@ SYMBOLS:
\ float define-primitive-type
<c-type>
- float >>class
- float >>boxed-class
+ math:float >>class
+ math:float >>boxed-class
[ alien-double ] >>getter
[ [ >float ] 2dip set-alien-double ] >>setter
8 >>size
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 6201f1e245..54bb3812a4 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -1,8 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel combinators alien alien.strings alien.c-types
-alien.syntax math.parser prettyprint.backend prettyprint.custom
-prettyprint.sections definitions see see.private ;
+alien.syntax arrays math.parser prettyprint.backend
+prettyprint.custom prettyprint.sections definitions see see.private
+strings words ;
IN: alien.prettyprint
M: alien pprint*
@@ -17,9 +18,14 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
M: c-type-word definer drop \ C-TYPE: f ;
M: c-type-word definition drop f ;
+GENERIC: pprint-c-type ( c-type -- )
+M: word pprint-c-type pprint-word ;
+M: string pprint-c-type text ;
+M: array pprint-c-type pprint* ;
+
M: typedef-word see-class*
<colon
\ TYPEDEF: pprint-word
- dup "typedef" word-prop pprint-word
+ dup "c-type" word-prop pprint-c-type
pprint-word
block> ;
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 9c829bc390..f881ff5f91 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -770,5 +770,5 @@ USE: vocabs.loader
4 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
- "bool" define-primitive-type
+ bool define-primitive-type
] with-compilation-unit
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index e06c026d39..1088f20175 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -14,9 +14,10 @@ M: float-regs param-regs
M: x86.64 reserved-area-size 0 ;
-! The ABI for passing structs by value is pretty messed up
-<< "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>rep) >>
+SYMBOL: (stack-value)
+! The ABI for passing structs by value is pretty great
+<< void* c-type clone \ (stack-value) define-primitive-type
+stack-params \ (stack-value) c-type (>>rep) >>
: struct-types&offset ( struct-type -- pairs )
fields>> [
@@ -36,7 +37,7 @@ stack-params "__stack_value" c-type (>>rep) >>
: flatten-large-struct ( c-type -- seq )
heap-size cell align
- cell /i "__stack_value" c-type <repetition> ;
+ cell /i \ (stack-value) c-type <repetition> ;
M: struct-type flatten-value-type ( type -- seq )
dup heap-size 16 > [
diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor
index d9f83612e6..bbe943e06b 100644
--- a/basis/cpu/x86/64/winnt/winnt.factor
+++ b/basis/cpu/x86/64/winnt/winnt.factor
@@ -25,8 +25,8 @@ M: x86.64 dummy-fp-params? t ;
M: x86.64 temp-reg RAX ;
<<
-"longlong" "ptrdiff_t" typedef
-"longlong" "intptr_t" typedef
-"int" c-type "long" define-primitive-type
-"uint" c-type "ulong" define-primitive-type
+longlong ptrdiff_t typedef
+longlong intptr_t typedef
+int c-type long define-primitive-type
+uint c-type ulong define-primitive-type
>>
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 27b6667c05..04b5308836 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -12,6 +12,7 @@ compiler.cfg.comparisons
compiler.cfg.stack-frame
compiler.codegen
compiler.codegen.fixup ;
+FROM: math => float ;
IN: cpu.x86
<< enable-fixnum-log2 >>
From 3b4330fcf64b2b76fa08c646f3b5d6db6fd51166 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 21:43:18 -0500
Subject: [PATCH 003/266] get things to a point where they bootstrap again
---
basis/alien/c-types/c-types.factor | 49 ++++++++-----------
basis/alien/parser/parser.factor | 19 +++++--
basis/alien/syntax/syntax.factor | 4 +-
basis/classes/struct/struct-tests.factor | 20 ++++----
basis/classes/struct/struct.factor | 27 ++--------
basis/compiler/codegen/codegen.factor | 2 +-
basis/core-foundation/numbers/numbers.factor | 1 +
basis/cpu/x86/features/features.factor | 4 +-
basis/functors/functors-tests.factor | 15 +++---
basis/math/libm/libm.factor | 40 +++++++--------
.../specialized-arrays.factor | 28 +++++++----
basis/stack-checker/alien/alien.factor | 2 +-
basis/windows/com/syntax/syntax.factor | 2 +-
13 files changed, 107 insertions(+), 106 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 71073ddc91..123abb5298 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -5,7 +5,7 @@ namespaces make parser sequences strings words splitting math.parser
cpu.architecture alien alien.accessors alien.strings quotations
layouts system compiler.units io io.files io.encodings.binary
io.streams.memory accessors combinators effects continuations fry
-classes vocabs vocabs.loader vocabs.parser words.symbol ;
+classes vocabs vocabs.loader words.symbol ;
QUALIFIED: math
IN: alien.c-types
@@ -16,7 +16,8 @@ SYMBOLS:
long ulong
longlong ulonglong
float double
- void* bool ;
+ void* bool
+ void ;
DEFER: <int>
DEFER: *char
@@ -55,56 +56,48 @@ PREDICATE: c-type-word < word
UNION: c-type-name string c-type-word ;
-: (c-type) ( name -- type/f )
- c-types get-global at dup [
- dup string? [ (c-type) ] when
- ] when ;
-
! C type protocol
GENERIC: c-type ( name -- type ) foldable
-: parse-c-type-name ( name -- word/string )
- [ search ] keep or ;
-
GENERIC: resolve-pointer-type ( name -- c-type )
M: word resolve-pointer-type
dup "pointer-c-type" word-prop
- [ ] [ drop void* ] ?if c-type ;
+ [ ] [ drop void* ] ?if ;
M: string resolve-pointer-type
c-types get at dup string?
- [ "*" append ] [ drop void* ] if
- c-type ;
+ [ "*" append ] [ drop void* ] if ;
: resolve-typedef ( name -- type )
dup c-type-name? [ c-type ] when ;
-: parse-array-type ( name -- array )
+: parse-array-type ( name -- dims type )
"[" split unclip
- [ [ "]" ?tail drop string>number ] map ] dip
- parse-c-type-name prefix ;
-
-: parse-c-type ( string -- array )
- {
- { [ CHAR: ] over member? ] [ parse-array-type ] }
- { [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] }
- { [ dup c-types get at ] [ c-types get at resolve-typedef ] }
- { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
- [ no-c-type ]
- } cond ;
+ [ [ "]" ?tail drop string>number ] map ] dip ;
M: string c-type ( name -- type )
- parse-c-type ;
+ CHAR: ] over member? [
+ parse-array-type prefix
+ ] [
+ dup c-types get at [
+ resolve-typedef
+ ] [
+ "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
+ ] ?if
+ ] if ;
M: word c-type
"c-type" word-prop resolve-typedef ;
+: void? ( c-type -- ? )
+ { void "void" } member? ;
+
GENERIC: c-struct? ( type -- ? )
M: object c-struct?
drop f ;
M: string c-struct?
- dup "void" = [ drop f ] [ c-type c-struct? ] if ;
+ dup void? [ drop f ] [ c-type c-struct? ] if ;
! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the
@@ -366,7 +359,7 @@ M: long-long-type box-return ( type -- )
binary file-contents [ malloc-byte-array ] [ length ] bi ;
: if-void ( type true false -- )
- pick "void" = [ drop nip call ] [ nip call ] if ; inline
+ pick void? [ drop nip call ] [ nip call ] if ; inline
CONSTANT: primitive-types
{
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index f855378890..bca7c93802 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -1,10 +1,23 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs effects grouping kernel
-parser sequences splitting words fry locals lexer namespaces
-summary math ;
+USING: alien alien.c-types arrays assocs combinators effects
+grouping kernel parser sequences splitting words fry locals
+lexer namespaces summary math vocabs.parser ;
IN: alien.parser
+: parse-c-type-name ( name -- word/string )
+ [ search ] keep or ;
+
+: parse-c-type ( string -- array )
+ {
+ { [ dup "void" = ] [ drop void ] }
+ { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
+ { [ dup search c-type-word? ] [ parse-c-type-name ] }
+ { [ dup c-types get at ] [ ] }
+ { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
+ [ no-c-type ]
+ } cond ;
+
: scan-c-type ( -- c-type )
scan dup "{" =
[ drop \ } parse-until >array ]
diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index 040c6b0787..fac45176a3 100644
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -22,10 +22,10 @@ SYNTAX: TYPEDEF:
scan-c-type CREATE typedef ;
SYNTAX: C-STRUCT:
- CREATE current-vocab parse-definition define-struct ; deprecated
+ scan current-vocab parse-definition define-struct ; deprecated
SYNTAX: C-UNION:
- CREATE parse-definition define-union ; deprecated
+ scan parse-definition define-union ; deprecated
SYNTAX: C-ENUM:
";" parse-tokens
diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index bbbaf4f1d5..3be0be8ef1 100755
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -6,6 +6,8 @@ io.encodings.utf8 io.pathnames io.streams.string kernel libc
literals math mirrors multiline namespaces prettyprint
prettyprint.config see sequences specialized-arrays system
tools.test parser lexer eval layouts ;
+FROM: math => float
+QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: ushort
@@ -128,7 +130,7 @@ STRUCT: struct-test-bar
] unit-test
UNION-STRUCT: struct-test-float-and-bits
- { f float }
+ { f c:float }
{ bits uint } ;
[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
@@ -181,14 +183,14 @@ STRUCT: struct-test-string-ptr
] with-scope
] unit-test
-[ <" USING: classes.struct ;
+[ <" USING: alien.c-types classes.struct ;
IN: classes.struct.tests
STRUCT: struct-test-foo
{ x char initial: 0 } { y int initial: 123 } { z bool } ;
"> ]
[ [ struct-test-foo see ] with-string-writer ] unit-test
-[ <" USING: classes.struct ;
+[ <" USING: alien.c-types classes.struct ;
IN: classes.struct.tests
UNION-STRUCT: struct-test-float-and-bits
{ f float initial: 0.0 } { bits uint initial: 0 } ;
@@ -201,20 +203,20 @@ UNION-STRUCT: struct-test-float-and-bits
{ offset 0 }
{ initial 0 }
{ class fixnum }
- { type "char" }
+ { type char }
}
T{ struct-slot-spec
{ name "y" }
{ offset 4 }
{ initial 123 }
{ class integer }
- { type "int" }
+ { type int }
}
T{ struct-slot-spec
{ name "z" }
{ offset 8 }
{ initial f }
- { type "bool" }
+ { type bool }
{ class object }
}
} ] [ "struct-test-foo" c-type fields>> ] unit-test
@@ -223,14 +225,14 @@ UNION-STRUCT: struct-test-float-and-bits
T{ struct-slot-spec
{ name "f" }
{ offset 0 }
- { type "float" }
+ { type c:float }
{ class float }
{ initial 0.0 }
}
T{ struct-slot-spec
{ name "bits" }
{ offset 0 }
- { type "uint" }
+ { type uint }
{ class integer }
{ initial 0 }
}
@@ -277,7 +279,7 @@ STRUCT: struct-test-array-slots
] unit-test
STRUCT: struct-test-optimization
- { x { "int" 3 } } { y int } ;
+ { x { int 3 } } { y int } ;
SPECIALIZED-ARRAY: struct-test-optimization
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 1de221d2aa..a96a74d2ac 100755
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -1,12 +1,12 @@
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types arrays byte-arrays classes
-classes.parser classes.tuple classes.tuple.parser
+USING: accessors alien alien.c-types alien.parser arrays
+byte-arrays classes classes.parser classes.tuple classes.tuple.parser
classes.tuple.private combinators combinators.short-circuit
combinators.smart cpu.architecture definitions functors.backend
fry generalizations generic.parser kernel kernel.private lexer
libc locals macros make math math.order parser quotations
sequences slots slots.private specialized-arrays vectors words
-summary namespaces assocs ;
+summary namespaces assocs vocabs.parser ;
IN: classes.struct
SPECIALIZED-ARRAY: uchar
@@ -197,20 +197,6 @@ M: struct-c-type c-struct? drop t ;
[ type>> c-type-align ] [ max ] map-reduce ;
PRIVATE>
-M: struct-class c-type name>> c-type ;
-
-M: struct-class c-type-align c-type c-type-align ;
-
-M: struct-class c-type-getter c-type c-type-getter ;
-
-M: struct-class c-type-setter c-type c-type-setter ;
-
-M: struct-class c-type-boxer-quot c-type c-type-boxer-quot ;
-
-M: struct-class c-type-unboxer-quot c-type c-type-boxer-quot ;
-
-M: struct-class heap-size c-type heap-size ;
-
M: struct byte-length class "struct-size" word-prop ; foldable
! class definition
@@ -259,7 +245,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable
[ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
(struct-word-props)
]
- [ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline
+ [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline
PRIVATE>
: define-struct-class ( class slots -- )
@@ -284,9 +270,6 @@ ERROR: invalid-struct-slot token ;
[ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
<PRIVATE
-: scan-c-type ( -- c-type )
- scan dup "{" = [ drop \ } parse-until >array ] when ;
-
: parse-struct-slot ( -- slot )
scan scan-c-type \ } parse-until <struct-slot-spec> ;
@@ -317,7 +300,7 @@ SYNTAX: S@
<PRIVATE
: scan-c-type` ( -- c-type/param )
- scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
+ scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ;
: parse-struct-slot` ( accum -- accum )
scan-string-param scan-c-type` \ } parse-until
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 0456ff485f..ddf5aa0e02 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -456,7 +456,7 @@ TUPLE: callback-context ;
: callback-return-quot ( ctype -- quot )
return>> {
- { [ dup "void" = ] [ drop [ ] ] }
+ { [ dup void? ] [ drop [ ] ] }
{ [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
[ c-type c-type-unboxer-quot ]
} cond ;
diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor
index f01f522d61..ae061cb4eb 100644
--- a/basis/core-foundation/numbers/numbers.factor
+++ b/basis/core-foundation/numbers/numbers.factor
@@ -1,6 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax kernel math core-foundation ;
+FROM: math => float ;
IN: core-foundation.numbers
TYPEDEF: void* CFNumberRef
diff --git a/basis/cpu/x86/features/features.factor b/basis/cpu/x86/features/features.factor
index 02235bb62e..c5cf2d470a 100644
--- a/basis/cpu/x86/features/features.factor
+++ b/basis/cpu/x86/features/features.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: system kernel math math.order math.parser namespaces
-alien.syntax combinators locals init io cpu.x86 compiler
-compiler.units accessors ;
+alien.c-types alien.syntax combinators locals init io cpu.x86
+compiler compiler.units accessors ;
IN: cpu.x86.features
<PRIVATE
diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index bcdc1bae74..5f2e32ad71 100644
--- a/basis/functors/functors-tests.factor
+++ b/basis/functors/functors-tests.factor
@@ -1,5 +1,6 @@
USING: classes.struct functors tools.test math words kernel
multiline parser io.streams.string generic ;
+QUALIFIED-WITH: alien.c-types c
IN: functors.tests
<<
@@ -162,9 +163,9 @@ WHERE
STRUCT: T-class
{ NAME int }
{ x { TYPE 4 } }
- { y { "short" N } }
+ { y { short N } }
{ z TYPE initial: 5 }
- { float { "float" 2 } } ;
+ { float { c:float 2 } } ;
;FUNCTOR
@@ -179,35 +180,35 @@ STRUCT: T-class
{ offset 0 }
{ class integer }
{ initial 0 }
- { c-type "int" }
+ { c-type int }
}
T{ struct-slot-spec
{ name "x" }
{ offset 4 }
{ class object }
{ initial f }
- { c-type { "char" 4 } }
+ { c-type { char 4 } }
}
T{ struct-slot-spec
{ name "y" }
{ offset 8 }
{ class object }
{ initial f }
- { c-type { "short" 2 } }
+ { c-type { short 2 } }
}
T{ struct-slot-spec
{ name "z" }
{ offset 12 }
{ class fixnum }
{ initial 5 }
- { c-type "char" }
+ { c-type char }
}
T{ struct-slot-spec
{ name "float" }
{ offset 16 }
{ class object }
{ initial f }
- { c-type { "float" 2 } }
+ { c-type { c:float 2 } }
}
}
] [ a-struct struct-slots ] unit-test
diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor
index df8b36fd28..0288894081 100644
--- a/basis/math/libm/libm.factor
+++ b/basis/math/libm/libm.factor
@@ -1,62 +1,62 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien ;
+USING: alien alien.c-types ;
IN: math.libm
: facos ( x -- y )
- "double" "libm" "acos" { "double" } alien-invoke ;
+ double "libm" "acos" { double } alien-invoke ;
: fasin ( x -- y )
- "double" "libm" "asin" { "double" } alien-invoke ;
+ double "libm" "asin" { double } alien-invoke ;
: fatan ( x -- y )
- "double" "libm" "atan" { "double" } alien-invoke ;
+ double "libm" "atan" { double } alien-invoke ;
: fatan2 ( x y -- z )
- "double" "libm" "atan2" { "double" "double" } alien-invoke ;
+ double "libm" "atan2" { double double } alien-invoke ;
: fcos ( x -- y )
- "double" "libm" "cos" { "double" } alien-invoke ;
+ double "libm" "cos" { double } alien-invoke ;
: fsin ( x -- y )
- "double" "libm" "sin" { "double" } alien-invoke ;
+ double "libm" "sin" { double } alien-invoke ;
: ftan ( x -- y )
- "double" "libm" "tan" { "double" } alien-invoke ;
+ double "libm" "tan" { double } alien-invoke ;
: fcosh ( x -- y )
- "double" "libm" "cosh" { "double" } alien-invoke ;
+ double "libm" "cosh" { double } alien-invoke ;
: fsinh ( x -- y )
- "double" "libm" "sinh" { "double" } alien-invoke ;
+ double "libm" "sinh" { double } alien-invoke ;
: ftanh ( x -- y )
- "double" "libm" "tanh" { "double" } alien-invoke ;
+ double "libm" "tanh" { double } alien-invoke ;
: fexp ( x -- y )
- "double" "libm" "exp" { "double" } alien-invoke ;
+ double "libm" "exp" { double } alien-invoke ;
: flog ( x -- y )
- "double" "libm" "log" { "double" } alien-invoke ;
+ double "libm" "log" { double } alien-invoke ;
: flog10 ( x -- y )
- "double" "libm" "log10" { "double" } alien-invoke ;
+ double "libm" "log10" { double } alien-invoke ;
: fpow ( x y -- z )
- "double" "libm" "pow" { "double" "double" } alien-invoke ;
+ double "libm" "pow" { double double } alien-invoke ;
: fsqrt ( x -- y )
- "double" "libm" "sqrt" { "double" } alien-invoke ;
+ double "libm" "sqrt" { double } alien-invoke ;
! Windows doesn't have these...
: flog1+ ( x -- y )
- "double" "libm" "log1p" { "double" } alien-invoke ;
+ double "libm" "log1p" { double } alien-invoke ;
: facosh ( x -- y )
- "double" "libm" "acosh" { "double" } alien-invoke ;
+ double "libm" "acosh" { double } alien-invoke ;
: fasinh ( x -- y )
- "double" "libm" "asinh" { "double" } alien-invoke ;
+ double "libm" "asinh" { double } alien-invoke ;
: fatanh ( x -- y )
- "double" "libm" "atanh" { "double" } alien-invoke ;
+ double "libm" "atanh" { double } alien-invoke ;
diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index 15245cc710..bca85a25db 100755
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -103,13 +103,21 @@ A T c-type-boxed-class f specialize-vector-words
;FUNCTOR
+GENERIC: (underlying-type) ( c-type -- c-type' )
+
+M: string (underlying-type) c-types get at ;
+M: word (underlying-type) "c-type" word-prop ;
+
: underlying-type ( c-type -- c-type' )
- dup c-types get at {
+ dup (underlying-type) {
{ [ dup not ] [ drop no-c-type ] }
- { [ dup string? ] [ nip underlying-type ] }
+ { [ dup c-type-name? ] [ nip underlying-type ] }
[ drop ]
} cond ;
+: underlying-type-name ( c-type -- name )
+ underlying-type dup word? [ name>> ] when ;
+
: specialized-array-vocab ( c-type -- vocab )
"specialized-arrays.instances." prepend ;
@@ -125,26 +133,26 @@ PRIVATE>
] ?if ; inline
: define-array-vocab ( type -- vocab )
- underlying-type
+ underlying-type-name
[ specialized-array-vocab ] [ '[ _ define-array ] ] bi
generate-vocab ;
-M: string require-c-array define-array-vocab drop ;
+M: c-type-name require-c-array define-array-vocab drop ;
ERROR: specialized-array-vocab-not-loaded c-type ;
-M: string c-array-constructor
- underlying-type
+M: c-type-name c-array-constructor
+ underlying-type-name
dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
-M: string c-(array)-constructor
- underlying-type
+M: c-type-name c-(array)-constructor
+ underlying-type-name
dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
-M: string c-direct-array-constructor
- underlying-type
+M: c-type-name c-direct-array-constructor
+ underlying-type-name
dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index da559abd78..3d150adf91 100644
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -19,7 +19,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
: alien-stack ( params extra -- )
over parameters>> length + consume-d >>in-d
- dup return>> "void" = 0 1 ? produce-d >>out-d
+ dup return>> void? 0 1 ? produce-d >>out-d
drop ;
: return-prep-quot ( node -- quot )
diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor
index 2100d6a215..3cf8b55e39 100755
--- a/basis/windows/com/syntax/syntax.factor
+++ b/basis/windows/com/syntax/syntax.factor
@@ -67,7 +67,7 @@ unless
: (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
swap
[ [ second ] map ]
- [ dup "void" = [ drop { } ] [ 1array ] if ] bi*
+ [ dup void? [ drop { } ] [ 1array ] if ] bi*
<effect> ;
: (define-word-for-function) ( function interface n -- )
From 26026ff6de7d5d1a0dd985a198c75dcc449d50f2 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 22:10:16 -0500
Subject: [PATCH 004/266] fix bug in pointer type parsing
---
basis/alien/c-types/c-types.factor | 6 ++----
1 file changed, 2 insertions(+), 4 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 123abb5298..02ab2dcafa 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -79,11 +79,9 @@ M: string c-type ( name -- type )
CHAR: ] over member? [
parse-array-type prefix
] [
- dup c-types get at [
- resolve-typedef
- ] [
+ dup c-types get at [ ] [
"*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
- ] ?if
+ ] ?if resolve-typedef
] if ;
M: word c-type
From b629391477ccaa8fb97a63bfea70ff35d8e67045 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 22:10:41 -0500
Subject: [PATCH 005/266] fix typedef prettyprinting
---
basis/alien/prettyprint/prettyprint.factor | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 54bb3812a4..4b53f36c3b 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -17,15 +17,20 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
M: c-type-word definer drop \ C-TYPE: f ;
M: c-type-word definition drop f ;
+M: typedef-word declarations. drop ;
GENERIC: pprint-c-type ( c-type -- )
M: word pprint-c-type pprint-word ;
M: string pprint-c-type text ;
M: array pprint-c-type pprint* ;
-M: typedef-word see-class*
+M: typedef-word definer drop \ TYPEDEF: f ;
+
+M: typedef-word synopsis*
<colon
\ TYPEDEF: pprint-word
dup "c-type" word-prop pprint-c-type
pprint-word
block> ;
+
+
From 2bbd29a5613d1887d3e7522faa07212f19a6734a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 22:39:25 -0500
Subject: [PATCH 006/266] prettyprinting for FUNCTION: definitions
---
basis/alien/parser/parser.factor | 10 +++++---
basis/alien/prettyprint/prettyprint.factor | 28 ++++++++++++++++------
2 files changed, 28 insertions(+), 10 deletions(-)
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index bca7c93802..662139810e 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -1,8 +1,9 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs combinators effects
-grouping kernel parser sequences splitting words fry locals
-lexer namespaces summary math vocabs.parser ;
+USING: accessors alien alien.c-types arrays assocs
+combinators effects grouping kernel parser sequences
+splitting words fry locals lexer namespaces summary
+math vocabs.parser ;
IN: alien.parser
: parse-c-type-name ( name -- word/string )
@@ -55,3 +56,6 @@ IN: alien.parser
: define-function ( return library function parameters -- )
make-function define-declared ;
+
+PREDICATE: alien-function-word < word
+ def>> [ length 5 = ] [ last \ alien-invoke eq? ] bi and ;
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 4b53f36c3b..096a5547c5 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators alien alien.strings alien.c-types
-alien.syntax arrays math.parser prettyprint.backend
-prettyprint.custom prettyprint.sections definitions see see.private
-strings words ;
+USING: accessors kernel combinators alien alien.strings alien.c-types
+alien.parser alien.syntax arrays assocs effects math.parser
+prettyprint.backend prettyprint.custom prettyprint.sections
+definitions see see.private sequences strings words ;
IN: alien.prettyprint
M: alien pprint*
@@ -21,16 +21,30 @@ M: typedef-word declarations. drop ;
GENERIC: pprint-c-type ( c-type -- )
M: word pprint-c-type pprint-word ;
+M: wrapper pprint-c-type wrapped>> pprint-word ;
M: string pprint-c-type text ;
M: array pprint-c-type pprint* ;
M: typedef-word definer drop \ TYPEDEF: f ;
M: typedef-word synopsis*
- <colon
\ TYPEDEF: pprint-word
dup "c-type" word-prop pprint-c-type
- pprint-word
- block> ;
+ pprint-word ;
+: pprint-function-arg ( type name -- )
+ [ pprint-c-type ] [ text ] bi* ;
+: pprint-function-args ( word -- )
+ [ def>> fourth ] [ stack-effect in>> ] bi zip unclip-last
+ [ [ first2 "," append pprint-function-arg ] each ] dip
+ first2 pprint-function-arg ;
+
+M: alien-function-word definer
+ drop \ FUNCTION: \ ; ;
+M: alien-function-word definition drop f ;
+M: alien-function-word synopsis*
+ \ FUNCTION: pprint-word
+ [ def>> first pprint-c-type ]
+ [ pprint-word ]
+ [ <block "(" text pprint-function-args ")" text block> ] tri ;
From 93b12d3ef414041c9c62a01c469f6e0888816099 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 22:43:11 -0500
Subject: [PATCH 007/266] update classes.struct tests to use word c-types
---
basis/classes/struct/struct-tests.factor | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 3be0be8ef1..e9e45487f9 100755
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -6,7 +6,7 @@ io.encodings.utf8 io.pathnames io.streams.string kernel libc
literals math mirrors multiline namespaces prettyprint
prettyprint.config see sequences specialized-arrays system
tools.test parser lexer eval layouts ;
-FROM: math => float
+FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: int
@@ -48,9 +48,9 @@ STRUCT: struct-test-bar
[ {
{ "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
- { { "x" "char" } 98 }
- { { "y" "int" } HEX: 7F00007F }
- { { "z" "bool" } f }
+ { { "x" char } 98 }
+ { { "y" int } HEX: 7F00007F }
+ { { "z" bool } f }
} ] [
B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
make-mirror >alist
From 6dc6886bd92c93b94c8ba74db0360a4afb612e5f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 15 Sep 2009 22:58:07 -0500
Subject: [PATCH 008/266] typedefs share their original type's pointer
definition
---
basis/alien/c-types/c-types-tests.factor | 2 +-
basis/alien/c-types/c-types.factor | 18 +++++++++++++-----
2 files changed, 14 insertions(+), 6 deletions(-)
diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor
index bfeff5f1de..792e7d416a 100644
--- a/basis/alien/c-types/c-types-tests.factor
+++ b/basis/alien/c-types/c-types-tests.factor
@@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray
TYPEDEF: uchar* MyLPBYTE
-[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test
+[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> <void*>
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 02ab2dcafa..7dc00333b8 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -65,8 +65,8 @@ M: word resolve-pointer-type
dup "pointer-c-type" word-prop
[ ] [ drop void* ] ?if ;
M: string resolve-pointer-type
- c-types get at dup string?
- [ "*" append ] [ drop void* ] if ;
+ c-types get at dup c-type-name?
+ [ resolve-pointer-type ] [ drop void* ] if ;
: resolve-typedef ( name -- type )
dup c-type-name? [ c-type ] when ;
@@ -313,9 +313,17 @@ PREDICATE: typedef-word < c-type-word
M: string typedef ( old new -- ) c-types get set-at ;
M: word typedef ( old new -- )
- [ nip define-symbol ]
- [ name>> typedef ]
- [ swap "c-type" set-word-prop ] 2tri ;
+ {
+ [ nip define-symbol ]
+ [ name>> typedef ]
+ [ swap "c-type" set-word-prop ]
+ [
+ swap dup word? [
+ "pointer-c-type" word-prop
+ "pointer-c-type" set-word-prop
+ ] [ 2drop ] if
+ ]
+ } 2cleave ;
TUPLE: long-long-type < c-type ;
From 1b349f6be7284999786a94c3fc3fe6f916969b3b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:03 +0100
Subject: [PATCH 009/266] Added TOOLCHAIN_PREFIX var to makefile
---
Makefile | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/Makefile b/Makefile
index 18cb7d15c7..bfaa6ec7a3 100755
--- a/Makefile
+++ b/Makefile
@@ -164,17 +164,17 @@ macosx.app: factor
Factor.app/Contents/MacOS/factor
$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
- $(LINKER) $(ENGINE) $(DLL_OBJS)
- $(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
+ $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS)
+ $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
- $(LINKER) $(ENGINE) $(DLL_OBJS)
- $(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
+ $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS)
+ $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
$(TEST_LIBRARY): vm/ffi_test.o
- $(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
+ $(TOOLCHAIN_PREFIX)$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
clean:
rm -f vm/*.o
@@ -187,22 +187,22 @@ tags:
etags vm/*.{cpp,hpp,mm,S,c}
vm/resources.o:
- $(WINDRES) vm/factor.rs vm/resources.o
+ $(TOOLCHAIN_PREFIX)$(WINDRES) vm/factor.rs vm/resources.o
vm/ffi_test.o: vm/ffi_test.c
- $(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
.c.o:
- $(CC) -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $<
.cpp.o:
- $(CPP) -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
.S.o:
- $(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
.mm.o:
- $(CPP) -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
.PHONY: factor tags clean
From caefc7aff9e19833dd130e0594a18a2ac2c3c505 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 010/266] Empty vm struct
---
vm/master.hpp | 2 ++
vm/vm.hpp | 9 +++++++++
2 files changed, 11 insertions(+)
mode change 100644 => 100755 vm/master.hpp
create mode 100644 vm/vm.hpp
diff --git a/vm/master.hpp b/vm/master.hpp
old mode 100644
new mode 100755
index 9d84c8b75c..c1b62d41ff
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -74,4 +74,6 @@
#include "factor.hpp"
#include "utilities.hpp"
+#include "vm.hpp"
+
#endif /* __FACTOR_MASTER_H__ */
diff --git a/vm/vm.hpp b/vm/vm.hpp
new file mode 100644
index 0000000000..6c76cdddfa
--- /dev/null
+++ b/vm/vm.hpp
@@ -0,0 +1,9 @@
+namespace factor
+{
+
+struct factorvm {
+};
+
+extern factorvm *vm;
+
+}
From d8ea82d8e8cfe8967d095ee3c8dd65365d67e1c0 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 011/266] added stub PRIMITIVE_GETVM macro
---
vm/primitives.hpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index c520a67cc5..f534a24791 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -5,5 +5,5 @@ extern "C" typedef void (*primitive_type)();
extern const primitive_type primitives[];
#define PRIMITIVE(name) extern "C" void primitive_##name()
-
+#define PRIMITIVE_GETVM() vm->
}
From adf252945168021c41d22d91543de603134ee877 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 012/266] added vm singleton
---
vm/factor.cpp | 3 +++
1 file changed, 3 insertions(+)
mode change 100644 => 100755 vm/factor.cpp
diff --git a/vm/factor.cpp b/vm/factor.cpp
old mode 100644
new mode 100755
index 33d8b73dfe..5dd88402bc
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -3,6 +3,8 @@
namespace factor
{
+factorvm *vm;
+
VM_C_API void default_parameters(vm_parameters *p)
{
p->image_path = NULL;
@@ -95,6 +97,7 @@ static void do_stage1_init()
VM_C_API void init_factor(vm_parameters *p)
{
+ vm = new factorvm;
/* Kilobytes */
p->ds_size = align_page(p->ds_size << 10);
p->rs_size = align_page(p->rs_size << 10);
From 88084a66ac79641a88509e80fccd277ca71b3e57 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 013/266] moved contexts functions into vm
---
vm/contexts.cpp | 112 +++++++++++++++++++++++++++++++++++++++-------
vm/primitives.hpp | 2 +-
vm/vm.hpp | 20 +++++++++
3 files changed, 117 insertions(+), 17 deletions(-)
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index b0a27ef18f..86156de3b5 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -8,27 +8,42 @@ namespace factor
cell ds_size, rs_size;
context *unused_contexts;
-void reset_datastack()
+void factorvm::reset_datastack()
{
ds = ds_bot - sizeof(cell);
}
-void reset_retainstack()
+void reset_datastack()
+{
+ return vm->reset_datastack();
+}
+
+void factorvm::reset_retainstack()
{
rs = rs_bot - sizeof(cell);
}
+void reset_retainstack()
+{
+ return vm->reset_retainstack();
+}
+
static const cell stack_reserved = (64 * sizeof(cell));
-void fix_stacks()
+void factorvm::fix_stacks()
{
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();
}
+void fix_stacks()
+{
+ return vm->fix_stacks();
+}
+
/* called before entry into foreign C code. Note that ds and rs might
be stored in registers, so callbacks must save and restore the correct values */
-void save_stacks()
+void factorvm::save_stacks()
{
if(stack_chain)
{
@@ -37,7 +52,12 @@ void save_stacks()
}
}
-context *alloc_context()
+void save_stacks()
+{
+ return vm->save_stacks();
+}
+
+context *factorvm::alloc_context()
{
context *new_context;
@@ -56,14 +76,24 @@ context *alloc_context()
return new_context;
}
-void dealloc_context(context *old_context)
+context *alloc_context()
+{
+ return vm->alloc_context();
+}
+
+void factorvm::dealloc_context(context *old_context)
{
old_context->next = unused_contexts;
unused_contexts = old_context;
}
+void dealloc_context(context *old_context)
+{
+ return vm->dealloc_context(old_context);
+}
+
/* called on entry into a compiled callback */
-void nest_stacks()
+void factorvm::nest_stacks()
{
context *new_context = alloc_context();
@@ -94,8 +124,13 @@ void nest_stacks()
reset_retainstack();
}
+void nest_stacks()
+{
+ return vm->nest_stacks();
+}
+
/* called when leaving a compiled callback */
-void unnest_stacks()
+void factorvm::unnest_stacks()
{
ds = stack_chain->datastack_save;
rs = stack_chain->retainstack_save;
@@ -109,8 +144,13 @@ void unnest_stacks()
dealloc_context(old_stacks);
}
+void unnest_stacks()
+{
+ return vm->unnest_stacks();
+}
+
/* called on startup */
-void init_stacks(cell ds_size_, cell rs_size_)
+void factorvm::init_stacks(cell ds_size_, cell rs_size_)
{
ds_size = ds_size_;
rs_size = rs_size_;
@@ -118,7 +158,12 @@ void init_stacks(cell ds_size_, cell rs_size_)
unused_contexts = NULL;
}
-bool stack_to_array(cell bottom, cell top)
+void init_stacks(cell ds_size_, cell rs_size_)
+{
+ return vm->init_stacks(ds_size_,rs_size_);
+}
+
+bool factorvm::stack_to_array(cell bottom, cell top)
{
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
@@ -133,38 +178,68 @@ bool stack_to_array(cell bottom, cell top)
}
}
-PRIMITIVE(datastack)
+bool stack_to_array(cell bottom, cell top)
+{
+ return vm->stack_to_array(bottom,top);
+}
+
+inline void factorvm::vmprim_datastack()
{
if(!stack_to_array(ds_bot,ds))
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
}
-PRIMITIVE(retainstack)
+PRIMITIVE(datastack)
+{
+ PRIMITIVE_GETVM()->vmprim_datastack();
+}
+
+inline void factorvm::vmprim_retainstack()
{
if(!stack_to_array(rs_bot,rs))
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
}
+PRIMITIVE(retainstack)
+{
+ PRIMITIVE_GETVM()->vmprim_retainstack();
+}
+
/* returns pointer to top of stack */
-cell array_to_stack(array *array, cell bottom)
+cell factorvm::array_to_stack(array *array, cell bottom)
{
cell depth = array_capacity(array) * sizeof(cell);
memcpy((void*)bottom,array + 1,depth);
return bottom + depth - sizeof(cell);
}
-PRIMITIVE(set_datastack)
+cell array_to_stack(array *array, cell bottom)
+{
+ return vm->array_to_stack(array,bottom);
+}
+
+inline void factorvm::vmprim_set_datastack()
{
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
}
-PRIMITIVE(set_retainstack)
+PRIMITIVE(set_datastack)
+{
+ PRIMITIVE_GETVM()->vmprim_set_datastack();
+}
+
+inline void factorvm::vmprim_set_retainstack()
{
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
}
+PRIMITIVE(set_retainstack)
+{
+ PRIMITIVE_GETVM()->vmprim_set_retainstack();
+}
+
/* Used to implement call( */
-PRIMITIVE(check_datastack)
+inline void factorvm::vmprim_check_datastack()
{
fixnum out = to_fixnum(dpop());
fixnum in = to_fixnum(dpop());
@@ -189,4 +264,9 @@ PRIMITIVE(check_datastack)
}
}
+PRIMITIVE(check_datastack)
+{
+ PRIMITIVE_GETVM()->vmprim_check_datastack();
+}
+
}
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index f534a24791..c7534ec1cc 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -5,5 +5,5 @@ extern "C" typedef void (*primitive_type)();
extern const primitive_type primitives[];
#define PRIMITIVE(name) extern "C" void primitive_##name()
-#define PRIMITIVE_GETVM() vm->
+#define PRIMITIVE_GETVM() vm
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 6c76cdddfa..73bcffc764 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -2,6 +2,26 @@ namespace factor
{
struct factorvm {
+
+ // contexts
+ void reset_datastack();
+ void reset_retainstack();
+ void fix_stacks();
+ void save_stacks();
+ context *alloc_context();
+ void dealloc_context(context *old_context);
+ void nest_stacks();
+ void unnest_stacks();
+ void init_stacks(cell ds_size_, cell rs_size_);
+ bool stack_to_array(cell bottom, cell top);
+ cell array_to_stack(array *array, cell bottom);
+ inline void vmprim_datastack();
+ inline void vmprim_retainstack();
+ inline void vmprim_set_datastack();
+ inline void vmprim_set_retainstack();
+ inline void vmprim_check_datastack();
+ // next method here:
+
};
extern factorvm *vm;
From 110f9252458508f6b484b387c7c220106acd916f Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 014/266] move functions from run.cpp into vm
---
vm/run.cpp | 63 ++++++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 11 ++++++++++
2 files changed, 65 insertions(+), 9 deletions(-)
mode change 100644 => 100755 vm/run.cpp
diff --git a/vm/run.cpp b/vm/run.cpp
old mode 100644
new mode 100755
index c6a4bad695..0a14d4f017
--- a/vm/run.cpp
+++ b/vm/run.cpp
@@ -7,35 +7,60 @@ namespace factor
cell T;
-PRIMITIVE(getenv)
+inline void factorvm::vmprim_getenv()
{
fixnum e = untag_fixnum(dpeek());
drepl(userenv[e]);
}
-PRIMITIVE(setenv)
+PRIMITIVE(getenv)
+{
+ PRIMITIVE_GETVM()->vmprim_getenv();
+}
+
+inline void factorvm::vmprim_setenv()
{
fixnum e = untag_fixnum(dpop());
cell value = dpop();
userenv[e] = value;
}
-PRIMITIVE(exit)
+PRIMITIVE(setenv)
+{
+ PRIMITIVE_GETVM()->vmprim_setenv();
+}
+
+inline void factorvm::vmprim_exit()
{
exit(to_fixnum(dpop()));
}
-PRIMITIVE(micros)
+PRIMITIVE(exit)
+{
+ PRIMITIVE_GETVM()->vmprim_exit();
+}
+
+inline void factorvm::vmprim_micros()
{
box_unsigned_8(current_micros());
}
-PRIMITIVE(sleep)
+PRIMITIVE(micros)
+{
+ PRIMITIVE_GETVM()->vmprim_micros();
+}
+
+inline void factorvm::vmprim_sleep()
{
sleep_micros(to_cell(dpop()));
}
-PRIMITIVE(set_slot)
+PRIMITIVE(sleep)
+{
+ PRIMITIVE_GETVM()->vmprim_sleep();
+}
+
+inline void factorvm::vmprim_set_slot()
{
fixnum slot = untag_fixnum(dpop());
object *obj = untag<object>(dpop());
@@ -45,7 +70,12 @@ PRIMITIVE(set_slot)
write_barrier(obj);
}
-PRIMITIVE(load_locals)
+PRIMITIVE(set_slot)
+{
+ PRIMITIVE_GETVM()->vmprim_set_slot();
+}
+
+inline void factorvm::vmprim_load_locals()
{
fixnum count = untag_fixnum(dpop());
memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
@@ -53,7 +83,12 @@ PRIMITIVE(load_locals)
rs += sizeof(cell) * count;
}
-static cell clone_object(cell obj_)
+PRIMITIVE(load_locals)
+{
+ PRIMITIVE_GETVM()->vmprim_load_locals();
+}
+
+cell factorvm::clone_object(cell obj_)
{
gc_root<object> obj(obj_);
@@ -68,9 +103,19 @@ static cell clone_object(cell obj_)
}
}
-PRIMITIVE(clone)
+cell clone_object(cell obj_)
+{
+ return vm->clone_object(obj_);
+}
+
+inline void factorvm::vmprim_clone()
{
drepl(clone_object(dpeek()));
}
+PRIMITIVE(clone)
+{
+ PRIMITIVE_GETVM()->vmprim_clone();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 73bcffc764..7533d748b0 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -20,6 +20,17 @@ struct factorvm {
inline void vmprim_set_datastack();
inline void vmprim_set_retainstack();
inline void vmprim_check_datastack();
+
+ // run
+ inline void vmprim_getenv();
+ inline void vmprim_setenv();
+ inline void vmprim_exit();
+ inline void vmprim_micros();
+ inline void vmprim_sleep();
+ inline void vmprim_set_slot();
+ inline void vmprim_load_locals();
+ cell clone_object(cell obj_);
+ inline void vmprim_clone();
// next method here:
};
From aa01f6b74828dced81e2eb0971038d70babe1261 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 015/266] moved profiling fns into vm
---
vm/profiler.cpp | 28 ++++++++++++++++++++++++----
vm/vm.hpp | 6 ++++++
2 files changed, 30 insertions(+), 4 deletions(-)
mode change 100644 => 100755 vm/profiler.cpp
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
old mode 100644
new mode 100755
index a3265e0ffa..7b8f04a3bd
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -5,13 +5,18 @@ namespace factor
bool profiling_p;
-void init_profiler()
+void factorvm::init_profiler()
{
profiling_p = false;
}
+void init_profiler()
+{
+ return vm->init_profiler();
+}
+
/* Allocates memory */
-code_block *compile_profiling_stub(cell word_)
+code_block *factorvm::compile_profiling_stub(cell word_)
{
gc_root<word> word(word_);
@@ -21,8 +26,13 @@ code_block *compile_profiling_stub(cell word_)
return jit.to_code_block();
}
+code_block *compile_profiling_stub(cell word_)
+{
+ return vm->compile_profiling_stub(word_);
+}
+
/* Allocates memory */
-static void set_profiling(bool profiling)
+void factorvm::set_profiling(bool profiling)
{
if(profiling == profiling_p)
return;
@@ -49,9 +59,19 @@ static void set_profiling(bool profiling)
iterate_code_heap(relocate_code_block);
}
-PRIMITIVE(profiling)
+void set_profiling(bool profiling)
+{
+ return vm->set_profiling(profiling);
+}
+
+inline void factorvm::vmprim_profiling()
{
set_profiling(to_boolean(dpop()));
}
+PRIMITIVE(profiling)
+{
+ PRIMITIVE_GETVM()->vmprim_profiling();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 7533d748b0..c18ba90772 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -31,6 +31,12 @@ struct factorvm {
inline void vmprim_load_locals();
cell clone_object(cell obj_);
inline void vmprim_clone();
+
+ // profiler
+ void init_profiler();
+ code_block *compile_profiling_stub(cell word_);
+ void set_profiling(bool profiling);
+ inline void vmprim_profiling();
// next method here:
};
From 10901e7c372aa99b1a333ac914ffca7547f2b0ab Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:04 +0100
Subject: [PATCH 016/266] moved errors.cpp functions to vm
---
vm/errors.cpp | 115 ++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 20 +++++++++
2 files changed, 117 insertions(+), 18 deletions(-)
mode change 100644 => 100755 vm/errors.cpp
diff --git a/vm/errors.cpp b/vm/errors.cpp
old mode 100644
new mode 100755
index ebe6201f72..23833960e1
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -10,21 +10,31 @@ cell signal_fault_addr;
unsigned int signal_fpu_status;
stack_frame *signal_callstack_top;
-void out_of_memory()
+void factorvm::out_of_memory()
{
print_string("Out of memory\n\n");
dump_generations();
exit(1);
}
-void fatal_error(const char* msg, cell tagged)
+void out_of_memory()
+{
+ return vm->out_of_memory();
+}
+
+void factorvm::fatal_error(const char* msg, cell tagged)
{
print_string("fatal_error: "); print_string(msg);
print_string(": "); print_cell_hex(tagged); nl();
exit(1);
}
-void critical_error(const char* msg, cell tagged)
+void fatal_error(const char* msg, cell tagged)
+{
+ return vm->fatal_error(msg,tagged);
+}
+
+void factorvm::critical_error(const char* msg, cell tagged)
{
print_string("You have triggered a bug in Factor. Please report.\n");
print_string("critical_error: "); print_string(msg);
@@ -32,7 +42,12 @@ void critical_error(const char* msg, cell tagged)
factorbug();
}
-void throw_error(cell error, stack_frame *callstack_top)
+void critical_error(const char* msg, cell tagged)
+{
+ return vm->critical_error(msg,tagged);
+}
+
+void factorvm::throw_error(cell error, stack_frame *callstack_top)
{
/* If the error handler is set, we rewind any C stack frames and
pass the error to user-space. */
@@ -77,26 +92,45 @@ void throw_error(cell error, stack_frame *callstack_top)
}
}
-void general_error(vm_error_type error, cell arg1, cell arg2,
- stack_frame *callstack_top)
+void throw_error(cell error, stack_frame *callstack_top)
+{
+ return vm->throw_error(error, callstack_top);
+}
+
+void factorvm::general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top)
{
throw_error(allot_array_4(userenv[ERROR_ENV],
tag_fixnum(error),arg1,arg2),callstack_top);
}
-void type_error(cell type, cell tagged)
+void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top)
+{
+ return vm->general_error(error,arg1,arg2,callstack_top);
+}
+
+void factorvm::type_error(cell type, cell tagged)
{
general_error(ERROR_TYPE,tag_fixnum(type),tagged,NULL);
}
-void not_implemented_error()
+void type_error(cell type, cell tagged)
+{
+ return vm->type_error(type, tagged);
+}
+
+void factorvm::not_implemented_error()
{
general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
}
+void not_implemented_error()
+{
+ return vm->not_implemented_error();
+}
+
/* Test if 'fault' is in the guard page at the top or bottom (depending on
offset being 0 or -1) of area+area_size */
-bool in_page(cell fault, cell area, cell area_size, int offset)
+bool factorvm::in_page(cell fault, cell area, cell area_size, int offset)
{
int pagesize = getpagesize();
area += area_size;
@@ -105,7 +139,12 @@ bool in_page(cell fault, cell area, cell area_size, int offset)
return fault >= area && fault <= area + pagesize;
}
-void memory_protection_error(cell addr, stack_frame *native_stack)
+bool in_page(cell fault, cell area, cell area_size, int offset)
+{
+ return vm->in_page(fault,area,area_size,offset);
+}
+
+void factorvm::memory_protection_error(cell addr, stack_frame *native_stack)
{
if(in_page(addr, ds_bot, 0, -1))
general_error(ERROR_DS_UNDERFLOW,F,F,native_stack);
@@ -121,45 +160,85 @@ void memory_protection_error(cell addr, stack_frame *native_stack)
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
}
-void signal_error(int signal, stack_frame *native_stack)
+void memory_protection_error(cell addr, stack_frame *native_stack)
+{
+ return vm->memory_protection_error(addr,native_stack);
+}
+
+void factorvm::signal_error(int signal, stack_frame *native_stack)
{
general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack);
}
-void divide_by_zero_error()
+void signal_error(int signal, stack_frame *native_stack)
+{
+ return vm->signal_error(signal, native_stack);
+}
+
+void factorvm::divide_by_zero_error()
{
general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
}
-void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
+void divide_by_zero_error()
+{
+ return vm->divide_by_zero_error();
+}
+
+void factorvm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
{
general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),F,signal_callstack_top);
}
-PRIMITIVE(call_clear)
+inline void factorvm::vmprim_call_clear()
{
throw_impl(dpop(),stack_chain->callstack_bottom);
}
+PRIMITIVE(call_clear)
+{
+ PRIMITIVE_GETVM()->vmprim_call_clear();
+}
+
/* For testing purposes */
-PRIMITIVE(unimplemented)
+inline void factorvm::vmprim_unimplemented()
{
not_implemented_error();
}
-void memory_signal_handler_impl()
+PRIMITIVE(unimplemented)
+{
+ PRIMITIVE_GETVM()->vmprim_unimplemented();
+}
+
+void factorvm::memory_signal_handler_impl()
{
memory_protection_error(signal_fault_addr,signal_callstack_top);
}
-void misc_signal_handler_impl()
+void memory_signal_handler_impl()
+{
+ return vm->memory_signal_handler_impl();
+}
+
+void factorvm::misc_signal_handler_impl()
{
signal_error(signal_number,signal_callstack_top);
}
-void fp_signal_handler_impl()
+void misc_signal_handler_impl()
+{
+ vm->misc_signal_handler_impl();
+}
+
+void factorvm::fp_signal_handler_impl()
{
fp_trap_error(signal_fpu_status,signal_callstack_top);
}
+void fp_signal_handler_impl()
+{
+ vm->fp_signal_handler_impl();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index c18ba90772..dd34a211fa 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -37,6 +37,26 @@ struct factorvm {
code_block *compile_profiling_stub(cell word_);
void set_profiling(bool profiling);
inline void vmprim_profiling();
+
+ // errors
+ void out_of_memory();
+ void fatal_error(const char* msg, cell tagged);
+ void critical_error(const char* msg, cell tagged);
+ void throw_error(cell error, stack_frame *callstack_top);
+
+ void not_implemented_error();
+ bool in_page(cell fault, cell area, cell area_size, int offset);
+ void memory_protection_error(cell addr, stack_frame *native_stack);
+ void signal_error(int signal, stack_frame *native_stack);
+ void divide_by_zero_error();
+ void fp_trap_error(stack_frame *signal_callstack_top);
+ inline void vmprim_call_clear();
+ inline void vmprim_unimplemented();
+ void memory_signal_handler_impl();
+ void misc_signal_handler_impl();
+ void fp_signal_handler_impl();
+ void type_error(cell type, cell tagged);
+ void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top);
// next method here:
};
From 8426e2f877713316207892c9025a96fa84c7c954 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:05 +0100
Subject: [PATCH 017/266] Dev checkpoint
---
vm/bignum.cpp | 40 ++++++++++++++++++++++++++++++----------
vm/vm.hpp | 8 +++++++-
2 files changed, 37 insertions(+), 11 deletions(-)
mode change 100644 => 100755 vm/bignum.cpp
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
old mode 100644
new mode 100755
index c487186da0..a3c3e73ca1
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -61,8 +61,7 @@ namespace factor
/* Exports */
-int
-bignum_equal_p(bignum * x, bignum * y)
+int factorvm::bignum_equal_p(bignum * x, bignum * y)
{
return
((BIGNUM_ZERO_P (x))
@@ -74,8 +73,12 @@ bignum_equal_p(bignum * x, bignum * y)
&& (bignum_equal_p_unsigned (x, y))));
}
-enum bignum_comparison
-bignum_compare(bignum * x, bignum * y)
+int bignum_equal_p(bignum * x, bignum * y)
+{
+ return vm->bignum_equal_p(x,y);
+}
+
+enum bignum_comparison factorvm::bignum_compare(bignum * x, bignum * y)
{
return
((BIGNUM_ZERO_P (x))
@@ -97,9 +100,13 @@ bignum_compare(bignum * x, bignum * y)
: (bignum_compare_unsigned (x, y))));
}
+enum bignum_comparison bignum_compare(bignum * x, bignum * y)
+{
+ return vm->bignum_compare(x,y);
+}
+
/* allocates memory */
-bignum *
-bignum_add(bignum * x, bignum * y)
+bignum *factorvm::bignum_add(bignum * x, bignum * y)
{
return
((BIGNUM_ZERO_P (x))
@@ -115,9 +122,13 @@ bignum_add(bignum * x, bignum * y)
: (bignum_add_unsigned (x, y, 0)))));
}
+bignum *bignum_add(bignum * x, bignum * y)
+{
+ return vm->bignum_add(x,y);
+}
+
/* allocates memory */
-bignum *
-bignum_subtract(bignum * x, bignum * y)
+bignum *factorvm::bignum_subtract(bignum * x, bignum * y)
{
return
((BIGNUM_ZERO_P (x))
@@ -135,9 +146,13 @@ bignum_subtract(bignum * x, bignum * y)
: (bignum_subtract_unsigned (x, y))))));
}
+bignum *bignum_subtract(bignum * x, bignum * y)
+{
+ return vm->bignum_subtract(x,y);
+}
+
/* allocates memory */
-bignum *
-bignum_multiply(bignum * x, bignum * y)
+bignum *factorvm::bignum_multiply(bignum * x, bignum * y)
{
bignum_length_type x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y));
@@ -168,6 +183,11 @@ bignum_multiply(bignum * x, bignum * y)
return (bignum_multiply_unsigned (x, y, negative_p));
}
+bignum *bignum_multiply(bignum * x, bignum * y)
+{
+ return vm->bignum_multiply(x,y);
+}
+
/* allocates memory */
void
bignum_divide(bignum * numerator, bignum * denominator,
diff --git a/vm/vm.hpp b/vm/vm.hpp
index dd34a211fa..523e1f63e7 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -43,7 +43,6 @@ struct factorvm {
void fatal_error(const char* msg, cell tagged);
void critical_error(const char* msg, cell tagged);
void throw_error(cell error, stack_frame *callstack_top);
-
void not_implemented_error();
bool in_page(cell fault, cell area, cell area_size, int offset);
void memory_protection_error(cell addr, stack_frame *native_stack);
@@ -57,6 +56,13 @@ struct factorvm {
void fp_signal_handler_impl();
void type_error(cell type, cell tagged);
void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top);
+
+ // bignum
+ int bignum_equal_p(bignum * x, bignum * y);
+ enum bignum_comparison bignum_compare(bignum * x, bignum * y);
+ bignum *bignum_add(bignum * x, bignum * y);
+ bignum *bignum_subtract(bignum * x, bignum * y);
+ bignum *bignum_multiply(bignum * x, bignum * y);
// next method here:
};
From 149af514e654bd9f2ac05a0dd0386dbf3ef75e6f Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:05 +0100
Subject: [PATCH 018/266] Dev checkpoint
---
vm/bignum.cpp | 119 +++++++++++++++++++++++++++++++++++---------------
vm/vm.hpp | 14 ++++++
2 files changed, 98 insertions(+), 35 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index a3c3e73ca1..405aff4e5e 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -189,9 +189,7 @@ bignum *bignum_multiply(bignum * x, bignum * y)
}
/* allocates memory */
-void
-bignum_divide(bignum * numerator, bignum * denominator,
- bignum * * quotient, bignum * * remainder)
+void factorvm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
{
if (BIGNUM_ZERO_P (denominator))
{
@@ -261,9 +259,13 @@ bignum_divide(bignum * numerator, bignum * denominator,
}
}
+void bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
+{
+ return vm->bignum_divide(numerator,denominator,quotient,remainder);
+}
+
/* allocates memory */
-bignum *
-bignum_quotient(bignum * numerator, bignum * denominator)
+bignum *factorvm::bignum_quotient(bignum * numerator, bignum * denominator)
{
if (BIGNUM_ZERO_P (denominator))
{
@@ -314,9 +316,13 @@ bignum_quotient(bignum * numerator, bignum * denominator)
}
}
+bignum *bignum_quotient(bignum * numerator, bignum * denominator)
+{
+ return vm->bignum_quotient(numerator,denominator);
+}
+
/* allocates memory */
-bignum *
-bignum_remainder(bignum * numerator, bignum * denominator)
+bignum *factorvm::bignum_remainder(bignum * numerator, bignum * denominator)
{
if (BIGNUM_ZERO_P (denominator))
{
@@ -359,6 +365,11 @@ bignum_remainder(bignum * numerator, bignum * denominator)
}
}
+bignum *bignum_remainder(bignum * numerator, bignum * denominator)
+{
+ return vm->bignum_remainder(numerator, denominator);
+}
+
#define FOO_TO_BIGNUM(name,type,utype) \
bignum * name##_to_bignum(type n) \
{ \
@@ -416,8 +427,7 @@ BIGNUM_TO_FOO(fixnum,fixnum,cell);
BIGNUM_TO_FOO(long_long,s64,u64)
BIGNUM_TO_FOO(ulong_long,u64,u64)
-double
-bignum_to_double(bignum * bignum)
+double factorvm::bignum_to_double(bignum * bignum)
{
if (BIGNUM_ZERO_P (bignum))
return (0);
@@ -431,6 +441,11 @@ bignum_to_double(bignum * bignum)
}
}
+double bignum_to_double(bignum * bignum)
+{
+ return vm->bignum_to_double(bignum);
+}
+
#define DTB_WRITE_DIGIT(factor) \
{ \
significand *= (factor); \
@@ -442,8 +457,7 @@ bignum_to_double(bignum * bignum)
/* allocates memory */
#define inf std::numeric_limits<double>::infinity()
-bignum *
-double_to_bignum(double x)
+bignum *factorvm::double_to_bignum(double x)
{
if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
int exponent;
@@ -474,12 +488,16 @@ double_to_bignum(double x)
}
}
+bignum *double_to_bignum(double x)
+{
+ return vm->double_to_bignum(x);
+}
+
#undef DTB_WRITE_DIGIT
/* Comparisons */
-int
-bignum_equal_p_unsigned(bignum * x, bignum * y)
+int factorvm::bignum_equal_p_unsigned(bignum * x, bignum * y)
{
bignum_length_type length = (BIGNUM_LENGTH (x));
if (length != (BIGNUM_LENGTH (y)))
@@ -496,8 +514,12 @@ bignum_equal_p_unsigned(bignum * x, bignum * y)
}
}
-enum bignum_comparison
-bignum_compare_unsigned(bignum * x, bignum * y)
+int bignum_equal_p_unsigned(bignum * x, bignum * y)
+{
+ return vm->bignum_equal_p_unsigned(x,y);
+}
+
+enum bignum_comparison factorvm::bignum_compare_unsigned(bignum * x, bignum * y)
{
bignum_length_type x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y));
@@ -522,11 +544,15 @@ bignum_compare_unsigned(bignum * x, bignum * y)
return (bignum_comparison_equal);
}
+enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y)
+{
+ return vm->bignum_compare_unsigned(x,y);
+}
+
/* Addition */
/* allocates memory */
-bignum *
-bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
+bignum *factorvm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
{
GC_BIGNUM(x); GC_BIGNUM(y);
@@ -590,11 +616,15 @@ bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
}
}
+bignum *bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
+{
+ return vm->bignum_add_unsigned(x,y,negative_p);
+}
+
/* Subtraction */
/* allocates memory */
-bignum *
-bignum_subtract_unsigned(bignum * x, bignum * y)
+bignum *factorvm::bignum_subtract_unsigned(bignum * x, bignum * y)
{
GC_BIGNUM(x); GC_BIGNUM(y);
@@ -665,6 +695,11 @@ bignum_subtract_unsigned(bignum * x, bignum * y)
}
}
+bignum *bignum_subtract_unsigned(bignum * x, bignum * y)
+{
+ return vm->bignum_subtract_unsigned(x,y);
+}
+
/* Multiplication
Maximum value for product_low or product_high:
((R * R) + (R * (R - 2)) + (R - 1))
@@ -672,8 +707,7 @@ bignum_subtract_unsigned(bignum * x, bignum * y)
where R == BIGNUM_RADIX_ROOT */
/* allocates memory */
-bignum *
-bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
+bignum *factorvm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
{
GC_BIGNUM(x); GC_BIGNUM(y);
@@ -743,10 +777,13 @@ bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
}
}
+bignum *bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
+{
+ return vm->bignum_multiply_unsigned(x,y,negative_p);
+}
+
/* allocates memory */
-bignum *
-bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,
- int negative_p)
+bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
{
GC_BIGNUM(x);
@@ -760,8 +797,12 @@ bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,
return (bignum_trim (p));
}
-void
-bignum_destructive_add(bignum * bignum, bignum_digit_type n)
+bignum *bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
+{
+ return vm->bignum_multiply_unsigned_small_factor(x,y,negative_p);
+}
+
+void factorvm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
{
bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
bignum_digit_type digit;
@@ -784,8 +825,12 @@ bignum_destructive_add(bignum * bignum, bignum_digit_type n)
}
}
-void
-bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
+void bignum_destructive_add(bignum * bignum, bignum_digit_type n)
+{
+ return vm->bignum_destructive_add(bignum,n);
+}
+
+void factorvm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
{
bignum_digit_type carry = 0;
bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
@@ -814,6 +859,11 @@ bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
#undef product_high
}
+void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
+{
+ return vm->bignum_destructive_scale_up(bignum,factor);
+}
+
/* Division */
/* For help understanding this algorithm, see:
@@ -822,13 +872,7 @@ bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
section 4.3.1, "Multiple-Precision Arithmetic". */
/* allocates memory */
-void
-bignum_divide_unsigned_large_denominator(bignum * numerator,
- bignum * denominator,
- bignum * * quotient,
- bignum * * remainder,
- int q_negative_p,
- int r_negative_p)
+void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
{
GC_BIGNUM(numerator); GC_BIGNUM(denominator);
@@ -885,6 +929,11 @@ bignum_divide_unsigned_large_denominator(bignum * numerator,
return;
}
+void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
+{
+ return vm->bignum_divide_unsigned_large_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
+}
+
void
bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
{
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 523e1f63e7..c492477db2 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -63,6 +63,20 @@ struct factorvm {
bignum *bignum_add(bignum * x, bignum * y);
bignum *bignum_subtract(bignum * x, bignum * y);
bignum *bignum_multiply(bignum * x, bignum * y);
+ void bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder);
+ bignum *bignum_quotient(bignum * numerator, bignum * denominator);
+ bignum *bignum_remainder(bignum * numerator, bignum * denominator);
+ double bignum_to_double(bignum * bignum);
+ bignum *double_to_bignum(double x);
+ int bignum_equal_p_unsigned(bignum * x, bignum * y);
+ enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y);
+ bignum *bignum_add_unsigned(bignum * x, bignum * y, int negative_p);
+ bignum *bignum_subtract_unsigned(bignum * x, bignum * y);
+ bignum *bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p);
+ bignum *bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p);
+ void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
+ void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
+ void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
// next method here:
};
From a6fc19f4b0f6a2962af71fd1d436defcf33f6376 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:05 +0100
Subject: [PATCH 019/266] Dev checkpoint
---
vm/bignum.cpp | 41 ++++++++++++++++++++++++-----------------
vm/vm.hpp | 4 ++++
2 files changed, 28 insertions(+), 17 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 405aff4e5e..03fccf3d20 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -934,8 +934,7 @@ void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denom
return vm->bignum_divide_unsigned_large_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
}
-void
-bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
+void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
{
bignum_length_type u_length = (BIGNUM_LENGTH (u));
bignum_length_type v_length = (BIGNUM_LENGTH (v));
@@ -1009,11 +1008,12 @@ bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
#undef qj
}
-bignum_digit_type
-bignum_divide_subtract(bignum_digit_type * v_start,
- bignum_digit_type * v_end,
- bignum_digit_type guess,
- bignum_digit_type * u_start)
+void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
+{
+ return vm->bignum_divide_unsigned_normalized(u,v,q);
+}
+
+bignum_digit_type factorvm::bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
{
bignum_digit_type * v_scan = v_start;
bignum_digit_type * u_scan = u_start;
@@ -1088,14 +1088,13 @@ bignum_divide_subtract(bignum_digit_type * v_start,
return (guess - 1);
}
+bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
+{
+ return vm->bignum_divide_subtract(v_start,v_end,guess,u_start);
+}
+
/* allocates memory */
-void
-bignum_divide_unsigned_medium_denominator(bignum * numerator,
- bignum_digit_type denominator,
- bignum * * quotient,
- bignum * * remainder,
- int q_negative_p,
- int r_negative_p)
+void factorvm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
{
GC_BIGNUM(numerator);
@@ -1153,9 +1152,12 @@ bignum_divide_unsigned_medium_denominator(bignum * numerator,
return;
}
-void
-bignum_destructive_normalization(bignum * source, bignum * target,
- int shift_left)
+void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
+{
+ vm->bignum_divide_unsigned_medium_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
+}
+
+void factorvm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
{
bignum_digit_type digit;
bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
@@ -1178,6 +1180,11 @@ bignum_destructive_normalization(bignum * source, bignum * target,
return;
}
+void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
+{
+ return vm->bignum_destructive_normalization(source,target,shift_left);
+}
+
void
bignum_destructive_unnormalization(bignum * bignum, int shift_right)
{
diff --git a/vm/vm.hpp b/vm/vm.hpp
index c492477db2..88cea40245 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -77,6 +77,10 @@ struct factorvm {
void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
+ void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q);
+ bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start);
+ void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left);
// next method here:
};
From 1a87f3bb5f1b5e49a893c5dc98caccdaa1dda30d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:05 +0100
Subject: [PATCH 020/266] moved bignum functions to vm
---
vm/bignum.cpp | 236 +++++++++++++++++++++++++++++++++++---------------
vm/vm.hpp | 40 ++++++++-
2 files changed, 205 insertions(+), 71 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 03fccf3d20..a5310d1c14 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -1185,8 +1185,7 @@ void bignum_destructive_normalization(bignum * source, bignum * target, int shif
return vm->bignum_destructive_normalization(source,target,shift_left);
}
-void
-bignum_destructive_unnormalization(bignum * bignum, int shift_right)
+void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
{
bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
@@ -1204,6 +1203,11 @@ bignum_destructive_unnormalization(bignum * bignum, int shift_right)
return;
}
+void bignum_destructive_unnormalization(bignum * bignum, int shift_right)
+{
+ return vm->bignum_destructive_unnormalization(bignum,shift_right);
+}
+
/* This is a reduced version of the division algorithm, applied to the
case of dividing two bignum digits by one bignum digit. It is
assumed that the numerator, denominator are normalized. */
@@ -1232,10 +1236,7 @@ bignum_destructive_unnormalization(bignum * bignum, int shift_right)
qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
}
-bignum_digit_type
-bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
- bignum_digit_type v,
- bignum_digit_type * q) /* return value */
+bignum_digit_type factorvm::bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
{
bignum_digit_type guess;
bignum_digit_type comparand;
@@ -1271,6 +1272,11 @@ bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
return (HD_CONS ((u[2]), (u[3])));
}
+bignum_digit_type bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
+{
+ return vm->bignum_digit_divide(uh,ul,v,q);
+}
+
#undef BDD_STEP
#define BDDS_MULSUB(vn, un, carry_in) \
@@ -1304,9 +1310,7 @@ bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
} \
}
-bignum_digit_type
-bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
- bignum_digit_type guess, bignum_digit_type * u)
+bignum_digit_type factorvm::bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
{
{
bignum_digit_type product;
@@ -1336,17 +1340,16 @@ bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
return (guess - 1);
}
+bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
+{
+ return vm->bignum_digit_divide_subtract(v1,v2,guess,u);
+}
+
#undef BDDS_MULSUB
#undef BDDS_ADD
/* allocates memory */
-void
-bignum_divide_unsigned_small_denominator(bignum * numerator,
- bignum_digit_type denominator,
- bignum * * quotient,
- bignum * * remainder,
- int q_negative_p,
- int r_negative_p)
+void factorvm::bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
{
GC_BIGNUM(numerator);
@@ -1365,12 +1368,16 @@ bignum_divide_unsigned_small_denominator(bignum * numerator,
return;
}
+void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
+{
+ return vm->bignum_divide_unsigned_small_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
+}
+
/* Given (denominator > 1), it is fairly easy to show that
(quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
that all digits are < BIGNUM_RADIX. */
-bignum_digit_type
-bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
+bignum_digit_type factorvm::bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
{
bignum_digit_type numerator;
bignum_digit_type remainder = 0;
@@ -1392,10 +1399,13 @@ bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
#undef quotient_high
}
+bignum_digit_type bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
+{
+ return vm->bignum_destructive_scale_down(bignum,denominator);
+}
+
/* allocates memory */
-bignum *
-bignum_remainder_unsigned_small_denominator(
- bignum * n, bignum_digit_type d, int negative_p)
+bignum * factorvm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
{
bignum_digit_type two_digits;
bignum_digit_type * start = (BIGNUM_START_PTR (n));
@@ -1413,9 +1423,13 @@ bignum_remainder_unsigned_small_denominator(
return (bignum_digit_to_bignum (r, negative_p));
}
+bignum * bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
+{
+ return vm->bignum_remainder_unsigned_small_denominator(n,d,negative_p);
+}
+
/* allocates memory */
-bignum *
-bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
+bignum *factorvm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
{
if (digit == 0)
return (BIGNUM_ZERO ());
@@ -1427,9 +1441,13 @@ bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
}
}
+bignum *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
+{
+ return vm->bignum_digit_to_bignum(digit, negative_p);
+}
+
/* allocates memory */
-bignum *
-allot_bignum(bignum_length_type length, int negative_p)
+bignum *factorvm::allot_bignum(bignum_length_type length, int negative_p)
{
BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
bignum * result = allot_array_internal<bignum>(length + 1);
@@ -1437,9 +1455,13 @@ allot_bignum(bignum_length_type length, int negative_p)
return (result);
}
+bignum *allot_bignum(bignum_length_type length, int negative_p)
+{
+ return vm->allot_bignum(length,negative_p);
+}
+
/* allocates memory */
-bignum *
-allot_bignum_zeroed(bignum_length_type length, int negative_p)
+bignum * factorvm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
{
bignum * result = allot_bignum(length,negative_p);
bignum_digit_type * scan = (BIGNUM_START_PTR (result));
@@ -1449,12 +1471,16 @@ allot_bignum_zeroed(bignum_length_type length, int negative_p)
return (result);
}
+bignum * allot_bignum_zeroed(bignum_length_type length, int negative_p)
+{
+ return vm->allot_bignum_zeroed(length,negative_p);
+}
+
#define BIGNUM_REDUCE_LENGTH(source, length) \
source = reallot_array(source,length + 1)
/* allocates memory */
-bignum *
-bignum_shorten_length(bignum * bignum, bignum_length_type length)
+bignum *factorvm::bignum_shorten_length(bignum * bignum, bignum_length_type length)
{
bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
@@ -1466,9 +1492,13 @@ bignum_shorten_length(bignum * bignum, bignum_length_type length)
return (bignum);
}
+bignum *bignum_shorten_length(bignum * bignum, bignum_length_type length)
+{
+ return vm->bignum_shorten_length(bignum,length);
+}
+
/* allocates memory */
-bignum *
-bignum_trim(bignum * bignum)
+bignum *factorvm::bignum_trim(bignum * bignum)
{
bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
@@ -1485,11 +1515,15 @@ bignum_trim(bignum * bignum)
return (bignum);
}
+bignum *bignum_trim(bignum * bignum)
+{
+ return vm->bignum_trim(bignum);
+}
+
/* Copying */
/* allocates memory */
-bignum *
-bignum_new_sign(bignum * x, int negative_p)
+bignum *factorvm::bignum_new_sign(bignum * x, int negative_p)
{
GC_BIGNUM(x);
bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
@@ -1498,9 +1532,13 @@ bignum_new_sign(bignum * x, int negative_p)
return (result);
}
+bignum *bignum_new_sign(bignum * x, int negative_p)
+{
+ return vm->bignum_new_sign(x,negative_p);
+}
+
/* allocates memory */
-bignum *
-bignum_maybe_new_sign(bignum * x, int negative_p)
+bignum *factorvm::bignum_maybe_new_sign(bignum * x, int negative_p)
{
if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
return (x);
@@ -1513,8 +1551,12 @@ bignum_maybe_new_sign(bignum * x, int negative_p)
}
}
-void
-bignum_destructive_copy(bignum * source, bignum * target)
+bignum *bignum_maybe_new_sign(bignum * x, int negative_p)
+{
+ return vm->bignum_maybe_new_sign(x,negative_p);
+}
+
+void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
{
bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
bignum_digit_type * end_source =
@@ -1525,20 +1567,28 @@ bignum_destructive_copy(bignum * source, bignum * target)
return;
}
+void bignum_destructive_copy(bignum * source, bignum * target)
+{
+ return vm->bignum_destructive_copy(source,target);
+}
+
/*
* Added bitwise operations (and oddp).
*/
/* allocates memory */
-bignum *
-bignum_bitwise_not(bignum * x)
+bignum *factorvm::bignum_bitwise_not(bignum * x)
{
return bignum_subtract(BIGNUM_ONE(1), x);
}
+bignum *bignum_bitwise_not(bignum * x)
+{
+ return vm->bignum_bitwise_not(x);
+}
+
/* allocates memory */
-bignum *
-bignum_arithmetic_shift(bignum * arg1, fixnum n)
+bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
{
if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
@@ -1546,13 +1596,17 @@ bignum_arithmetic_shift(bignum * arg1, fixnum n)
return bignum_magnitude_ash(arg1, n);
}
+bignum *bignum_arithmetic_shift(bignum * arg1, fixnum n)
+{
+ return vm->bignum_arithmetic_shift(arg1,n);
+}
+
#define AND_OP 0
#define IOR_OP 1
#define XOR_OP 2
/* allocates memory */
-bignum *
-bignum_bitwise_and(bignum * arg1, bignum * arg2)
+bignum *factorvm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
{
return(
(BIGNUM_NEGATIVE_P (arg1))
@@ -1565,9 +1619,13 @@ bignum_bitwise_and(bignum * arg1, bignum * arg2)
);
}
+bignum *bignum_bitwise_and(bignum * arg1, bignum * arg2)
+{
+ return vm->bignum_bitwise_and(arg1,arg2);
+}
+
/* allocates memory */
-bignum *
-bignum_bitwise_ior(bignum * arg1, bignum * arg2)
+bignum *factorvm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
{
return(
(BIGNUM_NEGATIVE_P (arg1))
@@ -1580,9 +1638,13 @@ bignum_bitwise_ior(bignum * arg1, bignum * arg2)
);
}
+bignum *bignum_bitwise_ior(bignum * arg1, bignum * arg2)
+{
+ return vm->bignum_bitwise_ior(arg1,arg2);
+}
+
/* allocates memory */
-bignum *
-bignum_bitwise_xor(bignum * arg1, bignum * arg2)
+bignum *factorvm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
{
return(
(BIGNUM_NEGATIVE_P (arg1))
@@ -1595,11 +1657,15 @@ bignum_bitwise_xor(bignum * arg1, bignum * arg2)
);
}
+bignum *bignum_bitwise_xor(bignum * arg1, bignum * arg2)
+{
+ return vm->bignum_bitwise_xor(arg1,arg2);
+}
+
/* allocates memory */
/* ash for the magnitude */
/* assume arg1 is a big number, n is a long */
-bignum *
-bignum_magnitude_ash(bignum * arg1, fixnum n)
+bignum *factorvm::bignum_magnitude_ash(bignum * arg1, fixnum n)
{
GC_BIGNUM(arg1);
@@ -1659,9 +1725,13 @@ bignum_magnitude_ash(bignum * arg1, fixnum n)
return (bignum_trim (result));
}
+bignum *bignum_magnitude_ash(bignum * arg1, fixnum n)
+{
+ return vm->bignum_magnitude_ash(arg1,n);
+}
+
/* allocates memory */
-bignum *
-bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
+bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
GC_BIGNUM(arg1); GC_BIGNUM(arg2);
@@ -1694,9 +1764,13 @@ bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
return bignum_trim(result);
}
+bignum *bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
+{
+ return vm->bignum_pospos_bitwise_op(op,arg1,arg2);
+}
+
/* allocates memory */
-bignum *
-bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
+bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
GC_BIGNUM(arg1); GC_BIGNUM(arg2);
@@ -1747,9 +1821,13 @@ bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
return bignum_trim(result);
}
+bignum *bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
+{
+ return vm->bignum_posneg_bitwise_op(op,arg1,arg2);
+}
+
/* allocates memory */
-bignum *
-bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
+bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
GC_BIGNUM(arg1); GC_BIGNUM(arg2);
@@ -1808,8 +1886,12 @@ bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
return bignum_trim(result);
}
-void
-bignum_negate_magnitude(bignum * arg)
+bignum *bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
+{
+ return vm->bignum_negneg_bitwise_op(op,arg1,arg2);
+}
+
+void factorvm::bignum_negate_magnitude(bignum * arg)
{
bignum_digit_type *scan;
bignum_digit_type *end;
@@ -1836,9 +1918,13 @@ bignum_negate_magnitude(bignum * arg)
}
}
+void bignum_negate_magnitude(bignum * arg)
+{
+ return vm->bignum_negate_magnitude(arg);
+}
+
/* Allocates memory */
-bignum *
-bignum_integer_length(bignum * x)
+bignum *factorvm::bignum_integer_length(bignum * x)
{
GC_BIGNUM(x);
@@ -1858,17 +1944,25 @@ bignum_integer_length(bignum * x)
return (bignum_trim (result));
}
+bignum *bignum_integer_length(bignum * x)
+{
+ return vm->bignum_integer_length(x);
+}
+
/* Allocates memory */
-int
-bignum_logbitp(int shift, bignum * arg)
+int factorvm::bignum_logbitp(int shift, bignum * arg)
{
return((BIGNUM_NEGATIVE_P (arg))
? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
: bignum_unsigned_logbitp (shift,arg));
}
-int
-bignum_unsigned_logbitp(int shift, bignum * bignum)
+int bignum_logbitp(int shift, bignum * arg)
+{
+ return vm->bignum_logbitp(shift,arg);
+}
+
+int factorvm::bignum_unsigned_logbitp(int shift, bignum * bignum)
{
bignum_length_type len = (BIGNUM_LENGTH (bignum));
int index = shift / BIGNUM_DIGIT_LENGTH;
@@ -1880,12 +1974,13 @@ bignum_unsigned_logbitp(int shift, bignum * bignum)
return (digit & mask) ? 1 : 0;
}
+int bignum_unsigned_logbitp(int shift, bignum * bignum)
+{
+ return vm->bignum_unsigned_logbitp(shift,bignum);
+}
+
/* Allocates memory */
-bignum *
-digit_stream_to_bignum(unsigned int n_digits,
- unsigned int (*producer)(unsigned int),
- unsigned int radix,
- int negative_p)
+bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p)
{
BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
if (n_digits == 0)
@@ -1921,4 +2016,9 @@ digit_stream_to_bignum(unsigned int n_digits,
}
}
+bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p)
+{
+ return vm->digit_stream_to_bignum(n_digits,producer,radix,negative_p);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 88cea40245..17a62fb0af 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -76,11 +76,45 @@ struct factorvm {
bignum *bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p);
void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
- void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
+ void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator,
+ bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q);
- bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start);
- void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end,
+ bignum_digit_type guess, bignum_digit_type * u_start);
+ void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator,
+ bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left);
+ void bignum_destructive_unnormalization(bignum * bignum, int shift_right);
+ bignum_digit_type bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
+ bignum_digit_type v, bignum_digit_type * q) /* return value */;
+ bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
+ bignum_digit_type guess, bignum_digit_type * u);
+ void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator,
+ bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ bignum_digit_type bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator);
+ bignum * bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p);
+ bignum *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p);
+ bignum *allot_bignum(bignum_length_type length, int negative_p);
+ bignum * allot_bignum_zeroed(bignum_length_type length, int negative_p);
+ bignum *bignum_shorten_length(bignum * bignum, bignum_length_type length);
+ bignum *bignum_trim(bignum * bignum);
+ bignum *bignum_new_sign(bignum * x, int negative_p);
+ bignum *bignum_maybe_new_sign(bignum * x, int negative_p);
+ void bignum_destructive_copy(bignum * source, bignum * target);
+ bignum *bignum_bitwise_not(bignum * x);
+ bignum *bignum_arithmetic_shift(bignum * arg1, fixnum n);
+ bignum *bignum_bitwise_and(bignum * arg1, bignum * arg2);
+ bignum *bignum_bitwise_ior(bignum * arg1, bignum * arg2);
+ bignum *bignum_bitwise_xor(bignum * arg1, bignum * arg2);
+ bignum *bignum_magnitude_ash(bignum * arg1, fixnum n);
+ bignum *bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2);
+ bignum *bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2);
+ bignum *bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2);
+ void bignum_negate_magnitude(bignum * arg);
+ bignum *bignum_integer_length(bignum * x);
+ int bignum_logbitp(int shift, bignum * arg);
+ int bignum_unsigned_logbitp(int shift, bignum * bignum);
+ bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p);
// next method here:
};
From 9f6f7adaba0e0e944d0d082f9f1a7287004071c8 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:05 +0100
Subject: [PATCH 021/266] moved data_heap fns to vm struct
---
vm/data_heap.cpp | 182 ++++++++++++++++++++++++++++++++++++++---------
vm/vm.hpp | 27 +++++++
2 files changed, 177 insertions(+), 32 deletions(-)
mode change 100644 => 100755 vm/data_heap.cpp
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
old mode 100644
new mode 100755
index 5c1c8079c7..9069621e52
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -16,7 +16,7 @@ bool gc_off;
data_heap *data;
-cell init_zone(zone *z, cell size, cell start)
+cell factorvm::init_zone(zone *z, cell size, cell start)
{
z->size = size;
z->start = z->here = start;
@@ -24,7 +24,12 @@ cell init_zone(zone *z, cell size, cell start)
return z->end;
}
-void init_card_decks()
+cell init_zone(zone *z, cell size, cell start)
+{
+ return vm->init_zone(z,size,start);
+}
+
+void factorvm::init_card_decks()
{
cell start = align(data->seg->start,deck_size);
allot_markers_offset = (cell)data->allot_markers - (start >> card_bits);
@@ -32,10 +37,12 @@ void init_card_decks()
decks_offset = (cell)data->decks - (start >> deck_bits);
}
-data_heap *alloc_data_heap(cell gens,
- cell young_size,
- cell aging_size,
- cell tenured_size)
+void init_card_decks()
+{
+ return vm->init_card_decks();
+}
+
+data_heap *factorvm::alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size)
{
young_size = align(young_size,deck_size);
aging_size = align(aging_size,deck_size);
@@ -99,7 +106,12 @@ data_heap *alloc_data_heap(cell gens,
return data;
}
-data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
+data_heap *alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size)
+{
+ return vm->alloc_data_heap(gens,young_size,aging_size,tenured_size);
+}
+
+data_heap *factorvm::grow_data_heap(data_heap *data, cell requested_bytes)
{
cell new_tenured_size = (data->tenured_size * 2) + requested_bytes;
@@ -109,7 +121,12 @@ data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
new_tenured_size);
}
-void dealloc_data_heap(data_heap *data)
+data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
+{
+ return vm->grow_data_heap(data,requested_bytes);
+}
+
+void factorvm::dealloc_data_heap(data_heap *data)
{
dealloc_segment(data->seg);
free(data->generations);
@@ -120,7 +137,12 @@ void dealloc_data_heap(data_heap *data)
free(data);
}
-void clear_cards(cell from, cell to)
+void dealloc_data_heap(data_heap *data)
+{
+ return vm->dealloc_data_heap(data);
+}
+
+void factorvm::clear_cards(cell from, cell to)
{
/* NOTE: reverse order due to heap layout. */
card *first_card = addr_to_card(data->generations[to].start);
@@ -128,7 +150,12 @@ void clear_cards(cell from, cell to)
memset(first_card,0,last_card - first_card);
}
-void clear_decks(cell from, cell to)
+void clear_cards(cell from, cell to)
+{
+ return vm->clear_cards(from,to);
+}
+
+void factorvm::clear_decks(cell from, cell to)
{
/* NOTE: reverse order due to heap layout. */
card_deck *first_deck = addr_to_deck(data->generations[to].start);
@@ -136,7 +163,12 @@ void clear_decks(cell from, cell to)
memset(first_deck,0,last_deck - first_deck);
}
-void clear_allot_markers(cell from, cell to)
+void clear_decks(cell from, cell to)
+{
+ return vm->clear_decks(from,to);
+}
+
+void factorvm::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);
@@ -144,7 +176,12 @@ void clear_allot_markers(cell from, cell to)
memset(first_card,invalid_allot_marker,last_card - first_card);
}
-void reset_generation(cell i)
+void clear_allot_markers(cell from, cell to)
+{
+ return vm->clear_allot_markers(from,to);
+}
+
+void factorvm::reset_generation(cell i)
{
zone *z = (i == data->nursery() ? &nursery : &data->generations[i]);
@@ -153,9 +190,14 @@ void reset_generation(cell i)
memset((void*)z->start,69,z->size);
}
+void reset_generation(cell i)
+{
+ return vm->reset_generation(i);
+}
+
/* After garbage collection, any generations which are now empty need to have
their allocation pointers and cards reset. */
-void reset_generations(cell from, cell to)
+void factorvm::reset_generations(cell from, cell to)
{
cell i;
for(i = from; i <= to; i++)
@@ -166,7 +208,12 @@ void reset_generations(cell from, cell to)
clear_allot_markers(from,to);
}
-void set_data_heap(data_heap *data_)
+void reset_generations(cell from, cell to)
+{
+ return vm->reset_generations(from,to);
+}
+
+void factorvm::set_data_heap(data_heap *data_)
{
data = data_;
nursery = data->generations[data->nursery()];
@@ -176,17 +223,23 @@ void set_data_heap(data_heap *data_)
clear_allot_markers(data->nursery(),data->tenured());
}
-void init_data_heap(cell gens,
- cell young_size,
- cell aging_size,
- cell tenured_size,
- bool secure_gc_)
+void set_data_heap(data_heap *data_)
+{
+ return vm->set_data_heap(data_);
+}
+
+void factorvm::init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_)
{
set_data_heap(alloc_data_heap(gens,young_size,aging_size,tenured_size));
secure_gc = secure_gc_;
init_data_gc();
}
+void init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_)
+{
+ return vm->init_data_heap(gens,young_size,aging_size,tenured_size,secure_gc_);
+}
+
/* Size of the object pointed to by a tagged pointer */
cell object_size(cell tagged)
{
@@ -197,13 +250,18 @@ cell object_size(cell tagged)
}
/* Size of the object pointed to by an untagged pointer */
-cell untagged_object_size(object *pointer)
+cell factorvm::untagged_object_size(object *pointer)
{
return align8(unaligned_object_size(pointer));
}
+cell untagged_object_size(object *pointer)
+{
+ return vm->untagged_object_size(pointer);
+}
+
/* Size of the data area of an object pointed to by an untagged pointer */
-cell unaligned_object_size(object *pointer)
+cell factorvm::unaligned_object_size(object *pointer)
{
switch(pointer->h.hi_tag())
{
@@ -237,15 +295,25 @@ cell unaligned_object_size(object *pointer)
}
}
-PRIMITIVE(size)
+cell unaligned_object_size(object *pointer)
+{
+ return vm->unaligned_object_size(pointer);
+}
+
+inline void factorvm::vmprim_size()
{
box_unsigned_cell(object_size(dpop()));
}
+PRIMITIVE(size)
+{
+ PRIMITIVE_GETVM()->vmprim_size();
+}
+
/* The number of cells from the start of the object which should be scanned by
the GC. Some types have a binary payload at the end (string, word, DLL) which
we ignore. */
-cell binary_payload_start(object *pointer)
+cell factorvm::binary_payload_start(object *pointer)
{
switch(pointer->h.hi_tag())
{
@@ -279,8 +347,13 @@ cell binary_payload_start(object *pointer)
}
}
+cell binary_payload_start(object *pointer)
+{
+ return vm->binary_payload_start(pointer);
+}
+
/* Push memory usage statistics in data heap */
-PRIMITIVE(data_room)
+inline void factorvm::vmprim_data_room()
{
dpush(tag_fixnum((data->cards_end - data->cards) >> 10));
dpush(tag_fixnum((data->decks_end - data->decks) >> 10));
@@ -299,28 +372,48 @@ PRIMITIVE(data_room)
dpush(a.elements.value());
}
+PRIMITIVE(data_room)
+{
+ PRIMITIVE_GETVM()->vmprim_data_room();
+}
+
/* A heap walk allows useful things to be done, like finding all
references to an object for debugging purposes. */
cell heap_scan_ptr;
/* Disables GC and activates next-object ( -- obj ) primitive */
-void begin_scan()
+void factorvm::begin_scan()
{
heap_scan_ptr = data->generations[data->tenured()].start;
gc_off = true;
}
-void end_scan()
+void begin_scan()
+{
+ return vm->begin_scan();
+}
+
+void factorvm::end_scan()
{
gc_off = false;
}
-PRIMITIVE(begin_scan)
+void end_scan()
+{
+ return vm->end_scan();
+}
+
+inline void factorvm::vmprim_begin_scan()
{
begin_scan();
}
-cell next_object()
+PRIMITIVE(begin_scan)
+{
+ PRIMITIVE_GETVM()->vmprim_begin_scan();
+}
+
+cell factorvm::next_object()
{
if(!gc_off)
general_error(ERROR_HEAP_SCAN,F,F,NULL);
@@ -333,19 +426,34 @@ cell next_object()
return tag_dynamic(obj);
}
+cell next_object()
+{
+ return vm->next_object();
+}
+
/* Push object at heap scan cursor and advance; pushes f when done */
-PRIMITIVE(next_object)
+inline void factorvm::vmprim_next_object()
{
dpush(next_object());
}
+PRIMITIVE(next_object)
+{
+ PRIMITIVE_GETVM()->vmprim_next_object();
+}
+
/* Re-enables GC */
-PRIMITIVE(end_scan)
+inline void factorvm::vmprim_end_scan()
{
gc_off = false;
}
-template<typename T> void each_object(T &functor)
+PRIMITIVE(end_scan)
+{
+ PRIMITIVE_GETVM()->vmprim_end_scan();
+}
+
+template<typename T> void factorvm::each_object(T &functor)
{
begin_scan();
cell obj;
@@ -354,6 +462,11 @@ template<typename T> void each_object(T &functor)
end_scan();
}
+template<typename T> void each_object(T &functor)
+{
+ return vm->each_object(functor);
+}
+
namespace
{
@@ -371,7 +484,7 @@ struct word_accumulator {
}
-cell find_all_words()
+cell factorvm::find_all_words()
{
word_counter counter;
each_object(counter);
@@ -381,4 +494,9 @@ cell find_all_words()
return accum.words.elements.value();
}
+cell find_all_words()
+{
+ return vm->find_all_words();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 17a62fb0af..8ec5c7d094 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -115,6 +115,33 @@ struct factorvm {
int bignum_logbitp(int shift, bignum * arg);
int bignum_unsigned_logbitp(int shift, bignum * bignum);
bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p);
+
+ //data_heap
+ cell init_zone(zone *z, cell size, cell start);
+ void init_card_decks();
+ data_heap *alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size);
+ data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
+ void dealloc_data_heap(data_heap *data);
+ void clear_cards(cell from, cell to);
+ void clear_decks(cell from, cell to);
+ void clear_allot_markers(cell from, cell to);
+ void reset_generation(cell i);
+ void reset_generations(cell from, cell to);
+ void set_data_heap(data_heap *data_);
+ void init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_);
+ cell untagged_object_size(object *pointer);
+ cell unaligned_object_size(object *pointer);
+ inline void vmprim_size();
+ cell binary_payload_start(object *pointer);
+ inline void vmprim_data_room();
+ void begin_scan();
+ void end_scan();
+ inline void vmprim_begin_scan();
+ cell next_object();
+ inline void vmprim_next_object();
+ inline void vmprim_end_scan();
+ template<typename T> void each_object(T &functor);
+ cell find_all_words();
// next method here:
};
From 64c2d813061566e4226b8a13313ccf38def63d26 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:05 +0100
Subject: [PATCH 022/266] moved data_gc fns over to vm struct
---
vm/data_gc.cpp | 205 +++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 32 ++++++++
2 files changed, 206 insertions(+), 31 deletions(-)
mode change 100644 => 100755 vm/data_gc.cpp
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
old mode 100644
new mode 100755
index 458a437e37..ea7100fc02
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -33,15 +33,20 @@ cell last_code_heap_scan;
bool growing_data_heap;
data_heap *old_data_heap;
-void init_data_gc()
+void factorvm::init_data_gc()
{
performing_gc = false;
last_code_heap_scan = data->nursery();
collecting_aging_again = false;
}
+void init_data_gc()
+{
+ return vm->init_data_gc();
+}
+
/* Given a pointer to oldspace, copy it to newspace */
-static object *copy_untagged_object_impl(object *pointer, cell size)
+object *factorvm::copy_untagged_object_impl(object *pointer, cell size)
{
if(newspace->here + size >= newspace->end)
longjmp(gc_jmp,1);
@@ -55,14 +60,24 @@ static object *copy_untagged_object_impl(object *pointer, cell size)
return newpointer;
}
-static object *copy_object_impl(object *untagged)
+object *copy_untagged_object_impl(object *pointer, cell size)
+{
+ return vm->copy_untagged_object_impl(pointer,size);
+}
+
+object *factorvm::copy_object_impl(object *untagged)
{
object *newpointer = copy_untagged_object_impl(untagged,untagged_object_size(untagged));
untagged->h.forward_to(newpointer);
return newpointer;
}
-static bool should_copy_p(object *untagged)
+object *copy_object_impl(object *untagged)
+{
+ return vm->copy_object_impl(untagged);
+}
+
+bool factorvm::should_copy_p(object *untagged)
{
if(in_zone(newspace,untagged))
return false;
@@ -79,8 +94,13 @@ static bool should_copy_p(object *untagged)
}
}
+bool should_copy_p(object *untagged)
+{
+ return vm->should_copy_p(untagged);
+}
+
/* Follow a chain of forwarding pointers */
-static object *resolve_forwarding(object *untagged)
+object *factorvm::resolve_forwarding(object *untagged)
{
check_data_pointer(untagged);
@@ -98,7 +118,12 @@ static object *resolve_forwarding(object *untagged)
}
}
-template <typename T> static T *copy_untagged_object(T *untagged)
+object *resolve_forwarding(object *untagged)
+{
+ return vm->resolve_forwarding(untagged);
+}
+
+template <typename T> T *factorvm::copy_untagged_object(T *untagged)
{
check_data_pointer(untagged);
@@ -113,12 +138,22 @@ template <typename T> static T *copy_untagged_object(T *untagged)
return untagged;
}
-static cell copy_object(cell pointer)
+template <typename T> T *copy_untagged_object(T *untagged)
+{
+ return vm->copy_untagged_object(untagged);
+}
+
+cell factorvm::copy_object(cell pointer)
{
return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer));
}
-void copy_handle(cell *handle)
+cell copy_object(cell pointer)
+{
+ return vm->copy_object(pointer);
+}
+
+void factorvm::copy_handle(cell *handle)
{
cell pointer = *handle;
@@ -131,8 +166,13 @@ void copy_handle(cell *handle)
}
}
+void copy_handle(cell *handle)
+{
+ return vm->copy_handle(handle);
+}
+
/* Scan all the objects in the card */
-static void copy_card(card *ptr, cell gen, cell here)
+void factorvm::copy_card(card *ptr, cell gen, cell here)
{
cell card_scan = card_to_addr(ptr) + card_offset(ptr);
cell card_end = card_to_addr(ptr + 1);
@@ -145,7 +185,12 @@ static void copy_card(card *ptr, cell gen, cell here)
cards_scanned++;
}
-static void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
+void copy_card(card *ptr, cell gen, cell here)
+{
+ return vm->copy_card(ptr,gen,here);
+}
+
+void factorvm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
{
card *first_card = deck_to_card(deck);
card *last_card = deck_to_card(deck + 1);
@@ -176,8 +221,13 @@ static void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
decks_scanned++;
}
+void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
+{
+ return vm->copy_card_deck(deck,gen,mask,unmask);
+}
+
/* Copy all newspace objects referenced from marked cards to the destination */
-static void copy_gen_cards(cell gen)
+void factorvm::copy_gen_cards(cell gen)
{
card_deck *first_deck = addr_to_deck(data->generations[gen].start);
card_deck *last_deck = addr_to_deck(data->generations[gen].end);
@@ -242,9 +292,14 @@ static void copy_gen_cards(cell gen)
}
}
+void copy_gen_cards(cell gen)
+{
+ return vm->copy_gen_cards(gen);
+}
+
/* Scan cards in all generations older than the one being collected, copying
old->new references */
-static void copy_cards()
+void factorvm::copy_cards()
{
u64 start = current_micros();
@@ -255,8 +310,13 @@ static void copy_cards()
card_scan_time += (current_micros() - start);
}
+void copy_cards()
+{
+ return vm->copy_cards();
+}
+
/* Copy all tagged pointers in a range of memory */
-static void copy_stack_elements(segment *region, cell top)
+void factorvm::copy_stack_elements(segment *region, cell top)
{
cell ptr = region->start;
@@ -264,7 +324,12 @@ static void copy_stack_elements(segment *region, cell top)
copy_handle((cell*)ptr);
}
-static void copy_registered_locals()
+void copy_stack_elements(segment *region, cell top)
+{
+ return vm->copy_stack_elements(region,top);
+}
+
+void factorvm::copy_registered_locals()
{
std::vector<cell>::const_iterator iter = gc_locals.begin();
std::vector<cell>::const_iterator end = gc_locals.end();
@@ -273,7 +338,12 @@ static void copy_registered_locals()
copy_handle((cell *)(*iter));
}
-static void copy_registered_bignums()
+void copy_registered_locals()
+{
+ return vm->copy_registered_locals();
+}
+
+void factorvm::copy_registered_bignums()
{
std::vector<cell>::const_iterator iter = gc_bignums.begin();
std::vector<cell>::const_iterator end = gc_bignums.end();
@@ -295,9 +365,14 @@ static void copy_registered_bignums()
}
}
+void copy_registered_bignums()
+{
+ return vm->copy_registered_bignums();
+}
+
/* Copy roots over at the start of GC, namely various constants, stacks,
the user environment and extra roots registered by local_roots.hpp */
-static void copy_roots()
+void factorvm::copy_roots()
{
copy_handle(&T);
copy_handle(&bignum_zero);
@@ -331,7 +406,12 @@ static void copy_roots()
copy_handle(&userenv[i]);
}
-static cell copy_next_from_nursery(cell scan)
+void copy_roots()
+{
+ return vm->copy_roots();
+}
+
+cell factorvm::copy_next_from_nursery(cell scan)
{
cell *obj = (cell *)scan;
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
@@ -359,7 +439,12 @@ static cell copy_next_from_nursery(cell scan)
return scan + untagged_object_size((object *)scan);
}
-static cell copy_next_from_aging(cell scan)
+cell copy_next_from_nursery(cell scan)
+{
+ return vm->copy_next_from_nursery(scan);
+}
+
+cell factorvm::copy_next_from_aging(cell scan)
{
cell *obj = (cell *)scan;
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
@@ -391,7 +476,12 @@ static cell copy_next_from_aging(cell scan)
return scan + untagged_object_size((object *)scan);
}
-static cell copy_next_from_tenured(cell scan)
+cell copy_next_from_aging(cell scan)
+{
+ return vm->copy_next_from_aging(scan);
+}
+
+cell factorvm::copy_next_from_tenured(cell scan)
{
cell *obj = (cell *)scan;
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
@@ -421,7 +511,12 @@ static cell copy_next_from_tenured(cell scan)
return scan + untagged_object_size((object *)scan);
}
-void copy_reachable_objects(cell scan, cell *end)
+cell copy_next_from_tenured(cell scan)
+{
+ return vm->copy_next_from_tenured(scan);
+}
+
+void factorvm::copy_reachable_objects(cell scan, cell *end)
{
if(collecting_gen == data->nursery())
{
@@ -440,8 +535,13 @@ void copy_reachable_objects(cell scan, cell *end)
}
}
+void copy_reachable_objects(cell scan, cell *end)
+{
+ return vm->copy_reachable_objects(scan,end);
+}
+
/* Prepare to start copying reachable objects into an unused zone */
-static void begin_gc(cell requested_bytes)
+void factorvm::begin_gc(cell requested_bytes)
{
if(growing_data_heap)
{
@@ -474,7 +574,12 @@ static void begin_gc(cell requested_bytes)
}
}
-static void end_gc(cell gc_elapsed)
+void begin_gc(cell requested_bytes)
+{
+ return vm->begin_gc(requested_bytes);
+}
+
+void factorvm::end_gc(cell gc_elapsed)
{
gc_stats *s = &stats[collecting_gen];
@@ -512,12 +617,15 @@ static void end_gc(cell gc_elapsed)
collecting_aging_again = false;
}
+void end_gc(cell gc_elapsed)
+{
+ return vm->end_gc(gc_elapsed);
+}
+
/* Collect gen and all younger generations.
If growing_data_heap_ is true, we must grow the data heap to such a size that
an allocation of requested_bytes won't fail */
-void garbage_collection(cell gen,
- bool growing_data_heap_,
- cell requested_bytes)
+void factorvm::garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes)
{
if(gc_off)
{
@@ -595,17 +703,32 @@ void garbage_collection(cell gen,
performing_gc = false;
}
-void gc()
+void garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes)
+{
+ return vm->garbage_collection(gen,growing_data_heap_,requested_bytes);
+}
+
+void factorvm::gc()
{
garbage_collection(data->tenured(),false,0);
}
-PRIMITIVE(gc)
+void gc()
+{
+ return vm->gc();
+}
+
+inline void factorvm::vmprim_gc()
{
gc();
}
-PRIMITIVE(gc_stats)
+PRIMITIVE(gc)
+{
+ PRIMITIVE_GETVM()->vmprim_gc();
+}
+
+inline void factorvm::vmprim_gc_stats()
{
growable_array result;
@@ -635,7 +758,12 @@ PRIMITIVE(gc_stats)
dpush(result.elements.value());
}
-void clear_gc_stats()
+PRIMITIVE(gc_stats)
+{
+ PRIMITIVE_GETVM()->vmprim_gc_stats();
+}
+
+void factorvm::clear_gc_stats()
{
for(cell i = 0; i < max_gen_count; i++)
memset(&stats[i],0,sizeof(gc_stats));
@@ -646,6 +774,11 @@ void clear_gc_stats()
code_heap_scans = 0;
}
+void clear_gc_stats()
+{
+ return vm->clear_gc_stats();
+}
+
PRIMITIVE(clear_gc_stats)
{
clear_gc_stats();
@@ -653,7 +786,7 @@ PRIMITIVE(clear_gc_stats)
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
to coalesce equal but distinct quotations and wrappers. */
-PRIMITIVE(become)
+inline void factorvm::vmprim_become()
{
array *new_objects = untag_check<array>(dpop());
array *old_objects = untag_check<array>(dpop());
@@ -682,7 +815,12 @@ PRIMITIVE(become)
compile_all_words();
}
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
+PRIMITIVE(become)
+{
+ PRIMITIVE_GETVM()->vmprim_become();
+}
+
+VM_ASM_API void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
{
for(cell i = 0; i < gc_roots_size; i++)
gc_locals.push_back((cell)&gc_roots_base[i]);
@@ -693,4 +831,9 @@ VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
gc_locals.pop_back();
}
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
+{
+ return vm->inline_gc(gc_roots_base,gc_roots_size);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8ec5c7d094..5750d434c6 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -142,8 +142,40 @@ struct factorvm {
inline void vmprim_end_scan();
template<typename T> void each_object(T &functor);
cell find_all_words();
+
+ //data_gc
+ void init_data_gc();
+ object *copy_untagged_object_impl(object *pointer, cell size);
+ object *copy_object_impl(object *untagged);
+ bool should_copy_p(object *untagged);
+ object *resolve_forwarding(object *untagged);
+ template <typename T> T *copy_untagged_object(T *untagged);
+ cell copy_object(cell pointer);
+ void copy_handle(cell *handle);
+ void copy_card(card *ptr, cell gen, cell here);
+ void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask);
+ void copy_gen_cards(cell gen);
+ void copy_cards();
+ void copy_stack_elements(segment *region, cell top);
+ void copy_registered_locals();
+ void copy_registered_bignums();
+ void copy_roots();
+ cell copy_next_from_nursery(cell scan);
+ cell copy_next_from_aging(cell scan);
+ cell copy_next_from_tenured(cell scan);
+ void copy_reachable_objects(cell scan, cell *end);
+ void begin_gc(cell requested_bytes);
+ void end_gc(cell gc_elapsed);
+ void garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes);
+ void gc();
+ inline void vmprim_gc();
+ inline void vmprim_gc_stats();
+ void clear_gc_stats();
+ inline void vmprim_become();
+ void inline_gc(cell *gc_roots_base, cell gc_roots_size);
// next method here:
+
};
extern factorvm *vm;
From 13e0ae6d97388b332801ee452d8e831c45a2e211 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:06 +0100
Subject: [PATCH 023/266] moved debug functions into vm struct
---
vm/debug.cpp | 158 +++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 24 ++++++++
2 files changed, 158 insertions(+), 24 deletions(-)
mode change 100644 => 100755 vm/debug.cpp
diff --git a/vm/debug.cpp b/vm/debug.cpp
old mode 100644
new mode 100755
index 5f78afb9db..870c817a2b
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -6,14 +6,19 @@ namespace factor
static bool fep_disabled;
static bool full_output;
-void print_chars(string* str)
+void factorvm::print_chars(string* str)
{
cell i;
for(i = 0; i < string_capacity(str); i++)
putchar(string_nth(str,i));
}
-void print_word(word* word, cell nesting)
+void print_chars(string* str)
+{
+ return vm->print_chars(str);
+}
+
+void factorvm::print_word(word* word, cell nesting)
{
if(tagged<object>(word->vocabulary).type_p(STRING_TYPE))
{
@@ -31,14 +36,24 @@ void print_word(word* word, cell nesting)
}
}
-void print_factor_string(string* str)
+void print_word(word* word, cell nesting)
+{
+ return vm->print_word(word,nesting);
+}
+
+void factorvm::print_factor_string(string* str)
{
putchar('"');
print_chars(str);
putchar('"');
}
-void print_array(array* array, cell nesting)
+void print_factor_string(string* str)
+{
+ return vm->print_factor_string(str);
+}
+
+void factorvm::print_array(array* array, cell nesting)
{
cell length = array_capacity(array);
cell i;
@@ -62,7 +77,12 @@ void print_array(array* array, cell nesting)
print_string("...");
}
-void print_tuple(tuple *tuple, cell nesting)
+void print_array(array* array, cell nesting)
+{
+ return vm->print_array(array,nesting);
+}
+
+void factorvm::print_tuple(tuple *tuple, cell nesting)
{
tuple_layout *layout = untag<tuple_layout>(tuple->layout);
cell length = to_fixnum(layout->size);
@@ -91,7 +111,12 @@ void print_tuple(tuple *tuple, cell nesting)
print_string("...");
}
-void print_nested_obj(cell obj, fixnum nesting)
+void print_tuple(tuple *tuple, cell nesting)
+{
+ return vm->print_tuple(tuple,nesting);
+}
+
+void factorvm::print_nested_obj(cell obj, fixnum nesting)
{
if(nesting <= 0 && !full_output)
{
@@ -141,12 +166,22 @@ void print_nested_obj(cell obj, fixnum nesting)
}
}
-void print_obj(cell obj)
+void print_nested_obj(cell obj, fixnum nesting)
+{
+ return vm->print_nested_obj(obj,nesting);
+}
+
+void factorvm::print_obj(cell obj)
{
print_nested_obj(obj,10);
}
-void print_objects(cell *start, cell *end)
+void print_obj(cell obj)
+{
+ return vm->print_obj(obj);
+}
+
+void factorvm::print_objects(cell *start, cell *end)
{
for(; start <= end; start++)
{
@@ -155,19 +190,34 @@ void print_objects(cell *start, cell *end)
}
}
-void print_datastack()
+void print_objects(cell *start, cell *end)
+{
+ return vm->print_objects(start,end);
+}
+
+void factorvm::print_datastack()
{
print_string("==== DATA STACK:\n");
print_objects((cell *)ds_bot,(cell *)ds);
}
-void print_retainstack()
+void print_datastack()
+{
+ return vm->print_datastack();
+}
+
+void factorvm::print_retainstack()
{
print_string("==== RETAIN STACK:\n");
print_objects((cell *)rs_bot,(cell *)rs);
}
-void print_stack_frame(stack_frame *frame)
+void print_retainstack()
+{
+ return vm->print_retainstack();
+}
+
+void factorvm::print_stack_frame(stack_frame *frame)
{
print_obj(frame_executing(frame));
print_string("\n");
@@ -184,15 +234,25 @@ void print_stack_frame(stack_frame *frame)
print_string("\n");
}
-void print_callstack()
+void print_stack_frame(stack_frame *frame)
+{
+ return vm->print_stack_frame(frame);
+}
+
+void factorvm::print_callstack()
{
print_string("==== CALL STACK:\n");
cell bottom = (cell)stack_chain->callstack_bottom;
cell top = (cell)stack_chain->callstack_top;
- iterate_callstack(top,bottom,print_stack_frame);
+ iterate_callstack(top,bottom,factor::print_stack_frame);
}
-void dump_cell(cell x)
+void print_callstack()
+{
+ return vm->print_callstack();
+}
+
+void factorvm::dump_cell(cell x)
{
print_cell_hex_pad(x); print_string(": ");
x = *(cell *)x;
@@ -200,7 +260,12 @@ void dump_cell(cell x)
nl();
}
-void dump_memory(cell from, cell to)
+void dump_cell(cell x)
+{
+ return vm->dump_cell(x);
+}
+
+void factorvm::dump_memory(cell from, cell to)
{
from = UNTAG(from);
@@ -208,14 +273,24 @@ void dump_memory(cell from, cell to)
dump_cell(from);
}
-void dump_zone(zone *z)
+void dump_memory(cell from, cell to)
+{
+ return vm->dump_memory(from,to);
+}
+
+void factorvm::dump_zone(zone *z)
{
print_string("Start="); print_cell(z->start);
print_string(", size="); print_cell(z->size);
print_string(", here="); print_cell(z->here - z->start); nl();
}
-void dump_generations()
+void dump_zone(zone *z)
+{
+ return vm->dump_zone(z);
+}
+
+void factorvm::dump_generations()
{
cell i;
@@ -241,7 +316,12 @@ void dump_generations()
nl();
}
-void dump_objects(cell type)
+void dump_generations()
+{
+ return vm->dump_generations();
+}
+
+void factorvm::dump_objects(cell type)
{
gc();
begin_scan();
@@ -261,10 +341,15 @@ void dump_objects(cell type)
end_scan();
}
+void dump_objects(cell type)
+{
+ return vm->dump_objects(type);
+}
+
cell look_for;
cell obj;
-void find_data_references_step(cell *scan)
+void factorvm::find_data_references_step(cell *scan)
{
if(look_for == *scan)
{
@@ -275,20 +360,30 @@ void find_data_references_step(cell *scan)
}
}
-void find_data_references(cell look_for_)
+void find_data_references_step(cell *scan)
+{
+ return vm->find_data_references_step(scan);
+}
+
+void factorvm::find_data_references(cell look_for_)
{
look_for = look_for_;
begin_scan();
while((obj = next_object()) != F)
- do_slots(UNTAG(obj),find_data_references_step);
+ do_slots(UNTAG(obj),factor::find_data_references_step);
end_scan();
}
+void find_data_references(cell look_for_)
+{
+ return vm->find_data_references(look_for_);
+}
+
/* Dump all code blocks for debugging */
-void dump_code_heap()
+void factorvm::dump_code_heap()
{
cell reloc_size = 0, literal_size = 0;
@@ -328,7 +423,12 @@ void dump_code_heap()
print_cell(literal_size); print_string(" bytes of literal data\n");
}
-void factorbug()
+void dump_code_heap()
+{
+ return vm->dump_code_heap();
+}
+
+void factorvm::factorbug()
{
if(fep_disabled)
{
@@ -472,11 +572,21 @@ void factorbug()
}
}
-PRIMITIVE(die)
+void factorbug()
+{
+ return vm->factorbug();
+}
+
+inline void factorvm::vmprim_die()
{
print_string("The die word was called by the library. Unless you called it yourself,\n");
print_string("you have triggered a bug in Factor. Please report.\n");
factorbug();
}
+PRIMITIVE(die)
+{
+ PRIMITIVE_GETVM()->vmprim_die();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 5750d434c6..6a4b85012a 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -173,6 +173,30 @@ struct factorvm {
void clear_gc_stats();
inline void vmprim_become();
void inline_gc(cell *gc_roots_base, cell gc_roots_size);
+
+ //debug
+ void print_chars(string* str);
+ void print_word(word* word, cell nesting);
+ void print_factor_string(string* str);
+ void print_array(array* array, cell nesting);
+ void print_tuple(tuple *tuple, cell nesting);
+ void print_nested_obj(cell obj, fixnum nesting);
+ void print_obj(cell obj);
+ void print_objects(cell *start, cell *end);
+ void print_datastack();
+ void print_retainstack();
+ void print_stack_frame(stack_frame *frame);
+ void print_callstack();
+ void dump_cell(cell x);
+ void dump_memory(cell from, cell to);
+ void dump_zone(zone *z);
+ void dump_generations();
+ void dump_objects(cell type);
+ void find_data_references_step(cell *scan);
+ void find_data_references(cell look_for_);
+ void dump_code_heap();
+ void factorbug();
+ inline void vmprim_die();
// next method here:
From 72098c5f6a2a3011e9d496018cf18a7a7967c45e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:06 +0100
Subject: [PATCH 024/266] moved arrays fns into vm
---
vm/arrays.cpp | 42 ++++++++++++++++++++++++++++++++++++------
vm/vm.hpp | 8 ++++++++
2 files changed, 44 insertions(+), 6 deletions(-)
diff --git a/vm/arrays.cpp b/vm/arrays.cpp
index f9a3f211d0..236f2d9c54 100644
--- a/vm/arrays.cpp
+++ b/vm/arrays.cpp
@@ -4,7 +4,7 @@ namespace factor
{
/* make a new array with an initial element */
-array *allot_array(cell capacity, cell fill_)
+array *factorvm::allot_array(cell capacity, cell fill_)
{
gc_root<object> fill(fill_);
gc_root<array> new_array(allot_array_internal<array>(capacity));
@@ -23,15 +23,25 @@ array *allot_array(cell capacity, cell fill_)
return new_array.untagged();
}
+array *allot_array(cell capacity, cell fill_)
+{
+ return vm->allot_array(capacity,fill_);
+}
+
/* push a new array on the stack */
-PRIMITIVE(array)
+inline void factorvm::vmprim_array()
{
cell initial = dpop();
cell size = unbox_array_size();
dpush(tag<array>(allot_array(size,initial)));
}
-cell allot_array_1(cell obj_)
+PRIMITIVE(array)
+{
+ PRIMITIVE_GETVM()->vmprim_array();
+}
+
+cell factorvm::allot_array_1(cell obj_)
{
gc_root<object> obj(obj_);
gc_root<array> a(allot_array_internal<array>(1));
@@ -39,7 +49,12 @@ cell allot_array_1(cell obj_)
return a.value();
}
-cell allot_array_2(cell v1_, cell v2_)
+cell allot_array_1(cell obj_)
+{
+ return vm->allot_array_1(obj_);
+}
+
+cell factorvm::allot_array_2(cell v1_, cell v2_)
{
gc_root<object> v1(v1_);
gc_root<object> v2(v2_);
@@ -49,7 +64,12 @@ cell allot_array_2(cell v1_, cell v2_)
return a.value();
}
-cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
+cell allot_array_2(cell v1_, cell v2_)
+{
+ return vm->allot_array_2(v1_,v2_);
+}
+
+cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
{
gc_root<object> v1(v1_);
gc_root<object> v2(v2_);
@@ -63,13 +83,23 @@ cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
return a.value();
}
-PRIMITIVE(resize_array)
+cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
+{
+ return vm->allot_array_4(v1_,v2_,v3_,v4_);
+}
+
+inline void factorvm::vmprim_resize_array()
{
array* a = untag_check<array>(dpop());
cell capacity = unbox_array_size();
dpush(tag<array>(reallot_array(a,capacity)));
}
+PRIMITIVE(resize_array)
+{
+ PRIMITIVE_GETVM()->vmprim_resize_array();
+}
+
void growable_array::add(cell elt_)
{
gc_root<object> elt(elt_);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 6a4b85012a..65fea6f9f2 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -197,6 +197,14 @@ struct factorvm {
void dump_code_heap();
void factorbug();
inline void vmprim_die();
+
+ //arrays
+ array *allot_array(cell capacity, cell fill_);
+ inline void vmprim_array();
+ cell allot_array_1(cell obj_);
+ cell allot_array_2(cell v1_, cell v2_);
+ cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
+ inline void vmprim_resize_array();
// next method here:
From 0f2a89cfbd50e6fb4c3fa8728b79d5d14209d165 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:06 +0100
Subject: [PATCH 025/266] moved strings fns to vm
---
vm/strings.cpp | 98 ++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 16 +++++++++
2 files changed, 100 insertions(+), 14 deletions(-)
diff --git a/vm/strings.cpp b/vm/strings.cpp
index c70d9dfb6d..7e0506a519 100644
--- a/vm/strings.cpp
+++ b/vm/strings.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-cell string_nth(string* str, cell index)
+cell factorvm::string_nth(string* str, cell index)
{
/* If high bit is set, the most significant 16 bits of the char
come from the aux vector. The least significant bit of the
@@ -22,12 +22,22 @@ cell string_nth(string* str, cell index)
}
}
-void set_string_nth_fast(string *str, cell index, cell ch)
+cell string_nth(string* str, cell index)
+{
+ return vm->string_nth(str,index);
+}
+
+void factorvm::set_string_nth_fast(string *str, cell index, cell ch)
{
str->data()[index] = ch;
}
-void set_string_nth_slow(string *str_, cell index, cell ch)
+void set_string_nth_fast(string *str, cell index, cell ch)
+{
+ return vm->set_string_nth_fast(str,index,ch);
+}
+
+void factorvm::set_string_nth_slow(string *str_, cell index, cell ch)
{
gc_root<string> str(str_);
@@ -54,8 +64,13 @@ void set_string_nth_slow(string *str_, cell index, cell ch)
aux->data<u16>()[index] = ((ch >> 7) ^ 1);
}
+void set_string_nth_slow(string *str_, cell index, cell ch)
+{
+ return vm->set_string_nth_slow(str_,index,ch);
+}
+
/* allocates memory */
-void set_string_nth(string *str, cell index, cell ch)
+void factorvm::set_string_nth(string *str, cell index, cell ch)
{
if(ch <= 0x7f)
set_string_nth_fast(str,index,ch);
@@ -63,8 +78,13 @@ void set_string_nth(string *str, cell index, cell ch)
set_string_nth_slow(str,index,ch);
}
+void set_string_nth(string *str, cell index, cell ch)
+{
+ return vm->set_string_nth(str,index,ch);
+}
+
/* Allocates memory */
-string *allot_string_internal(cell capacity)
+string *factorvm::allot_string_internal(cell capacity)
{
string *str = allot<string>(string_size(capacity));
@@ -75,8 +95,13 @@ string *allot_string_internal(cell capacity)
return str;
}
+string *allot_string_internal(cell capacity)
+{
+ return vm->allot_string_internal(capacity);
+}
+
/* Allocates memory */
-void fill_string(string *str_, cell start, cell capacity, cell fill)
+void factorvm::fill_string(string *str_, cell start, cell capacity, cell fill)
{
gc_root<string> str(str_);
@@ -91,29 +116,49 @@ void fill_string(string *str_, cell start, cell capacity, cell fill)
}
}
+void fill_string(string *str_, cell start, cell capacity, cell fill)
+{
+ return vm->fill_string(str_,start,capacity,fill);
+}
+
/* Allocates memory */
-string *allot_string(cell capacity, cell fill)
+string *factorvm::allot_string(cell capacity, cell fill)
{
gc_root<string> str(allot_string_internal(capacity));
fill_string(str.untagged(),0,capacity,fill);
return str.untagged();
}
-PRIMITIVE(string)
+string *allot_string(cell capacity, cell fill)
+{
+ return vm->allot_string(capacity,fill);
+}
+
+inline void factorvm::vmprim_string()
{
cell initial = to_cell(dpop());
cell length = unbox_array_size();
dpush(tag<string>(allot_string(length,initial)));
}
-static bool reallot_string_in_place_p(string *str, cell capacity)
+PRIMITIVE(string)
+{
+ PRIMITIVE_GETVM()->vmprim_string();
+}
+
+bool factorvm::reallot_string_in_place_p(string *str, cell capacity)
{
return in_zone(&nursery,str)
&& (str->aux == F || in_zone(&nursery,untag<byte_array>(str->aux)))
&& capacity <= string_capacity(str);
}
-string* reallot_string(string *str_, cell capacity)
+bool reallot_string_in_place_p(string *str, cell capacity)
+{
+ return vm->reallot_string_in_place_p(str,capacity);
+}
+
+string* factorvm::reallot_string(string *str_, cell capacity)
{
gc_root<string> str(str_);
@@ -155,21 +200,36 @@ string* reallot_string(string *str_, cell capacity)
}
}
-PRIMITIVE(resize_string)
+string* reallot_string(string *str_, cell capacity)
+{
+ return vm->reallot_string(str_,capacity);
+}
+
+inline void factorvm::vmprim_resize_string()
{
string* str = untag_check<string>(dpop());
cell capacity = unbox_array_size();
dpush(tag<string>(reallot_string(str,capacity)));
}
-PRIMITIVE(string_nth)
+PRIMITIVE(resize_string)
+{
+ PRIMITIVE_GETVM()->vmprim_resize_string();
+}
+
+inline void factorvm::vmprim_string_nth()
{
string *str = untag<string>(dpop());
cell index = untag_fixnum(dpop());
dpush(tag_fixnum(string_nth(str,index)));
}
-PRIMITIVE(set_string_nth_fast)
+PRIMITIVE(string_nth)
+{
+ PRIMITIVE_GETVM()->vmprim_string_nth();
+}
+
+inline void factorvm::vmprim_set_string_nth_fast()
{
string *str = untag<string>(dpop());
cell index = untag_fixnum(dpop());
@@ -177,7 +237,12 @@ PRIMITIVE(set_string_nth_fast)
set_string_nth_fast(str,index,value);
}
-PRIMITIVE(set_string_nth_slow)
+PRIMITIVE(set_string_nth_fast)
+{
+ PRIMITIVE_GETVM()->vmprim_set_string_nth_fast();
+}
+
+inline void factorvm::vmprim_set_string_nth_slow()
{
string *str = untag<string>(dpop());
cell index = untag_fixnum(dpop());
@@ -185,4 +250,9 @@ PRIMITIVE(set_string_nth_slow)
set_string_nth_slow(str,index,value);
}
+PRIMITIVE(set_string_nth_slow)
+{
+ PRIMITIVE_GETVM()->vmprim_set_string_nth_slow();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 65fea6f9f2..087e1ebe95 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -205,6 +205,22 @@ struct factorvm {
cell allot_array_2(cell v1_, cell v2_);
cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
inline void vmprim_resize_array();
+
+ //strings
+ cell string_nth(string* str, cell index);
+ void set_string_nth_fast(string *str, cell index, cell ch);
+ void set_string_nth_slow(string *str_, cell index, cell ch);
+ void set_string_nth(string *str, cell index, cell ch);
+ string *allot_string_internal(cell capacity);
+ void fill_string(string *str_, cell start, cell capacity, cell fill);
+ string *allot_string(cell capacity, cell fill);
+ inline void vmprim_string();
+ bool reallot_string_in_place_p(string *str, cell capacity);
+ string* reallot_string(string *str_, cell capacity);
+ inline void vmprim_resize_string();
+ inline void vmprim_string_nth();
+ inline void vmprim_set_string_nth_fast();
+ inline void vmprim_set_string_nth_slow();
// next method here:
From 25d0bb756f575b31971c6d06151dfacc5e681695 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:06 +0100
Subject: [PATCH 026/266] added boolean fns to vm
---
vm/booleans.cpp | 14 ++++++++++++--
vm/vm.hpp | 4 ++++
2 files changed, 16 insertions(+), 2 deletions(-)
diff --git a/vm/booleans.cpp b/vm/booleans.cpp
index 8407e10099..6a1bb79298 100644
--- a/vm/booleans.cpp
+++ b/vm/booleans.cpp
@@ -3,14 +3,24 @@
namespace factor
{
-VM_C_API void box_boolean(bool value)
+void factorvm::box_boolean(bool value)
{
dpush(value ? T : F);
}
-VM_C_API bool to_boolean(cell value)
+VM_C_API void box_boolean(bool value)
+{
+ return vm->box_boolean(value);
+}
+
+bool factorvm::to_boolean(cell value)
{
return value != F;
}
+VM_C_API bool to_boolean(cell value)
+{
+ return vm->to_boolean(value);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 087e1ebe95..fbdfe125d3 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -221,6 +221,10 @@ struct factorvm {
inline void vmprim_string_nth();
inline void vmprim_set_string_nth_fast();
inline void vmprim_set_string_nth_slow();
+
+ //booleans
+ void box_boolean(bool value);
+ bool to_boolean(cell value);
// next method here:
From fa46b90197f363c370bbce768c680664ff0f7a2d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:06 +0100
Subject: [PATCH 027/266] added byte_arrays fns to vm
---
vm/byte_arrays.cpp | 28 ++++++++++++++++++++++++----
vm/vm.hpp | 6 ++++++
2 files changed, 30 insertions(+), 4 deletions(-)
diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp
index 2eda3f33c4..495e5211a7 100644
--- a/vm/byte_arrays.cpp
+++ b/vm/byte_arrays.cpp
@@ -3,32 +3,52 @@
namespace factor
{
-byte_array *allot_byte_array(cell size)
+byte_array *factorvm::allot_byte_array(cell size)
{
byte_array *array = allot_array_internal<byte_array>(size);
memset(array + 1,0,size);
return array;
}
-PRIMITIVE(byte_array)
+byte_array *allot_byte_array(cell size)
+{
+ return vm->allot_byte_array(size);
+}
+
+inline void factorvm::vmprim_byte_array()
{
cell size = unbox_array_size();
dpush(tag<byte_array>(allot_byte_array(size)));
}
-PRIMITIVE(uninitialized_byte_array)
+PRIMITIVE(byte_array)
+{
+ PRIMITIVE_GETVM()->vmprim_byte_array();
+}
+
+inline void factorvm::vmprim_uninitialized_byte_array()
{
cell size = unbox_array_size();
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
}
-PRIMITIVE(resize_byte_array)
+PRIMITIVE(uninitialized_byte_array)
+{
+ PRIMITIVE_GETVM()->vmprim_uninitialized_byte_array();
+}
+
+inline void factorvm::vmprim_resize_byte_array()
{
byte_array *array = untag_check<byte_array>(dpop());
cell capacity = unbox_array_size();
dpush(tag<byte_array>(reallot_array(array,capacity)));
}
+PRIMITIVE(resize_byte_array)
+{
+ PRIMITIVE_GETVM()->vmprim_resize_byte_array();
+}
+
void growable_byte_array::append_bytes(void *elts, cell len)
{
cell new_size = count + len;
diff --git a/vm/vm.hpp b/vm/vm.hpp
index fbdfe125d3..8e8d8bb9b8 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -225,6 +225,12 @@ struct factorvm {
//booleans
void box_boolean(bool value);
bool to_boolean(cell value);
+
+ //byte arrays
+ byte_array *allot_byte_array(cell size);
+ inline void vmprim_byte_array();
+ inline void vmprim_uninitialized_byte_array();
+ inline void vmprim_resize_byte_array();
// next method here:
From dbbc9bb2b149c37052e12610efc2fabd7c8a2ae8 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:06 +0100
Subject: [PATCH 028/266] added tuples fns to vm
---
vm/tuples.cpp | 21 ++++++++++++++++++---
vm/vm.hpp | 5 +++++
2 files changed, 23 insertions(+), 3 deletions(-)
diff --git a/vm/tuples.cpp b/vm/tuples.cpp
index d7e22bb807..c38832ac0b 100644
--- a/vm/tuples.cpp
+++ b/vm/tuples.cpp
@@ -4,7 +4,7 @@ namespace factor
{
/* push a new tuple on the stack */
-tuple *allot_tuple(cell layout_)
+tuple *factorvm::allot_tuple(cell layout_)
{
gc_root<tuple_layout> layout(layout_);
gc_root<tuple> t(allot<tuple>(tuple_size(layout.untagged())));
@@ -12,7 +12,12 @@ tuple *allot_tuple(cell layout_)
return t.untagged();
}
-PRIMITIVE(tuple)
+tuple *allot_tuple(cell layout_)
+{
+ return vm->allot_tuple(layout_);
+}
+
+inline void factorvm::vmprim_tuple()
{
gc_root<tuple_layout> layout(dpop());
tuple *t = allot_tuple(layout.value());
@@ -23,8 +28,13 @@ PRIMITIVE(tuple)
dpush(tag<tuple>(t));
}
+PRIMITIVE(tuple)
+{
+ PRIMITIVE_GETVM()->vmprim_tuple();
+}
+
/* push a new tuple on the stack, filling its slots from the stack */
-PRIMITIVE(tuple_boa)
+inline void factorvm::vmprim_tuple_boa()
{
gc_root<tuple_layout> layout(dpop());
gc_root<tuple> t(allot_tuple(layout.value()));
@@ -34,4 +44,9 @@ PRIMITIVE(tuple_boa)
dpush(t.value());
}
+PRIMITIVE(tuple_boa)
+{
+ PRIMITIVE_GETVM()->vmprim_tuple_boa();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8e8d8bb9b8..5ddfd5cd4a 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -231,6 +231,11 @@ struct factorvm {
inline void vmprim_byte_array();
inline void vmprim_uninitialized_byte_array();
inline void vmprim_resize_byte_array();
+
+ //tuples
+ tuple *allot_tuple(cell layout_);
+ inline void vmprim_tuple();
+ inline void vmprim_tuple_boa();
// next method here:
From 4f4c53c8228568655ce297feb971ee8d1685e24c Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:07 +0100
Subject: [PATCH 029/266] moved words functions to vm
---
vm/vm.hpp | 8 ++++++++
vm/words.cpp | 42 ++++++++++++++++++++++++++++++++++++------
2 files changed, 44 insertions(+), 6 deletions(-)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 5ddfd5cd4a..c1dc417f83 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -236,6 +236,14 @@ struct factorvm {
tuple *allot_tuple(cell layout_);
inline void vmprim_tuple();
inline void vmprim_tuple_boa();
+
+ //words
+ word *allot_word(cell vocab_, cell name_);
+ inline void vmprim_word();
+ inline void vmprim_word_xt();
+ void update_word_xt(cell w_);
+ inline void vmprim_optimized_p();
+ inline void vmprim_wrapper();
// next method here:
diff --git a/vm/words.cpp b/vm/words.cpp
index fa090c9cea..644db46896 100644
--- a/vm/words.cpp
+++ b/vm/words.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-word *allot_word(cell vocab_, cell name_)
+word *factorvm::allot_word(cell vocab_, cell name_)
{
gc_root<object> vocab(vocab_);
gc_root<object> name(name_);
@@ -31,16 +31,26 @@ word *allot_word(cell vocab_, cell name_)
return new_word.untagged();
}
+word *allot_word(cell vocab_, cell name_)
+{
+ return vm->allot_word(vocab_,name_);
+}
+
/* <word> ( name vocabulary -- word ) */
-PRIMITIVE(word)
+inline void factorvm::vmprim_word()
{
cell vocab = dpop();
cell name = dpop();
dpush(tag<word>(allot_word(vocab,name)));
}
+PRIMITIVE(word)
+{
+ PRIMITIVE_GETVM()->vmprim_word();
+}
+
/* word-xt ( word -- start end ) */
-PRIMITIVE(word_xt)
+inline void factorvm::vmprim_word_xt()
{
word *w = untag_check<word>(dpop());
code_block *code = (profiling_p ? w->profiling : w->code);
@@ -48,8 +58,13 @@ PRIMITIVE(word_xt)
dpush(allot_cell((cell)code + code->size));
}
+PRIMITIVE(word_xt)
+{
+ PRIMITIVE_GETVM()->vmprim_word_xt();
+}
+
/* Allocates memory */
-void update_word_xt(cell w_)
+void factorvm::update_word_xt(cell w_)
{
gc_root<word> w(w_);
@@ -64,16 +79,31 @@ void update_word_xt(cell w_)
w->xt = w->code->xt();
}
-PRIMITIVE(optimized_p)
+void update_word_xt(cell w_)
+{
+ return vm->update_word_xt(w_);
+}
+
+inline void factorvm::vmprim_optimized_p()
{
drepl(tag_boolean(word_optimized_p(untag_check<word>(dpeek()))));
}
-PRIMITIVE(wrapper)
+PRIMITIVE(optimized_p)
+{
+ PRIMITIVE_GETVM()->vmprim_optimized_p();
+}
+
+inline void factorvm::vmprim_wrapper()
{
wrapper *new_wrapper = allot<wrapper>(sizeof(wrapper));
new_wrapper->object = dpeek();
drepl(tag<wrapper>(new_wrapper));
}
+PRIMITIVE(wrapper)
+{
+ PRIMITIVE_GETVM()->vmprim_wrapper();
+}
+
}
From 552b9ecd81215100934802895d7423386c33598f Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:07 +0100
Subject: [PATCH 030/266] Dev checkpoint
---
vm/math.cpp | 212 ++++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 32 ++++++++
2 files changed, 213 insertions(+), 31 deletions(-)
mode change 100644 => 100755 vm/math.cpp
diff --git a/vm/math.cpp b/vm/math.cpp
old mode 100644
new mode 100755
index b16557b8b7..30b32de7ed
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -7,19 +7,29 @@ cell bignum_zero;
cell bignum_pos_one;
cell bignum_neg_one;
-PRIMITIVE(bignum_to_fixnum)
+inline void factorvm::vmprim_bignum_to_fixnum()
{
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
}
-PRIMITIVE(float_to_fixnum)
+PRIMITIVE(bignum_to_fixnum)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_to_fixnum();
+}
+
+inline void factorvm::vmprim_float_to_fixnum()
{
drepl(tag_fixnum(float_to_fixnum(dpeek())));
}
+PRIMITIVE(float_to_fixnum)
+{
+ PRIMITIVE_GETVM()->vmprim_float_to_fixnum();
+}
+
/* Division can only overflow when we are dividing the most negative fixnum
by -1. */
-PRIMITIVE(fixnum_divint)
+inline void factorvm::vmprim_fixnum_divint()
{
fixnum y = untag_fixnum(dpop()); \
fixnum x = untag_fixnum(dpeek());
@@ -30,7 +40,12 @@ PRIMITIVE(fixnum_divint)
drepl(tag_fixnum(result));
}
-PRIMITIVE(fixnum_divmod)
+PRIMITIVE(fixnum_divint)
+{
+ PRIMITIVE_GETVM()->vmprim_fixnum_divint();
+}
+
+inline void factorvm::vmprim_fixnum_divmod()
{
cell y = ((cell *)ds)[0];
cell x = ((cell *)ds)[-1];
@@ -46,26 +61,46 @@ PRIMITIVE(fixnum_divmod)
}
}
+PRIMITIVE(fixnum_divmod)
+{
+ PRIMITIVE_GETVM()->vmprim_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.
*/
-static inline fixnum sign_mask(fixnum x)
+inline fixnum factorvm::sign_mask(fixnum x)
{
return x >> (WORD_SIZE - 1);
}
-static inline fixnum branchless_max(fixnum x, fixnum y)
+inline fixnum sign_mask(fixnum x)
+{
+ return vm->sign_mask(x);
+}
+
+inline fixnum factorvm::branchless_max(fixnum x, fixnum y)
{
return (x - ((x - y) & sign_mask(x - y)));
}
-static inline fixnum branchless_abs(fixnum x)
+inline fixnum branchless_max(fixnum x, fixnum y)
+{
+ return vm->branchless_max(x,y);
+}
+
+inline fixnum factorvm::branchless_abs(fixnum x)
{
return (x ^ sign_mask(x)) - sign_mask(x);
}
-PRIMITIVE(fixnum_shift)
+inline fixnum branchless_abs(fixnum x)
+{
+ return vm->branchless_abs(x);
+}
+
+inline void factorvm::vmprim_fixnum_shift()
{
fixnum y = untag_fixnum(dpop());
fixnum x = untag_fixnum(dpeek());
@@ -92,51 +127,91 @@ PRIMITIVE(fixnum_shift)
fixnum_to_bignum(x),y)));
}
-PRIMITIVE(fixnum_to_bignum)
+PRIMITIVE(fixnum_shift)
+{
+ PRIMITIVE_GETVM()->vmprim_fixnum_shift();
+}
+
+inline void factorvm::vmprim_fixnum_to_bignum()
{
drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
}
-PRIMITIVE(float_to_bignum)
+PRIMITIVE(fixnum_to_bignum)
+{
+ PRIMITIVE_GETVM()->vmprim_fixnum_to_bignum();
+}
+
+inline void factorvm::vmprim_float_to_bignum()
{
drepl(tag<bignum>(float_to_bignum(dpeek())));
}
+PRIMITIVE(float_to_bignum)
+{
+ PRIMITIVE_GETVM()->vmprim_float_to_bignum();
+}
+
#define POP_BIGNUMS(x,y) \
bignum * y = untag<bignum>(dpop()); \
bignum * x = untag<bignum>(dpop());
-PRIMITIVE(bignum_eq)
+inline void factorvm::vmprim_bignum_eq()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_equal_p(x,y));
}
-PRIMITIVE(bignum_add)
+PRIMITIVE(bignum_eq)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_eq();
+}
+
+inline void factorvm::vmprim_bignum_add()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_add(x,y)));
}
-PRIMITIVE(bignum_subtract)
+PRIMITIVE(bignum_add)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_add();
+}
+
+inline void factorvm::vmprim_bignum_subtract()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_subtract(x,y)));
}
-PRIMITIVE(bignum_multiply)
+PRIMITIVE(bignum_subtract)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_subtract();
+}
+
+inline void factorvm::vmprim_bignum_multiply()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_multiply(x,y)));
}
-PRIMITIVE(bignum_divint)
+PRIMITIVE(bignum_multiply)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_multiply();
+}
+
+inline void factorvm::vmprim_bignum_divint()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_quotient(x,y)));
}
-PRIMITIVE(bignum_divmod)
+PRIMITIVE(bignum_divint)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_divint();
+}
+
+inline void factorvm::vmprim_bignum_divmod()
{
bignum *q, *r;
POP_BIGNUMS(x,y);
@@ -145,91 +220,166 @@ PRIMITIVE(bignum_divmod)
dpush(tag<bignum>(r));
}
-PRIMITIVE(bignum_mod)
+PRIMITIVE(bignum_divmod)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_divmod();
+}
+
+inline void factorvm::vmprim_bignum_mod()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_remainder(x,y)));
}
-PRIMITIVE(bignum_and)
+PRIMITIVE(bignum_mod)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_mod();
+}
+
+inline void factorvm::vmprim_bignum_and()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_and(x,y)));
}
-PRIMITIVE(bignum_or)
+PRIMITIVE(bignum_and)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_and();
+}
+
+inline void factorvm::vmprim_bignum_or()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
}
-PRIMITIVE(bignum_xor)
+PRIMITIVE(bignum_or)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_or();
+}
+
+inline void factorvm::vmprim_bignum_xor()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
}
-PRIMITIVE(bignum_shift)
+PRIMITIVE(bignum_xor)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_xor();
+}
+
+inline void factorvm::vmprim_bignum_shift()
{
fixnum y = untag_fixnum(dpop());
bignum* x = untag<bignum>(dpop());
dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
}
-PRIMITIVE(bignum_less)
+PRIMITIVE(bignum_shift)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_shift();
+}
+
+inline void factorvm::vmprim_bignum_less()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) == bignum_comparison_less);
}
-PRIMITIVE(bignum_lesseq)
+PRIMITIVE(bignum_less)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_less();
+}
+
+inline void factorvm::vmprim_bignum_lesseq()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
}
-PRIMITIVE(bignum_greater)
+PRIMITIVE(bignum_lesseq)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_lesseq();
+}
+
+inline void factorvm::vmprim_bignum_greater()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
}
-PRIMITIVE(bignum_greatereq)
+PRIMITIVE(bignum_greater)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_greater();
+}
+
+inline void factorvm::vmprim_bignum_greatereq()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) != bignum_comparison_less);
}
-PRIMITIVE(bignum_not)
+PRIMITIVE(bignum_greatereq)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_greatereq();
+}
+
+inline void factorvm::vmprim_bignum_not()
{
drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
}
-PRIMITIVE(bignum_bitp)
+PRIMITIVE(bignum_not)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_not();
+}
+
+inline void factorvm::vmprim_bignum_bitp()
{
fixnum bit = to_fixnum(dpop());
bignum *x = untag<bignum>(dpop());
box_boolean(bignum_logbitp(bit,x));
}
-PRIMITIVE(bignum_log2)
+PRIMITIVE(bignum_bitp)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_bitp();
+}
+
+inline void factorvm::vmprim_bignum_log2()
{
drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
}
-unsigned int bignum_producer(unsigned int digit)
+PRIMITIVE(bignum_log2)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_log2();
+}
+
+unsigned int factorvm::bignum_producer(unsigned int digit)
{
unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
return *(ptr + digit);
}
-PRIMITIVE(byte_array_to_bignum)
+unsigned int bignum_producer(unsigned int digit)
+{
+ return vm->bignum_producer(digit);
+}
+
+inline void factorvm::vmprim_byte_array_to_bignum()
{
cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
- bignum * result = digit_stream_to_bignum(n_digits,bignum_producer,0x100,0);
+ bignum * result = factor::digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
drepl(tag<bignum>(result));
}
+PRIMITIVE(byte_array_to_bignum)
+{
+ PRIMITIVE_GETVM()->vmprim_byte_array_to_bignum();
+}
+
cell unbox_array_size()
{
switch(tagged<object>(dpeek()).type())
diff --git a/vm/vm.hpp b/vm/vm.hpp
index c1dc417f83..3521978cae 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -244,6 +244,38 @@ struct factorvm {
void update_word_xt(cell w_);
inline void vmprim_optimized_p();
inline void vmprim_wrapper();
+
+ //math
+ inline void vmprim_bignum_to_fixnum();
+ inline void vmprim_float_to_fixnum();
+ inline void vmprim_fixnum_divint();
+ inline void vmprim_fixnum_divmod();
+ inline fixnum sign_mask(fixnum x);
+ inline fixnum branchless_max(fixnum x, fixnum y);
+ inline fixnum branchless_abs(fixnum x);
+ inline void vmprim_fixnum_shift();
+ inline void vmprim_fixnum_to_bignum();
+ inline void vmprim_float_to_bignum();
+ inline void vmprim_bignum_eq();
+ inline void vmprim_bignum_add();
+ inline void vmprim_bignum_subtract();
+ inline void vmprim_bignum_multiply();
+ inline void vmprim_bignum_divint();
+ inline void vmprim_bignum_divmod();
+ inline void vmprim_bignum_mod();
+ inline void vmprim_bignum_and();
+ inline void vmprim_bignum_or();
+ inline void vmprim_bignum_xor();
+ inline void vmprim_bignum_shift();
+ inline void vmprim_bignum_less();
+ inline void vmprim_bignum_lesseq();
+ inline void vmprim_bignum_greater();
+ inline void vmprim_bignum_greatereq();
+ inline void vmprim_bignum_not();
+ inline void vmprim_bignum_bitp();
+ inline void vmprim_bignum_log2();
+ unsigned int bignum_producer(unsigned int digit);
+ inline void vmprim_byte_array_to_bignum();
// next method here:
From 10e5dc9b3ce850feeb5f4d92a2e4a8375f3d117b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:07 +0100
Subject: [PATCH 031/266] moved math functions to vm
---
vm/math.cpp | 274 +++++++++++++++++++++++++++++++++++++++++++++-------
vm/vm.hpp | 42 ++++++++
2 files changed, 279 insertions(+), 37 deletions(-)
diff --git a/vm/math.cpp b/vm/math.cpp
index 30b32de7ed..ac04e906a2 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -380,7 +380,7 @@ PRIMITIVE(byte_array_to_bignum)
PRIMITIVE_GETVM()->vmprim_byte_array_to_bignum();
}
-cell unbox_array_size()
+cell factorvm::unbox_array_size()
{
switch(tagged<object>(dpeek()).type())
{
@@ -413,17 +413,32 @@ cell unbox_array_size()
return 0; /* can't happen */
}
-PRIMITIVE(fixnum_to_float)
+cell unbox_array_size()
+{
+ return vm->unbox_array_size();
+}
+
+inline void factorvm::vmprim_fixnum_to_float()
{
drepl(allot_float(fixnum_to_float(dpeek())));
}
-PRIMITIVE(bignum_to_float)
+PRIMITIVE(fixnum_to_float)
+{
+ PRIMITIVE_GETVM()->vmprim_fixnum_to_float();
+}
+
+inline void factorvm::vmprim_bignum_to_float()
{
drepl(allot_float(bignum_to_float(dpeek())));
}
-PRIMITIVE(str_to_float)
+PRIMITIVE(bignum_to_float)
+{
+ PRIMITIVE_GETVM()->vmprim_bignum_to_float();
+}
+
+inline void factorvm::vmprim_str_to_float()
{
byte_array *bytes = untag_check<byte_array>(dpeek());
cell capacity = array_capacity(bytes);
@@ -437,98 +452,178 @@ PRIMITIVE(str_to_float)
drepl(F);
}
-PRIMITIVE(float_to_str)
+PRIMITIVE(str_to_float)
+{
+ PRIMITIVE_GETVM()->vmprim_str_to_float();
+}
+
+inline void factorvm::vmprim_float_to_str()
{
byte_array *array = allot_byte_array(33);
snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
dpush(tag<byte_array>(array));
}
+PRIMITIVE(float_to_str)
+{
+ PRIMITIVE_GETVM()->vmprim_float_to_str();
+}
+
#define POP_FLOATS(x,y) \
double y = untag_float(dpop()); \
double x = untag_float(dpop());
-PRIMITIVE(float_eq)
+inline void factorvm::vmprim_float_eq()
{
POP_FLOATS(x,y);
box_boolean(x == y);
}
-PRIMITIVE(float_add)
+PRIMITIVE(float_eq)
+{
+ PRIMITIVE_GETVM()->vmprim_float_eq();
+}
+
+inline void factorvm::vmprim_float_add()
{
POP_FLOATS(x,y);
box_double(x + y);
}
-PRIMITIVE(float_subtract)
+PRIMITIVE(float_add)
+{
+ PRIMITIVE_GETVM()->vmprim_float_add();
+}
+
+inline void factorvm::vmprim_float_subtract()
{
POP_FLOATS(x,y);
box_double(x - y);
}
-PRIMITIVE(float_multiply)
+PRIMITIVE(float_subtract)
+{
+ PRIMITIVE_GETVM()->vmprim_float_subtract();
+}
+
+inline void factorvm::vmprim_float_multiply()
{
POP_FLOATS(x,y);
box_double(x * y);
}
-PRIMITIVE(float_divfloat)
+PRIMITIVE(float_multiply)
+{
+ PRIMITIVE_GETVM()->vmprim_float_multiply();
+}
+
+inline void factorvm::vmprim_float_divfloat()
{
POP_FLOATS(x,y);
box_double(x / y);
}
-PRIMITIVE(float_mod)
+PRIMITIVE(float_divfloat)
+{
+ PRIMITIVE_GETVM()->vmprim_float_divfloat();
+}
+
+inline void factorvm::vmprim_float_mod()
{
POP_FLOATS(x,y);
box_double(fmod(x,y));
}
-PRIMITIVE(float_less)
+PRIMITIVE(float_mod)
+{
+ PRIMITIVE_GETVM()->vmprim_float_mod();
+}
+
+inline void factorvm::vmprim_float_less()
{
POP_FLOATS(x,y);
box_boolean(x < y);
}
-PRIMITIVE(float_lesseq)
+PRIMITIVE(float_less)
+{
+ PRIMITIVE_GETVM()->vmprim_float_less();
+}
+
+inline void factorvm::vmprim_float_lesseq()
{
POP_FLOATS(x,y);
box_boolean(x <= y);
}
-PRIMITIVE(float_greater)
+PRIMITIVE(float_lesseq)
+{
+ PRIMITIVE_GETVM()->vmprim_float_lesseq();
+}
+
+inline void factorvm::vmprim_float_greater()
{
POP_FLOATS(x,y);
box_boolean(x > y);
}
-PRIMITIVE(float_greatereq)
+PRIMITIVE(float_greater)
+{
+ PRIMITIVE_GETVM()->vmprim_float_greater();
+}
+
+inline void factorvm::vmprim_float_greatereq()
{
POP_FLOATS(x,y);
box_boolean(x >= y);
}
-PRIMITIVE(float_bits)
+PRIMITIVE(float_greatereq)
+{
+ PRIMITIVE_GETVM()->vmprim_float_greatereq();
+}
+
+inline void factorvm::vmprim_float_bits()
{
box_unsigned_4(float_bits(untag_float_check(dpop())));
}
-PRIMITIVE(bits_float)
+PRIMITIVE(float_bits)
+{
+ PRIMITIVE_GETVM()->vmprim_float_bits();
+}
+
+inline void factorvm::vmprim_bits_float()
{
box_float(bits_float(to_cell(dpop())));
}
-PRIMITIVE(double_bits)
+PRIMITIVE(bits_float)
+{
+ PRIMITIVE_GETVM()->vmprim_bits_float();
+}
+
+inline void factorvm::vmprim_double_bits()
{
box_unsigned_8(double_bits(untag_float_check(dpop())));
}
-PRIMITIVE(bits_double)
+PRIMITIVE(double_bits)
+{
+ PRIMITIVE_GETVM()->vmprim_double_bits();
+}
+
+inline void factorvm::vmprim_bits_double()
{
box_double(bits_double(to_unsigned_8(dpop())));
}
-VM_C_API fixnum to_fixnum(cell tagged)
+PRIMITIVE(bits_double)
+{
+ PRIMITIVE_GETVM()->vmprim_bits_double();
+}
+
+fixnum factorvm::to_fixnum(cell tagged)
{
switch(TAG(tagged))
{
@@ -542,52 +637,102 @@ VM_C_API fixnum to_fixnum(cell tagged)
}
}
-VM_C_API cell to_cell(cell tagged)
+VM_C_API fixnum to_fixnum(cell tagged)
+{
+ return vm->to_fixnum(tagged);
+}
+
+cell factorvm::to_cell(cell tagged)
{
return (cell)to_fixnum(tagged);
}
+VM_C_API cell to_cell(cell tagged)
+{
+ return vm->to_cell(tagged);
+}
+
+void factorvm::box_signed_1(s8 n)
+{
+ dpush(tag_fixnum(n));
+}
+
VM_C_API void box_signed_1(s8 n)
+{
+ return vm->box_signed_1(n);
+}
+
+void factorvm::box_unsigned_1(u8 n)
{
dpush(tag_fixnum(n));
}
VM_C_API void box_unsigned_1(u8 n)
+{
+ return vm->box_unsigned_1(n);
+}
+
+void factorvm::box_signed_2(s16 n)
{
dpush(tag_fixnum(n));
}
VM_C_API void box_signed_2(s16 n)
+{
+ return vm->box_signed_2(n);
+}
+
+void factorvm::box_unsigned_2(u16 n)
{
dpush(tag_fixnum(n));
}
VM_C_API void box_unsigned_2(u16 n)
{
- dpush(tag_fixnum(n));
+ return vm->box_unsigned_2(n);
}
-VM_C_API void box_signed_4(s32 n)
+void factorvm::box_signed_4(s32 n)
{
dpush(allot_integer(n));
}
-VM_C_API void box_unsigned_4(u32 n)
+VM_C_API void box_signed_4(s32 n)
+{
+ return vm->box_signed_4(n);
+}
+
+void factorvm::box_unsigned_4(u32 n)
{
dpush(allot_cell(n));
}
-VM_C_API void box_signed_cell(fixnum integer)
+VM_C_API void box_unsigned_4(u32 n)
+{
+ return vm->box_unsigned_4(n);
+}
+
+void factorvm::box_signed_cell(fixnum integer)
{
dpush(allot_integer(integer));
}
-VM_C_API void box_unsigned_cell(cell cell)
+VM_C_API void box_signed_cell(fixnum integer)
+{
+ return vm->box_signed_cell(integer);
+}
+
+void factorvm::box_unsigned_cell(cell cell)
{
dpush(allot_cell(cell));
}
-VM_C_API void box_signed_8(s64 n)
+VM_C_API void box_unsigned_cell(cell cell)
+{
+ return vm->box_unsigned_cell(cell);
+}
+
+void factorvm::box_signed_8(s64 n)
{
if(n < fixnum_min || n > fixnum_max)
dpush(tag<bignum>(long_long_to_bignum(n)));
@@ -595,7 +740,12 @@ VM_C_API void box_signed_8(s64 n)
dpush(tag_fixnum(n));
}
-VM_C_API s64 to_signed_8(cell obj)
+VM_C_API void box_signed_8(s64 n)
+{
+ return vm->box_signed_8(n);
+}
+
+s64 factorvm::to_signed_8(cell obj)
{
switch(tagged<object>(obj).type())
{
@@ -609,7 +759,12 @@ VM_C_API s64 to_signed_8(cell obj)
}
}
-VM_C_API void box_unsigned_8(u64 n)
+VM_C_API s64 to_signed_8(cell obj)
+{
+ return vm->to_signed_8(obj);
+}
+
+void factorvm::box_unsigned_8(u64 n)
{
if(n > (u64)fixnum_max)
dpush(tag<bignum>(ulong_long_to_bignum(n)));
@@ -617,7 +772,12 @@ VM_C_API void box_unsigned_8(u64 n)
dpush(tag_fixnum(n));
}
-VM_C_API u64 to_unsigned_8(cell obj)
+VM_C_API void box_unsigned_8(u64 n)
+{
+ return vm->box_unsigned_8(n);
+}
+
+u64 factorvm::to_unsigned_8(cell obj)
{
switch(tagged<object>(obj).type())
{
@@ -631,41 +791,76 @@ VM_C_API u64 to_unsigned_8(cell obj)
}
}
-VM_C_API void box_float(float flo)
+VM_C_API u64 to_unsigned_8(cell obj)
+{
+ return vm->to_unsigned_8(obj);
+}
+
+void factorvm::box_float(float flo)
{
dpush(allot_float(flo));
}
+VM_C_API void box_float(float flo)
+{
+ return vm->box_float(flo);
+}
+
+float factorvm::to_float(cell value)
+{
+ return untag_float_check(value);
+}
+
VM_C_API float to_float(cell value)
{
- return untag_float_check(value);
+ return vm->to_float(value);
}
-VM_C_API void box_double(double flo)
+void factorvm::box_double(double flo)
{
dpush(allot_float(flo));
}
-VM_C_API double to_double(cell value)
+VM_C_API void box_double(double flo)
+{
+ return vm->box_double(flo);
+}
+
+double factorvm::to_double(cell value)
{
return untag_float_check(value);
}
+VM_C_API double to_double(cell value)
+{
+ return vm->to_double(value);
+}
+
/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
overflow, they call these functions. */
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
+void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
{
drepl(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) + untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
+{
+ return vm->overflow_fixnum_add(x,y);
+}
+
+void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
{
drepl(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) - untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
+{
+ return vm->overflow_fixnum_subtract(x,y);
+}
+
+void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
{
bignum *bx = fixnum_to_bignum(x);
GC_BIGNUM(bx);
@@ -674,4 +869,9 @@ VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
drepl(tag<bignum>(bignum_multiply(bx,by)));
}
+VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
+{
+ return vm->overflow_fixnum_multiply(x,y);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 3521978cae..7df9386083 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -276,9 +276,51 @@ struct factorvm {
inline void vmprim_bignum_log2();
unsigned int bignum_producer(unsigned int digit);
inline void vmprim_byte_array_to_bignum();
+ cell unbox_array_size();
+ inline void vmprim_fixnum_to_float();
+ inline void vmprim_bignum_to_float();
+ inline void vmprim_str_to_float();
+ inline void vmprim_float_to_str();
+ inline void vmprim_float_eq();
+ inline void vmprim_float_add();
+ inline void vmprim_float_subtract();
+ inline void vmprim_float_multiply();
+ inline void vmprim_float_divfloat();
+ inline void vmprim_float_mod();
+ inline void vmprim_float_less();
+ inline void vmprim_float_lesseq();
+ inline void vmprim_float_greater();
+ inline void vmprim_float_greatereq();
+ inline void vmprim_float_bits();
+ inline void vmprim_bits_float();
+ inline void vmprim_double_bits();
+ inline void vmprim_bits_double();
+ fixnum to_fixnum(cell tagged);
+ cell to_cell(cell tagged);
+ void box_signed_1(s8 n);
+ void box_unsigned_1(u8 n);
+ void box_signed_2(s16 n);
+ void box_unsigned_2(u16 n);
+ void box_signed_4(s32 n);
+ void box_unsigned_4(u32 n);
+ void box_signed_cell(fixnum integer);
+ void box_unsigned_cell(cell cell);
+ void box_signed_8(s64 n);
+ s64 to_signed_8(cell obj);
+ void box_unsigned_8(u64 n);
+ u64 to_unsigned_8(cell obj);
+ void box_float(float flo);
+ float to_float(cell value);
+ void box_double(double flo);
+ double to_double(cell value);
+ void overflow_fixnum_add(fixnum x, fixnum y);
+ void overflow_fixnum_subtract(fixnum x, fixnum y);
+ void overflow_fixnum_multiply(fixnum x, fixnum y);
// next method here:
+
+
};
extern factorvm *vm;
From 062c56f94b020429d730697b4206e5a9fa8b7863 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:07 +0100
Subject: [PATCH 032/266] moved io functions to vm
---
vm/io.cpp | 84 +++++++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 14 ++++++++++
2 files changed, 86 insertions(+), 12 deletions(-)
mode change 100644 => 100755 vm/io.cpp
diff --git a/vm/io.cpp b/vm/io.cpp
old mode 100644
new mode 100755
index 5bb5834691..570a9a2633
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -14,14 +14,19 @@ The Factor library provides platform-specific code for Unix and Windows
with many more capabilities so these words are not usually used in
normal operation. */
-void init_c_io()
+void factorvm::init_c_io()
{
userenv[STDIN_ENV] = allot_alien(F,(cell)stdin);
userenv[STDOUT_ENV] = allot_alien(F,(cell)stdout);
userenv[STDERR_ENV] = allot_alien(F,(cell)stderr);
}
-void io_error()
+void init_c_io()
+{
+ return vm->init_c_io();
+}
+
+void factorvm::io_error()
{
#ifndef WINCE
if(errno == EINTR)
@@ -31,7 +36,12 @@ void io_error()
general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
}
-PRIMITIVE(fopen)
+void io_error()
+{
+ return vm->io_error();
+}
+
+inline void factorvm::vmprim_fopen()
{
gc_root<byte_array> mode(dpop());
gc_root<byte_array> path(dpop());
@@ -52,7 +62,12 @@ PRIMITIVE(fopen)
}
}
-PRIMITIVE(fgetc)
+PRIMITIVE(fopen)
+{
+ PRIMITIVE_GETVM()->vmprim_fopen();
+}
+
+inline void factorvm::vmprim_fgetc()
{
FILE *file = (FILE *)unbox_alien();
@@ -77,7 +92,12 @@ PRIMITIVE(fgetc)
}
}
-PRIMITIVE(fread)
+PRIMITIVE(fgetc)
+{
+ PRIMITIVE_GETVM()->vmprim_fgetc();
+}
+
+inline void factorvm::vmprim_fread()
{
FILE *file = (FILE *)unbox_alien();
fixnum size = unbox_array_size();
@@ -117,7 +137,12 @@ PRIMITIVE(fread)
}
}
-PRIMITIVE(fputc)
+PRIMITIVE(fread)
+{
+ PRIMITIVE_GETVM()->vmprim_fread();
+}
+
+inline void factorvm::vmprim_fputc()
{
FILE *file = (FILE *)unbox_alien();
fixnum ch = to_fixnum(dpop());
@@ -135,7 +160,12 @@ PRIMITIVE(fputc)
}
}
-PRIMITIVE(fwrite)
+PRIMITIVE(fputc)
+{
+ PRIMITIVE_GETVM()->vmprim_fputc();
+}
+
+inline void factorvm::vmprim_fwrite()
{
FILE *file = (FILE *)unbox_alien();
byte_array *text = untag_check<byte_array>(dpop());
@@ -164,7 +194,12 @@ PRIMITIVE(fwrite)
}
}
-PRIMITIVE(fseek)
+PRIMITIVE(fwrite)
+{
+ PRIMITIVE_GETVM()->vmprim_fwrite();
+}
+
+inline void factorvm::vmprim_fseek()
{
int whence = to_fixnum(dpop());
FILE *file = (FILE *)unbox_alien();
@@ -189,7 +224,12 @@ PRIMITIVE(fseek)
}
}
-PRIMITIVE(fflush)
+PRIMITIVE(fseek)
+{
+ PRIMITIVE_GETVM()->vmprim_fseek();
+}
+
+inline void factorvm::vmprim_fflush()
{
FILE *file = (FILE *)unbox_alien();
for(;;)
@@ -201,7 +241,12 @@ PRIMITIVE(fflush)
}
}
-PRIMITIVE(fclose)
+PRIMITIVE(fflush)
+{
+ PRIMITIVE_GETVM()->vmprim_fflush();
+}
+
+inline void factorvm::vmprim_fclose()
{
FILE *file = (FILE *)unbox_alien();
for(;;)
@@ -213,17 +258,32 @@ PRIMITIVE(fclose)
}
}
+PRIMITIVE(fclose)
+{
+ PRIMITIVE_GETVM()->vmprim_fclose();
+}
+
/* This function is used by FFI I/O. Accessing the errno global directly is
not portable, since on some libc's errno is not a global but a funky macro that
reads thread-local storage. */
-VM_C_API int err_no()
+int factorvm::err_no()
{
return errno;
}
-VM_C_API void clear_err_no()
+VM_C_API int err_no()
+{
+ return vm->err_no();
+}
+
+void factorvm::clear_err_no()
{
errno = 0;
}
+VM_C_API void clear_err_no()
+{
+ return vm->clear_err_no();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 7df9386083..372908b697 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -316,6 +316,20 @@ struct factorvm {
void overflow_fixnum_add(fixnum x, fixnum y);
void overflow_fixnum_subtract(fixnum x, fixnum y);
void overflow_fixnum_multiply(fixnum x, fixnum y);
+
+ //io
+ void init_c_io();
+ void io_error();
+ inline void vmprim_fopen();
+ inline void vmprim_fgetc();
+ inline void vmprim_fread();
+ inline void vmprim_fputc();
+ inline void vmprim_fwrite();
+ inline void vmprim_fseek();
+ inline void vmprim_fflush();
+ inline void vmprim_fclose();
+ int err_no();
+ void clear_err_no();
// next method here:
From fdabc9a5d83beedde377f9c9de4d1811eea53117 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:07 +0100
Subject: [PATCH 033/266] moved code_gc functions to vm
---
vm/code_gc.cpp | 112 ++++++++++++++++++++++++++++++++++++++++++-------
vm/vm.hpp | 18 ++++++++
2 files changed, 114 insertions(+), 16 deletions(-)
mode change 100644 => 100755 vm/code_gc.cpp
diff --git a/vm/code_gc.cpp b/vm/code_gc.cpp
old mode 100644
new mode 100755
index 4710a1baa0..d229fcd3bf
--- a/vm/code_gc.cpp
+++ b/vm/code_gc.cpp
@@ -3,15 +3,20 @@
namespace factor
{
-static void clear_free_list(heap *heap)
+void factorvm::clear_free_list(heap *heap)
{
memset(&heap->free,0,sizeof(heap_free_list));
}
+void clear_free_list(heap *heap)
+{
+ return vm->clear_free_list(heap);
+}
+
/* This malloc-style heap code is reasonably generic. Maybe in the future, it
will be used for the data heap too, if we ever get incremental
mark/sweep/compact GC. */
-void new_heap(heap *heap, cell size)
+void factorvm::new_heap(heap *heap, cell size)
{
heap->seg = alloc_segment(align_page(size));
if(!heap->seg)
@@ -20,7 +25,12 @@ void new_heap(heap *heap, cell size)
clear_free_list(heap);
}
-static void add_to_free_list(heap *heap, free_heap_block *block)
+void new_heap(heap *heap, cell size)
+{
+ return vm->new_heap(heap,size);
+}
+
+void factorvm::add_to_free_list(heap *heap, free_heap_block *block)
{
if(block->size < free_list_count * block_size_increment)
{
@@ -35,11 +45,16 @@ static void add_to_free_list(heap *heap, free_heap_block *block)
}
}
+void add_to_free_list(heap *heap, free_heap_block *block)
+{
+ return vm->add_to_free_list(heap,block);
+}
+
/* Called after reading the code heap from the image file, and after code GC.
In the former case, we must add a large free block from compiling.base + size to
compiling.limit. */
-void build_free_list(heap *heap, cell size)
+void factorvm::build_free_list(heap *heap, cell size)
{
heap_block *prev = NULL;
@@ -91,13 +106,23 @@ void build_free_list(heap *heap, cell size)
}
-static void assert_free_block(free_heap_block *block)
+void build_free_list(heap *heap, cell size)
+{
+ return vm->build_free_list(heap,size);
+}
+
+void factorvm::assert_free_block(free_heap_block *block)
{
if(block->status != B_FREE)
critical_error("Invalid block in free list",(cell)block);
}
+
+void assert_free_block(free_heap_block *block)
+{
+ return vm->assert_free_block(block);
+}
-static free_heap_block *find_free_block(heap *heap, cell size)
+free_heap_block *factorvm::find_free_block(heap *heap, cell size)
{
cell attempt = size;
@@ -137,7 +162,12 @@ static free_heap_block *find_free_block(heap *heap, cell size)
return NULL;
}
-static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size)
+free_heap_block *find_free_block(heap *heap, cell size)
+{
+ return vm->find_free_block(heap,size);
+}
+
+free_heap_block *factorvm::split_free_block(heap *heap, free_heap_block *block, cell size)
{
if(block->size != size )
{
@@ -153,8 +183,13 @@ static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cel
return block;
}
+free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size)
+{
+ return vm->split_free_block(heap,block,size);
+}
+
/* Allocate a block of memory from the mark and sweep GC heap */
-heap_block *heap_allot(heap *heap, cell size)
+heap_block *factorvm::heap_allot(heap *heap, cell size)
{
size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
@@ -170,14 +205,24 @@ heap_block *heap_allot(heap *heap, cell size)
return NULL;
}
+heap_block *heap_allot(heap *heap, cell size)
+{
+ return vm->heap_allot(heap,size);
+}
+
/* Deallocates a block manually */
-void heap_free(heap *heap, heap_block *block)
+void factorvm::heap_free(heap *heap, heap_block *block)
{
block->status = B_FREE;
add_to_free_list(heap,(free_heap_block *)block);
}
-void mark_block(heap_block *block)
+void heap_free(heap *heap, heap_block *block)
+{
+ return vm->heap_free(heap,block);
+}
+
+void factorvm::mark_block(heap_block *block)
{
/* If already marked, do nothing */
switch(block->status)
@@ -193,9 +238,14 @@ void mark_block(heap_block *block)
}
}
+void mark_block(heap_block *block)
+{
+ return vm->mark_block(block);
+}
+
/* If in the middle of code GC, we have to grow the heap, data GC restarts from
scratch, so we have to unmark any marked blocks. */
-void unmark_marked(heap *heap)
+void factorvm::unmark_marked(heap *heap)
{
heap_block *scan = first_block(heap);
@@ -208,9 +258,14 @@ void unmark_marked(heap *heap)
}
}
+void unmark_marked(heap *heap)
+{
+ return vm->unmark_marked(heap);
+}
+
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
which are allocated and not marked can be reclaimed. */
-void free_unmarked(heap *heap, heap_iterator iter)
+void factorvm::free_unmarked(heap *heap, heap_iterator iter)
{
clear_free_list(heap);
@@ -257,8 +312,13 @@ void free_unmarked(heap *heap, heap_iterator iter)
add_to_free_list(heap,(free_heap_block *)prev);
}
+void free_unmarked(heap *heap, heap_iterator iter)
+{
+ return vm->free_unmarked(heap,iter);
+}
+
/* Compute total sum of sizes of free blocks, and size of largest free block */
-void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
+void factorvm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
{
*used = 0;
*total_free = 0;
@@ -286,8 +346,13 @@ void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
}
}
+void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
+{
+ return vm->heap_usage(heap,used,total_free,max_free);
+}
+
/* The size of the heap, not including the last block if it's free */
-cell heap_size(heap *heap)
+cell factorvm::heap_size(heap *heap)
{
heap_block *scan = first_block(heap);
@@ -302,8 +367,13 @@ cell heap_size(heap *heap)
return heap->seg->size;
}
+cell heap_size(heap *heap)
+{
+ return vm->heap_size(heap);
+}
+
/* Compute where each block is going to go, after compaction */
-cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
+cell factorvm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
{
heap_block *scan = first_block(heap);
char *address = (char *)first_block(heap);
@@ -324,7 +394,12 @@ cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &for
return (cell)address - heap->seg->start;
}
-void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
+cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
+{
+ return vm->compute_heap_forwarding(heap,forwarding);
+}
+
+void factorvm::compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
{
heap_block *scan = first_block(heap);
@@ -338,4 +413,9 @@ void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
}
}
+void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
+{
+ return vm->compact_heap(heap,forwarding);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 372908b697..8166adb556 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -330,6 +330,24 @@ struct factorvm {
inline void vmprim_fclose();
int err_no();
void clear_err_no();
+
+ //code_gc
+ void clear_free_list(heap *heap);
+ void new_heap(heap *heap, cell size);
+ void add_to_free_list(heap *heap, free_heap_block *block);
+ void build_free_list(heap *heap, cell size);
+ void assert_free_block(free_heap_block *block);
+ free_heap_block *find_free_block(heap *heap, cell size);
+ free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size);
+ heap_block *heap_allot(heap *heap, cell size);
+ void heap_free(heap *heap, heap_block *block);
+ void mark_block(heap_block *block);
+ void unmark_marked(heap *heap);
+ void free_unmarked(heap *heap, heap_iterator iter);
+ void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free);
+ cell heap_size(heap *heap);
+ cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding);
+ void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding);
// next method here:
From 0097e76a82fdf18af50cfe99e46b73093536b2eb Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:07 +0100
Subject: [PATCH 034/266] moved code_block functions to vm
---
vm/code_block.cpp | 247 +++++++++++++++++++++++++++++++++++++---------
vm/vm.hpp | 34 +++++++
2 files changed, 235 insertions(+), 46 deletions(-)
mode change 100644 => 100755 vm/code_block.cpp
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
old mode 100644
new mode 100755
index aaf8e25866..ff569328be
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -3,27 +3,47 @@
namespace factor
{
-static relocation_type relocation_type_of(relocation_entry r)
+relocation_type factorvm::relocation_type_of(relocation_entry r)
{
return (relocation_type)((r & 0xf0000000) >> 28);
}
-static relocation_class relocation_class_of(relocation_entry r)
+relocation_type relocation_type_of(relocation_entry r)
+{
+ return vm->relocation_type_of(r);
+}
+
+relocation_class factorvm::relocation_class_of(relocation_entry r)
{
return (relocation_class)((r & 0x0f000000) >> 24);
}
-static cell relocation_offset_of(relocation_entry r)
+relocation_class relocation_class_of(relocation_entry r)
+{
+ return vm->relocation_class_of(r);
+}
+
+cell factorvm::relocation_offset_of(relocation_entry r)
{
return (r & 0x00ffffff);
}
-void flush_icache_for(code_block *block)
+cell relocation_offset_of(relocation_entry r)
+{
+ return vm->relocation_offset_of(r);
+}
+
+void factorvm::flush_icache_for(code_block *block)
{
flush_icache((cell)block,block->size);
}
-static int number_of_parameters(relocation_type type)
+void flush_icache_for(code_block *block)
+{
+ return vm->flush_icache_for(block);
+}
+
+int factorvm::number_of_parameters(relocation_type type)
{
switch(type)
{
@@ -47,7 +67,12 @@ static int number_of_parameters(relocation_type type)
}
}
-void *object_xt(cell obj)
+int number_of_parameters(relocation_type type)
+{
+ return vm->number_of_parameters(type);
+}
+
+void *factorvm::object_xt(cell obj)
{
switch(tagged<object>(obj).type())
{
@@ -61,7 +86,12 @@ void *object_xt(cell obj)
}
}
-static void *xt_pic(word *w, cell tagged_quot)
+void *object_xt(cell obj)
+{
+ return vm->object_xt(obj);
+}
+
+void *factorvm::xt_pic(word *w, cell tagged_quot)
{
if(tagged_quot == F || max_pic_size == 0)
return w->xt;
@@ -75,25 +105,45 @@ static void *xt_pic(word *w, cell tagged_quot)
}
}
-void *word_xt_pic(word *w)
+void *xt_pic(word *w, cell tagged_quot)
+{
+ return vm->xt_pic(w,tagged_quot);
+}
+
+void *factorvm::word_xt_pic(word *w)
{
return xt_pic(w,w->pic_def);
}
-void *word_xt_pic_tail(word *w)
+void *word_xt_pic(word *w)
+{
+ return vm->word_xt_pic(w);
+}
+
+void *factorvm::word_xt_pic_tail(word *w)
{
return xt_pic(w,w->pic_tail_def);
}
+void *word_xt_pic_tail(word *w)
+{
+ return vm->word_xt_pic_tail(w);
+}
+
/* References to undefined symbols are patched up to call this function on
image load */
-void undefined_symbol()
+void factorvm::undefined_symbol()
{
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
}
+void undefined_symbol()
+{
+ return vm->undefined_symbol();
+}
+
/* Look up an external library symbol referenced by a compiled code block */
-void *get_rel_symbol(array *literals, cell index)
+void *factorvm::get_rel_symbol(array *literals, cell index)
{
cell symbol = array_nth(literals,index);
cell library = array_nth(literals,index + 1);
@@ -101,7 +151,7 @@ void *get_rel_symbol(array *literals, cell index)
dll *d = (library == F ? NULL : untag<dll>(library));
if(d != NULL && !d->dll)
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
switch(tagged<object>(symbol).type())
{
@@ -114,7 +164,7 @@ void *get_rel_symbol(array *literals, cell index)
return sym;
else
{
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
}
}
case ARRAY_TYPE:
@@ -129,15 +179,20 @@ void *get_rel_symbol(array *literals, cell index)
if(sym)
return sym;
}
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
}
default:
critical_error("Bad symbol specifier",symbol);
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
}
}
-cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
+void *get_rel_symbol(array *literals, cell index)
+{
+ return vm->get_rel_symbol(literals,index);
+}
+
+cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
{
array *literals = untag<array>(compiled->literals);
cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
@@ -179,7 +234,12 @@ cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
#undef ARG
}
-void iterate_relocations(code_block *compiled, relocation_iterator iter)
+cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
+{
+ return vm->compute_relocation(rel,index,compiled);
+}
+
+void factorvm::iterate_relocations(code_block *compiled, relocation_iterator iter)
{
if(compiled->relocation != F)
{
@@ -197,15 +257,25 @@ void iterate_relocations(code_block *compiled, relocation_iterator iter)
}
}
+void iterate_relocations(code_block *compiled, relocation_iterator iter)
+{
+ return vm->iterate_relocations(compiled,iter);
+}
+
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
-static void store_address_2_2(cell *ptr, cell value)
+void factorvm::store_address_2_2(cell *ptr, cell value)
{
ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
}
+void store_address_2_2(cell *ptr, cell value)
+{
+ return vm->store_address_2_2(ptr,value);
+}
+
/* Store a value into a bitfield of a PowerPC instruction */
-static void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
+void factorvm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
{
/* This is unaccurate but good enough */
fixnum test = (fixnum)mask >> 1;
@@ -215,8 +285,13 @@ static void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shif
*ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
}
+void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
+{
+ return vm->store_address_masked(ptr,value,mask,shift);
+}
+
/* Perform a fixup on a code block */
-void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
+void factorvm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
{
fixnum relative_value = absolute_value - offset;
@@ -261,7 +336,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)
+void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
+{
+ return vm->store_address_in_code_block(klass,offset,absolute_value);
+}
+
+void factorvm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
{
if(relocation_type_of(rel) == RT_IMMEDIATE)
{
@@ -272,19 +352,29 @@ void update_literal_references_step(relocation_entry rel, cell index, code_block
}
}
+void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
+{
+ return vm->update_literal_references_step(rel,index,compiled);
+}
+
/* Update pointers to literals from compiled code. */
-void update_literal_references(code_block *compiled)
+void factorvm::update_literal_references(code_block *compiled)
{
if(!compiled->needs_fixup)
{
- iterate_relocations(compiled,update_literal_references_step);
+ iterate_relocations(compiled,factor::update_literal_references_step);
flush_icache_for(compiled);
}
}
+void update_literal_references(code_block *compiled)
+{
+ return vm->update_literal_references(compiled);
+}
+
/* Copy all literals referenced from a code block to newspace. Only for
aging and nursery collections */
-void copy_literal_references(code_block *compiled)
+void factorvm::copy_literal_references(code_block *compiled)
{
if(collecting_gen >= compiled->last_scan)
{
@@ -307,8 +397,13 @@ void copy_literal_references(code_block *compiled)
}
}
+void copy_literal_references(code_block *compiled)
+{
+ return vm->copy_literal_references(compiled);
+}
+
/* Compute an address to store at a relocation */
-void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
+void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
{
#ifdef FACTOR_DEBUG
tagged<array>(compiled->literals).untag_check();
@@ -320,18 +415,28 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp
compute_relocation(rel,index,compiled));
}
-void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
+void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
+{
+ return vm->relocate_code_block_step(rel,index,compiled);
+}
+
+void factorvm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
{
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);
}
+void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
+{
+ return vm->update_word_references_step(rel,index,compiled);
+}
+
/* Relocate new code blocks completely; updating references to literals,
dlsyms, and words. For all other words in the code heap, we only need
to update references to other words, without worrying about literals
or dlsyms. */
-void update_word_references(code_block *compiled)
+void factorvm::update_word_references(code_block *compiled)
{
if(compiled->needs_fixup)
relocate_code_block(compiled);
@@ -346,30 +451,45 @@ void update_word_references(code_block *compiled)
heap_free(&code,compiled);
else
{
- iterate_relocations(compiled,update_word_references_step);
+ iterate_relocations(compiled,factor::update_word_references_step);
flush_icache_for(compiled);
}
}
-void update_literal_and_word_references(code_block *compiled)
+void update_word_references(code_block *compiled)
+{
+ return vm->update_word_references(compiled);
+}
+
+void factorvm::update_literal_and_word_references(code_block *compiled)
{
update_literal_references(compiled);
update_word_references(compiled);
}
-static void check_code_address(cell address)
+void update_literal_and_word_references(code_block *compiled)
+{
+ return vm->update_literal_and_word_references(compiled);
+}
+
+void factorvm::check_code_address(cell address)
{
#ifdef FACTOR_DEBUG
assert(address >= code.seg->start && address < code.seg->end);
#endif
}
+void check_code_address(cell address)
+{
+ return vm->check_code_address(address);
+}
+
/* Update references to words. This is done after a new code block
is added to the heap. */
/* Mark all literals referenced from a word XT. Only for tenured
collections */
-void mark_code_block(code_block *compiled)
+void factorvm::mark_code_block(code_block *compiled)
{
check_code_address((cell)compiled);
@@ -379,24 +499,39 @@ void mark_code_block(code_block *compiled)
copy_handle(&compiled->relocation);
}
-void mark_stack_frame_step(stack_frame *frame)
+void mark_code_block(code_block *compiled)
+{
+ return vm->mark_code_block(compiled);
+}
+
+void factorvm::mark_stack_frame_step(stack_frame *frame)
{
mark_code_block(frame_code(frame));
}
+void mark_stack_frame_step(stack_frame *frame)
+{
+ return vm->mark_stack_frame_step(frame);
+}
+
/* Mark code blocks executing in currently active stack frames. */
-void mark_active_blocks(context *stacks)
+void factorvm::mark_active_blocks(context *stacks)
{
if(collecting_gen == data->tenured())
{
cell top = (cell)stacks->callstack_top;
cell bottom = (cell)stacks->callstack_bottom;
- iterate_callstack(top,bottom,mark_stack_frame_step);
+ iterate_callstack(top,bottom,factor::mark_stack_frame_step);
}
}
-void mark_object_code_block(object *object)
+void mark_active_blocks(context *stacks)
+{
+ return vm->mark_active_blocks(stacks);
+}
+
+void factorvm::mark_object_code_block(object *object)
{
switch(object->h.hi_tag())
{
@@ -419,23 +554,33 @@ void mark_object_code_block(object *object)
case CALLSTACK_TYPE:
{
callstack *stack = (callstack *)object;
- iterate_callstack_object(stack,mark_stack_frame_step);
+ iterate_callstack_object(stack,factor::mark_stack_frame_step);
break;
}
}
}
+void mark_object_code_block(object *object)
+{
+ return vm->mark_object_code_block(object);
+}
+
/* Perform all fixups on a code block */
-void relocate_code_block(code_block *compiled)
+void factorvm::relocate_code_block(code_block *compiled)
{
compiled->last_scan = data->nursery();
compiled->needs_fixup = false;
- iterate_relocations(compiled,relocate_code_block_step);
+ iterate_relocations(compiled,factor::relocate_code_block_step);
flush_icache_for(compiled);
}
+void relocate_code_block(code_block *compiled)
+{
+ return vm->relocate_code_block(compiled);
+}
+
/* Fixup labels. This is done at compile time, not image load time */
-void fixup_labels(array *labels, code_block *compiled)
+void factorvm::fixup_labels(array *labels, code_block *compiled)
{
cell i;
cell size = array_capacity(labels);
@@ -452,8 +597,13 @@ void fixup_labels(array *labels, code_block *compiled)
}
}
+void fixup_labels(array *labels, code_block *compiled)
+{
+ return vm->fixup_labels(labels,compiled);
+}
+
/* Might GC */
-code_block *allot_code_block(cell size)
+code_block *factorvm::allot_code_block(cell size)
{
heap_block *block = heap_allot(&code,size + sizeof(code_block));
@@ -480,13 +630,13 @@ code_block *allot_code_block(cell size)
return (code_block *)block;
}
+code_block *allot_code_block(cell size)
+{
+ return vm->allot_code_block(size);
+}
+
/* Might GC */
-code_block *add_code_block(
- cell type,
- cell code_,
- cell labels_,
- cell relocation_,
- cell literals_)
+code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
{
gc_root<byte_array> code(code_);
gc_root<object> labels(labels_);
@@ -522,4 +672,9 @@ code_block *add_code_block(
return compiled;
}
+code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
+{
+ return vm->add_code_block(type,code_,labels_,relocation_,literals_);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8166adb556..e829417d0b 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -348,6 +348,40 @@ struct factorvm {
cell heap_size(heap *heap);
cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding);
void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding);
+
+ //code_block
+ relocation_type relocation_type_of(relocation_entry r);
+ relocation_class relocation_class_of(relocation_entry r);
+ cell relocation_offset_of(relocation_entry r);
+ void flush_icache_for(code_block *block);
+ int number_of_parameters(relocation_type type);
+ void *object_xt(cell obj);
+ void *xt_pic(word *w, cell tagged_quot);
+ void *word_xt_pic(word *w);
+ void *word_xt_pic_tail(word *w);
+ void undefined_symbol();
+ void *get_rel_symbol(array *literals, cell index);
+ cell compute_relocation(relocation_entry rel, cell index, code_block *compiled);
+ void iterate_relocations(code_block *compiled, relocation_iterator iter);
+ void store_address_2_2(cell *ptr, cell value);
+ void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift);
+ 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);
+ void update_literal_references(code_block *compiled);
+ void copy_literal_references(code_block *compiled);
+ void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled);
+ void update_word_references_step(relocation_entry rel, cell index, code_block *compiled);
+ void update_word_references(code_block *compiled);
+ void update_literal_and_word_references(code_block *compiled);
+ void check_code_address(cell address);
+ void mark_code_block(code_block *compiled);
+ void mark_stack_frame_step(stack_frame *frame);
+ void mark_active_blocks(context *stacks);
+ void mark_object_code_block(object *object);
+ void relocate_code_block(code_block *compiled);
+ void fixup_labels(array *labels, code_block *compiled);
+ code_block *allot_code_block(cell size);
+ code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_);
// next method here:
From ee07c0b4e50a6ae7b8f2988a64aa220898c3d3ca Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:08 +0100
Subject: [PATCH 035/266] moved code_heap functions to vm
---
vm/code_heap.cpp | 95 ++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 15 ++++++++
2 files changed, 95 insertions(+), 15 deletions(-)
mode change 100644 => 100755 vm/code_heap.cpp
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
old mode 100644
new mode 100755
index 2d2e975fb4..53eb011a9d
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -6,18 +6,28 @@ namespace factor
heap code;
/* Allocate a code heap during startup */
-void init_code_heap(cell size)
+void factorvm::init_code_heap(cell size)
{
new_heap(&code,size);
}
-bool in_code_heap_p(cell ptr)
+void init_code_heap(cell size)
+{
+ return vm->init_code_heap(size);
+}
+
+bool factorvm::in_code_heap_p(cell ptr)
{
return (ptr >= code.seg->start && ptr <= code.seg->end);
}
+bool in_code_heap_p(cell ptr)
+{
+ return vm->in_code_heap_p(ptr);
+}
+
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
-void jit_compile_word(cell word_, cell def_, bool relocate)
+void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
{
gc_root<word> word(word_);
gc_root<quotation> def(def_);
@@ -30,8 +40,13 @@ void jit_compile_word(cell word_, cell def_, bool relocate)
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
}
+void jit_compile_word(cell word_, cell def_, bool relocate)
+{
+ return vm->jit_compile_word(word_,def_,relocate);
+}
+
/* Apply a function to every code block */
-void iterate_code_heap(code_heap_iterator iter)
+void factorvm::iterate_code_heap(code_heap_iterator iter)
{
heap_block *scan = first_block(&code);
@@ -43,21 +58,36 @@ void iterate_code_heap(code_heap_iterator iter)
}
}
+void iterate_code_heap(code_heap_iterator iter)
+{
+ return vm->iterate_code_heap(iter);
+}
+
/* Copy literals referenced from all code blocks to newspace. Only for
aging and nursery collections */
+void factorvm::copy_code_heap_roots()
+{
+ iterate_code_heap(factor::copy_literal_references);
+}
+
void copy_code_heap_roots()
{
- iterate_code_heap(copy_literal_references);
+ return vm->copy_code_heap_roots();
}
/* Update pointers to words referenced from all code blocks. Only after
defining a new word. */
-void update_code_heap_words()
+void factorvm::update_code_heap_words()
{
- iterate_code_heap(update_word_references);
+ iterate_code_heap(factor::update_word_references);
}
-PRIMITIVE(modify_code_heap)
+void update_code_heap_words()
+{
+ return vm->update_code_heap_words();
+}
+
+inline void factorvm::vmprim_modify_code_heap()
{
gc_root<array> alist(dpop());
@@ -108,8 +138,13 @@ PRIMITIVE(modify_code_heap)
update_code_heap_words();
}
+PRIMITIVE(modify_code_heap)
+{
+ PRIMITIVE_GETVM()->vmprim_modify_code_heap();
+}
+
/* Push the free space and total size of the code heap */
-PRIMITIVE(code_room)
+inline void factorvm::vmprim_code_room()
{
cell used, total_free, max_free;
heap_usage(&code,&used,&total_free,&max_free);
@@ -119,14 +154,24 @@ PRIMITIVE(code_room)
dpush(tag_fixnum(max_free / 1024));
}
+PRIMITIVE(code_room)
+{
+ PRIMITIVE_GETVM()->vmprim_code_room();
+}
+
static unordered_map<heap_block *,char *> forwarding;
-code_block *forward_xt(code_block *compiled)
+code_block *factorvm::forward_xt(code_block *compiled)
{
return (code_block *)forwarding[compiled];
}
-void forward_frame_xt(stack_frame *frame)
+code_block *forward_xt(code_block *compiled)
+{
+ return vm->forward_xt(compiled);
+}
+
+void factorvm::forward_frame_xt(stack_frame *frame)
{
cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
code_block *forwarded = forward_xt(frame_code(frame));
@@ -134,7 +179,12 @@ void forward_frame_xt(stack_frame *frame)
FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
}
-void forward_object_xts()
+void forward_frame_xt(stack_frame *frame)
+{
+ return vm->forward_frame_xt(frame);
+}
+
+void factorvm::forward_object_xts()
{
begin_scan();
@@ -165,7 +215,7 @@ void forward_object_xts()
case CALLSTACK_TYPE:
{
callstack *stack = untag<callstack>(obj);
- iterate_callstack_object(stack,forward_frame_xt);
+ iterate_callstack_object(stack,factor::forward_frame_xt);
}
break;
default:
@@ -176,8 +226,13 @@ void forward_object_xts()
end_scan();
}
+void forward_object_xts()
+{
+ return vm->forward_object_xts();
+}
+
/* Set the XT fields now that the heap has been compacted */
-void fixup_object_xts()
+void factorvm::fixup_object_xts()
{
begin_scan();
@@ -205,11 +260,16 @@ void fixup_object_xts()
end_scan();
}
+void fixup_object_xts()
+{
+ return vm->fixup_object_xts();
+}
+
/* Move all free space to the end of the code heap. This is not very efficient,
since it makes several passes over the code and data heaps, but we only ever
do this before saving a deployed image and exiting, so performaance is not
critical here */
-void compact_code_heap()
+void factorvm::compact_code_heap()
{
/* Free all unreachable code blocks */
gc();
@@ -231,4 +291,9 @@ void compact_code_heap()
build_free_list(&code,size);
}
+void compact_code_heap()
+{
+ return vm->compact_code_heap();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index e829417d0b..0395876137 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -382,6 +382,21 @@ struct factorvm {
void fixup_labels(array *labels, code_block *compiled);
code_block *allot_code_block(cell size);
code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_);
+
+ //code_heap
+ void init_code_heap(cell size);
+ bool in_code_heap_p(cell ptr);
+ void jit_compile_word(cell word_, cell def_, bool relocate);
+ void iterate_code_heap(code_heap_iterator iter);
+ void copy_code_heap_roots();
+ void update_code_heap_words();
+ inline void vmprim_modify_code_heap();
+ inline void vmprim_code_room();
+ code_block *forward_xt(code_block *compiled);
+ void forward_frame_xt(stack_frame *frame);
+ void forward_object_xts();
+ void fixup_object_xts();
+ void compact_code_heap();
// next method here:
From 1bba717b368857a0f8eaced0a6f019c54f72f294 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:08 +0100
Subject: [PATCH 036/266] moved image functions to vm
---
vm/image.cpp | 132 +++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 20 ++++++++
2 files changed, 131 insertions(+), 21 deletions(-)
diff --git a/vm/image.cpp b/vm/image.cpp
index de9de1acf1..7724e28f72 100644
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -4,7 +4,7 @@ namespace factor
{
/* Certain special objects in the image are known to the runtime */
-static void init_objects(image_header *h)
+void factorvm::init_objects(image_header *h)
{
memcpy(userenv,h->userenv,sizeof(userenv));
@@ -14,9 +14,14 @@ static void init_objects(image_header *h)
bignum_neg_one = h->bignum_neg_one;
}
+void init_objects(image_header *h)
+{
+ return vm->init_objects(h);
+}
+
cell data_relocation_base;
-static void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
+void factorvm::load_data_heap(FILE *file, image_header *h, vm_parameters *p)
{
cell good_size = h->data_size + (1 << 20);
@@ -49,9 +54,14 @@ static void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
data_relocation_base = h->data_relocation_base;
}
+void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
+{
+ return vm->load_data_heap(file,h,p);
+}
+
cell code_relocation_base;
-static void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
+void factorvm::load_code_heap(FILE *file, image_header *h, vm_parameters *p)
{
if(h->code_size > p->code_size)
fatal_error("Code heap too small to fit image",h->code_size);
@@ -76,8 +86,13 @@ static void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
build_free_list(&code,h->code_size);
}
+void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
+{
+ return vm->load_code_heap(file,h,p);
+}
+
/* Save the current image to disk */
-bool save_image(const vm_char *filename)
+bool factorvm::save_image(const vm_char *filename)
{
FILE* file;
image_header h;
@@ -122,7 +137,12 @@ bool save_image(const vm_char *filename)
return ok;
}
-PRIMITIVE(save_image)
+bool save_image(const vm_char *filename)
+{
+ return vm->save_image(filename);
+}
+
+inline void factorvm::vmprim_save_image()
{
/* do a full GC to push everything into tenured space */
gc();
@@ -132,8 +152,13 @@ PRIMITIVE(save_image)
save_image((vm_char *)(path.untagged() + 1));
}
-PRIMITIVE(save_image_and_exit)
-{
+PRIMITIVE(save_image)
+{
+ PRIMITIVE_GETVM()->vmprim_save_image();
+}
+
+inline void factorvm::vmprim_save_image_and_exit()
+{
/* We unbox this before doing anything else. This is the only point
where we might throw an error, so we have to throw an error here since
later steps destroy the current image. */
@@ -158,7 +183,12 @@ PRIMITIVE(save_image_and_exit)
exit(1);
}
-static void data_fixup(cell *cell)
+PRIMITIVE(save_image_and_exit)
+{
+ PRIMITIVE_GETVM()->vmprim_save_image_and_exit();
+}
+
+void factorvm::data_fixup(cell *cell)
{
if(immediate_p(*cell))
return;
@@ -167,14 +197,24 @@ static void data_fixup(cell *cell)
*cell += (tenured->start - data_relocation_base);
}
-template <typename T> void code_fixup(T **handle)
+void data_fixup(cell *cell)
+{
+ return vm->data_fixup(cell);
+}
+
+template <typename T> void factorvm::code_fixup(T **handle)
{
T *ptr = *handle;
T *new_ptr = (T *)(((cell)ptr) + (code.seg->start - code_relocation_base));
*handle = new_ptr;
}
-static void fixup_word(word *word)
+template <typename T> void code_fixup(T **handle)
+{
+ return vm->code_fixup(handle);
+}
+
+void factorvm::fixup_word(word *word)
{
if(word->code)
code_fixup(&word->code);
@@ -183,7 +223,12 @@ static void fixup_word(word *word)
code_fixup(&word->xt);
}
-static void fixup_quotation(quotation *quot)
+void fixup_word(word *word)
+{
+ return vm->fixup_word(word);
+}
+
+void factorvm::fixup_quotation(quotation *quot)
{
if(quot->code)
{
@@ -194,24 +239,44 @@ static void fixup_quotation(quotation *quot)
quot->xt = (void *)lazy_jit_compile;
}
-static void fixup_alien(alien *d)
+void fixup_quotation(quotation *quot)
+{
+ return vm->fixup_quotation(quot);
+}
+
+void factorvm::fixup_alien(alien *d)
{
d->expired = T;
}
-static void fixup_stack_frame(stack_frame *frame)
+void fixup_alien(alien *d)
+{
+ return vm->fixup_alien(d);
+}
+
+void factorvm::fixup_stack_frame(stack_frame *frame)
{
code_fixup(&frame->xt);
code_fixup(&FRAME_RETURN_ADDRESS(frame));
}
-static void fixup_callstack_object(callstack *stack)
+void fixup_stack_frame(stack_frame *frame)
{
- iterate_callstack_object(stack,fixup_stack_frame);
+ return vm->fixup_stack_frame(frame);
+}
+
+void factorvm::fixup_callstack_object(callstack *stack)
+{
+ iterate_callstack_object(stack,factor::fixup_stack_frame);
+}
+
+void fixup_callstack_object(callstack *stack)
+{
+ return vm->fixup_callstack_object(stack);
}
/* Initialize an object in a newly-loaded image */
-static void relocate_object(object *object)
+void factorvm::relocate_object(object *object)
{
cell hi_tag = object->h.hi_tag();
@@ -231,7 +296,7 @@ static void relocate_object(object *object)
}
else
{
- do_slots((cell)object,data_fixup);
+ do_slots((cell)object,factor::data_fixup);
switch(hi_tag)
{
@@ -254,9 +319,14 @@ static void relocate_object(object *object)
}
}
+void relocate_object(object *object)
+{
+ return vm->relocate_object(object);
+}
+
/* Since the image might have been saved with a different base address than
where it is loaded, we need to fix up pointers in the image. */
-void relocate_data()
+void factorvm::relocate_data()
{
cell relocating;
@@ -281,7 +351,12 @@ void relocate_data()
}
}
-static void fixup_code_block(code_block *compiled)
+void relocate_data()
+{
+ return vm->relocate_data();
+}
+
+void factorvm::fixup_code_block(code_block *compiled)
{
/* relocate literal table data */
data_fixup(&compiled->relocation);
@@ -290,14 +365,24 @@ static void fixup_code_block(code_block *compiled)
relocate_code_block(compiled);
}
+void fixup_code_block(code_block *compiled)
+{
+ return vm->fixup_code_block(compiled);
+}
+
+void factorvm::relocate_code()
+{
+ iterate_code_heap(factor::fixup_code_block);
+}
+
void relocate_code()
{
- iterate_code_heap(fixup_code_block);
+ return vm->relocate_code();
}
/* Read an image file from disk, only done once during startup */
/* This function also initializes the data and code heaps */
-void load_image(vm_parameters *p)
+void factorvm::load_image(vm_parameters *p)
{
FILE *file = OPEN_READ(p->image_path);
if(file == NULL)
@@ -331,4 +416,9 @@ void load_image(vm_parameters *p)
userenv[IMAGE_ENV] = allot_alien(F,(cell)p->image_path);
}
+void load_image(vm_parameters *p)
+{
+ return vm->load_image(p);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0395876137..21effc10c3 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -397,6 +397,26 @@ struct factorvm {
void forward_object_xts();
void fixup_object_xts();
void compact_code_heap();
+
+ //image
+ void init_objects(image_header *h);
+ void load_data_heap(FILE *file, image_header *h, vm_parameters *p);
+ void load_code_heap(FILE *file, image_header *h, vm_parameters *p);
+ bool save_image(const vm_char *filename);
+ inline void vmprim_save_image();
+ inline void vmprim_save_image_and_exit();
+ void data_fixup(cell *cell);
+ template <typename T> void code_fixup(T **handle);
+ void fixup_word(word *word);
+ void fixup_quotation(quotation *quot);
+ void fixup_alien(alien *d);
+ void fixup_stack_frame(stack_frame *frame);
+ void fixup_callstack_object(callstack *stack);
+ void relocate_object(object *object);
+ void relocate_data();
+ void fixup_code_block(code_block *compiled);
+ void relocate_code();
+ void load_image(vm_parameters *p);
// next method here:
From 28620619e93465e0b7248e1a498874d519e5699b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:08 +0100
Subject: [PATCH 037/266] moved alien functions to vm
---
vm/alien.cpp | 112 +++++++++++++++++++++++++++++++++++------
vm/callstack.cpp | 126 ++++++++++++++++++++++++++++++++++++++++-------
vm/data_gc.cpp | 2 +-
vm/profiler.cpp | 2 +-
vm/vm.hpp | 38 ++++++++++++++
5 files changed, 244 insertions(+), 36 deletions(-)
mode change 100644 => 100755 vm/alien.cpp
mode change 100644 => 100755 vm/callstack.cpp
diff --git a/vm/alien.cpp b/vm/alien.cpp
old mode 100644
new mode 100755
index 13764a8e50..3a99d89afb
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -5,7 +5,7 @@ namespace factor
/* gets the address of an object representing a C pointer, with the
intention of storing the pointer across code which may potentially GC. */
-char *pinned_alien_offset(cell obj)
+char *factorvm::pinned_alien_offset(cell obj)
{
switch(tagged<object>(obj).type())
{
@@ -24,8 +24,13 @@ char *pinned_alien_offset(cell obj)
}
}
+char *pinned_alien_offset(cell obj)
+{
+ return vm->pinned_alien_offset(obj);
+}
+
/* make an alien */
-cell allot_alien(cell delegate_, cell displacement)
+cell factorvm::allot_alien(cell delegate_, cell displacement)
{
gc_root<object> delegate(delegate_);
gc_root<alien> new_alien(allot<alien>(sizeof(alien)));
@@ -45,8 +50,13 @@ cell allot_alien(cell delegate_, cell displacement)
return new_alien.value();
}
+cell allot_alien(cell delegate_, cell displacement)
+{
+ return vm->allot_alien(delegate_,displacement);
+}
+
/* make an alien pointing at an offset of another alien */
-PRIMITIVE(displaced_alien)
+inline void factorvm::vmprim_displaced_alien()
{
cell alien = dpop();
cell displacement = to_cell(dpop());
@@ -69,20 +79,35 @@ PRIMITIVE(displaced_alien)
}
}
+PRIMITIVE(displaced_alien)
+{
+ PRIMITIVE_GETVM()->vmprim_displaced_alien();
+}
+
/* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */
-PRIMITIVE(alien_address)
+inline void factorvm::vmprim_alien_address()
{
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
}
+PRIMITIVE(alien_address)
+{
+ PRIMITIVE_GETVM()->vmprim_alien_address();
+}
+
/* pop ( alien n ) from datastack, return alien's address plus n */
-static void *alien_pointer()
+void *factorvm::alien_pointer()
{
fixnum offset = to_fixnum(dpop());
return unbox_alien() + offset;
}
+void *alien_pointer()
+{
+ return vm->alien_pointer();
+}
+
/* define words to read/write values at an alien address */
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
@@ -111,7 +136,7 @@ DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double)
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
/* open a native library and push a handle */
-PRIMITIVE(dlopen)
+inline void factorvm::vmprim_dlopen()
{
gc_root<byte_array> path(dpop());
path.untag_check();
@@ -121,8 +146,13 @@ PRIMITIVE(dlopen)
dpush(library.value());
}
+PRIMITIVE(dlopen)
+{
+ PRIMITIVE_GETVM()->vmprim_dlopen();
+}
+
/* look up a symbol in a native library */
-PRIMITIVE(dlsym)
+inline void factorvm::vmprim_dlsym()
{
gc_root<object> library(dpop());
gc_root<byte_array> name(dpop());
@@ -143,15 +173,25 @@ PRIMITIVE(dlsym)
}
}
+PRIMITIVE(dlsym)
+{
+ PRIMITIVE_GETVM()->vmprim_dlsym();
+}
+
/* close a native library handle */
-PRIMITIVE(dlclose)
+inline void factorvm::vmprim_dlclose()
{
dll *d = untag_check<dll>(dpop());
if(d->dll != NULL)
ffi_dlclose(d);
}
-PRIMITIVE(dll_validp)
+PRIMITIVE(dlclose)
+{
+ PRIMITIVE_GETVM()->vmprim_dlclose();
+}
+
+inline void factorvm::vmprim_dll_validp()
{
cell library = dpop();
if(library == F)
@@ -160,8 +200,13 @@ PRIMITIVE(dll_validp)
dpush(untag_check<dll>(library)->dll == NULL ? F : T);
}
+PRIMITIVE(dll_validp)
+{
+ PRIMITIVE_GETVM()->vmprim_dll_validp();
+}
+
/* gets the address of an object representing a C pointer */
-VM_C_API char *alien_offset(cell obj)
+char *factorvm::alien_offset(cell obj)
{
switch(tagged<object>(obj).type())
{
@@ -182,14 +227,24 @@ VM_C_API char *alien_offset(cell obj)
}
}
+VM_C_API char *alien_offset(cell obj)
+{
+ return vm->alien_offset(obj);
+}
+
/* pop an object representing a C pointer */
-VM_C_API char *unbox_alien()
+char *factorvm::unbox_alien()
{
return alien_offset(dpop());
}
+VM_C_API char *unbox_alien()
+{
+ return vm->unbox_alien();
+}
+
/* make an alien and push */
-VM_C_API void box_alien(void *ptr)
+void factorvm::box_alien(void *ptr)
{
if(ptr == NULL)
dpush(F);
@@ -197,22 +252,37 @@ VM_C_API void box_alien(void *ptr)
dpush(allot_alien(F,(cell)ptr));
}
+VM_C_API void box_alien(void *ptr)
+{
+ return vm->box_alien(ptr);
+}
+
/* for FFI calls passing structs by value */
-VM_C_API void to_value_struct(cell src, void *dest, cell size)
+void factorvm::to_value_struct(cell src, void *dest, cell size)
{
memcpy(dest,alien_offset(src),size);
}
+VM_C_API void to_value_struct(cell src, void *dest, cell size)
+{
+ return vm->to_value_struct(src,dest,size);
+}
+
/* for FFI callbacks receiving structs by value */
-VM_C_API void box_value_struct(void *src, cell size)
+void factorvm::box_value_struct(void *src, cell size)
{
byte_array *bytes = allot_byte_array(size);
memcpy(bytes->data<void>(),src,size);
dpush(tag<byte_array>(bytes));
}
+VM_C_API void box_value_struct(void *src, cell size)
+{
+ return vm->box_value_struct(src,size);
+}
+
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
-VM_C_API void box_small_struct(cell x, cell y, cell size)
+void factorvm::box_small_struct(cell x, cell y, cell size)
{
cell data[2];
data[0] = x;
@@ -220,8 +290,13 @@ VM_C_API void box_small_struct(cell x, cell y, cell size)
box_value_struct(data,size);
}
+VM_C_API void box_small_struct(cell x, cell y, cell size)
+{
+ return vm->box_small_struct(x,y,size);
+}
+
/* On OS X/PPC, complex numbers are returned in registers. */
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
{
cell data[4];
data[0] = x1;
@@ -231,4 +306,9 @@ VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
box_value_struct(data,size);
}
+VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+{
+ return vm->box_medium_struct(x1, x2, x3, x4, size);
+}
+
}
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
old mode 100644
new mode 100755
index 39988ae976..e82314b8d2
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-static void check_frame(stack_frame *frame)
+void factorvm::check_frame(stack_frame *frame)
{
#ifdef FACTOR_DEBUG
check_code_pointer((cell)frame->xt);
@@ -11,14 +11,24 @@ static void check_frame(stack_frame *frame)
#endif
}
-callstack *allot_callstack(cell size)
+void check_frame(stack_frame *frame)
+{
+ return vm->check_frame(frame);
+}
+
+callstack *factorvm::allot_callstack(cell size)
{
callstack *stack = allot<callstack>(callstack_size(size));
stack->length = tag_fixnum(size);
return stack;
}
-stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
+callstack *allot_callstack(cell size)
+{
+ return vm->allot_callstack(size);
+}
+
+stack_frame *factorvm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
{
stack_frame *frame = bottom - 1;
@@ -28,6 +38,11 @@ stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
return frame + 1;
}
+stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
+{
+ return vm->fix_callstack_top(top,bottom);
+}
+
/* We ignore the topmost frame, the one calling 'callstack',
so that set-callstack doesn't get stuck in an infinite loop.
@@ -35,7 +50,7 @@ This means that if 'callstack' is called in tail position, we
will have popped a necessary frame... however this word is only
called by continuation implementation, and user code shouldn't
be calling it at all, so we leave it as it is for now. */
-stack_frame *capture_start()
+stack_frame *factorvm::capture_start()
{
stack_frame *frame = stack_chain->callstack_bottom - 1;
while(frame >= stack_chain->callstack_top
@@ -46,7 +61,12 @@ stack_frame *capture_start()
return frame + 1;
}
-PRIMITIVE(callstack)
+stack_frame *capture_start()
+{
+ return vm->capture_start();
+}
+
+inline void factorvm::vmprim_callstack()
{
stack_frame *top = capture_start();
stack_frame *bottom = stack_chain->callstack_bottom;
@@ -60,7 +80,12 @@ PRIMITIVE(callstack)
dpush(tag<callstack>(stack));
}
-PRIMITIVE(set_callstack)
+PRIMITIVE(callstack)
+{
+ PRIMITIVE_GETVM()->vmprim_callstack();
+}
+
+inline void factorvm::vmprim_set_callstack()
{
callstack *stack = untag_check<callstack>(dpop());
@@ -73,18 +98,33 @@ PRIMITIVE(set_callstack)
critical_error("Bug in set_callstack()",0);
}
-code_block *frame_code(stack_frame *frame)
+PRIMITIVE(set_callstack)
+{
+ PRIMITIVE_GETVM()->vmprim_set_callstack();
+}
+
+code_block *factorvm::frame_code(stack_frame *frame)
{
check_frame(frame);
return (code_block *)frame->xt - 1;
}
-cell frame_type(stack_frame *frame)
+code_block *frame_code(stack_frame *frame)
+{
+ return vm->frame_code(frame);
+}
+
+cell factorvm::frame_type(stack_frame *frame)
{
return frame_code(frame)->type;
}
-cell frame_executing(stack_frame *frame)
+cell frame_type(stack_frame *frame)
+{
+ return vm->frame_type(frame);
+}
+
+cell factorvm::frame_executing(stack_frame *frame)
{
code_block *compiled = frame_code(frame);
if(compiled->literals == F || !stack_traces_p())
@@ -98,14 +138,24 @@ cell frame_executing(stack_frame *frame)
}
}
-stack_frame *frame_successor(stack_frame *frame)
+cell frame_executing(stack_frame *frame)
+{
+ return vm->frame_executing(frame);
+}
+
+stack_frame *factorvm::frame_successor(stack_frame *frame)
{
check_frame(frame);
return (stack_frame *)((cell)frame - frame->size);
}
+stack_frame *frame_successor(stack_frame *frame)
+{
+ return vm->frame_successor(frame);
+}
+
/* Allocates memory */
-cell frame_scan(stack_frame *frame)
+cell factorvm::frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
@@ -131,6 +181,11 @@ cell frame_scan(stack_frame *frame)
}
}
+cell frame_scan(stack_frame *frame)
+{
+ return vm->frame_scan(frame);
+}
+
namespace
{
@@ -149,7 +204,7 @@ struct stack_frame_accumulator {
}
-PRIMITIVE(callstack_to_array)
+inline void factorvm::vmprim_callstack_to_array()
{
gc_root<callstack> callstack(dpop());
@@ -160,7 +215,12 @@ PRIMITIVE(callstack_to_array)
dpush(accum.frames.elements.value());
}
-stack_frame *innermost_stack_frame(callstack *stack)
+PRIMITIVE(callstack_to_array)
+{
+ PRIMITIVE_GETVM()->vmprim_callstack_to_array();
+}
+
+stack_frame *factorvm::innermost_stack_frame(callstack *stack)
{
stack_frame *top = stack->top();
stack_frame *bottom = stack->bottom();
@@ -172,26 +232,46 @@ stack_frame *innermost_stack_frame(callstack *stack)
return frame;
}
-stack_frame *innermost_stack_frame_quot(callstack *callstack)
+stack_frame *innermost_stack_frame(callstack *stack)
+{
+ return vm->innermost_stack_frame(stack);
+}
+
+stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
{
stack_frame *inner = innermost_stack_frame(callstack);
tagged<quotation>(frame_executing(inner)).untag_check();
return inner;
}
+stack_frame *innermost_stack_frame_quot(callstack *callstack)
+{
+ return vm->innermost_stack_frame_quot(callstack);
+}
+
/* Some primitives implementing a limited form of callstack mutation.
Used by the single stepper. */
-PRIMITIVE(innermost_stack_frame_executing)
+inline void factorvm::vmprim_innermost_stack_frame_executing()
{
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
}
-PRIMITIVE(innermost_stack_frame_scan)
+PRIMITIVE(innermost_stack_frame_executing)
+{
+ PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_executing();
+}
+
+inline void factorvm::vmprim_innermost_stack_frame_scan()
{
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
}
-PRIMITIVE(set_innermost_stack_frame_quot)
+PRIMITIVE(innermost_stack_frame_scan)
+{
+ PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_scan();
+}
+
+inline void factorvm::vmprim_set_innermost_stack_frame_quot()
{
gc_root<callstack> callstack(dpop());
gc_root<quotation> quot(dpop());
@@ -207,10 +287,20 @@ PRIMITIVE(set_innermost_stack_frame_quot)
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
}
+PRIMITIVE(set_innermost_stack_frame_quot)
+{
+ PRIMITIVE_GETVM()->vmprim_set_innermost_stack_frame_quot();
+}
+
/* called before entry into Factor code. */
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
+void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
{
stack_chain->callstack_bottom = callstack_bottom;
}
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
+{
+ return vm->save_callstack_bottom(callstack_bottom);
+}
+
}
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index ea7100fc02..35d6812290 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -686,7 +686,7 @@ void factorvm::garbage_collection(cell gen,bool growing_data_heap_,cell requeste
code_heap_scans++;
if(collecting_gen == data->tenured())
- free_unmarked(&code,(heap_iterator)update_literal_and_word_references);
+ free_unmarked(&code,(heap_iterator)factor::update_literal_and_word_references);
else
copy_code_heap_roots();
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index 7b8f04a3bd..054fe01537 100755
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -56,7 +56,7 @@ void factorvm::set_profiling(bool profiling)
}
/* Update XTs in code heap */
- iterate_code_heap(relocate_code_block);
+ iterate_code_heap(factor::relocate_code_block);
}
void set_profiling(bool profiling)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 21effc10c3..063627b9b1 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -417,6 +417,44 @@ struct factorvm {
void fixup_code_block(code_block *compiled);
void relocate_code();
void load_image(vm_parameters *p);
+
+ //callstack
+ void check_frame(stack_frame *frame);
+ callstack *allot_callstack(cell size);
+ stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
+ stack_frame *capture_start();
+ inline void vmprim_callstack();
+ inline void vmprim_set_callstack();
+ code_block *frame_code(stack_frame *frame);
+ cell frame_type(stack_frame *frame);
+ cell frame_executing(stack_frame *frame);
+ stack_frame *frame_successor(stack_frame *frame);
+ cell frame_scan(stack_frame *frame);
+ inline void vmprim_callstack_to_array();
+ stack_frame *innermost_stack_frame(callstack *stack);
+ stack_frame *innermost_stack_frame_quot(callstack *callstack);
+ inline void vmprim_innermost_stack_frame_executing();
+ inline void vmprim_innermost_stack_frame_scan();
+ inline void vmprim_set_innermost_stack_frame_quot();
+ void save_callstack_bottom(stack_frame *callstack_bottom);
+
+ //alien
+ char *pinned_alien_offset(cell obj);
+ cell allot_alien(cell delegate_, cell displacement);
+ inline void vmprim_displaced_alien();
+ inline void vmprim_alien_address();
+ void *alien_pointer();
+ inline void vmprim_dlopen();
+ inline void vmprim_dlsym();
+ inline void vmprim_dlclose();
+ inline void vmprim_dll_validp();
+ char *alien_offset(cell obj);
+ char *unbox_alien();
+ void box_alien(void *ptr);
+ void to_value_struct(cell src, void *dest, cell size);
+ void box_value_struct(void *src, cell size);
+ void box_small_struct(cell x, cell y, cell size);
+ void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
// next method here:
From 2eca2ddeafde5e3715d6d70d1a3f9bb7e5728d51 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:08 +0100
Subject: [PATCH 038/266] moved quotations functions to vm
---
vm/quotations.cpp | 65 +++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 11 ++++++++
2 files changed, 66 insertions(+), 10 deletions(-)
mode change 100644 => 100755 vm/quotations.cpp
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
old mode 100644
new mode 100755
index e96af39766..a093e0e9df
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -265,7 +265,7 @@ void quotation_jit::iterate_quotation()
}
}
-void set_quot_xt(quotation *quot, code_block *code)
+void factorvm::set_quot_xt(quotation *quot, code_block *code)
{
if(code->type != QUOTATION_TYPE)
critical_error("Bad param to set_quot_xt",(cell)code);
@@ -274,8 +274,13 @@ void set_quot_xt(quotation *quot, code_block *code)
quot->xt = code->xt();
}
+void set_quot_xt(quotation *quot, code_block *code)
+{
+ return vm->set_quot_xt(quot,code);
+}
+
/* Allocates memory */
-void jit_compile(cell quot_, bool relocating)
+void factorvm::jit_compile(cell quot_, bool relocating)
{
gc_root<quotation> quot(quot_);
if(quot->code) return;
@@ -289,13 +294,23 @@ void jit_compile(cell quot_, bool relocating)
if(relocating) relocate_code_block(compiled);
}
-PRIMITIVE(jit_compile)
+void jit_compile(cell quot_, bool relocating)
+{
+ return vm->jit_compile(quot_,relocating);
+}
+
+inline void factorvm::vmprim_jit_compile()
{
jit_compile(dpop(),true);
}
+PRIMITIVE(jit_compile)
+{
+ PRIMITIVE_GETVM()->vmprim_jit_compile();
+}
+
/* push a new quotation on the stack */
-PRIMITIVE(array_to_quotation)
+inline void factorvm::vmprim_array_to_quotation()
{
quotation *quot = allot<quotation>(sizeof(quotation));
quot->array = dpeek();
@@ -306,13 +321,23 @@ PRIMITIVE(array_to_quotation)
drepl(tag<quotation>(quot));
}
-PRIMITIVE(quotation_xt)
+PRIMITIVE(array_to_quotation)
+{
+ PRIMITIVE_GETVM()->vmprim_array_to_quotation();
+}
+
+inline void factorvm::vmprim_quotation_xt()
{
quotation *quot = untag_check<quotation>(dpeek());
drepl(allot_cell((cell)quot->xt));
}
-void compile_all_words()
+PRIMITIVE(quotation_xt)
+{
+ PRIMITIVE_GETVM()->vmprim_quotation_xt();
+}
+
+void factorvm::compile_all_words()
{
gc_root<array> words(find_all_words());
@@ -329,11 +354,16 @@ void compile_all_words()
}
- iterate_code_heap(relocate_code_block);
+ iterate_code_heap(factor::relocate_code_block);
+}
+
+void compile_all_words()
+{
+ return vm->compile_all_words();
}
/* Allocates memory */
-fixnum quot_code_offset_to_scan(cell quot_, cell offset)
+fixnum factorvm::quot_code_offset_to_scan(cell quot_, cell offset)
{
gc_root<quotation> quot(quot_);
gc_root<array> array(quot->array);
@@ -345,7 +375,12 @@ fixnum quot_code_offset_to_scan(cell quot_, cell offset)
return compiler.get_position();
}
-VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
+fixnum quot_code_offset_to_scan(cell quot_, cell offset)
+{
+ return vm->quot_code_offset_to_scan(quot_,offset);
+}
+
+cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
{
gc_root<quotation> quot(quot_);
stack_chain->callstack_top = stack;
@@ -353,11 +388,21 @@ VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
return quot.value();
}
-PRIMITIVE(quot_compiled_p)
+VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
+{
+ return vm->lazy_jit_compile_impl(quot_,stack);
+}
+
+inline void factorvm::vmprim_quot_compiled_p()
{
tagged<quotation> quot(dpop());
quot.untag_check();
dpush(tag_boolean(quot->code != NULL));
}
+PRIMITIVE(quot_compiled_p)
+{
+ PRIMITIVE_GETVM()->vmprim_quot_compiled_p();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 063627b9b1..bd3a01ac8f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -455,6 +455,17 @@ struct factorvm {
void box_value_struct(void *src, cell size);
void box_small_struct(cell x, cell y, cell size);
void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
+
+ //quotations
+ inline void vmprim_jit_compile();
+ inline void vmprim_array_to_quotation();
+ inline void vmprim_quotation_xt();
+ void set_quot_xt(quotation *quot, code_block *code);
+ void jit_compile(cell quot_, bool relocating);
+ void compile_all_words();
+ fixnum quot_code_offset_to_scan(cell quot_, cell offset);
+ cell lazy_jit_compile_impl(cell quot_, stack_frame *stack);
+ inline void vmprim_quot_compiled_p();
// next method here:
From c018372cd3ffc7104daa34c03ee8ab536b91eb25 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:08 +0100
Subject: [PATCH 039/266] moved dispatch functions to vm
---
vm/dispatch.cpp | 105 +++++++++++++++++++++++++++++++++++++++++-------
vm/vm.hpp | 17 ++++++++
2 files changed, 107 insertions(+), 15 deletions(-)
mode change 100644 => 100755 vm/dispatch.cpp
diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp
old mode 100644
new mode 100755
index 4a1411733e..fbfc0f79cf
--- a/vm/dispatch.cpp
+++ b/vm/dispatch.cpp
@@ -6,7 +6,7 @@ namespace factor
cell megamorphic_cache_hits;
cell megamorphic_cache_misses;
-static cell search_lookup_alist(cell table, cell klass)
+cell factorvm::search_lookup_alist(cell table, cell klass)
{
array *elements = untag<array>(table);
fixnum index = array_capacity(elements) - 2;
@@ -21,7 +21,12 @@ static cell search_lookup_alist(cell table, cell klass)
return F;
}
-static cell search_lookup_hash(cell table, cell klass, cell hashcode)
+cell search_lookup_alist(cell table, cell klass)
+{
+ return vm->search_lookup_alist(table,klass);
+}
+
+cell factorvm::search_lookup_hash(cell table, cell klass, cell hashcode)
{
array *buckets = untag<array>(table);
cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
@@ -31,19 +36,34 @@ static cell search_lookup_hash(cell table, cell klass, cell hashcode)
return search_lookup_alist(bucket,klass);
}
-static cell nth_superclass(tuple_layout *layout, fixnum echelon)
+cell search_lookup_hash(cell table, cell klass, cell hashcode)
+{
+ return vm->search_lookup_hash(table,klass,hashcode);
+}
+
+cell factorvm::nth_superclass(tuple_layout *layout, fixnum echelon)
{
cell *ptr = (cell *)(layout + 1);
return ptr[echelon * 2];
}
-static cell nth_hashcode(tuple_layout *layout, fixnum echelon)
+cell nth_superclass(tuple_layout *layout, fixnum echelon)
+{
+ return vm->nth_superclass(layout,echelon);
+}
+
+cell factorvm::nth_hashcode(tuple_layout *layout, fixnum echelon)
{
cell *ptr = (cell *)(layout + 1);
return ptr[echelon * 2 + 1];
}
-static cell lookup_tuple_method(cell obj, cell methods)
+cell nth_hashcode(tuple_layout *layout, fixnum echelon)
+{
+ return vm->nth_hashcode(layout,echelon);
+}
+
+cell factorvm::lookup_tuple_method(cell obj, cell methods)
{
tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout);
@@ -75,7 +95,12 @@ static cell lookup_tuple_method(cell obj, cell methods)
return F;
}
-static cell lookup_hi_tag_method(cell obj, cell methods)
+cell lookup_tuple_method(cell obj, cell methods)
+{
+ return vm->lookup_tuple_method(obj,methods);
+}
+
+cell factorvm::lookup_hi_tag_method(cell obj, cell methods)
{
array *hi_tag_methods = untag<array>(methods);
cell tag = untag<object>(obj)->h.hi_tag() - HEADER_TYPE;
@@ -85,7 +110,12 @@ static cell lookup_hi_tag_method(cell obj, cell methods)
return array_nth(hi_tag_methods,tag);
}
-static cell lookup_hairy_method(cell obj, cell methods)
+cell lookup_hi_tag_method(cell obj, cell methods)
+{
+ return vm->lookup_hi_tag_method(obj,methods);
+}
+
+cell factorvm::lookup_hairy_method(cell obj, cell methods)
{
cell method = array_nth(untag<array>(methods),TAG(obj));
if(tagged<object>(method).type_p(WORD_TYPE))
@@ -107,7 +137,12 @@ static cell lookup_hairy_method(cell obj, cell methods)
}
}
-cell lookup_method(cell obj, cell methods)
+cell lookup_hairy_method(cell obj, cell methods)
+{
+ return vm->lookup_hairy_method(obj,methods);
+}
+
+cell factorvm::lookup_method(cell obj, cell methods)
{
cell tag = TAG(obj);
if(tag == TUPLE_TYPE || tag == OBJECT_TYPE)
@@ -116,14 +151,24 @@ cell lookup_method(cell obj, cell methods)
return array_nth(untag<array>(methods),TAG(obj));
}
-PRIMITIVE(lookup_method)
+cell lookup_method(cell obj, cell methods)
+{
+ return vm->lookup_method(obj,methods);
+}
+
+inline void factorvm::vmprim_lookup_method()
{
cell methods = dpop();
cell obj = dpop();
dpush(lookup_method(obj,methods));
}
-cell object_class(cell obj)
+PRIMITIVE(lookup_method)
+{
+ PRIMITIVE_GETVM()->vmprim_lookup_method();
+}
+
+cell factorvm::object_class(cell obj)
{
switch(TAG(obj))
{
@@ -136,13 +181,23 @@ cell object_class(cell obj)
}
}
-static cell method_cache_hashcode(cell klass, array *array)
+cell object_class(cell obj)
+{
+ return vm->object_class(obj);
+}
+
+cell factorvm::method_cache_hashcode(cell klass, array *array)
{
cell capacity = (array_capacity(array) >> 1) - 1;
return ((klass >> TAG_BITS) & capacity) << 1;
}
-static void update_method_cache(cell cache, cell klass, cell method)
+cell method_cache_hashcode(cell klass, array *array)
+{
+ return vm->method_cache_hashcode(klass,array);
+}
+
+void factorvm::update_method_cache(cell cache, cell klass, cell method)
{
array *cache_elements = untag<array>(cache);
cell hashcode = method_cache_hashcode(klass,cache_elements);
@@ -150,7 +205,12 @@ static void update_method_cache(cell cache, cell klass, cell method)
set_array_nth(cache_elements,hashcode + 1,method);
}
-PRIMITIVE(mega_cache_miss)
+void update_method_cache(cell cache, cell klass, cell method)
+{
+ return vm->update_method_cache(cache,klass,method);
+}
+
+inline void factorvm::vmprim_mega_cache_miss()
{
megamorphic_cache_misses++;
@@ -167,12 +227,22 @@ PRIMITIVE(mega_cache_miss)
dpush(method);
}
-PRIMITIVE(reset_dispatch_stats)
+PRIMITIVE(mega_cache_miss)
+{
+ PRIMITIVE_GETVM()->vmprim_mega_cache_miss();
+}
+
+inline void factorvm::vmprim_reset_dispatch_stats()
{
megamorphic_cache_hits = megamorphic_cache_misses = 0;
}
-PRIMITIVE(dispatch_stats)
+PRIMITIVE(reset_dispatch_stats)
+{
+ PRIMITIVE_GETVM()->vmprim_reset_dispatch_stats();
+}
+
+inline void factorvm::vmprim_dispatch_stats()
{
growable_array stats;
stats.add(allot_cell(megamorphic_cache_hits));
@@ -181,6 +251,11 @@ PRIMITIVE(dispatch_stats)
dpush(stats.elements.value());
}
+PRIMITIVE(dispatch_stats)
+{
+ PRIMITIVE_GETVM()->vmprim_dispatch_stats();
+}
+
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)
{
gc_root<array> methods(methods_);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index bd3a01ac8f..9e3e802b4f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -466,6 +466,23 @@ struct factorvm {
fixnum quot_code_offset_to_scan(cell quot_, cell offset);
cell lazy_jit_compile_impl(cell quot_, stack_frame *stack);
inline void vmprim_quot_compiled_p();
+
+ //dispatch
+ cell search_lookup_alist(cell table, cell klass);
+ cell search_lookup_hash(cell table, cell klass, cell hashcode);
+ cell nth_superclass(tuple_layout *layout, fixnum echelon);
+ cell nth_hashcode(tuple_layout *layout, fixnum echelon);
+ cell lookup_tuple_method(cell obj, cell methods);
+ cell lookup_hi_tag_method(cell obj, cell methods);
+ cell lookup_hairy_method(cell obj, cell methods);
+ cell lookup_method(cell obj, cell methods);
+ inline void vmprim_lookup_method();
+ cell object_class(cell obj);
+ cell method_cache_hashcode(cell klass, array *array);
+ void update_method_cache(cell cache, cell klass, cell method);
+ inline void vmprim_mega_cache_miss();
+ inline void vmprim_reset_dispatch_stats();
+ inline void vmprim_dispatch_stats();
// next method here:
From 5980165829bdd3e790e887f99007262f785f957d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:08 +0100
Subject: [PATCH 040/266] moved inline_cache functions to vm
---
vm/inline_cache.cpp | 88 ++++++++++++++++++++++++++++++++++++---------
vm/vm.hpp | 14 ++++++++
2 files changed, 86 insertions(+), 16 deletions(-)
mode change 100644 => 100755 vm/inline_cache.cpp
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
old mode 100644
new mode 100755
index e9e098de70..05a977a67d
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -12,12 +12,17 @@ cell pic_to_mega_transitions;
/* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
cell pic_counts[4];
-void init_inline_caching(int max_size)
+void factorvm::init_inline_caching(int max_size)
{
max_pic_size = max_size;
}
-void deallocate_inline_cache(cell return_address)
+void init_inline_caching(int max_size)
+{
+ return vm->init_inline_caching(max_size);
+}
+
+void factorvm::deallocate_inline_cache(cell return_address)
{
/* Find the call target. */
void *old_xt = get_call_target(return_address);
@@ -36,9 +41,14 @@ void deallocate_inline_cache(cell return_address)
heap_free(&code,old_block);
}
+void deallocate_inline_cache(cell return_address)
+{
+ return vm->deallocate_inline_cache(return_address);
+}
+
/* Figure out what kind of type check the PIC needs based on the methods
it contains */
-static cell determine_inline_cache_type(array *cache_entries)
+cell factorvm::determine_inline_cache_type(array *cache_entries)
{
bool seen_hi_tag = false, seen_tuple = false;
@@ -75,11 +85,21 @@ static cell determine_inline_cache_type(array *cache_entries)
return 0;
}
-static void update_pic_count(cell type)
+cell determine_inline_cache_type(array *cache_entries)
+{
+ return vm->determine_inline_cache_type(cache_entries);
+}
+
+void factorvm::update_pic_count(cell type)
{
pic_counts[type - PIC_TAG]++;
}
+void update_pic_count(cell type)
+{
+ return vm->update_pic_count(type);
+}
+
struct inline_cache_jit : public jit {
fixnum index;
@@ -147,11 +167,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
word_special(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
}
-static code_block *compile_inline_cache(fixnum index,
- cell generic_word_,
- cell methods_,
- cell cache_entries_,
- bool tail_call_p)
+code_block *factorvm::compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
{
gc_root<word> generic_word(generic_word_);
gc_root<array> methods(methods_);
@@ -168,19 +184,34 @@ static code_block *compile_inline_cache(fixnum index,
return code;
}
+code_block *compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
+{
+ return vm->compile_inline_cache(index,generic_word_,methods_,cache_entries_,tail_call_p);
+}
+
/* A generic word's definition performs general method lookup. Allocates memory */
-static void *megamorphic_call_stub(cell generic_word)
+void *factorvm::megamorphic_call_stub(cell generic_word)
{
return untag<word>(generic_word)->xt;
}
-static cell inline_cache_size(cell cache_entries)
+void *megamorphic_call_stub(cell generic_word)
+{
+ return vm->megamorphic_call_stub(generic_word);
+}
+
+cell factorvm::inline_cache_size(cell cache_entries)
{
return array_capacity(untag_check<array>(cache_entries)) / 2;
}
+cell inline_cache_size(cell cache_entries)
+{
+ return vm->inline_cache_size(cache_entries);
+}
+
/* Allocates memory */
-static cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
+cell factorvm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
{
gc_root<array> cache_entries(cache_entries_);
gc_root<object> klass(klass_);
@@ -193,7 +224,12 @@ static cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method
return new_cache_entries.value();
}
-static void update_pic_transitions(cell pic_size)
+cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
+{
+ return vm->add_inline_cache_entry(cache_entries_,klass_,method_);
+}
+
+void factorvm::update_pic_transitions(cell pic_size)
{
if(pic_size == max_pic_size)
pic_to_mega_transitions++;
@@ -203,9 +239,14 @@ static void update_pic_transitions(cell pic_size)
ic_to_pic_transitions++;
}
+void update_pic_transitions(cell pic_size)
+{
+ return vm->update_pic_transitions(pic_size);
+}
+
/* The cache_entries parameter is either f (on cold call site) or an array (on cache miss).
Called from assembly with the actual return address */
-void *inline_cache_miss(cell return_address)
+void *factorvm::inline_cache_miss(cell return_address)
{
check_code_pointer(return_address);
@@ -257,14 +298,24 @@ void *inline_cache_miss(cell return_address)
return xt;
}
-PRIMITIVE(reset_inline_cache_stats)
+void *inline_cache_miss(cell return_address)
+{
+ return vm->inline_cache_miss(return_address);
+}
+
+inline void factorvm::vmprim_reset_inline_cache_stats()
{
cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
cell i;
for(i = 0; i < 4; i++) pic_counts[i] = 0;
}
-PRIMITIVE(inline_cache_stats)
+PRIMITIVE(reset_inline_cache_stats)
+{
+ PRIMITIVE_GETVM()->vmprim_reset_inline_cache_stats();
+}
+
+inline void factorvm::vmprim_inline_cache_stats()
{
growable_array stats;
stats.add(allot_cell(cold_call_to_ic_transitions));
@@ -277,4 +328,9 @@ PRIMITIVE(inline_cache_stats)
dpush(stats.elements.value());
}
+PRIMITIVE(inline_cache_stats)
+{
+ PRIMITIVE_GETVM()->vmprim_inline_cache_stats();
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 9e3e802b4f..7b23f07ba8 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -483,6 +483,20 @@ struct factorvm {
inline void vmprim_mega_cache_miss();
inline void vmprim_reset_dispatch_stats();
inline void vmprim_dispatch_stats();
+
+ //inline cache
+ void init_inline_caching(int max_size);
+ void deallocate_inline_cache(cell return_address);
+ cell determine_inline_cache_type(array *cache_entries);
+ void update_pic_count(cell type);
+ code_block *compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p);
+ void *megamorphic_call_stub(cell generic_word);
+ cell inline_cache_size(cell cache_entries);
+ cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_);
+ void update_pic_transitions(cell pic_size);
+ void *inline_cache_miss(cell return_address);
+ inline void vmprim_reset_inline_cache_stats();
+ inline void vmprim_inline_cache_stats();
// next method here:
From f88eaa0df3577e72210ee285363c6dc7c89cb9d2 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:09 +0100
Subject: [PATCH 041/266] moved factor.cpp functions to vm
---
vm/factor.cpp | 91 +++++++++++++++++++++++++++++++++++++++++++--------
vm/vm.hpp | 15 +++++++++
2 files changed, 93 insertions(+), 13 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 5dd88402bc..6a7180ccd7 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -5,7 +5,7 @@ namespace factor
factorvm *vm;
-VM_C_API void default_parameters(vm_parameters *p)
+void factorvm::default_parameters(vm_parameters *p)
{
p->image_path = NULL;
@@ -45,7 +45,12 @@ VM_C_API void default_parameters(vm_parameters *p)
p->stack_traces = true;
}
-static bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
+VM_C_API void default_parameters(vm_parameters *p)
+{
+ return vm->default_parameters(p);
+}
+
+bool factorvm::factor_arg(const vm_char* str, const vm_char* arg, cell* value)
{
int val;
if(SSCANF(str,arg,&val) > 0)
@@ -57,7 +62,12 @@ static bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
return false;
}
-VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
+bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
+{
+ return vm->factor_arg(str,arg,value);
+}
+
+void factorvm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
{
default_parameters(p);
p->executable_path = argv[0];
@@ -82,8 +92,13 @@ VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **ar
}
}
+VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
+{
+ return vm->init_parameters_from_args(p,argc,argv);
+}
+
/* Do some initialization that we do once only */
-static void do_stage1_init()
+void factorvm::do_stage1_init()
{
print_string("*** Stage 2 early init... ");
fflush(stdout);
@@ -95,7 +110,12 @@ static void do_stage1_init()
fflush(stdout);
}
-VM_C_API void init_factor(vm_parameters *p)
+void do_stage1_init()
+{
+ return vm->do_stage1_init();
+}
+
+void factorvm::init_factor(vm_parameters *p)
{
vm = new factorvm;
/* Kilobytes */
@@ -152,8 +172,13 @@ VM_C_API void init_factor(vm_parameters *p)
}
}
+VM_C_API void init_factor(vm_parameters *p)
+{
+ return vm->init_factor(p);
+}
+
/* May allocate memory */
-VM_C_API void pass_args_to_factor(int argc, vm_char **argv)
+void factorvm::pass_args_to_factor(int argc, vm_char **argv)
{
growable_array args;
int i;
@@ -165,7 +190,12 @@ VM_C_API void pass_args_to_factor(int argc, vm_char **argv)
userenv[ARGS_ENV] = args.elements.value();
}
-static void start_factor(vm_parameters *p)
+VM_C_API void pass_args_to_factor(int argc, vm_char **argv)
+{
+ return vm->pass_args_to_factor(argc,argv);
+}
+
+void factorvm::start_factor(vm_parameters *p)
{
if(p->fep) factorbug();
@@ -174,13 +204,23 @@ static void start_factor(vm_parameters *p)
unnest_stacks();
}
-VM_C_API void start_embedded_factor(vm_parameters *p)
+void start_factor(vm_parameters *p)
+{
+ return vm->start_factor(p);
+}
+
+void factorvm::start_embedded_factor(vm_parameters *p)
{
userenv[EMBEDDED_ENV] = T;
start_factor(p);
}
-VM_C_API void start_standalone_factor(int argc, vm_char **argv)
+VM_C_API void start_embedded_factor(vm_parameters *p)
+{
+ return vm->start_embedded_factor(p);
+}
+
+void factorvm::start_standalone_factor(int argc, vm_char **argv)
{
vm_parameters p;
default_parameters(&p);
@@ -190,27 +230,52 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv)
start_factor(&p);
}
-VM_C_API char *factor_eval_string(char *string)
+VM_C_API void start_standalone_factor(int argc, vm_char **argv)
+{
+ return vm->start_standalone_factor(argc,argv);
+}
+
+char *factorvm::factor_eval_string(char *string)
{
char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
return callback(string);
}
-VM_C_API void factor_eval_free(char *result)
+VM_C_API char *factor_eval_string(char *string)
+{
+ return vm->factor_eval_string(string);
+}
+
+void factorvm::factor_eval_free(char *result)
{
free(result);
}
-VM_C_API void factor_yield()
+VM_C_API void factor_eval_free(char *result)
+{
+ return vm->factor_eval_free(result);
+}
+
+void factorvm::factor_yield()
{
void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
callback();
}
-VM_C_API void factor_sleep(long us)
+VM_C_API void factor_yield()
+{
+ return vm->factor_yield();
+}
+
+void factorvm::factor_sleep(long us)
{
void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
callback(us);
}
+VM_C_API void factor_sleep(long us)
+{
+ return vm->factor_sleep(us);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 7b23f07ba8..2c4cf21144 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -497,6 +497,21 @@ struct factorvm {
void *inline_cache_miss(cell return_address);
inline void vmprim_reset_inline_cache_stats();
inline void vmprim_inline_cache_stats();
+
+ //factor
+ void default_parameters(vm_parameters *p);
+ bool factor_arg(const vm_char* str, const vm_char* arg, cell* value);
+ void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv);
+ void do_stage1_init();
+ void init_factor(vm_parameters *p);
+ void pass_args_to_factor(int argc, vm_char **argv);
+ void start_factor(vm_parameters *p);
+ void start_embedded_factor(vm_parameters *p);
+ void start_standalone_factor(int argc, vm_char **argv);
+ char *factor_eval_string(char *string);
+ void factor_eval_free(char *result);
+ void factor_yield();
+ void factor_sleep(long us);
// next method here:
From a826496a7185e5ad594c9aa60fcbca6d667e4228 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:09 +0100
Subject: [PATCH 042/266] moved utilities.cpp functions to vm
---
vm/utilities.cpp | 63 +++++++++++++++++++++++++++++++++++++++++-------
vm/vm.hpp | 11 +++++++++
2 files changed, 65 insertions(+), 9 deletions(-)
mode change 100644 => 100755 vm/utilities.cpp
diff --git a/vm/utilities.cpp b/vm/utilities.cpp
old mode 100644
new mode 100755
index 37fe28948e..ce17e8f526
--- a/vm/utilities.cpp
+++ b/vm/utilities.cpp
@@ -4,57 +4,102 @@ namespace factor
{
/* If memory allocation fails, bail out */
-void *safe_malloc(size_t size)
+void *factorvm::safe_malloc(size_t size)
{
void *ptr = malloc(size);
if(!ptr) fatal_error("Out of memory in safe_malloc", 0);
return ptr;
}
-vm_char *safe_strdup(const vm_char *str)
+void *safe_malloc(size_t size)
+{
+ return vm->safe_malloc(size);
+}
+
+vm_char *factorvm::safe_strdup(const vm_char *str)
{
vm_char *ptr = STRDUP(str);
if(!ptr) fatal_error("Out of memory in safe_strdup", 0);
return ptr;
}
+vm_char *safe_strdup(const vm_char *str)
+{
+ return vm->safe_strdup(str);
+}
+
/* We don't use printf directly, because format directives are not portable.
Instead we define the common cases here. */
-void nl()
+void factorvm::nl()
{
fputs("\n",stdout);
}
-void print_string(const char *str)
+void nl()
+{
+ return vm->nl();
+}
+
+void factorvm::print_string(const char *str)
{
fputs(str,stdout);
}
-void print_cell(cell x)
+void print_string(const char *str)
+{
+ return vm->print_string(str);
+}
+
+void factorvm::print_cell(cell x)
{
printf(CELL_FORMAT,x);
}
-void print_cell_hex(cell x)
+void print_cell(cell x)
+{
+ return vm->print_cell(x);
+}
+
+void factorvm::print_cell_hex(cell x)
{
printf(CELL_HEX_FORMAT,x);
}
-void print_cell_hex_pad(cell x)
+void print_cell_hex(cell x)
+{
+ return vm->print_cell_hex(x);
+}
+
+void factorvm::print_cell_hex_pad(cell x)
{
printf(CELL_HEX_PAD_FORMAT,x);
}
-void print_fixnum(fixnum x)
+void print_cell_hex_pad(cell x)
+{
+ return vm->print_cell_hex_pad(x);
+}
+
+void factorvm::print_fixnum(fixnum x)
{
printf(FIXNUM_FORMAT,x);
}
-cell read_cell_hex()
+void print_fixnum(fixnum x)
+{
+ return vm->print_fixnum(x);
+}
+
+cell factorvm::read_cell_hex()
{
cell cell;
if(scanf(CELL_HEX_FORMAT,&cell) < 0) exit(1);
return cell;
+}
+
+cell read_cell_hex()
+{
+ return vm->read_cell_hex();
};
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 2c4cf21144..bae1b61c09 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -512,6 +512,17 @@ struct factorvm {
void factor_eval_free(char *result);
void factor_yield();
void factor_sleep(long us);
+
+ //utilities
+ void *safe_malloc(size_t size);
+ vm_char *safe_strdup(const vm_char *str);
+ void nl();
+ void print_string(const char *str);
+ void print_cell(cell x);
+ void print_cell_hex(cell x);
+ void print_cell_hex_pad(cell x);
+ void print_fixnum(fixnum x);
+ cell read_cell_hex();
// next method here:
From 8fea98ad7a9170a50120c5b444ebdf627788b49d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:09 +0100
Subject: [PATCH 043/266] factorvm initialised globally
---
vm/factor.cpp | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 6a7180ccd7..a75f8da8c2 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-factorvm *vm;
+factorvm *vm = new factorvm;
void factorvm::default_parameters(vm_parameters *p)
{
@@ -117,7 +117,6 @@ void do_stage1_init()
void factorvm::init_factor(vm_parameters *p)
{
- vm = new factorvm;
/* Kilobytes */
p->ds_size = align_page(p->ds_size << 10);
p->rs_size = align_page(p->rs_size << 10);
From 386dafe7479b33472302c3ebae99761faaf2a902 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:09 +0100
Subject: [PATCH 044/266] moved local roots state to vm, shuffled includes
around
---
vm/code_gc.hpp | 2 +-
vm/code_heap.hpp | 2 +-
vm/jit.hpp | 1 +
vm/local_roots.cpp | 5 -----
vm/local_roots.hpp | 25 +++++++++++--------------
vm/master.hpp | 5 +++--
vm/stacks.hpp | 8 ++++----
vm/vm.hpp | 17 +++++++++++++++++
8 files changed, 38 insertions(+), 27 deletions(-)
mode change 100644 => 100755 vm/code_gc.hpp
mode change 100644 => 100755 vm/code_heap.hpp
diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp
old mode 100644
new mode 100755
index 1cfafb69c2..ed59cc5919
--- a/vm/code_gc.hpp
+++ b/vm/code_gc.hpp
@@ -14,7 +14,7 @@ struct heap {
heap_free_list free;
};
-typedef void (*heap_iterator)(heap_block *compiled);
+//typedef void (*heap_iterator)(heap_block *compiled);
void new_heap(heap *h, cell size);
void build_free_list(heap *h, cell size);
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
old mode 100644
new mode 100755
index 6f139a4728..a77a89b827
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -10,7 +10,7 @@ bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word, cell def, bool relocate);
-typedef void (*code_heap_iterator)(code_block *compiled);
+//typedef void (*code_heap_iterator)(code_block *compiled);
void iterate_code_heap(code_heap_iterator iter);
diff --git a/vm/jit.hpp b/vm/jit.hpp
index 50b40eca30..69ab0f9595 100644
--- a/vm/jit.hpp
+++ b/vm/jit.hpp
@@ -10,6 +10,7 @@ struct jit {
bool computing_offset_p;
fixnum position;
cell offset;
+ //factorvm *vm;
jit(cell jit_type, cell owner);
void compute_position(cell offset);
diff --git a/vm/local_roots.cpp b/vm/local_roots.cpp
index 7e1b2da76a..71baee6deb 100644
--- a/vm/local_roots.cpp
+++ b/vm/local_roots.cpp
@@ -2,9 +2,4 @@
namespace factor
{
-
-std::vector<cell> gc_locals;
-
-std::vector<cell> gc_bignums;
-
}
diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp
index d67622fc0a..ac9b322d5f 100644
--- a/vm/local_roots.hpp
+++ b/vm/local_roots.hpp
@@ -1,16 +1,14 @@
namespace factor
{
-/* If a runtime function needs to call another function which potentially
-allocates memory, it must wrap any local variable references to Factor
-objects in gc_root instances */
-extern std::vector<cell> gc_locals;
+struct factorvm;
template <typename T>
struct gc_root : public tagged<T>
{
- void push() { check_tagged_pointer(tagged<T>::value()); gc_locals.push_back((cell)this); }
+ void push() { check_tagged_pointer(tagged<T>::value()); vm->gc_locals.push_back((cell)this); }
+ //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<T>(value_) { push(); }
explicit gc_root(cell value_) : tagged<T>(value_) { push(); }
explicit gc_root(T *value_) : tagged<T>(value_) { push(); }
@@ -19,30 +17,29 @@ struct gc_root : public tagged<T>
~gc_root() {
#ifdef FACTOR_DEBUG
- assert(gc_locals.back() == (cell)this);
+ assert(vm->gc_locals.back() == (cell)this);
#endif
- gc_locals.pop_back();
+ vm->gc_locals.pop_back();
}
};
/* A similar hack for the bignum implementation */
-extern std::vector<cell> gc_bignums;
-
struct gc_bignum
{
bignum **addr;
-
- gc_bignum(bignum **addr_) : addr(addr_) {
+ factorvm *myvm;
+ //gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
+ gc_bignum(bignum **addr_) : addr(addr_), myvm(vm) {
if(*addr_)
check_data_pointer(*addr_);
- gc_bignums.push_back((cell)addr);
+ vm->gc_bignums.push_back((cell)addr);
}
~gc_bignum() {
#ifdef FACTOR_DEBUG
- assert(gc_bignums.back() == (cell)addr);
+ assert(vm->gc_bignums.back() == (cell)addr);
#endif
- gc_bignums.pop_back();
+ vm->gc_bignums.pop_back();
}
};
diff --git a/vm/master.hpp b/vm/master.hpp
index c1b62d41ff..2f9b19d12b 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -46,6 +46,8 @@
#include "errors.hpp"
#include "bignumint.hpp"
#include "bignum.hpp"
+#include "code_block.hpp"
+#include "vm.hpp"
#include "data_heap.hpp"
#include "write_barrier.hpp"
#include "data_gc.hpp"
@@ -62,7 +64,6 @@
#include "float_bits.hpp"
#include "io.hpp"
#include "code_gc.hpp"
-#include "code_block.hpp"
#include "code_heap.hpp"
#include "image.hpp"
#include "callstack.hpp"
@@ -74,6 +75,6 @@
#include "factor.hpp"
#include "utilities.hpp"
-#include "vm.hpp"
+
#endif /* __FACTOR_MASTER_H__ */
diff --git a/vm/stacks.hpp b/vm/stacks.hpp
index bc1aac8154..4906d107bc 100644
--- a/vm/stacks.hpp
+++ b/vm/stacks.hpp
@@ -2,15 +2,15 @@ namespace factor
{
#define DEFPUSHPOP(prefix,ptr) \
- inline static cell prefix##peek() { return *(cell *)ptr; } \
- inline static void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \
- inline static cell prefix##pop() \
+ inline cell prefix##peek() { return *(cell *)ptr; } \
+ inline void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \
+ inline cell prefix##pop() \
{ \
cell value = prefix##peek(); \
ptr -= sizeof(cell); \
return value; \
} \
- inline static void prefix##push(cell tagged) \
+ inline void prefix##push(cell tagged) \
{ \
ptr += sizeof(cell); \
prefix##repl(tagged); \
diff --git a/vm/vm.hpp b/vm/vm.hpp
index bae1b61c09..2326f23148 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -1,6 +1,19 @@
namespace factor
{
+struct heap;
+struct data_heap;
+struct data;
+struct zone;
+struct vm_parameters;
+struct image_header;
+
+typedef u8 card;
+typedef u8 card_deck;
+
+typedef void (*heap_iterator)(heap_block *compiled);
+typedef void (*code_heap_iterator)(code_block *compiled);
+
struct factorvm {
// contexts
@@ -174,6 +187,10 @@ struct factorvm {
inline void vmprim_become();
void inline_gc(cell *gc_roots_base, cell gc_roots_size);
+ // local roots
+ std::vector<cell> gc_locals;
+ std::vector<cell> gc_bignums;
+
//debug
void print_chars(string* str);
void print_word(word* word, cell nesting);
From 54b3c1ea8801cc65964486b6b841715c040100c1 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:09 +0100
Subject: [PATCH 045/266] added vm member to jit classes
---
vm/inline_cache.cpp | 4 ++--
vm/jit.cpp | 5 +++--
vm/jit.hpp | 4 ++--
vm/profiler.cpp | 2 +-
vm/quotations.cpp | 4 ++--
vm/quotations.hpp | 4 ++--
6 files changed, 12 insertions(+), 11 deletions(-)
mode change 100644 => 100755 vm/quotations.hpp
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index 05a977a67d..9e26f75ad9 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -103,7 +103,7 @@ void update_pic_count(cell type)
struct inline_cache_jit : public jit {
fixnum index;
- inline_cache_jit(cell generic_word_) : jit(PIC_TYPE,generic_word_) {};
+ inline_cache_jit(cell generic_word_,factorvm *vm) : jit(PIC_TYPE,generic_word_,vm) {};
void emit_check(cell klass);
void compile_inline_cache(fixnum index,
@@ -173,7 +173,7 @@ code_block *factorvm::compile_inline_cache(fixnum index,cell generic_word_,cell
gc_root<array> methods(methods_);
gc_root<array> cache_entries(cache_entries_);
- inline_cache_jit jit(generic_word.value());
+ inline_cache_jit jit(generic_word.value(),this);
jit.compile_inline_cache(index,
generic_word.value(),
methods.value(),
diff --git a/vm/jit.cpp b/vm/jit.cpp
index a3f222a953..104231f532 100644
--- a/vm/jit.cpp
+++ b/vm/jit.cpp
@@ -10,7 +10,7 @@ namespace factor
- polymorphic inline caches (inline_cache.cpp) */
/* Allocates memory */
-jit::jit(cell type_, cell owner_)
+jit::jit(cell type_, cell owner_, factorvm *vm)
: type(type_),
owner(owner_),
code(),
@@ -18,7 +18,8 @@ jit::jit(cell type_, cell owner_)
literals(),
computing_offset_p(false),
position(0),
- offset(0)
+ offset(0),
+ myvm(vm)
{
if(stack_traces_p()) literal(owner.value());
}
diff --git a/vm/jit.hpp b/vm/jit.hpp
index 69ab0f9595..0e3db90d38 100644
--- a/vm/jit.hpp
+++ b/vm/jit.hpp
@@ -10,9 +10,9 @@ struct jit {
bool computing_offset_p;
fixnum position;
cell offset;
- //factorvm *vm;
+ factorvm *myvm;
- jit(cell jit_type, cell owner);
+ jit(cell jit_type, cell owner, factorvm *vm);
void compute_position(cell offset);
void emit_relocation(cell code_template);
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index 054fe01537..de5da244a9 100755
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -20,7 +20,7 @@ code_block *factorvm::compile_profiling_stub(cell word_)
{
gc_root<word> word(word_);
- jit jit(WORD_TYPE,word.value());
+ jit jit(WORD_TYPE,word.value(),this);
jit.emit_with(userenv[JIT_PROFILING],word.value());
return jit.to_code_block();
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index a093e0e9df..4a1ad4d371 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -285,7 +285,7 @@ void factorvm::jit_compile(cell quot_, bool relocating)
gc_root<quotation> quot(quot_);
if(quot->code) return;
- quotation_jit compiler(quot.value(),true,relocating);
+ quotation_jit compiler(quot.value(),true,relocating,this);
compiler.iterate_quotation();
code_block *compiled = compiler.to_code_block();
@@ -368,7 +368,7 @@ fixnum factorvm::quot_code_offset_to_scan(cell quot_, cell offset)
gc_root<quotation> quot(quot_);
gc_root<array> array(quot->array);
- quotation_jit compiler(quot.value(),false,false);
+ quotation_jit compiler(quot.value(),false,false,this);
compiler.compute_position(offset);
compiler.iterate_quotation();
diff --git a/vm/quotations.hpp b/vm/quotations.hpp
old mode 100644
new mode 100755
index c1a2a92bd1..b70be4306e
--- a/vm/quotations.hpp
+++ b/vm/quotations.hpp
@@ -5,8 +5,8 @@ struct quotation_jit : public jit {
gc_root<array> elements;
bool compiling, relocate;
- quotation_jit(cell quot, bool compiling_, bool relocate_)
- : jit(QUOTATION_TYPE,quot),
+ quotation_jit(cell quot, bool compiling_, bool relocate_, factorvm *vm)
+ : jit(QUOTATION_TYPE,quot,vm),
elements(owner.as<quotation>().untagged()->array),
compiling(compiling_),
relocate(relocate_) {};
From a2f14b5a6d782525d6386e4b2391043ebba80182 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:09 +0100
Subject: [PATCH 046/266] added vm member to gc_root and growable arrays
---
vm/alien.cpp | 12 ++++++------
vm/arrays.cpp | 26 +++++++++++++-------------
vm/arrays.hpp | 3 +--
vm/byte_arrays.cpp | 2 +-
vm/byte_arrays.hpp | 2 +-
vm/callstack.cpp | 14 ++++++++------
vm/callstack.hpp | 2 +-
vm/code_block.cpp | 8 ++++----
vm/code_heap.cpp | 12 ++++++------
vm/data_gc.cpp | 2 +-
vm/data_heap.cpp | 6 +++---
vm/dispatch.cpp | 6 +++---
vm/factor.cpp | 2 +-
vm/generic_arrays.hpp | 2 +-
vm/image.cpp | 4 ++--
vm/inline_cache.cpp | 32 ++++++++++++++++----------------
vm/io.cpp | 6 +++---
vm/jit.cpp | 18 +++++++++---------
vm/jit.hpp | 4 ++--
vm/local_roots.hpp | 20 +++++++++++---------
vm/profiler.cpp | 4 ++--
vm/quotations.cpp | 14 +++++++-------
vm/quotations.hpp | 4 ++--
vm/run.cpp | 2 +-
vm/strings.cpp | 10 +++++-----
vm/tuples.cpp | 10 +++++-----
vm/words.cpp | 8 ++++----
27 files changed, 119 insertions(+), 116 deletions(-)
mode change 100644 => 100755 vm/arrays.hpp
mode change 100644 => 100755 vm/byte_arrays.hpp
mode change 100644 => 100755 vm/callstack.hpp
mode change 100644 => 100755 vm/image.cpp
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 3a99d89afb..0419e3cec3 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -32,8 +32,8 @@ char *pinned_alien_offset(cell obj)
/* make an alien */
cell factorvm::allot_alien(cell delegate_, cell displacement)
{
- gc_root<object> delegate(delegate_);
- gc_root<alien> new_alien(allot<alien>(sizeof(alien)));
+ gc_root<object> delegate(delegate_,this);
+ gc_root<alien> new_alien(allot<alien>(sizeof(alien)),this);
if(delegate.type_p(ALIEN_TYPE))
{
@@ -138,9 +138,9 @@ DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
/* open a native library and push a handle */
inline void factorvm::vmprim_dlopen()
{
- gc_root<byte_array> path(dpop());
+ gc_root<byte_array> path(dpop(),this);
path.untag_check();
- gc_root<dll> library(allot<dll>(sizeof(dll)));
+ gc_root<dll> library(allot<dll>(sizeof(dll)),this);
library->path = path.value();
ffi_dlopen(library.untagged());
dpush(library.value());
@@ -154,8 +154,8 @@ PRIMITIVE(dlopen)
/* look up a symbol in a native library */
inline void factorvm::vmprim_dlsym()
{
- gc_root<object> library(dpop());
- gc_root<byte_array> name(dpop());
+ gc_root<object> library(dpop(),this);
+ gc_root<byte_array> name(dpop(),this);
name.untag_check();
symbol_char *sym = name->data<symbol_char>();
diff --git a/vm/arrays.cpp b/vm/arrays.cpp
index 236f2d9c54..6d09a11c7d 100644
--- a/vm/arrays.cpp
+++ b/vm/arrays.cpp
@@ -6,8 +6,8 @@ namespace factor
/* make a new array with an initial element */
array *factorvm::allot_array(cell capacity, cell fill_)
{
- gc_root<object> fill(fill_);
- gc_root<array> new_array(allot_array_internal<array>(capacity));
+ gc_root<object> fill(fill_,this);
+ gc_root<array> new_array(allot_array_internal<array>(capacity),this);
if(fill.value() == tag_fixnum(0))
memset(new_array->data(),'\0',capacity * sizeof(cell));
@@ -43,8 +43,8 @@ PRIMITIVE(array)
cell factorvm::allot_array_1(cell obj_)
{
- gc_root<object> obj(obj_);
- gc_root<array> a(allot_array_internal<array>(1));
+ gc_root<object> obj(obj_,this);
+ gc_root<array> a(allot_array_internal<array>(1),this);
set_array_nth(a.untagged(),0,obj.value());
return a.value();
}
@@ -56,9 +56,9 @@ cell allot_array_1(cell obj_)
cell factorvm::allot_array_2(cell v1_, cell v2_)
{
- gc_root<object> v1(v1_);
- gc_root<object> v2(v2_);
- gc_root<array> a(allot_array_internal<array>(2));
+ gc_root<object> v1(v1_,this);
+ gc_root<object> v2(v2_,this);
+ gc_root<array> a(allot_array_internal<array>(2),this);
set_array_nth(a.untagged(),0,v1.value());
set_array_nth(a.untagged(),1,v2.value());
return a.value();
@@ -71,11 +71,11 @@ cell allot_array_2(cell v1_, cell v2_)
cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
{
- gc_root<object> v1(v1_);
- gc_root<object> v2(v2_);
- gc_root<object> v3(v3_);
- gc_root<object> v4(v4_);
- gc_root<array> a(allot_array_internal<array>(4));
+ gc_root<object> v1(v1_,this);
+ gc_root<object> v2(v2_,this);
+ gc_root<object> v3(v3_,this);
+ gc_root<object> v4(v4_,this);
+ gc_root<array> a(allot_array_internal<array>(4),this);
set_array_nth(a.untagged(),0,v1.value());
set_array_nth(a.untagged(),1,v2.value());
set_array_nth(a.untagged(),2,v3.value());
@@ -102,7 +102,7 @@ PRIMITIVE(resize_array)
void growable_array::add(cell elt_)
{
- gc_root<object> elt(elt_);
+ gc_root<object> elt(elt_,elements.myvm);
if(count == array_capacity(elements.untagged()))
elements = reallot_array(elements.untagged(),count * 2);
diff --git a/vm/arrays.hpp b/vm/arrays.hpp
old mode 100644
new mode 100755
index 06e6ed6e4d..ab4ad61a71
--- a/vm/arrays.hpp
+++ b/vm/arrays.hpp
@@ -1,6 +1,5 @@
namespace factor
{
-
inline static cell array_nth(array *array, cell slot)
{
#ifdef FACTOR_DEBUG
@@ -34,7 +33,7 @@ struct growable_array {
cell count;
gc_root<array> elements;
- growable_array(cell capacity = 10) : count(0), elements(allot_array(capacity,F)) {}
+ growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(allot_array(capacity,F),myvm) {}
void add(cell elt);
void trim();
diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp
index 495e5211a7..39ca778147 100644
--- a/vm/byte_arrays.cpp
+++ b/vm/byte_arrays.cpp
@@ -63,7 +63,7 @@ void growable_byte_array::append_bytes(void *elts, cell len)
void growable_byte_array::append_byte_array(cell byte_array_)
{
- gc_root<byte_array> byte_array(byte_array_);
+ gc_root<byte_array> byte_array(byte_array_,elements.myvm);
cell len = array_capacity(byte_array.untagged());
cell new_size = count + len;
diff --git a/vm/byte_arrays.hpp b/vm/byte_arrays.hpp
old mode 100644
new mode 100755
index 6de8ee4e9f..68b706be7b
--- a/vm/byte_arrays.hpp
+++ b/vm/byte_arrays.hpp
@@ -11,7 +11,7 @@ struct growable_byte_array {
cell count;
gc_root<byte_array> elements;
- growable_byte_array(cell capacity = 40) : count(0), elements(allot_byte_array(capacity)) { }
+ growable_byte_array(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
void append_bytes(void *elts, cell len);
void append_byte_array(cell elts);
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index e82314b8d2..e4f03abca9 100755
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -192,10 +192,12 @@ namespace
struct stack_frame_accumulator {
growable_array frames;
+ stack_frame_accumulator(factorvm *vm) : frames(vm) {}
+
void operator()(stack_frame *frame)
{
- gc_root<object> executing(frame_executing(frame));
- gc_root<object> scan(frame_scan(frame));
+ gc_root<object> executing(frame_executing(frame),frames.elements.myvm);
+ gc_root<object> scan(frame_scan(frame),frames.elements.myvm);
frames.add(executing.value());
frames.add(scan.value());
@@ -206,9 +208,9 @@ struct stack_frame_accumulator {
inline void factorvm::vmprim_callstack_to_array()
{
- gc_root<callstack> callstack(dpop());
+ gc_root<callstack> callstack(dpop(),this);
- stack_frame_accumulator accum;
+ stack_frame_accumulator accum(this);
iterate_callstack_object(callstack.untagged(),accum);
accum.frames.trim();
@@ -273,8 +275,8 @@ PRIMITIVE(innermost_stack_frame_scan)
inline void factorvm::vmprim_set_innermost_stack_frame_quot()
{
- gc_root<callstack> callstack(dpop());
- gc_root<quotation> quot(dpop());
+ gc_root<callstack> callstack(dpop(),this);
+ gc_root<quotation> quot(dpop(),this);
callstack.untag_check();
quot.untag_check();
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
old mode 100644
new mode 100755
index a3cc058e2b..ea62f6da4b
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -37,7 +37,7 @@ template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
keep the callstack in a GC root and use relative offsets */
template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
{
- gc_root<callstack> stack(stack_);
+ gc_root<callstack> stack(stack_,vm);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
while(frame_offset >= 0)
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index ff569328be..d5aa7581c2 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -638,10 +638,10 @@ code_block *allot_code_block(cell size)
/* Might GC */
code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
{
- gc_root<byte_array> code(code_);
- gc_root<object> labels(labels_);
- gc_root<byte_array> relocation(relocation_);
- gc_root<array> literals(literals_);
+ gc_root<byte_array> code(code_,this);
+ gc_root<object> labels(labels_,this);
+ gc_root<byte_array> relocation(relocation_,this);
+ gc_root<array> literals(literals_,this);
cell code_length = align8(array_capacity(code.untagged()));
code_block *compiled = allot_code_block(code_length);
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 53eb011a9d..943ee8d7c0 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -29,8 +29,8 @@ bool in_code_heap_p(cell ptr)
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
{
- gc_root<word> word(word_);
- gc_root<quotation> def(def_);
+ gc_root<word> word(word_,this);
+ gc_root<quotation> def(def_,this);
jit_compile(def.value(),relocate);
@@ -89,7 +89,7 @@ void update_code_heap_words()
inline void factorvm::vmprim_modify_code_heap()
{
- gc_root<array> alist(dpop());
+ gc_root<array> alist(dpop(),this);
cell count = array_capacity(alist.untagged());
@@ -99,10 +99,10 @@ inline void factorvm::vmprim_modify_code_heap()
cell i;
for(i = 0; i < count; i++)
{
- gc_root<array> pair(array_nth(alist.untagged(),i));
+ gc_root<array> pair(array_nth(alist.untagged(),i),this);
- gc_root<word> word(array_nth(pair.untagged(),0));
- gc_root<object> data(array_nth(pair.untagged(),1));
+ gc_root<word> word(array_nth(pair.untagged(),0),this);
+ gc_root<object> data(array_nth(pair.untagged(),1),this);
switch(data.type())
{
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index 35d6812290..ea7098912e 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -730,7 +730,7 @@ PRIMITIVE(gc)
inline void factorvm::vmprim_gc_stats()
{
- growable_array result;
+ growable_array result(this);
cell i;
u64 total_gc_time = 0;
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index 9069621e52..377cd6e943 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -358,7 +358,7 @@ inline void factorvm::vmprim_data_room()
dpush(tag_fixnum((data->cards_end - data->cards) >> 10));
dpush(tag_fixnum((data->decks_end - data->decks) >> 10));
- growable_array a;
+ growable_array a(this);
cell gen;
for(gen = 0; gen < data->gen_count; gen++)
@@ -478,7 +478,7 @@ struct word_counter {
struct word_accumulator {
growable_array words;
- word_accumulator(int count) : words(count) {}
+ word_accumulator(int count,factorvm *vm) : words(vm,count) {}
void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); }
};
@@ -488,7 +488,7 @@ cell factorvm::find_all_words()
{
word_counter counter;
each_object(counter);
- word_accumulator accum(counter.count);
+ word_accumulator accum(counter.count,this);
each_object(accum);
accum.words.trim();
return accum.words.elements.value();
diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp
index fbfc0f79cf..1721efe181 100755
--- a/vm/dispatch.cpp
+++ b/vm/dispatch.cpp
@@ -244,7 +244,7 @@ PRIMITIVE(reset_dispatch_stats)
inline void factorvm::vmprim_dispatch_stats()
{
- growable_array stats;
+ growable_array stats(this);
stats.add(allot_cell(megamorphic_cache_hits));
stats.add(allot_cell(megamorphic_cache_misses));
stats.trim();
@@ -258,8 +258,8 @@ PRIMITIVE(dispatch_stats)
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)
{
- gc_root<array> methods(methods_);
- gc_root<array> cache(cache_);
+ gc_root<array> methods(methods_,myvm);
+ gc_root<array> cache(cache_,myvm);
/* Generate machine code to determine the object's class. */
emit_class_lookup(index,PIC_HI_TAG_TUPLE);
diff --git a/vm/factor.cpp b/vm/factor.cpp
index a75f8da8c2..55d7abcc49 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -179,7 +179,7 @@ VM_C_API void init_factor(vm_parameters *p)
/* May allocate memory */
void factorvm::pass_args_to_factor(int argc, vm_char **argv)
{
- growable_array args;
+ growable_array args(this);
int i;
for(i = 1; i < argc; i++)
diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp
index 26c8149a10..6d85e4569a 100644
--- a/vm/generic_arrays.hpp
+++ b/vm/generic_arrays.hpp
@@ -33,7 +33,7 @@ template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
template <typename T> T *reallot_array(T *array_, cell capacity)
{
- gc_root<T> array(array_);
+ gc_root<T> array(array_,vm);
if(reallot_array_in_place_p(array.untagged(),capacity))
{
diff --git a/vm/image.cpp b/vm/image.cpp
old mode 100644
new mode 100755
index 7724e28f72..24988b24b5
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -147,7 +147,7 @@ inline void factorvm::vmprim_save_image()
/* do a full GC to push everything into tenured space */
gc();
- gc_root<byte_array> path(dpop());
+ gc_root<byte_array> path(dpop(),this);
path.untag_check();
save_image((vm_char *)(path.untagged() + 1));
}
@@ -162,7 +162,7 @@ inline void factorvm::vmprim_save_image_and_exit()
/* We unbox this before doing anything else. This is the only point
where we might throw an error, so we have to throw an error here since
later steps destroy the current image. */
- gc_root<byte_array> path(dpop());
+ gc_root<byte_array> path(dpop(),this);
path.untag_check();
/* strip out userenv data which is set on startup anyway */
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index 9e26f75ad9..b6a90b1ff4 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -132,9 +132,9 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
cell cache_entries_,
bool tail_call_p)
{
- gc_root<word> generic_word(generic_word_);
- gc_root<array> methods(methods_);
- gc_root<array> cache_entries(cache_entries_);
+ gc_root<word> generic_word(generic_word_,myvm);
+ gc_root<array> methods(methods_,myvm);
+ gc_root<array> cache_entries(cache_entries_,myvm);
cell inline_cache_type = determine_inline_cache_type(cache_entries.untagged());
update_pic_count(inline_cache_type);
@@ -169,9 +169,9 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
code_block *factorvm::compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
{
- gc_root<word> generic_word(generic_word_);
- gc_root<array> methods(methods_);
- gc_root<array> cache_entries(cache_entries_);
+ gc_root<word> generic_word(generic_word_,this);
+ gc_root<array> methods(methods_,this);
+ gc_root<array> cache_entries(cache_entries_,this);
inline_cache_jit jit(generic_word.value(),this);
jit.compile_inline_cache(index,
@@ -213,12 +213,12 @@ cell inline_cache_size(cell cache_entries)
/* Allocates memory */
cell factorvm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
{
- gc_root<array> cache_entries(cache_entries_);
- gc_root<object> klass(klass_);
- gc_root<word> method(method_);
+ gc_root<array> cache_entries(cache_entries_,this);
+ gc_root<object> klass(klass_,this);
+ gc_root<word> method(method_,this);
cell pic_size = array_capacity(cache_entries.untagged());
- gc_root<array> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2));
+ gc_root<array> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2),this);
set_array_nth(new_cache_entries.untagged(),pic_size,klass.value());
set_array_nth(new_cache_entries.untagged(),pic_size + 1,method.value());
return new_cache_entries.value();
@@ -255,11 +255,11 @@ void *factorvm::inline_cache_miss(cell return_address)
instead of leaving dead PICs around until the next GC. */
deallocate_inline_cache(return_address);
- gc_root<array> cache_entries(dpop());
+ gc_root<array> cache_entries(dpop(),this);
fixnum index = untag_fixnum(dpop());
- gc_root<array> methods(dpop());
- gc_root<word> generic_word(dpop());
- gc_root<object> object(((cell *)ds)[-index]);
+ gc_root<array> methods(dpop(),this);
+ gc_root<word> generic_word(dpop(),this);
+ gc_root<object> object(((cell *)ds)[-index],this);
void *xt;
@@ -277,7 +277,7 @@ void *factorvm::inline_cache_miss(cell return_address)
gc_root<array> new_cache_entries(add_inline_cache_entry(
cache_entries.value(),
klass,
- method));
+ method),this);
xt = compile_inline_cache(index,
generic_word.value(),
methods.value(),
@@ -317,7 +317,7 @@ PRIMITIVE(reset_inline_cache_stats)
inline void factorvm::vmprim_inline_cache_stats()
{
- growable_array stats;
+ growable_array stats(this);
stats.add(allot_cell(cold_call_to_ic_transitions));
stats.add(allot_cell(ic_to_pic_transitions));
stats.add(allot_cell(pic_to_mega_transitions));
diff --git a/vm/io.cpp b/vm/io.cpp
index 570a9a2633..93ae005b6a 100755
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -43,8 +43,8 @@ void io_error()
inline void factorvm::vmprim_fopen()
{
- gc_root<byte_array> mode(dpop());
- gc_root<byte_array> path(dpop());
+ gc_root<byte_array> mode(dpop(),this);
+ gc_root<byte_array> path(dpop(),this);
mode.untag_check();
path.untag_check();
@@ -108,7 +108,7 @@ inline void factorvm::vmprim_fread()
return;
}
- gc_root<byte_array> buf(allot_array_internal<byte_array>(size));
+ gc_root<byte_array> buf(allot_array_internal<byte_array>(size),this);
for(;;)
{
diff --git a/vm/jit.cpp b/vm/jit.cpp
index 104231f532..9757e54dc4 100644
--- a/vm/jit.cpp
+++ b/vm/jit.cpp
@@ -12,10 +12,10 @@ namespace factor
/* Allocates memory */
jit::jit(cell type_, cell owner_, factorvm *vm)
: type(type_),
- owner(owner_),
- code(),
- relocation(),
- literals(),
+ owner(owner_,vm),
+ code(vm),
+ relocation(vm),
+ literals(vm),
computing_offset_p(false),
position(0),
offset(0),
@@ -26,7 +26,7 @@ jit::jit(cell type_, cell owner_, factorvm *vm)
void jit::emit_relocation(cell code_template_)
{
- gc_root<array> code_template(code_template_);
+ gc_root<array> code_template(code_template_,myvm);
cell capacity = array_capacity(code_template.untagged());
for(cell i = 1; i < capacity; i += 3)
{
@@ -45,11 +45,11 @@ void jit::emit_relocation(cell code_template_)
/* Allocates memory */
void jit::emit(cell code_template_)
{
- gc_root<array> code_template(code_template_);
+ gc_root<array> code_template(code_template_,myvm);
emit_relocation(code_template.value());
- gc_root<byte_array> insns(array_nth(code_template.untagged(),0));
+ gc_root<byte_array> insns(array_nth(code_template.untagged(),0),myvm);
if(computing_offset_p)
{
@@ -73,8 +73,8 @@ void jit::emit(cell code_template_)
}
void jit::emit_with(cell code_template_, cell argument_) {
- gc_root<array> code_template(code_template_);
- gc_root<object> argument(argument_);
+ gc_root<array> code_template(code_template_,myvm);
+ gc_root<object> argument(argument_,myvm);
literal(argument.value());
emit(code_template.value());
}
diff --git a/vm/jit.hpp b/vm/jit.hpp
index 0e3db90d38..0fa145cded 100644
--- a/vm/jit.hpp
+++ b/vm/jit.hpp
@@ -40,8 +40,8 @@ struct jit {
}
void emit_subprimitive(cell word_) {
- gc_root<word> word(word_);
- gc_root<array> code_template(word->subprimitive);
+ gc_root<word> word(word_,myvm);
+ gc_root<array> code_template(word->subprimitive,myvm);
if(array_capacity(code_template.untagged()) > 1) literal(T);
emit(code_template.value());
}
diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp
index ac9b322d5f..e0b33a4d1d 100644
--- a/vm/local_roots.hpp
+++ b/vm/local_roots.hpp
@@ -3,17 +3,19 @@ namespace factor
struct factorvm;
-template <typename T>
-struct gc_root : public tagged<T>
+template <typename TYPE>
+struct gc_root : public tagged<TYPE>
{
- void push() { check_tagged_pointer(tagged<T>::value()); vm->gc_locals.push_back((cell)this); }
-
- //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<T>(value_) { push(); }
- explicit gc_root(cell value_) : tagged<T>(value_) { push(); }
- explicit gc_root(T *value_) : tagged<T>(value_) { push(); }
+ factorvm *myvm;
- const gc_root<T>& operator=(const T *x) { tagged<T>::operator=(x); return *this; }
- const gc_root<T>& operator=(const cell &x) { tagged<T>::operator=(x); return *this; }
+ void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
+
+ //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
+ explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
+ explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
+
+ const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
+ const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
~gc_root() {
#ifdef FACTOR_DEBUG
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index de5da244a9..e87dd947fd 100755
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -18,7 +18,7 @@ void init_profiler()
/* Allocates memory */
code_block *factorvm::compile_profiling_stub(cell word_)
{
- gc_root<word> word(word_);
+ gc_root<word> word(word_,this);
jit jit(WORD_TYPE,word.value(),this);
jit.emit_with(userenv[JIT_PROFILING],word.value());
@@ -43,7 +43,7 @@ void factorvm::set_profiling(bool profiling)
and allocate profiling blocks if necessary */
gc();
- gc_root<array> words(find_all_words());
+ gc_root<array> words(find_all_words(),this);
cell i;
cell length = array_capacity(words.untagged());
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 4a1ad4d371..0237651e17 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -125,7 +125,7 @@ void quotation_jit::iterate_quotation()
{
set_position(i);
- gc_root<object> obj(array_nth(elements.untagged(),i));
+ gc_root<object> obj(array_nth(elements.untagged(),i),myvm);
switch(obj.type())
{
@@ -282,7 +282,7 @@ void set_quot_xt(quotation *quot, code_block *code)
/* Allocates memory */
void factorvm::jit_compile(cell quot_, bool relocating)
{
- gc_root<quotation> quot(quot_);
+ gc_root<quotation> quot(quot_,this);
if(quot->code) return;
quotation_jit compiler(quot.value(),true,relocating,this);
@@ -339,13 +339,13 @@ PRIMITIVE(quotation_xt)
void factorvm::compile_all_words()
{
- gc_root<array> words(find_all_words());
+ gc_root<array> words(find_all_words(),this);
cell i;
cell length = array_capacity(words.untagged());
for(i = 0; i < length; i++)
{
- gc_root<word> word(array_nth(words.untagged(),i));
+ gc_root<word> word(array_nth(words.untagged(),i),this);
if(!word->code || !word_optimized_p(word.untagged()))
jit_compile_word(word.value(),word->def,false);
@@ -365,8 +365,8 @@ void compile_all_words()
/* Allocates memory */
fixnum factorvm::quot_code_offset_to_scan(cell quot_, cell offset)
{
- gc_root<quotation> quot(quot_);
- gc_root<array> array(quot->array);
+ gc_root<quotation> quot(quot_,this);
+ gc_root<array> array(quot->array,this);
quotation_jit compiler(quot.value(),false,false,this);
compiler.compute_position(offset);
@@ -382,7 +382,7 @@ fixnum quot_code_offset_to_scan(cell quot_, cell offset)
cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
{
- gc_root<quotation> quot(quot_);
+ gc_root<quotation> quot(quot_,this);
stack_chain->callstack_top = stack;
jit_compile(quot.value(),true);
return quot.value();
diff --git a/vm/quotations.hpp b/vm/quotations.hpp
index b70be4306e..dad41917e0 100755
--- a/vm/quotations.hpp
+++ b/vm/quotations.hpp
@@ -7,9 +7,9 @@ struct quotation_jit : public jit {
quotation_jit(cell quot, bool compiling_, bool relocate_, factorvm *vm)
: jit(QUOTATION_TYPE,quot,vm),
- elements(owner.as<quotation>().untagged()->array),
+ elements(owner.as<quotation>().untagged()->array,vm),
compiling(compiling_),
- relocate(relocate_) {};
+ relocate(relocate_){};
void emit_mega_cache_lookup(cell methods, fixnum index, cell cache);
bool primitive_call_p(cell i);
diff --git a/vm/run.cpp b/vm/run.cpp
index 0a14d4f017..e0ad1abb12 100755
--- a/vm/run.cpp
+++ b/vm/run.cpp
@@ -90,7 +90,7 @@ PRIMITIVE(load_locals)
cell factorvm::clone_object(cell obj_)
{
- gc_root<object> obj(obj_);
+ gc_root<object> obj(obj_,this);
if(immediate_p(obj.value()))
return obj.value();
diff --git a/vm/strings.cpp b/vm/strings.cpp
index 7e0506a519..a8962ee921 100644
--- a/vm/strings.cpp
+++ b/vm/strings.cpp
@@ -39,7 +39,7 @@ void set_string_nth_fast(string *str, cell index, cell ch)
void factorvm::set_string_nth_slow(string *str_, cell index, cell ch)
{
- gc_root<string> str(str_);
+ gc_root<string> str(str_,this);
byte_array *aux;
@@ -103,7 +103,7 @@ string *allot_string_internal(cell capacity)
/* Allocates memory */
void factorvm::fill_string(string *str_, cell start, cell capacity, cell fill)
{
- gc_root<string> str(str_);
+ gc_root<string> str(str_,this);
if(fill <= 0x7f)
memset(&str->data()[start],fill,capacity - start);
@@ -124,7 +124,7 @@ void fill_string(string *str_, cell start, cell capacity, cell fill)
/* Allocates memory */
string *factorvm::allot_string(cell capacity, cell fill)
{
- gc_root<string> str(allot_string_internal(capacity));
+ gc_root<string> str(allot_string_internal(capacity),this);
fill_string(str.untagged(),0,capacity,fill);
return str.untagged();
}
@@ -160,7 +160,7 @@ bool reallot_string_in_place_p(string *str, cell capacity)
string* factorvm::reallot_string(string *str_, cell capacity)
{
- gc_root<string> str(str_);
+ gc_root<string> str(str_,this);
if(reallot_string_in_place_p(str.untagged(),capacity))
{
@@ -180,7 +180,7 @@ string* factorvm::reallot_string(string *str_, cell capacity)
if(capacity < to_copy)
to_copy = capacity;
- gc_root<string> new_str(allot_string_internal(capacity));
+ gc_root<string> new_str(allot_string_internal(capacity),this);
memcpy(new_str->data(),str->data(),to_copy);
diff --git a/vm/tuples.cpp b/vm/tuples.cpp
index c38832ac0b..5c4c6e17b0 100644
--- a/vm/tuples.cpp
+++ b/vm/tuples.cpp
@@ -6,8 +6,8 @@ namespace factor
/* push a new tuple on the stack */
tuple *factorvm::allot_tuple(cell layout_)
{
- gc_root<tuple_layout> layout(layout_);
- gc_root<tuple> t(allot<tuple>(tuple_size(layout.untagged())));
+ gc_root<tuple_layout> layout(layout_,this);
+ gc_root<tuple> t(allot<tuple>(tuple_size(layout.untagged())),this);
t->layout = layout.value();
return t.untagged();
}
@@ -19,7 +19,7 @@ tuple *allot_tuple(cell layout_)
inline void factorvm::vmprim_tuple()
{
- gc_root<tuple_layout> layout(dpop());
+ gc_root<tuple_layout> layout(dpop(),this);
tuple *t = allot_tuple(layout.value());
fixnum i;
for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--)
@@ -36,8 +36,8 @@ PRIMITIVE(tuple)
/* push a new tuple on the stack, filling its slots from the stack */
inline void factorvm::vmprim_tuple_boa()
{
- gc_root<tuple_layout> layout(dpop());
- gc_root<tuple> t(allot_tuple(layout.value()));
+ gc_root<tuple_layout> layout(dpop(),this);
+ gc_root<tuple> t(allot_tuple(layout.value()),this);
cell size = untag_fixnum(layout.untagged()->size) * sizeof(cell);
memcpy(t->data(),(cell *)(ds - (size - sizeof(cell))),size);
ds -= size;
diff --git a/vm/words.cpp b/vm/words.cpp
index 644db46896..68b6afd9d0 100644
--- a/vm/words.cpp
+++ b/vm/words.cpp
@@ -5,10 +5,10 @@ namespace factor
word *factorvm::allot_word(cell vocab_, cell name_)
{
- gc_root<object> vocab(vocab_);
- gc_root<object> name(name_);
+ gc_root<object> vocab(vocab_,this);
+ gc_root<object> name(name_,this);
- gc_root<word> new_word(allot<word>(sizeof(word)));
+ gc_root<word> new_word(allot<word>(sizeof(word)),this);
new_word->hashcode = tag_fixnum((rand() << 16) ^ rand());
new_word->vocabulary = vocab.value();
@@ -66,7 +66,7 @@ PRIMITIVE(word_xt)
/* Allocates memory */
void factorvm::update_word_xt(cell w_)
{
- gc_root<word> w(w_);
+ gc_root<word> w(w_,this);
if(profiling_p)
{
From e678f6a68158d62af2a14a011708ad8dbeeb992f Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:10 +0100
Subject: [PATCH 047/266] added vm member to gc_bignum
---
vm/bignum.cpp | 34 +++++++++++++++++-----------------
vm/local_roots.hpp | 15 +++++++--------
vm/math.cpp | 4 ++--
3 files changed, 26 insertions(+), 27 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index a5310d1c14..62d9952364 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -554,7 +554,7 @@ enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y)
/* allocates memory */
bignum *factorvm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
{
- GC_BIGNUM(x); GC_BIGNUM(y);
+ GC_BIGNUM(x,this); GC_BIGNUM(y,this);
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{
@@ -626,7 +626,7 @@ bignum *bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
/* allocates memory */
bignum *factorvm::bignum_subtract_unsigned(bignum * x, bignum * y)
{
- GC_BIGNUM(x); GC_BIGNUM(y);
+ GC_BIGNUM(x,this); GC_BIGNUM(y,this);
int negative_p = 0;
switch (bignum_compare_unsigned (x, y))
@@ -709,7 +709,7 @@ bignum *bignum_subtract_unsigned(bignum * x, bignum * y)
/* allocates memory */
bignum *factorvm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
{
- GC_BIGNUM(x); GC_BIGNUM(y);
+ GC_BIGNUM(x,this); GC_BIGNUM(y,this);
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{
@@ -785,7 +785,7 @@ bignum *bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
/* allocates memory */
bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
{
- GC_BIGNUM(x);
+ GC_BIGNUM(x,this);
bignum_length_type length_x = (BIGNUM_LENGTH (x));
@@ -874,7 +874,7 @@ void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
/* allocates memory */
void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
{
- GC_BIGNUM(numerator); GC_BIGNUM(denominator);
+ GC_BIGNUM(numerator,this); GC_BIGNUM(denominator,this);
bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
@@ -883,10 +883,10 @@ void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bign
((quotient != ((bignum * *) 0))
? (allot_bignum ((length_n - length_d), q_negative_p))
: BIGNUM_OUT_OF_BAND);
- GC_BIGNUM(q);
+ GC_BIGNUM(q,this);
bignum * u = (allot_bignum (length_n, r_negative_p));
- GC_BIGNUM(u);
+ GC_BIGNUM(u,this);
int shift = 0;
BIGNUM_ASSERT (length_d > 1);
@@ -1096,12 +1096,12 @@ bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_dig
/* allocates memory */
void factorvm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
{
- GC_BIGNUM(numerator);
+ GC_BIGNUM(numerator,this);
bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
bignum_length_type length_q;
bignum * q = NULL;
- GC_BIGNUM(q);
+ GC_BIGNUM(q,this);
int shift = 0;
/* Because `bignum_digit_divide' requires a normalized denominator. */
@@ -1351,10 +1351,10 @@ bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digi
/* allocates memory */
void factorvm::bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
{
- GC_BIGNUM(numerator);
+ GC_BIGNUM(numerator,this);
bignum * q = (bignum_new_sign (numerator, q_negative_p));
- GC_BIGNUM(q);
+ GC_BIGNUM(q,this);
bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
@@ -1525,7 +1525,7 @@ bignum *bignum_trim(bignum * bignum)
/* allocates memory */
bignum *factorvm::bignum_new_sign(bignum * x, int negative_p)
{
- GC_BIGNUM(x);
+ GC_BIGNUM(x,this);
bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
bignum_destructive_copy (x, result);
@@ -1667,7 +1667,7 @@ bignum *bignum_bitwise_xor(bignum * arg1, bignum * arg2)
/* assume arg1 is a big number, n is a long */
bignum *factorvm::bignum_magnitude_ash(bignum * arg1, fixnum n)
{
- GC_BIGNUM(arg1);
+ GC_BIGNUM(arg1,this);
bignum * result = NULL;
bignum_digit_type *scan1;
@@ -1733,7 +1733,7 @@ bignum *bignum_magnitude_ash(bignum * arg1, fixnum n)
/* allocates memory */
bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
- GC_BIGNUM(arg1); GC_BIGNUM(arg2);
+ GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
bignum * result;
bignum_length_type max_length;
@@ -1772,7 +1772,7 @@ bignum *bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
/* allocates memory */
bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
- GC_BIGNUM(arg1); GC_BIGNUM(arg2);
+ GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
bignum * result;
bignum_length_type max_length;
@@ -1829,7 +1829,7 @@ bignum *bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
/* allocates memory */
bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
- GC_BIGNUM(arg1); GC_BIGNUM(arg2);
+ GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
bignum * result;
bignum_length_type max_length;
@@ -1926,7 +1926,7 @@ void bignum_negate_magnitude(bignum * arg)
/* Allocates memory */
bignum *factorvm::bignum_integer_length(bignum * x)
{
- GC_BIGNUM(x);
+ GC_BIGNUM(x,this);
bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
bignum_digit_type digit = (BIGNUM_REF (x, index));
diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp
index e0b33a4d1d..26d083be40 100644
--- a/vm/local_roots.hpp
+++ b/vm/local_roots.hpp
@@ -19,9 +19,9 @@ struct gc_root : public tagged<TYPE>
~gc_root() {
#ifdef FACTOR_DEBUG
- assert(vm->gc_locals.back() == (cell)this);
+ assert(myvm->gc_locals.back() == (cell)this);
#endif
- vm->gc_locals.pop_back();
+ myvm->gc_locals.pop_back();
}
};
@@ -30,21 +30,20 @@ struct gc_bignum
{
bignum **addr;
factorvm *myvm;
- //gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
- gc_bignum(bignum **addr_) : addr(addr_), myvm(vm) {
+ gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
if(*addr_)
check_data_pointer(*addr_);
- vm->gc_bignums.push_back((cell)addr);
+ myvm->gc_bignums.push_back((cell)addr);
}
~gc_bignum() {
#ifdef FACTOR_DEBUG
- assert(vm->gc_bignums.back() == (cell)addr);
+ assert(myvm->gc_bignums.back() == (cell)addr);
#endif
- vm->gc_bignums.pop_back();
+ myvm->gc_bignums.pop_back();
}
};
-#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x)
+#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
}
diff --git a/vm/math.cpp b/vm/math.cpp
index ac04e906a2..f273cede0e 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -863,9 +863,9 @@ VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
{
bignum *bx = fixnum_to_bignum(x);
- GC_BIGNUM(bx);
+ GC_BIGNUM(bx,this);
bignum *by = fixnum_to_bignum(y);
- GC_BIGNUM(by);
+ GC_BIGNUM(by,this);
drepl(tag<bignum>(bignum_multiply(bx,by)));
}
From 1b6415599879d1dead5175c4b9767289a7bcf502 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:10 +0100
Subject: [PATCH 048/266] moved reallot_array into vm
---
vm/arrays.cpp | 8 +++++---
vm/byte_arrays.cpp | 11 ++++++-----
vm/generic_arrays.hpp | 12 ++++++------
vm/vm.hpp | 4 ++++
4 files changed, 21 insertions(+), 14 deletions(-)
diff --git a/vm/arrays.cpp b/vm/arrays.cpp
index 6d09a11c7d..8d964c4d21 100644
--- a/vm/arrays.cpp
+++ b/vm/arrays.cpp
@@ -102,16 +102,18 @@ PRIMITIVE(resize_array)
void growable_array::add(cell elt_)
{
- gc_root<object> elt(elt_,elements.myvm);
+ factorvm* myvm = elements.myvm;
+ gc_root<object> elt(elt_,myvm);
if(count == array_capacity(elements.untagged()))
- elements = reallot_array(elements.untagged(),count * 2);
+ elements = myvm->reallot_array(elements.untagged(),count * 2);
set_array_nth(elements.untagged(),count++,elt.value());
}
void growable_array::trim()
{
- elements = reallot_array(elements.untagged(),count);
+ factorvm *myvm = elements.myvm;
+ elements = myvm->reallot_array(elements.untagged(),count);
}
}
diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp
index 39ca778147..0f4591a89c 100644
--- a/vm/byte_arrays.cpp
+++ b/vm/byte_arrays.cpp
@@ -52,9 +52,9 @@ PRIMITIVE(resize_byte_array)
void growable_byte_array::append_bytes(void *elts, cell len)
{
cell new_size = count + len;
-
+ factorvm *myvm = elements.myvm;
if(new_size >= array_capacity(elements.untagged()))
- elements = reallot_array(elements.untagged(),new_size * 2);
+ elements = myvm->reallot_array(elements.untagged(),new_size * 2);
memcpy(&elements->data<u8>()[count],elts,len);
@@ -67,9 +67,9 @@ void growable_byte_array::append_byte_array(cell byte_array_)
cell len = array_capacity(byte_array.untagged());
cell new_size = count + len;
-
+ factorvm *myvm = elements.myvm;
if(new_size >= array_capacity(elements.untagged()))
- elements = reallot_array(elements.untagged(),new_size * 2);
+ elements = myvm->reallot_array(elements.untagged(),new_size * 2);
memcpy(&elements->data<u8>()[count],byte_array->data<u8>(),len);
@@ -78,7 +78,8 @@ void growable_byte_array::append_byte_array(cell byte_array_)
void growable_byte_array::trim()
{
- elements = reallot_array(elements.untagged(),count);
+ factorvm *myvm = elements.myvm;
+ elements = myvm->reallot_array(elements.untagged(),count);
}
}
diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp
index 6d85e4569a..3c997708e5 100644
--- a/vm/generic_arrays.hpp
+++ b/vm/generic_arrays.hpp
@@ -31,9 +31,9 @@ template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
return in_zone(&nursery,array) && capacity <= array_capacity(array);
}
-template <typename T> T *reallot_array(T *array_, cell capacity)
+template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
{
- gc_root<T> array(array_,vm);
+ gc_root<TYPE> array(array_,this);
if(reallot_array_in_place_p(array.untagged(),capacity))
{
@@ -46,11 +46,11 @@ template <typename T> T *reallot_array(T *array_, cell capacity)
if(capacity < to_copy)
to_copy = capacity;
- T *new_array = allot_array_internal<T>(capacity);
+ TYPE *new_array = allot_array_internal<TYPE>(capacity);
- memcpy(new_array + 1,array.untagged() + 1,to_copy * T::element_size);
- memset((char *)(new_array + 1) + to_copy * T::element_size,
- 0,(capacity - to_copy) * T::element_size);
+ memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
+ memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
+ 0,(capacity - to_copy) * TYPE::element_size);
return new_array;
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 2326f23148..b0dc17d4e8 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -191,6 +191,10 @@ struct factorvm {
std::vector<cell> gc_locals;
std::vector<cell> gc_bignums;
+ // generic arrays
+
+ template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
+
//debug
void print_chars(string* str);
void print_word(word* word, cell nesting);
From be3a9f7f663d2ccee6eb5df0c68e45b1148d7f34 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:10 +0100
Subject: [PATCH 049/266] moved data_gc templates and inline functions to vm
---
vm/data_gc.hpp | 44 +++++++++++++++++++++++++++++++++++++-------
vm/vm.hpp | 9 ++++++++-
2 files changed, 45 insertions(+), 8 deletions(-)
mode change 100644 => 100755 vm/data_gc.hpp
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
old mode 100644
new mode 100755
index 334ad5a2bb..995d539d5d
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -22,7 +22,7 @@ void init_data_gc();
void gc();
-inline static bool collecting_accumulation_gen_p()
+inline bool factorvm::collecting_accumulation_gen_p()
{
return ((data->have_aging_p()
&& collecting_gen == data->aging()
@@ -30,6 +30,11 @@ inline static bool collecting_accumulation_gen_p()
|| collecting_gen == data->tenured());
}
+inline bool collecting_accumulation_gen_p()
+{
+ return vm->collecting_accumulation_gen_p();
+}
+
void copy_handle(cell *handle);
void garbage_collection(volatile cell gen,
@@ -41,7 +46,7 @@ allocation (which does not call GC because of possible roots in volatile
registers) does not run out of memory */
static const cell allot_buffer_zone = 1024;
-inline static object *allot_zone(zone *z, cell a)
+inline object *factorvm::allot_zone(zone *z, cell a)
{
cell h = z->here;
z->here = h + align8(a);
@@ -50,11 +55,16 @@ inline static object *allot_zone(zone *z, cell a)
return obj;
}
+inline object *allot_zone(zone *z, cell a)
+{
+ return vm->allot_zone(z,a);
+}
+
/*
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!
*/
-inline static object *allot_object(header header, cell size)
+inline object *factorvm::allot_object(header header, cell size)
{
#ifdef GC_DEBUG
if(!gc_off)
@@ -105,9 +115,19 @@ inline static object *allot_object(header header, cell size)
return obj;
}
-template<typename T> T *allot(cell size)
+inline object *allot_object(header header, cell size)
{
- return (T *)allot_object(header(T::type_number),size);
+ return vm->allot_object(header,size);
+}
+
+template<typename TYPE> TYPE *factorvm::allot(cell size)
+{
+ return (TYPE *)allot_object(header(TYPE::type_number),size);
+}
+
+template<typename TYPE> TYPE *allot(cell size)
+{
+ return vm->allot<TYPE>(size);
}
void copy_reachable_objects(cell scan, cell *end);
@@ -120,7 +140,7 @@ PRIMITIVE(become);
extern bool growing_data_heap;
-inline static void check_data_pointer(object *pointer)
+inline void factorvm::check_data_pointer(object *pointer)
{
#ifdef FACTOR_DEBUG
if(!growing_data_heap)
@@ -131,7 +151,12 @@ inline static void check_data_pointer(object *pointer)
#endif
}
-inline static void check_tagged_pointer(cell tagged)
+inline void check_data_pointer(object *pointer)
+{
+ return vm->check_data_pointer(pointer);
+}
+
+inline void factorvm::check_tagged_pointer(cell tagged)
{
#ifdef FACTOR_DEBUG
if(!immediate_p(tagged))
@@ -143,6 +168,11 @@ inline static void check_tagged_pointer(cell tagged)
#endif
}
+inline void check_tagged_pointer(cell tagged)
+{
+ return vm->check_tagged_pointer(tagged);
+}
+
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b0dc17d4e8..bcbf2fe6bf 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -186,6 +186,13 @@ struct factorvm {
void clear_gc_stats();
inline void vmprim_become();
void inline_gc(cell *gc_roots_base, cell gc_roots_size);
+ inline bool collecting_accumulation_gen_p();
+ inline object *allot_zone(zone *z, cell a);
+ inline object *allot_object(header header, cell size);
+ template <typename TYPE> TYPE *allot(cell size);
+ inline void check_data_pointer(object *pointer);
+ inline void check_tagged_pointer(cell tagged);
+ // next method here:
// local roots
std::vector<cell> gc_locals;
@@ -544,7 +551,7 @@ struct factorvm {
void print_cell_hex_pad(cell x);
void print_fixnum(fixnum x);
cell read_cell_hex();
- // next method here:
+
From b1189dc4f19160c7a87b55a8ce29393cbd605e80 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:10 +0100
Subject: [PATCH 050/266] moved write_barrier functions to vm
---
vm/code_block.hpp | 2 +-
vm/vm.hpp | 15 +++++++++--
vm/write_barrier.hpp | 63 +++++++++++++++++++++++++++++++++++++-------
3 files changed, 68 insertions(+), 12 deletions(-)
mode change 100644 => 100755 vm/write_barrier.hpp
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index d46cd9e885..3497ff33ba 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -86,7 +86,7 @@ void mark_object_code_block(object *scan);
void relocate_code_block(code_block *relocating);
-inline static bool stack_traces_p()
+inline bool stack_traces_p()
{
return userenv[STACK_TRACES_ENV] != F;
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index bcbf2fe6bf..ffdf42aff9 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -155,6 +155,19 @@ struct factorvm {
inline void vmprim_end_scan();
template<typename T> void each_object(T &functor);
cell find_all_words();
+
+ //write barrier
+ inline card *addr_to_card(cell a);
+ inline cell card_to_addr(card *c);
+ inline cell card_offset(card *c);
+ inline card_deck *addr_to_deck(cell a);
+ inline cell deck_to_addr(card_deck *c);
+ inline card *deck_to_card(card_deck *d);
+ inline card *addr_to_allot_marker(object *a);
+ inline void write_barrier(object *obj);
+ inline void allot_barrier(object *address);
+ // next method here:
+
//data_gc
void init_data_gc();
@@ -192,14 +205,12 @@ struct factorvm {
template <typename TYPE> TYPE *allot(cell size);
inline void check_data_pointer(object *pointer);
inline void check_tagged_pointer(cell tagged);
- // next method here:
// local roots
std::vector<cell> gc_locals;
std::vector<cell> gc_bignums;
// generic arrays
-
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
//debug
diff --git a/vm/write_barrier.hpp b/vm/write_barrier.hpp
old mode 100644
new mode 100755
index 0006581034..e874600b24
--- a/vm/write_barrier.hpp
+++ b/vm/write_barrier.hpp
@@ -22,65 +22,110 @@ 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)
+inline card *factorvm::addr_to_card(cell a)
{
return (card*)(((cell)(a) >> card_bits) + cards_offset);
}
-inline static cell card_to_addr(card *c)
+inline card *addr_to_card(cell a)
+{
+ return vm->addr_to_card(a);
+}
+
+inline cell factorvm::card_to_addr(card *c)
{
return ((cell)c - cards_offset) << card_bits;
}
-inline static cell card_offset(card *c)
+inline cell card_to_addr(card *c)
+{
+ return vm->card_to_addr(c);
+}
+
+inline cell factorvm::card_offset(card *c)
{
return *(c - (cell)data->cards + (cell)data->allot_markers);
}
+inline cell card_offset(card *c)
+{
+ return vm->card_offset(c);
+}
+
typedef u8 card_deck;
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)
+inline card_deck *factorvm::addr_to_deck(cell a)
{
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
}
-inline static cell deck_to_addr(card_deck *c)
+inline card_deck *addr_to_deck(cell a)
+{
+ return vm->addr_to_deck(a);
+}
+
+inline cell factorvm::deck_to_addr(card_deck *c)
{
return ((cell)c - decks_offset) << deck_bits;
}
-inline static card *deck_to_card(card_deck *d)
+inline cell deck_to_addr(card_deck *c)
+{
+ return vm->deck_to_addr(c);
+}
+
+inline card *factorvm::deck_to_card(card_deck *d)
{
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
}
+inline card *deck_to_card(card_deck *d)
+{
+ return vm->deck_to_card(d);
+}
+
static const cell invalid_allot_marker = 0xff;
extern cell allot_markers_offset;
-inline static card *addr_to_allot_marker(object *a)
+inline card *factorvm::addr_to_allot_marker(object *a)
{
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
}
+inline card *addr_to_allot_marker(object *a)
+{
+ return vm->addr_to_allot_marker(a);
+}
+
/* 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)
+inline void factorvm::write_barrier(object *obj)
{
*addr_to_card((cell)obj) = card_mark_mask;
*addr_to_deck((cell)obj) = card_mark_mask;
}
+inline void write_barrier(object *obj)
+{
+ return vm->write_barrier(obj);
+}
+
/* we need to remember the first object allocated in the card */
-inline static void allot_barrier(object *address)
+inline void factorvm::allot_barrier(object *address)
{
card *ptr = addr_to_allot_marker(address);
if(*ptr == invalid_allot_marker)
*ptr = ((cell)address & addr_card_mask);
}
+inline void allot_barrier(object *address)
+{
+ return vm->allot_barrier(address);
+}
+
}
From 625380c25c2abff24d93e3fa458ad3b8c320a0e7 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:10 +0100
Subject: [PATCH 051/266] moved generic_array.hpp functions to vm
---
vm/generic_arrays.hpp | 14 ++++++++++++--
vm/vm.hpp | 4 +++-
2 files changed, 15 insertions(+), 3 deletions(-)
diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp
index 3c997708e5..e134b1a2ad 100644
--- a/vm/generic_arrays.hpp
+++ b/vm/generic_arrays.hpp
@@ -19,18 +19,28 @@ template <typename T> cell array_size(T *array)
return array_size<T>(array_capacity(array));
}
-template <typename T> T *allot_array_internal(cell capacity)
+template <typename T> T *factorvm::allot_array_internal(cell capacity)
{
T *array = allot<T>(array_size<T>(capacity));
array->capacity = tag_fixnum(capacity);
return array;
}
-template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
+template <typename T> T *allot_array_internal(cell capacity)
+{
+ return vm->allot_array_internal<T>(capacity);
+}
+
+template <typename T> bool factorvm::reallot_array_in_place_p(T *array, cell capacity)
{
return in_zone(&nursery,array) && capacity <= array_capacity(array);
}
+template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
+{
+ return vm->reallot_array_in_place_p<T>(array,capacity);
+}
+
template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
{
gc_root<TYPE> array(array_,this);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index ffdf42aff9..7c657ff9e4 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -166,7 +166,6 @@ struct factorvm {
inline card *addr_to_allot_marker(object *a);
inline void write_barrier(object *obj);
inline void allot_barrier(object *address);
- // next method here:
//data_gc
@@ -211,7 +210,10 @@ struct factorvm {
std::vector<cell> gc_bignums;
// generic arrays
+ template <typename T> T *allot_array_internal(cell capacity);
+ template <typename T> bool reallot_array_in_place_p(T *array, cell capacity);
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
+ // next method here:
//debug
void print_chars(string* str);
From 33ecaa5010631ac0c834e0996c22d05ebdbb070b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:10 +0100
Subject: [PATCH 052/266] moved arrays.hpp functions to vm
---
vm/arrays.hpp | 10 ++++++++--
vm/vm.hpp | 3 ++-
2 files changed, 10 insertions(+), 3 deletions(-)
diff --git a/vm/arrays.hpp b/vm/arrays.hpp
index ab4ad61a71..eda30c52fb 100755
--- a/vm/arrays.hpp
+++ b/vm/arrays.hpp
@@ -1,6 +1,7 @@
namespace factor
{
-inline static cell array_nth(array *array, cell slot)
+
+inline cell array_nth(array *array, cell slot)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
@@ -9,7 +10,7 @@ inline static cell array_nth(array *array, cell slot)
return array->data()[slot];
}
-inline static void set_array_nth(array *array, cell slot, cell value)
+inline void factorvm::set_array_nth(array *array, cell slot, cell value)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
@@ -20,6 +21,11 @@ inline static void set_array_nth(array *array, cell slot, cell value)
write_barrier(array);
}
+inline void set_array_nth(array *array, cell slot, cell value)
+{
+ return vm->set_array_nth(array,slot,value);
+}
+
array *allot_array(cell capacity, cell fill);
cell allot_array_1(cell obj);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 7c657ff9e4..0389817bb9 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -213,7 +213,6 @@ struct factorvm {
template <typename T> T *allot_array_internal(cell capacity);
template <typename T> bool reallot_array_in_place_p(T *array, cell capacity);
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
- // next method here:
//debug
void print_chars(string* str);
@@ -246,6 +245,8 @@ struct factorvm {
cell allot_array_2(cell v1_, cell v2_);
cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
inline void vmprim_resize_array();
+ inline void set_array_nth(array *array, cell slot, cell value);
+ // next method here:
//strings
cell string_nth(string* str, cell index);
From ae5c0fbfb299f678c667ba75af75d64915326f89 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:11 +0100
Subject: [PATCH 053/266] moved math.hpp functions to vm
---
vm/math.hpp | 37 +++++++++++++++++++++++++++++++------
vm/vm.hpp | 7 ++++++-
2 files changed, 37 insertions(+), 7 deletions(-)
diff --git a/vm/math.hpp b/vm/math.hpp
index 7828aa3e6c..cb4f1b1101 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -42,7 +42,7 @@ PRIMITIVE(bignum_bitp);
PRIMITIVE(bignum_log2);
PRIMITIVE(byte_array_to_bignum);
-inline static cell allot_integer(fixnum x)
+inline cell factorvm::allot_integer(fixnum x)
{
if(x < fixnum_min || x > fixnum_max)
return tag<bignum>(fixnum_to_bignum(x));
@@ -50,7 +50,12 @@ inline static cell allot_integer(fixnum x)
return tag_fixnum(x);
}
-inline static cell allot_cell(cell x)
+inline cell allot_integer(fixnum x)
+{
+ return vm->allot_integer(x);
+}
+
+inline cell factorvm::allot_cell(cell x)
{
if(x > (cell)fixnum_max)
return tag<bignum>(cell_to_bignum(x));
@@ -58,6 +63,11 @@ inline static cell allot_cell(cell x)
return tag_fixnum(x);
}
+inline cell allot_cell(cell x)
+{
+ return vm->allot_cell(x);
+}
+
cell unbox_array_size();
inline static double untag_float(cell tagged)
@@ -70,33 +80,48 @@ inline static double untag_float_check(cell tagged)
return untag_check<boxed_float>(tagged)->n;
}
-inline static cell allot_float(double n)
+inline cell factorvm::allot_float(double n)
{
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
flo->n = n;
return tag(flo);
}
+inline cell allot_float(double n)
+{
+ return vm->allot_float(n);
+}
+
inline static fixnum float_to_fixnum(cell tagged)
{
return (fixnum)untag_float(tagged);
}
-inline static bignum *float_to_bignum(cell tagged)
+inline bignum *factorvm::float_to_bignum(cell tagged)
{
return double_to_bignum(untag_float(tagged));
}
-inline static double fixnum_to_float(cell tagged)
+inline bignum *float_to_bignum(cell tagged)
+{
+ return vm->float_to_bignum(tagged);
+}
+
+inline double fixnum_to_float(cell tagged)
{
return (double)untag_fixnum(tagged);
}
-inline static double bignum_to_float(cell tagged)
+inline double factorvm::bignum_to_float(cell tagged)
{
return bignum_to_double(untag<bignum>(tagged));
}
+inline double bignum_to_float(cell tagged)
+{
+ return vm->bignum_to_float(tagged);
+}
+
PRIMITIVE(fixnum_to_float);
PRIMITIVE(bignum_to_float);
PRIMITIVE(str_to_float);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0389817bb9..5db239626d 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -246,7 +246,6 @@ struct factorvm {
cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
inline void vmprim_resize_array();
inline void set_array_nth(array *array, cell slot, cell value);
- // next method here:
//strings
cell string_nth(string* str, cell index);
@@ -358,6 +357,12 @@ struct factorvm {
void overflow_fixnum_add(fixnum x, fixnum y);
void overflow_fixnum_subtract(fixnum x, fixnum y);
void overflow_fixnum_multiply(fixnum x, fixnum y);
+ inline cell allot_integer(fixnum x);
+ inline cell allot_cell(cell x);
+ inline cell allot_float(double n);
+ inline bignum *float_to_bignum(cell tagged);
+ inline double bignum_to_float(cell tagged);
+ // next method here:
//io
void init_c_io();
From a6c3c1e7d2877d541900afd9a83a9d421380a381 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:11 +0100
Subject: [PATCH 054/266] moved callstack.hpp functions to vm
---
vm/callstack.hpp | 7 ++++++-
vm/code_heap.hpp | 2 --
vm/vm.hpp | 1 +
3 files changed, 7 insertions(+), 3 deletions(-)
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index ea62f6da4b..7e7e5cc20b 100755
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -35,7 +35,7 @@ template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
-template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
+template<typename T> void factorvm::iterate_callstack_object(callstack *stack_, T &iterator)
{
gc_root<callstack> stack(stack_,vm);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
@@ -48,4 +48,9 @@ template<typename T> void iterate_callstack_object(callstack *stack_, T &iterato
}
}
+template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
+{
+ return vm->iterate_callstack_object(stack_,iterator);
+}
+
}
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index a77a89b827..20d2b974d3 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -10,8 +10,6 @@ bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word, cell def, bool relocate);
-//typedef void (*code_heap_iterator)(code_block *compiled);
-
void iterate_code_heap(code_heap_iterator iter);
void copy_code_heap_roots();
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 5db239626d..2c52ffcf5d 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -466,6 +466,7 @@ struct factorvm {
void load_image(vm_parameters *p);
//callstack
+ template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator);
void check_frame(stack_frame *frame);
callstack *allot_callstack(cell size);
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
From 31905b68a7fbcb5b1d460be19969d85ff04b14a8 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:11 +0100
Subject: [PATCH 055/266] moved write_barrier inline function impls to vm.hpp
---
vm/master.hpp | 2 +-
vm/vm.hpp | 103 ++++++++++++++++++++++++++++++++++++++++++-
vm/write_barrier.hpp | 97 ----------------------------------------
3 files changed, 103 insertions(+), 99 deletions(-)
diff --git a/vm/master.hpp b/vm/master.hpp
index 2f9b19d12b..0b3bf7b474 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -47,9 +47,9 @@
#include "bignumint.hpp"
#include "bignum.hpp"
#include "code_block.hpp"
-#include "vm.hpp"
#include "data_heap.hpp"
#include "write_barrier.hpp"
+#include "vm.hpp"
#include "data_gc.hpp"
#include "local_roots.hpp"
#include "generic_arrays.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 2c52ffcf5d..cfb18d2036 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -362,7 +362,6 @@ struct factorvm {
inline cell allot_float(double n);
inline bignum *float_to_bignum(cell tagged);
inline double bignum_to_float(cell tagged);
- // next method here:
//io
void init_c_io();
@@ -580,4 +579,106 @@ struct factorvm {
extern factorvm *vm;
+
+// write_barrier.hpp
+
+inline card *factorvm::addr_to_card(cell a)
+{
+ return (card*)(((cell)(a) >> card_bits) + cards_offset);
+}
+
+inline card *addr_to_card(cell a)
+{
+ return vm->addr_to_card(a);
+}
+
+inline cell factorvm::card_to_addr(card *c)
+{
+ return ((cell)c - cards_offset) << card_bits;
+}
+
+inline cell card_to_addr(card *c)
+{
+ return vm->card_to_addr(c);
+}
+
+inline cell factorvm::card_offset(card *c)
+{
+ return *(c - (cell)data->cards + (cell)data->allot_markers);
+}
+
+inline cell card_offset(card *c)
+{
+ return vm->card_offset(c);
+}
+
+inline card_deck *factorvm::addr_to_deck(cell a)
+{
+ return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
+}
+
+inline card_deck *addr_to_deck(cell a)
+{
+ return vm->addr_to_deck(a);
+}
+
+inline cell factorvm::deck_to_addr(card_deck *c)
+{
+ return ((cell)c - decks_offset) << deck_bits;
+}
+
+inline cell deck_to_addr(card_deck *c)
+{
+ return vm->deck_to_addr(c);
+}
+
+inline card *factorvm::deck_to_card(card_deck *d)
+{
+ return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
+}
+
+inline card *deck_to_card(card_deck *d)
+{
+ return vm->deck_to_card(d);
+}
+
+inline card *factorvm::addr_to_allot_marker(object *a)
+{
+ return (card *)(((cell)a >> card_bits) + allot_markers_offset);
+}
+
+inline card *addr_to_allot_marker(object *a)
+{
+ return vm->addr_to_allot_marker(a);
+}
+
+/* the write barrier must be called any time we are potentially storing a
+pointer from an older generation to a younger one */
+inline void factorvm::write_barrier(object *obj)
+{
+ *addr_to_card((cell)obj) = card_mark_mask;
+ *addr_to_deck((cell)obj) = card_mark_mask;
+}
+
+inline void write_barrier(object *obj)
+{
+ return vm->write_barrier(obj);
+}
+
+/* we need to remember the first object allocated in the card */
+inline void factorvm::allot_barrier(object *address)
+{
+ card *ptr = addr_to_allot_marker(address);
+ if(*ptr == invalid_allot_marker)
+ *ptr = ((cell)address & addr_card_mask);
+}
+
+inline void allot_barrier(object *address)
+{
+ return vm->allot_barrier(address);
+}
+
+// next method here:
+
+
}
diff --git a/vm/write_barrier.hpp b/vm/write_barrier.hpp
index e874600b24..b45573b126 100755
--- a/vm/write_barrier.hpp
+++ b/vm/write_barrier.hpp
@@ -22,110 +22,13 @@ static const cell card_bits = 8;
static const cell card_size = (1<<card_bits);
static const cell addr_card_mask = (card_size-1);
-inline card *factorvm::addr_to_card(cell a)
-{
- return (card*)(((cell)(a) >> card_bits) + cards_offset);
-}
-
-inline card *addr_to_card(cell a)
-{
- return vm->addr_to_card(a);
-}
-
-inline cell factorvm::card_to_addr(card *c)
-{
- return ((cell)c - cards_offset) << card_bits;
-}
-
-inline cell card_to_addr(card *c)
-{
- return vm->card_to_addr(c);
-}
-
-inline cell factorvm::card_offset(card *c)
-{
- return *(c - (cell)data->cards + (cell)data->allot_markers);
-}
-
-inline cell card_offset(card *c)
-{
- return vm->card_offset(c);
-}
typedef u8 card_deck;
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 card_deck *factorvm::addr_to_deck(cell a)
-{
- return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
-}
-
-inline card_deck *addr_to_deck(cell a)
-{
- return vm->addr_to_deck(a);
-}
-
-inline cell factorvm::deck_to_addr(card_deck *c)
-{
- return ((cell)c - decks_offset) << deck_bits;
-}
-
-inline cell deck_to_addr(card_deck *c)
-{
- return vm->deck_to_addr(c);
-}
-
-inline card *factorvm::deck_to_card(card_deck *d)
-{
- return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
-}
-
-inline card *deck_to_card(card_deck *d)
-{
- return vm->deck_to_card(d);
-}
-
static const cell invalid_allot_marker = 0xff;
-
extern cell allot_markers_offset;
-inline card *factorvm::addr_to_allot_marker(object *a)
-{
- return (card *)(((cell)a >> card_bits) + allot_markers_offset);
-}
-
-inline card *addr_to_allot_marker(object *a)
-{
- return vm->addr_to_allot_marker(a);
-}
-
-/* the write barrier must be called any time we are potentially storing a
-pointer from an older generation to a younger one */
-inline void factorvm::write_barrier(object *obj)
-{
- *addr_to_card((cell)obj) = card_mark_mask;
- *addr_to_deck((cell)obj) = card_mark_mask;
-}
-
-inline void write_barrier(object *obj)
-{
- return vm->write_barrier(obj);
-}
-
-/* we need to remember the first object allocated in the card */
-inline void factorvm::allot_barrier(object *address)
-{
- card *ptr = addr_to_allot_marker(address);
- if(*ptr == invalid_allot_marker)
- *ptr = ((cell)address & addr_card_mask);
-}
-
-inline void allot_barrier(object *address)
-{
- return vm->allot_barrier(address);
-}
-
}
From 4dabd186c988aa2a34351f8c00d606a573129322 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:11 +0100
Subject: [PATCH 056/266] moved data_gc and local_roots inline functions to
vm.hpp
---
vm/data_gc.hpp | 129 ---------------------------------
vm/local_roots.hpp | 45 ------------
vm/master.hpp | 2 +-
vm/vm.hpp | 175 +++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 176 insertions(+), 175 deletions(-)
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 995d539d5d..47d2657587 100755
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -22,19 +22,6 @@ void init_data_gc();
void gc();
-inline bool factorvm::collecting_accumulation_gen_p()
-{
- return ((data->have_aging_p()
- && collecting_gen == data->aging()
- && !collecting_aging_again)
- || collecting_gen == data->tenured());
-}
-
-inline bool collecting_accumulation_gen_p()
-{
- return vm->collecting_accumulation_gen_p();
-}
-
void copy_handle(cell *handle);
void garbage_collection(volatile cell gen,
@@ -46,90 +33,6 @@ allocation (which does not call GC because of possible roots in volatile
registers) does not run out of memory */
static const cell allot_buffer_zone = 1024;
-inline object *factorvm::allot_zone(zone *z, cell a)
-{
- cell h = z->here;
- z->here = h + align8(a);
- object *obj = (object *)h;
- allot_barrier(obj);
- return obj;
-}
-
-inline object *allot_zone(zone *z, cell a)
-{
- return vm->allot_zone(z,a);
-}
-
-/*
- * It is up to the caller to fill in the object's fields in a meaningful
- * fashion!
- */
-inline object *factorvm::allot_object(header header, cell size)
-{
-#ifdef GC_DEBUG
- if(!gc_off)
- gc();
-#endif
-
- object *obj;
-
- 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(data->nursery(),false,0);
-
- cell h = nursery.here;
- nursery.here = h + align8(size);
- obj = (object *)h;
- }
- /* If the object is bigger than the nursery, allocate it in
- tenured space */
- else
- {
- 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[data->tenured()];
- }
-
- /* If it still won't fit, grow the heap */
- if(tenured->here + size > tenured->end)
- {
- garbage_collection(data->tenured(),true,size);
- tenured = &data->generations[data->tenured()];
- }
-
- obj = allot_zone(tenured,size);
-
- /* Allows initialization code to store old->new pointers
- without hitting the write barrier in the common case of
- a nursery allocation */
- write_barrier(obj);
- }
-
- obj->h = header;
- return obj;
-}
-
-inline object *allot_object(header header, cell size)
-{
- return vm->allot_object(header,size);
-}
-
-template<typename TYPE> TYPE *factorvm::allot(cell size)
-{
- return (TYPE *)allot_object(header(TYPE::type_number),size);
-}
-
-template<typename TYPE> TYPE *allot(cell size)
-{
- return vm->allot<TYPE>(size);
-}
-
void copy_reachable_objects(cell scan, cell *end);
PRIMITIVE(gc);
@@ -140,38 +43,6 @@ PRIMITIVE(become);
extern bool growing_data_heap;
-inline void factorvm::check_data_pointer(object *pointer)
-{
-#ifdef FACTOR_DEBUG
- if(!growing_data_heap)
- {
- assert((cell)pointer >= data->seg->start
- && (cell)pointer < data->seg->end);
- }
-#endif
-}
-
-inline void check_data_pointer(object *pointer)
-{
- return vm->check_data_pointer(pointer);
-}
-
-inline void factorvm::check_tagged_pointer(cell tagged)
-{
-#ifdef FACTOR_DEBUG
- if(!immediate_p(tagged))
- {
- object *obj = untag<object>(tagged);
- check_data_pointer(obj);
- obj->h.hi_tag();
- }
-#endif
-}
-
-inline void check_tagged_pointer(cell tagged)
-{
- return vm->check_tagged_pointer(tagged);
-}
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp
index 26d083be40..412ef35bb4 100644
--- a/vm/local_roots.hpp
+++ b/vm/local_roots.hpp
@@ -1,49 +1,4 @@
namespace factor
{
-struct factorvm;
-
-template <typename TYPE>
-struct gc_root : public tagged<TYPE>
-{
- factorvm *myvm;
-
- void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
-
- //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
- explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
- explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
-
- const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
- const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
-
- ~gc_root() {
-#ifdef FACTOR_DEBUG
- assert(myvm->gc_locals.back() == (cell)this);
-#endif
- myvm->gc_locals.pop_back();
- }
-};
-
-/* A similar hack for the bignum implementation */
-struct gc_bignum
-{
- bignum **addr;
- factorvm *myvm;
- gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
- if(*addr_)
- check_data_pointer(*addr_);
- myvm->gc_bignums.push_back((cell)addr);
- }
-
- ~gc_bignum() {
-#ifdef FACTOR_DEBUG
- assert(myvm->gc_bignums.back() == (cell)addr);
-#endif
- myvm->gc_bignums.pop_back();
- }
-};
-
-#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
-
}
diff --git a/vm/master.hpp b/vm/master.hpp
index 0b3bf7b474..7b3d6c5c73 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -49,9 +49,9 @@
#include "code_block.hpp"
#include "data_heap.hpp"
#include "write_barrier.hpp"
-#include "vm.hpp"
#include "data_gc.hpp"
#include "local_roots.hpp"
+#include "vm.hpp"
#include "generic_arrays.hpp"
#include "debug.hpp"
#include "arrays.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index cfb18d2036..f44c1ca0eb 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -678,6 +678,181 @@ inline void allot_barrier(object *address)
return vm->allot_barrier(address);
}
+
+//data_gc.hpp
+inline bool factorvm::collecting_accumulation_gen_p()
+{
+ return ((data->have_aging_p()
+ && collecting_gen == data->aging()
+ && !collecting_aging_again)
+ || collecting_gen == data->tenured());
+}
+
+inline bool collecting_accumulation_gen_p()
+{
+ return vm->collecting_accumulation_gen_p();
+}
+
+inline object *factorvm::allot_zone(zone *z, cell a)
+{
+ cell h = z->here;
+ z->here = h + align8(a);
+ object *obj = (object *)h;
+ allot_barrier(obj);
+ return obj;
+}
+
+inline object *allot_zone(zone *z, cell a)
+{
+ return vm->allot_zone(z,a);
+}
+
+/*
+ * It is up to the caller to fill in the object's fields in a meaningful
+ * fashion!
+ */
+inline object *factorvm::allot_object(header header, cell size)
+{
+#ifdef GC_DEBUG
+ if(!gc_off)
+ gc();
+#endif
+
+ object *obj;
+
+ 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(data->nursery(),false,0);
+
+ cell h = nursery.here;
+ nursery.here = h + align8(size);
+ obj = (object *)h;
+ }
+ /* If the object is bigger than the nursery, allocate it in
+ tenured space */
+ else
+ {
+ 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[data->tenured()];
+ }
+
+ /* If it still won't fit, grow the heap */
+ if(tenured->here + size > tenured->end)
+ {
+ garbage_collection(data->tenured(),true,size);
+ tenured = &data->generations[data->tenured()];
+ }
+
+ obj = allot_zone(tenured,size);
+
+ /* Allows initialization code to store old->new pointers
+ without hitting the write barrier in the common case of
+ a nursery allocation */
+ write_barrier(obj);
+ }
+
+ obj->h = header;
+ return obj;
+}
+
+inline object *allot_object(header header, cell size)
+{
+ return vm->allot_object(header,size);
+}
+
+template<typename TYPE> TYPE *factorvm::allot(cell size)
+{
+ return (TYPE *)allot_object(header(TYPE::type_number),size);
+}
+
+template<typename TYPE> TYPE *allot(cell size)
+{
+ return vm->allot<TYPE>(size);
+}
+
+inline void factorvm::check_data_pointer(object *pointer)
+{
+#ifdef FACTOR_DEBUG
+ if(!growing_data_heap)
+ {
+ assert((cell)pointer >= data->seg->start
+ && (cell)pointer < data->seg->end);
+ }
+#endif
+}
+
+inline void check_data_pointer(object *pointer)
+{
+ return vm->check_data_pointer(pointer);
+}
+
+inline void factorvm::check_tagged_pointer(cell tagged)
+{
+#ifdef FACTOR_DEBUG
+ if(!immediate_p(tagged))
+ {
+ object *obj = untag<object>(tagged);
+ check_data_pointer(obj);
+ obj->h.hi_tag();
+ }
+#endif
+}
+
+inline void check_tagged_pointer(cell tagged)
+{
+ return vm->check_tagged_pointer(tagged);
+}
+
+//local_roots.hpp
+template <typename TYPE>
+struct gc_root : public tagged<TYPE>
+{
+ factorvm *myvm;
+
+ void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
+
+ //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
+ explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
+ explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
+
+ const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
+ const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
+
+ ~gc_root() {
+#ifdef FACTOR_DEBUG
+ assert(myvm->gc_locals.back() == (cell)this);
+#endif
+ myvm->gc_locals.pop_back();
+ }
+};
+
+/* A similar hack for the bignum implementation */
+struct gc_bignum
+{
+ bignum **addr;
+ factorvm *myvm;
+ gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
+ if(*addr_)
+ check_data_pointer(*addr_);
+ myvm->gc_bignums.push_back((cell)addr);
+ }
+
+ ~gc_bignum() {
+#ifdef FACTOR_DEBUG
+ assert(myvm->gc_bignums.back() == (cell)addr);
+#endif
+ myvm->gc_bignums.pop_back();
+ }
+};
+
+#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
// next method here:
From 2e129dfc453096063f5e8a0a867fa1642756a9ed Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:11 +0100
Subject: [PATCH 057/266] moved generic_arrays inline functions to vm.hpp
---
vm/generic_arrays.hpp | 47 -----------------------------------------
vm/master.hpp | 2 +-
vm/vm.hpp | 49 +++++++++++++++++++++++++++++++++++++++++++
3 files changed, 50 insertions(+), 48 deletions(-)
diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp
index e134b1a2ad..0125cb7651 100644
--- a/vm/generic_arrays.hpp
+++ b/vm/generic_arrays.hpp
@@ -19,51 +19,4 @@ template <typename T> cell array_size(T *array)
return array_size<T>(array_capacity(array));
}
-template <typename T> T *factorvm::allot_array_internal(cell capacity)
-{
- T *array = allot<T>(array_size<T>(capacity));
- array->capacity = tag_fixnum(capacity);
- return array;
-}
-
-template <typename T> T *allot_array_internal(cell capacity)
-{
- return vm->allot_array_internal<T>(capacity);
-}
-
-template <typename T> bool factorvm::reallot_array_in_place_p(T *array, cell capacity)
-{
- return in_zone(&nursery,array) && capacity <= array_capacity(array);
-}
-
-template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
-{
- return vm->reallot_array_in_place_p<T>(array,capacity);
-}
-
-template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
-{
- gc_root<TYPE> array(array_,this);
-
- if(reallot_array_in_place_p(array.untagged(),capacity))
- {
- array->capacity = tag_fixnum(capacity);
- return array.untagged();
- }
- else
- {
- cell to_copy = array_capacity(array.untagged());
- if(capacity < to_copy)
- to_copy = capacity;
-
- TYPE *new_array = allot_array_internal<TYPE>(capacity);
-
- memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
- memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
- 0,(capacity - to_copy) * TYPE::element_size);
-
- return new_array;
- }
-}
-
}
diff --git a/vm/master.hpp b/vm/master.hpp
index 7b3d6c5c73..c25cbdc3a6 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -51,8 +51,8 @@
#include "write_barrier.hpp"
#include "data_gc.hpp"
#include "local_roots.hpp"
-#include "vm.hpp"
#include "generic_arrays.hpp"
+#include "vm.hpp"
#include "debug.hpp"
#include "arrays.hpp"
#include "strings.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index f44c1ca0eb..8e0c583c5e 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -853,6 +853,55 @@ struct gc_bignum
};
#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
+
+//generic_arrays.hpp
+template <typename T> T *factorvm::allot_array_internal(cell capacity)
+{
+ T *array = allot<T>(array_size<T>(capacity));
+ array->capacity = tag_fixnum(capacity);
+ return array;
+}
+
+template <typename T> T *allot_array_internal(cell capacity)
+{
+ return vm->allot_array_internal<T>(capacity);
+}
+
+template <typename T> bool factorvm::reallot_array_in_place_p(T *array, cell capacity)
+{
+ return in_zone(&nursery,array) && capacity <= array_capacity(array);
+}
+
+template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
+{
+ return vm->reallot_array_in_place_p<T>(array,capacity);
+}
+
+template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
+{
+ gc_root<TYPE> array(array_,this);
+
+ if(reallot_array_in_place_p(array.untagged(),capacity))
+ {
+ array->capacity = tag_fixnum(capacity);
+ return array.untagged();
+ }
+ else
+ {
+ cell to_copy = array_capacity(array.untagged());
+ if(capacity < to_copy)
+ to_copy = capacity;
+
+ TYPE *new_array = allot_array_internal<TYPE>(capacity);
+
+ memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
+ memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
+ 0,(capacity - to_copy) * TYPE::element_size);
+
+ return new_array;
+ }
+}
+
// next method here:
From 209755e2de5a1c97655ac91d2ccae01d995ee3f9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:11 +0100
Subject: [PATCH 058/266] moved arrays.hpp inline functions to vm.hpp
---
vm/arrays.hpp | 25 ++-----------------------
vm/master.hpp | 2 +-
vm/vm.hpp | 27 +++++++++++++++++++++++++++
3 files changed, 30 insertions(+), 24 deletions(-)
diff --git a/vm/arrays.hpp b/vm/arrays.hpp
index eda30c52fb..282474ade8 100755
--- a/vm/arrays.hpp
+++ b/vm/arrays.hpp
@@ -10,21 +10,9 @@ inline cell array_nth(array *array, cell slot)
return array->data()[slot];
}
-inline void factorvm::set_array_nth(array *array, cell slot, cell value)
-{
-#ifdef FACTOR_DEBUG
- assert(slot < array_capacity(array));
- assert(array->h.hi_tag() == ARRAY_TYPE);
- check_tagged_pointer(value);
-#endif
- array->data()[slot] = value;
- write_barrier(array);
-}
-inline void set_array_nth(array *array, cell slot, cell value)
-{
- return vm->set_array_nth(array,slot,value);
-}
+
+
array *allot_array(cell capacity, cell fill);
@@ -35,14 +23,5 @@ cell allot_array_4(cell v1, cell v2, cell v3, cell v4);
PRIMITIVE(array);
PRIMITIVE(resize_array);
-struct growable_array {
- cell count;
- gc_root<array> elements;
-
- growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(allot_array(capacity,F),myvm) {}
-
- void add(cell elt);
- void trim();
-};
}
diff --git a/vm/master.hpp b/vm/master.hpp
index c25cbdc3a6..98ed043e05 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -52,9 +52,9 @@
#include "data_gc.hpp"
#include "local_roots.hpp"
#include "generic_arrays.hpp"
-#include "vm.hpp"
#include "debug.hpp"
#include "arrays.hpp"
+#include "vm.hpp"
#include "strings.hpp"
#include "booleans.hpp"
#include "byte_arrays.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8e0c583c5e..0ccb86b970 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -902,6 +902,33 @@ template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capaci
}
}
+//arrays.hpp
+inline void factorvm::set_array_nth(array *array, cell slot, cell value)
+{
+#ifdef FACTOR_DEBUG
+ assert(slot < array_capacity(array));
+ assert(array->h.hi_tag() == ARRAY_TYPE);
+ check_tagged_pointer(value);
+#endif
+ array->data()[slot] = value;
+ write_barrier(array);
+}
+
+inline void set_array_nth(array *array, cell slot, cell value)
+{
+ return vm->set_array_nth(array,slot,value);
+}
+
+struct growable_array {
+ cell count;
+ gc_root<array> elements;
+
+ growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(allot_array(capacity,F),myvm) {}
+
+ void add(cell elt);
+ void trim();
+};
+
// next method here:
From a249b484c47773193f731f0b24bc47b58d701357 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:12 +0100
Subject: [PATCH 059/266] moved byte_arrays.hpp inline functions to vm.hpp
---
vm/byte_arrays.hpp | 11 -----------
vm/master.hpp | 2 +-
vm/vm.hpp | 13 +++++++++++++
3 files changed, 14 insertions(+), 12 deletions(-)
diff --git a/vm/byte_arrays.hpp b/vm/byte_arrays.hpp
index 68b706be7b..4954f31094 100755
--- a/vm/byte_arrays.hpp
+++ b/vm/byte_arrays.hpp
@@ -7,16 +7,5 @@ PRIMITIVE(byte_array);
PRIMITIVE(uninitialized_byte_array);
PRIMITIVE(resize_byte_array);
-struct growable_byte_array {
- cell count;
- gc_root<byte_array> elements;
-
- growable_byte_array(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
-
- void append_bytes(void *elts, cell len);
- void append_byte_array(cell elts);
-
- void trim();
-};
}
diff --git a/vm/master.hpp b/vm/master.hpp
index 98ed043e05..0eb51e7230 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -54,11 +54,11 @@
#include "generic_arrays.hpp"
#include "debug.hpp"
#include "arrays.hpp"
-#include "vm.hpp"
#include "strings.hpp"
#include "booleans.hpp"
#include "byte_arrays.hpp"
#include "tuples.hpp"
+#include "vm.hpp"
#include "words.hpp"
#include "math.hpp"
#include "float_bits.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0ccb86b970..b185a1600e 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -929,6 +929,19 @@ struct growable_array {
void trim();
};
+//byte_arrays.hpp
+struct growable_byte_array {
+ cell count;
+ gc_root<byte_array> elements;
+
+ growable_byte_array(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
+
+ void append_bytes(void *elts, cell len);
+ void append_byte_array(cell elts);
+
+ void trim();
+};
+
// next method here:
From 9e23e4126772a84cc7010c4cb88af2b8b6e51221 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:12 +0100
Subject: [PATCH 060/266] moved math.hpp inline functions to vm.hpp
---
vm/master.hpp | 2 +-
vm/math.hpp | 58 +++++++++-----------------------------------------
vm/vm.hpp | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 70 insertions(+), 49 deletions(-)
diff --git a/vm/master.hpp b/vm/master.hpp
index 0eb51e7230..4adc163123 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -58,9 +58,9 @@
#include "booleans.hpp"
#include "byte_arrays.hpp"
#include "tuples.hpp"
-#include "vm.hpp"
#include "words.hpp"
#include "math.hpp"
+#include "vm.hpp"
#include "float_bits.hpp"
#include "io.hpp"
#include "code_gc.hpp"
diff --git a/vm/math.hpp b/vm/math.hpp
index cb4f1b1101..0f8de05218 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -42,31 +42,13 @@ PRIMITIVE(bignum_bitp);
PRIMITIVE(bignum_log2);
PRIMITIVE(byte_array_to_bignum);
-inline cell factorvm::allot_integer(fixnum x)
-{
- if(x < fixnum_min || x > fixnum_max)
- return tag<bignum>(fixnum_to_bignum(x));
- else
- return tag_fixnum(x);
-}
-inline cell allot_integer(fixnum x)
-{
- return vm->allot_integer(x);
-}
-inline cell factorvm::allot_cell(cell x)
-{
- if(x > (cell)fixnum_max)
- return tag<bignum>(cell_to_bignum(x));
- else
- return tag_fixnum(x);
-}
-inline cell allot_cell(cell x)
-{
- return vm->allot_cell(x);
-}
+
+
+
+
cell unbox_array_size();
@@ -80,47 +62,27 @@ inline static double untag_float_check(cell tagged)
return untag_check<boxed_float>(tagged)->n;
}
-inline cell factorvm::allot_float(double n)
-{
- boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
- flo->n = n;
- return tag(flo);
-}
-inline cell allot_float(double n)
-{
- return vm->allot_float(n);
-}
+
+
inline static fixnum float_to_fixnum(cell tagged)
{
return (fixnum)untag_float(tagged);
}
-inline bignum *factorvm::float_to_bignum(cell tagged)
-{
- return double_to_bignum(untag_float(tagged));
-}
-inline bignum *float_to_bignum(cell tagged)
-{
- return vm->float_to_bignum(tagged);
-}
+
+
inline double fixnum_to_float(cell tagged)
{
return (double)untag_fixnum(tagged);
}
-inline double factorvm::bignum_to_float(cell tagged)
-{
- return bignum_to_double(untag<bignum>(tagged));
-}
-inline double bignum_to_float(cell tagged)
-{
- return vm->bignum_to_float(tagged);
-}
+
+
PRIMITIVE(fixnum_to_float);
PRIMITIVE(bignum_to_float);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b185a1600e..fdfa48d1e7 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -942,6 +942,65 @@ struct growable_byte_array {
void trim();
};
+//math.hpp
+inline cell factorvm::allot_integer(fixnum x)
+{
+ if(x < fixnum_min || x > fixnum_max)
+ return tag<bignum>(fixnum_to_bignum(x));
+ else
+ return tag_fixnum(x);
+}
+
+inline cell allot_integer(fixnum x)
+{
+ return vm->allot_integer(x);
+}
+
+inline cell factorvm::allot_cell(cell x)
+{
+ if(x > (cell)fixnum_max)
+ return tag<bignum>(cell_to_bignum(x));
+ else
+ return tag_fixnum(x);
+}
+
+inline cell allot_cell(cell x)
+{
+ return vm->allot_cell(x);
+}
+
+inline cell factorvm::allot_float(double n)
+{
+ boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
+ flo->n = n;
+ return tag(flo);
+}
+
+inline cell allot_float(double n)
+{
+ return vm->allot_float(n);
+}
+
+inline bignum *factorvm::float_to_bignum(cell tagged)
+{
+ return double_to_bignum(untag_float(tagged));
+}
+
+inline bignum *float_to_bignum(cell tagged)
+{
+ return vm->float_to_bignum(tagged);
+}
+
+inline double factorvm::bignum_to_float(cell tagged)
+{
+ return bignum_to_double(untag<bignum>(tagged));
+}
+
+inline double bignum_to_float(cell tagged)
+{
+ return vm->bignum_to_float(tagged);
+}
+
// next method here:
From fb9f9ac3d35acb073e8e1b818df589654109de27 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:12 +0100
Subject: [PATCH 061/266] moved callstack.hpp inline functions to vm.hpp
---
vm/callstack.hpp | 19 -------------------
vm/code_gc.hpp | 2 +-
vm/code_heap.hpp | 2 ++
vm/master.hpp | 2 +-
vm/vm.hpp | 23 +++++++++++++++++++++--
5 files changed, 25 insertions(+), 23 deletions(-)
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index 7e7e5cc20b..ee097b528c 100755
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -33,24 +33,5 @@ template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
}
}
-/* This is a little tricky. The iterator may allocate memory, so we
-keep the callstack in a GC root and use relative offsets */
-template<typename T> void factorvm::iterate_callstack_object(callstack *stack_, T &iterator)
-{
- gc_root<callstack> stack(stack_,vm);
- fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
-
- while(frame_offset >= 0)
- {
- stack_frame *frame = stack->frame_at(frame_offset);
- frame_offset -= frame->size;
- iterator(frame);
- }
-}
-
-template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
-{
- return vm->iterate_callstack_object(stack_,iterator);
-}
}
diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp
index ed59cc5919..1cfafb69c2 100755
--- a/vm/code_gc.hpp
+++ b/vm/code_gc.hpp
@@ -14,7 +14,7 @@ struct heap {
heap_free_list free;
};
-//typedef void (*heap_iterator)(heap_block *compiled);
+typedef void (*heap_iterator)(heap_block *compiled);
void new_heap(heap *h, cell size);
void build_free_list(heap *h, cell size);
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 20d2b974d3..6f139a4728 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -10,6 +10,8 @@ bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word, cell def, bool relocate);
+typedef void (*code_heap_iterator)(code_block *compiled);
+
void iterate_code_heap(code_heap_iterator iter);
void copy_code_heap_roots();
diff --git a/vm/master.hpp b/vm/master.hpp
index 4adc163123..792e997f6f 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -60,13 +60,13 @@
#include "tuples.hpp"
#include "words.hpp"
#include "math.hpp"
-#include "vm.hpp"
#include "float_bits.hpp"
#include "io.hpp"
#include "code_gc.hpp"
#include "code_heap.hpp"
#include "image.hpp"
#include "callstack.hpp"
+#include "vm.hpp"
#include "alien.hpp"
#include "jit.hpp"
#include "quotations.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index fdfa48d1e7..1caa30040b 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -11,8 +11,6 @@ struct image_header;
typedef u8 card;
typedef u8 card_deck;
-typedef void (*heap_iterator)(heap_block *compiled);
-typedef void (*code_heap_iterator)(code_block *compiled);
struct factorvm {
@@ -1001,6 +999,27 @@ inline double bignum_to_float(cell tagged)
return vm->bignum_to_float(tagged);
}
+//callstack.hpp
+/* This is a little tricky. The iterator may allocate memory, so we
+keep the callstack in a GC root and use relative offsets */
+template<typename T> void factorvm::iterate_callstack_object(callstack *stack_, T &iterator)
+{
+ gc_root<callstack> stack(stack_,vm);
+ fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
+
+ while(frame_offset >= 0)
+ {
+ stack_frame *frame = stack->frame_at(frame_offset);
+ frame_offset -= frame->size;
+ iterator(frame);
+ }
+}
+
+template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
+{
+ return vm->iterate_callstack_object(stack_,iterator);
+}
+
// next method here:
From ecfd9a6075be6906ad2b599d9d8afacbba31944c Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:12 +0100
Subject: [PATCH 062/266] reordered master to untangle dependency chain a bit
---
vm/master.hpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/vm/master.hpp b/vm/master.hpp
index 792e997f6f..e118be67c3 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -66,8 +66,8 @@
#include "code_heap.hpp"
#include "image.hpp"
#include "callstack.hpp"
-#include "vm.hpp"
#include "alien.hpp"
+#include "vm.hpp"
#include "jit.hpp"
#include "quotations.hpp"
#include "dispatch.hpp"
From 80716a1b6e34fc31e43301753191a8f136572251 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:12 +0100
Subject: [PATCH 063/266] moved global state from contexts and run into vm Also
renamed template type from T to TYPE to prevent clash with vm::T (true)
---
vm/booleans.hpp | 4 ----
vm/contexts.cpp | 2 --
vm/contexts.hpp | 2 +-
vm/data_gc.cpp | 8 ++++----
vm/data_heap.cpp | 4 ++--
vm/image.cpp | 8 ++++----
vm/jit.hpp | 2 +-
vm/run.cpp | 1 -
vm/run.hpp | 3 ---
vm/vm.hpp | 34 +++++++++++++++++++++++++---------
10 files changed, 37 insertions(+), 31 deletions(-)
mode change 100644 => 100755 vm/run.hpp
diff --git a/vm/booleans.hpp b/vm/booleans.hpp
index ea16e0536b..c410f67481 100644
--- a/vm/booleans.hpp
+++ b/vm/booleans.hpp
@@ -1,10 +1,6 @@
namespace factor
{
-inline static cell tag_boolean(cell untagged)
-{
- return (untagged ? T : F);
-}
VM_C_API void box_boolean(bool value);
VM_C_API bool to_boolean(cell value);
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 86156de3b5..03768ec0db 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -5,8 +5,6 @@ factor::context *stack_chain;
namespace factor
{
-cell ds_size, rs_size;
-context *unused_contexts;
void factorvm::reset_datastack()
{
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 4a6f401f0b..56642bcd1a 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -36,7 +36,7 @@ struct context {
context *next;
};
-extern cell ds_size, rs_size;
+//extern cell ds_size, rs_size;
#define ds_bot (stack_chain->datastack_region->start)
#define ds_top (stack_chain->datastack_region->end)
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index ea7098912e..ac0402b47d 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -123,22 +123,22 @@ object *resolve_forwarding(object *untagged)
return vm->resolve_forwarding(untagged);
}
-template <typename T> T *factorvm::copy_untagged_object(T *untagged)
+template <typename TYPE> TYPE *factorvm::copy_untagged_object(TYPE *untagged)
{
check_data_pointer(untagged);
if(untagged->h.forwarding_pointer_p())
- untagged = (T *)resolve_forwarding(untagged->h.forwarding_pointer());
+ untagged = (TYPE *)resolve_forwarding(untagged->h.forwarding_pointer());
else
{
untagged->h.check_header();
- untagged = (T *)copy_object_impl(untagged);
+ untagged = (TYPE *)copy_object_impl(untagged);
}
return untagged;
}
-template <typename T> T *copy_untagged_object(T *untagged)
+template <typename TYPE> TYPE *copy_untagged_object(TYPE *untagged)
{
return vm->copy_untagged_object(untagged);
}
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index 377cd6e943..34284659f0 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -453,7 +453,7 @@ PRIMITIVE(end_scan)
PRIMITIVE_GETVM()->vmprim_end_scan();
}
-template<typename T> void factorvm::each_object(T &functor)
+template<typename TYPE> void factorvm::each_object(TYPE &functor)
{
begin_scan();
cell obj;
@@ -462,7 +462,7 @@ template<typename T> void factorvm::each_object(T &functor)
end_scan();
}
-template<typename T> void each_object(T &functor)
+template<typename TYPE> void each_object(TYPE &functor)
{
return vm->each_object(functor);
}
diff --git a/vm/image.cpp b/vm/image.cpp
index 24988b24b5..746461680c 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -202,14 +202,14 @@ void data_fixup(cell *cell)
return vm->data_fixup(cell);
}
-template <typename T> void factorvm::code_fixup(T **handle)
+template <typename TYPE> void factorvm::code_fixup(TYPE **handle)
{
- T *ptr = *handle;
- T *new_ptr = (T *)(((cell)ptr) + (code.seg->start - code_relocation_base));
+ TYPE *ptr = *handle;
+ TYPE *new_ptr = (TYPE *)(((cell)ptr) + (code.seg->start - code_relocation_base));
*handle = new_ptr;
}
-template <typename T> void code_fixup(T **handle)
+template <typename TYPE> void code_fixup(TYPE **handle)
{
return vm->code_fixup(handle);
}
diff --git a/vm/jit.hpp b/vm/jit.hpp
index 0fa145cded..81754be26a 100644
--- a/vm/jit.hpp
+++ b/vm/jit.hpp
@@ -42,7 +42,7 @@ struct jit {
void emit_subprimitive(cell word_) {
gc_root<word> word(word_,myvm);
gc_root<array> code_template(word->subprimitive,myvm);
- if(array_capacity(code_template.untagged()) > 1) literal(T);
+ if(array_capacity(code_template.untagged()) > 1) literal(myvm->T);
emit(code_template.value());
}
diff --git a/vm/run.cpp b/vm/run.cpp
index e0ad1abb12..7f4894f1ef 100755
--- a/vm/run.cpp
+++ b/vm/run.cpp
@@ -5,7 +5,6 @@ factor::cell userenv[USER_ENV];
namespace factor
{
-cell T;
inline void factorvm::vmprim_getenv()
{
diff --git a/vm/run.hpp b/vm/run.hpp
old mode 100644
new mode 100755
index 7527889efb..4b43a156e4
--- a/vm/run.hpp
+++ b/vm/run.hpp
@@ -98,9 +98,6 @@ inline static bool save_env_p(cell i)
return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
}
-/* Canonical T object. It's just a word */
-extern cell T;
-
PRIMITIVE(getenv);
PRIMITIVE(setenv);
PRIMITIVE(exit);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 1caa30040b..a58ac1ad9e 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -15,6 +15,8 @@ typedef u8 card_deck;
struct factorvm {
// contexts
+ cell ds_size, rs_size;
+ context *unused_contexts;
void reset_datastack();
void reset_retainstack();
void fix_stacks();
@@ -33,6 +35,7 @@ struct factorvm {
inline void vmprim_check_datastack();
// run
+ cell T; /* Canonical T object. It's just a word */
inline void vmprim_getenv();
inline void vmprim_setenv();
inline void vmprim_exit();
@@ -264,6 +267,7 @@ struct factorvm {
//booleans
void box_boolean(bool value);
bool to_boolean(cell value);
+ inline cell tag_boolean(cell untagged);
//byte arrays
byte_array *allot_byte_array(cell size);
@@ -853,26 +857,26 @@ struct gc_bignum
#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
//generic_arrays.hpp
-template <typename T> T *factorvm::allot_array_internal(cell capacity)
+template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
{
- T *array = allot<T>(array_size<T>(capacity));
+ TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
array->capacity = tag_fixnum(capacity);
return array;
}
-template <typename T> T *allot_array_internal(cell capacity)
+template <typename TYPE> TYPE *allot_array_internal(cell capacity)
{
- return vm->allot_array_internal<T>(capacity);
+ return vm->allot_array_internal<TYPE>(capacity);
}
-template <typename T> bool factorvm::reallot_array_in_place_p(T *array, cell capacity)
+template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
{
return in_zone(&nursery,array) && capacity <= array_capacity(array);
}
-template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
+template <typename TYPE> bool reallot_array_in_place_p(TYPE *array, cell capacity)
{
- return vm->reallot_array_in_place_p<T>(array,capacity);
+ return vm->reallot_array_in_place_p<TYPE>(array,capacity);
}
template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
@@ -1002,7 +1006,7 @@ inline double bignum_to_float(cell tagged)
//callstack.hpp
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
-template<typename T> void factorvm::iterate_callstack_object(callstack *stack_, T &iterator)
+template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
{
gc_root<callstack> stack(stack_,vm);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
@@ -1015,11 +1019,23 @@ template<typename T> void factorvm::iterate_callstack_object(callstack *stack_,
}
}
-template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
+template<typename TYPE> void iterate_callstack_object(callstack *stack_, TYPE &iterator)
{
return vm->iterate_callstack_object(stack_,iterator);
}
+//booleans.hpp
+inline cell factorvm::tag_boolean(cell untagged)
+{
+ return (untagged ? T : F);
+}
+
+inline cell tag_boolean(cell untagged)
+{
+ return vm->tag_boolean(untagged);
+}
+
+
// next method here:
From 3025cef1c68baa6b5ba971153f2422bb61ce3b0a Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:12 +0100
Subject: [PATCH 064/266] moved global state from data_gc into vm
---
vm/data_gc.cpp | 30 ------------------------------
vm/data_gc.hpp | 10 ----------
vm/vm.hpp | 30 ++++++++++++++++++++++++++++++
3 files changed, 30 insertions(+), 40 deletions(-)
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index ac0402b47d..408a70ea5e 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -3,36 +3,6 @@
namespace factor
{
-/* used during garbage collection only */
-zone *newspace;
-bool performing_gc;
-bool performing_compaction;
-cell collecting_gen;
-
-/* if true, we are 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];
-u64 cards_scanned;
-u64 decks_scanned;
-u64 card_scan_time;
-cell code_heap_scans;
-
-/* What generation was being collected when copy_code_heap_roots() was last
-called? Until the next call to add_code_block(), future
-collections of younger generations don't have to touch the code
-heap. */
-cell last_code_heap_scan;
-
-/* sometimes we grow the heap */
-bool growing_data_heap;
-data_heap *old_data_heap;
-
void factorvm::init_data_gc()
{
performing_gc = false;
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 47d2657587..68b2b4a936 100755
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -10,14 +10,6 @@ struct gc_stats {
u64 bytes_copied;
};
-extern zone *newspace;
-
-extern bool performing_compaction;
-extern cell collecting_gen;
-extern bool collecting_aging_again;
-
-extern cell last_code_heap_scan;
-
void init_data_gc();
void gc();
@@ -41,8 +33,6 @@ void clear_gc_stats();
PRIMITIVE(clear_gc_stats);
PRIMITIVE(become);
-extern bool growing_data_heap;
-
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index a58ac1ad9e..59d9d277f8 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -170,6 +170,36 @@ struct factorvm {
//data_gc
+ /* used during garbage collection only */
+ zone *newspace;
+ 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 */
+ 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];
+ u64 cards_scanned;
+ u64 decks_scanned;
+ u64 card_scan_time;
+ cell code_heap_scans;
+
+ /* What generation was being collected when copy_code_heap_roots() was last
+ called? Until the next call to add_code_block(), future
+ collections of younger generations don't have to touch the code
+ heap. */
+ cell last_code_heap_scan;
+
+ /* sometimes we grow the heap */
+ bool growing_data_heap;
+ data_heap *old_data_heap;
+
void init_data_gc();
object *copy_untagged_object_impl(object *pointer, cell size);
object *copy_object_impl(object *untagged);
From 221c0ac5c892612800d38e83e06cf81870c91d2e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 065/266] moved global state from data_heap into vm
---
vm/data_heap.cpp | 12 ++----------
vm/data_heap.hpp | 6 ------
vm/vm.hpp | 6 ++++++
3 files changed, 8 insertions(+), 16 deletions(-)
mode change 100644 => 100755 vm/data_heap.hpp
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index 34284659f0..020954bf05 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -5,16 +5,12 @@ factor::zone nursery;
namespace factor
{
-/* Set by the -securegc command line argument */
-bool secure_gc;
-
/* new objects are allocated here */
VM_C_API zone nursery;
-/* GC is off during heap walking */
-bool gc_off;
-data_heap *data;
+
+
cell factorvm::init_zone(zone *z, cell size, cell start)
{
@@ -377,10 +373,6 @@ PRIMITIVE(data_room)
PRIMITIVE_GETVM()->vmprim_data_room();
}
-/* A heap walk allows useful things to be done, like finding all
-references to an object for debugging purposes. */
-cell heap_scan_ptr;
-
/* Disables GC and activates next-object ( -- obj ) primitive */
void factorvm::begin_scan()
{
diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp
old mode 100644
new mode 100755
index 4ef72a6fcb..2bec35b8c1
--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@@ -1,8 +1,6 @@
namespace factor
{
-/* Set by the -securegc command line argument */
-extern bool secure_gc;
/* generational copying GC divides memory into zones */
struct zone {
@@ -47,7 +45,6 @@ struct data_heap {
bool have_aging_p() { return gen_count > 2; }
};
-extern data_heap *data;
static const cell max_gen_count = 3;
@@ -99,9 +96,6 @@ PRIMITIVE(begin_scan);
PRIMITIVE(next_object);
PRIMITIVE(end_scan);
-/* GC is off during heap walking */
-extern bool gc_off;
-
cell find_all_words();
/* Every object has a regular representation in the runtime, which makes GC
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 59d9d277f8..1e30c13136 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -131,6 +131,12 @@ struct factorvm {
bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p);
//data_heap
+ bool secure_gc; /* Set by the -securegc command line argument */
+ bool gc_off; /* GC is off during heap walking */
+ data_heap *data;
+ /* A heap walk allows useful things to be done, like finding all
+ references to an object for debugging purposes. */
+ cell heap_scan_ptr;
cell init_zone(zone *z, cell size, cell start);
void init_card_decks();
data_heap *alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size);
From 396eeeba34496919a7e57b8ad9eb70e07d4c7b21 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 066/266] moved global state from code_heap into vm
---
vm/code_heap.cpp | 3 ---
vm/code_heap.hpp | 2 --
vm/vm.hpp | 2 ++
3 files changed, 2 insertions(+), 5 deletions(-)
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 943ee8d7c0..3d5d2c955a 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -3,8 +3,6 @@
namespace factor
{
-heap code;
-
/* Allocate a code heap during startup */
void factorvm::init_code_heap(cell size)
{
@@ -159,7 +157,6 @@ PRIMITIVE(code_room)
PRIMITIVE_GETVM()->vmprim_code_room();
}
-static unordered_map<heap_block *,char *> forwarding;
code_block *factorvm::forward_xt(code_block *compiled)
{
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 6f139a4728..31116590ad 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -1,8 +1,6 @@
namespace factor
{
-/* compiled code */
-extern heap code;
void init_code_heap(cell size);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 1e30c13136..8eda721992 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -468,6 +468,8 @@ struct factorvm {
code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_);
//code_heap
+ heap code;
+ unordered_map<heap_block *,char *> forwarding;
void init_code_heap(cell size);
bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word_, cell def_, bool relocate);
From c506abc6cdcc548cec12d6c8ac9d78dac6bce3f6 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 067/266] moved global state from debug into vm
---
vm/debug.cpp | 4 ----
vm/vm.hpp | 5 ++++-
2 files changed, 4 insertions(+), 5 deletions(-)
diff --git a/vm/debug.cpp b/vm/debug.cpp
index 870c817a2b..5d033fd90e 100755
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -3,8 +3,6 @@
namespace factor
{
-static bool fep_disabled;
-static bool full_output;
void factorvm::print_chars(string* str)
{
@@ -346,8 +344,6 @@ void dump_objects(cell type)
return vm->dump_objects(type);
}
-cell look_for;
-cell obj;
void factorvm::find_data_references_step(cell *scan)
{
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8eda721992..4ad83b86be 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -252,6 +252,10 @@ struct factorvm {
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
//debug
+ bool fep_disabled;
+ bool full_output;
+ cell look_for;
+ cell obj;
void print_chars(string* str);
void print_word(word* word, cell nesting);
void print_factor_string(string* str);
@@ -1073,7 +1077,6 @@ inline cell tag_boolean(cell untagged)
return vm->tag_boolean(untagged);
}
-
// next method here:
From 498b1917dc196a8732c0fef74680aac0964ab77b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 068/266] moved global state from dispatch into vm
---
vm/dispatch.cpp | 3 ---
vm/dispatch.hpp | 3 ---
vm/vm.hpp | 2 ++
3 files changed, 2 insertions(+), 6 deletions(-)
diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp
index 1721efe181..25f7a2f2ec 100755
--- a/vm/dispatch.cpp
+++ b/vm/dispatch.cpp
@@ -3,9 +3,6 @@
namespace factor
{
-cell megamorphic_cache_hits;
-cell megamorphic_cache_misses;
-
cell factorvm::search_lookup_alist(cell table, cell klass)
{
array *elements = untag<array>(table);
diff --git a/vm/dispatch.hpp b/vm/dispatch.hpp
index 75368191a7..f5648c7ebe 100644
--- a/vm/dispatch.hpp
+++ b/vm/dispatch.hpp
@@ -1,9 +1,6 @@
namespace factor
{
-extern cell megamorphic_cache_hits;
-extern cell megamorphic_cache_misses;
-
cell lookup_method(cell object, cell methods);
PRIMITIVE(lookup_method);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 4ad83b86be..8a0808397d 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -559,6 +559,8 @@ struct factorvm {
inline void vmprim_quot_compiled_p();
//dispatch
+ cell megamorphic_cache_hits;
+ cell megamorphic_cache_misses;
cell search_lookup_alist(cell table, cell klass);
cell search_lookup_hash(cell table, cell klass, cell hashcode);
cell nth_superclass(tuple_layout *layout, fixnum echelon);
From 839491a828ec0528918e3b0e97ebe2ea49ea8d68 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 069/266] moved global state from inline_cache into vm
---
vm/image.cpp | 2 --
vm/inline_cache.cpp | 8 --------
vm/inline_cache.hpp | 3 ---
vm/vm.hpp | 7 +++++++
4 files changed, 7 insertions(+), 13 deletions(-)
diff --git a/vm/image.cpp b/vm/image.cpp
index 746461680c..91fa1b801b 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -19,7 +19,6 @@ void init_objects(image_header *h)
return vm->init_objects(h);
}
-cell data_relocation_base;
void factorvm::load_data_heap(FILE *file, image_header *h, vm_parameters *p)
{
@@ -59,7 +58,6 @@ void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
return vm->load_data_heap(file,h,p);
}
-cell code_relocation_base;
void factorvm::load_code_heap(FILE *file, image_header *h, vm_parameters *p)
{
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index b6a90b1ff4..15d8fcb203 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -3,14 +3,6 @@
namespace factor
{
-cell max_pic_size;
-
-cell cold_call_to_ic_transitions;
-cell ic_to_pic_transitions;
-cell pic_to_mega_transitions;
-
-/* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
-cell pic_counts[4];
void factorvm::init_inline_caching(int max_size)
{
diff --git a/vm/inline_cache.hpp b/vm/inline_cache.hpp
index e2a6ae8cf9..e354d30677 100644
--- a/vm/inline_cache.hpp
+++ b/vm/inline_cache.hpp
@@ -1,8 +1,5 @@
namespace factor
{
-
-extern cell max_pic_size;
-
void init_inline_caching(int max_size);
PRIMITIVE(reset_inline_cache_stats);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8a0808397d..813bf5c528 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -489,6 +489,8 @@ struct factorvm {
void compact_code_heap();
//image
+ cell code_relocation_base;
+ cell data_relocation_base;
void init_objects(image_header *h);
void load_data_heap(FILE *file, image_header *h, vm_parameters *p);
void load_code_heap(FILE *file, image_header *h, vm_parameters *p);
@@ -578,6 +580,11 @@ struct factorvm {
inline void vmprim_dispatch_stats();
//inline cache
+ cell max_pic_size;
+ cell cold_call_to_ic_transitions;
+ cell ic_to_pic_transitions;
+ cell pic_to_mega_transitions;
+ cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
void init_inline_caching(int max_size);
void deallocate_inline_cache(cell return_address);
cell determine_inline_cache_type(array *cache_entries);
From efa974f0250946959fd2f46d5e370f383b9e21fd Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 070/266] moved global state from math into vm
---
vm/bignum.cpp | 2 +-
vm/bignum.hpp | 4 ----
vm/local_roots.hpp | 1 -
vm/math.cpp | 4 ----
vm/math.hpp | 4 ----
vm/vm.hpp | 10 ++++++++++
6 files changed, 11 insertions(+), 14 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 62d9952364..03b34edd97 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -371,7 +371,7 @@ bignum *bignum_remainder(bignum * numerator, bignum * denominator)
}
#define FOO_TO_BIGNUM(name,type,utype) \
- bignum * name##_to_bignum(type n) \
+ bignum * factorvm::name##_to_bignum(type n) \
{ \
int negative_p; \
bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
diff --git a/vm/bignum.hpp b/vm/bignum.hpp
index 296f0dce4c..5f502dcc22 100644
--- a/vm/bignum.hpp
+++ b/vm/bignum.hpp
@@ -55,10 +55,6 @@ bignum_divide(bignum * numerator, bignum * denominator,
bignum * * quotient, bignum * * remainder);
bignum * bignum_quotient(bignum *, bignum *);
bignum * bignum_remainder(bignum *, bignum *);
-bignum * fixnum_to_bignum(fixnum);
-bignum * cell_to_bignum(cell);
-bignum * long_long_to_bignum(s64 n);
-bignum * ulong_long_to_bignum(u64 n);
fixnum bignum_to_fixnum(bignum *);
cell bignum_to_cell(bignum *);
s64 bignum_to_long_long(bignum *);
diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp
index 412ef35bb4..0d6a033f82 100644
--- a/vm/local_roots.hpp
+++ b/vm/local_roots.hpp
@@ -1,4 +1,3 @@
namespace factor
{
-
}
diff --git a/vm/math.cpp b/vm/math.cpp
index f273cede0e..74caec3074 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -3,10 +3,6 @@
namespace factor
{
-cell bignum_zero;
-cell bignum_pos_one;
-cell bignum_neg_one;
-
inline void factorvm::vmprim_bignum_to_fixnum()
{
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
diff --git a/vm/math.hpp b/vm/math.hpp
index 0f8de05218..863fa1b4af 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -1,10 +1,6 @@
namespace factor
{
-extern cell bignum_zero;
-extern cell bignum_pos_one;
-extern cell bignum_neg_one;
-
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));
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 813bf5c528..fab910be48 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -243,6 +243,9 @@ struct factorvm {
inline void check_tagged_pointer(cell tagged);
// local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
std::vector<cell> gc_locals;
std::vector<cell> gc_bignums;
@@ -329,10 +332,17 @@ struct factorvm {
inline void vmprim_wrapper();
//math
+ cell bignum_zero;
+ cell bignum_pos_one;
+ cell bignum_neg_one;
inline void vmprim_bignum_to_fixnum();
inline void vmprim_float_to_fixnum();
inline void vmprim_fixnum_divint();
inline void vmprim_fixnum_divmod();
+ bignum *fixnum_to_bignum(fixnum);
+ bignum *cell_to_bignum(cell);
+ bignum *long_long_to_bignum(s64 n);
+ bignum *ulong_long_to_bignum(u64 n);
inline fixnum sign_mask(fixnum x);
inline fixnum branchless_max(fixnum x, fixnum y);
inline fixnum branchless_abs(fixnum x);
From 8fa607e9a96d5f348ffdeecb57d499f129b3eb79 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:13 +0100
Subject: [PATCH 071/266] Dev checkpoint
---
vm/code_block.cpp | 12 ++++++------
vm/code_block.hpp | 8 +++++---
vm/code_heap.cpp | 2 +-
vm/code_heap.hpp | 3 ++-
vm/contexts.hpp | 2 --
vm/image.cpp | 4 ++--
vm/profiler.cpp | 1 -
vm/profiler.hpp | 1 -
vm/vm.hpp | 12 +-----------
9 files changed, 17 insertions(+), 28 deletions(-)
mode change 100644 => 100755 vm/profiler.hpp
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index d5aa7581c2..0c95fcc424 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -397,9 +397,9 @@ void factorvm::copy_literal_references(code_block *compiled)
}
}
-void copy_literal_references(code_block *compiled)
+void copy_literal_references(code_block *compiled, factorvm *myvm)
{
- return vm->copy_literal_references(compiled);
+ return myvm->copy_literal_references(compiled);
}
/* Compute an address to store at a relocation */
@@ -456,9 +456,9 @@ void factorvm::update_word_references(code_block *compiled)
}
}
-void update_word_references(code_block *compiled)
+void update_word_references(code_block *compiled, factorvm *myvm)
{
- return vm->update_word_references(compiled);
+ return myvm->update_word_references(compiled);
}
void factorvm::update_literal_and_word_references(code_block *compiled)
@@ -574,9 +574,9 @@ void factorvm::relocate_code_block(code_block *compiled)
flush_icache_for(compiled);
}
-void relocate_code_block(code_block *compiled)
+void relocate_code_block(code_block *compiled, factorvm *myvm)
{
- return vm->relocate_code_block(compiled);
+ return myvm->relocate_code_block(compiled);
}
/* Fixup labels. This is done at compile time, not image load time */
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index 3497ff33ba..67c1e837f4 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -62,19 +62,21 @@ typedef u32 relocation_entry;
void flush_icache_for(code_block *compiled);
+struct factorvm;
+
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
void iterate_relocations(code_block *compiled, relocation_iterator iter);
void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
-void relocate_code_block(code_block *compiled);
+void relocate_code_block(code_block *compiled, factorvm *myvm);
void update_literal_references(code_block *compiled);
-void copy_literal_references(code_block *compiled);
+void copy_literal_references(code_block *compiled, factorvm *myvm);
-void update_word_references(code_block *compiled);
+void update_word_references(code_block *compiled, factorvm *myvm);
void update_literal_and_word_references(code_block *compiled);
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 3d5d2c955a..9399c9ae70 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -51,7 +51,7 @@ void factorvm::iterate_code_heap(code_heap_iterator iter)
while(scan)
{
if(scan->status != B_FREE)
- iter((code_block *)scan);
+ iter((code_block *)scan,this);
scan = next_block(&code,scan);
}
}
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 31116590ad..26e1faeb19 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -8,7 +8,8 @@ bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word, cell def, bool relocate);
-typedef void (*code_heap_iterator)(code_block *compiled);
+struct factorvm;
+typedef void (*code_heap_iterator)(code_block *compiled,factorvm *myvm);
void iterate_code_heap(code_heap_iterator iter);
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 56642bcd1a..9828210111 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -36,8 +36,6 @@ struct context {
context *next;
};
-//extern cell ds_size, rs_size;
-
#define ds_bot (stack_chain->datastack_region->start)
#define ds_top (stack_chain->datastack_region->end)
#define rs_bot (stack_chain->retainstack_region->start)
diff --git a/vm/image.cpp b/vm/image.cpp
index 91fa1b801b..ee86dd5a3f 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -363,9 +363,9 @@ void factorvm::fixup_code_block(code_block *compiled)
relocate_code_block(compiled);
}
-void fixup_code_block(code_block *compiled)
+void fixup_code_block(code_block *compiled,factorvm *myvm)
{
- return vm->fixup_code_block(compiled);
+ return myvm->fixup_code_block(compiled);
}
void factorvm::relocate_code()
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index e87dd947fd..8f714a992c 100755
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -3,7 +3,6 @@
namespace factor
{
-bool profiling_p;
void factorvm::init_profiler()
{
diff --git a/vm/profiler.hpp b/vm/profiler.hpp
old mode 100644
new mode 100755
index b83ef3d354..ab1d27b9d8
--- a/vm/profiler.hpp
+++ b/vm/profiler.hpp
@@ -1,7 +1,6 @@
namespace factor
{
-extern bool profiling_p;
void init_profiler();
code_block *compile_profiling_stub(cell word);
PRIMITIVE(profiling);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index fab910be48..d0f31e4d3f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -1,17 +1,6 @@
namespace factor
{
-struct heap;
-struct data_heap;
-struct data;
-struct zone;
-struct vm_parameters;
-struct image_header;
-
-typedef u8 card;
-typedef u8 card_deck;
-
-
struct factorvm {
// contexts
@@ -47,6 +36,7 @@ struct factorvm {
inline void vmprim_clone();
// profiler
+ bool profiling_p;
void init_profiler();
code_block *compile_profiling_stub(cell word_);
void set_profiling(bool profiling);
From 93c665c6535113054a82c130d617f37e1d3ca13d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:14 +0100
Subject: [PATCH 072/266] Dev checkpoint
---
vm/code_block.cpp | 14 +++++++-------
vm/code_block.hpp | 2 +-
2 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 0c95fcc424..1beeddd69e 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -251,7 +251,7 @@ void factorvm::iterate_relocations(code_block *compiled, relocation_iterator ite
for(cell i = 0; i < length; i++)
{
relocation_entry rel = relocation->data<relocation_entry>()[i];
- iter(rel,index,compiled);
+ iter(rel,index,compiled,this);
index += number_of_parameters(relocation_type_of(rel));
}
}
@@ -352,9 +352,9 @@ void factorvm::update_literal_references_step(relocation_entry rel, cell index,
}
}
-void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
+void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
{
- return vm->update_literal_references_step(rel,index,compiled);
+ return myvm->update_literal_references_step(rel,index,compiled);
}
/* Update pointers to literals from compiled code. */
@@ -415,9 +415,9 @@ void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_b
compute_relocation(rel,index,compiled));
}
-void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
+void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
{
- return vm->relocate_code_block_step(rel,index,compiled);
+ return myvm->relocate_code_block_step(rel,index,compiled);
}
void factorvm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
@@ -427,9 +427,9 @@ void factorvm::update_word_references_step(relocation_entry rel, cell index, cod
relocate_code_block_step(rel,index,compiled);
}
-void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
+void update_word_references_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
{
- return vm->update_word_references_step(rel,index,compiled);
+ return myvm->update_word_references_step(rel,index,compiled);
}
/* Relocate new code blocks completely; updating references to literals,
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index 67c1e837f4..e29d161339 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -64,7 +64,7 @@ void flush_icache_for(code_block *compiled);
struct factorvm;
-typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
+typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled, factorvm *vm);
void iterate_relocations(code_block *compiled, relocation_iterator iter);
From baaf71eddc9fec772a0b45751140a9f3a5d7aaec Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:14 +0100
Subject: [PATCH 073/266] Dev checkpoint
---
vm/code_block.cpp | 4 ++--
vm/code_block.hpp | 2 +-
vm/code_gc.cpp | 2 +-
vm/code_gc.hpp | 2 +-
4 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 1beeddd69e..9486d7f3b3 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -467,9 +467,9 @@ void factorvm::update_literal_and_word_references(code_block *compiled)
update_word_references(compiled);
}
-void update_literal_and_word_references(code_block *compiled)
+void update_literal_and_word_references(code_block *compiled, factorvm *myvm)
{
- return vm->update_literal_and_word_references(compiled);
+ return myvm->update_literal_and_word_references(compiled);
}
void factorvm::check_code_address(cell address)
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index e29d161339..0addaeb854 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -78,7 +78,7 @@ void copy_literal_references(code_block *compiled, factorvm *myvm);
void update_word_references(code_block *compiled, factorvm *myvm);
-void update_literal_and_word_references(code_block *compiled);
+void update_literal_and_word_references(code_block *compiled, factorvm *myvm);
void mark_code_block(code_block *compiled);
diff --git a/vm/code_gc.cpp b/vm/code_gc.cpp
index d229fcd3bf..9ccc83aa0f 100755
--- a/vm/code_gc.cpp
+++ b/vm/code_gc.cpp
@@ -299,7 +299,7 @@ void factorvm::free_unmarked(heap *heap, heap_iterator iter)
add_to_free_list(heap,(free_heap_block *)prev);
scan->status = B_ALLOCATED;
prev = scan;
- iter(scan);
+ iter(scan,this);
break;
default:
critical_error("Invalid scan->status",(cell)scan);
diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp
index 1cfafb69c2..08bdd327c7 100755
--- a/vm/code_gc.hpp
+++ b/vm/code_gc.hpp
@@ -14,7 +14,7 @@ struct heap {
heap_free_list free;
};
-typedef void (*heap_iterator)(heap_block *compiled);
+typedef void (*heap_iterator)(heap_block *compiled,factorvm *vm);
void new_heap(heap *h, cell size);
void build_free_list(heap *h, cell size);
From d5da6a3d581f3216147d340efb06349ea19e0e64 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:14 +0100
Subject: [PATCH 074/266] Dev checkpoint
---
vm/callstack.cpp | 6 +++---
vm/callstack.hpp | 10 ----------
vm/code_block.cpp | 8 ++++----
vm/code_heap.cpp | 4 ++--
vm/data_heap.hpp | 17 ----------------
vm/debug.cpp | 8 ++++----
vm/image.cpp | 8 ++++----
vm/math.cpp | 3 ++-
vm/vm.hpp | 51 +++++++++++++++++++++++++++++++++++++++++++++--
9 files changed, 68 insertions(+), 47 deletions(-)
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index e4f03abca9..8df438206c 100755
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -194,10 +194,10 @@ struct stack_frame_accumulator {
stack_frame_accumulator(factorvm *vm) : frames(vm) {}
- void operator()(stack_frame *frame)
+ void operator()(stack_frame *frame, factorvm *myvm)
{
- gc_root<object> executing(frame_executing(frame),frames.elements.myvm);
- gc_root<object> scan(frame_scan(frame),frames.elements.myvm);
+ gc_root<object> executing(frame_executing(frame),myvm);
+ gc_root<object> scan(frame_scan(frame),myvm);
frames.add(executing.value());
frames.add(scan.value());
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index ee097b528c..82fb93a1bc 100755
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -22,16 +22,6 @@ PRIMITIVE(set_innermost_stack_frame_quot);
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom);
-template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
-{
- stack_frame *frame = (stack_frame *)bottom - 1;
-
- while((cell)frame >= top)
- {
- iterator(frame);
- frame = frame_successor(frame);
- }
-}
}
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 9486d7f3b3..b8d4621d38 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -137,9 +137,9 @@ void factorvm::undefined_symbol()
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
}
-void undefined_symbol()
+void undefined_symbol(factorvm *myvm)
{
- return vm->undefined_symbol();
+ return myvm->undefined_symbol();
}
/* Look up an external library symbol referenced by a compiled code block */
@@ -509,9 +509,9 @@ void factorvm::mark_stack_frame_step(stack_frame *frame)
mark_code_block(frame_code(frame));
}
-void mark_stack_frame_step(stack_frame *frame)
+void mark_stack_frame_step(stack_frame *frame, factorvm *myvm)
{
- return vm->mark_stack_frame_step(frame);
+ return myvm->mark_stack_frame_step(frame);
}
/* Mark code blocks executing in currently active stack frames. */
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 9399c9ae70..fb24af4044 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -176,9 +176,9 @@ void factorvm::forward_frame_xt(stack_frame *frame)
FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
}
-void forward_frame_xt(stack_frame *frame)
+void forward_frame_xt(stack_frame *frame,factorvm *myvm)
{
- return vm->forward_frame_xt(frame);
+ return myvm->forward_frame_xt(frame);
}
void factorvm::forward_object_xts()
diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp
index 2bec35b8c1..67e3109924 100755
--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@@ -98,23 +98,6 @@ PRIMITIVE(end_scan);
cell find_all_words();
-/* Every object has a regular representation in the runtime, which makes GC
-much simpler. Every slot of the object until binary_payload_start is a pointer
-to some other object. */
-inline static void do_slots(cell obj, void (* iter)(cell *))
-{
- cell scan = obj;
- cell payload_start = binary_payload_start((object *)obj);
- cell end = obj + payload_start;
-
- scan += sizeof(cell);
-
- while(scan < end)
- {
- iter((cell *)scan);
- scan += sizeof(cell);
- }
-}
}
diff --git a/vm/debug.cpp b/vm/debug.cpp
index 5d033fd90e..eb64ad22d4 100755
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -232,9 +232,9 @@ void factorvm::print_stack_frame(stack_frame *frame)
print_string("\n");
}
-void print_stack_frame(stack_frame *frame)
+void print_stack_frame(stack_frame *frame, factorvm *myvm)
{
- return vm->print_stack_frame(frame);
+ return myvm->print_stack_frame(frame);
}
void factorvm::print_callstack()
@@ -356,9 +356,9 @@ void factorvm::find_data_references_step(cell *scan)
}
}
-void find_data_references_step(cell *scan)
+void find_data_references_step(cell *scan,factorvm *myvm)
{
- return vm->find_data_references_step(scan);
+ return myvm->find_data_references_step(scan);
}
void factorvm::find_data_references(cell look_for_)
diff --git a/vm/image.cpp b/vm/image.cpp
index ee86dd5a3f..b8e89d5fcb 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -195,9 +195,9 @@ void factorvm::data_fixup(cell *cell)
*cell += (tenured->start - data_relocation_base);
}
-void data_fixup(cell *cell)
+void data_fixup(cell *cell, factorvm *myvm)
{
- return vm->data_fixup(cell);
+ return myvm->data_fixup(cell);
}
template <typename TYPE> void factorvm::code_fixup(TYPE **handle)
@@ -258,9 +258,9 @@ void factorvm::fixup_stack_frame(stack_frame *frame)
code_fixup(&FRAME_RETURN_ADDRESS(frame));
}
-void fixup_stack_frame(stack_frame *frame)
+void fixup_stack_frame(stack_frame *frame, factorvm *myvm)
{
- return vm->fixup_stack_frame(frame);
+ return myvm->fixup_stack_frame(frame);
}
void factorvm::fixup_callstack_object(callstack *stack)
diff --git a/vm/math.cpp b/vm/math.cpp
index 74caec3074..ed556f268a 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -367,7 +367,8 @@ unsigned int bignum_producer(unsigned int digit)
inline void factorvm::vmprim_byte_array_to_bignum()
{
cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
- bignum * result = factor::digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
+ // bignum * result = factor::digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
+ bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
drepl(tag<bignum>(result));
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index d0f31e4d3f..42a250832c 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -61,6 +61,8 @@ struct factorvm {
void type_error(cell type, cell tagged);
void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top);
+ //callstack
+
// bignum
int bignum_equal_p(bignum * x, bignum * y);
enum bignum_comparison bignum_compare(bignum * x, bignum * y);
@@ -530,6 +532,10 @@ struct factorvm {
inline void vmprim_innermost_stack_frame_scan();
inline void vmprim_set_innermost_stack_frame_quot();
void save_callstack_bottom(stack_frame *callstack_bottom);
+ template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator);
+ inline void do_slots(cell obj, void (* iter)(cell *,factorvm*));
+ // next method here:
+
//alien
char *pinned_alien_offset(cell obj);
@@ -1066,7 +1072,7 @@ template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack
{
stack_frame *frame = stack->frame_at(frame_offset);
frame_offset -= frame->size;
- iterator(frame);
+ iterator(frame,this);
}
}
@@ -1086,7 +1092,48 @@ inline cell tag_boolean(cell untagged)
return vm->tag_boolean(untagged);
}
-// next method here:
+// callstack.hpp
+template<typename TYPE> void factorvm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
+{
+ stack_frame *frame = (stack_frame *)bottom - 1;
+
+ while((cell)frame >= top)
+ {
+ iterator(frame,this);
+ frame = frame_successor(frame);
+ }
+}
+
+template<typename TYPE> void iterate_callstack(cell top, cell bottom, TYPE &iterator)
+{
+ return vm->iterate_callstack(top,bottom,iterator);
+}
+
+
+// data_heap.hpp
+/* Every object has a regular representation in the runtime, which makes GC
+much simpler. Every slot of the object until binary_payload_start is a pointer
+to some other object. */
+struct factorvm;
+inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
+{
+ cell scan = obj;
+ cell payload_start = binary_payload_start((object *)obj);
+ cell end = obj + payload_start;
+
+ scan += sizeof(cell);
+
+ while(scan < end)
+ {
+ iter((cell *)scan,this);
+ scan += sizeof(cell);
+ }
+}
+
+inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
+{
+ return vm->do_slots(obj,iter);
+}
}
From d093ff766f9e45cdf4c564383a0ddcea6991f7e9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:14 +0100
Subject: [PATCH 075/266] updated function ptr calls (iterators etc..) to take
a vm parameter
---
vm/bignum.cpp | 8 ++++----
vm/bignum.hpp | 3 ++-
vm/math.cpp | 4 ++--
vm/vm.hpp | 2 +-
4 files changed, 9 insertions(+), 8 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 03b34edd97..f61b44340e 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -1980,14 +1980,14 @@ int bignum_unsigned_logbitp(int shift, bignum * bignum)
}
/* Allocates memory */
-bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p)
+bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
{
BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
if (n_digits == 0)
return (BIGNUM_ZERO ());
if (n_digits == 1)
{
- fixnum digit = ((fixnum) ((*producer) (0)));
+ fixnum digit = ((fixnum) ((*producer) (0,this)));
return (fixnum_to_bignum (negative_p ? (- digit) : digit));
}
{
@@ -2009,14 +2009,14 @@ bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*p
{
bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
bignum_destructive_add
- (result, ((bignum_digit_type) ((*producer) (n_digits))));
+ (result, ((bignum_digit_type) ((*producer) (n_digits,this))));
}
return (bignum_trim (result));
}
}
}
-bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p)
+bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
{
return vm->digit_stream_to_bignum(n_digits,producer,radix,negative_p);
}
diff --git a/vm/bignum.hpp b/vm/bignum.hpp
index 5f502dcc22..8f21702f1a 100644
--- a/vm/bignum.hpp
+++ b/vm/bignum.hpp
@@ -119,8 +119,9 @@ void bignum_negate_magnitude(bignum *);
bignum * bignum_integer_length(bignum * arg1);
int bignum_unsigned_logbitp(int shift, bignum * bignum);
int bignum_logbitp(int shift, bignum * arg);
+struct factorvm;
bignum * digit_stream_to_bignum(unsigned int n_digits,
- unsigned int (*producer)(unsigned int),
+ unsigned int (*producer)(unsigned int,factorvm*),
unsigned int radix,
int negative_p);
diff --git a/vm/math.cpp b/vm/math.cpp
index ed556f268a..98188059f6 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -359,9 +359,9 @@ unsigned int factorvm::bignum_producer(unsigned int digit)
return *(ptr + digit);
}
-unsigned int bignum_producer(unsigned int digit)
+unsigned int bignum_producer(unsigned int digit, factorvm *myvm)
{
- return vm->bignum_producer(digit);
+ return myvm->bignum_producer(digit);
}
inline void factorvm::vmprim_byte_array_to_bignum()
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 42a250832c..0f7a26c020 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -120,7 +120,7 @@ struct factorvm {
bignum *bignum_integer_length(bignum * x);
int bignum_logbitp(int shift, bignum * arg);
int bignum_unsigned_logbitp(int shift, bignum * bignum);
- bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int), unsigned int radix, int negative_p);
+ bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm *), unsigned int radix, int negative_p);
//data_heap
bool secure_gc; /* Set by the -securegc command line argument */
From 2e81b174a712e445ba333c1f8f7760aebd8911b1 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:14 +0100
Subject: [PATCH 076/266] removed some stub functions from contexts
---
vm/contexts.cpp | 40 ----------------------------------------
vm/contexts.hpp | 5 -----
2 files changed, 45 deletions(-)
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 03768ec0db..448351baf7 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -11,21 +11,11 @@ void factorvm::reset_datastack()
ds = ds_bot - sizeof(cell);
}
-void reset_datastack()
-{
- return vm->reset_datastack();
-}
-
void factorvm::reset_retainstack()
{
rs = rs_bot - sizeof(cell);
}
-void reset_retainstack()
-{
- return vm->reset_retainstack();
-}
-
static const cell stack_reserved = (64 * sizeof(cell));
void factorvm::fix_stacks()
@@ -34,11 +24,6 @@ void factorvm::fix_stacks()
if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
}
-void fix_stacks()
-{
- return vm->fix_stacks();
-}
-
/* called before entry into foreign C code. Note that ds and rs might
be stored in registers, so callbacks must save and restore the correct values */
void factorvm::save_stacks()
@@ -74,22 +59,12 @@ context *factorvm::alloc_context()
return new_context;
}
-context *alloc_context()
-{
- return vm->alloc_context();
-}
-
void factorvm::dealloc_context(context *old_context)
{
old_context->next = unused_contexts;
unused_contexts = old_context;
}
-void dealloc_context(context *old_context)
-{
- return vm->dealloc_context(old_context);
-}
-
/* called on entry into a compiled callback */
void factorvm::nest_stacks()
{
@@ -156,11 +131,6 @@ void factorvm::init_stacks(cell ds_size_, cell rs_size_)
unused_contexts = NULL;
}
-void init_stacks(cell ds_size_, cell rs_size_)
-{
- return vm->init_stacks(ds_size_,rs_size_);
-}
-
bool factorvm::stack_to_array(cell bottom, cell top)
{
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
@@ -176,11 +146,6 @@ bool factorvm::stack_to_array(cell bottom, cell top)
}
}
-bool stack_to_array(cell bottom, cell top)
-{
- return vm->stack_to_array(bottom,top);
-}
-
inline void factorvm::vmprim_datastack()
{
if(!stack_to_array(ds_bot,ds))
@@ -211,11 +176,6 @@ cell factorvm::array_to_stack(array *array, cell bottom)
return bottom + depth - sizeof(cell);
}
-cell array_to_stack(array *array, cell bottom)
-{
- return vm->array_to_stack(array,bottom);
-}
-
inline void factorvm::vmprim_set_datastack()
{
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 9828210111..00d9646424 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -44,11 +44,6 @@ struct context {
DEFPUSHPOP(d,ds)
DEFPUSHPOP(r,rs)
-void reset_datastack();
-void reset_retainstack();
-void fix_stacks();
-void init_stacks(cell ds_size, cell rs_size);
-
PRIMITIVE(datastack);
PRIMITIVE(retainstack);
PRIMITIVE(set_datastack);
From a66cf7e609f4de7883e07a41787288ef2f67f5e8 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:14 +0100
Subject: [PATCH 077/266] removed stub function from run
---
vm/run.cpp | 5 -----
1 file changed, 5 deletions(-)
diff --git a/vm/run.cpp b/vm/run.cpp
index 7f4894f1ef..f8c099bbfd 100755
--- a/vm/run.cpp
+++ b/vm/run.cpp
@@ -102,11 +102,6 @@ cell factorvm::clone_object(cell obj_)
}
}
-cell clone_object(cell obj_)
-{
- return vm->clone_object(obj_);
-}
-
inline void factorvm::vmprim_clone()
{
drepl(clone_object(dpeek()));
From 75c81af691f12fb850f8ec8d80917ef13ba4ec34 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:15 +0100
Subject: [PATCH 078/266] moved more math.hpp inline functions to vm
---
vm/math.hpp | 40 ----------------------------------------
vm/vm.hpp | 47 ++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 46 insertions(+), 41 deletions(-)
diff --git a/vm/math.hpp b/vm/math.hpp
index 863fa1b4af..4633721194 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -38,48 +38,8 @@ PRIMITIVE(bignum_bitp);
PRIMITIVE(bignum_log2);
PRIMITIVE(byte_array_to_bignum);
-
-
-
-
-
-
-
-
cell unbox_array_size();
-inline static double untag_float(cell tagged)
-{
- return untag<boxed_float>(tagged)->n;
-}
-
-inline static double untag_float_check(cell tagged)
-{
- return untag_check<boxed_float>(tagged)->n;
-}
-
-
-
-
-
-inline static fixnum float_to_fixnum(cell tagged)
-{
- return (fixnum)untag_float(tagged);
-}
-
-
-
-
-
-inline double fixnum_to_float(cell tagged)
-{
- return (double)untag_fixnum(tagged);
-}
-
-
-
-
-
PRIMITIVE(fixnum_to_float);
PRIMITIVE(bignum_to_float);
PRIMITIVE(str_to_float);
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0f7a26c020..30b7395a70 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -406,6 +406,11 @@ struct factorvm {
inline cell allot_float(double n);
inline bignum *float_to_bignum(cell tagged);
inline double bignum_to_float(cell tagged);
+ inline double untag_float(cell tagged);
+ inline double untag_float_check(cell tagged);
+ inline fixnum float_to_fixnum(cell tagged);
+ inline double fixnum_to_float(cell tagged);
+ // next method here:
//io
void init_c_io();
@@ -534,7 +539,6 @@ struct factorvm {
void save_callstack_bottom(stack_frame *callstack_bottom);
template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator);
inline void do_slots(cell obj, void (* iter)(cell *,factorvm*));
- // next method here:
//alien
@@ -1060,6 +1064,47 @@ inline double bignum_to_float(cell tagged)
return vm->bignum_to_float(tagged);
}
+inline double factorvm::untag_float(cell tagged)
+{
+ return untag<boxed_float>(tagged)->n;
+}
+
+inline double untag_float(cell tagged)
+{
+ return vm->untag_float(tagged);
+}
+
+inline double factorvm::untag_float_check(cell tagged)
+{
+ return untag_check<boxed_float>(tagged)->n;
+}
+
+inline double untag_float_check(cell tagged)
+{
+ return vm->untag_float_check(tagged);
+}
+
+inline fixnum factorvm::float_to_fixnum(cell tagged)
+{
+ return (fixnum)untag_float(tagged);
+}
+
+inline static fixnum float_to_fixnum(cell tagged)
+{
+ return vm->float_to_fixnum(tagged);
+}
+
+inline double factorvm::fixnum_to_float(cell tagged)
+{
+ return (double)untag_fixnum(tagged);
+}
+
+inline double fixnum_to_float(cell tagged)
+{
+ return vm->fixnum_to_float(tagged);
+}
+
+
//callstack.hpp
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
From e4f92cdbf25253b2bcc545c2f490b6d2050394bb Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:15 +0100
Subject: [PATCH 079/266] moved tagged.hpp templates to vm.hpp
---
vm/tagged.hpp | 63 ++------------------------------------------
vm/vm.hpp | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 75 insertions(+), 61 deletions(-)
mode change 100644 => 100755 vm/tagged.hpp
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
old mode 100644
new mode 100755
index ea1942e10c..ca208555da
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -1,72 +1,13 @@
namespace factor
{
-template <typename T> cell tag(T *value)
+template <typename TYPE> cell tag(TYPE *value)
{
- return RETAG(value,tag_for(T::type_number));
+ return RETAG(value,tag_for(TYPE::type_number));
}
inline static cell tag_dynamic(object *value)
{
return RETAG(value,tag_for(value->h.hi_tag()));
}
-
-template <typename T>
-struct tagged
-{
- cell value_;
-
- cell value() const { return value_; }
- T *untagged() const { return (T *)(UNTAG(value_)); }
-
- cell type() const {
- cell tag = TAG(value_);
- if(tag == OBJECT_TYPE)
- return untagged()->h.hi_tag();
- else
- return tag;
- }
-
- bool type_p(cell type_) const { return type() == type_; }
-
- T *untag_check() const {
- if(T::type_number != TYPE_COUNT && !type_p(T::type_number))
- type_error(T::type_number,value_);
- return untagged();
- }
-
- explicit tagged(cell tagged) : value_(tagged) {
-#ifdef FACTOR_DEBUG
- untag_check();
-#endif
- }
-
- explicit tagged(T *untagged) : value_(factor::tag(untagged)) {
-#ifdef FACTOR_DEBUG
- untag_check();
-#endif
- }
-
- T *operator->() const { return untagged(); }
- cell *operator&() const { return &value_; }
-
- const tagged<T>& operator=(const T *x) { value_ = tag(x); return *this; }
- const tagged<T>& operator=(const cell &x) { value_ = x; return *this; }
-
- bool operator==(const tagged<T> &x) { return value_ == x.value_; }
- bool operator!=(const tagged<T> &x) { return value_ != x.value_; }
-
- template<typename X> tagged<X> as() { return tagged<X>(value_); }
-};
-
-template <typename T> T *untag_check(cell value)
-{
- return tagged<T>(value).untag_check();
-}
-
-template <typename T> T *untag(cell value)
-{
- return tagged<T>(value).untagged();
-}
-
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 30b7395a70..24cb7a98f1 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -410,6 +410,8 @@ struct factorvm {
inline double untag_float_check(cell tagged);
inline fixnum float_to_fixnum(cell tagged);
inline double fixnum_to_float(cell tagged);
+ template <typename T> T *untag_check(cell value);
+ template <typename T> T *untag(cell value);
// next method here:
//io
@@ -642,6 +644,77 @@ struct factorvm {
extern factorvm *vm;
+//tagged.hpp
+
+template <typename TYPE>
+struct tagged
+{
+ cell value_;
+
+ cell value() const { return value_; }
+ TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
+
+ cell type() const {
+ cell tag = TAG(value_);
+ if(tag == OBJECT_TYPE)
+ return untagged()->h.hi_tag();
+ else
+ return tag;
+ }
+
+ bool type_p(cell type_) const { return type() == type_; }
+
+ TYPE *untag_check() const {
+ if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
+ type_error(TYPE::type_number,value_);
+ return untagged();
+ }
+
+ explicit tagged(cell tagged) : value_(tagged) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ TYPE *operator->() const { return untagged(); }
+ cell *operator&() const { return &value_; }
+
+ const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
+ const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
+
+ bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
+ bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
+
+ template<typename X> tagged<X> as() { return tagged<X>(value_); }
+};
+
+template <typename TYPE> TYPE *factorvm::untag_check(cell value)
+{
+ return tagged<TYPE>(value).untag_check();
+}
+
+template <typename TYPE> TYPE *untag_check(cell value)
+{
+ return vm->untag_check<TYPE>(value);
+}
+
+template <typename TYPE> TYPE *factorvm::untag(cell value)
+{
+ return tagged<TYPE>(value).untagged();
+}
+
+template <typename TYPE> TYPE *untag(cell value)
+{
+ return vm->untag<TYPE>(value);
+}
+
+
// write_barrier.hpp
From e08a6e21cbe15319b94558e489201e057f898419 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:15 +0100
Subject: [PATCH 080/266] split the moved inline stuff into separate header
file
---
vm/inlineimpls.hpp | 616 +++++++++++++++++++++++++++++++++++++++++++++
vm/master.hpp | 1 +
vm/vm.hpp | 610 --------------------------------------------
3 files changed, 617 insertions(+), 610 deletions(-)
create mode 100644 vm/inlineimpls.hpp
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
new file mode 100644
index 0000000000..b88b3254df
--- /dev/null
+++ b/vm/inlineimpls.hpp
@@ -0,0 +1,616 @@
+namespace factor
+{
+
+// I've had to copy inline implementations here to make dependencies work. Hopefully this can be better factored
+// once the rest of the reentrant changes are done. -PD
+
+//tagged.hpp
+
+template <typename TYPE>
+struct tagged
+{
+ cell value_;
+
+ cell value() const { return value_; }
+ TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
+
+ cell type() const {
+ cell tag = TAG(value_);
+ if(tag == OBJECT_TYPE)
+ return untagged()->h.hi_tag();
+ else
+ return tag;
+ }
+
+ bool type_p(cell type_) const { return type() == type_; }
+
+ TYPE *untag_check() const {
+ if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
+ type_error(TYPE::type_number,value_);
+ return untagged();
+ }
+
+ explicit tagged(cell tagged) : value_(tagged) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ TYPE *operator->() const { return untagged(); }
+ cell *operator&() const { return &value_; }
+
+ const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
+ const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
+
+ bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
+ bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
+
+ template<typename X> tagged<X> as() { return tagged<X>(value_); }
+};
+
+template <typename TYPE> TYPE *factorvm::untag_check(cell value)
+{
+ return tagged<TYPE>(value).untag_check();
+}
+
+template <typename TYPE> TYPE *untag_check(cell value)
+{
+ return vm->untag_check<TYPE>(value);
+}
+
+template <typename TYPE> TYPE *factorvm::untag(cell value)
+{
+ return tagged<TYPE>(value).untagged();
+}
+
+template <typename TYPE> TYPE *untag(cell value)
+{
+ return vm->untag<TYPE>(value);
+}
+
+
+
+// write_barrier.hpp
+
+inline card *factorvm::addr_to_card(cell a)
+{
+ return (card*)(((cell)(a) >> card_bits) + cards_offset);
+}
+
+inline card *addr_to_card(cell a)
+{
+ return vm->addr_to_card(a);
+}
+
+inline cell factorvm::card_to_addr(card *c)
+{
+ return ((cell)c - cards_offset) << card_bits;
+}
+
+inline cell card_to_addr(card *c)
+{
+ return vm->card_to_addr(c);
+}
+
+inline cell factorvm::card_offset(card *c)
+{
+ return *(c - (cell)data->cards + (cell)data->allot_markers);
+}
+
+inline cell card_offset(card *c)
+{
+ return vm->card_offset(c);
+}
+
+inline card_deck *factorvm::addr_to_deck(cell a)
+{
+ return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
+}
+
+inline card_deck *addr_to_deck(cell a)
+{
+ return vm->addr_to_deck(a);
+}
+
+inline cell factorvm::deck_to_addr(card_deck *c)
+{
+ return ((cell)c - decks_offset) << deck_bits;
+}
+
+inline cell deck_to_addr(card_deck *c)
+{
+ return vm->deck_to_addr(c);
+}
+
+inline card *factorvm::deck_to_card(card_deck *d)
+{
+ return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
+}
+
+inline card *deck_to_card(card_deck *d)
+{
+ return vm->deck_to_card(d);
+}
+
+inline card *factorvm::addr_to_allot_marker(object *a)
+{
+ return (card *)(((cell)a >> card_bits) + allot_markers_offset);
+}
+
+inline card *addr_to_allot_marker(object *a)
+{
+ return vm->addr_to_allot_marker(a);
+}
+
+/* the write barrier must be called any time we are potentially storing a
+pointer from an older generation to a younger one */
+inline void factorvm::write_barrier(object *obj)
+{
+ *addr_to_card((cell)obj) = card_mark_mask;
+ *addr_to_deck((cell)obj) = card_mark_mask;
+}
+
+inline void write_barrier(object *obj)
+{
+ return vm->write_barrier(obj);
+}
+
+/* we need to remember the first object allocated in the card */
+inline void factorvm::allot_barrier(object *address)
+{
+ card *ptr = addr_to_allot_marker(address);
+ if(*ptr == invalid_allot_marker)
+ *ptr = ((cell)address & addr_card_mask);
+}
+
+inline void allot_barrier(object *address)
+{
+ return vm->allot_barrier(address);
+}
+
+
+//data_gc.hpp
+inline bool factorvm::collecting_accumulation_gen_p()
+{
+ return ((data->have_aging_p()
+ && collecting_gen == data->aging()
+ && !collecting_aging_again)
+ || collecting_gen == data->tenured());
+}
+
+inline bool collecting_accumulation_gen_p()
+{
+ return vm->collecting_accumulation_gen_p();
+}
+
+inline object *factorvm::allot_zone(zone *z, cell a)
+{
+ cell h = z->here;
+ z->here = h + align8(a);
+ object *obj = (object *)h;
+ allot_barrier(obj);
+ return obj;
+}
+
+inline object *allot_zone(zone *z, cell a)
+{
+ return vm->allot_zone(z,a);
+}
+
+/*
+ * It is up to the caller to fill in the object's fields in a meaningful
+ * fashion!
+ */
+inline object *factorvm::allot_object(header header, cell size)
+{
+#ifdef GC_DEBUG
+ if(!gc_off)
+ gc();
+#endif
+
+ object *obj;
+
+ 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(data->nursery(),false,0);
+
+ cell h = nursery.here;
+ nursery.here = h + align8(size);
+ obj = (object *)h;
+ }
+ /* If the object is bigger than the nursery, allocate it in
+ tenured space */
+ else
+ {
+ 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[data->tenured()];
+ }
+
+ /* If it still won't fit, grow the heap */
+ if(tenured->here + size > tenured->end)
+ {
+ garbage_collection(data->tenured(),true,size);
+ tenured = &data->generations[data->tenured()];
+ }
+
+ obj = allot_zone(tenured,size);
+
+ /* Allows initialization code to store old->new pointers
+ without hitting the write barrier in the common case of
+ a nursery allocation */
+ write_barrier(obj);
+ }
+
+ obj->h = header;
+ return obj;
+}
+
+inline object *allot_object(header header, cell size)
+{
+ return vm->allot_object(header,size);
+}
+
+template<typename TYPE> TYPE *factorvm::allot(cell size)
+{
+ return (TYPE *)allot_object(header(TYPE::type_number),size);
+}
+
+template<typename TYPE> TYPE *allot(cell size)
+{
+ return vm->allot<TYPE>(size);
+}
+
+inline void factorvm::check_data_pointer(object *pointer)
+{
+#ifdef FACTOR_DEBUG
+ if(!growing_data_heap)
+ {
+ assert((cell)pointer >= data->seg->start
+ && (cell)pointer < data->seg->end);
+ }
+#endif
+}
+
+inline void check_data_pointer(object *pointer)
+{
+ return vm->check_data_pointer(pointer);
+}
+
+inline void factorvm::check_tagged_pointer(cell tagged)
+{
+#ifdef FACTOR_DEBUG
+ if(!immediate_p(tagged))
+ {
+ object *obj = untag<object>(tagged);
+ check_data_pointer(obj);
+ obj->h.hi_tag();
+ }
+#endif
+}
+
+inline void check_tagged_pointer(cell tagged)
+{
+ return vm->check_tagged_pointer(tagged);
+}
+
+//local_roots.hpp
+template <typename TYPE>
+struct gc_root : public tagged<TYPE>
+{
+ factorvm *myvm;
+
+ void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
+
+ //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
+ explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
+ explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
+
+ const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
+ const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
+
+ ~gc_root() {
+#ifdef FACTOR_DEBUG
+ assert(myvm->gc_locals.back() == (cell)this);
+#endif
+ myvm->gc_locals.pop_back();
+ }
+};
+
+/* A similar hack for the bignum implementation */
+struct gc_bignum
+{
+ bignum **addr;
+ factorvm *myvm;
+ gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
+ if(*addr_)
+ check_data_pointer(*addr_);
+ myvm->gc_bignums.push_back((cell)addr);
+ }
+
+ ~gc_bignum() {
+#ifdef FACTOR_DEBUG
+ assert(myvm->gc_bignums.back() == (cell)addr);
+#endif
+ myvm->gc_bignums.pop_back();
+ }
+};
+
+#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
+
+//generic_arrays.hpp
+template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
+{
+ TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
+ array->capacity = tag_fixnum(capacity);
+ return array;
+}
+
+template <typename TYPE> TYPE *allot_array_internal(cell capacity)
+{
+ return vm->allot_array_internal<TYPE>(capacity);
+}
+
+template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
+{
+ return in_zone(&nursery,array) && capacity <= array_capacity(array);
+}
+
+template <typename TYPE> bool reallot_array_in_place_p(TYPE *array, cell capacity)
+{
+ return vm->reallot_array_in_place_p<TYPE>(array,capacity);
+}
+
+template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
+{
+ gc_root<TYPE> array(array_,this);
+
+ if(reallot_array_in_place_p(array.untagged(),capacity))
+ {
+ array->capacity = tag_fixnum(capacity);
+ return array.untagged();
+ }
+ else
+ {
+ cell to_copy = array_capacity(array.untagged());
+ if(capacity < to_copy)
+ to_copy = capacity;
+
+ TYPE *new_array = allot_array_internal<TYPE>(capacity);
+
+ memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
+ memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
+ 0,(capacity - to_copy) * TYPE::element_size);
+
+ return new_array;
+ }
+}
+
+//arrays.hpp
+inline void factorvm::set_array_nth(array *array, cell slot, cell value)
+{
+#ifdef FACTOR_DEBUG
+ assert(slot < array_capacity(array));
+ assert(array->h.hi_tag() == ARRAY_TYPE);
+ check_tagged_pointer(value);
+#endif
+ array->data()[slot] = value;
+ write_barrier(array);
+}
+
+inline void set_array_nth(array *array, cell slot, cell value)
+{
+ return vm->set_array_nth(array,slot,value);
+}
+
+struct growable_array {
+ cell count;
+ gc_root<array> elements;
+
+ growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(allot_array(capacity,F),myvm) {}
+
+ void add(cell elt);
+ void trim();
+};
+
+//byte_arrays.hpp
+struct growable_byte_array {
+ cell count;
+ gc_root<byte_array> elements;
+
+ growable_byte_array(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
+
+ void append_bytes(void *elts, cell len);
+ void append_byte_array(cell elts);
+
+ void trim();
+};
+
+//math.hpp
+inline cell factorvm::allot_integer(fixnum x)
+{
+ if(x < fixnum_min || x > fixnum_max)
+ return tag<bignum>(fixnum_to_bignum(x));
+ else
+ return tag_fixnum(x);
+}
+
+inline cell allot_integer(fixnum x)
+{
+ return vm->allot_integer(x);
+}
+
+inline cell factorvm::allot_cell(cell x)
+{
+ if(x > (cell)fixnum_max)
+ return tag<bignum>(cell_to_bignum(x));
+ else
+ return tag_fixnum(x);
+}
+
+inline cell allot_cell(cell x)
+{
+ return vm->allot_cell(x);
+}
+
+inline cell factorvm::allot_float(double n)
+{
+ boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
+ flo->n = n;
+ return tag(flo);
+}
+
+inline cell allot_float(double n)
+{
+ return vm->allot_float(n);
+}
+
+inline bignum *factorvm::float_to_bignum(cell tagged)
+{
+ return double_to_bignum(untag_float(tagged));
+}
+
+inline bignum *float_to_bignum(cell tagged)
+{
+ return vm->float_to_bignum(tagged);
+}
+
+inline double factorvm::bignum_to_float(cell tagged)
+{
+ return bignum_to_double(untag<bignum>(tagged));
+}
+
+inline double bignum_to_float(cell tagged)
+{
+ return vm->bignum_to_float(tagged);
+}
+
+inline double factorvm::untag_float(cell tagged)
+{
+ return untag<boxed_float>(tagged)->n;
+}
+
+inline double untag_float(cell tagged)
+{
+ return vm->untag_float(tagged);
+}
+
+inline double factorvm::untag_float_check(cell tagged)
+{
+ return untag_check<boxed_float>(tagged)->n;
+}
+
+inline double untag_float_check(cell tagged)
+{
+ return vm->untag_float_check(tagged);
+}
+
+inline fixnum factorvm::float_to_fixnum(cell tagged)
+{
+ return (fixnum)untag_float(tagged);
+}
+
+inline static fixnum float_to_fixnum(cell tagged)
+{
+ return vm->float_to_fixnum(tagged);
+}
+
+inline double factorvm::fixnum_to_float(cell tagged)
+{
+ return (double)untag_fixnum(tagged);
+}
+
+inline double fixnum_to_float(cell tagged)
+{
+ return vm->fixnum_to_float(tagged);
+}
+
+
+//callstack.hpp
+/* This is a little tricky. The iterator may allocate memory, so we
+keep the callstack in a GC root and use relative offsets */
+template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
+{
+ gc_root<callstack> stack(stack_,vm);
+ fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
+
+ while(frame_offset >= 0)
+ {
+ stack_frame *frame = stack->frame_at(frame_offset);
+ frame_offset -= frame->size;
+ iterator(frame,this);
+ }
+}
+
+template<typename TYPE> void iterate_callstack_object(callstack *stack_, TYPE &iterator)
+{
+ return vm->iterate_callstack_object(stack_,iterator);
+}
+
+//booleans.hpp
+inline cell factorvm::tag_boolean(cell untagged)
+{
+ return (untagged ? T : F);
+}
+
+inline cell tag_boolean(cell untagged)
+{
+ return vm->tag_boolean(untagged);
+}
+
+// callstack.hpp
+template<typename TYPE> void factorvm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
+{
+ stack_frame *frame = (stack_frame *)bottom - 1;
+
+ while((cell)frame >= top)
+ {
+ iterator(frame,this);
+ frame = frame_successor(frame);
+ }
+}
+
+template<typename TYPE> void iterate_callstack(cell top, cell bottom, TYPE &iterator)
+{
+ return vm->iterate_callstack(top,bottom,iterator);
+}
+
+
+// data_heap.hpp
+/* Every object has a regular representation in the runtime, which makes GC
+much simpler. Every slot of the object until binary_payload_start is a pointer
+to some other object. */
+struct factorvm;
+inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
+{
+ cell scan = obj;
+ cell payload_start = binary_payload_start((object *)obj);
+ cell end = obj + payload_start;
+
+ scan += sizeof(cell);
+
+ while(scan < end)
+ {
+ iter((cell *)scan,this);
+ scan += sizeof(cell);
+ }
+}
+
+inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
+{
+ return vm->do_slots(obj,iter);
+}
+
+}
diff --git a/vm/master.hpp b/vm/master.hpp
index e118be67c3..5d95fa440e 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -68,6 +68,7 @@
#include "callstack.hpp"
#include "alien.hpp"
#include "vm.hpp"
+#include "inlineimpls.hpp"
#include "jit.hpp"
#include "quotations.hpp"
#include "dispatch.hpp"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 24cb7a98f1..1ed6d965bc 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -644,614 +644,4 @@ struct factorvm {
extern factorvm *vm;
-//tagged.hpp
-
-template <typename TYPE>
-struct tagged
-{
- cell value_;
-
- cell value() const { return value_; }
- TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
-
- cell type() const {
- cell tag = TAG(value_);
- if(tag == OBJECT_TYPE)
- return untagged()->h.hi_tag();
- else
- return tag;
- }
-
- bool type_p(cell type_) const { return type() == type_; }
-
- TYPE *untag_check() const {
- if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
- type_error(TYPE::type_number,value_);
- return untagged();
- }
-
- explicit tagged(cell tagged) : value_(tagged) {
-#ifdef FACTOR_DEBUG
- untag_check();
-#endif
- }
-
- explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
-#ifdef FACTOR_DEBUG
- untag_check();
-#endif
- }
-
- TYPE *operator->() const { return untagged(); }
- cell *operator&() const { return &value_; }
-
- const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
- const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
-
- bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
- bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
-
- template<typename X> tagged<X> as() { return tagged<X>(value_); }
-};
-
-template <typename TYPE> TYPE *factorvm::untag_check(cell value)
-{
- return tagged<TYPE>(value).untag_check();
-}
-
-template <typename TYPE> TYPE *untag_check(cell value)
-{
- return vm->untag_check<TYPE>(value);
-}
-
-template <typename TYPE> TYPE *factorvm::untag(cell value)
-{
- return tagged<TYPE>(value).untagged();
-}
-
-template <typename TYPE> TYPE *untag(cell value)
-{
- return vm->untag<TYPE>(value);
-}
-
-
-
-// write_barrier.hpp
-
-inline card *factorvm::addr_to_card(cell a)
-{
- return (card*)(((cell)(a) >> card_bits) + cards_offset);
-}
-
-inline card *addr_to_card(cell a)
-{
- return vm->addr_to_card(a);
-}
-
-inline cell factorvm::card_to_addr(card *c)
-{
- return ((cell)c - cards_offset) << card_bits;
-}
-
-inline cell card_to_addr(card *c)
-{
- return vm->card_to_addr(c);
-}
-
-inline cell factorvm::card_offset(card *c)
-{
- return *(c - (cell)data->cards + (cell)data->allot_markers);
-}
-
-inline cell card_offset(card *c)
-{
- return vm->card_offset(c);
-}
-
-inline card_deck *factorvm::addr_to_deck(cell a)
-{
- return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
-}
-
-inline card_deck *addr_to_deck(cell a)
-{
- return vm->addr_to_deck(a);
-}
-
-inline cell factorvm::deck_to_addr(card_deck *c)
-{
- return ((cell)c - decks_offset) << deck_bits;
-}
-
-inline cell deck_to_addr(card_deck *c)
-{
- return vm->deck_to_addr(c);
-}
-
-inline card *factorvm::deck_to_card(card_deck *d)
-{
- return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
-}
-
-inline card *deck_to_card(card_deck *d)
-{
- return vm->deck_to_card(d);
-}
-
-inline card *factorvm::addr_to_allot_marker(object *a)
-{
- return (card *)(((cell)a >> card_bits) + allot_markers_offset);
-}
-
-inline card *addr_to_allot_marker(object *a)
-{
- return vm->addr_to_allot_marker(a);
-}
-
-/* the write barrier must be called any time we are potentially storing a
-pointer from an older generation to a younger one */
-inline void factorvm::write_barrier(object *obj)
-{
- *addr_to_card((cell)obj) = card_mark_mask;
- *addr_to_deck((cell)obj) = card_mark_mask;
-}
-
-inline void write_barrier(object *obj)
-{
- return vm->write_barrier(obj);
-}
-
-/* we need to remember the first object allocated in the card */
-inline void factorvm::allot_barrier(object *address)
-{
- card *ptr = addr_to_allot_marker(address);
- if(*ptr == invalid_allot_marker)
- *ptr = ((cell)address & addr_card_mask);
-}
-
-inline void allot_barrier(object *address)
-{
- return vm->allot_barrier(address);
-}
-
-
-//data_gc.hpp
-inline bool factorvm::collecting_accumulation_gen_p()
-{
- return ((data->have_aging_p()
- && collecting_gen == data->aging()
- && !collecting_aging_again)
- || collecting_gen == data->tenured());
-}
-
-inline bool collecting_accumulation_gen_p()
-{
- return vm->collecting_accumulation_gen_p();
-}
-
-inline object *factorvm::allot_zone(zone *z, cell a)
-{
- cell h = z->here;
- z->here = h + align8(a);
- object *obj = (object *)h;
- allot_barrier(obj);
- return obj;
-}
-
-inline object *allot_zone(zone *z, cell a)
-{
- return vm->allot_zone(z,a);
-}
-
-/*
- * It is up to the caller to fill in the object's fields in a meaningful
- * fashion!
- */
-inline object *factorvm::allot_object(header header, cell size)
-{
-#ifdef GC_DEBUG
- if(!gc_off)
- gc();
-#endif
-
- object *obj;
-
- 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(data->nursery(),false,0);
-
- cell h = nursery.here;
- nursery.here = h + align8(size);
- obj = (object *)h;
- }
- /* If the object is bigger than the nursery, allocate it in
- tenured space */
- else
- {
- 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[data->tenured()];
- }
-
- /* If it still won't fit, grow the heap */
- if(tenured->here + size > tenured->end)
- {
- garbage_collection(data->tenured(),true,size);
- tenured = &data->generations[data->tenured()];
- }
-
- obj = allot_zone(tenured,size);
-
- /* Allows initialization code to store old->new pointers
- without hitting the write barrier in the common case of
- a nursery allocation */
- write_barrier(obj);
- }
-
- obj->h = header;
- return obj;
-}
-
-inline object *allot_object(header header, cell size)
-{
- return vm->allot_object(header,size);
-}
-
-template<typename TYPE> TYPE *factorvm::allot(cell size)
-{
- return (TYPE *)allot_object(header(TYPE::type_number),size);
-}
-
-template<typename TYPE> TYPE *allot(cell size)
-{
- return vm->allot<TYPE>(size);
-}
-
-inline void factorvm::check_data_pointer(object *pointer)
-{
-#ifdef FACTOR_DEBUG
- if(!growing_data_heap)
- {
- assert((cell)pointer >= data->seg->start
- && (cell)pointer < data->seg->end);
- }
-#endif
-}
-
-inline void check_data_pointer(object *pointer)
-{
- return vm->check_data_pointer(pointer);
-}
-
-inline void factorvm::check_tagged_pointer(cell tagged)
-{
-#ifdef FACTOR_DEBUG
- if(!immediate_p(tagged))
- {
- object *obj = untag<object>(tagged);
- check_data_pointer(obj);
- obj->h.hi_tag();
- }
-#endif
-}
-
-inline void check_tagged_pointer(cell tagged)
-{
- return vm->check_tagged_pointer(tagged);
-}
-
-//local_roots.hpp
-template <typename TYPE>
-struct gc_root : public tagged<TYPE>
-{
- factorvm *myvm;
-
- void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
-
- //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
- explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
- explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
-
- const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
- const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
-
- ~gc_root() {
-#ifdef FACTOR_DEBUG
- assert(myvm->gc_locals.back() == (cell)this);
-#endif
- myvm->gc_locals.pop_back();
- }
-};
-
-/* A similar hack for the bignum implementation */
-struct gc_bignum
-{
- bignum **addr;
- factorvm *myvm;
- gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
- if(*addr_)
- check_data_pointer(*addr_);
- myvm->gc_bignums.push_back((cell)addr);
- }
-
- ~gc_bignum() {
-#ifdef FACTOR_DEBUG
- assert(myvm->gc_bignums.back() == (cell)addr);
-#endif
- myvm->gc_bignums.pop_back();
- }
-};
-
-#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
-
-//generic_arrays.hpp
-template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
-{
- TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
- array->capacity = tag_fixnum(capacity);
- return array;
-}
-
-template <typename TYPE> TYPE *allot_array_internal(cell capacity)
-{
- return vm->allot_array_internal<TYPE>(capacity);
-}
-
-template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
-{
- return in_zone(&nursery,array) && capacity <= array_capacity(array);
-}
-
-template <typename TYPE> bool reallot_array_in_place_p(TYPE *array, cell capacity)
-{
- return vm->reallot_array_in_place_p<TYPE>(array,capacity);
-}
-
-template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
-{
- gc_root<TYPE> array(array_,this);
-
- if(reallot_array_in_place_p(array.untagged(),capacity))
- {
- array->capacity = tag_fixnum(capacity);
- return array.untagged();
- }
- else
- {
- cell to_copy = array_capacity(array.untagged());
- if(capacity < to_copy)
- to_copy = capacity;
-
- TYPE *new_array = allot_array_internal<TYPE>(capacity);
-
- memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
- memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
- 0,(capacity - to_copy) * TYPE::element_size);
-
- return new_array;
- }
-}
-
-//arrays.hpp
-inline void factorvm::set_array_nth(array *array, cell slot, cell value)
-{
-#ifdef FACTOR_DEBUG
- assert(slot < array_capacity(array));
- assert(array->h.hi_tag() == ARRAY_TYPE);
- check_tagged_pointer(value);
-#endif
- array->data()[slot] = value;
- write_barrier(array);
-}
-
-inline void set_array_nth(array *array, cell slot, cell value)
-{
- return vm->set_array_nth(array,slot,value);
-}
-
-struct growable_array {
- cell count;
- gc_root<array> elements;
-
- growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(allot_array(capacity,F),myvm) {}
-
- void add(cell elt);
- void trim();
-};
-
-//byte_arrays.hpp
-struct growable_byte_array {
- cell count;
- gc_root<byte_array> elements;
-
- growable_byte_array(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
-
- void append_bytes(void *elts, cell len);
- void append_byte_array(cell elts);
-
- void trim();
-};
-
-//math.hpp
-inline cell factorvm::allot_integer(fixnum x)
-{
- if(x < fixnum_min || x > fixnum_max)
- return tag<bignum>(fixnum_to_bignum(x));
- else
- return tag_fixnum(x);
-}
-
-inline cell allot_integer(fixnum x)
-{
- return vm->allot_integer(x);
-}
-
-inline cell factorvm::allot_cell(cell x)
-{
- if(x > (cell)fixnum_max)
- return tag<bignum>(cell_to_bignum(x));
- else
- return tag_fixnum(x);
-}
-
-inline cell allot_cell(cell x)
-{
- return vm->allot_cell(x);
-}
-
-inline cell factorvm::allot_float(double n)
-{
- boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
- flo->n = n;
- return tag(flo);
-}
-
-inline cell allot_float(double n)
-{
- return vm->allot_float(n);
-}
-
-inline bignum *factorvm::float_to_bignum(cell tagged)
-{
- return double_to_bignum(untag_float(tagged));
-}
-
-inline bignum *float_to_bignum(cell tagged)
-{
- return vm->float_to_bignum(tagged);
-}
-
-inline double factorvm::bignum_to_float(cell tagged)
-{
- return bignum_to_double(untag<bignum>(tagged));
-}
-
-inline double bignum_to_float(cell tagged)
-{
- return vm->bignum_to_float(tagged);
-}
-
-inline double factorvm::untag_float(cell tagged)
-{
- return untag<boxed_float>(tagged)->n;
-}
-
-inline double untag_float(cell tagged)
-{
- return vm->untag_float(tagged);
-}
-
-inline double factorvm::untag_float_check(cell tagged)
-{
- return untag_check<boxed_float>(tagged)->n;
-}
-
-inline double untag_float_check(cell tagged)
-{
- return vm->untag_float_check(tagged);
-}
-
-inline fixnum factorvm::float_to_fixnum(cell tagged)
-{
- return (fixnum)untag_float(tagged);
-}
-
-inline static fixnum float_to_fixnum(cell tagged)
-{
- return vm->float_to_fixnum(tagged);
-}
-
-inline double factorvm::fixnum_to_float(cell tagged)
-{
- return (double)untag_fixnum(tagged);
-}
-
-inline double fixnum_to_float(cell tagged)
-{
- return vm->fixnum_to_float(tagged);
-}
-
-
-//callstack.hpp
-/* This is a little tricky. The iterator may allocate memory, so we
-keep the callstack in a GC root and use relative offsets */
-template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
-{
- gc_root<callstack> stack(stack_,vm);
- fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
-
- while(frame_offset >= 0)
- {
- stack_frame *frame = stack->frame_at(frame_offset);
- frame_offset -= frame->size;
- iterator(frame,this);
- }
-}
-
-template<typename TYPE> void iterate_callstack_object(callstack *stack_, TYPE &iterator)
-{
- return vm->iterate_callstack_object(stack_,iterator);
-}
-
-//booleans.hpp
-inline cell factorvm::tag_boolean(cell untagged)
-{
- return (untagged ? T : F);
-}
-
-inline cell tag_boolean(cell untagged)
-{
- return vm->tag_boolean(untagged);
-}
-
-// callstack.hpp
-template<typename TYPE> void factorvm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
-{
- stack_frame *frame = (stack_frame *)bottom - 1;
-
- while((cell)frame >= top)
- {
- iterator(frame,this);
- frame = frame_successor(frame);
- }
-}
-
-template<typename TYPE> void iterate_callstack(cell top, cell bottom, TYPE &iterator)
-{
- return vm->iterate_callstack(top,bottom,iterator);
-}
-
-
-// data_heap.hpp
-/* Every object has a regular representation in the runtime, which makes GC
-much simpler. Every slot of the object until binary_payload_start is a pointer
-to some other object. */
-struct factorvm;
-inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
-{
- cell scan = obj;
- cell payload_start = binary_payload_start((object *)obj);
- cell end = obj + payload_start;
-
- scan += sizeof(cell);
-
- while(scan < end)
- {
- iter((cell *)scan,this);
- scan += sizeof(cell);
- }
-}
-
-inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
-{
- return vm->do_slots(obj,iter);
-}
-
-
}
From e2993558a8f0a7d33be646efe9f3c68514086dda Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:15 +0100
Subject: [PATCH 081/266] moved tagged template code back into tagged.hpp
header
---
vm/inlineimpls.hpp | 70 ----------------------------------------------
vm/master.hpp | 2 +-
vm/tagged.hpp | 70 ++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 71 insertions(+), 71 deletions(-)
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index b88b3254df..8885c09404 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -6,76 +6,6 @@ namespace factor
//tagged.hpp
-template <typename TYPE>
-struct tagged
-{
- cell value_;
-
- cell value() const { return value_; }
- TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
-
- cell type() const {
- cell tag = TAG(value_);
- if(tag == OBJECT_TYPE)
- return untagged()->h.hi_tag();
- else
- return tag;
- }
-
- bool type_p(cell type_) const { return type() == type_; }
-
- TYPE *untag_check() const {
- if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
- type_error(TYPE::type_number,value_);
- return untagged();
- }
-
- explicit tagged(cell tagged) : value_(tagged) {
-#ifdef FACTOR_DEBUG
- untag_check();
-#endif
- }
-
- explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
-#ifdef FACTOR_DEBUG
- untag_check();
-#endif
- }
-
- TYPE *operator->() const { return untagged(); }
- cell *operator&() const { return &value_; }
-
- const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
- const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
-
- bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
- bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
-
- template<typename X> tagged<X> as() { return tagged<X>(value_); }
-};
-
-template <typename TYPE> TYPE *factorvm::untag_check(cell value)
-{
- return tagged<TYPE>(value).untag_check();
-}
-
-template <typename TYPE> TYPE *untag_check(cell value)
-{
- return vm->untag_check<TYPE>(value);
-}
-
-template <typename TYPE> TYPE *factorvm::untag(cell value)
-{
- return tagged<TYPE>(value).untagged();
-}
-
-template <typename TYPE> TYPE *untag(cell value)
-{
- return vm->untag<TYPE>(value);
-}
-
-
-
// write_barrier.hpp
inline card *factorvm::addr_to_card(cell a)
diff --git a/vm/master.hpp b/vm/master.hpp
index 5d95fa440e..bf60d1e4f6 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -41,7 +41,6 @@
#include "segments.hpp"
#include "contexts.hpp"
#include "run.hpp"
-#include "tagged.hpp"
#include "profiler.hpp"
#include "errors.hpp"
#include "bignumint.hpp"
@@ -68,6 +67,7 @@
#include "callstack.hpp"
#include "alien.hpp"
#include "vm.hpp"
+#include "tagged.hpp"
#include "inlineimpls.hpp"
#include "jit.hpp"
#include "quotations.hpp"
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index ca208555da..4a1babb599 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -10,4 +10,74 @@ inline static cell tag_dynamic(object *value)
{
return RETAG(value,tag_for(value->h.hi_tag()));
}
+
+template <typename TYPE>
+struct tagged
+{
+ cell value_;
+
+ cell value() const { return value_; }
+ TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
+
+ cell type() const {
+ cell tag = TAG(value_);
+ if(tag == OBJECT_TYPE)
+ return untagged()->h.hi_tag();
+ else
+ return tag;
+ }
+
+ bool type_p(cell type_) const { return type() == type_; }
+
+ TYPE *untag_check() const {
+ if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
+ type_error(TYPE::type_number,value_);
+ return untagged();
+ }
+
+ explicit tagged(cell tagged) : value_(tagged) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ TYPE *operator->() const { return untagged(); }
+ cell *operator&() const { return &value_; }
+
+ const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
+ const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
+
+ bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
+ bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
+
+ template<typename X> tagged<X> as() { return tagged<X>(value_); }
+};
+
+template <typename TYPE> TYPE *factorvm::untag_check(cell value)
+{
+ return tagged<TYPE>(value).untag_check();
+}
+
+template <typename TYPE> TYPE *untag_check(cell value)
+{
+ return vm->untag_check<TYPE>(value);
+}
+
+template <typename TYPE> TYPE *factorvm::untag(cell value)
+{
+ return tagged<TYPE>(value).untagged();
+}
+
+template <typename TYPE> TYPE *untag(cell value)
+{
+ return vm->untag<TYPE>(value);
+}
+
+
}
From 82e1ea71109a8d456a8272ee1e4adb4edc599cc2 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:15 +0100
Subject: [PATCH 082/266] vm ptr passed to untag_check
---
vm/alien.cpp | 4 ++--
vm/callstack.cpp | 6 +++---
vm/image.cpp | 4 ++--
vm/inlineimpls.hpp | 4 +---
vm/io.cpp | 4 ++--
vm/quotations.cpp | 2 +-
vm/tagged.hpp | 6 +++---
7 files changed, 14 insertions(+), 16 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 0419e3cec3..ffd49f60b0 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -139,7 +139,7 @@ DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
inline void factorvm::vmprim_dlopen()
{
gc_root<byte_array> path(dpop(),this);
- path.untag_check();
+ path.untag_check(this);
gc_root<dll> library(allot<dll>(sizeof(dll)),this);
library->path = path.value();
ffi_dlopen(library.untagged());
@@ -156,7 +156,7 @@ inline void factorvm::vmprim_dlsym()
{
gc_root<object> library(dpop(),this);
gc_root<byte_array> name(dpop(),this);
- name.untag_check();
+ name.untag_check(this);
symbol_char *sym = name->data<symbol_char>();
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index 8df438206c..c330e38064 100755
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -242,7 +242,7 @@ stack_frame *innermost_stack_frame(callstack *stack)
stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
{
stack_frame *inner = innermost_stack_frame(callstack);
- tagged<quotation>(frame_executing(inner)).untag_check();
+ tagged<quotation>(frame_executing(inner)).untag_check(this);
return inner;
}
@@ -278,8 +278,8 @@ inline void factorvm::vmprim_set_innermost_stack_frame_quot()
gc_root<callstack> callstack(dpop(),this);
gc_root<quotation> quot(dpop(),this);
- callstack.untag_check();
- quot.untag_check();
+ callstack.untag_check(this);
+ quot.untag_check(this);
jit_compile(quot.value(),true);
diff --git a/vm/image.cpp b/vm/image.cpp
index b8e89d5fcb..5ceefdfeb4 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -146,7 +146,7 @@ inline void factorvm::vmprim_save_image()
gc();
gc_root<byte_array> path(dpop(),this);
- path.untag_check();
+ path.untag_check(this);
save_image((vm_char *)(path.untagged() + 1));
}
@@ -161,7 +161,7 @@ inline void factorvm::vmprim_save_image_and_exit()
where we might throw an error, so we have to throw an error here since
later steps destroy the current image. */
gc_root<byte_array> path(dpop(),this);
- path.untag_check();
+ path.untag_check(this);
/* strip out userenv data which is set on startup anyway */
for(cell i = 0; i < USER_ENV; i++)
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index 8885c09404..b7aaacbc58 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -1,11 +1,9 @@
namespace factor
{
-// I've had to copy inline implementations here to make dependencies work. Hopefully this can be better factored
+// I've had to copy inline implementations here to make dependencies work. Am hoping to move this code back into include files
// once the rest of the reentrant changes are done. -PD
-//tagged.hpp
-
// write_barrier.hpp
inline card *factorvm::addr_to_card(cell a)
diff --git a/vm/io.cpp b/vm/io.cpp
index 93ae005b6a..cfbafda907 100755
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -45,8 +45,8 @@ inline void factorvm::vmprim_fopen()
{
gc_root<byte_array> mode(dpop(),this);
gc_root<byte_array> path(dpop(),this);
- mode.untag_check();
- path.untag_check();
+ mode.untag_check(this);
+ path.untag_check(this);
for(;;)
{
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 0237651e17..ef615dc095 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -396,7 +396,7 @@ VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
inline void factorvm::vmprim_quot_compiled_p()
{
tagged<quotation> quot(dpop());
- quot.untag_check();
+ quot.untag_check(this);
dpush(tag_boolean(quot->code != NULL));
}
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index 4a1babb599..9f8a0eb411 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -29,9 +29,9 @@ struct tagged
bool type_p(cell type_) const { return type() == type_; }
- TYPE *untag_check() const {
+ TYPE *untag_check(factorvm *myvm) const {
if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
- type_error(TYPE::type_number,value_);
+ myvm->type_error(TYPE::type_number,value_);
return untagged();
}
@@ -61,7 +61,7 @@ struct tagged
template <typename TYPE> TYPE *factorvm::untag_check(cell value)
{
- return tagged<TYPE>(value).untag_check();
+ return tagged<TYPE>(value).untag_check(this);
}
template <typename TYPE> TYPE *untag_check(cell value)
From 7a20e1648cb8dd405dfb2947a9d3b82850db4263 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:15 +0100
Subject: [PATCH 083/266] Dev checkpoint
---
vm/data_heap.cpp | 7 ++++++-
vm/vm.hpp | 4 +++-
2 files changed, 9 insertions(+), 2 deletions(-)
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index 020954bf05..e484a18b7a 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -237,7 +237,7 @@ void init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,
}
/* Size of the object pointed to by a tagged pointer */
-cell object_size(cell tagged)
+cell factorvm::object_size(cell tagged)
{
if(immediate_p(tagged))
return 0;
@@ -245,6 +245,11 @@ cell object_size(cell tagged)
return untagged_object_size(untag<object>(tagged));
}
+cell object_size(cell tagged)
+{
+ return vm->object_size(tagged);
+}
+
/* Size of the object pointed to by an untagged pointer */
cell factorvm::untagged_object_size(object *pointer)
{
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 1ed6d965bc..3aab1061ff 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -154,6 +154,9 @@ struct factorvm {
inline void vmprim_end_scan();
template<typename T> void each_object(T &functor);
cell find_all_words();
+ cell object_size(cell tagged);
+ // next method here:
+
//write barrier
inline card *addr_to_card(cell a);
@@ -412,7 +415,6 @@ struct factorvm {
inline double fixnum_to_float(cell tagged);
template <typename T> T *untag_check(cell value);
template <typename T> T *untag(cell value);
- // next method here:
//io
void init_c_io();
From b2f52ed109f4d08fe5cba55db737d2e988a8ed7f Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:16 +0100
Subject: [PATCH 084/266] removed non-primitive global functions from data_heap
---
vm/data_heap.cpp | 89 ------------------------------------------------
vm/data_heap.hpp | 36 +-------------------
2 files changed, 1 insertion(+), 124 deletions(-)
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index e484a18b7a..e790c63122 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -8,10 +8,6 @@ namespace factor
/* new objects are allocated here */
VM_C_API zone nursery;
-
-
-
-
cell factorvm::init_zone(zone *z, cell size, cell start)
{
z->size = size;
@@ -20,10 +16,6 @@ cell factorvm::init_zone(zone *z, cell size, cell start)
return z->end;
}
-cell init_zone(zone *z, cell size, cell start)
-{
- return vm->init_zone(z,size,start);
-}
void factorvm::init_card_decks()
{
@@ -33,11 +25,6 @@ void factorvm::init_card_decks()
decks_offset = (cell)data->decks - (start >> deck_bits);
}
-void init_card_decks()
-{
- return vm->init_card_decks();
-}
-
data_heap *factorvm::alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size)
{
young_size = align(young_size,deck_size);
@@ -102,10 +89,6 @@ data_heap *factorvm::alloc_data_heap(cell gens, cell young_size,cell aging_size,
return data;
}
-data_heap *alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size)
-{
- return vm->alloc_data_heap(gens,young_size,aging_size,tenured_size);
-}
data_heap *factorvm::grow_data_heap(data_heap *data, cell requested_bytes)
{
@@ -117,10 +100,6 @@ data_heap *factorvm::grow_data_heap(data_heap *data, cell requested_bytes)
new_tenured_size);
}
-data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
-{
- return vm->grow_data_heap(data,requested_bytes);
-}
void factorvm::dealloc_data_heap(data_heap *data)
{
@@ -133,10 +112,6 @@ void factorvm::dealloc_data_heap(data_heap *data)
free(data);
}
-void dealloc_data_heap(data_heap *data)
-{
- return vm->dealloc_data_heap(data);
-}
void factorvm::clear_cards(cell from, cell to)
{
@@ -146,10 +121,6 @@ void factorvm::clear_cards(cell from, cell to)
memset(first_card,0,last_card - first_card);
}
-void clear_cards(cell from, cell to)
-{
- return vm->clear_cards(from,to);
-}
void factorvm::clear_decks(cell from, cell to)
{
@@ -159,10 +130,6 @@ void factorvm::clear_decks(cell from, cell to)
memset(first_deck,0,last_deck - first_deck);
}
-void clear_decks(cell from, cell to)
-{
- return vm->clear_decks(from,to);
-}
void factorvm::clear_allot_markers(cell from, cell to)
{
@@ -172,10 +139,6 @@ void factorvm::clear_allot_markers(cell from, cell to)
memset(first_card,invalid_allot_marker,last_card - first_card);
}
-void clear_allot_markers(cell from, cell to)
-{
- return vm->clear_allot_markers(from,to);
-}
void factorvm::reset_generation(cell i)
{
@@ -186,10 +149,6 @@ void factorvm::reset_generation(cell i)
memset((void*)z->start,69,z->size);
}
-void reset_generation(cell i)
-{
- return vm->reset_generation(i);
-}
/* After garbage collection, any generations which are now empty need to have
their allocation pointers and cards reset. */
@@ -204,10 +163,6 @@ void factorvm::reset_generations(cell from, cell to)
clear_allot_markers(from,to);
}
-void reset_generations(cell from, cell to)
-{
- return vm->reset_generations(from,to);
-}
void factorvm::set_data_heap(data_heap *data_)
{
@@ -219,10 +174,6 @@ void factorvm::set_data_heap(data_heap *data_)
clear_allot_markers(data->nursery(),data->tenured());
}
-void set_data_heap(data_heap *data_)
-{
- return vm->set_data_heap(data_);
-}
void factorvm::init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_)
{
@@ -231,10 +182,6 @@ void factorvm::init_data_heap(cell gens,cell young_size,cell aging_size,cell ten
init_data_gc();
}
-void init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_)
-{
- return vm->init_data_heap(gens,young_size,aging_size,tenured_size,secure_gc_);
-}
/* Size of the object pointed to by a tagged pointer */
cell factorvm::object_size(cell tagged)
@@ -245,10 +192,6 @@ cell factorvm::object_size(cell tagged)
return untagged_object_size(untag<object>(tagged));
}
-cell object_size(cell tagged)
-{
- return vm->object_size(tagged);
-}
/* Size of the object pointed to by an untagged pointer */
cell factorvm::untagged_object_size(object *pointer)
@@ -256,10 +199,6 @@ cell factorvm::untagged_object_size(object *pointer)
return align8(unaligned_object_size(pointer));
}
-cell untagged_object_size(object *pointer)
-{
- return vm->untagged_object_size(pointer);
-}
/* Size of the data area of an object pointed to by an untagged pointer */
cell factorvm::unaligned_object_size(object *pointer)
@@ -296,10 +235,6 @@ cell factorvm::unaligned_object_size(object *pointer)
}
}
-cell unaligned_object_size(object *pointer)
-{
- return vm->unaligned_object_size(pointer);
-}
inline void factorvm::vmprim_size()
{
@@ -348,10 +283,6 @@ cell factorvm::binary_payload_start(object *pointer)
}
}
-cell binary_payload_start(object *pointer)
-{
- return vm->binary_payload_start(pointer);
-}
/* Push memory usage statistics in data heap */
inline void factorvm::vmprim_data_room()
@@ -385,20 +316,12 @@ void factorvm::begin_scan()
gc_off = true;
}
-void begin_scan()
-{
- return vm->begin_scan();
-}
void factorvm::end_scan()
{
gc_off = false;
}
-void end_scan()
-{
- return vm->end_scan();
-}
inline void factorvm::vmprim_begin_scan()
{
@@ -423,10 +346,6 @@ cell factorvm::next_object()
return tag_dynamic(obj);
}
-cell next_object()
-{
- return vm->next_object();
-}
/* Push object at heap scan cursor and advance; pushes f when done */
inline void factorvm::vmprim_next_object()
@@ -459,10 +378,6 @@ template<typename TYPE> void factorvm::each_object(TYPE &functor)
end_scan();
}
-template<typename TYPE> void each_object(TYPE &functor)
-{
- return vm->each_object(functor);
-}
namespace
{
@@ -491,9 +406,5 @@ cell factorvm::find_all_words()
return accum.words.elements.value();
}
-cell find_all_words()
-{
- return vm->find_all_words();
-}
}
diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp
index 67e3109924..88316ffd8d 100755
--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@@ -53,42 +53,11 @@ inline static bool in_zone(zone *z, object *pointer)
return (cell)pointer >= z->start && (cell)pointer < z->end;
}
-cell init_zone(zone *z, cell size, cell base);
-
-void init_card_decks();
-
-data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
-
-void dealloc_data_heap(data_heap *data);
-
-void clear_cards(cell from, cell to);
-void clear_decks(cell from, cell to);
-void clear_allot_markers(cell from, cell to);
-void reset_generation(cell i);
-void reset_generations(cell from, cell to);
-
-void set_data_heap(data_heap *data_heap_);
-
-void init_data_heap(cell gens,
- cell young_size,
- cell aging_size,
- cell tenured_size,
- bool secure_gc_);
-
/* set up guard pages to check for under/overflow.
size must be a multiple of the page size */
-segment *alloc_segment(cell size);
+segment *alloc_segment(cell size); // defined in OS-*.cpp files PD
void dealloc_segment(segment *block);
-cell untagged_object_size(object *pointer);
-cell unaligned_object_size(object *pointer);
-cell binary_payload_start(object *pointer);
-cell object_size(cell tagged);
-
-void begin_scan();
-void end_scan();
-cell next_object();
-
PRIMITIVE(data_room);
PRIMITIVE(size);
@@ -96,9 +65,6 @@ PRIMITIVE(begin_scan);
PRIMITIVE(next_object);
PRIMITIVE(end_scan);
-cell find_all_words();
-
-
}
/* new objects are allocated here */
From 39dc71e6121009f5009d8f4897d28d3c254fc228 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:16 +0100
Subject: [PATCH 085/266] removed global functions from data_gc
---
vm/data_gc.cpp | 104 ++-----------------------------------------------
vm/data_gc.hpp | 14 -------
vm/vm.hpp | 1 +
3 files changed, 5 insertions(+), 114 deletions(-)
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index 408a70ea5e..dfc1067690 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -10,10 +10,6 @@ void factorvm::init_data_gc()
collecting_aging_again = false;
}
-void init_data_gc()
-{
- return vm->init_data_gc();
-}
/* Given a pointer to oldspace, copy it to newspace */
object *factorvm::copy_untagged_object_impl(object *pointer, cell size)
@@ -30,10 +26,6 @@ object *factorvm::copy_untagged_object_impl(object *pointer, cell size)
return newpointer;
}
-object *copy_untagged_object_impl(object *pointer, cell size)
-{
- return vm->copy_untagged_object_impl(pointer,size);
-}
object *factorvm::copy_object_impl(object *untagged)
{
@@ -42,10 +34,6 @@ object *factorvm::copy_object_impl(object *untagged)
return newpointer;
}
-object *copy_object_impl(object *untagged)
-{
- return vm->copy_object_impl(untagged);
-}
bool factorvm::should_copy_p(object *untagged)
{
@@ -64,10 +52,6 @@ bool factorvm::should_copy_p(object *untagged)
}
}
-bool should_copy_p(object *untagged)
-{
- return vm->should_copy_p(untagged);
-}
/* Follow a chain of forwarding pointers */
object *factorvm::resolve_forwarding(object *untagged)
@@ -88,10 +72,6 @@ object *factorvm::resolve_forwarding(object *untagged)
}
}
-object *resolve_forwarding(object *untagged)
-{
- return vm->resolve_forwarding(untagged);
-}
template <typename TYPE> TYPE *factorvm::copy_untagged_object(TYPE *untagged)
{
@@ -108,20 +88,12 @@ template <typename TYPE> TYPE *factorvm::copy_untagged_object(TYPE *untagged)
return untagged;
}
-template <typename TYPE> TYPE *copy_untagged_object(TYPE *untagged)
-{
- return vm->copy_untagged_object(untagged);
-}
cell factorvm::copy_object(cell pointer)
{
return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer));
}
-cell copy_object(cell pointer)
-{
- return vm->copy_object(pointer);
-}
void factorvm::copy_handle(cell *handle)
{
@@ -136,10 +108,6 @@ void factorvm::copy_handle(cell *handle)
}
}
-void copy_handle(cell *handle)
-{
- return vm->copy_handle(handle);
-}
/* Scan all the objects in the card */
void factorvm::copy_card(card *ptr, cell gen, cell here)
@@ -155,10 +123,6 @@ void factorvm::copy_card(card *ptr, cell gen, cell here)
cards_scanned++;
}
-void copy_card(card *ptr, cell gen, cell here)
-{
- return vm->copy_card(ptr,gen,here);
-}
void factorvm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
{
@@ -191,10 +155,6 @@ void factorvm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
decks_scanned++;
}
-void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
-{
- return vm->copy_card_deck(deck,gen,mask,unmask);
-}
/* Copy all newspace objects referenced from marked cards to the destination */
void factorvm::copy_gen_cards(cell gen)
@@ -262,10 +222,6 @@ void factorvm::copy_gen_cards(cell gen)
}
}
-void copy_gen_cards(cell gen)
-{
- return vm->copy_gen_cards(gen);
-}
/* Scan cards in all generations older than the one being collected, copying
old->new references */
@@ -280,10 +236,6 @@ void factorvm::copy_cards()
card_scan_time += (current_micros() - start);
}
-void copy_cards()
-{
- return vm->copy_cards();
-}
/* Copy all tagged pointers in a range of memory */
void factorvm::copy_stack_elements(segment *region, cell top)
@@ -294,10 +246,6 @@ void factorvm::copy_stack_elements(segment *region, cell top)
copy_handle((cell*)ptr);
}
-void copy_stack_elements(segment *region, cell top)
-{
- return vm->copy_stack_elements(region,top);
-}
void factorvm::copy_registered_locals()
{
@@ -308,10 +256,6 @@ void factorvm::copy_registered_locals()
copy_handle((cell *)(*iter));
}
-void copy_registered_locals()
-{
- return vm->copy_registered_locals();
-}
void factorvm::copy_registered_bignums()
{
@@ -335,10 +279,6 @@ void factorvm::copy_registered_bignums()
}
}
-void copy_registered_bignums()
-{
- return vm->copy_registered_bignums();
-}
/* Copy roots over at the start of GC, namely various constants, stacks,
the user environment and extra roots registered by local_roots.hpp */
@@ -376,10 +316,6 @@ void factorvm::copy_roots()
copy_handle(&userenv[i]);
}
-void copy_roots()
-{
- return vm->copy_roots();
-}
cell factorvm::copy_next_from_nursery(cell scan)
{
@@ -409,10 +345,6 @@ cell factorvm::copy_next_from_nursery(cell scan)
return scan + untagged_object_size((object *)scan);
}
-cell copy_next_from_nursery(cell scan)
-{
- return vm->copy_next_from_nursery(scan);
-}
cell factorvm::copy_next_from_aging(cell scan)
{
@@ -446,10 +378,6 @@ cell factorvm::copy_next_from_aging(cell scan)
return scan + untagged_object_size((object *)scan);
}
-cell copy_next_from_aging(cell scan)
-{
- return vm->copy_next_from_aging(scan);
-}
cell factorvm::copy_next_from_tenured(cell scan)
{
@@ -481,10 +409,6 @@ cell factorvm::copy_next_from_tenured(cell scan)
return scan + untagged_object_size((object *)scan);
}
-cell copy_next_from_tenured(cell scan)
-{
- return vm->copy_next_from_tenured(scan);
-}
void factorvm::copy_reachable_objects(cell scan, cell *end)
{
@@ -505,10 +429,6 @@ void factorvm::copy_reachable_objects(cell scan, cell *end)
}
}
-void copy_reachable_objects(cell scan, cell *end)
-{
- return vm->copy_reachable_objects(scan,end);
-}
/* Prepare to start copying reachable objects into an unused zone */
void factorvm::begin_gc(cell requested_bytes)
@@ -544,10 +464,6 @@ void factorvm::begin_gc(cell requested_bytes)
}
}
-void begin_gc(cell requested_bytes)
-{
- return vm->begin_gc(requested_bytes);
-}
void factorvm::end_gc(cell gc_elapsed)
{
@@ -587,10 +503,6 @@ void factorvm::end_gc(cell gc_elapsed)
collecting_aging_again = false;
}
-void end_gc(cell gc_elapsed)
-{
- return vm->end_gc(gc_elapsed);
-}
/* Collect gen and all younger generations.
If growing_data_heap_ is true, we must grow the data heap to such a size that
@@ -673,20 +585,12 @@ void factorvm::garbage_collection(cell gen,bool growing_data_heap_,cell requeste
performing_gc = false;
}
-void garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes)
-{
- return vm->garbage_collection(gen,growing_data_heap_,requested_bytes);
-}
void factorvm::gc()
{
garbage_collection(data->tenured(),false,0);
}
-void gc()
-{
- return vm->gc();
-}
inline void factorvm::vmprim_gc()
{
@@ -744,14 +648,14 @@ void factorvm::clear_gc_stats()
code_heap_scans = 0;
}
-void clear_gc_stats()
+inline void factorvm::vmprim_clear_gc_stats()
{
- return vm->clear_gc_stats();
+ clear_gc_stats();
}
PRIMITIVE(clear_gc_stats)
{
- clear_gc_stats();
+ PRIMITIVE_GETVM()->vmprim_clear_gc_stats();
}
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
@@ -803,7 +707,7 @@ VM_ASM_API void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
{
- return vm->inline_gc(gc_roots_base,gc_roots_size);
+ return vm->inline_gc(gc_roots_base,gc_roots_size);
}
}
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 68b2b4a936..950990a91b 100755
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -10,30 +10,16 @@ struct gc_stats {
u64 bytes_copied;
};
-void init_data_gc();
-
-void gc();
-
-void copy_handle(cell *handle);
-
-void garbage_collection(volatile cell gen,
- bool growing_data_heap_,
- cell requested_bytes);
-
/* 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 */
static const cell allot_buffer_zone = 1024;
-void copy_reachable_objects(cell scan, cell *end);
-
PRIMITIVE(gc);
PRIMITIVE(gc_stats);
-void clear_gc_stats();
PRIMITIVE(clear_gc_stats);
PRIMITIVE(become);
-
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 3aab1061ff..1c4832e289 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -236,6 +236,7 @@ struct factorvm {
template <typename TYPE> TYPE *allot(cell size);
inline void check_data_pointer(object *pointer);
inline void check_tagged_pointer(cell tagged);
+ inline void vmprim_clear_gc_stats();
// local roots
/* If a runtime function needs to call another function which potentially
From 00087e681450aec4eccd6145ca9617c98100321e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:16 +0100
Subject: [PATCH 086/266] removed global functions from code_gc
---
vm/code_gc.cpp | 65 --------------------------------------------------
vm/code_gc.hpp | 12 ----------
2 files changed, 77 deletions(-)
diff --git a/vm/code_gc.cpp b/vm/code_gc.cpp
index 9ccc83aa0f..4a86359f1f 100755
--- a/vm/code_gc.cpp
+++ b/vm/code_gc.cpp
@@ -8,10 +8,6 @@ void factorvm::clear_free_list(heap *heap)
memset(&heap->free,0,sizeof(heap_free_list));
}
-void clear_free_list(heap *heap)
-{
- return vm->clear_free_list(heap);
-}
/* This malloc-style heap code is reasonably generic. Maybe in the future, it
will be used for the data heap too, if we ever get incremental
@@ -25,10 +21,6 @@ void factorvm::new_heap(heap *heap, cell size)
clear_free_list(heap);
}
-void new_heap(heap *heap, cell size)
-{
- return vm->new_heap(heap,size);
-}
void factorvm::add_to_free_list(heap *heap, free_heap_block *block)
{
@@ -45,10 +37,6 @@ void factorvm::add_to_free_list(heap *heap, free_heap_block *block)
}
}
-void add_to_free_list(heap *heap, free_heap_block *block)
-{
- return vm->add_to_free_list(heap,block);
-}
/* Called after reading the code heap from the image file, and after code GC.
@@ -106,10 +94,6 @@ void factorvm::build_free_list(heap *heap, cell size)
}
-void build_free_list(heap *heap, cell size)
-{
- return vm->build_free_list(heap,size);
-}
void factorvm::assert_free_block(free_heap_block *block)
{
@@ -117,10 +101,6 @@ void factorvm::assert_free_block(free_heap_block *block)
critical_error("Invalid block in free list",(cell)block);
}
-void assert_free_block(free_heap_block *block)
-{
- return vm->assert_free_block(block);
-}
free_heap_block *factorvm::find_free_block(heap *heap, cell size)
{
@@ -162,10 +142,6 @@ free_heap_block *factorvm::find_free_block(heap *heap, cell size)
return NULL;
}
-free_heap_block *find_free_block(heap *heap, cell size)
-{
- return vm->find_free_block(heap,size);
-}
free_heap_block *factorvm::split_free_block(heap *heap, free_heap_block *block, cell size)
{
@@ -183,10 +159,6 @@ free_heap_block *factorvm::split_free_block(heap *heap, free_heap_block *block,
return block;
}
-free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size)
-{
- return vm->split_free_block(heap,block,size);
-}
/* Allocate a block of memory from the mark and sweep GC heap */
heap_block *factorvm::heap_allot(heap *heap, cell size)
@@ -205,10 +177,6 @@ heap_block *factorvm::heap_allot(heap *heap, cell size)
return NULL;
}
-heap_block *heap_allot(heap *heap, cell size)
-{
- return vm->heap_allot(heap,size);
-}
/* Deallocates a block manually */
void factorvm::heap_free(heap *heap, heap_block *block)
@@ -217,10 +185,6 @@ void factorvm::heap_free(heap *heap, heap_block *block)
add_to_free_list(heap,(free_heap_block *)block);
}
-void heap_free(heap *heap, heap_block *block)
-{
- return vm->heap_free(heap,block);
-}
void factorvm::mark_block(heap_block *block)
{
@@ -238,10 +202,6 @@ void factorvm::mark_block(heap_block *block)
}
}
-void mark_block(heap_block *block)
-{
- return vm->mark_block(block);
-}
/* If in the middle of code GC, we have to grow the heap, data GC restarts from
scratch, so we have to unmark any marked blocks. */
@@ -258,10 +218,6 @@ void factorvm::unmark_marked(heap *heap)
}
}
-void unmark_marked(heap *heap)
-{
- return vm->unmark_marked(heap);
-}
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
which are allocated and not marked can be reclaimed. */
@@ -312,10 +268,6 @@ void factorvm::free_unmarked(heap *heap, heap_iterator iter)
add_to_free_list(heap,(free_heap_block *)prev);
}
-void free_unmarked(heap *heap, heap_iterator iter)
-{
- return vm->free_unmarked(heap,iter);
-}
/* Compute total sum of sizes of free blocks, and size of largest free block */
void factorvm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
@@ -346,10 +298,6 @@ void factorvm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_fr
}
}
-void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
-{
- return vm->heap_usage(heap,used,total_free,max_free);
-}
/* The size of the heap, not including the last block if it's free */
cell factorvm::heap_size(heap *heap)
@@ -367,10 +315,6 @@ cell factorvm::heap_size(heap *heap)
return heap->seg->size;
}
-cell heap_size(heap *heap)
-{
- return vm->heap_size(heap);
-}
/* Compute where each block is going to go, after compaction */
cell factorvm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
@@ -394,10 +338,6 @@ cell factorvm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,ch
return (cell)address - heap->seg->start;
}
-cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
-{
- return vm->compute_heap_forwarding(heap,forwarding);
-}
void factorvm::compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
{
@@ -413,9 +353,4 @@ void factorvm::compact_heap(heap *heap, unordered_map<heap_block *,char *> &forw
}
}
-void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
-{
- return vm->compact_heap(heap,forwarding);
-}
-
}
diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp
index 08bdd327c7..c59980dc30 100755
--- a/vm/code_gc.hpp
+++ b/vm/code_gc.hpp
@@ -16,18 +16,6 @@ struct heap {
typedef void (*heap_iterator)(heap_block *compiled,factorvm *vm);
-void new_heap(heap *h, cell size);
-void build_free_list(heap *h, cell size);
-heap_block *heap_allot(heap *h, cell size);
-void heap_free(heap *h, heap_block *block);
-void mark_block(heap_block *block);
-void unmark_marked(heap *heap);
-void free_unmarked(heap *heap, heap_iterator iter);
-void heap_usage(heap *h, cell *used, cell *total_free, cell *max_free);
-cell heap_size(heap *h);
-cell compute_heap_forwarding(heap *h, unordered_map<heap_block *,char *> &forwarding);
-void compact_heap(heap *h, unordered_map<heap_block *,char *> &forwarding);
-
inline static heap_block *next_block(heap *h, heap_block *block)
{
cell next = ((cell)block + block->size);
From afe1cf0c735edbb7052ea8ff1982790e22fc982b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:16 +0100
Subject: [PATCH 087/266] removed some global functions from code_heap
---
vm/code_heap.cpp | 37 -------------------------------------
vm/code_heap.hpp | 21 +--------------------
vm/inlineimpls.hpp | 9 +++++++++
vm/vm.hpp | 3 ++-
4 files changed, 12 insertions(+), 58 deletions(-)
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index fb24af4044..39f0dfd52a 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -9,10 +9,6 @@ void factorvm::init_code_heap(cell size)
new_heap(&code,size);
}
-void init_code_heap(cell size)
-{
- return vm->init_code_heap(size);
-}
bool factorvm::in_code_heap_p(cell ptr)
{
@@ -38,10 +34,6 @@ void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
}
-void jit_compile_word(cell word_, cell def_, bool relocate)
-{
- return vm->jit_compile_word(word_,def_,relocate);
-}
/* Apply a function to every code block */
void factorvm::iterate_code_heap(code_heap_iterator iter)
@@ -56,10 +48,6 @@ void factorvm::iterate_code_heap(code_heap_iterator iter)
}
}
-void iterate_code_heap(code_heap_iterator iter)
-{
- return vm->iterate_code_heap(iter);
-}
/* Copy literals referenced from all code blocks to newspace. Only for
aging and nursery collections */
@@ -68,10 +56,6 @@ void factorvm::copy_code_heap_roots()
iterate_code_heap(factor::copy_literal_references);
}
-void copy_code_heap_roots()
-{
- return vm->copy_code_heap_roots();
-}
/* Update pointers to words referenced from all code blocks. Only after
defining a new word. */
@@ -80,10 +64,6 @@ void factorvm::update_code_heap_words()
iterate_code_heap(factor::update_word_references);
}
-void update_code_heap_words()
-{
- return vm->update_code_heap_words();
-}
inline void factorvm::vmprim_modify_code_heap()
{
@@ -163,10 +143,6 @@ code_block *factorvm::forward_xt(code_block *compiled)
return (code_block *)forwarding[compiled];
}
-code_block *forward_xt(code_block *compiled)
-{
- return vm->forward_xt(compiled);
-}
void factorvm::forward_frame_xt(stack_frame *frame)
{
@@ -223,10 +199,6 @@ void factorvm::forward_object_xts()
end_scan();
}
-void forward_object_xts()
-{
- return vm->forward_object_xts();
-}
/* Set the XT fields now that the heap has been compacted */
void factorvm::fixup_object_xts()
@@ -257,10 +229,6 @@ void factorvm::fixup_object_xts()
end_scan();
}
-void fixup_object_xts()
-{
- return vm->fixup_object_xts();
-}
/* Move all free space to the end of the code heap. This is not very efficient,
since it makes several passes over the code and data heaps, but we only ever
@@ -288,9 +256,4 @@ void factorvm::compact_code_heap()
build_free_list(&code,size);
}
-void compact_code_heap()
-{
- return vm->compact_code_heap();
-}
-
}
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 26e1faeb19..32e1dacfee 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -1,31 +1,12 @@
namespace factor
{
-
-void init_code_heap(cell size);
-
-bool in_code_heap_p(cell ptr);
-
-void jit_compile_word(cell word, cell def, bool relocate);
+bool in_code_heap_p(cell ptr); // Used by platform specific code
struct factorvm;
typedef void (*code_heap_iterator)(code_block *compiled,factorvm *myvm);
-void iterate_code_heap(code_heap_iterator iter);
-
-void copy_code_heap_roots();
-
PRIMITIVE(modify_code_heap);
-
PRIMITIVE(code_room);
-void compact_code_heap();
-
-inline static void check_code_pointer(cell ptr)
-{
-#ifdef FACTOR_DEBUG
- assert(in_code_heap_p(ptr));
-#endif
-}
-
}
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index b7aaacbc58..241c958b2c 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -541,4 +541,13 @@ inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
return vm->do_slots(obj,iter);
}
+// code_heap.hpp
+
+inline void factorvm::check_code_pointer(cell ptr)
+{
+#ifdef FACTOR_DEBUG
+ assert(in_code_heap_p(ptr));
+#endif
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 1c4832e289..a4c58a2a0b 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -155,7 +155,6 @@ struct factorvm {
template<typename T> void each_object(T &functor);
cell find_all_words();
cell object_size(cell tagged);
- // next method here:
//write barrier
@@ -499,6 +498,8 @@ struct factorvm {
void forward_object_xts();
void fixup_object_xts();
void compact_code_heap();
+ inline void check_code_pointer(cell ptr);
+ // next method here:
//image
cell code_relocation_base;
From 100c26c38fdc7cd5879219bbc2cdb11d5ed35d0a Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:16 +0100
Subject: [PATCH 088/266] removed global functions from profiler
---
vm/profiler.cpp | 12 ------------
vm/profiler.hpp | 2 --
2 files changed, 14 deletions(-)
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index 8f714a992c..1b7c7c1ac5 100755
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -9,10 +9,6 @@ void factorvm::init_profiler()
profiling_p = false;
}
-void init_profiler()
-{
- return vm->init_profiler();
-}
/* Allocates memory */
code_block *factorvm::compile_profiling_stub(cell word_)
@@ -25,10 +21,6 @@ code_block *factorvm::compile_profiling_stub(cell word_)
return jit.to_code_block();
}
-code_block *compile_profiling_stub(cell word_)
-{
- return vm->compile_profiling_stub(word_);
-}
/* Allocates memory */
void factorvm::set_profiling(bool profiling)
@@ -58,10 +50,6 @@ void factorvm::set_profiling(bool profiling)
iterate_code_heap(factor::relocate_code_block);
}
-void set_profiling(bool profiling)
-{
- return vm->set_profiling(profiling);
-}
inline void factorvm::vmprim_profiling()
{
diff --git a/vm/profiler.hpp b/vm/profiler.hpp
index ab1d27b9d8..28bfbcc09f 100755
--- a/vm/profiler.hpp
+++ b/vm/profiler.hpp
@@ -1,8 +1,6 @@
namespace factor
{
-void init_profiler();
-code_block *compile_profiling_stub(cell word);
PRIMITIVE(profiling);
}
From 32eace1a11170264f67c59a8d38cb1f021c75817 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:17 +0100
Subject: [PATCH 089/266] removed global functions from bignum.cpp
---
vm/bignum.cpp | 207 +-------------------------------------------------
vm/bignum.hpp | 75 ------------------
vm/vm.hpp | 4 +
3 files changed, 5 insertions(+), 281 deletions(-)
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index f61b44340e..4c01b12820 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -73,10 +73,6 @@ int factorvm::bignum_equal_p(bignum * x, bignum * y)
&& (bignum_equal_p_unsigned (x, y))));
}
-int bignum_equal_p(bignum * x, bignum * y)
-{
- return vm->bignum_equal_p(x,y);
-}
enum bignum_comparison factorvm::bignum_compare(bignum * x, bignum * y)
{
@@ -100,10 +96,6 @@ enum bignum_comparison factorvm::bignum_compare(bignum * x, bignum * y)
: (bignum_compare_unsigned (x, y))));
}
-enum bignum_comparison bignum_compare(bignum * x, bignum * y)
-{
- return vm->bignum_compare(x,y);
-}
/* allocates memory */
bignum *factorvm::bignum_add(bignum * x, bignum * y)
@@ -122,11 +114,6 @@ bignum *factorvm::bignum_add(bignum * x, bignum * y)
: (bignum_add_unsigned (x, y, 0)))));
}
-bignum *bignum_add(bignum * x, bignum * y)
-{
- return vm->bignum_add(x,y);
-}
-
/* allocates memory */
bignum *factorvm::bignum_subtract(bignum * x, bignum * y)
{
@@ -146,10 +133,6 @@ bignum *factorvm::bignum_subtract(bignum * x, bignum * y)
: (bignum_subtract_unsigned (x, y))))));
}
-bignum *bignum_subtract(bignum * x, bignum * y)
-{
- return vm->bignum_subtract(x,y);
-}
/* allocates memory */
bignum *factorvm::bignum_multiply(bignum * x, bignum * y)
@@ -183,10 +166,6 @@ bignum *factorvm::bignum_multiply(bignum * x, bignum * y)
return (bignum_multiply_unsigned (x, y, negative_p));
}
-bignum *bignum_multiply(bignum * x, bignum * y)
-{
- return vm->bignum_multiply(x,y);
-}
/* allocates memory */
void factorvm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
@@ -259,10 +238,6 @@ void factorvm::bignum_divide(bignum * numerator, bignum * denominator, bignum *
}
}
-void bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
-{
- return vm->bignum_divide(numerator,denominator,quotient,remainder);
-}
/* allocates memory */
bignum *factorvm::bignum_quotient(bignum * numerator, bignum * denominator)
@@ -316,10 +291,6 @@ bignum *factorvm::bignum_quotient(bignum * numerator, bignum * denominator)
}
}
-bignum *bignum_quotient(bignum * numerator, bignum * denominator)
-{
- return vm->bignum_quotient(numerator,denominator);
-}
/* allocates memory */
bignum *factorvm::bignum_remainder(bignum * numerator, bignum * denominator)
@@ -365,10 +336,6 @@ bignum *factorvm::bignum_remainder(bignum * numerator, bignum * denominator)
}
}
-bignum *bignum_remainder(bignum * numerator, bignum * denominator)
-{
- return vm->bignum_remainder(numerator, denominator);
-}
#define FOO_TO_BIGNUM(name,type,utype) \
bignum * factorvm::name##_to_bignum(type n) \
@@ -407,7 +374,7 @@ FOO_TO_BIGNUM(long_long,s64,u64)
FOO_TO_BIGNUM(ulong_long,u64,u64)
#define BIGNUM_TO_FOO(name,type,utype) \
- type bignum_to_##name(bignum * bignum) \
+type factorvm::bignum_to_##name(bignum * bignum) \
{ \
if (BIGNUM_ZERO_P (bignum)) \
return (0); \
@@ -441,10 +408,6 @@ double factorvm::bignum_to_double(bignum * bignum)
}
}
-double bignum_to_double(bignum * bignum)
-{
- return vm->bignum_to_double(bignum);
-}
#define DTB_WRITE_DIGIT(factor) \
{ \
@@ -488,10 +451,6 @@ bignum *factorvm::double_to_bignum(double x)
}
}
-bignum *double_to_bignum(double x)
-{
- return vm->double_to_bignum(x);
-}
#undef DTB_WRITE_DIGIT
@@ -514,10 +473,6 @@ int factorvm::bignum_equal_p_unsigned(bignum * x, bignum * y)
}
}
-int bignum_equal_p_unsigned(bignum * x, bignum * y)
-{
- return vm->bignum_equal_p_unsigned(x,y);
-}
enum bignum_comparison factorvm::bignum_compare_unsigned(bignum * x, bignum * y)
{
@@ -544,10 +499,6 @@ enum bignum_comparison factorvm::bignum_compare_unsigned(bignum * x, bignum * y)
return (bignum_comparison_equal);
}
-enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y)
-{
- return vm->bignum_compare_unsigned(x,y);
-}
/* Addition */
@@ -616,10 +567,6 @@ bignum *factorvm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
}
}
-bignum *bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
-{
- return vm->bignum_add_unsigned(x,y,negative_p);
-}
/* Subtraction */
@@ -695,10 +642,6 @@ bignum *factorvm::bignum_subtract_unsigned(bignum * x, bignum * y)
}
}
-bignum *bignum_subtract_unsigned(bignum * x, bignum * y)
-{
- return vm->bignum_subtract_unsigned(x,y);
-}
/* Multiplication
Maximum value for product_low or product_high:
@@ -777,10 +720,6 @@ bignum *factorvm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_
}
}
-bignum *bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
-{
- return vm->bignum_multiply_unsigned(x,y,negative_p);
-}
/* allocates memory */
bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
@@ -797,10 +736,6 @@ bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit
return (bignum_trim (p));
}
-bignum *bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
-{
- return vm->bignum_multiply_unsigned_small_factor(x,y,negative_p);
-}
void factorvm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
{
@@ -825,10 +760,6 @@ void factorvm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
}
}
-void bignum_destructive_add(bignum * bignum, bignum_digit_type n)
-{
- return vm->bignum_destructive_add(bignum,n);
-}
void factorvm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
{
@@ -859,10 +790,6 @@ void factorvm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type fa
#undef product_high
}
-void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
-{
- return vm->bignum_destructive_scale_up(bignum,factor);
-}
/* Division */
@@ -929,10 +856,6 @@ void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bign
return;
}
-void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
-{
- return vm->bignum_divide_unsigned_large_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
-}
void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
{
@@ -1008,10 +931,6 @@ void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum
#undef qj
}
-void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
-{
- return vm->bignum_divide_unsigned_normalized(u,v,q);
-}
bignum_digit_type factorvm::bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
{
@@ -1088,10 +1007,6 @@ bignum_digit_type factorvm::bignum_divide_subtract(bignum_digit_type * v_start,
return (guess - 1);
}
-bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
-{
- return vm->bignum_divide_subtract(v_start,v_end,guess,u_start);
-}
/* allocates memory */
void factorvm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
@@ -1152,10 +1067,6 @@ void factorvm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bign
return;
}
-void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
-{
- vm->bignum_divide_unsigned_medium_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
-}
void factorvm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
{
@@ -1180,10 +1091,6 @@ void factorvm::bignum_destructive_normalization(bignum * source, bignum * target
return;
}
-void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
-{
- return vm->bignum_destructive_normalization(source,target,shift_left);
-}
void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
{
@@ -1203,10 +1110,6 @@ void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_rig
return;
}
-void bignum_destructive_unnormalization(bignum * bignum, int shift_right)
-{
- return vm->bignum_destructive_unnormalization(bignum,shift_right);
-}
/* This is a reduced version of the division algorithm, applied to the
case of dividing two bignum digits by one bignum digit. It is
@@ -1272,10 +1175,6 @@ bignum_digit_type factorvm::bignum_digit_divide(bignum_digit_type uh, bignum_dig
return (HD_CONS ((u[2]), (u[3])));
}
-bignum_digit_type bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
-{
- return vm->bignum_digit_divide(uh,ul,v,q);
-}
#undef BDD_STEP
@@ -1340,10 +1239,6 @@ bignum_digit_type factorvm::bignum_digit_divide_subtract(bignum_digit_type v1, b
return (guess - 1);
}
-bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
-{
- return vm->bignum_digit_divide_subtract(v1,v2,guess,u);
-}
#undef BDDS_MULSUB
#undef BDDS_ADD
@@ -1368,10 +1263,6 @@ void factorvm::bignum_divide_unsigned_small_denominator(bignum * numerator, bign
return;
}
-void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
-{
- return vm->bignum_divide_unsigned_small_denominator(numerator,denominator,quotient,remainder,q_negative_p,r_negative_p);
-}
/* Given (denominator > 1), it is fairly easy to show that
(quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
@@ -1399,10 +1290,6 @@ bignum_digit_type factorvm::bignum_destructive_scale_down(bignum * bignum, bignu
#undef quotient_high
}
-bignum_digit_type bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
-{
- return vm->bignum_destructive_scale_down(bignum,denominator);
-}
/* allocates memory */
bignum * factorvm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
@@ -1423,10 +1310,6 @@ bignum * factorvm::bignum_remainder_unsigned_small_denominator(bignum * n, bignu
return (bignum_digit_to_bignum (r, negative_p));
}
-bignum * bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
-{
- return vm->bignum_remainder_unsigned_small_denominator(n,d,negative_p);
-}
/* allocates memory */
bignum *factorvm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
@@ -1441,10 +1324,6 @@ bignum *factorvm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p
}
}
-bignum *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
-{
- return vm->bignum_digit_to_bignum(digit, negative_p);
-}
/* allocates memory */
bignum *factorvm::allot_bignum(bignum_length_type length, int negative_p)
@@ -1455,10 +1334,6 @@ bignum *factorvm::allot_bignum(bignum_length_type length, int negative_p)
return (result);
}
-bignum *allot_bignum(bignum_length_type length, int negative_p)
-{
- return vm->allot_bignum(length,negative_p);
-}
/* allocates memory */
bignum * factorvm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
@@ -1471,10 +1346,6 @@ bignum * factorvm::allot_bignum_zeroed(bignum_length_type length, int negative_p
return (result);
}
-bignum * allot_bignum_zeroed(bignum_length_type length, int negative_p)
-{
- return vm->allot_bignum_zeroed(length,negative_p);
-}
#define BIGNUM_REDUCE_LENGTH(source, length) \
source = reallot_array(source,length + 1)
@@ -1492,10 +1363,6 @@ bignum *factorvm::bignum_shorten_length(bignum * bignum, bignum_length_type leng
return (bignum);
}
-bignum *bignum_shorten_length(bignum * bignum, bignum_length_type length)
-{
- return vm->bignum_shorten_length(bignum,length);
-}
/* allocates memory */
bignum *factorvm::bignum_trim(bignum * bignum)
@@ -1515,10 +1382,6 @@ bignum *factorvm::bignum_trim(bignum * bignum)
return (bignum);
}
-bignum *bignum_trim(bignum * bignum)
-{
- return vm->bignum_trim(bignum);
-}
/* Copying */
@@ -1532,10 +1395,6 @@ bignum *factorvm::bignum_new_sign(bignum * x, int negative_p)
return (result);
}
-bignum *bignum_new_sign(bignum * x, int negative_p)
-{
- return vm->bignum_new_sign(x,negative_p);
-}
/* allocates memory */
bignum *factorvm::bignum_maybe_new_sign(bignum * x, int negative_p)
@@ -1551,10 +1410,6 @@ bignum *factorvm::bignum_maybe_new_sign(bignum * x, int negative_p)
}
}
-bignum *bignum_maybe_new_sign(bignum * x, int negative_p)
-{
- return vm->bignum_maybe_new_sign(x,negative_p);
-}
void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
{
@@ -1567,10 +1422,6 @@ void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
return;
}
-void bignum_destructive_copy(bignum * source, bignum * target)
-{
- return vm->bignum_destructive_copy(source,target);
-}
/*
* Added bitwise operations (and oddp).
@@ -1582,10 +1433,6 @@ bignum *factorvm::bignum_bitwise_not(bignum * x)
return bignum_subtract(BIGNUM_ONE(1), x);
}
-bignum *bignum_bitwise_not(bignum * x)
-{
- return vm->bignum_bitwise_not(x);
-}
/* allocates memory */
bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
@@ -1596,10 +1443,6 @@ bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
return bignum_magnitude_ash(arg1, n);
}
-bignum *bignum_arithmetic_shift(bignum * arg1, fixnum n)
-{
- return vm->bignum_arithmetic_shift(arg1,n);
-}
#define AND_OP 0
#define IOR_OP 1
@@ -1619,10 +1462,6 @@ bignum *factorvm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
);
}
-bignum *bignum_bitwise_and(bignum * arg1, bignum * arg2)
-{
- return vm->bignum_bitwise_and(arg1,arg2);
-}
/* allocates memory */
bignum *factorvm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
@@ -1638,10 +1477,6 @@ bignum *factorvm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
);
}
-bignum *bignum_bitwise_ior(bignum * arg1, bignum * arg2)
-{
- return vm->bignum_bitwise_ior(arg1,arg2);
-}
/* allocates memory */
bignum *factorvm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
@@ -1657,10 +1492,6 @@ bignum *factorvm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
);
}
-bignum *bignum_bitwise_xor(bignum * arg1, bignum * arg2)
-{
- return vm->bignum_bitwise_xor(arg1,arg2);
-}
/* allocates memory */
/* ash for the magnitude */
@@ -1725,10 +1556,6 @@ bignum *factorvm::bignum_magnitude_ash(bignum * arg1, fixnum n)
return (bignum_trim (result));
}
-bignum *bignum_magnitude_ash(bignum * arg1, fixnum n)
-{
- return vm->bignum_magnitude_ash(arg1,n);
-}
/* allocates memory */
bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
@@ -1764,10 +1591,6 @@ bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
return bignum_trim(result);
}
-bignum *bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
-{
- return vm->bignum_pospos_bitwise_op(op,arg1,arg2);
-}
/* allocates memory */
bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
@@ -1821,10 +1644,6 @@ bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
return bignum_trim(result);
}
-bignum *bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
-{
- return vm->bignum_posneg_bitwise_op(op,arg1,arg2);
-}
/* allocates memory */
bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
@@ -1886,10 +1705,6 @@ bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
return bignum_trim(result);
}
-bignum *bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
-{
- return vm->bignum_negneg_bitwise_op(op,arg1,arg2);
-}
void factorvm::bignum_negate_magnitude(bignum * arg)
{
@@ -1918,10 +1733,6 @@ void factorvm::bignum_negate_magnitude(bignum * arg)
}
}
-void bignum_negate_magnitude(bignum * arg)
-{
- return vm->bignum_negate_magnitude(arg);
-}
/* Allocates memory */
bignum *factorvm::bignum_integer_length(bignum * x)
@@ -1944,10 +1755,6 @@ bignum *factorvm::bignum_integer_length(bignum * x)
return (bignum_trim (result));
}
-bignum *bignum_integer_length(bignum * x)
-{
- return vm->bignum_integer_length(x);
-}
/* Allocates memory */
int factorvm::bignum_logbitp(int shift, bignum * arg)
@@ -1957,10 +1764,6 @@ int factorvm::bignum_logbitp(int shift, bignum * arg)
: bignum_unsigned_logbitp (shift,arg));
}
-int bignum_logbitp(int shift, bignum * arg)
-{
- return vm->bignum_logbitp(shift,arg);
-}
int factorvm::bignum_unsigned_logbitp(int shift, bignum * bignum)
{
@@ -1974,10 +1777,6 @@ int factorvm::bignum_unsigned_logbitp(int shift, bignum * bignum)
return (digit & mask) ? 1 : 0;
}
-int bignum_unsigned_logbitp(int shift, bignum * bignum)
-{
- return vm->bignum_unsigned_logbitp(shift,bignum);
-}
/* Allocates memory */
bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
@@ -2016,9 +1815,5 @@ bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*p
}
}
-bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
-{
- return vm->digit_stream_to_bignum(n_digits,producer,radix,negative_p);
-}
}
diff --git a/vm/bignum.hpp b/vm/bignum.hpp
index 8f21702f1a..efa050667b 100644
--- a/vm/bignum.hpp
+++ b/vm/bignum.hpp
@@ -44,81 +44,6 @@ enum bignum_comparison
bignum_comparison_greater = 1
};
-int bignum_equal_p(bignum *, bignum *);
-enum bignum_comparison bignum_compare(bignum *, bignum *);
-bignum * bignum_add(bignum *, bignum *);
-bignum * bignum_subtract(bignum *, bignum *);
-bignum * bignum_negate(bignum *);
-bignum * bignum_multiply(bignum *, bignum *);
-void
-bignum_divide(bignum * numerator, bignum * denominator,
- bignum * * quotient, bignum * * remainder);
-bignum * bignum_quotient(bignum *, bignum *);
-bignum * bignum_remainder(bignum *, bignum *);
-fixnum bignum_to_fixnum(bignum *);
-cell bignum_to_cell(bignum *);
-s64 bignum_to_long_long(bignum *);
-u64 bignum_to_ulong_long(bignum *);
-bignum * double_to_bignum(double);
-double bignum_to_double(bignum *);
-
-/* Added bitwise operators. */
-
-bignum * bignum_bitwise_not(bignum *);
-bignum * bignum_arithmetic_shift(bignum *, fixnum);
-bignum * bignum_bitwise_and(bignum *, bignum *);
-bignum * bignum_bitwise_ior(bignum *, bignum *);
-bignum * bignum_bitwise_xor(bignum *, bignum *);
-
-/* Forward references */
-int bignum_equal_p_unsigned(bignum *, bignum *);
-enum bignum_comparison bignum_compare_unsigned(bignum *, bignum *);
-bignum * bignum_add_unsigned(bignum *, bignum *, int);
-bignum * bignum_subtract_unsigned(bignum *, bignum *);
-bignum * bignum_multiply_unsigned(bignum *, bignum *, int);
-bignum * bignum_multiply_unsigned_small_factor
- (bignum *, bignum_digit_type, int);
-void bignum_destructive_scale_up(bignum *, bignum_digit_type);
-void bignum_destructive_add(bignum *, bignum_digit_type);
-void bignum_divide_unsigned_large_denominator
- (bignum *, bignum *, bignum * *, bignum * *, int, int);
-void bignum_destructive_normalization(bignum *, bignum *, int);
-void bignum_destructive_unnormalization(bignum *, int);
-void bignum_divide_unsigned_normalized(bignum *, bignum *, bignum *);
-bignum_digit_type bignum_divide_subtract
- (bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
- bignum_digit_type *);
-void bignum_divide_unsigned_medium_denominator
- (bignum *, bignum_digit_type, bignum * *, bignum * *, int, int);
-bignum_digit_type bignum_digit_divide
- (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
-bignum_digit_type bignum_digit_divide_subtract
- (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
-void bignum_divide_unsigned_small_denominator
- (bignum *, bignum_digit_type, bignum * *, bignum * *, int, int);
-bignum_digit_type bignum_destructive_scale_down
- (bignum *, bignum_digit_type);
-bignum * bignum_remainder_unsigned_small_denominator
- (bignum *, bignum_digit_type, int);
-bignum * bignum_digit_to_bignum(bignum_digit_type, int);
-bignum * allot_bignum(bignum_length_type, int);
-bignum * allot_bignum_zeroed(bignum_length_type, int);
-bignum * bignum_shorten_length(bignum *, bignum_length_type);
-bignum * bignum_trim(bignum *);
-bignum * bignum_new_sign(bignum *, int);
-bignum * bignum_maybe_new_sign(bignum *, int);
-void bignum_destructive_copy(bignum *, bignum *);
-
-/* Added for bitwise operations. */
-bignum * bignum_magnitude_ash(bignum * arg1, fixnum n);
-bignum * bignum_pospos_bitwise_op(int op, bignum *, bignum *);
-bignum * bignum_posneg_bitwise_op(int op, bignum *, bignum *);
-bignum * bignum_negneg_bitwise_op(int op, bignum *, bignum *);
-void bignum_negate_magnitude(bignum *);
-
-bignum * bignum_integer_length(bignum * arg1);
-int bignum_unsigned_logbitp(int shift, bignum * bignum);
-int bignum_logbitp(int shift, bignum * arg);
struct factorvm;
bignum * digit_stream_to_bignum(unsigned int n_digits,
unsigned int (*producer)(unsigned int,factorvm*),
diff --git a/vm/vm.hpp b/vm/vm.hpp
index a4c58a2a0b..f259096766 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -72,6 +72,10 @@ struct factorvm {
void bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder);
bignum *bignum_quotient(bignum * numerator, bignum * denominator);
bignum *bignum_remainder(bignum * numerator, bignum * denominator);
+ cell bignum_to_cell(bignum * bignum);
+ fixnum bignum_to_fixnum(bignum * bignum);
+ s64 bignum_to_long_long(bignum * bignum);
+ u64 bignum_to_ulong_long(bignum * bignum);
double bignum_to_double(bignum * bignum);
bignum *double_to_bignum(double x);
int bignum_equal_p_unsigned(bignum * x, bignum * y);
From 959da30f05f306e3b1129aead6220329b713aa89 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:17 +0100
Subject: [PATCH 090/266] removed global functions from code_block.cpp
---
vm/code_block.cpp | 92 -----------------------------------------------
vm/code_block.hpp | 22 +-----------
vm/jit.cpp | 2 +-
3 files changed, 2 insertions(+), 114 deletions(-)
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index b8d4621d38..f19759fb0e 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -8,40 +8,24 @@ relocation_type factorvm::relocation_type_of(relocation_entry r)
return (relocation_type)((r & 0xf0000000) >> 28);
}
-relocation_type relocation_type_of(relocation_entry r)
-{
- return vm->relocation_type_of(r);
-}
relocation_class factorvm::relocation_class_of(relocation_entry r)
{
return (relocation_class)((r & 0x0f000000) >> 24);
}
-relocation_class relocation_class_of(relocation_entry r)
-{
- return vm->relocation_class_of(r);
-}
cell factorvm::relocation_offset_of(relocation_entry r)
{
return (r & 0x00ffffff);
}
-cell relocation_offset_of(relocation_entry r)
-{
- return vm->relocation_offset_of(r);
-}
void factorvm::flush_icache_for(code_block *block)
{
flush_icache((cell)block,block->size);
}
-void flush_icache_for(code_block *block)
-{
- return vm->flush_icache_for(block);
-}
int factorvm::number_of_parameters(relocation_type type)
{
@@ -67,10 +51,6 @@ int factorvm::number_of_parameters(relocation_type type)
}
}
-int number_of_parameters(relocation_type type)
-{
- return vm->number_of_parameters(type);
-}
void *factorvm::object_xt(cell obj)
{
@@ -86,10 +66,6 @@ void *factorvm::object_xt(cell obj)
}
}
-void *object_xt(cell obj)
-{
- return vm->object_xt(obj);
-}
void *factorvm::xt_pic(word *w, cell tagged_quot)
{
@@ -105,30 +81,18 @@ void *factorvm::xt_pic(word *w, cell tagged_quot)
}
}
-void *xt_pic(word *w, cell tagged_quot)
-{
- return vm->xt_pic(w,tagged_quot);
-}
void *factorvm::word_xt_pic(word *w)
{
return xt_pic(w,w->pic_def);
}
-void *word_xt_pic(word *w)
-{
- return vm->word_xt_pic(w);
-}
void *factorvm::word_xt_pic_tail(word *w)
{
return xt_pic(w,w->pic_tail_def);
}
-void *word_xt_pic_tail(word *w)
-{
- return vm->word_xt_pic_tail(w);
-}
/* References to undefined symbols are patched up to call this function on
image load */
@@ -187,10 +151,6 @@ void *factorvm::get_rel_symbol(array *literals, cell index)
}
}
-void *get_rel_symbol(array *literals, cell index)
-{
- return vm->get_rel_symbol(literals,index);
-}
cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
{
@@ -234,10 +194,6 @@ cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *
#undef ARG
}
-cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
-{
- return vm->compute_relocation(rel,index,compiled);
-}
void factorvm::iterate_relocations(code_block *compiled, relocation_iterator iter)
{
@@ -257,10 +213,6 @@ void factorvm::iterate_relocations(code_block *compiled, relocation_iterator ite
}
}
-void iterate_relocations(code_block *compiled, relocation_iterator iter)
-{
- return vm->iterate_relocations(compiled,iter);
-}
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
void factorvm::store_address_2_2(cell *ptr, cell value)
@@ -269,10 +221,6 @@ void factorvm::store_address_2_2(cell *ptr, cell value)
ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
}
-void store_address_2_2(cell *ptr, cell value)
-{
- return vm->store_address_2_2(ptr,value);
-}
/* Store a value into a bitfield of a PowerPC instruction */
void factorvm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
@@ -285,10 +233,6 @@ void factorvm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum s
*ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
}
-void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
-{
- return vm->store_address_masked(ptr,value,mask,shift);
-}
/* Perform a fixup on a code block */
void factorvm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
@@ -336,10 +280,6 @@ void factorvm::store_address_in_code_block(cell klass, cell offset, fixnum absol
}
}
-void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
-{
- return vm->store_address_in_code_block(klass,offset,absolute_value);
-}
void factorvm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
{
@@ -367,10 +307,6 @@ void factorvm::update_literal_references(code_block *compiled)
}
}
-void update_literal_references(code_block *compiled)
-{
- return vm->update_literal_references(compiled);
-}
/* Copy all literals referenced from a code block to newspace. Only for
aging and nursery collections */
@@ -479,10 +415,6 @@ void factorvm::check_code_address(cell address)
#endif
}
-void check_code_address(cell address)
-{
- return vm->check_code_address(address);
-}
/* Update references to words. This is done after a new code block
is added to the heap. */
@@ -499,10 +431,6 @@ void factorvm::mark_code_block(code_block *compiled)
copy_handle(&compiled->relocation);
}
-void mark_code_block(code_block *compiled)
-{
- return vm->mark_code_block(compiled);
-}
void factorvm::mark_stack_frame_step(stack_frame *frame)
{
@@ -526,10 +454,6 @@ void factorvm::mark_active_blocks(context *stacks)
}
}
-void mark_active_blocks(context *stacks)
-{
- return vm->mark_active_blocks(stacks);
-}
void factorvm::mark_object_code_block(object *object)
{
@@ -560,10 +484,6 @@ void factorvm::mark_object_code_block(object *object)
}
}
-void mark_object_code_block(object *object)
-{
- return vm->mark_object_code_block(object);
-}
/* Perform all fixups on a code block */
void factorvm::relocate_code_block(code_block *compiled)
@@ -597,10 +517,6 @@ void factorvm::fixup_labels(array *labels, code_block *compiled)
}
}
-void fixup_labels(array *labels, code_block *compiled)
-{
- return vm->fixup_labels(labels,compiled);
-}
/* Might GC */
code_block *factorvm::allot_code_block(cell size)
@@ -630,10 +546,6 @@ code_block *factorvm::allot_code_block(cell size)
return (code_block *)block;
}
-code_block *allot_code_block(cell size)
-{
- return vm->allot_code_block(size);
-}
/* Might GC */
code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
@@ -672,9 +584,5 @@ code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relo
return compiled;
}
-code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
-{
- return vm->add_code_block(type,code_,labels_,relocation_,literals_);
-}
}
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index 0addaeb854..60046ed380 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -60,39 +60,19 @@ 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;
-void flush_icache_for(code_block *compiled);
-
struct factorvm;
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled, factorvm *vm);
-void iterate_relocations(code_block *compiled, relocation_iterator iter);
-
-void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
-
+// callback functions
void relocate_code_block(code_block *compiled, factorvm *myvm);
-
-void update_literal_references(code_block *compiled);
-
void copy_literal_references(code_block *compiled, factorvm *myvm);
-
void update_word_references(code_block *compiled, factorvm *myvm);
-
void update_literal_and_word_references(code_block *compiled, factorvm *myvm);
-void mark_code_block(code_block *compiled);
-
-void mark_active_blocks(context *stacks);
-
-void mark_object_code_block(object *scan);
-
-void relocate_code_block(code_block *relocating);
-
inline bool stack_traces_p()
{
return userenv[STACK_TRACES_ENV] != F;
}
-code_block *add_code_block(cell type, cell code, cell labels, cell relocation, cell literals);
-
}
diff --git a/vm/jit.cpp b/vm/jit.cpp
index 9757e54dc4..7177f26073 100644
--- a/vm/jit.cpp
+++ b/vm/jit.cpp
@@ -102,7 +102,7 @@ code_block *jit::to_code_block()
relocation.trim();
literals.trim();
- return add_code_block(
+ return myvm->add_code_block(
type,
code.elements.value(),
F, /* no labels */
From 5a0c4d18aa3779777c66b1e0639b12dbfddf29eb Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:17 +0100
Subject: [PATCH 091/266] removed global functions from debug.cpp
---
vm/debug.cpp | 76 ----------------------------------------------------
vm/debug.hpp | 5 ----
2 files changed, 81 deletions(-)
mode change 100644 => 100755 vm/debug.hpp
diff --git a/vm/debug.cpp b/vm/debug.cpp
index eb64ad22d4..6009e922f7 100755
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -11,10 +11,6 @@ void factorvm::print_chars(string* str)
putchar(string_nth(str,i));
}
-void print_chars(string* str)
-{
- return vm->print_chars(str);
-}
void factorvm::print_word(word* word, cell nesting)
{
@@ -34,10 +30,6 @@ void factorvm::print_word(word* word, cell nesting)
}
}
-void print_word(word* word, cell nesting)
-{
- return vm->print_word(word,nesting);
-}
void factorvm::print_factor_string(string* str)
{
@@ -46,10 +38,6 @@ void factorvm::print_factor_string(string* str)
putchar('"');
}
-void print_factor_string(string* str)
-{
- return vm->print_factor_string(str);
-}
void factorvm::print_array(array* array, cell nesting)
{
@@ -75,10 +63,6 @@ void factorvm::print_array(array* array, cell nesting)
print_string("...");
}
-void print_array(array* array, cell nesting)
-{
- return vm->print_array(array,nesting);
-}
void factorvm::print_tuple(tuple *tuple, cell nesting)
{
@@ -109,10 +93,6 @@ void factorvm::print_tuple(tuple *tuple, cell nesting)
print_string("...");
}
-void print_tuple(tuple *tuple, cell nesting)
-{
- return vm->print_tuple(tuple,nesting);
-}
void factorvm::print_nested_obj(cell obj, fixnum nesting)
{
@@ -164,20 +144,12 @@ void factorvm::print_nested_obj(cell obj, fixnum nesting)
}
}
-void print_nested_obj(cell obj, fixnum nesting)
-{
- return vm->print_nested_obj(obj,nesting);
-}
void factorvm::print_obj(cell obj)
{
print_nested_obj(obj,10);
}
-void print_obj(cell obj)
-{
- return vm->print_obj(obj);
-}
void factorvm::print_objects(cell *start, cell *end)
{
@@ -188,10 +160,6 @@ void factorvm::print_objects(cell *start, cell *end)
}
}
-void print_objects(cell *start, cell *end)
-{
- return vm->print_objects(start,end);
-}
void factorvm::print_datastack()
{
@@ -199,10 +167,6 @@ void factorvm::print_datastack()
print_objects((cell *)ds_bot,(cell *)ds);
}
-void print_datastack()
-{
- return vm->print_datastack();
-}
void factorvm::print_retainstack()
{
@@ -210,10 +174,6 @@ void factorvm::print_retainstack()
print_objects((cell *)rs_bot,(cell *)rs);
}
-void print_retainstack()
-{
- return vm->print_retainstack();
-}
void factorvm::print_stack_frame(stack_frame *frame)
{
@@ -245,10 +205,6 @@ void factorvm::print_callstack()
iterate_callstack(top,bottom,factor::print_stack_frame);
}
-void print_callstack()
-{
- return vm->print_callstack();
-}
void factorvm::dump_cell(cell x)
{
@@ -258,10 +214,6 @@ void factorvm::dump_cell(cell x)
nl();
}
-void dump_cell(cell x)
-{
- return vm->dump_cell(x);
-}
void factorvm::dump_memory(cell from, cell to)
{
@@ -271,10 +223,6 @@ void factorvm::dump_memory(cell from, cell to)
dump_cell(from);
}
-void dump_memory(cell from, cell to)
-{
- return vm->dump_memory(from,to);
-}
void factorvm::dump_zone(zone *z)
{
@@ -283,10 +231,6 @@ void factorvm::dump_zone(zone *z)
print_string(", here="); print_cell(z->here - z->start); nl();
}
-void dump_zone(zone *z)
-{
- return vm->dump_zone(z);
-}
void factorvm::dump_generations()
{
@@ -314,10 +258,6 @@ void factorvm::dump_generations()
nl();
}
-void dump_generations()
-{
- return vm->dump_generations();
-}
void factorvm::dump_objects(cell type)
{
@@ -339,10 +279,6 @@ void factorvm::dump_objects(cell type)
end_scan();
}
-void dump_objects(cell type)
-{
- return vm->dump_objects(type);
-}
void factorvm::find_data_references_step(cell *scan)
@@ -373,10 +309,6 @@ void factorvm::find_data_references(cell look_for_)
end_scan();
}
-void find_data_references(cell look_for_)
-{
- return vm->find_data_references(look_for_);
-}
/* Dump all code blocks for debugging */
void factorvm::dump_code_heap()
@@ -419,10 +351,6 @@ void factorvm::dump_code_heap()
print_cell(literal_size); print_string(" bytes of literal data\n");
}
-void dump_code_heap()
-{
- return vm->dump_code_heap();
-}
void factorvm::factorbug()
{
@@ -568,10 +496,6 @@ void factorvm::factorbug()
}
}
-void factorbug()
-{
- return vm->factorbug();
-}
inline void factorvm::vmprim_die()
{
diff --git a/vm/debug.hpp b/vm/debug.hpp
old mode 100644
new mode 100755
index cb84c9256c..48566f1b2d
--- a/vm/debug.hpp
+++ b/vm/debug.hpp
@@ -1,11 +1,6 @@
namespace factor
{
-void print_obj(cell obj);
-void print_nested_obj(cell obj, fixnum nesting);
-void dump_generations();
-void factorbug();
-void dump_zone(zone *z);
PRIMITIVE(die);
From d21b1b2e1ec5a9756271a52794f3ad860a175c21 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:17 +0100
Subject: [PATCH 092/266] removed global functions from arrays.cpp
---
vm/arrays.cpp | 16 ----------------
vm/arrays.hpp | 10 ----------
vm/inlineimpls.hpp | 2 +-
3 files changed, 1 insertion(+), 27 deletions(-)
diff --git a/vm/arrays.cpp b/vm/arrays.cpp
index 8d964c4d21..62992c4e7c 100644
--- a/vm/arrays.cpp
+++ b/vm/arrays.cpp
@@ -23,10 +23,6 @@ array *factorvm::allot_array(cell capacity, cell fill_)
return new_array.untagged();
}
-array *allot_array(cell capacity, cell fill_)
-{
- return vm->allot_array(capacity,fill_);
-}
/* push a new array on the stack */
inline void factorvm::vmprim_array()
@@ -49,10 +45,6 @@ cell factorvm::allot_array_1(cell obj_)
return a.value();
}
-cell allot_array_1(cell obj_)
-{
- return vm->allot_array_1(obj_);
-}
cell factorvm::allot_array_2(cell v1_, cell v2_)
{
@@ -64,10 +56,6 @@ cell factorvm::allot_array_2(cell v1_, cell v2_)
return a.value();
}
-cell allot_array_2(cell v1_, cell v2_)
-{
- return vm->allot_array_2(v1_,v2_);
-}
cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
{
@@ -83,10 +71,6 @@ cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
return a.value();
}
-cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
-{
- return vm->allot_array_4(v1_,v2_,v3_,v4_);
-}
inline void factorvm::vmprim_resize_array()
{
diff --git a/vm/arrays.hpp b/vm/arrays.hpp
index 282474ade8..e3eaccfba3 100755
--- a/vm/arrays.hpp
+++ b/vm/arrays.hpp
@@ -10,16 +10,6 @@ inline cell array_nth(array *array, cell slot)
return array->data()[slot];
}
-
-
-
-
-array *allot_array(cell capacity, cell fill);
-
-cell allot_array_1(cell obj);
-cell allot_array_2(cell v1, cell v2);
-cell allot_array_4(cell v1, cell v2, cell v3, cell v4);
-
PRIMITIVE(array);
PRIMITIVE(resize_array);
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index 241c958b2c..3932177a72 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -347,7 +347,7 @@ struct growable_array {
cell count;
gc_root<array> elements;
- growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(allot_array(capacity,F),myvm) {}
+ growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
void add(cell elt);
void trim();
From 9e2d40a228b40c2c5d772c5d5dfbe9f3edfc0524 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:17 +0100
Subject: [PATCH 093/266] removed global functions from strings.cpp
---
vm/strings.cpp | 36 ------------------------------------
vm/strings.hpp | 7 -------
2 files changed, 43 deletions(-)
diff --git a/vm/strings.cpp b/vm/strings.cpp
index a8962ee921..82db8430eb 100644
--- a/vm/strings.cpp
+++ b/vm/strings.cpp
@@ -22,20 +22,12 @@ cell factorvm::string_nth(string* str, cell index)
}
}
-cell string_nth(string* str, cell index)
-{
- return vm->string_nth(str,index);
-}
void factorvm::set_string_nth_fast(string *str, cell index, cell ch)
{
str->data()[index] = ch;
}
-void set_string_nth_fast(string *str, cell index, cell ch)
-{
- return vm->set_string_nth_fast(str,index,ch);
-}
void factorvm::set_string_nth_slow(string *str_, cell index, cell ch)
{
@@ -64,10 +56,6 @@ void factorvm::set_string_nth_slow(string *str_, cell index, cell ch)
aux->data<u16>()[index] = ((ch >> 7) ^ 1);
}
-void set_string_nth_slow(string *str_, cell index, cell ch)
-{
- return vm->set_string_nth_slow(str_,index,ch);
-}
/* allocates memory */
void factorvm::set_string_nth(string *str, cell index, cell ch)
@@ -78,10 +66,6 @@ void factorvm::set_string_nth(string *str, cell index, cell ch)
set_string_nth_slow(str,index,ch);
}
-void set_string_nth(string *str, cell index, cell ch)
-{
- return vm->set_string_nth(str,index,ch);
-}
/* Allocates memory */
string *factorvm::allot_string_internal(cell capacity)
@@ -95,10 +79,6 @@ string *factorvm::allot_string_internal(cell capacity)
return str;
}
-string *allot_string_internal(cell capacity)
-{
- return vm->allot_string_internal(capacity);
-}
/* Allocates memory */
void factorvm::fill_string(string *str_, cell start, cell capacity, cell fill)
@@ -116,10 +96,6 @@ void factorvm::fill_string(string *str_, cell start, cell capacity, cell fill)
}
}
-void fill_string(string *str_, cell start, cell capacity, cell fill)
-{
- return vm->fill_string(str_,start,capacity,fill);
-}
/* Allocates memory */
string *factorvm::allot_string(cell capacity, cell fill)
@@ -129,10 +105,6 @@ string *factorvm::allot_string(cell capacity, cell fill)
return str.untagged();
}
-string *allot_string(cell capacity, cell fill)
-{
- return vm->allot_string(capacity,fill);
-}
inline void factorvm::vmprim_string()
{
@@ -153,10 +125,6 @@ bool factorvm::reallot_string_in_place_p(string *str, cell capacity)
&& capacity <= string_capacity(str);
}
-bool reallot_string_in_place_p(string *str, cell capacity)
-{
- return vm->reallot_string_in_place_p(str,capacity);
-}
string* factorvm::reallot_string(string *str_, cell capacity)
{
@@ -200,10 +168,6 @@ string* factorvm::reallot_string(string *str_, cell capacity)
}
}
-string* reallot_string(string *str_, cell capacity)
-{
- return vm->reallot_string(str_,capacity);
-}
inline void factorvm::vmprim_resize_string()
{
diff --git a/vm/strings.hpp b/vm/strings.hpp
index 9a082b0b83..87beb9a0a8 100644
--- a/vm/strings.hpp
+++ b/vm/strings.hpp
@@ -11,16 +11,9 @@ inline static cell string_size(cell size)
return sizeof(string) + size;
}
-string* allot_string_internal(cell capacity);
-string* allot_string(cell capacity, cell fill);
PRIMITIVE(string);
-string *reallot_string(string *string, cell capacity);
PRIMITIVE(resize_string);
-/* String getters and setters */
-cell string_nth(string* string, cell index);
-void set_string_nth(string* string, cell index, cell value);
-
PRIMITIVE(string_nth);
PRIMITIVE(set_string_nth_slow);
PRIMITIVE(set_string_nth_fast);
From 10bf5ca17c35b2cad76b8c5b50e598fa04202e61 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:17 +0100
Subject: [PATCH 094/266] removed global functions from byte_arrays.cpp and
tuples.cpp
---
vm/byte_arrays.cpp | 4 ----
vm/byte_arrays.hpp | 2 --
vm/inlineimpls.hpp | 2 +-
vm/tuples.cpp | 5 -----
4 files changed, 1 insertion(+), 12 deletions(-)
diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp
index 0f4591a89c..4a197d8452 100644
--- a/vm/byte_arrays.cpp
+++ b/vm/byte_arrays.cpp
@@ -10,10 +10,6 @@ byte_array *factorvm::allot_byte_array(cell size)
return array;
}
-byte_array *allot_byte_array(cell size)
-{
- return vm->allot_byte_array(size);
-}
inline void factorvm::vmprim_byte_array()
{
diff --git a/vm/byte_arrays.hpp b/vm/byte_arrays.hpp
index 4954f31094..c1adcd95f0 100755
--- a/vm/byte_arrays.hpp
+++ b/vm/byte_arrays.hpp
@@ -1,8 +1,6 @@
namespace factor
{
-byte_array *allot_byte_array(cell size);
-
PRIMITIVE(byte_array);
PRIMITIVE(uninitialized_byte_array);
PRIMITIVE(resize_byte_array);
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index 3932177a72..90ccd8d869 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -358,7 +358,7 @@ struct growable_byte_array {
cell count;
gc_root<byte_array> elements;
- growable_byte_array(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
+ growable_byte_array(factorvm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
void append_bytes(void *elts, cell len);
void append_byte_array(cell elts);
diff --git a/vm/tuples.cpp b/vm/tuples.cpp
index 5c4c6e17b0..520bc55d4d 100644
--- a/vm/tuples.cpp
+++ b/vm/tuples.cpp
@@ -12,11 +12,6 @@ tuple *factorvm::allot_tuple(cell layout_)
return t.untagged();
}
-tuple *allot_tuple(cell layout_)
-{
- return vm->allot_tuple(layout_);
-}
-
inline void factorvm::vmprim_tuple()
{
gc_root<tuple_layout> layout(dpop(),this);
From 2dba15535f82997762937dfbba9d47326ad69be5 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:18 +0100
Subject: [PATCH 095/266] removed global functions from words.cpp
---
vm/words.cpp | 10 ----------
vm/words.hpp | 4 ----
2 files changed, 14 deletions(-)
diff --git a/vm/words.cpp b/vm/words.cpp
index 68b6afd9d0..f3c511efe9 100644
--- a/vm/words.cpp
+++ b/vm/words.cpp
@@ -31,11 +31,6 @@ word *factorvm::allot_word(cell vocab_, cell name_)
return new_word.untagged();
}
-word *allot_word(cell vocab_, cell name_)
-{
- return vm->allot_word(vocab_,name_);
-}
-
/* <word> ( name vocabulary -- word ) */
inline void factorvm::vmprim_word()
{
@@ -79,11 +74,6 @@ void factorvm::update_word_xt(cell w_)
w->xt = w->code->xt();
}
-void update_word_xt(cell w_)
-{
- return vm->update_word_xt(w_);
-}
-
inline void factorvm::vmprim_optimized_p()
{
drepl(tag_boolean(word_optimized_p(untag_check<word>(dpeek()))));
diff --git a/vm/words.hpp b/vm/words.hpp
index f9d5a7aff4..d3be2bde07 100644
--- a/vm/words.hpp
+++ b/vm/words.hpp
@@ -1,11 +1,8 @@
namespace factor
{
-word *allot_word(cell vocab, cell name);
-
PRIMITIVE(word);
PRIMITIVE(word_xt);
-void update_word_xt(cell word);
inline bool word_optimized_p(word *word)
{
@@ -13,7 +10,6 @@ inline bool word_optimized_p(word *word)
}
PRIMITIVE(optimized_p);
-
PRIMITIVE(wrapper);
}
From fc5c51e2cdfa9ae8530c5c7f887dd7b8459226f8 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:18 +0100
Subject: [PATCH 096/266] removed some global functions from math.cpp
---
vm/math.cpp | 16 ----------------
vm/math.hpp | 2 --
2 files changed, 18 deletions(-)
diff --git a/vm/math.cpp b/vm/math.cpp
index 98188059f6..0a46252d7f 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -71,30 +71,18 @@ inline fixnum factorvm::sign_mask(fixnum x)
return x >> (WORD_SIZE - 1);
}
-inline fixnum sign_mask(fixnum x)
-{
- return vm->sign_mask(x);
-}
inline fixnum factorvm::branchless_max(fixnum x, fixnum y)
{
return (x - ((x - y) & sign_mask(x - y)));
}
-inline fixnum branchless_max(fixnum x, fixnum y)
-{
- return vm->branchless_max(x,y);
-}
inline fixnum factorvm::branchless_abs(fixnum x)
{
return (x ^ sign_mask(x)) - sign_mask(x);
}
-inline fixnum branchless_abs(fixnum x)
-{
- return vm->branchless_abs(x);
-}
inline void factorvm::vmprim_fixnum_shift()
{
@@ -410,10 +398,6 @@ cell factorvm::unbox_array_size()
return 0; /* can't happen */
}
-cell unbox_array_size()
-{
- return vm->unbox_array_size();
-}
inline void factorvm::vmprim_fixnum_to_float()
{
diff --git a/vm/math.hpp b/vm/math.hpp
index 4633721194..e8347fe0e2 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -38,8 +38,6 @@ PRIMITIVE(bignum_bitp);
PRIMITIVE(bignum_log2);
PRIMITIVE(byte_array_to_bignum);
-cell unbox_array_size();
-
PRIMITIVE(fixnum_to_float);
PRIMITIVE(bignum_to_float);
PRIMITIVE(str_to_float);
From 0397f92569206005050396cfd9277d3c903cc6cf Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:18 +0100
Subject: [PATCH 097/266] removed some global functions from io.cpp
---
vm/io.cpp | 8 --------
vm/io.hpp | 3 ---
2 files changed, 11 deletions(-)
mode change 100644 => 100755 vm/io.hpp
diff --git a/vm/io.cpp b/vm/io.cpp
index cfbafda907..47d964eaad 100755
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -21,10 +21,6 @@ void factorvm::init_c_io()
userenv[STDERR_ENV] = allot_alien(F,(cell)stderr);
}
-void init_c_io()
-{
- return vm->init_c_io();
-}
void factorvm::io_error()
{
@@ -36,10 +32,6 @@ void factorvm::io_error()
general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
}
-void io_error()
-{
- return vm->io_error();
-}
inline void factorvm::vmprim_fopen()
{
diff --git a/vm/io.hpp b/vm/io.hpp
old mode 100644
new mode 100755
index d94d6402d9..1b5e281b54
--- a/vm/io.hpp
+++ b/vm/io.hpp
@@ -1,9 +1,6 @@
namespace factor
{
-void init_c_io();
-void io_error();
-
PRIMITIVE(fopen);
PRIMITIVE(fgetc);
PRIMITIVE(fread);
From 1887a16ca399bd96821bb34b8a33747a70bf7993 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:18 +0100
Subject: [PATCH 098/266] removed some global functions from image.cpp
---
vm/image.cpp | 52 ----------------------------------------------------
vm/image.hpp | 3 ---
2 files changed, 55 deletions(-)
mode change 100644 => 100755 vm/image.hpp
diff --git a/vm/image.cpp b/vm/image.cpp
index 5ceefdfeb4..747e0cc37e 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -14,10 +14,6 @@ void factorvm::init_objects(image_header *h)
bignum_neg_one = h->bignum_neg_one;
}
-void init_objects(image_header *h)
-{
- return vm->init_objects(h);
-}
void factorvm::load_data_heap(FILE *file, image_header *h, vm_parameters *p)
@@ -53,10 +49,6 @@ void factorvm::load_data_heap(FILE *file, image_header *h, vm_parameters *p)
data_relocation_base = h->data_relocation_base;
}
-void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
-{
- return vm->load_data_heap(file,h,p);
-}
void factorvm::load_code_heap(FILE *file, image_header *h, vm_parameters *p)
@@ -84,10 +76,6 @@ void factorvm::load_code_heap(FILE *file, image_header *h, vm_parameters *p)
build_free_list(&code,h->code_size);
}
-void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
-{
- return vm->load_code_heap(file,h,p);
-}
/* Save the current image to disk */
bool factorvm::save_image(const vm_char *filename)
@@ -135,10 +123,6 @@ bool factorvm::save_image(const vm_char *filename)
return ok;
}
-bool save_image(const vm_char *filename)
-{
- return vm->save_image(filename);
-}
inline void factorvm::vmprim_save_image()
{
@@ -207,10 +191,6 @@ template <typename TYPE> void factorvm::code_fixup(TYPE **handle)
*handle = new_ptr;
}
-template <typename TYPE> void code_fixup(TYPE **handle)
-{
- return vm->code_fixup(handle);
-}
void factorvm::fixup_word(word *word)
{
@@ -221,10 +201,6 @@ void factorvm::fixup_word(word *word)
code_fixup(&word->xt);
}
-void fixup_word(word *word)
-{
- return vm->fixup_word(word);
-}
void factorvm::fixup_quotation(quotation *quot)
{
@@ -237,20 +213,12 @@ void factorvm::fixup_quotation(quotation *quot)
quot->xt = (void *)lazy_jit_compile;
}
-void fixup_quotation(quotation *quot)
-{
- return vm->fixup_quotation(quot);
-}
void factorvm::fixup_alien(alien *d)
{
d->expired = T;
}
-void fixup_alien(alien *d)
-{
- return vm->fixup_alien(d);
-}
void factorvm::fixup_stack_frame(stack_frame *frame)
{
@@ -268,10 +236,6 @@ void factorvm::fixup_callstack_object(callstack *stack)
iterate_callstack_object(stack,factor::fixup_stack_frame);
}
-void fixup_callstack_object(callstack *stack)
-{
- return vm->fixup_callstack_object(stack);
-}
/* Initialize an object in a newly-loaded image */
void factorvm::relocate_object(object *object)
@@ -317,10 +281,6 @@ void factorvm::relocate_object(object *object)
}
}
-void relocate_object(object *object)
-{
- return vm->relocate_object(object);
-}
/* Since the image might have been saved with a different base address than
where it is loaded, we need to fix up pointers in the image. */
@@ -349,10 +309,6 @@ void factorvm::relocate_data()
}
}
-void relocate_data()
-{
- return vm->relocate_data();
-}
void factorvm::fixup_code_block(code_block *compiled)
{
@@ -373,10 +329,6 @@ void factorvm::relocate_code()
iterate_code_heap(factor::fixup_code_block);
}
-void relocate_code()
-{
- return vm->relocate_code();
-}
/* Read an image file from disk, only done once during startup */
/* This function also initializes the data and code heaps */
@@ -414,9 +366,5 @@ void factorvm::load_image(vm_parameters *p)
userenv[IMAGE_ENV] = allot_alien(F,(cell)p->image_path);
}
-void load_image(vm_parameters *p)
-{
- return vm->load_image(p);
-}
}
diff --git a/vm/image.hpp b/vm/image.hpp
old mode 100644
new mode 100755
index 807a7a6bcf..eab0343716
--- a/vm/image.hpp
+++ b/vm/image.hpp
@@ -41,9 +41,6 @@ struct vm_parameters {
cell max_pic_size;
};
-void load_image(vm_parameters *p);
-bool save_image(const vm_char *file);
-
PRIMITIVE(save_image);
PRIMITIVE(save_image_and_exit);
From 551a800d2f71ca5c9f06fdb17fa1c31f9d182e9a Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:18 +0100
Subject: [PATCH 099/266] removed some global functions from callstack.cpp
---
vm/callstack.cpp | 58 ++----------------------------------------------
vm/callstack.hpp | 7 ------
2 files changed, 2 insertions(+), 63 deletions(-)
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index c330e38064..676e4260c9 100755
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -11,11 +11,6 @@ void factorvm::check_frame(stack_frame *frame)
#endif
}
-void check_frame(stack_frame *frame)
-{
- return vm->check_frame(frame);
-}
-
callstack *factorvm::allot_callstack(cell size)
{
callstack *stack = allot<callstack>(callstack_size(size));
@@ -23,11 +18,6 @@ callstack *factorvm::allot_callstack(cell size)
return stack;
}
-callstack *allot_callstack(cell size)
-{
- return vm->allot_callstack(size);
-}
-
stack_frame *factorvm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
{
stack_frame *frame = bottom - 1;
@@ -38,11 +28,6 @@ stack_frame *factorvm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
return frame + 1;
}
-stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
-{
- return vm->fix_callstack_top(top,bottom);
-}
-
/* We ignore the topmost frame, the one calling 'callstack',
so that set-callstack doesn't get stuck in an infinite loop.
@@ -61,11 +46,6 @@ stack_frame *factorvm::capture_start()
return frame + 1;
}
-stack_frame *capture_start()
-{
- return vm->capture_start();
-}
-
inline void factorvm::vmprim_callstack()
{
stack_frame *top = capture_start();
@@ -109,21 +89,12 @@ code_block *factorvm::frame_code(stack_frame *frame)
return (code_block *)frame->xt - 1;
}
-code_block *frame_code(stack_frame *frame)
-{
- return vm->frame_code(frame);
-}
cell factorvm::frame_type(stack_frame *frame)
{
return frame_code(frame)->type;
}
-cell frame_type(stack_frame *frame)
-{
- return vm->frame_type(frame);
-}
-
cell factorvm::frame_executing(stack_frame *frame)
{
code_block *compiled = frame_code(frame);
@@ -138,22 +109,12 @@ cell factorvm::frame_executing(stack_frame *frame)
}
}
-cell frame_executing(stack_frame *frame)
-{
- return vm->frame_executing(frame);
-}
-
stack_frame *factorvm::frame_successor(stack_frame *frame)
{
check_frame(frame);
return (stack_frame *)((cell)frame - frame->size);
}
-stack_frame *frame_successor(stack_frame *frame)
-{
- return vm->frame_successor(frame);
-}
-
/* Allocates memory */
cell factorvm::frame_scan(stack_frame *frame)
{
@@ -181,11 +142,6 @@ cell factorvm::frame_scan(stack_frame *frame)
}
}
-cell frame_scan(stack_frame *frame)
-{
- return vm->frame_scan(frame);
-}
-
namespace
{
@@ -196,8 +152,8 @@ struct stack_frame_accumulator {
void operator()(stack_frame *frame, factorvm *myvm)
{
- gc_root<object> executing(frame_executing(frame),myvm);
- gc_root<object> scan(frame_scan(frame),myvm);
+ gc_root<object> executing(myvm->frame_executing(frame),myvm);
+ gc_root<object> scan(myvm->frame_scan(frame),myvm);
frames.add(executing.value());
frames.add(scan.value());
@@ -234,11 +190,6 @@ stack_frame *factorvm::innermost_stack_frame(callstack *stack)
return frame;
}
-stack_frame *innermost_stack_frame(callstack *stack)
-{
- return vm->innermost_stack_frame(stack);
-}
-
stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
{
stack_frame *inner = innermost_stack_frame(callstack);
@@ -246,11 +197,6 @@ stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
return inner;
}
-stack_frame *innermost_stack_frame_quot(callstack *callstack)
-{
- return vm->innermost_stack_frame_quot(callstack);
-}
-
/* Some primitives implementing a limited form of callstack mutation.
Used by the single stepper. */
inline void factorvm::vmprim_innermost_stack_frame_executing()
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index 82fb93a1bc..406d8e7154 100755
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -6,13 +6,6 @@ inline static cell callstack_size(cell size)
return sizeof(callstack) + size;
}
-stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
-stack_frame *frame_successor(stack_frame *frame);
-code_block *frame_code(stack_frame *frame);
-cell frame_executing(stack_frame *frame);
-cell frame_scan(stack_frame *frame);
-cell frame_type(stack_frame *frame);
-
PRIMITIVE(callstack);
PRIMITIVE(set_callstack);
PRIMITIVE(callstack_to_array);
From 7f70b6320c3dbcea833ea892947ea74a66eb92c3 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:18 +0100
Subject: [PATCH 100/266] removed some global functions from alien.cpp
---
vm/alien.cpp | 17 ++++-------------
vm/alien.hpp | 2 --
2 files changed, 4 insertions(+), 15 deletions(-)
mode change 100644 => 100755 vm/alien.hpp
diff --git a/vm/alien.cpp b/vm/alien.cpp
index ffd49f60b0..41a1e8d522 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -24,11 +24,6 @@ char *factorvm::pinned_alien_offset(cell obj)
}
}
-char *pinned_alien_offset(cell obj)
-{
- return vm->pinned_alien_offset(obj);
-}
-
/* make an alien */
cell factorvm::allot_alien(cell delegate_, cell displacement)
{
@@ -50,11 +45,6 @@ cell factorvm::allot_alien(cell delegate_, cell displacement)
return new_alien.value();
}
-cell allot_alien(cell delegate_, cell displacement)
-{
- return vm->allot_alien(delegate_,displacement);
-}
-
/* make an alien pointing at an offset of another alien */
inline void factorvm::vmprim_displaced_alien()
{
@@ -108,15 +98,16 @@ void *alien_pointer()
return vm->alien_pointer();
}
+
/* define words to read/write values at an alien address */
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
{ \
- boxer(*(type*)alien_pointer()); \
+ boxer(*(type*)PRIMITIVE_GETVM()->alien_pointer()); \
} \
PRIMITIVE(set_alien_##name) \
{ \
- type *ptr = (type *)alien_pointer(); \
+ type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
type value = to(dpop()); \
*ptr = value; \
}
@@ -133,7 +124,7 @@ DEFINE_ALIEN_ACCESSOR(signed_1,s8,box_signed_1,to_fixnum)
DEFINE_ALIEN_ACCESSOR(unsigned_1,u8,box_unsigned_1,to_cell)
DEFINE_ALIEN_ACCESSOR(float,float,box_float,to_float)
DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double)
-DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
+DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,PRIMITIVE_GETVM()->pinned_alien_offset)
/* open a native library and push a handle */
inline void factorvm::vmprim_dlopen()
diff --git a/vm/alien.hpp b/vm/alien.hpp
old mode 100644
new mode 100755
index 6235a2d6c7..0a4f3a7e93
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@@ -1,8 +1,6 @@
namespace factor
{
-cell allot_alien(cell delegate, cell displacement);
-
PRIMITIVE(displaced_alien);
PRIMITIVE(alien_address);
From 0de0d5f2567f076a2c54a8ba1b4cac89c9ccb474 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:19 +0100
Subject: [PATCH 101/266] removed some global functions from quotations.cpp
---
vm/quotations.cpp | 30 +++++-------------------------
vm/quotations.hpp | 6 ------
2 files changed, 5 insertions(+), 31 deletions(-)
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index ef615dc095..b7bce0bfd7 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -198,8 +198,8 @@ void quotation_jit::iterate_quotation()
if(compiling)
{
- jit_compile(array_nth(elements.untagged(),i),relocate);
- jit_compile(array_nth(elements.untagged(),i + 1),relocate);
+ myvm->jit_compile(array_nth(elements.untagged(),i),relocate);
+ myvm->jit_compile(array_nth(elements.untagged(),i + 1),relocate);
}
literal(array_nth(elements.untagged(),i));
@@ -214,7 +214,7 @@ void quotation_jit::iterate_quotation()
else if(fast_dip_p(i))
{
if(compiling)
- jit_compile(obj.value(),relocate);
+ myvm->jit_compile(obj.value(),relocate);
emit_with(userenv[JIT_DIP],obj.value());
i++;
break;
@@ -223,7 +223,7 @@ void quotation_jit::iterate_quotation()
else if(fast_2dip_p(i))
{
if(compiling)
- jit_compile(obj.value(),relocate);
+ myvm->jit_compile(obj.value(),relocate);
emit_with(userenv[JIT_2DIP],obj.value());
i++;
break;
@@ -232,7 +232,7 @@ void quotation_jit::iterate_quotation()
else if(fast_3dip_p(i))
{
if(compiling)
- jit_compile(obj.value(),relocate);
+ myvm->jit_compile(obj.value(),relocate);
emit_with(userenv[JIT_3DIP],obj.value());
i++;
break;
@@ -274,11 +274,6 @@ void factorvm::set_quot_xt(quotation *quot, code_block *code)
quot->xt = code->xt();
}
-void set_quot_xt(quotation *quot, code_block *code)
-{
- return vm->set_quot_xt(quot,code);
-}
-
/* Allocates memory */
void factorvm::jit_compile(cell quot_, bool relocating)
{
@@ -294,11 +289,6 @@ void factorvm::jit_compile(cell quot_, bool relocating)
if(relocating) relocate_code_block(compiled);
}
-void jit_compile(cell quot_, bool relocating)
-{
- return vm->jit_compile(quot_,relocating);
-}
-
inline void factorvm::vmprim_jit_compile()
{
jit_compile(dpop(),true);
@@ -357,11 +347,6 @@ void factorvm::compile_all_words()
iterate_code_heap(factor::relocate_code_block);
}
-void compile_all_words()
-{
- return vm->compile_all_words();
-}
-
/* Allocates memory */
fixnum factorvm::quot_code_offset_to_scan(cell quot_, cell offset)
{
@@ -375,11 +360,6 @@ fixnum factorvm::quot_code_offset_to_scan(cell quot_, cell offset)
return compiler.get_position();
}
-fixnum quot_code_offset_to_scan(cell quot_, cell offset)
-{
- return vm->quot_code_offset_to_scan(quot_,offset);
-}
-
cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
{
gc_root<quotation> quot(quot_,this);
diff --git a/vm/quotations.hpp b/vm/quotations.hpp
index dad41917e0..6c8b17db21 100755
--- a/vm/quotations.hpp
+++ b/vm/quotations.hpp
@@ -22,14 +22,8 @@ struct quotation_jit : public jit {
void iterate_quotation();
};
-void set_quot_xt(quotation *quot, code_block *code);
-void jit_compile(cell quot, bool relocate);
-fixnum quot_code_offset_to_scan(cell quot, cell offset);
-
PRIMITIVE(jit_compile);
-void compile_all_words();
-
PRIMITIVE(array_to_quotation);
PRIMITIVE(quotation_xt);
From 6234b7957f972c6c6d84b03db1cee6a3eaf1fa0f Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:19 +0100
Subject: [PATCH 102/266] removed some global functions from dispatch.cpp
---
vm/dispatch.cpp | 55 -------------------------------------------------
vm/dispatch.hpp | 9 --------
2 files changed, 64 deletions(-)
diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp
index 25f7a2f2ec..85d92f90a0 100755
--- a/vm/dispatch.cpp
+++ b/vm/dispatch.cpp
@@ -18,11 +18,6 @@ cell factorvm::search_lookup_alist(cell table, cell klass)
return F;
}
-cell search_lookup_alist(cell table, cell klass)
-{
- return vm->search_lookup_alist(table,klass);
-}
-
cell factorvm::search_lookup_hash(cell table, cell klass, cell hashcode)
{
array *buckets = untag<array>(table);
@@ -33,33 +28,18 @@ cell factorvm::search_lookup_hash(cell table, cell klass, cell hashcode)
return search_lookup_alist(bucket,klass);
}
-cell search_lookup_hash(cell table, cell klass, cell hashcode)
-{
- return vm->search_lookup_hash(table,klass,hashcode);
-}
-
cell factorvm::nth_superclass(tuple_layout *layout, fixnum echelon)
{
cell *ptr = (cell *)(layout + 1);
return ptr[echelon * 2];
}
-cell nth_superclass(tuple_layout *layout, fixnum echelon)
-{
- return vm->nth_superclass(layout,echelon);
-}
-
cell factorvm::nth_hashcode(tuple_layout *layout, fixnum echelon)
{
cell *ptr = (cell *)(layout + 1);
return ptr[echelon * 2 + 1];
}
-cell nth_hashcode(tuple_layout *layout, fixnum echelon)
-{
- return vm->nth_hashcode(layout,echelon);
-}
-
cell factorvm::lookup_tuple_method(cell obj, cell methods)
{
tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout);
@@ -92,11 +72,6 @@ cell factorvm::lookup_tuple_method(cell obj, cell methods)
return F;
}
-cell lookup_tuple_method(cell obj, cell methods)
-{
- return vm->lookup_tuple_method(obj,methods);
-}
-
cell factorvm::lookup_hi_tag_method(cell obj, cell methods)
{
array *hi_tag_methods = untag<array>(methods);
@@ -107,11 +82,6 @@ cell factorvm::lookup_hi_tag_method(cell obj, cell methods)
return array_nth(hi_tag_methods,tag);
}
-cell lookup_hi_tag_method(cell obj, cell methods)
-{
- return vm->lookup_hi_tag_method(obj,methods);
-}
-
cell factorvm::lookup_hairy_method(cell obj, cell methods)
{
cell method = array_nth(untag<array>(methods),TAG(obj));
@@ -134,11 +104,6 @@ cell factorvm::lookup_hairy_method(cell obj, cell methods)
}
}
-cell lookup_hairy_method(cell obj, cell methods)
-{
- return vm->lookup_hairy_method(obj,methods);
-}
-
cell factorvm::lookup_method(cell obj, cell methods)
{
cell tag = TAG(obj);
@@ -148,11 +113,6 @@ cell factorvm::lookup_method(cell obj, cell methods)
return array_nth(untag<array>(methods),TAG(obj));
}
-cell lookup_method(cell obj, cell methods)
-{
- return vm->lookup_method(obj,methods);
-}
-
inline void factorvm::vmprim_lookup_method()
{
cell methods = dpop();
@@ -178,22 +138,12 @@ cell factorvm::object_class(cell obj)
}
}
-cell object_class(cell obj)
-{
- return vm->object_class(obj);
-}
-
cell factorvm::method_cache_hashcode(cell klass, array *array)
{
cell capacity = (array_capacity(array) >> 1) - 1;
return ((klass >> TAG_BITS) & capacity) << 1;
}
-cell method_cache_hashcode(cell klass, array *array)
-{
- return vm->method_cache_hashcode(klass,array);
-}
-
void factorvm::update_method_cache(cell cache, cell klass, cell method)
{
array *cache_elements = untag<array>(cache);
@@ -202,11 +152,6 @@ void factorvm::update_method_cache(cell cache, cell klass, cell method)
set_array_nth(cache_elements,hashcode + 1,method);
}
-void update_method_cache(cell cache, cell klass, cell method)
-{
- return vm->update_method_cache(cache,klass,method);
-}
-
inline void factorvm::vmprim_mega_cache_miss()
{
megamorphic_cache_misses++;
diff --git a/vm/dispatch.hpp b/vm/dispatch.hpp
index f5648c7ebe..b9cbcbbd85 100644
--- a/vm/dispatch.hpp
+++ b/vm/dispatch.hpp
@@ -1,18 +1,9 @@
namespace factor
{
-cell lookup_method(cell object, cell methods);
PRIMITIVE(lookup_method);
-
-cell object_class(cell object);
-
PRIMITIVE(mega_cache_miss);
-
PRIMITIVE(reset_dispatch_stats);
PRIMITIVE(dispatch_stats);
-void jit_emit_class_lookup(jit *jit, fixnum index, cell type);
-
-void jit_emit_mega_cache_lookup(jit *jit, cell methods, fixnum index, cell cache);
-
}
From 1c656e1bac44711cc6a726f32ffe1de85697c28a Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:19 +0100
Subject: [PATCH 103/266] removed some global functions from inline_cache.cpp
---
vm/inline_cache.cpp | 52 ++++-----------------------------------------
vm/inline_cache.hpp | 2 --
2 files changed, 4 insertions(+), 50 deletions(-)
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index 15d8fcb203..24008cae79 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -9,11 +9,6 @@ void factorvm::init_inline_caching(int max_size)
max_pic_size = max_size;
}
-void init_inline_caching(int max_size)
-{
- return vm->init_inline_caching(max_size);
-}
-
void factorvm::deallocate_inline_cache(cell return_address)
{
/* Find the call target. */
@@ -33,11 +28,6 @@ void factorvm::deallocate_inline_cache(cell return_address)
heap_free(&code,old_block);
}
-void deallocate_inline_cache(cell return_address)
-{
- return vm->deallocate_inline_cache(return_address);
-}
-
/* Figure out what kind of type check the PIC needs based on the methods
it contains */
cell factorvm::determine_inline_cache_type(array *cache_entries)
@@ -77,21 +67,11 @@ cell factorvm::determine_inline_cache_type(array *cache_entries)
return 0;
}
-cell determine_inline_cache_type(array *cache_entries)
-{
- return vm->determine_inline_cache_type(cache_entries);
-}
-
void factorvm::update_pic_count(cell type)
{
pic_counts[type - PIC_TAG]++;
}
-void update_pic_count(cell type)
-{
- return vm->update_pic_count(type);
-}
-
struct inline_cache_jit : public jit {
fixnum index;
@@ -128,8 +108,8 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
gc_root<array> methods(methods_,myvm);
gc_root<array> cache_entries(cache_entries_,myvm);
- cell inline_cache_type = determine_inline_cache_type(cache_entries.untagged());
- update_pic_count(inline_cache_type);
+ cell inline_cache_type = myvm->determine_inline_cache_type(cache_entries.untagged());
+ myvm->update_pic_count(inline_cache_type);
/* Generate machine code to determine the object's class. */
emit_class_lookup(index,inline_cache_type);
@@ -176,32 +156,17 @@ code_block *factorvm::compile_inline_cache(fixnum index,cell generic_word_,cell
return code;
}
-code_block *compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
-{
- return vm->compile_inline_cache(index,generic_word_,methods_,cache_entries_,tail_call_p);
-}
-
/* A generic word's definition performs general method lookup. Allocates memory */
void *factorvm::megamorphic_call_stub(cell generic_word)
{
return untag<word>(generic_word)->xt;
}
-void *megamorphic_call_stub(cell generic_word)
-{
- return vm->megamorphic_call_stub(generic_word);
-}
-
cell factorvm::inline_cache_size(cell cache_entries)
{
return array_capacity(untag_check<array>(cache_entries)) / 2;
}
-cell inline_cache_size(cell cache_entries)
-{
- return vm->inline_cache_size(cache_entries);
-}
-
/* Allocates memory */
cell factorvm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
{
@@ -216,11 +181,6 @@ cell factorvm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell met
return new_cache_entries.value();
}
-cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
-{
- return vm->add_inline_cache_entry(cache_entries_,klass_,method_);
-}
-
void factorvm::update_pic_transitions(cell pic_size)
{
if(pic_size == max_pic_size)
@@ -231,11 +191,6 @@ void factorvm::update_pic_transitions(cell pic_size)
ic_to_pic_transitions++;
}
-void update_pic_transitions(cell pic_size)
-{
- return vm->update_pic_transitions(pic_size);
-}
-
/* The cache_entries parameter is either f (on cold call site) or an array (on cache miss).
Called from assembly with the actual return address */
void *factorvm::inline_cache_miss(cell return_address)
@@ -290,11 +245,12 @@ void *factorvm::inline_cache_miss(cell return_address)
return xt;
}
-void *inline_cache_miss(cell return_address)
+VM_C_API void *inline_cache_miss(cell return_address)
{
return vm->inline_cache_miss(return_address);
}
+
inline void factorvm::vmprim_reset_inline_cache_stats()
{
cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
diff --git a/vm/inline_cache.hpp b/vm/inline_cache.hpp
index e354d30677..5b1bbdf516 100644
--- a/vm/inline_cache.hpp
+++ b/vm/inline_cache.hpp
@@ -1,7 +1,5 @@
namespace factor
{
-void init_inline_caching(int max_size);
-
PRIMITIVE(reset_inline_cache_stats);
PRIMITIVE(inline_cache_stats);
PRIMITIVE(inline_cache_miss);
From 390712b00ab740715e8417edcf1c826d52e39281 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:19 +0100
Subject: [PATCH 104/266] removed some global functions from utilities.cpp
---
vm/utilities.cpp | 30 ------------------------------
vm/utilities.hpp | 8 --------
2 files changed, 38 deletions(-)
mode change 100644 => 100755 vm/utilities.hpp
diff --git a/vm/utilities.cpp b/vm/utilities.cpp
index ce17e8f526..a1e3f30e00 100755
--- a/vm/utilities.cpp
+++ b/vm/utilities.cpp
@@ -35,11 +35,6 @@ void factorvm::nl()
fputs("\n",stdout);
}
-void nl()
-{
- return vm->nl();
-}
-
void factorvm::print_string(const char *str)
{
fputs(str,stdout);
@@ -55,41 +50,21 @@ void factorvm::print_cell(cell x)
printf(CELL_FORMAT,x);
}
-void print_cell(cell x)
-{
- return vm->print_cell(x);
-}
-
void factorvm::print_cell_hex(cell x)
{
printf(CELL_HEX_FORMAT,x);
}
-void print_cell_hex(cell x)
-{
- return vm->print_cell_hex(x);
-}
-
void factorvm::print_cell_hex_pad(cell x)
{
printf(CELL_HEX_PAD_FORMAT,x);
}
-void print_cell_hex_pad(cell x)
-{
- return vm->print_cell_hex_pad(x);
-}
-
void factorvm::print_fixnum(fixnum x)
{
printf(FIXNUM_FORMAT,x);
}
-void print_fixnum(fixnum x)
-{
- return vm->print_fixnum(x);
-}
-
cell factorvm::read_cell_hex()
{
cell cell;
@@ -97,9 +72,4 @@ cell factorvm::read_cell_hex()
return cell;
}
-cell read_cell_hex()
-{
- return vm->read_cell_hex();
-};
-
}
diff --git a/vm/utilities.hpp b/vm/utilities.hpp
old mode 100644
new mode 100755
index 7e7765170e..bc7f7d918a
--- a/vm/utilities.hpp
+++ b/vm/utilities.hpp
@@ -1,15 +1,7 @@
namespace factor
{
-
void *safe_malloc(size_t size);
vm_char *safe_strdup(const vm_char *str);
-
-void nl();
void print_string(const char *str);
-void print_cell(cell x);
-void print_cell_hex(cell x);
-void print_cell_hex_pad(cell x);
-void print_fixnum(fixnum x);
-cell read_cell_hex();
}
From d3b5321b6e9a0cc92732987f24f312c5ec10f99e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:19 +0100
Subject: [PATCH 105/266] removed some global functions from errors.cpp
---
vm/errors.cpp | 25 -------------------------
vm/errors.hpp | 5 -----
2 files changed, 30 deletions(-)
mode change 100644 => 100755 vm/errors.hpp
diff --git a/vm/errors.cpp b/vm/errors.cpp
index 23833960e1..f2cab405a8 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -92,11 +92,6 @@ void factorvm::throw_error(cell error, stack_frame *callstack_top)
}
}
-void throw_error(cell error, stack_frame *callstack_top)
-{
- return vm->throw_error(error, callstack_top);
-}
-
void factorvm::general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top)
{
throw_error(allot_array_4(userenv[ERROR_ENV],
@@ -113,11 +108,6 @@ void factorvm::type_error(cell type, cell tagged)
general_error(ERROR_TYPE,tag_fixnum(type),tagged,NULL);
}
-void type_error(cell type, cell tagged)
-{
- return vm->type_error(type, tagged);
-}
-
void factorvm::not_implemented_error()
{
general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
@@ -139,11 +129,6 @@ bool factorvm::in_page(cell fault, cell area, cell area_size, int offset)
return fault >= area && fault <= area + pagesize;
}
-bool in_page(cell fault, cell area, cell area_size, int offset)
-{
- return vm->in_page(fault,area,area_size,offset);
-}
-
void factorvm::memory_protection_error(cell addr, stack_frame *native_stack)
{
if(in_page(addr, ds_bot, 0, -1))
@@ -160,21 +145,11 @@ void factorvm::memory_protection_error(cell addr, stack_frame *native_stack)
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
}
-void memory_protection_error(cell addr, stack_frame *native_stack)
-{
- return vm->memory_protection_error(addr,native_stack);
-}
-
void factorvm::signal_error(int signal, stack_frame *native_stack)
{
general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack);
}
-void signal_error(int signal, stack_frame *native_stack)
-{
- return vm->signal_error(signal, native_stack);
-}
-
void factorvm::divide_by_zero_error()
{
general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
diff --git a/vm/errors.hpp b/vm/errors.hpp
old mode 100644
new mode 100755
index 7f3c4dcd4a..69a90b70e2
--- a/vm/errors.hpp
+++ b/vm/errors.hpp
@@ -29,12 +29,7 @@ void critical_error(const char* msg, cell tagged);
PRIMITIVE(die);
-void throw_error(cell error, stack_frame *native_stack);
void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
-void divide_by_zero_error();
-void memory_protection_error(cell addr, stack_frame *native_stack);
-void signal_error(int signal, stack_frame *native_stack);
-void type_error(cell type, cell tagged);
void not_implemented_error();
void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
From 75a3db3bfb9dfa7459f8e5a04a1e562c62ecbf32 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 17 Aug 2009 21:37:19 +0100
Subject: [PATCH 106/266] Fixed typo from upstream
---
vm/vm.hpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index f259096766..0407185012 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -180,7 +180,7 @@ struct factorvm {
bool performing_compaction;
cell collecting_gen;
- /* if true, we collecting aging space for the second time, so if it is still
+ /* if true, we are collecting aging space for the second time, so if it is still
full, we go on to collect tenured */
bool collecting_aging_again;
From 97addbaf7a16866370a1192fea10281a5f19fac6 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 26 Aug 2009 16:05:50 +0100
Subject: [PATCH 107/266] got os-macosx.mm to compile
---
vm/os-macosx.mm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/vm/os-macosx.mm b/vm/os-macosx.mm
index 792ba0d541..c7e9c0bf6b 100644
--- a/vm/os-macosx.mm
+++ b/vm/os-macosx.mm
@@ -13,7 +13,7 @@ NS_DURING
c_to_factor(quot);
NS_VOIDRETURN;
NS_HANDLER
- dpush(allot_alien(F,(cell)localException));
+ dpush(vm->allot_alien(F,(cell)localException));
quot = userenv[COCOA_EXCEPTION_ENV];
if(!tagged<object>(quot).type_p(QUOTATION_TYPE))
{
From 7592a424e89ebabbea16063873537e5e26ff1e6b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 19:02:04 +0100
Subject: [PATCH 108/266] Dev checkpoint
---
vm/os-windows.cpp | 70 ++++++++++++++++++++++++++++++++++++++++-------
vm/vm.hpp | 18 ++++++++++--
2 files changed, 75 insertions(+), 13 deletions(-)
diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp
index 7db19ff560..8acd207058 100644
--- a/vm/os-windows.cpp
+++ b/vm/os-windows.cpp
@@ -5,29 +5,49 @@ namespace factor
HMODULE hFactorDll;
-void init_ffi()
+void factorvm::init_ffi()
{
hFactorDll = GetModuleHandle(FACTOR_DLL);
if(!hFactorDll)
fatal_error("GetModuleHandle(\"" FACTOR_DLL_NAME "\") failed", 0);
}
-void ffi_dlopen(dll *dll)
+void init_ffi()
+{
+ return vm->init_ffi();
+}
+
+void factorvm::ffi_dlopen(dll *dll)
{
dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0);
}
-void *ffi_dlsym(dll *dll, symbol_char *symbol)
+void ffi_dlopen(dll *dll)
+{
+ return vm->ffi_dlopen(dll);
+}
+
+void *factorvm::ffi_dlsym(dll *dll, symbol_char *symbol)
{
return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol);
}
-void ffi_dlclose(dll *dll)
+void *ffi_dlsym(dll *dll, symbol_char *symbol)
+{
+ return vm->ffi_dlsym(dll,symbol);
+}
+
+void factorvm::ffi_dlclose(dll *dll)
{
FreeLibrary((HMODULE)dll->dll);
dll->dll = NULL;
}
+void ffi_dlclose(dll *dll)
+{
+ return vm->ffi_dlclose(dll);
+}
+
bool windows_stat(vm_char *path)
{
BY_HANDLE_FILE_INFORMATION bhfi;
@@ -82,7 +102,7 @@ const vm_char *default_image_path()
}
/* You must free() this yourself. */
-const vm_char *vm_executable_path()
+const vm_char *factorvm::vm_executable_path()
{
vm_char full_path[MAX_UNICODE_PATH];
if(!GetModuleFileName(NULL, full_path, MAX_UNICODE_PATH))
@@ -90,14 +110,24 @@ const vm_char *vm_executable_path()
return safe_strdup(full_path);
}
+const vm_char *vm_executable_path()
+{
+ return vm->vm_executable_path();
+}
-PRIMITIVE(existsp)
+
+inline void factorvm::vmprim_existsp()
{
vm_char *path = untag_check<byte_array>(dpop())->data<vm_char>();
box_boolean(windows_stat(path));
}
-segment *alloc_segment(cell size)
+PRIMITIVE(existsp)
+{
+ PRIMITIVE_GETVM()->vmprim_existsp();
+}
+
+segment *factorvm::alloc_segment(cell size)
{
char *mem;
DWORD ignore;
@@ -122,7 +152,12 @@ segment *alloc_segment(cell size)
return block;
}
-void dealloc_segment(segment *block)
+segment *alloc_segment(cell size)
+{
+ return vm->alloc_segment(size);
+}
+
+void factorvm::dealloc_segment(segment *block)
{
SYSTEM_INFO si;
GetSystemInfo(&si);
@@ -131,7 +166,12 @@ void dealloc_segment(segment *block)
free(block);
}
-long getpagesize()
+void dealloc_segment(segment *block)
+{
+ return vm->dealloc_segment(block);
+}
+
+long factorvm::getpagesize()
{
static long g_pagesize = 0;
if (! g_pagesize)
@@ -143,9 +183,19 @@ long getpagesize()
return g_pagesize;
}
-void sleep_micros(u64 usec)
+long getpagesize()
+{
+ return vm->getpagesize();
+}
+
+void factorvm::sleep_micros(u64 usec)
{
Sleep((DWORD)(usec / 1000));
}
+void sleep_micros(u64 usec)
+{
+ return vm->sleep_micros(usec);
+}
+
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0407185012..3a22826137 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -503,7 +503,7 @@ struct factorvm {
void fixup_object_xts();
void compact_code_heap();
inline void check_code_pointer(cell ptr);
- // next method here:
+
//image
cell code_relocation_base;
@@ -645,8 +645,20 @@ struct factorvm {
cell read_cell_hex();
-
-
+ // os-windows
+#if defined(WINDOWS)
+ void init_ffi();
+ void ffi_dlopen(dll *dll);
+ void *ffi_dlsym(dll *dll, symbol_char *symbol);
+ void ffi_dlclose(dll *dll);
+ void sleep_micros(u64 usec);
+ long getpagesize();
+ void dealloc_segment(segment *block);
+ segment *alloc_segment(cell size);
+ const vm_char *vm_executable_path();
+ inline void vmprim_existsp();
+ // next method here:
+#endif
};
From aa58b54c2e99506827119d5425dc1c9f419f6da0 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 19:35:12 +0100
Subject: [PATCH 109/266] moved align_page into vm
---
vm/inlineimpls.hpp | 12 ++++++++++++
vm/segments.hpp | 5 -----
vm/vm.hpp | 3 +++
3 files changed, 15 insertions(+), 5 deletions(-)
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index 90ccd8d869..ca0b13be39 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -4,6 +4,18 @@ namespace factor
// I've had to copy inline implementations here to make dependencies work. Am hoping to move this code back into include files
// once the rest of the reentrant changes are done. -PD
+// segments.hpp
+
+inline cell factorvm::align_page(cell a)
+{
+ return align(a,getpagesize());
+}
+
+inline static cell align_page(cell a)
+{
+ return vm->align_page(a);
+}
+
// write_barrier.hpp
inline card *factorvm::addr_to_card(cell a)
diff --git a/vm/segments.hpp b/vm/segments.hpp
index 36b5bc747b..a715b4dabc 100644
--- a/vm/segments.hpp
+++ b/vm/segments.hpp
@@ -7,9 +7,4 @@ struct segment {
cell end;
};
-inline static cell align_page(cell a)
-{
- return align(a,getpagesize());
-}
-
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 3a22826137..9ee5a2d81f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -3,6 +3,9 @@ namespace factor
struct factorvm {
+ // segments
+ inline cell align_page(cell a);
+
// contexts
cell ds_size, rs_size;
context *unused_contexts;
From 7cebe088a16e7ddab668a055cb4b704650ffd7e7 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 19:52:11 +0100
Subject: [PATCH 110/266] moved some os-windows functions into the vm
---
vm/os-windows.cpp | 52 ++++-------------------------------------------
vm/os-windows.hpp | 9 --------
vm/vm.hpp | 3 +++
3 files changed, 7 insertions(+), 57 deletions(-)
diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp
index 8acd207058..38c8b944a4 100644
--- a/vm/os-windows.cpp
+++ b/vm/os-windows.cpp
@@ -12,43 +12,23 @@ void factorvm::init_ffi()
fatal_error("GetModuleHandle(\"" FACTOR_DLL_NAME "\") failed", 0);
}
-void init_ffi()
-{
- return vm->init_ffi();
-}
-
void factorvm::ffi_dlopen(dll *dll)
{
dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0);
}
-void ffi_dlopen(dll *dll)
-{
- return vm->ffi_dlopen(dll);
-}
-
void *factorvm::ffi_dlsym(dll *dll, symbol_char *symbol)
{
return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol);
}
-void *ffi_dlsym(dll *dll, symbol_char *symbol)
-{
- return vm->ffi_dlsym(dll,symbol);
-}
-
void factorvm::ffi_dlclose(dll *dll)
{
FreeLibrary((HMODULE)dll->dll);
dll->dll = NULL;
}
-void ffi_dlclose(dll *dll)
-{
- return vm->ffi_dlclose(dll);
-}
-
-bool windows_stat(vm_char *path)
+bool factorvm::windows_stat(vm_char *path)
{
BY_HANDLE_FILE_INFORMATION bhfi;
HANDLE h = CreateFileW(path,
@@ -76,14 +56,15 @@ bool windows_stat(vm_char *path)
return ret;
}
-void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
+
+void factorvm::windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
{
snwprintf(temp_path, length-1, L"%s.image", full_path);
temp_path[sizeof(temp_path) - 1] = 0;
}
/* You must free() this yourself. */
-const vm_char *default_image_path()
+const vm_char *factorvm::default_image_path()
{
vm_char full_path[MAX_UNICODE_PATH];
vm_char *ptr;
@@ -110,11 +91,6 @@ const vm_char *factorvm::vm_executable_path()
return safe_strdup(full_path);
}
-const vm_char *vm_executable_path()
-{
- return vm->vm_executable_path();
-}
-
inline void factorvm::vmprim_existsp()
{
@@ -152,11 +128,6 @@ segment *factorvm::alloc_segment(cell size)
return block;
}
-segment *alloc_segment(cell size)
-{
- return vm->alloc_segment(size);
-}
-
void factorvm::dealloc_segment(segment *block)
{
SYSTEM_INFO si;
@@ -166,11 +137,6 @@ void factorvm::dealloc_segment(segment *block)
free(block);
}
-void dealloc_segment(segment *block)
-{
- return vm->dealloc_segment(block);
-}
-
long factorvm::getpagesize()
{
static long g_pagesize = 0;
@@ -183,19 +149,9 @@ long factorvm::getpagesize()
return g_pagesize;
}
-long getpagesize()
-{
- return vm->getpagesize();
-}
-
void factorvm::sleep_micros(u64 usec)
{
Sleep((DWORD)(usec / 1000));
}
-void sleep_micros(u64 usec)
-{
- return vm->sleep_micros(usec);
-}
-
}
diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp
index 27e2775289..e5617213f4 100644
--- a/vm/os-windows.hpp
+++ b/vm/os-windows.hpp
@@ -41,18 +41,9 @@ typedef wchar_t vm_char;
/* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */
#define EPOCH_OFFSET 0x019db1ded53e8000LL
-void init_ffi();
-void ffi_dlopen(dll *dll);
-void *ffi_dlsym(dll *dll, symbol_char *symbol);
-void ffi_dlclose(dll *dll);
-
-void sleep_micros(u64 msec);
inline static void init_signals() {}
inline static void early_init() {}
-const vm_char *vm_executable_path();
-const vm_char *default_image_path();
-long getpagesize ();
s64 current_micros();
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 9ee5a2d81f..4257d17fd9 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -660,6 +660,9 @@ struct factorvm {
segment *alloc_segment(cell size);
const vm_char *vm_executable_path();
inline void vmprim_existsp();
+ const vm_char *default_image_path();
+ void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length);
+ bool windows_stat(vm_char *path);
// next method here:
#endif
From 01ecb1163595c1cee0100fd2f5a7e6d0c87a5b26 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 20:03:11 +0100
Subject: [PATCH 111/266] Dev checkpoint
---
vm/os-windows-nt.cpp | 18 ++++++++++++++++--
vm/vm.hpp | 18 +++++++++++++++---
2 files changed, 31 insertions(+), 5 deletions(-)
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index b50c9b7af8..8a8b2132ad 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-s64 current_micros()
+s64 factorvm::current_micros()
{
FILETIME t;
GetSystemTimeAsFileTime(&t);
@@ -11,6 +11,11 @@ s64 current_micros()
- EPOCH_OFFSET) / 10;
}
+s64 current_micros()
+{
+ return vm->current_micros();
+}
+
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
@@ -58,7 +63,7 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
return EXCEPTION_CONTINUE_EXECUTION;
}
-void c_to_factor_toplevel(cell quot)
+void factorvm::c_to_factor_toplevel(cell quot)
{
if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
fatal_error("AddVectoredExceptionHandler failed", 0);
@@ -66,6 +71,15 @@ void c_to_factor_toplevel(cell quot)
RemoveVectoredExceptionHandler((void *)exception_handler);
}
+void c_to_factor_toplevel(cell quot)
+{
+ return vm->c_to_factor_toplevel(quot);
+}
+
+void factorvm::open_console()
+{
+}
+
void open_console()
{
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 4257d17fd9..fa4c365da6 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -649,7 +649,7 @@ struct factorvm {
// os-windows
-#if defined(WINDOWS)
+ #if defined(WINDOWS)
void init_ffi();
void ffi_dlopen(dll *dll);
void *ffi_dlsym(dll *dll, symbol_char *symbol);
@@ -663,8 +663,20 @@ struct factorvm {
const vm_char *default_image_path();
void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length);
bool windows_stat(vm_char *path);
- // next method here:
-#endif
+
+ #if defined(WINCE)
+ #else /* WINNT */
+ s64 current_micros();
+ void c_to_factor_toplevel(cell quot);
+ void open_console();
+ // next method here:
+ #endif
+
+
+ #ifdef FACTOR_X86
+ #endif
+
+ #endif
};
From d48dffcfa023e85f1496a8312661c870c1815187 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 20:22:11 +0100
Subject: [PATCH 112/266] moved os-windows-nt functions into the vm
---
vm/os-windows-nt.cpp | 14 --------------
vm/os-windows-nt.hpp | 2 --
vm/vm.hpp | 10 ++--------
3 files changed, 2 insertions(+), 24 deletions(-)
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 8a8b2132ad..26781ee4f9 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -11,11 +11,6 @@ s64 factorvm::current_micros()
- EPOCH_OFFSET) / 10;
}
-s64 current_micros()
-{
- return vm->current_micros();
-}
-
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
@@ -71,17 +66,8 @@ void factorvm::c_to_factor_toplevel(cell quot)
RemoveVectoredExceptionHandler((void *)exception_handler);
}
-void c_to_factor_toplevel(cell quot)
-{
- return vm->c_to_factor_toplevel(quot);
-}
-
void factorvm::open_console()
{
}
-void open_console()
-{
-}
-
}
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index 088103bb5b..c083844ae0 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -19,9 +19,7 @@ typedef char symbol_char;
#define FACTOR_STDCALL __attribute__((stdcall))
-void c_to_factor_toplevel(cell quot);
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
-void open_console();
// SSE traps raise these exception codes, which are defined in internal NT headers
// but not winbase.h
diff --git a/vm/vm.hpp b/vm/vm.hpp
index fa4c365da6..9af0c5c8f9 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -664,18 +664,12 @@ struct factorvm {
void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length);
bool windows_stat(vm_char *path);
- #if defined(WINCE)
- #else /* WINNT */
+ #if defined(WINNT)
s64 current_micros();
void c_to_factor_toplevel(cell quot);
void open_console();
// next method here:
- #endif
-
-
- #ifdef FACTOR_X86
- #endif
-
+ #endif
#endif
};
From a5f24c8fb99b4959e3d93c741b2d77d3e9eeb3e7 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 20:40:26 +0100
Subject: [PATCH 113/266] added VM relocation type
---
basis/compiler/constants/constants.factor | 1 +
vm/code_block.cpp | 3 +++
vm/code_block.hpp | 2 ++
vm/master.hpp | 2 +-
4 files changed, 7 insertions(+), 1 deletion(-)
diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index b795862970..cc6003b89c 100644
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -50,6 +50,7 @@ CONSTANT: rt-immediate 8
CONSTANT: rt-stack-chain 9
CONSTANT: rt-untagged 10
CONSTANT: rt-megamorphic-cache-hits 11
+CONSTANT: rt-vm 12
: rc-absolute? ( n -- ? )
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index f19759fb0e..a64a8d2c2d 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -44,6 +44,7 @@ int factorvm::number_of_parameters(relocation_type type)
case RT_THIS:
case RT_STACK_CHAIN:
case RT_MEGAMORPHIC_CACHE_HITS:
+ case RT_VM:
return 0;
default:
critical_error("Bad rel type",type);
@@ -186,6 +187,8 @@ cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *
return untag_fixnum(ARG);
case RT_MEGAMORPHIC_CACHE_HITS:
return (cell)&megamorphic_cache_hits;
+ case RT_VM:
+ return (cell)this;
default:
critical_error("Bad rel type",rel);
return 0; /* Can't happen */
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index 60046ed380..50d937f4af 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -26,6 +26,8 @@ enum relocation_type {
RT_UNTAGGED,
/* address of megamorphic_cache_hits var */
RT_MEGAMORPHIC_CACHE_HITS,
+ /* address of vm object*/
+ RT_VM,
};
enum relocation_class {
diff --git a/vm/master.hpp b/vm/master.hpp
index bf60d1e4f6..c5c14e6999 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -35,8 +35,8 @@
/* Factor headers */
#include "layouts.hpp"
-#include "platform.hpp"
#include "primitives.hpp"
+#include "platform.hpp"
#include "stacks.hpp"
#include "segments.hpp"
#include "contexts.hpp"
From 57011aed515ea1bcb10213b9ce417c04c42ebae1 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 20:49:22 +0100
Subject: [PATCH 114/266] vm ptr passed to primitives on X86.32 (other cpus
still use singleton vm ptr)
---
basis/cpu/x86/32/bootstrap.factor | 2 ++
vm/cpu-x86.32.hpp | 1 -
vm/master.hpp | 2 +-
vm/primitives.hpp | 14 ++++++++++----
4 files changed, 13 insertions(+), 6 deletions(-)
diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index 674cc817d7..da55ea5ccd 100644
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -27,6 +27,8 @@ IN: bootstrap.x86
temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
! save stack pointer
temp0 [] stack-reg MOV
+ ! pass vm ptr to primitive
+ EAX 0 MOV rc-absolute-cell rt-vm jit-rel
! call the primitive
0 JMP rc-relative rt-primitive jit-rel
] jit-primitive jit-define
diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp
index 902b33b0b4..351865f776 100644
--- a/vm/cpu-x86.32.hpp
+++ b/vm/cpu-x86.32.hpp
@@ -7,5 +7,4 @@ register cell ds asm("esi");
register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
-
}
diff --git a/vm/master.hpp b/vm/master.hpp
index c5c14e6999..bf60d1e4f6 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -35,8 +35,8 @@
/* Factor headers */
#include "layouts.hpp"
-#include "primitives.hpp"
#include "platform.hpp"
+#include "primitives.hpp"
#include "stacks.hpp"
#include "segments.hpp"
#include "contexts.hpp"
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index c7534ec1cc..c6d704ffc7 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -1,9 +1,15 @@
namespace factor
{
-extern "C" typedef void (*primitive_type)();
-extern const primitive_type primitives[];
+#if defined(FACTOR_X86)
+ extern "C" __attribute__ ((regparm (1))) typedef void (*primitive_type)(void *myvm);
+ #define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm)
+ #define PRIMITIVE_GETVM() ((factorvm*)myvm)
+#else
+ extern "C" typedef void (*primitive_type)(void *myvm);
+ #define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm)
+ #define PRIMITIVE_GETVM() vm
+#endif
-#define PRIMITIVE(name) extern "C" void primitive_##name()
-#define PRIMITIVE_GETVM() vm
+extern const primitive_type primitives[];
}
From 6a193bb0d54d8728576aa0ca670ff7d02920fec3 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 18 Aug 2009 21:03:22 +0100
Subject: [PATCH 115/266] Added %vm-invoke to pass vm ptr to vm functions
(x86.32 only, otherwise uses singleton vm)
---
basis/cpu/architecture/architecture.factor | 2 ++
basis/cpu/x86/32/32.factor | 6 ++++++
basis/cpu/x86/64/64.factor | 2 ++
basis/cpu/x86/x86.factor | 2 +-
vm/cpu-x86.32.hpp | 2 ++
vm/data_gc.cpp | 6 +++---
vm/data_gc.hpp | 4 ++--
7 files changed, 18 insertions(+), 6 deletions(-)
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index d6611c3384..da1bcfc61f 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -297,6 +297,8 @@ M: object %prepare-var-args ;
HOOK: %alien-invoke cpu ( function library -- )
+HOOK: %vm-invoke cpu ( function library -- )
+
HOOK: %cleanup cpu ( params -- )
M: object %cleanup ( params -- ) drop ;
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 9939154512..3ec08d5507 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -47,6 +47,12 @@ M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
+M: x86.32 %vm-invoke
+ temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as the 3rd argument
+ temp-reg PUSH
+ %alien-invoke
+ temp-reg POP ;
+
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
[ return-in-registers?>> ]
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index f4018b1508..4d041d2334 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -172,6 +172,8 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
+M: x86.64 %vm-invoke %alien-invoke ;
+
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
RBP RAX MOV ;
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 27b6667c05..da391f6320 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -610,7 +610,7 @@ M:: x86 %call-gc ( gc-root-count -- )
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Call GC
- "inline_gc" f %alien-invoke ;
+ "inline_gc" f %vm-invoke ;
M: x86 %alien-global
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp
index 351865f776..28f2e2978e 100644
--- a/vm/cpu-x86.32.hpp
+++ b/vm/cpu-x86.32.hpp
@@ -7,4 +7,6 @@ register cell ds asm("esi");
register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
+#undef VM_PTR
+#define VM_PTR myvm
}
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index dfc1067690..5a7f34ca4b 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -694,7 +694,7 @@ PRIMITIVE(become)
PRIMITIVE_GETVM()->vmprim_become();
}
-VM_ASM_API void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
+void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
{
for(cell i = 0; i < gc_roots_size; i++)
gc_locals.push_back((cell)&gc_roots_base[i]);
@@ -705,9 +705,9 @@ VM_ASM_API void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
gc_locals.pop_back();
}
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factorvm *myvm)
{
- return vm->inline_gc(gc_roots_base,gc_roots_size);
+ return VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
}
}
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 950990a91b..84c824d779 100755
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -19,7 +19,7 @@ PRIMITIVE(gc);
PRIMITIVE(gc_stats);
PRIMITIVE(clear_gc_stats);
PRIMITIVE(become);
-
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
+struct factorvm;
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factorvm *myvm);
}
From 4afc16e95b853b3f9e3a9e0a70c428330b29a222 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 19 Aug 2009 19:02:12 +0100
Subject: [PATCH 116/266] passing vm ptr to lazy_jit_compile mostly working
---
basis/cpu/x86/32/32.factor | 1 +
basis/cpu/x86/32/bootstrap.factor | 1 +
basis/cpu/x86/64/unix/bootstrap.factor | 1 +
basis/cpu/x86/64/winnt/bootstrap.factor | 1 +
basis/cpu/x86/bootstrap.factor | 2 ++
vm/cpu-ppc.hpp | 6 +++---
vm/cpu-x86.S | 13 +++++++++----
vm/cpu-x86.hpp | 4 ++--
vm/os-genunix.cpp | 2 +-
vm/os-macosx.mm | 2 +-
vm/os-windows-ce.cpp | 2 +-
vm/os-windows-nt.cpp | 2 +-
vm/quotations.cpp | 2 +-
vm/quotations.hpp | 2 +-
14 files changed, 26 insertions(+), 15 deletions(-)
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 3ec08d5507..a48528d3fd 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -240,6 +240,7 @@ M: x86.32 %alien-callback ( quot -- )
4 [
EAX swap %load-reference
EAX PUSH
+ param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup
"c_to_factor" f %alien-invoke
] with-aligned-stack ;
diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index da55ea5ccd..afa7c245a0 100644
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -12,6 +12,7 @@ IN: bootstrap.x86
: div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ;
: arg ( -- reg ) EAX ;
+: arg2 ( -- reg ) EDX ;
: temp0 ( -- reg ) EAX ;
: temp1 ( -- reg ) EDX ;
: temp2 ( -- reg ) ECX ;
diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor
index b6d56840e2..199fe8daf4 100644
--- a/basis/cpu/x86/64/unix/bootstrap.factor
+++ b/basis/cpu/x86/64/unix/bootstrap.factor
@@ -6,6 +6,7 @@ IN: bootstrap.x86
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
: arg ( -- reg ) RDI ;
+: arg2 ( -- reg ) RSI ;
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
call
diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor
index 0228082956..72b9d27ca4 100644
--- a/basis/cpu/x86/64/winnt/bootstrap.factor
+++ b/basis/cpu/x86/64/winnt/bootstrap.factor
@@ -7,6 +7,7 @@ IN: bootstrap.x86
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
: arg ( -- reg ) RCX ;
+: arg2 ( -- reg ) RDX ;
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
call
diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index 0dafc3d9c4..8949b24b1a 100644
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -251,6 +251,8 @@ big-endian off
arg ds-reg [] MOV
! pop stack
ds-reg bootstrap-cell SUB
+ ! pass vm pointer
+ arg2 0 MOV rc-absolute-cell rt-vm jit-rel
! call quotation
arg quot-xt-offset [+] JMP
] \ (call) define-sub-primitive
diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp
index 2124e03350..495eb375ec 100644
--- a/vm/cpu-ppc.hpp
+++ b/vm/cpu-ppc.hpp
@@ -81,9 +81,9 @@ inline static unsigned int fpu_status(unsigned int status)
}
/* Defined in assembly */
-VM_ASM_API void c_to_factor(cell quot);
-VM_ASM_API void throw_impl(cell quot, stack_frame *rewind);
-VM_ASM_API void lazy_jit_compile(cell quot);
+VM_ASM_API void c_to_factor(cell quot, void *vm);
+VM_ASM_API void throw_impl(cell quot, stack_frame *rewind, void *vm);
+VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_ASM_API void flush_icache(cell start, cell len);
VM_ASM_API void set_callstack(stack_frame *to,
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index d229b2cb79..384bd794c5 100644
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -34,17 +34,19 @@ multiply_overflow:
mov ARITH_TEMP_2,ARG1
jmp MANGLE(overflow_fixnum_multiply)
-DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
+DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
PUSH_NONVOLATILE
mov ARG0,NV_TEMP_REG
-
+ //mov $35,ARG1
/* Create register shadow area for Win64 */
sub $32,STACK_REG
/* Save stack pointer */
lea -CELL_SIZE(STACK_REG),ARG0
+ push ARG1 /* save vm ptr */
call MANGLE(save_callstack_bottom)
-
+ pop ARG1
+
/* Call quot-xt */
mov NV_TEMP_REG,ARG0
call *QUOT_XT_OFFSET(ARG0)
@@ -65,10 +67,13 @@ DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
mov ARG1,STACK_REG
jmp *QUOT_XT_OFFSET(ARG0)
-DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot)):
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,NV_TEMP_REG /* stash vm ptr */
mov STACK_REG,ARG1 /* Save stack pointer */
sub $STACK_PADDING,STACK_REG
+ push NV_TEMP_REG /* push vm ptr as arg3 */
call MANGLE(lazy_jit_compile_impl)
+ pop NV_TEMP_REG
mov RETURN_REG,ARG0 /* No-op on 32-bit */
add $STACK_PADDING,STACK_REG
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp
index 4a37a17889..cf706a62b0 100644
--- a/vm/cpu-x86.hpp
+++ b/vm/cpu-x86.hpp
@@ -69,9 +69,9 @@ inline static unsigned int fpu_status(unsigned int status)
}
/* Defined in assembly */
-VM_ASM_API void c_to_factor(cell quot);
+VM_ASM_API void c_to_factor(cell quot,void *vm);
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
-VM_ASM_API void lazy_jit_compile(cell quot);
+VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_C_API void set_callstack(stack_frame *to,
stack_frame *from,
diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp
index 6cca455eb7..29c3e79859 100644
--- a/vm/os-genunix.cpp
+++ b/vm/os-genunix.cpp
@@ -5,7 +5,7 @@ namespace factor
void c_to_factor_toplevel(cell quot)
{
- c_to_factor(quot);
+ c_to_factor(quot,vm);
}
void init_signals()
diff --git a/vm/os-macosx.mm b/vm/os-macosx.mm
index c7e9c0bf6b..865371b8ac 100644
--- a/vm/os-macosx.mm
+++ b/vm/os-macosx.mm
@@ -10,7 +10,7 @@ void c_to_factor_toplevel(cell quot)
for(;;)
{
NS_DURING
- c_to_factor(quot);
+ c_to_factor(quot,vm);
NS_VOIDRETURN;
NS_HANDLER
dpush(vm->allot_alien(F,(cell)localException));
diff --git a/vm/os-windows-ce.cpp b/vm/os-windows-ce.cpp
index 2e69a1eb5b..a3192b07f5 100644
--- a/vm/os-windows-ce.cpp
+++ b/vm/os-windows-ce.cpp
@@ -37,7 +37,7 @@ PRIMITIVE(os_envs)
void c_to_factor_toplevel(cell quot)
{
- c_to_factor(quot);
+ c_to_factor(quot,vm);
}
void open_console() { }
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 26781ee4f9..535e7b8640 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -62,7 +62,7 @@ void factorvm::c_to_factor_toplevel(cell quot)
{
if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
fatal_error("AddVectoredExceptionHandler failed", 0);
- c_to_factor(quot);
+ c_to_factor(quot,this);
RemoveVectoredExceptionHandler((void *)exception_handler);
}
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index b7bce0bfd7..34fe6a12a6 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -368,7 +368,7 @@ cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
return quot.value();
}
-VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
+VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factorvm *myvm)
{
return vm->lazy_jit_compile_impl(quot_,stack);
}
diff --git a/vm/quotations.hpp b/vm/quotations.hpp
index 6c8b17db21..ae24a522f9 100755
--- a/vm/quotations.hpp
+++ b/vm/quotations.hpp
@@ -27,7 +27,7 @@ PRIMITIVE(jit_compile);
PRIMITIVE(array_to_quotation);
PRIMITIVE(quotation_xt);
-VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack);
+VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factorvm *myvm);
PRIMITIVE(quot_compiled_p);
From 465f06ebc24361566e0eba6cdb40b434a13d04c1 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 19 Aug 2009 19:40:09 +0100
Subject: [PATCH 117/266] throw_impl now forwards the vm ptr
---
basis/cpu/x86/bootstrap.factor | 2 +-
vm/cpu-x86.32.S | 13 +++++++++++++
vm/cpu-x86.64.S | 11 +++++++++++
vm/cpu-x86.S | 11 -----------
vm/cpu-x86.hpp | 2 +-
vm/errors.cpp | 4 ++--
vm/quotations.cpp | 2 +-
7 files changed, 29 insertions(+), 16 deletions(-)
diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index 8949b24b1a..5bc5272ab4 100644
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -252,7 +252,7 @@ big-endian off
! pop stack
ds-reg bootstrap-cell SUB
! pass vm pointer
- arg2 0 MOV rc-absolute-cell rt-vm jit-rel
+ arg2 0 MOV rc-absolute-cell rt-vm jit-rel
! call quotation
arg quot-xt-offset [+] JMP
] \ (call) define-sub-primitive
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 87a0e03f99..9d2bf082d1 100644
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -79,6 +79,19 @@ DEF(void,set_x87_env,(const void*)):
fldcw 2(%eax)
ret
+DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
+ mov CELL_SIZE(STACK_REG),NV_TEMP_REG /* stash vm ptr */
+ /* clear x87 stack, but preserve rounding mode and exception flags */
+ sub $2,STACK_REG
+ fnstcw (STACK_REG)
+ fninit
+ fldcw (STACK_REG)
+ /* rewind_to */
+ mov ARG1,STACK_REG
+ mov NV_TEMP_REG,ARG1
+ jmp *QUOT_XT_OFFSET(ARG0)
+
+
#include "cpu-x86.S"
#ifdef WINDOWS
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 0da360e675..606c81c582 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -88,6 +88,7 @@ DEF(void,primitive_inline_cache_miss_tail,(void)):
add $STACK_PADDING,%rsp
jmp *%rax
+<<<<<<< HEAD
DEF(void,get_sse_env,(void*)):
stmxcsr (%rdi)
ret
@@ -106,4 +107,14 @@ DEF(void,set_x87_env,(const void*)):
fldcw 2(%rdi)
ret
+DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
+ /* clear x87 stack, but preserve rounding mode and exception flags */
+ sub $2,STACK_REG
+ fnstcw (STACK_REG)
+ fninit
+ fldcw (STACK_REG)
+ /* rewind_to */
+ mov ARG1,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0)
+
#include "cpu-x86.S"
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index 384bd794c5..03f08fdabc 100644
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -37,7 +37,6 @@ multiply_overflow:
DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
PUSH_NONVOLATILE
mov ARG0,NV_TEMP_REG
- //mov $35,ARG1
/* Create register shadow area for Win64 */
sub $32,STACK_REG
@@ -57,16 +56,6 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
POP_NONVOLATILE
ret
-DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
- /* clear x87 stack, but preserve rounding mode and exception flags */
- sub $2,STACK_REG
- fnstcw (STACK_REG)
- fninit
- fldcw (STACK_REG)
- /* rewind_to */
- mov ARG1,STACK_REG
- jmp *QUOT_XT_OFFSET(ARG0)
-
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
mov ARG1,NV_TEMP_REG /* stash vm ptr */
mov STACK_REG,ARG1 /* Save stack pointer */
diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp
index cf706a62b0..8fe0cc4b10 100644
--- a/vm/cpu-x86.hpp
+++ b/vm/cpu-x86.hpp
@@ -70,7 +70,7 @@ inline static unsigned int fpu_status(unsigned int status)
/* Defined in assembly */
VM_ASM_API void c_to_factor(cell quot,void *vm);
-VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
+VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to, void *vm);
VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_C_API void set_callstack(stack_frame *to,
diff --git a/vm/errors.cpp b/vm/errors.cpp
index f2cab405a8..e1266cf608 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -78,7 +78,7 @@ void factorvm::throw_error(cell error, stack_frame *callstack_top)
else
callstack_top = stack_chain->callstack_top;
- throw_impl(userenv[BREAK_ENV],callstack_top);
+ throw_impl(userenv[BREAK_ENV],callstack_top,this);
}
/* Error was thrown in early startup before error handler is set, just
crash. */
@@ -167,7 +167,7 @@ void factorvm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_callst
inline void factorvm::vmprim_call_clear()
{
- throw_impl(dpop(),stack_chain->callstack_bottom);
+ throw_impl(dpop(),stack_chain->callstack_bottom,this);
}
PRIMITIVE(call_clear)
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 34fe6a12a6..9654e2eff3 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -370,7 +370,7 @@ cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factorvm *myvm)
{
- return vm->lazy_jit_compile_impl(quot_,stack);
+ return VM_PTR->lazy_jit_compile_impl(quot_,stack);
}
inline void factorvm::vmprim_quot_compiled_p()
From 25bbca2f66dd44dfa205a8e6122a39958cf5b77e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 18:57:04 +0100
Subject: [PATCH 118/266] removed save_stacks global function
---
vm/contexts.cpp | 5 -----
vm/contexts.hpp | 1 -
2 files changed, 6 deletions(-)
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 448351baf7..3d627ab050 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -35,11 +35,6 @@ void factorvm::save_stacks()
}
}
-void save_stacks()
-{
- return vm->save_stacks();
-}
-
context *factorvm::alloc_context()
{
context *new_context;
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 00d9646424..905d3d5b49 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -50,7 +50,6 @@ PRIMITIVE(set_datastack);
PRIMITIVE(set_retainstack);
PRIMITIVE(check_datastack);
-VM_C_API void save_stacks();
VM_C_API void nest_stacks();
VM_C_API void unnest_stacks();
From 9a37b6abb63149c7aadc68bc6a32b8568a0f8a53 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 19:20:48 +0100
Subject: [PATCH 119/266] moved stack_chain into vm struct
---
basis/cpu/x86/x86.factor | 4 ++--
vm/contexts.cpp | 2 --
vm/contexts.hpp | 1 -
vm/cpu-x86.64.S | 2 +-
vm/vm.hpp | 3 +++
5 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index da391f6320..798b67bc1a 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -612,7 +612,7 @@ M:: x86 %call-gc ( gc-root-count -- )
! Call GC
"inline_gc" f %vm-invoke ;
-M: x86 %alien-global
+M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
@@ -742,7 +742,7 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
- temp1 "stack_chain" f %alien-global
+ temp1 0 MOV rc-absolute-cell rt-vm rel-fixup ! stack-chain is first item in vm struct. TODO: make vm C-STRUCT
temp1 temp1 [] MOV
temp2 stack-reg cell neg [+] LEA
temp1 [] temp2 MOV
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 3d627ab050..f5c63f1e7f 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -1,7 +1,5 @@
#include "master.hpp"
-factor::context *stack_chain;
-
namespace factor
{
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 905d3d5b49..17f8a7eb70 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -55,4 +55,3 @@ VM_C_API void unnest_stacks();
}
-VM_C_API factor::context *stack_chain;
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 606c81c582..98addeb80d 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -88,7 +88,7 @@ DEF(void,primitive_inline_cache_miss_tail,(void)):
add $STACK_PADDING,%rsp
jmp *%rax
-<<<<<<< HEAD
+
DEF(void,get_sse_env,(void*)):
stmxcsr (%rdi)
ret
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 9af0c5c8f9..40be36b249 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -3,6 +3,9 @@ namespace factor
struct factorvm {
+ factor::context *stack_chain;
+
+
// segments
inline cell align_page(cell a);
From 88d31793580584773f7e5235f7a7eb8d6cddb483 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 19:39:40 +0100
Subject: [PATCH 120/266] Added a vm C-STRUCT, using it for struct offsets in
x86 asm
---
basis/cpu/x86/x86.factor | 13 +++++++++++--
basis/vm/authors.txt | 1 +
basis/vm/summary.txt | 1 +
basis/vm/vm.factor | 8 ++++++++
4 files changed, 21 insertions(+), 2 deletions(-)
create mode 100644 basis/vm/authors.txt
create mode 100644 basis/vm/summary.txt
create mode 100644 basis/vm/vm.factor
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 798b67bc1a..c142818c7f 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1,5 +1,6 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
+<<<<<<< HEAD
USING: accessors assocs alien alien.c-types arrays strings
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
cpu.architecture kernel kernel.private math memory namespaces make
@@ -12,6 +13,14 @@ compiler.cfg.comparisons
compiler.cfg.stack-frame
compiler.codegen
compiler.codegen.fixup ;
+=======
+USING: accessors alien combinators compiler.cfg.comparisons
+compiler.cfg.intrinsics compiler.cfg.registers
+compiler.cfg.stack-frame compiler.codegen.fixup compiler.constants
+cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands fry
+kernel layouts locals make math math.order namespaces sequences system
+vm ;
+>>>>>>> Added a vm C-STRUCT, using it for struct offsets in x86 asm
IN: cpu.x86
<< enable-fixnum-log2 >>
@@ -742,8 +751,8 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
- temp1 0 MOV rc-absolute-cell rt-vm rel-fixup ! stack-chain is first item in vm struct. TODO: make vm C-STRUCT
- temp1 temp1 [] MOV
+ temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ temp1 temp1 "stack_chain" vm-offset [+] MOV
temp2 stack-reg cell neg [+] LEA
temp1 [] temp2 MOV
callback-allowed? [
diff --git a/basis/vm/authors.txt b/basis/vm/authors.txt
new file mode 100644
index 0000000000..b125620d17
--- /dev/null
+++ b/basis/vm/authors.txt
@@ -0,0 +1 @@
+Phil Dawes
\ No newline at end of file
diff --git a/basis/vm/summary.txt b/basis/vm/summary.txt
new file mode 100644
index 0000000000..bfa1067bc7
--- /dev/null
+++ b/basis/vm/summary.txt
@@ -0,0 +1 @@
+Layout of the C vm structure
diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
new file mode 100644
index 0000000000..335f80918b
--- /dev/null
+++ b/basis/vm/vm.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2009 Phil Dawes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.structs alien.syntax ;
+IN: vm
+
+C-STRUCT: vm { "context*" "stack_chain" } ;
+
+: vm-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
From 0b0937cf0ebac8dc7f15727e2d2c29679d77aab6 Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@oberon.local>
Date: Sun, 30 Aug 2009 14:55:46 -0500
Subject: [PATCH 121/266] ppc asm to get stack_chain using vm ptr
---
basis/cpu/ppc/ppc.factor | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 9c829bc390..44309b15c6 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -7,7 +7,7 @@ cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.comparisons
compiler.codegen.fixup compiler.cfg.intrinsics
compiler.cfg.stack-frame compiler.cfg.build-stack-frame
-compiler.units compiler.constants compiler.codegen ;
+compiler.units compiler.constants compiler.codegen vm ;
FROM: cpu.ppc.assembler => B ;
IN: cpu.ppc
@@ -678,11 +678,18 @@ M: ppc %box-large-struct ( n c-type -- )
! Call the function
"box_value_struct" f %alien-invoke ;
+: %load-vm-addr ( reg -- )
+ 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ;
+
+: %load-vm-field-addr ( reg symbol -- )
+ [ drop %load-vm-addr ]
+ [ [ dup ] dip vm-offset ADDI ] 2bi ;
+
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
- temp1 "stack_chain" f %alien-global
+ temp1 "stack_chain" %load-vm-field-addr
temp1 temp1 0 LWZ
1 temp1 0 STW
callback-allowed? [
From 0be499de8aeee84ac2b17f545b145d3c148253b5 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 19:58:39 +0100
Subject: [PATCH 122/266] renamed to vm-field-offset. Slava's better at naming
than me
---
basis/cpu/ppc/ppc.factor | 2 +-
basis/cpu/x86/x86.factor | 2 +-
basis/vm/vm.factor | 2 +-
3 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 44309b15c6..8491a933db 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -683,7 +683,7 @@ M: ppc %box-large-struct ( n c-type -- )
: %load-vm-field-addr ( reg symbol -- )
[ drop %load-vm-addr ]
- [ [ dup ] dip vm-offset ADDI ] 2bi ;
+ [ [ dup ] dip vm-field-offset ADDI ] 2bi ;
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index c142818c7f..9222e63b7f 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -752,7 +752,7 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
#! callback which does a GC, which must reliably trace
#! all roots.
temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
- temp1 temp1 "stack_chain" vm-offset [+] MOV
+ temp1 temp1 "stack_chain" vm-field-offset [+] MOV
temp2 stack-reg cell neg [+] LEA
temp1 [] temp2 MOV
callback-allowed? [
diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
index 335f80918b..5ae82c1c7a 100644
--- a/basis/vm/vm.factor
+++ b/basis/vm/vm.factor
@@ -5,4 +5,4 @@ IN: vm
C-STRUCT: vm { "context*" "stack_chain" } ;
-: vm-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
+: vm-field-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
From c010afc34597d3dedb218cf13357f2cc24c8c094 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 20:20:35 +0100
Subject: [PATCH 123/266] nursery global variable moved into vm
---
basis/cpu/ppc/ppc.factor | 17 +++++++++--------
basis/cpu/x86/x86.factor | 3 ++-
basis/vm/vm.factor | 14 +++++++++++++-
vm/data_heap.cpp | 5 -----
vm/data_heap.hpp | 3 ---
vm/vm.hpp | 7 ++++---
6 files changed, 28 insertions(+), 21 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 8491a933db..a6d70f88e8 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -29,6 +29,14 @@ enable-float-intrinsics
\ ##float>integer t frame-required? set-word-prop
>>
+: %load-vm-addr ( reg -- )
+ 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ;
+
+: %load-vm-field-addr ( reg symbol -- )
+ [ drop %load-vm-addr ]
+ [ [ dup ] dip vm-field-offset ADDI ] 2bi ;
+
+
M: ppc machine-registers
{
{ int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
@@ -418,7 +426,7 @@ M: ppc %set-alien-float swap 0 STFS ;
M: ppc %set-alien-double swap 0 STFD ;
: load-zone-ptr ( reg -- )
- "nursery" f %alien-global ;
+ "nursery" %load-vm-field-addr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ;
@@ -678,13 +686,6 @@ M: ppc %box-large-struct ( n c-type -- )
! Call the function
"box_value_struct" f %alien-invoke ;
-: %load-vm-addr ( reg -- )
- 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ;
-
-: %load-vm-field-addr ( reg symbol -- )
- [ drop %load-vm-addr ]
- [ [ dup ] dip vm-field-offset ADDI ] 2bi ;
-
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 9222e63b7f..4f79f50f96 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -566,7 +566,8 @@ M: x86 %sar [ SAR ] emit-shift ;
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
- 0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
+ [ 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+ [ "nursery" vm-field-offset ADD ] bi ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
index 5ae82c1c7a..19d009f121 100644
--- a/basis/vm/vm.factor
+++ b/basis/vm/vm.factor
@@ -3,6 +3,18 @@
USING: alien.structs alien.syntax ;
IN: vm
-C-STRUCT: vm { "context*" "stack_chain" } ;
+TYPEDEF: void* cell
+
+C-STRUCT: zone
+ { "cell" "start" }
+ { "cell" "here" }
+ { "cell" "size" }
+ { "cell" "end" }
+ ;
+
+C-STRUCT: vm
+ { "context*" "stack_chain" }
+ { "zone" "nursery" }
+ ;
: vm-field-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index e790c63122..de3d8d87be 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -1,13 +1,8 @@
#include "master.hpp"
-factor::zone nursery;
-
namespace factor
{
-/* new objects are allocated here */
-VM_C_API zone nursery;
-
cell factorvm::init_zone(zone *z, cell size, cell start)
{
z->size = size;
diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp
index 88316ffd8d..7e6ff81e70 100755
--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@@ -66,6 +66,3 @@ PRIMITIVE(next_object);
PRIMITIVE(end_scan);
}
-
-/* new objects are allocated here */
-VM_C_API factor::zone nursery;
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 40be36b249..12f767404f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -2,9 +2,10 @@ namespace factor
{
struct factorvm {
-
- factor::context *stack_chain;
-
+ // if you change this struct, also change vm.factor
+ context *stack_chain;
+ /* new objects are allocated here */
+ zone nursery;
// segments
inline cell align_page(cell a);
From c6d855d494984df5879635feb7b6db68efb72b53 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 20:35:54 +0100
Subject: [PATCH 124/266] moved allot_markers_offset variable into vm struct
---
vm/vm.hpp | 2 ++
vm/write_barrier.cpp | 4 ----
vm/write_barrier.hpp | 1 -
3 files changed, 2 insertions(+), 5 deletions(-)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 12f767404f..7508abf5ea 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -7,6 +7,7 @@ struct factorvm {
/* new objects are allocated here */
zone nursery;
+
// segments
inline cell align_page(cell a);
@@ -169,6 +170,7 @@ struct factorvm {
//write barrier
+ cell allot_markers_offset;
inline card *addr_to_card(cell a);
inline cell card_to_addr(card *c);
inline cell card_offset(card *c);
diff --git a/vm/write_barrier.cpp b/vm/write_barrier.cpp
index 0e87434b56..7ce764722e 100644
--- a/vm/write_barrier.cpp
+++ b/vm/write_barrier.cpp
@@ -5,7 +5,3 @@ using namespace factor;
cell cards_offset;
cell decks_offset;
-namespace factor
-{
- cell allot_markers_offset;
-}
diff --git a/vm/write_barrier.hpp b/vm/write_barrier.hpp
index b45573b126..b2b370d274 100755
--- a/vm/write_barrier.hpp
+++ b/vm/write_barrier.hpp
@@ -29,6 +29,5 @@ 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);
static const cell invalid_allot_marker = 0xff;
-extern cell allot_markers_offset;
}
From 5bb04857bf681d47dfef1d524518bc665802a020 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 20 Aug 2009 20:45:06 +0100
Subject: [PATCH 125/266] moved cards_offset and decks_offset into vm struct
(for x86)
---
basis/cpu/ppc/ppc.factor | 4 ++--
basis/cpu/x86/x86.factor | 8 ++++++--
basis/vm/vm.factor | 2 ++
vm/vm.hpp | 6 +++---
vm/write_barrier.cpp | 2 --
vm/write_barrier.hpp | 3 ---
6 files changed, 13 insertions(+), 12 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index a6d70f88e8..37a5369259 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -449,10 +449,10 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
dst class store-tagged ;
: load-cards-offset ( dst -- )
- [ "cards_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
+ [ "cards_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
: load-decks-offset ( dst -- )
- [ "decks_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
+ [ "decks_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
M:: ppc %write-barrier ( src card# table -- )
card-mark scratch-reg LI
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 4f79f50f96..7e73275dde 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -587,18 +587,22 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
dst class store-tagged
nursery-ptr size inc-allot-ptr ;
+: %vm-field-ptr ( reg field -- )
+ [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+ [ vm-field-offset ADD ] 2bi ;
+
M:: x86 %write-barrier ( src card# table -- )
#! Mark the card pointed to by vreg.
! Mark the card
card# src MOV
card# card-bits SHR
- table "cards_offset" f %alien-global
+ table "cards_offset" %vm-field-ptr
table table [] MOV
table card# [+] card-mark <byte> MOV
! Mark the card deck
card# deck-bits card-bits - SHR
- table "decks_offset" f %alien-global
+ table "decks_offset" %vm-field-ptr
table table [] MOV
table card# [+] card-mark <byte> MOV ;
diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
index 19d009f121..655250d755 100644
--- a/basis/vm/vm.factor
+++ b/basis/vm/vm.factor
@@ -15,6 +15,8 @@ C-STRUCT: zone
C-STRUCT: vm
{ "context*" "stack_chain" }
{ "zone" "nursery" }
+ { "cell" "cards_offset" }
+ { "cell" "decks_offset" }
;
: vm-field-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 7508abf5ea..00a24e4502 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -4,9 +4,9 @@ namespace factor
struct factorvm {
// if you change this struct, also change vm.factor
context *stack_chain;
- /* new objects are allocated here */
- zone nursery;
-
+ zone nursery; /* new objects are allocated here */
+ cell cards_offset;
+ cell decks_offset;
// segments
inline cell align_page(cell a);
diff --git a/vm/write_barrier.cpp b/vm/write_barrier.cpp
index 7ce764722e..72879aab4b 100644
--- a/vm/write_barrier.cpp
+++ b/vm/write_barrier.cpp
@@ -2,6 +2,4 @@
using namespace factor;
-cell cards_offset;
-cell decks_offset;
diff --git a/vm/write_barrier.hpp b/vm/write_barrier.hpp
index b2b370d274..7c0241a31a 100755
--- a/vm/write_barrier.hpp
+++ b/vm/write_barrier.hpp
@@ -6,9 +6,6 @@ card has a slot written to.
the offset of the first object is set by the allocator. */
-VM_C_API factor::cell cards_offset;
-VM_C_API factor::cell decks_offset;
-
namespace factor
{
From 43787e2664c5e8dc38ba2f14a753fa3c20abc0a5 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 08:21:44 +0100
Subject: [PATCH 126/266] moved stack_traces_p into the vm
---
vm/code_block.hpp | 5 -----
vm/jit.cpp | 2 +-
vm/vm.hpp | 10 +++++++++-
3 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index 50d937f4af..17ccdfe8ab 100644
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -72,9 +72,4 @@ void copy_literal_references(code_block *compiled, factorvm *myvm);
void update_word_references(code_block *compiled, factorvm *myvm);
void update_literal_and_word_references(code_block *compiled, factorvm *myvm);
-inline bool stack_traces_p()
-{
- return userenv[STACK_TRACES_ENV] != F;
-}
-
}
diff --git a/vm/jit.cpp b/vm/jit.cpp
index 7177f26073..d474d23a18 100644
--- a/vm/jit.cpp
+++ b/vm/jit.cpp
@@ -21,7 +21,7 @@ jit::jit(cell type_, cell owner_, factorvm *vm)
offset(0),
myvm(vm)
{
- if(stack_traces_p()) literal(owner.value());
+ if(myvm->stack_traces_p()) literal(owner.value());
}
void jit::emit_relocation(cell code_template_)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 00a24e4502..88b323adf4 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -2,11 +2,15 @@ namespace factor
{
struct factorvm {
- // if you change this struct, also change vm.factor
+
+ // if you change this struct, also change vm.factor k--------
context *stack_chain;
zone nursery; /* new objects are allocated here */
cell cards_offset;
cell decks_offset;
+ // cell userenv[USER_ENV]; // prob best to put this last
+
+
// segments
inline cell align_page(cell a);
@@ -494,6 +498,10 @@ struct factorvm {
void fixup_labels(array *labels, code_block *compiled);
code_block *allot_code_block(cell size);
code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_);
+ inline bool stack_traces_p()
+ {
+ return userenv[STACK_TRACES_ENV] != F;
+ }
//code_heap
heap code;
From a4a4439fc54a44ad27f1bb3587fc3390846f9f01 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 18:33:04 +0100
Subject: [PATCH 127/266] got debug compiles working again
---
vm/code_block.cpp | 4 ++--
vm/tagged.hpp | 4 ++--
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index a64a8d2c2d..9eec4a2ea6 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -345,8 +345,8 @@ void copy_literal_references(code_block *compiled, factorvm *myvm)
void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
{
#ifdef FACTOR_DEBUG
- tagged<array>(compiled->literals).untag_check();
- tagged<byte_array>(compiled->relocation).untag_check();
+ tagged<array>(compiled->literals).untag_check(vm);
+ tagged<byte_array>(compiled->relocation).untag_check(vm);
#endif
store_address_in_code_block(relocation_class_of(rel),
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index 9f8a0eb411..b73f3aeb7a 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -37,13 +37,13 @@ struct tagged
explicit tagged(cell tagged) : value_(tagged) {
#ifdef FACTOR_DEBUG
- untag_check();
+ untag_check(vm);
#endif
}
explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
#ifdef FACTOR_DEBUG
- untag_check();
+ untag_check(vm);
#endif
}
From ef16c4be66727649ed66b16f1dc363868c6eebf3 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 19:27:40 +0100
Subject: [PATCH 128/266] moved userenv into vm in C code (DOESNT BOOTSTRAP
YET!!!)
---
vm/dispatch.cpp | 10 +++++-----
vm/inline_cache.cpp | 8 ++++----
vm/jit.cpp | 4 ++--
vm/jit.hpp | 8 ++++----
vm/quotations.cpp | 44 ++++++++++++++++++++++----------------------
vm/run.cpp | 2 --
vm/run.hpp | 3 +--
vm/vm.hpp | 3 +--
8 files changed, 39 insertions(+), 43 deletions(-)
diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp
index 85d92f90a0..e87cdeac70 100755
--- a/vm/dispatch.cpp
+++ b/vm/dispatch.cpp
@@ -207,21 +207,21 @@ void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cac
emit_class_lookup(index,PIC_HI_TAG_TUPLE);
/* Do a cache lookup. */
- emit_with(userenv[MEGA_LOOKUP],cache.value());
+ emit_with(myvm->userenv[MEGA_LOOKUP],cache.value());
/* If we end up here, the cache missed. */
- emit(userenv[JIT_PROLOG]);
+ emit(myvm->userenv[JIT_PROLOG]);
/* Push index, method table and cache on the stack. */
push(methods.value());
push(tag_fixnum(index));
push(cache.value());
- word_call(userenv[MEGA_MISS_WORD]);
+ word_call(myvm->userenv[MEGA_MISS_WORD]);
/* Now the new method has been stored into the cache, and its on
the stack. */
- emit(userenv[JIT_EPILOG]);
- emit(userenv[JIT_EXECUTE_JUMP]);
+ emit(myvm->userenv[JIT_EPILOG]);
+ emit(myvm->userenv[JIT_EXECUTE_JUMP]);
}
}
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index 24008cae79..35479c29f5 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -89,9 +89,9 @@ void inline_cache_jit::emit_check(cell klass)
{
cell code_template;
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)
- code_template = userenv[PIC_CHECK_TAG];
+ code_template = myvm->userenv[PIC_CHECK_TAG];
else
- code_template = userenv[PIC_CHECK];
+ code_template = myvm->userenv[PIC_CHECK];
emit_with(code_template,klass);
}
@@ -124,7 +124,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
/* Yes? Jump to method */
cell method = array_nth(cache_entries.untagged(),i + 1);
- emit_with(userenv[PIC_HIT],method);
+ emit_with(myvm->userenv[PIC_HIT],method);
}
/* Generate machine code to handle a cache miss, which ultimately results in
@@ -136,7 +136,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
- word_special(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
+ word_special(myvm->userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
}
code_block *factorvm::compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
diff --git a/vm/jit.cpp b/vm/jit.cpp
index d474d23a18..cdb5acace3 100644
--- a/vm/jit.cpp
+++ b/vm/jit.cpp
@@ -81,8 +81,8 @@ void jit::emit_with(cell code_template_, cell argument_) {
void jit::emit_class_lookup(fixnum index, cell type)
{
- emit_with(userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
- emit(userenv[type]);
+ emit_with(myvm->userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
+ emit(myvm->userenv[type]);
}
/* Facility to convert compiled code offsets to quotation offsets.
diff --git a/vm/jit.hpp b/vm/jit.hpp
index 81754be26a..a44f359ffe 100644
--- a/vm/jit.hpp
+++ b/vm/jit.hpp
@@ -22,21 +22,21 @@ struct jit {
void emit_with(cell code_template_, cell literal_);
void push(cell literal) {
- emit_with(userenv[JIT_PUSH_IMMEDIATE],literal);
+ emit_with(myvm->userenv[JIT_PUSH_IMMEDIATE],literal);
}
void word_jump(cell word) {
literal(tag_fixnum(xt_tail_pic_offset));
literal(word);
- emit(userenv[JIT_WORD_JUMP]);
+ emit(myvm->userenv[JIT_WORD_JUMP]);
}
void word_call(cell word) {
- emit_with(userenv[JIT_WORD_CALL],word);
+ emit_with(myvm->userenv[JIT_WORD_CALL],word);
}
void word_special(cell word) {
- emit_with(userenv[JIT_WORD_SPECIAL],word);
+ emit_with(myvm->userenv[JIT_WORD_SPECIAL],word);
}
void emit_subprimitive(cell word_) {
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 9654e2eff3..7b03ada175 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -40,7 +40,7 @@ bool quotation_jit::primitive_call_p(cell i)
{
return (i + 2) == array_capacity(elements.untagged())
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(FIXNUM_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_PRIMITIVE_WORD];
+ && array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_PRIMITIVE_WORD];
}
bool quotation_jit::fast_if_p(cell i)
@@ -48,28 +48,28 @@ bool quotation_jit::fast_if_p(cell i)
return (i + 3) == array_capacity(elements.untagged())
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
&& tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 2) == userenv[JIT_IF_WORD];
+ && array_nth(elements.untagged(),i + 2) == myvm->userenv[JIT_IF_WORD];
}
bool quotation_jit::fast_dip_p(cell i)
{
return (i + 2) <= array_capacity(elements.untagged())
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_DIP_WORD];
+ && array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_DIP_WORD];
}
bool quotation_jit::fast_2dip_p(cell i)
{
return (i + 2) <= array_capacity(elements.untagged())
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_2DIP_WORD];
+ && array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_2DIP_WORD];
}
bool quotation_jit::fast_3dip_p(cell i)
{
return (i + 2) <= array_capacity(elements.untagged())
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_3DIP_WORD];
+ && array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_3DIP_WORD];
}
bool quotation_jit::mega_lookup_p(cell i)
@@ -78,7 +78,7 @@ bool quotation_jit::mega_lookup_p(cell i)
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(ARRAY_TYPE)
&& tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE)
&& tagged<object>(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE)
- && array_nth(elements.untagged(),i + 3) == userenv[MEGA_LOOKUP_WORD];
+ && array_nth(elements.untagged(),i + 3) == myvm->userenv[MEGA_LOOKUP_WORD];
}
bool quotation_jit::stack_frame_p()
@@ -115,7 +115,7 @@ void quotation_jit::iterate_quotation()
set_position(0);
if(stack_frame)
- emit(userenv[JIT_PROLOG]);
+ emit(myvm->userenv[JIT_PROLOG]);
cell i;
cell length = array_capacity(elements.untagged());
@@ -134,23 +134,23 @@ void quotation_jit::iterate_quotation()
if(obj.as<word>()->subprimitive != F)
emit_subprimitive(obj.value());
/* The (execute) primitive is special-cased */
- else if(obj.value() == userenv[JIT_EXECUTE_WORD])
+ else if(obj.value() == myvm->userenv[JIT_EXECUTE_WORD])
{
if(i == length - 1)
{
- if(stack_frame) emit(userenv[JIT_EPILOG]);
+ if(stack_frame) emit(myvm->userenv[JIT_EPILOG]);
tail_call = true;
- emit(userenv[JIT_EXECUTE_JUMP]);
+ emit(myvm->userenv[JIT_EXECUTE_JUMP]);
}
else
- emit(userenv[JIT_EXECUTE_CALL]);
+ emit(myvm->userenv[JIT_EXECUTE_CALL]);
}
/* Everything else */
else
{
if(i == length - 1)
{
- if(stack_frame) emit(userenv[JIT_EPILOG]);
+ if(stack_frame) emit(myvm->userenv[JIT_EPILOG]);
tail_call = true;
/* Inline cache misses are special-cased.
The calling convention for tail
@@ -160,8 +160,8 @@ void quotation_jit::iterate_quotation()
the inline cache miss primitive, and
we don't want to clobber the saved
address. */
- if(obj.value() == userenv[PIC_MISS_WORD]
- || obj.value() == userenv[PIC_MISS_TAIL_WORD])
+ if(obj.value() == myvm->userenv[PIC_MISS_WORD]
+ || obj.value() == myvm->userenv[PIC_MISS_TAIL_WORD])
{
word_special(obj.value());
}
@@ -181,7 +181,7 @@ void quotation_jit::iterate_quotation()
/* Primitive calls */
if(primitive_call_p(i))
{
- emit_with(userenv[JIT_PRIMITIVE],obj.value());
+ emit_with(myvm->userenv[JIT_PRIMITIVE],obj.value());
i++;
@@ -193,7 +193,7 @@ void quotation_jit::iterate_quotation()
mutually recursive in the library, but both still work) */
if(fast_if_p(i))
{
- if(stack_frame) emit(userenv[JIT_EPILOG]);
+ if(stack_frame) emit(myvm->userenv[JIT_EPILOG]);
tail_call = true;
if(compiling)
@@ -204,7 +204,7 @@ void quotation_jit::iterate_quotation()
literal(array_nth(elements.untagged(),i));
literal(array_nth(elements.untagged(),i + 1));
- emit(userenv[JIT_IF]);
+ emit(myvm->userenv[JIT_IF]);
i += 2;
@@ -215,7 +215,7 @@ void quotation_jit::iterate_quotation()
{
if(compiling)
myvm->jit_compile(obj.value(),relocate);
- emit_with(userenv[JIT_DIP],obj.value());
+ emit_with(myvm->userenv[JIT_DIP],obj.value());
i++;
break;
}
@@ -224,7 +224,7 @@ void quotation_jit::iterate_quotation()
{
if(compiling)
myvm->jit_compile(obj.value(),relocate);
- emit_with(userenv[JIT_2DIP],obj.value());
+ emit_with(myvm->userenv[JIT_2DIP],obj.value());
i++;
break;
}
@@ -233,7 +233,7 @@ void quotation_jit::iterate_quotation()
{
if(compiling)
myvm->jit_compile(obj.value(),relocate);
- emit_with(userenv[JIT_3DIP],obj.value());
+ emit_with(myvm->userenv[JIT_3DIP],obj.value());
i++;
break;
}
@@ -260,8 +260,8 @@ void quotation_jit::iterate_quotation()
set_position(length);
if(stack_frame)
- emit(userenv[JIT_EPILOG]);
- emit(userenv[JIT_RETURN]);
+ emit(myvm->userenv[JIT_EPILOG]);
+ emit(myvm->userenv[JIT_RETURN]);
}
}
diff --git a/vm/run.cpp b/vm/run.cpp
index f8c099bbfd..1d670e3625 100755
--- a/vm/run.cpp
+++ b/vm/run.cpp
@@ -1,7 +1,5 @@
#include "master.hpp"
-factor::cell userenv[USER_ENV];
-
namespace factor
{
diff --git a/vm/run.hpp b/vm/run.hpp
index 4b43a156e4..d10a6678b8 100755
--- a/vm/run.hpp
+++ b/vm/run.hpp
@@ -109,5 +109,4 @@ PRIMITIVE(clone);
}
-/* TAGGED user environment data; see getenv/setenv prims */
-VM_C_API factor::cell userenv[USER_ENV];
+
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 88b323adf4..967956e0cf 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -8,8 +8,7 @@ struct factorvm {
zone nursery; /* new objects are allocated here */
cell cards_offset;
cell decks_offset;
- // cell userenv[USER_ENV]; // prob best to put this last
-
+ cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
// segments
From 3b3ed501c773e336e5fd184a913f7213fa306981 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 19:54:47 +0100
Subject: [PATCH 129/266] added padding to align userenv to an 8byte boundary
---
vm/vm.hpp | 1 +
1 file changed, 1 insertion(+)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 967956e0cf..e0b598de6f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -8,6 +8,7 @@ struct factorvm {
zone nursery; /* new objects are allocated here */
cell cards_offset;
cell decks_offset;
+ cell __padding__ ; // align to 8byte boundary (for 32bit platforms)
cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
From ff8f2b10ece80f628b4055a656b714d0e573576c Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 20:13:49 +0100
Subject: [PATCH 130/266] fixed up getenv compiler intrinsic to use vm struct
userenv
---
.../cfg/alias-analysis/alias-analysis.factor | 2 ++
basis/compiler/cfg/hats/hats.factor | 2 +-
.../cfg/instructions/instructions.factor | 4 ++++
.../compiler/cfg/intrinsics/misc/misc.factor | 2 +-
basis/compiler/codegen/codegen.factor | 3 +++
basis/cpu/architecture/architecture.factor | 1 +
basis/cpu/ppc/ppc.factor | 1 +
basis/cpu/x86/x86.factor | 23 ++++++-------------
basis/vm/vm.factor | 2 ++
vm/os-macosx.mm | 2 +-
vm/vm.hpp | 8 +++++--
11 files changed, 29 insertions(+), 21 deletions(-)
diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
index fcfc89ea52..cb8b2de543 100644
--- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
@@ -190,12 +190,14 @@ M: ##slot-imm insn-slot# slot>> ;
M: ##set-slot insn-slot# slot>> constant ;
M: ##set-slot-imm insn-slot# slot>> ;
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
+M: ##vm-field-ptr insn-slot# fieldname>> 1array ; ! is this right?
M: ##slot insn-object obj>> resolve ;
M: ##slot-imm insn-object obj>> resolve ;
M: ##set-slot insn-object obj>> resolve ;
M: ##set-slot-imm insn-object obj>> resolve ;
M: ##alien-global insn-object drop \ ##alien-global ;
+M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
: init-alias-analysis ( insns -- insns' )
H{ } clone histories set
diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor
index 469ba37703..1b99b5d4dd 100644
--- a/basis/compiler/cfg/hats/hats.factor
+++ b/basis/compiler/cfg/hats/hats.factor
@@ -57,4 +57,4 @@ insn-classes get [
: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline
: ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline
-: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
\ No newline at end of file
+: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 32e5d46c61..7c28198f67 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -450,6 +450,10 @@ INSN: ##alien-global
def: dst/int-rep
literal: symbol library ;
+INSN: ##vm-field-ptr
+def: dst/int-rep
+literal: fieldname ;
+
! FFI
INSN: ##alien-invoke
literal: params stack-frame ;
diff --git a/basis/compiler/cfg/intrinsics/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor
index f9f2182a4e..f9f3488773 100644
--- a/basis/compiler/cfg/intrinsics/misc/misc.factor
+++ b/basis/compiler/cfg/intrinsics/misc/misc.factor
@@ -10,7 +10,7 @@ IN: compiler.cfg.intrinsics.misc
ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
: emit-getenv ( node -- )
- "userenv" f ^^alien-global
+ "userenv" ^^vm-field-ptr
swap node-input-infos first literal>>
[ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot 0 ^^slot ] if*
ds-push ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 0456ff485f..de15cda21c 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -270,6 +270,9 @@ M: ##alien-global generate-insn
[ dst>> ] [ symbol>> ] [ library>> ] tri
%alien-global ;
+M: ##vm-field-ptr generate-insn
+ [ dst>> ] [ fieldname>> ] bi %vm-field-ptr ;
+
! ##alien-invoke
GENERIC: next-fastcall-param ( rep -- )
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index da1bcfc61f..b9d07f578e 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -202,6 +202,7 @@ HOOK: %set-alien-double cpu ( ptr value -- )
HOOK: %set-alien-vector cpu ( ptr value rep -- )
HOOK: %alien-global cpu ( dst symbol library -- )
+HOOK: %vm-field-ptr cpu ( dst fieldname -- )
HOOK: %allot cpu ( dst size class temp -- )
HOOK: %write-barrier cpu ( src card# table -- )
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 37a5369259..fc6a122101 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -36,6 +36,7 @@ enable-float-intrinsics
[ drop %load-vm-addr ]
[ [ dup ] dip vm-field-offset ADDI ] 2bi ;
+M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
M: ppc machine-registers
{
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 7e73275dde..57517ba319 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1,6 +1,5 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-<<<<<<< HEAD
USING: accessors assocs alien alien.c-types arrays strings
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
cpu.architecture kernel kernel.private math memory namespaces make
@@ -12,15 +11,7 @@ compiler.cfg.intrinsics
compiler.cfg.comparisons
compiler.cfg.stack-frame
compiler.codegen
-compiler.codegen.fixup ;
-=======
-USING: accessors alien combinators compiler.cfg.comparisons
-compiler.cfg.intrinsics compiler.cfg.registers
-compiler.cfg.stack-frame compiler.codegen.fixup compiler.constants
-cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands fry
-kernel layouts locals make math math.order namespaces sequences system
-vm ;
->>>>>>> Added a vm C-STRUCT, using it for struct offsets in x86 asm
+compiler.codegen.fixup vm ;
IN: cpu.x86
<< enable-fixnum-log2 >>
@@ -564,10 +555,13 @@ M: x86 %shl [ SHL ] emit-shift ;
M: x86 %shr [ SHR ] emit-shift ;
M: x86 %sar [ SAR ] emit-shift ;
+M: x86 %vm-field-ptr ( dst field -- )
+ [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+ [ vm-field-offset ADD ] 2bi ;
+
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
- [ 0 MOV rc-absolute-cell rt-vm rel-fixup ]
- [ "nursery" vm-field-offset ADD ] bi ;
+ "nursery" %vm-field-ptr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
@@ -587,9 +581,6 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
dst class store-tagged
nursery-ptr size inc-allot-ptr ;
-: %vm-field-ptr ( reg field -- )
- [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
- [ vm-field-offset ADD ] 2bi ;
M:: x86 %write-barrier ( src card# table -- )
#! Mark the card pointed to by vreg.
@@ -627,7 +618,7 @@ M:: x86 %call-gc ( gc-root-count -- )
"inline_gc" f %vm-invoke ;
M: x86 %alien-global ( dst symbol library -- )
- [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
+ [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
index 655250d755..e2e7fc879c 100644
--- a/basis/vm/vm.factor
+++ b/basis/vm/vm.factor
@@ -17,6 +17,8 @@ C-STRUCT: vm
{ "zone" "nursery" }
{ "cell" "cards_offset" }
{ "cell" "decks_offset" }
+ { "cell" "__padding__" }
+ { "cell[70]" "userenv" }
;
: vm-field-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
diff --git a/vm/os-macosx.mm b/vm/os-macosx.mm
index 865371b8ac..e4da7b2221 100644
--- a/vm/os-macosx.mm
+++ b/vm/os-macosx.mm
@@ -14,7 +14,7 @@ NS_DURING
NS_VOIDRETURN;
NS_HANDLER
dpush(vm->allot_alien(F,(cell)localException));
- quot = userenv[COCOA_EXCEPTION_ENV];
+ quot = vm->userenv[COCOA_EXCEPTION_ENV];
if(!tagged<object>(quot).type_p(QUOTATION_TYPE))
{
/* No Cocoa exception handler was registered, so
diff --git a/vm/vm.hpp b/vm/vm.hpp
index e0b598de6f..8372c3f0ba 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -8,9 +8,13 @@ struct factorvm {
zone nursery; /* new objects are allocated here */
cell cards_offset;
cell decks_offset;
- cell __padding__ ; // align to 8byte boundary (for 32bit platforms)
+#ifndef FACTOR_64
+ cell __padding__ ; // align to 8 byte boundary
+#endif
cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-
+#ifndef FACTOR_64
+ cell __padding2__; // not sure why we need this, bootstrap doesn't work without it
+#endif
// segments
inline cell align_page(cell a);
From 65a264aa1fba38b52123fab084a8f7bab11bdd3b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 20:44:06 +0100
Subject: [PATCH 131/266] turned errno() methods back into functions since they
should already be thread safe
---
vm/io.cpp | 15 ++-------------
vm/vm.hpp | 2 --
2 files changed, 2 insertions(+), 15 deletions(-)
diff --git a/vm/io.cpp b/vm/io.cpp
index 47d964eaad..650afb8f8a 100755
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -258,24 +258,13 @@ PRIMITIVE(fclose)
/* This function is used by FFI I/O. Accessing the errno global directly is
not portable, since on some libc's errno is not a global but a funky macro that
reads thread-local storage. */
-int factorvm::err_no()
+VM_C_API int err_no()
{
return errno;
}
-VM_C_API int err_no()
-{
- return vm->err_no();
-}
-
-void factorvm::clear_err_no()
+VM_C_API void clear_err_no()
{
errno = 0;
}
-
-VM_C_API void clear_err_no()
-{
- return vm->clear_err_no();
-}
-
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8372c3f0ba..1b0274e0b1 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -448,8 +448,6 @@ struct factorvm {
inline void vmprim_fseek();
inline void vmprim_fflush();
inline void vmprim_fclose();
- int err_no();
- void clear_err_no();
//code_gc
void clear_free_list(heap *heap);
From c5119218c53b5d51154b73aee2fa6fe61750f0ae Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 21:02:13 +0100
Subject: [PATCH 132/266] moved gc_locals accessors into vm
---
vm/vm.hpp | 3 +++
1 file changed, 3 insertions(+)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 1b0274e0b1..f72076c7b1 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -221,6 +221,9 @@ struct factorvm {
bool growing_data_heap;
data_heap *old_data_heap;
+ DEFPUSHPOP(gc_local_,gc_locals)
+
+
void init_data_gc();
object *copy_untagged_object_impl(object *pointer, cell size);
object *copy_object_impl(object *untagged);
From ff54a57eb314e8f672c1056244333736ceb5498e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 21 Aug 2009 21:24:53 +0100
Subject: [PATCH 133/266] added code to pass vm ptr to some unboxers
---
basis/cpu/architecture/architecture.factor | 2 +-
basis/cpu/x86/32/32.factor | 11 +++++----
basis/cpu/x86/64/64.factor | 2 +-
basis/cpu/x86/x86.factor | 2 +-
vm/alien.cpp | 4 ++--
vm/cpu-x86.32.hpp | 2 ++
vm/math.cpp | 26 ++++++++++++----------
vm/math.hpp | 12 +++++-----
vm/primitives.hpp | 2 ++
9 files changed, 36 insertions(+), 27 deletions(-)
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index b9d07f578e..6d88944881 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -298,7 +298,7 @@ M: object %prepare-var-args ;
HOOK: %alien-invoke cpu ( function library -- )
-HOOK: %vm-invoke cpu ( function library -- )
+HOOK: %vm-invoke cpu ( function -- )
HOOK: %cleanup cpu ( params -- )
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index a48528d3fd..306771a4b5 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -47,10 +47,10 @@ M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
-M: x86.32 %vm-invoke
- temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as the 3rd argument
+M: x86.32 %vm-invoke ( function -- )
+ temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
temp-reg PUSH
- %alien-invoke
+ f %alien-invoke
temp-reg POP ;
M: x86.32 return-struct-in-registers? ( c-type -- ? )
@@ -163,7 +163,10 @@ M: x86.32 %prepare-unbox ( -- )
ESI 4 SUB ;
: call-unbox-func ( func -- )
- 4 [
+ 8 [
+ ! push vm ptr
+ temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
+ temp-reg PUSH
! Push parameter
EAX PUSH
! Call the unboxer
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 4d041d2334..06592078d8 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -172,7 +172,7 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
-M: x86.64 %vm-invoke %alien-invoke ;
+M: x86.64 %vm-invoke ( function -- ) f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 57517ba319..da4e7d5286 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -615,7 +615,7 @@ M:: x86 %call-gc ( gc-root-count -- )
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Call GC
- "inline_gc" f %vm-invoke ;
+ "inline_gc" %vm-invoke ;
M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 41a1e8d522..da33c01df1 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -108,7 +108,7 @@ void *alien_pointer()
PRIMITIVE(set_alien_##name) \
{ \
type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
- type value = to(dpop()); \
+ type value = PRIMITIVE_GETVM()->to(dpop()); \
*ptr = value; \
}
@@ -124,7 +124,7 @@ DEFINE_ALIEN_ACCESSOR(signed_1,s8,box_signed_1,to_fixnum)
DEFINE_ALIEN_ACCESSOR(unsigned_1,u8,box_unsigned_1,to_cell)
DEFINE_ALIEN_ACCESSOR(float,float,box_float,to_float)
DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double)
-DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,PRIMITIVE_GETVM()->pinned_alien_offset)
+DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
/* open a native library and push a handle */
inline void factorvm::vmprim_dlopen()
diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp
index 28f2e2978e..f9895cefbd 100644
--- a/vm/cpu-x86.32.hpp
+++ b/vm/cpu-x86.32.hpp
@@ -9,4 +9,6 @@ register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
#undef VM_PTR
#define VM_PTR myvm
+#undef ASSERTVM
+#define ASSERTVM() assert(vm==myvm)
}
diff --git a/vm/math.cpp b/vm/math.cpp
index 0a46252d7f..1bb8f0abe5 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -618,9 +618,9 @@ fixnum factorvm::to_fixnum(cell tagged)
}
}
-VM_C_API fixnum to_fixnum(cell tagged)
+VM_C_API fixnum to_fixnum(cell tagged,factorvm *myvm)
{
- return vm->to_fixnum(tagged);
+ return VM_PTR->to_fixnum(tagged);
}
cell factorvm::to_cell(cell tagged)
@@ -628,9 +628,9 @@ cell factorvm::to_cell(cell tagged)
return (cell)to_fixnum(tagged);
}
-VM_C_API cell to_cell(cell tagged)
+VM_C_API cell to_cell(cell tagged, factorvm *myvm)
{
- return vm->to_cell(tagged);
+ return VM_PTR->to_cell(tagged);
}
void factorvm::box_signed_1(s8 n)
@@ -740,9 +740,10 @@ s64 factorvm::to_signed_8(cell obj)
}
}
-VM_C_API s64 to_signed_8(cell obj)
+VM_C_API s64 to_signed_8(cell obj,factorvm *myvm)
{
- return vm->to_signed_8(obj);
+ ASSERTVM();
+ return VM_PTR->to_signed_8(obj);
}
void factorvm::box_unsigned_8(u64 n)
@@ -772,9 +773,10 @@ u64 factorvm::to_unsigned_8(cell obj)
}
}
-VM_C_API u64 to_unsigned_8(cell obj)
+VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
{
- return vm->to_unsigned_8(obj);
+ ASSERTVM();
+ return VM_PTR->to_unsigned_8(obj);
}
void factorvm::box_float(float flo)
@@ -792,9 +794,9 @@ float factorvm::to_float(cell value)
return untag_float_check(value);
}
-VM_C_API float to_float(cell value)
+VM_C_API float to_float(cell value,factorvm *myvm)
{
- return vm->to_float(value);
+ return VM_PTR->to_float(value);
}
void factorvm::box_double(double flo)
@@ -812,9 +814,9 @@ double factorvm::to_double(cell value)
return untag_float_check(value);
}
-VM_C_API double to_double(cell value)
+VM_C_API double to_double(cell value,factorvm *myvm)
{
- return vm->to_double(value);
+ return VM_PTR->to_double(value);
}
/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
diff --git a/vm/math.hpp b/vm/math.hpp
index e8347fe0e2..8affd8edd2 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -61,9 +61,9 @@ PRIMITIVE(double_bits);
PRIMITIVE(bits_double);
VM_C_API void box_float(float flo);
-VM_C_API float to_float(cell value);
+VM_C_API float to_float(cell value, factorvm *vm);
VM_C_API void box_double(double flo);
-VM_C_API double to_double(cell value);
+VM_C_API double to_double(cell value, factorvm *vm);
VM_C_API void box_signed_1(s8 n);
VM_C_API void box_unsigned_1(u8 n);
@@ -76,11 +76,11 @@ VM_C_API void box_unsigned_cell(cell cell);
VM_C_API void box_signed_8(s64 n);
VM_C_API void box_unsigned_8(u64 n);
-VM_C_API s64 to_signed_8(cell obj);
-VM_C_API u64 to_unsigned_8(cell obj);
+VM_C_API s64 to_signed_8(cell obj, factorvm *vm);
+VM_C_API u64 to_unsigned_8(cell obj, factorvm *vm);
-VM_C_API fixnum to_fixnum(cell tagged);
-VM_C_API cell to_cell(cell tagged);
+VM_C_API fixnum to_fixnum(cell tagged, factorvm *vm);
+VM_C_API cell to_cell(cell tagged, factorvm *vm);
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y);
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y);
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index c6d704ffc7..212126f322 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -12,4 +12,6 @@ namespace factor
#endif
extern const primitive_type primitives[];
+#define VM_PTR vm
+#define ASSERTVM()
}
From 3b52df9e02738fee2fa2d76df00405cf86297aa0 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sat, 22 Aug 2009 10:21:32 +0100
Subject: [PATCH 134/266] added vm ptr to x86.32 boxing asm
---
basis/cpu/x86/32/32.factor | 17 +++++++++++------
1 file changed, 11 insertions(+), 6 deletions(-)
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 306771a4b5..adddc4c5b2 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -47,9 +47,12 @@ M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
-M: x86.32 %vm-invoke ( function -- )
+: push-vm-ptr ( -- )
temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
- temp-reg PUSH
+ temp-reg PUSH ;
+
+M: x86.32 %vm-invoke ( function -- )
+ push-vm-ptr
f %alien-invoke
temp-reg POP ;
@@ -109,9 +112,12 @@ M: x86.32 %save-param-reg 3drop ;
#! parameter being passed to a callback from C.
over [ load-return-reg ] [ 2drop ] if ;
+CONSTANT: vm-ptr-size 4
+
M:: x86.32 %box ( n rep func -- )
n rep (%box)
- rep rep-size [
+ rep rep-size vm-ptr-size + [
+ push-vm-ptr
rep push-return-reg
func f %alien-invoke
] with-aligned-stack ;
@@ -164,9 +170,8 @@ M: x86.32 %prepare-unbox ( -- )
: call-unbox-func ( func -- )
8 [
- ! push vm ptr
- temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
- temp-reg PUSH
+ ! push the vm ptr as an argument
+ push-vm-ptr
! Push parameter
EAX PUSH
! Call the unboxer
From 199fba7a9992cff85aac74587d3ce6df39b21756 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sat, 22 Aug 2009 10:50:52 +0100
Subject: [PATCH 135/266] converted box_* integer functions to use vm (x86
windows)
---
vm/alien.cpp | 8 +++++---
vm/math.cpp | 50 ++++++++++++++++++++++++++++++--------------------
vm/math.hpp | 20 ++++++++++----------
3 files changed, 45 insertions(+), 33 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index da33c01df1..e2298630e1 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -103,12 +103,14 @@ void *alien_pointer()
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
{ \
- boxer(*(type*)PRIMITIVE_GETVM()->alien_pointer()); \
+ factorvm *myvm = PRIMITIVE_GETVM(); \
+ myvm->boxer(*(type*)myvm->alien_pointer()); \
} \
PRIMITIVE(set_alien_##name) \
{ \
- type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
- type value = PRIMITIVE_GETVM()->to(dpop()); \
+ factorvm *myvm = PRIMITIVE_GETVM(); \
+ type *ptr = (type *)myvm->alien_pointer(); \
+ type value = myvm->to(dpop()); \
*ptr = value; \
}
diff --git a/vm/math.cpp b/vm/math.cpp
index 1bb8f0abe5..e6e1abf80a 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -638,9 +638,10 @@ void factorvm::box_signed_1(s8 n)
dpush(tag_fixnum(n));
}
-VM_C_API void box_signed_1(s8 n)
+VM_C_API void box_signed_1(s8 n,factorvm *myvm)
{
- return vm->box_signed_1(n);
+ ASSERTVM();
+ return VM_PTR->box_signed_1(n);
}
void factorvm::box_unsigned_1(u8 n)
@@ -648,9 +649,10 @@ void factorvm::box_unsigned_1(u8 n)
dpush(tag_fixnum(n));
}
-VM_C_API void box_unsigned_1(u8 n)
+VM_C_API void box_unsigned_1(u8 n,factorvm *myvm)
{
- return vm->box_unsigned_1(n);
+ ASSERTVM();
+ return VM_PTR->box_unsigned_1(n);
}
void factorvm::box_signed_2(s16 n)
@@ -658,9 +660,10 @@ void factorvm::box_signed_2(s16 n)
dpush(tag_fixnum(n));
}
-VM_C_API void box_signed_2(s16 n)
+VM_C_API void box_signed_2(s16 n,factorvm *myvm)
{
- return vm->box_signed_2(n);
+ ASSERTVM();
+ return VM_PTR->box_signed_2(n);
}
void factorvm::box_unsigned_2(u16 n)
@@ -668,9 +671,10 @@ void factorvm::box_unsigned_2(u16 n)
dpush(tag_fixnum(n));
}
-VM_C_API void box_unsigned_2(u16 n)
+VM_C_API void box_unsigned_2(u16 n,factorvm *myvm)
{
- return vm->box_unsigned_2(n);
+ ASSERTVM();
+ return VM_PTR->box_unsigned_2(n);
}
void factorvm::box_signed_4(s32 n)
@@ -678,9 +682,10 @@ void factorvm::box_signed_4(s32 n)
dpush(allot_integer(n));
}
-VM_C_API void box_signed_4(s32 n)
+VM_C_API void box_signed_4(s32 n,factorvm *myvm)
{
- return vm->box_signed_4(n);
+ ASSERTVM();
+ return VM_PTR->box_signed_4(n);
}
void factorvm::box_unsigned_4(u32 n)
@@ -688,9 +693,10 @@ void factorvm::box_unsigned_4(u32 n)
dpush(allot_cell(n));
}
-VM_C_API void box_unsigned_4(u32 n)
+VM_C_API void box_unsigned_4(u32 n,factorvm *myvm)
{
- return vm->box_unsigned_4(n);
+ ASSERTVM();
+ return VM_PTR->box_unsigned_4(n);
}
void factorvm::box_signed_cell(fixnum integer)
@@ -698,9 +704,10 @@ void factorvm::box_signed_cell(fixnum integer)
dpush(allot_integer(integer));
}
-VM_C_API void box_signed_cell(fixnum integer)
+VM_C_API void box_signed_cell(fixnum integer,factorvm *myvm)
{
- return vm->box_signed_cell(integer);
+ ASSERTVM();
+ return VM_PTR->box_signed_cell(integer);
}
void factorvm::box_unsigned_cell(cell cell)
@@ -708,9 +715,10 @@ void factorvm::box_unsigned_cell(cell cell)
dpush(allot_cell(cell));
}
-VM_C_API void box_unsigned_cell(cell cell)
+VM_C_API void box_unsigned_cell(cell cell,factorvm *myvm)
{
- return vm->box_unsigned_cell(cell);
+ ASSERTVM();
+ return VM_PTR->box_unsigned_cell(cell);
}
void factorvm::box_signed_8(s64 n)
@@ -721,9 +729,10 @@ void factorvm::box_signed_8(s64 n)
dpush(tag_fixnum(n));
}
-VM_C_API void box_signed_8(s64 n)
+VM_C_API void box_signed_8(s64 n,factorvm *myvm)
{
- return vm->box_signed_8(n);
+ ASSERTVM();
+ return VM_PTR->box_signed_8(n);
}
s64 factorvm::to_signed_8(cell obj)
@@ -754,9 +763,10 @@ void factorvm::box_unsigned_8(u64 n)
dpush(tag_fixnum(n));
}
-VM_C_API void box_unsigned_8(u64 n)
+VM_C_API void box_unsigned_8(u64 n,factorvm *myvm)
{
- return vm->box_unsigned_8(n);
+ ASSERTVM();
+ return VM_PTR->box_unsigned_8(n);
}
u64 factorvm::to_unsigned_8(cell obj)
diff --git a/vm/math.hpp b/vm/math.hpp
index 8affd8edd2..11c43a01a1 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -65,16 +65,16 @@ VM_C_API float to_float(cell value, factorvm *vm);
VM_C_API void box_double(double flo);
VM_C_API double to_double(cell value, factorvm *vm);
-VM_C_API void box_signed_1(s8 n);
-VM_C_API void box_unsigned_1(u8 n);
-VM_C_API void box_signed_2(s16 n);
-VM_C_API void box_unsigned_2(u16 n);
-VM_C_API void box_signed_4(s32 n);
-VM_C_API void box_unsigned_4(u32 n);
-VM_C_API void box_signed_cell(fixnum integer);
-VM_C_API void box_unsigned_cell(cell cell);
-VM_C_API void box_signed_8(s64 n);
-VM_C_API void box_unsigned_8(u64 n);
+VM_C_API void box_signed_1(s8 n, factorvm *vm);
+VM_C_API void box_unsigned_1(u8 n, factorvm *vm);
+VM_C_API void box_signed_2(s16 n, factorvm *vm);
+VM_C_API void box_unsigned_2(u16 n, factorvm *vm);
+VM_C_API void box_signed_4(s32 n, factorvm *vm);
+VM_C_API void box_unsigned_4(u32 n, factorvm *vm);
+VM_C_API void box_signed_cell(fixnum integer, factorvm *vm);
+VM_C_API void box_unsigned_cell(cell cell, factorvm *vm);
+VM_C_API void box_signed_8(s64 n, factorvm *vm);
+VM_C_API void box_unsigned_8(u64 n, factorvm *vm);
VM_C_API s64 to_signed_8(cell obj, factorvm *vm);
VM_C_API u64 to_unsigned_8(cell obj, factorvm *vm);
From 81106f9e209eaa2c241f60a6f51f2f168a55b0a9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 2 Sep 2009 08:06:00 +0100
Subject: [PATCH 136/266] converted box_* integer functions to use vm (x86
windows)
---
vm/alien.cpp | 8 +++-----
vm/cpu-x86.32.hpp | 4 ----
2 files changed, 3 insertions(+), 9 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index e2298630e1..6c83f87182 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -103,14 +103,12 @@ void *alien_pointer()
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
{ \
- factorvm *myvm = PRIMITIVE_GETVM(); \
- myvm->boxer(*(type*)myvm->alien_pointer()); \
+ PRIMITIVE_GETVM()->boxer(*(type*)PRIMITIVE_GETVM()->alien_pointer()); \
} \
PRIMITIVE(set_alien_##name) \
{ \
- factorvm *myvm = PRIMITIVE_GETVM(); \
- type *ptr = (type *)myvm->alien_pointer(); \
- type value = myvm->to(dpop()); \
+ type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
+ type value = PRIMITIVE_GETVM()->to(dpop()); \
*ptr = value; \
}
diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp
index f9895cefbd..351865f776 100644
--- a/vm/cpu-x86.32.hpp
+++ b/vm/cpu-x86.32.hpp
@@ -7,8 +7,4 @@ register cell ds asm("esi");
register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
-#undef VM_PTR
-#define VM_PTR myvm
-#undef ASSERTVM
-#define ASSERTVM() assert(vm==myvm)
}
From a39bf2f8e223dd7190053dc5f473b34272494da6 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sat, 22 Aug 2009 11:04:34 +0100
Subject: [PATCH 137/266] converted box_* float functions to use vm (x86 win32)
---
vm/math.cpp | 12 +++++++-----
vm/math.hpp | 4 ++--
2 files changed, 9 insertions(+), 7 deletions(-)
diff --git a/vm/math.cpp b/vm/math.cpp
index e6e1abf80a..c403073804 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -788,15 +788,16 @@ VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
ASSERTVM();
return VM_PTR->to_unsigned_8(obj);
}
-
+
void factorvm::box_float(float flo)
{
dpush(allot_float(flo));
}
-VM_C_API void box_float(float flo)
+VM_C_API void box_float(float flo,factorvm *myvm) // not sure if this is ever called
{
- return vm->box_float(flo);
+ ASSERTVM();
+ return VM_PTR->box_float(flo);
}
float factorvm::to_float(cell value)
@@ -814,9 +815,10 @@ void factorvm::box_double(double flo)
dpush(allot_float(flo));
}
-VM_C_API void box_double(double flo)
+VM_C_API void box_double(double flo,factorvm *myvm) // not sure if this is ever called
{
- return vm->box_double(flo);
+ ASSERTVM();
+ return VM_PTR->box_double(flo);
}
double factorvm::to_double(cell value)
diff --git a/vm/math.hpp b/vm/math.hpp
index 11c43a01a1..5939b25b37 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -60,9 +60,9 @@ PRIMITIVE(bits_float);
PRIMITIVE(double_bits);
PRIMITIVE(bits_double);
-VM_C_API void box_float(float flo);
+VM_C_API void box_float(float flo, factorvm *vm);
VM_C_API float to_float(cell value, factorvm *vm);
-VM_C_API void box_double(double flo);
+VM_C_API void box_double(double flo, factorvm *vm);
VM_C_API double to_double(cell value, factorvm *vm);
VM_C_API void box_signed_1(s8 n, factorvm *vm);
From 7759b89de9e70a31d47b76284bc7320d0f942d64 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sat, 22 Aug 2009 11:15:58 +0100
Subject: [PATCH 138/266] removed all vm-> singleton accesses from inlineimpls
---
vm/arrays.cpp | 2 +-
vm/inlineimpls.hpp | 163 +--------------------------------------------
vm/math.cpp | 6 +-
vm/math.hpp | 1 +
vm/primitives.hpp | 1 +
vm/vm.hpp | 3 -
6 files changed, 8 insertions(+), 168 deletions(-)
diff --git a/vm/arrays.cpp b/vm/arrays.cpp
index 62992c4e7c..3052563dea 100644
--- a/vm/arrays.cpp
+++ b/vm/arrays.cpp
@@ -91,7 +91,7 @@ void growable_array::add(cell elt_)
if(count == array_capacity(elements.untagged()))
elements = myvm->reallot_array(elements.untagged(),count * 2);
- set_array_nth(elements.untagged(),count++,elt.value());
+ myvm->set_array_nth(elements.untagged(),count++,elt.value());
}
void growable_array::trim()
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index ca0b13be39..6b74634715 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -11,11 +11,6 @@ inline cell factorvm::align_page(cell a)
return align(a,getpagesize());
}
-inline static cell align_page(cell a)
-{
- return vm->align_page(a);
-}
-
// write_barrier.hpp
inline card *factorvm::addr_to_card(cell a)
@@ -23,71 +18,38 @@ inline card *factorvm::addr_to_card(cell a)
return (card*)(((cell)(a) >> card_bits) + cards_offset);
}
-inline card *addr_to_card(cell a)
-{
- return vm->addr_to_card(a);
-}
inline cell factorvm::card_to_addr(card *c)
{
return ((cell)c - cards_offset) << card_bits;
}
-inline cell card_to_addr(card *c)
-{
- return vm->card_to_addr(c);
-}
inline cell factorvm::card_offset(card *c)
{
return *(c - (cell)data->cards + (cell)data->allot_markers);
}
-inline cell card_offset(card *c)
-{
- return vm->card_offset(c);
-}
-
inline card_deck *factorvm::addr_to_deck(cell a)
{
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
}
-inline card_deck *addr_to_deck(cell a)
-{
- return vm->addr_to_deck(a);
-}
-
inline cell factorvm::deck_to_addr(card_deck *c)
{
return ((cell)c - decks_offset) << deck_bits;
}
-inline cell deck_to_addr(card_deck *c)
-{
- return vm->deck_to_addr(c);
-}
-
inline card *factorvm::deck_to_card(card_deck *d)
{
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
}
-inline card *deck_to_card(card_deck *d)
-{
- return vm->deck_to_card(d);
-}
-
inline card *factorvm::addr_to_allot_marker(object *a)
{
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
}
-inline card *addr_to_allot_marker(object *a)
-{
- return vm->addr_to_allot_marker(a);
-}
-
/* the write barrier must be called any time we are potentially storing a
pointer from an older generation to a younger one */
inline void factorvm::write_barrier(object *obj)
@@ -96,11 +58,6 @@ inline void factorvm::write_barrier(object *obj)
*addr_to_deck((cell)obj) = card_mark_mask;
}
-inline void write_barrier(object *obj)
-{
- return vm->write_barrier(obj);
-}
-
/* we need to remember the first object allocated in the card */
inline void factorvm::allot_barrier(object *address)
{
@@ -109,11 +66,6 @@ inline void factorvm::allot_barrier(object *address)
*ptr = ((cell)address & addr_card_mask);
}
-inline void allot_barrier(object *address)
-{
- return vm->allot_barrier(address);
-}
-
//data_gc.hpp
inline bool factorvm::collecting_accumulation_gen_p()
@@ -124,11 +76,6 @@ inline bool factorvm::collecting_accumulation_gen_p()
|| collecting_gen == data->tenured());
}
-inline bool collecting_accumulation_gen_p()
-{
- return vm->collecting_accumulation_gen_p();
-}
-
inline object *factorvm::allot_zone(zone *z, cell a)
{
cell h = z->here;
@@ -138,11 +85,6 @@ inline object *factorvm::allot_zone(zone *z, cell a)
return obj;
}
-inline object *allot_zone(zone *z, cell a)
-{
- return vm->allot_zone(z,a);
-}
-
/*
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!
@@ -198,21 +140,11 @@ inline object *factorvm::allot_object(header header, cell size)
return obj;
}
-inline object *allot_object(header header, cell size)
-{
- return vm->allot_object(header,size);
-}
-
template<typename TYPE> TYPE *factorvm::allot(cell size)
{
return (TYPE *)allot_object(header(TYPE::type_number),size);
}
-template<typename TYPE> TYPE *allot(cell size)
-{
- return vm->allot<TYPE>(size);
-}
-
inline void factorvm::check_data_pointer(object *pointer)
{
#ifdef FACTOR_DEBUG
@@ -224,11 +156,6 @@ inline void factorvm::check_data_pointer(object *pointer)
#endif
}
-inline void check_data_pointer(object *pointer)
-{
- return vm->check_data_pointer(pointer);
-}
-
inline void factorvm::check_tagged_pointer(cell tagged)
{
#ifdef FACTOR_DEBUG
@@ -241,18 +168,13 @@ inline void factorvm::check_tagged_pointer(cell tagged)
#endif
}
-inline void check_tagged_pointer(cell tagged)
-{
- return vm->check_tagged_pointer(tagged);
-}
-
//local_roots.hpp
template <typename TYPE>
struct gc_root : public tagged<TYPE>
{
factorvm *myvm;
- void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
+ void push() { myvm->check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
//explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
@@ -276,7 +198,7 @@ struct gc_bignum
factorvm *myvm;
gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
if(*addr_)
- check_data_pointer(*addr_);
+ myvm->check_data_pointer(*addr_);
myvm->gc_bignums.push_back((cell)addr);
}
@@ -298,21 +220,11 @@ template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
return array;
}
-template <typename TYPE> TYPE *allot_array_internal(cell capacity)
-{
- return vm->allot_array_internal<TYPE>(capacity);
-}
-
template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
{
return in_zone(&nursery,array) && capacity <= array_capacity(array);
}
-template <typename TYPE> bool reallot_array_in_place_p(TYPE *array, cell capacity)
-{
- return vm->reallot_array_in_place_p<TYPE>(array,capacity);
-}
-
template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
{
gc_root<TYPE> array(array_,this);
@@ -350,11 +262,6 @@ inline void factorvm::set_array_nth(array *array, cell slot, cell value)
write_barrier(array);
}
-inline void set_array_nth(array *array, cell slot, cell value)
-{
- return vm->set_array_nth(array,slot,value);
-}
-
struct growable_array {
cell count;
gc_root<array> elements;
@@ -387,11 +294,6 @@ inline cell factorvm::allot_integer(fixnum x)
return tag_fixnum(x);
}
-inline cell allot_integer(fixnum x)
-{
- return vm->allot_integer(x);
-}
-
inline cell factorvm::allot_cell(cell x)
{
if(x > (cell)fixnum_max)
@@ -400,11 +302,6 @@ inline cell factorvm::allot_cell(cell x)
return tag_fixnum(x);
}
-inline cell allot_cell(cell x)
-{
- return vm->allot_cell(x);
-}
-
inline cell factorvm::allot_float(double n)
{
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
@@ -412,72 +309,36 @@ inline cell factorvm::allot_float(double n)
return tag(flo);
}
-inline cell allot_float(double n)
-{
- return vm->allot_float(n);
-}
-
inline bignum *factorvm::float_to_bignum(cell tagged)
{
return double_to_bignum(untag_float(tagged));
}
-inline bignum *float_to_bignum(cell tagged)
-{
- return vm->float_to_bignum(tagged);
-}
-
inline double factorvm::bignum_to_float(cell tagged)
{
return bignum_to_double(untag<bignum>(tagged));
}
-inline double bignum_to_float(cell tagged)
-{
- return vm->bignum_to_float(tagged);
-}
-
inline double factorvm::untag_float(cell tagged)
{
return untag<boxed_float>(tagged)->n;
}
-inline double untag_float(cell tagged)
-{
- return vm->untag_float(tagged);
-}
-
inline double factorvm::untag_float_check(cell tagged)
{
return untag_check<boxed_float>(tagged)->n;
}
-inline double untag_float_check(cell tagged)
-{
- return vm->untag_float_check(tagged);
-}
-
inline fixnum factorvm::float_to_fixnum(cell tagged)
{
return (fixnum)untag_float(tagged);
}
-inline static fixnum float_to_fixnum(cell tagged)
-{
- return vm->float_to_fixnum(tagged);
-}
-
inline double factorvm::fixnum_to_float(cell tagged)
{
return (double)untag_fixnum(tagged);
}
-inline double fixnum_to_float(cell tagged)
-{
- return vm->fixnum_to_float(tagged);
-}
-
-
//callstack.hpp
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
@@ -494,22 +355,12 @@ template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack
}
}
-template<typename TYPE> void iterate_callstack_object(callstack *stack_, TYPE &iterator)
-{
- return vm->iterate_callstack_object(stack_,iterator);
-}
-
//booleans.hpp
inline cell factorvm::tag_boolean(cell untagged)
{
return (untagged ? T : F);
}
-inline cell tag_boolean(cell untagged)
-{
- return vm->tag_boolean(untagged);
-}
-
// callstack.hpp
template<typename TYPE> void factorvm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
{
@@ -522,11 +373,6 @@ template<typename TYPE> void factorvm::iterate_callstack(cell top, cell bottom,
}
}
-template<typename TYPE> void iterate_callstack(cell top, cell bottom, TYPE &iterator)
-{
- return vm->iterate_callstack(top,bottom,iterator);
-}
-
// data_heap.hpp
/* Every object has a regular representation in the runtime, which makes GC
@@ -548,11 +394,6 @@ inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
}
}
-inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
-{
- return vm->do_slots(obj,iter);
-}
-
// code_heap.hpp
inline void factorvm::check_code_pointer(cell ptr)
diff --git a/vm/math.cpp b/vm/math.cpp
index c403073804..8d213b391d 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -841,7 +841,7 @@ void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
{
- return vm->overflow_fixnum_add(x,y);
+ return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
}
void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
@@ -852,7 +852,7 @@ void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
{
- return vm->overflow_fixnum_subtract(x,y);
+ return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
}
void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
@@ -866,7 +866,7 @@ void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
{
- return vm->overflow_fixnum_multiply(x,y);
+ return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
}
}
diff --git a/vm/math.hpp b/vm/math.hpp
index 5939b25b37..b45284f693 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -5,6 +5,7 @@ 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));
+// defined in assembler
PRIMITIVE(fixnum_add);
PRIMITIVE(fixnum_subtract);
PRIMITIVE(fixnum_multiply);
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index 212126f322..8e6c3b8f51 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -12,6 +12,7 @@ namespace factor
#endif
extern const primitive_type primitives[];
+#define PRIMITIVE_OVERFLOW_GETVM() vm
#define VM_PTR vm
#define ASSERTVM()
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index f72076c7b1..1b0274e0b1 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -221,9 +221,6 @@ struct factorvm {
bool growing_data_heap;
data_heap *old_data_heap;
- DEFPUSHPOP(gc_local_,gc_locals)
-
-
void init_data_gc();
object *copy_untagged_object_impl(object *pointer, cell size);
object *copy_object_impl(object *untagged);
From fa2dccd6d3688ed7fa0965057f3fe2c804c654b9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sat, 22 Aug 2009 21:35:47 +0100
Subject: [PATCH 139/266] vm passed in box_alien and alien_offset (win32)
---
vm/alien.cpp | 15 +++++++++++----
vm/alien.hpp | 4 ++--
vm/os-unix.cpp | 2 +-
3 files changed, 14 insertions(+), 7 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 6c83f87182..23ca60bf6a 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -218,9 +218,10 @@ char *factorvm::alien_offset(cell obj)
}
}
-VM_C_API char *alien_offset(cell obj)
+VM_C_API char *alien_offset(cell obj, factorvm *myvm)
{
- return vm->alien_offset(obj);
+ ASSERTVM();
+ return VM_PTR->alien_offset(obj);
}
/* pop an object representing a C pointer */
@@ -231,6 +232,7 @@ char *factorvm::unbox_alien()
VM_C_API char *unbox_alien()
{
+ printf("*PHIL unbox_alien\n");
return vm->unbox_alien();
}
@@ -243,9 +245,10 @@ void factorvm::box_alien(void *ptr)
dpush(allot_alien(F,(cell)ptr));
}
-VM_C_API void box_alien(void *ptr)
+VM_C_API void box_alien(void *ptr, factorvm *myvm)
{
- return vm->box_alien(ptr);
+ ASSERTVM();
+ return VM_PTR->box_alien(ptr);
}
/* for FFI calls passing structs by value */
@@ -256,6 +259,7 @@ void factorvm::to_value_struct(cell src, void *dest, cell size)
VM_C_API void to_value_struct(cell src, void *dest, cell size)
{
+ printf("PHIL to_value_struct\n");
return vm->to_value_struct(src,dest,size);
}
@@ -269,6 +273,7 @@ void factorvm::box_value_struct(void *src, cell size)
VM_C_API void box_value_struct(void *src, cell size)
{
+ printf("PHIL box_value_struct\n");
return vm->box_value_struct(src,size);
}
@@ -283,6 +288,7 @@ void factorvm::box_small_struct(cell x, cell y, cell size)
VM_C_API void box_small_struct(cell x, cell y, cell size)
{
+ printf("PHIL box_small_struct\n");
return vm->box_small_struct(x,y,size);
}
@@ -299,6 +305,7 @@ void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
{
+ printf("PHIL box_medium_struct\n");
return vm->box_medium_struct(x1, x2, x3, x4, size);
}
diff --git a/vm/alien.hpp b/vm/alien.hpp
index 0a4f3a7e93..327d791406 100755
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@@ -36,9 +36,9 @@ PRIMITIVE(dlsym);
PRIMITIVE(dlclose);
PRIMITIVE(dll_validp);
-VM_C_API char *alien_offset(cell object);
+VM_C_API char *alien_offset(cell object, factorvm *vm);
VM_C_API char *unbox_alien();
-VM_C_API void box_alien(void *ptr);
+VM_C_API void box_alien(void *ptr, factorvm *vm);
VM_C_API void to_value_struct(cell src, void *dest, cell size);
VM_C_API void box_value_struct(void *src, cell size);
VM_C_API void box_small_struct(cell x, cell y, cell size);
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 189fca0cf7..3785aeda72 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -39,7 +39,7 @@ void init_ffi()
void ffi_dlopen(dll *dll)
{
- dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY);
+ dll->dll = dlopen(alien_offset(dll->path,vm), RTLD_LAZY);
}
void *ffi_dlsym(dll *dll, symbol_char *symbol)
From 0a15e20e1282565dc760200c3b92deb4a02f6c85 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 14:36:24 +0100
Subject: [PATCH 140/266] Added basic win32 start-thread support
---
vm/factor.cpp | 26 ++++++++++++++++++++++++++
vm/factor.hpp | 1 +
vm/os-windows-nt.cpp | 5 +++++
vm/os-windows-nt.hpp | 3 +++
4 files changed, 35 insertions(+)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 55d7abcc49..883b4f9462 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -277,4 +277,30 @@ VM_C_API void factor_sleep(long us)
return vm->factor_sleep(us);
}
+struct startargs {
+ int argc;
+ vm_char **argv;
+};
+
+void* start_standalone_factor_thread(void *arg)
+{
+ factorvm *newvm = new factorvm;
+ startargs *args = (startargs*) arg;
+ vm_parameters p;
+ newvm->default_parameters(&p);
+ newvm->init_parameters_from_args(&p,args->argc, args->argv);
+ newvm->init_factor(&p);
+ newvm->pass_args_to_factor(args->argc,args->argv);
+ newvm->start_factor(&p);
+ return 0;
+}
+
+
+VM_C_API void start_standalone_factor_in_new_thread(int argc, vm_char **argv)
+{
+ startargs *args = new startargs; // leaks startargs structure
+ args->argc = argc; args->argv = argv;
+ start_thread(start_standalone_factor_thread,args);
+}
+
}
diff --git a/vm/factor.hpp b/vm/factor.hpp
index 6e00bc012e..b2aeccd1a6 100644
--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@@ -7,6 +7,7 @@ VM_C_API void init_factor(vm_parameters *p);
VM_C_API void pass_args_to_factor(int argc, vm_char **argv);
VM_C_API void start_embedded_factor(vm_parameters *p);
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
+VM_C_API void start_standalone_factor_in_new_thread(int argc, vm_char **argv);
VM_C_API char *factor_eval_string(char *string);
VM_C_API void factor_eval_free(char *result);
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 535e7b8640..9187b88986 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -3,6 +3,11 @@
namespace factor
{
+void start_thread(void *(*start_routine)(void *),void *args){
+ CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
+}
+
+
s64 factorvm::current_micros()
{
FILETIME t;
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index c083844ae0..27923a000a 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -21,9 +21,12 @@ typedef char symbol_char;
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
+
// SSE traps raise these exception codes, which are defined in internal NT headers
// but not winbase.h
#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4
#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5
+void start_thread(void *(*start_routine)(void *),void *args);
+
}
From 58190c06dca6da81a177830bf7ef2964b241d588 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 14:45:09 +0100
Subject: [PATCH 141/266] passing ptr in boolean boxing and
save_callstack_bottom
---
vm/booleans.cpp | 10 ++++++----
vm/booleans.hpp | 4 ++--
vm/callstack.cpp | 5 +++--
vm/callstack.hpp | 2 +-
4 files changed, 12 insertions(+), 9 deletions(-)
diff --git a/vm/booleans.cpp b/vm/booleans.cpp
index 6a1bb79298..aa3f392b3e 100644
--- a/vm/booleans.cpp
+++ b/vm/booleans.cpp
@@ -8,9 +8,10 @@ void factorvm::box_boolean(bool value)
dpush(value ? T : F);
}
-VM_C_API void box_boolean(bool value)
+VM_C_API void box_boolean(bool value, factorvm *myvm)
{
- return vm->box_boolean(value);
+ ASSERTVM();
+ return VM_PTR->box_boolean(value);
}
bool factorvm::to_boolean(cell value)
@@ -18,9 +19,10 @@ bool factorvm::to_boolean(cell value)
return value != F;
}
-VM_C_API bool to_boolean(cell value)
+VM_C_API bool to_boolean(cell value, factorvm *myvm)
{
- return vm->to_boolean(value);
+ ASSERTVM();
+ return VM_PTR->to_boolean(value);
}
}
diff --git a/vm/booleans.hpp b/vm/booleans.hpp
index c410f67481..843cd7fd66 100644
--- a/vm/booleans.hpp
+++ b/vm/booleans.hpp
@@ -2,7 +2,7 @@ namespace factor
{
-VM_C_API void box_boolean(bool value);
-VM_C_API bool to_boolean(cell value);
+VM_C_API void box_boolean(bool value, factorvm *vm);
+VM_C_API bool to_boolean(cell value, factorvm *vm);
}
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index 676e4260c9..b89dd0cfef 100755
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -246,9 +246,10 @@ void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
stack_chain->callstack_bottom = callstack_bottom;
}
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factorvm *myvm)
{
- return vm->save_callstack_bottom(callstack_bottom);
+ ASSERTVM();
+ return VM_PTR->save_callstack_bottom(callstack_bottom);
}
}
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index 406d8e7154..d34cd618e3 100755
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -13,7 +13,7 @@ PRIMITIVE(innermost_stack_frame_executing);
PRIMITIVE(innermost_stack_frame_scan);
PRIMITIVE(set_innermost_stack_frame_quot);
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom);
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom,factorvm *vm);
From cdb6304fef1c3181100dbe3cf0116dcd3b8e6e71 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 19:40:59 +0100
Subject: [PATCH 142/266] Dev checkpoint
---
basis/cpu/x86/32/32.factor | 2 ++
vm/code_heap.cpp | 2 +-
vm/contexts.cpp | 6 ++++--
vm/contexts.hpp | 5 +++--
4 files changed, 10 insertions(+), 5 deletions(-)
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index adddc4c5b2..fe365f2e50 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -257,11 +257,13 @@ M: x86.32 %callback-value ( ctype -- )
ESP 12 SUB
! Save top of data stack in non-volatile register
%prepare-unbox
+ push-vm-ptr
EAX PUSH
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Place top of data stack in EAX
EAX POP
+ temp-reg POP
! Restore C stack
ESP 12 ADD
! Unbox EAX
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 39f0dfd52a..d91e349db7 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -17,7 +17,7 @@ bool factorvm::in_code_heap_p(cell ptr)
bool in_code_heap_p(cell ptr)
{
- return vm->in_code_heap_p(ptr);
+ return vm->in_code_heap_p(ptr); // used by os specific signal handlers
}
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index f5c63f1e7f..26197a4863 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -90,8 +90,9 @@ void factorvm::nest_stacks()
reset_retainstack();
}
-void nest_stacks()
+void nest_stacks(factorvm *myvm)
{
+ printf("PHIL nest_stacks %d %d\n",vm,myvm);fflush(stdout);
return vm->nest_stacks();
}
@@ -110,8 +111,9 @@ void factorvm::unnest_stacks()
dealloc_context(old_stacks);
}
-void unnest_stacks()
+void unnest_stacks(factorvm *myvm)
{
+ printf("PHIL unnest_stacks %d %d\n",vm,myvm);fflush(stdout);
return vm->unnest_stacks();
}
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 17f8a7eb70..060b15fad7 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -50,8 +50,9 @@ PRIMITIVE(set_datastack);
PRIMITIVE(set_retainstack);
PRIMITIVE(check_datastack);
-VM_C_API void nest_stacks();
-VM_C_API void unnest_stacks();
+struct factorvm;
+VM_C_API void nest_stacks(factorvm *vm);
+VM_C_API void unnest_stacks(factorvm *vm);
}
From 005549ba43bae34eae3166ea1e1f418a38259d1e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 20:04:05 +0100
Subject: [PATCH 143/266] vm pointer passed to nest_stacks and unnest_stacks
(win32)
---
basis/compiler/codegen/codegen.factor | 4 ++--
basis/cpu/x86/32/32.factor | 4 ++--
basis/cpu/x86/x86.factor | 2 +-
vm/contexts.cpp | 8 ++++----
4 files changed, 9 insertions(+), 9 deletions(-)
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index de15cda21c..6d43adf933 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -437,7 +437,7 @@ M: ##alien-indirect generate-insn
! Generate code for boxing input parameters in a callback.
[
dup \ %save-param-reg move-parameters
- "nest_stacks" f %alien-invoke
+ "nest_stacks" %vm-invoke
box-parameters
] with-param-regs ;
@@ -475,7 +475,7 @@ TUPLE: callback-context ;
[ callback-context new do-callback ] %
] [ ] make ;
-: %unnest-stacks ( -- ) "unnest_stacks" f %alien-invoke ;
+: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke ;
M: ##callback-return generate-insn
#! All the extra book-keeping for %unwind is only for x86.
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index fe365f2e50..9499df7aaf 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -257,13 +257,13 @@ M: x86.32 %callback-value ( ctype -- )
ESP 12 SUB
! Save top of data stack in non-volatile register
%prepare-unbox
- push-vm-ptr
EAX PUSH
+ push-vm-ptr
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Place top of data stack in EAX
- EAX POP
temp-reg POP
+ EAX POP
! Restore C stack
ESP 12 ADD
! Unbox EAX
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index da4e7d5286..9ac787a027 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -615,7 +615,7 @@ M:: x86 %call-gc ( gc-root-count -- )
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Call GC
- "inline_gc" %vm-invoke ;
+ "inline_gc" %vm-invoke ; ! (PHIL) TODO: vm-invoke won't work with ppc or x86.64. need %vm-invoke-3rd
M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 26197a4863..5acb7d5090 100644
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -92,8 +92,8 @@ void factorvm::nest_stacks()
void nest_stacks(factorvm *myvm)
{
- printf("PHIL nest_stacks %d %d\n",vm,myvm);fflush(stdout);
- return vm->nest_stacks();
+ ASSERTVM();
+ return VM_PTR->nest_stacks();
}
/* called when leaving a compiled callback */
@@ -113,8 +113,8 @@ void factorvm::unnest_stacks()
void unnest_stacks(factorvm *myvm)
{
- printf("PHIL unnest_stacks %d %d\n",vm,myvm);fflush(stdout);
- return vm->unnest_stacks();
+ ASSERTVM();
+ return VM_PTR->unnest_stacks();
}
/* called on startup */
From 2f3cd4d23d21aa231e5c7ae17ed1cdb265323369 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 21:04:19 +0100
Subject: [PATCH 144/266] removed some vm-> pointers
---
vm/alien.cpp | 2 +-
vm/os-freebsd.cpp | 2 +-
vm/os-genunix.cpp | 2 +-
vm/os-linux.cpp | 4 ++--
vm/os-unix.cpp | 4 ++--
vm/os-unix.hpp | 2 +-
vm/quotations.cpp | 2 +-
vm/tagged.hpp | 11 -----------
vm/utilities.cpp | 13 -------------
vm/utilities.hpp | 3 ---
10 files changed, 9 insertions(+), 36 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 23ca60bf6a..bed24d1037 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -232,7 +232,7 @@ char *factorvm::unbox_alien()
VM_C_API char *unbox_alien()
{
- printf("*PHIL unbox_alien\n");
+ printf("*PHIL unbox_alien\n");fflush(stdout);
return vm->unbox_alien();
}
diff --git a/vm/os-freebsd.cpp b/vm/os-freebsd.cpp
index d259658284..64c8ac19da 100644
--- a/vm/os-freebsd.cpp
+++ b/vm/os-freebsd.cpp
@@ -33,7 +33,7 @@ const char *vm_executable_path()
if(strcmp(path, "unknown") == 0)
return NULL;
- return safe_strdup(path);
+ return vm->safe_strdup(path);
}
}
diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp
index 29c3e79859..9e7804caf0 100644
--- a/vm/os-genunix.cpp
+++ b/vm/os-genunix.cpp
@@ -31,7 +31,7 @@ const char *default_image_path()
const char *iter = path;
while(*iter) { len++; iter++; }
- char *new_path = (char *)safe_malloc(PATH_MAX + SUFFIX_LEN + 1);
+ char *new_path = (char *)vm->safe_malloc(PATH_MAX + SUFFIX_LEN + 1);
memcpy(new_path,path,len + 1);
memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1);
return new_path;
diff --git a/vm/os-linux.cpp b/vm/os-linux.cpp
index 2bc121ffc7..62deb70f01 100644
--- a/vm/os-linux.cpp
+++ b/vm/os-linux.cpp
@@ -6,7 +6,7 @@ namespace factor
/* Snarfed from SBCL linux-so.c. You must free() this yourself. */
const char *vm_executable_path()
{
- char *path = (char *)safe_malloc(PATH_MAX + 1);
+ char *path = (char *)vm->safe_malloc(PATH_MAX + 1);
int size = readlink("/proc/self/exe", path, PATH_MAX);
if (size < 0)
@@ -17,7 +17,7 @@ const char *vm_executable_path()
else
{
path[size] = '\0';
- return safe_strdup(path);
+ return vm->safe_strdup(path);
}
}
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 3785aeda72..67327e7d30 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -58,7 +58,7 @@ void ffi_dlclose(dll *dll)
PRIMITIVE(existsp)
{
struct stat sb;
- char *path = (char *)(untag_check<byte_array>(dpop()) + 1);
+ char *path = (char *)(vm->untag_check<byte_array>(dpop()) + 1);
box_boolean(stat(path,&sb) >= 0);
}
@@ -79,7 +79,7 @@ segment *alloc_segment(cell size)
if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1)
fatal_error("Cannot protect high guard page",(cell)array);
- segment *retval = (segment *)safe_malloc(sizeof(segment));
+ segment *retval = (segment *)vm->safe_malloc(sizeof(segment));
retval->start = (cell)(array + pagesize);
retval->size = size;
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index 8aff18364e..52dc1bfd6e 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -40,7 +40,7 @@ typedef char symbol_char;
#define OPEN_READ(path) fopen(path,"rb")
#define OPEN_WRITE(path) fopen(path,"wb")
-#define print_native_string(string) print_string(string)
+#define print_native_string(string) vm->print_string(string)
void start_thread(void *(*start_routine)(void *));
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 7b03ada175..b28fb1d3a1 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -92,7 +92,7 @@ bool quotation_jit::stack_frame_p()
switch(tagged<object>(obj).type())
{
case WORD_TYPE:
- if(untag<word>(obj)->subprimitive == F)
+ if(myvm->untag<word>(obj)->subprimitive == F)
return true;
break;
case QUOTATION_TYPE:
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index b73f3aeb7a..2bf058212f 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -64,20 +64,9 @@ template <typename TYPE> TYPE *factorvm::untag_check(cell value)
return tagged<TYPE>(value).untag_check(this);
}
-template <typename TYPE> TYPE *untag_check(cell value)
-{
- return vm->untag_check<TYPE>(value);
-}
-
template <typename TYPE> TYPE *factorvm::untag(cell value)
{
return tagged<TYPE>(value).untagged();
}
-template <typename TYPE> TYPE *untag(cell value)
-{
- return vm->untag<TYPE>(value);
-}
-
-
}
diff --git a/vm/utilities.cpp b/vm/utilities.cpp
index a1e3f30e00..4f4da9a1bc 100755
--- a/vm/utilities.cpp
+++ b/vm/utilities.cpp
@@ -11,11 +11,6 @@ void *factorvm::safe_malloc(size_t size)
return ptr;
}
-void *safe_malloc(size_t size)
-{
- return vm->safe_malloc(size);
-}
-
vm_char *factorvm::safe_strdup(const vm_char *str)
{
vm_char *ptr = STRDUP(str);
@@ -23,10 +18,6 @@ vm_char *factorvm::safe_strdup(const vm_char *str)
return ptr;
}
-vm_char *safe_strdup(const vm_char *str)
-{
- return vm->safe_strdup(str);
-}
/* We don't use printf directly, because format directives are not portable.
Instead we define the common cases here. */
@@ -40,10 +31,6 @@ void factorvm::print_string(const char *str)
fputs(str,stdout);
}
-void print_string(const char *str)
-{
- return vm->print_string(str);
-}
void factorvm::print_cell(cell x)
{
diff --git a/vm/utilities.hpp b/vm/utilities.hpp
index bc7f7d918a..412ef35bb4 100755
--- a/vm/utilities.hpp
+++ b/vm/utilities.hpp
@@ -1,7 +1,4 @@
namespace factor
{
-void *safe_malloc(size_t size);
-vm_char *safe_strdup(const vm_char *str);
-void print_string(const char *str);
}
From 700e03a6a61caa508b81a059b8508e983cef97b7 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 21:19:35 +0100
Subject: [PATCH 145/266] removed some vm-> forwarding functions
---
vm/alien.cpp | 8 +-------
vm/code_heap.cpp | 6 ------
vm/code_heap.hpp | 3 ---
vm/mach_signal.cpp | 2 +-
vm/os-unix.cpp | 2 +-
vm/os-windows-nt.cpp | 2 +-
6 files changed, 4 insertions(+), 19 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index bed24d1037..282f5c2fc9 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -93,12 +93,6 @@ void *factorvm::alien_pointer()
return unbox_alien() + offset;
}
-void *alien_pointer()
-{
- return vm->alien_pointer();
-}
-
-
/* define words to read/write values at an alien address */
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
@@ -232,7 +226,7 @@ char *factorvm::unbox_alien()
VM_C_API char *unbox_alien()
{
- printf("*PHIL unbox_alien\n");fflush(stdout);
+ printf("PHIL unbox_alien\n");fflush(stdout);
return vm->unbox_alien();
}
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index d91e349db7..372e194cf6 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -9,17 +9,11 @@ void factorvm::init_code_heap(cell size)
new_heap(&code,size);
}
-
bool factorvm::in_code_heap_p(cell ptr)
{
return (ptr >= code.seg->start && ptr <= code.seg->end);
}
-bool in_code_heap_p(cell ptr)
-{
- return vm->in_code_heap_p(ptr); // used by os specific signal handlers
-}
-
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
{
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 32e1dacfee..a357699591 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -1,8 +1,5 @@
namespace factor
{
-
-bool in_code_heap_p(cell ptr); // Used by platform specific code
-
struct factorvm;
typedef void (*code_heap_iterator)(code_block *compiled,factorvm *myvm);
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index d8eea06f0b..df5d78d35e 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -41,7 +41,7 @@ static void call_fault_handler(
a divide by zero or stack underflow in the listener */
/* Are we in compiled Factor code? Then use the current stack pointer */
- if(in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
+ if(vm->in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
/* Are we in C? Then use the saved callstack top */
else
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 67327e7d30..c96addb6f4 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -107,7 +107,7 @@ static stack_frame *uap_stack_pointer(void *uap)
delivered during stack frame setup/teardown or while transitioning
from Factor to C is a sign of things seriously gone wrong, not just
a divide by zero or stack underflow in the listener */
- if(in_code_heap_p(UAP_PROGRAM_COUNTER(uap)))
+ if(vm->in_code_heap_p(UAP_PROGRAM_COUNTER(uap)))
{
stack_frame *ptr = (stack_frame *)ucontext_stack_pointer(uap);
if(!ptr)
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 9187b88986..49594ed14a 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -21,7 +21,7 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
- if(in_code_heap_p(c->EIP))
+ if(vm->in_code_heap_p(c->EIP))
signal_callstack_top = (stack_frame *)c->ESP;
else
signal_callstack_top = NULL;
From 20ef4200fb44f748e07bf3727ece63fec514144b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 23 Aug 2009 21:39:17 +0100
Subject: [PATCH 146/266] removed some error vm-> functions
---
vm/errors.cpp | 28 ----------------------------
vm/errors.hpp | 9 ---------
vm/mach_signal.cpp | 6 +++---
vm/os-linux-arm.cpp | 2 +-
vm/os-linux.cpp | 8 ++++----
vm/os-unix.cpp | 36 ++++++++++++++++++------------------
vm/os-windows-ce.cpp | 4 ++--
vm/vm.hpp | 4 ++--
8 files changed, 30 insertions(+), 67 deletions(-)
diff --git a/vm/errors.cpp b/vm/errors.cpp
index e1266cf608..09b397dd02 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -17,11 +17,6 @@ void factorvm::out_of_memory()
exit(1);
}
-void out_of_memory()
-{
- return vm->out_of_memory();
-}
-
void factorvm::fatal_error(const char* msg, cell tagged)
{
print_string("fatal_error: "); print_string(msg);
@@ -29,11 +24,6 @@ void factorvm::fatal_error(const char* msg, cell tagged)
exit(1);
}
-void fatal_error(const char* msg, cell tagged)
-{
- return vm->fatal_error(msg,tagged);
-}
-
void factorvm::critical_error(const char* msg, cell tagged)
{
print_string("You have triggered a bug in Factor. Please report.\n");
@@ -42,11 +32,6 @@ void factorvm::critical_error(const char* msg, cell tagged)
factorbug();
}
-void critical_error(const char* msg, cell tagged)
-{
- return vm->critical_error(msg,tagged);
-}
-
void factorvm::throw_error(cell error, stack_frame *callstack_top)
{
/* If the error handler is set, we rewind any C stack frames and
@@ -98,10 +83,6 @@ void factorvm::general_error(vm_error_type error, cell arg1, cell arg2, stack_fr
tag_fixnum(error),arg1,arg2),callstack_top);
}
-void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top)
-{
- return vm->general_error(error,arg1,arg2,callstack_top);
-}
void factorvm::type_error(cell type, cell tagged)
{
@@ -113,10 +94,6 @@ void factorvm::not_implemented_error()
general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
}
-void not_implemented_error()
-{
- return vm->not_implemented_error();
-}
/* Test if 'fault' is in the guard page at the top or bottom (depending on
offset being 0 or -1) of area+area_size */
@@ -155,11 +132,6 @@ void factorvm::divide_by_zero_error()
general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
}
-void divide_by_zero_error()
-{
- return vm->divide_by_zero_error();
-}
-
void factorvm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
{
general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),F,signal_callstack_top);
diff --git a/vm/errors.hpp b/vm/errors.hpp
index 69a90b70e2..cc85cfd0a8 100755
--- a/vm/errors.hpp
+++ b/vm/errors.hpp
@@ -23,16 +23,7 @@ enum vm_error_type
ERROR_FP_TRAP,
};
-void out_of_memory();
-void fatal_error(const char* msg, cell tagged);
-void critical_error(const char* msg, cell tagged);
-
PRIMITIVE(die);
-
-void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
-void not_implemented_error();
-void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
-
PRIMITIVE(call_clear);
PRIMITIVE(unimplemented);
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index df5d78d35e..7b050f72dc 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -203,13 +203,13 @@ void mach_initialize ()
/* Allocate a port on which the thread shall listen for exceptions. */
if (mach_port_allocate (self, MACH_PORT_RIGHT_RECEIVE, &our_exception_port)
!= KERN_SUCCESS)
- fatal_error("mach_port_allocate() failed",0);
+ vm->fatal_error("mach_port_allocate() failed",0);
/* See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/mach_port_insert_right.html. */
if (mach_port_insert_right (self, our_exception_port, our_exception_port,
MACH_MSG_TYPE_MAKE_SEND)
!= KERN_SUCCESS)
- fatal_error("mach_port_insert_right() failed",0);
+ vm->fatal_error("mach_port_insert_right() failed",0);
/* The exceptions we want to catch. */
mask = EXC_MASK_BAD_ACCESS | EXC_MASK_ARITHMETIC;
@@ -226,7 +226,7 @@ void mach_initialize ()
if (task_set_exception_ports (self, mask, our_exception_port,
EXCEPTION_DEFAULT, MACHINE_THREAD_STATE)
!= KERN_SUCCESS)
- fatal_error("task_set_exception_ports() failed",0);
+ vm->fatal_error("task_set_exception_ports() failed",0);
}
}
diff --git a/vm/os-linux-arm.cpp b/vm/os-linux-arm.cpp
index 8e131b9011..9a9ce7ada5 100644
--- a/vm/os-linux-arm.cpp
+++ b/vm/os-linux-arm.cpp
@@ -25,7 +25,7 @@ void flush_icache(cell start, cell len)
: "r0","r1","r2");
if(result < 0)
- critical_error("flush_icache() failed",result);
+ vm->critical_error("flush_icache() failed",result);
}
}
diff --git a/vm/os-linux.cpp b/vm/os-linux.cpp
index 62deb70f01..c21f8142a1 100644
--- a/vm/os-linux.cpp
+++ b/vm/os-linux.cpp
@@ -11,7 +11,7 @@ const char *vm_executable_path()
int size = readlink("/proc/self/exe", path, PATH_MAX);
if (size < 0)
{
- fatal_error("Cannot read /proc/self/exe",0);
+ vm->fatal_error("Cannot read /proc/self/exe",0);
return NULL;
}
else
@@ -42,19 +42,19 @@ VM_C_API int inotify_rm_watch(int fd, u32 wd)
VM_C_API int inotify_init()
{
- not_implemented_error();
+ vm->not_implemented_error();
return -1;
}
VM_C_API int inotify_add_watch(int fd, const char *name, u32 mask)
{
- not_implemented_error();
+ vm->not_implemented_error();
return -1;
}
VM_C_API int inotify_rm_watch(int fd, u32 wd)
{
- not_implemented_error();
+ vm->not_implemented_error();
return -1;
}
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index c96addb6f4..3cb7295996 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -9,11 +9,11 @@ void start_thread(void *(*start_routine)(void *))
pthread_t thread;
if (pthread_attr_init (&attr) != 0)
- fatal_error("pthread_attr_init() failed",0);
+ vm->fatal_error("pthread_attr_init() failed",0);
if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) != 0)
- fatal_error("pthread_attr_setdetachstate() failed",0);
+ vm->fatal_error("pthread_attr_setdetachstate() failed",0);
if (pthread_create (&thread, &attr, start_routine, NULL) != 0)
- fatal_error("pthread_create() failed",0);
+ vm->fatal_error("pthread_create() failed",0);
pthread_attr_destroy (&attr);
}
@@ -51,7 +51,7 @@ void *ffi_dlsym(dll *dll, symbol_char *symbol)
void ffi_dlclose(dll *dll)
{
if(dlclose(dll->dll))
- general_error(ERROR_FFI,F,F,NULL);
+ vm->general_error(ERROR_FFI,F,F,NULL);
dll->dll = NULL;
}
@@ -71,13 +71,13 @@ segment *alloc_segment(cell size)
MAP_ANON | MAP_PRIVATE,-1,0);
if(array == (char*)-1)
- out_of_memory();
+ vm->out_of_memory();
if(mprotect(array,pagesize,PROT_NONE) == -1)
- fatal_error("Cannot protect low guard page",(cell)array);
+ vm->fatal_error("Cannot protect low guard page",(cell)array);
if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1)
- fatal_error("Cannot protect high guard page",(cell)array);
+ vm->fatal_error("Cannot protect high guard page",(cell)array);
segment *retval = (segment *)vm->safe_malloc(sizeof(segment));
@@ -96,7 +96,7 @@ void dealloc_segment(segment *block)
pagesize + block->size + pagesize);
if(retval)
- fatal_error("dealloc_segment failed",0);
+ vm->fatal_error("dealloc_segment failed",0);
free(block);
}
@@ -111,7 +111,7 @@ static stack_frame *uap_stack_pointer(void *uap)
{
stack_frame *ptr = (stack_frame *)ucontext_stack_pointer(uap);
if(!ptr)
- critical_error("Invalid uap",(cell)uap);
+ vm->critical_error("Invalid uap",(cell)uap);
return ptr;
}
else
@@ -154,7 +154,7 @@ static void sigaction_safe(int signum, const struct sigaction *act, struct sigac
while(ret == -1 && errno == EINTR);
if(ret == -1)
- fatal_error("sigaction failed", 0);
+ vm->fatal_error("sigaction failed", 0);
}
void unix_init_signals()
@@ -216,7 +216,7 @@ extern "C" {
void safe_close(int fd)
{
if(close(fd) < 0)
- fatal_error("error closing fd",errno);
+ vm->fatal_error("error closing fd",errno);
}
bool check_write(int fd, void *data, ssize_t size)
@@ -235,7 +235,7 @@ bool check_write(int fd, void *data, ssize_t size)
void safe_write(int fd, void *data, ssize_t size)
{
if(!check_write(fd,data,size))
- fatal_error("error writing fd",errno);
+ vm->fatal_error("error writing fd",errno);
}
bool safe_read(int fd, void *data, ssize_t size)
@@ -247,7 +247,7 @@ bool safe_read(int fd, void *data, ssize_t size)
return safe_read(fd,data,size);
else
{
- fatal_error("error reading fd",errno);
+ vm->fatal_error("error reading fd",errno);
return false;
}
}
@@ -266,7 +266,7 @@ void *stdin_loop(void *arg)
break;
if(buf[0] != 'X')
- fatal_error("stdin_loop: bad data on control fd",buf[0]);
+ vm->fatal_error("stdin_loop: bad data on control fd",buf[0]);
for(;;)
{
@@ -303,19 +303,19 @@ void open_console()
int filedes[2];
if(pipe(filedes) < 0)
- fatal_error("Error opening control pipe",errno);
+ vm->fatal_error("Error opening control pipe",errno);
control_read = filedes[0];
control_write = filedes[1];
if(pipe(filedes) < 0)
- fatal_error("Error opening size pipe",errno);
+ vm->fatal_error("Error opening size pipe",errno);
size_read = filedes[0];
size_write = filedes[1];
if(pipe(filedes) < 0)
- fatal_error("Error opening stdin pipe",errno);
+ vm->fatal_error("Error opening stdin pipe",errno);
stdin_read = filedes[0];
stdin_write = filedes[1];
@@ -330,7 +330,7 @@ VM_C_API void wait_for_stdin()
if(errno == EINTR)
wait_for_stdin();
else
- fatal_error("Error writing control fd",errno);
+ vm->fatal_error("Error writing control fd",errno);
}
}
diff --git a/vm/os-windows-ce.cpp b/vm/os-windows-ce.cpp
index a3192b07f5..6454535f43 100644
--- a/vm/os-windows-ce.cpp
+++ b/vm/os-windows-ce.cpp
@@ -26,13 +26,13 @@ void flush_icache(cell start, cell end)
char *getenv(char *name)
{
- not_implemented_error();
+ vm->not_implemented_error();
return 0; /* unreachable */
}
PRIMITIVE(os_envs)
{
- not_implemented_error();
+ vm->not_implemented_error();
}
void c_to_factor_toplevel(cell quot)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 1b0274e0b1..50006d012a 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -68,14 +68,14 @@ struct factorvm {
void memory_protection_error(cell addr, stack_frame *native_stack);
void signal_error(int signal, stack_frame *native_stack);
void divide_by_zero_error();
- void fp_trap_error(stack_frame *signal_callstack_top);
+ void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
inline void vmprim_call_clear();
inline void vmprim_unimplemented();
void memory_signal_handler_impl();
void misc_signal_handler_impl();
void fp_signal_handler_impl();
void type_error(cell type, cell tagged);
- void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top);
+ void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
//callstack
From e2d246f37158b09a0cffd64dd30f86a3f7c2c4ba Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 18:34:30 +0100
Subject: [PATCH 147/266] removed most global functions from factor.cpp
---
vm/factor.cpp | 116 +++++++++++---------------------------------------
vm/factor.hpp | 10 -----
2 files changed, 24 insertions(+), 102 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 883b4f9462..0c47e2329a 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-factorvm *vm = new factorvm;
+factorvm *vm;
void factorvm::default_parameters(vm_parameters *p)
{
@@ -45,11 +45,6 @@ void factorvm::default_parameters(vm_parameters *p)
p->stack_traces = true;
}
-VM_C_API void default_parameters(vm_parameters *p)
-{
- return vm->default_parameters(p);
-}
-
bool factorvm::factor_arg(const vm_char* str, const vm_char* arg, cell* value)
{
int val;
@@ -62,11 +57,6 @@ bool factorvm::factor_arg(const vm_char* str, const vm_char* arg, cell* value)
return false;
}
-bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
-{
- return vm->factor_arg(str,arg,value);
-}
-
void factorvm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
{
default_parameters(p);
@@ -92,11 +82,6 @@ void factorvm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **a
}
}
-VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
-{
- return vm->init_parameters_from_args(p,argc,argv);
-}
-
/* Do some initialization that we do once only */
void factorvm::do_stage1_init()
{
@@ -110,11 +95,6 @@ void factorvm::do_stage1_init()
fflush(stdout);
}
-void do_stage1_init()
-{
- return vm->do_stage1_init();
-}
-
void factorvm::init_factor(vm_parameters *p)
{
/* Kilobytes */
@@ -171,11 +151,6 @@ void factorvm::init_factor(vm_parameters *p)
}
}
-VM_C_API void init_factor(vm_parameters *p)
-{
- return vm->init_factor(p);
-}
-
/* May allocate memory */
void factorvm::pass_args_to_factor(int argc, vm_char **argv)
{
@@ -189,11 +164,6 @@ void factorvm::pass_args_to_factor(int argc, vm_char **argv)
userenv[ARGS_ENV] = args.elements.value();
}
-VM_C_API void pass_args_to_factor(int argc, vm_char **argv)
-{
- return vm->pass_args_to_factor(argc,argv);
-}
-
void factorvm::start_factor(vm_parameters *p)
{
if(p->fep) factorbug();
@@ -203,20 +173,28 @@ void factorvm::start_factor(vm_parameters *p)
unnest_stacks();
}
-void start_factor(vm_parameters *p)
+
+char *factorvm::factor_eval_string(char *string)
{
- return vm->start_factor(p);
+ char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
+ return callback(string);
}
-void factorvm::start_embedded_factor(vm_parameters *p)
+void factorvm::factor_eval_free(char *result)
{
- userenv[EMBEDDED_ENV] = T;
- start_factor(p);
+ free(result);
}
-VM_C_API void start_embedded_factor(vm_parameters *p)
+void factorvm::factor_yield()
{
- return vm->start_embedded_factor(p);
+ void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
+ callback();
+}
+
+void factorvm::factor_sleep(long us)
+{
+ void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
+ callback(us);
}
void factorvm::start_standalone_factor(int argc, vm_char **argv)
@@ -229,54 +207,6 @@ void factorvm::start_standalone_factor(int argc, vm_char **argv)
start_factor(&p);
}
-VM_C_API void start_standalone_factor(int argc, vm_char **argv)
-{
- return vm->start_standalone_factor(argc,argv);
-}
-
-char *factorvm::factor_eval_string(char *string)
-{
- char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
- return callback(string);
-}
-
-VM_C_API char *factor_eval_string(char *string)
-{
- return vm->factor_eval_string(string);
-}
-
-void factorvm::factor_eval_free(char *result)
-{
- free(result);
-}
-
-VM_C_API void factor_eval_free(char *result)
-{
- return vm->factor_eval_free(result);
-}
-
-void factorvm::factor_yield()
-{
- void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
- callback();
-}
-
-VM_C_API void factor_yield()
-{
- return vm->factor_yield();
-}
-
-void factorvm::factor_sleep(long us)
-{
- void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
- callback(us);
-}
-
-VM_C_API void factor_sleep(long us)
-{
- return vm->factor_sleep(us);
-}
-
struct startargs {
int argc;
vm_char **argv;
@@ -286,16 +216,18 @@ void* start_standalone_factor_thread(void *arg)
{
factorvm *newvm = new factorvm;
startargs *args = (startargs*) arg;
- vm_parameters p;
- newvm->default_parameters(&p);
- newvm->init_parameters_from_args(&p,args->argc, args->argv);
- newvm->init_factor(&p);
- newvm->pass_args_to_factor(args->argc,args->argv);
- newvm->start_factor(&p);
+ newvm->start_standalone_factor(args->argc, args->argv);
return 0;
}
+VM_C_API void start_standalone_factor(int argc, vm_char **argv)
+{
+ factorvm *newvm = new factorvm;
+ vm = newvm;
+ return newvm->start_standalone_factor(argc,argv);
+}
+
VM_C_API void start_standalone_factor_in_new_thread(int argc, vm_char **argv)
{
startargs *args = new startargs; // leaks startargs structure
diff --git a/vm/factor.hpp b/vm/factor.hpp
index b2aeccd1a6..5c5b92dff2 100644
--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@@ -1,17 +1,7 @@
namespace factor
{
-VM_C_API void default_parameters(vm_parameters *p);
-VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv);
-VM_C_API void init_factor(vm_parameters *p);
-VM_C_API void pass_args_to_factor(int argc, vm_char **argv);
-VM_C_API void start_embedded_factor(vm_parameters *p);
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
VM_C_API void start_standalone_factor_in_new_thread(int argc, vm_char **argv);
-VM_C_API char *factor_eval_string(char *string);
-VM_C_API void factor_eval_free(char *result);
-VM_C_API void factor_yield();
-VM_C_API void factor_sleep(long ms);
-
}
From e05f91f3a8bff7a7413e2d0d5bc897e6613e4d71 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 19:15:39 +0100
Subject: [PATCH 148/266] cleaning up stray vm singleton usage
---
vm/code_block.cpp | 4 ++--
vm/inlineimpls.hpp | 3 +--
2 files changed, 3 insertions(+), 4 deletions(-)
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 9eec4a2ea6..c2dfe1cac3 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -345,8 +345,8 @@ void copy_literal_references(code_block *compiled, factorvm *myvm)
void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
{
#ifdef FACTOR_DEBUG
- tagged<array>(compiled->literals).untag_check(vm);
- tagged<byte_array>(compiled->relocation).untag_check(vm);
+ tagged<array>(compiled->literals).untag_check(this);
+ tagged<byte_array>(compiled->relocation).untag_check(this);
#endif
store_address_in_code_block(relocation_class_of(rel),
diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp
index 6b74634715..a247afa4d7 100644
--- a/vm/inlineimpls.hpp
+++ b/vm/inlineimpls.hpp
@@ -176,7 +176,6 @@ struct gc_root : public tagged<TYPE>
void push() { myvm->check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
- //explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
@@ -344,7 +343,7 @@ inline double factorvm::fixnum_to_float(cell tagged)
keep the callstack in a GC root and use relative offsets */
template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
{
- gc_root<callstack> stack(stack_,vm);
+ gc_root<callstack> stack(stack_,this);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
while(frame_offset >= 0)
From e98f168a11e58ef4fe9d36e16b02763e8a21bb95 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 20:10:56 +0100
Subject: [PATCH 149/266] print_native_string doesn't need singleton ptr
---
vm/os-unix.hpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index 52dc1bfd6e..8aff18364e 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -40,7 +40,7 @@ typedef char symbol_char;
#define OPEN_READ(path) fopen(path,"rb")
#define OPEN_WRITE(path) fopen(path,"wb")
-#define print_native_string(string) vm->print_string(string)
+#define print_native_string(string) print_string(string)
void start_thread(void *(*start_routine)(void *));
From 12ca7bdc57c4958b6d6079a3eb3737420c1bdde6 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 20:26:10 +0100
Subject: [PATCH 150/266] added factorvm ptrs to the rest of alien functions.
(Left commented debug lines to remind me that these haven't been tested yet, and some are osx specific)
---
vm/alien.cpp | 30 +++++++++++++++---------------
vm/alien.hpp | 10 +++++-----
2 files changed, 20 insertions(+), 20 deletions(-)
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 282f5c2fc9..9eb6da9784 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -224,10 +224,10 @@ char *factorvm::unbox_alien()
return alien_offset(dpop());
}
-VM_C_API char *unbox_alien()
+VM_C_API char *unbox_alien(factorvm *myvm)
{
- printf("PHIL unbox_alien\n");fflush(stdout);
- return vm->unbox_alien();
+ //printf("PHIL unbox_alien %d %d\n",vm,myvm);fflush(stdout);
+ return VM_PTR->unbox_alien();
}
/* make an alien and push */
@@ -251,10 +251,10 @@ void factorvm::to_value_struct(cell src, void *dest, cell size)
memcpy(dest,alien_offset(src),size);
}
-VM_C_API void to_value_struct(cell src, void *dest, cell size)
+VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *myvm)
{
- printf("PHIL to_value_struct\n");
- return vm->to_value_struct(src,dest,size);
+ //printf("PHIL to_value_struct %d %d\n",vm,myvm);fflush(stdout);
+ return VM_PTR->to_value_struct(src,dest,size);
}
/* for FFI callbacks receiving structs by value */
@@ -265,10 +265,10 @@ void factorvm::box_value_struct(void *src, cell size)
dpush(tag<byte_array>(bytes));
}
-VM_C_API void box_value_struct(void *src, cell size)
+VM_C_API void box_value_struct(void *src, cell size,factorvm *myvm)
{
- printf("PHIL box_value_struct\n");
- return vm->box_value_struct(src,size);
+ //printf("PHIL box_value_struct %d %d\n",vm,myvm);fflush(stdout);
+ return VM_PTR->box_value_struct(src,size);
}
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
@@ -280,10 +280,10 @@ void factorvm::box_small_struct(cell x, cell y, cell size)
box_value_struct(data,size);
}
-VM_C_API void box_small_struct(cell x, cell y, cell size)
+VM_C_API void box_small_struct(cell x, cell y, cell size, factorvm *myvm)
{
- printf("PHIL box_small_struct\n");
- return vm->box_small_struct(x,y,size);
+ //printf("PHIL box_small_struct %d %d\n",vm,myvm);fflush(stdout);
+ return VM_PTR->box_small_struct(x,y,size);
}
/* On OS X/PPC, complex numbers are returned in registers. */
@@ -297,10 +297,10 @@ void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
box_value_struct(data,size);
}
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factorvm *myvm)
{
- printf("PHIL box_medium_struct\n");
- return vm->box_medium_struct(x1, x2, x3, x4, size);
+ //printf("PHIL box_medium_struct %d %d\n",vm,myvm);fflush(stdout);
+ return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
}
}
diff --git a/vm/alien.hpp b/vm/alien.hpp
index 327d791406..7b537146fd 100755
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@@ -37,11 +37,11 @@ PRIMITIVE(dlclose);
PRIMITIVE(dll_validp);
VM_C_API char *alien_offset(cell object, factorvm *vm);
-VM_C_API char *unbox_alien();
+VM_C_API char *unbox_alien(factorvm *vm);
VM_C_API void box_alien(void *ptr, factorvm *vm);
-VM_C_API void to_value_struct(cell src, void *dest, cell size);
-VM_C_API void box_value_struct(void *src, cell size);
-VM_C_API void box_small_struct(cell x, cell y, cell size);
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
+VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *vm);
+VM_C_API void box_value_struct(void *src, cell size,factorvm *vm);
+VM_C_API void box_small_struct(cell x, cell y, cell size,factorvm *vm);
+VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factorvm *vm);
}
From 9cac5e8aa99cc255eac8c32e0a2759076a82e273 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 20:46:34 +0100
Subject: [PATCH 151/266] added lookup_vm and removed last usage of vm from
windows code
---
vm/errors.cpp | 6 +++---
vm/errors.hpp | 7 -------
vm/factor.cpp | 15 +++++++++++++++
vm/mach_signal.cpp | 8 ++++----
vm/os-unix.cpp | 8 ++++----
vm/os-unix.hpp | 1 +
vm/os-windows-nt.cpp | 23 ++++++++++++-----------
vm/os-windows-nt.hpp | 5 +++--
vm/vm.hpp | 8 ++++++++
9 files changed, 50 insertions(+), 31 deletions(-)
diff --git a/vm/errors.cpp b/vm/errors.cpp
index 09b397dd02..09e6313f29 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -165,7 +165,7 @@ void factorvm::memory_signal_handler_impl()
void memory_signal_handler_impl()
{
- return vm->memory_signal_handler_impl();
+ SIGNAL_VM_PTR->misc_signal_handler_impl();
}
void factorvm::misc_signal_handler_impl()
@@ -175,7 +175,7 @@ void factorvm::misc_signal_handler_impl()
void misc_signal_handler_impl()
{
- vm->misc_signal_handler_impl();
+ SIGNAL_VM_PTR->misc_signal_handler_impl();
}
void factorvm::fp_signal_handler_impl()
@@ -185,7 +185,7 @@ void factorvm::fp_signal_handler_impl()
void fp_signal_handler_impl()
{
- vm->fp_signal_handler_impl();
+ SIGNAL_VM_PTR->fp_signal_handler_impl();
}
}
diff --git a/vm/errors.hpp b/vm/errors.hpp
index cc85cfd0a8..8725941920 100755
--- a/vm/errors.hpp
+++ b/vm/errors.hpp
@@ -27,13 +27,6 @@ PRIMITIVE(die);
PRIMITIVE(call_clear);
PRIMITIVE(unimplemented);
-/* Global variables used to pass fault handler state from signal handler to
-user-space */
-extern cell signal_number;
-extern cell signal_fault_addr;
-extern unsigned int signal_fpu_status;
-extern stack_frame *signal_callstack_top;
-
void memory_signal_handler_impl();
void fp_signal_handler_impl();
void misc_signal_handler_impl();
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 0c47e2329a..6e31a02cab 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -5,6 +5,19 @@ namespace factor
factorvm *vm;
+unordered_map<long,factorvm*> thread_vms;
+
+factorvm *lookup_vm(long threadid)
+{
+ return thread_vms[threadid];
+}
+
+void register_vm(long threadid, factorvm *vm)
+{
+ thread_vms[threadid] = vm;
+}
+
+
void factorvm::default_parameters(vm_parameters *p)
{
p->image_path = NULL;
@@ -199,6 +212,8 @@ void factorvm::factor_sleep(long us)
void factorvm::start_standalone_factor(int argc, vm_char **argv)
{
+ printf("thread id is %d\n",GetCurrentThreadId());fflush(stdout);
+ register_vm(GetCurrentThreadId(),this);
vm_parameters p;
default_parameters(&p);
init_parameters_from_args(&p,argc,argv);
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index 7b050f72dc..ca3b7aa161 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -42,17 +42,17 @@ static void call_fault_handler(
/* Are we in compiled Factor code? Then use the current stack pointer */
if(vm->in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
- signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
+ vm->signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
/* Are we in C? Then use the saved callstack top */
else
- signal_callstack_top = NULL;
+ vm->signal_callstack_top = NULL;
MACH_STACK_POINTER(thread_state) = fix_stack_pointer(MACH_STACK_POINTER(thread_state));
/* Now we point the program counter at the right handler function. */
if(exception == EXC_BAD_ACCESS)
{
- signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
+ vm->signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
MACH_PROGRAM_COUNTER(thread_state) = (cell)memory_signal_handler_impl;
}
else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV)
@@ -63,7 +63,7 @@ static void call_fault_handler(
}
else
{
- signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
+ vm->signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
MACH_PROGRAM_COUNTER(thread_state) = (cell)misc_signal_handler_impl;
}
}
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 3cb7295996..97e1e0c04d 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -120,15 +120,15 @@ static stack_frame *uap_stack_pointer(void *uap)
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- signal_fault_addr = (cell)siginfo->si_addr;
- signal_callstack_top = uap_stack_pointer(uap);
+ vm->signal_fault_addr = (cell)siginfo->si_addr;
+ vm->signal_callstack_top = uap_stack_pointer(uap);
UAP_PROGRAM_COUNTER(uap) = (cell)memory_signal_handler_impl;
}
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- signal_number = signal;
- signal_callstack_top = uap_stack_pointer(uap);
+ vm->signal_number = signal;
+ vm->signal_callstack_top = uap_stack_pointer(uap);
UAP_PROGRAM_COUNTER(uap) = (cell)misc_signal_handler_impl;
}
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index 8aff18364e..b7e528a421 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -58,4 +58,5 @@ void sleep_micros(cell usec);
void open_console();
+#define SIGNAL_VM_PTR vm
}
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 49594ed14a..a4cdbc66af 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -3,8 +3,8 @@
namespace factor
{
-void start_thread(void *(*start_routine)(void *),void *args){
- CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
+void *start_thread(void *(*start_routine)(void *),void *args){
+ return CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
}
@@ -18,18 +18,19 @@ s64 factorvm::current_micros()
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
+ printf("exception handler %d\n",GetCurrentThreadId());
+ factorvm *myvm = lookup_vm(GetCurrentThreadId());
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
- if(vm->in_code_heap_p(c->EIP))
- signal_callstack_top = (stack_frame *)c->ESP;
+ if(myvm->in_code_heap_p(c->EIP))
+ myvm->signal_callstack_top = (stack_frame *)c->ESP;
else
- signal_callstack_top = NULL;
+ myvm->signal_callstack_top = NULL;
- switch (e->ExceptionCode)
- {
- case EXCEPTION_ACCESS_VIOLATION:
- signal_fault_addr = e->ExceptionInformation[1];
+ switch (e->ExceptionCode) {
+ case EXCEPTION_ACCESS_VIOLATION:
+ myvm->signal_fault_addr = e->ExceptionInformation[1];
c->EIP = (cell)memory_signal_handler_impl;
break;
@@ -42,7 +43,7 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
case STATUS_FLOAT_UNDERFLOW:
case STATUS_FLOAT_MULTIPLE_FAULTS:
case STATUS_FLOAT_MULTIPLE_TRAPS:
- signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
+ myvm->signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
X87SW(c) = 0;
MXCSR(c) &= 0xffffffc0;
c->EIP = (cell)fp_signal_handler_impl;
@@ -56,7 +57,7 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
enabled. Don't really have any idea what this exception means. */
break;
default:
- signal_number = e->ExceptionCode;
+ myvm->signal_number = e->ExceptionCode;
c->EIP = (cell)misc_signal_handler_impl;
break;
}
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index 27923a000a..e5c5adadf1 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -21,12 +21,13 @@ typedef char symbol_char;
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
-
// SSE traps raise these exception codes, which are defined in internal NT headers
// but not winbase.h
#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4
#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5
-void start_thread(void *(*start_routine)(void *),void *args);
+void *start_thread(void *(*start_routine)(void *),void *args);
+
+#define SIGNAL_VM_PTR lookup_vm(GetCurrentThreadId())
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 50006d012a..b3e40640b7 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -59,6 +59,12 @@ struct factorvm {
inline void vmprim_profiling();
// errors
+ /* Global variables used to pass fault handler state from signal handler to
+ user-space */
+ cell signal_number;
+ cell signal_fault_addr;
+ unsigned int signal_fpu_status;
+ stack_frame *signal_callstack_top;
void out_of_memory();
void fatal_error(const char* msg, cell tagged);
void critical_error(const char* msg, cell tagged);
@@ -692,4 +698,6 @@ struct factorvm {
extern factorvm *vm;
+extern factorvm *lookup_vm(long threadid);
+extern void register_vm(long threadid,factorvm *vm);
}
From 5c2a28173a344a185aa301739531e5d239ba7ae6 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 20:59:05 +0100
Subject: [PATCH 152/266] Start windows factor in a spawned thread (for
testing)
---
vm/factor.cpp | 7 ++++---
vm/factor.hpp | 2 +-
vm/main-windows-nt.cpp | 2 ++
vm/os-windows-nt.cpp | 2 +-
4 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 6e31a02cab..bb30aae7ee 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -212,7 +212,7 @@ void factorvm::factor_sleep(long us)
void factorvm::start_standalone_factor(int argc, vm_char **argv)
{
- printf("thread id is %d\n",GetCurrentThreadId());fflush(stdout);
+ //printf("thread id is %d\n",GetCurrentThreadId());fflush(stdout);
register_vm(GetCurrentThreadId(),this);
vm_parameters p;
default_parameters(&p);
@@ -243,11 +243,12 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv)
return newvm->start_standalone_factor(argc,argv);
}
-VM_C_API void start_standalone_factor_in_new_thread(int argc, vm_char **argv)
+VM_C_API void *start_standalone_factor_in_new_thread(int argc, vm_char **argv)
{
startargs *args = new startargs; // leaks startargs structure
args->argc = argc; args->argv = argv;
- start_thread(start_standalone_factor_thread,args);
+ void *handle = start_thread(start_standalone_factor_thread,args);
+ return handle;
}
}
diff --git a/vm/factor.hpp b/vm/factor.hpp
index 5c5b92dff2..fbd6873c28 100644
--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@@ -2,6 +2,6 @@ namespace factor
{
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
-VM_C_API void start_standalone_factor_in_new_thread(int argc, vm_char **argv);
+VM_C_API void *start_standalone_factor_in_new_thread(int argc, vm_char **argv);
}
diff --git a/vm/main-windows-nt.cpp b/vm/main-windows-nt.cpp
index eaaad0f55b..4a0fc2ae35 100644
--- a/vm/main-windows-nt.cpp
+++ b/vm/main-windows-nt.cpp
@@ -17,6 +17,8 @@ int WINAPI WinMain(
}
factor::start_standalone_factor(nArgs,szArglist);
+ //HANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist);
+ //WaitForSingleObject(thread, INFINITE);
LocalFree(szArglist);
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index a4cdbc66af..b212287e5f 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -18,7 +18,7 @@ s64 factorvm::current_micros()
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
- printf("exception handler %d\n",GetCurrentThreadId());
+ //printf("exception handler %d\n",GetCurrentThreadId());fflush(stdout);
factorvm *myvm = lookup_vm(GetCurrentThreadId());
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
From aa005c948f8aadf91f218935d9bd1cb01977787a Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 24 Aug 2009 21:10:18 +0100
Subject: [PATCH 153/266] win32 main starts factorvm in new thread
---
vm/factor.cpp | 4 ++--
vm/factor.hpp | 1 -
vm/os-windows-nt.cpp | 12 ++++++++----
3 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index bb30aae7ee..77ad60bd47 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -170,8 +170,9 @@ void factorvm::pass_args_to_factor(int argc, vm_char **argv)
growable_array args(this);
int i;
- for(i = 1; i < argc; i++)
+ for(i = 1; i < argc; i++){
args.add(allot_alien(F,(cell)argv[i]));
+ }
args.trim();
userenv[ARGS_ENV] = args.elements.value();
@@ -212,7 +213,6 @@ void factorvm::factor_sleep(long us)
void factorvm::start_standalone_factor(int argc, vm_char **argv)
{
- //printf("thread id is %d\n",GetCurrentThreadId());fflush(stdout);
register_vm(GetCurrentThreadId(),this);
vm_parameters p;
default_parameters(&p);
diff --git a/vm/factor.hpp b/vm/factor.hpp
index fbd6873c28..b824758c8a 100644
--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@@ -3,5 +3,4 @@ namespace factor
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
VM_C_API void *start_standalone_factor_in_new_thread(int argc, vm_char **argv);
-
}
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index b212287e5f..c36c2f3f7e 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -18,7 +18,6 @@ s64 factorvm::current_micros()
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
- //printf("exception handler %d\n",GetCurrentThreadId());fflush(stdout);
factorvm *myvm = lookup_vm(GetCurrentThreadId());
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
@@ -64,12 +63,17 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
return EXCEPTION_CONTINUE_EXECUTION;
}
+bool handler_added = 0;
+
void factorvm::c_to_factor_toplevel(cell quot)
{
- if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
- fatal_error("AddVectoredExceptionHandler failed", 0);
+ if(!handler_added){
+ if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
+ fatal_error("AddVectoredExceptionHandler failed", 0);
+ handler_added = 1;
+ }
c_to_factor(quot,this);
- RemoveVectoredExceptionHandler((void *)exception_handler);
+ RemoveVectoredExceptionHandler((void *)exception_handler);
}
void factorvm::open_console()
From 6ddd3c654e5eea5bcc122076b8616855a37ead19 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 06:35:54 +0100
Subject: [PATCH 154/266] fixed up linux64 bootstrap (single threaded)
---
vm/factor.cpp | 5 ++---
vm/mach_signal.cpp | 2 +-
vm/os-unix.cpp | 21 ++++++++++++++++-----
vm/os-unix.hpp | 2 +-
vm/os-windows-nt.cpp | 4 ++++
vm/vm.hpp | 12 +++++++++---
6 files changed, 33 insertions(+), 13 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 77ad60bd47..a241ccf86b 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -213,7 +213,7 @@ void factorvm::factor_sleep(long us)
void factorvm::start_standalone_factor(int argc, vm_char **argv)
{
- register_vm(GetCurrentThreadId(),this);
+ register_vm(thread_id(),this);
vm_parameters p;
default_parameters(&p);
init_parameters_from_args(&p,argc,argv);
@@ -247,8 +247,7 @@ VM_C_API void *start_standalone_factor_in_new_thread(int argc, vm_char **argv)
{
startargs *args = new startargs; // leaks startargs structure
args->argc = argc; args->argv = argv;
- void *handle = start_thread(start_standalone_factor_thread,args);
- return handle;
+ return start_thread(start_standalone_factor_thread,args);
}
}
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index ca3b7aa161..c1d263527d 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -215,7 +215,7 @@ void mach_initialize ()
mask = EXC_MASK_BAD_ACCESS | EXC_MASK_ARITHMETIC;
/* Create the thread listening on the exception port. */
- start_thread(mach_exception_thread);
+ start_thread(mach_exception_thread,NULL);
/* Replace the exception port info for these exceptions with our own.
Note that we replace the exception port for the entire task, not only
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 97e1e0c04d..4de5ede704 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -3,18 +3,18 @@
namespace factor
{
-void start_thread(void *(*start_routine)(void *))
+void *start_thread(void *(*start_routine)(void *),void *args)
{
pthread_attr_t attr;
pthread_t thread;
-
if (pthread_attr_init (&attr) != 0)
vm->fatal_error("pthread_attr_init() failed",0);
if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) != 0)
vm->fatal_error("pthread_attr_setdetachstate() failed",0);
- if (pthread_create (&thread, &attr, start_routine, NULL) != 0)
+ if (pthread_create (&thread, &attr, start_routine, args) != 0)
vm->fatal_error("pthread_create() failed",0);
pthread_attr_destroy (&attr);
+ return (void*)thread;
}
static void *null_dll;
@@ -55,13 +55,24 @@ void ffi_dlclose(dll *dll)
dll->dll = NULL;
}
-PRIMITIVE(existsp)
+
+long factorvm::thread_id(){
+ return 0; // TODO fix me
+}
+
+
+inline void factorvm::vmprim_existsp()
{
struct stat sb;
char *path = (char *)(vm->untag_check<byte_array>(dpop()) + 1);
box_boolean(stat(path,&sb) >= 0);
}
+PRIMITIVE(existsp)
+{
+ PRIMITIVE_GETVM()->vmprim_existsp();
+}
+
segment *alloc_segment(cell size)
{
int pagesize = getpagesize();
@@ -320,7 +331,7 @@ void open_console()
stdin_read = filedes[0];
stdin_write = filedes[1];
- start_thread(stdin_loop);
+ start_thread(stdin_loop,NULL);
}
VM_C_API void wait_for_stdin()
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index b7e528a421..60beb88233 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -42,7 +42,7 @@ typedef char symbol_char;
#define print_native_string(string) print_string(string)
-void start_thread(void *(*start_routine)(void *));
+void *start_thread(void *(*start_routine)(void *),void *args);
void init_ffi();
void ffi_dlopen(dll *dll);
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index c36c2f3f7e..6085d65670 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -7,6 +7,10 @@ void *start_thread(void *(*start_routine)(void *),void *args){
return CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
}
+long factorvm::thread_id(){
+ return GetCurrentThreadId();
+}
+
s64 factorvm::current_micros()
{
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b3e40640b7..384c98186a 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -669,6 +669,12 @@ struct factorvm {
void print_fixnum(fixnum x);
cell read_cell_hex();
+
+
+
+ // os-*
+ inline void vmprim_existsp();
+ long thread_id();
// os-windows
#if defined(WINDOWS)
@@ -681,17 +687,17 @@ struct factorvm {
void dealloc_segment(segment *block);
segment *alloc_segment(cell size);
const vm_char *vm_executable_path();
- inline void vmprim_existsp();
const vm_char *default_image_path();
void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length);
bool windows_stat(vm_char *path);
-
+
#if defined(WINNT)
s64 current_micros();
void c_to_factor_toplevel(cell quot);
void open_console();
- // next method here:
+ // next method here:
#endif
+
#endif
};
From 0bc7c0c1d0cadbead754ebaa4bbe32a981a7f374 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 06:41:37 +0100
Subject: [PATCH 155/266] separated vm-1st-arg and vm-3rd-arg asm invoke words
(needed for ppc & x86.64)
---
basis/compiler/codegen/codegen.factor | 4 ++--
basis/cpu/architecture/architecture.factor | 3 ++-
basis/cpu/ppc/ppc.factor | 3 +++
basis/cpu/x86/32/32.factor | 5 ++++-
basis/cpu/x86/64/64.factor | 4 +++-
basis/cpu/x86/x86.factor | 2 +-
6 files changed, 15 insertions(+), 6 deletions(-)
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 6d43adf933..f41bc853b5 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -437,7 +437,7 @@ M: ##alien-indirect generate-insn
! Generate code for boxing input parameters in a callback.
[
dup \ %save-param-reg move-parameters
- "nest_stacks" %vm-invoke
+ "nest_stacks" %vm-invoke-1st-arg
box-parameters
] with-param-regs ;
@@ -475,7 +475,7 @@ TUPLE: callback-context ;
[ callback-context new do-callback ] %
] [ ] make ;
-: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke ;
+: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ;
M: ##callback-return generate-insn
#! All the extra book-keeping for %unwind is only for x86.
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 6d88944881..fbec9f697a 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -298,7 +298,8 @@ M: object %prepare-var-args ;
HOOK: %alien-invoke cpu ( function library -- )
-HOOK: %vm-invoke cpu ( function -- )
+HOOK: %vm-invoke-1st-arg cpu ( function -- )
+HOOK: %vm-invoke-3rd-arg cpu ( function -- )
HOOK: %cleanup cpu ( params -- )
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index fc6a122101..83f1bc9a74 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -38,6 +38,9 @@ enable-float-intrinsics
M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
+M: ppc %vm-invoke-1st-arg ( function -- ) f %alien-invoke ;
+M: ppc %vm-invoke-3rd-arg ( function -- ) f %alien-invoke ;
+
M: ppc machine-registers
{
{ int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 9499df7aaf..f711455fa3 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -51,11 +51,14 @@ M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
temp-reg PUSH ;
-M: x86.32 %vm-invoke ( function -- )
+M: x86.32 %vm-invoke-1st-arg ( function -- )
push-vm-ptr
f %alien-invoke
temp-reg POP ;
+M: x86.32 %vm-invoke-3rd-arg ( function -- )
+ %vm-invoke-1st-arg ; ! first 2 args are regs, 3rd is stack so vm-invoke-1st-arg works here
+
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
[ return-in-registers?>> ]
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 06592078d8..8c713eac8b 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -172,7 +172,9 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
-M: x86.64 %vm-invoke ( function -- ) f %alien-invoke ;
+M: x86.64 %vm-invoke-1st-arg ( function -- ) f %alien-invoke ;
+
+M: x86.64 %vm-invoke-3rd-arg ( function -- ) f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 9ac787a027..91705efec6 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -615,7 +615,7 @@ M:: x86 %call-gc ( gc-root-count -- )
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Call GC
- "inline_gc" %vm-invoke ; ! (PHIL) TODO: vm-invoke won't work with ppc or x86.64. need %vm-invoke-3rd
+ "inline_gc" %vm-invoke-3rd-arg ;
M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
From be1b079eb57501c5ca935289d12531d98ff52a3b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 06:59:26 +0100
Subject: [PATCH 156/266] Primitives now pass vm ptr on 64bit x86
---
basis/cpu/x86/64/bootstrap.factor | 3 +++
vm/primitives.hpp | 1 +
2 files changed, 4 insertions(+)
diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
index 8b0d53cda5..28309e7d97 100644
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/basis/cpu/x86/64/bootstrap.factor
@@ -21,6 +21,9 @@ IN: bootstrap.x86
: rex-length ( -- n ) 1 ;
[
+ ! HACK: stash vm pointer above the ds stack
+ temp0 0 MOV rc-absolute-cell rt-vm jit-rel
+ ds-reg bootstrap-cell [+] temp0 MOV
! load stack_chain
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
temp0 temp0 [] MOV
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index 8e6c3b8f51..5eefc19e01 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -13,6 +13,7 @@ namespace factor
extern const primitive_type primitives[];
#define PRIMITIVE_OVERFLOW_GETVM() vm
+
#define VM_PTR vm
#define ASSERTVM()
}
From 334f4c3455ad11e0a46a0cf680d6644e79801489 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 07:15:30 +0100
Subject: [PATCH 157/266] overflow functions now retrieving their vm ptr from
above ds stack
---
vm/primitives.hpp | 1 -
1 file changed, 1 deletion(-)
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index 5eefc19e01..8e6c3b8f51 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -13,7 +13,6 @@ namespace factor
extern const primitive_type primitives[];
#define PRIMITIVE_OVERFLOW_GETVM() vm
-
#define VM_PTR vm
#define ASSERTVM()
}
From 5cd2fbb56450817b67c8bf1039b913bd042c59e9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 07:30:16 +0100
Subject: [PATCH 158/266] vm ptr passed to lazy_jit_compile on x86.64
---
basis/cpu/x86/64/64.factor | 8 ++++++--
vm/cpu-x86.32.S | 14 +++++++++++++-
vm/cpu-x86.64.S | 11 +++++++++++
vm/cpu-x86.S | 12 +-----------
4 files changed, 31 insertions(+), 14 deletions(-)
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 8c713eac8b..46b1e9866f 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -172,9 +172,13 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
-M: x86.64 %vm-invoke-1st-arg ( function -- ) f %alien-invoke ;
+M: x86.64 %vm-invoke-1st-arg ( function -- )
+ param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ f %alien-invoke ;
-M: x86.64 %vm-invoke-3rd-arg ( function -- ) f %alien-invoke ;
+M: x86.64 %vm-invoke-3rd-arg ( function -- )
+ param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
+ f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 9d2bf082d1..326ddb6eb8 100644
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -80,7 +80,7 @@ DEF(void,set_x87_env,(const void*)):
ret
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
- mov CELL_SIZE(STACK_REG),NV_TEMP_REG /* stash vm ptr */
+ mov CELL_SIZE(STACK_REG),NV_TEMP_REG /* get vm ptr in case quot_xt = lazy_jit_compile */
/* clear x87 stack, but preserve rounding mode and exception flags */
sub $2,STACK_REG
fnstcw (STACK_REG)
@@ -91,6 +91,18 @@ DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
mov NV_TEMP_REG,ARG1
jmp *QUOT_XT_OFFSET(ARG0)
+
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,NV_TEMP_REG /* stash vm ptr */
+ mov STACK_REG,ARG1 /* Save stack pointer */
+ sub $STACK_PADDING,STACK_REG
+ push NV_TEMP_REG /* push vm ptr as arg3 */
+ call MANGLE(lazy_jit_compile_impl)
+ pop NV_TEMP_REG
+ mov RETURN_REG,ARG0 /* No-op on 32-bit */
+ add $STACK_PADDING,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+
#include "cpu-x86.S"
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 98addeb80d..4d5c70616f 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -115,6 +115,17 @@ DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
fldcw (STACK_REG)
/* rewind_to */
mov ARG1,STACK_REG
+ mov ARG2,ARG1 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
jmp *QUOT_XT_OFFSET(ARG0)
+
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,ARG2 /* vm is 3rd arg */
+ mov STACK_REG,ARG1 /* Save stack pointer */
+ sub $STACK_PADDING,STACK_REG
+ call MANGLE(lazy_jit_compile_impl)
+ mov RETURN_REG,ARG0 /* No-op on 32-bit */
+ add $STACK_PADDING,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+
#include "cpu-x86.S"
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index 03f08fdabc..2599ba3f97 100644
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -56,17 +56,6 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
POP_NONVOLATILE
ret
-DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
- mov ARG1,NV_TEMP_REG /* stash vm ptr */
- mov STACK_REG,ARG1 /* Save stack pointer */
- sub $STACK_PADDING,STACK_REG
- push NV_TEMP_REG /* push vm ptr as arg3 */
- call MANGLE(lazy_jit_compile_impl)
- pop NV_TEMP_REG
- mov RETURN_REG,ARG0 /* No-op on 32-bit */
- add $STACK_PADDING,STACK_REG
- jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
-
/* cpu.x86.features calls this */
DEF(bool,sse_version,(void)):
mov $0x1,RETURN_REG
@@ -103,6 +92,7 @@ sse_2:
sse_1:
mov $10,RETURN_REG
ret
+
#ifdef WINDOWS
.section .drectve
.ascii " -export:sse_version"
From b02c602a89f81cdc11f2390f9d9767ab45bce268 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 07:55:51 +0100
Subject: [PATCH 159/266] added vm passing to some alien/boxing functions and
added some vm asserts
---
basis/cpu/x86/64/64.factor | 13 ++++++++++---
vm/alien.cpp | 10 +++++-----
vm/data_gc.cpp | 1 +
vm/math.cpp | 3 +++
vm/quotations.cpp | 1 +
5 files changed, 20 insertions(+), 8 deletions(-)
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 46b1e9866f..a0ca3d17c7 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -74,9 +74,14 @@ M: x86.64 %prepare-unbox ( -- )
param-reg-1 R14 [] MOV
R14 cell SUB ;
+: %vm-invoke-2nd-arg ( function -- )
+ param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup
+ f %alien-invoke ;
+
+
M:: x86.64 %unbox ( n rep func -- )
! Call the unboxer
- func f %alien-invoke
+ func %vm-invoke-2nd-arg
! Store the return value on the C stack if this is an
! alien-invoke, otherwise leave it the return register if
! this is the end of alien-callback
@@ -92,9 +97,10 @@ M: x86.64 %unbox-long-long ( n func -- )
{ float-regs [ float-regs get pop swap MOVSD ] }
} case ;
+
M: x86.64 %unbox-small-struct ( c-type -- )
! Alien must be in param-reg-1.
- "alien_offset" f %alien-invoke
+ "alien_offset" %vm-invoke-2nd-arg
! Move alien_offset() return value to R11 so that we don't
! clobber it.
R11 RAX MOV
@@ -125,7 +131,7 @@ M:: x86.64 %box ( n rep func -- )
] [
rep load-return-value
] if
- func f %alien-invoke ;
+ func %vm-invoke-2nd-arg ;
M: x86.64 %box-long-long ( n func -- )
[ int-rep ] dip %box ;
@@ -176,6 +182,7 @@ M: x86.64 %vm-invoke-1st-arg ( function -- )
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
+
M: x86.64 %vm-invoke-3rd-arg ( function -- )
param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 9eb6da9784..829a7efeb6 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -226,7 +226,7 @@ char *factorvm::unbox_alien()
VM_C_API char *unbox_alien(factorvm *myvm)
{
- //printf("PHIL unbox_alien %d %d\n",vm,myvm);fflush(stdout);
+ ASSERTVM();
return VM_PTR->unbox_alien();
}
@@ -253,7 +253,7 @@ void factorvm::to_value_struct(cell src, void *dest, cell size)
VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *myvm)
{
- //printf("PHIL to_value_struct %d %d\n",vm,myvm);fflush(stdout);
+ ASSERTVM();
return VM_PTR->to_value_struct(src,dest,size);
}
@@ -267,7 +267,7 @@ void factorvm::box_value_struct(void *src, cell size)
VM_C_API void box_value_struct(void *src, cell size,factorvm *myvm)
{
- //printf("PHIL box_value_struct %d %d\n",vm,myvm);fflush(stdout);
+ ASSERTVM();
return VM_PTR->box_value_struct(src,size);
}
@@ -282,7 +282,7 @@ void factorvm::box_small_struct(cell x, cell y, cell size)
VM_C_API void box_small_struct(cell x, cell y, cell size, factorvm *myvm)
{
- //printf("PHIL box_small_struct %d %d\n",vm,myvm);fflush(stdout);
+ ASSERTVM();
return VM_PTR->box_small_struct(x,y,size);
}
@@ -299,7 +299,7 @@ void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factorvm *myvm)
{
- //printf("PHIL box_medium_struct %d %d\n",vm,myvm);fflush(stdout);
+ ASSERTVM();
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
}
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index 5a7f34ca4b..c6cdd39853 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -707,6 +707,7 @@ void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factorvm *myvm)
{
+ ASSERTVM();
return VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
}
diff --git a/vm/math.cpp b/vm/math.cpp
index 8d213b391d..d6d824f7c0 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -620,6 +620,7 @@ fixnum factorvm::to_fixnum(cell tagged)
VM_C_API fixnum to_fixnum(cell tagged,factorvm *myvm)
{
+ ASSERTVM();
return VM_PTR->to_fixnum(tagged);
}
@@ -630,6 +631,7 @@ cell factorvm::to_cell(cell tagged)
VM_C_API cell to_cell(cell tagged, factorvm *myvm)
{
+ ASSERTVM();
return VM_PTR->to_cell(tagged);
}
@@ -807,6 +809,7 @@ float factorvm::to_float(cell value)
VM_C_API float to_float(cell value,factorvm *myvm)
{
+ ASSERTVM();
return VM_PTR->to_float(value);
}
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index b28fb1d3a1..9c771129fc 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -370,6 +370,7 @@ cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factorvm *myvm)
{
+ ASSERTVM();
return VM_PTR->lazy_jit_compile_impl(quot_,stack);
}
From 784b8d16ae5c4c6391f57a500c1a9b7ba0f62fa0 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 08:20:58 +0100
Subject: [PATCH 160/266] moved utility functions and fatal_error out of vm
struct since doesn't need state
---
vm/errors.cpp | 2 +-
vm/errors.hpp | 1 +
vm/mach_signal.cpp | 6 +++---
vm/os-genunix.cpp | 2 +-
vm/os-linux.cpp | 6 +++---
vm/os-unix.cpp | 32 ++++++++++++++++----------------
vm/utilities.cpp | 18 +++++++++---------
vm/utilities.hpp | 10 +++++++++-
vm/vm.hpp | 15 ---------------
9 files changed, 43 insertions(+), 49 deletions(-)
diff --git a/vm/errors.cpp b/vm/errors.cpp
index 09e6313f29..f483fb4a09 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -17,7 +17,7 @@ void factorvm::out_of_memory()
exit(1);
}
-void factorvm::fatal_error(const char* msg, cell tagged)
+void fatal_error(const char* msg, cell tagged)
{
print_string("fatal_error: "); print_string(msg);
print_string(": "); print_cell_hex(tagged); nl();
diff --git a/vm/errors.hpp b/vm/errors.hpp
index 8725941920..4f45c55c73 100755
--- a/vm/errors.hpp
+++ b/vm/errors.hpp
@@ -27,6 +27,7 @@ PRIMITIVE(die);
PRIMITIVE(call_clear);
PRIMITIVE(unimplemented);
+void fatal_error(const char* msg, cell tagged);
void memory_signal_handler_impl();
void fp_signal_handler_impl();
void misc_signal_handler_impl();
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index c1d263527d..ecded49c0f 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -203,13 +203,13 @@ void mach_initialize ()
/* Allocate a port on which the thread shall listen for exceptions. */
if (mach_port_allocate (self, MACH_PORT_RIGHT_RECEIVE, &our_exception_port)
!= KERN_SUCCESS)
- vm->fatal_error("mach_port_allocate() failed",0);
+ fatal_error("mach_port_allocate() failed",0);
/* See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/mach_port_insert_right.html. */
if (mach_port_insert_right (self, our_exception_port, our_exception_port,
MACH_MSG_TYPE_MAKE_SEND)
!= KERN_SUCCESS)
- vm->fatal_error("mach_port_insert_right() failed",0);
+ fatal_error("mach_port_insert_right() failed",0);
/* The exceptions we want to catch. */
mask = EXC_MASK_BAD_ACCESS | EXC_MASK_ARITHMETIC;
@@ -226,7 +226,7 @@ void mach_initialize ()
if (task_set_exception_ports (self, mask, our_exception_port,
EXCEPTION_DEFAULT, MACHINE_THREAD_STATE)
!= KERN_SUCCESS)
- vm->fatal_error("task_set_exception_ports() failed",0);
+ fatal_error("task_set_exception_ports() failed",0);
}
}
diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp
index 9e7804caf0..29c3e79859 100644
--- a/vm/os-genunix.cpp
+++ b/vm/os-genunix.cpp
@@ -31,7 +31,7 @@ const char *default_image_path()
const char *iter = path;
while(*iter) { len++; iter++; }
- char *new_path = (char *)vm->safe_malloc(PATH_MAX + SUFFIX_LEN + 1);
+ char *new_path = (char *)safe_malloc(PATH_MAX + SUFFIX_LEN + 1);
memcpy(new_path,path,len + 1);
memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1);
return new_path;
diff --git a/vm/os-linux.cpp b/vm/os-linux.cpp
index c21f8142a1..7929701d41 100644
--- a/vm/os-linux.cpp
+++ b/vm/os-linux.cpp
@@ -6,18 +6,18 @@ namespace factor
/* Snarfed from SBCL linux-so.c. You must free() this yourself. */
const char *vm_executable_path()
{
- char *path = (char *)vm->safe_malloc(PATH_MAX + 1);
+ char *path = (char *)safe_malloc(PATH_MAX + 1);
int size = readlink("/proc/self/exe", path, PATH_MAX);
if (size < 0)
{
- vm->fatal_error("Cannot read /proc/self/exe",0);
+ fatal_error("Cannot read /proc/self/exe",0);
return NULL;
}
else
{
path[size] = '\0';
- return vm->safe_strdup(path);
+ return safe_strdup(path);
}
}
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 4de5ede704..832b93b392 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -8,11 +8,11 @@ void *start_thread(void *(*start_routine)(void *),void *args)
pthread_attr_t attr;
pthread_t thread;
if (pthread_attr_init (&attr) != 0)
- vm->fatal_error("pthread_attr_init() failed",0);
+ fatal_error("pthread_attr_init() failed",0);
if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) != 0)
- vm->fatal_error("pthread_attr_setdetachstate() failed",0);
+ fatal_error("pthread_attr_setdetachstate() failed",0);
if (pthread_create (&thread, &attr, start_routine, args) != 0)
- vm->fatal_error("pthread_create() failed",0);
+ fatal_error("pthread_create() failed",0);
pthread_attr_destroy (&attr);
return (void*)thread;
}
@@ -85,12 +85,12 @@ segment *alloc_segment(cell size)
vm->out_of_memory();
if(mprotect(array,pagesize,PROT_NONE) == -1)
- vm->fatal_error("Cannot protect low guard page",(cell)array);
+ fatal_error("Cannot protect low guard page",(cell)array);
if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1)
- vm->fatal_error("Cannot protect high guard page",(cell)array);
+ fatal_error("Cannot protect high guard page",(cell)array);
- segment *retval = (segment *)vm->safe_malloc(sizeof(segment));
+ segment *retval = (segment *)safe_malloc(sizeof(segment));
retval->start = (cell)(array + pagesize);
retval->size = size;
@@ -107,7 +107,7 @@ void dealloc_segment(segment *block)
pagesize + block->size + pagesize);
if(retval)
- vm->fatal_error("dealloc_segment failed",0);
+ fatal_error("dealloc_segment failed",0);
free(block);
}
@@ -165,7 +165,7 @@ static void sigaction_safe(int signum, const struct sigaction *act, struct sigac
while(ret == -1 && errno == EINTR);
if(ret == -1)
- vm->fatal_error("sigaction failed", 0);
+ fatal_error("sigaction failed", 0);
}
void unix_init_signals()
@@ -227,7 +227,7 @@ extern "C" {
void safe_close(int fd)
{
if(close(fd) < 0)
- vm->fatal_error("error closing fd",errno);
+ fatal_error("error closing fd",errno);
}
bool check_write(int fd, void *data, ssize_t size)
@@ -246,7 +246,7 @@ bool check_write(int fd, void *data, ssize_t size)
void safe_write(int fd, void *data, ssize_t size)
{
if(!check_write(fd,data,size))
- vm->fatal_error("error writing fd",errno);
+ fatal_error("error writing fd",errno);
}
bool safe_read(int fd, void *data, ssize_t size)
@@ -258,7 +258,7 @@ bool safe_read(int fd, void *data, ssize_t size)
return safe_read(fd,data,size);
else
{
- vm->fatal_error("error reading fd",errno);
+ fatal_error("error reading fd",errno);
return false;
}
}
@@ -277,7 +277,7 @@ void *stdin_loop(void *arg)
break;
if(buf[0] != 'X')
- vm->fatal_error("stdin_loop: bad data on control fd",buf[0]);
+ fatal_error("stdin_loop: bad data on control fd",buf[0]);
for(;;)
{
@@ -314,19 +314,19 @@ void open_console()
int filedes[2];
if(pipe(filedes) < 0)
- vm->fatal_error("Error opening control pipe",errno);
+ fatal_error("Error opening control pipe",errno);
control_read = filedes[0];
control_write = filedes[1];
if(pipe(filedes) < 0)
- vm->fatal_error("Error opening size pipe",errno);
+ fatal_error("Error opening size pipe",errno);
size_read = filedes[0];
size_write = filedes[1];
if(pipe(filedes) < 0)
- vm->fatal_error("Error opening stdin pipe",errno);
+ fatal_error("Error opening stdin pipe",errno);
stdin_read = filedes[0];
stdin_write = filedes[1];
@@ -341,7 +341,7 @@ VM_C_API void wait_for_stdin()
if(errno == EINTR)
wait_for_stdin();
else
- vm->fatal_error("Error writing control fd",errno);
+ fatal_error("Error writing control fd",errno);
}
}
diff --git a/vm/utilities.cpp b/vm/utilities.cpp
index 4f4da9a1bc..94f010d050 100755
--- a/vm/utilities.cpp
+++ b/vm/utilities.cpp
@@ -4,14 +4,14 @@ namespace factor
{
/* If memory allocation fails, bail out */
-void *factorvm::safe_malloc(size_t size)
+void *safe_malloc(size_t size)
{
void *ptr = malloc(size);
if(!ptr) fatal_error("Out of memory in safe_malloc", 0);
return ptr;
}
-vm_char *factorvm::safe_strdup(const vm_char *str)
+vm_char *safe_strdup(const vm_char *str)
{
vm_char *ptr = STRDUP(str);
if(!ptr) fatal_error("Out of memory in safe_strdup", 0);
@@ -21,38 +21,38 @@ vm_char *factorvm::safe_strdup(const vm_char *str)
/* We don't use printf directly, because format directives are not portable.
Instead we define the common cases here. */
-void factorvm::nl()
+void nl()
{
fputs("\n",stdout);
}
-void factorvm::print_string(const char *str)
+void print_string(const char *str)
{
fputs(str,stdout);
}
-void factorvm::print_cell(cell x)
+void print_cell(cell x)
{
printf(CELL_FORMAT,x);
}
-void factorvm::print_cell_hex(cell x)
+void print_cell_hex(cell x)
{
printf(CELL_HEX_FORMAT,x);
}
-void factorvm::print_cell_hex_pad(cell x)
+void print_cell_hex_pad(cell x)
{
printf(CELL_HEX_PAD_FORMAT,x);
}
-void factorvm::print_fixnum(fixnum x)
+void print_fixnum(fixnum x)
{
printf(FIXNUM_FORMAT,x);
}
-cell factorvm::read_cell_hex()
+cell read_cell_hex()
{
cell cell;
if(scanf(CELL_HEX_FORMAT,&cell) < 0) exit(1);
diff --git a/vm/utilities.hpp b/vm/utilities.hpp
index 412ef35bb4..68e0c97b25 100755
--- a/vm/utilities.hpp
+++ b/vm/utilities.hpp
@@ -1,4 +1,12 @@
namespace factor
{
-
+ void *safe_malloc(size_t size);
+ vm_char *safe_strdup(const vm_char *str);
+ void print_string(const char *str);
+ void nl();
+ void print_cell(cell x);
+ void print_cell_hex(cell x);
+ void print_cell_hex_pad(cell x);
+ void print_fixnum(fixnum x);
+ cell read_cell_hex();
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 384c98186a..0a0393700c 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -66,7 +66,6 @@ struct factorvm {
unsigned int signal_fpu_status;
stack_frame *signal_callstack_top;
void out_of_memory();
- void fatal_error(const char* msg, cell tagged);
void critical_error(const char* msg, cell tagged);
void throw_error(cell error, stack_frame *callstack_top);
void not_implemented_error();
@@ -658,20 +657,6 @@ struct factorvm {
void factor_yield();
void factor_sleep(long us);
- //utilities
- void *safe_malloc(size_t size);
- vm_char *safe_strdup(const vm_char *str);
- void nl();
- void print_string(const char *str);
- void print_cell(cell x);
- void print_cell_hex(cell x);
- void print_cell_hex_pad(cell x);
- void print_fixnum(fixnum x);
- cell read_cell_hex();
-
-
-
-
// os-*
inline void vmprim_existsp();
long thread_id();
From 1456fb3c97f419c58a97e176b6ce3096699d34aa Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 08:35:22 +0100
Subject: [PATCH 161/266] removed vm ptrs from unix code (still in signal
handlers tho)
---
vm/os-unix.cpp | 22 +++++++++++-----------
vm/os-windows-nt.cpp | 2 +-
vm/vm.hpp | 10 +++++-----
3 files changed, 17 insertions(+), 17 deletions(-)
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 832b93b392..ed007398a3 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -31,40 +31,40 @@ void sleep_micros(cell usec)
usleep(usec);
}
-void init_ffi()
+void factorvm::init_ffi()
{
/* NULL_DLL is "libfactor.dylib" for OS X and NULL for generic unix */
null_dll = dlopen(NULL_DLL,RTLD_LAZY);
}
-void ffi_dlopen(dll *dll)
+void factorvm::ffi_dlopen(dll *dll)
{
- dll->dll = dlopen(alien_offset(dll->path,vm), RTLD_LAZY);
+ dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY);
}
-void *ffi_dlsym(dll *dll, symbol_char *symbol)
+void *factorvm::ffi_dlsym(dll *dll, symbol_char *symbol)
{
void *handle = (dll == NULL ? null_dll : dll->dll);
return dlsym(handle,symbol);
}
-void ffi_dlclose(dll *dll)
+void factorvm::ffi_dlclose(dll *dll)
{
if(dlclose(dll->dll))
- vm->general_error(ERROR_FFI,F,F,NULL);
+ general_error(ERROR_FFI,F,F,NULL);
dll->dll = NULL;
}
-long factorvm::thread_id(){
- return 0; // TODO fix me
+cell factorvm::thread_id(){
+ return pthread_self();
}
inline void factorvm::vmprim_existsp()
{
struct stat sb;
- char *path = (char *)(vm->untag_check<byte_array>(dpop()) + 1);
+ char *path = (char *)(untag_check<byte_array>(dpop()) + 1);
box_boolean(stat(path,&sb) >= 0);
}
@@ -73,7 +73,7 @@ PRIMITIVE(existsp)
PRIMITIVE_GETVM()->vmprim_existsp();
}
-segment *alloc_segment(cell size)
+segment *factorvm::alloc_segment(cell size)
{
int pagesize = getpagesize();
@@ -82,7 +82,7 @@ segment *alloc_segment(cell size)
MAP_ANON | MAP_PRIVATE,-1,0);
if(array == (char*)-1)
- vm->out_of_memory();
+ out_of_memory();
if(mprotect(array,pagesize,PROT_NONE) == -1)
fatal_error("Cannot protect low guard page",(cell)array);
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 6085d65670..630782a946 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -7,7 +7,7 @@ void *start_thread(void *(*start_routine)(void *),void *args){
return CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
}
-long factorvm::thread_id(){
+cell factorvm::thread_id(){
return GetCurrentThreadId();
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0a0393700c..9af73e4c7e 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -659,18 +659,18 @@ struct factorvm {
// os-*
inline void vmprim_existsp();
- long thread_id();
-
- // os-windows
- #if defined(WINDOWS)
+ cell thread_id();
void init_ffi();
void ffi_dlopen(dll *dll);
void *ffi_dlsym(dll *dll, symbol_char *symbol);
void ffi_dlclose(dll *dll);
+ segment *alloc_segment(cell size);
+
+ // os-windows
+ #if defined(WINDOWS)
void sleep_micros(u64 usec);
long getpagesize();
void dealloc_segment(segment *block);
- segment *alloc_segment(cell size);
const vm_char *vm_executable_path();
const vm_char *default_image_path();
void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length);
From 3c139593c5b248fcf159a20500a9223fc55aa644 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 08:55:18 +0100
Subject: [PATCH 162/266] moved the thread stuff around a bit
---
vm/factor.cpp | 6 +++---
vm/factor.hpp | 2 +-
vm/os-unix.cpp | 12 +++++++-----
vm/os-unix.hpp | 8 +++-----
vm/os-windows-nt.cpp | 8 ++++----
vm/os-windows-nt.hpp | 5 ++++-
vm/vm.hpp | 6 ++----
7 files changed, 24 insertions(+), 23 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index a241ccf86b..57bceb9cb7 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -7,12 +7,12 @@ factorvm *vm;
unordered_map<long,factorvm*> thread_vms;
-factorvm *lookup_vm(long threadid)
+factorvm *lookup_vm(unsigned long threadid)
{
return thread_vms[threadid];
}
-void register_vm(long threadid, factorvm *vm)
+void register_vm(unsigned long threadid, factorvm *vm)
{
thread_vms[threadid] = vm;
}
@@ -243,7 +243,7 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv)
return newvm->start_standalone_factor(argc,argv);
}
-VM_C_API void *start_standalone_factor_in_new_thread(int argc, vm_char **argv)
+VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv)
{
startargs *args = new startargs; // leaks startargs structure
args->argc = argc; args->argv = argv;
diff --git a/vm/factor.hpp b/vm/factor.hpp
index b824758c8a..46662072b5 100644
--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@@ -2,5 +2,5 @@ namespace factor
{
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
-VM_C_API void *start_standalone_factor_in_new_thread(int argc, vm_char **argv);
+VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv);
}
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index ed007398a3..7f4b070c60 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -3,7 +3,7 @@
namespace factor
{
-void *start_thread(void *(*start_routine)(void *),void *args)
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args)
{
pthread_attr_t attr;
pthread_t thread;
@@ -14,9 +14,14 @@ void *start_thread(void *(*start_routine)(void *),void *args)
if (pthread_create (&thread, &attr, start_routine, args) != 0)
fatal_error("pthread_create() failed",0);
pthread_attr_destroy (&attr);
- return (void*)thread;
+ return thread;
}
+unsigned long thread_id(){
+ return pthread_self();
+}
+
+
static void *null_dll;
s64 current_micros()
@@ -56,9 +61,6 @@ void factorvm::ffi_dlclose(dll *dll)
}
-cell factorvm::thread_id(){
- return pthread_self();
-}
inline void factorvm::vmprim_existsp()
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index 60beb88233..b37d2beeea 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -42,12 +42,10 @@ typedef char symbol_char;
#define print_native_string(string) print_string(string)
-void *start_thread(void *(*start_routine)(void *),void *args);
+typedef pthread_t THREADHANDLE;
-void init_ffi();
-void ffi_dlopen(dll *dll);
-void *ffi_dlsym(dll *dll, symbol_char *symbol);
-void ffi_dlclose(dll *dll);
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
+unsigned long thread_id();
void unix_init_signals();
void signal_handler(int signal, siginfo_t* siginfo, void* uap);
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 630782a946..fbaadaaba7 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -3,16 +3,16 @@
namespace factor
{
-void *start_thread(void *(*start_routine)(void *),void *args){
- return CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args){
+ return (void*) CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
}
-cell factorvm::thread_id(){
+unsigned long thread_id(){
return GetCurrentThreadId();
}
-s64 factorvm::current_micros()
+s64 current_micros()
{
FILETIME t;
GetSystemTimeAsFileTime(&t);
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index e5c5adadf1..68de8ff49e 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -26,7 +26,10 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4
#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5
-void *start_thread(void *(*start_routine)(void *),void *args);
+typedef HANDLE THREADHANDLE;
+
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
+unsigned long thread_id();
#define SIGNAL_VM_PTR lookup_vm(GetCurrentThreadId())
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 9af73e4c7e..76cf8c4e53 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -659,7 +659,6 @@ struct factorvm {
// os-*
inline void vmprim_existsp();
- cell thread_id();
void init_ffi();
void ffi_dlopen(dll *dll);
void *ffi_dlsym(dll *dll, symbol_char *symbol);
@@ -677,7 +676,6 @@ struct factorvm {
bool windows_stat(vm_char *path);
#if defined(WINNT)
- s64 current_micros();
void c_to_factor_toplevel(cell quot);
void open_console();
// next method here:
@@ -689,6 +687,6 @@ struct factorvm {
extern factorvm *vm;
-extern factorvm *lookup_vm(long threadid);
-extern void register_vm(long threadid,factorvm *vm);
+extern factorvm *lookup_vm(unsigned long threadid);
+extern void register_vm(unsigned long threadid,factorvm *vm);
}
From fa6d8d239bbf79ffc636de494edce2d5b2a3a859 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 18:08:45 +0100
Subject: [PATCH 163/266] removed vm singleton usage from unix stuff
---
vm/os-genunix.cpp | 4 ++--
vm/os-unix.cpp | 18 ++++++++++--------
vm/vm.hpp | 1 +
3 files changed, 13 insertions(+), 10 deletions(-)
diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp
index 29c3e79859..6540d8d196 100644
--- a/vm/os-genunix.cpp
+++ b/vm/os-genunix.cpp
@@ -3,9 +3,9 @@
namespace factor
{
-void c_to_factor_toplevel(cell quot)
+void factorvm::c_to_factor_toplevel(cell quot)
{
- c_to_factor(quot,vm);
+ c_to_factor(quot,this);
}
void init_signals()
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 7f4b070c60..268469a875 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -9,7 +9,7 @@ THREADHANDLE start_thread(void *(*start_routine)(void *),void *args)
pthread_t thread;
if (pthread_attr_init (&attr) != 0)
fatal_error("pthread_attr_init() failed",0);
- if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) != 0)
+ if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_JOINABLE) != 0)
fatal_error("pthread_attr_setdetachstate() failed",0);
if (pthread_create (&thread, &attr, start_routine, args) != 0)
fatal_error("pthread_create() failed",0);
@@ -114,17 +114,17 @@ void dealloc_segment(segment *block)
free(block);
}
-static stack_frame *uap_stack_pointer(void *uap)
+stack_frame *factorvm::uap_stack_pointer(void *uap)
{
/* There is a race condition here, but in practice a signal
delivered during stack frame setup/teardown or while transitioning
from Factor to C is a sign of things seriously gone wrong, not just
a divide by zero or stack underflow in the listener */
- if(vm->in_code_heap_p(UAP_PROGRAM_COUNTER(uap)))
+ if(in_code_heap_p(UAP_PROGRAM_COUNTER(uap)))
{
stack_frame *ptr = (stack_frame *)ucontext_stack_pointer(uap);
if(!ptr)
- vm->critical_error("Invalid uap",(cell)uap);
+ critical_error("Invalid uap",(cell)uap);
return ptr;
}
else
@@ -133,15 +133,17 @@ static stack_frame *uap_stack_pointer(void *uap)
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- vm->signal_fault_addr = (cell)siginfo->si_addr;
- vm->signal_callstack_top = uap_stack_pointer(uap);
+ factorvm *myvm = lookup_vm(thread_id());
+ myvm->signal_fault_addr = (cell)siginfo->si_addr;
+ myvm->signal_callstack_top = myvm->uap_stack_pointer(uap);
UAP_PROGRAM_COUNTER(uap) = (cell)memory_signal_handler_impl;
}
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- vm->signal_number = signal;
- vm->signal_callstack_top = uap_stack_pointer(uap);
+ factorvm *myvm = lookup_vm(thread_id());
+ myvm->signal_number = signal;
+ myvm->signal_callstack_top = myvm->uap_stack_pointer(uap);
UAP_PROGRAM_COUNTER(uap) = (cell)misc_signal_handler_impl;
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 76cf8c4e53..65e41881cb 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -664,6 +664,7 @@ struct factorvm {
void *ffi_dlsym(dll *dll, symbol_char *symbol);
void ffi_dlclose(dll *dll);
segment *alloc_segment(cell size);
+ void c_to_factor_toplevel(cell quot);
// os-windows
#if defined(WINDOWS)
From ca16daa4b223342c010bfdde6a1f97fd6261b692 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 18:17:14 +0100
Subject: [PATCH 164/266] cleaned up code a bit, added multithreaded mode flags
---
vm/factor.cpp | 4 ++--
vm/main-unix.cpp | 7 ++++++-
vm/main-windows-nt.cpp | 7 +++++--
vm/os-unix.hpp | 2 --
vm/os-windows-nt.hpp | 2 --
vm/primitives.hpp | 5 -----
vm/tagged.hpp | 4 ++--
vm/vm.hpp | 34 ++++++++++++++++++++++++++++++++--
8 files changed, 47 insertions(+), 18 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 57bceb9cb7..026453eae3 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -12,9 +12,9 @@ factorvm *lookup_vm(unsigned long threadid)
return thread_vms[threadid];
}
-void register_vm(unsigned long threadid, factorvm *vm)
+void register_vm(unsigned long threadid, factorvm *thevm)
{
- thread_vms[threadid] = vm;
+ thread_vms[threadid] = thevm;
}
diff --git a/vm/main-unix.cpp b/vm/main-unix.cpp
index bc605e3cfd..bd1549a38e 100644
--- a/vm/main-unix.cpp
+++ b/vm/main-unix.cpp
@@ -2,6 +2,11 @@
int main(int argc, char **argv)
{
- factor::start_standalone_factor(argc,argv);
+ #ifdef FACTOR_MULTITHREADED
+ factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(argc,argv);
+ pthread_join(thread,NULL);
+ #else
+ factor::start_standalone_factor(argc,argv);
+ #endif
return 0;
}
diff --git a/vm/main-windows-nt.cpp b/vm/main-windows-nt.cpp
index 4a0fc2ae35..2120717d86 100644
--- a/vm/main-windows-nt.cpp
+++ b/vm/main-windows-nt.cpp
@@ -16,9 +16,12 @@ int WINAPI WinMain(
return 1;
}
+ #ifdef FACTOR_MULTITHREADED
+ factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist);
+ WaitForSingleObject(thread, INFINITE);
+ #else
factor::start_standalone_factor(nArgs,szArglist);
- //HANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist);
- //WaitForSingleObject(thread, INFINITE);
+ #endif
LocalFree(szArglist);
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index b37d2beeea..e3e207f641 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -55,6 +55,4 @@ s64 current_micros();
void sleep_micros(cell usec);
void open_console();
-
-#define SIGNAL_VM_PTR vm
}
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index 68de8ff49e..385553e11e 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -31,6 +31,4 @@ typedef HANDLE THREADHANDLE;
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
unsigned long thread_id();
-#define SIGNAL_VM_PTR lookup_vm(GetCurrentThreadId())
-
}
diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index 8e6c3b8f51..4be190d4e6 100644
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -4,15 +4,10 @@ namespace factor
#if defined(FACTOR_X86)
extern "C" __attribute__ ((regparm (1))) typedef void (*primitive_type)(void *myvm);
#define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm)
- #define PRIMITIVE_GETVM() ((factorvm*)myvm)
#else
extern "C" typedef void (*primitive_type)(void *myvm);
#define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm)
- #define PRIMITIVE_GETVM() vm
#endif
extern const primitive_type primitives[];
-#define PRIMITIVE_OVERFLOW_GETVM() vm
-#define VM_PTR vm
-#define ASSERTVM()
}
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index 2bf058212f..13ddf4a047 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -37,13 +37,13 @@ struct tagged
explicit tagged(cell tagged) : value_(tagged) {
#ifdef FACTOR_DEBUG
- untag_check(vm);
+ untag_check(SIGNAL_VM_PTR);
#endif
}
explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
#ifdef FACTOR_DEBUG
- untag_check(vm);
+ untag_check(SIGNAL_VM_PTR);
#endif
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 65e41881cb..35011171ee 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -677,17 +677,47 @@ struct factorvm {
bool windows_stat(vm_char *path);
#if defined(WINNT)
- void c_to_factor_toplevel(cell quot);
void open_console();
// next method here:
#endif
+ #else // UNIX
+
+ stack_frame *uap_stack_pointer(void *uap);
#endif
};
-extern factorvm *vm;
extern factorvm *lookup_vm(unsigned long threadid);
extern void register_vm(unsigned long threadid,factorvm *vm);
+
+#define FACTOR_SINGLE_THREADED
+
+#ifdef FACTOR_SINGLE_THREADED
+ extern factorvm *vm;
+ #define PRIMITIVE_GETVM() vm
+ #define PRIMITIVE_OVERFLOW_GETVM() vm
+ #define VM_PTR vm
+ #define ASSERTVM()
+ #define SIGNAL_VM_PTR vm
+#endif
+
+#ifdef FACTOR_TESTING_MULTITHREADED
+ extern factorvm *vm;
+ #define PRIMITIVE_GETVM() ((factorvm*)myvm)
+ #define PRIMITIVE_OVERFLOW_GETVM() vm
+ #define VM_PTR myvm
+ #define ASSERTVM() assert(vm==myvm)
+ #define SIGNAL_VM_PTR lookup_vm(thread_id())
+#endif
+
+#ifdef FACTOR_MULTITHREADED
+ #define PRIMITIVE_GETVM() ((factorvm*)myvm)
+ #define PRIMITIVE_OVERFLOW_GETVM() ((factorvm*)myvm)
+ #define VM_PTR myvm
+ #define ASSERTVM()
+ #define SIGNAL_VM_PTR lookup_vm(thread_id())
+#endif
+
}
From 3345922330a8925c0ffe21815eb09a2e5d732418 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 25 Aug 2009 18:29:28 +0100
Subject: [PATCH 165/266] quick test vocab for mt stuff
---
basis/cpu/x86/64/64.factor | 4 +++-
extra/mttest/mttest.factor | 25 +++++++++++++++++++++++++
vm/errors.cpp | 4 ++--
vm/math.cpp | 2 +-
vm/os-unix.cpp | 4 ++--
vm/tagged.hpp | 4 ++--
vm/vm.hpp | 6 +++---
7 files changed, 38 insertions(+), 11 deletions(-)
create mode 100644 extra/mttest/mttest.factor
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index a0ca3d17c7..925de44c23 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -123,6 +123,8 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
[ ]
tri copy-register ;
+
+
M:: x86.64 %box ( n rep func -- )
n [
n
@@ -131,7 +133,7 @@ M:: x86.64 %box ( n rep func -- )
] [
rep load-return-value
] if
- func %vm-invoke-2nd-arg ;
+ rep int-rep? [ func %vm-invoke-2nd-arg ] [ func %vm-invoke-1st-arg ] if ;
M: x86.64 %box-long-long ( n func -- )
[ int-rep ] dip %box ;
diff --git a/extra/mttest/mttest.factor b/extra/mttest/mttest.factor
new file mode 100644
index 0000000000..90a398c59a
--- /dev/null
+++ b/extra/mttest/mttest.factor
@@ -0,0 +1,25 @@
+USING: alien.syntax io io.encodings.utf16n io.encodings.utf8 io.files
+kernel namespaces sequences system threads unix.utilities ;
+IN: mttest
+
+FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
+
+HOOK: native-string-encoding os ( -- encoding )
+M: windows native-string-encoding utf16n ;
+M: unix native-string-encoding utf8 ;
+
+: start-vm-in-os-thread ( args -- threadhandle )
+ \ vm get-global prefix
+ [ length ] [ native-string-encoding strings>alien ] bi
+ start_standalone_factor_in_new_thread ;
+
+: start-tetris-in-os-thread ( -- )
+ { "-run=tetris" } start-vm-in-os-thread drop ;
+
+: start-testthread-in-os-thread ( -- )
+ { "-run=mttest" } start-vm-in-os-thread drop ;
+
+: testthread ( -- )
+ "/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
+
+MAIN: testthread
\ No newline at end of file
diff --git a/vm/errors.cpp b/vm/errors.cpp
index f483fb4a09..154237a8f2 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -165,7 +165,7 @@ void factorvm::memory_signal_handler_impl()
void memory_signal_handler_impl()
{
- SIGNAL_VM_PTR->misc_signal_handler_impl();
+ SIGNAL_VM_PTR()->misc_signal_handler_impl();
}
void factorvm::misc_signal_handler_impl()
@@ -175,7 +175,7 @@ void factorvm::misc_signal_handler_impl()
void misc_signal_handler_impl()
{
- SIGNAL_VM_PTR->misc_signal_handler_impl();
+ SIGNAL_VM_PTR()->misc_signal_handler_impl();
}
void factorvm::fp_signal_handler_impl()
diff --git a/vm/math.cpp b/vm/math.cpp
index d6d824f7c0..40a0c20a3b 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -818,7 +818,7 @@ void factorvm::box_double(double flo)
dpush(allot_float(flo));
}
-VM_C_API void box_double(double flo,factorvm *myvm) // not sure if this is ever called
+VM_C_API void box_double(double flo,factorvm *myvm)
{
ASSERTVM();
return VM_PTR->box_double(flo);
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 268469a875..4cee04a11b 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -133,7 +133,7 @@ stack_frame *factorvm::uap_stack_pointer(void *uap)
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- factorvm *myvm = lookup_vm(thread_id());
+ factorvm *myvm = SIGNAL_VM_PTR();
myvm->signal_fault_addr = (cell)siginfo->si_addr;
myvm->signal_callstack_top = myvm->uap_stack_pointer(uap);
UAP_PROGRAM_COUNTER(uap) = (cell)memory_signal_handler_impl;
@@ -141,7 +141,7 @@ void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- factorvm *myvm = lookup_vm(thread_id());
+ factorvm *myvm = SIGNAL_VM_PTR();
myvm->signal_number = signal;
myvm->signal_callstack_top = myvm->uap_stack_pointer(uap);
UAP_PROGRAM_COUNTER(uap) = (cell)misc_signal_handler_impl;
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index 13ddf4a047..8eb492a140 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -37,13 +37,13 @@ struct tagged
explicit tagged(cell tagged) : value_(tagged) {
#ifdef FACTOR_DEBUG
- untag_check(SIGNAL_VM_PTR);
+ untag_check(SIGNAL_VM_PTR());
#endif
}
explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
#ifdef FACTOR_DEBUG
- untag_check(SIGNAL_VM_PTR);
+ untag_check(SIGNAL_VM_PTR());
#endif
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 35011171ee..c30af505f9 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -700,7 +700,7 @@ extern void register_vm(unsigned long threadid,factorvm *vm);
#define PRIMITIVE_OVERFLOW_GETVM() vm
#define VM_PTR vm
#define ASSERTVM()
- #define SIGNAL_VM_PTR vm
+ #define SIGNAL_VM_PTR() vm
#endif
#ifdef FACTOR_TESTING_MULTITHREADED
@@ -709,7 +709,7 @@ extern void register_vm(unsigned long threadid,factorvm *vm);
#define PRIMITIVE_OVERFLOW_GETVM() vm
#define VM_PTR myvm
#define ASSERTVM() assert(vm==myvm)
- #define SIGNAL_VM_PTR lookup_vm(thread_id())
+ #define SIGNAL_VM_PTR() lookup_vm(thread_id())
#endif
#ifdef FACTOR_MULTITHREADED
@@ -717,7 +717,7 @@ extern void register_vm(unsigned long threadid,factorvm *vm);
#define PRIMITIVE_OVERFLOW_GETVM() ((factorvm*)myvm)
#define VM_PTR myvm
#define ASSERTVM()
- #define SIGNAL_VM_PTR lookup_vm(thread_id())
+ #define SIGNAL_VM_PTR() lookup_vm(thread_id())
#endif
}
From 888eae9554608adb5dcc0bfaf06e5c16de5fc05d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 27 Aug 2009 19:49:57 +0100
Subject: [PATCH 166/266] fixed vm ptr passing to box_value_struct
---
basis/cpu/x86/64/64.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 925de44c23..498a502fca 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -165,7 +165,7 @@ M: x86.64 %box-large-struct ( n c-type -- )
! Compute destination address
param-reg-1 swap struct-return@ LEA
! Copy the struct from the C stack
- "box_value_struct" f %alien-invoke ;
+ "box_value_struct" %vm-invoke-3rd-arg ;
M: x86.64 %prepare-box-struct ( -- )
! Compute target address for value struct return
From 1b92721660dce1da3302a684967b0b2b0e0e5ea7 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 27 Aug 2009 19:55:25 +0100
Subject: [PATCH 167/266] fixed vm ptr passing to box_small_struct
---
basis/cpu/x86/64/64.factor | 22 +++++++++++++---------
1 file changed, 13 insertions(+), 9 deletions(-)
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 498a502fca..4bdabe30be 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -74,10 +74,22 @@ M: x86.64 %prepare-unbox ( -- )
param-reg-1 R14 [] MOV
R14 cell SUB ;
+M: x86.64 %vm-invoke-1st-arg ( function -- )
+ param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ f %alien-invoke ;
+
: %vm-invoke-2nd-arg ( function -- )
param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
+M: x86.64 %vm-invoke-3rd-arg ( function -- )
+ param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
+ f %alien-invoke ;
+
+: %vm-invoke-4th-arg ( function -- )
+ int-regs param-regs fourth 0 MOV rc-absolute-cell rt-vm rel-fixup
+ f %alien-invoke ;
+
M:: x86.64 %unbox ( n rep func -- )
! Call the unboxer
@@ -153,7 +165,7 @@ M: x86.64 %box-small-struct ( c-type -- )
[ param-reg-3 swap heap-size MOV ] bi
param-reg-1 0 box-struct-field@ MOV
param-reg-2 1 box-struct-field@ MOV
- "box_small_struct" f %alien-invoke
+ "box_small_struct" %vm-invoke-4th-arg
] with-return-regs ;
: struct-return@ ( n -- operand )
@@ -180,14 +192,6 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
-M: x86.64 %vm-invoke-1st-arg ( function -- )
- param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
- f %alien-invoke ;
-
-
-M: x86.64 %vm-invoke-3rd-arg ( function -- )
- param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
- f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
From 0470b7d2c590119d4b3c6c1a0755127e5f823f31 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 27 Aug 2009 19:58:40 +0100
Subject: [PATCH 168/266] fixed vm ptr passing to to_value_struct
---
basis/cpu/x86/64/64.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 4bdabe30be..5d5f30fbc2 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -127,7 +127,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
! Load structure size into param-reg-3
param-reg-3 c-type heap-size MOV
! Copy the struct to the C stack
- "to_value_struct" f %alien-invoke ;
+ "to_value_struct" %vm-invoke-4th-arg ;
: load-return-value ( rep -- )
[ [ 0 ] dip reg-class-of param-reg ]
@@ -194,7 +194,7 @@ M: x86.64 %alien-invoke
M: x86.64 %prepare-alien-indirect ( -- )
- "unbox_alien" f %alien-invoke
+ "unbox_alien" %vm-invoke-1st-arg
RBP RAX MOV ;
M: x86.64 %alien-indirect ( -- )
From 2e50da6beb8db4b86a1cdaea58078eca0fd00cbf Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 2 Sep 2009 10:43:21 +0100
Subject: [PATCH 169/266] added vm-ptr primitive
---
core/bootstrap/primitives.factor | 2 ++
vm/alien.cpp | 10 ++++++++++
vm/alien.hpp | 2 ++
vm/primitives.cpp | 1 +
vm/vm.hpp | 1 +
5 files changed, 16 insertions(+)
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 355fa8ed58..fc071cc566 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -103,6 +103,7 @@ bootstrapping? on
"words"
"vectors"
"vectors.private"
+ "vm"
} [ create-vocab drop ] each
! Builtin classes
@@ -518,6 +519,7 @@ tuple
{ "inline-cache-stats" "generic.single" (( -- stats )) }
{ "optimized?" "words" (( word -- ? )) }
{ "quot-compiled?" "quotations" (( quot -- ? )) }
+ { "vm-ptr" "vm" (( -- ptr )) }
} [ [ first3 ] dip swap make-primitive ] each-index
! Bump build number
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 829a7efeb6..ea8d0a6026 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -303,4 +303,14 @@ VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, f
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
}
+inline void factorvm::vmprim_vm_ptr()
+{
+ box_alien(this);
+}
+
+PRIMITIVE(vm_ptr)
+{
+ PRIMITIVE_GETVM()->vmprim_vm_ptr();
+}
+
}
diff --git a/vm/alien.hpp b/vm/alien.hpp
index 7b537146fd..ca3601f51e 100755
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@@ -36,6 +36,8 @@ PRIMITIVE(dlsym);
PRIMITIVE(dlclose);
PRIMITIVE(dll_validp);
+PRIMITIVE(vm_ptr);
+
VM_C_API char *alien_offset(cell object, factorvm *vm);
VM_C_API char *unbox_alien(factorvm *vm);
VM_C_API void box_alien(void *ptr, factorvm *vm);
diff --git a/vm/primitives.cpp b/vm/primitives.cpp
index 6dbe281d0c..1cbad03001 100644
--- a/vm/primitives.cpp
+++ b/vm/primitives.cpp
@@ -162,6 +162,7 @@ const primitive_type primitives[] = {
primitive_inline_cache_stats,
primitive_optimized_p,
primitive_quot_compiled_p,
+ primitive_vm_ptr,
};
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index c30af505f9..a16ff21121 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -585,6 +585,7 @@ struct factorvm {
inline void vmprim_dlsym();
inline void vmprim_dlclose();
inline void vmprim_dll_validp();
+ inline void vmprim_vm_ptr();
char *alien_offset(cell obj);
char *unbox_alien();
void box_alien(void *ptr);
From 4af25578d8ce5cf06973aab8ba9a1f6ee7d71d23 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 2 Sep 2009 10:45:03 +0100
Subject: [PATCH 170/266] fixed up some alien boxing (x86 32 & 64)
---
basis/cpu/x86/32/32.factor | 29 ++++++++++++++++++-----------
basis/cpu/x86/64/64.factor | 4 ++--
2 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index f711455fa3..85db5fb09c 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -133,7 +133,8 @@ M:: x86.32 %box ( n rep func -- )
M: x86.32 %box-long-long ( n func -- )
[ (%box-long-long) ] dip
- 8 [
+ 8 vm-ptr-size + [
+ push-vm-ptr
EDX PUSH
EAX PUSH
f %alien-invoke
@@ -141,12 +142,13 @@ M: x86.32 %box-long-long ( n func -- )
M:: x86.32 %box-large-struct ( n c-type -- )
! Compute destination address
- ECX n struct-return@ LEA
- 8 [
+ EDX n struct-return@ LEA
+ 8 vm-ptr-size + [
+ push-vm-ptr
! Push struct size
c-type heap-size PUSH
! Push destination address
- ECX PUSH
+ EDX PUSH
! Copy the struct from the C stack
"box_value_struct" f %alien-invoke
] with-aligned-stack ;
@@ -159,7 +161,8 @@ M: x86.32 %prepare-box-struct ( -- )
M: x86.32 %box-small-struct ( c-type -- )
#! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
- 12 [
+ 12 vm-ptr-size + [
+ push-vm-ptr
heap-size PUSH
EDX PUSH
EAX PUSH
@@ -200,7 +203,8 @@ M: x86.32 %unbox-long-long ( n func -- )
: %unbox-struct-1 ( -- )
#! Alien must be in EAX.
- 4 [
+ 4 vm-ptr-size + [
+ push-vm-ptr
EAX PUSH
"alien_offset" f %alien-invoke
! Load first cell
@@ -209,7 +213,8 @@ M: x86.32 %unbox-long-long ( n func -- )
: %unbox-struct-2 ( -- )
#! Alien must be in EAX.
- 4 [
+ 4 vm-ptr-size + [
+ push-vm-ptr
EAX PUSH
"alien_offset" f %alien-invoke
! Load second cell
@@ -228,12 +233,13 @@ M: x86 %unbox-small-struct ( size -- )
M:: x86.32 %unbox-large-struct ( n c-type -- )
! Alien must be in EAX.
! Compute destination address
- ECX n stack@ LEA
- 12 [
+ EDX n stack@ LEA
+ 12 vm-ptr-size + [
+ push-vm-ptr
! Push struct size
c-type heap-size PUSH
! Push destination address
- ECX PUSH
+ EDX PUSH
! Push source address
EAX PUSH
! Copy the struct to the stack
@@ -241,7 +247,8 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
] with-aligned-stack ;
M: x86.32 %prepare-alien-indirect ( -- )
- "unbox_alien" f %alien-invoke
+ push-vm-ptr "unbox_alien" f %alien-invoke
+ temp-reg POP
EBP EAX MOV ;
M: x86.32 %alien-indirect ( -- )
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 5d5f30fbc2..0528733af1 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -202,7 +202,7 @@ M: x86.64 %alien-indirect ( -- )
M: x86.64 %alien-callback ( quot -- )
param-reg-1 swap %load-reference
- "c_to_factor" f %alien-invoke ;
+ "c_to_factor" %vm-invoke-2nd-arg ;
M: x86.64 %callback-value ( ctype -- )
! Save top of data stack
@@ -211,7 +211,7 @@ M: x86.64 %callback-value ( ctype -- )
RSP 8 SUB
param-reg-1 PUSH
! Restore data/call/retain stacks
- "unnest_stacks" f %alien-invoke
+ "unnest_stacks" %vm-invoke-1st-arg
! Put former top of data stack in param-reg-1
param-reg-1 POP
RSP 8 ADD
From 3a3154797ccc5a95abe5fdc1b8ef336ce9648b73 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 28 Aug 2009 20:17:21 +0100
Subject: [PATCH 171/266] fixed stupid signal handler bug
---
vm/errors.cpp | 2 +-
vm/factor.cpp | 6 +++++-
vm/main-unix.cpp | 7 +------
3 files changed, 7 insertions(+), 8 deletions(-)
diff --git a/vm/errors.cpp b/vm/errors.cpp
index 154237a8f2..8372edf0d2 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -165,7 +165,7 @@ void factorvm::memory_signal_handler_impl()
void memory_signal_handler_impl()
{
- SIGNAL_VM_PTR()->misc_signal_handler_impl();
+ SIGNAL_VM_PTR()->memory_signal_handler_impl();
}
void factorvm::misc_signal_handler_impl()
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 026453eae3..741800f8d1 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -52,7 +52,11 @@ void factorvm::default_parameters(vm_parameters *p)
#ifdef WINDOWS
p->console = false;
#else
- p->console = true;
+ if (this == vm)
+ p->console = true;
+ else
+ p->console = false;
+
#endif
p->stack_traces = true;
diff --git a/vm/main-unix.cpp b/vm/main-unix.cpp
index bd1549a38e..bc605e3cfd 100644
--- a/vm/main-unix.cpp
+++ b/vm/main-unix.cpp
@@ -2,11 +2,6 @@
int main(int argc, char **argv)
{
- #ifdef FACTOR_MULTITHREADED
- factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(argc,argv);
- pthread_join(thread,NULL);
- #else
- factor::start_standalone_factor(argc,argv);
- #endif
+ factor::start_standalone_factor(argc,argv);
return 0;
}
From b1c68d92b7ece61074f17635355dbcf9c86f48e4 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 28 Aug 2009 20:23:01 +0100
Subject: [PATCH 172/266] added threadsafe defines. Dunno if they do much
---
vm/master.hpp | 3 +++
1 file changed, 3 insertions(+)
diff --git a/vm/master.hpp b/vm/master.hpp
index bf60d1e4f6..00ee181b8f 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -1,6 +1,9 @@
#ifndef __FACTOR_MASTER_H__
#define __FACTOR_MASTER_H__
+#define _THREAD_SAFE
+#define _REENTRANT
+
#ifndef WINCE
#include <errno.h>
#endif
From f4af39b60e09faae16acc99d3f389c79afb1b115 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 28 Aug 2009 21:46:47 +0100
Subject: [PATCH 173/266] thread_id is a pthread_t on unix
---
vm/factor.cpp | 15 ++++-----------
vm/factor.hpp | 2 ++
vm/main-unix.cpp | 1 +
vm/main-windows-nt.cpp | 1 +
vm/os-macosx.mm | 2 +-
vm/os-unix.cpp | 20 ++++++++++++++++++--
vm/os-unix.hpp | 6 +++++-
vm/os-windows-nt.cpp | 25 ++++++++++++++++++++++---
vm/os-windows-nt.hpp | 6 +++++-
vm/vm.hpp | 16 ++++++++--------
10 files changed, 67 insertions(+), 27 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 741800f8d1..4ef4d11796 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -5,19 +5,11 @@ namespace factor
factorvm *vm;
-unordered_map<long,factorvm*> thread_vms;
-
-factorvm *lookup_vm(unsigned long threadid)
+void init_globals()
{
- return thread_vms[threadid];
+ init_platform_globals();
}
-void register_vm(unsigned long threadid, factorvm *thevm)
-{
- thread_vms[threadid] = thevm;
-}
-
-
void factorvm::default_parameters(vm_parameters *p)
{
p->image_path = NULL;
@@ -217,7 +209,6 @@ void factorvm::factor_sleep(long us)
void factorvm::start_standalone_factor(int argc, vm_char **argv)
{
- register_vm(thread_id(),this);
vm_parameters p;
default_parameters(&p);
init_parameters_from_args(&p,argc,argv);
@@ -234,6 +225,7 @@ struct startargs {
void* start_standalone_factor_thread(void *arg)
{
factorvm *newvm = new factorvm;
+ register_vm_with_thread(newvm);
startargs *args = (startargs*) arg;
newvm->start_standalone_factor(args->argc, args->argv);
return 0;
@@ -244,6 +236,7 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv)
{
factorvm *newvm = new factorvm;
vm = newvm;
+ register_vm_with_thread(newvm);
return newvm->start_standalone_factor(argc,argv);
}
diff --git a/vm/factor.hpp b/vm/factor.hpp
index 46662072b5..5f41c952e1 100644
--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@@ -1,6 +1,8 @@
namespace factor
{
+VM_C_API void init_globals();
+
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv);
}
diff --git a/vm/main-unix.cpp b/vm/main-unix.cpp
index bc605e3cfd..b8914e2bd3 100644
--- a/vm/main-unix.cpp
+++ b/vm/main-unix.cpp
@@ -2,6 +2,7 @@
int main(int argc, char **argv)
{
+ factor::init_globals();
factor::start_standalone_factor(argc,argv);
return 0;
}
diff --git a/vm/main-windows-nt.cpp b/vm/main-windows-nt.cpp
index 2120717d86..df4a1172f1 100644
--- a/vm/main-windows-nt.cpp
+++ b/vm/main-windows-nt.cpp
@@ -16,6 +16,7 @@ int WINAPI WinMain(
return 1;
}
+ factor::init_globals();
#ifdef FACTOR_MULTITHREADED
factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist);
WaitForSingleObject(thread, INFINITE);
diff --git a/vm/os-macosx.mm b/vm/os-macosx.mm
index e4da7b2221..7f692def06 100644
--- a/vm/os-macosx.mm
+++ b/vm/os-macosx.mm
@@ -5,7 +5,7 @@
namespace factor
{
-void c_to_factor_toplevel(cell quot)
+void factorvm::c_to_factor_toplevel(cell quot)
{
for(;;)
{
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 4cee04a11b..7913647f3e 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -17,10 +17,26 @@ THREADHANDLE start_thread(void *(*start_routine)(void *),void *args)
return thread;
}
-unsigned long thread_id(){
- return pthread_self();
+
+pthread_key_t tlsKey = 0;
+
+void init_platform_globals()
+{
+ if (pthread_key_create(&tlsKey, NULL) != 0){
+ fatal_error("pthread_key_create() failed",0);
+ }
+
}
+void register_vm_with_thread(factorvm *vm)
+{
+ pthread_setspecific(tlsKey,vm);
+}
+
+factorvm *tls_vm()
+{
+ return (factorvm*)pthread_getspecific(tlsKey);
+}
static void *null_dll;
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index e3e207f641..5f84106f97 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -45,7 +45,7 @@ typedef char symbol_char;
typedef pthread_t THREADHANDLE;
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
-unsigned long thread_id();
+pthread_t thread_id();
void unix_init_signals();
void signal_handler(int signal, siginfo_t* siginfo, void* uap);
@@ -54,5 +54,9 @@ void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);
s64 current_micros();
void sleep_micros(cell usec);
+void init_platform_globals();
+struct factorvm;
+void register_vm_with_thread(factorvm *vm);
+factorvm *tls_vm();
void open_console();
}
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index fbaadaaba7..ee00e1434a 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -3,12 +3,31 @@
namespace factor
{
+
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args){
return (void*) CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
}
-unsigned long thread_id(){
- return GetCurrentThreadId();
+
+DWORD dwTlsIndex;
+
+void init_platform_globals()
+{
+ if ((dwTlsIndex = TlsAlloc()) == TLS_OUT_OF_INDEXES) {
+ fatal_error("TlsAlloc failed - out of indexes",0);
+ }
+}
+
+void register_vm_with_thread(factorvm *vm)
+{
+ if (! TlsSetValue(dwTlsIndex, vm)) {
+ fatal_error("TlsSetValue failed",0);
+ }
+}
+
+factorvm *tls_vm()
+{
+ return (factorvm*)TlsGetValue(dwTlsIndex);
}
@@ -22,7 +41,7 @@ s64 current_micros()
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
- factorvm *myvm = lookup_vm(GetCurrentThreadId());
+ factorvm *myvm = SIGNAL_VM_PTR();
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index 385553e11e..366348a898 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -29,6 +29,10 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
typedef HANDLE THREADHANDLE;
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
-unsigned long thread_id();
+
+void init_platform_globals();
+struct factorvm;
+void register_vm_with_thread(factorvm *vm);
+factorvm *tls_vm();
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index a16ff21121..b94ba16e00 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -690,12 +690,11 @@ struct factorvm {
};
-extern factorvm *lookup_vm(unsigned long threadid);
-extern void register_vm(unsigned long threadid,factorvm *vm);
+// #define FACTOR_SINGLE_THREADED_SINGLETON
+#define FACTOR_SINGLE_THREADED_TESTING
-#define FACTOR_SINGLE_THREADED
-
-#ifdef FACTOR_SINGLE_THREADED
+#ifdef FACTOR_SINGLE_THREADED_SINGLETON
+/* calls are dispatched using the singleton */
extern factorvm *vm;
#define PRIMITIVE_GETVM() vm
#define PRIMITIVE_OVERFLOW_GETVM() vm
@@ -704,13 +703,14 @@ extern void register_vm(unsigned long threadid,factorvm *vm);
#define SIGNAL_VM_PTR() vm
#endif
-#ifdef FACTOR_TESTING_MULTITHREADED
+#ifdef FACTOR_SINGLE_THREADED_TESTING
+/* calls are dispatched as per multithreaded, but checked against singleton */
extern factorvm *vm;
#define PRIMITIVE_GETVM() ((factorvm*)myvm)
#define PRIMITIVE_OVERFLOW_GETVM() vm
#define VM_PTR myvm
#define ASSERTVM() assert(vm==myvm)
- #define SIGNAL_VM_PTR() lookup_vm(thread_id())
+ #define SIGNAL_VM_PTR() tls_vm()
#endif
#ifdef FACTOR_MULTITHREADED
@@ -718,7 +718,7 @@ extern void register_vm(unsigned long threadid,factorvm *vm);
#define PRIMITIVE_OVERFLOW_GETVM() ((factorvm*)myvm)
#define VM_PTR myvm
#define ASSERTVM()
- #define SIGNAL_VM_PTR() lookup_vm(thread_id())
+ #define SIGNAL_VM_PTR() tls_vm()
#endif
}
From e49fa4109d1950a2acb041b4c39df02c7509668b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 1 Sep 2009 19:08:27 +0100
Subject: [PATCH 174/266] added FACTOR_MULTITHREADED_TLS option
---
vm/vm.hpp | 14 +++++++++++---
1 file changed, 11 insertions(+), 3 deletions(-)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b94ba16e00..6570cf0c04 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -690,11 +690,10 @@ struct factorvm {
};
-// #define FACTOR_SINGLE_THREADED_SINGLETON
-#define FACTOR_SINGLE_THREADED_TESTING
+#define FACTOR_MULTITHREADED_TLS
#ifdef FACTOR_SINGLE_THREADED_SINGLETON
-/* calls are dispatched using the singleton */
+/* calls are dispatched using the singleton vm ptr */
extern factorvm *vm;
#define PRIMITIVE_GETVM() vm
#define PRIMITIVE_OVERFLOW_GETVM() vm
@@ -713,6 +712,15 @@ struct factorvm {
#define SIGNAL_VM_PTR() tls_vm()
#endif
+#ifdef FACTOR_MULTITHREADED_TLS
+/* uses thread local storage to obtain vm ptr */
+ #define PRIMITIVE_GETVM() tls_vm()
+ #define PRIMITIVE_OVERFLOW_GETVM() tls_vm()
+ #define VM_PTR tls_vm()
+ #define ASSERTVM()
+ #define SIGNAL_VM_PTR() tls_vm()
+#endif
+
#ifdef FACTOR_MULTITHREADED
#define PRIMITIVE_GETVM() ((factorvm*)myvm)
#define PRIMITIVE_OVERFLOW_GETVM() ((factorvm*)myvm)
From 544bc3cd336e9fefbc5ec3cf2b2a66e939332aef Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 1 Sep 2009 19:17:34 +0100
Subject: [PATCH 175/266] removed vm ptr from os-macosx.mm
---
vm/os-macosx.mm | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/vm/os-macosx.mm b/vm/os-macosx.mm
index 7f692def06..872e0b8b48 100644
--- a/vm/os-macosx.mm
+++ b/vm/os-macosx.mm
@@ -10,11 +10,11 @@ void factorvm::c_to_factor_toplevel(cell quot)
for(;;)
{
NS_DURING
- c_to_factor(quot,vm);
+ c_to_factor(quot,this);
NS_VOIDRETURN;
NS_HANDLER
- dpush(vm->allot_alien(F,(cell)localException));
- quot = vm->userenv[COCOA_EXCEPTION_ENV];
+ dpush(allot_alien(F,(cell)localException));
+ quot = userenv[COCOA_EXCEPTION_ENV];
if(!tagged<object>(quot).type_p(QUOTATION_TYPE))
{
/* No Cocoa exception handler was registered, so
From 9e460f6decdc801be87423b81ca7f24146fe0af8 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 1 Sep 2009 19:40:03 +0100
Subject: [PATCH 176/266] removed vm ptr from mach_signal and some other places
---
vm/mach_signal.cpp | 10 +++++-----
vm/os-freebsd.cpp | 2 +-
vm/os-linux-arm.cpp | 2 +-
vm/os-linux.cpp | 6 +++---
4 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index ecded49c0f..03a6ca2b72 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -41,18 +41,18 @@ static void call_fault_handler(
a divide by zero or stack underflow in the listener */
/* Are we in compiled Factor code? Then use the current stack pointer */
- if(vm->in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
- vm->signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
+ if(SIGNAL_VM_PTR()->in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
+ SIGNAL_VM_PTR()->signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
/* Are we in C? Then use the saved callstack top */
else
- vm->signal_callstack_top = NULL;
+ SIGNAL_VM_PTR()->signal_callstack_top = NULL;
MACH_STACK_POINTER(thread_state) = fix_stack_pointer(MACH_STACK_POINTER(thread_state));
/* Now we point the program counter at the right handler function. */
if(exception == EXC_BAD_ACCESS)
{
- vm->signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
+ SIGNAL_VM_PTR()->signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
MACH_PROGRAM_COUNTER(thread_state) = (cell)memory_signal_handler_impl;
}
else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV)
@@ -63,7 +63,7 @@ static void call_fault_handler(
}
else
{
- vm->signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
+ SIGNAL_VM_PTR()->signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
MACH_PROGRAM_COUNTER(thread_state) = (cell)misc_signal_handler_impl;
}
}
diff --git a/vm/os-freebsd.cpp b/vm/os-freebsd.cpp
index 64c8ac19da..d259658284 100644
--- a/vm/os-freebsd.cpp
+++ b/vm/os-freebsd.cpp
@@ -33,7 +33,7 @@ const char *vm_executable_path()
if(strcmp(path, "unknown") == 0)
return NULL;
- return vm->safe_strdup(path);
+ return safe_strdup(path);
}
}
diff --git a/vm/os-linux-arm.cpp b/vm/os-linux-arm.cpp
index 9a9ce7ada5..0f459d5ec5 100644
--- a/vm/os-linux-arm.cpp
+++ b/vm/os-linux-arm.cpp
@@ -25,7 +25,7 @@ void flush_icache(cell start, cell len)
: "r0","r1","r2");
if(result < 0)
- vm->critical_error("flush_icache() failed",result);
+ SIGNAL_VM_PTR->critical_error("flush_icache() failed",result);
}
}
diff --git a/vm/os-linux.cpp b/vm/os-linux.cpp
index 7929701d41..66b197e7c9 100644
--- a/vm/os-linux.cpp
+++ b/vm/os-linux.cpp
@@ -42,19 +42,19 @@ VM_C_API int inotify_rm_watch(int fd, u32 wd)
VM_C_API int inotify_init()
{
- vm->not_implemented_error();
+ VM_PTR->not_implemented_error();
return -1;
}
VM_C_API int inotify_add_watch(int fd, const char *name, u32 mask)
{
- vm->not_implemented_error();
+ VM_PTR->not_implemented_error();
return -1;
}
VM_C_API int inotify_rm_watch(int fd, u32 wd)
{
- vm->not_implemented_error();
+ VM_PTR->not_implemented_error();
return -1;
}
From 9bf6f97e35f6e6ca8c48d52b106b3963f9bc28b3 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 1 Sep 2009 20:47:18 +0100
Subject: [PATCH 177/266] Switched on singleton flag
---
vm/vm.hpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 6570cf0c04..91a832aa10 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -690,7 +690,7 @@ struct factorvm {
};
-#define FACTOR_MULTITHREADED_TLS
+#define FACTOR_SINGLE_THREADED_SINGLETON
#ifdef FACTOR_SINGLE_THREADED_SINGLETON
/* calls are dispatched using the singleton vm ptr */
From b07550620f9d7f005a03f9e275afa445da98aed0 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 3 Sep 2009 19:41:19 +0100
Subject: [PATCH 178/266] Dev checkpoint
---
basis/vm/vm.factor | 1 -
vm/errors.cpp | 2 +-
vm/vm.hpp | 175 ++++++++++++++++++++++++---------------------
3 files changed, 96 insertions(+), 82 deletions(-)
diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
index e2e7fc879c..ab5a98ab3c 100644
--- a/basis/vm/vm.factor
+++ b/basis/vm/vm.factor
@@ -17,7 +17,6 @@ C-STRUCT: vm
{ "zone" "nursery" }
{ "cell" "cards_offset" }
{ "cell" "decks_offset" }
- { "cell" "__padding__" }
{ "cell[70]" "userenv" }
;
diff --git a/vm/errors.cpp b/vm/errors.cpp
index 8372edf0d2..c137782f81 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -185,7 +185,7 @@ void factorvm::fp_signal_handler_impl()
void fp_signal_handler_impl()
{
- SIGNAL_VM_PTR->fp_signal_handler_impl();
+ SIGNAL_VM_PTR()->fp_signal_handler_impl();
}
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 91a832aa10..b6508c7560 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -1,27 +1,112 @@
namespace factor
{
-struct factorvm {
-
+struct factorvmdata {
// if you change this struct, also change vm.factor k--------
context *stack_chain;
zone nursery; /* new objects are allocated here */
cell cards_offset;
cell decks_offset;
-#ifndef FACTOR_64
- cell __padding__ ; // align to 8 byte boundary
-#endif
cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-#ifndef FACTOR_64
- cell __padding2__; // not sure why we need this, bootstrap doesn't work without it
-#endif
+
+ // -------------------------------
+
+ // contexts
+ cell ds_size, rs_size;
+ context *unused_contexts;
+
+ // run
+ cell T; /* Canonical T object. It's just a word */
+
+ // profiler
+ bool profiling_p;
+
+ // errors
+ /* Global variables used to pass fault handler state from signal handler to
+ user-space */
+ cell signal_number;
+ cell signal_fault_addr;
+ unsigned int signal_fpu_status;
+ stack_frame *signal_callstack_top;
+ //data_heap
+ bool secure_gc; /* Set by the -securegc command line argument */
+ bool gc_off; /* GC is off during heap walking */
+ data_heap *data;
+ /* A heap walk allows useful things to be done, like finding all
+ references to an object for debugging purposes. */
+ cell heap_scan_ptr;
+ //write barrier
+ cell allot_markers_offset;
+ //data_gc
+ /* used during garbage collection only */
+ zone *newspace;
+ bool performing_gc;
+ bool performing_compaction;
+ cell collecting_gen;
+ /* if true, we are 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];
+ u64 cards_scanned;
+ u64 decks_scanned;
+ u64 card_scan_time;
+ cell code_heap_scans;
+ /* What generation was being collected when copy_code_heap_roots() was last
+ called? Until the next call to add_code_block(), future
+ collections of younger generations don't have to touch the code
+ heap. */
+ cell last_code_heap_scan;
+ /* sometimes we grow the heap */
+ bool growing_data_heap;
+ data_heap *old_data_heap;
+
+ // local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
+ std::vector<cell> gc_locals;
+ std::vector<cell> gc_bignums;
+
+ //debug
+ bool fep_disabled;
+ bool full_output;
+ cell look_for;
+ cell obj;
+
+ //math
+ cell bignum_zero;
+ cell bignum_pos_one;
+ cell bignum_neg_one;
+
+ //code_heap
+ heap code;
+ unordered_map<heap_block *,char *> forwarding;
+
+ //image
+ cell code_relocation_base;
+ cell data_relocation_base;
+
+ //dispatch
+ cell megamorphic_cache_hits;
+ cell megamorphic_cache_misses;
+
+ //inline cache
+ cell max_pic_size;
+ cell cold_call_to_ic_transitions;
+ cell ic_to_pic_transitions;
+ cell pic_to_mega_transitions;
+ cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
+};
+
+struct factorvm : factorvmdata {
// segments
inline cell align_page(cell a);
// contexts
- cell ds_size, rs_size;
- context *unused_contexts;
void reset_datastack();
void reset_retainstack();
void fix_stacks();
@@ -40,7 +125,6 @@ struct factorvm {
inline void vmprim_check_datastack();
// run
- cell T; /* Canonical T object. It's just a word */
inline void vmprim_getenv();
inline void vmprim_setenv();
inline void vmprim_exit();
@@ -52,19 +136,12 @@ struct factorvm {
inline void vmprim_clone();
// profiler
- bool profiling_p;
void init_profiler();
code_block *compile_profiling_stub(cell word_);
void set_profiling(bool profiling);
inline void vmprim_profiling();
// errors
- /* Global variables used to pass fault handler state from signal handler to
- user-space */
- cell signal_number;
- cell signal_fault_addr;
- unsigned int signal_fpu_status;
- stack_frame *signal_callstack_top;
void out_of_memory();
void critical_error(const char* msg, cell tagged);
void throw_error(cell error, stack_frame *callstack_top);
@@ -148,12 +225,6 @@ struct factorvm {
bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm *), unsigned int radix, int negative_p);
//data_heap
- bool secure_gc; /* Set by the -securegc command line argument */
- bool gc_off; /* GC is off during heap walking */
- data_heap *data;
- /* A heap walk allows useful things to be done, like finding all
- references to an object for debugging purposes. */
- cell heap_scan_ptr;
cell init_zone(zone *z, cell size, cell start);
void init_card_decks();
data_heap *alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size);
@@ -183,7 +254,6 @@ struct factorvm {
//write barrier
- cell allot_markers_offset;
inline card *addr_to_card(cell a);
inline cell card_to_addr(card *c);
inline cell card_offset(card *c);
@@ -196,36 +266,6 @@ struct factorvm {
//data_gc
- /* used during garbage collection only */
- zone *newspace;
- bool performing_gc;
- bool performing_compaction;
- cell collecting_gen;
-
- /* if true, we are 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];
- u64 cards_scanned;
- u64 decks_scanned;
- u64 card_scan_time;
- cell code_heap_scans;
-
- /* What generation was being collected when copy_code_heap_roots() was last
- called? Until the next call to add_code_block(), future
- collections of younger generations don't have to touch the code
- heap. */
- cell last_code_heap_scan;
-
- /* sometimes we grow the heap */
- bool growing_data_heap;
- data_heap *old_data_heap;
-
void init_data_gc();
object *copy_untagged_object_impl(object *pointer, cell size);
object *copy_object_impl(object *untagged);
@@ -263,23 +303,12 @@ struct factorvm {
inline void check_tagged_pointer(cell tagged);
inline void vmprim_clear_gc_stats();
- // local roots
- /* If a runtime function needs to call another function which potentially
- allocates memory, it must wrap any local variable references to Factor
- objects in gc_root instances */
- std::vector<cell> gc_locals;
- std::vector<cell> gc_bignums;
-
// generic arrays
template <typename T> T *allot_array_internal(cell capacity);
template <typename T> bool reallot_array_in_place_p(T *array, cell capacity);
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
//debug
- bool fep_disabled;
- bool full_output;
- cell look_for;
- cell obj;
void print_chars(string* str);
void print_word(word* word, cell nesting);
void print_factor_string(string* str);
@@ -353,9 +382,6 @@ struct factorvm {
inline void vmprim_wrapper();
//math
- cell bignum_zero;
- cell bignum_pos_one;
- cell bignum_neg_one;
inline void vmprim_bignum_to_fixnum();
inline void vmprim_float_to_fixnum();
inline void vmprim_fixnum_divint();
@@ -511,8 +537,6 @@ struct factorvm {
}
//code_heap
- heap code;
- unordered_map<heap_block *,char *> forwarding;
void init_code_heap(cell size);
bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word_, cell def_, bool relocate);
@@ -530,8 +554,6 @@ struct factorvm {
//image
- cell code_relocation_base;
- cell data_relocation_base;
void init_objects(image_header *h);
void load_data_heap(FILE *file, image_header *h, vm_parameters *p);
void load_code_heap(FILE *file, image_header *h, vm_parameters *p);
@@ -606,8 +628,6 @@ struct factorvm {
inline void vmprim_quot_compiled_p();
//dispatch
- cell megamorphic_cache_hits;
- cell megamorphic_cache_misses;
cell search_lookup_alist(cell table, cell klass);
cell search_lookup_hash(cell table, cell klass, cell hashcode);
cell nth_superclass(tuple_layout *layout, fixnum echelon);
@@ -625,11 +645,6 @@ struct factorvm {
inline void vmprim_dispatch_stats();
//inline cache
- cell max_pic_size;
- cell cold_call_to_ic_transitions;
- cell ic_to_pic_transitions;
- cell pic_to_mega_transitions;
- cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
void init_inline_caching(int max_size);
void deallocate_inline_cache(cell return_address);
cell determine_inline_cache_type(array *cache_entries);
From e8d1612e8e1c30ccf52c384d145fd854a8535885 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Thu, 3 Sep 2009 20:32:39 +0100
Subject: [PATCH 179/266] Split data out into separate vm-data struct
---
vm/bignum.cpp | 2574 +++++++++++++++++++++---------------------
vm/errors.cpp | 7 -
vm/factor.cpp | 156 +++
vm/os-windows-nt.cpp | 31 +-
vm/vm-data-dummy.hpp | 116 ++
vm/vm-data.hpp | 105 ++
vm/vm.hpp | 105 +-
7 files changed, 1687 insertions(+), 1407 deletions(-)
create mode 100644 vm/vm-data-dummy.hpp
create mode 100644 vm/vm-data.hpp
diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 4c01b12820..3e754c2ab5 100755
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -1,36 +1,36 @@
/* :tabSize=2:indentSize=2:noTabs=true:
-Copyright (C) 1989-94 Massachusetts Institute of Technology
-Portions copyright (C) 2004-2008 Slava Pestov
+ Copyright (C) 1989-94 Massachusetts Institute of Technology
+ Portions copyright (C) 2004-2008 Slava Pestov
-This material was developed by the Scheme project at the Massachusetts
-Institute of Technology, Department of Electrical Engineering and
-Computer Science. Permission to copy and modify this software, to
-redistribute either the original software or a modified version, and
-to use this software for any purpose is granted, subject to the
-following restrictions and understandings.
+ This material was developed by the Scheme project at the Massachusetts
+ Institute of Technology, Department of Electrical Engineering and
+ Computer Science. Permission to copy and modify this software, to
+ redistribute either the original software or a modified version, and
+ to use this software for any purpose is granted, subject to the
+ following restrictions and understandings.
-1. Any copy made of this software must include this copyright notice
-in full.
+ 1. Any copy made of this software must include this copyright notice
+ in full.
-2. Users of this software agree to make their best efforts (a) to
-return to the MIT Scheme project any improvements or extensions that
-they make, so that these may be included in future releases; and (b)
-to inform MIT of noteworthy uses of this software.
+ 2. Users of this software agree to make their best efforts (a) to
+ return to the MIT Scheme project any improvements or extensions that
+ they make, so that these may be included in future releases; and (b)
+ to inform MIT of noteworthy uses of this software.
-3. All materials developed as a consequence of the use of this
-software shall duly acknowledge such use, in accordance with the usual
-standards of acknowledging credit in academic research.
+ 3. All materials developed as a consequence of the use of this
+ software shall duly acknowledge such use, in accordance with the usual
+ standards of acknowledging credit in academic research.
-4. MIT has made no warrantee or representation that the operation of
-this software will be error-free, and MIT is under no obligation to
-provide any services, by way of maintenance, update, or otherwise.
+ 4. MIT has made no warrantee or representation that the operation of
+ this software will be error-free, and MIT is under no obligation to
+ provide any services, by way of maintenance, update, or otherwise.
-5. In conjunction with products arising from the use of this material,
-there shall be no use of the name of the Massachusetts Institute of
-Technology nor of any adaptation thereof in any advertising,
-promotional, or sales literature without prior written consent from
-MIT in each case. */
+ 5. In conjunction with products arising from the use of this material,
+ there shall be no use of the name of the Massachusetts Institute of
+ Technology nor of any adaptation thereof in any advertising,
+ promotional, or sales literature without prior written consent from
+ MIT in each case. */
/* Changes for Scheme 48:
* - Converted to ANSI.
@@ -63,309 +63,309 @@ namespace factor
int factorvm::bignum_equal_p(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? (BIGNUM_ZERO_P (y))
- : ((! (BIGNUM_ZERO_P (y)))
- && ((BIGNUM_NEGATIVE_P (x))
- ? (BIGNUM_NEGATIVE_P (y))
- : (! (BIGNUM_NEGATIVE_P (y))))
- && (bignum_equal_p_unsigned (x, y))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? (BIGNUM_ZERO_P (y))
+ : ((! (BIGNUM_ZERO_P (y)))
+ && ((BIGNUM_NEGATIVE_P (x))
+ ? (BIGNUM_NEGATIVE_P (y))
+ : (! (BIGNUM_NEGATIVE_P (y))))
+ && (bignum_equal_p_unsigned (x, y))));
}
enum bignum_comparison factorvm::bignum_compare(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? ((BIGNUM_ZERO_P (y))
- ? bignum_comparison_equal
- : (BIGNUM_NEGATIVE_P (y))
- ? bignum_comparison_greater
- : bignum_comparison_less)
- : (BIGNUM_ZERO_P (y))
- ? ((BIGNUM_NEGATIVE_P (x))
- ? bignum_comparison_less
- : bignum_comparison_greater)
- : (BIGNUM_NEGATIVE_P (x))
- ? ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_compare_unsigned (y, x))
- : (bignum_comparison_less))
- : ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_comparison_greater)
- : (bignum_compare_unsigned (x, y))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? ((BIGNUM_ZERO_P (y))
+ ? bignum_comparison_equal
+ : (BIGNUM_NEGATIVE_P (y))
+ ? bignum_comparison_greater
+ : bignum_comparison_less)
+ : (BIGNUM_ZERO_P (y))
+ ? ((BIGNUM_NEGATIVE_P (x))
+ ? bignum_comparison_less
+ : bignum_comparison_greater)
+ : (BIGNUM_NEGATIVE_P (x))
+ ? ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_compare_unsigned (y, x))
+ : (bignum_comparison_less))
+ : ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_comparison_greater)
+ : (bignum_compare_unsigned (x, y))));
}
/* allocates memory */
bignum *factorvm::bignum_add(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? (y)
- : (BIGNUM_ZERO_P (y))
- ? (x)
- : ((BIGNUM_NEGATIVE_P (x))
- ? ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_add_unsigned (x, y, 1))
- : (bignum_subtract_unsigned (y, x)))
- : ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_subtract_unsigned (x, y))
- : (bignum_add_unsigned (x, y, 0)))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? (y)
+ : (BIGNUM_ZERO_P (y))
+ ? (x)
+ : ((BIGNUM_NEGATIVE_P (x))
+ ? ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_add_unsigned (x, y, 1))
+ : (bignum_subtract_unsigned (y, x)))
+ : ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_subtract_unsigned (x, y))
+ : (bignum_add_unsigned (x, y, 0)))));
}
/* allocates memory */
bignum *factorvm::bignum_subtract(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? ((BIGNUM_ZERO_P (y))
- ? (y)
- : (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
- : ((BIGNUM_ZERO_P (y))
- ? (x)
- : ((BIGNUM_NEGATIVE_P (x))
- ? ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_subtract_unsigned (y, x))
- : (bignum_add_unsigned (x, y, 1)))
- : ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_add_unsigned (x, y, 0))
- : (bignum_subtract_unsigned (x, y))))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? ((BIGNUM_ZERO_P (y))
+ ? (y)
+ : (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
+ : ((BIGNUM_ZERO_P (y))
+ ? (x)
+ : ((BIGNUM_NEGATIVE_P (x))
+ ? ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_subtract_unsigned (y, x))
+ : (bignum_add_unsigned (x, y, 1)))
+ : ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_add_unsigned (x, y, 0))
+ : (bignum_subtract_unsigned (x, y))))));
}
/* allocates memory */
bignum *factorvm::bignum_multiply(bignum * x, bignum * y)
{
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum_length_type y_length = (BIGNUM_LENGTH (y));
- int negative_p =
- ((BIGNUM_NEGATIVE_P (x))
- ? (! (BIGNUM_NEGATIVE_P (y)))
- : (BIGNUM_NEGATIVE_P (y)));
- if (BIGNUM_ZERO_P (x))
- return (x);
- if (BIGNUM_ZERO_P (y))
- return (y);
- if (x_length == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (x, 0));
- if (digit == 1)
- return (bignum_maybe_new_sign (y, negative_p));
- if (digit < BIGNUM_RADIX_ROOT)
- return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
- }
- if (y_length == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (y, 0));
- if (digit == 1)
- return (bignum_maybe_new_sign (x, negative_p));
- if (digit < BIGNUM_RADIX_ROOT)
- return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
- }
- return (bignum_multiply_unsigned (x, y, negative_p));
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ bignum_length_type y_length = (BIGNUM_LENGTH (y));
+ int negative_p =
+ ((BIGNUM_NEGATIVE_P (x))
+ ? (! (BIGNUM_NEGATIVE_P (y)))
+ : (BIGNUM_NEGATIVE_P (y)));
+ if (BIGNUM_ZERO_P (x))
+ return (x);
+ if (BIGNUM_ZERO_P (y))
+ return (y);
+ if (x_length == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (x, 0));
+ if (digit == 1)
+ return (bignum_maybe_new_sign (y, negative_p));
+ if (digit < BIGNUM_RADIX_ROOT)
+ return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
+ }
+ if (y_length == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (y, 0));
+ if (digit == 1)
+ return (bignum_maybe_new_sign (x, negative_p));
+ if (digit < BIGNUM_RADIX_ROOT)
+ return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
+ }
+ return (bignum_multiply_unsigned (x, y, negative_p));
}
/* allocates memory */
void factorvm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
{
- if (BIGNUM_ZERO_P (denominator))
- {
- divide_by_zero_error();
- return;
- }
- if (BIGNUM_ZERO_P (numerator))
- {
- (*quotient) = numerator;
- (*remainder) = numerator;
- }
- else
- {
- int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
- int q_negative_p =
- ((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
- switch (bignum_compare_unsigned (numerator, denominator))
- {
- case bignum_comparison_equal:
- {
- (*quotient) = (BIGNUM_ONE (q_negative_p));
- (*remainder) = (BIGNUM_ZERO ());
- break;
- }
- case bignum_comparison_less:
- {
- (*quotient) = (BIGNUM_ZERO ());
- (*remainder) = numerator;
- break;
- }
- case bignum_comparison_greater:
- {
- if ((BIGNUM_LENGTH (denominator)) == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
- if (digit == 1)
- {
- (*quotient) =
- (bignum_maybe_new_sign (numerator, q_negative_p));
- (*remainder) = (BIGNUM_ZERO ());
- break;
- }
- else if (digit < BIGNUM_RADIX_ROOT)
- {
- bignum_divide_unsigned_small_denominator
- (numerator, digit,
- quotient, remainder,
- q_negative_p, r_negative_p);
- break;
- }
- else
- {
- bignum_divide_unsigned_medium_denominator
- (numerator, digit,
- quotient, remainder,
- q_negative_p, r_negative_p);
- break;
- }
- }
- bignum_divide_unsigned_large_denominator
- (numerator, denominator,
- quotient, remainder,
- q_negative_p, r_negative_p);
- break;
- }
- }
- }
+ if (BIGNUM_ZERO_P (denominator))
+ {
+ divide_by_zero_error();
+ return;
+ }
+ if (BIGNUM_ZERO_P (numerator))
+ {
+ (*quotient) = numerator;
+ (*remainder) = numerator;
+ }
+ else
+ {
+ int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
+ int q_negative_p =
+ ((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
+ switch (bignum_compare_unsigned (numerator, denominator))
+ {
+ case bignum_comparison_equal:
+ {
+ (*quotient) = (BIGNUM_ONE (q_negative_p));
+ (*remainder) = (BIGNUM_ZERO ());
+ break;
+ }
+ case bignum_comparison_less:
+ {
+ (*quotient) = (BIGNUM_ZERO ());
+ (*remainder) = numerator;
+ break;
+ }
+ case bignum_comparison_greater:
+ {
+ if ((BIGNUM_LENGTH (denominator)) == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
+ if (digit == 1)
+ {
+ (*quotient) =
+ (bignum_maybe_new_sign (numerator, q_negative_p));
+ (*remainder) = (BIGNUM_ZERO ());
+ break;
+ }
+ else if (digit < BIGNUM_RADIX_ROOT)
+ {
+ bignum_divide_unsigned_small_denominator
+ (numerator, digit,
+ quotient, remainder,
+ q_negative_p, r_negative_p);
+ break;
+ }
+ else
+ {
+ bignum_divide_unsigned_medium_denominator
+ (numerator, digit,
+ quotient, remainder,
+ q_negative_p, r_negative_p);
+ break;
+ }
+ }
+ bignum_divide_unsigned_large_denominator
+ (numerator, denominator,
+ quotient, remainder,
+ q_negative_p, r_negative_p);
+ break;
+ }
+ }
+ }
}
/* allocates memory */
bignum *factorvm::bignum_quotient(bignum * numerator, bignum * denominator)
{
- if (BIGNUM_ZERO_P (denominator))
- {
- divide_by_zero_error();
- return (BIGNUM_OUT_OF_BAND);
- }
- if (BIGNUM_ZERO_P (numerator))
- return numerator;
- {
- int q_negative_p =
- ((BIGNUM_NEGATIVE_P (denominator))
- ? (! (BIGNUM_NEGATIVE_P (numerator)))
- : (BIGNUM_NEGATIVE_P (numerator)));
- switch (bignum_compare_unsigned (numerator, denominator))
- {
- case bignum_comparison_equal:
- return (BIGNUM_ONE (q_negative_p));
- case bignum_comparison_less:
- return (BIGNUM_ZERO ());
- case bignum_comparison_greater:
- default: /* to appease gcc -Wall */
- {
- bignum * quotient;
- if ((BIGNUM_LENGTH (denominator)) == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
- if (digit == 1)
- return (bignum_maybe_new_sign (numerator, q_negative_p));
- if (digit < BIGNUM_RADIX_ROOT)
- bignum_divide_unsigned_small_denominator
- (numerator, digit,
- ("ient), ((bignum * *) 0),
- q_negative_p, 0);
- else
- bignum_divide_unsigned_medium_denominator
- (numerator, digit,
- ("ient), ((bignum * *) 0),
- q_negative_p, 0);
- }
- else
- bignum_divide_unsigned_large_denominator
- (numerator, denominator,
- ("ient), ((bignum * *) 0),
- q_negative_p, 0);
- return (quotient);
- }
- }
- }
+ if (BIGNUM_ZERO_P (denominator))
+ {
+ divide_by_zero_error();
+ return (BIGNUM_OUT_OF_BAND);
+ }
+ if (BIGNUM_ZERO_P (numerator))
+ return numerator;
+ {
+ int q_negative_p =
+ ((BIGNUM_NEGATIVE_P (denominator))
+ ? (! (BIGNUM_NEGATIVE_P (numerator)))
+ : (BIGNUM_NEGATIVE_P (numerator)));
+ switch (bignum_compare_unsigned (numerator, denominator))
+ {
+ case bignum_comparison_equal:
+ return (BIGNUM_ONE (q_negative_p));
+ case bignum_comparison_less:
+ return (BIGNUM_ZERO ());
+ case bignum_comparison_greater:
+ default: /* to appease gcc -Wall */
+ {
+ bignum * quotient;
+ if ((BIGNUM_LENGTH (denominator)) == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
+ if (digit == 1)
+ return (bignum_maybe_new_sign (numerator, q_negative_p));
+ if (digit < BIGNUM_RADIX_ROOT)
+ bignum_divide_unsigned_small_denominator
+ (numerator, digit,
+ ("ient), ((bignum * *) 0),
+ q_negative_p, 0);
+ else
+ bignum_divide_unsigned_medium_denominator
+ (numerator, digit,
+ ("ient), ((bignum * *) 0),
+ q_negative_p, 0);
+ }
+ else
+ bignum_divide_unsigned_large_denominator
+ (numerator, denominator,
+ ("ient), ((bignum * *) 0),
+ q_negative_p, 0);
+ return (quotient);
+ }
+ }
+ }
}
/* allocates memory */
bignum *factorvm::bignum_remainder(bignum * numerator, bignum * denominator)
{
- if (BIGNUM_ZERO_P (denominator))
- {
- divide_by_zero_error();
- return (BIGNUM_OUT_OF_BAND);
- }
- if (BIGNUM_ZERO_P (numerator))
- return numerator;
- switch (bignum_compare_unsigned (numerator, denominator))
- {
- case bignum_comparison_equal:
- return (BIGNUM_ZERO ());
- case bignum_comparison_less:
- return numerator;
- case bignum_comparison_greater:
- default: /* to appease gcc -Wall */
- {
- bignum * remainder;
- if ((BIGNUM_LENGTH (denominator)) == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
- if (digit == 1)
- return (BIGNUM_ZERO ());
- if (digit < BIGNUM_RADIX_ROOT)
- return
- (bignum_remainder_unsigned_small_denominator
- (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
- bignum_divide_unsigned_medium_denominator
- (numerator, digit,
- ((bignum * *) 0), (&remainder),
- 0, (BIGNUM_NEGATIVE_P (numerator)));
- }
- else
- bignum_divide_unsigned_large_denominator
- (numerator, denominator,
- ((bignum * *) 0), (&remainder),
- 0, (BIGNUM_NEGATIVE_P (numerator)));
- return (remainder);
- }
- }
+ if (BIGNUM_ZERO_P (denominator))
+ {
+ divide_by_zero_error();
+ return (BIGNUM_OUT_OF_BAND);
+ }
+ if (BIGNUM_ZERO_P (numerator))
+ return numerator;
+ switch (bignum_compare_unsigned (numerator, denominator))
+ {
+ case bignum_comparison_equal:
+ return (BIGNUM_ZERO ());
+ case bignum_comparison_less:
+ return numerator;
+ case bignum_comparison_greater:
+ default: /* to appease gcc -Wall */
+ {
+ bignum * remainder;
+ if ((BIGNUM_LENGTH (denominator)) == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
+ if (digit == 1)
+ return (BIGNUM_ZERO ());
+ if (digit < BIGNUM_RADIX_ROOT)
+ return
+ (bignum_remainder_unsigned_small_denominator
+ (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
+ bignum_divide_unsigned_medium_denominator
+ (numerator, digit,
+ ((bignum * *) 0), (&remainder),
+ 0, (BIGNUM_NEGATIVE_P (numerator)));
+ }
+ else
+ bignum_divide_unsigned_large_denominator
+ (numerator, denominator,
+ ((bignum * *) 0), (&remainder),
+ 0, (BIGNUM_NEGATIVE_P (numerator)));
+ return (remainder);
+ }
+ }
}
-#define FOO_TO_BIGNUM(name,type,utype) \
- bignum * factorvm::name##_to_bignum(type n) \
- { \
- int negative_p; \
- bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
- bignum_digit_type * end_digits = result_digits; \
- /* Special cases win when these small constants are cached. */ \
- if (n == 0) return (BIGNUM_ZERO ()); \
- if (n == 1) return (BIGNUM_ONE (0)); \
- if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1)); \
- { \
- utype accumulator = ((negative_p = (n < (type)0)) ? (-n) : n); \
- do \
- { \
- (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
- accumulator >>= BIGNUM_DIGIT_LENGTH; \
- } \
- while (accumulator != 0); \
- } \
- { \
- bignum * result = \
- (allot_bignum ((end_digits - result_digits), negative_p)); \
- bignum_digit_type * scan_digits = result_digits; \
- bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
- while (scan_digits < end_digits) \
- (*scan_result++) = (*scan_digits++); \
- return (result); \
- } \
- }
+#define FOO_TO_BIGNUM(name,type,utype) \
+bignum * factorvm::name##_to_bignum(type n) \
+{ \
+ int negative_p; \
+ bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
+ bignum_digit_type * end_digits = result_digits; \
+ /* Special cases win when these small constants are cached. */ \
+ if (n == 0) return (BIGNUM_ZERO ()); \
+ if (n == 1) return (BIGNUM_ONE (0)); \
+ if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1)); \
+ { \
+ utype accumulator = ((negative_p = (n < (type)0)) ? (-n) : n); \
+ do \
+ { \
+ (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
+ accumulator >>= BIGNUM_DIGIT_LENGTH; \
+ } \
+ while (accumulator != 0); \
+ } \
+ { \
+ bignum * result = \
+ (allot_bignum ((end_digits - result_digits), negative_p)); \
+ bignum_digit_type * scan_digits = result_digits; \
+ bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
+ while (scan_digits < end_digits) \
+ (*scan_result++) = (*scan_digits++); \
+ return (result); \
+ } \
+}
/* all below allocate memory */
FOO_TO_BIGNUM(cell,cell,cell)
@@ -373,20 +373,20 @@ FOO_TO_BIGNUM(fixnum,fixnum,cell)
FOO_TO_BIGNUM(long_long,s64,u64)
FOO_TO_BIGNUM(ulong_long,u64,u64)
-#define BIGNUM_TO_FOO(name,type,utype) \
-type factorvm::bignum_to_##name(bignum * bignum) \
- { \
- if (BIGNUM_ZERO_P (bignum)) \
- return (0); \
- { \
- utype accumulator = 0; \
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
- while (start < scan) \
- accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
- return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \
- } \
- }
+#define BIGNUM_TO_FOO(name,type,utype) \
+ type factorvm::bignum_to_##name(bignum * bignum) \
+ { \
+ if (BIGNUM_ZERO_P (bignum)) \
+ return (0); \
+ { \
+ utype accumulator = 0; \
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
+ while (start < scan) \
+ accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
+ return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \
+ } \
+ }
/* all of the below allocate memory */
BIGNUM_TO_FOO(cell,cell,cell);
@@ -396,25 +396,25 @@ BIGNUM_TO_FOO(ulong_long,u64,u64)
double factorvm::bignum_to_double(bignum * bignum)
{
- if (BIGNUM_ZERO_P (bignum))
- return (0);
- {
- double accumulator = 0;
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
- while (start < scan)
- accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
- return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
- }
+ if (BIGNUM_ZERO_P (bignum))
+ return (0);
+ {
+ double accumulator = 0;
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
+ while (start < scan)
+ accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
+ return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
+ }
}
-#define DTB_WRITE_DIGIT(factor) \
-{ \
- significand *= (factor); \
- digit = ((bignum_digit_type) significand); \
- (*--scan) = digit; \
- significand -= ((double) digit); \
+#define DTB_WRITE_DIGIT(factor) \
+{ \
+ significand *= (factor); \
+ digit = ((bignum_digit_type) significand); \
+ (*--scan) = digit; \
+ significand -= ((double) digit); \
}
/* allocates memory */
@@ -422,33 +422,33 @@ double factorvm::bignum_to_double(bignum * bignum)
bignum *factorvm::double_to_bignum(double x)
{
- if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
- int exponent;
- double significand = (frexp (x, (&exponent)));
- if (exponent <= 0) return (BIGNUM_ZERO ());
- if (exponent == 1) return (BIGNUM_ONE (x < 0));
- if (significand < 0) significand = (-significand);
- {
- bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
- bignum * result = (allot_bignum (length, (x < 0)));
- bignum_digit_type * start = (BIGNUM_START_PTR (result));
- bignum_digit_type * scan = (start + length);
- bignum_digit_type digit;
- int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
- if (odd_bits > 0)
- DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
- while (start < scan)
- {
- if (significand == 0)
- {
- while (start < scan)
- (*--scan) = 0;
- break;
- }
- DTB_WRITE_DIGIT (BIGNUM_RADIX);
- }
- return (result);
- }
+ if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
+ int exponent;
+ double significand = (frexp (x, (&exponent)));
+ if (exponent <= 0) return (BIGNUM_ZERO ());
+ if (exponent == 1) return (BIGNUM_ONE (x < 0));
+ if (significand < 0) significand = (-significand);
+ {
+ bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
+ bignum * result = (allot_bignum (length, (x < 0)));
+ bignum_digit_type * start = (BIGNUM_START_PTR (result));
+ bignum_digit_type * scan = (start + length);
+ bignum_digit_type digit;
+ int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
+ if (odd_bits > 0)
+ DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
+ while (start < scan)
+ {
+ if (significand == 0)
+ {
+ while (start < scan)
+ (*--scan) = 0;
+ break;
+ }
+ DTB_WRITE_DIGIT (BIGNUM_RADIX);
+ }
+ return (result);
+ }
}
@@ -458,45 +458,45 @@ bignum *factorvm::double_to_bignum(double x)
int factorvm::bignum_equal_p_unsigned(bignum * x, bignum * y)
{
- bignum_length_type length = (BIGNUM_LENGTH (x));
- if (length != (BIGNUM_LENGTH (y)))
- return (0);
- else
- {
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_x = (scan_x + length);
- while (scan_x < end_x)
- if ((*scan_x++) != (*scan_y++))
- return (0);
- return (1);
- }
+ bignum_length_type length = (BIGNUM_LENGTH (x));
+ if (length != (BIGNUM_LENGTH (y)))
+ return (0);
+ else
+ {
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_x = (scan_x + length);
+ while (scan_x < end_x)
+ if ((*scan_x++) != (*scan_y++))
+ return (0);
+ return (1);
+ }
}
enum bignum_comparison factorvm::bignum_compare_unsigned(bignum * x, bignum * y)
{
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum_length_type y_length = (BIGNUM_LENGTH (y));
- if (x_length < y_length)
- return (bignum_comparison_less);
- if (x_length > y_length)
- return (bignum_comparison_greater);
- {
- bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_x = (start_x + x_length);
- bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
- while (start_x < scan_x)
- {
- bignum_digit_type digit_x = (*--scan_x);
- bignum_digit_type digit_y = (*--scan_y);
- if (digit_x < digit_y)
- return (bignum_comparison_less);
- if (digit_x > digit_y)
- return (bignum_comparison_greater);
- }
- }
- return (bignum_comparison_equal);
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ bignum_length_type y_length = (BIGNUM_LENGTH (y));
+ if (x_length < y_length)
+ return (bignum_comparison_less);
+ if (x_length > y_length)
+ return (bignum_comparison_greater);
+ {
+ bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_x = (start_x + x_length);
+ bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
+ while (start_x < scan_x)
+ {
+ bignum_digit_type digit_x = (*--scan_x);
+ bignum_digit_type digit_y = (*--scan_y);
+ if (digit_x < digit_y)
+ return (bignum_comparison_less);
+ if (digit_x > digit_y)
+ return (bignum_comparison_greater);
+ }
+ }
+ return (bignum_comparison_equal);
}
@@ -507,64 +507,64 @@ bignum *factorvm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
{
GC_BIGNUM(x,this); GC_BIGNUM(y,this);
- if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
- {
- bignum * z = x;
- x = y;
- y = z;
- }
- {
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
+ {
+ bignum * z = x;
+ x = y;
+ y = z;
+ }
+ {
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum * r = (allot_bignum ((x_length + 1), negative_p));
+ bignum * r = (allot_bignum ((x_length + 1), negative_p));
- bignum_digit_type sum;
- bignum_digit_type carry = 0;
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
- {
- bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
- while (scan_y < end_y)
- {
- sum = ((*scan_x++) + (*scan_y++) + carry);
- if (sum < BIGNUM_RADIX)
- {
- (*scan_r++) = sum;
- carry = 0;
- }
- else
- {
- (*scan_r++) = (sum - BIGNUM_RADIX);
- carry = 1;
- }
- }
- }
- {
- bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
- if (carry != 0)
- while (scan_x < end_x)
- {
- sum = ((*scan_x++) + 1);
- if (sum < BIGNUM_RADIX)
- {
- (*scan_r++) = sum;
- carry = 0;
- break;
- }
- else
- (*scan_r++) = (sum - BIGNUM_RADIX);
- }
- while (scan_x < end_x)
- (*scan_r++) = (*scan_x++);
- }
- if (carry != 0)
- {
- (*scan_r) = 1;
- return (r);
- }
- return (bignum_shorten_length (r, x_length));
- }
+ bignum_digit_type sum;
+ bignum_digit_type carry = 0;
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
+ {
+ bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
+ while (scan_y < end_y)
+ {
+ sum = ((*scan_x++) + (*scan_y++) + carry);
+ if (sum < BIGNUM_RADIX)
+ {
+ (*scan_r++) = sum;
+ carry = 0;
+ }
+ else
+ {
+ (*scan_r++) = (sum - BIGNUM_RADIX);
+ carry = 1;
+ }
+ }
+ }
+ {
+ bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
+ if (carry != 0)
+ while (scan_x < end_x)
+ {
+ sum = ((*scan_x++) + 1);
+ if (sum < BIGNUM_RADIX)
+ {
+ (*scan_r++) = sum;
+ carry = 0;
+ break;
+ }
+ else
+ (*scan_r++) = (sum - BIGNUM_RADIX);
+ }
+ while (scan_x < end_x)
+ (*scan_r++) = (*scan_x++);
+ }
+ if (carry != 0)
+ {
+ (*scan_r) = 1;
+ return (r);
+ }
+ return (bignum_shorten_length (r, x_length));
+ }
}
@@ -575,149 +575,149 @@ bignum *factorvm::bignum_subtract_unsigned(bignum * x, bignum * y)
{
GC_BIGNUM(x,this); GC_BIGNUM(y,this);
- int negative_p = 0;
- switch (bignum_compare_unsigned (x, y))
- {
- case bignum_comparison_equal:
- return (BIGNUM_ZERO ());
- case bignum_comparison_less:
- {
- bignum * z = x;
- x = y;
- y = z;
- }
- negative_p = 1;
- break;
- case bignum_comparison_greater:
- negative_p = 0;
- break;
- }
- {
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ int negative_p = 0;
+ switch (bignum_compare_unsigned (x, y))
+ {
+ case bignum_comparison_equal:
+ return (BIGNUM_ZERO ());
+ case bignum_comparison_less:
+ {
+ bignum * z = x;
+ x = y;
+ y = z;
+ }
+ negative_p = 1;
+ break;
+ case bignum_comparison_greater:
+ negative_p = 0;
+ break;
+ }
+ {
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum * r = (allot_bignum (x_length, negative_p));
+ bignum * r = (allot_bignum (x_length, negative_p));
- bignum_digit_type difference;
- bignum_digit_type borrow = 0;
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
- {
- bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
- while (scan_y < end_y)
- {
- difference = (((*scan_x++) - (*scan_y++)) - borrow);
- if (difference < 0)
- {
- (*scan_r++) = (difference + BIGNUM_RADIX);
- borrow = 1;
- }
- else
- {
- (*scan_r++) = difference;
- borrow = 0;
- }
- }
- }
- {
- bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
- if (borrow != 0)
- while (scan_x < end_x)
- {
- difference = ((*scan_x++) - borrow);
- if (difference < 0)
- (*scan_r++) = (difference + BIGNUM_RADIX);
- else
- {
- (*scan_r++) = difference;
- borrow = 0;
- break;
- }
- }
- BIGNUM_ASSERT (borrow == 0);
- while (scan_x < end_x)
- (*scan_r++) = (*scan_x++);
- }
- return (bignum_trim (r));
- }
+ bignum_digit_type difference;
+ bignum_digit_type borrow = 0;
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
+ {
+ bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
+ while (scan_y < end_y)
+ {
+ difference = (((*scan_x++) - (*scan_y++)) - borrow);
+ if (difference < 0)
+ {
+ (*scan_r++) = (difference + BIGNUM_RADIX);
+ borrow = 1;
+ }
+ else
+ {
+ (*scan_r++) = difference;
+ borrow = 0;
+ }
+ }
+ }
+ {
+ bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
+ if (borrow != 0)
+ while (scan_x < end_x)
+ {
+ difference = ((*scan_x++) - borrow);
+ if (difference < 0)
+ (*scan_r++) = (difference + BIGNUM_RADIX);
+ else
+ {
+ (*scan_r++) = difference;
+ borrow = 0;
+ break;
+ }
+ }
+ BIGNUM_ASSERT (borrow == 0);
+ while (scan_x < end_x)
+ (*scan_r++) = (*scan_x++);
+ }
+ return (bignum_trim (r));
+ }
}
/* Multiplication
Maximum value for product_low or product_high:
- ((R * R) + (R * (R - 2)) + (R - 1))
+ ((R * R) + (R * (R - 2)) + (R - 1))
Maximum value for carry: ((R * (R - 1)) + (R - 1))
- where R == BIGNUM_RADIX_ROOT */
+ where R == BIGNUM_RADIX_ROOT */
/* allocates memory */
bignum *factorvm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
{
GC_BIGNUM(x,this); GC_BIGNUM(y,this);
- if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
- {
- bignum * z = x;
- x = y;
- y = z;
- }
- {
- bignum_digit_type carry;
- bignum_digit_type y_digit_low;
- bignum_digit_type y_digit_high;
- bignum_digit_type x_digit_low;
- bignum_digit_type x_digit_high;
- bignum_digit_type product_low;
- bignum_digit_type * scan_r;
- bignum_digit_type * scan_y;
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum_length_type y_length = (BIGNUM_LENGTH (y));
+ if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
+ {
+ bignum * z = x;
+ x = y;
+ y = z;
+ }
+ {
+ bignum_digit_type carry;
+ bignum_digit_type y_digit_low;
+ bignum_digit_type y_digit_high;
+ bignum_digit_type x_digit_low;
+ bignum_digit_type x_digit_high;
+ bignum_digit_type product_low;
+ bignum_digit_type * scan_r;
+ bignum_digit_type * scan_y;
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ bignum_length_type y_length = (BIGNUM_LENGTH (y));
- bignum * r =
- (allot_bignum_zeroed ((x_length + y_length), negative_p));
+ bignum * r =
+ (allot_bignum_zeroed ((x_length + y_length), negative_p));
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * end_x = (scan_x + x_length);
- bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_y = (start_y + y_length);
- bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * end_x = (scan_x + x_length);
+ bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_y = (start_y + y_length);
+ bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
#define x_digit x_digit_high
#define y_digit y_digit_high
#define product_high carry
- while (scan_x < end_x)
- {
- x_digit = (*scan_x++);
- x_digit_low = (HD_LOW (x_digit));
- x_digit_high = (HD_HIGH (x_digit));
- carry = 0;
- scan_y = start_y;
- scan_r = (start_r++);
- while (scan_y < end_y)
- {
- y_digit = (*scan_y++);
- y_digit_low = (HD_LOW (y_digit));
- y_digit_high = (HD_HIGH (y_digit));
- product_low =
- ((*scan_r) +
- (x_digit_low * y_digit_low) +
- (HD_LOW (carry)));
- product_high =
- ((x_digit_high * y_digit_low) +
- (x_digit_low * y_digit_high) +
- (HD_HIGH (product_low)) +
- (HD_HIGH (carry)));
- (*scan_r++) =
- (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
- carry =
- ((x_digit_high * y_digit_high) +
- (HD_HIGH (product_high)));
- }
- (*scan_r) += carry;
- }
- return (bignum_trim (r));
+ while (scan_x < end_x)
+ {
+ x_digit = (*scan_x++);
+ x_digit_low = (HD_LOW (x_digit));
+ x_digit_high = (HD_HIGH (x_digit));
+ carry = 0;
+ scan_y = start_y;
+ scan_r = (start_r++);
+ while (scan_y < end_y)
+ {
+ y_digit = (*scan_y++);
+ y_digit_low = (HD_LOW (y_digit));
+ y_digit_high = (HD_HIGH (y_digit));
+ product_low =
+ ((*scan_r) +
+ (x_digit_low * y_digit_low) +
+ (HD_LOW (carry)));
+ product_high =
+ ((x_digit_high * y_digit_low) +
+ (x_digit_low * y_digit_high) +
+ (HD_HIGH (product_low)) +
+ (HD_HIGH (carry)));
+ (*scan_r++) =
+ (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
+ carry =
+ ((x_digit_high * y_digit_high) +
+ (HD_HIGH (product_high)));
+ }
+ (*scan_r) += carry;
+ }
+ return (bignum_trim (r));
#undef x_digit
#undef y_digit
#undef product_high
- }
+ }
}
@@ -726,67 +726,67 @@ bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit
{
GC_BIGNUM(x,this);
- bignum_length_type length_x = (BIGNUM_LENGTH (x));
+ bignum_length_type length_x = (BIGNUM_LENGTH (x));
- bignum * p = (allot_bignum ((length_x + 1), negative_p));
+ bignum * p = (allot_bignum ((length_x + 1), negative_p));
- bignum_destructive_copy (x, p);
- (BIGNUM_REF (p, length_x)) = 0;
- bignum_destructive_scale_up (p, y);
- return (bignum_trim (p));
+ bignum_destructive_copy (x, p);
+ (BIGNUM_REF (p, length_x)) = 0;
+ bignum_destructive_scale_up (p, y);
+ return (bignum_trim (p));
}
void factorvm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
{
- bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
- bignum_digit_type digit;
- digit = ((*scan) + n);
- if (digit < BIGNUM_RADIX)
- {
- (*scan) = digit;
- return;
- }
- (*scan++) = (digit - BIGNUM_RADIX);
- while (1)
- {
- digit = ((*scan) + 1);
- if (digit < BIGNUM_RADIX)
- {
- (*scan) = digit;
- return;
- }
- (*scan++) = (digit - BIGNUM_RADIX);
- }
+ bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type digit;
+ digit = ((*scan) + n);
+ if (digit < BIGNUM_RADIX)
+ {
+ (*scan) = digit;
+ return;
+ }
+ (*scan++) = (digit - BIGNUM_RADIX);
+ while (1)
+ {
+ digit = ((*scan) + 1);
+ if (digit < BIGNUM_RADIX)
+ {
+ (*scan) = digit;
+ return;
+ }
+ (*scan++) = (digit - BIGNUM_RADIX);
+ }
}
void factorvm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
{
- bignum_digit_type carry = 0;
- bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
- bignum_digit_type two_digits;
- bignum_digit_type product_low;
+ bignum_digit_type carry = 0;
+ bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type two_digits;
+ bignum_digit_type product_low;
#define product_high carry
- bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
- BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
- while (scan < end)
- {
- two_digits = (*scan);
- product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
- product_high =
- ((factor * (HD_HIGH (two_digits))) +
- (HD_HIGH (product_low)) +
- (HD_HIGH (carry)));
- (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
- carry = (HD_HIGH (product_high));
- }
- /* A carry here would be an overflow, i.e. it would not fit.
- Hopefully the callers allocate enough space that this will
- never happen.
- */
- BIGNUM_ASSERT (carry == 0);
- return;
+ bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
+ BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
+ while (scan < end)
+ {
+ two_digits = (*scan);
+ product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
+ product_high =
+ ((factor * (HD_HIGH (two_digits))) +
+ (HD_HIGH (product_low)) +
+ (HD_HIGH (carry)));
+ (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
+ carry = (HD_HIGH (product_high));
+ }
+ /* A carry here would be an overflow, i.e. it would not fit.
+ Hopefully the callers allocate enough space that this will
+ never happen.
+ */
+ BIGNUM_ASSERT (carry == 0);
+ return;
#undef product_high
}
@@ -803,129 +803,129 @@ void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bign
{
GC_BIGNUM(numerator,this); GC_BIGNUM(denominator,this);
- bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
- bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
+ bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
+ bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
- bignum * q =
- ((quotient != ((bignum * *) 0))
- ? (allot_bignum ((length_n - length_d), q_negative_p))
- : BIGNUM_OUT_OF_BAND);
- GC_BIGNUM(q,this);
+ bignum * q =
+ ((quotient != ((bignum * *) 0))
+ ? (allot_bignum ((length_n - length_d), q_negative_p))
+ : BIGNUM_OUT_OF_BAND);
+ GC_BIGNUM(q,this);
- bignum * u = (allot_bignum (length_n, r_negative_p));
- GC_BIGNUM(u,this);
+ bignum * u = (allot_bignum (length_n, r_negative_p));
+ GC_BIGNUM(u,this);
- int shift = 0;
- BIGNUM_ASSERT (length_d > 1);
- {
- bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
- while (v1 < (BIGNUM_RADIX / 2))
- {
- v1 <<= 1;
- shift += 1;
- }
- }
- if (shift == 0)
- {
- bignum_destructive_copy (numerator, u);
- (BIGNUM_REF (u, (length_n - 1))) = 0;
- bignum_divide_unsigned_normalized (u, denominator, q);
- }
- else
- {
- bignum * v = (allot_bignum (length_d, 0));
+ int shift = 0;
+ BIGNUM_ASSERT (length_d > 1);
+ {
+ bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
+ while (v1 < (BIGNUM_RADIX / 2))
+ {
+ v1 <<= 1;
+ shift += 1;
+ }
+ }
+ if (shift == 0)
+ {
+ bignum_destructive_copy (numerator, u);
+ (BIGNUM_REF (u, (length_n - 1))) = 0;
+ bignum_divide_unsigned_normalized (u, denominator, q);
+ }
+ else
+ {
+ bignum * v = (allot_bignum (length_d, 0));
- bignum_destructive_normalization (numerator, u, shift);
- bignum_destructive_normalization (denominator, v, shift);
- bignum_divide_unsigned_normalized (u, v, q);
- if (remainder != ((bignum * *) 0))
- bignum_destructive_unnormalization (u, shift);
- }
+ bignum_destructive_normalization (numerator, u, shift);
+ bignum_destructive_normalization (denominator, v, shift);
+ bignum_divide_unsigned_normalized (u, v, q);
+ if (remainder != ((bignum * *) 0))
+ bignum_destructive_unnormalization (u, shift);
+ }
- if(q)
- q = bignum_trim (q);
+ if(q)
+ q = bignum_trim (q);
- u = bignum_trim (u);
+ u = bignum_trim (u);
- if (quotient != ((bignum * *) 0))
- (*quotient) = q;
+ if (quotient != ((bignum * *) 0))
+ (*quotient) = q;
- if (remainder != ((bignum * *) 0))
- (*remainder) = u;
+ if (remainder != ((bignum * *) 0))
+ (*remainder) = u;
- return;
+ return;
}
void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
{
- bignum_length_type u_length = (BIGNUM_LENGTH (u));
- bignum_length_type v_length = (BIGNUM_LENGTH (v));
- bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
- bignum_digit_type * u_scan = (u_start + u_length);
- bignum_digit_type * u_scan_limit = (u_start + v_length);
- bignum_digit_type * u_scan_start = (u_scan - v_length);
- bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
- bignum_digit_type * v_end = (v_start + v_length);
- bignum_digit_type * q_scan = NULL;
- bignum_digit_type v1 = (v_end[-1]);
- bignum_digit_type v2 = (v_end[-2]);
- bignum_digit_type ph; /* high half of double-digit product */
- bignum_digit_type pl; /* low half of double-digit product */
- bignum_digit_type guess;
- bignum_digit_type gh; /* high half-digit of guess */
- bignum_digit_type ch; /* high half of double-digit comparand */
- bignum_digit_type v2l = (HD_LOW (v2));
- bignum_digit_type v2h = (HD_HIGH (v2));
- bignum_digit_type cl; /* low half of double-digit comparand */
+ bignum_length_type u_length = (BIGNUM_LENGTH (u));
+ bignum_length_type v_length = (BIGNUM_LENGTH (v));
+ bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
+ bignum_digit_type * u_scan = (u_start + u_length);
+ bignum_digit_type * u_scan_limit = (u_start + v_length);
+ bignum_digit_type * u_scan_start = (u_scan - v_length);
+ bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
+ bignum_digit_type * v_end = (v_start + v_length);
+ bignum_digit_type * q_scan = NULL;
+ bignum_digit_type v1 = (v_end[-1]);
+ bignum_digit_type v2 = (v_end[-2]);
+ bignum_digit_type ph; /* high half of double-digit product */
+ bignum_digit_type pl; /* low half of double-digit product */
+ bignum_digit_type guess;
+ bignum_digit_type gh; /* high half-digit of guess */
+ bignum_digit_type ch; /* high half of double-digit comparand */
+ bignum_digit_type v2l = (HD_LOW (v2));
+ bignum_digit_type v2h = (HD_HIGH (v2));
+ bignum_digit_type cl; /* low half of double-digit comparand */
#define gl ph /* low half-digit of guess */
#define uj pl
#define qj ph
- bignum_digit_type gm; /* memory loc for reference parameter */
- if (q != BIGNUM_OUT_OF_BAND)
- q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
- while (u_scan_limit < u_scan)
- {
- uj = (*--u_scan);
- if (uj != v1)
- {
- /* comparand =
- (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
- guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
- cl = (u_scan[-2]);
- ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
- guess = gm;
- }
- else
- {
- cl = (u_scan[-2]);
- ch = ((u_scan[-1]) + v1);
- guess = (BIGNUM_RADIX - 1);
- }
- while (1)
- {
- /* product = (guess * v2); */
- gl = (HD_LOW (guess));
- gh = (HD_HIGH (guess));
- pl = (v2l * gl);
- ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
- pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
- ph = ((v2h * gh) + (HD_HIGH (ph)));
- /* if (comparand >= product) */
- if ((ch > ph) || ((ch == ph) && (cl >= pl)))
- break;
- guess -= 1;
- /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
- ch += v1;
- /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
- if (ch >= BIGNUM_RADIX)
- break;
- }
- qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
- if (q != BIGNUM_OUT_OF_BAND)
- (*--q_scan) = qj;
- }
- return;
+ bignum_digit_type gm; /* memory loc for reference parameter */
+ if (q != BIGNUM_OUT_OF_BAND)
+ q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
+ while (u_scan_limit < u_scan)
+ {
+ uj = (*--u_scan);
+ if (uj != v1)
+ {
+ /* comparand =
+ (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
+ guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
+ cl = (u_scan[-2]);
+ ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
+ guess = gm;
+ }
+ else
+ {
+ cl = (u_scan[-2]);
+ ch = ((u_scan[-1]) + v1);
+ guess = (BIGNUM_RADIX - 1);
+ }
+ while (1)
+ {
+ /* product = (guess * v2); */
+ gl = (HD_LOW (guess));
+ gh = (HD_HIGH (guess));
+ pl = (v2l * gl);
+ ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
+ pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
+ ph = ((v2h * gh) + (HD_HIGH (ph)));
+ /* if (comparand >= product) */
+ if ((ch > ph) || ((ch == ph) && (cl >= pl)))
+ break;
+ guess -= 1;
+ /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
+ ch += v1;
+ /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
+ if (ch >= BIGNUM_RADIX)
+ break;
+ }
+ qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
+ if (q != BIGNUM_OUT_OF_BAND)
+ (*--q_scan) = qj;
+ }
+ return;
#undef gl
#undef uj
#undef qj
@@ -934,77 +934,77 @@ void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum
bignum_digit_type factorvm::bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
{
- bignum_digit_type * v_scan = v_start;
- bignum_digit_type * u_scan = u_start;
- bignum_digit_type carry = 0;
- if (guess == 0) return (0);
- {
- bignum_digit_type gl = (HD_LOW (guess));
- bignum_digit_type gh = (HD_HIGH (guess));
- bignum_digit_type v;
- bignum_digit_type pl;
- bignum_digit_type vl;
+ bignum_digit_type * v_scan = v_start;
+ bignum_digit_type * u_scan = u_start;
+ bignum_digit_type carry = 0;
+ if (guess == 0) return (0);
+ {
+ bignum_digit_type gl = (HD_LOW (guess));
+ bignum_digit_type gh = (HD_HIGH (guess));
+ bignum_digit_type v;
+ bignum_digit_type pl;
+ bignum_digit_type vl;
#define vh v
#define ph carry
#define diff pl
- while (v_scan < v_end)
- {
- v = (*v_scan++);
- vl = (HD_LOW (v));
- vh = (HD_HIGH (v));
- pl = ((vl * gl) + (HD_LOW (carry)));
- ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
- diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
- if (diff < 0)
- {
- (*u_scan++) = (diff + BIGNUM_RADIX);
- carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
- }
- else
- {
- (*u_scan++) = diff;
- carry = ((vh * gh) + (HD_HIGH (ph)));
- }
- }
- if (carry == 0)
- return (guess);
- diff = ((*u_scan) - carry);
- if (diff < 0)
- (*u_scan) = (diff + BIGNUM_RADIX);
- else
- {
- (*u_scan) = diff;
- return (guess);
- }
+ while (v_scan < v_end)
+ {
+ v = (*v_scan++);
+ vl = (HD_LOW (v));
+ vh = (HD_HIGH (v));
+ pl = ((vl * gl) + (HD_LOW (carry)));
+ ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
+ diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
+ if (diff < 0)
+ {
+ (*u_scan++) = (diff + BIGNUM_RADIX);
+ carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
+ }
+ else
+ {
+ (*u_scan++) = diff;
+ carry = ((vh * gh) + (HD_HIGH (ph)));
+ }
+ }
+ if (carry == 0)
+ return (guess);
+ diff = ((*u_scan) - carry);
+ if (diff < 0)
+ (*u_scan) = (diff + BIGNUM_RADIX);
+ else
+ {
+ (*u_scan) = diff;
+ return (guess);
+ }
#undef vh
#undef ph
#undef diff
- }
- /* Subtraction generated carry, implying guess is one too large.
- Add v back in to bring it back down. */
- v_scan = v_start;
- u_scan = u_start;
- carry = 0;
- while (v_scan < v_end)
- {
- bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
- if (sum < BIGNUM_RADIX)
- {
- (*u_scan++) = sum;
- carry = 0;
- }
- else
- {
- (*u_scan++) = (sum - BIGNUM_RADIX);
- carry = 1;
- }
- }
- if (carry == 1)
- {
- bignum_digit_type sum = ((*u_scan) + carry);
- (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
- }
- return (guess - 1);
+ }
+ /* Subtraction generated carry, implying guess is one too large.
+ Add v back in to bring it back down. */
+ v_scan = v_start;
+ u_scan = u_start;
+ carry = 0;
+ while (v_scan < v_end)
+ {
+ bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
+ if (sum < BIGNUM_RADIX)
+ {
+ (*u_scan++) = sum;
+ carry = 0;
+ }
+ else
+ {
+ (*u_scan++) = (sum - BIGNUM_RADIX);
+ carry = 1;
+ }
+ }
+ if (carry == 1)
+ {
+ bignum_digit_type sum = ((*u_scan) + carry);
+ (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
+ }
+ return (guess - 1);
}
@@ -1013,101 +1013,101 @@ void factorvm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bign
{
GC_BIGNUM(numerator,this);
- bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
- bignum_length_type length_q;
- bignum * q = NULL;
- GC_BIGNUM(q,this);
+ bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
+ bignum_length_type length_q;
+ bignum * q = NULL;
+ GC_BIGNUM(q,this);
- int shift = 0;
- /* Because `bignum_digit_divide' requires a normalized denominator. */
- while (denominator < (BIGNUM_RADIX / 2))
- {
- denominator <<= 1;
- shift += 1;
- }
- if (shift == 0)
- {
- length_q = length_n;
+ int shift = 0;
+ /* Because `bignum_digit_divide' requires a normalized denominator. */
+ while (denominator < (BIGNUM_RADIX / 2))
+ {
+ denominator <<= 1;
+ shift += 1;
+ }
+ if (shift == 0)
+ {
+ length_q = length_n;
- q = (allot_bignum (length_q, q_negative_p));
- bignum_destructive_copy (numerator, q);
- }
- else
- {
- length_q = (length_n + 1);
+ q = (allot_bignum (length_q, q_negative_p));
+ bignum_destructive_copy (numerator, q);
+ }
+ else
+ {
+ length_q = (length_n + 1);
- q = (allot_bignum (length_q, q_negative_p));
- bignum_destructive_normalization (numerator, q, shift);
- }
- {
- bignum_digit_type r = 0;
- bignum_digit_type * start = (BIGNUM_START_PTR (q));
- bignum_digit_type * scan = (start + length_q);
- bignum_digit_type qj;
+ q = (allot_bignum (length_q, q_negative_p));
+ bignum_destructive_normalization (numerator, q, shift);
+ }
+ {
+ bignum_digit_type r = 0;
+ bignum_digit_type * start = (BIGNUM_START_PTR (q));
+ bignum_digit_type * scan = (start + length_q);
+ bignum_digit_type qj;
- while (start < scan)
- {
- r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
- (*scan) = qj;
- }
+ while (start < scan)
+ {
+ r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
+ (*scan) = qj;
+ }
- q = bignum_trim (q);
+ q = bignum_trim (q);
- if (remainder != ((bignum * *) 0))
- {
- if (shift != 0)
- r >>= shift;
+ if (remainder != ((bignum * *) 0))
+ {
+ if (shift != 0)
+ r >>= shift;
- (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
- }
+ (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
+ }
- if (quotient != ((bignum * *) 0))
- (*quotient) = q;
- }
- return;
+ if (quotient != ((bignum * *) 0))
+ (*quotient) = q;
+ }
+ return;
}
void factorvm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
{
- bignum_digit_type digit;
- bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
- bignum_digit_type carry = 0;
- bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
- bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
- bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
- int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
- bignum_digit_type mask = (((cell)1 << shift_right) - 1);
- while (scan_source < end_source)
- {
- digit = (*scan_source++);
- (*scan_target++) = (((digit & mask) << shift_left) | carry);
- carry = (digit >> shift_right);
- }
- if (scan_target < end_target)
- (*scan_target) = carry;
- else
- BIGNUM_ASSERT (carry == 0);
- return;
+ bignum_digit_type digit;
+ bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
+ bignum_digit_type carry = 0;
+ bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
+ bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
+ bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
+ int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
+ bignum_digit_type mask = (((cell)1 << shift_right) - 1);
+ while (scan_source < end_source)
+ {
+ digit = (*scan_source++);
+ (*scan_target++) = (((digit & mask) << shift_left) | carry);
+ carry = (digit >> shift_right);
+ }
+ if (scan_target < end_target)
+ (*scan_target) = carry;
+ else
+ BIGNUM_ASSERT (carry == 0);
+ return;
}
void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
{
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
- bignum_digit_type digit;
- bignum_digit_type carry = 0;
- int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
- bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
- while (start < scan)
- {
- digit = (*--scan);
- (*scan) = ((digit >> shift_right) | carry);
- carry = ((digit & mask) << shift_left);
- }
- BIGNUM_ASSERT (carry == 0);
- return;
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
+ bignum_digit_type digit;
+ bignum_digit_type carry = 0;
+ int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
+ bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
+ while (start < scan)
+ {
+ digit = (*--scan);
+ (*scan) = ((digit >> shift_right) | carry);
+ carry = ((digit & mask) << shift_left);
+ }
+ BIGNUM_ASSERT (carry == 0);
+ return;
}
@@ -1115,128 +1115,128 @@ void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_rig
case of dividing two bignum digits by one bignum digit. It is
assumed that the numerator, denominator are normalized. */
-#define BDD_STEP(qn, j) \
-{ \
- uj = (u[j]); \
- if (uj != v1) \
- { \
- uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \
- guess = (uj_uj1 / v1); \
- comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \
- } \
- else \
- { \
- guess = (BIGNUM_RADIX_ROOT - 1); \
- comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \
- } \
- while ((guess * v2) > comparand) \
- { \
- guess -= 1; \
- comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \
- if (comparand >= BIGNUM_RADIX) \
- break; \
- } \
- qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
+#define BDD_STEP(qn, j) \
+{ \
+ uj = (u[j]); \
+ if (uj != v1) \
+ { \
+ uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \
+ guess = (uj_uj1 / v1); \
+ comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \
+ } \
+ else \
+ { \
+ guess = (BIGNUM_RADIX_ROOT - 1); \
+ comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \
+ } \
+ while ((guess * v2) > comparand) \
+ { \
+ guess -= 1; \
+ comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \
+ if (comparand >= BIGNUM_RADIX) \
+ break; \
+ } \
+ qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
}
bignum_digit_type factorvm::bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
{
- bignum_digit_type guess;
- bignum_digit_type comparand;
- bignum_digit_type v1 = (HD_HIGH (v));
- bignum_digit_type v2 = (HD_LOW (v));
- bignum_digit_type uj;
- bignum_digit_type uj_uj1;
- bignum_digit_type q1;
- bignum_digit_type q2;
- bignum_digit_type u [4];
- if (uh == 0)
- {
- if (ul < v)
- {
- (*q) = 0;
- return (ul);
- }
- else if (ul == v)
- {
- (*q) = 1;
- return (0);
- }
- }
- (u[0]) = (HD_HIGH (uh));
- (u[1]) = (HD_LOW (uh));
- (u[2]) = (HD_HIGH (ul));
- (u[3]) = (HD_LOW (ul));
- v1 = (HD_HIGH (v));
- v2 = (HD_LOW (v));
- BDD_STEP (q1, 0);
- BDD_STEP (q2, 1);
- (*q) = (HD_CONS (q1, q2));
- return (HD_CONS ((u[2]), (u[3])));
+ bignum_digit_type guess;
+ bignum_digit_type comparand;
+ bignum_digit_type v1 = (HD_HIGH (v));
+ bignum_digit_type v2 = (HD_LOW (v));
+ bignum_digit_type uj;
+ bignum_digit_type uj_uj1;
+ bignum_digit_type q1;
+ bignum_digit_type q2;
+ bignum_digit_type u [4];
+ if (uh == 0)
+ {
+ if (ul < v)
+ {
+ (*q) = 0;
+ return (ul);
+ }
+ else if (ul == v)
+ {
+ (*q) = 1;
+ return (0);
+ }
+ }
+ (u[0]) = (HD_HIGH (uh));
+ (u[1]) = (HD_LOW (uh));
+ (u[2]) = (HD_HIGH (ul));
+ (u[3]) = (HD_LOW (ul));
+ v1 = (HD_HIGH (v));
+ v2 = (HD_LOW (v));
+ BDD_STEP (q1, 0);
+ BDD_STEP (q2, 1);
+ (*q) = (HD_CONS (q1, q2));
+ return (HD_CONS ((u[2]), (u[3])));
}
#undef BDD_STEP
-#define BDDS_MULSUB(vn, un, carry_in) \
-{ \
- product = ((vn * guess) + carry_in); \
- diff = (un - (HD_LOW (product))); \
- if (diff < 0) \
- { \
- un = (diff + BIGNUM_RADIX_ROOT); \
- carry = ((HD_HIGH (product)) + 1); \
- } \
- else \
- { \
- un = diff; \
- carry = (HD_HIGH (product)); \
- } \
+#define BDDS_MULSUB(vn, un, carry_in) \
+{ \
+ product = ((vn * guess) + carry_in); \
+ diff = (un - (HD_LOW (product))); \
+ if (diff < 0) \
+ { \
+ un = (diff + BIGNUM_RADIX_ROOT); \
+ carry = ((HD_HIGH (product)) + 1); \
+ } \
+ else \
+ { \
+ un = diff; \
+ carry = (HD_HIGH (product)); \
+ } \
}
-#define BDDS_ADD(vn, un, carry_in) \
-{ \
- sum = (vn + un + carry_in); \
- if (sum < BIGNUM_RADIX_ROOT) \
- { \
- un = sum; \
- carry = 0; \
- } \
- else \
- { \
- un = (sum - BIGNUM_RADIX_ROOT); \
- carry = 1; \
- } \
+#define BDDS_ADD(vn, un, carry_in) \
+{ \
+ sum = (vn + un + carry_in); \
+ if (sum < BIGNUM_RADIX_ROOT) \
+ { \
+ un = sum; \
+ carry = 0; \
+ } \
+ else \
+ { \
+ un = (sum - BIGNUM_RADIX_ROOT); \
+ carry = 1; \
+ } \
}
bignum_digit_type factorvm::bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
{
- {
- bignum_digit_type product;
- bignum_digit_type diff;
- bignum_digit_type carry;
- BDDS_MULSUB (v2, (u[2]), 0);
- BDDS_MULSUB (v1, (u[1]), carry);
- if (carry == 0)
- return (guess);
- diff = ((u[0]) - carry);
- if (diff < 0)
- (u[0]) = (diff + BIGNUM_RADIX);
- else
- {
- (u[0]) = diff;
- return (guess);
- }
- }
- {
- bignum_digit_type sum;
- bignum_digit_type carry;
- BDDS_ADD(v2, (u[2]), 0);
- BDDS_ADD(v1, (u[1]), carry);
- if (carry == 1)
- (u[0]) += 1;
- }
- return (guess - 1);
+ {
+ bignum_digit_type product;
+ bignum_digit_type diff;
+ bignum_digit_type carry;
+ BDDS_MULSUB (v2, (u[2]), 0);
+ BDDS_MULSUB (v1, (u[1]), carry);
+ if (carry == 0)
+ return (guess);
+ diff = ((u[0]) - carry);
+ if (diff < 0)
+ (u[0]) = (diff + BIGNUM_RADIX);
+ else
+ {
+ (u[0]) = diff;
+ return (guess);
+ }
+ }
+ {
+ bignum_digit_type sum;
+ bignum_digit_type carry;
+ BDDS_ADD(v2, (u[2]), 0);
+ BDDS_ADD(v1, (u[1]), carry);
+ if (carry == 1)
+ (u[0]) += 1;
+ }
+ return (guess - 1);
}
@@ -1248,19 +1248,19 @@ void factorvm::bignum_divide_unsigned_small_denominator(bignum * numerator, bign
{
GC_BIGNUM(numerator,this);
- bignum * q = (bignum_new_sign (numerator, q_negative_p));
- GC_BIGNUM(q,this);
+ bignum * q = (bignum_new_sign (numerator, q_negative_p));
+ GC_BIGNUM(q,this);
- bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
+ bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
- q = (bignum_trim (q));
+ q = (bignum_trim (q));
- if (remainder != ((bignum * *) 0))
- (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
+ if (remainder != ((bignum * *) 0))
+ (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
- (*quotient) = q;
+ (*quotient) = q;
- return;
+ return;
}
@@ -1270,23 +1270,23 @@ void factorvm::bignum_divide_unsigned_small_denominator(bignum * numerator, bign
bignum_digit_type factorvm::bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
{
- bignum_digit_type numerator;
- bignum_digit_type remainder = 0;
- bignum_digit_type two_digits;
+ bignum_digit_type numerator;
+ bignum_digit_type remainder = 0;
+ bignum_digit_type two_digits;
#define quotient_high remainder
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
- BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
- while (start < scan)
- {
- two_digits = (*--scan);
- numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
- quotient_high = (numerator / denominator);
- numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
- (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
- remainder = (numerator % denominator);
- }
- return (remainder);
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
+ BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
+ while (start < scan)
+ {
+ two_digits = (*--scan);
+ numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
+ quotient_high = (numerator / denominator);
+ numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
+ (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
+ remainder = (numerator % denominator);
+ }
+ return (remainder);
#undef quotient_high
}
@@ -1294,92 +1294,92 @@ bignum_digit_type factorvm::bignum_destructive_scale_down(bignum * bignum, bignu
/* allocates memory */
bignum * factorvm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
{
- bignum_digit_type two_digits;
- bignum_digit_type * start = (BIGNUM_START_PTR (n));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
- bignum_digit_type r = 0;
- BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
- while (start < scan)
- {
- two_digits = (*--scan);
- r =
- ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
- (HD_LOW (two_digits))))
- % d);
- }
- return (bignum_digit_to_bignum (r, negative_p));
+ bignum_digit_type two_digits;
+ bignum_digit_type * start = (BIGNUM_START_PTR (n));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
+ bignum_digit_type r = 0;
+ BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
+ while (start < scan)
+ {
+ two_digits = (*--scan);
+ r =
+ ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
+ (HD_LOW (two_digits))))
+ % d);
+ }
+ return (bignum_digit_to_bignum (r, negative_p));
}
/* allocates memory */
bignum *factorvm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
{
- if (digit == 0)
- return (BIGNUM_ZERO ());
- else
- {
- bignum * result = (allot_bignum (1, negative_p));
- (BIGNUM_REF (result, 0)) = digit;
- return (result);
- }
+ if (digit == 0)
+ return (BIGNUM_ZERO ());
+ else
+ {
+ bignum * result = (allot_bignum (1, negative_p));
+ (BIGNUM_REF (result, 0)) = digit;
+ return (result);
+ }
}
/* allocates memory */
bignum *factorvm::allot_bignum(bignum_length_type length, int negative_p)
{
- BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
- bignum * result = allot_array_internal<bignum>(length + 1);
- BIGNUM_SET_NEGATIVE_P (result, negative_p);
- return (result);
+ BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
+ bignum * result = allot_array_internal<bignum>(length + 1);
+ BIGNUM_SET_NEGATIVE_P (result, negative_p);
+ return (result);
}
/* allocates memory */
bignum * factorvm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
{
- bignum * result = allot_bignum(length,negative_p);
- bignum_digit_type * scan = (BIGNUM_START_PTR (result));
- bignum_digit_type * end = (scan + length);
- while (scan < end)
- (*scan++) = 0;
- return (result);
+ bignum * result = allot_bignum(length,negative_p);
+ bignum_digit_type * scan = (BIGNUM_START_PTR (result));
+ bignum_digit_type * end = (scan + length);
+ while (scan < end)
+ (*scan++) = 0;
+ return (result);
}
-#define BIGNUM_REDUCE_LENGTH(source, length) \
- source = reallot_array(source,length + 1)
+#define BIGNUM_REDUCE_LENGTH(source, length) \
+source = reallot_array(source,length + 1)
/* allocates memory */
bignum *factorvm::bignum_shorten_length(bignum * bignum, bignum_length_type length)
{
- bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
- BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
- if (length < current_length)
- {
- BIGNUM_REDUCE_LENGTH (bignum, length);
- BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
- }
- return (bignum);
+ bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
+ BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
+ if (length < current_length)
+ {
+ BIGNUM_REDUCE_LENGTH (bignum, length);
+ BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
+ }
+ return (bignum);
}
/* allocates memory */
bignum *factorvm::bignum_trim(bignum * bignum)
{
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
- bignum_digit_type * scan = end;
- while ((start <= scan) && ((*--scan) == 0))
- ;
- scan += 1;
- if (scan < end)
- {
- bignum_length_type length = (scan - start);
- BIGNUM_REDUCE_LENGTH (bignum, length);
- BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
- }
- return (bignum);
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
+ bignum_digit_type * scan = end;
+ while ((start <= scan) && ((*--scan) == 0))
+ ;
+ scan += 1;
+ if (scan < end)
+ {
+ bignum_length_type length = (scan - start);
+ BIGNUM_REDUCE_LENGTH (bignum, length);
+ BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
+ }
+ return (bignum);
}
@@ -1389,37 +1389,37 @@ bignum *factorvm::bignum_trim(bignum * bignum)
bignum *factorvm::bignum_new_sign(bignum * x, int negative_p)
{
GC_BIGNUM(x,this);
- bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
+ bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
- bignum_destructive_copy (x, result);
- return (result);
+ bignum_destructive_copy (x, result);
+ return (result);
}
/* allocates memory */
bignum *factorvm::bignum_maybe_new_sign(bignum * x, int negative_p)
{
- if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
- return (x);
- else
- {
- bignum * result =
- (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
- bignum_destructive_copy (x, result);
- return (result);
- }
+ if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
+ return (x);
+ else
+ {
+ bignum * result =
+ (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
+ bignum_destructive_copy (x, result);
+ return (result);
+ }
}
void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
{
- bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
- bignum_digit_type * end_source =
- (scan_source + (BIGNUM_LENGTH (source)));
- bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
- while (scan_source < end_source)
- (*scan_target++) = (*scan_source++);
- return;
+ bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
+ bignum_digit_type * end_source =
+ (scan_source + (BIGNUM_LENGTH (source)));
+ bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
+ while (scan_source < end_source)
+ (*scan_target++) = (*scan_source++);
+ return;
}
@@ -1430,17 +1430,17 @@ void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
/* allocates memory */
bignum *factorvm::bignum_bitwise_not(bignum * x)
{
- return bignum_subtract(BIGNUM_ONE(1), x);
+ return bignum_subtract(BIGNUM_ONE(1), x);
}
/* allocates memory */
bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
{
- if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
- return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
- else
- return bignum_magnitude_ash(arg1, n);
+ if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
+ return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
+ else
+ return bignum_magnitude_ash(arg1, n);
}
@@ -1451,45 +1451,45 @@ bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
/* allocates memory */
bignum *factorvm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
{
- return(
- (BIGNUM_NEGATIVE_P (arg1))
- ? (BIGNUM_NEGATIVE_P (arg2))
+ return(
+ (BIGNUM_NEGATIVE_P (arg1))
+ ? (BIGNUM_NEGATIVE_P (arg2))
? bignum_negneg_bitwise_op(AND_OP, arg1, arg2)
: bignum_posneg_bitwise_op(AND_OP, arg2, arg1)
- : (BIGNUM_NEGATIVE_P (arg2))
+ : (BIGNUM_NEGATIVE_P (arg2))
? bignum_posneg_bitwise_op(AND_OP, arg1, arg2)
: bignum_pospos_bitwise_op(AND_OP, arg1, arg2)
- );
+ );
}
/* allocates memory */
bignum *factorvm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
{
- return(
- (BIGNUM_NEGATIVE_P (arg1))
- ? (BIGNUM_NEGATIVE_P (arg2))
+ return(
+ (BIGNUM_NEGATIVE_P (arg1))
+ ? (BIGNUM_NEGATIVE_P (arg2))
? bignum_negneg_bitwise_op(IOR_OP, arg1, arg2)
: bignum_posneg_bitwise_op(IOR_OP, arg2, arg1)
- : (BIGNUM_NEGATIVE_P (arg2))
+ : (BIGNUM_NEGATIVE_P (arg2))
? bignum_posneg_bitwise_op(IOR_OP, arg1, arg2)
: bignum_pospos_bitwise_op(IOR_OP, arg1, arg2)
- );
+ );
}
/* allocates memory */
bignum *factorvm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
{
- return(
- (BIGNUM_NEGATIVE_P (arg1))
- ? (BIGNUM_NEGATIVE_P (arg2))
+ return(
+ (BIGNUM_NEGATIVE_P (arg1))
+ ? (BIGNUM_NEGATIVE_P (arg2))
? bignum_negneg_bitwise_op(XOR_OP, arg1, arg2)
: bignum_posneg_bitwise_op(XOR_OP, arg2, arg1)
- : (BIGNUM_NEGATIVE_P (arg2))
+ : (BIGNUM_NEGATIVE_P (arg2))
? bignum_posneg_bitwise_op(XOR_OP, arg1, arg2)
: bignum_pospos_bitwise_op(XOR_OP, arg1, arg2)
- );
+ );
}
@@ -1500,60 +1500,60 @@ bignum *factorvm::bignum_magnitude_ash(bignum * arg1, fixnum n)
{
GC_BIGNUM(arg1,this);
- bignum * result = NULL;
- bignum_digit_type *scan1;
- bignum_digit_type *scanr;
- bignum_digit_type *end;
+ bignum * result = NULL;
+ bignum_digit_type *scan1;
+ bignum_digit_type *scanr;
+ bignum_digit_type *end;
- fixnum digit_offset,bit_offset;
+ fixnum digit_offset,bit_offset;
- if (BIGNUM_ZERO_P (arg1)) return (arg1);
+ if (BIGNUM_ZERO_P (arg1)) return (arg1);
- if (n > 0) {
- digit_offset = n / BIGNUM_DIGIT_LENGTH;
- bit_offset = n % BIGNUM_DIGIT_LENGTH;
+ if (n > 0) {
+ digit_offset = n / BIGNUM_DIGIT_LENGTH;
+ bit_offset = n % BIGNUM_DIGIT_LENGTH;
- result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
- BIGNUM_NEGATIVE_P(arg1));
+ result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
+ BIGNUM_NEGATIVE_P(arg1));
- scanr = BIGNUM_START_PTR (result) + digit_offset;
- scan1 = BIGNUM_START_PTR (arg1);
- end = scan1 + BIGNUM_LENGTH (arg1);
+ scanr = BIGNUM_START_PTR (result) + digit_offset;
+ scan1 = BIGNUM_START_PTR (arg1);
+ end = scan1 + BIGNUM_LENGTH (arg1);
- while (scan1 < end) {
- *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
- *scanr = *scanr & BIGNUM_DIGIT_MASK;
- scanr++;
- *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
- *scanr = *scanr & BIGNUM_DIGIT_MASK;
- }
- }
- else if (n < 0
- && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
- result = BIGNUM_ZERO ();
+ while (scan1 < end) {
+ *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
+ *scanr = *scanr & BIGNUM_DIGIT_MASK;
+ scanr++;
+ *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
+ *scanr = *scanr & BIGNUM_DIGIT_MASK;
+ }
+ }
+ else if (n < 0
+ && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
+ result = BIGNUM_ZERO ();
- else if (n < 0) {
- digit_offset = -n / BIGNUM_DIGIT_LENGTH;
- bit_offset = -n % BIGNUM_DIGIT_LENGTH;
+ else if (n < 0) {
+ digit_offset = -n / BIGNUM_DIGIT_LENGTH;
+ bit_offset = -n % BIGNUM_DIGIT_LENGTH;
- result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
- BIGNUM_NEGATIVE_P(arg1));
+ result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
+ BIGNUM_NEGATIVE_P(arg1));
- scanr = BIGNUM_START_PTR (result);
- scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
- end = scanr + BIGNUM_LENGTH (result) - 1;
+ scanr = BIGNUM_START_PTR (result);
+ scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
+ end = scanr + BIGNUM_LENGTH (result) - 1;
- while (scanr < end) {
- *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
- *scanr = (*scanr |
- *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
- scanr++;
- }
- *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
- }
- else if (n == 0) result = arg1;
+ while (scanr < end) {
+ *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
+ *scanr = (*scanr |
+ *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
+ scanr++;
+ }
+ *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
+ }
+ else if (n == 0) result = arg1;
- return (bignum_trim (result));
+ return (bignum_trim (result));
}
@@ -1562,33 +1562,33 @@ bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
- bignum * result;
- bignum_length_type max_length;
+ bignum * result;
+ bignum_length_type max_length;
- bignum_digit_type *scan1, *end1, digit1;
- bignum_digit_type *scan2, *end2, digit2;
- bignum_digit_type *scanr, *endr;
+ bignum_digit_type *scan1, *end1, digit1;
+ bignum_digit_type *scan2, *end2, digit2;
+ bignum_digit_type *scanr, *endr;
- max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
- ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
+ max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
+ ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
- result = allot_bignum(max_length, 0);
+ result = allot_bignum(max_length, 0);
- scanr = BIGNUM_START_PTR(result);
- scan1 = BIGNUM_START_PTR(arg1);
- scan2 = BIGNUM_START_PTR(arg2);
- endr = scanr + max_length;
- end1 = scan1 + BIGNUM_LENGTH(arg1);
- end2 = scan2 + BIGNUM_LENGTH(arg2);
+ scanr = BIGNUM_START_PTR(result);
+ scan1 = BIGNUM_START_PTR(arg1);
+ scan2 = BIGNUM_START_PTR(arg2);
+ endr = scanr + max_length;
+ end1 = scan1 + BIGNUM_LENGTH(arg1);
+ end2 = scan2 + BIGNUM_LENGTH(arg2);
- while (scanr < endr) {
- digit1 = (scan1 < end1) ? *scan1++ : 0;
- digit2 = (scan2 < end2) ? *scan2++ : 0;
- *scanr++ = (op == AND_OP) ? digit1 & digit2 :
- (op == IOR_OP) ? digit1 | digit2 :
- digit1 ^ digit2;
- }
- return bignum_trim(result);
+ while (scanr < endr) {
+ digit1 = (scan1 < end1) ? *scan1++ : 0;
+ digit2 = (scan2 < end2) ? *scan2++ : 0;
+ *scanr++ = (op == AND_OP) ? digit1 & digit2 :
+ (op == IOR_OP) ? digit1 | digit2 :
+ digit1 ^ digit2;
+ }
+ return bignum_trim(result);
}
@@ -1597,51 +1597,51 @@ bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
- bignum * result;
- bignum_length_type max_length;
+ bignum * result;
+ bignum_length_type max_length;
- bignum_digit_type *scan1, *end1, digit1;
- bignum_digit_type *scan2, *end2, digit2, carry2;
- bignum_digit_type *scanr, *endr;
+ bignum_digit_type *scan1, *end1, digit1;
+ bignum_digit_type *scan2, *end2, digit2, carry2;
+ bignum_digit_type *scanr, *endr;
- char neg_p = op == IOR_OP || op == XOR_OP;
+ char neg_p = op == IOR_OP || op == XOR_OP;
- max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
- ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
+ max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
+ ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
- result = allot_bignum(max_length, neg_p);
+ result = allot_bignum(max_length, neg_p);
- scanr = BIGNUM_START_PTR(result);
- scan1 = BIGNUM_START_PTR(arg1);
- scan2 = BIGNUM_START_PTR(arg2);
- endr = scanr + max_length;
- end1 = scan1 + BIGNUM_LENGTH(arg1);
- end2 = scan2 + BIGNUM_LENGTH(arg2);
+ scanr = BIGNUM_START_PTR(result);
+ scan1 = BIGNUM_START_PTR(arg1);
+ scan2 = BIGNUM_START_PTR(arg2);
+ endr = scanr + max_length;
+ end1 = scan1 + BIGNUM_LENGTH(arg1);
+ end2 = scan2 + BIGNUM_LENGTH(arg2);
- carry2 = 1;
+ carry2 = 1;
- while (scanr < endr) {
- digit1 = (scan1 < end1) ? *scan1++ : 0;
- digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
- + carry2;
+ while (scanr < endr) {
+ digit1 = (scan1 < end1) ? *scan1++ : 0;
+ digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
+ + carry2;
- if (digit2 < BIGNUM_RADIX)
- carry2 = 0;
- else
- {
- digit2 = (digit2 - BIGNUM_RADIX);
- carry2 = 1;
- }
+ if (digit2 < BIGNUM_RADIX)
+ carry2 = 0;
+ else
+ {
+ digit2 = (digit2 - BIGNUM_RADIX);
+ carry2 = 1;
+ }
- *scanr++ = (op == AND_OP) ? digit1 & digit2 :
- (op == IOR_OP) ? digit1 | digit2 :
- digit1 ^ digit2;
- }
+ *scanr++ = (op == AND_OP) ? digit1 & digit2 :
+ (op == IOR_OP) ? digit1 | digit2 :
+ digit1 ^ digit2;
+ }
- if (neg_p)
- bignum_negate_magnitude(result);
+ if (neg_p)
+ bignum_negate_magnitude(result);
- return bignum_trim(result);
+ return bignum_trim(result);
}
@@ -1650,87 +1650,87 @@ bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
- bignum * result;
- bignum_length_type max_length;
+ bignum * result;
+ bignum_length_type max_length;
- bignum_digit_type *scan1, *end1, digit1, carry1;
- bignum_digit_type *scan2, *end2, digit2, carry2;
- bignum_digit_type *scanr, *endr;
+ bignum_digit_type *scan1, *end1, digit1, carry1;
+ bignum_digit_type *scan2, *end2, digit2, carry2;
+ bignum_digit_type *scanr, *endr;
- char neg_p = op == AND_OP || op == IOR_OP;
+ char neg_p = op == AND_OP || op == IOR_OP;
- max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
- ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
+ max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
+ ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
- result = allot_bignum(max_length, neg_p);
+ result = allot_bignum(max_length, neg_p);
- scanr = BIGNUM_START_PTR(result);
- scan1 = BIGNUM_START_PTR(arg1);
- scan2 = BIGNUM_START_PTR(arg2);
- endr = scanr + max_length;
- end1 = scan1 + BIGNUM_LENGTH(arg1);
- end2 = scan2 + BIGNUM_LENGTH(arg2);
+ scanr = BIGNUM_START_PTR(result);
+ scan1 = BIGNUM_START_PTR(arg1);
+ scan2 = BIGNUM_START_PTR(arg2);
+ endr = scanr + max_length;
+ end1 = scan1 + BIGNUM_LENGTH(arg1);
+ end2 = scan2 + BIGNUM_LENGTH(arg2);
- carry1 = 1;
- carry2 = 1;
+ carry1 = 1;
+ carry2 = 1;
- while (scanr < endr) {
- digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
- digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
+ while (scanr < endr) {
+ digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
+ digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
- if (digit1 < BIGNUM_RADIX)
- carry1 = 0;
- else
- {
- digit1 = (digit1 - BIGNUM_RADIX);
- carry1 = 1;
- }
+ if (digit1 < BIGNUM_RADIX)
+ carry1 = 0;
+ else
+ {
+ digit1 = (digit1 - BIGNUM_RADIX);
+ carry1 = 1;
+ }
- if (digit2 < BIGNUM_RADIX)
- carry2 = 0;
- else
- {
- digit2 = (digit2 - BIGNUM_RADIX);
- carry2 = 1;
- }
+ if (digit2 < BIGNUM_RADIX)
+ carry2 = 0;
+ else
+ {
+ digit2 = (digit2 - BIGNUM_RADIX);
+ carry2 = 1;
+ }
- *scanr++ = (op == AND_OP) ? digit1 & digit2 :
- (op == IOR_OP) ? digit1 | digit2 :
- digit1 ^ digit2;
- }
+ *scanr++ = (op == AND_OP) ? digit1 & digit2 :
+ (op == IOR_OP) ? digit1 | digit2 :
+ digit1 ^ digit2;
+ }
- if (neg_p)
- bignum_negate_magnitude(result);
+ if (neg_p)
+ bignum_negate_magnitude(result);
- return bignum_trim(result);
+ return bignum_trim(result);
}
void factorvm::bignum_negate_magnitude(bignum * arg)
{
- bignum_digit_type *scan;
- bignum_digit_type *end;
- bignum_digit_type digit;
- bignum_digit_type carry;
+ bignum_digit_type *scan;
+ bignum_digit_type *end;
+ bignum_digit_type digit;
+ bignum_digit_type carry;
- scan = BIGNUM_START_PTR(arg);
- end = scan + BIGNUM_LENGTH(arg);
+ scan = BIGNUM_START_PTR(arg);
+ end = scan + BIGNUM_LENGTH(arg);
- carry = 1;
+ carry = 1;
- while (scan < end) {
- digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
+ while (scan < end) {
+ digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
- if (digit < BIGNUM_RADIX)
- carry = 0;
- else
- {
- digit = (digit - BIGNUM_RADIX);
- carry = 1;
- }
+ if (digit < BIGNUM_RADIX)
+ carry = 0;
+ else
+ {
+ digit = (digit - BIGNUM_RADIX);
+ carry = 1;
+ }
- *scan++ = digit;
- }
+ *scan++ = digit;
+ }
}
@@ -1739,80 +1739,80 @@ bignum *factorvm::bignum_integer_length(bignum * x)
{
GC_BIGNUM(x,this);
- bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
- bignum_digit_type digit = (BIGNUM_REF (x, index));
+ bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
+ bignum_digit_type digit = (BIGNUM_REF (x, index));
- bignum * result = (allot_bignum (2, 0));
+ bignum * result = (allot_bignum (2, 0));
- (BIGNUM_REF (result, 0)) = index;
- (BIGNUM_REF (result, 1)) = 0;
- bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
- while (digit > 1)
- {
- bignum_destructive_add (result, ((bignum_digit_type) 1));
- digit >>= 1;
- }
- return (bignum_trim (result));
+ (BIGNUM_REF (result, 0)) = index;
+ (BIGNUM_REF (result, 1)) = 0;
+ bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
+ while (digit > 1)
+ {
+ bignum_destructive_add (result, ((bignum_digit_type) 1));
+ digit >>= 1;
+ }
+ return (bignum_trim (result));
}
/* Allocates memory */
int factorvm::bignum_logbitp(int shift, bignum * arg)
{
- return((BIGNUM_NEGATIVE_P (arg))
- ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
- : bignum_unsigned_logbitp (shift,arg));
+ return((BIGNUM_NEGATIVE_P (arg))
+ ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
+ : bignum_unsigned_logbitp (shift,arg));
}
int factorvm::bignum_unsigned_logbitp(int shift, bignum * bignum)
{
- bignum_length_type len = (BIGNUM_LENGTH (bignum));
- int index = shift / BIGNUM_DIGIT_LENGTH;
- if (index >= len)
- return 0;
- bignum_digit_type digit = (BIGNUM_REF (bignum, index));
- int p = shift % BIGNUM_DIGIT_LENGTH;
- bignum_digit_type mask = ((fixnum)1) << p;
- return (digit & mask) ? 1 : 0;
+ bignum_length_type len = (BIGNUM_LENGTH (bignum));
+ int index = shift / BIGNUM_DIGIT_LENGTH;
+ if (index >= len)
+ return 0;
+ bignum_digit_type digit = (BIGNUM_REF (bignum, index));
+ int p = shift % BIGNUM_DIGIT_LENGTH;
+ bignum_digit_type mask = ((fixnum)1) << p;
+ return (digit & mask) ? 1 : 0;
}
/* Allocates memory */
bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
{
- BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
- if (n_digits == 0)
- return (BIGNUM_ZERO ());
- if (n_digits == 1)
- {
- fixnum digit = ((fixnum) ((*producer) (0,this)));
- return (fixnum_to_bignum (negative_p ? (- digit) : digit));
- }
- {
- bignum_length_type length;
- {
- unsigned int radix_copy = radix;
- unsigned int log_radix = 0;
- while (radix_copy > 0)
- {
- radix_copy >>= 1;
- log_radix += 1;
- }
- /* This length will be at least as large as needed. */
- length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
- }
- {
- bignum * result = (allot_bignum_zeroed (length, negative_p));
- while ((n_digits--) > 0)
- {
- bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
- bignum_destructive_add
- (result, ((bignum_digit_type) ((*producer) (n_digits,this))));
- }
- return (bignum_trim (result));
- }
- }
+ BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
+ if (n_digits == 0)
+ return (BIGNUM_ZERO ());
+ if (n_digits == 1)
+ {
+ fixnum digit = ((fixnum) ((*producer) (0,this)));
+ return (fixnum_to_bignum (negative_p ? (- digit) : digit));
+ }
+ {
+ bignum_length_type length;
+ {
+ unsigned int radix_copy = radix;
+ unsigned int log_radix = 0;
+ while (radix_copy > 0)
+ {
+ radix_copy >>= 1;
+ log_radix += 1;
+ }
+ /* This length will be at least as large as needed. */
+ length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
+ }
+ {
+ bignum * result = (allot_bignum_zeroed (length, negative_p));
+ while ((n_digits--) > 0)
+ {
+ bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
+ bignum_destructive_add
+ (result, ((bignum_digit_type) ((*producer) (n_digits,this))));
+ }
+ return (bignum_trim (result));
+ }
+ }
}
diff --git a/vm/errors.cpp b/vm/errors.cpp
index c137782f81..b3e9543b13 100755
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -3,13 +3,6 @@
namespace factor
{
-/* Global variables used to pass fault handler state from signal handler to
-user-space */
-cell signal_number;
-cell signal_fault_addr;
-unsigned int signal_fpu_status;
-stack_frame *signal_callstack_top;
-
void factorvm::out_of_memory()
{
print_string("Out of memory\n\n");
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 4ef4d11796..34e2267a88 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -235,6 +235,8 @@ void* start_standalone_factor_thread(void *arg)
VM_C_API void start_standalone_factor(int argc, vm_char **argv)
{
factorvm *newvm = new factorvm;
+ newvm->print_vm_data();
+ printf("PHIL YEAH: %d %d %d %d\n",(void*)(newvm),(void*)(newvm+1),sizeof(newvm), sizeof(factorvm));
vm = newvm;
register_vm_with_thread(newvm);
return newvm->start_standalone_factor(argc,argv);
@@ -247,4 +249,158 @@ VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **
return start_thread(start_standalone_factor_thread,args);
}
+
+void factorvm::print_vm_data() {
+ printf("PHIL: stack_chain %d\n",&stack_chain);
+ printf("PHIL: nursery %d\n",&nursery);
+ printf("PHIL: cards_offset %d\n",&cards_offset);
+ printf("PHIL: decks_offset %d\n",&decks_offset);
+ printf("PHIL: userenv %d\n",&userenv);
+ printf("PHIL: ds_size %d\n",&ds_size);
+ printf("PHIL: rs_size %d\n",&rs_size);
+ printf("PHIL: unused_contexts %d\n",&unused_contexts);
+ printf("PHIL: T %d\n",&T);
+ printf("PHIL: profiling_p %d\n",&profiling_p);
+ printf("PHIL: signal_number %d\n",&signal_number);
+ printf("PHIL: signal_fault_addr %d\n",&signal_fault_addr);
+ printf("PHIL: signal_callstack_top %d\n",&signal_callstack_top);
+ printf("PHIL: secure_gc %d\n",&secure_gc);
+ printf("PHIL: gc_off %d\n",&gc_off);
+ printf("PHIL: data %d\n",&data);
+ printf("PHIL: heap_scan_ptr %d\n",&heap_scan_ptr);
+ printf("PHIL: allot_markers_offset %d\n",&allot_markers_offset);
+ printf("PHIL: newspace %d\n",&newspace);
+ printf("PHIL: performing_gc %d\n",&performing_gc);
+ printf("PHIL: performing_compaction %d\n",&performing_compaction);
+ printf("PHIL: collecting_gen %d\n",&collecting_gen);
+ printf("PHIL: collecting_aging_again %d\n",&collecting_aging_again);
+ printf("PHIL: gc_jmp %d\n",&gc_jmp);
+ printf("PHIL: stats %d\n",&stats);
+ printf("PHIL: cards_scanned %d\n",&cards_scanned);
+ printf("PHIL: decks_scanned %d\n",&decks_scanned);
+ printf("PHIL: card_scan_time %d\n",&card_scan_time);
+ printf("PHIL: code_heap_scans %d\n",&code_heap_scans);
+ printf("PHIL: last_code_heap_scan %d\n",&last_code_heap_scan);
+ printf("PHIL: growing_data_heap %d\n",&growing_data_heap);
+ printf("PHIL: old_data_heap %d\n",&old_data_heap);
+ printf("PHIL: gc_locals %d\n",&gc_locals);
+ printf("PHIL: gc_bignums %d\n",&gc_bignums);
+ printf("PHIL: fep_disabled %d\n",&fep_disabled);
+ printf("PHIL: full_output %d\n",&full_output);
+ printf("PHIL: look_for %d\n",&look_for);
+ printf("PHIL: obj %d\n",&obj);
+ printf("PHIL: bignum_zero %d\n",&bignum_zero);
+ printf("PHIL: bignum_pos_one %d\n",&bignum_pos_one);
+ printf("PHIL: bignum_neg_one %d\n",&bignum_neg_one);
+ printf("PHIL: code %d\n",&code);
+ printf("PHIL: forwarding %d\n",&forwarding);
+ printf("PHIL: code_relocation_base %d\n",&code_relocation_base);
+ printf("PHIL: data_relocation_base %d\n",&data_relocation_base);
+ printf("PHIL: megamorphic_cache_hits %d\n",&megamorphic_cache_hits);
+ printf("PHIL: megamorphic_cache_misses %d\n",&megamorphic_cache_misses);
+ printf("PHIL: max_pic_size %d\n",&max_pic_size);
+ printf("PHIL: cold_call_to_ic_transitions %d\n",&cold_call_to_ic_transitions);
+ printf("PHIL: ic_to_pic_transitions %d\n",&ic_to_pic_transitions);
+ printf("PHIL: pic_to_mega_transitions %d\n",&pic_to_mega_transitions);
+ printf("PHIL: pic_counts %d\n",&pic_counts);
+}
+
+ // if you change this struct, also change vm.factor k--------
+ context *stack_chain;
+ zone nursery; /* new objects are allocated here */
+ cell cards_offset;
+ cell decks_offset;
+ cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
+
+ // -------------------------------
+
+ // contexts
+ cell ds_size, rs_size;
+ context *unused_contexts;
+
+ // run
+ cell T; /* Canonical T object. It's just a word */
+
+ // profiler
+ bool profiling_p;
+
+ // errors
+ /* Global variables used to pass fault handler state from signal handler to
+ user-space */
+ cell signal_number;
+ cell signal_fault_addr;
+ unsigned int signal_fpu_status;
+ stack_frame *signal_callstack_top;
+
+ //data_heap
+ bool secure_gc; /* Set by the -securegc command line argument */
+ bool gc_off; /* GC is off during heap walking */
+ data_heap *data;
+ /* A heap walk allows useful things to be done, like finding all
+ references to an object for debugging purposes. */
+ cell heap_scan_ptr;
+ //write barrier
+ cell allot_markers_offset;
+ //data_gc
+ /* used during garbage collection only */
+ zone *newspace;
+ bool performing_gc;
+ bool performing_compaction;
+ cell collecting_gen;
+ /* if true, we are 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];
+ u64 cards_scanned;
+ u64 decks_scanned;
+ u64 card_scan_time;
+ cell code_heap_scans;
+ /* What generation was being collected when copy_code_heap_roots() was last
+ called? Until the next call to add_code_block(), future
+ collections of younger generations don't have to touch the code
+ heap. */
+ cell last_code_heap_scan;
+ /* sometimes we grow the heap */
+ bool growing_data_heap;
+ data_heap *old_data_heap;
+
+ // local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
+ std::vector<cell> gc_locals;
+ std::vector<cell> gc_bignums;
+
+ //debug
+ bool fep_disabled;
+ bool full_output;
+ cell look_for;
+ cell obj;
+
+ //math
+ cell bignum_zero;
+ cell bignum_pos_one;
+ cell bignum_neg_one;
+
+ //code_heap
+ heap code;
+ unordered_map<heap_block *,char *> forwarding;
+
+ //image
+ cell code_relocation_base;
+ cell data_relocation_base;
+
+ //dispatch
+ cell megamorphic_cache_hits;
+ cell megamorphic_cache_misses;
+
+ //inline cache
+ cell max_pic_size;
+ cell cold_call_to_ic_transitions;
+ cell ic_to_pic_transitions;
+ cell pic_to_mega_transitions;
+ cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
}
diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index ee00e1434a..988ce60a8a 100755
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -39,21 +39,20 @@ s64 current_micros()
- EPOCH_OFFSET) / 10;
}
-FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
+LONG factorvm::exception_handler(PEXCEPTION_POINTERS pe)
{
- factorvm *myvm = SIGNAL_VM_PTR();
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
- if(myvm->in_code_heap_p(c->EIP))
- myvm->signal_callstack_top = (stack_frame *)c->ESP;
+ if(in_code_heap_p(c->EIP))
+ signal_callstack_top = (stack_frame *)c->ESP;
else
- myvm->signal_callstack_top = NULL;
+ signal_callstack_top = NULL;
switch (e->ExceptionCode) {
case EXCEPTION_ACCESS_VIOLATION:
- myvm->signal_fault_addr = e->ExceptionInformation[1];
- c->EIP = (cell)memory_signal_handler_impl;
+ signal_fault_addr = e->ExceptionInformation[1];
+ c->EIP = (cell)factor::memory_signal_handler_impl;
break;
case STATUS_FLOAT_DENORMAL_OPERAND:
@@ -65,10 +64,10 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
case STATUS_FLOAT_UNDERFLOW:
case STATUS_FLOAT_MULTIPLE_FAULTS:
case STATUS_FLOAT_MULTIPLE_TRAPS:
- myvm->signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
+ signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
X87SW(c) = 0;
MXCSR(c) &= 0xffffffc0;
- c->EIP = (cell)fp_signal_handler_impl;
+ c->EIP = (cell)factor::fp_signal_handler_impl;
break;
case 0x40010006:
/* If the Widcomm bluetooth stack is installed, the BTTray.exe
@@ -79,24 +78,30 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
enabled. Don't really have any idea what this exception means. */
break;
default:
- myvm->signal_number = e->ExceptionCode;
- c->EIP = (cell)misc_signal_handler_impl;
+ signal_number = e->ExceptionCode;
+ c->EIP = (cell)factor::misc_signal_handler_impl;
break;
}
return EXCEPTION_CONTINUE_EXECUTION;
}
+
+FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
+{
+ return SIGNAL_VM_PTR()->exception_handler(pe);
+}
+
bool handler_added = 0;
void factorvm::c_to_factor_toplevel(cell quot)
{
if(!handler_added){
- if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
+ if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)factor::exception_handler))
fatal_error("AddVectoredExceptionHandler failed", 0);
handler_added = 1;
}
c_to_factor(quot,this);
- RemoveVectoredExceptionHandler((void *)exception_handler);
+ RemoveVectoredExceptionHandler((void *)factor::exception_handler);
}
void factorvm::open_console()
diff --git a/vm/vm-data-dummy.hpp b/vm/vm-data-dummy.hpp
new file mode 100644
index 0000000000..c028a61503
--- /dev/null
+++ b/vm/vm-data-dummy.hpp
@@ -0,0 +1,116 @@
+namespace factor
+{
+
+ // if you change this struct, also change vm.factor k--------
+ extern "C" context *stack_chain;
+ extern "C" zone nursery; /* new objects are allocated here */
+ extern "C" cell cards_offset;
+ extern "C" cell decks_offset;
+//extern "C" cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
+
+ // -------------------------------
+
+ // contexts
+ extern "C" cell ds_size, rs_size;
+ extern "C" context *unused_contexts;
+
+
+ // profiler
+ extern "C" bool profiling_p;
+
+ // errors
+ /* Global variables used to pass fault handler state from signal handler to
+ user-space */
+ extern "C" cell signal_number;
+ extern "C" cell signal_fault_addr;
+ extern "C" unsigned int signal_fpu_status;
+ extern "C" stack_frame *signal_callstack_top;
+
+ //data_heap
+ extern "C" bool secure_gc; /* Set by the -securegc command line argument */
+ extern "C" bool gc_off; /* GC is off during heap walking */
+ extern "C" data_heap *data;
+ /* A heap walk allows useful things to be done, like finding all
+ references to an object for debugging purposes. */
+ extern "C" cell heap_scan_ptr;
+ //write barrier
+ extern "C" cell allot_markers_offset;
+ //data_gc
+ /* used during garbage collection only */
+ extern "C" zone *newspace;
+ extern "C" bool performing_gc;
+ extern "C" bool performing_compaction;
+ extern "C" cell collecting_gen;
+ /* if true, we are collecting aging space for the second time, so if it is still
+ full, we go on to collect tenured */
+ extern "C" 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. */
+ extern "C" jmp_buf gc_jmp;
+ extern "C" gc_stats stats[max_gen_count];
+ extern "C" u64 cards_scanned;
+ extern "C" u64 decks_scanned;
+ extern "C" u64 card_scan_time;
+ extern "C" cell code_heap_scans;
+ /* What generation was being collected when copy_code_heap_roots() was last
+ called? Until the next call to add_code_block(), future
+ collections of younger generations don't have to touch the code
+ heap. */
+ extern "C" cell last_code_heap_scan;
+ /* sometimes we grow the heap */
+ extern "C" bool growing_data_heap;
+ extern "C" data_heap *old_data_heap;
+
+ // local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
+ //extern "C" segment *gc_locals_region;
+ //extern "C" cell gc_locals;
+ //extern "C" segment *gc_bignums_region;
+ //extern "C" cell gc_bignums;
+
+ //debug
+ extern "C" bool fep_disabled;
+ extern "C" bool full_output;
+ extern "C" cell look_for;
+ extern "C" cell obj;
+
+ //math
+ extern "C" cell bignum_zero;
+ extern "C" cell bignum_pos_one;
+ extern "C" cell bignum_neg_one;
+
+ //code_heap
+ extern "C" heap code;
+ extern "C" unordered_map<heap_block *,char *> forwarding;
+
+ //image
+ extern "C" cell code_relocation_base;
+ extern "C" cell data_relocation_base;
+
+ //dispatch
+ extern "C" cell megamorphic_cache_hits;
+ extern "C" cell megamorphic_cache_misses;
+
+ //inline cache
+ extern "C" cell max_pic_size;
+ extern "C" cell cold_call_to_ic_transitions;
+ extern "C" cell ic_to_pic_transitions;
+ extern "C" cell pic_to_mega_transitions;
+ extern "C" cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
+
+struct factorvmdata {
+ cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
+
+ // run
+ cell T; /* Canonical T object. It's just a word */
+
+ // local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
+ std::vector<cell> gc_locals;
+ std::vector<cell> gc_bignums;
+};
+}
diff --git a/vm/vm-data.hpp b/vm/vm-data.hpp
new file mode 100644
index 0000000000..701e35da9d
--- /dev/null
+++ b/vm/vm-data.hpp
@@ -0,0 +1,105 @@
+namespace factor
+{
+
+struct factorvmdata {
+ // if you change this struct, also change vm.factor k--------
+ context *stack_chain;
+ zone nursery; /* new objects are allocated here */
+ cell cards_offset;
+ cell decks_offset;
+ cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
+
+ // -------------------------------
+
+ // contexts
+ cell ds_size, rs_size;
+ context *unused_contexts;
+
+ // run
+ cell T; /* Canonical T object. It's just a word */
+
+ // profiler
+ bool profiling_p;
+
+ // errors
+ /* Global variables used to pass fault handler state from signal handler to
+ user-space */
+ cell signal_number;
+ cell signal_fault_addr;
+ unsigned int signal_fpu_status;
+ stack_frame *signal_callstack_top;
+
+ //data_heap
+ bool secure_gc; /* Set by the -securegc command line argument */
+ bool gc_off; /* GC is off during heap walking */
+ data_heap *data;
+ /* A heap walk allows useful things to be done, like finding all
+ references to an object for debugging purposes. */
+ cell heap_scan_ptr;
+ //write barrier
+ cell allot_markers_offset;
+ //data_gc
+ /* used during garbage collection only */
+ zone *newspace;
+ bool performing_gc;
+ bool performing_compaction;
+ cell collecting_gen;
+ /* if true, we are 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];
+ u64 cards_scanned;
+ u64 decks_scanned;
+ u64 card_scan_time;
+ cell code_heap_scans;
+ /* What generation was being collected when copy_code_heap_roots() was last
+ called? Until the next call to add_code_block(), future
+ collections of younger generations don't have to touch the code
+ heap. */
+ cell last_code_heap_scan;
+ /* sometimes we grow the heap */
+ bool growing_data_heap;
+ data_heap *old_data_heap;
+
+ // local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
+ std::vector<cell> gc_locals;
+ std::vector<cell> gc_bignums;
+
+ //debug
+ bool fep_disabled;
+ bool full_output;
+ cell look_for;
+ cell obj;
+
+ //math
+ cell bignum_zero;
+ cell bignum_pos_one;
+ cell bignum_neg_one;
+
+ //code_heap
+ heap code;
+ unordered_map<heap_block *,char *> forwarding;
+
+ //image
+ cell code_relocation_base;
+ cell data_relocation_base;
+
+ //dispatch
+ cell megamorphic_cache_hits;
+ cell megamorphic_cache_misses;
+
+ //inline cache
+ cell max_pic_size;
+ cell cold_call_to_ic_transitions;
+ cell ic_to_pic_transitions;
+ cell pic_to_mega_transitions;
+ cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
+};
+
+}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b6508c7560..baa67deae8 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -1,106 +1,8 @@
+#include "vm-data-dummy.hpp"
+
namespace factor
{
-struct factorvmdata {
- // if you change this struct, also change vm.factor k--------
- context *stack_chain;
- zone nursery; /* new objects are allocated here */
- cell cards_offset;
- cell decks_offset;
- cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-
- // -------------------------------
-
- // contexts
- cell ds_size, rs_size;
- context *unused_contexts;
-
- // run
- cell T; /* Canonical T object. It's just a word */
-
- // profiler
- bool profiling_p;
-
- // errors
- /* Global variables used to pass fault handler state from signal handler to
- user-space */
- cell signal_number;
- cell signal_fault_addr;
- unsigned int signal_fpu_status;
- stack_frame *signal_callstack_top;
- //data_heap
- bool secure_gc; /* Set by the -securegc command line argument */
- bool gc_off; /* GC is off during heap walking */
- data_heap *data;
- /* A heap walk allows useful things to be done, like finding all
- references to an object for debugging purposes. */
- cell heap_scan_ptr;
- //write barrier
- cell allot_markers_offset;
- //data_gc
- /* used during garbage collection only */
- zone *newspace;
- bool performing_gc;
- bool performing_compaction;
- cell collecting_gen;
- /* if true, we are 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];
- u64 cards_scanned;
- u64 decks_scanned;
- u64 card_scan_time;
- cell code_heap_scans;
- /* What generation was being collected when copy_code_heap_roots() was last
- called? Until the next call to add_code_block(), future
- collections of younger generations don't have to touch the code
- heap. */
- cell last_code_heap_scan;
- /* sometimes we grow the heap */
- bool growing_data_heap;
- data_heap *old_data_heap;
-
- // local roots
- /* If a runtime function needs to call another function which potentially
- allocates memory, it must wrap any local variable references to Factor
- objects in gc_root instances */
- std::vector<cell> gc_locals;
- std::vector<cell> gc_bignums;
-
- //debug
- bool fep_disabled;
- bool full_output;
- cell look_for;
- cell obj;
-
- //math
- cell bignum_zero;
- cell bignum_pos_one;
- cell bignum_neg_one;
-
- //code_heap
- heap code;
- unordered_map<heap_block *,char *> forwarding;
-
- //image
- cell code_relocation_base;
- cell data_relocation_base;
-
- //dispatch
- cell megamorphic_cache_hits;
- cell megamorphic_cache_misses;
-
- //inline cache
- cell max_pic_size;
- cell cold_call_to_ic_transitions;
- cell ic_to_pic_transitions;
- cell pic_to_mega_transitions;
- cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
-};
-
struct factorvm : factorvmdata {
// segments
@@ -694,6 +596,7 @@ struct factorvm : factorvmdata {
#if defined(WINNT)
void open_console();
+ LONG exception_handler(PEXCEPTION_POINTERS pe);
// next method here:
#endif
#else // UNIX
@@ -702,9 +605,11 @@ struct factorvm : factorvmdata {
#endif
+ void print_vm_data();
};
+
#define FACTOR_SINGLE_THREADED_SINGLETON
#ifdef FACTOR_SINGLE_THREADED_SINGLETON
From eee1de23c834db5ac2c02d807b5967665ed91c44 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 19:21:00 +0100
Subject: [PATCH 180/266] removed debugging
---
vm/factor.cpp | 58 ---------------------------------------------------
1 file changed, 58 deletions(-)
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 34e2267a88..7b95304887 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -235,8 +235,6 @@ void* start_standalone_factor_thread(void *arg)
VM_C_API void start_standalone_factor(int argc, vm_char **argv)
{
factorvm *newvm = new factorvm;
- newvm->print_vm_data();
- printf("PHIL YEAH: %d %d %d %d\n",(void*)(newvm),(void*)(newvm+1),sizeof(newvm), sizeof(factorvm));
vm = newvm;
register_vm_with_thread(newvm);
return newvm->start_standalone_factor(argc,argv);
@@ -249,62 +247,6 @@ VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **
return start_thread(start_standalone_factor_thread,args);
}
-
-void factorvm::print_vm_data() {
- printf("PHIL: stack_chain %d\n",&stack_chain);
- printf("PHIL: nursery %d\n",&nursery);
- printf("PHIL: cards_offset %d\n",&cards_offset);
- printf("PHIL: decks_offset %d\n",&decks_offset);
- printf("PHIL: userenv %d\n",&userenv);
- printf("PHIL: ds_size %d\n",&ds_size);
- printf("PHIL: rs_size %d\n",&rs_size);
- printf("PHIL: unused_contexts %d\n",&unused_contexts);
- printf("PHIL: T %d\n",&T);
- printf("PHIL: profiling_p %d\n",&profiling_p);
- printf("PHIL: signal_number %d\n",&signal_number);
- printf("PHIL: signal_fault_addr %d\n",&signal_fault_addr);
- printf("PHIL: signal_callstack_top %d\n",&signal_callstack_top);
- printf("PHIL: secure_gc %d\n",&secure_gc);
- printf("PHIL: gc_off %d\n",&gc_off);
- printf("PHIL: data %d\n",&data);
- printf("PHIL: heap_scan_ptr %d\n",&heap_scan_ptr);
- printf("PHIL: allot_markers_offset %d\n",&allot_markers_offset);
- printf("PHIL: newspace %d\n",&newspace);
- printf("PHIL: performing_gc %d\n",&performing_gc);
- printf("PHIL: performing_compaction %d\n",&performing_compaction);
- printf("PHIL: collecting_gen %d\n",&collecting_gen);
- printf("PHIL: collecting_aging_again %d\n",&collecting_aging_again);
- printf("PHIL: gc_jmp %d\n",&gc_jmp);
- printf("PHIL: stats %d\n",&stats);
- printf("PHIL: cards_scanned %d\n",&cards_scanned);
- printf("PHIL: decks_scanned %d\n",&decks_scanned);
- printf("PHIL: card_scan_time %d\n",&card_scan_time);
- printf("PHIL: code_heap_scans %d\n",&code_heap_scans);
- printf("PHIL: last_code_heap_scan %d\n",&last_code_heap_scan);
- printf("PHIL: growing_data_heap %d\n",&growing_data_heap);
- printf("PHIL: old_data_heap %d\n",&old_data_heap);
- printf("PHIL: gc_locals %d\n",&gc_locals);
- printf("PHIL: gc_bignums %d\n",&gc_bignums);
- printf("PHIL: fep_disabled %d\n",&fep_disabled);
- printf("PHIL: full_output %d\n",&full_output);
- printf("PHIL: look_for %d\n",&look_for);
- printf("PHIL: obj %d\n",&obj);
- printf("PHIL: bignum_zero %d\n",&bignum_zero);
- printf("PHIL: bignum_pos_one %d\n",&bignum_pos_one);
- printf("PHIL: bignum_neg_one %d\n",&bignum_neg_one);
- printf("PHIL: code %d\n",&code);
- printf("PHIL: forwarding %d\n",&forwarding);
- printf("PHIL: code_relocation_base %d\n",&code_relocation_base);
- printf("PHIL: data_relocation_base %d\n",&data_relocation_base);
- printf("PHIL: megamorphic_cache_hits %d\n",&megamorphic_cache_hits);
- printf("PHIL: megamorphic_cache_misses %d\n",&megamorphic_cache_misses);
- printf("PHIL: max_pic_size %d\n",&max_pic_size);
- printf("PHIL: cold_call_to_ic_transitions %d\n",&cold_call_to_ic_transitions);
- printf("PHIL: ic_to_pic_transitions %d\n",&ic_to_pic_transitions);
- printf("PHIL: pic_to_mega_transitions %d\n",&pic_to_mega_transitions);
- printf("PHIL: pic_counts %d\n",&pic_counts);
-}
-
// if you change this struct, also change vm.factor k--------
context *stack_chain;
zone nursery; /* new objects are allocated here */
From b02944c6d5f4e204e07b06806d80da8129149fb9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 19:23:20 +0100
Subject: [PATCH 181/266] moved signal handlers into vm object
---
vm/os-unix.cpp | 27 +++++++++++++++++++--------
vm/vm.hpp | 9 +++++----
2 files changed, 24 insertions(+), 12 deletions(-)
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 7913647f3e..3f4e1b29f7 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -147,20 +147,31 @@ stack_frame *factorvm::uap_stack_pointer(void *uap)
return NULL;
}
+
+
+void factorvm::memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ signal_fault_addr = (cell)siginfo->si_addr;
+ signal_callstack_top = uap_stack_pointer(uap);
+ UAP_PROGRAM_COUNTER(uap) = (cell)factor::memory_signal_handler_impl;
+}
+
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- factorvm *myvm = SIGNAL_VM_PTR();
- myvm->signal_fault_addr = (cell)siginfo->si_addr;
- myvm->signal_callstack_top = myvm->uap_stack_pointer(uap);
- UAP_PROGRAM_COUNTER(uap) = (cell)memory_signal_handler_impl;
+ SIGNAL_VM_PTR()->memory_signal_handler(signal,siginfo,uap);
+}
+
+
+void factorvm::misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ signal_number = signal;
+ signal_callstack_top = uap_stack_pointer(uap);
+ UAP_PROGRAM_COUNTER(uap) = (cell)factor::misc_signal_handler_impl;
}
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
- factorvm *myvm = SIGNAL_VM_PTR();
- myvm->signal_number = signal;
- myvm->signal_callstack_top = myvm->uap_stack_pointer(uap);
- UAP_PROGRAM_COUNTER(uap) = (cell)misc_signal_handler_impl;
+ SIGNAL_VM_PTR()->misc_signal_handler(signal,siginfo,uap);
}
void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index baa67deae8..efb0fa48e9 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -355,9 +355,9 @@ struct factorvm : factorvmdata {
float to_float(cell value);
void box_double(double flo);
double to_double(cell value);
- void overflow_fixnum_add(fixnum x, fixnum y);
- void overflow_fixnum_subtract(fixnum x, fixnum y);
- void overflow_fixnum_multiply(fixnum x, fixnum y);
+ inline void overflow_fixnum_add(fixnum x, fixnum y);
+ inline void overflow_fixnum_subtract(fixnum x, fixnum y);
+ inline void overflow_fixnum_multiply(fixnum x, fixnum y);
inline cell allot_integer(fixnum x);
inline cell allot_cell(cell x);
inline cell allot_float(double n);
@@ -600,7 +600,8 @@ struct factorvm : factorvmdata {
// next method here:
#endif
#else // UNIX
-
+ void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap);
+ void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap);
stack_frame *uap_stack_pointer(void *uap);
#endif
From 67ac514a3b4abf8ab3b0eb4c96744c8b40de5262 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 19:24:30 +0100
Subject: [PATCH 182/266] Added vm ptr to math overflow functions
---
vm/math.cpp | 12 ++++++------
vm/math.hpp | 6 +++---
2 files changed, 9 insertions(+), 9 deletions(-)
diff --git a/vm/math.cpp b/vm/math.cpp
index 40a0c20a3b..fbb946e19f 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -836,29 +836,29 @@ VM_C_API double to_double(cell value,factorvm *myvm)
/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
overflow, they call these functions. */
-void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
+inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
{
drepl(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) + untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
{
return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
}
-void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
+inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
{
drepl(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) - untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
{
return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
}
-void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
+inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
{
bignum *bx = fixnum_to_bignum(x);
GC_BIGNUM(bx,this);
@@ -867,7 +867,7 @@ void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
drepl(tag<bignum>(bignum_multiply(bx,by)));
}
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
{
return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
}
diff --git a/vm/math.hpp b/vm/math.hpp
index b45284f693..5183f85f45 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -83,8 +83,8 @@ VM_C_API u64 to_unsigned_8(cell obj, factorvm *vm);
VM_C_API fixnum to_fixnum(cell tagged, factorvm *vm);
VM_C_API cell to_cell(cell tagged, factorvm *vm);
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y);
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y);
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y);
+VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factorvm *vm);
+VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *vm);
+VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *vm);
}
From 34ce33431784af6395f55264517cc06b54dc62a4 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 19:25:22 +0100
Subject: [PATCH 183/266] Added data constructor to initialize bools in
factorvmdata struct
---
vm/vm-data.hpp | 13 +++++++++++++
vm/vm.hpp | 2 +-
2 files changed, 14 insertions(+), 1 deletion(-)
diff --git a/vm/vm-data.hpp b/vm/vm-data.hpp
index 701e35da9d..de5cf36632 100644
--- a/vm/vm-data.hpp
+++ b/vm/vm-data.hpp
@@ -100,6 +100,19 @@ struct factorvmdata {
cell ic_to_pic_transitions;
cell pic_to_mega_transitions;
cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
+
+ factorvmdata()
+ : profiling_p(false),
+ secure_gc(false),
+ gc_off(false),
+ performing_gc(false),
+ performing_compaction(false),
+ collecting_aging_again(false),
+ growing_data_heap(false),
+ fep_disabled(false),
+ full_output(false)
+ {}
+
};
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index efb0fa48e9..a199885f49 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -1,4 +1,4 @@
-#include "vm-data-dummy.hpp"
+#include "vm-data.hpp"
namespace factor
{
From 3ecff2c0ebb6705b5aba0cfaf29a63bb049a794a Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 19:52:05 +0100
Subject: [PATCH 184/266] fixed bug where vm_char being treated as 1byte type
---
vm/os-windows.cpp | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp
index 38c8b944a4..bd7e573dcc 100644
--- a/vm/os-windows.cpp
+++ b/vm/os-windows.cpp
@@ -60,7 +60,7 @@ bool factorvm::windows_stat(vm_char *path)
void factorvm::windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
{
snwprintf(temp_path, length-1, L"%s.image", full_path);
- temp_path[sizeof(temp_path) - 1] = 0;
+ temp_path[length - 1] = 0;
}
/* You must free() this yourself. */
@@ -76,8 +76,8 @@ const vm_char *factorvm::default_image_path()
if((ptr = wcsrchr(full_path, '.')))
*ptr = 0;
- snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
- temp_path[sizeof(temp_path) - 1] = 0;
+ snwprintf(temp_path, MAX_UNICODE_PATH-1, L"%s.image", full_path);
+ temp_path[MAX_UNICODE_PATH - 1] = 0;
return safe_strdup(temp_path);
}
From deb7af70bb42bdf3bf9837d1f7232671b8d41a70 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 20:13:44 +0100
Subject: [PATCH 185/266] asm math functions pass vm ptr to overflow function
in 3rd arg (X86.32)
---
vm/cpu-ppc.hpp | 1 +
vm/cpu-x86.32.S | 1 +
vm/cpu-x86.32.hpp | 1 +
vm/cpu-x86.64.hpp | 2 +-
vm/cpu-x86.S | 10 +++++++---
vm/math.cpp | 6 +++---
vm/math.hpp | 6 +++---
vm/vm.hpp | 6 +++---
8 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp
index 495eb375ec..d0036fb84f 100644
--- a/vm/cpu-ppc.hpp
+++ b/vm/cpu-ppc.hpp
@@ -3,6 +3,7 @@ namespace factor
#define FACTOR_CPU_STRING "ppc"
#define VM_ASM_API VM_C_API
+#define VM_ASM_API_OVERFLOW VM_C_API
register cell ds asm("r13");
register cell rs asm("r14");
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 326ddb6eb8..1618171b5b 100644
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -2,6 +2,7 @@
#define ARG0 %eax
#define ARG1 %edx
+#define ARG2 %ecx
#define STACK_REG %esp
#define DS_REG %esi
#define RETURN_REG %eax
diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp
index 351865f776..a95179a49b 100644
--- a/vm/cpu-x86.32.hpp
+++ b/vm/cpu-x86.32.hpp
@@ -7,4 +7,5 @@ register cell ds asm("esi");
register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
+#define VM_ASM_API_OVERFLOW VM_C_API __attribute__ ((regparm (3)))
}
diff --git a/vm/cpu-x86.64.hpp b/vm/cpu-x86.64.hpp
index 679c301548..841705c171 100644
--- a/vm/cpu-x86.64.hpp
+++ b/vm/cpu-x86.64.hpp
@@ -7,5 +7,5 @@ register cell ds asm("r14");
register cell rs asm("r15");
#define VM_ASM_API VM_C_API
-
+#define VM_ASM_API_OVERFLOW VM_C_API
}
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index 2599ba3f97..a18d1483fb 100644
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -1,4 +1,5 @@
-DEF(void,primitive_fixnum_add,(void)):
+DEF(void,primitive_fixnum_add,(void *myvm)):
+ mov ARG0, ARG2 /* save vm ptr for overflow */
mov (DS_REG),ARG0
mov -CELL_SIZE(DS_REG),ARG1
sub $CELL_SIZE,DS_REG
@@ -8,7 +9,8 @@ DEF(void,primitive_fixnum_add,(void)):
mov ARITH_TEMP_1,(DS_REG)
ret
-DEF(void,primitive_fixnum_subtract,(void)):
+DEF(void,primitive_fixnum_subtract,(void *myvm)):
+ mov ARG0, ARG2 /* save vm ptr for overflow */
mov (DS_REG),ARG1
mov -CELL_SIZE(DS_REG),ARG0
sub $CELL_SIZE,DS_REG
@@ -18,7 +20,8 @@ DEF(void,primitive_fixnum_subtract,(void)):
mov ARITH_TEMP_1,(DS_REG)
ret
-DEF(void,primitive_fixnum_multiply,(void)):
+DEF(void,primitive_fixnum_multiply,(void *myvm)):
+ mov ARG0, ARG2 /* save vm ptr for overflow */
mov (DS_REG),ARITH_TEMP_1
mov ARITH_TEMP_1,DIV_RESULT
mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
@@ -28,6 +31,7 @@ DEF(void,primitive_fixnum_multiply,(void)):
jo multiply_overflow
mov DIV_RESULT,(DS_REG)
ret
+
multiply_overflow:
sar $3,ARITH_TEMP_1
mov ARITH_TEMP_1,ARG0
diff --git a/vm/math.cpp b/vm/math.cpp
index fbb946e19f..be285872f5 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -842,7 +842,7 @@ inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
untag_fixnum(x) + untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
+VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
{
return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
}
@@ -853,7 +853,7 @@ inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
untag_fixnum(x) - untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
+VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
{
return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
}
@@ -867,7 +867,7 @@ inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
drepl(tag<bignum>(bignum_multiply(bx,by)));
}
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
+VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
{
return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
}
diff --git a/vm/math.hpp b/vm/math.hpp
index 5183f85f45..5e6121afb2 100644
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -83,8 +83,8 @@ VM_C_API u64 to_unsigned_8(cell obj, factorvm *vm);
VM_C_API fixnum to_fixnum(cell tagged, factorvm *vm);
VM_C_API cell to_cell(cell tagged, factorvm *vm);
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factorvm *vm);
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *vm);
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *vm);
+VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *vm);
+VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *vm);
+VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *vm);
}
diff --git a/vm/vm.hpp b/vm/vm.hpp
index a199885f49..3c0f4a246b 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -626,10 +626,10 @@ struct factorvm : factorvmdata {
#ifdef FACTOR_SINGLE_THREADED_TESTING
/* calls are dispatched as per multithreaded, but checked against singleton */
extern factorvm *vm;
- #define PRIMITIVE_GETVM() ((factorvm*)myvm)
- #define PRIMITIVE_OVERFLOW_GETVM() vm
- #define VM_PTR myvm
#define ASSERTVM() assert(vm==myvm)
+ #define PRIMITIVE_GETVM() ((factorvm*)myvm)
+ #define PRIMITIVE_OVERFLOW_GETVM() ASSERTVM(); myvm
+ #define VM_PTR myvm
#define SIGNAL_VM_PTR() tls_vm()
#endif
From 3343723ee3277fa2028678f73bc04253ba351128 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 20:37:23 +0100
Subject: [PATCH 186/266] Don't return functions returning void. -O3 seems to
optimize them out!
---
vm/data_gc.cpp | 2 +-
vm/math.cpp | 7 ++++---
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index c6cdd39853..c192d5714e 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -708,7 +708,7 @@ void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factorvm *myvm)
{
ASSERTVM();
- return VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
+ VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
}
}
diff --git a/vm/math.cpp b/vm/math.cpp
index be285872f5..4b595f85a3 100755
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -831,6 +831,7 @@ double factorvm::to_double(cell value)
VM_C_API double to_double(cell value,factorvm *myvm)
{
+ ASSERTVM();
return VM_PTR->to_double(value);
}
@@ -844,7 +845,7 @@ inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
{
- return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
+ PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
}
inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
@@ -855,7 +856,7 @@ inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
{
- return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
+ PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
}
inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
@@ -869,7 +870,7 @@ inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
{
- return PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
+ PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
}
}
From 480a15c2c3934bc9efbf29bdc7132df69a8de899 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Fri, 4 Sep 2009 21:11:13 +0100
Subject: [PATCH 187/266] Added vm passing to inline_cache_miss x86.32 asm
---
vm/cpu-x86.32.S | 7 ++++---
vm/inline_cache.cpp | 5 +++--
vm/inline_cache.hpp | 2 +-
3 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 1618171b5b..a486fed29d 100644
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -49,13 +49,14 @@ DEF(long long,read_timestamp_counter,(void)):
rdtsc
ret
-DEF(void,primitive_inline_cache_miss,(void)):
+DEF(void,primitive_inline_cache_miss,(void *vm)):
mov (%esp),%ebx
-DEF(void,primitive_inline_cache_miss_tail,(void)):
+DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
sub $8,%esp
+ push %eax /* push vm ptr */
push %ebx
call MANGLE(inline_cache_miss)
- add $12,%esp
+ add $16,%esp
jmp *%eax
DEF(void,get_sse_env,(void*)):
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index 35479c29f5..4c77a83a93 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -245,9 +245,10 @@ void *factorvm::inline_cache_miss(cell return_address)
return xt;
}
-VM_C_API void *inline_cache_miss(cell return_address)
+VM_C_API void *inline_cache_miss(cell return_address, factorvm *myvm)
{
- return vm->inline_cache_miss(return_address);
+ ASSERTVM();
+ return VM_PTR->inline_cache_miss(return_address);
}
diff --git a/vm/inline_cache.hpp b/vm/inline_cache.hpp
index 5b1bbdf516..02ac43dce8 100644
--- a/vm/inline_cache.hpp
+++ b/vm/inline_cache.hpp
@@ -5,6 +5,6 @@ PRIMITIVE(inline_cache_stats);
PRIMITIVE(inline_cache_miss);
PRIMITIVE(inline_cache_miss_tail);
-VM_C_API void *inline_cache_miss(cell return_address);
+VM_C_API void *inline_cache_miss(cell return_address, factorvm *vm);
}
From 8a65f35c3175660fa84d402c0326f34c35737184 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 7 Sep 2009 07:15:10 +0100
Subject: [PATCH 188/266] vm passed in primitives as arg0 for x86.64
---
basis/cpu/x86/64/bootstrap.factor | 6 +++---
vm/cpu-x86.64.S | 5 +++--
2 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
index 28309e7d97..aa7a5dcd67 100644
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/basis/cpu/x86/64/bootstrap.factor
@@ -21,9 +21,7 @@ IN: bootstrap.x86
: rex-length ( -- n ) 1 ;
[
- ! HACK: stash vm pointer above the ds stack
- temp0 0 MOV rc-absolute-cell rt-vm jit-rel
- ds-reg bootstrap-cell [+] temp0 MOV
+
! load stack_chain
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
temp0 temp0 [] MOV
@@ -31,6 +29,8 @@ IN: bootstrap.x86
temp0 [] stack-reg MOV
! load XT
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
+ ! load vm ptr
+ arg 0 MOV rc-absolute-cell rt-vm jit-rel
! go
temp1 JMP
] jit-primitive jit-define
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 4d5c70616f..704cebe804 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -79,10 +79,11 @@ DEF(long long,read_timestamp_counter,(void)):
or %rdx,%rax
ret
-DEF(void,primitive_inline_cache_miss,(void)):
+DEF(void,primitive_inline_cache_miss,(void *vm)):
mov (%rsp),%rbx
-DEF(void,primitive_inline_cache_miss_tail,(void)):
+DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
sub $STACK_PADDING,%rsp
+ mov ARG0,ARG1
mov %rbx,ARG0
call MANGLE(inline_cache_miss)
add $STACK_PADDING,%rsp
From c7b7517f36dbcdf2db47de04c685e87273775944 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 7 Sep 2009 07:23:29 +0100
Subject: [PATCH 189/266] small x86 asm cleanup
---
basis/cpu/x86/32/bootstrap.factor | 2 +-
vm/cpu-x86.32.S | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index afa7c245a0..e2096987da 100644
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -29,7 +29,7 @@ IN: bootstrap.x86
! save stack pointer
temp0 [] stack-reg MOV
! pass vm ptr to primitive
- EAX 0 MOV rc-absolute-cell rt-vm jit-rel
+ arg 0 MOV rc-absolute-cell rt-vm jit-rel
! call the primitive
0 JMP rc-relative rt-primitive jit-rel
] jit-primitive jit-define
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index a486fed29d..042924ca4f 100644
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -53,7 +53,7 @@ DEF(void,primitive_inline_cache_miss,(void *vm)):
mov (%esp),%ebx
DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
sub $8,%esp
- push %eax /* push vm ptr */
+ push ARG0 /* push vm ptr */
push %ebx
call MANGLE(inline_cache_miss)
add $16,%esp
From 617a7cbd6561c08f2c778c7fbac9e04fd748fc46 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 7 Sep 2009 07:41:11 +0100
Subject: [PATCH 190/266] Added more init code to vm constructor.
Also removed dummy variables file as have fixed that problem now
---
vm/factor.cpp | 98 ------------------------------------
vm/vm-data-dummy.hpp | 116 -------------------------------------------
vm/vm-data.hpp | 7 ++-
3 files changed, 5 insertions(+), 216 deletions(-)
delete mode 100644 vm/vm-data-dummy.hpp
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 7b95304887..4ef4d11796 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -247,102 +247,4 @@ VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **
return start_thread(start_standalone_factor_thread,args);
}
- // if you change this struct, also change vm.factor k--------
- context *stack_chain;
- zone nursery; /* new objects are allocated here */
- cell cards_offset;
- cell decks_offset;
- cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-
- // -------------------------------
-
- // contexts
- cell ds_size, rs_size;
- context *unused_contexts;
-
- // run
- cell T; /* Canonical T object. It's just a word */
-
- // profiler
- bool profiling_p;
-
- // errors
- /* Global variables used to pass fault handler state from signal handler to
- user-space */
- cell signal_number;
- cell signal_fault_addr;
- unsigned int signal_fpu_status;
- stack_frame *signal_callstack_top;
-
- //data_heap
- bool secure_gc; /* Set by the -securegc command line argument */
- bool gc_off; /* GC is off during heap walking */
- data_heap *data;
- /* A heap walk allows useful things to be done, like finding all
- references to an object for debugging purposes. */
- cell heap_scan_ptr;
- //write barrier
- cell allot_markers_offset;
- //data_gc
- /* used during garbage collection only */
- zone *newspace;
- bool performing_gc;
- bool performing_compaction;
- cell collecting_gen;
- /* if true, we are 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];
- u64 cards_scanned;
- u64 decks_scanned;
- u64 card_scan_time;
- cell code_heap_scans;
- /* What generation was being collected when copy_code_heap_roots() was last
- called? Until the next call to add_code_block(), future
- collections of younger generations don't have to touch the code
- heap. */
- cell last_code_heap_scan;
- /* sometimes we grow the heap */
- bool growing_data_heap;
- data_heap *old_data_heap;
-
- // local roots
- /* If a runtime function needs to call another function which potentially
- allocates memory, it must wrap any local variable references to Factor
- objects in gc_root instances */
- std::vector<cell> gc_locals;
- std::vector<cell> gc_bignums;
-
- //debug
- bool fep_disabled;
- bool full_output;
- cell look_for;
- cell obj;
-
- //math
- cell bignum_zero;
- cell bignum_pos_one;
- cell bignum_neg_one;
-
- //code_heap
- heap code;
- unordered_map<heap_block *,char *> forwarding;
-
- //image
- cell code_relocation_base;
- cell data_relocation_base;
-
- //dispatch
- cell megamorphic_cache_hits;
- cell megamorphic_cache_misses;
-
- //inline cache
- cell max_pic_size;
- cell cold_call_to_ic_transitions;
- cell ic_to_pic_transitions;
- cell pic_to_mega_transitions;
- cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
}
diff --git a/vm/vm-data-dummy.hpp b/vm/vm-data-dummy.hpp
deleted file mode 100644
index c028a61503..0000000000
--- a/vm/vm-data-dummy.hpp
+++ /dev/null
@@ -1,116 +0,0 @@
-namespace factor
-{
-
- // if you change this struct, also change vm.factor k--------
- extern "C" context *stack_chain;
- extern "C" zone nursery; /* new objects are allocated here */
- extern "C" cell cards_offset;
- extern "C" cell decks_offset;
-//extern "C" cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-
- // -------------------------------
-
- // contexts
- extern "C" cell ds_size, rs_size;
- extern "C" context *unused_contexts;
-
-
- // profiler
- extern "C" bool profiling_p;
-
- // errors
- /* Global variables used to pass fault handler state from signal handler to
- user-space */
- extern "C" cell signal_number;
- extern "C" cell signal_fault_addr;
- extern "C" unsigned int signal_fpu_status;
- extern "C" stack_frame *signal_callstack_top;
-
- //data_heap
- extern "C" bool secure_gc; /* Set by the -securegc command line argument */
- extern "C" bool gc_off; /* GC is off during heap walking */
- extern "C" data_heap *data;
- /* A heap walk allows useful things to be done, like finding all
- references to an object for debugging purposes. */
- extern "C" cell heap_scan_ptr;
- //write barrier
- extern "C" cell allot_markers_offset;
- //data_gc
- /* used during garbage collection only */
- extern "C" zone *newspace;
- extern "C" bool performing_gc;
- extern "C" bool performing_compaction;
- extern "C" cell collecting_gen;
- /* if true, we are collecting aging space for the second time, so if it is still
- full, we go on to collect tenured */
- extern "C" 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. */
- extern "C" jmp_buf gc_jmp;
- extern "C" gc_stats stats[max_gen_count];
- extern "C" u64 cards_scanned;
- extern "C" u64 decks_scanned;
- extern "C" u64 card_scan_time;
- extern "C" cell code_heap_scans;
- /* What generation was being collected when copy_code_heap_roots() was last
- called? Until the next call to add_code_block(), future
- collections of younger generations don't have to touch the code
- heap. */
- extern "C" cell last_code_heap_scan;
- /* sometimes we grow the heap */
- extern "C" bool growing_data_heap;
- extern "C" data_heap *old_data_heap;
-
- // local roots
- /* If a runtime function needs to call another function which potentially
- allocates memory, it must wrap any local variable references to Factor
- objects in gc_root instances */
- //extern "C" segment *gc_locals_region;
- //extern "C" cell gc_locals;
- //extern "C" segment *gc_bignums_region;
- //extern "C" cell gc_bignums;
-
- //debug
- extern "C" bool fep_disabled;
- extern "C" bool full_output;
- extern "C" cell look_for;
- extern "C" cell obj;
-
- //math
- extern "C" cell bignum_zero;
- extern "C" cell bignum_pos_one;
- extern "C" cell bignum_neg_one;
-
- //code_heap
- extern "C" heap code;
- extern "C" unordered_map<heap_block *,char *> forwarding;
-
- //image
- extern "C" cell code_relocation_base;
- extern "C" cell data_relocation_base;
-
- //dispatch
- extern "C" cell megamorphic_cache_hits;
- extern "C" cell megamorphic_cache_misses;
-
- //inline cache
- extern "C" cell max_pic_size;
- extern "C" cell cold_call_to_ic_transitions;
- extern "C" cell ic_to_pic_transitions;
- extern "C" cell pic_to_mega_transitions;
- extern "C" cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
-
-struct factorvmdata {
- cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-
- // run
- cell T; /* Canonical T object. It's just a word */
-
- // local roots
- /* If a runtime function needs to call another function which potentially
- allocates memory, it must wrap any local variable references to Factor
- objects in gc_root instances */
- std::vector<cell> gc_locals;
- std::vector<cell> gc_bignums;
-};
-}
diff --git a/vm/vm-data.hpp b/vm/vm-data.hpp
index de5cf36632..f5ecdc5f62 100644
--- a/vm/vm-data.hpp
+++ b/vm/vm-data.hpp
@@ -110,8 +110,11 @@ struct factorvmdata {
collecting_aging_again(false),
growing_data_heap(false),
fep_disabled(false),
- full_output(false)
- {}
+ full_output(false),
+ max_pic_size(0)
+ {
+ memset(this,0,sizeof(this)); // just to make sure
+ }
};
From a8d1e5187d98cf5d0e776415ae16e73a5475fbc9 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 7 Sep 2009 08:18:41 +0100
Subject: [PATCH 191/266] Added -DREENTRANT option to Makefile
Also renamed FACTOR_MULTITHREADED to FACTOR_REENTRANT
---
Makefile | 4 ++++
vm/vm.hpp | 9 +++++----
2 files changed, 9 insertions(+), 4 deletions(-)
diff --git a/Makefile b/Makefile
index bfaa6ec7a3..10efe34d34 100755
--- a/Makefile
+++ b/Makefile
@@ -18,6 +18,10 @@ else
CFLAGS += -O3
endif
+ifdef REENTRANT
+ CFLAGS += -DFACTOR_REENTRANT
+endif
+
CFLAGS += $(SITE_CFLAGS)
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 3c0f4a246b..e4cd633fb1 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -610,8 +610,9 @@ struct factorvm : factorvmdata {
};
-
-#define FACTOR_SINGLE_THREADED_SINGLETON
+#ifndef FACTOR_REENTRANT
+ #define FACTOR_SINGLE_THREADED_SINGLETON
+#endif
#ifdef FACTOR_SINGLE_THREADED_SINGLETON
/* calls are dispatched using the singleton vm ptr */
@@ -633,7 +634,7 @@ struct factorvm : factorvmdata {
#define SIGNAL_VM_PTR() tls_vm()
#endif
-#ifdef FACTOR_MULTITHREADED_TLS
+#ifdef FACTOR_REENTRANT_TLS
/* uses thread local storage to obtain vm ptr */
#define PRIMITIVE_GETVM() tls_vm()
#define PRIMITIVE_OVERFLOW_GETVM() tls_vm()
@@ -642,7 +643,7 @@ struct factorvm : factorvmdata {
#define SIGNAL_VM_PTR() tls_vm()
#endif
-#ifdef FACTOR_MULTITHREADED
+#ifdef FACTOR_REENTRANT
#define PRIMITIVE_GETVM() ((factorvm*)myvm)
#define PRIMITIVE_OVERFLOW_GETVM() ((factorvm*)myvm)
#define VM_PTR myvm
From 8049b441c2ccdc1571ea7cbc134d3865c008816d Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 7 Sep 2009 18:20:43 +0100
Subject: [PATCH 192/266] imul clobbers arg2 on x86.64, so stashing vm ptr on
the stack
---
vm/cpu-x86.S | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index a18d1483fb..5360d6c227 100644
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -21,7 +21,7 @@ DEF(void,primitive_fixnum_subtract,(void *myvm)):
ret
DEF(void,primitive_fixnum_multiply,(void *myvm)):
- mov ARG0, ARG2 /* save vm ptr for overflow */
+ push ARG0 /* save vm ptr for overflow */
mov (DS_REG),ARITH_TEMP_1
mov ARITH_TEMP_1,DIV_RESULT
mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
@@ -30,14 +30,16 @@ DEF(void,primitive_fixnum_multiply,(void *myvm)):
imul ARITH_TEMP_2
jo multiply_overflow
mov DIV_RESULT,(DS_REG)
+ pop ARG2
ret
-
multiply_overflow:
sar $3,ARITH_TEMP_1
mov ARITH_TEMP_1,ARG0
mov ARITH_TEMP_2,ARG1
+ pop ARG2
jmp MANGLE(overflow_fixnum_multiply)
+
DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
PUSH_NONVOLATILE
mov ARG0,NV_TEMP_REG
From 2cf2dab48e26431772b615e252bcc17034b6a390 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Sun, 13 Sep 2009 21:50:20 +0100
Subject: [PATCH 193/266] fpe signals working on unix again
---
vm/os-unix.cpp | 17 +++++++++++------
vm/vm.hpp | 1 +
2 files changed, 12 insertions(+), 6 deletions(-)
diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
index 3f4e1b29f7..65b32066e5 100644
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -174,16 +174,21 @@ void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
SIGNAL_VM_PTR()->misc_signal_handler(signal,siginfo,uap);
}
-void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+void factorvm::fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
signal_number = signal;
signal_callstack_top = uap_stack_pointer(uap);
- signal_fpu_status = fpu_status(uap_fpu_status(uap));
- uap_clear_fpu_status(uap);
+ signal_fpu_status = fpu_status(uap_fpu_status(uap));
+ uap_clear_fpu_status(uap);
UAP_PROGRAM_COUNTER(uap) =
- (siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF)
- ? (cell)misc_signal_handler_impl
- : (cell)fp_signal_handler_impl;
+ (siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF)
+ ? (cell)factor::misc_signal_handler_impl
+ : (cell)factor::fp_signal_handler_impl;
+}
+
+void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ SIGNAL_VM_PTR()->fpe_signal_handler(signal, siginfo, uap);
}
static void sigaction_safe(int signum, const struct sigaction *act, struct sigaction *oldact)
diff --git a/vm/vm.hpp b/vm/vm.hpp
index e4cd633fb1..b426ff67d8 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -602,6 +602,7 @@ struct factorvm : factorvmdata {
#else // UNIX
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap);
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap);
+ void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap);
stack_frame *uap_stack_pointer(void *uap);
#endif
From d2afb4b3442c074f8959b1f59b7f32c83e910254 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Mon, 14 Sep 2009 08:00:28 +0100
Subject: [PATCH 194/266] put mach call_fault_handler in the vm
---
vm/mach_signal.cpp | 31 ++++++++++++++++++++-----------
vm/vm.hpp | 4 ++++
2 files changed, 24 insertions(+), 11 deletions(-)
diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
index 03a6ca2b72..08b0d00f1c 100644
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -28,7 +28,7 @@ http://www.wodeveloper.com/omniLists/macosx-dev/2000/June/msg00137.html */
/* Modify a suspended thread's thread_state so that when the thread resumes
executing, the call frame of the current C primitive (if any) is rewound, and
the appropriate Factor error is thrown from the top-most Factor frame. */
-static void call_fault_handler(
+void factorvm::call_fault_handler(
exception_type_t exception,
exception_data_type_t code,
MACH_EXC_STATE_TYPE *exc_state,
@@ -41,33 +41,42 @@ static void call_fault_handler(
a divide by zero or stack underflow in the listener */
/* Are we in compiled Factor code? Then use the current stack pointer */
- if(SIGNAL_VM_PTR()->in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
- SIGNAL_VM_PTR()->signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
+ if(in_code_heap_p(MACH_PROGRAM_COUNTER(thread_state)))
+ signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
/* Are we in C? Then use the saved callstack top */
else
- SIGNAL_VM_PTR()->signal_callstack_top = NULL;
+ signal_callstack_top = NULL;
MACH_STACK_POINTER(thread_state) = fix_stack_pointer(MACH_STACK_POINTER(thread_state));
/* Now we point the program counter at the right handler function. */
if(exception == EXC_BAD_ACCESS)
{
- SIGNAL_VM_PTR()->signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
- MACH_PROGRAM_COUNTER(thread_state) = (cell)memory_signal_handler_impl;
+ signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
+ MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::memory_signal_handler_impl;
}
else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV)
{
- signal_fpu_status = fpu_status(mach_fpu_status(float_state));
- mach_clear_fpu_status(float_state);
- MACH_PROGRAM_COUNTER(thread_state) = (cell)fp_signal_handler_impl;
+ signal_fpu_status = fpu_status(mach_fpu_status(float_state));
+ mach_clear_fpu_status(float_state);
+ MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::fp_signal_handler_impl;
}
else
{
- SIGNAL_VM_PTR()->signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
- MACH_PROGRAM_COUNTER(thread_state) = (cell)misc_signal_handler_impl;
+ signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
+ MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::misc_signal_handler_impl;
}
}
+static void call_fault_handler(exception_type_t exception,
+ exception_data_type_t code,
+ MACH_EXC_STATE_TYPE *exc_state,
+ MACH_THREAD_STATE_TYPE *thread_state,
+ MACH_FLOAT_STATE_TYPE *float_state)
+{
+ SIGNAL_VM_PTR()->call_fault_handler(exception,code,exc_state,thread_state,float_state);
+}
+
/* Handle an exception by invoking the user's fault handler and/or forwarding
the duty to the previously installed handlers. */
extern "C"
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b426ff67d8..76a2adb9c6 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -607,6 +607,10 @@ struct factorvm : factorvmdata {
#endif
+ #ifdef __APPLE__
+ void call_fault_handler(exception_type_t exception, exception_data_type_t code, MACH_EXC_STATE_TYPE *exc_state, MACH_THREAD_STATE_TYPE *thread_state, MACH_FLOAT_STATE_TYPE *float_state);
+ #endif
+
void print_vm_data();
};
From 01d2ef415ac71210614ea6fff0d032edef67d59b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 09:20:47 -0500
Subject: [PATCH 195/266] get compiler tests loading
---
basis/classes/struct/struct.factor | 2 +-
basis/compiler/tests/alien.factor | 1 +
basis/compiler/tests/codegen.factor | 3 ++-
basis/compiler/tests/intrinsics.factor | 1 +
basis/compiler/tree/cleanup/cleanup-tests.factor | 1 +
basis/compiler/tree/propagation/propagation-tests.factor | 1 +
basis/cpu/x86/64/unix/unix.factor | 2 +-
7 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index a96a74d2ac..dabdead10c 100755
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -126,7 +126,7 @@ M: struct-c-type c-type ;
M: struct-c-type c-type-stack-align? drop f ;
: if-value-struct ( ctype true false -- )
- [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
+ [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
M: struct-c-type unbox-parameter
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 484b1f4f2f..e21e13dc13 100755
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -5,6 +5,7 @@ io.streams.string kernel math memory namespaces
namespaces.private parser quotations sequences
specialized-arrays stack-checker stack-checker.errors
system threads tools.test words ;
+FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char
IN: compiler.tests.alien
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index fcbac30444..56e368e320 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -4,6 +4,7 @@ namespaces.private slots.private sequences.private byte-arrays alien
alien.accessors layouts words definitions compiler.units io
combinators vectors grouping make alien.c-types combinators.short-circuit
math.order math.libm math.parser ;
+FROM: math => float ;
QUALIFIED: namespaces.private
IN: compiler.tests.codegen
@@ -414,4 +415,4 @@ cell 4 = [
[ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
[ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
-[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
\ No newline at end of file
+[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index ad2d2c8be5..dc2f5d9257 100644
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -5,6 +5,7 @@ hashtables.private byte-arrays system random layouts vectors
sbufs strings.private slots.private alien math.order
alien.accessors alien.c-types alien.syntax alien.strings
namespaces libc io.encodings.ascii classes compiler ;
+FROM: math => float ;
IN: compiler.tests.intrinsics
! Make sure that intrinsic ops compile to correct code.
diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index faf6968670..02e7409c24 100755
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -16,6 +16,7 @@ compiler.tree.propagation
compiler.tree.propagation.info
compiler.tree.checker
compiler.tree.debugger ;
+FROM: math => float ;
IN: compiler.tree.cleanup.tests
[ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 0c220542ca..0da234791b 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -10,6 +10,7 @@ compiler.tree.debugger compiler.tree.checker
slots.private words hashtables classes assocs locals
specialized-arrays system sorting math.libm
math.intervals quotations effects alien ;
+FROM: math => float ;
SPECIALIZED-ARRAY: double
IN: compiler.tree.propagation.tests
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 2f8a01f0fe..13e91a87a4 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -34,7 +34,7 @@ stack-params \ (stack-value) c-type (>>rep) >>
: flatten-small-struct ( c-type -- seq )
struct-types&offset split-struct [
[ c-type c-type-rep reg-class-of ] map
- int-regs swap member? "void*" "double" ? c-type
+ int-regs swap member? void* double ? c-type
] map ;
: flatten-large-struct ( c-type -- seq )
From 21c09ab97ad2b4cf5c18e3c29eef6f4e3fe76605 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 09:56:07 -0500
Subject: [PATCH 196/266] fix struct class see
---
basis/classes/struct/prettyprint/prettyprint.factor | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor
index 2c969531e8..7f57e8568a 100644
--- a/basis/classes/struct/prettyprint/prettyprint.factor
+++ b/basis/classes/struct/prettyprint/prettyprint.factor
@@ -1,9 +1,9 @@
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types arrays assocs classes
-classes.struct combinators combinators.short-circuit continuations
-fry kernel libc make math math.parser mirrors prettyprint.backend
-prettyprint.custom prettyprint.sections see.private sequences
-slots strings summary words ;
+USING: accessors alien alien.c-types alien.prettyprint arrays
+assocs classes classes.struct combinators combinators.short-circuit
+continuations fry kernel libc make math math.parser mirrors
+prettyprint.backend prettyprint.custom prettyprint.sections
+see.private sequences slots strings summary words ;
IN: classes.struct.prettyprint
<PRIVATE
@@ -20,7 +20,7 @@ IN: classes.struct.prettyprint
<flow \ { pprint-word
f <inset {
[ name>> text ]
- [ type>> dup string? [ text ] [ pprint* ] if ]
+ [ type>> pprint-c-type ]
[ read-only>> [ \ read-only pprint-word ] when ]
[ initial>> [ \ initial: pprint-word pprint* ] when* ]
} cleave block>
From b403ba5c1755dda9682d3ba7d696cd4d9879a6c0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 10:24:03 -0500
Subject: [PATCH 197/266] fix FUNCTION: prettyprint when function has no
arguments
---
basis/alien/prettyprint/prettyprint.factor | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 096a5547c5..4586c08542 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -36,9 +36,11 @@ M: typedef-word synopsis*
[ pprint-c-type ] [ text ] bi* ;
: pprint-function-args ( word -- )
- [ def>> fourth ] [ stack-effect in>> ] bi zip unclip-last
- [ [ first2 "," append pprint-function-arg ] each ] dip
- first2 pprint-function-arg ;
+ [ def>> fourth ] [ stack-effect in>> ] bi zip [ ] [
+ unclip-last
+ [ [ first2 "," append pprint-function-arg ] each ] dip
+ first2 pprint-function-arg
+ ] if-empty ;
M: alien-function-word definer
drop \ FUNCTION: \ ; ;
From fc5500a0dcfad986222f41085f151f92802763c5 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 13:11:53 -0500
Subject: [PATCH 198/266] oops... word c-types can be structs too
---
basis/alien/c-types/c-types.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 7dc00333b8..f147810cd2 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -94,7 +94,7 @@ GENERIC: c-struct? ( type -- ? )
M: object c-struct?
drop f ;
-M: string c-struct?
+M: c-type-name c-struct?
dup void? [ drop f ] [ c-type c-struct? ] if ;
! These words being foldable means that words need to be
@@ -123,7 +123,7 @@ M: c-type-name <c-array>
GENERIC: (c-array) ( len c-type -- array )
-M: string (c-array)
+M: c-type-name (c-array)
c-(array)-constructor execute( len -- array ) ; inline
GENERIC: <c-direct-array> ( alien len c-type -- array )
From 123a962596345e2c29b297010fcdf8753fa36cdc Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 13:42:40 -0500
Subject: [PATCH 199/266] fix button background (from Keith Lazuka
<klazuka@gmail.com>)
---
basis/ui/gadgets/buttons/buttons.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index 26cbafc0d5..fb6f8153e9 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -119,7 +119,7 @@ PRIVATE>
[ append theme-image ] tri-curry@ tri
] 2dip <tile-pen> ;
-CONSTANT: button-background COLOR: FactorLightTan
+CONSTANT: button-background COLOR: FactorTan
CONSTANT: button-clicked-background COLOR: FactorDarkSlateBlue
: <border-button-pen> ( -- pen )
From e70c063e61a65be2e208ed2db7d313cbb6201bd8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 14:17:13 -0500
Subject: [PATCH 200/266] fix alien-function-word predicate
---
basis/alien/parser/parser.factor | 11 +++++++----
1 file changed, 7 insertions(+), 4 deletions(-)
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 662139810e..ab09383d7c 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays assocs
-combinators effects grouping kernel parser sequences
-splitting words fry locals lexer namespaces summary
-math vocabs.parser ;
+combinators combinators.short-circuit effects grouping
+kernel parser sequences splitting words fry locals lexer
+namespaces summary math vocabs.parser ;
IN: alien.parser
: parse-c-type-name ( name -- word/string )
@@ -58,4 +58,7 @@ IN: alien.parser
make-function define-declared ;
PREDICATE: alien-function-word < word
- def>> [ length 5 = ] [ last \ alien-invoke eq? ] bi and ;
+ def>> {
+ [ length 5 = ]
+ [ last \ alien-invoke eq? ]
+ } 1&& ;
From 53abf7e15d3b95e27aa632c2494263f137119de9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 16 Sep 2009 13:17:15 -0700
Subject: [PATCH 201/266] add recaptcha vocabulary
---
.../furnace/chloe-tags/recaptcha/authors.txt | 1 +
.../recaptcha/recaptcha-docs.factor | 77 +++++++++++++++++++
.../chloe-tags/recaptcha/recaptcha.factor | 75 ++++++++++++++++++
.../chloe-tags/recaptcha/recaptcha.xml | 7 ++
.../furnace/chloe-tags/recaptcha/summary.txt | 1 +
basis/furnace/chloe-tags/recaptcha/tags.txt | 1 +
6 files changed, 162 insertions(+)
create mode 100644 basis/furnace/chloe-tags/recaptcha/authors.txt
create mode 100644 basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor
create mode 100644 basis/furnace/chloe-tags/recaptcha/recaptcha.factor
create mode 100644 basis/furnace/chloe-tags/recaptcha/recaptcha.xml
create mode 100644 basis/furnace/chloe-tags/recaptcha/summary.txt
create mode 100644 basis/furnace/chloe-tags/recaptcha/tags.txt
diff --git a/basis/furnace/chloe-tags/recaptcha/authors.txt b/basis/furnace/chloe-tags/recaptcha/authors.txt
new file mode 100644
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/furnace/chloe-tags/recaptcha/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor b/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor
new file mode 100644
index 0000000000..0d93949f53
--- /dev/null
+++ b/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor
@@ -0,0 +1,77 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax http.server.filters kernel
+multiline furnace.actions ;
+IN: furnace.chloe-tags.recaptcha
+
+HELP: <recaptcha>
+{ $values
+ { "responder" "a responder" }
+ { "obj" object }
+}
+{ $description "A " { $link filter-responder } " wrapping another responder. Set the domain, public, and private keys using the key you get by registering with Recaptcha." } ;
+
+HELP: recaptcha-error
+{ $var-description "Set to the error string returned by the Recaptcha server." } ;
+
+HELP: recaptcha-valid?
+{ $var-description "Set to " { $link t } " if the user solved the last Recaptcha correctly." } ;
+
+HELP: validate-recaptcha
+{ $description "Validates a Recaptcha using the Recaptcha web service API." } ;
+
+ARTICLE: "recaptcha-example" "Recaptcha example"
+"There are several steps to using the Recaptcha library."
+{ $list
+ { "Wrap the responder in a " { $link <recaptcha> } }
+ { "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
+ { "Put the chloe tag " { $snippet "<recaptcha/>" } " in the template for your " { $link action } }
+}
+"An example follows:"
+{ $code
+HEREDOC: RECAPTCHA-TUTORIAL
+TUPLE: recaptcha-app < dispatcher recaptcha ;
+
+: <recaptcha-challenge> ( -- obj )
+ <action>
+ [
+ validate-recaptcha
+ recaptcha-valid? get "?good" "?bad" ? <redirect>
+ ] >>submit
+ [
+ <response>
+{" <?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html><body><t:recaptcha/></body></html>
+</t:chloe>"} >>body
+ ] >>display ;
+
+: <recaptcha-app> ( -- obj )
+ \ recaptcha-app new-dispatcher
+ <recaptcha-challenge> "" add-responder
+ <recaptcha>
+ "concatenative.org" >>domain
+ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key
+ "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ;
+
+<recaptcha-app> main-responder set-global
+RECAPTCHA-TUTORIAL
+}
+
+;
+
+ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
+"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
+
+"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
+
+"Wrapping a responder with Recaptcha:"
+{ $subsection <recaptcha> }
+"Validating recaptcha:"
+{ $subsection validate-recaptcha }
+"Symbols set after validation:"
+{ $subsection recaptcha-valid? }
+{ $subsection recaptcha-error }
+{ $subsection "recaptcha-example" } ;
+
+ABOUT: "furnace.chloe-tags.recaptcha"
diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha.factor b/basis/furnace/chloe-tags/recaptcha/recaptcha.factor
new file mode 100644
index 0000000000..81744dc0e0
--- /dev/null
+++ b/basis/furnace/chloe-tags/recaptcha/recaptcha.factor
@@ -0,0 +1,75 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions furnace.redirection html.forms
+html.templates.chloe.compiler html.templates.chloe.syntax
+http.client http.server http.server.filters io.sockets kernel
+locals namespaces sequences splitting urls validators
+xml.syntax ;
+IN: furnace.chloe-tags.recaptcha
+
+TUPLE: recaptcha < filter-responder domain public-key private-key ;
+
+SYMBOLS: recaptcha-valid? recaptcha-error ;
+
+: <recaptcha> ( responder -- obj )
+ recaptcha new
+ swap >>responder ;
+
+M: recaptcha call-responder*
+ dup \ recaptcha set
+ responder>> call-responder ;
+
+<PRIVATE
+
+: (render-recaptcha) ( private-key -- xml )
+ dup
+[XML <script type="text/javascript"
+ src=<->>
+</script>
+
+<noscript>
+ <iframe src=<->
+ height="300" width="500" frameborder="0"></iframe><br/>
+ <textarea name="recaptcha_challenge_field" rows="3" cols="40">
+ </textarea>
+ <input type="hidden" name="recaptcha_response_field"
+ value="manual_challenge"/>
+</noscript>
+XML] ;
+
+: recaptcha-url ( secure? -- ? )
+ [ "https://api.recaptcha.net/challenge" >url ]
+ [ "http://api.recaptcha.net/challenge" >url ] if ;
+
+: render-recaptcha ( -- xml )
+ secure-connection? recaptcha-url
+ recaptcha get public-key>> "k" set-query-param (render-recaptcha) ;
+
+: parse-recaptcha-response ( string -- valid? error )
+ "\n" split first2 [ "true" = ] dip ;
+
+:: (validate-recaptcha) ( challenge response recaptcha -- valid? error )
+ recaptcha private-key>> :> private-key
+ remote-address get host>> :> remote-ip
+ H{
+ { "challenge" challenge }
+ { "response" response }
+ { "privatekey" private-key }
+ { "remoteip" remote-ip }
+ } URL" http://api-verify.recaptcha.net/verify"
+ <post-request> http-request nip parse-recaptcha-response ;
+
+CHLOE: recaptcha
+ drop [ render-recaptcha ] [xml-code] ;
+
+PRIVATE>
+
+: validate-recaptcha ( -- )
+ {
+ { "recaptcha_challenge_field" [ v-required ] }
+ { "recaptcha_response_field" [ v-required ] }
+ } validate-params
+ "recaptcha_challenge_field" value
+ "recaptcha_response_field" value
+ \ recaptcha get (validate-recaptcha)
+ [ recaptcha-valid? set ] [ recaptcha-error set ] bi* ;
diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha.xml b/basis/furnace/chloe-tags/recaptcha/recaptcha.xml
new file mode 100644
index 0000000000..6cbf795310
--- /dev/null
+++ b/basis/furnace/chloe-tags/recaptcha/recaptcha.xml
@@ -0,0 +1,7 @@
+<?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html>
+ <body><t:recaptcha/>
+ </body>
+</html>
+</t:chloe>
diff --git a/basis/furnace/chloe-tags/recaptcha/summary.txt b/basis/furnace/chloe-tags/recaptcha/summary.txt
new file mode 100644
index 0000000000..909566f3cc
--- /dev/null
+++ b/basis/furnace/chloe-tags/recaptcha/summary.txt
@@ -0,0 +1 @@
+Recaptcha library
diff --git a/basis/furnace/chloe-tags/recaptcha/tags.txt b/basis/furnace/chloe-tags/recaptcha/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/furnace/chloe-tags/recaptcha/tags.txt
@@ -0,0 +1 @@
+web
From c880d3fff3af76ecfb1da228cf1f8cba611e90b3 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 15:41:38 -0500
Subject: [PATCH 202/266] update functors tests
---
basis/functors/functors-tests.factor | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index 5f2e32ad71..58da96aa17 100644
--- a/basis/functors/functors-tests.factor
+++ b/basis/functors/functors-tests.factor
@@ -161,15 +161,15 @@ T-class DEFINES-CLASS ${T}
WHERE
STRUCT: T-class
- { NAME int }
+ { NAME c:int }
{ x { TYPE 4 } }
- { y { short N } }
+ { y { c:short N } }
{ z TYPE initial: 5 }
{ float { c:float 2 } } ;
;FUNCTOR
-"a-struct" "nemo" "char" 2 define-a-struct
+"a-struct" "nemo" c:char 2 define-a-struct
>>
@@ -180,35 +180,35 @@ STRUCT: T-class
{ offset 0 }
{ class integer }
{ initial 0 }
- { c-type int }
+ { type c:int }
}
T{ struct-slot-spec
{ name "x" }
{ offset 4 }
{ class object }
{ initial f }
- { c-type { char 4 } }
+ { type { c:char 4 } }
}
T{ struct-slot-spec
{ name "y" }
{ offset 8 }
{ class object }
{ initial f }
- { c-type { short 2 } }
+ { type { c:short 2 } }
}
T{ struct-slot-spec
{ name "z" }
{ offset 12 }
{ class fixnum }
{ initial 5 }
- { c-type char }
+ { type c:char }
}
T{ struct-slot-spec
{ name "float" }
{ offset 16 }
{ class object }
{ initial f }
- { c-type { c:float 2 } }
+ { type { c:float 2 } }
}
}
] [ a-struct struct-slots ] unit-test
From 40620d470fc50175aa709687c8633bff09b1810b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 17:18:19 -0500
Subject: [PATCH 203/266] allow word c-types and definitions to coexist
---
basis/alien/parser/parser.factor | 6 ++++++
basis/alien/syntax/syntax.factor | 2 +-
2 files changed, 7 insertions(+), 1 deletion(-)
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index ab09383d7c..9a24f7cd4d 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -24,6 +24,12 @@ IN: alien.parser
[ drop \ } parse-until >array ]
[ parse-c-type ] if ;
+: reset-c-type ( word -- )
+ { "c-type" "pointer-c-type" } reset-props ;
+
+: CREATE-C-TYPE ( -- word )
+ scan current-vocab create dup reset-c-type ;
+
: normalize-c-arg ( type name -- type' name' )
[ length ]
[
diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index fac45176a3..0e3b569fff 100644
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -19,7 +19,7 @@ SYNTAX: FUNCTION:
(FUNCTION:) define-declared ;
SYNTAX: TYPEDEF:
- scan-c-type CREATE typedef ;
+ scan-c-type CREATE-C-TYPE typedef ;
SYNTAX: C-STRUCT:
scan current-vocab parse-definition define-struct ; deprecated
From 58756c27c53029af3b810247cc003f8cee53c745 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 17:36:50 -0500
Subject: [PATCH 204/266] have typedefs take on the old type's pointer type
even when the new type is a word and the old a string
---
basis/alien/c-types/c-types.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index f147810cd2..ecdc926b62 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -318,8 +318,8 @@ M: word typedef ( old new -- )
[ name>> typedef ]
[ swap "c-type" set-word-prop ]
[
- swap dup word? [
- "pointer-c-type" word-prop
+ swap dup c-type-name? [
+ resolve-pointer-type
"pointer-c-type" set-word-prop
] [ 2drop ] if
]
From d1c69efc0f4843dafa4fc201fdfb68523d9613dc Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 17:38:01 -0500
Subject: [PATCH 205/266] fix functors tests
---
basis/functors/functors-tests.factor | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index bcdc1bae74..32d578d05d 100644
--- a/basis/functors/functors-tests.factor
+++ b/basis/functors/functors-tests.factor
@@ -179,35 +179,35 @@ STRUCT: T-class
{ offset 0 }
{ class integer }
{ initial 0 }
- { c-type "int" }
+ { type "int" }
}
T{ struct-slot-spec
{ name "x" }
{ offset 4 }
{ class object }
{ initial f }
- { c-type { "char" 4 } }
+ { type { "char" 4 } }
}
T{ struct-slot-spec
{ name "y" }
{ offset 8 }
{ class object }
{ initial f }
- { c-type { "short" 2 } }
+ { type { "short" 2 } }
}
T{ struct-slot-spec
{ name "z" }
{ offset 12 }
{ class fixnum }
{ initial 5 }
- { c-type "char" }
+ { type "char" }
}
T{ struct-slot-spec
{ name "float" }
{ offset 16 }
{ class object }
{ initial f }
- { c-type { "float" 2 } }
+ { type { "float" 2 } }
}
}
] [ a-struct struct-slots ] unit-test
From ef98f1de68a3452ceedb7c6e91de75f71ec50d4a Mon Sep 17 00:00:00 2001
From: Bruno Deferrari <utizoc@gmail.com>
Date: Wed, 16 Sep 2009 19:58:45 -0300
Subject: [PATCH 206/266] irc.client: Fix detach chat (wasn't sending a PART
message)
---
extra/irc/client/internals/internals-tests.factor | 8 +++++++-
extra/irc/client/internals/internals.factor | 2 +-
2 files changed, 8 insertions(+), 2 deletions(-)
diff --git a/extra/irc/client/internals/internals-tests.factor b/extra/irc/client/internals/internals-tests.factor
index a591fe9ce0..84510fb67e 100644
--- a/extra/irc/client/internals/internals-tests.factor
+++ b/extra/irc/client/internals/internals-tests.factor
@@ -99,7 +99,13 @@ M: mb-writer dispose drop ;
! Test join
[ { "JOIN #factortest" } [
- "#factortest" %join %pop-output-line
+ "#factortest" %join %pop-output-line
+ ] unit-test
+] spawning-irc
+
+[ { "PART #factortest" } [
+ "#factortest" %join %pop-output-line drop
+ "#factortest" chat> remove-chat %pop-output-line
] unit-test
] spawning-irc
diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor
index 6ce851e7dd..ef1695f563 100644
--- a/extra/irc/client/internals/internals.factor
+++ b/extra/irc/client/internals/internals.factor
@@ -172,7 +172,7 @@ M: irc-nick-chat remove-chat name>> unregister-chat ;
M: irc-server-chat remove-chat drop +server-chat+ unregister-chat ;
M: irc-channel-chat remove-chat
- [ part new annotate-message irc-send ]
+ [ name>> "PART " prepend string>irc-message irc-send ]
[ name>> unregister-chat ] bi ;
: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
From 748ba4b833f2912b24d8140714a714cc73a1b551 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 18:07:39 -0500
Subject: [PATCH 207/266] give a better error message when an invalid slot name
is used in a tuple/struct literal
---
basis/debugger/debugger.factor | 2 ++
core/classes/tuple/parser/parser.factor | 10 +++++++++-
2 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 2fad0e4c2e..1e08896e8d 100644
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -174,6 +174,8 @@ M: no-method error.
M: bad-slot-value summary drop "Bad store to specialized slot" ;
+M: bad-slot-name summary drop "Bad slot name in object literal" ;
+
M: no-math-method summary
drop "No suitable arithmetic method" ;
diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index 0a57ad34f3..626cbd63df 100644
--- a/core/classes/tuple/parser/parser.factor
+++ b/core/classes/tuple/parser/parser.factor
@@ -99,9 +99,17 @@ GENERIC# boa>object 1 ( class slots -- tuple )
M: tuple-class boa>object
swap prefix >tuple ;
+ERROR: bad-slot-name class slot ;
+
+: check-slot-exists ( class initials slot-spec/f index/f name -- class initials slot-spec index )
+ over [ drop ] [ nip nip nip bad-slot-name ] if ;
+
+: slot-named-checked ( class initials name slots -- class initials slot-spec )
+ over [ slot-named* ] dip check-slot-exists drop ;
+
: assoc>object ( class slots values -- tuple )
[ [ [ initial>> ] map ] keep ] dip
- swap [ [ slot-named* drop ] curry dip ] curry assoc-map
+ swap [ [ slot-named-checked ] curry dip ] curry assoc-map
[ dup <enum> ] dip update boa>object ;
: parse-tuple-literal-slots ( class slots -- tuple )
From d79b6d590eff83e22152587f5c163bfb74b42f82 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 16 Sep 2009 16:11:05 -0700
Subject: [PATCH 208/266] html.templates.chloe: minor doc fix
---
basis/html/templates/chloe/chloe-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor
index 9716407de8..61121bd769 100644
--- a/basis/html/templates/chloe/chloe-docs.factor
+++ b/basis/html/templates/chloe/chloe-docs.factor
@@ -24,7 +24,7 @@ HELP: compile-attr
{ $description "Compiles code which pushes an attribute value previously extracted by " { $link required-attr } " or " { $link optional-attr } " on the stack. If the attribute value begins with " { $snippet "@" } ", compiles into code which pushes the a form value." } ;
HELP: CHLOE:
-{ $syntax "name definition... ;" }
+{ $syntax "CHLOE: name definition... ;" }
{ $values { "name" "the tag name" } { "definition" { $quotation "( tag -- )" } } }
{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;
From 8d83824bb8415bc203dcc102cc6233822305535c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 16 Sep 2009 16:13:55 -0700
Subject: [PATCH 209/266] benchmark.spectral-norm: take out unsafe sequence
access since it doesn't make it faster, and replace tuck/2bi* with bi-curry
bi*
---
extra/benchmark/spectral-norm/spectral-norm.factor | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor
index 4f93367b8a..41ae5b3578 100644
--- a/extra/benchmark/spectral-norm/spectral-norm.factor
+++ b/extra/benchmark/spectral-norm/spectral-norm.factor
@@ -1,8 +1,7 @@
! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: specialized-arrays kernel math math.functions
-math.vectors sequences sequences.private prettyprint words hints
-locals ;
+math.vectors sequences prettyprint words hints locals ;
SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm
@@ -19,13 +18,13 @@ IN: benchmark.spectral-norm
+ 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x )
- tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline
+ [ swap nth ] [ eval-A ] bi-curry bi* * ; inline
: eval-A-times-u ( n u -- seq )
[ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x )
- tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline
+ [ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline
: eval-At-times-u ( u n -- seq )
[ (eval-At-times-u) ] inner-loop ; inline
From 9479fb4099f4404978e8ed6f709d9dbdc32b02b2 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 20:54:22 -0500
Subject: [PATCH 210/266] have SPECIALIZED-ARRAY: scan in a c-type rather than
a string
---
basis/specialized-arrays/specialized-arrays.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index bca85a25db..0490ede304 100755
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types assocs byte-arrays classes
-compiler.units functors kernel lexer libc math
+USING: accessors alien alien.c-types alien.parser assocs
+byte-arrays classes compiler.units functors kernel lexer libc math
math.vectors.specialization namespaces parser prettyprint.custom
sequences sequences.private strings summary vocabs vocabs.loader
vocabs.parser words fry combinators ;
@@ -157,7 +157,7 @@ M: c-type-name c-direct-array-constructor
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
SYNTAX: SPECIALIZED-ARRAY:
- scan define-array-vocab use-vocab ;
+ scan-c-type define-array-vocab use-vocab ;
"prettyprint" vocab [
"specialized-arrays.prettyprint" require
From 263ce45932f6926a9654d21f9cf2296d1a82cd1c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 20:54:57 -0500
Subject: [PATCH 211/266] fix resolve-pointer-type
---
basis/alien/c-types/c-types.factor | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index ecdc926b62..6d63987265 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -65,8 +65,12 @@ M: word resolve-pointer-type
dup "pointer-c-type" word-prop
[ ] [ drop void* ] ?if ;
M: string resolve-pointer-type
- c-types get at dup c-type-name?
- [ resolve-pointer-type ] [ drop void* ] if ;
+ dup "*" append dup c-types get at
+ [ nip ] [
+ drop
+ c-types get at dup c-type-name?
+ [ resolve-pointer-type ] [ drop void* ] if
+ ] if ;
: resolve-typedef ( name -- type )
dup c-type-name? [ c-type ] when ;
From 31264538e3f9dfcbf77329d92dae7b8869b9fe34 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 20:55:14 -0500
Subject: [PATCH 212/266] get gpu vocabs to load with c-type changes
---
extra/gpu/demos/bunny/bunny.factor | 1 +
extra/gpu/render/render.factor | 4 +++-
extra/gpu/state/state.factor | 4 +++-
3 files changed, 7 insertions(+), 2 deletions(-)
diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor
index 10e49984a1..d6c7456d63 100755
--- a/extra/gpu/demos/bunny/bunny.factor
+++ b/extra/gpu/demos/bunny/bunny.factor
@@ -7,6 +7,7 @@ io io.encodings.ascii io.files io.files.temp kernel math
math.matrices math.parser math.vectors method-chains sequences
splitting threads ui ui.gadgets ui.gadgets.worlds
ui.pixel-formats specialized-arrays specialized-vectors ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-VECTOR: uint
IN: gpu.demos.bunny
diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor
index 0ee9ab78c5..9d8c15ab7a 100644
--- a/extra/gpu/render/render.factor
+++ b/extra/gpu/render/render.factor
@@ -9,7 +9,9 @@ lexer locals math math.order math.parser namespaces opengl
opengl.gl parser quotations sequences slots sorting
specialized-arrays strings ui.gadgets.worlds variants
vocabs.parser words ;
-SPECIALIZED-ARRAY: float
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: uint
SPECIALIZED-ARRAY: void*
diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor
index 02d6046722..2bca8f72fc 100755
--- a/extra/gpu/state/state.factor
+++ b/extra/gpu/state/state.factor
@@ -2,8 +2,10 @@
USING: accessors alien.c-types arrays byte-arrays combinators gpu
kernel literals math math.rectangles opengl opengl.gl sequences
variants specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+FROM: math => float ;
SPECIALIZED-ARRAY: int
-SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: c:float
IN: gpu.state
UNION: ?rect rect POSTPONE: f ;
From 8f336b4ec00bfd1dd08cb798d5dcae8cf8f7da6f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 21:24:10 -0500
Subject: [PATCH 213/266] alien.fortran can't piggyback the alien.parser arg
parser anymore
---
basis/alien/fortran/fortran.factor | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor
index 52d69fd193..3670a376e1 100644
--- a/basis/alien/fortran/fortran.factor
+++ b/basis/alien/fortran/fortran.factor
@@ -1,5 +1,5 @@
! (c) 2009 Joe Groff, see BSD license
-USING: accessors alien alien.c-types alien.complex alien.parser
+USING: accessors alien alien.c-types alien.complex grouping
alien.strings alien.syntax arrays ascii assocs
byte-arrays combinators combinators.short-circuit fry generalizations
kernel lexer macros math math.parser namespaces parser sequences
@@ -429,6 +429,11 @@ PRIVATE>
MACRO: fortran-invoke ( return library function parameters -- )
{ [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
+: parse-arglist ( parameters return -- types effect )
+ [ 2 group unzip [ "," ?tail drop ] map ]
+ [ [ { } ] [ 1array ] if-void ]
+ bi* <effect> ;
+
:: define-fortran-function ( return library function parameters -- )
function create-in dup reset-generic
return library function parameters return [ "void" ] unless* parse-arglist
From fa60d96ae47006a7071f2c8599f2656e56c98843 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Sep 2009 21:25:46 -0500
Subject: [PATCH 214/266] fix "float" ambiguities in math.blas, opengl vocabs
---
basis/math/blas/matrices/matrices.factor | 1 +
basis/math/blas/vectors/vectors.factor | 1 +
basis/opengl/opengl.factor | 1 +
3 files changed, 3 insertions(+)
diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor
index a051fb250d..4212f32b2d 100755
--- a/basis/math/blas/matrices/matrices.factor
+++ b/basis/math/blas/matrices/matrices.factor
@@ -5,6 +5,7 @@ math.complex math.functions math.order functors words
sequences sequences.merged sequences.private shuffle
parser prettyprint.backend prettyprint.custom ascii
specialized-arrays ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
SPECIALIZED-ARRAY: complex-float
diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor
index c08fdb6120..20ee7925b0 100755
--- a/basis/math/blas/vectors/vectors.factor
+++ b/basis/math/blas/vectors/vectors.factor
@@ -3,6 +3,7 @@ combinators.short-circuit fry kernel math math.blas.ffi
math.complex math.functions math.order sequences sequences.private
functors words locals parser prettyprint.backend prettyprint.custom
specialized-arrays ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
SPECIALIZED-ARRAY: complex-float
diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index 75f327664d..cdf68cebd3 100755
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -8,6 +8,7 @@ math.parser opengl.gl combinators combinators.smart arrays
sequences splitting words byte-arrays assocs vocabs
colors colors.constants accessors generalizations locals fry
specialized-arrays ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: uint
IN: opengl
From 1f04ed01feda73e467055fe58e842ea267d90ad6 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 09:29:23 -0500
Subject: [PATCH 215/266] fix more ambiguities
---
basis/math/vectors/simd/functor/functor.factor | 12 ++++++++----
basis/math/vectors/simd/simd.factor | 14 ++++++++------
.../specialized-arrays-tests.factor | 1 +
basis/x11/xlib/xlib.factor | 1 +
extra/alien/marshall/marshall.factor | 1 +
extra/bunny/model/model.factor | 5 +++--
extra/gpu/textures/textures.factor | 1 +
extra/openal/openal.factor | 1 +
8 files changed, 24 insertions(+), 12 deletions(-)
diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor
index cabb731fef..641585a5d7 100644
--- a/basis/math/vectors/simd/functor/functor.factor
+++ b/basis/math/vectors/simd/functor/functor.factor
@@ -9,14 +9,16 @@ ERROR: bad-length got expected ;
FUNCTOR: define-simd-128 ( T -- )
-N [ 16 T heap-size /i ]
+T-TYPE IS ${T}
+
+N [ 16 T-TYPE heap-size /i ]
A DEFINES-CLASS ${T}-${N}
>A DEFINES >${A}
A{ DEFINES ${A}{
-NTH [ T dup c-type-getter-boxer array-accessor ]
-SET-NTH [ T dup c-setter array-accessor ]
+NTH [ T-TYPE dup c-type-getter-boxer array-accessor ]
+SET-NTH [ T-TYPE dup c-setter array-accessor ]
A-rep IS ${A}-rep
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
@@ -74,7 +76,9 @@ PRIVATE>
! Synthesize 256-bit vectors from a pair of 128-bit vectors
FUNCTOR: define-simd-256 ( T -- )
-N [ 32 T heap-size /i ]
+T-TYPE IS ${T}
+
+N [ 32 T-TYPE heap-size /i ]
N/2 [ N 2 / ]
A/2 IS ${T}-${N/2}
diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor
index 7df9b2d8d2..a3c99ae217 100644
--- a/basis/math/vectors/simd/simd.factor
+++ b/basis/math/vectors/simd/simd.factor
@@ -5,6 +5,8 @@ kernel math math.functions math.vectors
math.vectors.simd.functor math.vectors.simd.intrinsics
math.vectors.specialization parser prettyprint.custom sequences
sequences.private locals assocs words fry ;
+FROM: alien.c-types => float ;
+QUALIFIED-WITH: math m
IN: math.vectors.simd
<<
@@ -15,9 +17,9 @@ DEFER: float-8
DEFER: double-4
"double" define-simd-128
-"float" define-simd-128
+"float" define-simd-128
"double" define-simd-256
-"float" define-simd-256
+"float" define-simd-256
>>
@@ -136,7 +138,7 @@ DEFER: double-4
PRIVATE>
-\ float-4 \ float-4-with float H{
+\ float-4 \ float-4-with m:float H{
{ v+ [ [ (simd-v+) ] float-4-vv->v-op ] }
{ v- [ [ (simd-v-) ] float-4-vv->v-op ] }
{ v* [ [ (simd-v*) ] float-4-vv->v-op ] }
@@ -146,7 +148,7 @@ PRIVATE>
{ sum [ [ (simd-sum) ] float-4-v->n-op ] }
} simd-vector-words
-\ double-2 \ double-2-with float H{
+\ double-2 \ double-2-with m:float H{
{ v+ [ [ (simd-v+) ] double-2-vv->v-op ] }
{ v- [ [ (simd-v-) ] double-2-vv->v-op ] }
{ v* [ [ (simd-v*) ] double-2-vv->v-op ] }
@@ -156,7 +158,7 @@ PRIVATE>
{ sum [ [ (simd-sum) ] double-2-v->n-op ] }
} simd-vector-words
-\ float-8 \ float-8-with float H{
+\ float-8 \ float-8-with m:float H{
{ v+ [ [ (simd-v+) ] float-8-vv->v-op ] }
{ v- [ [ (simd-v-) ] float-8-vv->v-op ] }
{ v* [ [ (simd-v*) ] float-8-vv->v-op ] }
@@ -166,7 +168,7 @@ PRIVATE>
{ sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] }
} simd-vector-words
-\ double-4 \ double-4-with float H{
+\ double-4 \ double-4-with m:float H{
{ v+ [ [ (simd-v+) ] double-4-vv->v-op ] }
{ v- [ [ (simd-v-) ] double-4-vv->v-op ] }
{ v* [ [ (simd-v*) ] double-4-vv->v-op ] }
diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor
index 2698149bac..e289efb077 100755
--- a/basis/specialized-arrays/specialized-arrays-tests.factor
+++ b/basis/specialized-arrays/specialized-arrays-tests.factor
@@ -5,6 +5,7 @@ kernel arrays combinators compiler compiler.units classes.struct
combinators.smart compiler.tree.debugger math libc destructors
sequences.private multiline eval words vocabs namespaces
assocs prettyprint ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: bool
diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor
index 48d556de1d..98305e8304 100644
--- a/basis/x11/xlib/xlib.factor
+++ b/basis/x11/xlib/xlib.factor
@@ -13,6 +13,7 @@
USING: accessors kernel arrays alien alien.c-types alien.strings
alien.syntax classes.struct math math.bitwise words sequences
namespaces continuations io io.encodings.ascii x11.syntax ;
+FROM: alien.c-types => short ;
IN: x11.xlib
LIBRARY: xlib
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index 2cae122641..e8ea0d3754 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -6,6 +6,7 @@ combinators combinators.short-circuit destructors fry
io.encodings.utf8 kernel libc sequences
specialized-arrays strings unix.utilities vocabs.parser
words libc.private locals generalizations math ;
+FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: bool
SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: double
diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor
index dd6730b57f..d80f3aa98a 100755
--- a/extra/bunny/model/model.factor
+++ b/extra/bunny/model/model.factor
@@ -3,8 +3,9 @@ http.client io io.encodings.ascii io.files io.files.temp kernel
math math.matrices math.parser math.vectors opengl
opengl.capabilities opengl.gl opengl.demo-support sequences
splitting vectors words specialized-arrays ;
-SPECIALIZED-ARRAY: float
-SPECIALIZED-ARRAY: uint
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
+SPECIALIZED-ARRAY: c:uint
IN: bunny.model
: numbers ( str -- seq )
diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor
index 8015ff9a9b..2649f7c586 100644
--- a/extra/gpu/textures/textures.factor
+++ b/extra/gpu/textures/textures.factor
@@ -3,6 +3,7 @@ USING: accessors alien.c-types arrays byte-arrays combinators
destructors fry gpu gpu.buffers images kernel locals math
opengl opengl.gl opengl.textures sequences
specialized-arrays ui.gadgets.worlds variants ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: gpu.textures
diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor
index 81a6621eff..bccdec1420 100644
--- a/extra/openal/openal.factor
+++ b/extra/openal/openal.factor
@@ -4,6 +4,7 @@ USING: kernel accessors arrays alien system combinators
alien.syntax namespaces alien.c-types sequences vocabs.loader
shuffle openal.backend alien.libraries generalizations
specialized-arrays ;
+FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: uint
IN: openal
From e02d480b43ad6dc0a99d307351c6ed0584734063 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 09:40:37 -0500
Subject: [PATCH 216/266] fix alien.inline tests
---
extra/alien/inline/types/types.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor
index 070febc324..ac7f6ae17f 100644
--- a/extra/alien/inline/types/types.factor
+++ b/extra/alien/inline/types/types.factor
@@ -2,10 +2,11 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs combinators.short-circuit
continuations effects fry kernel math memoize sequences
-splitting strings peg.ebnf make ;
+splitting strings peg.ebnf make words ;
IN: alien.inline.types
: cify-type ( str -- str' )
+ dup word? [ name>> ] when
{ { CHAR: - CHAR: space } } substitute ;
: factorize-type ( str -- str' )
From c3f0688164f2cf18b08c3c830fe533ff6c88003b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 09:55:09 -0500
Subject: [PATCH 217/266] more loading fixes
---
extra/alien/marshall/marshall.factor | 2 +-
extra/freetype/freetype.factor | 2 +-
extra/jamshred/gl/gl.factor | 1 +
extra/synth/buffers/buffers.factor | 1 +
4 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index e8ea0d3754..d343da0fe0 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -23,7 +23,7 @@ SPECIALIZED-ARRAY: ushort
SPECIALIZED-ARRAY: void*
IN: alien.marshall
-<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
+<< primitive-types [ [ void* = ] [ bool = ] bi or not ]
filter [ define-primitive-marshallers ] each >>
TUPLE: alien-wrapper { underlying alien } ;
diff --git a/extra/freetype/freetype.factor b/extra/freetype/freetype.factor
index c45475cefa..0bfaae9853 100644
--- a/extra/freetype/freetype.factor
+++ b/extra/freetype/freetype.factor
@@ -23,7 +23,7 @@ TYPEDEF: ushort FT_UShort
TYPEDEF: long FT_Long
TYPEDEF: ulong FT_ULong
TYPEDEF: uchar FT_Bool
-TYPEDEF: cell FT_Offset
+TYPEDEF: ulong FT_Offset
TYPEDEF: int FT_PtrDist
TYPEDEF: char FT_String
TYPEDEF: int FT_Tag
diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor
index 1a03a2c941..60e9e39d9f 100644
--- a/extra/jamshred/gl/gl.factor
+++ b/extra/jamshred/gl/gl.factor
@@ -4,6 +4,7 @@ USING: accessors alien.c-types jamshred.game jamshred.oint
jamshred.player jamshred.tunnel kernel math math.constants
math.functions math.vectors opengl opengl.gl opengl.glu
opengl.demo-support sequences specialized-arrays ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: jamshred.gl
diff --git a/extra/synth/buffers/buffers.factor b/extra/synth/buffers/buffers.factor
index 71b05ac642..978fb32d42 100644
--- a/extra/synth/buffers/buffers.factor
+++ b/extra/synth/buffers/buffers.factor
@@ -2,6 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types combinators kernel locals math
math.ranges openal sequences sequences.merged specialized-arrays ;
+FROM: alien.c-types => short ;
SPECIALIZED-ARRAY: uchar
SPECIALIZED-ARRAY: short
IN: synth.buffers
From d9c6230f43bad0d3db82d761f2c81026726b418e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 11:10:06 -0500
Subject: [PATCH 218/266] fix more alien.inline tests
---
extra/alien/inline/inline.factor | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/extra/alien/inline/inline.factor b/extra/alien/inline/inline.factor
index 84c3450102..ee69d954ea 100644
--- a/extra/alien/inline/inline.factor
+++ b/extra/alien/inline/inline.factor
@@ -41,6 +41,11 @@ SYMBOL: c-strings
[ current-vocab name>> % "_" % % ] "" make ;
PRIVATE>
+: parse-arglist ( parameters return -- types effect )
+ [ 2 group unzip [ "," ?tail drop ] map ]
+ [ [ { } ] [ 1array ] if-void ]
+ bi* <effect> ;
+
: append-function-body ( prototype-str body -- str )
[ swap % " {\n" % % "\n}\n" % ] "" make ;
From 17008bd2754daa61383288497afc47c15d6aab0f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 17 Sep 2009 09:13:33 -0700
Subject: [PATCH 219/266] fix recaptcha, move to furnace.recaptcha
---
.../{chloe-tags => }/recaptcha/authors.txt | 0
.../recaptcha/recaptcha-docs.factor | 32 ++++++++++++-------
.../recaptcha/recaptcha.factor | 11 ++++---
.../{chloe-tags => }/recaptcha/recaptcha.xml | 0
.../{chloe-tags => }/recaptcha/summary.txt | 0
.../{chloe-tags => }/recaptcha/tags.txt | 0
6 files changed, 26 insertions(+), 17 deletions(-)
rename basis/furnace/{chloe-tags => }/recaptcha/authors.txt (100%)
rename basis/furnace/{chloe-tags => }/recaptcha/recaptcha-docs.factor (71%)
rename basis/furnace/{chloe-tags => }/recaptcha/recaptcha.factor (88%)
rename basis/furnace/{chloe-tags => }/recaptcha/recaptcha.xml (100%)
rename basis/furnace/{chloe-tags => }/recaptcha/summary.txt (100%)
rename basis/furnace/{chloe-tags => }/recaptcha/tags.txt (100%)
diff --git a/basis/furnace/chloe-tags/recaptcha/authors.txt b/basis/furnace/recaptcha/authors.txt
similarity index 100%
rename from basis/furnace/chloe-tags/recaptcha/authors.txt
rename to basis/furnace/recaptcha/authors.txt
diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor
similarity index 71%
rename from basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor
rename to basis/furnace/recaptcha/recaptcha-docs.factor
index 0d93949f53..90d4a8195c 100644
--- a/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor
+++ b/basis/furnace/recaptcha/recaptcha-docs.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax http.server.filters kernel
-multiline furnace.actions ;
-IN: furnace.chloe-tags.recaptcha
+multiline furnace.actions furnace.alloy ;
+IN: furnace.recaptcha
HELP: <recaptcha>
{ $values
@@ -30,20 +30,27 @@ ARTICLE: "recaptcha-example" "Recaptcha example"
"An example follows:"
{ $code
HEREDOC: RECAPTCHA-TUTORIAL
+USING: db.sqlite kernel http.server.dispatchers db.sqlite
+furnace.actions furnace.recaptcha furnace.conversations
+furnace.redirection xml.syntax html.templates.chloe.compiler
+io.streams.string http.server.responses furnace.alloy http.server ;
TUPLE: recaptcha-app < dispatcher recaptcha ;
+: recaptcha-db ( -- obj )
+ "recaptcha-example" <sqlite-db> ;
+
: <recaptcha-challenge> ( -- obj )
<action>
[
+ begin-conversation
validate-recaptcha
- recaptcha-valid? get "?good" "?bad" ? <redirect>
+ recaptcha-valid? cget "?good" "?bad" ? >url <continue-conversation>
] >>submit
[
- <response>
-{" <?xml version='1.0' ?>
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-<html><body><t:recaptcha/></body></html>
-</t:chloe>"} >>body
+ <XML <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+ <html><body><form submit="" method="post"><t:recaptcha/></form></body></html>
+ </t:chloe> XML>
+ compile-template [ call( -- ) ] with-string-writer "text/html" <content>
] >>display ;
: <recaptcha-app> ( -- obj )
@@ -51,8 +58,9 @@ TUPLE: recaptcha-app < dispatcher recaptcha ;
<recaptcha-challenge> "" add-responder
<recaptcha>
"concatenative.org" >>domain
- "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key
- "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ;
+ "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
+ "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
+ recaptcha-db <alloy> ;
<recaptcha-app> main-responder set-global
RECAPTCHA-TUTORIAL
@@ -60,7 +68,7 @@ RECAPTCHA-TUTORIAL
;
-ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
+ARTICLE: "furnace.recaptcha" "Recaptcha"
"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
@@ -74,4 +82,4 @@ ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
{ $subsection recaptcha-error }
{ $subsection "recaptcha-example" } ;
-ABOUT: "furnace.chloe-tags.recaptcha"
+ABOUT: "furnace.recaptcha"
diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha.factor b/basis/furnace/recaptcha/recaptcha.factor
similarity index 88%
rename from basis/furnace/chloe-tags/recaptcha/recaptcha.factor
rename to basis/furnace/recaptcha/recaptcha.factor
index 81744dc0e0..99b223b8e3 100644
--- a/basis/furnace/chloe-tags/recaptcha/recaptcha.factor
+++ b/basis/furnace/recaptcha/recaptcha.factor
@@ -4,8 +4,8 @@ USING: accessors furnace.actions furnace.redirection html.forms
html.templates.chloe.compiler html.templates.chloe.syntax
http.client http.server http.server.filters io.sockets kernel
locals namespaces sequences splitting urls validators
-xml.syntax ;
-IN: furnace.chloe-tags.recaptcha
+xml.syntax furnace.conversations ;
+IN: furnace.recaptcha
TUPLE: recaptcha < filter-responder domain public-key private-key ;
@@ -38,8 +38,9 @@ M: recaptcha call-responder*
XML] ;
: recaptcha-url ( secure? -- ? )
- [ "https://api.recaptcha.net/challenge" >url ]
- [ "http://api.recaptcha.net/challenge" >url ] if ;
+ [ "https://api.recaptcha.net/challenge" ]
+ [ "http://api.recaptcha.net/challenge" ] if
+ recaptcha-error cget [ "?error=" glue ] when* >url ;
: render-recaptcha ( -- xml )
secure-connection? recaptcha-url
@@ -72,4 +73,4 @@ PRIVATE>
"recaptcha_challenge_field" value
"recaptcha_response_field" value
\ recaptcha get (validate-recaptcha)
- [ recaptcha-valid? set ] [ recaptcha-error set ] bi* ;
+ [ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ;
diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha.xml b/basis/furnace/recaptcha/recaptcha.xml
similarity index 100%
rename from basis/furnace/chloe-tags/recaptcha/recaptcha.xml
rename to basis/furnace/recaptcha/recaptcha.xml
diff --git a/basis/furnace/chloe-tags/recaptcha/summary.txt b/basis/furnace/recaptcha/summary.txt
similarity index 100%
rename from basis/furnace/chloe-tags/recaptcha/summary.txt
rename to basis/furnace/recaptcha/summary.txt
diff --git a/basis/furnace/chloe-tags/recaptcha/tags.txt b/basis/furnace/recaptcha/tags.txt
similarity index 100%
rename from basis/furnace/chloe-tags/recaptcha/tags.txt
rename to basis/furnace/recaptcha/tags.txt
From 97d4ac27988946e6a64e9c8f80a56b960a662f0c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 17 Sep 2009 09:14:56 -0700
Subject: [PATCH 220/266] bootstrap.stage1: decent error message if
stage2.factor can't be found
---
core/bootstrap/stage1.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor
index c7be17e38d..9c84904ff7 100644
--- a/core/bootstrap/stage1.factor
+++ b/core/bootstrap/stage1.factor
@@ -40,7 +40,7 @@ load-help? off
"bootstrap.layouts" require
[
- "vocab:bootstrap/stage2.factor"
+ "resource:basis/bootstrap/stage2.factor"
dup exists? [
run-file
] [
From ce97e7328bbd4995aa481bcb76a3d3bb3809d190 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 17 Sep 2009 09:48:49 -0700
Subject: [PATCH 221/266] move recaptcha example to a vocabulary on disk
---
basis/furnace/recaptcha/example/authors.txt | 1 +
.../furnace/recaptcha/example/example.factor | 31 +++++++++++
basis/furnace/recaptcha/example/example.xml | 4 ++
basis/furnace/recaptcha/recaptcha-docs.factor | 52 ++++---------------
4 files changed, 47 insertions(+), 41 deletions(-)
create mode 100644 basis/furnace/recaptcha/example/authors.txt
create mode 100644 basis/furnace/recaptcha/example/example.factor
create mode 100644 basis/furnace/recaptcha/example/example.xml
diff --git a/basis/furnace/recaptcha/example/authors.txt b/basis/furnace/recaptcha/example/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/basis/furnace/recaptcha/example/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/basis/furnace/recaptcha/example/example.factor b/basis/furnace/recaptcha/example/example.factor
new file mode 100644
index 0000000000..264be678ae
--- /dev/null
+++ b/basis/furnace/recaptcha/example/example.factor
@@ -0,0 +1,31 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors db.sqlite furnace.actions furnace.alloy
+furnace.conversations furnace.recaptcha furnace.redirection
+html.templates.chloe.compiler http.server
+http.server.dispatchers http.server.responses io.streams.string
+kernel urls xml.syntax ;
+IN: furnace.recaptcha.example
+
+TUPLE: recaptcha-app < dispatcher recaptcha ;
+
+: recaptcha-db ( -- obj ) "recaptcha-example" <sqlite-db> ;
+
+: <recaptcha-challenge> ( -- obj )
+ <page-action>
+ [
+ begin-conversation
+ validate-recaptcha
+ recaptcha-valid? cget
+ "?good" "?bad" ? >url <continue-conversation>
+ ] >>submit
+ { recaptcha-app "example" } >>template ;
+
+: <recaptcha-app> ( -- obj )
+ \ recaptcha-app new-dispatcher
+ <recaptcha-challenge> "" add-responder
+ <recaptcha>
+ "concatenative.org" >>domain
+ "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
+ "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
+ recaptcha-db <alloy> ;
diff --git a/basis/furnace/recaptcha/example/example.xml b/basis/furnace/recaptcha/example/example.xml
new file mode 100644
index 0000000000..e59f441f7f
--- /dev/null
+++ b/basis/furnace/recaptcha/example/example.xml
@@ -0,0 +1,4 @@
+<?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html><body><form submit="" method="post"><t:recaptcha/></form></body></html>
+</t:chloe>
diff --git a/basis/furnace/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor
index 90d4a8195c..d416dd9474 100644
--- a/basis/furnace/recaptcha/recaptcha-docs.factor
+++ b/basis/furnace/recaptcha/recaptcha-docs.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax http.server.filters kernel
-multiline furnace.actions furnace.alloy ;
+multiline furnace.actions furnace.alloy furnace.conversations ;
IN: furnace.recaptcha
HELP: <recaptcha>
@@ -24,49 +24,19 @@ ARTICLE: "recaptcha-example" "Recaptcha example"
"There are several steps to using the Recaptcha library."
{ $list
{ "Wrap the responder in a " { $link <recaptcha> } }
+ { "Wrap the responder in a " { $link <conversations> } " if it is not already" }
+ { "Ensure that there is a database connected, with the " { $link <alloy> } " word" }
+ { "Start a conversation to move values between requests" }
{ "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
- { "Put the chloe tag " { $snippet "<recaptcha/>" } " in the template for your " { $link action } }
+ { "Pass the conversation from your submit action using " { $link <continue-conversation> } }
+ { "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template for your " { $link page-action } }
}
-"An example follows:"
+$nl
+"Run this example vocabulary:"
{ $code
-HEREDOC: RECAPTCHA-TUTORIAL
-USING: db.sqlite kernel http.server.dispatchers db.sqlite
-furnace.actions furnace.recaptcha furnace.conversations
-furnace.redirection xml.syntax html.templates.chloe.compiler
-io.streams.string http.server.responses furnace.alloy http.server ;
-TUPLE: recaptcha-app < dispatcher recaptcha ;
-
-: recaptcha-db ( -- obj )
- "recaptcha-example" <sqlite-db> ;
-
-: <recaptcha-challenge> ( -- obj )
- <action>
- [
- begin-conversation
- validate-recaptcha
- recaptcha-valid? cget "?good" "?bad" ? >url <continue-conversation>
- ] >>submit
- [
- <XML <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
- <html><body><form submit="" method="post"><t:recaptcha/></form></body></html>
- </t:chloe> XML>
- compile-template [ call( -- ) ] with-string-writer "text/html" <content>
- ] >>display ;
-
-: <recaptcha-app> ( -- obj )
- \ recaptcha-app new-dispatcher
- <recaptcha-challenge> "" add-responder
- <recaptcha>
- "concatenative.org" >>domain
- "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
- "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
- recaptcha-db <alloy> ;
-
-<recaptcha-app> main-responder set-global
-RECAPTCHA-TUTORIAL
-}
-
-;
+ "USE: furnace.recaptcha.example"
+ "<recaptcha-app> main-responder set-global"
+} ;
ARTICLE: "furnace.recaptcha" "Recaptcha"
"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
From eeebf6c7514768e65d3e8c6d32aa7b633dba5fc0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 14:01:41 -0500
Subject: [PATCH 222/266] fix loading issues in windows vocabs
---
basis/windows/dinput/constants/constants.factor | 9 +++++++--
basis/windows/types/types.factor | 4 +++-
basis/windows/winsock/winsock.factor | 1 +
3 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor
index b67b5fa08f..270c2fa3dd 100755
--- a/basis/windows/dinput/constants/constants.factor
+++ b/basis/windows/dinput/constants/constants.factor
@@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
combinators sequences fry math accessors macros words quotations
libc continuations generalizations splitting locals assocs init
-specialized-arrays memoize classes.struct ;
+specialized-arrays memoize classes.struct strings arrays ;
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.dinput.constants
@@ -22,12 +22,17 @@ SYMBOLS:
MEMO: c-type* ( name -- c-type ) c-type ;
MEMO: heap-size* ( c-type -- n ) heap-size ;
+GENERIC: array-base-type ( c-type -- c-type' )
+M: object array-base-type ;
+M: string array-base-type "[" split1 drop ;
+M: array array-base-type first ;
+
: (field-spec-of) ( field struct -- field-spec )
c-type* fields>> [ name>> = ] with find nip ;
: (offsetof) ( field struct -- offset )
[ (field-spec-of) offset>> ] [ drop 0 ] if* ;
: (sizeof) ( field struct -- size )
- [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ;
+ [ (field-spec-of) type>> array-base-type heap-size* ] [ drop 1 ] if* ;
: (flag) ( thing -- integer )
{
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index c882ba2e7f..544abb69a8 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -3,6 +3,7 @@
USING: alien alien.c-types alien.syntax namespaces kernel words
sequences math math.bitwise math.vectors colors
io.encodings.utf16n classes.struct accessors ;
+FROM: alien.c-types => float short ;
IN: windows.types
TYPEDEF: char CHAR
@@ -69,7 +70,8 @@ TYPEDEF: ulonglong ULARGE_INTEGER
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
-<< { "char*" utf16n } "wchar_t*" typedef >>
+SYMBOL: wchar_t*
+<< { char* utf16n } \ wchar_t* typedef >>
TYPEDEF: wchar_t* LPCSTR
TYPEDEF: wchar_t* LPWSTR
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 87b8970b02..e29eb3e090 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -4,6 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel literals math sequences windows.types
windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
classes.struct windows.com.syntax init ;
+FROM: alien.c-types => short ;
IN: windows.winsock
TYPEDEF: void* SOCKET
From 4758cca22319f5c84a2ef623dde3e797fafd1a8b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 14:22:49 -0500
Subject: [PATCH 223/266] fix dinput device hotplug support
---
basis/game-input/dinput/dinput.factor | 17 +++++++++++------
1 file changed, 11 insertions(+), 6 deletions(-)
diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor
index ea3100f95f..a7489f26a2 100755
--- a/basis/game-input/dinput/dinput.factor
+++ b/basis/game-input/dinput/dinput.factor
@@ -160,19 +160,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
[ device-attached? not ] filter
[ remove-controller ] each ;
-: device-interface? ( dbt-broadcast-hdr -- ? )
- dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ;
+: ?device-interface ( dbt-broadcast-hdr -- ? )
+ dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE =
+ [ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ]
+ [ drop f ] if ; inline
: device-arrived ( dbt-broadcast-hdr -- )
- device-interface? [ find-controllers ] when ;
+ ?device-interface [ find-controllers ] when ; inline
: device-removed ( dbt-broadcast-hdr -- )
- device-interface? [ find-and-remove-detached-devices ] when ;
+ ?device-interface [ find-and-remove-detached-devices ] when ; inline
+
+: <DEV_BROADCAST_HDR> ( wParam -- struct )
+ <alien> DEV_BROADCAST_HDR memory>struct ;
: handle-wm-devicechange ( hWnd uMsg wParam lParam -- )
[ 2drop ] 2dip swap {
- { [ dup DBT_DEVICEARRIVAL = ] [ drop <alien> device-arrived ] }
- { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop <alien> device-removed ] }
+ { [ dup DBT_DEVICEARRIVAL = ] [ drop <DEV_BROADCAST_HDR> device-arrived ] }
+ { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop <DEV_BROADCAST_HDR> device-removed ] }
[ 2drop ]
} cond ;
From 086d4a87b4425dc4f717335ebc3d967cd40cef6d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 17 Sep 2009 13:09:45 -0700
Subject: [PATCH 224/266] fix recaptcha docs
---
basis/furnace/recaptcha/recaptcha-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/furnace/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor
index d416dd9474..e6473a4bf9 100644
--- a/basis/furnace/recaptcha/recaptcha-docs.factor
+++ b/basis/furnace/recaptcha/recaptcha-docs.factor
@@ -39,7 +39,7 @@ $nl
} ;
ARTICLE: "furnace.recaptcha" "Recaptcha"
-"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
+"The " { $vocab-link "furnace.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
From 7f1c33f363459329ecea66c837201fdd85b11879 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 17 Sep 2009 13:27:15 -0700
Subject: [PATCH 225/266] stack-checker.errors: improve documentation a bit
---
basis/stack-checker/errors/errors-docs.factor | 38 +++++++++++++++++--
1 file changed, 34 insertions(+), 4 deletions(-)
diff --git a/basis/stack-checker/errors/errors-docs.factor b/basis/stack-checker/errors/errors-docs.factor
index 6a67b815cd..e451c53c71 100755
--- a/basis/stack-checker/errors/errors-docs.factor
+++ b/basis/stack-checker/errors/errors-docs.factor
@@ -1,14 +1,43 @@
USING: help.markup help.syntax kernel effects sequences
-sequences.private words ;
+sequences.private words combinators ;
IN: stack-checker.errors
+HELP: do-not-compile
+{ $error-description "Thrown when inference encounters a macro being applied to a value which is not known to be a literal. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
+{ $examples
+ "In this example, " { $link cleave } " is being applied to an array that is constructed on the fly. This is not allowed and fails to compile with a " { $link do-not-compile } " error:"
+ { $code
+ ": cannot-compile-call-example ( x -- y z )"
+ " [ 1 + ] [ 1 - ] 2array cleave ;"
+ }
+} ;
+
HELP: literal-expected
{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known to be a literal, or constructed in a manner which can be analyzed statically. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
{ $examples
- "In this example, words calling " { $snippet "literal-expected-example" } " will have a static stac keffect, even if " { $snippet "literal-expected-example" } " does not:"
+ "In this example, the words being defined cannot be called, because they fail to compile with a " { $link literal-expected } " error:"
{ $code
- ": literal-expected-example ( quot -- )"
+ ": bad-example ( quot -- )"
+ " [ call ] [ call ] bi ;"
+ ""
+ ": usage ( -- )"
+ " 10 [ 2 * ] bad-example . ;"
+ }
+ "One fix is to declare the combinator as inline:"
+ { $code
+ ": good-example ( quot -- )"
" [ call ] [ call ] bi ; inline"
+ ""
+ ": usage ( -- )"
+ " 10 [ 2 * ] good-example . ;"
+ }
+ "Another fix is to use " { $link POSTPONE: call( } ":"
+ { $code
+ ": good-example ( quot -- )"
+ " [ call( x -- y ) ] [ call( x -- y ) ] bi ;"
+ ""
+ ": usage ( -- )"
+ " 10 [ 2 * ] good-example . ;"
}
} ;
@@ -89,7 +118,8 @@ ARTICLE: "inference-errors" "Stack checker errors"
{ { $link "tools.inference" } " throws them as errors" }
{ "The " { $link "compiler" } " reports them via " { $link "tools.errors" } }
}
-"Error thrown when insufficient information is available to calculate the stack effect of a combinator call (see " { $link "inference-combinators" } "):"
+"Errors thrown when insufficient information is available to calculate the stack effect of a call to a combinator or macro (see " { $link "inference-combinators" } "):"
+{ $subsection do-not-compile }
{ $subsection literal-expected }
"Error thrown when a word's stack effect declaration does not match the composition of the stack effects of its factors:"
{ $subsection effect-error }
From 6b502f6fe56d4ec63a08d5bb469dc0eec9bfc587 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 17 Sep 2009 14:07:08 -0700
Subject: [PATCH 226/266] combinators: clarify docs
---
core/combinators/combinators-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index 4a7fcea0e6..5d778ba1e4 100755
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -85,7 +85,7 @@ $nl
} ;
ARTICLE: "spread-combinators" "Spread combinators"
-"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading."
+"The spread combinators apply multiple quotations to multiple values. In this case, " { $snippet "*" } " suffix signify spreading."
$nl
"Two quotations:"
{ $subsection bi* }
From aa1edad0788d91f89965e3c82b51c1d8f6fbf698 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 19:10:40 -0500
Subject: [PATCH 227/266] disambiguate math:float in cpu.ppc
---
basis/cpu/ppc/ppc.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index f881ff5f91..063f3b37b1 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -9,6 +9,7 @@ compiler.codegen.fixup compiler.cfg.intrinsics
compiler.cfg.stack-frame compiler.cfg.build-stack-frame
compiler.units compiler.constants compiler.codegen ;
FROM: cpu.ppc.assembler => B ;
+FROM: math => float ;
IN: cpu.ppc
! PowerPC register assignments:
From 076ab42dc37caaa946769ec79faee57af0865bb3 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 17 Sep 2009 22:07:21 -0500
Subject: [PATCH 228/266] move some allocation words that don't really have
much to do with c types out of alien.c-types into a new alien.data vocab
---
basis/alien/arrays/arrays-docs.factor | 2 +-
basis/alien/arrays/arrays.factor | 4 +-
basis/alien/c-types/c-types-docs.factor | 181 ++----------------
basis/alien/c-types/c-types.factor | 105 ++--------
basis/alien/data/authors.txt | 1 +
basis/alien/data/data-docs.factor | 148 ++++++++++++++
basis/alien/data/data.factor | 83 ++++++++
basis/alien/data/summary.txt | 1 +
basis/alien/fortran/fortran-tests.factor | 4 +-
basis/alien/fortran/fortran.factor | 2 +-
.../remote-control/remote-control.factor | 2 +-
basis/alien/structs/structs-docs.factor | 2 +-
basis/alien/structs/structs-tests.factor | 2 +-
basis/bit-arrays/bit-arrays.factor | 2 +-
basis/checksums/openssl/openssl.factor | 6 +-
.../struct/prettyprint/prettyprint.factor | 2 +-
basis/classes/struct/struct-tests.factor | 2 +-
basis/classes/struct/struct.factor | 2 +-
basis/cocoa/enumeration/enumeration.factor | 11 +-
basis/cocoa/plists/plists.factor | 4 +-
basis/compiler/tests/intrinsics.factor | 2 +-
basis/cpu/ppc/ppc.factor | 2 +-
basis/db/postgresql/lib/lib.factor | 10 +-
basis/db/sqlite/lib/lib.factor | 2 +-
basis/environment/unix/unix.factor | 7 +-
basis/environment/winnt/winnt.factor | 11 +-
basis/game-input/dinput/dinput.factor | 2 +-
.../dinput/keys-array/keys-array.factor | 4 +-
basis/game-input/iokit/iokit.factor | 3 +-
basis/images/memory/memory.factor | 6 +-
.../windows/nt/privileges/privileges.factor | 2 +-
basis/io/buffers/buffers-tests.factor | 6 +-
basis/io/buffers/buffers.factor | 4 +-
basis/io/files/info/windows/windows.factor | 2 +-
basis/io/files/windows/windows.factor | 2 +-
basis/io/mmap/mmap.factor | 2 +-
basis/io/monitors/windows/nt/nt.factor | 4 +-
.../io/sockets/secure/openssl/openssl.factor | 8 +-
basis/io/sockets/sockets.factor | 2 +-
basis/io/sockets/unix/unix.factor | 2 +-
basis/io/sockets/windows/nt/nt.factor | 2 +-
basis/libc/libc.factor | 20 +-
basis/math/blas/matrices/matrices.factor | 14 +-
.../vectors/simd/intrinsics/intrinsics.factor | 2 +-
basis/opengl/shaders/shaders.factor | 2 +-
basis/random/windows/windows.factor | 2 +-
.../specialized-arrays-tests.factor | 2 +-
.../specialized-arrays.factor | 2 +-
basis/tools/deploy/config/config-docs.factor | 2 +-
basis/tools/disassembler/disassembler.factor | 2 +-
basis/tools/disassembler/udis/udis.factor | 2 +-
basis/ui/backend/cocoa/views/views.factor | 10 +-
basis/ui/backend/windows/windows.factor | 2 +-
basis/unix/process/process.factor | 6 +-
basis/unix/utilities/utilities.factor | 2 +-
basis/unix/utmpx/utmpx.factor | 8 +-
basis/windows/com/com.factor | 2 +-
basis/windows/com/wrapper/wrapper.factor | 12 +-
.../windows/dinput/constants/constants.factor | 9 +-
.../dragdrop-listener.factor | 9 +-
basis/windows/errors/errors.factor | 11 +-
basis/windows/offscreen/offscreen.factor | 6 +-
basis/windows/ole32/ole32.factor | 4 +-
basis/x11/xlib/xlib.factor | 6 +-
core/alien/strings/strings-tests.factor | 2 +-
extra/alien/inline/syntax/syntax-tests.factor | 2 +-
extra/alien/marshall/marshall-docs.factor | 2 +-
extra/alien/marshall/marshall.factor | 2 +-
extra/alien/marshall/private/private.factor | 2 +-
extra/alien/marshall/structs/structs.factor | 2 +-
extra/audio/wav/wav.factor | 2 +-
extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor | 2 +-
extra/ecdsa/ecdsa.factor | 2 +-
extra/gpu/render/render.factor | 2 +-
extra/gpu/shaders/shaders.factor | 14 +-
extra/gpu/state/state.factor | 6 +-
extra/half-floats/half-floats-tests.factor | 2 +-
extra/half-floats/half-floats.factor | 2 +-
extra/io/serial/unix/unix.factor | 7 +-
extra/memory/piles/piles.factor | 2 +-
extra/system-info/windows/ce/ce.factor | 2 +-
81 files changed, 427 insertions(+), 416 deletions(-)
create mode 100644 basis/alien/data/authors.txt
create mode 100644 basis/alien/data/data-docs.factor
create mode 100644 basis/alien/data/data.factor
create mode 100644 basis/alien/data/summary.txt
diff --git a/basis/alien/arrays/arrays-docs.factor b/basis/alien/arrays/arrays-docs.factor
index db4a7bf595..74174485fe 100755
--- a/basis/alien/arrays/arrays-docs.factor
+++ b/basis/alien/arrays/arrays-docs.factor
@@ -1,5 +1,5 @@
+USING: help.syntax help.markup byte-arrays alien.c-types alien.data ;
IN: alien.arrays
-USING: help.syntax help.markup byte-arrays alien.c-types ;
ARTICLE: "c-arrays" "C arrays"
"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."
diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index 52c6afa4df..ee75d22c2c 100755
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.strings alien.c-types alien.accessors
-arrays words sequences math kernel namespaces fry libc cpu.architecture
+USING: alien alien.strings alien.c-types alien.data alien.accessors
+arrays words sequences math kernel namespaces fry cpu.architecture
io.encodings.utf8 accessors ;
IN: alien.arrays
diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor
index d9e1f7124a..a9613d2c9f 100755
--- a/basis/alien/c-types/c-types-docs.factor
+++ b/basis/alien/c-types/c-types-docs.factor
@@ -1,7 +1,25 @@
-IN: alien.c-types
USING: alien help.syntax help.markup libc kernel.private
byte-arrays math strings hashtables alien.syntax alien.strings sequences
io.encodings.string debugger destructors vocabs.loader ;
+IN: alien.c-types
+
+HELP: byte-length
+{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
+{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
+
+HELP: heap-size
+{ $values { "type" string } { "size" integer } }
+{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
+{ $examples
+ "On a 32-bit system, you will get the following output:"
+ { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" }
+}
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
+
+HELP: stack-size
+{ $values { "type" string } { "size" integer } }
+{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
HELP: <c-type>
{ $values { "type" hashtable } }
@@ -20,24 +38,6 @@ HELP: c-type
{ $description "Looks up a C type by name." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-HELP: heap-size
-{ $values { "type" string } { "size" integer } }
-{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
-{ $examples
- "On a 32-bit system, you will get the following output:"
- { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" }
-}
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-
-HELP: stack-size
-{ $values { "type" string } { "size" integer } }
-{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-
-HELP: byte-length
-{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
-{ $contract "Outputs the size of the byte array or float array data in bytes as presented to the C library interface." } ;
-
HELP: c-getter
{ $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } }
{ $description "Outputs a quotation which reads values of this C type from a C structure." }
@@ -48,49 +48,6 @@ HELP: c-setter
{ $description "Outputs a quotation which writes values of this C type to a C structure." }
{ $errors "Throws an error if the type does not exist." } ;
-HELP: <c-array>
-{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
-{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
-{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
-
-HELP: <c-object>
-{ $values { "type" "a C type" } { "array" byte-array } }
-{ $description "Creates a byte array suitable for holding a value with the given C type." }
-{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
-
-{ <c-object> malloc-object } related-words
-
-HELP: memory>byte-array
-{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
-{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
-
-HELP: byte-array>memory
-{ $values { "byte-array" byte-array } { "base" c-ptr } }
-{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
-{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
-
-HELP: malloc-array
-{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
-
-HELP: malloc-object
-{ $values { "type" "a C type" } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ;
-
-HELP: malloc-byte-array
-{ $values { "byte-array" byte-array } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if memory allocation fails." } ;
-
-{ <c-array> <c-direct-array> malloc-array } related-words
-
HELP: box-parameter
{ $values { "n" integer } { "ctype" string } }
{ $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
@@ -116,48 +73,6 @@ HELP: define-out
{ $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
-{ string>alien alien>string malloc-string } related-words
-
-HELP: malloc-string
-{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
-{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if one of the following conditions occurs:"
- { $list
- "the string contains null code points"
- "the string contains characters not representable using the encoding specified"
- "memory allocation fails"
- }
-} ;
-
-HELP: require-c-array
-{ $values { "c-type" "a C type" } }
-{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
-{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
-
-HELP: <c-direct-array>
-{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
-{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
-
-ARTICLE: "c-strings" "C strings"
-"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
-$nl
-"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
-$nl
-"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
-$nl
-"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
-$nl
-"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
-{ $subsection string>alien }
-{ $subsection malloc-string }
-"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
-$nl
-"A word to read strings from arbitrary addresses:"
-{ $subsection alien>string }
-"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
-
ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
$nl
@@ -234,61 +149,3 @@ $nl
"Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation."
$nl
"Structure and union types are specified by the name of the structure or union." ;
-
-ARTICLE: "c-byte-arrays" "Passing data in byte arrays"
-"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array."
-$nl
-"Byte arrays can be allocated directly with a byte count using the " { $link <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
-{ $subsection <c-object> }
-{ $subsection <c-array> }
-{ $warning
-"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." }
-{ $see-also "c-arrays" } ;
-
-ARTICLE: "malloc" "Manual memory management"
-"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case."
-$nl
-"Allocating a C datum with a fixed address:"
-{ $subsection malloc-object }
-{ $subsection malloc-array }
-{ $subsection malloc-byte-array }
-"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:"
-{ $subsection malloc }
-{ $subsection calloc }
-{ $subsection realloc }
-"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
-{ $subsection free }
-"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
-{ $subsection &free }
-{ $subsection |free }
-"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
-$nl
-"You can unsafely copy a range of bytes from one memory location to another:"
-{ $subsection memcpy }
-"You can copy a range of bytes from memory into a byte array:"
-{ $subsection memory>byte-array }
-"You can copy a byte array to memory unsafely:"
-{ $subsection byte-array>memory } ;
-
-ARTICLE: "c-data" "Passing data between Factor and C"
-"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
-$nl
-"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
-{ $subsection "c-types-specs" }
-{ $subsection "c-byte-arrays" }
-{ $subsection "malloc" }
-{ $subsection "c-strings" }
-{ $subsection "c-arrays" }
-{ $subsection "c-out-params" }
-"Important guidelines for passing data in byte arrays:"
-{ $subsection "byte-arrays-gc" }
-"C-style enumerated types are supported:"
-{ $subsection POSTPONE: C-ENUM: }
-"C types can be aliased for convenience and consitency with native library documentation:"
-{ $subsection POSTPONE: TYPEDEF: }
-"New C types can be defined:"
-{ $subsection "c-structs" }
-{ $subsection "c-unions" }
-"A utility for defining " { $link "destructors" } " for deallocating memory:"
-{ $subsection "alien.destructors" }
-{ $see-also "aliens" } ;
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 6d63987265..fa27e29c04 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays arrays assocs kernel kernel.private libc math
+USING: byte-arrays arrays assocs kernel kernel.private math
namespaces make parser sequences strings words splitting math.parser
cpu.architecture alien alien.accessors alien.strings quotations
layouts system compiler.units io io.files io.encodings.binary
@@ -22,8 +22,6 @@ SYMBOLS:
DEFER: <int>
DEFER: *char
-: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
-
TUPLE: abstract-c-type
{ class class initial: object }
{ boxed-class class initial: object }
@@ -104,43 +102,6 @@ M: c-type-name c-struct?
! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the
! size facilitates some optimizations.
-GENERIC: heap-size ( type -- size ) foldable
-
-M: c-type-name heap-size c-type heap-size ;
-
-M: abstract-c-type heap-size size>> ;
-
-GENERIC: require-c-array ( c-type -- )
-
-M: array require-c-array first require-c-array ;
-
-GENERIC: c-array-constructor ( c-type -- word )
-
-GENERIC: c-(array)-constructor ( c-type -- word )
-
-GENERIC: c-direct-array-constructor ( c-type -- word )
-
-GENERIC: <c-array> ( len c-type -- array )
-
-M: c-type-name <c-array>
- c-array-constructor execute( len -- array ) ; inline
-
-GENERIC: (c-array) ( len c-type -- array )
-
-M: c-type-name (c-array)
- c-(array)-constructor execute( len -- array ) ; inline
-
-GENERIC: <c-direct-array> ( alien len c-type -- array )
-
-M: c-type-name <c-direct-array>
- c-direct-array-constructor execute( alien len -- array ) ; inline
-
-: malloc-array ( n type -- alien )
- [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
-
-: (malloc-array) ( n type -- alien )
- [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
-
GENERIC: c-type-class ( name -- class )
M: abstract-c-type c-type-class class>> ;
@@ -239,29 +200,28 @@ M: c-type unbox-return f swap c-type-unbox ;
M: c-type-name unbox-return c-type unbox-return ;
+: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
+
+GENERIC: heap-size ( type -- size ) foldable
+
+M: c-type-name heap-size c-type heap-size ;
+
+M: abstract-c-type heap-size size>> ;
+
GENERIC: stack-size ( type -- size ) foldable
M: c-type-name stack-size c-type stack-size ;
M: c-type stack-size size>> cell align ;
-MIXIN: value-type
-
-M: value-type c-type-rep drop int-rep ;
-
-M: value-type c-type-getter
- drop [ swap <displaced-alien> ] ;
-
-M: value-type c-type-setter ( type -- quot )
- [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
- '[ @ swap @ _ memcpy ] ;
-
GENERIC: byte-length ( seq -- n ) flushable
M: byte-array byte-length length ; inline
M: f byte-length drop 0 ; inline
+MIXIN: value-type
+
: c-getter ( name -- quot )
c-type-getter [
[ "Cannot read struct fields with this type" throw ]
@@ -275,36 +235,6 @@ M: f byte-length drop 0 ; inline
[ "Cannot write struct fields with this type" throw ]
] unless* ;
-: <c-object> ( type -- array )
- heap-size <byte-array> ; inline
-
-: (c-object) ( type -- array )
- heap-size (byte-array) ; inline
-
-: malloc-object ( type -- alien )
- 1 swap heap-size calloc ; inline
-
-: (malloc-object) ( type -- alien )
- heap-size malloc ; inline
-
-: malloc-byte-array ( byte-array -- alien )
- dup byte-length [ nip malloc dup ] 2keep memcpy ;
-
-: memory>byte-array ( alien len -- byte-array )
- [ nip (byte-array) dup ] 2keep memcpy ;
-
-: malloc-string ( string encoding -- alien )
- string>alien malloc-byte-array ;
-
-M: memory-stream stream-read
- [
- [ index>> ] [ alien>> ] bi <displaced-alien>
- swap memory>byte-array
- ] [ [ + ] change-index drop ] 2bi ;
-
-: byte-array>memory ( byte-array base -- )
- swap dup byte-length memcpy ; inline
-
: array-accessor ( type quot -- def )
[
\ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
@@ -352,22 +282,15 @@ M: long-long-type box-return ( type -- )
: define-out ( name -- )
[ "alien.c-types" constructor-word ]
- [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
+ [ dup c-setter '[ _ heap-size <byte-array> [ 0 @ ] keep ] ] bi
(( value -- c-ptr )) define-inline ;
-: >c-bool ( ? -- int ) 1 0 ? ; inline
-
-: c-bool> ( int -- ? ) 0 = not ; inline
-
: define-primitive-type ( type name -- )
[ typedef ]
[ name>> define-deref ]
[ name>> define-out ]
tri ;
-: malloc-file-contents ( path -- alien len )
- binary file-contents [ malloc-byte-array ] [ length ] bi ;
-
: if-void ( type true false -- )
pick void? [ drop nip call ] [ nip call ] if ; inline
@@ -510,8 +433,8 @@ SYMBOLS:
\ uchar define-primitive-type
<c-type>
- [ alien-unsigned-1 c-bool> ] >>getter
- [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
+ [ alien-unsigned-1 0 = not ] >>getter
+ [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
"box_boolean" >>boxer
diff --git a/basis/alien/data/authors.txt b/basis/alien/data/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/alien/data/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor
new file mode 100644
index 0000000000..19bfaaa8ce
--- /dev/null
+++ b/basis/alien/data/data-docs.factor
@@ -0,0 +1,148 @@
+USING: alien alien.c-types help.syntax help.markup libc kernel.private
+byte-arrays math strings hashtables alien.syntax alien.strings sequences
+io.encodings.string debugger destructors vocabs.loader ;
+IN: alien.data
+
+HELP: <c-array>
+{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
+{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
+
+HELP: <c-object>
+{ $values { "type" "a C type" } { "array" byte-array } }
+{ $description "Creates a byte array suitable for holding a value with the given C type." }
+{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
+
+{ <c-object> malloc-object } related-words
+
+HELP: memory>byte-array
+{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
+{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
+
+HELP: byte-array>memory
+{ $values { "byte-array" byte-array } { "base" c-ptr } }
+{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
+{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
+
+HELP: malloc-array
+{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
+
+HELP: malloc-object
+{ $values { "type" "a C type" } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ;
+
+HELP: malloc-byte-array
+{ $values { "byte-array" byte-array } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if memory allocation fails." } ;
+
+{ <c-array> <c-direct-array> malloc-array } related-words
+
+{ string>alien alien>string malloc-string } related-words
+
+ARTICLE: "malloc" "Manual memory management"
+"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case."
+$nl
+"Allocating a C datum with a fixed address:"
+{ $subsection malloc-object }
+{ $subsection malloc-array }
+{ $subsection malloc-byte-array }
+"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:"
+{ $subsection malloc }
+{ $subsection calloc }
+{ $subsection realloc }
+"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
+{ $subsection free }
+"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
+{ $subsection &free }
+{ $subsection |free }
+"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
+$nl
+"You can unsafely copy a range of bytes from one memory location to another:"
+{ $subsection memcpy }
+"You can copy a range of bytes from memory into a byte array:"
+{ $subsection memory>byte-array }
+"You can copy a byte array to memory unsafely:"
+{ $subsection byte-array>memory } ;
+
+
+ARTICLE: "c-byte-arrays" "Passing data in byte arrays"
+"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array."
+$nl
+"Byte arrays can be allocated directly with a byte count using the " { $link <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
+{ $subsection <c-object> }
+{ $subsection <c-array> }
+{ $warning
+"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." }
+{ $see-also "c-arrays" } ;
+
+ARTICLE: "c-data" "Passing data between Factor and C"
+"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
+$nl
+"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
+{ $subsection "c-types-specs" }
+{ $subsection "c-byte-arrays" }
+{ $subsection "malloc" }
+{ $subsection "c-strings" }
+{ $subsection "c-arrays" }
+{ $subsection "c-out-params" }
+"Important guidelines for passing data in byte arrays:"
+{ $subsection "byte-arrays-gc" }
+"C-style enumerated types are supported:"
+{ $subsection POSTPONE: C-ENUM: }
+"C types can be aliased for convenience and consitency with native library documentation:"
+{ $subsection POSTPONE: TYPEDEF: }
+"New C types can be defined:"
+{ $subsection "c-structs" }
+{ $subsection "c-unions" }
+"A utility for defining " { $link "destructors" } " for deallocating memory:"
+{ $subsection "alien.destructors" }
+{ $see-also "aliens" } ;
+HELP: malloc-string
+{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
+{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if one of the following conditions occurs:"
+ { $list
+ "the string contains null code points"
+ "the string contains characters not representable using the encoding specified"
+ "memory allocation fails"
+ }
+} ;
+
+HELP: require-c-array
+{ $values { "c-type" "a C type" } }
+{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
+{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
+
+HELP: <c-direct-array>
+{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
+{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
+
+ARTICLE: "c-strings" "C strings"
+"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
+$nl
+"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
+$nl
+"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
+$nl
+"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
+$nl
+"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
+{ $subsection string>alien }
+{ $subsection malloc-string }
+"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
+$nl
+"A word to read strings from arbitrary addresses:"
+{ $subsection alien>string }
+"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+
diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor
new file mode 100644
index 0000000000..1f2c5160e1
--- /dev/null
+++ b/basis/alien/data/data.factor
@@ -0,0 +1,83 @@
+! (c)2009 Slava Pestov, Joe Groff bsd license
+USING: accessors alien alien.c-types alien.strings arrays
+byte-arrays cpu.architecture fry io io.encodings.binary
+io.files io.streams.memory kernel libc math sequences ;
+IN: alien.data
+
+GENERIC: require-c-array ( c-type -- )
+
+M: array require-c-array first require-c-array ;
+
+GENERIC: c-array-constructor ( c-type -- word )
+
+GENERIC: c-(array)-constructor ( c-type -- word )
+
+GENERIC: c-direct-array-constructor ( c-type -- word )
+
+GENERIC: <c-array> ( len c-type -- array )
+
+M: c-type-name <c-array>
+ c-array-constructor execute( len -- array ) ; inline
+
+GENERIC: (c-array) ( len c-type -- array )
+
+M: c-type-name (c-array)
+ c-(array)-constructor execute( len -- array ) ; inline
+
+GENERIC: <c-direct-array> ( alien len c-type -- array )
+
+M: c-type-name <c-direct-array>
+ c-direct-array-constructor execute( alien len -- array ) ; inline
+
+: malloc-array ( n type -- alien )
+ [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
+
+: (malloc-array) ( n type -- alien )
+ [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
+
+: <c-object> ( type -- array )
+ heap-size <byte-array> ; inline
+
+: (c-object) ( type -- array )
+ heap-size (byte-array) ; inline
+
+: malloc-object ( type -- alien )
+ 1 swap heap-size calloc ; inline
+
+: (malloc-object) ( type -- alien )
+ heap-size malloc ; inline
+
+: malloc-byte-array ( byte-array -- alien )
+ dup byte-length [ nip malloc dup ] 2keep memcpy ;
+
+: memory>byte-array ( alien len -- byte-array )
+ [ nip (byte-array) dup ] 2keep memcpy ;
+
+: malloc-string ( string encoding -- alien )
+ string>alien malloc-byte-array ;
+
+: malloc-file-contents ( path -- alien len )
+ binary file-contents [ malloc-byte-array ] [ length ] bi ;
+
+M: memory-stream stream-read
+ [
+ [ index>> ] [ alien>> ] bi <displaced-alien>
+ swap memory>byte-array
+ ] [ [ + ] change-index drop ] 2bi ;
+
+: byte-array>memory ( byte-array base -- )
+ swap dup byte-length memcpy ; inline
+
+: >c-bool ( ? -- int ) 1 0 ? ; inline
+
+: c-bool> ( int -- ? ) 0 = not ; inline
+
+M: value-type c-type-rep drop int-rep ;
+
+M: value-type c-type-getter
+ drop [ swap <displaced-alien> ] ;
+
+M: value-type c-type-setter ( type -- quot )
+ [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
+ '[ @ swap @ _ memcpy ] ;
+
diff --git a/basis/alien/data/summary.txt b/basis/alien/data/summary.txt
new file mode 100644
index 0000000000..addddb2da4
--- /dev/null
+++ b/basis/alien/data/summary.txt
@@ -0,0 +1 @@
+Words for allocating objects and arrays of C types
diff --git a/basis/alien/fortran/fortran-tests.factor b/basis/alien/fortran/fortran-tests.factor
index 9d893b95c4..238207f192 100644
--- a/basis/alien/fortran/fortran-tests.factor
+++ b/basis/alien/fortran/fortran-tests.factor
@@ -1,7 +1,7 @@
! (c) 2009 Joe Groff, see BSD license
USING: accessors alien alien.c-types alien.complex
-alien.fortran alien.fortran.private alien.strings classes.struct
-arrays assocs byte-arrays combinators fry
+alien.data alien.fortran alien.fortran.private alien.strings
+classes.struct arrays assocs byte-arrays combinators fry
generalizations io.encodings.ascii kernel macros
macros.expander namespaces sequences shuffle tools.test ;
IN: alien.fortran.tests
diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor
index 3670a376e1..bf8721b549 100644
--- a/basis/alien/fortran/fortran.factor
+++ b/basis/alien/fortran/fortran.factor
@@ -1,5 +1,5 @@
! (c) 2009 Joe Groff, see BSD license
-USING: accessors alien alien.c-types alien.complex grouping
+USING: accessors alien alien.c-types alien.complex alien.data grouping
alien.strings alien.syntax arrays ascii assocs
byte-arrays combinators combinators.short-circuit fry generalizations
kernel lexer macros math math.parser namespaces parser sequences
diff --git a/basis/alien/remote-control/remote-control.factor b/basis/alien/remote-control/remote-control.factor
index b72c79e478..4ccd0e7488 100644
--- a/basis/alien/remote-control/remote-control.factor
+++ b/basis/alien/remote-control/remote-control.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings parser
+USING: accessors alien alien.data alien.strings parser
threads words kernel.private kernel io.encodings.utf8 eval ;
IN: alien.remote-control
diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor
index 62a3817fec..d0485ae4ba 100644
--- a/basis/alien/structs/structs-docs.factor
+++ b/basis/alien/structs/structs-docs.factor
@@ -1,4 +1,4 @@
-USING: alien.c-types strings help.markup help.syntax alien.syntax
+USING: alien.c-types alien.data strings help.markup help.syntax alien.syntax
sequences io arrays kernel words assocs namespaces ;
IN: alien.structs
diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor
index 3f84377d5c..d22aa5ee45 100755
--- a/basis/alien/structs/structs-tests.factor
+++ b/basis/alien/structs/structs-tests.factor
@@ -1,4 +1,4 @@
-USING: alien alien.syntax alien.c-types kernel tools.test
+USING: alien alien.syntax alien.c-types alien.data kernel tools.test
sequences system libc words vocabs namespaces layouts ;
IN: alien.structs.tests
diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor
index 0f87cf4cb6..f5613da6b5 100644
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types accessors math alien.accessors kernel
+USING: alien.c-types alien.data accessors math alien.accessors kernel
kernel.private sequences sequences.private byte-arrays
parser prettyprint.custom fry ;
IN: bit-arrays
diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor
index 6f21d96e86..673500b62a 100644
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays alien.c-types kernel continuations
-destructors sequences io openssl openssl.libcrypto checksums
-checksums.stream ;
+USING: accessors byte-arrays alien.c-types alien.data kernel
+continuations destructors sequences io openssl openssl.libcrypto
+checksums checksums.stream ;
IN: checksums.openssl
ERROR: unknown-digest name ;
diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor
index 7f57e8568a..43d24e5716 100644
--- a/basis/classes/struct/prettyprint/prettyprint.factor
+++ b/basis/classes/struct/prettyprint/prettyprint.factor
@@ -1,5 +1,5 @@
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.prettyprint arrays
+USING: accessors alien alien.c-types alien.data alien.prettyprint arrays
assocs classes classes.struct combinators combinators.short-circuit
continuations fry kernel libc make math math.parser mirrors
prettyprint.backend prettyprint.custom prettyprint.sections
diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index e9e45487f9..b60bfa375b 100755
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -1,5 +1,5 @@
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types ascii
+USING: accessors alien alien.c-types alien.data ascii
assocs byte-arrays classes.struct classes.tuple.private
combinators compiler.tree.debugger compiler.units destructors
io.encodings.utf8 io.pathnames io.streams.string kernel libc
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index dabdead10c..7e99328652 100755
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -1,5 +1,5 @@
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.parser arrays
+USING: accessors alien alien.c-types alien.data alien.parser arrays
byte-arrays classes classes.parser classes.tuple classes.tuple.parser
classes.tuple.private combinators combinators.short-circuit
combinators.smart cpu.architecture definitions functors.backend
diff --git a/basis/cocoa/enumeration/enumeration.factor b/basis/cocoa/enumeration/enumeration.factor
index caa83331ab..c7bdf625d9 100755
--- a/basis/cocoa/enumeration/enumeration.factor
+++ b/basis/cocoa/enumeration/enumeration.factor
@@ -1,17 +1,16 @@
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types
-locals math sequences vectors fry libc destructors ;
+USING: accessors kernel classes.struct cocoa cocoa.runtime cocoa.types alien.data
+locals math sequences vectors fry libc destructors specialized-arrays ;
+SPECIALIZED-ARRAY: id
IN: cocoa.enumeration
-<< "id" require-c-array >>
-
CONSTANT: NS-EACH-BUFFER-SIZE 16
: with-enumeration-buffers ( quot -- )
'[
NSFastEnumerationState malloc-struct &free
- NS-EACH-BUFFER-SIZE "id" malloc-array &free
+ NS-EACH-BUFFER-SIZE id malloc-array &free
NS-EACH-BUFFER-SIZE
@
] with-destructors ; inline
@@ -19,7 +18,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
:: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
items-count 0 = [
- state itemsPtr>> [ items-count "id" <c-direct-array> ] [ stackbuf ] if* :> items
+ state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
items-count iota [ items nth quot call ] each
object quot state stackbuf count (NSFastEnumeration-each)
] unless ; inline recursive
diff --git a/basis/cocoa/plists/plists.factor b/basis/cocoa/plists/plists.factor
index ceb097bb3a..86b13b2ddc 100644
--- a/basis/cocoa/plists/plists.factor
+++ b/basis/cocoa/plists/plists.factor
@@ -4,8 +4,8 @@
USING: strings arrays hashtables assocs sequences fry macros
cocoa.messages cocoa.classes cocoa.application cocoa kernel
namespaces io.backend math cocoa.enumeration byte-arrays
-combinators alien.c-types words core-foundation quotations
-core-foundation.data core-foundation.utilities ;
+combinators alien.c-types alien.data words core-foundation
+quotations core-foundation.data core-foundation.utilities ;
IN: cocoa.plists
: >plist ( value -- plist ) >cf -> autorelease ;
diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index dc2f5d9257..24114e0ccb 100644
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -3,7 +3,7 @@ math math.constants math.private math.integers.private sequences
strings tools.test words continuations sequences.private
hashtables.private byte-arrays system random layouts vectors
sbufs strings.private slots.private alien math.order
-alien.accessors alien.c-types alien.syntax alien.strings
+alien.accessors alien.c-types alien.data alien.syntax alien.strings
namespaces libc io.encodings.ascii classes compiler ;
FROM: math => float ;
IN: compiler.tests.intrinsics
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 063f3b37b1..72ad543307 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel combinators make math
math.order math.ranges system namespaces locals layouts words
-alien alien.accessors alien.c-types literals cpu.architecture
+alien alien.accessors alien.c-types alien.data literals cpu.architecture
cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.comparisons
compiler.codegen.fixup compiler.cfg.intrinsics
diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor
index 2278afe4ed..5398e669ed 100644
--- a/basis/db/postgresql/lib/lib.factor
+++ b/basis/db/postgresql/lib/lib.factor
@@ -2,11 +2,11 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations db io kernel math namespaces
quotations sequences db.postgresql.ffi alien alien.c-types
-db.types tools.walker ascii splitting math.parser combinators
-libc calendar.format byte-arrays destructors prettyprint
-accessors strings serialize io.encodings.binary io.encodings.utf8
-alien.strings io.streams.byte-array summary present urls
-specialized-arrays db.private ;
+alien.data db.types tools.walker ascii splitting math.parser
+combinators libc calendar.format byte-arrays destructors
+prettyprint accessors strings serialize io.encodings.binary
+io.encodings.utf8 alien.strings io.streams.byte-array summary
+present urls specialized-arrays db.private ;
SPECIALIZED-ARRAY: uint
SPECIALIZED-ARRAY: void*
IN: db.postgresql.lib
diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor
index 3565b09856..163026f5ff 100644
--- a/basis/db/sqlite/lib/lib.factor
+++ b/basis/db/sqlite/lib/lib.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays assocs kernel math math.parser
+USING: alien.c-types alien.data arrays assocs kernel math math.parser
namespaces sequences db.sqlite.ffi db combinators
continuations db.types calendar.format serialize
io.streams.byte-array byte-arrays io.encodings.binary
diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor
index 84dfbbd43e..3fc8c2f79b 100644
--- a/basis/environment/unix/unix.factor
+++ b/basis/environment/unix/unix.factor
@@ -1,8 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax kernel
-layouts sequences system unix environment io.encodings.utf8
-unix.utilities vocabs.loader combinators alien.accessors ;
+USING: alien alien.c-types alien.data alien.strings
+alien.syntax kernel layouts sequences system unix
+environment io.encodings.utf8 unix.utilities vocabs.loader
+combinators alien.accessors ;
IN: environment.unix
HOOK: environ os ( -- void* )
diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor
index 518a7d5d7a..cba92a0e3c 100755
--- a/basis/environment/winnt/winnt.factor
+++ b/basis/environment/winnt/winnt.factor
@@ -1,15 +1,14 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings fry io.encodings.utf16n kernel
-splitting windows windows.kernel32 system environment
-alien.c-types sequences windows.errors io.streams.memory
-io.encodings io ;
+splitting windows windows.kernel32 windows.types system
+environment alien.data sequences windows.errors
+io.streams.memory io.encodings io ;
+SPECIALIZED-ARRAY: TCHAR
IN: environment.winnt
-<< "TCHAR" require-c-array >>
-
M: winnt os-env ( key -- value )
- MAX_UNICODE_PATH "TCHAR" <c-array>
+ MAX_UNICODE_PATH TCHAR <c-array>
[ dup length GetEnvironmentVariable ] keep over 0 = [
2drop f
] [
diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor
index a7489f26a2..16bea60ea5 100755
--- a/basis/game-input/dinput/dinput.factor
+++ b/basis/game-input/dinput/dinput.factor
@@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle
specialized-arrays ui.backend.windows vectors windows.com
windows.dinput windows.dinput.constants windows.errors
windows.kernel32 windows.messages windows.ole32
-windows.user32 classes.struct ;
+windows.user32 classes.struct alien.data ;
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
IN: game-input.dinput
diff --git a/basis/game-input/dinput/keys-array/keys-array.factor b/basis/game-input/dinput/keys-array/keys-array.factor
index 9a84747dd8..a8813b0397 100755
--- a/basis/game-input/dinput/keys-array/keys-array.factor
+++ b/basis/game-input/dinput/keys-array/keys-array.factor
@@ -1,5 +1,5 @@
-USING: sequences sequences.private math alien.c-types
-accessors ;
+USING: sequences sequences.private math
+accessors alien.data ;
IN: game-input.dinput.keys-array
TUPLE: keys-array
diff --git a/basis/game-input/iokit/iokit.factor b/basis/game-input/iokit/iokit.factor
index 71d547ad29..85f058f283 100755
--- a/basis/game-input/iokit/iokit.factor
+++ b/basis/game-input/iokit/iokit.factor
@@ -3,7 +3,8 @@ kernel cocoa.enumeration destructors math.parser cocoa.application
sequences locals combinators.short-circuit threads
namespaces assocs arrays combinators hints alien
core-foundation.run-loop accessors sequences.private
-alien.c-types math parser game-input vectors bit-arrays ;
+alien.c-types alien.data math parser game-input vectors
+bit-arrays ;
IN: game-input.iokit
SINGLETON: iokit-game-input-backend
diff --git a/basis/images/memory/memory.factor b/basis/images/memory/memory.factor
index 1a977b604e..ccf891d770 100644
--- a/basis/images/memory/memory.factor
+++ b/basis/images/memory/memory.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types destructors fry images kernel
-libc math sequences ;
+USING: accessors alien.c-types alien.data destructors fry images
+kernel libc math sequences ;
IN: images.memory
! Some code shared by core-graphics and cairo for constructing
@@ -27,4 +27,4 @@ PRIVATE>
: make-memory-bitmap ( dim quot -- image )
'[
[ malloc-bitmap-data ] keep _ [ <bitmap-image> ] 2bi
- ] with-destructors ; inline
\ No newline at end of file
+ ] with-destructors ; inline
diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor
index 57878ba75b..bb9e0edc33 100755
--- a/basis/io/backend/windows/nt/privileges/privileges.factor
+++ b/basis/io/backend/windows/nt/privileges/privileges.factor
@@ -1,4 +1,4 @@
-USING: alien alien.c-types alien.syntax arrays continuations
+USING: alien alien.c-types alien.data alien.syntax arrays continuations
destructors generic io.mmap io.ports io.backend.windows io.files.windows
kernel libc math math.bitwise namespaces quotations sequences windows
windows.advapi32 windows.kernel32 io.backend system accessors
diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor
index 4425e08106..d366df7c54 100644
--- a/basis/io/buffers/buffers-tests.factor
+++ b/basis/io/buffers/buffers-tests.factor
@@ -1,7 +1,7 @@
IN: io.buffers.tests
-USING: alien alien.c-types io.buffers kernel kernel.private libc
-sequences tools.test namespaces byte-arrays strings accessors
-destructors ;
+USING: alien alien.c-types alien.data io.buffers kernel
+kernel.private libc sequences tools.test namespaces byte-arrays
+strings accessors destructors ;
: buffer-set ( string buffer -- )
over >byte-array over ptr>> byte-array>memory
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 82c5326b1d..aa9cedf340 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -2,8 +2,8 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types
-alien.syntax kernel libc math sequences byte-arrays strings
-hints math.order destructors combinators ;
+alien.data alien.syntax kernel libc math sequences byte-arrays
+strings hints math.order destructors combinators ;
IN: io.buffers
TUPLE: buffer
diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor
index bb3a412669..5ae21fcfee 100755
--- a/basis/io/files/info/windows/windows.factor
+++ b/basis/io/files/info/windows/windows.factor
@@ -6,7 +6,7 @@ windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
calendar ascii combinators.short-circuit locals classes.struct
-specialized-arrays ;
+specialized-arrays alien.data ;
SPECIALIZED-ARRAY: ushort
IN: io.files.info.windows
diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor
index 43463bd3f1..ca5c9b3c4a 100755
--- a/basis/io/files/windows/windows.factor
+++ b/basis/io/files/windows/windows.factor
@@ -6,7 +6,7 @@ io.backend.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words system
destructors accessors math.bitwise continuations windows.errors
-arrays byte-arrays generalizations ;
+arrays byte-arrays generalizations alien.data ;
IN: io.files.windows
: open-file ( path access-mode create-mode flags -- handle )
diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor
index 704a585dd4..a866232760 100644
--- a/basis/io/mmap/mmap.factor
+++ b/basis/io/mmap/mmap.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors io.files io.files.info
io.backend kernel quotations system alien alien.accessors
-accessors vocabs.loader combinators alien.c-types
+accessors vocabs.loader combinators alien.c-types alien.data
math ;
IN: io.mmap
diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/nt/nt.factor
index 3d837d79d8..9cd8bc4df8 100755
--- a/basis/io/monitors/windows/nt/nt.factor
+++ b/basis/io/monitors/windows/nt/nt.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings libc destructors locals
-kernel math assocs namespaces make continuations sequences
+USING: alien alien.c-types alien.data alien.strings libc destructors
+locals kernel math assocs namespaces make continuations sequences
hashtables sorting arrays combinators math.bitwise strings
system accessors threads splitting io.backend io.backend.windows
io.backend.windows.nt io.files.windows.nt io.monitors io.ports
diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index 8f596da0bd..6d01a66cf0 100644
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays kernel sequences namespaces math
-math.order combinators init alien alien.c-types alien.strings
-libc continuations destructors summary splitting assocs random
-math.parser locals unicode.case openssl openssl.libcrypto
-openssl.libssl io.backend io.ports io.pathnames
+math.order combinators init alien alien.c-types alien.data
+alien.strings libc continuations destructors summary splitting
+assocs random math.parser locals unicode.case openssl
+openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames
io.encodings.8-bit io.timeouts io.sockets.secure ;
IN: io.sockets.secure.openssl
diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index 601d269d5c..a542575446 100755
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -6,7 +6,7 @@ arrays io.encodings io.ports io.streams.duplex io.encodings.ascii
alien.strings io.binary accessors destructors classes byte-arrays
parser alien.c-types math.parser splitting grouping math assocs
summary system vocabs.loader combinators present fry vocabs.parser
-classes.struct ;
+classes.struct alien.data ;
IN: io.sockets
<< {
diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor
index e892c6a7ef..fa46a71ca0 100755
--- a/basis/io/sockets/unix/unix.factor
+++ b/basis/io/sockets/unix/unix.factor
@@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix
io.streams.duplex io.backend io.pathnames io.sockets.private
io.files.private io.encodings.utf8 math.parser continuations
libc combinators system accessors destructors unix locals init
-classes.struct ;
+classes.struct alien.data ;
EXCLUDE: namespaces => bind ;
EXCLUDE: io => read write ;
diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor
index f423a42b65..7cc21c9611 100755
--- a/basis/io/sockets/windows/nt/nt.factor
+++ b/basis/io/sockets/windows/nt/nt.factor
@@ -1,4 +1,4 @@
-USING: alien alien.accessors alien.c-types byte-arrays
+USING: alien alien.accessors alien.c-types alien.data byte-arrays
continuations destructors io.ports io.timeouts io.sockets
io.sockets.private io namespaces io.streams.duplex
io.backend.windows io.sockets.windows io.backend.windows.nt
diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor
index 4142e40c68..fe56c83516 100644
--- a/basis/libc/libc.factor
+++ b/basis/libc/libc.factor
@@ -2,29 +2,29 @@
! Copyright (C) 2007, 2009 Slava Pestov
! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs continuations alien.destructors kernel
+USING: alien alien.c-types assocs continuations alien.destructors kernel
namespaces accessors sets summary destructors destructors.private ;
IN: libc
: errno ( -- int )
- "int" "factor" "err_no" { } alien-invoke ;
+ int "factor" "err_no" { } alien-invoke ;
: clear-errno ( -- )
- "void" "factor" "clear_err_no" { } alien-invoke ;
+ void "factor" "clear_err_no" { } alien-invoke ;
<PRIVATE
: (malloc) ( size -- alien )
- "void*" "libc" "malloc" { "ulong" } alien-invoke ;
+ void* "libc" "malloc" { ulong } alien-invoke ;
: (calloc) ( count size -- alien )
- "void*" "libc" "calloc" { "ulong" "ulong" } alien-invoke ;
+ void* "libc" "calloc" { ulong ulong } alien-invoke ;
: (free) ( alien -- )
- "void" "libc" "free" { "void*" } alien-invoke ;
+ void "libc" "free" { void* } alien-invoke ;
: (realloc) ( alien size -- newalien )
- "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
+ void* "libc" "realloc" { void* ulong } alien-invoke ;
! We stick malloc-ptr instances in the global disposables set
TUPLE: malloc-ptr value continuation ;
@@ -81,15 +81,15 @@ PRIVATE>
>c-ptr [ delete-malloc ] [ (free) ] bi ;
: memcpy ( dst src size -- )
- "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
+ void "libc" "memcpy" { void* void* ulong } alien-invoke ;
: memcmp ( a b size -- cmp )
- "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ;
+ int "libc" "memcmp" { void* void* ulong } alien-invoke ;
: memory= ( a b size -- ? )
memcmp 0 = ;
: strlen ( alien -- len )
- "size_t" "libc" "strlen" { "char*" } alien-invoke ;
+ size_t "libc" "strlen" { char* } alien-invoke ;
DESTRUCTOR: free
diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor
index 4212f32b2d..aa9681bb2e 100755
--- a/basis/math/blas/matrices/matrices.factor
+++ b/basis/math/blas/matrices/matrices.factor
@@ -1,10 +1,10 @@
-USING: accessors alien alien.c-types arrays byte-arrays combinators
-combinators.short-circuit fry kernel locals macros
-math math.blas.ffi math.blas.vectors math.blas.vectors.private
-math.complex math.functions math.order functors words
-sequences sequences.merged sequences.private shuffle
-parser prettyprint.backend prettyprint.custom ascii
-specialized-arrays ;
+USING: accessors alien alien.c-types alien.data arrays
+byte-arrays combinators combinators.short-circuit fry
+kernel locals macros math math.blas.ffi math.blas.vectors
+math.blas.vectors.private math.complex math.functions
+math.order functors words sequences sequences.merged
+sequences.private shuffle parser prettyprint.backend
+prettyprint.custom ascii specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor
index 28547f8cf9..914d1ef169 100644
--- a/basis/math/vectors/simd/intrinsics/intrinsics.factor
+++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel alien alien.c-types cpu.architecture libc ;
+USING: kernel alien alien.data cpu.architecture libc ;
IN: math.vectors.simd.intrinsics
ERROR: bad-simd-call ;
diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor
index 26ffd0cf88..562cbc91ce 100755
--- a/basis/opengl/shaders/shaders.factor
+++ b/basis/opengl/shaders/shaders.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces
-assocs alien alien.strings libc opengl math sequences combinators
+assocs alien alien.data alien.strings libc opengl math sequences combinators
macros arrays io.encodings.ascii fry specialized-arrays
destructors accessors ;
SPECIALIZED-ARRAY: uint
diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor
index 83b1fab0d0..d959b191c9 100644
--- a/basis/random/windows/windows.factor
+++ b/basis/random/windows/windows.factor
@@ -1,4 +1,4 @@
-USING: accessors alien.c-types byte-arrays
+USING: accessors alien.c-types alien.data byte-arrays
combinators.short-circuit continuations destructors init kernel
locals namespaces random windows.advapi32 windows.errors
windows.kernel32 math.bitwise ;
diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor
index e289efb077..5d88f42d50 100755
--- a/basis/specialized-arrays/specialized-arrays-tests.factor
+++ b/basis/specialized-arrays/specialized-arrays-tests.factor
@@ -4,7 +4,7 @@ specialized-arrays.private sequences alien.c-types accessors
kernel arrays combinators compiler compiler.units classes.struct
combinators.smart compiler.tree.debugger math libc destructors
sequences.private multiline eval words vocabs namespaces
-assocs prettyprint ;
+assocs prettyprint alien.data ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: int
diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index 0490ede304..6931c83677 100755
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.parser assocs
+USING: accessors alien alien.c-types alien.data alien.parser assocs
byte-arrays classes compiler.units functors kernel lexer libc math
math.vectors.specialization namespaces parser prettyprint.custom
sequences sequences.private strings summary vocabs vocabs.loader
diff --git a/basis/tools/deploy/config/config-docs.factor b/basis/tools/deploy/config/config-docs.factor
index bd612c644a..12016168fb 100644
--- a/basis/tools/deploy/config/config-docs.factor
+++ b/basis/tools/deploy/config/config-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax words alien.c-types assocs
+USING: help.markup help.syntax words alien.c-types alien.data assocs
kernel math ;
IN: tools.deploy.config
diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor
index 0a8ab0b116..16408c0eb8 100755
--- a/basis/tools/disassembler/disassembler.factor
+++ b/basis/tools/disassembler/disassembler.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays byte-arrays combinators
destructors generic io kernel libc math sequences system tr
-vocabs.loader words ;
+vocabs.loader words alien.data ;
IN: tools.disassembler
GENERIC: disassemble ( obj -- )
diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor
index 2f0456ab62..aaa54ae527 100755
--- a/basis/tools/disassembler/udis/udis.factor
+++ b/basis/tools/disassembler/udis/udis.factor
@@ -4,7 +4,7 @@ USING: tools.disassembler namespaces combinators
alien alien.syntax alien.c-types lexer parser kernel
sequences layouts math math.order alien.libraries
math.parser system make fry arrays libc destructors
-tools.disassembler.utils splitting ;
+tools.disassembler.utils splitting alien.data ;
IN: tools.disassembler.udis
<<
diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index 6ae56af030..a49d22735d 100644
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings arrays assocs
-cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes
-cocoa.views cocoa.application cocoa.pasteboard cocoa.types
-cocoa.windows sequences io.encodings.utf8 ui ui.private ui.gadgets
-ui.gadgets.private ui.gadgets.worlds ui.gestures
+USING: accessors alien alien.c-types alien.data alien.strings
+arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing
+cocoa.classes cocoa.views cocoa.application cocoa.pasteboard
+cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
core-foundation.strings core-graphics core-graphics.types threads
combinators math.rectangles ;
IN: ui.backend.cocoa.views
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 2be6e70df8..5e2c25ea30 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -13,7 +13,7 @@ opengl ui.render math.bitwise locals accessors math.rectangles
math.order calendar ascii sets io.encodings.utf16n
windows.errors literals ui.pixel-formats
ui.pixel-formats.private memoize classes
-specialized-arrays classes.struct ;
+specialized-arrays classes.struct alien.data ;
SPECIALIZED-ARRAY: POINT
IN: ui.backend.windows
diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor
index 131d8dda5d..2912f8b744 100644
--- a/basis/unix/process/process.factor
+++ b/basis/unix/process/process.factor
@@ -1,6 +1,6 @@
-USING: kernel alien.c-types alien.strings sequences math alien.syntax
-unix namespaces continuations threads assocs io.backend.unix
-io.encodings.utf8 unix.utilities fry ;
+USING: kernel alien.c-types alien.data alien.strings sequences
+math alien.syntax unix namespaces continuations threads assocs
+io.backend.unix io.encodings.utf8 unix.utilities fry ;
IN: unix.process
! Low-level Unix process launching utilities. These are used
diff --git a/basis/unix/utilities/utilities.factor b/basis/unix/utilities/utilities.factor
index 8d141ccb24..919b2ae8a2 100644
--- a/basis/unix/utilities/utilities.factor
+++ b/basis/unix/utilities/utilities.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings
+USING: alien alien.c-types alien.data alien.strings
combinators.short-circuit fry kernel layouts sequences accessors
specialized-arrays ;
IN: unix.utilities
diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor
index 6e72f7d114..f6ccf6858b 100644
--- a/basis/unix/utmpx/utmpx.factor
+++ b/basis/unix/utmpx/utmpx.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax combinators continuations
-io.encodings.string io.encodings.utf8 kernel sequences strings
-unix calendar system accessors unix.time calendar.unix
-vocabs.loader ;
+USING: alien.c-types alien.data alien.syntax combinators
+continuations io.encodings.string io.encodings.utf8 kernel
+sequences strings unix calendar system accessors unix.time
+calendar.unix vocabs.loader ;
IN: unix.utmpx
CONSTANT: EMPTY 0
diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor
index d485692a91..e06f5b6071 100644
--- a/basis/windows/com/com.factor
+++ b/basis/windows/com/com.factor
@@ -1,6 +1,6 @@
USING: alien alien.c-types alien.destructors windows.com.syntax
windows.ole32 windows.types continuations kernel alien.syntax
-libc destructors accessors ;
+libc destructors accessors alien.data ;
IN: windows.com
LIBRARY: ole32
diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index e69fc5b820..e4f0ef0654 100755
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -1,9 +1,9 @@
-USING: alien alien.c-types alien.accessors windows.com.syntax
-init windows.com.syntax.private windows.com continuations kernel
-namespaces windows.ole32 libc vocabs assocs accessors arrays
-sequences quotations combinators math words compiler.units
-destructors fry math.parser generalizations sets
-specialized-arrays windows.kernel32 classes.struct ;
+USING: alien alien.c-types alien.data alien.accessors
+windows.com.syntax init windows.com.syntax.private windows.com
+continuations kernel namespaces windows.ole32 libc vocabs
+assocs accessors arrays sequences quotations combinators math
+words compiler.units destructors fry math.parser generalizations
+sets specialized-arrays windows.kernel32 classes.struct ;
SPECIALIZED-ARRAY: void*
IN: windows.com.wrapper
diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor
index 270c2fa3dd..3c0509c49d 100755
--- a/basis/windows/dinput/constants/constants.factor
+++ b/basis/windows/dinput/constants/constants.factor
@@ -1,8 +1,9 @@
USING: windows.dinput windows.kernel32 windows.ole32 windows.com
-windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
-combinators sequences fry math accessors macros words quotations
-libc continuations generalizations splitting locals assocs init
-specialized-arrays memoize classes.struct strings arrays ;
+windows.com.syntax alien alien.c-types alien.data alien.syntax
+kernel system namespaces combinators sequences fry math accessors
+macros words quotations libc continuations generalizations
+splitting locals assocs init specialized-arrays memoize
+classes.struct strings arrays ;
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.dinput.constants
diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor
index bd6512341f..bb8e60cdf5 100755
--- a/basis/windows/dragdrop-listener/dragdrop-listener.factor
+++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor
@@ -1,17 +1,16 @@
USING: alien.strings io.encodings.utf16n windows.com
windows.com.wrapper combinators windows.kernel32 windows.ole32
-windows.shell32 kernel accessors
+windows.shell32 kernel accessors windows.types
prettyprint namespaces ui.tools.listener ui.tools.workspace
-alien.c-types alien sequences math ;
+alien.data alien sequences math ;
+SPECIALIZED-ARRAY: WCHAR
IN: windows.dragdrop-listener
-<< "WCHAR" require-c-array >>
-
: filenames-from-hdrop ( hdrop -- filenames )
dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files
[
2dup f 0 DragQueryFile 1 + ! get size of filename buffer
- dup "WCHAR" <c-array>
+ dup WCHAR <c-array>
[ swap DragQueryFile drop ] keep
utf16n alien>string
] with map ;
diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor
index d2ee337726..483494ba0c 100755
--- a/basis/windows/errors/errors.factor
+++ b/basis/windows/errors/errors.factor
@@ -1,11 +1,10 @@
-USING: alien.c-types kernel locals math math.bitwise
+USING: alien.data kernel locals math math.bitwise
windows.kernel32 sequences byte-arrays unicode.categories
io.encodings.string io.encodings.utf16n alien.strings
-arrays literals ;
+arrays literals windows.types ;
+SPECIALIZED-ARRAY: TCHAR
IN: windows.errors
-<< "TCHAR" require-c-array >>
-
CONSTANT: ERROR_SUCCESS 0
CONSTANT: ERROR_INVALID_FUNCTION 1
CONSTANT: ERROR_FILE_NOT_FOUND 2
@@ -698,8 +697,6 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF
: make-lang-id ( lang1 lang2 -- n )
10 shift bitor ; inline
-<< "TCHAR" require-c-array >>
-
ERROR: error-message-failed id ;
:: n>win32-error-string ( id -- string )
{
@@ -709,7 +706,7 @@ ERROR: error-message-failed id ;
f
id
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
- 32768 [ "TCHAR" <c-array> ] [ ] bi
+ 32768 [ TCHAR <c-array> ] [ ] bi
f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
utf16n alien>string [ blank? ] trim ;
diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor
index 63cfd92ba1..e38477c98c 100755
--- a/basis/windows/offscreen/offscreen.factor
+++ b/basis/windows/offscreen/offscreen.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2009 Joe Groff, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel combinators sequences
-math windows.gdi32 windows.types images destructors
-accessors fry locals classes.struct ;
+USING: alien.c-types alien.data kernel combinators
+sequences math windows.gdi32 windows.types images
+destructors accessors fry locals classes.struct ;
IN: windows.offscreen
: (bitmap-info) ( dim -- BITMAPINFO )
diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index 9e117c8522..fe47a7f923 100755
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -1,5 +1,5 @@
-USING: alien alien.syntax alien.c-types alien.strings math
-kernel sequences windows.errors windows.types io accessors
+USING: alien alien.syntax alien.c-types alien.data alien.strings
+math kernel sequences windows.errors windows.types io accessors
math.order namespaces make math.parser windows.kernel32
combinators locals specialized-arrays literals splitting
grouping classes.struct combinators.smart ;
diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor
index 98305e8304..0cd7704cf8 100644
--- a/basis/x11/xlib/xlib.factor
+++ b/basis/x11/xlib/xlib.factor
@@ -10,9 +10,9 @@
! add to this library and are wondering what part of the file to
! modify, just find the function or data structure in the manual
! and note the section.
-USING: accessors kernel arrays alien alien.c-types alien.strings
-alien.syntax classes.struct math math.bitwise words sequences
-namespaces continuations io io.encodings.ascii x11.syntax ;
+USING: accessors kernel arrays alien alien.c-types alien.data
+alien.strings alien.syntax classes.struct math math.bitwise words
+sequences namespaces continuations io io.encodings.ascii x11.syntax ;
FROM: alien.c-types => short ;
IN: x11.xlib
diff --git a/core/alien/strings/strings-tests.factor b/core/alien/strings/strings-tests.factor
index 6a0a42253b..c1b5a9e159 100644
--- a/core/alien/strings/strings-tests.factor
+++ b/core/alien/strings/strings-tests.factor
@@ -1,4 +1,4 @@
-USING: alien.strings alien.c-types tools.test kernel libc
+USING: alien.strings alien.c-types alien.data tools.test kernel libc
io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
IN: alien.strings.tests
diff --git a/extra/alien/inline/syntax/syntax-tests.factor b/extra/alien/inline/syntax/syntax-tests.factor
index e6a0b8b7d8..c49b2b5aae 100644
--- a/extra/alien/inline/syntax/syntax-tests.factor
+++ b/extra/alien/inline/syntax/syntax-tests.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.inline alien.inline.syntax io.directories io.files
-kernel namespaces tools.test alien.c-types alien.structs ;
+kernel namespaces tools.test alien.c-types alien.data alien.structs ;
IN: alien.inline.syntax.tests
DELETE-C-LIBRARY: test
diff --git a/extra/alien/marshall/marshall-docs.factor b/extra/alien/marshall/marshall-docs.factor
index 361753a0d3..5d6ec29912 100644
--- a/extra/alien/marshall/marshall-docs.factor
+++ b/extra/alien/marshall/marshall-docs.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel quotations sequences
-strings alien alien.c-types math byte-arrays ;
+strings alien alien.c-types alien.data math byte-arrays ;
IN: alien.marshall
<PRIVATE
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index d343da0fe0..059ee72de1 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -3,7 +3,7 @@
USING: accessors alien alien.c-types alien.inline.types
alien.marshall.private alien.strings byte-arrays classes
combinators combinators.short-circuit destructors fry
-io.encodings.utf8 kernel libc sequences
+io.encodings.utf8 kernel libc sequences alien.data
specialized-arrays strings unix.utilities vocabs.parser
words libc.private locals generalizations math ;
FROM: alien.c-types => float short ;
diff --git a/extra/alien/marshall/private/private.factor b/extra/alien/marshall/private/private.factor
index c85b722d11..d138282ff3 100644
--- a/extra/alien/marshall/private/private.factor
+++ b/extra/alien/marshall/private/private.factor
@@ -3,7 +3,7 @@
USING: accessors alien alien.c-types alien.inline arrays
combinators fry functors kernel lexer libc macros math
sequences specialized-arrays libc.private
-combinators.short-circuit ;
+combinators.short-circuit alien.data ;
SPECIALIZED-ARRAY: void*
IN: alien.marshall.private
diff --git a/extra/alien/marshall/structs/structs.factor b/extra/alien/marshall/structs/structs.factor
index 54bcab45f2..3f9c8e3a7e 100644
--- a/extra/alien/marshall/structs/structs.factor
+++ b/extra/alien/marshall/structs/structs.factor
@@ -3,7 +3,7 @@
USING: accessors alien.c-types alien.marshall arrays assocs
classes.tuple combinators destructors generalizations generic
kernel libc locals parser quotations sequences slots words
-alien.structs lexer vocabs.parser fry effects ;
+alien.structs lexer vocabs.parser fry effects alien.data ;
IN: alien.marshall.structs
<PRIVATE
diff --git a/extra/audio/wav/wav.factor b/extra/audio/wav/wav.factor
index 6b76e98f3a..4df8b52424 100644
--- a/extra/audio/wav/wav.factor
+++ b/extra/audio/wav/wav.factor
@@ -1,7 +1,7 @@
USING: alien.c-types alien.syntax audio combinators
combinators.short-circuit io io.binary io.encodings.binary
io.files io.streams.byte-array kernel locals math
-sequences ;
+sequences alien.data ;
IN: audio.wav
CONSTANT: RIFF-MAGIC "RIFF"
diff --git a/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor b/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor
index 8041bef07f..bd13de32c7 100644
--- a/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor
+++ b/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.accessors alien.c-types alien.syntax byte-arrays
destructors generalizations hints kernel libc locals math math.order
-sequences sequences.private classes.struct accessors ;
+sequences sequences.private classes.struct accessors alien.data ;
IN: benchmark.yuv-to-rgb
STRUCT: yuv_buffer
diff --git a/extra/ecdsa/ecdsa.factor b/extra/ecdsa/ecdsa.factor
index 1000bb9d71..c4d889991e 100644
--- a/extra/ecdsa/ecdsa.factor
+++ b/extra/ecdsa/ecdsa.factor
@@ -3,7 +3,7 @@
USING: kernel accessors sequences sequences.private destructors math namespaces
locals openssl openssl.libcrypto byte-arrays bit-arrays.private
- alien.c-types alien.destructors ;
+ alien.c-types alien.destructors alien.data ;
IN: ecdsa
diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor
index 9d8c15ab7a..4f2437c0c1 100644
--- a/extra/gpu/render/render.factor
+++ b/extra/gpu/render/render.factor
@@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types arrays
+USING: accessors alien alien.c-types alien.data arrays
assocs classes classes.mixin classes.parser classes.singleton
classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
generic generic.parser gpu gpu.buffers gpu.framebuffers
diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor
index 91bc760673..39c1792a16 100755
--- a/extra/gpu/shaders/shaders.factor
+++ b/extra/gpu/shaders/shaders.factor
@@ -1,11 +1,11 @@
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types alien.strings arrays assocs
-byte-arrays classes.mixin classes.parser classes.singleton
-classes.struct combinators combinators.short-circuit definitions
-destructors generic.parser gpu gpu.buffers hashtables images
-io.encodings.ascii io.files io.pathnames kernel lexer literals
-locals math math.parser memoize multiline namespaces opengl
-opengl.gl opengl.shaders parser quotations sequences
+USING: accessors alien alien.c-types alien.data alien.strings
+arrays assocs byte-arrays classes.mixin classes.parser
+classes.singleton classes.struct combinators combinators.short-circuit
+definitions destructors generic.parser gpu gpu.buffers hashtables
+images io.encodings.ascii io.files io.pathnames kernel lexer
+literals locals math math.parser memoize multiline namespaces
+opengl opengl.gl opengl.shaders parser quotations sequences
specialized-arrays splitting strings tr ui.gadgets.worlds
variants vectors vocabs vocabs.loader vocabs.parser words
words.constant ;
diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor
index 2bca8f72fc..1a840ea0b4 100755
--- a/extra/gpu/state/state.factor
+++ b/extra/gpu/state/state.factor
@@ -1,7 +1,7 @@
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types arrays byte-arrays combinators gpu
-kernel literals math math.rectangles opengl opengl.gl sequences
-variants specialized-arrays ;
+USING: accessors alien.c-types alien.data arrays byte-arrays
+combinators gpu kernel literals math math.rectangles opengl
+opengl.gl sequences variants specialized-arrays ;
QUALIFIED-WITH: alien.c-types c
FROM: math => float ;
SPECIALIZED-ARRAY: int
diff --git a/extra/half-floats/half-floats-tests.factor b/extra/half-floats/half-floats-tests.factor
index cf3d7d3690..ad3d156bc4 100644
--- a/extra/half-floats/half-floats-tests.factor
+++ b/extra/half-floats/half-floats-tests.factor
@@ -1,5 +1,5 @@
USING: alien.c-types alien.syntax half-floats kernel math tools.test
-specialized-arrays ;
+specialized-arrays alien.data ;
SPECIALIZED-ARRAY: half
IN: half-floats.tests
diff --git a/extra/half-floats/half-floats.factor b/extra/half-floats/half-floats.factor
index 2c089e4330..4d78068c03 100755
--- a/extra/half-floats/half-floats.factor
+++ b/extra/half-floats/half-floats.factor
@@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types alien.syntax kernel math math.order ;
+USING: accessors alien.c-types alien.data alien.syntax kernel math math.order ;
IN: half-floats
: half>bits ( float -- bits )
diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor
index 1ba8031dfc..57c30dde15 100644
--- a/extra/io/serial/unix/unix.factor
+++ b/extra/io/serial/unix/unix.factor
@@ -1,8 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.syntax combinators io.ports
-io.streams.duplex system kernel math math.bitwise
-vocabs.loader unix io.serial io.serial.unix.termios io.backend.unix ;
+USING: accessors alien.c-types alien.syntax alien.data
+combinators io.ports io.streams.duplex system kernel
+math math.bitwise vocabs.loader unix io.serial
+io.serial.unix.termios io.backend.unix ;
IN: io.serial.unix
<< {
diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor
index 46729c42be..a5602273d2 100644
--- a/extra/memory/piles/piles.factor
+++ b/extra/memory/piles/piles.factor
@@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types destructors kernel libc math ;
+USING: accessors alien alien.c-types alien.data destructors kernel libc math ;
IN: memory.piles
TUPLE: pile
diff --git a/extra/system-info/windows/ce/ce.factor b/extra/system-info/windows/ce/ce.factor
index 13c7cb9433..8c4f81a117 100755
--- a/extra/system-info/windows/ce/ce.factor
+++ b/extra/system-info/windows/ce/ce.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types system-info kernel math namespaces
+USING: alien.c-types alien.data system-info kernel math namespaces
windows windows.kernel32 system-info.backend system ;
IN: system-info.windows.ce
From b48beb48f4d74f97e566363b54d67dce017968ac Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 10:01:38 -0500
Subject: [PATCH 229/266] fix loading problems on windows
---
basis/environment/winnt/winnt.factor | 2 +-
basis/windows/errors/errors.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor
index cba92a0e3c..894415ace8 100755
--- a/basis/environment/winnt/winnt.factor
+++ b/basis/environment/winnt/winnt.factor
@@ -3,7 +3,7 @@
USING: alien.strings fry io.encodings.utf16n kernel
splitting windows windows.kernel32 windows.types system
environment alien.data sequences windows.errors
-io.streams.memory io.encodings io ;
+io.streams.memory io.encodings io specialized-arrays ;
SPECIALIZED-ARRAY: TCHAR
IN: environment.winnt
diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor
index 483494ba0c..a7a41433f7 100755
--- a/basis/windows/errors/errors.factor
+++ b/basis/windows/errors/errors.factor
@@ -1,7 +1,7 @@
USING: alien.data kernel locals math math.bitwise
windows.kernel32 sequences byte-arrays unicode.categories
io.encodings.string io.encodings.utf16n alien.strings
-arrays literals windows.types ;
+arrays literals windows.types specialized-arrays ;
SPECIALIZED-ARRAY: TCHAR
IN: windows.errors
From ceff1b40bec2b63dfc93c3b25e433aeda72cd344 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 13:41:55 -0500
Subject: [PATCH 230/266] helper words for qtkit
---
extra/qtkit/qtkit.factor | 19 ++++++++++++++++++-
1 file changed, 18 insertions(+), 1 deletion(-)
diff --git a/extra/qtkit/qtkit.factor b/extra/qtkit/qtkit.factor
index d0567bdd48..b573cd51ab 100644
--- a/extra/qtkit/qtkit.factor
+++ b/extra/qtkit/qtkit.factor
@@ -1,4 +1,5 @@
-USING: classes.struct cocoa core-foundation.strings ;
+USING: classes.struct cocoa cocoa.application cocoa.classes
+cocoa.enumeration cocoa.plists core-foundation.strings kernel ;
IN: qtkit
STRUCT: QTTime
@@ -74,3 +75,19 @@ IMPORT: QTMovieView
IMPORT: QTSampleBuffer
IMPORT: QTTrack
+: <movie> ( filename -- movie )
+ QTMovie swap <NSString> f -> movieWithFile:error: -> retain ;
+
+: movie-attributes ( movie -- attributes )
+ -> movieAttributes plist> ;
+
+: play ( movie -- )
+ -> play ;
+: stop ( movie -- )
+ -> stop ;
+
+: movie-tracks ( movie -- tracks )
+ -> tracks NSFastEnumeration>vector ;
+
+: track-attributes ( track -- attributes )
+ -> trackAttributes plist> ;
From 238f600da28e01cd4f999149f646a079e3db70f8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 15:11:01 -0500
Subject: [PATCH 231/266] document number-base prettyprinter variable. add more
docs about hex float syntax
---
basis/prettyprint/config/config-docs.factor | 3 +++
basis/prettyprint/prettyprint-docs.factor | 5 +++--
core/math/parser/parser-docs.factor | 6 +++---
core/syntax/syntax-docs.factor | 11 +++++++----
4 files changed, 16 insertions(+), 9 deletions(-)
diff --git a/basis/prettyprint/config/config-docs.factor b/basis/prettyprint/config/config-docs.factor
index 1dcb1b5617..ccc63c61cb 100644
--- a/basis/prettyprint/config/config-docs.factor
+++ b/basis/prettyprint/config/config-docs.factor
@@ -19,6 +19,9 @@ HELP: length-limit
HELP: line-limit
{ $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ;
+HELP: number-base
+{ $var-description "The number base in which the prettyprinter will output numeric literals. A value of " { $snippet "2" } " will print integers and ratios in binary with " { $link POSTPONE: BIN: } ", and " { $snippet "8" } " will print them in octal with " { $link POSTPONE: OCT: } ". A value of " { $snippet "16" } " will print all integers, ratios, and floating-point values in hexadecimal with " { $link POSTPONE: HEX: } ". Other values of " { $snippet "number-base" } " will print numbers in decimal, which is the default." } ;
+
HELP: string-limit?
{ $var-description "Toggles whether printed strings are truncated to the margin." } ;
diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor
index 7c114f2e22..1560b208ab 100644
--- a/basis/prettyprint/prettyprint-docs.factor
+++ b/basis/prettyprint/prettyprint-docs.factor
@@ -28,6 +28,7 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables"
{ $subsection nesting-limit }
{ $subsection length-limit }
{ $subsection line-limit }
+{ $subsection number-base }
{ $subsection string-limit? }
{ $subsection boa-tuples? }
{ $subsection c-object-pointers? }
@@ -202,8 +203,8 @@ HELP: .o
{ $description "Outputs an integer in octal." } ;
HELP: .h
-{ $values { "n" "an integer" } }
-{ $description "Outputs an integer in hexadecimal." } ;
+{ $values { "n" "an integer or floating-point value" } }
+{ $description "Outputs an integer or floating-point value in hexadecimal." } ;
HELP: stack.
{ $values { "seq" "a sequence" } }
diff --git a/core/math/parser/parser-docs.factor b/core/math/parser/parser-docs.factor
index ebb9c8aa5e..c3ee350099 100644
--- a/core/math/parser/parser-docs.factor
+++ b/core/math/parser/parser-docs.factor
@@ -61,7 +61,7 @@ HELP: bin>
$nl
"Outputs " { $link f } " if the string does not represent a number." } ;
-{ bin> POSTPONE: BIN: bin> .b } related-words
+{ >bin POSTPONE: BIN: bin> .b } related-words
HELP: oct>
{ $values { "str" string } { "n/f" "a real number or " { $link f } } }
@@ -69,7 +69,7 @@ HELP: oct>
$nl
"Outputs " { $link f } " if the string does not represent a number." } ;
-{ oct> POSTPONE: OCT: oct> .o } related-words
+{ >oct POSTPONE: OCT: oct> .o } related-words
HELP: hex>
{ $values { "str" string } { "n/f" "a real number or " { $link f } } }
@@ -77,7 +77,7 @@ HELP: hex>
$nl
"Outputs " { $link f } " if the string does not represent a number." } ;
-{ hex> POSTPONE: HEX: hex> .h } related-words
+{ >hex POSTPONE: HEX: hex> .h } related-words
HELP: >base
{ $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } }
diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index e34fb0957f..394ae3f67c 100644
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -593,10 +593,13 @@ HELP: #!
{ $description "Discards all input until the end of the line." } ;
HELP: HEX:
-{ $syntax "HEX: integer" }
-{ $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } }
-{ $description "Adds an integer read from a hexadecimal literal to the parse tree." }
-{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ;
+{ $syntax "HEX: NNN" "HEX: NNN.NNNpEEE" }
+{ $values { "N" "hexadecimal digit (0-9, a-f, A-F)" } { "pEEE" "decimal exponent value" } }
+{ $description "Adds an integer or floating-point value read from a hexadecimal literal to the parse tree." }
+{ $examples
+ { $example "USE: prettyprint" "HEX: ff ." "255" }
+ { $example "USE: prettyprint" "HEX: 1.8p5 ." "48.0" }
+} ;
HELP: OCT:
{ $syntax "OCT: integer" }
From 53752b4cfd1eba6fe1722c06ab4b191c3db5089d Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 16:14:02 -0500
Subject: [PATCH 232/266] update C-STRUCT:s in audio.wav
---
extra/audio/wav/wav.factor | 64 ++++++++++++++++++--------------------
1 file changed, 30 insertions(+), 34 deletions(-)
diff --git a/extra/audio/wav/wav.factor b/extra/audio/wav/wav.factor
index 4df8b52424..89cd04ad60 100644
--- a/extra/audio/wav/wav.factor
+++ b/extra/audio/wav/wav.factor
@@ -1,7 +1,7 @@
USING: alien.c-types alien.syntax audio combinators
combinators.short-circuit io io.binary io.encodings.binary
io.files io.streams.byte-array kernel locals math
-sequences alien.data ;
+sequences alien alien.data classes.struct accessors ;
IN: audio.wav
CONSTANT: RIFF-MAGIC "RIFF"
@@ -9,30 +9,26 @@ CONSTANT: WAVE-MAGIC "WAVE"
CONSTANT: FMT-MAGIC "fmt "
CONSTANT: DATA-MAGIC "data"
-C-STRUCT: riff-chunk-header
- { "char[4]" "id" }
- { "uchar[4]" "size" }
- ;
+STRUCT: riff-chunk-header
+ { id char[4] }
+ { size char[4] } ;
-C-STRUCT: riff-chunk
- { "riff-chunk-header" "header" }
- { "char[4]" "format" }
- ;
+STRUCT: riff-chunk
+ { header riff-chunk-header }
+ { format char[4] } ;
-C-STRUCT: wav-fmt-chunk
- { "riff-chunk-header" "header" }
- { "uchar[2]" "audio-format" }
- { "uchar[2]" "num-channels" }
- { "uchar[4]" "sample-rate" }
- { "uchar[4]" "byte-rate" }
- { "uchar[2]" "block-align" }
- { "uchar[2]" "bits-per-sample" }
- ;
+STRUCT: wav-fmt-chunk
+ { header riff-chunk-header }
+ { audio-format uchar[2] }
+ { num-channels uchar[2] }
+ { sample-rate uchar[4] }
+ { byte-rate uchar[4] }
+ { block-align uchar[2] }
+ { bits-per-sample uchar[2] } ;
-C-STRUCT: wav-data-chunk
- { "riff-chunk-header" "header" }
- { "uchar[0]" "body" }
- ;
+STRUCT: wav-data-chunk
+ { header riff-chunk-header }
+ { body uchar[0] } ;
ERROR: invalid-wav-file ;
@@ -44,39 +40,39 @@ ERROR: invalid-wav-file ;
: read-chunk ( -- byte-array/f )
4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ;
: read-riff-chunk ( -- byte-array/f )
- "riff-chunk" heap-size ensured-read* ;
+ riff-chunk heap-size ensured-read* ;
: id= ( chunk id -- ? )
- [ 4 head ] dip sequence= ;
+ [ 4 head ] dip sequence= ; inline
-: check-chunk ( chunk id min-size -- ? )
- [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
+: check-chunk ( chunk id class -- ? )
+ heap-size [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
:: read-wav-chunks ( -- fmt data )
f :> fmt! f :> data!
[ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
[ {
- { [ dup FMT-MAGIC "wav-fmt-chunk" heap-size check-chunk ] [ fmt! ] }
- { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] }
+ { [ dup FMT-MAGIC wav-fmt-chunk check-chunk ] [ wav-fmt-chunk memory>struct fmt! ] }
+ { [ dup DATA-MAGIC wav-data-chunk check-chunk ] [ wav-data-chunk memory>struct data! ] }
} cond ] while drop
fmt data 2dup and [ invalid-wav-file ] unless ;
: verify-wav ( chunk -- )
{
[ RIFF-MAGIC id= ]
- [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ]
+ [ riff-chunk memory>struct format>> 4 memory>byte-array WAVE-MAGIC id= ]
} 1&&
[ invalid-wav-file ] unless ;
: (read-wav) ( -- audio )
read-wav-chunks
[
- [ wav-fmt-chunk-num-channels 2 memory>byte-array le> ]
- [ wav-fmt-chunk-bits-per-sample 2 memory>byte-array le> ]
- [ wav-fmt-chunk-sample-rate 4 memory>byte-array le> ] tri
+ [ num-channels>> 2 memory>byte-array le> ]
+ [ bits-per-sample>> 2 memory>byte-array le> ]
+ [ sample-rate>> 4 memory>byte-array le> ] tri
] [
- [ riff-chunk-header-size 4 memory>byte-array le> dup ]
- [ wav-data-chunk-body ] bi swap memory>byte-array
+ [ header>> size>> 4 memory>byte-array le> dup ]
+ [ body>> >c-ptr ] bi swap memory>byte-array
] bi* <audio> ;
: read-wav ( filename -- audio )
From 07591e8e22972e3a215c0f8571ba06d9b0a7722e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 18 Sep 2009 14:35:53 -0700
Subject: [PATCH 233/266] websites.concatenative: enable user-admin in
production
---
extra/websites/concatenative/concatenative.factor | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index 207ae9ab34..b5a29073cd 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -91,7 +91,10 @@ SYMBOL: dh-file
: init-production ( -- )
common-configuration
<vhost-dispatcher>
- <factor-website> <wiki> <login-config> <factor-boilerplate> "wiki" add-responder test-db <alloy> "concatenative.org" add-responder
+ <factor-website>
+ <wiki> "wiki" add-responder
+ <user-admin> "user-admin" add-responder
+ <login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
<pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
<planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
home "docs" append-path <help-webapp> test-db <alloy> "docs.factorcode.org" add-responder
From fc288c0e0593ca44886402e1175beb8e47f861d8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 18 Sep 2009 14:36:06 -0700
Subject: [PATCH 234/266] slides: support 'f' to toggle fullscreen view
---
extra/slides/slides.factor | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor
index 32ceb3b677..af37580ff2 100755
--- a/extra/slides/slides.factor
+++ b/extra/slides/slides.factor
@@ -19,10 +19,14 @@ CONSTANT: stylesheet
{ wrap-margin 1100 }
}
}
- { code-style
+ { code-char-style
H{
{ font-name "monospace" }
{ font-size 36 }
+ }
+ }
+ { code-style
+ H{
{ page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
}
}
@@ -101,6 +105,7 @@ SYNTAX: STRIP-TEASE:
{ T{ button-down } [ request-focus ] }
{ T{ key-down f f "DOWN" } [ next-page ] }
{ T{ key-down f f "UP" } [ prev-page ] }
+ { T{ key-down f f "f" } [ dup fullscreen? not set-fullscreen ] }
} set-gestures
: slides-window ( slides -- )
From 4f07a26bd0938805aa8452368482991cc2038ef8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 17:26:20 -0500
Subject: [PATCH 235/266] change half-floats to make a primitive C type instead
of a single-slot C-STRUCT: + boxer/unboxer
---
extra/half-floats/half-floats-tests.factor | 24 +++++++++++-----------
extra/half-floats/half-floats.factor | 19 +++++++++++------
2 files changed, 25 insertions(+), 18 deletions(-)
diff --git a/extra/half-floats/half-floats-tests.factor b/extra/half-floats/half-floats-tests.factor
index ad3d156bc4..d6b26cb129 100644
--- a/extra/half-floats/half-floats-tests.factor
+++ b/extra/half-floats/half-floats-tests.factor
@@ -1,5 +1,5 @@
-USING: alien.c-types alien.syntax half-floats kernel math tools.test
-specialized-arrays alien.data ;
+USING: accessors alien.c-types alien.syntax half-floats kernel
+math tools.test specialized-arrays alien.data classes.struct ;
SPECIALIZED-ARRAY: half
IN: half-floats.tests
@@ -9,7 +9,7 @@ IN: half-floats.tests
[ HEX: be00 ] [ -1.5 half>bits ] unit-test
[ HEX: 7c00 ] [ 1/0. half>bits ] unit-test
[ HEX: fc00 ] [ -1/0. half>bits ] unit-test
-[ HEX: 7eaa ] [ HEX: aaaaaaaaaaaaa <fp-nan> half>bits ] unit-test
+[ HEX: 7eaa ] [ NAN: aaaaaaaaaaaaa half>bits ] unit-test
! too-big floats overflow to infinity
[ HEX: 7c00 ] [ 65536.0 half>bits ] unit-test
@@ -30,18 +30,18 @@ IN: half-floats.tests
[ 3.0 ] [ HEX: 4200 bits>half ] unit-test
[ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test
-C-STRUCT: halves
- { "half" "tom" }
- { "half" "dick" }
- { "half" "harry" }
- { "half" "harry-jr" } ;
+STRUCT: halves
+ { tom half }
+ { dick half }
+ { harry half }
+ { harry-jr half } ;
-[ 8 ] [ "halves" heap-size ] unit-test
+[ 8 ] [ halves heap-size ] unit-test
[ 3.0 ] [
- "halves" <c-object>
- 3.0 over set-halves-dick
- halves-dick
+ halves <struct>
+ 3.0 >>dick
+ dick>>
] unit-test
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]
diff --git a/extra/half-floats/half-floats.factor b/extra/half-floats/half-floats.factor
index 4d78068c03..d0f6a09067 100755
--- a/extra/half-floats/half-floats.factor
+++ b/extra/half-floats/half-floats.factor
@@ -1,5 +1,7 @@
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types alien.data alien.syntax kernel math math.order ;
+USING: accessors alien.accessors alien.c-types alien.data
+alien.syntax kernel math math.order ;
+FROM: math => float ;
IN: half-floats
: half>bits ( float -- bits )
@@ -26,13 +28,18 @@ IN: half-floats
] unless
] bi bitor bits>float ;
-C-STRUCT: half { "ushort" "(bits)" } ;
+SYMBOL: half
<<
-"half" c-type
- [ half>bits <ushort> ] >>unboxer-quot
- [ *ushort bits>half ] >>boxer-quot
- drop
+<c-type>
+ float >>class
+ float >>boxed-class
+ [ alien-unsigned-2 bits>half ] >>getter
+ [ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
+ 2 >>size
+ 2 >>align
+ [ >float ] >>unboxer-quot
+\ half define-primitive-type
>>
From 47359279a521c67c5a6f4fc2c0c1f9a31f7a9331 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 17:42:25 -0500
Subject: [PATCH 236/266] update structs in cairo.ffi
---
basis/cairo/ffi/ffi.factor | 102 +++++++++++++++++++------------------
1 file changed, 52 insertions(+), 50 deletions(-)
diff --git a/basis/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor
index ce5f0cc233..947869e357 100644
--- a/basis/cairo/ffi/ffi.factor
+++ b/basis/cairo/ffi/ffi.factor
@@ -6,7 +6,7 @@
USING: system combinators alien alien.syntax alien.c-types
alien.destructors kernel accessors sequences arrays ui.gadgets
-alien.libraries ;
+alien.libraries classes.struct ;
IN: cairo.ffi
<< {
@@ -26,23 +26,23 @@ TYPEDEF: int cairo_bool_t
TYPEDEF: void* cairo_t
TYPEDEF: void* cairo_surface_t
-C-STRUCT: cairo_matrix_t
- { "double" "xx" }
- { "double" "yx" }
- { "double" "xy" }
- { "double" "yy" }
- { "double" "x0" }
- { "double" "y0" } ;
+STRUCT: cairo_matrix_t
+ { xx double }
+ { yx double }
+ { xy double }
+ { yy double }
+ { x0 double }
+ { y0 double } ;
TYPEDEF: void* cairo_pattern_t
TYPEDEF: void* cairo_destroy_func_t
: cairo-destroy-func ( quot -- callback )
- [ "void" { "void*" } "cdecl" ] dip alien-callback ; inline
+ [ void { void* } "cdecl" ] dip alien-callback ; inline
! See cairo.h for details
-C-STRUCT: cairo_user_data_key_t
- { "int" "unused" } ;
+STRUCT: cairo_user_data_key_t
+ { unused int } ;
TYPEDEF: int cairo_status_t
C-ENUM:
@@ -79,11 +79,11 @@ CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000
TYPEDEF: void* cairo_write_func_t
: cairo-write-func ( quot -- callback )
- [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { void* uchar* int } "cdecl" ] dip alien-callback ; inline
TYPEDEF: void* cairo_read_func_t
: cairo-read-func ( quot -- callback )
- [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { void* uchar* int } "cdecl" ] dip alien-callback ; inline
! Functions for manipulating state objects
FUNCTION: cairo_t*
@@ -336,16 +336,16 @@ cairo_clip_preserve ( cairo_t* cr ) ;
FUNCTION: void
cairo_clip_extents ( cairo_t* cr, double* x1, double* y1, double* x2, double* y2 ) ;
-C-STRUCT: cairo_rectangle_t
- { "double" "x" }
- { "double" "y" }
- { "double" "width" }
- { "double" "height" } ;
+STRUCT: cairo_rectangle_t
+ { x double }
+ { y double }
+ { width double }
+ { height double } ;
-C-STRUCT: cairo_rectangle_list_t
- { "cairo_status_t" "status" }
- { "cairo_rectangle_t*" "rectangles" }
- { "int" "num_rectangles" } ;
+STRUCT: cairo_rectangle_list_t
+ { status cairo_status_t }
+ { rectangles cairo_rectangle_t* }
+ { num_rectangles int } ;
FUNCTION: cairo_rectangle_list_t*
cairo_copy_clip_rectangle_list ( cairo_t* cr ) ;
@@ -359,25 +359,25 @@ TYPEDEF: void* cairo_scaled_font_t
TYPEDEF: void* cairo_font_face_t
-C-STRUCT: cairo_glyph_t
- { "ulong" "index" }
- { "double" "x" }
- { "double" "y" } ;
+STRUCT: cairo_glyph_t
+ { index ulong }
+ { x double }
+ { y double } ;
-C-STRUCT: cairo_text_extents_t
- { "double" "x_bearing" }
- { "double" "y_bearing" }
- { "double" "width" }
- { "double" "height" }
- { "double" "x_advance" }
- { "double" "y_advance" } ;
+STRUCT: cairo_text_extents_t
+ { x_bearing double }
+ { y_bearing double }
+ { width double }
+ { height double }
+ { x_advance double }
+ { y_advance double } ;
-C-STRUCT: cairo_font_extents_t
- { "double" "ascent" }
- { "double" "descent" }
- { "double" "height" }
- { "double" "max_x_advance" }
- { "double" "max_y_advance" } ;
+STRUCT: cairo_font_extents_t
+ { ascent double }
+ { descent double }
+ { height double }
+ { max_x_advance double }
+ { max_y_advance double } ;
TYPEDEF: int cairo_font_slant_t
C-ENUM:
@@ -648,20 +648,22 @@ C-ENUM:
CAIRO_PATH_CLOSE_PATH ;
! NEED TO DO UNION HERE
-C-STRUCT: cairo_path_data_t-point
- { "double" "x" }
- { "double" "y" } ;
+STRUCT: cairo_path_data_t-point
+ { x double }
+ { y double } ;
-C-STRUCT: cairo_path_data_t-header
- { "cairo_path_data_type_t" "type" }
- { "int" "length" } ;
+STRUCT: cairo_path_data_t-header
+ { type cairo_path_data_type_t }
+ { length int } ;
-C-UNION: cairo_path_data_t "cairo_path_data_t-point" "cairo_path_data_t-header" ;
+UNION-STRUCT: cairo_path_data_t
+ { point cairo_path_data_t-point }
+ { header cairo_path_data_t-header } ;
-C-STRUCT: cairo_path_t
- { "cairo_status_t" "status" }
- { "cairo_path_data_t*" "data" }
- { "int" "num_data" } ;
+STRUCT: cairo_path_t
+ { status cairo_status_t }
+ { data cairo_path_data_t* }
+ { num_data int } ;
FUNCTION: cairo_path_t*
cairo_copy_path ( cairo_t* cr ) ;
From e6bc7088821bf61f025ecbfc0b926871fd4dfecc Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 17:50:20 -0500
Subject: [PATCH 237/266] update openssl.libcrypto structs
---
basis/checksums/openssl/openssl.factor | 4 +-
.../io/sockets/secure/openssl/openssl.factor | 2 +-
basis/openssl/libcrypto/libcrypto.factor | 70 +++++++++----------
3 files changed, 38 insertions(+), 38 deletions(-)
diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor
index 673500b62a..bc70230fd0 100644
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays alien.c-types alien.data kernel
continuations destructors sequences io openssl openssl.libcrypto
-checksums checksums.stream ;
+checksums checksums.stream classes.struct ;
IN: checksums.openssl
ERROR: unknown-digest name ;
@@ -23,7 +23,7 @@ TUPLE: evp-md-context < disposable handle ;
: <evp-md-context> ( -- ctx )
evp-md-context new-disposable
- "EVP_MD_CTX" <c-object> dup EVP_MD_CTX_init >>handle ;
+ EVP_MD_CTX <struct> dup EVP_MD_CTX_init >>handle ;
M: evp-md-context dispose*
handle>> EVP_MD_CTX_cleanup drop ;
diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index 6d01a66cf0..400a44ea02 100644
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -31,7 +31,7 @@ TUPLE: openssl-context < secure-context aliens sessions ;
] [ drop ] if ;
: password-callback ( -- alien )
- "int" { "void*" "int" "bool" "void*" } "cdecl"
+ int { void* int bool void* } "cdecl"
[| buf size rwflag password! |
password [ B{ 0 } password! ] unless
diff --git a/basis/openssl/libcrypto/libcrypto.factor b/basis/openssl/libcrypto/libcrypto.factor
index 0eba1d2854..df9955a53c 100644
--- a/basis/openssl/libcrypto/libcrypto.factor
+++ b/basis/openssl/libcrypto/libcrypto.factor
@@ -5,8 +5,8 @@
!
! export LD_LIBRARY_PATH=/opt/local/lib
-USING: alien alien.syntax combinators kernel system
-alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators kernel system
+alien.libraries classes.struct ;
IN: openssl.libcrypto
@@ -20,35 +20,35 @@ IN: openssl.libcrypto
} cond
>>
-C-STRUCT: bio-method
- { "int" "type" }
- { "void*" "name" }
- { "void*" "bwrite" }
- { "void*" "bread" }
- { "void*" "bputs" }
- { "void*" "bgets" }
- { "void*" "ctrl" }
- { "void*" "create" }
- { "void*" "destroy" }
- { "void*" "callback-ctrl" } ;
+STRUCT: bio-method
+ { type int }
+ { name void* }
+ { bwrite void* }
+ { bread void* }
+ { bputs void* }
+ { bgets void* }
+ { ctrl void* }
+ { create void* }
+ { destroy void* }
+ { callback-ctrl void* } ;
-C-STRUCT: bio
- { "void*" "method" }
- { "void*" "callback" }
- { "void*" "cb-arg" }
- { "int" "init" }
- { "int" "shutdown" }
- { "int" "flags" }
- { "int" "retry-reason" }
- { "int" "num" }
- { "void*" "ptr" }
- { "void*" "next-bio" }
- { "void*" "prev-bio" }
- { "int" "references" }
- { "ulong" "num-read" }
- { "ulong" "num-write" }
- { "void*" "crypto-ex-data-stack" }
- { "int" "crypto-ex-data-dummy" } ;
+STRUCT: bio
+ { method void* }
+ { callback void* }
+ { cb-arg void* }
+ { init int }
+ { shutdown int }
+ { flags int }
+ { retry-reason int }
+ { num int }
+ { ptr void* }
+ { next-bio void* }
+ { prev-bio void* }
+ { references int }
+ { num-read ulong }
+ { num-write ulong }
+ { crypto-ex-data-stack void* }
+ { crypto-ex-data-dummy int } ;
CONSTANT: BIO_NOCLOSE HEX: 00
CONSTANT: BIO_CLOSE HEX: 01
@@ -103,11 +103,11 @@ FUNCTION: void* BIO_f_buffer ( ) ;
CONSTANT: EVP_MAX_MD_SIZE 64
-C-STRUCT: EVP_MD_CTX
- { "EVP_MD*" "digest" }
- { "ENGINE*" "engine" }
- { "ulong" "flags" }
- { "void*" "md_data" } ;
+STRUCT: EVP_MD_CTX
+ { digest EVP_MD* }
+ { engine ENGINE* }
+ { flags ulong }
+ { md_data void* } ;
TYPEDEF: void* EVP_MD*
TYPEDEF: void* ENGINE*
From 36fc70160d1978ac84e192d66dd51df7f76076dd Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 17:57:50 -0500
Subject: [PATCH 238/266] update tools.disassembler.udis structs
---
basis/tools/disassembler/udis/udis.factor | 105 +++++++++++-----------
1 file changed, 53 insertions(+), 52 deletions(-)
diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor
index aaa54ae527..89bd5f726c 100755
--- a/basis/tools/disassembler/udis/udis.factor
+++ b/basis/tools/disassembler/udis/udis.factor
@@ -4,7 +4,8 @@ USING: tools.disassembler namespaces combinators
alien alien.syntax alien.c-types lexer parser kernel
sequences layouts math math.order alien.libraries
math.parser system make fry arrays libc destructors
-tools.disassembler.utils splitting alien.data ;
+tools.disassembler.utils splitting alien.data
+classes.struct ;
IN: tools.disassembler.udis
<<
@@ -17,57 +18,57 @@ IN: tools.disassembler.udis
LIBRARY: libudis86
-C-STRUCT: ud_operand
- { "int" "type" }
- { "uchar" "size" }
- { "ulonglong" "lval" }
- { "int" "base" }
- { "int" "index" }
- { "uchar" "offset" }
- { "uchar" "scale" } ;
+STRUCT: ud_operand
+ { type int }
+ { size uchar }
+ { lval ulonglong }
+ { base int }
+ { index int }
+ { offset uchar }
+ { scale uchar } ;
-C-STRUCT: ud
- { "void*" "inp_hook" }
- { "uchar" "inp_curr" }
- { "uchar" "inp_fill" }
- { "FILE*" "inp_file" }
- { "uchar" "inp_ctr" }
- { "uchar*" "inp_buff" }
- { "uchar*" "inp_buff_end" }
- { "uchar" "inp_end" }
- { "void*" "translator" }
- { "ulonglong" "insn_offset" }
- { "char[32]" "insn_hexcode" }
- { "char[64]" "insn_buffer" }
- { "uint" "insn_fill" }
- { "uchar" "dis_mode" }
- { "ulonglong" "pc" }
- { "uchar" "vendor" }
- { "struct map_entry*" "mapen" }
- { "int" "mnemonic" }
- { "ud_operand[3]" "operand" }
- { "uchar" "error" }
- { "uchar" "pfx_rex" }
- { "uchar" "pfx_seg" }
- { "uchar" "pfx_opr" }
- { "uchar" "pfx_adr" }
- { "uchar" "pfx_lock" }
- { "uchar" "pfx_rep" }
- { "uchar" "pfx_repe" }
- { "uchar" "pfx_repne" }
- { "uchar" "pfx_insn" }
- { "uchar" "default64" }
- { "uchar" "opr_mode" }
- { "uchar" "adr_mode" }
- { "uchar" "br_far" }
- { "uchar" "br_near" }
- { "uchar" "implicit_addr" }
- { "uchar" "c1" }
- { "uchar" "c2" }
- { "uchar" "c3" }
- { "uchar[256]" "inp_cache" }
- { "uchar[64]" "inp_sess" }
- { "ud_itab_entry*" "itab_entry" } ;
+STRUCT: ud
+ { inp_hook void* }
+ { inp_curr uchar }
+ { inp_fill uchar }
+ { inp_file FILE* }
+ { inp_ctr uchar }
+ { inp_buff uchar* }
+ { inp_buff_end uchar* }
+ { inp_end uchar }
+ { translator void* }
+ { insn_offset ulonglong }
+ { insn_hexcode char[32] }
+ { insn_buffer char[64] }
+ { insn_fill uint }
+ { dis_mode uchar }
+ { pc ulonglong }
+ { vendor uchar }
+ { mapen void* }
+ { mnemonic int }
+ { operand ud_operand[3] }
+ { error uchar }
+ { pfx_rex uchar }
+ { pfx_seg uchar }
+ { pfx_opr uchar }
+ { pfx_adr uchar }
+ { pfx_lock uchar }
+ { pfx_rep uchar }
+ { pfx_repe uchar }
+ { pfx_repne uchar }
+ { pfx_insn uchar }
+ { default64 uchar }
+ { opr_mode uchar }
+ { adr_mode uchar }
+ { br_far uchar }
+ { br_near uchar }
+ { implicit_addr uchar }
+ { c1 uchar }
+ { c2 uchar }
+ { c3 uchar }
+ { inp_cache uchar[256] }
+ { inp_sess uchar[64] }
+ { itab_entry ud_itab_entry* } ;
FUNCTION: void ud_translate_intel ( ud* u ) ;
FUNCTION: void ud_translate_att ( ud* u ) ;
@@ -98,7 +99,7 @@ FUNCTION: uint ud_insn_len ( ud* u ) ;
FUNCTION: char* ud_lookup_mnemonic ( int c ) ;
: <ud> ( -- ud )
- "ud" malloc-object &free
+ ud malloc-struct &free
dup ud_init
dup cell-bits ud_set_mode
dup UD_SYN_INTEL ud_set_syntax ;
From 91902825acd7dc61b4c0b06f3cfff2eee0e1be6d Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 18:30:48 -0500
Subject: [PATCH 239/266] update structs in unix.utmpx
---
basis/unix/bsd/macosx/macosx.factor | 23 ++++++++-------
basis/unix/bsd/netbsd/structs/structs.factor | 31 ++++++++++----------
basis/unix/utmpx/utmpx.factor | 18 ++++++------
3 files changed, 37 insertions(+), 35 deletions(-)
diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor
index 5edd1a5093..c263be7056 100644
--- a/basis/unix/bsd/macosx/macosx.factor
+++ b/basis/unix/bsd/macosx/macosx.factor
@@ -1,4 +1,5 @@
-USING: alien.syntax unix.time classes.struct ;
+USING: alien.c-types alien.syntax unix.time unix.types
+unix.types.macosx classes.struct ;
IN: unix
CONSTANT: FD_SETSIZE 1024
@@ -18,15 +19,15 @@ CONSTANT: _UTX_LINESIZE 32
CONSTANT: _UTX_IDSIZE 4
CONSTANT: _UTX_HOSTSIZE 256
-C-STRUCT: utmpx
- { { "char" _UTX_USERSIZE } "ut_user" }
- { { "char" _UTX_IDSIZE } "ut_id" }
- { { "char" _UTX_LINESIZE } "ut_line" }
- { "pid_t" "ut_pid" }
- { "short" "ut_type" }
- { "timeval" "ut_tv" }
- { { "char" _UTX_HOSTSIZE } "ut_host" }
- { { "uint" 16 } "ut_pad" } ;
+STRUCT: utmpx
+ { ut_user { char _UTX_USERSIZE } }
+ { ut_id { char _UTX_IDSIZE } }
+ { ut_line { char _UTX_LINESIZE } }
+ { ut_pid pid_t }
+ { ut_type short }
+ { ut_tv timeval }
+ { ut_host { char _UTX_HOSTSIZE } }
+ { ut_pad { uint 16 } } ;
CONSTANT: __DARWIN_MAXPATHLEN 1024
CONSTANT: __DARWIN_MAXNAMELEN 255
@@ -37,7 +38,7 @@ STRUCT: dirent
{ d_reclen __uint16_t }
{ d_type __uint8_t }
{ d_namlen __uint8_t }
- { d_name { "char" __DARWIN_MAXNAMELEN+1 } } ;
+ { d_name { char __DARWIN_MAXNAMELEN+1 } } ;
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
diff --git a/basis/unix/bsd/netbsd/structs/structs.factor b/basis/unix/bsd/netbsd/structs/structs.factor
index f8aee1635d..1882fa830b 100644
--- a/basis/unix/bsd/netbsd/structs/structs.factor
+++ b/basis/unix/bsd/netbsd/structs/structs.factor
@@ -1,29 +1,30 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.time classes.struct ;
+USING: alien.c-types alien.syntax unix.time unix.types
+unix.types.netbsd classes.struct ;
IN: unix
STRUCT: sockaddr_storage
{ ss_len __uint8_t }
{ ss_family sa_family_t }
- { __ss_pad1 { "char" _SS_PAD1SIZE } }
+ { __ss_pad1 { char _SS_PAD1SIZE } }
{ __ss_align __int64_t }
- { __ss_pad2 { "char" _SS_PAD2SIZE } } ;
+ { __ss_pad2 { char _SS_PAD2SIZE } } ;
STRUCT: exit_struct
{ e_termination uint16_t }
{ e_exit uint16_t } ;
-C-STRUCT: utmpx
- { { "char" _UTX_USERSIZE } "ut_user" }
- { { "char" _UTX_IDSIZE } "ut_id" }
- { { "char" _UTX_LINESIZE } "ut_line" }
- { { "char" _UTX_HOSTSIZE } "ut_host" }
- { "uint16_t" "ut_session" }
- { "uint16_t" "ut_type" }
- { "pid_t" "ut_pid" }
- { "exit_struct" "ut_exit" }
- { "sockaddr_storage" "ut_ss" }
- { "timeval" "ut_tv" }
- { { "uint32_t" 10 } "ut_pad" } ;
+STRUCT: utmpx
+ { ut_user { char _UTX_USERSIZE } }
+ { ut_id { char _UTX_IDSIZE } }
+ { ut_line { char _UTX_LINESIZE } }
+ { ut_host { char _UTX_HOSTSIZE } }
+ { ut_session uint16_t }
+ { ut_type uint16_t }
+ { ut_pid pid_t }
+ { ut_exit exit_struct }
+ { ut_ss sockaddr_storage }
+ { ut_tv timeval }
+ { ut_pad { uint32_t 10 } } ;
diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor
index f6ccf6858b..6083776fc6 100644
--- a/basis/unix/utmpx/utmpx.factor
+++ b/basis/unix/utmpx/utmpx.factor
@@ -3,7 +3,7 @@
USING: alien.c-types alien.data alien.syntax combinators
continuations io.encodings.string io.encodings.utf8 kernel
sequences strings unix calendar system accessors unix.time
-calendar.unix vocabs.loader ;
+calendar.unix vocabs.loader classes.struct ;
IN: unix.utmpx
CONSTANT: EMPTY 0
@@ -39,15 +39,15 @@ M: unix new-utmpx-record
utmpx-record new ;
M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
- [ new-utmpx-record ] dip
+ [ new-utmpx-record ] dip \ utmpx memory>struct
{
- [ utmpx-ut_user _UTX_USERSIZE memory>string >>user ]
- [ utmpx-ut_id _UTX_IDSIZE memory>string >>id ]
- [ utmpx-ut_line _UTX_LINESIZE memory>string >>line ]
- [ utmpx-ut_pid >>pid ]
- [ utmpx-ut_type >>type ]
- [ utmpx-ut_tv timeval>unix-time >>timestamp ]
- [ utmpx-ut_host _UTX_HOSTSIZE memory>string >>host ]
+ [ ut_user>> _UTX_USERSIZE memory>string >>user ]
+ [ ut_id>> _UTX_IDSIZE memory>string >>id ]
+ [ ut_line>> _UTX_LINESIZE memory>string >>line ]
+ [ ut_pid>> >>pid ]
+ [ ut_type>> >>type ]
+ [ ut_tv>> timeval>unix-time >>timestamp ]
+ [ ut_host>> _UTX_HOSTSIZE memory>string >>host ]
} cleave ;
: with-utmpx ( quot -- )
From c093f52271b4ede2b84e6373f1c21d7a24f13eae Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 18:44:36 -0500
Subject: [PATCH 240/266] update structs in windows.advapi32
---
basis/windows/advapi32/advapi32.factor | 102 ++++++++++++-------------
1 file changed, 51 insertions(+), 51 deletions(-)
diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor
index 6d80534e8c..1bc7f30caf 100755
--- a/basis/windows/advapi32/advapi32.factor
+++ b/basis/windows/advapi32/advapi32.factor
@@ -62,12 +62,12 @@ CONSTANT: CRYPT_DELETEKEYSET HEX: 10
CONSTANT: CRYPT_MACHINE_KEYSET HEX: 20
CONSTANT: CRYPT_SILENT HEX: 40
-C-STRUCT: ACL
- { "BYTE" "AclRevision" }
- { "BYTE" "Sbz1" }
- { "WORD" "AclSize" }
- { "WORD" "AceCount" }
- { "WORD" "Sbz2" } ;
+STRUCT: ACL
+ { AclRevision BYTE }
+ { Sbz1 BYTE }
+ { AclSize WORD }
+ { AceCount WORD }
+ { Sbz2 WORD } ;
TYPEDEF: ACL* PACL
@@ -82,56 +82,56 @@ CONSTANT: NO_PROPAGATE_INHERIT_ACE HEX: 4
CONSTANT: INHERIT_ONLY_ACE HEX: 8
CONSTANT: VALID_INHERIT_FLAGS HEX: f
-C-STRUCT: ACE_HEADER
- { "BYTE" "AceType" }
- { "BYTE" "AceFlags" }
- { "WORD" "AceSize" } ;
+STRUCT: ACE_HEADER
+ { AceType BYTE }
+ { AceFlags BYTE }
+ { AceSize WORD } ;
TYPEDEF: ACE_HEADER* PACE_HEADER
-C-STRUCT: ACCESS_ALLOWED_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: ACCESS_ALLOWED_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: ACCESS_ALLOWED_ACE* PACCESS_ALLOWED_ACE
-C-STRUCT: ACCESS_DENIED_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: ACCESS_DENIED_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: ACCESS_DENIED_ACE* PACCESS_DENIED_ACE
-C-STRUCT: SYSTEM_AUDIT_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: SYSTEM_AUDIT_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: SYSTEM_AUDIT_ACE* PSYSTEM_AUDIT_ACE
-C-STRUCT: SYSTEM_ALARM_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: SYSTEM_ALARM_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: SYSTEM_ALARM_ACE* PSYSTEM_ALARM_ACE
-C-STRUCT: ACCESS_ALLOWED_CALLBACK_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: ACCESS_ALLOWED_CALLBACK_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: ACCESS_ALLOWED_CALLBACK_ACE* PACCESS_ALLOWED_CALLBACK_ACE
-C-STRUCT: SECURITY_DESCRIPTOR
- { "UCHAR" "Revision" }
- { "UCHAR" "Sbz1" }
- { "WORD" "Control" }
- { "PVOID" "Owner" }
- { "PVOID" "Group" }
- { "PACL" "Sacl" }
- { "PACL" "Dacl" } ;
+STRUCT: SECURITY_DESCRIPTOR
+ { Revision UCHAR }
+ { Sbz1 UCHAR }
+ { Control WORD }
+ { Owner PVOID }
+ { Group PVOID }
+ { Sacl PACL }
+ { Dacl PACL } ;
TYPEDEF: SECURITY_DESCRIPTOR* PSECURITY_DESCRIPTOR
@@ -224,21 +224,21 @@ C-ENUM:
TYPEDEF: TRUSTEE* PTRUSTEE
-C-STRUCT: TRUSTEE
- { "PTRUSTEE" "pMultipleTrustee" }
- { "MULTIPLE_TRUSTEE_OPERATION" "MultipleTrusteeOperation" }
- { "TRUSTEE_FORM" "TrusteeForm" }
- { "TRUSTEE_TYPE" "TrusteeType" }
- { "LPTSTR" "ptstrName" } ;
+STRUCT: TRUSTEE
+ { pMultipleTrustee PTRUSTEE }
+ { MultipleTrusteeOperation MULTIPLE_TRUSTEE_OPERATION }
+ { TrusteeForm TRUSTEE_FORM }
+ { TrusteeType TRUSTEE_TYPE }
+ { ptstrName LPTSTR } ;
-C-STRUCT: EXPLICIT_ACCESS
- { "DWORD" "grfAccessPermissions" }
- { "ACCESS_MODE" "grfAccessMode" }
- { "DWORD" "grfInheritance" }
- { "TRUSTEE" "Trustee" } ;
+STRUCT: EXPLICIT_ACCESS
+ { grfAccessPermissions DWORD }
+ { grfAccessMode ACCESS_MODE }
+ { grfInheritance DWORD }
+ { Trustee TRUSTEE } ;
-C-STRUCT: SID_IDENTIFIER_AUTHORITY
- { { "BYTE" 6 } "Value" } ;
+STRUCT: SID_IDENTIFIER_AUTHORITY
+ { Value { BYTE 6 } } ;
TYPEDEF: SID_IDENTIFIER_AUTHORITY* PSID_IDENTIFIER_AUTHORITY
From 81db20f59ebc82dbe3bac77e40776a13d2ea5612 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 18:54:08 -0500
Subject: [PATCH 241/266] update windows.kernel32 structs (*)
---
.../windows/nt/privileges/privileges.factor | 26 +--
basis/windows/kernel32/kernel32.factor | 172 ++++++++----------
2 files changed, 89 insertions(+), 109 deletions(-)
diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor
index bb9e0edc33..6acc1f3544 100755
--- a/basis/io/backend/windows/nt/privileges/privileges.factor
+++ b/basis/io/backend/windows/nt/privileges/privileges.factor
@@ -1,7 +1,7 @@
USING: alien alien.c-types alien.data alien.syntax arrays continuations
destructors generic io.mmap io.ports io.backend.windows io.files.windows
kernel libc math math.bitwise namespaces quotations sequences windows
-windows.advapi32 windows.kernel32 io.backend system accessors
+windows.advapi32 windows.kernel32 windows.types io.backend system accessors
io.backend.windows.privileges windows.errors ;
IN: io.backend.windows.nt.privileges
@@ -11,7 +11,7 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
: (open-process-token) ( handle -- handle )
- { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags "PHANDLE" <c-object>
+ { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
[ OpenProcessToken win32-error=0/f ] keep *void* ;
: open-process-token ( -- handle )
@@ -25,25 +25,17 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
[ CloseHandle drop ] [ ] cleanup ; inline
: lookup-privilege ( string -- luid )
- [ f ] dip "LUID" <c-object>
+ [ f ] dip LUID <struct>
[ LookupPrivilegeValue win32-error=0/f ] keep ;
: make-token-privileges ( name ? -- obj )
- "TOKEN_PRIVILEGES" <c-object>
- 1 over set-TOKEN_PRIVILEGES-PrivilegeCount
- "LUID_AND_ATTRIBUTES" malloc-object &free
- over set-TOKEN_PRIVILEGES-Privileges
-
- swap [
- SE_PRIVILEGE_ENABLED over TOKEN_PRIVILEGES-Privileges
- set-LUID_AND_ATTRIBUTES-Attributes
- ] when
-
+ TOKEN_PRIVILEGES <struct>
+ 1 >>PrivilegeCount
+ LUID_AND_ATTRIBUTES malloc-struct &free
+ swap [ SE_PRIVILEGE_ENABLED >>Attributes ] when
+ >>Privileges
[ lookup-privilege ] dip
- [
- TOKEN_PRIVILEGES-Privileges
- set-LUID_AND_ATTRIBUTES-Luid
- ] keep ;
+ [ Privileges>> (>>Luid) ] keep ;
M: winnt set-privilege ( name ? -- )
[
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 2cba1173d5..ef8952be73 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -317,14 +317,14 @@ STRUCT: OSVERSIONINFO
TYPEDEF: void* LPOSVERSIONINFO
-C-STRUCT: MEMORY_BASIC_INFORMATION
- { "void*" "BaseAddress" }
- { "void*" "AllocationBase" }
- { "DWORD" "AllocationProtect" }
- { "SIZE_T" "RegionSize" }
- { "DWORD" "state" }
- { "DWORD" "protect" }
- { "DWORD" "type" } ;
+STRUCT: MEMORY_BASIC_INFORMATION
+ { BaseAddress void* }
+ { AllocationBase void* }
+ { AllocationProtect DWORD }
+ { RegionSize SIZE_T }
+ { state DWORD }
+ { protect DWORD }
+ { type DWORD } ;
STRUCT: GUID
{ Data1 ULONG }
@@ -524,55 +524,55 @@ CONSTANT: EV_RX80FULL HEX: 400
CONSTANT: EV_EVENT1 HEX: 800
CONSTANT: EV_EVENT2 HEX: 1000
-C-STRUCT: DCB
- { "DWORD" "DCBlength" }
- { "DWORD" "BaudRate" }
- { "DWORD" "flags" }
- { "WORD" "wReserved" }
- { "WORD" "XonLim" }
- { "WORD" "XoffLim" }
- { "BYTE" "ByteSize" }
- { "BYTE" "Parity" }
- { "BYTE" "StopBits" }
- { "char" "XonChar" }
- { "char" "XoffChar" }
- { "char" "ErrorChar" }
- { "char" "EofChar" }
- { "char" "EvtChar" }
- { "WORD" "wReserved1" } ;
+STRUCT: DCB
+ { DCBlength DWORD }
+ { BaudRate DWORD }
+ { flags DWORD }
+ { wReserved WORD }
+ { XonLim WORD }
+ { XoffLim WORD }
+ { ByteSize BYTE }
+ { Parity BYTE }
+ { StopBits BYTE }
+ { XonChar char }
+ { XoffChar char }
+ { ErrorChar char }
+ { EofChar char }
+ { EvtChar char }
+ { wReserved1 WORD } ;
TYPEDEF: DCB* PDCB
TYPEDEF: DCB* LPDCB
-C-STRUCT: COMM_CONFIG
- { "DWORD" "dwSize" }
- { "WORD" "wVersion" }
- { "WORD" "wReserved" }
- { "DCB" "dcb" }
- { "DWORD" "dwProviderSubType" }
- { "DWORD" "dwProviderOffset" }
- { "DWORD" "dwProviderSize" }
- { { "WCHAR" 1 } "wcProviderData" } ;
+STRUCT: COMM_CONFIG
+ { dwSize DWORD }
+ { wVersion WORD }
+ { wReserved WORD }
+ { dcb DCB }
+ { dwProviderSubType DWORD }
+ { dwProviderOffset DWORD }
+ { dwProviderSize DWORD }
+ { wcProviderData { WCHAR 1 } } ;
TYPEDEF: COMMCONFIG* LPCOMMCONFIG
-C-STRUCT: COMMPROP
- { "WORD" "wPacketLength" }
- { "WORD" "wPacketVersion" }
- { "DWORD" "dwServiceMask" }
- { "DWORD" "dwReserved1" }
- { "DWORD" "dwMaxTxQueue" }
- { "DWORD" "dwMaxRxQueue" }
- { "DWORD" "dwMaxBaud" }
- { "DWORD" "dwProvSubType" }
- { "DWORD" "dwProvCapabilities" }
- { "DWORD" "dwSettableParams" }
- { "DWORD" "dwSettableBaud" }
- { "WORD" "wSettableData" }
- { "WORD" "wSettableStopParity" }
- { "DWORD" "dwCurrentTxQueue" }
- { "DWORD" "dwCurrentRxQueue" }
- { "DWORD" "dwProvSpec1" }
- { "DWORD" "dwProvSpec2" }
- { { "WCHAR" 1 } "wcProvChar" } ;
+STRUCT: COMMPROP
+ { wPacketLength WORD }
+ { wPacketVersion WORD }
+ { dwServiceMask DWORD }
+ { dwReserved1 DWORD }
+ { dwMaxTxQueue DWORD }
+ { dwMaxRxQueue DWORD }
+ { dwMaxBaud DWORD }
+ { dwProvSubType DWORD }
+ { dwProvCapabilities DWORD }
+ { dwSettableParams DWORD }
+ { dwSettableBaud DWORD }
+ { wSettableData WORD }
+ { wSettableStopParity WORD }
+ { dwCurrentTxQueue DWORD }
+ { dwCurrentRxQueue DWORD }
+ { dwProvSpec1 DWORD }
+ { dwProvSpec2 DWORD }
+ { wcProvChar { WCHAR 1 } } ;
TYPEDEF: COMMPROP* LPCOMMPROP
@@ -645,19 +645,19 @@ CONSTANT: WAIT_TIMEOUT 258
CONSTANT: WAIT_IO_COMPLETION HEX: c0
CONSTANT: WAIT_FAILED HEX: ffffffff
-C-STRUCT: LUID
- { "DWORD" "LowPart" }
- { "LONG" "HighPart" } ;
+STRUCT: LUID
+ { LowPart DWORD }
+ { HighPart LONG } ;
TYPEDEF: LUID* PLUID
-C-STRUCT: LUID_AND_ATTRIBUTES
- { "LUID" "Luid" }
- { "DWORD" "Attributes" } ;
+STRUCT: LUID_AND_ATTRIBUTES
+ { Luid LUID }
+ { Attributes DWORD } ;
TYPEDEF: LUID_AND_ATTRIBUTES* PLUID_AND_ATTRIBUTES
-C-STRUCT: TOKEN_PRIVILEGES
- { "DWORD" "PrivilegeCount" }
- { "LUID_AND_ATTRIBUTES*" "Privileges" } ;
+STRUCT: TOKEN_PRIVILEGES
+ { PrivilegeCount DWORD }
+ { Privileges LUID_AND_ATTRIBUTES* } ;
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
STRUCT: WIN32_FILE_ATTRIBUTE_DATA
@@ -669,29 +669,29 @@ STRUCT: WIN32_FILE_ATTRIBUTE_DATA
{ nFileSizeLow DWORD } ;
TYPEDEF: WIN32_FILE_ATTRIBUTE_DATA* LPWIN32_FILE_ATTRIBUTE_DATA
-C-STRUCT: BY_HANDLE_FILE_INFORMATION
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "dwVolumeSerialNumber" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" }
- { "DWORD" "nNumberOfLinks" }
- { "DWORD" "nFileIndexHigh" }
- { "DWORD" "nFileIndexLow" } ;
+STRUCT: BY_HANDLE_FILE_INFORMATION
+ { dwFileAttributes DWORD }
+ { ftCreationTime FILETIME }
+ { ftLastAccessTime FILETIME }
+ { ftLastWriteTime FILETIME }
+ { dwVolumeSerialNumber DWORD }
+ { nFileSizeHigh DWORD }
+ { nFileSizeLow DWORD }
+ { nNumberOfLinks DWORD }
+ { nFileIndexHigh DWORD }
+ { nFileIndexLow DWORD } ;
TYPEDEF: BY_HANDLE_FILE_INFORMATION* LPBY_HANDLE_FILE_INFORMATION
CONSTANT: OFS_MAXPATHNAME 128
-C-STRUCT: OFSTRUCT
- { "BYTE" "cBytes" }
- { "BYTE" "fFixedDisk" }
- { "WORD" "nErrCode" }
- { "WORD" "Reserved1" }
- { "WORD" "Reserved2" }
- ! { { "CHAR" OFS_MAXPATHNAME } "szPathName" } ;
- { { "CHAR" 128 } "szPathName" } ;
+STRUCT: OFSTRUCT
+ { cBytes BYTE }
+ { fFixedDisk BYTE }
+ { nErrCode WORD }
+ { Reserved1 WORD }
+ { Reserved2 WORD }
+ ! { szPathName { CHAR OFS_MAXPATHNAME } } ;
+ { szPathName { CHAR 128 } } ;
TYPEDEF: OFSTRUCT* LPOFSTRUCT
@@ -707,18 +707,6 @@ STRUCT: WIN32_FIND_DATA
{ cFileName { "TCHAR" MAX_PATH } }
{ cAlternateFileName TCHAR[14] } ;
-STRUCT: BY_HANDLE_FILE_INFORMATION
- { dwFileAttributes DWORD }
- { ftCreationTime FILETIME }
- { ftLastAccessTime FILETIME }
- { ftLastWriteTime FILETIME }
- { dwVolumeSerialNumber DWORD }
- { nFileSizeHigh DWORD }
- { nFileSizeLow DWORD }
- { nNumberOfLinks DWORD }
- { nFileIndexHigh DWORD }
- { nFileIndexLow DWORD } ;
-
TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA
TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA
TYPEDEF: void* POVERLAPPED
From 40a17176e9001986ac323d7fedec0ff31873760c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 18:57:36 -0500
Subject: [PATCH 242/266] update windows.ole32 structs (*)
---
.../dragdrop-listener.factor | 18 +++++-----
basis/windows/ole32/ole32.factor | 34 +++++++++----------
2 files changed, 26 insertions(+), 26 deletions(-)
diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor
index bb8e60cdf5..3ed2256c7d 100755
--- a/basis/windows/dragdrop-listener/dragdrop-listener.factor
+++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor
@@ -2,7 +2,7 @@ USING: alien.strings io.encodings.utf16n windows.com
windows.com.wrapper combinators windows.kernel32 windows.ole32
windows.shell32 kernel accessors windows.types
prettyprint namespaces ui.tools.listener ui.tools.workspace
-alien.data alien sequences math ;
+alien.data alien sequences math classes.struct ;
SPECIALIZED-ARRAY: WCHAR
IN: windows.dragdrop-listener
@@ -16,15 +16,15 @@ IN: windows.dragdrop-listener
] with map ;
: filenames-from-data-object ( data-object -- filenames )
- "FORMATETC" <c-object>
- CF_HDROP over set-FORMATETC-cfFormat
- f over set-FORMATETC-ptd
- DVASPECT_CONTENT over set-FORMATETC-dwAspect
- -1 over set-FORMATETC-lindex
- TYMED_HGLOBAL over set-FORMATETC-tymed
- "STGMEDIUM" <c-object>
+ FORMATETC <struct>
+ CF_HDROP >>cfFormat
+ f >>ptd
+ DVASPECT_CONTENT >>dwAspect
+ -1 >>lindex
+ TYMED_HGLOBAL >>tymed
+ STGMEDIUM <struct>
[ IDataObject::GetData ] keep swap succeeded? [
- dup STGMEDIUM-data
+ dup data>>
[ filenames-from-hdrop ] with-global-lock
swap ReleaseStgMedium
] [ drop f ] if ;
diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index fe47a7f923..3bc7f45960 100755
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -78,29 +78,29 @@ CONSTANT: TYMED_MFPICT 32
CONSTANT: TYMED_ENHMF 64
CONSTANT: TYMED_NULL 0
-C-STRUCT: DVTARGETDEVICE
- { "DWORD" "tdSize" }
- { "WORD" "tdDriverNameOffset" }
- { "WORD" "tdDeviceNameOffset" }
- { "WORD" "tdPortNameOffset" }
- { "WORD" "tdExtDevmodeOffset" }
- { "BYTE[1]" "tdData" } ;
+STRUCT: DVTARGETDEVICE
+ { tdSize DWORD }
+ { tdDriverNameOffset WORD }
+ { tdDeviceNameOffset WORD }
+ { tdPortNameOffset WORD }
+ { tdExtDevmodeOffset WORD }
+ { tdData BYTE[1] } ;
TYPEDEF: WORD CLIPFORMAT
TYPEDEF: POINT POINTL
-C-STRUCT: FORMATETC
- { "CLIPFORMAT" "cfFormat" }
- { "DVTARGETDEVICE*" "ptd" }
- { "DWORD" "dwAspect" }
- { "LONG" "lindex" }
- { "DWORD" "tymed" } ;
+STRUCT: FORMATETC
+ { cfFormat CLIPFORMAT }
+ { ptd DVTARGETDEVICE* }
+ { dwAspect DWORD }
+ { lindex LONG }
+ { tymed DWORD } ;
TYPEDEF: FORMATETC* LPFORMATETC
-C-STRUCT: STGMEDIUM
- { "DWORD" "tymed" }
- { "void*" "data" }
- { "LPUNKNOWN" "punkForRelease" } ;
+STRUCT: STGMEDIUM
+ { tymed DWORD }
+ { data void* }
+ { punkForRelease LPUNKNOWN } ;
TYPEDEF: STGMEDIUM* LPSTGMEDIUM
CONSTANT: COINIT_MULTITHREADED 0
From c86bef70c968eff87df19f1478c2fed1e9196fe9 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 19:12:31 -0500
Subject: [PATCH 243/266] update windows.types structs
---
basis/ui/backend/windows/windows.factor | 2 +-
basis/windows/types/types.factor | 87 ++++++++++++-------------
2 files changed, 44 insertions(+), 45 deletions(-)
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 5e2c25ea30..1e01f889dc 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -653,7 +653,7 @@ M: windows-ui-backend do-events
: init-win32-ui ( -- )
V{ } clone nc-buttons set-global
- "MSG" malloc-object msg-obj set-global
+ MSG malloc-struct msg-obj set-global
GetDoubleClickTime milliseconds double-click-timeout set-global ;
: cleanup-win32-ui ( -- )
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 544abb69a8..fa043b8033 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -250,14 +250,13 @@ STRUCT: RECT
{ right LONG }
{ bottom LONG } ;
-C-STRUCT: PAINTSTRUCT
- { "HDC" " hdc" }
- { "BOOL" "fErase" }
- { "RECT" "rcPaint" }
- { "BOOL" "fRestore" }
- { "BOOL" "fIncUpdate" }
- { "BYTE[32]" "rgbReserved" }
-;
+STRUCT: PAINTSTRUCT
+ { hdc HDC }
+ { fErase BOOL }
+ { rcPaint RECT }
+ { fRestore BOOL }
+ { fIncUpdate BOOL }
+ { rgbReserved BYTE[32] } ;
STRUCT: BITMAPINFOHEADER
{ biSize DWORD }
@@ -285,21 +284,21 @@ STRUCT: BITMAPINFO
TYPEDEF: void* LPPAINTSTRUCT
TYPEDEF: void* PAINTSTRUCT
-C-STRUCT: POINT
- { "LONG" "x" }
- { "LONG" "y" } ;
+STRUCT: POINT
+ { x LONG }
+ { y LONG } ;
STRUCT: SIZE
{ cx LONG }
{ cy LONG } ;
-C-STRUCT: MSG
- { "HWND" "hWnd" }
- { "UINT" "message" }
- { "WPARAM" "wParam" }
- { "LPARAM" "lParam" }
- { "DWORD" "time" }
- { "POINT" "pt" } ;
+STRUCT: MSG
+ { hWnd HWND }
+ { message UINT }
+ { wParam WPARAM }
+ { lParam LPARAM }
+ { time DWORD }
+ { pt POINT } ;
TYPEDEF: MSG* LPMSG
@@ -341,34 +340,34 @@ TYPEDEF: PFD* LPPFD
TYPEDEF: HANDLE HGLRC
TYPEDEF: HANDLE HRGN
-C-STRUCT: LVITEM
- { "uint" "mask" }
- { "int" "iItem" }
- { "int" "iSubItem" }
- { "uint" "state" }
- { "uint" "stateMask" }
- { "void*" "pszText" }
- { "int" "cchTextMax" }
- { "int" "iImage" }
- { "long" "lParam" }
- { "int" "iIndent" }
- { "int" "iGroupId" }
- { "uint" "cColumns" }
- { "uint*" "puColumns" }
- { "int*" "piColFmt" }
- { "int" "iGroup" } ;
+STRUCT: LVITEM
+ { mask uint }
+ { iItem int }
+ { iSubItem int }
+ { state uint }
+ { stateMask uint }
+ { pszText void* }
+ { cchTextMax int }
+ { iImage int }
+ { lParam long }
+ { iIndent int }
+ { iGroupId int }
+ { cColumns uint }
+ { puColumns uint* }
+ { piColFmt int* }
+ { iGroup int } ;
-C-STRUCT: LVFINDINFO
- { "uint" "flags" }
- { "char*" "psz" }
- { "long" "lParam" }
- { "POINT" "pt" }
- { "uint" "vkDirection" } ;
+STRUCT: LVFINDINFO
+ { flags uint }
+ { psz char* }
+ { lParam long }
+ { pt POINT }
+ { vkDirection uint } ;
-C-STRUCT: ACCEL
- { "BYTE" "fVirt" }
- { "WORD" "key" }
- { "WORD" "cmd" } ;
+STRUCT: ACCEL
+ { fVirt BYTE }
+ { key WORD }
+ { cmd WORD } ;
TYPEDEF: ACCEL* LPACCEL
TYPEDEF: DWORD COLORREF
From 72049b95ce2defed5e6296fa8ae19108d0a39a32 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 19:14:59 -0500
Subject: [PATCH 244/266] update windows.usp10 structs
---
basis/windows/usp10/usp10.factor | 68 ++++++++++++++++----------------
1 file changed, 34 insertions(+), 34 deletions(-)
diff --git a/basis/windows/usp10/usp10.factor b/basis/windows/usp10/usp10.factor
index 50fa98996c..cf8e69ba24 100755
--- a/basis/windows/usp10/usp10.factor
+++ b/basis/windows/usp10/usp10.factor
@@ -5,19 +5,19 @@ IN: windows.usp10
LIBRARY: usp10
-C-STRUCT: SCRIPT_CONTROL
- { "DWORD" "flags" } ;
+STRUCT: SCRIPT_CONTROL
+ { flags DWORD } ;
-C-STRUCT: SCRIPT_STATE
- { "WORD" "flags" } ;
+STRUCT: SCRIPT_STATE
+ { flags WORD } ;
-C-STRUCT: SCRIPT_ANALYSIS
- { "WORD" "flags" }
- { "SCRIPT_STATE" "s" } ;
+STRUCT: SCRIPT_ANALYSIS
+ { flags WORD }
+ { s SCRIPT_STATE } ;
-C-STRUCT: SCRIPT_ITEM
- { "int" "iCharPos" }
- { "SCRIPT_ANALYSIS" "a" } ;
+STRUCT: SCRIPT_ITEM
+ { iCharPos int }
+ { a SCRIPT_ANALYSIS } ;
FUNCTION: HRESULT ScriptItemize (
WCHAR* pwcInChars,
@@ -53,8 +53,8 @@ SCRIPT_JUSTIFY_BARA
SCRIPT_JUSTIFY_SEEN
SCRIPT_JUSTIFFY_RESERVED4 ;
-C-STRUCT: SCRIPT_VISATTR
- { "WORD" "flags" } ;
+STRUCT: SCRIPT_VISATTR
+ { flags WORD } ;
FUNCTION: HRESULT ScriptShape (
HDC hdc,
@@ -69,9 +69,9 @@ FUNCTION: HRESULT ScriptShape (
int* pcGlyphs
) ;
-C-STRUCT: GOFFSET
- { "LONG" "du" }
- { "LONG" "dv" } ;
+STRUCT: GOFFSET
+ { du LONG }
+ { dv LONG } ;
FUNCTION: HRESULT ScriptPlace (
HDC hdc,
@@ -111,8 +111,8 @@ FUNCTION: HRESULT ScriptJustify (
int* piJustify
) ;
-C-STRUCT: SCRIPT_LOGATTR
- { "BYTE" "flags" } ;
+STRUCT: SCRIPT_LOGATTR
+ { flags BYTE } ;
FUNCTION: HRESULT ScriptBreak (
WCHAR* pwcChars,
@@ -184,21 +184,21 @@ FUNCTION: HRESULT ScriptGetGlyphABCWidth (
ABC* pABC
) ;
-C-STRUCT: SCRIPT_PROPERTIES
- { "DWORD" "flags" } ;
+STRUCT: SCRIPT_PROPERTIES
+ { flags DWORD } ;
FUNCTION: HRESULT ScriptGetProperties (
SCRIPT_PROPERTIES*** ppSp,
int* piNumScripts
) ;
-C-STRUCT: SCRIPT_FONTPROPERTIES
- { "int" "cBytes" }
- { "WORD" "wgBlank" }
- { "WORD" "wgDefault" }
- { "WORD" "wgInvalid" }
- { "WORD" "wgKashida" }
- { "int" "iKashidaWidth" } ;
+STRUCT: SCRIPT_FONTPROPERTIES
+ { cBytes int }
+ { wgBlank WORD }
+ { wgDefault WORD }
+ { wgInvalid WORD }
+ { wgKashida WORD }
+ { iKashidaWidth int } ;
FUNCTION: HRESULT ScriptGetFontProperties (
HDC hdc,
@@ -234,11 +234,11 @@ CONSTANT: SSA_LAYOUTRTL HEX: 20000000
CONSTANT: SSA_DONTGLYPH HEX: 40000000
CONSTANT: SSA_NOKASHIDA HEX: 80000000
-C-STRUCT: SCRIPT_TABDEF
- { "int" "cTabStops" }
- { "int" "iScale" }
- { "int*" "pTabStops" }
- { "int" "iTabOrigin" } ;
+STRUCT: SCRIPT_TABDEF
+ { cTabStops int }
+ { iScale int }
+ { pTabStops int* }
+ { iTabOrigin int } ;
TYPEDEF: void* SCRIPT_STRING_ANALYSIS
@@ -319,8 +319,8 @@ FUNCTION: HRESULT ScriptIsComplex (
DWORD dwFlags
) ;
-C-STRUCT: SCRIPT_DIGITSUBSTITUTE
- { "DWORD" "flags" } ;
+STRUCT: SCRIPT_DIGITSUBSTITUTE
+ { flags DWORD } ;
FUNCTION: HRESULT ScriptRecordDigitSubstitution (
LCID Locale,
@@ -336,4 +336,4 @@ FUNCTION: HRESULT ScriptApplyDigitSubstitution (
SCRIPT_DIGITSUBSTITUTE* psds,
SCRIPT_CONTROL* psc,
SCRIPT_STATE* pss
-) ;
\ No newline at end of file
+) ;
From 5e15da2b428fbca7d477d61faf4a849d5da4085a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 18 Sep 2009 19:25:00 -0500
Subject: [PATCH 245/266] update windows.winsock structs
---
basis/windows/winsock/winsock.factor | 116 +++++++++++++--------------
1 file changed, 58 insertions(+), 58 deletions(-)
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index e29eb3e090..2e59b9fec1 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -135,9 +135,9 @@ STRUCT: addrinfo
{ addr sockaddr* }
{ next addrinfo* } ;
-C-STRUCT: timeval
- { "long" "sec" }
- { "long" "usec" } ;
+STRUCT: timeval
+ { sec long }
+ { usec long } ;
LIBRARY: winsock
@@ -177,15 +177,15 @@ TYPEDEF: HANDLE WSAEVENT
TYPEDEF: LPHANDLE LPWSAEVENT
TYPEDEF: sockaddr* LPSOCKADDR
-C-STRUCT: FLOWSPEC
- { "uint" "TokenRate" }
- { "uint" "TokenBucketSize" }
- { "uint" "PeakBandwidth" }
- { "uint" "Latency" }
- { "uint" "DelayVariation" }
- { "SERVICETYPE" "ServiceType" }
- { "uint" "MaxSduSize" }
- { "uint" "MinimumPolicedSize" } ;
+STRUCT: FLOWSPEC
+ { TokenRate uint }
+ { TokenBucketSize uint }
+ { PeakBandwidth uint }
+ { Latency uint }
+ { DelayVariation uint }
+ { ServiceType SERVICETYPE }
+ { MaxSduSize uint }
+ { MinimumPolicedSize uint } ;
TYPEDEF: FLOWSPEC* PFLOWSPEC
TYPEDEF: FLOWSPEC* LPFLOWSPEC
@@ -194,44 +194,44 @@ STRUCT: WSABUF
{ buf void* } ;
TYPEDEF: WSABUF* LPWSABUF
-C-STRUCT: QOS
- { "FLOWSPEC" "SendingFlowspec" }
- { "FLOWSPEC" "ReceivingFlowspec" }
- { "WSABUF" "ProviderSpecific" } ;
+STRUCT: QOS
+ { SendingFlowspec FLOWSPEC }
+ { ReceivingFlowspec FLOWSPEC }
+ { ProviderSpecific WSABUF } ;
TYPEDEF: QOS* LPQOS
CONSTANT: MAX_PROTOCOL_CHAIN 7
-C-STRUCT: WSAPROTOCOLCHAIN
- { "int" "ChainLen" }
- ! { { "DWORD" MAX_PROTOCOL_CHAIN } "ChainEntries" } ;
- { { "DWORD" 7 } "ChainEntries" } ;
+STRUCT: WSAPROTOCOLCHAIN
+ { ChainLen int }
+ ! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
+ { ChainEntries { DWORD 7 } } ;
TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
CONSTANT: WSAPROTOCOL_LEN 255
-C-STRUCT: WSAPROTOCOL_INFOW
- { "DWORD" "dwServiceFlags1" }
- { "DWORD" "dwServiceFlags2" }
- { "DWORD" "dwServiceFlags3" }
- { "DWORD" "dwServiceFlags4" }
- { "DWORD" "dwProviderFlags" }
- { "GUID" "ProviderId" }
- { "DWORD" "dwCatalogEntryId" }
- { "WSAPROTOCOLCHAIN" "ProtocolChain" }
- { "int" "iVersion" }
- { "int" "iAddressFamily" }
- { "int" "iMaxSockAddr" }
- { "int" "iMinSockAddr" }
- { "int" "iSocketType" }
- { "int" "iProtocol" }
- { "int" "iProtocolMaxOffset" }
- { "int" "iNetworkByteOrder" }
- { "int" "iSecurityScheme" }
- { "DWORD" "dwMessageSize" }
- { "DWORD" "dwProviderReserved" }
- { { "WCHAR" 256 } "szProtocol" } ;
- ! { { "WCHAR" 256 } "szProtocol"[WSAPROTOCOL_LEN+1] } ;
+STRUCT: WSAPROTOCOL_INFOW
+ { dwServiceFlags1 DWORD }
+ { dwServiceFlags2 DWORD }
+ { dwServiceFlags3 DWORD }
+ { dwServiceFlags4 DWORD }
+ { dwProviderFlags DWORD }
+ { ProviderId GUID }
+ { dwCatalogEntryId DWORD }
+ { ProtocolChain WSAPROTOCOLCHAIN }
+ { iVersion int }
+ { iAddressFamily int }
+ { iMaxSockAddr int }
+ { iMinSockAddr int }
+ { iSocketType int }
+ { iProtocol int }
+ { iProtocolMaxOffset int }
+ { iNetworkByteOrder int }
+ { iSecurityScheme int }
+ { dwMessageSize DWORD }
+ { dwProviderReserved DWORD }
+ { szProtocol { WCHAR 256 } } ;
+ ! { szProtocol[WSAPROTOCOL_LEN+1] { WCHAR 256 } } ;
TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFOW
TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFOW
TYPEDEF: WSAPROTOCOL_INFOW WSAPROTOCOL_INFO
@@ -239,12 +239,12 @@ TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFO
TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFO
-C-STRUCT: WSANAMESPACE_INFOW
- { "GUID" "NSProviderId" }
- { "DWORD" "dwNameSpace" }
- { "BOOL" "fActive" }
- { "DWORD" "dwVersion" }
- { "LPWSTR" "lpszIdentifier" } ;
+STRUCT: WSANAMESPACE_INFOW
+ { NSProviderId GUID }
+ { dwNameSpace DWORD }
+ { fActive BOOL }
+ { dwVersion DWORD }
+ { lpszIdentifier LPWSTR } ;
TYPEDEF: WSANAMESPACE_INFOW* PWSANAMESPACE_INFOW
TYPEDEF: WSANAMESPACE_INFOW* LPWSANAMESPACE_INFOW
TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
@@ -253,19 +253,19 @@ TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO
CONSTANT: FD_MAX_EVENTS 10
-C-STRUCT: WSANETWORKEVENTS
- { "long" "lNetworkEvents" }
- { { "int" FD_MAX_EVENTS } "iErrorCode" } ;
+STRUCT: WSANETWORKEVENTS
+ { lNetworkEvents long }
+ { iErrorCode { int FD_MAX_EVENTS } } ;
TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
-! C-STRUCT: WSAOVERLAPPED
- ! { "DWORD" "Internal" }
- ! { "DWORD" "InternalHigh" }
- ! { "DWORD" "Offset" }
- ! { "DWORD" "OffsetHigh" }
- ! { "WSAEVENT" "hEvent" }
- ! { "DWORD" "bytesTransferred" } ;
+! STRUCT: WSAOVERLAPPED
+ ! { Internal DWORD }
+ ! { InternalHigh DWORD }
+ ! { Offset DWORD }
+ ! { OffsetHigh DWORD }
+ ! { hEvent WSAEVENT }
+ ! { bytesTransferred DWORD } ;
! TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
FUNCTION: SOCKET WSAAccept ( SOCKET s,
From 014163e27b85410396859e04a984167873ea842e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 02:31:06 -0500
Subject: [PATCH 246/266] windows loading fixes
---
basis/windows/advapi32/advapi32.factor | 2 +-
basis/windows/kernel32/kernel32.factor | 2 +-
basis/windows/usp10/usp10.factor | 2 +-
3 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor
index 1bc7f30caf..21f048a00f 100755
--- a/basis/windows/advapi32/advapi32.factor
+++ b/basis/windows/advapi32/advapi32.factor
@@ -1,5 +1,5 @@
USING: alien.syntax kernel math windows.types windows.kernel32
-math.bitwise ;
+math.bitwise classes.struct ;
IN: windows.advapi32
LIBRARY: advapi32
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index ef8952be73..075b0218b3 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -690,8 +690,8 @@ STRUCT: OFSTRUCT
{ nErrCode WORD }
{ Reserved1 WORD }
{ Reserved2 WORD }
- ! { szPathName { CHAR OFS_MAXPATHNAME } } ;
{ szPathName { CHAR 128 } } ;
+ ! { szPathName { CHAR OFS_MAXPATHNAME } } ;
TYPEDEF: OFSTRUCT* LPOFSTRUCT
diff --git a/basis/windows/usp10/usp10.factor b/basis/windows/usp10/usp10.factor
index cf8e69ba24..eb57a46925 100755
--- a/basis/windows/usp10/usp10.factor
+++ b/basis/windows/usp10/usp10.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.destructors ;
+USING: alien.syntax alien.destructors classes.struct ;
IN: windows.usp10
LIBRARY: usp10
From f738a4dc4e39ba31be4d9bdf2a53c2924d4c783d Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 02:44:40 -0500
Subject: [PATCH 247/266] more windows loading fixes
---
.../windows/nt/privileges/privileges.factor | 88 +++++++++----------
basis/windows/winsock/winsock.factor | 2 +-
2 files changed, 45 insertions(+), 45 deletions(-)
diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor
index 6acc1f3544..bb075233bd 100755
--- a/basis/io/backend/windows/nt/privileges/privileges.factor
+++ b/basis/io/backend/windows/nt/privileges/privileges.factor
@@ -1,44 +1,44 @@
-USING: alien alien.c-types alien.data alien.syntax arrays continuations
-destructors generic io.mmap io.ports io.backend.windows io.files.windows
-kernel libc math math.bitwise namespaces quotations sequences windows
-windows.advapi32 windows.kernel32 windows.types io.backend system accessors
-io.backend.windows.privileges windows.errors ;
-IN: io.backend.windows.nt.privileges
-
-TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
-
-! Security tokens
-! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
-
-: (open-process-token) ( handle -- handle )
- { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
- [ OpenProcessToken win32-error=0/f ] keep *void* ;
-
-: open-process-token ( -- handle )
- #! remember to CloseHandle
- GetCurrentProcess (open-process-token) ;
-
-: with-process-token ( quot -- )
- #! quot: ( token-handle -- token-handle )
- [ open-process-token ] dip
- [ keep ] curry
- [ CloseHandle drop ] [ ] cleanup ; inline
-
-: lookup-privilege ( string -- luid )
- [ f ] dip LUID <struct>
- [ LookupPrivilegeValue win32-error=0/f ] keep ;
-
-: make-token-privileges ( name ? -- obj )
- TOKEN_PRIVILEGES <struct>
- 1 >>PrivilegeCount
- LUID_AND_ATTRIBUTES malloc-struct &free
- swap [ SE_PRIVILEGE_ENABLED >>Attributes ] when
- >>Privileges
- [ lookup-privilege ] dip
- [ Privileges>> (>>Luid) ] keep ;
-
-M: winnt set-privilege ( name ? -- )
- [
- -rot 0 -rot make-token-privileges
- dup length f f AdjustTokenPrivileges win32-error=0/f
- ] with-process-token ;
+USING: alien alien.c-types alien.data alien.syntax arrays continuations
+destructors generic io.mmap io.ports io.backend.windows io.files.windows
+kernel libc math math.bitwise namespaces quotations sequences windows
+windows.advapi32 windows.kernel32 windows.types io.backend system accessors
+io.backend.windows.privileges classes.struct windows.errors ;
+IN: io.backend.windows.nt.privileges
+
+TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
+
+! Security tokens
+! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
+
+: (open-process-token) ( handle -- handle )
+ { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
+ [ OpenProcessToken win32-error=0/f ] keep *void* ;
+
+: open-process-token ( -- handle )
+ #! remember to CloseHandle
+ GetCurrentProcess (open-process-token) ;
+
+: with-process-token ( quot -- )
+ #! quot: ( token-handle -- token-handle )
+ [ open-process-token ] dip
+ [ keep ] curry
+ [ CloseHandle drop ] [ ] cleanup ; inline
+
+: lookup-privilege ( string -- luid )
+ [ f ] dip LUID <struct>
+ [ LookupPrivilegeValue win32-error=0/f ] keep ;
+
+: make-token-privileges ( name ? -- obj )
+ TOKEN_PRIVILEGES <struct>
+ 1 >>PrivilegeCount
+ LUID_AND_ATTRIBUTES malloc-struct &free
+ swap [ SE_PRIVILEGE_ENABLED >>Attributes ] when
+ >>Privileges
+ [ lookup-privilege ] dip
+ [ Privileges>> (>>Luid) ] keep ;
+
+M: winnt set-privilege ( name ? -- )
+ [
+ -rot 0 -rot make-token-privileges
+ dup length f f AdjustTokenPrivileges win32-error=0/f
+ ] with-process-token ;
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 2e59b9fec1..dc751e64a6 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -204,8 +204,8 @@ CONSTANT: MAX_PROTOCOL_CHAIN 7
STRUCT: WSAPROTOCOLCHAIN
{ ChainLen int }
- ! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
{ ChainEntries { DWORD 7 } } ;
+ ! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
CONSTANT: WSAPROTOCOL_LEN 255
From b7eff85fe09be0e0cd6255b65fc467f0d1162776 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 10:01:12 -0500
Subject: [PATCH 248/266] fix windows test failures
---
.../backend/windows/nt/privileges/privileges.factor | 13 ++++++-------
basis/windows/types/types.factor | 9 ++++++---
2 files changed, 12 insertions(+), 10 deletions(-)
diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor
index bb075233bd..6022e91efd 100755
--- a/basis/io/backend/windows/nt/privileges/privileges.factor
+++ b/basis/io/backend/windows/nt/privileges/privileges.factor
@@ -1,6 +1,6 @@
USING: alien alien.c-types alien.data alien.syntax arrays continuations
destructors generic io.mmap io.ports io.backend.windows io.files.windows
-kernel libc math math.bitwise namespaces quotations sequences windows
+kernel libc locals math math.bitwise namespaces quotations sequences windows
windows.advapi32 windows.kernel32 windows.types io.backend system accessors
io.backend.windows.privileges classes.struct windows.errors ;
IN: io.backend.windows.nt.privileges
@@ -28,17 +28,16 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
[ f ] dip LUID <struct>
[ LookupPrivilegeValue win32-error=0/f ] keep ;
-: make-token-privileges ( name ? -- obj )
+:: make-token-privileges ( name enabled? -- obj )
TOKEN_PRIVILEGES <struct>
1 >>PrivilegeCount
LUID_AND_ATTRIBUTES malloc-struct &free
- swap [ SE_PRIVILEGE_ENABLED >>Attributes ] when
- >>Privileges
- [ lookup-privilege ] dip
- [ Privileges>> (>>Luid) ] keep ;
+ enabled? [ SE_PRIVILEGE_ENABLED >>Attributes ] when
+ name lookup-privilege >>Luid
+ >>Privileges ;
M: winnt set-privilege ( name ? -- )
[
-rot 0 -rot make-token-privileges
- dup length f f AdjustTokenPrivileges win32-error=0/f
+ dup byte-length f f AdjustTokenPrivileges win32-error=0/f
] with-process-token ;
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index fa043b8033..bac9ebf372 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -11,6 +11,12 @@ TYPEDEF: uchar UCHAR
TYPEDEF: uchar BYTE
TYPEDEF: ushort wchar_t
+SYMBOL: wchar_t*
+<<
+{ char* utf16n } \ wchar_t* typedef
+wchar_t wchar_t* "pointer-c-type" set-word-prop
+>>
+
TYPEDEF: wchar_t WCHAR
TYPEDEF: short SHORT
@@ -70,9 +76,6 @@ TYPEDEF: ulonglong ULARGE_INTEGER
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
-SYMBOL: wchar_t*
-<< { char* utf16n } \ wchar_t* typedef >>
-
TYPEDEF: wchar_t* LPCSTR
TYPEDEF: wchar_t* LPWSTR
TYPEDEF: WCHAR TCHAR
From 2313b077d2bb50aa0c33f35ed493efd2118dbcd9 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 11:30:23 -0500
Subject: [PATCH 249/266] fix windows bootstrap
---
basis/windows/types/types.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index bac9ebf372..6275f2d3c9 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -14,7 +14,7 @@ TYPEDEF: ushort wchar_t
SYMBOL: wchar_t*
<<
{ char* utf16n } \ wchar_t* typedef
-wchar_t wchar_t* "pointer-c-type" set-word-prop
+\ wchar_t \ wchar_t* "pointer-c-type" set-word-prop
>>
TYPEDEF: wchar_t WCHAR
From 433c0657294df1fbfa97cca6f2d5e56d0060f40f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 20:47:11 -0500
Subject: [PATCH 250/266] update structs in curses
---
extra/curses/curses.factor | 8 ++--
extra/curses/ffi/ffi.factor | 80 ++++++++++++++++++-------------------
2 files changed, 44 insertions(+), 44 deletions(-)
diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor
index 3e466b4781..4d6c77fd23 100644
--- a/extra/curses/curses.factor
+++ b/extra/curses/curses.factor
@@ -3,7 +3,7 @@
USING: accessors alien.c-types alien.strings assocs byte-arrays
combinators continuations destructors fry io.encodings.8-bit
io io.encodings.string io.encodings.utf8 kernel math
-namespaces prettyprint sequences
+namespaces prettyprint sequences classes.struct
strings threads curses.ffi ;
IN: curses
@@ -133,12 +133,12 @@ PRIVATE>
: move-cursor ( window-name y x -- )
[
- window-ptr
+ window-ptr c-window memory>struct
{
[ ]
[ (curses-window-refresh) ]
- [ c-window-_curx ]
- [ c-window-_cury ]
+ [ _curx>> ]
+ [ _cury>> ]
} cleave
] 2dip mvcur curses-error (curses-window-refresh) ;
diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor
index 3ff9404bff..4eb01e913c 100644
--- a/extra/curses/ffi/ffi.factor
+++ b/extra/curses/ffi/ffi.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.syntax combinators kernel system
-alien.libraries ;
+alien.libraries classes.struct ;
IN: curses.ffi
<< "curses" {
@@ -21,56 +21,56 @@ TYPEDEF: ushort wchar_t
CONSTANT: CCHARW_MAX 5
-C-STRUCT: cchar_t
- { "attr_t" "attr" }
- { { "wchar_t" CCHARW_MAX } "chars" } ;
+STRUCT: cchar_t
+ { attr attr_t }
+ { chars { wchar_t CCHARW_MAX } } ;
-C-STRUCT: pdat
- { "NCURSES_SIZE_T" "_pad_y" }
- { "NCURSES_SIZE_T" "_pad_x" }
- { "NCURSES_SIZE_T" "_pad_top" }
- { "NCURSES_SIZE_T" "_pad_left" }
- { "NCURSES_SIZE_T" "_pad_bottom" }
- { "NCURSES_SIZE_T" "_pad_right" } ;
+STRUCT: pdat
+ { _pad_y NCURSES_SIZE_T }
+ { _pad_x NCURSES_SIZE_T }
+ { _pad_top NCURSES_SIZE_T }
+ { _pad_left NCURSES_SIZE_T }
+ { _pad_bottom NCURSES_SIZE_T }
+ { _pad_right NCURSES_SIZE_T } ;
-C-STRUCT: c-window
- { "NCURSES_SIZE_T" "_cury" }
- { "NCURSES_SIZE_T" "_curx" }
+STRUCT: c-window
+ { _cury NCURSES_SIZE_T }
+ { _curx NCURSES_SIZE_T }
- { "NCURSES_SIZE_T" "_maxy" }
- { "NCURSES_SIZE_T" "_maxx" }
- { "NCURSES_SIZE_T" "_begy" }
- { "NCURSES_SIZE_T" "_begx" }
+ { _maxy NCURSES_SIZE_T }
+ { _maxx NCURSES_SIZE_T }
+ { _begy NCURSES_SIZE_T }
+ { _begx NCURSES_SIZE_T }
- { "short" " _flags" }
+ { _flags short }
- { "attr_t" "_attrs" }
- { "chtype" "_bkgd" }
+ { _attrs attr_t }
+ { _bkgd chtype }
- { "bool" "_notimeout" }
- { "bool" "_clear" }
- { "bool" "_leaveok" }
- { "bool" "_scroll" }
- { "bool" "_idlok" }
- { "bool" "_idcok" }
- { "bool" "_immed" }
- { "bool" "_sync" }
- { "bool" "_use_keypad" }
- { "int" "_delay" }
+ { _notimeout bool }
+ { _clear bool }
+ { _leaveok bool }
+ { _scroll bool }
+ { _idlok bool }
+ { _idcok bool }
+ { _immed bool }
+ { _sync bool }
+ { _use_keypad bool }
+ { _delay int }
- { "char*" "_line" }
- { "NCURSES_SIZE_T" "_regtop" }
- { "NCURSES_SIZE_T" "_regbottom" }
+ { _line char* }
+ { _regtop NCURSES_SIZE_T }
+ { _regbottom NCURSES_SIZE_T }
- { "int" "_parx" }
- { "int" "_pary" }
- { "WINDOW*" "_parent" }
+ { _parx int }
+ { _pary int }
+ { _parent WINDOW* }
- { "pdat" "_pad" }
+ { _pad pdat }
- { "NCURSES_SIZE_T" "_yoffset" }
+ { _yoffset NCURSES_SIZE_T }
- { "cchar_t" "_bkgrnd" } ;
+ { _bkgrnd cchar_t } ;
LIBRARY: curses
From 5d3452b3cf221da06ad6987066cefe94a663e125 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 21:10:40 -0500
Subject: [PATCH 251/266] update freetype structs
---
extra/freetype/freetype.factor | 188 ++++++++++++++++-----------------
1 file changed, 94 insertions(+), 94 deletions(-)
diff --git a/extra/freetype/freetype.factor b/extra/freetype/freetype.factor
index 0bfaae9853..6644596828 100644
--- a/extra/freetype/freetype.factor
+++ b/extra/freetype/freetype.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax kernel system combinators
-alien.libraries ;
+alien.libraries classes.struct ;
IN: freetype
<< "freetype" {
@@ -41,130 +41,130 @@ FUNCTION: FT_Error FT_Init_FreeType ( void* library ) ;
TYPEDEF: void face
TYPEDEF: void glyph
-C-STRUCT: glyph
- { "void*" "library" }
- { "face*" "face" }
- { "glyph*" "next" }
- { "FT_UInt" "reserved" }
- { "void*" "generic" }
- { "void*" "generic" }
+STRUCT: glyph
+ { library void* }
+ { face face* }
+ { next glyph* }
+ { reserved FT_UInt }
+ { generic void* }
+ { generic2 void* }
- { "FT_Pos" "width" }
- { "FT_Pos" "height" }
+ { width FT_Pos }
+ { height FT_Pos }
- { "FT_Pos" "hori-bearing-x" }
- { "FT_Pos" "hori-bearing-y" }
- { "FT_Pos" "hori-advance" }
+ { hori-bearing-x FT_Pos }
+ { hori-bearing-y FT_Pos }
+ { hori-advance FT_Pos }
- { "FT_Pos" "vert-bearing-x" }
- { "FT_Pos" "vert-bearing-y" }
- { "FT_Pos" "vert-advance" }
+ { vert-bearing-x FT_Pos }
+ { vert-bearing-y FT_Pos }
+ { vert-advance FT_Pos }
- { "FT_Fixed" "linear-hori-advance" }
- { "FT_Fixed" "linear-vert-advance" }
- { "FT_Pos" "advance-x" }
- { "FT_Pos" "advance-y" }
+ { linear-hori-advance FT_Fixed }
+ { linear-vert-advance FT_Fixed }
+ { advance-x FT_Pos }
+ { advance-y FT_Pos }
- { "intptr_t" "format" }
+ { format intptr_t }
- { "int" "bitmap-rows" }
- { "int" "bitmap-width" }
- { "int" "bitmap-pitch" }
- { "void*" "bitmap-buffer" }
- { "short" "bitmap-num-grays" }
- { "char" "bitmap-pixel-mode" }
- { "char" "bitmap-palette-mode" }
- { "void*" "bitmap-palette" }
+ { bitmap-rows int }
+ { bitmap-width int }
+ { bitmap-pitch int }
+ { bitmap-buffer void* }
+ { bitmap-num-grays short }
+ { bitmap-pixel-mode char }
+ { bitmap-palette-mode char }
+ { bitmap-palette void* }
- { "FT_Int" "bitmap-left" }
- { "FT_Int" "bitmap-top" }
+ { bitmap-left FT_Int }
+ { bitmap-top FT_Int }
- { "short" "n-contours" }
- { "short" "n-points" }
+ { n-contours short }
+ { n-points short }
- { "void*" "points" }
- { "char*" "tags" }
- { "short*" "contours" }
+ { points void* }
+ { tags char* }
+ { contours short* }
- { "int" "outline-flags" }
+ { outline-flags int }
- { "FT_UInt" "num_subglyphs" }
- { "void*" "subglyphs" }
+ { num_subglyphs FT_UInt }
+ { subglyphs void* }
- { "void*" "control-data" }
- { "long" "control-len" }
+ { control-data void* }
+ { control-len long }
- { "FT_Pos" "lsb-delta" }
- { "FT_Pos" "rsb-delta" }
+ { lsb-delta FT_Pos }
+ { rsb-delta FT_Pos }
- { "void*" "other" } ;
+ { other void* } ;
-C-STRUCT: face-size
- { "face*" "face" }
- { "void*" "generic" }
- { "void*" "generic" }
+STRUCT: face-size
+ { face face* }
+ { generic void* }
+ { generic2 void* }
- { "FT_UShort" "x-ppem" }
- { "FT_UShort" "y-ppem" }
+ { x-ppem FT_UShort }
+ { y-ppem FT_UShort }
- { "FT_Fixed" "x-scale" }
- { "FT_Fixed" "y-scale" }
+ { x-scale FT_Fixed }
+ { y-scale FT_Fixed }
- { "FT_Pos" "ascender" }
- { "FT_Pos" "descender" }
- { "FT_Pos" "height" }
- { "FT_Pos" "max-advance" } ;
+ { ascender FT_Pos }
+ { descender FT_Pos }
+ { height FT_Pos }
+ { max-advance FT_Pos } ;
-C-STRUCT: face
- { "FT_Long" "num-faces" }
- { "FT_Long" "index" }
+STRUCT: face
+ { num-faces FT_Long }
+ { index FT_Long }
- { "FT_Long" "flags" }
- { "FT_Long" "style-flags" }
+ { flags FT_Long }
+ { style-flags FT_Long }
- { "FT_Long" "num-glyphs" }
+ { num-glyphs FT_Long }
- { "FT_Char*" "family-name" }
- { "FT_Char*" "style-name" }
+ { family-name FT_Char* }
+ { style-name FT_Char* }
- { "FT_Int" "num-fixed-sizes" }
- { "void*" "available-sizes" }
+ { num-fixed-sizes FT_Int }
+ { available-sizes void* }
- { "FT_Int" "num-charmaps" }
- { "void*" "charmaps" }
+ { num-charmaps FT_Int }
+ { charmaps void* }
- { "void*" "generic" }
- { "void*" "generic" }
+ { generic void* }
+ { generic2 void* }
- { "FT_Pos" "x-min" }
- { "FT_Pos" "y-min" }
- { "FT_Pos" "x-max" }
- { "FT_Pos" "y-max" }
+ { x-min FT_Pos }
+ { y-min FT_Pos }
+ { x-max FT_Pos }
+ { y-max FT_Pos }
- { "FT_UShort" "units-per-em" }
- { "FT_Short" "ascender" }
- { "FT_Short" "descender" }
- { "FT_Short" "height" }
+ { units-per-em FT_UShort }
+ { ascender FT_Short }
+ { descender FT_Short }
+ { height FT_Short }
- { "FT_Short" "max-advance-width" }
- { "FT_Short" "max-advance-height" }
+ { max-advance-width FT_Short }
+ { max-advance-height FT_Short }
- { "FT_Short" "underline-position" }
- { "FT_Short" "underline-thickness" }
+ { underline-position FT_Short }
+ { underline-thickness FT_Short }
- { "glyph*" "glyph" }
- { "face-size*" "size" }
- { "void*" "charmap" } ;
+ { glyph glyph* }
+ { size face-size* }
+ { charmap void* } ;
-C-STRUCT: FT_Bitmap
- { "int" "rows" }
- { "int" "width" }
- { "int" "pitch" }
- { "void*" "buffer" }
- { "short" "num_grays" }
- { "char" "pixel_mode" }
- { "char" "palette_mode" }
- { "void*" "palette" } ;
+STRUCT: FT_Bitmap
+ { rows int }
+ { width int }
+ { pitch int }
+ { buffer void* }
+ { num_grays short }
+ { pixel_mode char }
+ { palette_mode char }
+ { palette void* } ;
FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;
From 6c400b44f3ee56b0ad76382a8ca2afc3d8719e25 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 21:10:53 -0500
Subject: [PATCH 252/266] update io.serial structs
---
extra/io/serial/unix/termios/bsd/bsd.factor | 18 ++++++++---------
.../io/serial/unix/termios/linux/linux.factor | 20 +++++++++----------
extra/io/serial/unix/unix.factor | 14 ++++++-------
3 files changed, 26 insertions(+), 26 deletions(-)
diff --git a/extra/io/serial/unix/termios/bsd/bsd.factor b/extra/io/serial/unix/termios/bsd/bsd.factor
index 63d0157780..1d1e217ba0 100644
--- a/extra/io/serial/unix/termios/bsd/bsd.factor
+++ b/extra/io/serial/unix/termios/bsd/bsd.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel sequences system ;
+USING: alien.syntax classes.struct kernel sequences system ;
IN: io.serial.unix.termios
CONSTANT: NCCS 20
@@ -9,11 +9,11 @@ TYPEDEF: uint tcflag_t
TYPEDEF: uchar cc_t
TYPEDEF: uint speed_t
-C-STRUCT: termios
- { "tcflag_t" "iflag" } ! input mode flags
- { "tcflag_t" "oflag" } ! output mode flags
- { "tcflag_t" "cflag" } ! control mode flags
- { "tcflag_t" "lflag" } ! local mode flags
- { { "cc_t" NCCS } "cc" } ! control characters
- { "speed_t" "ispeed" } ! input speed
- { "speed_t" "ospeed" } ; ! output speed
+STRUCT: termios
+ { iflag tcflag_t }
+ { oflag tcflag_t }
+ { cflag tcflag_t }
+ { lflag tcflag_t }
+ { cc { cc_t NCCS } }
+ { ispeed speed_t }
+ { ospeed speed_t } ;
diff --git a/extra/io/serial/unix/termios/linux/linux.factor b/extra/io/serial/unix/termios/linux/linux.factor
index 4b8c52c7fb..0982339cf8 100644
--- a/extra/io/serial/unix/termios/linux/linux.factor
+++ b/extra/io/serial/unix/termios/linux/linux.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel system unix ;
+USING: alien.syntax classes.struct kernel system unix ;
IN: io.serial.unix.termios
CONSTANT: NCCS 32
@@ -9,12 +9,12 @@ TYPEDEF: uchar cc_t
TYPEDEF: uint speed_t
TYPEDEF: uint tcflag_t
-C-STRUCT: termios
- { "tcflag_t" "iflag" } ! input mode flags
- { "tcflag_t" "oflag" } ! output mode flags
- { "tcflag_t" "cflag" } ! control mode flags
- { "tcflag_t" "lflag" } ! local mode flags
- { "cc_t" "line" } ! line discipline
- { { "cc_t" NCCS } "cc" } ! control characters
- { "speed_t" "ispeed" } ! input speed
- { "speed_t" "ospeed" } ; ! output speed
+STRUCT: termios
+ { iflag tcflag_t }
+ { oflag tcflag_t }
+ { cflag tcflag_t }
+ { lflag tcflag_t }
+ { line cc_t }
+ { cc { cc_t NCCS } }
+ { ispeed speed_t }
+ { ospeed speed_t } ;
diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor
index 57c30dde15..8ee115ca45 100644
--- a/extra/io/serial/unix/unix.factor
+++ b/extra/io/serial/unix/unix.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax alien.data
-combinators io.ports io.streams.duplex system kernel
-math math.bitwise vocabs.loader unix io.serial
+classes.struct combinators io.ports io.streams.duplex
+system kernel math math.bitwise vocabs.loader unix io.serial
io.serial.unix.termios io.backend.unix ;
IN: io.serial.unix
@@ -41,19 +41,19 @@ M: unix open-serial ( serial -- serial' )
: get-termios ( serial -- termios )
serial-fd
- "termios" <c-object> [ tcgetattr io-error ] keep ;
+ termios <struct> [ tcgetattr io-error ] keep ;
: configure-termios ( serial -- )
dup termios>>
{
- [ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ]
- [ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ]
+ [ [ iflag>> ] dip over [ (>>iflag) ] [ 2drop ] if ]
+ [ [ oflag>> ] dip over [ (>>oflag) ] [ 2drop ] if ]
[
[
[ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor
- ] dip set-termios-cflag
+ ] dip (>>cflag)
]
- [ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ]
+ [ [ lflag>> ] dip over [ (>>lflag) ] [ 2drop ] if ]
} 2cleave ;
: tciflush ( serial -- )
From 77caffff8eadfc980fb45a9e0b01b4b0bc0ce73f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 19 Sep 2009 21:16:13 -0500
Subject: [PATCH 253/266] update tokyo structs
---
extra/tokyo/alien/tcrdb/tcrdb.factor | 28 ++++++++++++++--------------
1 file changed, 14 insertions(+), 14 deletions(-)
diff --git a/extra/tokyo/alien/tcrdb/tcrdb.factor b/extra/tokyo/alien/tcrdb/tcrdb.factor
index 3ff3bc6428..0450e6522c 100755
--- a/extra/tokyo/alien/tcrdb/tcrdb.factor
+++ b/extra/tokyo/alien/tcrdb/tcrdb.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.libraries alien.syntax
combinators kernel system tokyo.alien.tchdb tokyo.alien.tcutil
-tokyo.alien.tctdb ;
+tokyo.alien.tctdb classes.struct ;
IN: tokyo.alien.tcrdb
<< "tokyotyrant" {
@@ -14,16 +14,16 @@ IN: tokyo.alien.tcrdb
LIBRARY: tokyotyrant
TYPEDEF: void* TCRDB*
-! C-STRUCT: TCRDB
-! { "pthread_mutex_t" mmtx }
-! { "pthread_key_t" eckey }
-! { "char*" host }
-! { "int" port }
-! { "char*" expr }
-! { "int" fd }
-! { "TTSOCK*" sock }
-! { "double" timeout }
-! { "int" opts } ;
+! STRUCT: TCRDB
+! { mmtx pthread_mutex_t }
+! { eckey pthread_key_t }
+! { host char* }
+! { port int }
+! { expr char* }
+! { fd int }
+! { sock TTSOCK* }
+! { timeout double }
+! { opts int } ;
C-ENUM:
TTESUCCESS
@@ -96,9 +96,9 @@ CONSTANT: RDBITVOID TDBITVOID
CONSTANT: RDBITKEEP TDBITKEEP
TYPEDEF: void* RDBQRY*
-! C-STRUCT: RDBQRY
-! { "TCRDB*" rdb }
-! { "TCLIST*" args } ;
+! STRUCT: RDBQRY
+! { rdb TCRDB* }
+! { args TCLIST* } ;
CONSTANT: RDBQCSTREQ TDBQCSTREQ
CONSTANT: RDBQCSTRINC TDBQCSTRINC
From 29c45120669cfebf8b1f7235a0c3e1596de76a85 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Sun, 20 Sep 2009 04:17:34 -0500
Subject: [PATCH 254/266] cpu.x86: cleanup
---
basis/cpu/x86/x86.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 97bd2f78de..d8e02fe516 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -11,11 +11,10 @@ compiler.cfg.intrinsics
compiler.cfg.comparisons
compiler.cfg.stack-frame
compiler.codegen.fixup ;
+FROM: layouts => cell ;
FROM: math => float ;
IN: cpu.x86
-<< enable-fixnum-log2 >>
-
! Add some methods to the assembler to be more useful to the backend
M: label JMP 0 JMP rc-relative label-fixup ;
M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
@@ -779,3 +778,4 @@ M: x86 small-enough? ( n -- ? )
enable-sse3-simd ;
enable-min/max
+enable-fixnum-log2
\ No newline at end of file
From f459c24e454057aa921bbb5cef4799a442149d69 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Sep 2009 16:48:42 -0500
Subject: [PATCH 255/266] oops, float>hex didn't preserve leading zeroes in
mantissa
---
core/math/parser/parser-tests.factor | 3 +++
core/math/parser/parser.factor | 3 ++-
2 files changed, 5 insertions(+), 1 deletion(-)
diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor
index f2ccb78a06..34bca8a34e 100644
--- a/core/math/parser/parser-tests.factor
+++ b/core/math/parser/parser-tests.factor
@@ -129,6 +129,7 @@ unit-test
[ "1.0p0" ] [ 1.0 >hex ] unit-test
[ "1.8p2" ] [ 6.0 >hex ] unit-test
+[ "1.08p2" ] [ 4.125 >hex ] unit-test
[ "1.8p-2" ] [ 0.375 >hex ] unit-test
[ "-1.8p2" ] [ -6.0 >hex ] unit-test
[ "1.8p10" ] [ 1536.0 >hex ] unit-test
@@ -137,6 +138,8 @@ unit-test
[ "-0.0" ] [ -0.0 >hex ] unit-test
[ 1.0 ] [ "1.0" hex> ] unit-test
+[ 1.5 ] [ "1.8" hex> ] unit-test
+[ 1.03125 ] [ "1.08" hex> ] unit-test
[ 15.5 ] [ "f.8" hex> ] unit-test
[ 15.53125 ] [ "f.88" hex> ] unit-test
[ -15.5 ] [ "-f.8" hex> ] unit-test
diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index d422a2c199..a53604ddf9 100644
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -213,7 +213,8 @@ M: ratio >base
-0.0 double>bits bitand zero? "" "-" ? ;
: float>hex-value ( mantissa -- str )
- 16 >base [ CHAR: 0 = ] trim-tail [ "0" ] [ ] if-empty "1." prepend ;
+ 16 >base 13 CHAR: 0 pad-head [ CHAR: 0 = ] trim-tail
+ [ "0" ] [ ] if-empty "1." prepend ;
: float>hex-expt ( mantissa -- str )
10 >base "p" prepend ;
From 32146c645d057631db5664580dffbbb7cf843cfe Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Sep 2009 23:10:54 -0500
Subject: [PATCH 256/266] add some keyboard shortcuts to vim plugin
---
misc/vim/plugin/factor.vim | 2 ++
1 file changed, 2 insertions(+)
diff --git a/misc/vim/plugin/factor.vim b/misc/vim/plugin/factor.vim
index aedae9770f..ad6f92f3c0 100644
--- a/misc/vim/plugin/factor.vim
+++ b/misc/vim/plugin/factor.vim
@@ -1,6 +1,8 @@
nmap <silent> <Leader>fi :FactorVocabImpl<CR>
nmap <silent> <Leader>fd :FactorVocabDocs<CR>
nmap <silent> <Leader>ft :FactorVocabTests<CR>
+nmap <Leader>fv :FactorVocab<SPACE>
+nmap <Leader>fn :NewFactorVocab<SPACE>
if !exists("g:FactorRoot")
let g:FactorRoot = "~/factor"
From 08d9d0ad28992c36e0a6af4ab816a30ac945f539 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Sep 2009 23:12:31 -0500
Subject: [PATCH 257/266] fix synopsis for C-TYPE:, TYPEDEF:, and FUNCTION: so
they properly show IN: clause
---
basis/alien/prettyprint/prettyprint.factor | 22 ++++++++++++++--------
1 file changed, 14 insertions(+), 8 deletions(-)
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 4586c08542..e17d4c0533 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -17,7 +17,7 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
M: c-type-word definer drop \ C-TYPE: f ;
M: c-type-word definition drop f ;
-M: typedef-word declarations. drop ;
+M: c-type-word declarations. drop ;
GENERIC: pprint-c-type ( c-type -- )
M: word pprint-c-type pprint-word ;
@@ -28,9 +28,12 @@ M: array pprint-c-type pprint* ;
M: typedef-word definer drop \ TYPEDEF: f ;
M: typedef-word synopsis*
- \ TYPEDEF: pprint-word
- dup "c-type" word-prop pprint-c-type
- pprint-word ;
+ {
+ [ seeing-word ]
+ [ definer. ]
+ [ "c-type" word-prop pprint-c-type ]
+ [ pprint-word ]
+ } cleave ;
: pprint-function-arg ( type name -- )
[ pprint-c-type ] [ text ] bi* ;
@@ -46,7 +49,10 @@ M: alien-function-word definer
drop \ FUNCTION: \ ; ;
M: alien-function-word definition drop f ;
M: alien-function-word synopsis*
- \ FUNCTION: pprint-word
- [ def>> first pprint-c-type ]
- [ pprint-word ]
- [ <block "(" text pprint-function-args ")" text block> ] tri ;
+ {
+ [ seeing-word ]
+ [ definer. ]
+ [ def>> first pprint-c-type ]
+ [ pprint-word ]
+ [ <block "(" text pprint-function-args ")" text block> ]
+ } cleave ;
From 3eeaca863155322b19f7c2ac8687bf0781ad06f5 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Sep 2009 23:24:24 -0500
Subject: [PATCH 258/266] move system-info to basis
---
{extra => basis}/system-info/authors.txt | 0
{extra => basis}/system-info/backend/authors.txt | 0
{extra => basis}/system-info/backend/backend.factor | 0
{extra => basis}/system-info/linux/authors.txt | 0
{extra => basis}/system-info/linux/linux.factor | 0
{extra => basis}/system-info/linux/tags.txt | 0
{extra => basis}/system-info/macosx/authors.txt | 0
{extra => basis}/system-info/macosx/macosx.factor | 0
{extra => basis}/system-info/macosx/tags.txt | 0
{extra => basis}/system-info/summary.txt | 0
{extra => basis}/system-info/system-info.factor | 0
{extra => basis}/system-info/windows/authors.txt | 0
{extra => basis}/system-info/windows/ce/authors.txt | 0
{extra => basis}/system-info/windows/ce/ce.factor | 0
{extra => basis}/system-info/windows/ce/tags.txt | 0
{extra => basis}/system-info/windows/nt/authors.txt | 0
{extra => basis}/system-info/windows/nt/nt.factor | 0
{extra => basis}/system-info/windows/nt/tags.txt | 0
{extra => basis}/system-info/windows/tags.txt | 0
{extra => basis}/system-info/windows/windows.factor | 0
20 files changed, 0 insertions(+), 0 deletions(-)
rename {extra => basis}/system-info/authors.txt (100%)
rename {extra => basis}/system-info/backend/authors.txt (100%)
rename {extra => basis}/system-info/backend/backend.factor (100%)
rename {extra => basis}/system-info/linux/authors.txt (100%)
rename {extra => basis}/system-info/linux/linux.factor (100%)
rename {extra => basis}/system-info/linux/tags.txt (100%)
rename {extra => basis}/system-info/macosx/authors.txt (100%)
rename {extra => basis}/system-info/macosx/macosx.factor (100%)
rename {extra => basis}/system-info/macosx/tags.txt (100%)
rename {extra => basis}/system-info/summary.txt (100%)
rename {extra => basis}/system-info/system-info.factor (100%)
rename {extra => basis}/system-info/windows/authors.txt (100%)
rename {extra => basis}/system-info/windows/ce/authors.txt (100%)
rename {extra => basis}/system-info/windows/ce/ce.factor (100%)
rename {extra => basis}/system-info/windows/ce/tags.txt (100%)
rename {extra => basis}/system-info/windows/nt/authors.txt (100%)
rename {extra => basis}/system-info/windows/nt/nt.factor (100%)
rename {extra => basis}/system-info/windows/nt/tags.txt (100%)
rename {extra => basis}/system-info/windows/tags.txt (100%)
rename {extra => basis}/system-info/windows/windows.factor (100%)
diff --git a/extra/system-info/authors.txt b/basis/system-info/authors.txt
similarity index 100%
rename from extra/system-info/authors.txt
rename to basis/system-info/authors.txt
diff --git a/extra/system-info/backend/authors.txt b/basis/system-info/backend/authors.txt
similarity index 100%
rename from extra/system-info/backend/authors.txt
rename to basis/system-info/backend/authors.txt
diff --git a/extra/system-info/backend/backend.factor b/basis/system-info/backend/backend.factor
similarity index 100%
rename from extra/system-info/backend/backend.factor
rename to basis/system-info/backend/backend.factor
diff --git a/extra/system-info/linux/authors.txt b/basis/system-info/linux/authors.txt
similarity index 100%
rename from extra/system-info/linux/authors.txt
rename to basis/system-info/linux/authors.txt
diff --git a/extra/system-info/linux/linux.factor b/basis/system-info/linux/linux.factor
similarity index 100%
rename from extra/system-info/linux/linux.factor
rename to basis/system-info/linux/linux.factor
diff --git a/extra/system-info/linux/tags.txt b/basis/system-info/linux/tags.txt
similarity index 100%
rename from extra/system-info/linux/tags.txt
rename to basis/system-info/linux/tags.txt
diff --git a/extra/system-info/macosx/authors.txt b/basis/system-info/macosx/authors.txt
similarity index 100%
rename from extra/system-info/macosx/authors.txt
rename to basis/system-info/macosx/authors.txt
diff --git a/extra/system-info/macosx/macosx.factor b/basis/system-info/macosx/macosx.factor
similarity index 100%
rename from extra/system-info/macosx/macosx.factor
rename to basis/system-info/macosx/macosx.factor
diff --git a/extra/system-info/macosx/tags.txt b/basis/system-info/macosx/tags.txt
similarity index 100%
rename from extra/system-info/macosx/tags.txt
rename to basis/system-info/macosx/tags.txt
diff --git a/extra/system-info/summary.txt b/basis/system-info/summary.txt
similarity index 100%
rename from extra/system-info/summary.txt
rename to basis/system-info/summary.txt
diff --git a/extra/system-info/system-info.factor b/basis/system-info/system-info.factor
similarity index 100%
rename from extra/system-info/system-info.factor
rename to basis/system-info/system-info.factor
diff --git a/extra/system-info/windows/authors.txt b/basis/system-info/windows/authors.txt
similarity index 100%
rename from extra/system-info/windows/authors.txt
rename to basis/system-info/windows/authors.txt
diff --git a/extra/system-info/windows/ce/authors.txt b/basis/system-info/windows/ce/authors.txt
similarity index 100%
rename from extra/system-info/windows/ce/authors.txt
rename to basis/system-info/windows/ce/authors.txt
diff --git a/extra/system-info/windows/ce/ce.factor b/basis/system-info/windows/ce/ce.factor
similarity index 100%
rename from extra/system-info/windows/ce/ce.factor
rename to basis/system-info/windows/ce/ce.factor
diff --git a/extra/system-info/windows/ce/tags.txt b/basis/system-info/windows/ce/tags.txt
similarity index 100%
rename from extra/system-info/windows/ce/tags.txt
rename to basis/system-info/windows/ce/tags.txt
diff --git a/extra/system-info/windows/nt/authors.txt b/basis/system-info/windows/nt/authors.txt
similarity index 100%
rename from extra/system-info/windows/nt/authors.txt
rename to basis/system-info/windows/nt/authors.txt
diff --git a/extra/system-info/windows/nt/nt.factor b/basis/system-info/windows/nt/nt.factor
similarity index 100%
rename from extra/system-info/windows/nt/nt.factor
rename to basis/system-info/windows/nt/nt.factor
diff --git a/extra/system-info/windows/nt/tags.txt b/basis/system-info/windows/nt/tags.txt
similarity index 100%
rename from extra/system-info/windows/nt/tags.txt
rename to basis/system-info/windows/nt/tags.txt
diff --git a/extra/system-info/windows/tags.txt b/basis/system-info/windows/tags.txt
similarity index 100%
rename from extra/system-info/windows/tags.txt
rename to basis/system-info/windows/tags.txt
diff --git a/extra/system-info/windows/windows.factor b/basis/system-info/windows/windows.factor
similarity index 100%
rename from extra/system-info/windows/windows.factor
rename to basis/system-info/windows/windows.factor
From 6645b41fac324c8318b93377db5d55faf2bc8a95 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Sep 2009 23:34:53 -0500
Subject: [PATCH 259/266] use hott vista fonts on windows 6.x
---
basis/windows/fonts/fonts.factor | 16 +++++++++++++---
1 file changed, 13 insertions(+), 3 deletions(-)
diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
index b8acf5d8d1..4e1310ff57 100755
--- a/basis/windows/fonts/fonts.factor
+++ b/basis/windows/fonts/fonts.factor
@@ -1,13 +1,23 @@
USING: assocs memoize locals kernel accessors init fonts math
-combinators windows.errors windows.types windows.gdi32 ;
+combinators system-info.windows windows.errors windows.types
+windows.gdi32 ;
IN: windows.fonts
-: windows-font-name ( string -- string' )
+MEMO: windows-fonts ( -- fonts )
+ windows-major 6 >=
+ H{
+ { "sans-serif" "Calibri" }
+ { "serif" "Cambria" }
+ { "monospace" "Consolas" }
+ }
H{
{ "sans-serif" "Tahoma" }
{ "serif" "Times New Roman" }
{ "monospace" "Courier New" }
- } ?at drop ;
+ } ? ;
+
+: windows-font-name ( string -- string' )
+ windows-fonts ?at drop ;
MEMO:: (cache-font) ( font -- HFONT )
font size>> neg ! nHeight
From b09006bba9baccb70aac0beab1a18cde94e5cff8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Sep 2009 23:59:43 -0500
Subject: [PATCH 260/266] include LIBRARY: in FUNCTION: synopsis
---
basis/alien/prettyprint/prettyprint.factor | 2 ++
1 file changed, 2 insertions(+)
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index e17d4c0533..69b9f37776 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -51,8 +51,10 @@ M: alien-function-word definition drop f ;
M: alien-function-word synopsis*
{
[ seeing-word ]
+ [ def>> second [ \ LIBRARY: [ text ] pprint-prefix ] when* ]
[ definer. ]
[ def>> first pprint-c-type ]
[ pprint-word ]
[ <block "(" text pprint-function-args ")" text block> ]
} cleave ;
+
From 00fa7f73fb43762e83812acb6334ea0abe4413c6 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 21 Sep 2009 11:59:41 -0500
Subject: [PATCH 261/266] add CALLBACK: syntax that defines a typedef and an
alien-callback constructor word for function pointer types. update some code
in iokit.hid and windows.dinput to use CALLBACK: instead of TYPEDEF:/word
pairs
---
basis/alien/parser/parser.factor | 29 ++++++++++--
basis/alien/syntax/syntax-docs.factor | 4 ++
basis/alien/syntax/syntax.factor | 6 +++
basis/iokit/hid/hid.factor | 29 +++---------
basis/windows/dinput/dinput.factor | 63 +++++++++++++++------------
5 files changed, 74 insertions(+), 57 deletions(-)
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 9a24f7cd4d..d58f9a315c 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -25,7 +25,7 @@ IN: alien.parser
[ parse-c-type ] if ;
: reset-c-type ( word -- )
- { "c-type" "pointer-c-type" } reset-props ;
+ { "c-type" "pointer-c-type" "callback-effect" "callback-abi" } reset-props ;
: CREATE-C-TYPE ( -- word )
scan current-vocab create dup reset-c-type ;
@@ -55,16 +55,37 @@ IN: alien.parser
return library function
parameters return parse-arglist [ function-quot ] dip ;
+: parse-arg-tokens ( -- tokens )
+ ";" parse-tokens [ "()" subseq? not ] filter ;
+
: (FUNCTION:) ( -- word quot effect )
- scan "c-library" get scan ";" parse-tokens
- [ "()" subseq? not ] filter
- make-function ;
+ scan "c-library" get scan parse-arg-tokens make-function ;
: define-function ( return library function parameters -- )
make-function define-declared ;
+: callback-quot ( return types abi -- quot )
+ [ [ ] 3curry dip alien-callback ] 3curry ;
+
+:: make-callback-type ( abi return! type-name! parameters -- word quot effect )
+ return type-name normalize-c-arg type-name! return!
+ type-name current-vocab create :> type-word
+ type-word [ reset-generic ] [ reset-c-type ] bi
+ void* type-word typedef
+ parameters return parse-arglist :> callback-effect :> types
+ type-word callback-effect "callback-effect" set-word-prop
+ type-word abi "callback-abi" set-word-prop
+ type-word return types abi callback-quot (( quot -- alien )) ;
+
+: (CALLBACK:) ( abi -- word quot effect )
+ scan scan parse-arg-tokens make-callback-type ;
+
PREDICATE: alien-function-word < word
def>> {
[ length 5 = ]
[ last \ alien-invoke eq? ]
} 1&& ;
+
+PREDICATE: alien-callback-type-word < typedef-word
+ "callback-effect" word-prop ;
+
diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor
index e56c83a154..ed9ae240b1 100644
--- a/basis/alien/syntax/syntax-docs.factor
+++ b/basis/alien/syntax/syntax-docs.factor
@@ -81,6 +81,10 @@ HELP: C-ENUM:
{ $code "CONSTANT: red 0" "CONSTANT: green 1" "CONSTANT: blue 2" }
} ;
+HELP: CALLBACK:
+{ $syntax "CALLBACK: return name ( parameters ) ;" }
+{ $values { "return" "a C return type" } { "name" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
+
HELP: &:
{ $syntax "&: symbol" }
{ $values { "symbol" "A C library symbol name" } }
diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index 0e3b569fff..611133bacb 100644
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -18,6 +18,12 @@ SYNTAX: LIBRARY: scan "c-library" set ;
SYNTAX: FUNCTION:
(FUNCTION:) define-declared ;
+SYNTAX: CALLBACK:
+ "cdecl" (CALLBACK:) define-inline ;
+
+SYNTAX: STDCALL-CALLBACK:
+ "stdcall" (CALLBACK:) define-inline ;
+
SYNTAX: TYPEDEF:
scan-c-type CREATE-C-TYPE typedef ;
diff --git a/basis/iokit/hid/hid.factor b/basis/iokit/hid/hid.factor
index 63f91ffc78..a1a4b942b7 100644
--- a/basis/iokit/hid/hid.factor
+++ b/basis/iokit/hid/hid.factor
@@ -130,30 +130,11 @@ TYPEDEF: void* IOHIDTransactionRef
TYPEDEF: UInt32 IOHIDValueScaleType
TYPEDEF: UInt32 IOHIDTransactionDirectionType
-TYPEDEF: void* IOHIDCallback
-: IOHIDCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDReportCallback
-: IOHIDReportCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "IOHIDReportType" "UInt32" "uchar*" "CFIndex" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDValueCallback
-: IOHIDValueCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "IOHIDValueRef" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDValueMultipleCallback
-: IOHIDValueMultipleCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "CFDictionaryRef" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDDeviceCallback
-: IOHIDDeviceCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "IOHIDDeviceRef" } "cdecl" ]
- dip alien-callback ; inline
+CALLBACK: void IOHIDCallback ( void* context, IOReturn result, void* sender ) ;
+CALLBACK: void IOHIDReportCallback ( void* context, IOReturn result, void* sender, IOHIDReportType type, UInt32 reportID, uchar* report, CFIndex reportLength ) ;
+CALLBACK: void IOHIDValueCallback ( void* context, IOReturn result, void* sender, IOHIDValueRef value ) ;
+CALLBACK: void IOHIDValueMultipleCallback ( void* context, IOReturn result, void* sender, CFDictionaryRef multiple ) ;
+CALLBACK: void IOHIDDeviceCallback ( void* context, IOReturn result, void* sender, IOHIDDeviceRef device ) ;
! IOHIDDevice
diff --git a/basis/windows/dinput/dinput.factor b/basis/windows/dinput/dinput.factor
index 46317ab604..598df9a389 100755
--- a/basis/windows/dinput/dinput.factor
+++ b/basis/windows/dinput/dinput.factor
@@ -5,35 +5,6 @@ IN: windows.dinput
LIBRARY: dinput
-TYPEDEF: void* LPDIENUMDEVICESCALLBACKW
-: LPDIENUMDEVICESCALLBACKW ( quot -- alien )
- [ "BOOL" { "LPCDIDEVICEINSTANCEW" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMDEVICESBYSEMANTICSCBW
-: LPDIENUMDEVICESBYSEMANTICSCBW ( quot -- alien )
- [ "BOOL" { "LPCDIDEVICEINSTANCEW" "IDirectInputDevice8W*" "DWORD" "DWORD" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDICONFIGUREDEVICESCALLBACK
-: LPDICONFIGUREDEVICESCALLBACK ( quot -- alien )
- [ "BOOL" { "IUnknown*" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMEFFECTSCALLBACKW
-: LPDIENUMEFFECTSCALLBACKW ( quot -- alien )
- [ "BOOL" { "LPCDIEFFECTINFOW" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
-: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK ( quot -- callback )
- [ "BOOL" { "LPDIRECTINPUTEFFECT" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMEFFECTSINFILECALLBACK
-: LPDIENUMEFFECTSINFILECALLBACK ( quot -- callback )
- [ "BOOL" { "LPCDIFILEEFFECT" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMDEVICEOBJECTSCALLBACKW
-: LPDIENUMDEVICEOBJECTSCALLBACKW ( quot -- callback )
- [ "BOOL" { "LPCDIDEVICEOBJECTINSTANCEW" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-
TYPEDEF: DWORD D3DCOLOR
STRUCT: DIDEVICEINSTANCEW
@@ -326,6 +297,27 @@ STRUCT: DIJOYSTATE2
TYPEDEF: DIJOYSTATE2* LPDIJOYSTATE2
TYPEDEF: DIJOYSTATE2* LPCDIJOYSTATE2
+STDCALL-CALLBACK: BOOL LPDIENUMDEVICESCALLBACKW (
+ LPCDIDEVICEINSTANCEW lpddi,
+ LPVOID pvRef
+) ;
+STDCALL-CALLBACK: BOOL LPDICONFIGUREDEVICESCALLBACK (
+ IUnknown* lpDDSTarget,
+ LPVOID pvRef
+) ;
+STDCALL-CALLBACK: BOOL LPDIENUMEFFECTSCALLBACKW (
+ LPCDIEFFECTINFOW pdei,
+ LPVOID pvRef
+) ;
+STDCALL-CALLBACK: BOOL LPDIENUMEFFECTSINFILECALLBACK (
+ LPCDIFILEEFFECT lpDiFileEf,
+ LPVOID pvRef
+) ;
+STDCALL-CALLBACK: BOOL LPDIENUMDEVICEOBJECTSCALLBACKW (
+ LPCDIDEVICEOBJECTINSTANCEW lpddoi,
+ LPVOID pvRef
+) ;
+
COM-INTERFACE: IDirectInputEffect IUnknown {E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35}
HRESULT Initialize ( HINSTANCE hinst, DWORD dwVersion, REFGUID rguid )
HRESULT GetEffectGuid ( LPGUID pguid )
@@ -338,6 +330,11 @@ COM-INTERFACE: IDirectInputEffect IUnknown {E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35
HRESULT Unload ( )
HRESULT Escape ( LPDIEFFESCAPE pesc ) ;
+STDCALL-CALLBACK: BOOL LPDIENUMCREATEDEFFECTOBJECTSCALLBACK (
+ IDirectInputEffect* peff,
+ LPVOID pvRef
+) ;
+
COM-INTERFACE: IDirectInputDevice8W IUnknown {54D41081-DC15-4833-A41B-748F73A38179}
HRESULT GetCapabilities ( LPDIDEVCAPS lpDIDeviceCaps )
HRESULT EnumObjects ( LPDIENUMDEVICEOBJECTSCALLBACKW lpCallback, LPVOID pvRef, DWORD dwFlags )
@@ -369,6 +366,14 @@ COM-INTERFACE: IDirectInputDevice8W IUnknown {54D41081-DC15-4833-A41B-748F73A381
HRESULT SetActionMap ( LPDIACTIONFORMATW lpdiActionFormat, LPCWSTR lpwszUserName, DWORD dwFlags )
HRESULT GetImageInfo ( LPDIDEVICEIMAGEINFOHEADERW lpdiDeviceImageInfoHeader ) ;
+STDCALL-CALLBACK: BOOL LPDIENUMDEVICESBYSEMANTICSCBW (
+ LPCDIDEVICEINSTANCEW lpddi,
+ IDirectInputDevice8W* lpdid,
+ DWORD dwFlags,
+ DWORD dwRemaining,
+ LPVOID pvRef
+) ;
+
COM-INTERFACE: IDirectInput8W IUnknown {BF798031-483A-4DA2-AA99-5D64ED369700}
HRESULT CreateDevice ( REFGUID rguid, IDirectInputDevice8W** lplpDevice, LPUNKNOWN pUnkOuter )
HRESULT EnumDevices ( DWORD dwDevType, LPDIENUMDEVICESCALLBACKW lpCallback, LPVOID pvRef, DWORD dwFlags )
From 55988828bfc9e8579e19c0b91f87879a9a30c480 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 21 Sep 2009 13:20:01 -0500
Subject: [PATCH 262/266] update alien docs to talk about C types as words
---
basis/alien/c-types/c-types-docs.factor | 46 +++++++++++++------------
basis/alien/data/data-docs.factor | 8 ++---
basis/alien/syntax/syntax-docs.factor | 38 ++++++++++++++++++--
core/alien/alien-docs.factor | 2 ++
4 files changed, 65 insertions(+), 29 deletions(-)
diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor
index a9613d2c9f..890a6f2964 100755
--- a/basis/alien/c-types/c-types-docs.factor
+++ b/basis/alien/c-types/c-types-docs.factor
@@ -1,6 +1,8 @@
-USING: alien help.syntax help.markup libc kernel.private
-byte-arrays math strings hashtables alien.syntax alien.strings sequences
-io.encodings.string debugger destructors vocabs.loader ;
+USING: alien alien.complex help.syntax help.markup libc kernel.private
+byte-arrays strings hashtables alien.syntax alien.strings sequences
+io.encodings.string debugger destructors vocabs.loader
+classes.struct ;
+QUALIFIED: math
IN: alien.c-types
HELP: byte-length
@@ -8,7 +10,7 @@ HELP: byte-length
{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
HELP: heap-size
-{ $values { "type" string } { "size" integer } }
+{ $values { "type" string } { "size" math:integer } }
{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
{ $examples
"On a 32-bit system, you will get the following output:"
@@ -17,7 +19,7 @@ HELP: heap-size
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
HELP: stack-size
-{ $values { "type" string } { "size" integer } }
+{ $values { "type" string } { "size" math:integer } }
{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
@@ -49,7 +51,7 @@ HELP: c-setter
{ $errors "Throws an error if the type does not exist." } ;
HELP: box-parameter
-{ $values { "n" integer } { "ctype" string } }
+{ $values { "n" math:integer } { "ctype" string } }
{ $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
{ $notes "This is an internal word used by the compiler when compiling callbacks." } ;
@@ -120,29 +122,29 @@ $nl
"Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link <void*> } " and " { $link *void* } " may be used." ;
ARTICLE: "c-types-specs" "C type specifiers"
-"C types are identified by strings, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words, as well as " { $link POSTPONE: C-STRUCT: } ", " { $link POSTPONE: C-UNION: } " and " { $link POSTPONE: TYPEDEF: } "."
+"C types are identified by special words, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words. New C types can be defined by the words " { $link POSTPONE: STRUCT: } ", " { $link POSTPONE: UNION-STRUCT: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: TYPEDEF: } "."
$nl
"The following numerical types are available; a " { $snippet "u" } " prefix denotes an unsigned type:"
{ $table
{ "C type" "Notes" }
- { { $snippet "char" } "always 1 byte" }
- { { $snippet "uchar" } { } }
- { { $snippet "short" } "always 2 bytes" }
- { { $snippet "ushort" } { } }
- { { $snippet "int" } "always 4 bytes" }
- { { $snippet "uint" } { } }
- { { $snippet "long" } { "same size as CPU word size and " { $snippet "void*" } ", except on 64-bit Windows, where it is 4 bytes" } }
- { { $snippet "ulong" } { } }
- { { $snippet "longlong" } "always 8 bytes" }
- { { $snippet "ulonglong" } { } }
- { { $snippet "float" } { } }
- { { $snippet "double" } { "same format as " { $link float } " objects" } }
- { { $snippet "complex-float" } { "C99 " { $snippet "complex float" } " type, converted to and from " { $link complex } " values" } }
- { { $snippet "complex-double" } { "C99 " { $snippet "complex double" } " type, converted to and from " { $link complex } " values" } }
+ { { $link char } "always 1 byte" }
+ { { $link uchar } { } }
+ { { $link short } "always 2 bytes" }
+ { { $link ushort } { } }
+ { { $link int } "always 4 bytes" }
+ { { $link uint } { } }
+ { { $link long } { "same size as CPU word size and " { $link void* } ", except on 64-bit Windows, where it is 4 bytes" } }
+ { { $link ulong } { } }
+ { { $link longlong } "always 8 bytes" }
+ { { $link ulonglong } { } }
+ { { $link float } { "single-precision float (not the same as Factor's " { $link math:float } " class!)" } }
+ { { $link double } { "double-precision float (the same format as Factor's " { $link math:float } " objects)" } }
+ { { $link complex-float } { "C99 or Fortran " { $snippet "complex float" } " type, converted to and from Factor " { $link math:complex } " values" } }
+ { { $link complex-double } { "C99 or Fortran " { $snippet "complex double" } " type, converted to and from Factor " { $link math:complex } " values" } }
}
"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
$nl
-"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $snippet "void*" } ", which denotes a generic pointer; " { $snippet "void" } " by itself is not a valid C type specifier. With the exception of strings (see " { $link "c-strings" } "), all pointer types are identical to " { $snippet "void*" } " as far as the C library interface is concerned."
+"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $link void* } ", which denotes a generic pointer; " { $link void } " by itself is not a valid C type specifier. With the exception of strings (see " { $link "c-strings" } "), all pointer types are identical to " { $snippet "void*" } " as far as the C library interface is concerned."
$nl
"Fixed-size array types are supported; the syntax consists of a C type name followed by dimension sizes in brackets; the following denotes a 3 by 4 array of integers:"
{ $code "int[3][4]" }
diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor
index 19bfaaa8ce..685639beed 100644
--- a/basis/alien/data/data-docs.factor
+++ b/basis/alien/data/data-docs.factor
@@ -129,20 +129,20 @@ HELP: <c-direct-array>
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
ARTICLE: "c-strings" "C strings"
-"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
+"C string types are arrays with shape " { $snippet "{ char* encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link char* } " is an alias for " { $snippet "{ char* utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
$nl
"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
$nl
"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
$nl
-"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
+"Care must be taken if the C function expects a " { $link char* } " with a length in bytes, rather than a null-terminated " { $link char* } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
$nl
-"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
+"Sometimes a C function has a parameter type of " { $link void* } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
{ $subsection string>alien }
{ $subsection malloc-string }
"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
$nl
"A word to read strings from arbitrary addresses:"
{ $subsection alien>string }
-"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+"For example, if a C function returns a " { $link char* } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $link void* } ", and call one of the above words before passing the pointer to " { $link free } "." ;
diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor
index ed9ae240b1..93a74c3b0a 100644
--- a/basis/alien/syntax/syntax-docs.factor
+++ b/basis/alien/syntax/syntax-docs.factor
@@ -82,8 +82,40 @@ HELP: C-ENUM:
} ;
HELP: CALLBACK:
-{ $syntax "CALLBACK: return name ( parameters ) ;" }
-{ $values { "return" "a C return type" } { "name" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
+{ $syntax "CALLBACK: return type ( parameters ) ;" }
+{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
+{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters with the " { $snippet "\"cdecl\"" } " ABI." }
+{ $examples
+ { $code
+ "CALLBACK: bool FakeCallback ( int message, void* payload ) ;"
+ ": MyFakeCallback ( -- alien )"
+ " [| message payload |"
+ " \"message #\" write"
+ " message number>string write"
+ " \" received\" write nl"
+ " t"
+ " ] FakeCallback ;"
+ }
+} ;
+
+HELP: STDCALL-CALLBACK:
+{ $syntax "STDCALL-CALLBACK: return type ( parameters ) ;" }
+{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
+{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters with the " { $snippet "\"stdcall\"" } " ABI." }
+{ $examples
+ { $code
+ "STDCALL-CALLBACK: bool FakeCallback ( int message, void* payload ) ;"
+ ": MyFakeCallback ( -- alien )"
+ " [| message payload |"
+ " \"message #\" write"
+ " message number>string write"
+ " \" received\" write nl"
+ " t"
+ " ] FakeCallback ;"
+ }
+} ;
+
+{ POSTPONE: CALLBACK: POSTPONE: STDCALL-CALLBACK: } related-words
HELP: &:
{ $syntax "&: symbol" }
@@ -92,7 +124,7 @@ HELP: &:
HELP: typedef
{ $values { "old" "a string" } { "new" "a string" } }
-{ $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
+{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
{ $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link POSTPONE: TYPEDEF: } " word instead." } ;
{ POSTPONE: TYPEDEF: typedef } related-words
diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor
index 66e67ab322..b310345464 100644
--- a/core/alien/alien-docs.factor
+++ b/core/alien/alien-docs.factor
@@ -175,6 +175,8 @@ $nl
ARTICLE: "alien-callback" "Calling Factor from C"
"Callbacks can be defined and passed to C code as function pointers; the C code can then invoke the callback and run Factor code:"
{ $subsection alien-callback }
+{ $subsection POSTPONE: CALLBACK: }
+{ $subsection POSTPONE: STDCALL-CALLBACK: }
"There are some caveats concerning the conversion of Factor objects to C values, and vice versa. See " { $link "c-data" } "."
{ $subsection "alien-callback-gc" }
{ $see-also "byte-arrays-gc" } ;
From 0ff319c409b4a0228e710c9bbf456ca0aab54e94 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 21 Sep 2009 13:39:55 -0500
Subject: [PATCH 263/266] docs for C type words
---
basis/alien/c-types/c-types-docs.factor | 36 +++++++++++++++++++++++++
1 file changed, 36 insertions(+)
diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor
index 890a6f2964..390477dcac 100755
--- a/basis/alien/c-types/c-types-docs.factor
+++ b/basis/alien/c-types/c-types-docs.factor
@@ -75,6 +75,42 @@ HELP: define-out
{ $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
+HELP: char
+{ $description "This C type represents a one-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to eight bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: uchar
+{ $description "This C type represents a one-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to eight bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: short
+{ $description "This C type represents a two-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to sixteen bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: ushort
+{ $description "This C type represents a two-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to sixteen bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: int
+{ $description "This C type represents a four-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to 32 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: uint
+{ $description "This C type represents a four-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 32 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: long
+{ $description "This C type represents a four- or eight-byte signed integer type. On Windows and on 32-bit Unix platforms, it will be four bytes. On 64-bit Unix platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: ulong
+{ $description "This C type represents a four- or eight-byte unsigned integer type. On Windows and on 32-bit Unix platforms, it will be four bytes. On 64-bit Unix platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: longlong
+{ $description "This C type represents an eight-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: ulonglong
+{ $description "This C type represents an eight-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: void
+{ $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link POSTPONE: FUNCTION: } " or " { $link POSTPONE: CALLBACK: } " definition, or an " { $link alien-invoke } " or " { $link alien-callback } " call." } ;
+HELP: void*
+{ $description "This C type represents a pointer to C memory. " { $link byte-array } " and " { $link alien } " values can be passed as inputs, but see " { $link "byte-arrays-gc" } " for notes about passing byte arrays into C functions. Output values are returned as " { $link alien } "s." } ;
+HELP: char*
+{ $description "This C type represents a pointer to a C string. See " { $link "c-strings" } " for details about using strings with the FFI." } ;
+HELP: float
+{ $description "This C type represents a single-precision IEEE 754 floating-point type. Input values will be converted to Factor " { $link math:float } "s and demoted to single-precision; output values will be returned as Factor " { $link math:float } "s." } ;
+HELP: double
+{ $description "This C type represents a double-precision IEEE 754 floating-point type. Input values will be converted to Factor " { $link math:float } "s; output values will be returned as Factor " { $link math:float } "s." } ;
+HELP: complex-float
+{ $description "This C type represents a single-precision IEEE 754 floating-point complex type. Input values will be converted from Factor " { $link math:complex } " objects into a single-precision complex float type; output values will be returned as Factor " { $link math:complex } " objects." } ;
+HELP: complex-double
+{ $description "This C type represents a double-precision IEEE 754 floating-point complex type. Input values will be converted from Factor " { $link math:complex } " objects into a double-precision complex float type; output values will be returned as Factor " { $link math:complex } " objects." } ;
+
+
ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
$nl
From 6ce8eba9618001e4f8922f6d25cd345a2f7c25f8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 21 Sep 2009 14:14:12 -0500
Subject: [PATCH 264/266] prettyprint CALLBACK: defs
---
basis/alien/prettyprint/prettyprint.factor | 29 +++++++++++++++++++---
1 file changed, 26 insertions(+), 3 deletions(-)
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 69b9f37776..eea3515c8f 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -38,8 +38,8 @@ M: typedef-word synopsis*
: pprint-function-arg ( type name -- )
[ pprint-c-type ] [ text ] bi* ;
-: pprint-function-args ( word -- )
- [ def>> fourth ] [ stack-effect in>> ] bi zip [ ] [
+: pprint-function-args ( types names -- )
+ zip [ ] [
unclip-last
[ [ first2 "," append pprint-function-arg ] each ] dip
first2 pprint-function-arg
@@ -55,6 +55,29 @@ M: alien-function-word synopsis*
[ definer. ]
[ def>> first pprint-c-type ]
[ pprint-word ]
- [ <block "(" text pprint-function-args ")" text block> ]
+ [
+ <block "(" text
+ [ def>> fourth ] [ stack-effect in>> ] bi
+ pprint-function-args
+ ")" text block>
+ ]
} cleave ;
+M: alien-callback-type-word definer
+ "callback-abi" word-prop "stdcall" =
+ \ STDCALL-CALLBACK: \ CALLBACK: ?
+ f ;
+M: alien-callback-type-word definition drop f ;
+M: alien-callback-type-word synopsis*
+ {
+ [ seeing-word ]
+ [ definer. ]
+ [ def>> first pprint-c-type ]
+ [ pprint-word ]
+ [
+ <block "(" text
+ [ def>> second ] [ "callback-effect" word-prop in>> ] bi
+ pprint-function-args
+ ")" text block>
+ ]
+ } cleave ;
From b5bd0532c2286d567bc856af758d4e7197283ce1 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 21 Sep 2009 16:05:13 -0500
Subject: [PATCH 265/266] oops--Segoe is the windows 6.x system font, not
Calibri
---
basis/windows/fonts/fonts.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
index 4e1310ff57..9e113e8c3b 100755
--- a/basis/windows/fonts/fonts.factor
+++ b/basis/windows/fonts/fonts.factor
@@ -6,7 +6,7 @@ IN: windows.fonts
MEMO: windows-fonts ( -- fonts )
windows-major 6 >=
H{
- { "sans-serif" "Calibri" }
+ { "sans-serif" "Segoe UI" }
{ "serif" "Cambria" }
{ "monospace" "Consolas" }
}
From 962d03985227dc3e7ebbfda5d905f638453a23d7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Mon, 21 Sep 2009 17:42:20 -0500
Subject: [PATCH 266/266] Rename specific-method to method-for-class, rename
(effective-method) to method-for-object, and make both much faster
---
basis/compiler/tests/optimizer.factor | 11 ------
.../tree/propagation/inlining/inlining.factor | 2 +-
.../propagation/transforms/transforms.factor | 2 +-
.../partial-dispatch/partial-dispatch.factor | 2 +-
core/classes/algebra/algebra-docs.factor | 8 ++---
core/classes/algebra/algebra-tests.factor | 8 ++++-
core/classes/algebra/algebra.factor | 8 ++---
core/generic/generic-tests.factor | 17 +++++++++
core/generic/generic.factor | 36 +++++++++++++++----
core/generic/hook/hook.factor | 2 +-
core/generic/math/math.factor | 6 ++--
core/generic/single/single.factor | 4 +--
core/generic/standard/standard.factor | 2 +-
13 files changed, 71 insertions(+), 37 deletions(-)
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 45ea841a73..18679ce77b 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -122,17 +122,6 @@ GENERIC: void-generic ( obj -- * )
[ t ] [ \ <tuple>-regression optimized? ] unit-test
-GENERIC: foozul ( a -- b )
-M: reversed foozul ;
-M: integer foozul ;
-M: slice foozul ;
-
-[ t ] [
- reversed \ foozul specific-method
- reversed \ foozul method
- eq?
-] unit-test
-
! regression
: constant-fold-2 ( -- value ) f ; foldable
: constant-fold-3 ( -- value ) 4 ; foldable
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 0b50632e4e..367427c716 100755
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -52,7 +52,7 @@ M: callable splicing-nodes splicing-body ;
2dup [ in-d>> length ] [ dispatch# ] bi* <= [ 2drop f f ] [
[ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
[ swap nth value-info class>> dup ] dip
- specific-method
+ method-for-class
] if
] if ;
diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index e08a21d4b9..8aa6a821d8 100644
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -14,7 +14,7 @@ IN: compiler.tree.propagation.transforms
! If first input has a known type and second input is an
! object, we convert this to [ swap equal? ].
in-d>> first2 value-info class>> object class= [
- value-info class>> \ equal? specific-method
+ value-info class>> \ equal? method-for-class
[ swap equal? ] f ?
] [ drop f ] if
] "custom-inlining" set-word-prop
diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index 7c66c911de..e72d77ee1f 100644
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -147,7 +147,7 @@ SYMBOL: fast-math-ops
: math-both-known? ( word left right -- ? )
3dup math-op
[ 2drop 2drop t ]
- [ drop math-class-max swap specific-method >boolean ] if ;
+ [ drop math-class-max swap method-for-class >boolean ] if ;
: (derived-ops) ( word assoc -- words )
swap '[ swap first _ eq? nip ] assoc-filter ;
diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor
index cbf6acdeed..2e14af27f3 100644
--- a/core/classes/algebra/algebra-docs.factor
+++ b/core/classes/algebra/algebra-docs.factor
@@ -10,7 +10,6 @@ ARTICLE: "class-operations" "Class operations"
{ $subsection class-and }
{ $subsection class-or }
{ $subsection classes-intersect? }
-{ $subsection min-class }
"Low-level implementation detail:"
{ $subsection flatten-class }
{ $subsection flatten-builtin-class }
@@ -37,6 +36,7 @@ $nl
"Operations:"
{ $subsection class< }
{ $subsection sort-classes }
+{ $subsection smallest-class }
"Metaclass order:"
{ $subsection rank-class } ;
@@ -73,6 +73,6 @@ HELP: classes-intersect?
{ $values { "first" class } { "second" class } { "?" "a boolean" } }
{ $description "Tests if two classes have a non-empty intersection. If the intersection is empty, no object can be an instance of both classes at once." } ;
-HELP: min-class
-{ $values { "class" class } { "seq" "a sequence of class words" } { "class/f" "a class word or " { $link f } } }
-{ $description "If all classes in " { $snippet "seq" } " that intersect " { $snippet "class" } " are subtypes of " { $snippet "class" } ", outputs the last such element of " { $snippet "seq" } ". If any conditions fail to hold, outputs " { $link f } "." } ;
+HELP: smallest-class
+{ $values { "classes" "a sequence of class words" } { "class/f" { $maybe class } } }
+{ $description "Outputs a minimum class from the given sequence." } ;
diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor
index d111d1daa2..855a15b66f 100644
--- a/core/classes/algebra/algebra-tests.factor
+++ b/core/classes/algebra/algebra-tests.factor
@@ -4,7 +4,7 @@ tools.test words quotations classes classes.algebra
classes.private classes.union classes.mixin classes.predicate
vectors source-files compiler.units growable random
stack-checker effects kernel.private sbufs math.order
-classes.tuple accessors ;
+classes.tuple accessors generic.private ;
IN: classes.algebra.tests
: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;
@@ -150,6 +150,12 @@ UNION: z1 b1 c1 ;
] unit-test
! Test method inlining
+[ real ] [ { real sequence } smallest-class ] unit-test
+[ real ] [ { sequence real } smallest-class ] unit-test
+
+: min-class ( class classes -- class/f )
+ interesting-classes smallest-class ;
+
[ f ] [ fixnum { } min-class ] unit-test
[ string ] [
diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index df4f8f2563..2d67403f94 100755
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -214,10 +214,10 @@ ERROR: topological-sort-failed ;
[ dup largest-class [ over delete-nth ] dip ]
produce nip ;
-: min-class ( class seq -- class/f )
- over [ classes-intersect? ] curry filter
- [ drop f ] [
- [ nip ] [ [ class<= ] with all? ] 2bi [ last ] [ drop f ] if
+: smallest-class ( classes -- class/f )
+ [ f ] [
+ natural-sort <reversed>
+ [ ] [ [ class<= ] most ] map-reduce
] if-empty ;
GENERIC: (flatten-class) ( class -- )
diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor
index a63cab1c5c..e2acbb8fe6 100755
--- a/core/generic/generic-tests.factor
+++ b/core/generic/generic-tests.factor
@@ -186,3 +186,20 @@ GENERIC: move-method-generic ( a -- b )
[ ] [ "IN: generic.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
[ { string } ] [ \ move-method-generic order ] unit-test
+
+GENERIC: foozul ( a -- b )
+M: reversed foozul ;
+M: integer foozul ;
+M: slice foozul ;
+
+[ t ] [
+ reversed \ foozul method-for-class
+ reversed \ foozul method
+ eq?
+] unit-test
+
+[ t ] [
+ fixnum \ <=> method-for-class
+ real \ <=> method
+ eq?
+] unit-test
\ No newline at end of file
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 4b398f6532..fcb7a53731 100644
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -24,20 +24,42 @@ M: generic definition drop f ;
: method ( class generic -- method/f )
"methods" word-prop at ;
-: order ( generic -- seq )
- "methods" word-prop keys sort-classes ;
+<PRIVATE
-: specific-method ( class generic -- method/f )
- [ nip ] [ order min-class ] 2bi
- dup [ swap method ] [ 2drop f ] if ;
+: interesting-class? ( class1 class2 -- ? )
+ {
+ ! Case 1: no intersection. Discard and keep going
+ { [ 2dup classes-intersect? not ] [ 2drop t ] }
+ ! Case 2: class1 contained in class2. Add to
+ ! interesting set and keep going.
+ { [ 2dup class<= ] [ nip , t ] }
+ ! Case 3: class1 and class2 are incomparable. Give up
+ [ 2drop f ]
+ } cond ;
+
+: interesting-classes ( class classes -- interesting/f )
+ [ [ interesting-class? ] with all? ] { } make and ;
+
+PRIVATE>
+
+: method-classes ( generic -- classes )
+ "methods" word-prop keys ;
+
+: order ( generic -- seq )
+ method-classes sort-classes ;
+
+: nearest-class ( class generic -- class/f )
+ method-classes interesting-classes smallest-class ;
+
+: method-for-class ( class generic -- method/f )
+ [ nip ] [ nearest-class ] 2bi dup [ swap method ] [ 2drop f ] if ;
GENERIC: effective-method ( generic -- method )
\ effective-method t "no-compile" set-word-prop
: next-method-class ( class generic -- class/f )
- order [ class<= ] with filter reverse dup length 1 =
- [ drop f ] [ second ] if ;
+ method-classes [ class< ] with filter smallest-class ;
: next-method ( class generic -- method/f )
[ next-method-class ] keep method ;
diff --git a/core/generic/hook/hook.factor b/core/generic/hook/hook.factor
index 5edbc54bd8..5359f473ac 100644
--- a/core/generic/hook/hook.factor
+++ b/core/generic/hook/hook.factor
@@ -23,4 +23,4 @@ M: hook-combination mega-cache-quot
M: hook-generic definer drop \ HOOK: f ;
M: hook-generic effective-method
- [ "combination" word-prop var>> get ] keep (effective-method) ;
\ No newline at end of file
+ [ "combination" word-prop var>> get ] keep method-for-object ;
\ No newline at end of file
diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor
index e0e8b91a2c..297684014b 100644
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@@ -50,7 +50,7 @@ ERROR: no-math-method left right generic ;
<PRIVATE
-: applicable-method ( generic class -- quot )
+: (math-method) ( generic class -- quot )
over method
[ 1quotation ]
[ default-math-method ] ?if ;
@@ -58,13 +58,13 @@ ERROR: no-math-method left right generic ;
PRIVATE>
: object-method ( generic -- quot )
- object bootstrap-word applicable-method ;
+ object bootstrap-word (math-method) ;
: math-method ( word class1 class2 -- quot )
2dup and [
[ 2array [ declare ] curry nip ]
[ math-upgrade nip ]
- [ math-class-max over order min-class applicable-method ]
+ [ math-class-max over nearest-class (math-method) ]
3tri 3append
] [
2drop object-method
diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor
index 8a53368062..9e773fe700 100644
--- a/core/generic/single/single.factor
+++ b/core/generic/single/single.factor
@@ -42,8 +42,8 @@ M: single-combination next-method-quot* ( class generic combination -- quot )
] [ 3drop f ] if
] with-combination ;
-: (effective-method) ( obj word -- method )
- [ [ order [ instance? ] with find-last nip ] keep method ]
+: method-for-object ( obj word -- method )
+ [ [ method-classes [ instance? ] with filter smallest-class ] keep method ]
[ "default-method" word-prop ]
bi or ;
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index 0d1220beac..35d299145d 100644
--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@ -40,7 +40,7 @@ M: standard-combination dispatch# #>> ;
M: standard-generic effective-method
[ datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
- (effective-method) ;
+ method-for-object ;
: inline-cache-quot ( word methods miss-word -- quot )
[ [ literalize , ] [ , ] [ combination get #>> , { } , , ] tri* ] [ ] make ;