Merge branch 'master' into dcn
Slava Pestov
commit
4175585fd4
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
IN: byte-arrays.hex
|
||||
USING: byte-arrays help.markup help.syntax ;
|
||||
|
||||
HELP: HEX{
|
||||
{ $syntax "HEX{ 0123 45 67 89abcdef }" }
|
||||
{ $description "Constructs a " { $link byte-array } " from data specified in hexadecimal format. Whitespace between the curly braces is ignored." } ;
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
! Copyright (C) 2009 Joe Groff.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: grouping lexer ascii parser sequences kernel math.parser ;
|
||||
IN: byte-arrays.hex
|
||||
|
||||
SYNTAX: HEX{
|
||||
"}" parse-tokens "" join
|
||||
[ blank? not ] filter
|
||||
2 group [ hex> ] B{ } map-as
|
||||
parsed ;
|
||||
|
||||
|
|
@ -8,6 +8,32 @@ IN: cpu.x86.assembler.tests
|
|||
[ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
|
||||
[ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
|
||||
|
||||
! r-rm / m-r sse instruction
|
||||
[ { HEX: 0f HEX: 10 HEX: c1 } ] [ [ XMM0 XMM1 MOVUPS ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: 10 HEX: 01 } ] [ [ XMM0 ECX [] MOVUPS ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: 11 HEX: 08 } ] [ [ EAX [] XMM1 MOVUPS ] { } make ] unit-test
|
||||
|
||||
[ { HEX: f3 HEX: 0f HEX: 10 HEX: c1 } ] [ [ XMM0 XMM1 MOVSS ] { } make ] unit-test
|
||||
[ { HEX: f3 HEX: 0f HEX: 10 HEX: 01 } ] [ [ XMM0 ECX [] MOVSS ] { } make ] unit-test
|
||||
[ { HEX: f3 HEX: 0f HEX: 11 HEX: 08 } ] [ [ EAX [] XMM1 MOVSS ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 66 HEX: 0f HEX: 6f HEX: c1 } ] [ [ XMM0 XMM1 MOVDQA ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: 6f HEX: 01 } ] [ [ XMM0 ECX [] MOVDQA ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: 7f HEX: 08 } ] [ [ EAX [] XMM1 MOVDQA ] { } make ] unit-test
|
||||
|
||||
! r-rm only sse instruction
|
||||
[ { HEX: 66 HEX: 0f HEX: 2e HEX: c1 } ] [ [ XMM0 XMM1 UCOMISD ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: 2e HEX: 01 } ] [ [ XMM0 ECX [] UCOMISD ] { } make ] unit-test
|
||||
[ [ EAX [] XMM1 UCOMISD ] { } make ] must-fail
|
||||
|
||||
! rm-r only sse instructions
|
||||
[ { HEX: 0f HEX: 2b HEX: 08 } ] [ [ EAX [] XMM1 MOVNTPS ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: e7 HEX: 08 } ] [ [ EAX [] XMM1 MOVNTDQ ] { } make ] unit-test
|
||||
|
||||
! three-byte-opcode ssse3 instruction
|
||||
[ { HEX: 66 HEX: 0f HEX: 38 HEX: 02 HEX: c1 } ] [ [ XMM0 XMM1 PHADDD ] { } make ] unit-test
|
||||
|
||||
! int/sse conversion instruction
|
||||
[ { HEX: f2 HEX: 0f HEX: 2c HEX: c0 } ] [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test
|
||||
[ { HEX: f2 HEX: 48 HEX: 0f HEX: 2c HEX: c0 } ] [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test
|
||||
[ { HEX: f2 HEX: 4c HEX: 0f HEX: 2c HEX: e0 } ] [ [ R12 XMM0 CVTTSD2SI ] { } make ] unit-test
|
||||
|
|
@ -25,6 +51,32 @@ IN: cpu.x86.assembler.tests
|
|||
! [ { HEX: f2 HEX: 0f HEX: 11 HEX: 00 } ] [ [ RAX [] XMM0 MOVSD ] { } make ] unit-test
|
||||
! [ { HEX: f2 HEX: 41 HEX: 0f HEX: 11 HEX: 04 HEX: 24 } ] [ [ R12 [] XMM0 MOVSD ] { } make ] unit-test
|
||||
|
||||
! 3-operand r-rm-imm sse instructions
|
||||
[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: c6 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 2 SHUFPS ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: c4 HEX: c1 HEX: 02 } ] [ [ XMM0 ECX 2 PINSRW ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: c5 HEX: c1 HEX: 02 } ] [ [ EAX XMM1 2 PEXTRW ] { } make ] unit-test
|
||||
|
||||
! sse shift instructions
|
||||
[ { HEX: 66 HEX: 0f HEX: 71 HEX: d0 HEX: 05 } ] [ [ XMM0 5 PSRLW ] { } make ] unit-test
|
||||
|
||||
! sse comparison instructions
|
||||
[ { HEX: 66 HEX: 0f HEX: c2 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 CMPLEPD ] { } make ] unit-test
|
||||
|
||||
! unique sse instructions
|
||||
[ { HEX: 0f HEX: 18 HEX: 00 } ] [ [ EAX [] PREFETCHNTA ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: 18 HEX: 08 } ] [ [ EAX [] PREFETCHT0 ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: 18 HEX: 10 } ] [ [ EAX [] PREFETCHT1 ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: 18 HEX: 18 } ] [ [ EAX [] PREFETCHT2 ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: ae HEX: 10 } ] [ [ EAX [] LDMXCSR ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: ae HEX: 18 } ] [ [ EAX [] STMXCSR ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 0f HEX: c3 HEX: 08 } ] [ [ EAX [] ECX MOVNTI ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 0f HEX: 50 HEX: c1 } ] [ [ EAX XMM1 MOVMSKPS ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 0f HEX: 50 HEX: c1 } ] [ [ EAX XMM1 MOVMSKPD ] { } make ] unit-test
|
||||
|
||||
! memory address modes
|
||||
[ { HEX: 8a HEX: 18 } ] [ [ BL RAX [] MOV ] { } make ] unit-test
|
||||
[ { HEX: 66 HEX: 8b HEX: 18 } ] [ [ BX RAX [] MOV ] { } make ] unit-test
|
||||
[ { HEX: 8b HEX: 18 } ] [ [ EBX RAX [] MOV ] { } make ] unit-test
|
||||
|
|
@ -72,3 +124,4 @@ IN: cpu.x86.assembler.tests
|
|||
[ { HEX: 48 HEX: 69 HEX: c1 HEX: 44 HEX: 03 HEX: 00 HEX: 00 } ] [ [ RAX RCX HEX: 344 IMUL3 ] { } make ] unit-test
|
||||
|
||||
[ { 15 183 195 } ] [ [ EAX BX MOVZX ] { } make ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
USING: arrays io.binary kernel combinators kernel.private math
|
||||
namespaces make sequences words system layouts math.order accessors
|
||||
cpu.x86.assembler.syntax ;
|
||||
QUALIFIED: sequences
|
||||
IN: cpu.x86.assembler
|
||||
|
||||
! A postfix assembler for x86-32 and x86-64.
|
||||
|
|
@ -12,11 +13,16 @@ IN: cpu.x86.assembler
|
|||
! Beware!
|
||||
|
||||
! Register operands -- eg, ECX
|
||||
REGISTERS: 8 AL CL DL BL ;
|
||||
REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
|
||||
|
||||
REGISTERS: 16 AX CX DX BX SP BP SI DI ;
|
||||
ALIAS: AH SPL
|
||||
ALIAS: CH BPL
|
||||
ALIAS: DH SIL
|
||||
ALIAS: BH DIL
|
||||
|
||||
REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI ;
|
||||
REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
|
||||
|
||||
REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
|
||||
|
||||
REGISTERS: 64
|
||||
RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
|
||||
|
|
@ -214,6 +220,8 @@ M: object operand-64? drop f ;
|
|||
|
||||
: extended-opcode ( opcode -- opcode' ) OCT: 17 swap 2array ;
|
||||
|
||||
: ssse3-opcode ( opcode -- opcode' ) OCT: 17 sequences:prefix ;
|
||||
|
||||
: extended-opcode, ( opcode -- ) extended-opcode opcode, ;
|
||||
|
||||
: opcode-or ( opcode mask -- opcode' )
|
||||
|
|
@ -451,6 +459,9 @@ M: operand TEST OCT: 204 2-operand ;
|
|||
! Misc
|
||||
|
||||
: NOP ( -- ) HEX: 90 , ;
|
||||
: PAUSE ( -- ) HEX: f3 , HEX: 90 , ;
|
||||
|
||||
: RDPMC ( -- ) HEX: 0f , HEX: 33 , ;
|
||||
|
||||
! x87 Floating Point Unit
|
||||
|
||||
|
|
@ -468,26 +479,242 @@ M: operand TEST OCT: 204 2-operand ;
|
|||
pick register-128? [ swapd ] [ BIN: 1 bitor ] if ;
|
||||
|
||||
: 2-operand-sse ( dst src op1 op2 -- )
|
||||
, direction-bit-sse extended-opcode (2-operand) ;
|
||||
[ , ] when* direction-bit-sse extended-opcode (2-operand) ;
|
||||
|
||||
: direction-op-sse ( dst src op1s -- dst' src' op1' )
|
||||
pick register-128? [ swapd first ] [ second ] if ;
|
||||
|
||||
: 2-operand-rm-mr-sse ( dst src op1{rm,mr} op2 -- )
|
||||
[ , ] when* direction-op-sse extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-ssse3 ( dst src op1 op2 -- )
|
||||
[ , ] when* swapd ssse3-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-rm-sse ( dst src op1 op2 -- )
|
||||
[ , ] when* swapd extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-mr-sse ( dst src op1 op2 -- )
|
||||
[ , ] when* extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-int/sse ( dst src op1 op2 -- )
|
||||
, swapd extended-opcode (2-operand) ;
|
||||
[ , ] when* swapd extended-opcode (2-operand) ;
|
||||
|
||||
: 3-operand-sse ( dst src imm op1 op2 -- )
|
||||
rot [ 2-operand-rm-sse ] dip , ;
|
||||
|
||||
: 2-operand-sse-cmp ( dst src cmp op1 op2 -- )
|
||||
3-operand-sse ; inline
|
||||
|
||||
: 2-operand-sse-shift ( dst imm reg op1 op2 -- )
|
||||
[ , ] when*
|
||||
[ f HEX: 0f ] dip 2array 3array
|
||||
swapd 1-operand , ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: MOVSS ( dest src -- ) HEX: 10 HEX: f3 2-operand-sse ;
|
||||
: MOVSD ( dest src -- ) HEX: 10 HEX: f2 2-operand-sse ;
|
||||
: ADDSD ( dest src -- ) HEX: 58 HEX: f2 2-operand-sse ;
|
||||
: MULSD ( dest src -- ) HEX: 59 HEX: f2 2-operand-sse ;
|
||||
: SUBSD ( dest src -- ) HEX: 5c HEX: f2 2-operand-sse ;
|
||||
: DIVSD ( dest src -- ) HEX: 5e HEX: f2 2-operand-sse ;
|
||||
: SQRTSD ( dest src -- ) HEX: 51 HEX: f2 2-operand-sse ;
|
||||
: UCOMISD ( dest src -- ) HEX: 2e HEX: 66 2-operand-sse ;
|
||||
: COMISD ( dest src -- ) HEX: 2f HEX: 66 2-operand-sse ;
|
||||
: MOVUPS ( dest src -- ) HEX: 10 f 2-operand-sse ;
|
||||
: MOVUPD ( dest src -- ) HEX: 10 HEX: 66 2-operand-sse ;
|
||||
: MOVSD ( dest src -- ) HEX: 10 HEX: f2 2-operand-sse ;
|
||||
: MOVSS ( dest src -- ) HEX: 10 HEX: f3 2-operand-sse ;
|
||||
: MOVLPS ( dest src -- ) HEX: 12 f 2-operand-sse ;
|
||||
: MOVLPD ( dest src -- ) HEX: 12 HEX: 66 2-operand-sse ;
|
||||
: MOVDDUP ( dest src -- ) HEX: 12 HEX: f2 2-operand-rm-sse ;
|
||||
: MOVSLDUP ( dest src -- ) HEX: 12 HEX: f3 2-operand-rm-sse ;
|
||||
: UNPCKLPS ( dest src -- ) HEX: 14 f 2-operand-rm-sse ;
|
||||
: UNPCKLPD ( dest src -- ) HEX: 14 HEX: 66 2-operand-rm-sse ;
|
||||
: UNPCKHPS ( dest src -- ) HEX: 15 f 2-operand-rm-sse ;
|
||||
: UNPCKHPD ( dest src -- ) HEX: 15 HEX: 66 2-operand-rm-sse ;
|
||||
: MOVHPS ( dest src -- ) HEX: 16 f 2-operand-sse ;
|
||||
: MOVHPD ( dest src -- ) HEX: 16 HEX: 66 2-operand-sse ;
|
||||
: MOVSHDUP ( dest src -- ) HEX: 16 HEX: f3 2-operand-rm-sse ;
|
||||
|
||||
: CVTSS2SD ( dest src -- ) HEX: 5a HEX: f3 2-operand-sse ;
|
||||
: CVTSD2SS ( dest src -- ) HEX: 5a HEX: f2 2-operand-sse ;
|
||||
: PREFETCHNTA ( mem -- ) { BIN: 000 f { HEX: 0f HEX: 18 } } 1-operand ;
|
||||
: PREFETCHT0 ( mem -- ) { BIN: 001 f { HEX: 0f HEX: 18 } } 1-operand ;
|
||||
: PREFETCHT1 ( mem -- ) { BIN: 010 f { HEX: 0f HEX: 18 } } 1-operand ;
|
||||
: PREFETCHT2 ( mem -- ) { BIN: 011 f { HEX: 0f HEX: 18 } } 1-operand ;
|
||||
|
||||
: MOVAPS ( dest src -- ) HEX: 28 f 2-operand-sse ;
|
||||
: MOVAPD ( dest src -- ) HEX: 28 HEX: 66 2-operand-sse ;
|
||||
: CVTSI2SD ( dest src -- ) HEX: 2a HEX: f2 2-operand-int/sse ;
|
||||
: CVTSI2SS ( dest src -- ) HEX: 2a HEX: f3 2-operand-int/sse ;
|
||||
: MOVNTPS ( dest src -- ) HEX: 2b f 2-operand-mr-sse ;
|
||||
: MOVNTPD ( dest src -- ) HEX: 2b HEX: 66 2-operand-mr-sse ;
|
||||
: CVTTSD2SI ( dest src -- ) HEX: 2c HEX: f2 2-operand-int/sse ;
|
||||
: CVTTSS2SI ( dest src -- ) HEX: 2c HEX: f3 2-operand-int/sse ;
|
||||
: CVTSD2SI ( dest src -- ) HEX: 2d HEX: f2 2-operand-int/sse ;
|
||||
: CVTSS2SI ( dest src -- ) HEX: 2d HEX: f3 2-operand-int/sse ;
|
||||
: UCOMISS ( dest src -- ) HEX: 2e f 2-operand-rm-sse ;
|
||||
: UCOMISD ( dest src -- ) HEX: 2e HEX: 66 2-operand-rm-sse ;
|
||||
: COMISS ( dest src -- ) HEX: 2f f 2-operand-rm-sse ;
|
||||
: COMISD ( dest src -- ) HEX: 2f HEX: 66 2-operand-rm-sse ;
|
||||
: PSHUFB ( dest src -- ) { HEX: 38 HEX: 00 } HEX: 66 2-operand-ssse3 ;
|
||||
: PHADDW ( dest src -- ) { HEX: 38 HEX: 01 } HEX: 66 2-operand-ssse3 ;
|
||||
: PHADDD ( dest src -- ) { HEX: 38 HEX: 02 } HEX: 66 2-operand-ssse3 ;
|
||||
: PHADDSW ( dest src -- ) { HEX: 38 HEX: 03 } HEX: 66 2-operand-ssse3 ;
|
||||
: PMADDUBSW ( dest src -- ) { HEX: 38 HEX: 04 } HEX: 66 2-operand-ssse3 ;
|
||||
: PHSUBW ( dest src -- ) { HEX: 38 HEX: 05 } HEX: 66 2-operand-ssse3 ;
|
||||
: PHSUBD ( dest src -- ) { HEX: 38 HEX: 06 } HEX: 66 2-operand-ssse3 ;
|
||||
: PHSUBSW ( dest src -- ) { HEX: 38 HEX: 07 } HEX: 66 2-operand-ssse3 ;
|
||||
: PSIGNB ( dest src -- ) { HEX: 38 HEX: 08 } HEX: 66 2-operand-ssse3 ;
|
||||
: PSIGNW ( dest src -- ) { HEX: 38 HEX: 09 } HEX: 66 2-operand-ssse3 ;
|
||||
: PSIGND ( dest src -- ) { HEX: 38 HEX: 0A } HEX: 66 2-operand-ssse3 ;
|
||||
: PMULHRSW ( dest src -- ) { HEX: 38 HEX: 0B } HEX: 66 2-operand-ssse3 ;
|
||||
: PABSB ( dest src -- ) { HEX: 38 HEX: 1C } HEX: 66 2-operand-ssse3 ;
|
||||
: PABSW ( dest src -- ) { HEX: 38 HEX: 1D } HEX: 66 2-operand-ssse3 ;
|
||||
: PABSD ( dest src -- ) { HEX: 38 HEX: 1E } HEX: 66 2-operand-ssse3 ;
|
||||
: PALIGNR ( dest src -- ) { HEX: 3A HEX: 0F } HEX: 66 2-operand-ssse3 ;
|
||||
: MOVMSKPS ( dest src -- ) HEX: 50 f 2-operand-int/sse ;
|
||||
: MOVMSKPD ( dest src -- ) HEX: 50 HEX: 66 2-operand-int/sse ;
|
||||
: SQRTPS ( dest src -- ) HEX: 51 f 2-operand-rm-sse ;
|
||||
: SQRTPD ( dest src -- ) HEX: 51 HEX: 66 2-operand-rm-sse ;
|
||||
: SQRTSD ( dest src -- ) HEX: 51 HEX: f2 2-operand-rm-sse ;
|
||||
: SQRTSS ( dest src -- ) HEX: 51 HEX: f3 2-operand-rm-sse ;
|
||||
: RSQRTPS ( dest src -- ) HEX: 52 f 2-operand-rm-sse ;
|
||||
: RSQRTSS ( dest src -- ) HEX: 52 HEX: f3 2-operand-rm-sse ;
|
||||
: RCPPS ( dest src -- ) HEX: 53 f 2-operand-rm-sse ;
|
||||
: RCPSS ( dest src -- ) HEX: 53 HEX: f3 2-operand-rm-sse ;
|
||||
: ANDPS ( dest src -- ) HEX: 54 f 2-operand-rm-sse ;
|
||||
: ANDPD ( dest src -- ) HEX: 54 HEX: 66 2-operand-rm-sse ;
|
||||
: ANDNPS ( dest src -- ) HEX: 55 f 2-operand-rm-sse ;
|
||||
: ANDNPD ( dest src -- ) HEX: 55 HEX: 66 2-operand-rm-sse ;
|
||||
: ORPS ( dest src -- ) HEX: 56 f 2-operand-rm-sse ;
|
||||
: ORPD ( dest src -- ) HEX: 56 HEX: 66 2-operand-rm-sse ;
|
||||
: XORPS ( dest src -- ) HEX: 57 f 2-operand-rm-sse ;
|
||||
: XORPD ( dest src -- ) HEX: 57 HEX: 66 2-operand-rm-sse ;
|
||||
: ADDPS ( dest src -- ) HEX: 58 f 2-operand-rm-sse ;
|
||||
: ADDPD ( dest src -- ) HEX: 58 HEX: 66 2-operand-rm-sse ;
|
||||
: ADDSD ( dest src -- ) HEX: 58 HEX: f2 2-operand-rm-sse ;
|
||||
: ADDSS ( dest src -- ) HEX: 58 HEX: f3 2-operand-rm-sse ;
|
||||
: MULPS ( dest src -- ) HEX: 59 f 2-operand-rm-sse ;
|
||||
: MULPD ( dest src -- ) HEX: 59 HEX: 66 2-operand-rm-sse ;
|
||||
: MULSD ( dest src -- ) HEX: 59 HEX: f2 2-operand-rm-sse ;
|
||||
: MULSS ( dest src -- ) HEX: 59 HEX: f3 2-operand-rm-sse ;
|
||||
: CVTPS2PD ( dest src -- ) HEX: 5a f 2-operand-rm-sse ;
|
||||
: CVTPD2PS ( dest src -- ) HEX: 5a HEX: 66 2-operand-rm-sse ;
|
||||
: CVTSD2SS ( dest src -- ) HEX: 5a HEX: f2 2-operand-rm-sse ;
|
||||
: CVTSS2SD ( dest src -- ) HEX: 5a HEX: f3 2-operand-rm-sse ;
|
||||
: CVTDQ2PS ( dest src -- ) HEX: 5b f 2-operand-rm-sse ;
|
||||
: CVTPS2DQ ( dest src -- ) HEX: 5b HEX: 66 2-operand-rm-sse ;
|
||||
: CVTTPS2DQ ( dest src -- ) HEX: 5b HEX: f3 2-operand-rm-sse ;
|
||||
: SUBPS ( dest src -- ) HEX: 5c f 2-operand-rm-sse ;
|
||||
: SUBPD ( dest src -- ) HEX: 5c HEX: 66 2-operand-rm-sse ;
|
||||
: SUBSD ( dest src -- ) HEX: 5c HEX: f2 2-operand-rm-sse ;
|
||||
: SUBSS ( dest src -- ) HEX: 5c HEX: f3 2-operand-rm-sse ;
|
||||
: MINPS ( dest src -- ) HEX: 5d f 2-operand-rm-sse ;
|
||||
: MINPD ( dest src -- ) HEX: 5d HEX: 66 2-operand-rm-sse ;
|
||||
: MINSD ( dest src -- ) HEX: 5d HEX: f2 2-operand-rm-sse ;
|
||||
: MINSS ( dest src -- ) HEX: 5d HEX: f3 2-operand-rm-sse ;
|
||||
: DIVPS ( dest src -- ) HEX: 5e f 2-operand-rm-sse ;
|
||||
: DIVPD ( dest src -- ) HEX: 5e HEX: 66 2-operand-rm-sse ;
|
||||
: DIVSD ( dest src -- ) HEX: 5e HEX: f2 2-operand-rm-sse ;
|
||||
: DIVSS ( dest src -- ) HEX: 5e HEX: f3 2-operand-rm-sse ;
|
||||
: MAXPS ( dest src -- ) HEX: 5f f 2-operand-rm-sse ;
|
||||
: MAXPD ( dest src -- ) HEX: 5f HEX: 66 2-operand-rm-sse ;
|
||||
: MAXSD ( dest src -- ) HEX: 5f HEX: f2 2-operand-rm-sse ;
|
||||
: MAXSS ( dest src -- ) HEX: 5f HEX: f3 2-operand-rm-sse ;
|
||||
: PUNPCKLQDQ ( dest src -- ) HEX: 6c HEX: 66 2-operand-rm-sse ;
|
||||
: PUNPCKHQDQ ( dest src -- ) HEX: 6d HEX: 66 2-operand-rm-sse ;
|
||||
|
||||
: MOVDQA ( dest src -- ) { HEX: 6f HEX: 7f } HEX: 66 2-operand-rm-mr-sse ;
|
||||
: MOVDQU ( dest src -- ) { HEX: 6f HEX: 7f } HEX: f3 2-operand-rm-mr-sse ;
|
||||
|
||||
: PSHUFD ( dest src imm -- ) HEX: 70 HEX: 66 3-operand-sse ;
|
||||
: PSHUFLW ( dest src imm -- ) HEX: 70 HEX: f2 3-operand-sse ;
|
||||
: PSHUFHW ( dest src imm -- ) HEX: 70 HEX: f3 3-operand-sse ;
|
||||
: PSRLW ( dest imm -- ) BIN: 010 HEX: 71 HEX: 66 2-operand-sse-shift ;
|
||||
: PSRAW ( dest imm -- ) BIN: 100 HEX: 71 HEX: 66 2-operand-sse-shift ;
|
||||
: PSLLW ( dest imm -- ) BIN: 110 HEX: 71 HEX: 66 2-operand-sse-shift ;
|
||||
: PSRLD ( dest imm -- ) BIN: 010 HEX: 72 HEX: 66 2-operand-sse-shift ;
|
||||
: PSRAD ( dest imm -- ) BIN: 100 HEX: 72 HEX: 66 2-operand-sse-shift ;
|
||||
: PSLLD ( dest imm -- ) BIN: 110 HEX: 72 HEX: 66 2-operand-sse-shift ;
|
||||
: PSRLQ ( dest imm -- ) BIN: 010 HEX: 73 HEX: 66 2-operand-sse-shift ;
|
||||
: PSRLDQ ( dest imm -- ) BIN: 011 HEX: 73 HEX: 66 2-operand-sse-shift ;
|
||||
: PSLLQ ( dest imm -- ) BIN: 110 HEX: 73 HEX: 66 2-operand-sse-shift ;
|
||||
: PSLLDQ ( dest imm -- ) BIN: 111 HEX: 73 HEX: 66 2-operand-sse-shift ;
|
||||
|
||||
: PCMPEQB ( dest src -- ) HEX: 74 HEX: 66 2-operand-rm-sse ;
|
||||
: PCMPEQW ( dest src -- ) HEX: 75 HEX: 66 2-operand-rm-sse ;
|
||||
: PCMPEQD ( dest src -- ) HEX: 76 HEX: 66 2-operand-rm-sse ;
|
||||
: HADDPD ( dest src -- ) HEX: 7c HEX: 66 2-operand-rm-sse ;
|
||||
: HADDPS ( dest src -- ) HEX: 7c HEX: f2 2-operand-rm-sse ;
|
||||
: HSUBPD ( dest src -- ) HEX: 7d HEX: 66 2-operand-rm-sse ;
|
||||
: HSUBPS ( dest src -- ) HEX: 7d HEX: f2 2-operand-rm-sse ;
|
||||
|
||||
: LDMXCSR ( src -- ) { BIN: 010 f { HEX: 0f HEX: ae } } 1-operand ;
|
||||
: STMXCSR ( dest -- ) { BIN: 011 f { HEX: 0f HEX: ae } } 1-operand ;
|
||||
: LFENCE ( -- ) HEX: 0f , HEX: ae , OCT: 350 , ;
|
||||
: MFENCE ( -- ) HEX: 0f , HEX: ae , OCT: 360 , ;
|
||||
: SFENCE ( -- ) HEX: 0f , HEX: ae , OCT: 370 , ;
|
||||
|
||||
: CMPEQPS ( dest src -- ) 0 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPLTPS ( dest src -- ) 1 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPLEPS ( dest src -- ) 2 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPUNORDPS ( dest src -- ) 3 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPNEQPS ( dest src -- ) 4 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPNLTPS ( dest src -- ) 5 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPNLEPS ( dest src -- ) 6 HEX: c2 f 2-operand-sse-cmp ;
|
||||
: CMPORDPS ( dest src -- ) 7 HEX: c2 f 2-operand-sse-cmp ;
|
||||
|
||||
: CMPEQPD ( dest src -- ) 0 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPLTPD ( dest src -- ) 1 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPLEPD ( dest src -- ) 2 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPUNORDPD ( dest src -- ) 3 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPNEQPD ( dest src -- ) 4 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPNLTPD ( dest src -- ) 5 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPNLEPD ( dest src -- ) 6 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
: CMPORDPD ( dest src -- ) 7 HEX: c2 HEX: 66 2-operand-sse-cmp ;
|
||||
|
||||
: CMPEQSD ( dest src -- ) 0 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPLTSD ( dest src -- ) 1 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPLESD ( dest src -- ) 2 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPUNORDSD ( dest src -- ) 3 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPNEQSD ( dest src -- ) 4 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPNLTSD ( dest src -- ) 5 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPNLESD ( dest src -- ) 6 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
: CMPORDSD ( dest src -- ) 7 HEX: c2 HEX: f2 2-operand-sse-cmp ;
|
||||
|
||||
: CMPEQSS ( dest src -- ) 0 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPLTSS ( dest src -- ) 1 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPLESS ( dest src -- ) 2 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPUNORDSS ( dest src -- ) 3 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPNEQSS ( dest src -- ) 4 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPNLTSS ( dest src -- ) 5 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPNLESS ( dest src -- ) 6 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPORDSS ( dest src -- ) 7 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
|
||||
: MOVNTI ( dest src -- ) { HEX: 0f HEX: c3 } (2-operand) ;
|
||||
|
||||
: PINSRW ( dest src imm -- ) HEX: c4 HEX: 66 3-operand-sse ;
|
||||
: PEXTRW ( dest src imm -- ) HEX: c5 HEX: 66 3-operand-sse ;
|
||||
: SHUFPS ( dest src imm -- ) HEX: c6 f 3-operand-sse ;
|
||||
: SHUFPD ( dest src imm -- ) HEX: c6 HEX: 66 3-operand-sse ;
|
||||
|
||||
: ADDSUBPD ( dest src -- ) HEX: d0 HEX: 66 2-operand-rm-sse ;
|
||||
: ADDSUBPS ( dest src -- ) HEX: d0 HEX: f2 2-operand-rm-sse ;
|
||||
: PADDQ ( dest src -- ) HEX: d4 HEX: 66 2-operand-rm-sse ;
|
||||
: PMINUB ( dest src -- ) HEX: da HEX: 66 2-operand-rm-sse ;
|
||||
: PMAXUB ( dest src -- ) HEX: de HEX: 66 2-operand-rm-sse ;
|
||||
: PAVGB ( dest src -- ) HEX: e0 HEX: 66 2-operand-rm-sse ;
|
||||
: PAVGW ( dest src -- ) HEX: e3 HEX: 66 2-operand-rm-sse ;
|
||||
: PMULHUW ( dest src -- ) HEX: e4 HEX: 66 2-operand-rm-sse ;
|
||||
: CVTTPD2DQ ( dest src -- ) HEX: e6 HEX: 66 2-operand-rm-sse ;
|
||||
: CVTPD2DQ ( dest src -- ) HEX: e6 HEX: f2 2-operand-rm-sse ;
|
||||
: CVTDQ2PD ( dest src -- ) HEX: e6 HEX: f3 2-operand-rm-sse ;
|
||||
|
||||
: MOVNTDQ ( dest src -- ) HEX: e7 HEX: 66 2-operand-mr-sse ;
|
||||
|
||||
: PMINSW ( dest src -- ) HEX: ea HEX: 66 2-operand-rm-sse ;
|
||||
: PMAXSW ( dest src -- ) HEX: ee HEX: 66 2-operand-rm-sse ;
|
||||
: LDDQU ( dest src -- ) HEX: f0 HEX: f2 2-operand-rm-sse ;
|
||||
: PMULUDQ ( dest src -- ) HEX: f4 HEX: 66 2-operand-rm-sse ;
|
||||
: PSADBW ( dest src -- ) HEX: f6 HEX: 66 2-operand-rm-sse ;
|
||||
|
||||
: MASKMOVDQU ( dest src -- ) HEX: f7 HEX: 66 2-operand-rm-sse ;
|
||||
|
||||
: PSUBQ ( dest src -- ) HEX: fb HEX: 66 2-operand-rm-sse ;
|
||||
|
||||
! x86-64 branch prediction hints
|
||||
|
||||
: HWNT ( -- ) HEX: 2e , ; ! Hint branch Weakly Not Taken
|
||||
: HST ( -- ) HEX: 3e , ; ! Hint branch Strongly Taken
|
||||
|
||||
: CVTSI2SD ( dest src -- ) HEX: 2a HEX: f2 2-operand-int/sse ;
|
||||
: CVTSD2SI ( dest src -- ) HEX: 2d HEX: f2 2-operand-int/sse ;
|
||||
: CVTTSD2SI ( dest src -- ) HEX: 2c HEX: f2 2-operand-int/sse ;
|
||||
|
|
|
|||
|
|
@ -61,22 +61,18 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
|
|||
|
||||
! Programs
|
||||
|
||||
: <mrt-gl-program> ( shaders frag-data-locations -- program )
|
||||
: (gl-program) ( shaders quot: ( gl-program -- ) -- program )
|
||||
glCreateProgram
|
||||
[
|
||||
[ swap [ glAttachShader ] with each ]
|
||||
[ swap [ first2 swap glBindFragDataLocation ] with each ] bi-curry bi*
|
||||
]
|
||||
[ glLinkProgram ]
|
||||
[ ] tri
|
||||
gl-error ;
|
||||
[ swap call ] bi-curry bi*
|
||||
] [ glLinkProgram ] [ ] tri gl-error ; inline
|
||||
|
||||
: <mrt-gl-program> ( shaders frag-data-locations -- program )
|
||||
[ [ first2 swap glBindFragDataLocation ] with each ] curry (gl-program) ;
|
||||
|
||||
: <gl-program> ( shaders -- program )
|
||||
glCreateProgram
|
||||
[ swap [ glAttachShader ] with each ]
|
||||
[ glLinkProgram ]
|
||||
[ ] tri
|
||||
gl-error ;
|
||||
[ drop ] (gl-program) ;
|
||||
|
||||
: (gl-program?) ( object -- ? )
|
||||
dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tr arrays sequences io words generic system combinators
|
||||
vocabs.loader kernel ;
|
||||
USING: alien alien.c-types arrays byte-arrays combinators
|
||||
destructors generic io kernel libc math sequences system tr
|
||||
vocabs.loader words ;
|
||||
IN: tools.disassembler
|
||||
|
||||
GENERIC: disassemble ( obj -- )
|
||||
|
|
@ -12,6 +13,13 @@ HOOK: disassemble* disassembler-backend ( from to -- lines )
|
|||
|
||||
TR: tabs>spaces "\t" "\s" ;
|
||||
|
||||
M: byte-array disassemble
|
||||
[
|
||||
[ malloc-byte-array &free alien-address dup ]
|
||||
[ length + ] bi
|
||||
2array disassemble
|
||||
] with-destructors ;
|
||||
|
||||
M: pair disassemble first2 disassemble* [ tabs>spaces print ] each ;
|
||||
|
||||
M: word disassemble word-xt 2array disassemble ;
|
||||
|
|
|
|||
|
|
@ -10,6 +10,13 @@ HELP: <buffer-ptr>
|
|||
}
|
||||
{ $description "Constructs a " { $link buffer-ptr } " tuple." } ;
|
||||
|
||||
HELP: <buffer-range>
|
||||
{ $values
|
||||
{ "buffer" buffer } { "offset" integer } { "size" integer }
|
||||
{ "buffer-range" buffer-range }
|
||||
}
|
||||
{ $description "Constructs a " { $link buffer-range } " tuple." } ;
|
||||
|
||||
HELP: <buffer>
|
||||
{ $values
|
||||
{ "upload" buffer-upload-pattern }
|
||||
|
|
@ -52,6 +59,7 @@ HELP: buffer-kind
|
|||
{ "An " { $link index-buffer } " is used to store indexes into a vertex array." }
|
||||
{ "A " { $link pixel-unpack-buffer } " is used as a source for updating texture image data." }
|
||||
{ "A " { $link pixel-pack-buffer } " is used as a destination for reading texture or framebuffer image data." }
|
||||
{ "A " { $link transform-feedback-buffer } " is used as a destination for transform feedback output from a vertex shader." }
|
||||
} }
|
||||
{ $notes "The " { $snippet "pixel-unpack-buffer" } " and " { $snippet "pixel-pack-buffer" } " kinds require OpenGL 2.1 or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
|
||||
|
||||
|
|
@ -62,6 +70,30 @@ HELP: buffer-ptr
|
|||
{ { $snippet "offset" } " is an integer offset from the beginning of the buffer." }
|
||||
} } ;
|
||||
|
||||
HELP: buffer-ptr>range
|
||||
{ $values
|
||||
{ "buffer-ptr" buffer-ptr }
|
||||
{ "buffer-range" buffer-range }
|
||||
}
|
||||
{ $description "Converts a " { $link buffer-ptr } " into a " { $link buffer-range } " spanning from the " { $snippet "offset" } " referenced by the " { $snippet "buffer-ptr" } " to the end of the underlying " { $link buffer } "." } ;
|
||||
|
||||
HELP: buffer-range
|
||||
{ $class-description "A " { $snippet "buffer-range" } " references a subset of a " { $link buffer } " object's memory. " { $snippet "buffer-range" } "s are tuples with the following slots:"
|
||||
{ $list
|
||||
{ { $snippet "buffer" } " is the " { $link buffer } " object being referenced." }
|
||||
{ { $snippet "offset" } " is an integer offset from the beginning of the buffer to the beginning of the referenced range." }
|
||||
{ { $snippet "size" } " is the integer length from the beginning offset to the end of the referenced range." }
|
||||
} } ;
|
||||
|
||||
{ buffer-ptr buffer-range } related-words
|
||||
|
||||
HELP: buffer-size
|
||||
{ $values
|
||||
{ "buffer" buffer }
|
||||
{ "size" integer }
|
||||
}
|
||||
{ $description "Returns the size in bytes of the memory currently allocated for a " { $link buffer } " object." } ;
|
||||
|
||||
HELP: buffer-upload-pattern
|
||||
{ $class-description { $snippet "buffer-upload-pattern" } " values aid the graphics driver in optimizing access to " { $link buffer } " objects by declaring the frequency with which the buffer will be supplied new data."
|
||||
{ $list
|
||||
|
|
@ -148,6 +180,10 @@ HELP: stream-upload
|
|||
|
||||
{ dynamic-upload static-upload stream-upload } related-words
|
||||
|
||||
HELP: transform-feedback-buffer
|
||||
{ $class-description "This " { $link buffer-kind } " declares that a " { $link buffer } "'s primary use will be to receive transform feedback output from a render job." }
|
||||
{ $notes "Transform feedback requires OpenGL 3.0 or one of the " { $snippet "GL_EXT_transform_feedback" } " or " { $snippet "GL_ARB_transform_feedback" } " extensions." } ;
|
||||
|
||||
HELP: update-buffer
|
||||
{ $values
|
||||
{ "buffer-ptr" buffer-ptr } { "size" integer } { "data" { $maybe c-ptr } }
|
||||
|
|
@ -157,7 +193,7 @@ HELP: update-buffer
|
|||
HELP: vertex-buffer
|
||||
{ $class-description "This " { $link buffer-kind } " declares that a " { $link buffer } "'s primary use will be to provide vertex attribute information to a vertex array." } ;
|
||||
|
||||
{ index-buffer pixel-pack-buffer pixel-unpack-buffer vertex-buffer } related-words
|
||||
{ index-buffer pixel-pack-buffer pixel-unpack-buffer vertex-buffer transform-feedback-buffer } related-words
|
||||
|
||||
HELP: with-mapped-buffer
|
||||
{ $values
|
||||
|
|
@ -165,7 +201,7 @@ HELP: with-mapped-buffer
|
|||
}
|
||||
{ $description "Maps " { $snippet "buffer" } " into CPU address space with " { $snippet "access" } " for the dynamic extent of " { $snippet "quot" } ". " { $snippet "quot" } " is called with a pointer to the mapped memory on top of the stack." } ;
|
||||
|
||||
{ allocate-buffer update-buffer read-buffer copy-buffer with-mapped-buffer } related-words
|
||||
{ allocate-buffer buffer-size update-buffer read-buffer copy-buffer with-mapped-buffer } related-words
|
||||
|
||||
HELP: write-access
|
||||
{ $class-description "This " { $link buffer-access-mode } " value requests write-only access when mapping a buffer object through " { $link with-mapped-buffer } "." } ;
|
||||
|
|
@ -183,6 +219,7 @@ ARTICLE: "gpu.buffers" "Buffer objects"
|
|||
{ $subsection buffer-usage-pattern }
|
||||
"Referencing buffer data:"
|
||||
{ $subsection buffer-ptr }
|
||||
{ $subsection buffer-range }
|
||||
"Manipulating buffer data:"
|
||||
{ $subsection allocate-buffer }
|
||||
{ $subsection update-buffer }
|
||||
|
|
|
|||
|
|
@ -15,7 +15,8 @@ VARIANT: buffer-access-mode
|
|||
|
||||
VARIANT: buffer-kind
|
||||
vertex-buffer index-buffer
|
||||
pixel-unpack-buffer pixel-pack-buffer ;
|
||||
pixel-unpack-buffer pixel-pack-buffer
|
||||
transform-feedback-buffer ;
|
||||
|
||||
TUPLE: buffer < gpu-object
|
||||
{ upload-pattern buffer-upload-pattern }
|
||||
|
|
@ -52,8 +53,15 @@ TUPLE: buffer < gpu-object
|
|||
{ index-buffer [ GL_ELEMENT_ARRAY_BUFFER ] }
|
||||
{ pixel-unpack-buffer [ GL_PIXEL_UNPACK_BUFFER ] }
|
||||
{ pixel-pack-buffer [ GL_PIXEL_PACK_BUFFER ] }
|
||||
{ transform-feedback-buffer [ GL_TRANSFORM_FEEDBACK_BUFFER ] }
|
||||
} case ; inline
|
||||
|
||||
: get-buffer-int ( target enum -- value )
|
||||
0 <int> [ glGetBufferParameteriv ] keep *int ;
|
||||
|
||||
: bind-buffer ( buffer -- target )
|
||||
[ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: buffer dispose
|
||||
|
|
@ -64,11 +72,22 @@ TUPLE: buffer-ptr
|
|||
{ offset integer read-only } ;
|
||||
C: <buffer-ptr> buffer-ptr
|
||||
|
||||
TUPLE: buffer-range < buffer-ptr
|
||||
{ size integer read-only } ;
|
||||
C: <buffer-range> buffer-range
|
||||
|
||||
UNION: gpu-data-ptr buffer-ptr c-ptr ;
|
||||
|
||||
: buffer-size ( buffer -- size )
|
||||
bind-buffer GL_BUFFER_SIZE get-buffer-int ;
|
||||
|
||||
: buffer-ptr>range ( buffer-ptr -- buffer-range )
|
||||
[ buffer>> ] [ offset>> ] bi
|
||||
2dup [ buffer-size ] dip -
|
||||
buffer-range boa ; inline
|
||||
|
||||
:: allocate-buffer ( buffer size initial-data -- )
|
||||
buffer kind>> gl-target :> target
|
||||
target buffer handle>> glBindBuffer
|
||||
buffer bind-buffer :> target
|
||||
target size initial-data buffer gl-buffer-usage glBufferData ;
|
||||
|
||||
: <buffer> ( upload usage kind size initial-data -- buffer )
|
||||
|
|
@ -81,15 +100,13 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
|
|||
|
||||
:: update-buffer ( buffer-ptr size data -- )
|
||||
buffer-ptr buffer>> :> buffer
|
||||
buffer kind>> gl-target :> target
|
||||
target buffer handle>> glBindBuffer
|
||||
buffer bind-buffer :> target
|
||||
target buffer-ptr offset>> size data glBufferSubData ;
|
||||
|
||||
:: read-buffer ( buffer-ptr size -- data )
|
||||
buffer-ptr buffer>> :> buffer
|
||||
buffer kind>> gl-target :> target
|
||||
buffer bind-buffer :> target
|
||||
size <byte-array> :> data
|
||||
target buffer handle>> glBindBuffer
|
||||
target buffer-ptr offset>> size data glGetBufferSubData
|
||||
data ;
|
||||
|
||||
|
|
@ -102,9 +119,7 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
|
|||
size glCopyBufferSubData ;
|
||||
|
||||
:: with-mapped-buffer ( buffer access quot: ( alien -- ) -- )
|
||||
buffer kind>> gl-target :> target
|
||||
|
||||
target buffer handle>> glBindBuffer
|
||||
buffer bind-buffer :> target
|
||||
target access gl-access glMapBuffer
|
||||
|
||||
quot call
|
||||
|
|
|
|||
|
|
@ -34,13 +34,6 @@ HELP: <multi-index-range>
|
|||
}
|
||||
{ $description "Constructs a " { $link multi-index-range } " tuple." } ;
|
||||
|
||||
HELP: <vertex-array>
|
||||
{ $values
|
||||
{ "program-instance" program-instance } { "vertex-formats" "a list of " { $link buffer-ptr } "/" { $link vertex-format } " pairs" }
|
||||
{ "vertex-array" vertex-array }
|
||||
}
|
||||
{ $description "Creates a new " { $link vertex-array } " to feed data to " { $snippet "program-instance" } " from the set of " { $link buffer } "s specified in " { $snippet "vertex-formats" } "." } ;
|
||||
|
||||
HELP: UNIFORM-TUPLE:
|
||||
{ $syntax <" UNIFORM-TUPLE: class-name
|
||||
{ "slot" uniform-type dimension }
|
||||
|
|
@ -78,30 +71,9 @@ $nl
|
|||
"A value of a uniform tuple type is a standard Factor tuple. Uniform tuples are constructed with " { $link new } " or " { $link boa } ", and values are placed inside them using standard slot accessors."
|
||||
} ;
|
||||
|
||||
HELP: VERTEX-FORMAT:
|
||||
{ $syntax <" VERTEX-FORMAT: format-name
|
||||
{ "attribute"/f component-type dimension normalize? }
|
||||
{ "attribute"/f component-type dimension normalize? }
|
||||
...
|
||||
{ "attribute"/f component-type dimension normalize? } ; "> }
|
||||
{ $description "Defines a new binary " { $link vertex-format } " for structuring vertex data stored in " { $link buffer } "s. Each " { $snippet "attribute" } " name either corresponds to an input parameter of a vertex shader, or is " { $link f } " to include padding in the vertex format. The " { $link component-type } " determines the format of the components, and the " { $snippet "dimension" } " determines the number of components. If the " { $snippet "component-type" } " is an integer type and " { $snippet "normalize?" } " is true, the component values will be scaled to the range 0.0 to 1.0 when fed to the vertex shader; otherwise, they will be cast to floats retaining their integral values." } ;
|
||||
|
||||
HELP: VERTEX-STRUCT:
|
||||
{ $syntax <" VERTEX-STRUCT: struct-name format-name "> }
|
||||
{ $description "Defines a struct C type (like " { $link POSTPONE: C-STRUCT: } ") with the same binary format and component types as the given " { $link vertex-format } "." } ;
|
||||
|
||||
HELP: bool-uniform
|
||||
{ $class-description "This " { $link uniform-type } " indicates that a slot of a " { $link uniform-tuple } " corresponds to a boolean uniform parameter." } ;
|
||||
|
||||
HELP: buffer>vertex-array
|
||||
{ $values
|
||||
{ "vertex-buffer" buffer } { "program-instance" program-instance } { "format" vertex-format }
|
||||
{ "vertex-array" vertex-array }
|
||||
}
|
||||
{ $description "Creates a new " { $link vertex-array } " from the entire contents of a single " { $link buffer } " in a single " { $link vertex-format } " for use with " { $snippet "program-instance" } "." } ;
|
||||
|
||||
{ vertex-array <vertex-array> buffer>vertex-array } related-words
|
||||
|
||||
HELP: bvec2-uniform
|
||||
{ $class-description "This " { $link uniform-type } " indicates that a slot of a " { $link uniform-tuple } " corresponds to a two-component boolean vector uniform parameter." } ;
|
||||
|
||||
|
|
@ -117,18 +89,6 @@ HELP: define-uniform-tuple
|
|||
}
|
||||
{ $description "Defines a new " { $link uniform-tuple } " as a subclass of " { $snippet "superclass" } " with the slots specified by the " { $link uniform } " tuple values in " { $snippet "uniforms" } ". The runtime equivalent of " { $link POSTPONE: UNIFORM-TUPLE: } ". This word must be called inside a compilation unit." } ;
|
||||
|
||||
HELP: define-vertex-format
|
||||
{ $values
|
||||
{ "class" class } { "vertex-attributes" sequence }
|
||||
}
|
||||
{ $description "Defines a new " { $link vertex-format } " with the binary format specified by the " { $link vertex-attribute } " tuple values in " { $snippet "vertex-attributes" } ". The runtime equivalent of " { $link POSTPONE: VERTEX-FORMAT: } ". This word must be called inside a compilation unit." } ;
|
||||
|
||||
HELP: define-vertex-struct
|
||||
{ $values
|
||||
{ "struct-name" string } { "vertex-format" vertex-format }
|
||||
}
|
||||
{ $description "Defines a new struct C type from a " { $link vertex-format } ". The runtime equivalent of " { $link POSTPONE: VERTEX-STRUCT: } ". This word must be called inside a compilation unit." } ;
|
||||
|
||||
HELP: float-uniform
|
||||
{ $class-description "This " { $link uniform-type } " indicates that a slot of a " { $link uniform-tuple } " corresponds to a float uniform parameter." } ;
|
||||
|
||||
|
|
@ -254,9 +214,11 @@ HELP: render-set
|
|||
{ "The " { $snippet "uniforms" } " slot contains a " { $link uniform-tuple } " with values for the shader program's uniform parameters." }
|
||||
{ "The " { $snippet "indexes" } " slot contains one of the " { $link vertex-indexes } " types and selects elements from the vertex array to be rendered." }
|
||||
{ "The " { $snippet "instances" } " slot, if not " { $link f } ", instructs the GPU to render several instances of the same set of vertexes. Instancing requires OpenGL 3.1 or one of the " { $snippet "GL_EXT_draw_instanced" } " or " { $snippet "GL_ARB_draw_instanced" } " extensions." }
|
||||
{ "The " { $snippet "framebuffer" } " slot determines the target for the rendering output. Either the " { $link system-framebuffer } " or a user-created " { $link framebuffer } " object can be specified. User-created framebuffers require OpenGL 3.0 or one of the " { $snippet "GL_EXT_framebuffer_object" } " or " { $snippet "GL_ARB_framebuffer_object" } " extensions." }
|
||||
{ "The " { $snippet "output-attachments" } " slot specifies which of the framebuffer's " { $link color-attachment-ref } "s to write the fragment shader's color output to. If the shader uses " { $snippet "gl_FragColor" } " or " { $snippet "gl_FragData[n]" } " to write its output, then " { $snippet "output-attachments" } " should be an array of " { $link color-attachment-ref } "s, and the output to color attachment binding is determined positionally. If the shader uses named output values, then " { $snippet "output-attachments" } " should be a list of string/" { $link color-attachment-ref } " pairs, mapping output names to color attachments. Named output values are available in GLSL 1.30 or later, and GLSL 1.20 and earlier using the " { $snippet "GL_EXT_gpu_shader4" } " extension." }
|
||||
} } ;
|
||||
{ "The " { $snippet "framebuffer" } " slot determines the target for the rendering output. Either the " { $link system-framebuffer } " or a user-created " { $link framebuffer } " object can be specified. " { $link f } " can also be specified to disable rasterization and only run the vertex transformation rendering stage." }
|
||||
{ "The " { $snippet "output-attachments" } " slot specifies which of the framebuffer's " { $link color-attachment-ref } "s to write the fragment shader's color output to. If the shader uses " { $snippet "gl_FragColor" } " or " { $snippet "gl_FragData[n]" } " to write its output, then " { $snippet "output-attachments" } " should be an array of " { $link color-attachment-ref } "s, and the output to color attachment binding is determined positionally. If the shader uses named output values, then " { $snippet "output-attachments" } " should be a list of string/" { $link color-attachment-ref } " pairs, mapping output names to color attachments." }
|
||||
{ "The " { $snippet "transform-feedback-output" } " slot specifies a target for transform feedback output from the vertex shader: either an entire " { $link buffer } ", a " { $link buffer-range } " subset, or a " { $link buffer-ptr } " offset into the buffer. If " { $link f } ", no transform feedback output is collected. The shader program associated with " { $snippet "vertex-array" } " must have a transform feedback output format specified." }
|
||||
} }
|
||||
{ $notes "User-created framebuffers require OpenGL 3.0 or one of the " { $snippet "GL_EXT_framebuffer_object" } " or " { $snippet "GL_ARB_framebuffer_object" } " extensions. Disabling rasterization requires OpenGL 3.0 or the " { $snippet "GL_EXT_transform_feedback" } " extension. Named output-attachment values are available in GLSL 1.30 or later, and GLSL 1.20 and earlier using the " { $snippet "GL_EXT_gpu_shader4" } " extension. Transform feedback requires OpenGL 3.0 or one of the " { $snippet "GL_EXT_transform_feedback" } " or " { $snippet "GL_ARB_transform_feedback" } " extensions." } ;
|
||||
|
||||
{ render render-set } related-words
|
||||
|
||||
|
|
@ -313,29 +275,6 @@ HELP: vec3-uniform
|
|||
HELP: vec4-uniform
|
||||
{ $class-description "This " { $link uniform-type } " indicates that a slot of a " { $link uniform-tuple } " corresponds to a four-component float vector uniform parameter." } ;
|
||||
|
||||
HELP: vertex-array
|
||||
{ $class-description "A " { $snippet "vertex-array" } " object associates a shader " { $link program-instance } " with vertex attribute data from one or more " { $link buffer } "s. The format of the binary data inside these buffers is described using " { $link vertex-format } "s. " { $snippet "vertex-array" } "s are constructed using the " { $link <vertex-array> } " or " { $link buffer>vertex-array } " words." } ;
|
||||
|
||||
HELP: vertex-array-buffer
|
||||
{ $values
|
||||
{ "vertex-array" vertex-array }
|
||||
{ "vertex-buffer" buffer }
|
||||
}
|
||||
{ $description "Returns the first " { $link buffer } " object comprised in " { $snippet "vertex-array" } "." } ;
|
||||
|
||||
HELP: vertex-attribute
|
||||
{ $class-description "This tuple type is passed to " { $link define-vertex-format } " to define a new " { $link vertex-format } " type." } ;
|
||||
|
||||
HELP: vertex-format
|
||||
{ $class-description "This class encompasses all vertex formats defined by " { $link POSTPONE: VERTEX-FORMAT: } ". A vertex format defines the binary layout of vertex attribute data in a " { $link buffer } " for use as part of a " { $link vertex-array } ". See the " { $link POSTPONE: VERTEX-FORMAT: } " documentation for details on how vertex formats are defined." } ;
|
||||
|
||||
HELP: vertex-format-size
|
||||
{ $values
|
||||
{ "format" vertex-format }
|
||||
{ "size" integer }
|
||||
}
|
||||
{ $description "Returns the size in bytes of a set of vertex attributes in " { $snippet "format" } "." } ;
|
||||
|
||||
HELP: vertex-indexes
|
||||
{ $class-description "This class is a union of the following tuple types, any of which can be used as the " { $snippet "indexes" } " slot of a " { $link render-set } " to select elements from a " { $link vertex-array } " for rendering."
|
||||
{ $list
|
||||
|
|
@ -349,11 +288,6 @@ ARTICLE: "gpu.render" "Rendering"
|
|||
"The " { $vocab-link "gpu.render" } " vocabulary contains words for organizing and submitting data to the GPU for rendering."
|
||||
{ $subsection render }
|
||||
{ $subsection render-set }
|
||||
"Render data inside GPU " { $link buffer } "s is organized into " { $link vertex-array } "s for consumption by shader code:"
|
||||
{ $subsection vertex-array }
|
||||
{ $subsection <vertex-array> }
|
||||
{ $subsection buffer>vertex-array }
|
||||
{ $subsection POSTPONE: VERTEX-FORMAT: }
|
||||
{ $link uniform-tuple } "s provide Factor types for containing and submitting shader uniform parameters:"
|
||||
{ $subsection POSTPONE: UNIFORM-TUPLE: }
|
||||
;
|
||||
|
|
|
|||
|
|
@ -3,24 +3,17 @@ USING: accessors alien alien.c-types alien.structs 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
|
||||
gpu.framebuffers.private gpu.shaders gpu.state gpu.textures
|
||||
gpu.textures.private half-floats images kernel lexer locals
|
||||
math math.order math.parser namespaces opengl opengl.gl parser
|
||||
quotations sequences slots sorting specialized-arrays.alien
|
||||
specialized-arrays.float specialized-arrays.int
|
||||
gpu.framebuffers.private gpu.shaders gpu.shaders.private gpu.state
|
||||
gpu.textures gpu.textures.private half-floats images kernel
|
||||
lexer locals math math.order math.parser namespaces opengl
|
||||
opengl.gl parser quotations sequences slots sorting
|
||||
specialized-arrays.alien specialized-arrays.float specialized-arrays.int
|
||||
specialized-arrays.uint strings tr ui.gadgets.worlds variants
|
||||
vocabs.parser words ;
|
||||
IN: gpu.render
|
||||
|
||||
UNION: ?string string POSTPONE: f ;
|
||||
UNION: ?integer integer POSTPONE: f ;
|
||||
|
||||
TUPLE: vertex-attribute
|
||||
{ name ?string read-only initial: f }
|
||||
{ component-type component-type read-only initial: float-components }
|
||||
{ dim integer read-only initial: 4 }
|
||||
{ normalize? boolean read-only initial: f } ;
|
||||
|
||||
VARIANT: uniform-type
|
||||
bool-uniform
|
||||
bvec2-uniform
|
||||
|
|
@ -111,52 +104,12 @@ VARIANT: primitive-mode
|
|||
triangle-strip-mode
|
||||
triangle-fan-mode ;
|
||||
|
||||
MIXIN: vertex-format
|
||||
|
||||
TUPLE: uniform-tuple ;
|
||||
|
||||
GENERIC: vertex-format-size ( format -- size )
|
||||
|
||||
ERROR: invalid-uniform-type uniform ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: gl-vertex-type ( component-type -- gl-type )
|
||||
{
|
||||
{ ubyte-components [ GL_UNSIGNED_BYTE ] }
|
||||
{ ushort-components [ GL_UNSIGNED_SHORT ] }
|
||||
{ uint-components [ GL_UNSIGNED_INT ] }
|
||||
{ half-components [ GL_HALF_FLOAT ] }
|
||||
{ float-components [ GL_FLOAT ] }
|
||||
{ byte-integer-components [ GL_BYTE ] }
|
||||
{ short-integer-components [ GL_SHORT ] }
|
||||
{ int-integer-components [ GL_INT ] }
|
||||
{ ubyte-integer-components [ GL_UNSIGNED_BYTE ] }
|
||||
{ ushort-integer-components [ GL_UNSIGNED_SHORT ] }
|
||||
{ uint-integer-components [ GL_UNSIGNED_INT ] }
|
||||
} case ;
|
||||
|
||||
: vertex-type-size ( component-type -- size )
|
||||
{
|
||||
{ ubyte-components [ 1 ] }
|
||||
{ ushort-components [ 2 ] }
|
||||
{ uint-components [ 4 ] }
|
||||
{ half-components [ 2 ] }
|
||||
{ float-components [ 4 ] }
|
||||
{ byte-integer-components [ 1 ] }
|
||||
{ short-integer-components [ 2 ] }
|
||||
{ int-integer-components [ 4 ] }
|
||||
{ ubyte-integer-components [ 1 ] }
|
||||
{ ushort-integer-components [ 2 ] }
|
||||
{ uint-integer-components [ 4 ] }
|
||||
} case ;
|
||||
|
||||
: vertex-attribute-size ( vertex-attribute -- size )
|
||||
[ component-type>> vertex-type-size ] [ dim>> ] bi * ;
|
||||
|
||||
: vertex-attributes-size ( vertex-attributes -- size )
|
||||
[ vertex-attribute-size ] [ + ] map-reduce ;
|
||||
|
||||
: gl-index-type ( index-type -- gl-index-type )
|
||||
{
|
||||
{ ubyte-indexes [ GL_UNSIGNED_BYTE ] }
|
||||
|
|
@ -210,56 +163,6 @@ M: multi-index-elements render-vertex-indexes
|
|||
: (bind-texture-unit) ( texture texture-unit -- )
|
||||
swap [ GL_TEXTURE0 + glActiveTexture ] [ bind-texture drop ] bi* ; inline
|
||||
|
||||
:: [bind-vertex-attribute] ( stride offset vertex-attribute -- stride offset' quot )
|
||||
vertex-attribute name>> :> name
|
||||
vertex-attribute component-type>> :> type
|
||||
type gl-vertex-type :> gl-type
|
||||
vertex-attribute dim>> :> dim
|
||||
vertex-attribute normalize?>> >c-bool :> normalize?
|
||||
vertex-attribute vertex-attribute-size :> size
|
||||
|
||||
stride offset size +
|
||||
{
|
||||
{ [ name not ] [ [ 2drop ] ] }
|
||||
{
|
||||
[ type unnormalized-integer-components? ]
|
||||
[
|
||||
{
|
||||
name attribute-index [ glEnableVertexAttribArray ] keep
|
||||
dim gl-type stride offset
|
||||
} >quotation :> dip-block
|
||||
|
||||
{ dip-block dip <displaced-alien> glVertexAttribIPointer } >quotation
|
||||
]
|
||||
}
|
||||
[
|
||||
{
|
||||
name attribute-index [ glEnableVertexAttribArray ] keep
|
||||
dim gl-type normalize? stride offset
|
||||
} >quotation :> dip-block
|
||||
|
||||
{ dip-block dip <displaced-alien> glVertexAttribPointer } >quotation
|
||||
]
|
||||
} cond ;
|
||||
|
||||
:: [bind-vertex-format] ( vertex-attributes -- quot )
|
||||
vertex-attributes vertex-attributes-size :> stride
|
||||
stride 0 vertex-attributes [ [bind-vertex-attribute] ] { } map-as 2nip :> attributes-cleave
|
||||
{ attributes-cleave 2cleave } >quotation :> with-block
|
||||
|
||||
{ drop vertex-buffer with-block with-buffer-ptr } >quotation ;
|
||||
|
||||
GENERIC: bind-vertex-format ( program-instance buffer-ptr format -- )
|
||||
|
||||
: define-vertex-format-methods ( class vertex-attributes -- )
|
||||
[
|
||||
[ \ bind-vertex-format create-method-in ] dip
|
||||
[bind-vertex-format] define
|
||||
] [
|
||||
[ \ vertex-format-size create-method-in ] dip
|
||||
[ \ drop ] dip vertex-attributes-size [ ] 2sequence define
|
||||
] 2bi ;
|
||||
|
||||
GENERIC: bind-uniform-textures ( program-instance uniform-tuple -- )
|
||||
GENERIC: bind-uniforms ( program-instance uniform-tuple -- )
|
||||
|
||||
|
|
@ -483,39 +386,6 @@ TR: hyphens>underscores "-" "_" ;
|
|||
] }
|
||||
} case ;
|
||||
|
||||
: component-type>c-type ( component-type -- c-type )
|
||||
{
|
||||
{ ubyte-components [ "uchar" ] }
|
||||
{ ushort-components [ "ushort" ] }
|
||||
{ uint-components [ "uint" ] }
|
||||
{ half-components [ "half" ] }
|
||||
{ float-components [ "float" ] }
|
||||
{ byte-integer-components [ "char" ] }
|
||||
{ ubyte-integer-components [ "uchar" ] }
|
||||
{ short-integer-components [ "short" ] }
|
||||
{ ushort-integer-components [ "ushort" ] }
|
||||
{ int-integer-components [ "int" ] }
|
||||
{ uint-integer-components [ "uint" ] }
|
||||
} case ;
|
||||
|
||||
: c-array-dim ( dim -- string )
|
||||
dup 1 = [ drop "" ] [ number>string "[" "]" surround ] if ;
|
||||
|
||||
SYMBOL: padding-no
|
||||
padding-no [ 0 ] initialize
|
||||
|
||||
: padding-name ( -- name )
|
||||
"padding-"
|
||||
padding-no get number>string append
|
||||
"(" ")" surround
|
||||
padding-no inc ;
|
||||
|
||||
: vertex-attribute>c-type ( vertex-attribute -- {type,name} )
|
||||
[
|
||||
[ component-type>> component-type>c-type ]
|
||||
[ dim>> c-array-dim ] bi append
|
||||
] [ name>> [ padding-name ] unless* ] bi 2array ;
|
||||
|
||||
: (define-uniform-tuple) ( class superclass uniforms -- )
|
||||
{
|
||||
[ [ uniform>slot ] map define-tuple-class ]
|
||||
|
|
@ -536,55 +406,12 @@ padding-no [ 0 ] initialize
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: define-vertex-format ( class vertex-attributes -- )
|
||||
[
|
||||
[
|
||||
[ define-singleton-class ]
|
||||
[ vertex-format add-mixin-instance ]
|
||||
[ ] tri
|
||||
] [ define-vertex-format-methods ] bi*
|
||||
]
|
||||
[ "vertex-format-attributes" set-word-prop ] 2bi ;
|
||||
|
||||
SYNTAX: VERTEX-FORMAT:
|
||||
CREATE-CLASS parse-definition
|
||||
[ first4 vertex-attribute boa ] map
|
||||
define-vertex-format ;
|
||||
|
||||
: define-vertex-struct ( struct-name vertex-format -- )
|
||||
[ current-vocab ] dip
|
||||
"vertex-format-attributes" word-prop [ vertex-attribute>c-type ] map
|
||||
define-struct ;
|
||||
|
||||
SYNTAX: VERTEX-STRUCT:
|
||||
scan scan-word define-vertex-struct ;
|
||||
|
||||
: define-uniform-tuple ( class superclass uniforms -- )
|
||||
(define-uniform-tuple) ; inline
|
||||
|
||||
SYNTAX: UNIFORM-TUPLE:
|
||||
parse-uniform-tuple-definition define-uniform-tuple ;
|
||||
|
||||
TUPLE: vertex-array < gpu-object
|
||||
{ program-instance program-instance read-only }
|
||||
{ vertex-buffers sequence read-only } ;
|
||||
|
||||
M: vertex-array dispose
|
||||
[ [ delete-vertex-array ] when* f ] change-handle drop ;
|
||||
|
||||
: <vertex-array> ( program-instance vertex-formats -- vertex-array )
|
||||
gen-vertex-array
|
||||
[ glBindVertexArray [ first2 bind-vertex-format ] with each ]
|
||||
[ -rot [ first buffer>> ] map vertex-array boa ] 3bi
|
||||
window-resource ;
|
||||
|
||||
: buffer>vertex-array ( vertex-buffer program-instance format -- vertex-array )
|
||||
[ swap ] dip
|
||||
[ 0 <buffer-ptr> ] dip 2array 1array <vertex-array> ; inline
|
||||
|
||||
: vertex-array-buffer ( vertex-array -- vertex-buffer )
|
||||
vertex-buffers>> first ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: bind-vertex-array ( vertex-array -- )
|
||||
|
|
@ -604,16 +431,43 @@ M: vertex-array dispose
|
|||
dup first sequence?
|
||||
[ bind-named-output-attachments ] [ [ drop ] 2dip bind-unnamed-output-attachments ] if ;
|
||||
|
||||
GENERIC: bind-transform-feedback-output ( output -- )
|
||||
|
||||
M: buffer bind-transform-feedback-output
|
||||
[ GL_TRANSFORM_FEEDBACK_BUFFER 0 ] dip handle>> glBindBufferBase ; inline
|
||||
|
||||
M: buffer-range bind-transform-feedback-output
|
||||
[ GL_TRANSFORM_FEEDBACK_BUFFER 0 ] dip
|
||||
[ handle>> ] [ offset>> ] [ size>> ] tri glBindBufferRange ; inline
|
||||
|
||||
M: buffer-ptr bind-transform-feedback-output
|
||||
buffer-ptr>range bind-transform-feedback-output ; inline
|
||||
|
||||
: gl-feedback-primitive-mode ( primitive-mode -- gl-mode )
|
||||
{
|
||||
{ points-mode [ GL_POINTS ] }
|
||||
{ lines-mode [ GL_LINES ] }
|
||||
{ line-strip-mode [ GL_LINES ] }
|
||||
{ line-loop-mode [ GL_LINES ] }
|
||||
{ triangles-mode [ GL_TRIANGLES ] }
|
||||
{ triangle-strip-mode [ GL_TRIANGLES ] }
|
||||
{ triangle-fan-mode [ GL_TRIANGLES ] }
|
||||
} case ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
UNION: ?any-framebuffer any-framebuffer POSTPONE: f ;
|
||||
UNION: transform-feedback-output buffer buffer-range POSTPONE: f ;
|
||||
|
||||
TUPLE: render-set
|
||||
{ primitive-mode primitive-mode read-only }
|
||||
{ vertex-array vertex-array read-only }
|
||||
{ uniforms uniform-tuple read-only }
|
||||
{ indexes vertex-indexes initial: T{ index-range } read-only }
|
||||
{ instances ?integer initial: f read-only }
|
||||
{ framebuffer any-framebuffer initial: system-framebuffer read-only }
|
||||
{ output-attachments sequence initial: { default-attachment } read-only } ;
|
||||
{ framebuffer ?any-framebuffer initial: system-framebuffer read-only }
|
||||
{ output-attachments sequence initial: { default-attachment } read-only }
|
||||
{ transform-feedback-output transform-feedback-output initial: f read-only } ;
|
||||
|
||||
: <render-set> ( x quot-assoc -- render-set )
|
||||
render-set swap make-tuple ; inline
|
||||
|
|
@ -631,7 +485,11 @@ TUPLE: render-set
|
|||
[ vertex-array>> program-instance>> ] [ uniforms>> ] bi
|
||||
[ bind-uniform-textures ] [ bind-uniforms ] 2bi
|
||||
]
|
||||
[ GL_DRAW_FRAMEBUFFER swap framebuffer>> framebuffer-handle glBindFramebuffer ]
|
||||
[
|
||||
framebuffer>>
|
||||
[ GL_DRAW_FRAMEBUFFER swap framebuffer-handle glBindFramebuffer ]
|
||||
[ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer GL_RASTERIZER_DISCARD glEnable ] if*
|
||||
]
|
||||
[
|
||||
[ vertex-array>> program-instance>> ]
|
||||
[ framebuffer>> ]
|
||||
|
|
@ -639,10 +497,20 @@ TUPLE: render-set
|
|||
bind-output-attachments
|
||||
]
|
||||
[ vertex-array>> bind-vertex-array ]
|
||||
[
|
||||
dup transform-feedback-output>> [
|
||||
[ primitive-mode>> gl-feedback-primitive-mode glBeginTransformFeedback ]
|
||||
[ bind-transform-feedback-output ] bi*
|
||||
] [ drop ] if*
|
||||
]
|
||||
|
||||
[
|
||||
[ primitive-mode>> ] [ indexes>> ] [ instances>> ] tri
|
||||
[ render-vertex-indexes-instanced ]
|
||||
[ render-vertex-indexes ] if*
|
||||
]
|
||||
|
||||
[ transform-feedback-output>> [ glEndTransformFeedback ] when ]
|
||||
[ framebuffer>> [ GL_RASTERIZER_DISCARD glDisable ] unless ]
|
||||
} cleave ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -3,10 +3,22 @@ IN: gpu.shaders.prettyprint
|
|||
|
||||
M: compile-shader-error error.
|
||||
"The GLSL shader " write
|
||||
[ shader>> name>> pprint-short " failed to compile." write nl ]
|
||||
[ log>> write nl ] bi ;
|
||||
[ shader>> name>> pprint-short " failed to compile." print ]
|
||||
[ log>> print ] bi ;
|
||||
|
||||
M: link-program-error error.
|
||||
"The GLSL program " write
|
||||
[ shader>> name>> pprint-short " failed to link." write nl ]
|
||||
[ log>> write nl ] bi ;
|
||||
[ shader>> name>> pprint-short " failed to link." print ]
|
||||
[ log>> print ] bi ;
|
||||
|
||||
M: too-many-feedback-formats-error error.
|
||||
drop
|
||||
"Only one transform feedback format can be specified for a program." print ;
|
||||
|
||||
M: invalid-link-feedback-format-error error.
|
||||
drop
|
||||
"Vertex formats used for transform feedback can't contain padding fields." print ;
|
||||
|
||||
M: inaccurate-feedback-attribute-error error.
|
||||
drop
|
||||
"The types of the transform feedback attributes don't match those specified by the program's vertex format." print ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: help.markup help.syntax kernel math multiline quotations strings ;
|
||||
USING: alien.syntax classes gpu.buffers help.markup help.syntax
|
||||
images kernel math multiline quotations sequences strings ;
|
||||
IN: gpu.shaders
|
||||
|
||||
HELP: <program-instance>
|
||||
|
|
@ -16,9 +17,17 @@ HELP: <shader-instance>
|
|||
}
|
||||
{ $description "Compiles an instance of " { $snippet "shader" } " for the current graphics context. If an instance already exists for " { $snippet "shader" } " in the current context, it is reused." } ;
|
||||
|
||||
HELP: <vertex-array>
|
||||
{ $values
|
||||
{ "program-instance" program-instance } { "vertex-formats" "a list of " { $link buffer-ptr } "/" { $link vertex-format } " pairs" }
|
||||
{ "vertex-array" vertex-array }
|
||||
}
|
||||
{ $description "Creates a new " { $link vertex-array } " to feed data to " { $snippet "program-instance" } " from the set of " { $link buffer } "s specified in " { $snippet "vertex-formats" } "." } ;
|
||||
|
||||
HELP: GLSL-PROGRAM:
|
||||
{ $syntax "GLSL-PROGRAM: program-name shader shader ... shader ;" }
|
||||
{ $description "Defines a new " { $link program } " named " { $snippet "program-name" } ". When the program is instantiated with " { $link <program-instance> } ", it will link together instances of all of the specified " { $link shader } "s to create the program instance." } ;
|
||||
{ $syntax "GLSL-PROGRAM: program-name shader shader ... shader [vertex-format] ;" }
|
||||
{ $description "Defines a new " { $link program } " named " { $snippet "program-name" } ". When the program is instantiated with " { $link <program-instance> } ", it will link together instances of all of the specified " { $link shader } "s to create the program instance. A single " { $link vertex-array } " may optionally be specified; if the program is used to collect transform feedback, this format will be used for the output." }
|
||||
{ $notes "Transform feedback requires OpenGL 3.0 or one of the " { $snippet "GL_EXT_transform_feedback" } " or " { $snippet "GL_ARB_transform_feedback" } " extensions." } ;
|
||||
|
||||
HELP: GLSL-SHADER-FILE:
|
||||
{ $syntax "GLSL-SHADER-FILE: shader-name shader-kind \"filename\"" }
|
||||
|
|
@ -32,6 +41,18 @@ shader source
|
|||
; "> }
|
||||
{ $description "Defines a new " { $link shader } " of kind " { $link shader-kind } " named " { $snippet "shader-name" } ". The shader will read its source code from the current Factor source file between the " { $snippet "GLSL-SHADER:" } " line and the first subsequent line with a single semicolon on it." } ;
|
||||
|
||||
HELP: VERTEX-FORMAT:
|
||||
{ $syntax <" VERTEX-FORMAT: format-name
|
||||
{ "attribute"/f component-type dimension normalize? }
|
||||
{ "attribute"/f component-type dimension normalize? }
|
||||
...
|
||||
{ "attribute"/f component-type dimension normalize? } ; "> }
|
||||
{ $description "Defines a new binary " { $link vertex-format } " for structuring vertex data stored in " { $link buffer } "s. Each " { $snippet "attribute" } " name either corresponds to an input parameter of a vertex shader, or is " { $link f } " to include padding in the vertex format. The " { $link component-type } " determines the format of the components, and the " { $snippet "dimension" } " determines the number of components. If the " { $snippet "component-type" } " is an integer type and " { $snippet "normalize?" } " is true, the component values will be scaled to the range 0.0 to 1.0 when fed to the vertex shader; otherwise, they will be cast to floats retaining their integral values." } ;
|
||||
|
||||
HELP: VERTEX-STRUCT:
|
||||
{ $syntax <" VERTEX-STRUCT: struct-name format-name "> }
|
||||
{ $description "Defines a struct C type (like " { $link POSTPONE: C-STRUCT: } ") with the same binary format and component types as the given " { $link vertex-format } "." } ;
|
||||
|
||||
{ POSTPONE: GLSL-PROGRAM: POSTPONE: GLSL-SHADER-FILE: POSTPONE: GLSL-SHADER: } related-words
|
||||
|
||||
HELP: attribute-index
|
||||
|
|
@ -41,6 +62,15 @@ HELP: attribute-index
|
|||
}
|
||||
{ $description "Returns the numeric index of the vertex attribute named " { $snippet "attribute-name" } " in " { $snippet "program-instance" } "." } ;
|
||||
|
||||
HELP: buffer>vertex-array
|
||||
{ $values
|
||||
{ "vertex-buffer" buffer } { "program-instance" program-instance } { "format" vertex-format }
|
||||
{ "vertex-array" vertex-array }
|
||||
}
|
||||
{ $description "Creates a new " { $link vertex-array } " from the entire contents of a single " { $link buffer } " in a single " { $link vertex-format } " for use with " { $snippet "program-instance" } "." } ;
|
||||
|
||||
{ vertex-array <vertex-array> buffer>vertex-array } related-words
|
||||
|
||||
HELP: compile-shader-error
|
||||
{ $class-description "An error compiling the source for a " { $link shader } "."
|
||||
{ $list
|
||||
|
|
@ -48,6 +78,18 @@ HELP: compile-shader-error
|
|||
{ "The " { $snippet "log" } " slot contains the error string from the GLSL compiler." }
|
||||
} } ;
|
||||
|
||||
HELP: define-vertex-format
|
||||
{ $values
|
||||
{ "class" class } { "vertex-attributes" sequence }
|
||||
}
|
||||
{ $description "Defines a new " { $link vertex-format } " with the binary format specified by the " { $link vertex-attribute } " tuple values in " { $snippet "vertex-attributes" } ". The runtime equivalent of " { $link POSTPONE: VERTEX-FORMAT: } ". This word must be called inside a compilation unit." } ;
|
||||
|
||||
HELP: define-vertex-struct
|
||||
{ $values
|
||||
{ "struct-name" string } { "vertex-format" vertex-format }
|
||||
}
|
||||
{ $description "Defines a new struct C type from a " { $link vertex-format } ". The runtime equivalent of " { $link POSTPONE: VERTEX-STRUCT: } ". This word must be called inside a compilation unit." } ;
|
||||
|
||||
HELP: fragment-shader
|
||||
{ $class-description "This " { $link shader-kind } " indicates that a " { $link shader } " is a fragment shader." } ;
|
||||
|
||||
|
|
@ -93,6 +135,15 @@ HELP: shader-kind
|
|||
{ { $link fragment-shader } "s run as part of rasterization and decide the final rendered output of a primitive as the outputs of the vertex shader are interpolated across its surface." }
|
||||
} } ;
|
||||
|
||||
HELP: too-many-feedback-formats-error
|
||||
{ $class-description "This error is thrown when a " { $link POSTPONE: GLSL-PROGRAM: } " definition attempts to include more than one " { $link vertex-format } " for transform feedback formatting." } ;
|
||||
|
||||
HELP: invalid-link-feedback-format-error
|
||||
{ $class-description "This error is thrown when the " { $link vertex-format } " specified as the transform feedback output format of a " { $link program } " is not suitable for the purpose. Transform feedback formats do not support padding (fields with a name of " { $link f } ")." } ;
|
||||
|
||||
HELP: inaccurate-feedback-attribute-error
|
||||
{ $class-description "This error is thrown when the " { $link vertex-format } " specified as the transform feedback output format of a " { $link program } " does not match the format of the output attributes linked into a " { $link program-instance } "." } ;
|
||||
|
||||
HELP: uniform-index
|
||||
{ $values
|
||||
{ "program-instance" program-instance } { "uniform-name" string }
|
||||
|
|
@ -103,6 +154,29 @@ HELP: uniform-index
|
|||
HELP: vertex-shader
|
||||
{ $class-description "This " { $link shader-kind } " indicates that a " { $link shader } " is a vertex shader." } ;
|
||||
|
||||
HELP: vertex-array
|
||||
{ $class-description "A " { $snippet "vertex-array" } " object associates a shader " { $link program-instance } " with vertex attribute data from one or more " { $link buffer } "s. The format of the binary data inside these buffers is described using " { $link vertex-format } "s. " { $snippet "vertex-array" } "s are constructed using the " { $link <vertex-array> } " or " { $link buffer>vertex-array } " words." } ;
|
||||
|
||||
HELP: vertex-array-buffer
|
||||
{ $values
|
||||
{ "vertex-array" vertex-array }
|
||||
{ "vertex-buffer" buffer }
|
||||
}
|
||||
{ $description "Returns the first " { $link buffer } " object comprised in " { $snippet "vertex-array" } "." } ;
|
||||
|
||||
HELP: vertex-attribute
|
||||
{ $class-description "This tuple type is passed to " { $link define-vertex-format } " to define a new " { $link vertex-format } " type." } ;
|
||||
|
||||
HELP: vertex-format
|
||||
{ $class-description "This class encompasses all vertex formats defined by " { $link POSTPONE: VERTEX-FORMAT: } ". A vertex format defines the binary layout of vertex attribute data in a " { $link buffer } " for use as part of a " { $link vertex-array } ". See the " { $link POSTPONE: VERTEX-FORMAT: } " documentation for details on how vertex formats are defined." } ;
|
||||
|
||||
HELP: vertex-format-size
|
||||
{ $values
|
||||
{ "format" vertex-format }
|
||||
{ "size" integer }
|
||||
}
|
||||
{ $description "Returns the size in bytes of a set of vertex attributes in " { $snippet "format" } "." } ;
|
||||
|
||||
ARTICLE: "gpu.shaders" "Shader objects"
|
||||
"The " { $vocab-link "gpu.shaders" } " vocabulary supports defining, compiling, and linking " { $link shader } "s into " { $link program } "s that run on the GPU and control rendering."
|
||||
{ $subsection POSTPONE: GLSL-PROGRAM: }
|
||||
|
|
@ -111,6 +185,11 @@ ARTICLE: "gpu.shaders" "Shader objects"
|
|||
"A program must be instantiated for each graphics context it is used in:"
|
||||
{ $subsection <program-instance> }
|
||||
"Program instances can be updated on the fly, allowing for interactive development of shaders:"
|
||||
{ $subsection refresh-program } ;
|
||||
{ $subsection refresh-program }
|
||||
"Render data inside GPU " { $link buffer } "s is organized into " { $link vertex-array } "s for consumption by shader code:"
|
||||
{ $subsection vertex-array }
|
||||
{ $subsection <vertex-array> }
|
||||
{ $subsection buffer>vertex-array }
|
||||
{ $subsection POSTPONE: VERTEX-FORMAT: } ;
|
||||
|
||||
ABOUT: "gpu.shaders"
|
||||
|
|
|
|||
|
|
@ -1,17 +1,35 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors arrays assocs combinators
|
||||
combinators.short-circuit definitions destructors gpu
|
||||
io.encodings.ascii io.files io.pathnames kernel lexer
|
||||
locals math math.parser memoize multiline namespaces
|
||||
opengl.gl opengl.shaders parser sequences
|
||||
specialized-arrays.int splitting strings ui.gadgets.worlds
|
||||
variants hashtables vectors vocabs vocabs.loader words
|
||||
words.constant ;
|
||||
USING: accessors alien alien.c-types alien.strings
|
||||
alien.structs arrays assocs byte-arrays classes.mixin
|
||||
classes.parser classes.singleton 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.alien specialized-arrays.int splitting
|
||||
strings ui.gadgets.worlds variants vectors vocabs vocabs.loader
|
||||
vocabs.parser words words.constant ;
|
||||
IN: gpu.shaders
|
||||
|
||||
VARIANT: shader-kind
|
||||
vertex-shader fragment-shader ;
|
||||
|
||||
UNION: ?string string POSTPONE: f ;
|
||||
|
||||
ERROR: too-many-feedback-formats-error formats ;
|
||||
ERROR: invalid-link-feedback-format-error format ;
|
||||
ERROR: inaccurate-feedback-attribute-error attribute ;
|
||||
|
||||
TUPLE: vertex-attribute
|
||||
{ name ?string read-only initial: f }
|
||||
{ component-type component-type read-only initial: float-components }
|
||||
{ dim integer read-only initial: 4 }
|
||||
{ normalize? boolean read-only initial: f } ;
|
||||
|
||||
MIXIN: vertex-format
|
||||
UNION: ?vertex-format vertex-format POSTPONE: f ;
|
||||
|
||||
TUPLE: shader
|
||||
{ name word read-only initial: t }
|
||||
{ kind shader-kind read-only }
|
||||
|
|
@ -25,6 +43,7 @@ TUPLE: program
|
|||
{ filename read-only }
|
||||
{ line integer read-only }
|
||||
{ shaders array read-only }
|
||||
{ feedback-format ?vertex-format read-only }
|
||||
{ instances hashtable read-only } ;
|
||||
|
||||
TUPLE: shader-instance < gpu-object
|
||||
|
|
@ -35,8 +54,206 @@ TUPLE: program-instance < gpu-object
|
|||
{ program program }
|
||||
{ world world } ;
|
||||
|
||||
GENERIC: vertex-format-size ( format -- size )
|
||||
|
||||
MEMO: uniform-index ( program-instance uniform-name -- index )
|
||||
[ handle>> ] dip glGetUniformLocation ;
|
||||
MEMO: attribute-index ( program-instance attribute-name -- index )
|
||||
[ handle>> ] dip glGetAttribLocation ;
|
||||
MEMO: output-index ( program-instance output-name -- index )
|
||||
[ handle>> ] dip glGetFragDataLocation ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: gl-vertex-type ( component-type -- gl-type )
|
||||
{
|
||||
{ ubyte-components [ GL_UNSIGNED_BYTE ] }
|
||||
{ ushort-components [ GL_UNSIGNED_SHORT ] }
|
||||
{ uint-components [ GL_UNSIGNED_INT ] }
|
||||
{ half-components [ GL_HALF_FLOAT ] }
|
||||
{ float-components [ GL_FLOAT ] }
|
||||
{ byte-integer-components [ GL_BYTE ] }
|
||||
{ short-integer-components [ GL_SHORT ] }
|
||||
{ int-integer-components [ GL_INT ] }
|
||||
{ ubyte-integer-components [ GL_UNSIGNED_BYTE ] }
|
||||
{ ushort-integer-components [ GL_UNSIGNED_SHORT ] }
|
||||
{ uint-integer-components [ GL_UNSIGNED_INT ] }
|
||||
} case ;
|
||||
|
||||
: vertex-type-size ( component-type -- size )
|
||||
{
|
||||
{ ubyte-components [ 1 ] }
|
||||
{ ushort-components [ 2 ] }
|
||||
{ uint-components [ 4 ] }
|
||||
{ half-components [ 2 ] }
|
||||
{ float-components [ 4 ] }
|
||||
{ byte-integer-components [ 1 ] }
|
||||
{ short-integer-components [ 2 ] }
|
||||
{ int-integer-components [ 4 ] }
|
||||
{ ubyte-integer-components [ 1 ] }
|
||||
{ ushort-integer-components [ 2 ] }
|
||||
{ uint-integer-components [ 4 ] }
|
||||
} case ;
|
||||
|
||||
: vertex-attribute-size ( vertex-attribute -- size )
|
||||
[ component-type>> vertex-type-size ] [ dim>> ] bi * ;
|
||||
|
||||
: vertex-attributes-size ( vertex-attributes -- size )
|
||||
[ vertex-attribute-size ] [ + ] map-reduce ;
|
||||
|
||||
: feedback-type= ( component-type dim gl-type -- ? )
|
||||
[ 2array ] dip {
|
||||
{ $ GL_FLOAT [ { float-components 1 } ] }
|
||||
{ $ GL_FLOAT_VEC2 [ { float-components 2 } ] }
|
||||
{ $ GL_FLOAT_VEC3 [ { float-components 3 } ] }
|
||||
{ $ GL_FLOAT_VEC4 [ { float-components 4 } ] }
|
||||
{ $ GL_INT [ { int-integer-components 1 } ] }
|
||||
{ $ GL_INT_VEC2 [ { int-integer-components 2 } ] }
|
||||
{ $ GL_INT_VEC3 [ { int-integer-components 3 } ] }
|
||||
{ $ GL_INT_VEC4 [ { int-integer-components 4 } ] }
|
||||
{ $ GL_UNSIGNED_INT [ { uint-integer-components 1 } ] }
|
||||
{ $ GL_UNSIGNED_INT_VEC2 [ { uint-integer-components 2 } ] }
|
||||
{ $ GL_UNSIGNED_INT_VEC3 [ { uint-integer-components 3 } ] }
|
||||
{ $ GL_UNSIGNED_INT_VEC4 [ { uint-integer-components 4 } ] }
|
||||
} case = ;
|
||||
|
||||
:: assert-feedback-attribute ( size gl-type name vertex-attribute -- )
|
||||
{
|
||||
[ vertex-attribute name>> name = ]
|
||||
[ size 1 = ]
|
||||
[ gl-type vertex-attribute [ component-type>> ] [ dim>> ] bi feedback-type= ]
|
||||
} 0&& [ vertex-attribute inaccurate-feedback-attribute-error ] unless ;
|
||||
|
||||
:: [bind-vertex-attribute] ( stride offset vertex-attribute -- stride offset' quot )
|
||||
vertex-attribute name>> :> name
|
||||
vertex-attribute component-type>> :> type
|
||||
type gl-vertex-type :> gl-type
|
||||
vertex-attribute dim>> :> dim
|
||||
vertex-attribute normalize?>> >c-bool :> normalize?
|
||||
vertex-attribute vertex-attribute-size :> size
|
||||
|
||||
stride offset size +
|
||||
{
|
||||
{ [ name not ] [ [ 2drop ] ] }
|
||||
{
|
||||
[ type unnormalized-integer-components? ]
|
||||
[
|
||||
{
|
||||
name attribute-index [ glEnableVertexAttribArray ] keep
|
||||
dim gl-type stride offset
|
||||
} >quotation :> dip-block
|
||||
|
||||
{ dip-block dip <displaced-alien> glVertexAttribIPointer } >quotation
|
||||
]
|
||||
}
|
||||
[
|
||||
{
|
||||
name attribute-index [ glEnableVertexAttribArray ] keep
|
||||
dim gl-type normalize? stride offset
|
||||
} >quotation :> dip-block
|
||||
|
||||
{ dip-block dip <displaced-alien> glVertexAttribPointer } >quotation
|
||||
]
|
||||
} cond ;
|
||||
|
||||
:: [bind-vertex-format] ( vertex-attributes -- quot )
|
||||
vertex-attributes vertex-attributes-size :> stride
|
||||
stride 0 vertex-attributes [ [bind-vertex-attribute] ] { } map-as 2nip :> attributes-cleave
|
||||
{ attributes-cleave 2cleave } >quotation :> with-block
|
||||
|
||||
{ drop vertex-buffer with-block with-buffer-ptr } >quotation ;
|
||||
|
||||
:: [link-feedback-format] ( vertex-attributes -- quot )
|
||||
vertex-attributes [ name>> not ] any?
|
||||
[ [ nip invalid-link-feedback-format-error ] ] [
|
||||
vertex-attributes
|
||||
[ name>> ascii malloc-string ]
|
||||
void*-array{ } map-as :> varying-names
|
||||
vertex-attributes length :> varying-count
|
||||
{ drop varying-count varying-names GL_INTERLEAVED_ATTRIBS glTransformFeedbackVaryings }
|
||||
>quotation
|
||||
] if ;
|
||||
|
||||
:: [verify-feedback-attribute] ( vertex-attribute index -- quot )
|
||||
vertex-attribute name>> :> name
|
||||
name length 1 + :> name-buffer-length
|
||||
{
|
||||
index name-buffer-length dup
|
||||
[ f 0 <int> 0 <int> ] dip <byte-array>
|
||||
[ glGetTransformFeedbackVarying ] 3keep
|
||||
ascii alien>string
|
||||
vertex-attribute assert-feedback-attribute
|
||||
} >quotation ;
|
||||
|
||||
:: [verify-feedback-format] ( vertex-attributes -- quot )
|
||||
vertex-attributes [ [verify-feedback-attribute] ] map-index :> verify-cleave
|
||||
{ drop verify-cleave cleave } >quotation ;
|
||||
|
||||
GENERIC: bind-vertex-format ( program-instance buffer-ptr format -- )
|
||||
|
||||
GENERIC: link-feedback-format ( program-handle format -- )
|
||||
|
||||
M: f link-feedback-format
|
||||
2drop ;
|
||||
|
||||
GENERIC: (verify-feedback-format) ( program-instance format -- )
|
||||
|
||||
M: f (verify-feedback-format)
|
||||
2drop ;
|
||||
|
||||
: verify-feedback-format ( program-instance -- )
|
||||
dup program>> feedback-format>> (verify-feedback-format) ;
|
||||
|
||||
: define-vertex-format-methods ( class vertex-attributes -- )
|
||||
{
|
||||
[
|
||||
[ \ bind-vertex-format create-method-in ] dip
|
||||
[bind-vertex-format] define
|
||||
] [
|
||||
[ \ link-feedback-format create-method-in ] dip
|
||||
[link-feedback-format] define
|
||||
] [
|
||||
[ \ (verify-feedback-format) create-method-in ] dip
|
||||
[verify-feedback-format] define
|
||||
] [
|
||||
[ \ vertex-format-size create-method-in ] dip
|
||||
[ \ drop ] dip vertex-attributes-size [ ] 2sequence define
|
||||
]
|
||||
} 2cleave ;
|
||||
|
||||
: component-type>c-type ( component-type -- c-type )
|
||||
{
|
||||
{ ubyte-components [ "uchar" ] }
|
||||
{ ushort-components [ "ushort" ] }
|
||||
{ uint-components [ "uint" ] }
|
||||
{ half-components [ "half" ] }
|
||||
{ float-components [ "float" ] }
|
||||
{ byte-integer-components [ "char" ] }
|
||||
{ ubyte-integer-components [ "uchar" ] }
|
||||
{ short-integer-components [ "short" ] }
|
||||
{ ushort-integer-components [ "ushort" ] }
|
||||
{ int-integer-components [ "int" ] }
|
||||
{ uint-integer-components [ "uint" ] }
|
||||
} case ;
|
||||
|
||||
: c-array-dim ( dim -- string )
|
||||
dup 1 = [ drop "" ] [ number>string "[" "]" surround ] if ;
|
||||
|
||||
SYMBOL: padding-no
|
||||
padding-no [ 0 ] initialize
|
||||
|
||||
: padding-name ( -- name )
|
||||
"padding-"
|
||||
padding-no get number>string append
|
||||
"(" ")" surround
|
||||
padding-no inc ;
|
||||
|
||||
: vertex-attribute>c-type ( vertex-attribute -- {type,name} )
|
||||
[
|
||||
[ component-type>> component-type>c-type ]
|
||||
[ dim>> c-array-dim ] bi append
|
||||
] [ name>> [ padding-name ] unless* ] bi 2array ;
|
||||
|
||||
: shader-filename ( shader/program -- filename )
|
||||
dup filename>> [ nip ] [ name>> where first ] if* file-name ;
|
||||
|
||||
|
|
@ -69,6 +286,49 @@ TUPLE: program-instance < gpu-object
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: define-vertex-format ( class vertex-attributes -- )
|
||||
[
|
||||
[
|
||||
[ define-singleton-class ]
|
||||
[ vertex-format add-mixin-instance ]
|
||||
[ ] tri
|
||||
] [ define-vertex-format-methods ] bi*
|
||||
]
|
||||
[ "vertex-format-attributes" set-word-prop ] 2bi ;
|
||||
|
||||
SYNTAX: VERTEX-FORMAT:
|
||||
CREATE-CLASS parse-definition
|
||||
[ first4 vertex-attribute boa ] map
|
||||
define-vertex-format ;
|
||||
|
||||
: define-vertex-struct ( struct-name vertex-format -- )
|
||||
[ current-vocab ] dip
|
||||
"vertex-format-attributes" word-prop [ vertex-attribute>c-type ] map
|
||||
define-struct ;
|
||||
|
||||
SYNTAX: VERTEX-STRUCT:
|
||||
scan scan-word define-vertex-struct ;
|
||||
|
||||
TUPLE: vertex-array < gpu-object
|
||||
{ program-instance program-instance read-only }
|
||||
{ vertex-buffers sequence read-only } ;
|
||||
|
||||
M: vertex-array dispose
|
||||
[ [ delete-vertex-array ] when* f ] change-handle drop ;
|
||||
|
||||
: <vertex-array> ( program-instance vertex-formats -- vertex-array )
|
||||
gen-vertex-array
|
||||
[ glBindVertexArray [ first2 bind-vertex-format ] with each ]
|
||||
[ -rot [ first buffer>> ] map vertex-array boa ] 3bi
|
||||
window-resource ;
|
||||
|
||||
: buffer>vertex-array ( vertex-buffer program-instance format -- vertex-array )
|
||||
[ swap ] dip
|
||||
[ 0 <buffer-ptr> ] dip 2array 1array <vertex-array> ; inline
|
||||
|
||||
: vertex-array-buffer ( vertex-array -- vertex-buffer )
|
||||
vertex-buffers>> first ;
|
||||
|
||||
TUPLE: compile-shader-error shader log ;
|
||||
TUPLE: link-program-error program log ;
|
||||
|
||||
|
|
@ -82,13 +342,6 @@ TUPLE: link-program-error program log ;
|
|||
|
||||
DEFER: <shader-instance>
|
||||
|
||||
MEMO: uniform-index ( program-instance uniform-name -- index )
|
||||
[ handle>> ] dip glGetUniformLocation ;
|
||||
MEMO: attribute-index ( program-instance attribute-name -- index )
|
||||
[ handle>> ] dip glGetAttribLocation ;
|
||||
MEMO: output-index ( program-instance output-name -- index )
|
||||
[ handle>> ] dip glGetFragDataLocation ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: valid-handle? ( handle -- ? )
|
||||
|
|
@ -101,10 +354,12 @@ MEMO: output-index ( program-instance output-name -- index )
|
|||
[ compile-shader-error ] if ;
|
||||
|
||||
: (link-program) ( program shader-instances -- program-instance )
|
||||
[ handle>> ] map <gl-program>
|
||||
dup gl-program-ok?
|
||||
[ swap world get \ program-instance boa window-resource ]
|
||||
[ link-program-error ] if ;
|
||||
[ [ handle>> ] map ] curry
|
||||
[ feedback-format>> [ link-feedback-format ] curry ] bi (gl-program)
|
||||
dup gl-program-ok? [
|
||||
[ swap world get \ program-instance boa |dispose dup verify-feedback-format ]
|
||||
with-destructors window-resource
|
||||
] [ link-program-error ] if ;
|
||||
|
||||
: link-program ( program -- program-instance )
|
||||
dup shaders>> [ <shader-instance> ] map (link-program) ;
|
||||
|
|
@ -139,6 +394,14 @@ MEMO: output-index ( program-instance output-name -- index )
|
|||
world get over instances>> at*
|
||||
[ nip ] [ drop link-program ] if ;
|
||||
|
||||
: shaders-and-feedback-format ( words -- shaders feedback-format )
|
||||
[ vertex-format? ] partition swap
|
||||
[ [ def>> first ] map ] [
|
||||
dup length 1 <=
|
||||
[ [ f ] [ first ] if-empty ]
|
||||
[ too-many-feedback-formats-error ] if
|
||||
] bi* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
:: refresh-program ( program -- )
|
||||
|
|
@ -191,7 +454,7 @@ SYNTAX: GLSL-PROGRAM:
|
|||
CREATE-WORD dup
|
||||
f
|
||||
lexer get line>>
|
||||
\ ; parse-until >array [ def>> first ] map
|
||||
\ ; parse-until >array shaders-and-feedback-format
|
||||
H{ } clone
|
||||
program boa
|
||||
define-constant ;
|
||||
|
|
|
|||
|
|
@ -151,7 +151,7 @@ M: cube-map-face texture-data-gl-target
|
|||
|
||||
: get-texture-float ( target level enum -- value )
|
||||
0 <float> [ glGetTexLevelParameterfv ] keep *float ;
|
||||
: get-texture-int ( texture level enum -- value )
|
||||
: get-texture-int ( target level enum -- value )
|
||||
0 <int> [ glGetTexLevelParameteriv ] keep *int ;
|
||||
|
||||
: ?product ( x -- y )
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: gpu.buffers gpu.render gpu.textures images kernel
|
||||
USING: gpu.buffers gpu.render gpu.shaders gpu.textures images kernel
|
||||
specialized-arrays.float ;
|
||||
IN: gpu.util
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue