steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2010-02-07 00:13:44 -08:00
parent 08b26f6739 55b27baf3a
commit 72f7f472b9
32 changed files with 454 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/cpu/ppc/bootstrap.factor
View File

@ -97,11 +97,11 @@ CONSTANT: ctx-reg 16
rs-reg ctx-reg context-retainstack-offset LWZ ; rs-reg ctx-reg context-retainstack-offset LWZ ;
[ [
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel 0 12 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
11 3 profile-count-offset LWZ 11 12 profile-count-offset LWZ
11 11 1 tag-fixnum ADDI 11 11 1 tag-fixnum ADDI
11 3 profile-count-offset STW 11 12 profile-count-offset STW
11 3 word-code-offset LWZ 11 12 word-code-offset LWZ
11 11 compiled-header-size ADDI 11 11 compiled-header-size ADDI
11 MTCTR 11 MTCTR
BCTR BCTR

2
basis/cpu/x86/64/bootstrap.factor
View File

@ -28,7 +28,7 @@ IN: bootstrap.x86
[ [
! load entry point ! load entry point
safe-reg -7 [] LEA safe-reg 0 MOV rc-absolute-cell rt-this jit-rel
! save stack frame size ! save stack frame size
stack-frame-size PUSH stack-frame-size PUSH
! push entry point ! push entry point

14
basis/images/tga/tga.factor
View File

@ -238,7 +238,7 @@ ERROR: bad-tga-unsupported ;
] unless ] unless
] ignore-errors ] ignore-errors
#! Only 24-bit uncompressed RGB and 32-bit uncompressed ARGB are supported. #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported.
#! Other formats would need to be converted to work within the image class. #! Other formats would need to be converted to work within the image class.
map-type 0 = [ bad-tga-unsupported ] unless map-type 0 = [ bad-tga-unsupported ] unless
image-type 2 = [ bad-tga-unsupported ] unless image-type 2 = [ bad-tga-unsupported ] unless
@ -247,7 +247,7 @@ ERROR: bad-tga-unsupported ;
#! Create image instance #! Create image instance
image new image new
alpha-bits 0 = [ RGB ] [ ARGB ] if >>component-order alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order
{ image-width image-height } >>dim { image-width image-height } >>dim
pixel-order 0 = >>upside-down? pixel-order 0 = >>upside-down?
image-data >>bitmap image-data >>bitmap
@ -259,7 +259,7 @@ M: tga-image stream>image
M: tga-image image>stream M: tga-image image>stream
drop drop
[ [
component-order>> { RGB ARGB } member? [ bad-tga-unsupported ] unless component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless
] keep ] keep
B{ 0 } write #! id-length B{ 0 } write #! id-length
@ -272,15 +272,15 @@ M: tga-image image>stream
[ dim>> second 2 >le write ] [ dim>> second 2 >le write ]
[ component-order>> [ component-order>>
{ {
{ RGB [ B{ 24 } write ] } { BGR [ B{ 24 } write ] }
{ ARGB [ B{ 32 } write ] } { BGRA [ B{ 32 } write ] }
} case } case
] ]
[ [
dup component-order>> dup component-order>>
{ {
{ RGB [ 0 ] } { BGR [ 0 ] }
{ ARGB [ 8 ] } { BGRA [ 8 ] }
} case swap } case swap
upside-down?>> [ 0 ] [ 2 ] if 3 shift bitor upside-down?>> [ 0 ] [ 2 ] if 3 shift bitor
1 >le write 1 >le write

4
basis/io/launcher/unix/unix-tests.factor
View File

@ -3,7 +3,7 @@ USING: io.files io.files.temp io.directories io.pathnames
tools.test io.launcher arrays io namespaces continuations math tools.test io.launcher arrays io namespaces continuations math
io.encodings.binary io.encodings.ascii accessors kernel io.encodings.binary io.encodings.ascii accessors kernel
sequences io.encodings.utf8 destructors io.streams.duplex locals sequences io.encodings.utf8 destructors io.streams.duplex locals
concurrency.promises threads unix.process calendar ; concurrency.promises threads unix.process calendar unix ;
[ ] [ [ ] [
[ "launcher-test-1" temp-file delete-file ] ignore-errors [ "launcher-test-1" temp-file delete-file ] ignore-errors
@ -134,7 +134,7 @@ concurrency.promises threads unix.process calendar ;
[ p fulfill ] [ wait-for-process s fulfill ] bi [ p fulfill ] [ wait-for-process s fulfill ] bi
] in-thread ] in-thread
p 1 seconds ?promise-timeout handle>> 9 kill drop p 1 seconds ?promise-timeout handle>> kill-process*
s ?promise 0 = s ?promise 0 =
] ]
] unit-test ] unit-test

2
basis/io/launcher/unix/unix.factor
View File

@ -91,7 +91,7 @@ M: unix kill-process* ( pid -- )
TUPLE: signal n ; TUPLE: signal n ;
: code>status ( code -- obj ) : code>status ( code -- obj )
dup WIFEXITED [ WEXITSTATUS ] [ WTERMSIG signal boa ] if ; dup WIFSIGNALED [ WTERMSIG signal boa ] [ WEXITSTATUS ] if ;
M: unix wait-for-processes ( -- ? ) M: unix wait-for-processes ( -- ? )
0 <int> -1 over WNOHANG waitpid 0 <int> -1 over WNOHANG waitpid

1
basis/ui/backend/windows/windows.factor
View File

@ -502,6 +502,7 @@ SYMBOL: nc-buttons
{ {
{ APPCOMMAND_BROWSER_BACKWARD [ pick window left-action send-action ] } { APPCOMMAND_BROWSER_BACKWARD [ pick window left-action send-action ] }
{ APPCOMMAND_BROWSER_FORWARD [ pick window right-action send-action ] } { APPCOMMAND_BROWSER_FORWARD [ pick window right-action send-action ] }
[ drop ]
} case 3drop ; } case 3drop ;
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- ) : handle-wm-buttondown ( hWnd uMsg wParam lParam -- )

2
basis/ui/text/text-docs.factor
View File

@ -49,7 +49,7 @@ HELP: line-metrics
{ $contract "Outputs a " { $link metrics } " object with text measurements." } ; { $contract "Outputs a " { $link metrics } " object with text measurements." } ;
ARTICLE: "text-rendering" "Rendering text" ARTICLE: "text-rendering" "Rendering text"
"The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X and FreeType on Windows and X11." "The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X, Uniscribe on Windows and Pango on X11."
{ $subsections "fonts" } { $subsections "fonts" }
"Measuring text:" "Measuring text:"
{ $subsections { $subsections

3
extra/game/models/collada/collada-docs.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.crossref help.stylesheet help.topics help.syntax USING: help.markup help.crossref help.stylesheet help.topics help.syntax
definitions io prettyprint summary arrays math sequences vocabs strings definitions io prettyprint summary arrays math sequences vocabs strings
see xml.data hashtables assocs game.models.collada.private game.models.util ; see xml.data hashtables assocs game.models.collada.private game.models
game.models.util ;
IN: game.models.collada IN: game.models.collada
ABOUT: "game.models.collada" ABOUT: "game.models.collada"

4
extra/game/models/collada/collada.factor
View File

@ -5,7 +5,7 @@ locals math math.parser sequences sequences.deep
specialized-arrays.instances.alien.c-types.float specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint splitting xml specialized-arrays.instances.alien.c-types.uint splitting xml
xml.data xml.traversal math.order xml.data xml.traversal math.order
namespaces combinators images gpu.shaders io make namespaces combinators images gpu.shaders io make game.models
game.models.util io.encodings.ascii game.models.loader ; game.models.util io.encodings.ascii game.models.loader ;
IN: game.models.collada IN: game.models.collada
@ -152,7 +152,7 @@ VERTEX-FORMAT: collada-vertex-format
soa>aos soa>aos
[ flatten >float-array ] [ flatten >float-array ]
[ flatten >uint-array ] [ flatten >uint-array ]
bi* collada-vertex-format model boa bi* collada-vertex-format f model boa
] bi ; ] bi ;
: mesh>triangles ( sources vertices mesh-tag -- models ) : mesh>triangles ( sources vertices mesh-tag -- models )

2
extra/game/models/models-docs.factor
View File

@ -6,4 +6,4 @@ see ;
IN: game.models IN: game.models
HELP: model HELP: model
{ $class-description "Tuple of a packed attribute buffer, index buffer and vertex format suitable for a single OpenGL draw call." } ; { $class-description "Tuple of a packed attribute buffer, index buffer, vertex format and material suitable for a single OpenGL draw call." } ;

2
extra/game/models/models.factor
View File

@ -3,5 +3,5 @@
USING: ; USING: ;
IN: game.models IN: game.models
TUPLE: model attribute-buffer index-buffer vertex-format ; TUPLE: model attribute-buffer index-buffer vertex-format material ;

70
extra/game/models/obj/obj-docs.factor
View File

@ -0,0 +1,70 @@
! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.crossref help.stylesheet help.topics help.syntax
definitions io prettyprint summary arrays math sequences vocabs strings
see xml.data hashtables assocs game.models.obj.private game.models
game.models.util io.pathnames ;
IN: game.models.obj
ABOUT: "game.models.obj"
ARTICLE: "game.models.obj" "Conversion of Wavefront OBJ assets"
"The " { $vocab-link "game.models.obj" } " vocabulary implements words for converting Wavefront OBJ assets to data suitable for use with OpenGL." ;
HELP: material
{ $class-description "Tuple describing the GPU state that needs to be applied prior to rendering geometry tagged with this material." } ;
HELP: cm
{ $values { "current-material" material } }
{ $description "Convenience word for accessing the current material while parsing primitives." } ;
HELP: md
{ $values { "material-dictionary" assoc } }
{ $description "Convenience word for accessing the material dictionary while parsing primitives. " } ;
HELP: strings>floats
{ $values { "strings" sequence } { "floats" sequence } }
{ $description "Convert a sequence of strings to a sequence of floats." } ;
HELP: strings>faces
{ $values { "strings" sequence } { "faces" sequence } }
{ $description "Convert a sequence of '/'-delimited strings into a sequence of sequences of numbers. Each number is an index into the vertex, texture or normal tables, respectively." } ;
HELP: split-string
{ $values { "string" string } { "strings" sequence } }
{ $description "Split the given string on whitespace." } ;
HELP: line>mtl
{ $values { "line" string } }
{ $description "Process a line from a material file within the current parsing context." } ;
HELP: read-mtl
{ $values { "file" pathname } { "material-dictionary" assoc } }
{ $description "Read the specified material file and generate a material dictionary keyed by material name." } ;
HELP: obj-vertex-format
{ $class-description "Vertex format used for rendering OBJ geometry." } ;
HELP: triangle>aos
{ $values { "x" sequence } { "y" sequence } }
{ $description "Convert a sequence of vertex, texture and normal indices into a sequence of vertex, texture and normal values." } ;
HELP: quad>aos
{ $values { "x" sequence } { "y" sequence } { "z" sequence } }
{ $description "Convert a sequence of vertex, texture and normal indices into two sequences of vertex, texture and normal values. This splits a quad into two triangles." } ;
HELP: face>aos
{ $values { "x" sequence } { "y" sequence } }
{ $description "Convert a face line to a sequence of vertex attributes." } ;
HELP: push*
{ $values { "elt" "an object" } { "seq" sequence } { "seq" sequence } }
{ $description "Push the value onto the sequence, keeping the sequence on the stack." } ;
HELP: push-current-model
{ $description "Push the current model being built onto the models list and initialize a fresh empty model." } ;
HELP: line>obj
{ $values { "line" string } }
{ $description "Process a line from the object file within the current parsing context." } ;

188
extra/game/models/obj/obj.factor
View File

