From 961d2258a6b9801e7d42f533e6390634c8c98f53 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Oct 2005 00:19:10 +0000 Subject: [PATCH] fix powerpc abi issues, add load.factor files --- library/alien/compiler.factor | 41 +++++++----- library/bootstrap/boot-stage2.factor | 81 ++---------------------- library/compiler/generator.factor | 10 +++ library/compiler/linearizer.factor | 10 +-- library/compiler/ppc/alien.factor | 34 ++++------ library/compiler/ppc/architecture.factor | 11 +++- library/compiler/ppc/assembler.factor | 2 +- library/compiler/ppc/generator.factor | 14 ++-- library/compiler/ppc/load.factor | 13 ++++ library/compiler/vops.factor | 17 +++++ library/compiler/x86/alien.factor | 4 -- library/compiler/x86/architecture.factor | 9 ++- library/compiler/x86/load.factor | 13 ++++ library/freetype/freetype-gl.factor | 66 +++++++++++-------- library/freetype/freetype.factor | 11 ---- library/freetype/load.factor | 8 ++- library/opengl/load.factor | 14 +++- library/opengl/opengl-utils.factor | 55 +++++++++------- library/sdl/load.factor | 9 ++- library/test/compiler/intrinsics.factor | 3 + library/ui/labels.factor | 2 +- library/unix/load.factor | 24 +++++++ library/win32/load.factor | 20 ++++++ 23 files changed, 273 insertions(+), 198 deletions(-) create mode 100644 library/compiler/ppc/load.factor create mode 100644 library/compiler/x86/load.factor create mode 100644 library/unix/load.factor create mode 100644 library/win32/load.factor diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index a336340cbc..8fea20309f 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -77,31 +77,38 @@ C: alien-node make-node ; : unbox-parameters ( params -- ) [ stack-space ] keep - [ [ c-aligned - dup ] keep unbox-parameter ] map nip % ; + [ [ c-aligned - dup ] keep unbox-parameter , ] each drop ; -: incr-param ( reg-class -- ) - #! OS X is so ugly. - dup class inc dup float-regs? [ - os "macosx" = [ - int-regs [ swap float-regs-size 4 / + ] change - ] [ - drop - ] if - ] [ - drop - ] if ; +: reg-class-full? ( class -- ? ) + dup class get swap fastcall-regs >= ; + +: spill-param ( reg-class -- n reg-class ) + reg-class-size stack-params [ tuck + ] change + << stack-params >> ; + +: inc-reg-class ( reg-class -- ) + #! On Mac OS X, float parameters 'shadow' integer registers. + dup class inc dup float-regs? dual-fp/int-regs? and [ + int-regs [ over reg-class-size 4 / + ] change + ] when drop ; + +: fastcall-param ( reg-class -- n reg-class ) + [ dup class get swap inc-reg-class ] keep ; : load-parameter ( n parameter -- node ) - c-type "reg-class" swap hash - [ [ class get ] keep incr-param ] keep %parameter ; + #! n is a stack location, and the value of the class + #! variable is a register number. + c-type "reg-class" swap hash dup reg-class-full? + [ spill-param ] [ fastcall-param ] if %parameter ; : load-parameters ( params -- ) [ + reverse 0 int-regs set 0 float-regs set - reverse 0 swap - [ 2dup load-parameter >r c-aligned + r> ] map nip - ] with-scope % ; + 0 stack-params set + 0 [ 2dup load-parameter , c-aligned + ] reduce drop + ] with-scope ; : linearize-parameters ( parameters -- ) #! Generate code for boxing a list of C types, then generate diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 77d439236b..9f27d69ab2 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -11,60 +11,15 @@ sequences sequences-internals words ; "Loading compiler backend..." print cpu "x86" = [ - "/library/compiler/x86/assembler.factor" - "/library/compiler/x86/architecture.factor" - "/library/compiler/x86/generator.factor" - "/library/compiler/x86/slots.factor" - "/library/compiler/x86/stack.factor" - "/library/compiler/x86/fixnum.factor" - "/library/compiler/x86/alien.factor" + "/library/compiler/x86/load.factor" "/library/alien/primitive-types.factor" ] pull-in cpu "ppc" = [ - "/library/compiler/ppc/assembler.factor" - "/library/compiler/ppc/architecture.factor" - "/library/compiler/ppc/generator.factor" - "/library/compiler/ppc/slots.factor" - "/library/compiler/ppc/stack.factor" - "/library/compiler/ppc/fixnum.factor" - "/library/compiler/ppc/alien.factor" + "/library/compiler/ppc/load.factor" "/library/alien/primitive-types.factor" ] pull-in -unix? [ - "sdl-gfx" "libSDL_gfx.so" "cdecl" add-library - - os "macosx" = [ - ! SDL and OpenGL are linked into the runtime - "sdl-ttf" "libSDL_ttf.dylib" "cdecl" add-library - "freetype" "libfreetype.dylib" "cdecl" add-library - ] [ - "sdl" "libSDL.so" "cdecl" add-library - "sdl-ttf" "libSDL_ttf.so" "cdecl" add-library - "gl" "libGL.so" "cdecl" add-library - "glu" "libGLU.so" "cdecl" add-library - "freetype" "libfreetype.so" "cdecl" add-library - ] if -] when - -win32? [ - "kernel32" "kernel32.dll" "stdcall" add-library - "user32" "user32.dll" "stdcall" add-library - "gdi32" "gdi32.dll" "stdcall" add-library - "winsock" "ws2_32.dll" "stdcall" add-library - "mswsock" "mswsock.dll" "stdcall" add-library - "libc" "msvcrt.dll" "cdecl" add-library - "sdl" "SDL.dll" "cdecl" add-library - "sdl-gfx" "SDL_gfx.dll" "cdecl" add-library - "sdl-ttf" "SDL_ttf.dll" "cdecl" add-library - "gl" "opengl32.dll" "stdcall" add-library - "glu" "glu32.dll" "stdcall" add-library -] when - -! Handle -libraries:... overrides -parse-command-line - "Loading more library code..." print t [ @@ -79,6 +34,9 @@ t [ "/library/help/tutorial.factor" ] pull-in +! Handle -libraries:... overrides +parse-command-line + : compile? "compile" get supported-cpu? and ; compile? [ @@ -94,36 +52,11 @@ compile? [ compile? [ unix? [ - "/library/unix/types.factor" - ] pull-in - - os "freebsd" = [ - "/library/unix/syscalls-freebsd.factor" - ] pull-in - - os "linux" = [ - "/library/unix/syscalls-linux.factor" - ] pull-in - - os "macosx" = [ - "/library/unix/syscalls-macosx.factor" - ] pull-in - - unix? [ - "/library/unix/syscalls.factor" - "/library/unix/io.factor" - "/library/unix/sockets.factor" - "/library/unix/files.factor" + "/library/unix/load.factor" ] pull-in os "win32" = [ - "/library/win32/win32-io.factor" - "/library/win32/win32-errors.factor" - "/library/win32/winsock.factor" - "/library/win32/win32-io-internals.factor" - "/library/win32/win32-stream.factor" - "/library/win32/win32-server.factor" - "/library/bootstrap/win32-io.factor" + "/library/win32/load.factor" ] pull-in ] when diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor index 596eded3bb..2bf0c249f1 100644 --- a/library/compiler/generator.factor +++ b/library/compiler/generator.factor @@ -7,6 +7,13 @@ memory namespaces sequences strings vectors words ; ! Compile a VOP. GENERIC: generate-node ( vop -- ) +: set-stack-reserve ( linear -- ) + #! The %prologue node contains the maximum stack reserve of + #! all VOPs. The precise meaning of stack reserve is + #! platform-specific. + 0 [ 0 [ stack-reserve max ] reduce max ] reduce + \ stack-reserve set ; + : generate-code ( word linear -- length ) compiled-offset >r compile-aligned @@ -23,6 +30,7 @@ GENERIC: generate-node ( vop -- ) : (generate) ( word linear -- ) #! Compile a word definition from linear IR. { } clone relocation-table set + dup set-stack-reserve begin-assembly swap >r >r generate-code generate-reloc @@ -55,6 +63,8 @@ M: %target-label generate-node vop-label compile-target ; M: %target generate-node vop-label dup postpone-word compile-target ; +M: %parameters generate-node ( vop -- ) drop ; + GENERIC: v>operand M: integer v>operand tag-bits shift ; diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor index 1b891babd3..b27fc4c274 100644 --- a/library/compiler/linearizer.factor +++ b/library/compiler/linearizer.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: compiler-frontend -USING: compiler-backend errors generic lists inference kernel -math namespaces prettyprint sequences -strings words ; +USING: arrays compiler-backend errors generic inference kernel +lists math namespaces prettyprint sequences strings words ; GENERIC: linearize* ( node -- ) @@ -11,10 +10,7 @@ GENERIC: linearize* ( node -- ) #! Transform dataflow IR into linear IR. This strips out #! stack flow information, and flattens conditionals into #! jumps and labels. - [ - %prologue , - linearize* - ] { } make ; + [ %prologue , linearize* ] { } make ; : linearize-next node-successor linearize* ; diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor index fe4062abf2..5bf87b5cb4 100644 --- a/library/compiler/ppc/alien.factor +++ b/library/compiler/ppc/alien.factor @@ -6,41 +6,35 @@ USING: alien assembler kernel math ; M: %alien-invoke generate-node ( vop -- ) dup 0 vop-in swap 1 vop-in load-library compile-c-call ; -: stack-reserve 8 + 16 align ; -: stack@ 12 + ; - -M: %parameters generate-node ( vop -- ) - 0 vop-in dup 0 = - [ drop ] [ stack-reserve 1 1 rot SUBI ] if ; - GENERIC: store-insn GENERIC: load-insn GENERIC: return-reg -M: int-regs store-insn drop STW ; +M: int-regs store-insn drop stack@ STW ; M: int-regs return-reg drop 3 ; -M: int-regs load-insn drop 3 + 1 rot LWZ ; +M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ; M: float-regs store-insn - float-regs-size 4 = [ STFS ] [ STFD ] if ; + >r stack@ r> float-regs-size 4 = [ STFS ] [ STFD ] if ; M: float-regs return-reg drop 1 ; M: float-regs load-insn - >r 1+ 1 rot r> float-regs-size 4 = [ LFS ] [ LFD ] if ; + >r 1+ 1 rot stack@ r> + float-regs-size 4 = [ LFS ] [ LFD ] if ; + +M: stack-params load-insn ( from to reg-class -- ) + drop >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW ; M: %unbox generate-node ( vop -- ) [ 1 vop-in f compile-c-call ] keep [ 2 vop-in return-reg 1 ] keep - [ 0 vop-in stack@ ] keep + [ 0 vop-in ] keep 2 vop-in store-insn ; M: %parameter generate-node ( vop -- ) - dup 0 vop-in stack@ - over 1 vop-in - rot 2 vop-in load-insn ; + [ 0 vop-in ] keep + [ 1 vop-in ] keep + 2 vop-in load-insn ; -M: %box generate-node ( vop -- ) - 0 vop-in f compile-c-call ; +M: %box generate-node ( vop -- ) 0 vop-in f compile-c-call ; -M: %cleanup generate-node ( vop -- ) - 0 vop-in dup 0 = - [ drop ] [ stack-reserve 1 1 rot ADDI ] if ; +M: %cleanup generate-node ( vop -- ) drop ; diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor index a86625c2f7..e90db1a6b7 100644 --- a/library/compiler/ppc/architecture.factor +++ b/library/compiler/ppc/architecture.factor @@ -1,5 +1,5 @@ IN: compiler-backend -USING: assembler compiler-backend math ; +USING: assembler compiler-backend kernel math ; ! PowerPC register assignments ! r3-r10 vregs @@ -19,3 +19,12 @@ USING: assembler compiler-backend math ; 8 ; inline M: vreg v>operand vreg-n 3 + ; + +M: int-regs fastcall-regs drop 8 ; +M: int-regs reg-class-size drop 4 ; +M: float-regs fastcall-regs drop 8 ; + +! Mach-O -vs- Linux/PPC +: stack@ os "macosx" = 24 8 ? + ; +: lr@ os "macosx" = 8 4 ? + ; +: dual-fp/int-regs? os "macosx" = ; diff --git a/library/compiler/ppc/assembler.factor b/library/compiler/ppc/assembler.factor index 0435416c5a..6e0514182e 100644 --- a/library/compiler/ppc/assembler.factor +++ b/library/compiler/ppc/assembler.factor @@ -190,7 +190,7 @@ M: word BC >r 0 BC r> relative-14 ; : LOAD ( n r -- ) #! PowerPC cannot load a 32 bit literal in one instruction. - >r dup dup HEX: ffff bitand = [ r> LI ] [ r> LOAD32 ] if ; + >r dup -32768 32767 between? [ r> LI ] [ r> LOAD32 ] if ; ! Floating point : (FMR) >r 0 -rot 72 r> x-form 63 insn ; diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor index b270c4425b..bf906fcb15 100644 --- a/library/compiler/ppc/generator.factor +++ b/library/compiler/ppc/generator.factor @@ -7,19 +7,21 @@ kernel-internals lists math memory namespaces words ; : compile-c-call ( symbol dll -- ) 2dup dlsym 11 LOAD32 0 1 rel-dlsym 11 MTLR BLRL ; +: stack-increment \ stack-reserve get stack@ 16 align ; + M: %prologue generate-node ( vop -- ) drop - 1 1 -16 STWU + 1 1 stack-increment neg STWU 0 MFLR - 0 1 20 STW ; + 0 1 stack-increment lr@ STW ; : compile-epilogue #! At the end of each word that calls a subroutine, we store #! the previous link register value in r0 by popping it off #! the stack, set the link register to the contents of r0, #! and jump to the link register. - 0 1 20 LWZ - 1 1 16 ADDI + 0 1 stack-increment lr@ LWZ + 1 1 stack-increment ADDI 0 MTLR ; M: %call-label generate-node ( vop -- ) @@ -27,8 +29,8 @@ M: %call-label generate-node ( vop -- ) #! Note: length of instruction sequence is hard-coded. vop-label compiled-offset 20 + 18 LOAD32 0 1 rel-address - 1 1 -16 STWU - 18 1 20 STW + 1 1 stack-increment neg STWU + 18 1 stack-increment cell + STW B ; : word-addr ( word -- ) diff --git a/library/compiler/ppc/load.factor b/library/compiler/ppc/load.factor new file mode 100644 index 0000000000..5b6e508c12 --- /dev/null +++ b/library/compiler/ppc/load.factor @@ -0,0 +1,13 @@ +USING: io kernel parser sequences ; + +[ + "/library/compiler/ppc/assembler.factor" + "/library/compiler/ppc/architecture.factor" + "/library/compiler/ppc/generator.factor" + "/library/compiler/ppc/slots.factor" + "/library/compiler/ppc/stack.factor" + "/library/compiler/ppc/fixnum.factor" + "/library/compiler/ppc/alien.factor" +] [ + dup print run-resource +] each diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor index 618753202e..7dc2d05f46 100644 --- a/library/compiler/vops.factor +++ b/library/compiler/vops.factor @@ -28,14 +28,24 @@ TUPLE: vreg n ; TUPLE: int-regs ; TUPLE: float-regs size ; +GENERIC: fastcall-regs ( register-class -- n ) + +GENERIC: reg-class-size ( register-class -- n ) + +M: float-regs reg-class-size float-regs-size ; + ! A data stack location. TUPLE: ds-loc n ; ! A call stack location. TUPLE: cs-loc n ; +! A pseudo-register class for parameters spilled on the stack +TUPLE: stack-params ; + ! A virtual operation TUPLE: vop inputs outputs label ; + : vop-in ( vop n -- input ) swap vop-inputs nth ; : set-vop-in ( input vop n -- ) swap vop-inputs set-nth ; : vop-out ( vop n -- input ) swap vop-outputs nth ; @@ -46,6 +56,12 @@ M: vop basic-block? drop f ; ! simplifies some code M: f basic-block? drop f ; +! Only on PowerPC. The %parameters node needs to reserve space +! in the stack frame. +GENERIC: stack-reserve + +M: vop stack-reserve drop 0 ; + : make-vop ( inputs outputs label vop -- vop ) [ >r r> set-delegate ] keep ; @@ -318,6 +334,7 @@ M: %setenv basic-block? drop t ; ! alien operations TUPLE: %parameters ; C: %parameters make-vop ; +M: %parameters stack-reserve 0 vop-in ; : %parameters ( n -- vop ) src-vop <%parameters> ; TUPLE: %parameter ; diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor index c4b65f0785..5fb7fc38a8 100644 --- a/library/compiler/x86/alien.factor +++ b/library/compiler/x86/alien.factor @@ -8,10 +8,6 @@ M: %alien-invoke generate-node #! call a C function. dup 0 vop-in swap 1 vop-in load-library compile-c-call ; -M: %parameters generate-node - #! x86 does not pass parameters in registers - drop ; - M: %parameter generate-node #! x86 does not pass parameters in registers drop ; diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor index 2eba327d6c..e8466b21b9 100644 --- a/library/compiler/x86/architecture.factor +++ b/library/compiler/x86/architecture.factor @@ -1,5 +1,5 @@ IN: compiler-backend -USING: assembler compiler-backend sequences ; +USING: assembler compiler-backend kernel sequences ; ! x86 register assignments ! EAX, ECX, EDX, EBP vregs @@ -19,3 +19,10 @@ USING: assembler compiler-backend sequences ; 3 ; inline M: vreg v>operand vreg-n { EAX ECX EDX } nth ; + +! On x86, parameters are never passed in registers. +M: int-regs fastcall-regs drop 0 ; +M: int-regs reg-class-size drop 4 ; +M: float-regs fastcall-regs drop 0 ; + +: dual-fp/int-regs? f ; diff --git a/library/compiler/x86/load.factor b/library/compiler/x86/load.factor new file mode 100644 index 0000000000..4eb9cc81f0 --- /dev/null +++ b/library/compiler/x86/load.factor @@ -0,0 +1,13 @@ +USING: io kernel parser sequences ; + +[ + "/library/compiler/x86/assembler.factor" + "/library/compiler/x86/architecture.factor" + "/library/compiler/x86/generator.factor" + "/library/compiler/x86/slots.factor" + "/library/compiler/x86/stack.factor" + "/library/compiler/x86/fixnum.factor" + "/library/compiler/x86/alien.factor" +] [ + dup print run-resource +] each diff --git a/library/freetype/freetype-gl.factor b/library/freetype/freetype-gl.factor index a64b7fc9ae..97d879957c 100644 --- a/library/freetype/freetype-gl.factor +++ b/library/freetype/freetype-gl.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -USING: # alien arrays errors hashtables io kernel lists -math namespaces opengl prettyprint sequences styles ; +USING: # alien arrays errors hashtables io kernel +kernel-internals lists math namespaces opengl prettyprint +sequences styles ; IN: freetype ! Memory management: freetype is allocated and freed by @@ -19,7 +20,7 @@ SYMBOL: open-fonts ] bind ; ! A sprite are a texture and display list. -TUPLE: sprite width height dlist texture ; +TUPLE: sprite dlist texture ; : free-dlists ( seq -- ) "Freeing display lists: " print . ; @@ -77,11 +78,13 @@ TUPLE: font height handle sprites metrics ; : dpi 100 ; -: font-units>pixels ( n font-size -- n ) - face-size-y-scale FT_MulFix fix>float ; +: fix>float 64 /f ; + +: font-units>pixels ( n font -- n ) + face-size face-size-y-scale FT_MulFix fix>float ; : init-font-height ( font -- ) - dup font-handle face-size + dup font-handle dup face-y-max over face-y-min - swap font-units>pixels swap set-font-height ; @@ -103,8 +106,6 @@ C: font ( handle -- font ) : load-glyph ( face char -- glyph ) dupd 0 FT_Load_Char freetype-error face-glyph ; -: fix>float 64 /f ; - : (char-size) ( font char -- dim ) >r font-handle r> load-glyph dup glyph-width fix>float @@ -122,31 +123,40 @@ C: font ( handle -- font ) load-glyph dup FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ; -: copy-row ( width texture bitmap row -- ) - #! Copy a row of the bitmap to the texture. - 2drop 2drop ; +: with-locked-block ( size quot -- | quot: address -- ) + swap malloc [ swap call ] keep free ; inline -: ( bitmap -- texture ) - dup glyph-bitmap-width next-power-of-2 - swap glyph-bitmap-rows next-power-of-2 * ; +: (copy-bitmap) ( bitmap-chase texture-chase width width-pow2 ) + >r 3dup swapd memcpy tuck >r >r + r> r> r> tuck >r >r + r> r> ; -: copy-glyph ( bitmap texture -- ) - #! Copy a bitmap into a texture whose width/height are - #! the width/height of the bitmap rounded up to the nearest - #! power of 2. - >r [ bitmap-width next-power-of-2 ] keep r> - over bitmap-rows [ >r 3dup r> copy-row ] each 3drop ; +: copy-bitmap ( glyph texture width-pow2 -- ) + pick glyph-bitmap-rows >r >r over glyph-bitmap-pitch >r >r + glyph-bitmap-buffer alien-address r> r> r> r> + [ (copy-bitmap) ] times 2drop 2drop ; -: glyph>texture ( bitmap -- texture ) - #! Given a glyph bitmap, copy it to a texture whose size is - #! a power of two. - dup [ copy-glyph ] keep ; +: bitmap>texture ( width height glyph -- id ) + #! Given a glyph bitmap, copy it to a texture with the given + #! width/height (which must be powers of two). + 3drop + 32 32 * 4 * [ + 32 32 * 4 * [ + 128 pick rot set-alien-signed-1 + ] each 32 32 rot gray-texture + ] with-locked-block ; -: ( font char -- sprite ) - 0 0 ; +: char-texture-size ( bitmap -- width height ) + dup glyph-bitmap-width swap glyph-bitmap-rows + [ next-power-of-2 ] 2apply ; + +: ( face char -- sprite ) + render-glyph [ char-texture-size 2dup ] keep + bitmap>texture [ texture>dlist ] keep ; : char-sprite ( open-font char -- sprite ) - over font-sprites [ dupd ] cache-nth nip ; + over font-sprites + [ >r dup font-handle r> ] cache-nth nip ; : draw-string ( font string -- ) - [ char-sprite drop ( sprite-dlist glCallList ) ] each-with ; + GL_TEXTURE_BIT [ + [ char-sprite sprite-dlist glCallList ] each-with + ] save-attribs ; diff --git a/library/freetype/freetype.factor b/library/freetype/freetype.factor index 67791a44bc..779bb231d6 100644 --- a/library/freetype/freetype.factor +++ b/library/freetype/freetype.factor @@ -32,17 +32,6 @@ TYPEDEF: long FT_F26Dot6 FUNCTION: FT_Error FT_Init_FreeType ( void* library ) ; -BEGIN-STRUCT: bitmap - FIELD: int rows - FIELD: int width - FIELD: int pitch - FIELD: uchar* buffer - FIELD: short num-grays - FIELD: char pixel-mode - FIELD: char palette-mode - FIELD: void* palette -END-STRUCT - ! circular reference between glyph and face TYPEDEF: void face TYPEDEF: void glyph diff --git a/library/freetype/load.factor b/library/freetype/load.factor index c42d11fc83..255644181e 100644 --- a/library/freetype/load.factor +++ b/library/freetype/load.factor @@ -1,5 +1,11 @@ -USING: io kernel parser sequences ; +USING: alien io kernel parser sequences ; +"freetype" @{ + @{ [ os "macosx" = ] [ "libfreetype.dylib" ] }@ + @{ [ os "win32" = ] [ "freetype.dll" ] }@ + @{ [ t ] [ "libfreetype.so" ] }@ +}@ cond "cdecl" add-library + [ "/library/freetype/freetype.factor" "/library/freetype/freetype-gl.factor" diff --git a/library/opengl/load.factor b/library/opengl/load.factor index 6a39f41aed..c35a36cd38 100644 --- a/library/opengl/load.factor +++ b/library/opengl/load.factor @@ -1,4 +1,16 @@ -USING: io kernel parser sequences ; +USING: alien io kernel parser sequences ; + +@{ + @{ [ os "macosx" = ] [ ] }@ + @{ [ os "win32" = ] [ + "gl" "opengl32.dll" "stdcall" add-library + "glu" "glu32.dll" "stdcall" add-library + ] }@ + @{ [ t ] [ + "gl" "libGL.so" "cdecl" add-library + "glu" "libGLU.so" "cdecl" add-library + ] }@ +}@ cond [ "/library/opengl/gl.factor" diff --git a/library/opengl/opengl-utils.factor b/library/opengl/opengl-utils.factor index 5f2abe2e7d..da725b0cac 100644 --- a/library/opengl/opengl-utils.factor +++ b/library/opengl/opengl-utils.factor @@ -4,7 +4,6 @@ IN: opengl USING: alien errors kernel math namespaces opengl sdl sequences ; : init-gl ( -- ) - GL_FLAT glShadeModel 0.0 0.0 0.0 0.0 glClearColor 1.0 0.0 0.0 glColor3d GL_COLOR_BUFFER_BIT glClear @@ -14,14 +13,8 @@ USING: alien errors kernel math namespaces opengl sdl sequences ; glLoadIdentity 0 0 width get height get glViewport 0 width get height get 0 gluOrtho2D - GL_SMOOTH glShadeModel ; - -: render ( -- ) - GL_TRIANGLES glBegin - 0.0 0.0 0.0 glVertex3f - 100.0 0.0 0.0 glVertex3f - 100.0 100.0 0.0 glVertex3f - glEnd ; + GL_SMOOTH glShadeModel + GL_TEXTURE_2D glEnable ; : gl-flags SDL_OPENGL SDL_RESIZABLE bitor SDL_HWSURFACE bitor SDL_DOUBLEBUF bitor ; @@ -34,10 +27,13 @@ USING: alien errors kernel math namespaces opengl sdl sequences ; : with-gl-screen ( quot -- ) >r 0 gl-flags r> with-screen ; +: gl-error ( -- ) + glGetError dup 0 = [ drop ] [ gluErrorString throw ] if ; + : with-gl-surface ( quot -- ) #! Execute a quotation, locking the current surface if it #! is required (eg, hardware surface). - [ init-gl call ] [ SDL_GL_SwapBuffers ] cleanup ; + [ init-gl call gl-error ] [ SDL_GL_SwapBuffers ] cleanup ; : do-state ( what quot -- ) swap glBegin call glEnd ; inline @@ -105,15 +101,22 @@ USING: alien errors kernel math namespaces opengl sdl sequences ; #! Generate texture ID. 1 0 [ glGenTextures ] keep *uint ; +: save-attribs ( bits quot -- ) + swap glPushAttrib call glPopAttrib ; inline + : gray-texture ( width height buffer -- id ) #! Given a buffer holding a width x height (powers of two) #! grayscale texture, bind it and return the ID. gen-texture [ - GL_TEXTURE_2D swap glBindTexture - GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri - GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri - >r >r >r GL_TEXTURE_2D 0 GL_RGBA r> r> 0 GL_ALPHA - GL_UNSIGNED_BYTE r> glTexImage2D + GL_TEXTURE_BIT [ + GL_TEXTURE_2D swap glBindTexture + GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameterf + GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameterf + >r >r >r GL_TEXTURE_2D 0 GL_RGBA r> r> 0 GL_RGBA + GL_UNSIGNED_BYTE r> glTexImage2D + ] save-attribs ] keep ; : gen-dlist ( -- id ) @@ -127,12 +130,16 @@ USING: alien errors kernel math namespaces opengl sdl sequences ; : texture>dlist ( width height id -- id ) #! Given a texture width/height and ID, make a display list #! for draws a quad with this texture. - GL_COMPILE [ - GL_TEXTURE_2D swap glBindTexture - GL_QUADS [ - 0 0 glTexCoord2d 0 over glVertex2i - 0 over glTexCoord2d 0 0 glVertex2i - 2dup glTexCoord2d over 0 glVertex2i - over 0 glTexCoord2d glVertex2i - ] do-state - ] make-dlist ; + GL_MODELVIEW [ + GL_COMPILE [ + 1 1 1 glColor3f + GL_TEXTURE_2D swap glBindTexture + GL_QUADS [ + 0 0 glTexCoord2d 0 0 glVertex2i + 0 1 glTexCoord2d 0 over glVertex2i + 1 1 glTexCoord2d 2dup glVertex2i + 1 0 glTexCoord2d over 0 glVertex2i + ] do-state + drop 0 0 glTranslatef + ] make-dlist + ] do-matrix ; diff --git a/library/sdl/load.factor b/library/sdl/load.factor index 78c4c54134..3b129582a8 100644 --- a/library/sdl/load.factor +++ b/library/sdl/load.factor @@ -1,4 +1,11 @@ -USING: kernel parser sequences io ; +USING: alien io kernel parser sequences ; + +@{ + @{ [ os "macosx" = ] [ ] }@ + @{ [ os "win32" = ] [ "sdl" "sdl.dll" "cdecl" add-library ] }@ + @{ [ t ] [ "sdl" "libSDL.so" "cdecl" add-library ] }@ +}@ cond + [ "/library/sdl/sdl.factor" "/library/sdl/sdl-video.factor" diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor index 5d60e6a9d6..27b9f6ff50 100644 --- a/library/test/compiler/intrinsics.factor +++ b/library/test/compiler/intrinsics.factor @@ -2,6 +2,9 @@ IN: temporary USING: arrays compiler kernel kernel-internals lists math math-internals sequences test words ; +! Oops! +[ 5000 ] [ [ 5000 ] compile-1 ] unit-test + ! Make sure that intrinsic ops compile to correct code. [ 1 ] [ [[ 1 2 ]] [ 0 slot ] compile-1 ] unit-test [ 1 ] [ [ [[ 1 2 ]] 0 slot ] compile-1 ] unit-test diff --git a/library/ui/labels.factor b/library/ui/labels.factor index 213a20e789..29afab0351 100644 --- a/library/ui/labels.factor +++ b/library/ui/labels.factor @@ -21,7 +21,7 @@ M: label pref-dim ( label -- dim ) label-size ; : draw-label ( label -- ) - dup label-text swap gadget-font draw-string ; + dup gadget-font swap label-text draw-string ; M: label draw-gadget* ( label -- ) dup delegate draw-gadget* draw-label ; diff --git a/library/unix/load.factor b/library/unix/load.factor new file mode 100644 index 0000000000..161a9c38a0 --- /dev/null +++ b/library/unix/load.factor @@ -0,0 +1,24 @@ +USING: io kernel parser sequences ; + +"/library/unix/types.factor" dup print run-resource + +os "freebsd" = [ + "/library/unix/syscalls-freebsd.factor" dup print run-resource +] when + +os "linux" = [ + "/library/unix/syscalls-linux.factor" dup print run-resource +] when + +os "macosx" = [ + "/library/unix/syscalls-macosx.factor" dup print run-resource +] when + +[ + "/library/unix/syscalls.factor" + "/library/unix/io.factor" + "/library/unix/sockets.factor" + "/library/unix/files.factor" +] [ + dup print run-resource +] each diff --git a/library/win32/load.factor b/library/win32/load.factor new file mode 100644 index 0000000000..6efef60298 --- /dev/null +++ b/library/win32/load.factor @@ -0,0 +1,20 @@ +USING: alien io kernel parser sequences ; + +"kernel32" "kernel32.dll" "stdcall" add-library +"user32" "user32.dll" "stdcall" add-library +"gdi32" "gdi32.dll" "stdcall" add-library +"winsock" "ws2_32.dll" "stdcall" add-library +"mswsock" "mswsock.dll" "stdcall" add-library +"libc" "msvcrt.dll" "cdecl" add-library + +[ + "/library/win32/win32-io.factor" + "/library/win32/win32-errors.factor" + "/library/win32/winsock.factor" + "/library/win32/win32-io-internals.factor" + "/library/win32/win32-stream.factor" + "/library/win32/win32-server.factor" + "/library/bootstrap/win32-io.factor" +] [ + dup print run-resource +] each