diff --git a/basis/byte-arrays/hex/authors.txt b/basis/byte-arrays/hex/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/byte-arrays/hex/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/byte-arrays/hex/hex-docs.factor b/basis/byte-arrays/hex/hex-docs.factor new file mode 100644 index 0000000000..8c60dc2646 --- /dev/null +++ b/basis/byte-arrays/hex/hex-docs.factor @@ -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." } ; diff --git a/basis/byte-arrays/hex/hex.factor b/basis/byte-arrays/hex/hex.factor new file mode 100644 index 0000000000..054c35dcfa --- /dev/null +++ b/basis/byte-arrays/hex/hex.factor @@ -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 ; + diff --git a/basis/cpu/x86/assembler/assembler-tests.factor b/basis/cpu/x86/assembler/assembler-tests.factor index a8c54fa65e..d2dd73779a 100644 --- a/basis/cpu/x86/assembler/assembler-tests.factor +++ b/basis/cpu/x86/assembler/assembler-tests.factor @@ -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 + diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index 95b85ac2dd..237ef8154d 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -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 ; diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 1561138522..9d5f4810e1 100755 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -61,22 +61,18 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; ! Programs -: ( 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 + +: ( shaders frag-data-locations -- program ) + [ [ first2 swap glBindFragDataLocation ] with each ] curry (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 ; diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor index 744318a0a4..0a8ab0b116 100755 --- a/basis/tools/disassembler/disassembler.factor +++ b/basis/tools/disassembler/disassembler.factor @@ -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 ; diff --git a/extra/gpu/buffers/buffers-docs.factor b/extra/gpu/buffers/buffers-docs.factor index eee5d2b716..d05783dbf8 100644 --- a/extra/gpu/buffers/buffers-docs.factor +++ b/extra/gpu/buffers/buffers-docs.factor @@ -10,6 +10,13 @@ HELP: } { $description "Constructs a " { $link buffer-ptr } " tuple." } ; +HELP: +{ $values + { "buffer" buffer } { "offset" integer } { "size" integer } + { "buffer-range" buffer-range } +} +{ $description "Constructs a " { $link buffer-range } " tuple." } ; + HELP: { $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 } diff --git a/extra/gpu/buffers/buffers.factor b/extra/gpu/buffers/buffers.factor index 187f194e7d..3de5a03d35 100644 --- a/extra/gpu/buffers/buffers.factor +++ b/extra/gpu/buffers/buffers.factor @@ -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 [ 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 +TUPLE: buffer-range < buffer-ptr + { size integer read-only } ; +C: 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 ; : ( 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 :> 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 diff --git a/extra/gpu/render/render-docs.factor b/extra/gpu/render/render-docs.factor index f198558b06..171c9bb031 100755 --- a/extra/gpu/render/render-docs.factor +++ b/extra/gpu/render/render-docs.factor @@ -34,13 +34,6 @@ HELP: } { $description "Constructs a " { $link multi-index-range } " tuple." } ; -HELP: -{ $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 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 } " 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 } -{ $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: } ; diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 51bd549b7a..ce6e0e25ff 100644 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -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 ; > 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 glVertexAttribIPointer } >quotation - ] - } - [ - { - name attribute-index [ glEnableVertexAttribArray ] keep - dim gl-type normalize? stride offset - } >quotation :> dip-block - - { dip-block dip 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 ; - -: ( 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 ] dip 2array 1array ; inline - -: vertex-array-buffer ( vertex-array -- vertex-buffer ) - vertex-buffers>> first ; - > 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 } ; : ( 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 diff --git a/extra/gpu/shaders/prettyprint/prettyprint.factor b/extra/gpu/shaders/prettyprint/prettyprint.factor index 128333ce3c..10afe4bee1 100644 --- a/extra/gpu/shaders/prettyprint/prettyprint.factor +++ b/extra/gpu/shaders/prettyprint/prettyprint.factor @@ -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 ; diff --git a/extra/gpu/shaders/shaders-docs.factor b/extra/gpu/shaders/shaders-docs.factor index cac61114d6..d59fa1bc39 100755 --- a/extra/gpu/shaders/shaders-docs.factor +++ b/extra/gpu/shaders/shaders-docs.factor @@ -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: @@ -16,9 +17,17 @@ HELP: } { $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: +{ $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 } ", 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 } ", 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 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 } " 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 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 } +{ $subsection buffer>vertex-array } +{ $subsection POSTPONE: VERTEX-FORMAT: } ; ABOUT: "gpu.shaders" diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index e11fa639b4..d2dd29595a 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -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 ; + > 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 glVertexAttribIPointer } >quotation + ] + } + [ + { + name attribute-index [ glEnableVertexAttribArray ] keep + dim gl-type normalize? stride offset + } >quotation :> dip-block + + { dip-block dip 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 0 ] dip + [ 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 ; + +: ( 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 ] dip 2array 1array ; 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: -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 ; - > ] map - 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>> [ ] 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 ; diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor index 5740799fbe..c84f3a2123 100644 --- a/extra/gpu/textures/textures.factor +++ b/extra/gpu/textures/textures.factor @@ -151,7 +151,7 @@ M: cube-map-face texture-data-gl-target : get-texture-float ( target level enum -- value ) 0 [ glGetTexLevelParameterfv ] keep *float ; -: get-texture-int ( texture level enum -- value ) +: get-texture-int ( target level enum -- value ) 0 [ glGetTexLevelParameteriv ] keep *int ; : ?product ( x -- y ) diff --git a/extra/gpu/util/util.factor b/extra/gpu/util/util.factor index 5b7719d06b..512cea4a17 100644 --- a/extra/gpu/util/util.factor +++ b/extra/gpu/util/util.factor @@ -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