@ -1,98 +1,166 @@
! Copyright (C) 2010 Your name. ! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings.ascii math.parser sequences splitting kernel USING: io io.encodings.ascii math.parser sequences splitting kernel
assocs io.files combinators math.order math namespaces assocs io.files combinators math.order math namespaces
arrays sequences.deep accessors arrays sequences.deep accessors
specialized-arrays.instances.alien.c-types.float specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint specialized-arrays.instances.alien.c-types.uint
game.models.util gpu.shaders images game.models.loader ; game.models game.models.util gpu.shaders images
game.models.loader prettyprint ;
IN: game.models.obj IN: game.models.obj
SINGLETON: obj-models SINGLETON: obj-models
"obj" ascii obj-models register-models-class "obj" ascii obj-models register-models-class
<PRIVATE <PRIVATE
SYMBOLS: v vt vn i ; SYMBOLS: vp vt vn current-model current-material material-dictionary models ;
TUPLE: material
{ name initial: f }
{ ambient-reflectivity initial: { 1.0 1.0 1.0 } }
{ diffuse-reflectivity initial: { 1.0 1.0 1.0 } }
{ specular-reflectivity initial: { 1.0 1.0 1.0 } }
{ transmission-filter initial: { 1.0 1.0 1.0 } }
{ dissolve initial: 1.0 }
{ specular-exponent initial: 10.0 }
{ refraction-index initial: 1.5 }
{ ambient-map initial: f }
{ diffuse-map initial: f }
{ specular-map initial: f }
{ specular-exponent-map initial: f }
{ dissolve-map initial: f }
{ displacement-map initial: f }
{ bump-map initial: f }
{ reflection-map initial: f } ;
: cm ( -- current-material ) current-material get ; inline
: md ( -- material-dictionary ) material-dictionary get ; inline
: strings>floats ( strings -- floats )
[ string>float ] map ;
: strings>faces ( strings -- faces )
[ "/" split [ string>number ] map ] map ;
: split-string ( string -- strings )
" \t\n" split harvest ;
: line>mtl ( line -- )
" \t\n" split harvest
[
[ rest ] [ first ] bi
{
{ "newmtl" [ first
[ material new swap >>name current-material set ]
[ cm swap md set-at ] bi
] }
{ "Ka" [ 3 head [ string>float ] map cm (>>ambient-reflectivity) ] }
{ "Kd" [ 3 head [ string>float ] map cm (>>diffuse-reflectivity) ] }
{ "Ks" [ 3 head [ string>float ] map cm (>>specular-reflectivity) ] }
{ "Tf" [ 3 head [ string>float ] map cm (>>transmission-filter) ] }
{ "d" [ first string>float cm (>>dissolve) ] }
{ "Ns" [ first string>float cm (>>specular-exponent) ] }
{ "Ni" [ first string>float cm (>>refraction-index) ] }
{ "map_Ka" [ first cm (>>ambient-map) ] }
{ "map_Kd" [ first cm (>>diffuse-map) ] }
{ "map_Ks" [ first cm (>>specular-map) ] }
{ "map_Ns" [ first cm (>>specular-exponent-map) ] }
{ "map_d" [ first cm (>>dissolve-map) ] }
{ "map_bump" [ first cm (>>bump-map) ] }
{ "bump" [ first cm (>>bump-map) ] }
{ "disp" [ first cm (>>displacement-map) ] }
{ "refl" [ first cm (>>reflection-map) ] }
[ 2drop ]
} case
] unless-empty ;
: read-mtl ( file -- material-dictionary )
[
f current-material set
H{ } clone material-dictionary set
] H{ } make-assoc
[
ascii file-lines [ line>mtl ] each
md
] bind ;
VERTEX-FORMAT: obj-vertex-format VERTEX-FORMAT: obj-vertex-format
{ "POSITION" float-components 3 f } { "POSITION" float-components 3 f }
{ "TEXCOORD" float-components 2 f } { "TEXCOORD" float-components 2 f }
{ "NORMAL" float-components 3 f } ; { "NORMAL" float-components 3 f } ;
: string>floats ( x -- y ) : triangle>aos ( x -- y )
[ string>float ] map ;
: string>faces ( x -- y )
[ "/" split [ string>number ] map ] map ;
: 3face>aos ( x -- y )
dup length {
{ 3
[
first3
[ 1 - v get nth ]
[ 1 - vt get nth ]
[ 1 - vn get nth ] tri* 3array flatten
] }
{ 2
[
first2
[ 1 - v get nth ]
[ 1 - vt get nth ] bi* 2array flatten
] }
} case ;
: 4face>aos ( x -- y z )
[ 3 head [ 3face>aos 1array ] map ]
[ [ 0 swap nth ] [ 2 swap nth ] [ 3 swap nth ] tri 3array [ 3face>aos 1array ] map ]
bi
;
: faces>aos ( x -- y )
dup length dup length
{ {
{ 3 [ [ 3face>aos 1array ] map 1array ] } { 3 [
{ 4 [ 4face>aos 2array ] } first3
[ 1 - vp get nth ]
[ 1 - vt get nth ]
[ 1 - vn get nth ] tri* 3array flatten
] }
{ 2 [
first2
[ 1 - vp get nth ]
[ 1 - vt get nth ] bi* 2array flatten
] }
} case ;
: quad>aos ( x -- y z )
[ 3 head [ triangle>aos 1array ] map ]
[ [ 2 swap nth ]
[ 3 swap nth ]
[ 0 swap nth ] tri 3array
[ triangle>aos 1array ] map ]
bi ;
: face>aos ( x -- y )
dup length
{
{ 3 [ [ triangle>aos 1array ] map 1array ] }
{ 4 [ quad>aos 2array ] }
} case ; } case ;
: push* ( x z -- y ) : push* ( elt seq -- seq )
[ push ] keep ; [ push ] keep ;
: push-current-model ( -- )
current-model get [
[ dseq>> flatten >float-array ]
[ iseq>> flatten >uint-array ]
bi obj-vertex-format current-material get model boa models get push
V{ } V{ } H{ } <indexed-seq> current-model set
] unless-empty ;
: line>obj ( line -- ) : line>obj ( line -- )
" \t\n" split harvest dup split-string
length 1 >
[ [
[ rest ] [ first ] bi [ rest ] [ first ] bi
{ {
{ "#" [ drop ] } { "mtllib" [ first read-mtl material-dictionary set ] }
{ "v" [ string>floats 3 head v [ push* ] change ] } { "v" [ strings>floats 3 head vp [ push* ] change ] }
{ "vt" [ string>floats 2 head vt [ push* ] change ] } { "vt" [ strings>floats 2 head vt [ push* ] change ] }
{ "vn" [ string>floats 3 head vn [ push* ] change ] } { "vn" [ strings>floats 3 head vn [ push* ] change ] }
{ "f" [ string>faces faces>aos [ [ i [ push* ] change ] each ] each ] } { "usemtl" [ push-current-model first md at current-material set ] }
{ "o" [ drop ] } { "f" [ strings>faces face>aos [ [ current-model [ push* ] change ] each ] each ] }
{ "g" [ drop ] } [ 2drop ]
{ "s" [ drop ] }
{ "mtllib" [ drop ] }
{ "usemtl" [ drop ] }
} case } case
] ] unless-empty ;
[ drop ] if ;
PRIVATE> PRIVATE>
M: obj-models stream>models M: obj-models stream>models
drop drop
[ [
V{ } V{ } clone vp set
[ clone v set ] V{ } clone vt set
[ clone vt set ] V{ } clone vn set
[ clone vn set ] tri V{ } clone models set
V{ } V{ } H{ } <indexed-seq> i set V{ } V{ } H{ } <indexed-seq> current-model set
f current-material set
f material-dictionary set
] H{ } make-assoc ] H{ } make-assoc
[ [
[ line>obj ] each-stream-line i get [ line>obj ] each-stream-line push-current-model
] bind models get
[ dseq>> flatten >float-array ] ] bind ;
[ iseq>> flatten >uint-array ] bi obj-vertex-format model boa 1array ;

2
extra/game/models/util/util.factor
View File

@ -3,8 +3,6 @@
USING: sequences accessors kernel locals assocs ; USING: sequences accessors kernel locals assocs ;
IN: game.models.util IN: game.models.util
TUPLE: model attribute-buffer index-buffer vertex-format ;
TUPLE: indexed-seq dseq iseq rassoc ; TUPLE: indexed-seq dseq iseq rassoc ;
INSTANCE: indexed-seq sequence INSTANCE: indexed-seq sequence

298
extra/model-viewer/model-viewer.factor
View File

@ -8,93 +8,109 @@ io io.encodings.ascii io.files io.files.temp kernel locals math
math.matrices math.vectors.simd math.parser math.vectors math.matrices math.vectors.simd math.parser math.vectors
method-chains namespaces sequences splitting threads ui ui.gadgets method-chains namespaces sequences splitting threads ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats specialized-arrays ui.gadgets.worlds ui.pixel-formats specialized-arrays
specialized-vectors literals fry xml specialized-vectors literals fry
xml.traversal sequences.deep destructors math.bitwise opengl.gl sequences.deep destructors math.bitwise opengl.gl
game.models.obj game.models.loader game.models.collada ; game.models game.models.obj game.models.loader game.models.collada
prettyprint images.tga ;
FROM: alien.c-types => float ; FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-VECTOR: uint SPECIALIZED-VECTOR: uint
IN: model-viewer IN: model-viewer
GLSL-SHADER: model-vertex-shader vertex-shader GLSL-SHADER: obj-vertex-shader vertex-shader
uniform mat4 mv_matrix, p_matrix; uniform mat4 mv_matrix;
uniform vec3 light_position; uniform mat4 p_matrix;
attribute vec3 POSITION; attribute vec3 POSITION;
attribute vec3 TEXCOORD;
attribute vec3 NORMAL; attribute vec3 NORMAL;
attribute vec2 TEXCOORD;
varying vec2 texit; varying vec2 texcoord_fs;
varying vec3 norm; varying vec3 normal_fs;
varying vec3 world_pos_fs;
void main() void main()
{ {
vec4 position = mv_matrix * vec4(POSITION, 1.0); vec4 position = mv_matrix * vec4(POSITION, 1.0);
gl_Position = p_matrix * position; gl_Position = p_matrix * position;
texit = TEXCOORD; world_pos_fs = POSITION;
norm = NORMAL; texcoord_fs = TEXCOORD;
normal_fs = NORMAL;
} }
; ;
GLSL-SHADER: model-fragment-shader fragment-shader GLSL-SHADER: obj-fragment-shader fragment-shader
varying vec2 texit;
varying vec3 norm;
void main()
{
gl_FragColor = vec4(texit, 0, 1) + vec4(norm, 1);
}
;
GLSL-PROGRAM: model-program
model-vertex-shader model-fragment-shader ;
GLSL-SHADER: debug-vertex-shader vertex-shader
uniform mat4 mv_matrix, p_matrix; uniform mat4 mv_matrix, p_matrix;
uniform vec3 light_position; uniform sampler2D map_Ka;
uniform sampler2D map_bump;
attribute vec3 POSITION; uniform vec3 Ka;
attribute vec3 COLOR; uniform vec3 view_pos;
varying vec4 color; uniform vec3 light;
varying vec2 texcoord_fs;
varying vec3 normal_fs;
varying vec3 world_pos_fs;
void main() void main()
{ {
gl_Position = p_matrix * mv_matrix * vec4(POSITION, 1.0); vec4 d = texture2D(map_Ka, texcoord_fs.xy);
color = vec4(COLOR, 1); vec3 b = texture2D(map_bump, texcoord_fs.xy).xyz;
vec3 n = normal_fs;
vec3 v = normalize(view_pos - world_pos_fs);
vec3 l = normalize(light);
vec3 h = normalize(v + l);
float cosTh = saturate(dot(n, l));
gl_FragColor = d * cosTh
+ d * 0.5 * cosTh * pow(saturate(dot(n, h)), 10.0) ;
} }
; ;
GLSL-SHADER: debug-fragment-shader fragment-shader GLSL-PROGRAM: obj-program
varying vec4 color; obj-vertex-shader obj-fragment-shader ;
void main()
{
gl_FragColor = color;
}
;
GLSL-PROGRAM: debug-program debug-vertex-shader debug-fragment-shader ;
UNIFORM-TUPLE: model-uniforms < mvp-uniforms UNIFORM-TUPLE: model-uniforms < mvp-uniforms
{ "light-position" vec3-uniform f } ; { "map_Ka" texture-uniform f }
{ "map_bump" texture-uniform f }
{ "Ka" vec3-uniform f }
{ "light" vec3-uniform f }
{ "view_pos" vec3-uniform f }
;
TUPLE: model-state TUPLE: model-state
models models
vertex-arrays vertex-arrays
index-vectors ; index-vectors
textures
bumps
kas ;
TUPLE: model-world < wasd-world TUPLE: model-world < wasd-world model-path model-state ;
{ model-state model-state } ;
VERTEX-FORMAT: model-vertex TUPLE: vbo
{ "POSITION" float-components 3 f } vertex-buffer
{ "NORMAL" float-components 3 f } index-buffer index-count vertex-format texture bump ka ;
{ "TEXCOORD" float-components 2 f } ;
VERTEX-FORMAT: debug-vertex : white-image ( -- image )
{ "POSITION" float-components 3 f } { 1 1 } BGR ubyte-components f
{ "COLOR" float-components 3 f } ; B{ 255 255 255 } image boa ;
TUPLE: vbo vertex-buffer index-buffer index-count vertex-format ;
: up-image ( -- image )
{ 1 1 } BGR ubyte-components f
B{ 0 0 0 } image boa ;
: make-texture ( pathname alt -- texture )
swap [ nip load-image ] [ ] if*
[
[ component-order>> ]
[ component-type>> ] bi
T{ texture-parameters
{ wrap repeat-texcoord }
{ min-filter filter-linear }
{ min-mipmap-filter f } }
<texture-2d>
]
[
0 swap [ allocate-texture-image ] 3keep 2drop
] bi ;
: <model-buffers> ( models -- buffers ) : <model-buffers> ( models -- buffers )
[ [
{ {
@ -102,110 +118,104 @@ TUPLE: vbo vertex-buffer index-buffer index-count vertex-format ;
[ index-buffer>> underlying>> static-upload draw-usage index-buffer byte-array>buffer ] [ index-buffer>> underlying>> static-upload draw-usage index-buffer byte-array>buffer ]
[ index-buffer>> length ] [ index-buffer>> length ]
[ vertex-format>> ] [ vertex-format>> ]
[ material>> ambient-map>> white-image make-texture ]
[ material>> bump-map>> up-image make-texture ]
[ material>> ambient-reflectivity>> ]
} cleave vbo boa } cleave vbo boa
] map ; ] map ;
: fill-model-state ( model-state -- ) : fill-model-state ( model-state -- )
dup models>> <model-buffers> dup models>> <model-buffers>
[
[
[ vertex-buffer>> model-program <program-instance> ]
[ vertex-format>> ] bi buffer>vertex-array
] map >>vertex-arrays drop
]
[
[
[ index-buffer>> ] [ index-count>> ] bi
'[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
] map >>index-vectors drop
] 2bi ;
: model-files ( -- files )
{ "C:/Users/erikc/Downloads/test2.dae"
"C:/Users/erikc/Downloads/Sponza.obj" } ;
: <model-state> ( -- model-state )
model-state new
model-files [ load-models ] [ append ] map-reduce >>models ;
M: model-world begin-game-world
init-gpu
{ 0.0 0.0 2.0 } 0 0 set-wasd-view
<model-state> [ fill-model-state drop ] [ >>model-state drop ] 2bi ;
: <model-uniforms> ( world -- uniforms )
[ wasd-mv-matrix ] [ wasd-p-matrix ] bi
{ -10000.0 10000.0 10000.0 } ! light position
model-uniforms boa ;
: draw-line ( world from to color -- )
[ 3 head ] tri@ dup -rot append -rot append swap append >float-array
underlying>> stream-upload draw-usage vertex-buffer byte-array>buffer
debug-program <program-instance> debug-vertex buffer>vertex-array
{ 0 1 } >uint-array stream-upload draw-usage index-buffer byte-array>buffer
2 '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
rot <model-uniforms>
{ {
{ "primitive-mode" [ 3drop lines-mode ] } [
{ "uniforms" [ nip nip ] } [
{ "vertex-array" [ drop drop ] } [ vertex-buffer>> obj-program <program-instance> ]
{ "indexes" [ drop nip ] } [ vertex-format>> ] bi buffer>vertex-array
} 3<render-set> render ; ] map >>vertex-arrays drop
]
[
[
[ index-buffer>> ] [ index-count>> ] bi
'[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
] map >>index-vectors drop
]
[ [ texture>> ] map >>textures drop ]
[ [ bump>> ] map >>bumps drop ]
[ [ ka>> ] map >>kas drop ]
} 2cleave ;
: draw-lines ( world lines -- ) : <model-state> ( model-world -- model-state )
3 <groups> [ first3 draw-line ] with each ; inline model-path>> 1array model-state new swap
[ load-models ] [ append ] map-reduce >>models ;
: draw-axes ( world -- ) :: <model-uniforms> ( world -- uniforms )
{ { 0 0 0 } { 1 0 0 } { 1 0 0 } world model-state>>
{ 0 0 0 } { 0 1 0 } { 0 1 0 } [ textures>> ] [ bumps>> ] [ kas>> ] tri
{ 0 0 0 } { 0 0 1 } { 0 0 1 } } draw-lines ; [| texture bump ka |
world wasd-mv-matrix
: draw-model ( world -- ) world wasd-p-matrix
texture bump ka
{ 0.5 0.5 0.5 }
world location>>
model-uniforms boa
] 3map ;
: clear-screen ( -- )
0 0 0 0 glClearColor 0 0 0 0 glClearColor
1 glClearDepth 1 glClearDepth
HEX: ffffffff glClearStencil HEX: ffffffff glClearStencil
{ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT GL_STENCIL_BUFFER_BIT } flags glClear { GL_COLOR_BUFFER_BIT
GL_DEPTH_BUFFER_BIT
GL_STENCIL_BUFFER_BIT } flags glClear ;
: draw-model ( world -- )
clear-screen
face-ccw cull-back <triangle-cull-state> set-gpu-state
cmp-less <depth-state> set-gpu-state
[ model-state>> vertex-arrays>> ]
[ model-state>> index-vectors>> ]
[ <model-uniforms> ]
tri
[ [
triangle-fill dup t <triangle-state> set-gpu-state {
face-ccw cull-back <triangle-cull-state> set-gpu-state { "primitive-mode" [ 3drop triangles-mode ] }
{ "uniforms" [ nip nip ] }
cmp-less <depth-state> set-gpu-state { "vertex-array" [ drop drop ] }
[ model-state>> vertex-arrays>> ] { "indexes" [ drop nip ] }
[ model-state>> index-vectors>> ] } 3<render-set> render
[ <model-uniforms> ] ] 3each ;
tri
[
{
{ "primitive-mode" [ 3drop triangles-mode ] }
{ "uniforms" [ nip nip ] }
{ "vertex-array" [ drop drop ] }
{ "indexes" [ drop nip ] }
} 3<render-set> render
] curry 2each
]
[
cmp-always <depth-state> set-gpu-state
draw-axes
]
bi ;
M: model-world draw-world* TUPLE: model-attributes < game-attributes model-path ;
draw-model ;
M: model-world draw-world* draw-model ;
M: model-world wasd-movement-speed drop 1/4. ; M: model-world wasd-movement-speed drop 1/4. ;
M: model-world wasd-near-plane drop 1/32. ; M: model-world wasd-near-plane drop 1/32. ;
M: model-world wasd-far-plane drop 1024.0 ; M: model-world wasd-far-plane drop 1024.0 ;
M: model-world begin-game-world
init-gpu
{ 0.0 0.0 2.0 } 0 0 set-wasd-view
[ <model-state> [ fill-model-state ] keep ] [ (>>model-state) ] bi ;
M: model-world apply-world-attributes
{
[ model-path>> >>model-path ]
[ call-next-method ]
} cleave ;
GAME: model-viewer { :: open-model-viewer ( model-path -- )
{ world-class model-world } [
{ title "Model Viewer" } f
{ pixel-format-attributes { windowed double-buffered } } T{ model-attributes
{ grab-input? t } { world-class model-world }
{ use-game-input? t } { grab-input? t }
{ pref-dim { 1024 768 } } { title "Model Viewer" }
{ tick-interval-micros $[ 60 fps ] } { pixel-format-attributes
} ; { windowed double-buffered }
}
{ pref-dim { 1024 768 } }
{ tick-interval-micros 16666 }
{ use-game-input? t }
{ model-path model-path }
}
clone
open-window
] with-ui ;

1
misc/fuel/fuel-syntax.el
View File

@ -287,6 +287,7 @@
("\\_<\\()\\))\\_>" (1 ")(")) ("\\_<\\()\\))\\_>" (1 ")("))
;; Quotations: ;; Quotations:
("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time
("\\_<\\(\\[\\)\\_>" (1 "(]")) ("\\_<\\(\\[\\)\\_>" (1 "(]"))
("\\_<\\(\\]\\)\\_>" (1 ")[")))) ("\\_<\\(\\]\\)\\_>" (1 ")["))))

2
vm/Config.macosx
View File

@ -11,7 +11,7 @@ SHARED_FLAG = -dynamiclib
ifdef X11 ifdef X11
LIBS = -lm -framework Cocoa -L/opt/local/lib $(X11_UI_LIBS) -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib LIBS = -lm -framework Cocoa -L/opt/local/lib $(X11_UI_LIBS) -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib
else else
LIBS = -lm -framework Cocoa -framework AppKit LIBS = -lm -framework Cocoa -framework AppKit
endif endif
LINKER = $(CPP) $(CFLAGS) -dynamiclib -single_module -std=gnu99 \ LINKER = $(CPP) $(CFLAGS) -dynamiclib -single_module -std=gnu99 \

2
vm/bignumint.hpp
View File

@ -96,7 +96,7 @@ typedef fixnum bignum_length_type;
#define BIGNUM_ASSERT(expression) \ #define BIGNUM_ASSERT(expression) \
{ \ { \
if (! (expression)) \ if (! (expression)) \
BIGNUM_EXCEPTION (); \ BIGNUM_EXCEPTION (); \
} }
#endif /* not BIGNUM_DISABLE_ASSERTION_CHECKS */ #endif /* not BIGNUM_DISABLE_ASSERTION_CHECKS */

14
vm/cpu-ppc.hpp
View File

@ -58,20 +58,20 @@ inline static bool tail_call_site_p(cell return_address)
inline static unsigned int fpu_status(unsigned int status) inline static unsigned int fpu_status(unsigned int status)
{ {
unsigned int r = 0; unsigned int r = 0;
if (status & 0x20000000) if (status & 0x20000000)
r |= FP_TRAP_INVALID_OPERATION; r |= FP_TRAP_INVALID_OPERATION;
if (status & 0x10000000) if (status & 0x10000000)
r |= FP_TRAP_OVERFLOW; r |= FP_TRAP_OVERFLOW;
if (status & 0x08000000) if (status & 0x08000000)
r |= FP_TRAP_UNDERFLOW; r |= FP_TRAP_UNDERFLOW;
if (status & 0x04000000) if (status & 0x04000000)
r |= FP_TRAP_ZERO_DIVIDE; r |= FP_TRAP_ZERO_DIVIDE;
if (status & 0x02000000) if (status & 0x02000000)
r |= FP_TRAP_INEXACT; r |= FP_TRAP_INEXACT;
return r; return r;
} }
/* Defined in assembly */ /* Defined in assembly */

14
vm/cpu-x86.hpp
View File

@ -55,20 +55,20 @@ inline static bool tail_call_site_p(cell return_address)
inline static unsigned int fpu_status(unsigned int status) inline static unsigned int fpu_status(unsigned int status)
{ {
unsigned int r = 0; unsigned int r = 0;
if (status & 0x01) if (status & 0x01)
r |= FP_TRAP_INVALID_OPERATION; r |= FP_TRAP_INVALID_OPERATION;
if (status & 0x04) if (status & 0x04)
r |= FP_TRAP_ZERO_DIVIDE; r |= FP_TRAP_ZERO_DIVIDE;
if (status & 0x08) if (status & 0x08)
r |= FP_TRAP_OVERFLOW; r |= FP_TRAP_OVERFLOW;
if (status & 0x10) if (status & 0x10)
r |= FP_TRAP_UNDERFLOW; r |= FP_TRAP_UNDERFLOW;
if (status & 0x20) if (status & 0x20)
r |= FP_TRAP_INEXACT; r |= FP_TRAP_INEXACT;
return r; return r;
} }
} }

2
vm/data_heap.cpp
View File

@ -201,7 +201,7 @@ cell object::binary_payload_start() const
return sizeof(wrapper); return sizeof(wrapper);
default: default:
critical_error("Invalid header",(cell)this); critical_error("Invalid header",(cell)this);
return 0; /* can't happen */ return 0; /* can't happen */
} }
} }

2
vm/full_collector.cpp
View File

@ -67,7 +67,7 @@ void factor_vm::collect_mark_impl(bool trace_contexts_p)
data->tenured->clear_mark_bits(); data->tenured->clear_mark_bits();
collector.trace_roots(); collector.trace_roots();
if(trace_contexts_p) if(trace_contexts_p)
{ {
collector.trace_contexts(); collector.trace_contexts();
collector.trace_context_code_blocks(); collector.trace_context_code_blocks();

2
vm/gc.hpp
View File

@ -45,7 +45,7 @@ struct gc_event {
struct gc_state { struct gc_state {
gc_op op; gc_op op;
u64 start_time; u64 start_time;
jmp_buf gc_unwind; jmp_buf gc_unwind;
gc_event *event; gc_event *event;
explicit gc_state(gc_op op_, factor_vm *parent); explicit gc_state(gc_op op_, factor_vm *parent);

37
vm/io.cpp
View File

@ -154,7 +154,7 @@ void factor_vm::primitive_fopen()
FILE *file; FILE *file;
file = safe_fopen((char *)(path.untagged() + 1), file = safe_fopen((char *)(path.untagged() + 1),
(char *)(mode.untagged() + 1)); (char *)(mode.untagged() + 1));
ctx->push(allot_alien(file)); ctx->push(allot_alien(file));
} }
@ -187,31 +187,24 @@ void factor_vm::primitive_fread()
data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this); data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this);
for(;;) int c = safe_fread(buf.untagged() + 1,1,size,file);
if(c == 0)
{ {
int c = safe_fread(buf.untagged() + 1,1,size,file); if(feof(file))
if(c == 0) ctx->push(false_object);
{
if(feof(file))
{
ctx->push(false_object);
break;
}
else
io_error();
}
else else
io_error();
}
else
{
if(feof(file))
{ {
if(feof(file)) byte_array *new_buf = allot_byte_array(c);
{ memcpy(new_buf + 1, buf.untagged() + 1,c);
byte_array *new_buf = allot_byte_array(c); buf = new_buf;
memcpy(new_buf + 1, buf.untagged() + 1,c);
buf = new_buf;
}
ctx->push(buf.value());
break;
} }
ctx->push(buf.value());
} }
} }

2
vm/jit.hpp
View File

@ -61,7 +61,7 @@ struct jit {
return position; return position;
} }
void set_position(fixnum position_) void set_position(fixnum position_)
{ {
if(computing_offset_p) if(computing_offset_p)
position = position_; position = position_;

2
vm/math.cpp
View File

@ -168,7 +168,7 @@ void factor_vm::primitive_bignum_xor()
void factor_vm::primitive_bignum_shift() void factor_vm::primitive_bignum_shift()
{ {
fixnum y = untag_fixnum(ctx->pop()); fixnum y = untag_fixnum(ctx->pop());
bignum* x = untag<bignum>(ctx->pop()); bignum* x = untag<bignum>(ctx->pop());
ctx->push(tag<bignum>(bignum_arithmetic_shift(x,y))); ctx->push(tag<bignum>(bignum_arithmetic_shift(x,y)));
} }

16
vm/os-freebsd-x86.32.hpp
View File

@ -6,35 +6,35 @@ namespace factor
inline static unsigned int uap_fpu_status(void *uap) inline static unsigned int uap_fpu_status(void *uap)
{ {
ucontext_t *ucontext = (ucontext_t *)uap; ucontext_t *ucontext = (ucontext_t *)uap;
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387) if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387)
{ {
struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate); struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate);
return x87->sv_env.en_sw; return x87->sv_env.en_sw;
} }
else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
{ {
struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate); struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr; return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr;
} }
else else
return 0; return 0;
} }
inline static void uap_clear_fpu_status(void *uap) inline static void uap_clear_fpu_status(void *uap)
{ {
ucontext_t *ucontext = (ucontext_t *)uap; ucontext_t *ucontext = (ucontext_t *)uap;
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387) if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387)
{ {
struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate); struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate);
x87->sv_env.en_sw = 0; x87->sv_env.en_sw = 0;
} }
else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
{ {
struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate); struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
xmm->sv_env.en_sw = 0; xmm->sv_env.en_sw = 0;
xmm->sv_env.en_mxcsr &= 0xffffffc0; xmm->sv_env.en_mxcsr &= 0xffffffc0;
} }
} }

12
vm/os-freebsd-x86.64.hpp
View File

@ -6,25 +6,25 @@ namespace factor
inline static unsigned int uap_fpu_status(void *uap) inline static unsigned int uap_fpu_status(void *uap)
{ {
ucontext_t *ucontext = (ucontext_t *)uap; ucontext_t *ucontext = (ucontext_t *)uap;
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
{ {
struct savefpu *xmm = (struct savefpu *)(&ucontext->uc_mcontext.mc_fpstate); struct savefpu *xmm = (struct savefpu *)(&ucontext->uc_mcontext.mc_fpstate);
return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr; return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr;
} }
else else
return 0; return 0;
} }
inline static void uap_clear_fpu_status(void *uap) inline static void uap_clear_fpu_status(void *uap)
{ {
ucontext_t *ucontext = (ucontext_t *)uap; ucontext_t *ucontext = (ucontext_t *)uap;
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
{ {
struct savefpu *xmm = (struct savefpu *)(&ucontext->uc_mcontext.mc_fpstate); struct savefpu *xmm = (struct savefpu *)(&ucontext->uc_mcontext.mc_fpstate);
xmm->sv_env.en_sw = 0; xmm->sv_env.en_sw = 0;
xmm->sv_env.en_mxcsr &= 0xffffffc0; xmm->sv_env.en_mxcsr &= 0xffffffc0;
} }
} }

12
vm/os-linux-x86.64.hpp
View File

@ -5,16 +5,16 @@ namespace factor
inline static unsigned int uap_fpu_status(void *uap) inline static unsigned int uap_fpu_status(void *uap)
{ {
ucontext_t *ucontext = (ucontext_t *)uap; ucontext_t *ucontext = (ucontext_t *)uap;
return ucontext->uc_mcontext.fpregs->swd return ucontext->uc_mcontext.fpregs->swd
| ucontext->uc_mcontext.fpregs->mxcsr; | ucontext->uc_mcontext.fpregs->mxcsr;
} }
inline static void uap_clear_fpu_status(void *uap) inline static void uap_clear_fpu_status(void *uap)
{ {
ucontext_t *ucontext = (ucontext_t *)uap; ucontext_t *ucontext = (ucontext_t *)uap;
ucontext->uc_mcontext.fpregs->swd = 0; ucontext->uc_mcontext.fpregs->swd = 0;
ucontext->uc_mcontext.fpregs->mxcsr &= 0xffffffc0; ucontext->uc_mcontext.fpregs->mxcsr &= 0xffffffc0;
} }
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[15]) #define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[15])

22
vm/os-windows-nt.cpp
View File

@ -37,8 +37,6 @@ u64 system_micros()
- EPOCH_OFFSET) / 10; - EPOCH_OFFSET) / 10;
} }
/* On VirtualBox, QueryPerformanceCounter does not increment
the high part every time the low part overflows. Workaround. */
u64 nano_count() u64 nano_count()
{ {
LARGE_INTEGER count; LARGE_INTEGER count;
@ -53,8 +51,14 @@ u64 nano_count()
if(ret == 0) if(ret == 0)
fatal_error("QueryPerformanceFrequency", 0); fatal_error("QueryPerformanceFrequency", 0);
if(count.LowPart < lo) #ifdef FACTOR_64
hi += 1; hi = count.HighPart;
#else
/* On VirtualBox, QueryPerformanceCounter does not increment
the high part every time the low part overflows. Workaround. */
if(lo > count.LowPart)
hi++;
#endif
lo = count.LowPart; lo = count.LowPart;
return (u64)((((u64)hi << 32) | (u64)lo)*(1000000000.0/frequency.QuadPart)); return (u64)((((u64)hi << 32) | (u64)lo)*(1000000000.0/frequency.QuadPart));
@ -75,12 +79,12 @@ LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
else else
signal_callstack_top = NULL; signal_callstack_top = NULL;
switch (e->ExceptionCode) switch (e->ExceptionCode)
{ {
case EXCEPTION_ACCESS_VIOLATION: case EXCEPTION_ACCESS_VIOLATION:
signal_fault_addr = e->ExceptionInformation[1]; signal_fault_addr = e->ExceptionInformation[1];
c->EIP = (cell)factor::memory_signal_handler_impl; c->EIP = (cell)factor::memory_signal_handler_impl;
break; break;
case STATUS_FLOAT_DENORMAL_OPERAND: case STATUS_FLOAT_DENORMAL_OPERAND:
case STATUS_FLOAT_DIVIDE_BY_ZERO: case STATUS_FLOAT_DIVIDE_BY_ZERO:
@ -91,7 +95,7 @@ LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
case STATUS_FLOAT_UNDERFLOW: case STATUS_FLOAT_UNDERFLOW:
case STATUS_FLOAT_MULTIPLE_FAULTS: case STATUS_FLOAT_MULTIPLE_FAULTS:
case STATUS_FLOAT_MULTIPLE_TRAPS: case STATUS_FLOAT_MULTIPLE_TRAPS:
#ifdef FACTOR_AMD64 #ifdef FACTOR_64
signal_fpu_status = fpu_status(MXCSR(c)); signal_fpu_status = fpu_status(MXCSR(c));
#else #else
signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c)); signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));

4
vm/os-windows.cpp
View File

@ -128,7 +128,7 @@ segment::~segment()
long getpagesize() long getpagesize()
{ {
static long g_pagesize = 0; static long g_pagesize = 0;
if (! g_pagesize) if(!g_pagesize)
{ {
SYSTEM_INFO system_info; SYSTEM_INFO system_info;
GetSystemInfo (&system_info); GetSystemInfo (&system_info);
@ -139,7 +139,7 @@ long getpagesize()
void factor_vm::move_file(const vm_char *path1, const vm_char *path2) void factor_vm::move_file(const vm_char *path1, const vm_char *path2)
{ {
if(MoveFileEx((path1),(path2),MOVEFILE_REPLACE_EXISTING) == false) if(MoveFileEx((path1),(path2),MOVEFILE_REPLACE_EXISTING) == false)
general_error(ERROR_IO,tag_fixnum(GetLastError()),false_object,NULL); general_error(ERROR_IO,tag_fixnum(GetLastError()),false_object,NULL);
} }

14
vm/vm.hpp
View File

@ -184,20 +184,20 @@ struct factor_vm
void bignum_destructive_add(bignum * bignum, bignum_digit_type n); void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor); void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator,
bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p); bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q); 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 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 guess, bignum_digit_type * u_start);
void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, 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 * * 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_normalization(bignum * source, bignum * target, int shift_left);
void bignum_destructive_unnormalization(bignum * bignum, int shift_right); 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 bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
bignum_digit_type v, bignum_digit_type * q) /* return value */; 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 bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
bignum_digit_type guess, bignum_digit_type * u); bignum_digit_type guess, bignum_digit_type * u);
void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, 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 * * 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_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_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 *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p);
@ -314,7 +314,7 @@ struct factor_vm
if(!(current_gc && current_gc->op == collect_growing_heap_op)) if(!(current_gc && current_gc->op == collect_growing_heap_op))
{ {
assert((cell)pointer >= data->seg->start assert((cell)pointer >= data->seg->start
&& (cell)pointer < data->seg->end); && (cell)pointer < data->seg->end);
} }
#endif #endif
} }