diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 36d12bf51..49ebe60dd 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -15,7 +15,7 @@ internal static class RevisionClass public const string Major = "3"; public const string Minor = "8"; public const string Build = "1"; - public const string Revision = "2980"; + public const string Revision = "2985"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 03cc80c26..e923e5890 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=1 -%REVISION%=2980 %MINOR%=8 +%REVISION%=2985 +%COREVERSION%=1 %MAJOR%=3 diff --git a/Parsers/PascalABCParserNewSaushkin/ABCPascal.cs b/Parsers/PascalABCParserNewSaushkin/ABCPascal.cs index a2611f5c5..8075a802b 100644 --- a/Parsers/PascalABCParserNewSaushkin/ABCPascal.cs +++ b/Parsers/PascalABCParserNewSaushkin/ABCPascal.cs @@ -2,7 +2,7 @@ // This CSharp output file generated by Gardens Point LEX // Version: 1.1.3.301 // Machine: DESKTOP-G8V08V4 -// DateTime: 21.08.2021 17:29:06 +// DateTime: 23.09.2021 17:46:26 // UserName: ????????? // GPLEX input file // GPLEX frame file diff --git a/Parsers/PascalABCParserNewSaushkin/ABCPascal.y b/Parsers/PascalABCParserNewSaushkin/ABCPascal.y index 6d5367f2f..4a17e3465 100644 --- a/Parsers/PascalABCParserNewSaushkin/ABCPascal.y +++ b/Parsers/PascalABCParserNewSaushkin/ABCPascal.y @@ -3474,11 +3474,17 @@ relop_expr { $$ = $1; } | relop_expr relop simple_expr { - $$ = new bin_expr($1, $3, $2.type, @$); + if ($2.type == Operators.NotIn) + $$ = new un_expr(new bin_expr($1, $3, Operators.In, @$),Operators.LogicalNOT,@$); + else + $$ = new bin_expr($1, $3, $2.type, @$); } | relop_expr relop new_question_expr { - $$ = new bin_expr($1, $3, $2.type, @$); + if ($2.type == Operators.NotIn) + $$ = new un_expr(new bin_expr($1, $3, Operators.In, @$),Operators.LogicalNOT,@$); + else + $$ = new bin_expr($1, $3, $2.type, @$); } | is_type_expr tkRoundOpen pattern_out_param_list tkRoundClose { @@ -3886,6 +3892,16 @@ relop { $$ = $1; } | tkIn { $$ = $1; } + | tkNot tkIn + { + if (parsertools.build_tree_for_formatter) + $$ = $2; + else + { + $$ = $2; + $$.type = Operators.NotIn; + } + } ; simple_expr diff --git a/Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs b/Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs index 8cb3b5ac6..0ae5fc31d 100644 --- a/Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs +++ b/Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs @@ -2,7 +2,7 @@ // GPPG version 1.3.6 // Machine: DESKTOP-G8V08V4 -// DateTime: 21.08.2021 17:29:06 +// DateTime: 23.09.2021 17:46:26 // UserName: ????????? // Input file @@ -76,8 +76,8 @@ public partial class GPPGParser: ShiftReduceParser aliasses; #pragma warning restore 649 - private static Rule[] rules = new Rule[1005]; - private static State[] states = new State[1669]; + private static Rule[] rules = new Rule[1006]; + private static State[] states = new State[1671]; private static string[] nonTerms = new string[] { "parse_goal", "unit_key_word", "class_or_static", "assignment", "optional_array_initializer", "attribute_declarations", "ot_visibility_specifier", "one_attribute", "attribute_variable", @@ -172,13 +172,13 @@ public partial class GPPGParser: ShiftReduceParser relop_expr, relop, simple_expr { - CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); + if (ValueStack[ValueStack.Depth-2].op.type == Operators.NotIn) + CurrentSemanticValue.ex = new un_expr(new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, Operators.In, CurrentLocationSpan),Operators.LogicalNOT,CurrentLocationSpan); + else + CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); } break; case 631: // relop_expr -> relop_expr, relop, new_question_expr { - CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); + if (ValueStack[ValueStack.Depth-2].op.type == Operators.NotIn) + CurrentSemanticValue.ex = new un_expr(new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, Operators.In, CurrentLocationSpan),Operators.LogicalNOT,CurrentLocationSpan); + else + CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); } break; case 632: // relop_expr -> is_type_expr, tkRoundOpen, pattern_out_param_list, tkRoundClose @@ -6335,10 +6344,21 @@ public partial class GPPGParser: ShiftReduceParser tkIn { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 707: // simple_expr -> term1 + case 707: // relop -> tkNot, tkIn +{ + if (parsertools.build_tree_for_formatter) + CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; + else + { + CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; + CurrentSemanticValue.op.type = Operators.NotIn; + } + } + break; + case 708: // simple_expr -> term1 { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 708: // simple_expr -> simple_expr, tkDotDot, term1 + case 709: // simple_expr -> simple_expr, tkDotDot, term1 { if (parsertools.build_tree_for_formatter) CurrentSemanticValue.ex = new diapason_expr(ValueStack[ValueStack.Depth-3].ex,ValueStack[ValueStack.Depth-1].ex,CurrentLocationSpan); @@ -6346,128 +6366,128 @@ public partial class GPPGParser: ShiftReduceParser term + case 710: // term1 -> term { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 710: // term1 -> term1, addop, term + case 711: // term1 -> term1, addop, term { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); } break; - case 711: // term1 -> term1, addop, new_question_expr + case 712: // term1 -> term1, addop, new_question_expr { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); } break; - case 712: // addop -> tkPlus + case 713: // addop -> tkPlus { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 713: // addop -> tkMinus + case 714: // addop -> tkMinus { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 714: // addop -> tkOr + case 715: // addop -> tkOr { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 715: // addop -> tkXor + case 716: // addop -> tkXor { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 716: // addop -> tkCSharpStyleOr + case 717: // addop -> tkCSharpStyleOr { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 717: // typecast_op -> tkAs + case 718: // typecast_op -> tkAs { CurrentSemanticValue.ob = op_typecast.as_op; } break; - case 718: // typecast_op -> tkIs + case 719: // typecast_op -> tkIs { CurrentSemanticValue.ob = op_typecast.is_op; } break; - case 719: // as_is_expr -> is_type_expr + case 720: // as_is_expr -> is_type_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 720: // as_is_expr -> as_expr + case 721: // as_is_expr -> as_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 721: // as_expr -> term, tkAs, simple_or_template_type_reference + case 722: // as_expr -> term, tkAs, simple_or_template_type_reference { CurrentSemanticValue.ex = NewAsIsExpr(ValueStack[ValueStack.Depth-3].ex, op_typecast.as_op, ValueStack[ValueStack.Depth-1].td, CurrentLocationSpan); } break; - case 722: // as_expr -> term, tkAs, array_type + case 723: // as_expr -> term, tkAs, array_type { CurrentSemanticValue.ex = NewAsIsExpr(ValueStack[ValueStack.Depth-3].ex, op_typecast.as_op, ValueStack[ValueStack.Depth-1].td, CurrentLocationSpan); } break; - case 723: // is_type_expr -> term, tkIs, simple_or_template_type_reference + case 724: // is_type_expr -> term, tkIs, simple_or_template_type_reference { CurrentSemanticValue.ex = NewAsIsExpr(ValueStack[ValueStack.Depth-3].ex, op_typecast.is_op, ValueStack[ValueStack.Depth-1].td, CurrentLocationSpan); } break; - case 724: // is_type_expr -> term, tkIs, array_type + case 725: // is_type_expr -> term, tkIs, array_type { CurrentSemanticValue.ex = NewAsIsExpr(ValueStack[ValueStack.Depth-3].ex, op_typecast.as_op, ValueStack[ValueStack.Depth-1].td, CurrentLocationSpan); } break; - case 725: // power_expr -> factor_without_unary_op, tkStarStar, factor + case 726: // power_expr -> factor_without_unary_op, tkStarStar, factor { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex,ValueStack[ValueStack.Depth-1].ex,(ValueStack[ValueStack.Depth-2].op).type, CurrentLocationSpan); } break; - case 726: // power_expr -> factor_without_unary_op, tkStarStar, power_expr + case 727: // power_expr -> factor_without_unary_op, tkStarStar, power_expr { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex,ValueStack[ValueStack.Depth-1].ex,(ValueStack[ValueStack.Depth-2].op).type, CurrentLocationSpan); } break; - case 727: // power_expr -> sign, power_expr + case 728: // power_expr -> sign, power_expr { CurrentSemanticValue.ex = new un_expr(ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); } break; - case 728: // term -> factor + case 729: // term -> factor { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 729: // term -> new_expr + case 730: // term -> new_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 730: // term -> power_expr + case 731: // term -> power_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 731: // term -> term, mulop, factor + case 732: // term -> term, mulop, factor { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex,ValueStack[ValueStack.Depth-1].ex,(ValueStack[ValueStack.Depth-2].op).type, CurrentLocationSpan); } break; - case 732: // term -> term, mulop, power_expr + case 733: // term -> term, mulop, power_expr { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex,ValueStack[ValueStack.Depth-1].ex,(ValueStack[ValueStack.Depth-2].op).type, CurrentLocationSpan); } break; - case 733: // term -> term, mulop, new_question_expr + case 734: // term -> term, mulop, new_question_expr { CurrentSemanticValue.ex = new bin_expr(ValueStack[ValueStack.Depth-3].ex,ValueStack[ValueStack.Depth-1].ex,(ValueStack[ValueStack.Depth-2].op).type, CurrentLocationSpan); } break; - case 734: // term -> as_is_expr + case 735: // term -> as_is_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 735: // mulop -> tkStar + case 736: // mulop -> tkStar { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 736: // mulop -> tkSlash + case 737: // mulop -> tkSlash { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 737: // mulop -> tkDiv + case 738: // mulop -> tkDiv { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 738: // mulop -> tkMod + case 739: // mulop -> tkMod { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 739: // mulop -> tkShl + case 740: // mulop -> tkShl { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 740: // mulop -> tkShr + case 741: // mulop -> tkShr { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 741: // mulop -> tkAnd + case 742: // mulop -> tkAnd { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 742: // default_expr -> tkDefault, tkRoundOpen, simple_or_template_type_reference, + case 743: // default_expr -> tkDefault, tkRoundOpen, simple_or_template_type_reference, // tkRoundClose { CurrentSemanticValue.ex = new default_operator(ValueStack[ValueStack.Depth-2].td as named_type_reference, CurrentLocationSpan); } break; - case 743: // tuple -> tkRoundOpen, expr_l1_or_unpacked, tkComma, expr_l1_or_unpacked_list, + case 744: // tuple -> tkRoundOpen, expr_l1_or_unpacked, tkComma, expr_l1_or_unpacked_list, // lambda_type_ref, optional_full_lambda_fp_list, tkRoundClose { if (ValueStack[ValueStack.Depth-6].ex is unpacked_list_of_ident_or_list) @@ -6486,35 +6506,35 @@ public partial class GPPGParser: ShiftReduceParser literal_or_number + case 745: // factor_without_unary_op -> literal_or_number { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 745: // factor_without_unary_op -> var_reference + case 746: // factor_without_unary_op -> var_reference { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 746: // factor -> tkNil + case 747: // factor -> tkNil { CurrentSemanticValue.ex = new nil_const(); CurrentSemanticValue.ex.source_context = CurrentLocationSpan; } break; - case 747: // factor -> literal_or_number + case 748: // factor -> literal_or_number { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 748: // factor -> default_expr + case 749: // factor -> default_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 749: // factor -> tkSquareOpen, elem_list, tkSquareClose + case 750: // factor -> tkSquareOpen, elem_list, tkSquareClose { CurrentSemanticValue.ex = new pascal_set_constant(ValueStack[ValueStack.Depth-2].stn as expression_list, CurrentLocationSpan); } break; - case 750: // factor -> tkNot, factor + case 751: // factor -> tkNot, factor { CurrentSemanticValue.ex = new un_expr(ValueStack[ValueStack.Depth-1].ex, ValueStack[ValueStack.Depth-2].op.type, CurrentLocationSpan); } break; - case 751: // factor -> sign, factor + case 752: // factor -> sign, factor { if (ValueStack[ValueStack.Depth-2].op.type == Operators.Minus) { @@ -6540,114 +6560,114 @@ public partial class GPPGParser: ShiftReduceParser tkDeref, factor + case 753: // factor -> tkDeref, factor { CurrentSemanticValue.ex = new index(ValueStack[ValueStack.Depth-1].ex, true, CurrentLocationSpan); } break; - case 753: // factor -> var_reference + case 754: // factor -> var_reference { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 754: // factor -> tuple + case 755: // factor -> tuple { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 755: // literal_or_number -> literal + case 756: // literal_or_number -> literal { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 756: // literal_or_number -> unsigned_number + case 757: // literal_or_number -> unsigned_number { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 757: // var_question_point -> variable, tkQuestionPoint, variable + case 758: // var_question_point -> variable, tkQuestionPoint, variable { CurrentSemanticValue.ex = new dot_question_node(ValueStack[ValueStack.Depth-3].ex as addressed_value,ValueStack[ValueStack.Depth-1].ex as addressed_value,CurrentLocationSpan); } break; - case 758: // var_question_point -> variable, tkQuestionPoint, var_question_point + case 759: // var_question_point -> variable, tkQuestionPoint, var_question_point { CurrentSemanticValue.ex = new dot_question_node(ValueStack[ValueStack.Depth-3].ex as addressed_value,ValueStack[ValueStack.Depth-1].ex as addressed_value,CurrentLocationSpan); } break; - case 759: // var_reference -> var_address, variable + case 760: // var_reference -> var_address, variable { CurrentSemanticValue.ex = NewVarReference(ValueStack[ValueStack.Depth-2].stn as get_address, ValueStack[ValueStack.Depth-1].ex as addressed_value, CurrentLocationSpan); } break; - case 760: // var_reference -> variable + case 761: // var_reference -> variable { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 761: // var_reference -> var_question_point + case 762: // var_reference -> var_question_point { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 762: // var_address -> tkAddressOf + case 763: // var_address -> tkAddressOf { CurrentSemanticValue.stn = NewVarAddress(CurrentLocationSpan); } break; - case 763: // var_address -> var_address, tkAddressOf + case 764: // var_address -> var_address, tkAddressOf { CurrentSemanticValue.stn = NewVarAddress(ValueStack[ValueStack.Depth-2].stn as get_address, CurrentLocationSpan); } break; - case 764: // attribute_variable -> simple_type_identifier, optional_expr_list_with_bracket + case 765: // attribute_variable -> simple_type_identifier, optional_expr_list_with_bracket { CurrentSemanticValue.stn = new attribute(null, ValueStack[ValueStack.Depth-2].td as named_type_reference, ValueStack[ValueStack.Depth-1].stn as expression_list, CurrentLocationSpan); } break; - case 765: // attribute_variable -> template_type, optional_expr_list_with_bracket + case 766: // attribute_variable -> template_type, optional_expr_list_with_bracket { CurrentSemanticValue.stn = new attribute(null, ValueStack[ValueStack.Depth-2].td as named_type_reference, ValueStack[ValueStack.Depth-1].stn as expression_list, CurrentLocationSpan); } break; - case 766: // dotted_identifier -> identifier + case 767: // dotted_identifier -> identifier { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].id; } break; - case 767: // dotted_identifier -> dotted_identifier, tkPoint, identifier_or_keyword + case 768: // dotted_identifier -> dotted_identifier, tkPoint, identifier_or_keyword { CurrentSemanticValue.ex = new dot_node(ValueStack[ValueStack.Depth-3].ex as addressed_value, ValueStack[ValueStack.Depth-1].id as addressed_value, CurrentLocationSpan); } break; - case 768: // variable_as_type -> dotted_identifier + case 769: // variable_as_type -> dotted_identifier { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex;} break; - case 769: // variable_as_type -> dotted_identifier, template_type_params + case 770: // variable_as_type -> dotted_identifier, template_type_params { CurrentSemanticValue.ex = new ident_with_templateparams(ValueStack[ValueStack.Depth-2].ex as addressed_value, ValueStack[ValueStack.Depth-1].stn as template_param_list, CurrentLocationSpan); } break; - case 770: // variable_or_literal_or_number -> variable + case 771: // variable_or_literal_or_number -> variable { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 771: // variable_or_literal_or_number -> literal_or_number + case 772: // variable_or_literal_or_number -> literal_or_number { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 772: // var_with_init_for_expr_with_let -> tkVar, identifier, tkAssign, expr, + case 773: // var_with_init_for_expr_with_let -> tkVar, identifier, tkAssign, expr, // tkSemiColon { CurrentSemanticValue.stn = new assign(ValueStack[ValueStack.Depth-4].id as addressed_value, ValueStack[ValueStack.Depth-2].ex, Operators.Assignment, CurrentLocationSpan); } break; - case 773: // var_with_init_for_expr_with_let_list -> var_with_init_for_expr_with_let + case 774: // var_with_init_for_expr_with_let_list -> var_with_init_for_expr_with_let { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 774: // var_with_init_for_expr_with_let_list -> var_with_init_for_expr_with_let_list, + case 775: // var_with_init_for_expr_with_let_list -> var_with_init_for_expr_with_let_list, // var_with_init_for_expr_with_let { ValueStack[ValueStack.Depth-2].stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-2].stn; } break; - case 775: // variable -> identifier + case 776: // variable -> identifier { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].id; } break; - case 776: // variable -> operator_name_ident + case 777: // variable -> operator_name_ident { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 777: // variable -> tkInherited, identifier + case 778: // variable -> tkInherited, identifier { CurrentSemanticValue.ex = new inherited_ident(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 778: // variable -> tkRoundOpen, expr, tkRoundClose + case 779: // variable -> tkRoundOpen, expr, tkRoundClose { if (!parsertools.build_tree_for_formatter) { @@ -6657,7 +6677,7 @@ public partial class GPPGParser: ShiftReduceParser tkRoundOpen, var_with_init_for_expr_with_let_list, expr, + case 780: // variable -> tkRoundOpen, var_with_init_for_expr_with_let_list, expr, // tkRoundClose { if (!parsertools.build_tree_for_formatter) @@ -6668,18 +6688,18 @@ public partial class GPPGParser: ShiftReduceParser sizeof_expr + case 781: // variable -> sizeof_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 781: // variable -> typeof_expr + case 782: // variable -> typeof_expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 782: // variable -> literal_or_number, tkPoint, identifier_or_keyword + case 783: // variable -> literal_or_number, tkPoint, identifier_or_keyword { CurrentSemanticValue.ex = new dot_node(ValueStack[ValueStack.Depth-3].ex as addressed_value, ValueStack[ValueStack.Depth-1].id as addressed_value, CurrentLocationSpan); } break; - case 783: // variable -> variable_or_literal_or_number, tkSquareOpen, expr_list, + case 784: // variable -> variable_or_literal_or_number, tkSquareOpen, expr_list, // tkSquareClose { var el = ValueStack[ValueStack.Depth-2].stn as expression_list; // SSM 10/03/16 @@ -6725,7 +6745,7 @@ public partial class GPPGParser: ShiftReduceParser variable_or_literal_or_number, tkQuestionSquareOpen, format_expr, + case 785: // variable -> variable_or_literal_or_number, tkQuestionSquareOpen, format_expr, // tkSquareClose { var fe = ValueStack[ValueStack.Depth-2].ex as format_expr; // SSM 9/01/17 @@ -6739,76 +6759,76 @@ public partial class GPPGParser: ShiftReduceParser tkVertParen, elem_list, tkVertParen + case 786: // variable -> tkVertParen, elem_list, tkVertParen { CurrentSemanticValue.ex = new array_const_new(ValueStack[ValueStack.Depth-2].stn as expression_list, CurrentLocationSpan); } break; - case 786: // variable -> variable, tkRoundOpen, optional_expr_list, tkRoundClose + case 787: // variable -> variable, tkRoundOpen, optional_expr_list, tkRoundClose { CurrentSemanticValue.ex = new method_call(ValueStack[ValueStack.Depth-4].ex as addressed_value,ValueStack[ValueStack.Depth-2].stn as expression_list, CurrentLocationSpan); } break; - case 787: // variable -> variable, tkPoint, identifier_keyword_operatorname + case 788: // variable -> variable, tkPoint, identifier_keyword_operatorname { CurrentSemanticValue.ex = new dot_node(ValueStack[ValueStack.Depth-3].ex as addressed_value, ValueStack[ValueStack.Depth-1].id as addressed_value, CurrentLocationSpan); } break; - case 788: // variable -> tuple, tkPoint, identifier_keyword_operatorname + case 789: // variable -> tuple, tkPoint, identifier_keyword_operatorname { CurrentSemanticValue.ex = new dot_node(ValueStack[ValueStack.Depth-3].ex as addressed_value, ValueStack[ValueStack.Depth-1].id as addressed_value, CurrentLocationSpan); } break; - case 789: // variable -> variable, tkDeref + case 790: // variable -> variable, tkDeref { CurrentSemanticValue.ex = new roof_dereference(ValueStack[ValueStack.Depth-2].ex as addressed_value,CurrentLocationSpan); } break; - case 790: // variable -> variable, tkAmpersend, template_type_params + case 791: // variable -> variable, tkAmpersend, template_type_params { CurrentSemanticValue.ex = new ident_with_templateparams(ValueStack[ValueStack.Depth-3].ex as addressed_value, ValueStack[ValueStack.Depth-1].stn as template_param_list, CurrentLocationSpan); } break; - case 791: // optional_expr_list -> expr_list + case 792: // optional_expr_list -> expr_list { CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } break; - case 792: // optional_expr_list -> /* empty */ + case 793: // optional_expr_list -> /* empty */ { CurrentSemanticValue.stn = null; } break; - case 793: // elem_list -> elem_list1 + case 794: // elem_list -> elem_list1 { CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } break; - case 794: // elem_list -> /* empty */ + case 795: // elem_list -> /* empty */ { CurrentSemanticValue.stn = null; } break; - case 795: // elem_list1 -> elem + case 796: // elem_list1 -> elem { CurrentSemanticValue.stn = new expression_list(ValueStack[ValueStack.Depth-1].ex, CurrentLocationSpan); } break; - case 796: // elem_list1 -> elem_list1, tkComma, elem + case 797: // elem_list1 -> elem_list1, tkComma, elem { CurrentSemanticValue.stn = (ValueStack[ValueStack.Depth-3].stn as expression_list).Add(ValueStack[ValueStack.Depth-1].ex, CurrentLocationSpan); } break; - case 797: // elem -> expr + case 798: // elem -> expr { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 798: // elem -> expr, tkDotDot, expr + case 799: // elem -> expr, tkDotDot, expr { CurrentSemanticValue.ex = new diapason_expr(ValueStack[ValueStack.Depth-3].ex, ValueStack[ValueStack.Depth-1].ex, CurrentLocationSpan); } break; - case 799: // one_literal -> tkStringLiteral + case 800: // one_literal -> tkStringLiteral { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].stn as literal; } break; - case 800: // one_literal -> tkAsciiChar + case 801: // one_literal -> tkAsciiChar { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].stn as literal; } break; - case 801: // literal -> literal_list + case 802: // literal -> literal_list { CurrentSemanticValue.ex = NewLiteral(ValueStack[ValueStack.Depth-1].stn as literal_const_line); } break; - case 802: // literal -> tkFormatStringLiteral + case 803: // literal -> tkFormatStringLiteral { if (parsertools.build_tree_for_formatter) { @@ -6820,12 +6840,12 @@ public partial class GPPGParser: ShiftReduceParser one_literal + case 804: // literal_list -> one_literal { CurrentSemanticValue.stn = new literal_const_line(ValueStack[ValueStack.Depth-1].ex as literal, CurrentLocationSpan); } break; - case 804: // literal_list -> literal_list, one_literal + case 805: // literal_list -> literal_list, one_literal { var line = ValueStack[ValueStack.Depth-2].stn as literal_const_line; if (line.literals.Last() is string_const && ValueStack[ValueStack.Depth-1].ex is string_const) @@ -6833,475 +6853,475 @@ public partial class GPPGParser: ShiftReduceParser tkOperator, overload_operator + case 806: // operator_name_ident -> tkOperator, overload_operator { CurrentSemanticValue.ex = new operator_name_ident((ValueStack[ValueStack.Depth-1].op as op_type_node).text, (ValueStack[ValueStack.Depth-1].op as op_type_node).type, CurrentLocationSpan); } break; - case 806: // optional_method_modificators -> tkSemiColon + case 807: // optional_method_modificators -> tkSemiColon { CurrentSemanticValue.stn = new procedure_attributes_list(new List(),CurrentLocationSpan); } break; - case 807: // optional_method_modificators -> tkSemiColon, meth_modificators, tkSemiColon + case 808: // optional_method_modificators -> tkSemiColon, meth_modificators, tkSemiColon { //parsertools.AddModifier((procedure_attributes_list)$2, proc_attribute.attr_overload); CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-2].stn; } break; - case 808: // optional_method_modificators1 -> /* empty */ + case 809: // optional_method_modificators1 -> /* empty */ { CurrentSemanticValue.stn = new procedure_attributes_list(new List(),CurrentLocationSpan); } break; - case 809: // optional_method_modificators1 -> tkSemiColon, meth_modificators + case 810: // optional_method_modificators1 -> tkSemiColon, meth_modificators { //parsertools.AddModifier((procedure_attributes_list)$2, proc_attribute.attr_overload); CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } break; - case 810: // meth_modificators -> meth_modificator + case 811: // meth_modificators -> meth_modificator { CurrentSemanticValue.stn = new procedure_attributes_list(ValueStack[ValueStack.Depth-1].id as procedure_attribute, CurrentLocationSpan); } break; - case 811: // meth_modificators -> meth_modificators, tkSemiColon, meth_modificator + case 812: // meth_modificators -> meth_modificators, tkSemiColon, meth_modificator { CurrentSemanticValue.stn = (ValueStack[ValueStack.Depth-3].stn as procedure_attributes_list).Add(ValueStack[ValueStack.Depth-1].id as procedure_attribute, CurrentLocationSpan); } break; - case 812: // identifier -> tkIdentifier + case 813: // identifier -> tkIdentifier { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 813: // identifier -> property_specifier_directives + case 814: // identifier -> property_specifier_directives { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 814: // identifier -> non_reserved + case 815: // identifier -> non_reserved { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 815: // identifier_or_keyword -> identifier + case 816: // identifier_or_keyword -> identifier { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 816: // identifier_or_keyword -> keyword + case 817: // identifier_or_keyword -> keyword { CurrentSemanticValue.id = new ident(ValueStack[ValueStack.Depth-1].ti.text, CurrentLocationSpan); } break; - case 817: // identifier_or_keyword -> reserved_keyword + case 818: // identifier_or_keyword -> reserved_keyword { CurrentSemanticValue.id = new ident(ValueStack[ValueStack.Depth-1].ti.text, CurrentLocationSpan); } break; - case 818: // identifier_keyword_operatorname -> identifier + case 819: // identifier_keyword_operatorname -> identifier { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 819: // identifier_keyword_operatorname -> keyword + case 820: // identifier_keyword_operatorname -> keyword { CurrentSemanticValue.id = new ident(ValueStack[ValueStack.Depth-1].ti.text, CurrentLocationSpan); } break; - case 820: // identifier_keyword_operatorname -> operator_name_ident + case 821: // identifier_keyword_operatorname -> operator_name_ident { CurrentSemanticValue.id = (ident)ValueStack[ValueStack.Depth-1].ex; } break; - case 821: // meth_modificator -> tkAbstract + case 822: // meth_modificator -> tkAbstract { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 822: // meth_modificator -> tkOverload + case 823: // meth_modificator -> tkOverload { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; parsertools.AddWarningFromResource("OVERLOAD_IS_NOT_USED", ValueStack[ValueStack.Depth-1].id.source_context); } break; - case 823: // meth_modificator -> tkReintroduce + case 824: // meth_modificator -> tkReintroduce { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 824: // meth_modificator -> tkOverride + case 825: // meth_modificator -> tkOverride { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 825: // meth_modificator -> tkExtensionMethod + case 826: // meth_modificator -> tkExtensionMethod { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 826: // meth_modificator -> tkVirtual + case 827: // meth_modificator -> tkVirtual { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 827: // property_modificator -> tkVirtual + case 828: // property_modificator -> tkVirtual { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 828: // property_modificator -> tkOverride + case 829: // property_modificator -> tkOverride { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 829: // property_modificator -> tkAbstract + case 830: // property_modificator -> tkAbstract { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 830: // property_modificator -> tkReintroduce + case 831: // property_modificator -> tkReintroduce { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 831: // property_specifier_directives -> tkRead + case 832: // property_specifier_directives -> tkRead { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 832: // property_specifier_directives -> tkWrite + case 833: // property_specifier_directives -> tkWrite { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 833: // non_reserved -> tkName + case 834: // non_reserved -> tkName { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 834: // non_reserved -> tkNew + case 835: // non_reserved -> tkNew { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 835: // visibility_specifier -> tkInternal + case 836: // visibility_specifier -> tkInternal { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 836: // visibility_specifier -> tkPublic + case 837: // visibility_specifier -> tkPublic { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 837: // visibility_specifier -> tkProtected + case 838: // visibility_specifier -> tkProtected { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 838: // visibility_specifier -> tkPrivate + case 839: // visibility_specifier -> tkPrivate { CurrentSemanticValue.id = ValueStack[ValueStack.Depth-1].id; } break; - case 839: // keyword -> visibility_specifier + case 840: // keyword -> visibility_specifier { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 840: // keyword -> tkSealed + case 841: // keyword -> tkSealed { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 841: // keyword -> tkTemplate + case 842: // keyword -> tkTemplate { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 842: // keyword -> tkOr + case 843: // keyword -> tkOr { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 843: // keyword -> tkTypeOf + case 844: // keyword -> tkTypeOf { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 844: // keyword -> tkSizeOf + case 845: // keyword -> tkSizeOf { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 845: // keyword -> tkDefault + case 846: // keyword -> tkDefault { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 846: // keyword -> tkWhere + case 847: // keyword -> tkWhere { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 847: // keyword -> tkXor + case 848: // keyword -> tkXor { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 848: // keyword -> tkAnd + case 849: // keyword -> tkAnd { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 849: // keyword -> tkDiv + case 850: // keyword -> tkDiv { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 850: // keyword -> tkMod + case 851: // keyword -> tkMod { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 851: // keyword -> tkShl + case 852: // keyword -> tkShl { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 852: // keyword -> tkShr + case 853: // keyword -> tkShr { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 853: // keyword -> tkNot + case 854: // keyword -> tkNot { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 854: // keyword -> tkAs + case 855: // keyword -> tkAs { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 855: // keyword -> tkIn + case 856: // keyword -> tkIn { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 856: // keyword -> tkIs + case 857: // keyword -> tkIs { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 857: // keyword -> tkArray + case 858: // keyword -> tkArray { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 858: // keyword -> tkSequence + case 859: // keyword -> tkSequence { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 859: // keyword -> tkBegin + case 860: // keyword -> tkBegin { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 860: // keyword -> tkCase + case 861: // keyword -> tkCase { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 861: // keyword -> tkClass + case 862: // keyword -> tkClass { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 862: // keyword -> tkConst + case 863: // keyword -> tkConst { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 863: // keyword -> tkConstructor + case 864: // keyword -> tkConstructor { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 864: // keyword -> tkDestructor + case 865: // keyword -> tkDestructor { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 865: // keyword -> tkDownto + case 866: // keyword -> tkDownto { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 866: // keyword -> tkDo + case 867: // keyword -> tkDo { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 867: // keyword -> tkElse + case 868: // keyword -> tkElse { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 868: // keyword -> tkEnd + case 869: // keyword -> tkEnd { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 869: // keyword -> tkExcept + case 870: // keyword -> tkExcept { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 870: // keyword -> tkFile + case 871: // keyword -> tkFile { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 871: // keyword -> tkAuto + case 872: // keyword -> tkAuto { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 872: // keyword -> tkFinalization + case 873: // keyword -> tkFinalization { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 873: // keyword -> tkFinally + case 874: // keyword -> tkFinally { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 874: // keyword -> tkFor + case 875: // keyword -> tkFor { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 875: // keyword -> tkForeach + case 876: // keyword -> tkForeach { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 876: // keyword -> tkFunction + case 877: // keyword -> tkFunction { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 877: // keyword -> tkIf + case 878: // keyword -> tkIf { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 878: // keyword -> tkImplementation + case 879: // keyword -> tkImplementation { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 879: // keyword -> tkInherited + case 880: // keyword -> tkInherited { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 880: // keyword -> tkInitialization + case 881: // keyword -> tkInitialization { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 881: // keyword -> tkInterface + case 882: // keyword -> tkInterface { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 882: // keyword -> tkProcedure + case 883: // keyword -> tkProcedure { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 883: // keyword -> tkProperty + case 884: // keyword -> tkProperty { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 884: // keyword -> tkRaise + case 885: // keyword -> tkRaise { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 885: // keyword -> tkRecord + case 886: // keyword -> tkRecord { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 886: // keyword -> tkRepeat + case 887: // keyword -> tkRepeat { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 887: // keyword -> tkSet + case 888: // keyword -> tkSet { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 888: // keyword -> tkTry + case 889: // keyword -> tkTry { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 889: // keyword -> tkType + case 890: // keyword -> tkType { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 890: // keyword -> tkStatic + case 891: // keyword -> tkStatic { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 891: // keyword -> tkThen + case 892: // keyword -> tkThen { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 892: // keyword -> tkTo + case 893: // keyword -> tkTo { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 893: // keyword -> tkUntil + case 894: // keyword -> tkUntil { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 894: // keyword -> tkUses + case 895: // keyword -> tkUses { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 895: // keyword -> tkVar + case 896: // keyword -> tkVar { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 896: // keyword -> tkWhile + case 897: // keyword -> tkWhile { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 897: // keyword -> tkWith + case 898: // keyword -> tkWith { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 898: // keyword -> tkNil + case 899: // keyword -> tkNil { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 899: // keyword -> tkGoto + case 900: // keyword -> tkGoto { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 900: // keyword -> tkOf + case 901: // keyword -> tkOf { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 901: // keyword -> tkLabel + case 902: // keyword -> tkLabel { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 902: // keyword -> tkProgram + case 903: // keyword -> tkProgram { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 903: // keyword -> tkUnit + case 904: // keyword -> tkUnit { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 904: // keyword -> tkLibrary + case 905: // keyword -> tkLibrary { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 905: // keyword -> tkNamespace + case 906: // keyword -> tkNamespace { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 906: // keyword -> tkExternal + case 907: // keyword -> tkExternal { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 907: // keyword -> tkParams + case 908: // keyword -> tkParams { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 908: // keyword -> tkEvent + case 909: // keyword -> tkEvent { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 909: // keyword -> tkYield + case 910: // keyword -> tkYield { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 910: // keyword -> tkMatch + case 911: // keyword -> tkMatch { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 911: // keyword -> tkWhen + case 912: // keyword -> tkWhen { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 912: // keyword -> tkPartial + case 913: // keyword -> tkPartial { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 913: // keyword -> tkAbstract + case 914: // keyword -> tkAbstract { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 914: // keyword -> tkLock + case 915: // keyword -> tkLock { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 915: // keyword -> tkImplicit + case 916: // keyword -> tkImplicit { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 916: // keyword -> tkExplicit + case 917: // keyword -> tkExplicit { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].op; } break; - case 917: // keyword -> tkOn + case 918: // keyword -> tkOn { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 918: // keyword -> tkVirtual + case 919: // keyword -> tkVirtual { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 919: // keyword -> tkOverride + case 920: // keyword -> tkOverride { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 920: // keyword -> tkLoop + case 921: // keyword -> tkLoop { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 921: // keyword -> tkExtensionMethod + case 922: // keyword -> tkExtensionMethod { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 922: // keyword -> tkOverload + case 923: // keyword -> tkOverload { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 923: // keyword -> tkReintroduce + case 924: // keyword -> tkReintroduce { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 924: // keyword -> tkForward + case 925: // keyword -> tkForward { CurrentSemanticValue.ti = new token_info(ValueStack[ValueStack.Depth-1].id.name, CurrentLocationSpan); } break; - case 925: // reserved_keyword -> tkOperator + case 926: // reserved_keyword -> tkOperator { CurrentSemanticValue.ti = ValueStack[ValueStack.Depth-1].ti; } break; - case 926: // overload_operator -> tkMinus + case 927: // overload_operator -> tkMinus { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 927: // overload_operator -> tkPlus + case 928: // overload_operator -> tkPlus { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 928: // overload_operator -> tkSlash + case 929: // overload_operator -> tkSlash { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 929: // overload_operator -> tkStar + case 930: // overload_operator -> tkStar { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 930: // overload_operator -> tkEqual + case 931: // overload_operator -> tkEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 931: // overload_operator -> tkGreater + case 932: // overload_operator -> tkGreater { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 932: // overload_operator -> tkGreaterEqual + case 933: // overload_operator -> tkGreaterEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 933: // overload_operator -> tkLower + case 934: // overload_operator -> tkLower { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 934: // overload_operator -> tkLowerEqual + case 935: // overload_operator -> tkLowerEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 935: // overload_operator -> tkNotEqual + case 936: // overload_operator -> tkNotEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 936: // overload_operator -> tkOr + case 937: // overload_operator -> tkOr { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 937: // overload_operator -> tkXor + case 938: // overload_operator -> tkXor { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 938: // overload_operator -> tkAnd + case 939: // overload_operator -> tkAnd { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 939: // overload_operator -> tkDiv + case 940: // overload_operator -> tkDiv { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 940: // overload_operator -> tkMod + case 941: // overload_operator -> tkMod { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 941: // overload_operator -> tkShl + case 942: // overload_operator -> tkShl { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 942: // overload_operator -> tkShr + case 943: // overload_operator -> tkShr { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 943: // overload_operator -> tkNot + case 944: // overload_operator -> tkNot { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 944: // overload_operator -> tkIn + case 945: // overload_operator -> tkIn { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 945: // overload_operator -> tkImplicit + case 946: // overload_operator -> tkImplicit { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 946: // overload_operator -> tkExplicit + case 947: // overload_operator -> tkExplicit { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 947: // overload_operator -> assign_operator + case 948: // overload_operator -> assign_operator { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 948: // overload_operator -> tkStarStar + case 949: // overload_operator -> tkStarStar { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 949: // assign_operator -> tkAssign + case 950: // assign_operator -> tkAssign { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 950: // assign_operator -> tkPlusEqual + case 951: // assign_operator -> tkPlusEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 951: // assign_operator -> tkMinusEqual + case 952: // assign_operator -> tkMinusEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 952: // assign_operator -> tkMultEqual + case 953: // assign_operator -> tkMultEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 953: // assign_operator -> tkDivEqual + case 954: // assign_operator -> tkDivEqual { CurrentSemanticValue.op = ValueStack[ValueStack.Depth-1].op; } break; - case 954: // lambda_unpacked_params -> tkBackSlashRoundOpen, + case 955: // lambda_unpacked_params -> tkBackSlashRoundOpen, // lambda_list_of_unpacked_params_or_id, tkComma, // lambda_unpacked_params_or_id, tkRoundClose { @@ -7310,24 +7330,24 @@ public partial class GPPGParser: ShiftReduceParser lambda_unpacked_params + case 956: // lambda_unpacked_params_or_id -> lambda_unpacked_params { CurrentSemanticValue.ob = new ident_or_list(ValueStack[ValueStack.Depth-1].ex as unpacked_list_of_ident_or_list); } break; - case 956: // lambda_unpacked_params_or_id -> identifier + case 957: // lambda_unpacked_params_or_id -> identifier { CurrentSemanticValue.ob = new ident_or_list(ValueStack[ValueStack.Depth-1].id as ident); } break; - case 957: // lambda_list_of_unpacked_params_or_id -> lambda_unpacked_params_or_id + case 958: // lambda_list_of_unpacked_params_or_id -> lambda_unpacked_params_or_id { CurrentSemanticValue.ob = new unpacked_list_of_ident_or_list(); (CurrentSemanticValue.ob as unpacked_list_of_ident_or_list).Add(ValueStack[ValueStack.Depth-1].ob as ident_or_list); (CurrentSemanticValue.ob as unpacked_list_of_ident_or_list).source_context = LocationStack[LocationStack.Depth-1]; } break; - case 958: // lambda_list_of_unpacked_params_or_id -> lambda_list_of_unpacked_params_or_id, + case 959: // lambda_list_of_unpacked_params_or_id -> lambda_list_of_unpacked_params_or_id, // tkComma, lambda_unpacked_params_or_id { CurrentSemanticValue.ob = ValueStack[ValueStack.Depth-3].ob; @@ -7335,24 +7355,24 @@ public partial class GPPGParser: ShiftReduceParser expr_l1 + case 960: // expr_l1_or_unpacked -> expr_l1 { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 960: // expr_l1_or_unpacked -> lambda_unpacked_params + case 961: // expr_l1_or_unpacked -> lambda_unpacked_params { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 961: // expr_l1_or_unpacked_list -> expr_l1_or_unpacked + case 962: // expr_l1_or_unpacked_list -> expr_l1_or_unpacked { CurrentSemanticValue.stn = new expression_list(ValueStack[ValueStack.Depth-1].ex, CurrentLocationSpan); } break; - case 962: // expr_l1_or_unpacked_list -> expr_l1_or_unpacked_list, tkComma, + case 963: // expr_l1_or_unpacked_list -> expr_l1_or_unpacked_list, tkComma, // expr_l1_or_unpacked { CurrentSemanticValue.stn = (ValueStack[ValueStack.Depth-3].stn as expression_list).Add(ValueStack[ValueStack.Depth-1].ex, CurrentLocationSpan); } break; - case 963: // func_decl_lambda -> identifier, tkArrow, lambda_function_body + case 964: // func_decl_lambda -> identifier, tkArrow, lambda_function_body { var idList = new ident_list(ValueStack[ValueStack.Depth-3].id, LocationStack[LocationStack.Depth-3]); var formalPars = new formal_parameters(new typed_parameters(idList, new lambda_inferred_type(new PascalABCCompiler.TreeRealization.lambda_any_type_node(), LocationStack[LocationStack.Depth-3]), parametr_kind.none, null, LocationStack[LocationStack.Depth-3]), LocationStack[LocationStack.Depth-3]); @@ -7363,7 +7383,7 @@ public partial class GPPGParser: ShiftReduceParser tkRoundOpen, tkRoundClose, lambda_type_ref_noproctype, + case 965: // func_decl_lambda -> tkRoundOpen, tkRoundClose, lambda_type_ref_noproctype, // tkArrow, lambda_function_body { // ����� ���� ������������� �� ���� � ���� ��������� lambda_inferred_type, ���� ������ ��� null! @@ -7373,7 +7393,7 @@ public partial class GPPGParser: ShiftReduceParser tkRoundOpen, identifier, tkColon, fptype, tkRoundClose, + case 966: // func_decl_lambda -> tkRoundOpen, identifier, tkColon, fptype, tkRoundClose, // lambda_type_ref_noproctype, tkArrow, lambda_function_body { var idList = new ident_list(ValueStack[ValueStack.Depth-7].id, LocationStack[LocationStack.Depth-7]); @@ -7385,7 +7405,7 @@ public partial class GPPGParser: ShiftReduceParser tkRoundOpen, identifier, tkSemiColon, full_lambda_fp_list, + case 967: // func_decl_lambda -> tkRoundOpen, identifier, tkSemiColon, full_lambda_fp_list, // tkRoundClose, lambda_type_ref_noproctype, tkArrow, // lambda_function_body { @@ -7399,7 +7419,7 @@ public partial class GPPGParser: ShiftReduceParser tkRoundOpen, identifier, tkColon, fptype, tkSemiColon, + case 968: // func_decl_lambda -> tkRoundOpen, identifier, tkColon, fptype, tkSemiColon, // full_lambda_fp_list, tkRoundClose, // lambda_type_ref_noproctype, tkArrow, lambda_function_body { @@ -7414,7 +7434,7 @@ public partial class GPPGParser: ShiftReduceParser tkRoundOpen, expr_l1_or_unpacked, tkComma, + case 969: // func_decl_lambda -> tkRoundOpen, expr_l1_or_unpacked, tkComma, // expr_l1_or_unpacked_list, lambda_type_ref, // optional_full_lambda_fp_list, tkRoundClose, rem_lambda { @@ -7524,7 +7544,7 @@ public partial class GPPGParser: ShiftReduceParser lambda_unpacked_params, rem_lambda + case 970: // func_decl_lambda -> lambda_unpacked_params, rem_lambda { var pair = ValueStack[ValueStack.Depth-1].ob as pair_type_stlist; // ���� ���������� ��������� - null. �������� �� �������� ��������� @@ -7536,62 +7556,62 @@ public partial class GPPGParser: ShiftReduceParser expl_func_decl_lambda + case 971: // func_decl_lambda -> expl_func_decl_lambda { CurrentSemanticValue.ex = ValueStack[ValueStack.Depth-1].ex; } break; - case 971: // optional_full_lambda_fp_list -> /* empty */ + case 972: // optional_full_lambda_fp_list -> /* empty */ { CurrentSemanticValue.stn = null; } break; - case 972: // optional_full_lambda_fp_list -> tkSemiColon, full_lambda_fp_list + case 973: // optional_full_lambda_fp_list -> tkSemiColon, full_lambda_fp_list { CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } break; - case 973: // rem_lambda -> lambda_type_ref_noproctype, tkArrow, lambda_function_body + case 974: // rem_lambda -> lambda_type_ref_noproctype, tkArrow, lambda_function_body { CurrentSemanticValue.ob = new pair_type_stlist(ValueStack[ValueStack.Depth-3].td,ValueStack[ValueStack.Depth-1].stn as statement_list); } break; - case 974: // expl_func_decl_lambda -> tkFunction, lambda_type_ref_noproctype, tkArrow, + case 975: // expl_func_decl_lambda -> tkFunction, lambda_type_ref_noproctype, tkArrow, // lambda_function_body { CurrentSemanticValue.ex = new function_lambda_definition(lambdaHelper.CreateLambdaName(), null, ValueStack[ValueStack.Depth-3].td, ValueStack[ValueStack.Depth-1].stn as statement_list, 1, CurrentLocationSpan); } break; - case 975: // expl_func_decl_lambda -> tkFunction, tkRoundOpen, tkRoundClose, + case 976: // expl_func_decl_lambda -> tkFunction, tkRoundOpen, tkRoundClose, // lambda_type_ref_noproctype, tkArrow, // lambda_function_body { CurrentSemanticValue.ex = new function_lambda_definition(lambdaHelper.CreateLambdaName(), null, ValueStack[ValueStack.Depth-3].td, ValueStack[ValueStack.Depth-1].stn as statement_list, 1, CurrentLocationSpan); } break; - case 976: // expl_func_decl_lambda -> tkFunction, tkRoundOpen, full_lambda_fp_list, + case 977: // expl_func_decl_lambda -> tkFunction, tkRoundOpen, full_lambda_fp_list, // tkRoundClose, lambda_type_ref_noproctype, tkArrow, // lambda_function_body { CurrentSemanticValue.ex = new function_lambda_definition(lambdaHelper.CreateLambdaName(), ValueStack[ValueStack.Depth-5].stn as formal_parameters, ValueStack[ValueStack.Depth-3].td, ValueStack[ValueStack.Depth-1].stn as statement_list, 1, CurrentLocationSpan); } break; - case 977: // expl_func_decl_lambda -> tkProcedure, tkArrow, lambda_procedure_body + case 978: // expl_func_decl_lambda -> tkProcedure, tkArrow, lambda_procedure_body { CurrentSemanticValue.ex = new function_lambda_definition(lambdaHelper.CreateLambdaName(), null, null, ValueStack[ValueStack.Depth-1].stn as statement_list, 2, CurrentLocationSpan); } break; - case 978: // expl_func_decl_lambda -> tkProcedure, tkRoundOpen, tkRoundClose, tkArrow, + case 979: // expl_func_decl_lambda -> tkProcedure, tkRoundOpen, tkRoundClose, tkArrow, // lambda_procedure_body { CurrentSemanticValue.ex = new function_lambda_definition(lambdaHelper.CreateLambdaName(), null, null, ValueStack[ValueStack.Depth-1].stn as statement_list, 2, CurrentLocationSpan); } break; - case 979: // expl_func_decl_lambda -> tkProcedure, tkRoundOpen, full_lambda_fp_list, + case 980: // expl_func_decl_lambda -> tkProcedure, tkRoundOpen, full_lambda_fp_list, // tkRoundClose, tkArrow, lambda_procedure_body { CurrentSemanticValue.ex = new function_lambda_definition(lambdaHelper.CreateLambdaName(), ValueStack[ValueStack.Depth-4].stn as formal_parameters, null, ValueStack[ValueStack.Depth-1].stn as statement_list, 2, CurrentLocationSpan); } break; - case 980: // full_lambda_fp_list -> lambda_simple_fp_sect + case 981: // full_lambda_fp_list -> lambda_simple_fp_sect { var typed_pars = ValueStack[ValueStack.Depth-1].stn as typed_parameters; if (typed_pars.vars_type is lambda_inferred_type) @@ -7611,102 +7631,102 @@ public partial class GPPGParser: ShiftReduceParser full_lambda_fp_list, tkSemiColon, lambda_simple_fp_sect + case 982: // full_lambda_fp_list -> full_lambda_fp_list, tkSemiColon, lambda_simple_fp_sect { CurrentSemanticValue.stn =(ValueStack[ValueStack.Depth-3].stn as formal_parameters).Add(ValueStack[ValueStack.Depth-1].stn as typed_parameters, CurrentLocationSpan); } break; - case 982: // lambda_simple_fp_sect -> ident_list, lambda_type_ref + case 983: // lambda_simple_fp_sect -> ident_list, lambda_type_ref { CurrentSemanticValue.stn = new typed_parameters(ValueStack[ValueStack.Depth-2].stn as ident_list, ValueStack[ValueStack.Depth-1].td, parametr_kind.none, null, CurrentLocationSpan); } break; - case 983: // lambda_type_ref -> /* empty */ + case 984: // lambda_type_ref -> /* empty */ { CurrentSemanticValue.td = new lambda_inferred_type(new PascalABCCompiler.TreeRealization.lambda_any_type_node(), null); } break; - case 984: // lambda_type_ref -> tkColon, fptype + case 985: // lambda_type_ref -> tkColon, fptype { CurrentSemanticValue.td = ValueStack[ValueStack.Depth-1].td; } break; - case 985: // lambda_type_ref_noproctype -> /* empty */ + case 986: // lambda_type_ref_noproctype -> /* empty */ { CurrentSemanticValue.td = new lambda_inferred_type(new PascalABCCompiler.TreeRealization.lambda_any_type_node(), null); } break; - case 986: // lambda_type_ref_noproctype -> tkColon, fptype_noproctype + case 987: // lambda_type_ref_noproctype -> tkColon, fptype_noproctype { CurrentSemanticValue.td = ValueStack[ValueStack.Depth-1].td; } break; - case 987: // common_lambda_body -> compound_stmt + case 988: // common_lambda_body -> compound_stmt { CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } break; - case 988: // common_lambda_body -> if_stmt + case 989: // common_lambda_body -> if_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 989: // common_lambda_body -> while_stmt + case 990: // common_lambda_body -> while_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 990: // common_lambda_body -> repeat_stmt + case 991: // common_lambda_body -> repeat_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 991: // common_lambda_body -> for_stmt + case 992: // common_lambda_body -> for_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 992: // common_lambda_body -> foreach_stmt + case 993: // common_lambda_body -> foreach_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 993: // common_lambda_body -> loop_stmt + case 994: // common_lambda_body -> loop_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 994: // common_lambda_body -> case_stmt + case 995: // common_lambda_body -> case_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 995: // common_lambda_body -> try_stmt + case 996: // common_lambda_body -> try_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 996: // common_lambda_body -> lock_stmt + case 997: // common_lambda_body -> lock_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 997: // common_lambda_body -> raise_stmt + case 998: // common_lambda_body -> raise_stmt { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 998: // common_lambda_body -> yield_stmt + case 999: // common_lambda_body -> yield_stmt { parsertools.AddErrorFromResource("YIELD_STATEMENT_CANNOT_BE_USED_IN_LAMBDA_BODY", CurrentLocationSpan); } break; - case 999: // common_lambda_body -> tkRoundOpen, assignment, tkRoundClose + case 1000: // common_lambda_body -> tkRoundOpen, assignment, tkRoundClose { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-2].stn as statement, CurrentLocationSpan); } break; - case 1000: // lambda_function_body -> expr_l1_for_lambda + case 1001: // lambda_function_body -> expr_l1_for_lambda { var id = SyntaxVisitors.HasNameVisitor.HasName(ValueStack[ValueStack.Depth-1].ex, "Result"); if (id != null) @@ -7718,22 +7738,22 @@ public partial class GPPGParser: ShiftReduceParser common_lambda_body + case 1002: // lambda_function_body -> common_lambda_body { CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } break; - case 1002: // lambda_procedure_body -> proc_call + case 1003: // lambda_procedure_body -> proc_call { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 1003: // lambda_procedure_body -> assignment + case 1004: // lambda_procedure_body -> assignment { CurrentSemanticValue.stn = new statement_list(ValueStack[ValueStack.Depth-1].stn as statement, CurrentLocationSpan); } break; - case 1004: // lambda_procedure_body -> common_lambda_body + case 1005: // lambda_procedure_body -> common_lambda_body { CurrentSemanticValue.stn = ValueStack[ValueStack.Depth-1].stn; } diff --git a/Parsers/PascalABCParserNewSaushkin/PABC.ymc b/Parsers/PascalABCParserNewSaushkin/PABC.ymc index 7faad014a..f3e8e83f5 100644 --- a/Parsers/PascalABCParserNewSaushkin/PABC.ymc +++ b/Parsers/PascalABCParserNewSaushkin/PABC.ymc @@ -347,6 +347,8 @@ script= + + diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 01e018071..e9a6a6313 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.8.1.2980 +3.8.1.2985 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index f69ef052a..45982b6d7 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.8.1.2980' +!define VERSION '3.8.1.2985' diff --git a/SyntaxTree/tree/TreeSubsidiary.cs b/SyntaxTree/tree/TreeSubsidiary.cs index 672683feb..cf960dba2 100644 --- a/SyntaxTree/tree/TreeSubsidiary.cs +++ b/SyntaxTree/tree/TreeSubsidiary.cs @@ -66,6 +66,7 @@ namespace PascalABCCompiler.SyntaxTree //Other operators Assignment, // := = In, // in + NotIn, // not in Is, // is As, // as Dereference, // ^ * diff --git a/SyntaxTreeConverters/StandardSyntaxConverter.cs b/SyntaxTreeConverters/StandardSyntaxConverter.cs index a08acd6b8..a94249535 100644 --- a/SyntaxTreeConverters/StandardSyntaxConverter.cs +++ b/SyntaxTreeConverters/StandardSyntaxConverter.cs @@ -56,6 +56,7 @@ namespace PascalABCCompiler.SyntaxTreeConverters // slice_expr и slice_expr_question SliceDesugarVisitor.New.ProcessNode(root); // поставил раньше AssignTuplesDesugarVisitor из за var (a,b) := a[1:3]; + // теперь коллизия с (a[1:6], a[6:11]):= (a[6:11], a[1:6]); // assign_tuple и assign_var_tuple AssignTuplesDesugarVisitor.New.ProcessNode(root); // теперь это - на семантике diff --git a/TestSuite/CompilationSamples/OpenCLABC.pas b/TestSuite/CompilationSamples/OpenCLABC.pas index bf3b5a1f4..85a8946c7 100644 --- a/TestSuite/CompilationSamples/OpenCLABC.pas +++ b/TestSuite/CompilationSamples/OpenCLABC.pas @@ -27,13 +27,42 @@ unit OpenCLABC; {$region ToDo} //=================================== -// Обязательно сделать до следующего пула: - -//ToDo .WhenDone после завершения выполнения странно себя вёл... +// Обязательно сделать до следующей стабильной версии: //=================================== // Запланированное: +//ToDo В описаниях в куче мест упоминаются буферы, которые вообще то теперь MemorySegment + +//ToDo q*4 - Повторение очереди 4 раза +// - Всегда можно использовать Combine(ArrFill(4,q)) +// - Но тогда внутри будет хранится массив - это лишнее, если все очереди одинаковые + +//ToDo Порядок Wait очередей в Wait группах +// - Проверить сочетание с каждой другой фичей + +//ToDo Перепродумать MemorySubSegment, в случае перевыделения основного буфера - он плохо себя ведёт... + +//ToDo boolean в CLArray +// - Его пытается маршлить как BOOL из C++, который имеет размер 4 байта +// - Проверить происходит ли собственно конверция +//ToDo CLBoolean? +// - boolean запретить не только в CLArray - во всех TRecord +//ToDo С char то же самое +//ToDO А для DateTime и размер посчитать не даёт + +//ToDo Преобразование array of T => KernelArg, используя CL_MEM_USE_HOST_PTR +// - #2478 + +//ToDo HFQ(()->S) не работает как ссылка на S:MemorySegment? + +//ToDo Использовать cl.EnqueueMapBuffer +// - В виде .AddMap((MappedArray,Context)->()) + +//ToDo Пройтись по интерфейсу, порасставлять кидание исключений +//ToDo Проверки и кидания исключений перед всеми cl.*, чтобы выводить норм сообщения об ошибках +// - В том числе проверки с помощью BlittableHelper + //ToDo Синхронные (с припиской Fast, а может Quick) варианты всего работающего по принципу HostQueue // //ToDo И асинхронные умнее запускать - помнить значение, указывающее можно ли выполнить их синхронно @@ -64,18 +93,9 @@ unit OpenCLABC; // - Вообще, поидее, должен быть более красивый способ добиться того же... Что то с контрактами? // - Обязательно сравнить скорость, перед тем как применять... -//ToDo Buffer переименовать в GPUMem -//ToDo И добавить типы как GPUArray - наверное с методом вроде .Flush, для более эффективной записи -// -//ToDo Инициалию буфера из BufferCommandQueue перенести в, собственно, вызовы GPUCommand.Invoke -// - И там же вызывать GPUArray.Flush - //ToDo Можно же сохранять неуправляемые очереди в список внутри CLTask, и затем использовать несколько раз // - И почему я раньше об этом не подумал... -//ToDo В тестеровщике, в тестах ошибок, в текстах ошибок - постоянно меняются номера лямбд... -// - Наверное стоит захардкодить в тестировщик игнор числа после "<>lambda", и так же для контейнера лямбды - //ToDo Заполнение Platform.All сейчас вылетит на компе с 0 платформ... // - Сразу не забыть исправить описание @@ -93,14 +113,8 @@ unit OpenCLABC; // - И только в WaitAll, другим Wait-ам это не нужно // - Или можно забыть про всё это и сделать+использовать AbortQueue чтоб убивать и Wait-ы, и всё остальное -//ToDo Проверки и кидания исключений перед всеми cl.*, чтобы выводить норм сообщения об ошибках -// - В том числе проверки с помощью BlittableHelper - //ToDo Создание SubDevice из cl_device_id -//ToDo Очереди-маркеры для Wait-очередей -// - чтобы не приходилось использовать константные для этого - //ToDo Очередь-обработчик ошибок // - .HandleExceptions // - Сделать легко, надо только вставить свой промежуточный CLTaskBase @@ -124,8 +138,6 @@ unit OpenCLABC; //ToDo Интегрировать профайлинг очередей -//ToDo Перепродумать SubBuffer, в случае перевыделения основного буфера - он плохо себя ведёт... - //ToDo Может всё же сделать защиту от дурака для "q.AddQueue(q)"? // - И в справке тогда убрать параграф... @@ -145,6 +157,7 @@ unit OpenCLABC; //ToDo https://github.com/pascalabcnet/pascalabcnet/issues/{id} // - #2221 // - #2431 +// - #2510 //ToDo Баги NVidia //ToDo https://developer.nvidia.com/nvidia_bug/{id} @@ -171,6 +184,9 @@ type {$region Re-definition's} + ///Класс исключений из OpenCL + OpenCLException = OpenCL.OpenCLException; + ///Тип устройства, поддерживающего OpenCL DeviceType = OpenCL.DeviceType; ///Уровень кэша, используемый в Device.SplitByAffinityDomain @@ -180,57 +196,34 @@ type {$region Properties} - {$region Buffer} + {$region Platform} - BufferProperties = sealed partial class + PlatformProperties = partial class - public constructor(ntv: cl_mem); + public constructor(ntv: cl_platform_id); private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - private function GetType: MemObjectType; - private function GetFlags: MemFlags; - private function GetSize: UIntPtr; - private function GetHostPtr: IntPtr; - private function GetMapCount: UInt32; - private function GetReferenceCount: UInt32; - private function GetUsesSvmPointer: Bool; - private function GetOffset: UIntPtr; + private function GetProfile: String; + private function GetVersion: String; + private function GetName: String; + private function GetVendor: String; + private function GetExtensions: String; + private function GetHostTimerResolution: UInt64; - public property &Type: MemObjectType read GetType; - public property Flags: MemFlags read GetFlags; - public property Size: UIntPtr read GetSize; - public property HostPtr: IntPtr read GetHostPtr; - public property MapCount: UInt32 read GetMapCount; - public property ReferenceCount: UInt32 read GetReferenceCount; - public property UsesSvmPointer: Bool read GetUsesSvmPointer; - public property Offset: UIntPtr read GetOffset; + public property Profile: String read GetProfile; + public property Version: String read GetVersion; + public property Name: String read GetName; + public property Vendor: String read GetVendor; + public property Extensions: String read GetExtensions; + public property HostTimerResolution: UInt64 read GetHostTimerResolution; end; - {$endregion Buffer} - - {$region Context} - - ContextProperties = sealed partial class - - public constructor(ntv: cl_context); - private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - - private function GetReferenceCount: UInt32; - private function GetNumDevices: UInt32; - private function GetProperties: array of ContextProperties; - - public property ReferenceCount: UInt32 read GetReferenceCount; - public property NumDevices: UInt32 read GetNumDevices; - public property Properties: array of ContextProperties read GetProperties; - - end; - - {$endregion Context} + {$endregion Platform} {$region Device} - DeviceProperties = sealed partial class + DeviceProperties = partial class public constructor(ntv: cl_device_id); private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); @@ -417,55 +410,28 @@ type {$endregion Device} - {$region Kernel} + {$region Context} - KernelProperties = sealed partial class + ContextProperties = partial class - public constructor(ntv: cl_kernel); + public constructor(ntv: cl_context); private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - private function GetFunctionName: String; - private function GetNumArgs: UInt32; private function GetReferenceCount: UInt32; - private function GetAttributes: String; + private function GetNumDevices: UInt32; + private function GetProperties: array of ContextProperties; - public property FunctionName: String read GetFunctionName; - public property NumArgs: UInt32 read GetNumArgs; - public property ReferenceCount: UInt32 read GetReferenceCount; - public property Attributes: String read GetAttributes; + public property ReferenceCount: UInt32 read GetReferenceCount; + public property NumDevices: UInt32 read GetNumDevices; + public property Properties: array of ContextProperties read GetProperties; end; - {$endregion Kernel} - - {$region Platform} - - PlatformProperties = sealed partial class - - public constructor(ntv: cl_platform_id); - private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - - private function GetProfile: String; - private function GetVersion: String; - private function GetName: String; - private function GetVendor: String; - private function GetExtensions: String; - private function GetHostTimerResolution: UInt64; - - public property Profile: String read GetProfile; - public property Version: String read GetVersion; - public property Name: String read GetName; - public property Vendor: String read GetVendor; - public property Extensions: String read GetExtensions; - public property HostTimerResolution: UInt64 read GetHostTimerResolution; - - end; - - {$endregion Platform} + {$endregion Context} {$region ProgramCode} - ProgramCodeProperties = sealed partial class + ProgramCodeProperties = partial class public constructor(ntv: cl_program); private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); @@ -490,9 +456,92 @@ type {$endregion ProgramCode} + {$region Kernel} + + KernelProperties = partial class + + public constructor(ntv: cl_kernel); + private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + private function GetFunctionName: String; + private function GetNumArgs: UInt32; + private function GetReferenceCount: UInt32; + private function GetAttributes: String; + + public property FunctionName: String read GetFunctionName; + public property NumArgs: UInt32 read GetNumArgs; + public property ReferenceCount: UInt32 read GetReferenceCount; + public property Attributes: String read GetAttributes; + + end; + + {$endregion Kernel} + + {$region MemorySegment} + + MemorySegmentProperties = partial class + + public constructor(ntv: cl_mem); + private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + private function GetFlags: MemFlags; + private function GetHostPtr: IntPtr; + private function GetMapCount: UInt32; + private function GetReferenceCount: UInt32; + private function GetUsesSvmPointer: Bool; + + public property Flags: MemFlags read GetFlags; + public property HostPtr: IntPtr read GetHostPtr; + public property MapCount: UInt32 read GetMapCount; + public property ReferenceCount: UInt32 read GetReferenceCount; + public property UsesSvmPointer: Bool read GetUsesSvmPointer; + + end; + + {$endregion MemorySegment} + + {$region MemorySubSegment} + + MemorySubSegmentProperties = partial class(MemorySegmentProperties) + + public constructor(ntv: cl_mem); + private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + private function GetOffset: UIntPtr; + + public property Offset: UIntPtr read GetOffset; + + end; + + {$endregion MemorySubSegment} + + {$region CLArray} + + CLArrayProperties = partial class + + public constructor(ntv: cl_mem); + private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + private function GetFlags: MemFlags; + private function GetHostPtr: IntPtr; + private function GetMapCount: UInt32; + private function GetReferenceCount: UInt32; + private function GetUsesSvmPointer: Bool; + + public property Flags: MemFlags read GetFlags; + public property HostPtr: IntPtr read GetHostPtr; + public property MapCount: UInt32 read GetMapCount; + public property ReferenceCount: UInt32 read GetReferenceCount; + public property UsesSvmPointer: Bool read GetUsesSvmPointer; + + end; + + {$endregion CLArray} + {$endregion Properties} {$region Wrappers} + // Для параметров команд ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU CommandQueue = abstract partial class end; ///Представляет аргумент, передаваемый в вызов kernel-а @@ -785,366 +834,6 @@ type {$endregion Context} - {$region Buffer} - - ///Представляет область памяти устройства OpenCL - Buffer = partial class - private ntv: cl_mem; - - private sz: UIntPtr; - ///Возвращает размер буфера в байтах - public property Size: UIntPtr read sz; - ///Возвращает размер буфера в байтах - public property Size32: UInt32 read sz.ToUInt32; - ///Возвращает размер буфера в байтах - public property Size64: UInt64 read sz.ToUInt64; - - ///Возвращает строку с основными данными о данном объекте - public function ToString: string; override := - $'{self.GetType.Name}[{ntv.val}] of size {Size}'; - - {$region constructor's} - - ///Создаёт буфер указанного в байтах размера - ///Память на GPU не выделяется до вызова метода .Init - public constructor(size: UIntPtr) := self.sz := size; - ///Создаёт буфер указанного в байтах размера - ///Память на GPU не выделяется до вызова метода .Init - public constructor(size: integer) := Create(new UIntPtr(size)); - ///Создаёт буфер указанного в байтах размера - ///Память на GPU не выделяется до вызова метода .Init - public constructor(size: int64) := Create(new UIntPtr(size)); - - ///Создаёт буфер указанного в байтах размера - ///Память на GPU выделяется сразу, на явно указанном контексте - public constructor(size: UIntPtr; c: Context); - begin - Create(size); - Init(c); - end; - ///Создаёт буфер указанного в байтах размера - ///Память на GPU выделяется сразу, на явно указанном контексте - public constructor(size: integer; c: Context) := Create(new UIntPtr(size), c); - ///Создаёт буфер указанного в байтах размера - ///Память на GPU выделяется сразу, на явно указанном контексте - public constructor(size: int64; c: Context) := Create(new UIntPtr(size), c); - - ///Создаёт обёртку для указанного неуправляемого объекта - ///При успешном создании обёртки вызывается cl.Retain - ///А во время вызова .Dispose - cl.Release - public constructor(ntv: cl_mem); - begin - cl.RetainMemObject(ntv).RaiseIfError; - self.ntv := ntv; - - cl.GetMemObjectInfo(ntv, MemInfo.MEM_SIZE, new UIntPtr(Marshal.SizeOf&), self.sz, IntPtr.Zero).RaiseIfError; - GC.AddMemoryPressure(Size64); - - end; - private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - - ///Выделяет память для данного буфера в указанном контексте - ///Если память уже выделена, то она освобождается и выделяется заново - public procedure Init(c: Context); virtual := - lock self do - begin - - var ec: ErrorCode; - var new_ntv := cl.CreateBuffer(c.ntv, MemFlags.MEM_READ_WRITE, sz, IntPtr.Zero, ec); - ec.RaiseIfError; - - if self.ntv=cl_mem.Zero then - GC.AddMemoryPressure(Size64) else - cl.ReleaseMemObject(self.ntv).RaiseIfError; - - self.ntv := new_ntv; - end; - - ///Выделяет память для данного буфера в указанном контексте - ///Если память уже выделена, то данный методы ничего не делает - public procedure InitIfNeed(c: Context); virtual := - if self.ntv=cl_mem.Zero then lock self do - begin - if self.ntv<>cl_mem.Zero then exit; // Во время ожидания lock могли инициализировать - - var ec: ErrorCode; - var new_ntv := cl.CreateBuffer(c.ntv, MemFlags.MEM_READ_WRITE, sz, IntPtr.Zero, ec); - ec.RaiseIfError; - - GC.AddMemoryPressure(Size64); - self.ntv := new_ntv; - end; - - {$endregion constructor's} - - {$region 1#Write&Read} - - ///Заполняет весь буфер данными, находящимися по указанному адресу в RAM - public function WriteData(ptr: CommandQueue): Buffer; - - ///Копирует всё содержимое буфера в RAM, по указанному адресу - public function ReadData(ptr: CommandQueue): Buffer; - - ///Заполняет часть буфер данными, находящимися по указанному адресу в RAM - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function WriteData(ptr: CommandQueue; buff_offset, len: CommandQueue): Buffer; - - ///Копирует часть содержимого буфера в RAM, по указанному адресу - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function ReadData(ptr: CommandQueue; buff_offset, len: CommandQueue): Buffer; - - ///Заполняет весь буфер данными, находящимися по указанному адресу в RAM - public function WriteData(ptr: pointer): Buffer; - - ///Копирует всё содержимое буфера в RAM, по указанному адресу - public function ReadData(ptr: pointer): Buffer; - - ///Заполняет часть буфер данными, находящимися по указанному адресу в RAM - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function WriteData(ptr: pointer; buff_offset, len: CommandQueue): Buffer; - - ///Копирует часть содержимого буфера в RAM, по указанному адресу - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function ReadData(ptr: pointer; buff_offset, len: CommandQueue): Buffer; - - ///Записывает указанное значение размерного типа в начало буфера - public function WriteValue(val: TRecord): Buffer; where TRecord: record; - - ///Записывает указанное значение размерного типа в буфер - ///buff_offset указывает отступ от начала буфера, в байтах - public function WriteValue(val: TRecord; buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Записывает указанное значение размерного типа в начало буфера - public function WriteValue(val: CommandQueue): Buffer; where TRecord: record; - - ///Записывает указанное значение размерного типа в буфер - ///buff_offset указывает отступ от начала буфера, в байтах - public function WriteValue(val: CommandQueue; buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Записывает весь массив в начало буфера - public function WriteArray1(a: CommandQueue): Buffer; where TRecord: record; - - ///Записывает весь массив в начало буфера - public function WriteArray2(a: CommandQueue): Buffer; where TRecord: record; - - ///Записывает весь массив в начало буфера - public function WriteArray3(a: CommandQueue): Buffer; where TRecord: record; - - ///Читает из буфера достаточно байт чтоб заполнить весь массив - public function ReadArray1(a: CommandQueue): Buffer; where TRecord: record; - - ///Читает из буфера достаточно байт чтоб заполнить весь массив - public function ReadArray2(a: CommandQueue): Buffer; where TRecord: record; - - ///Читает из буфера достаточно байт чтоб заполнить весь массив - public function ReadArray3(a: CommandQueue): Buffer; where TRecord: record; - - ///Записывает указанный участок массива в буфер - ///a_offset(-ы) указывают индекс в массиве - ///len указывает кол-во задействованных элементов массива - ///buff_offset указывает отступ от начала буфера, в байтах - public function WriteArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Записывает указанный участок массива в буфер - ///a_offset(-ы) указывают индекс в массиве - ///len указывает кол-во задействованных элементов массива - ///buff_offset указывает отступ от начала буфера, в байтах - /// - ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально - ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] - ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function WriteArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Записывает указанный участок массива в буфер - ///a_offset(-ы) указывают индекс в массиве - ///len указывает кол-во задействованных элементов массива - ///buff_offset указывает отступ от начала буфера, в байтах - /// - ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально - ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] - ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function WriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Читает в буфер указанный участок массива - ///a_offset(-ы) указывают индекс в массиве - ///len указывает кол-во задействованных элементов массива - ///buff_offset указывает отступ от начала буфера, в байтах - public function ReadArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Читает в буфер указанный участок массива - ///a_offset(-ы) указывают индекс в массиве - ///len указывает кол-во задействованных элементов массива - ///buff_offset указывает отступ от начала буфера, в байтах - /// - ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально - ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] - ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function ReadArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): Buffer; where TRecord: record; - - ///Читает в буфер указанный участок массива - ///a_offset(-ы) указывают индекс в массиве - ///len указывает кол-во задействованных элементов массива - ///buff_offset указывает отступ от начала буфера, в байтах - /// - ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально - ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] - ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function ReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): Buffer; where TRecord: record; - - {$endregion 1#Write&Read} - - {$region 2#Fill} - - ///Читает pattern_len байт из RAM по указанному адресу и заполняет их копиями весь буфер - public function FillData(ptr: CommandQueue; pattern_len: CommandQueue): Buffer; - - ///Читает pattern_len байт из RAM по указанному адресу и заполняет их копиями часть буфера - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function FillData(ptr: CommandQueue; pattern_len, buff_offset, len: CommandQueue): Buffer; - - ///Заполняет весь буфер копиями указанного значения размерного типа - public function FillValue(val: TRecord): Buffer; where TRecord: record; - - ///Заполняет часть буфера копиями указанного значения размерного типа - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function FillValue(val: TRecord; buff_offset, len: CommandQueue): Buffer; where TRecord: record; - - ///Заполняет весь буфер копиями указанного значения размерного типа - public function FillValue(val: CommandQueue): Buffer; where TRecord: record; - - ///Заполняет часть буфера копиями указанного значения размерного типа - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function FillValue(val: CommandQueue; buff_offset, len: CommandQueue): Buffer; where TRecord: record; - - {$endregion 2#Fill} - - {$region 3#Copy} - - ///Копирует данные из текущего буфера в b - ///Если буферы имеют разный размер - в качестве объёма данных берётся размер меньшего буфера - public function CopyTo(b: CommandQueue): Buffer; - - ///Копирует данные из b в текущий буфер - ///Если буферы имеют разный размер - в качестве объёма данных берётся размер меньшего буфера - public function CopyForm(b: CommandQueue): Buffer; - - ///Копирует данные из текущего буфера в b - ///from_pos указывает отступ в байтах от начала буфера, из которого копируют - ///to_pos указывает отступ в байтах от начала буфера, в который копируют - ///len указывает кол-во копируемых байт - public function CopyTo(b: CommandQueue; from_pos, to_pos, len: CommandQueue): Buffer; - - ///Копирует данные из b в текущий буфер - ///from_pos указывает отступ в байтах от начала буфера, из которого копируют - ///to_pos указывает отступ в байтах от начала буфера, в который копируют - ///len указывает кол-во копируемых байт - public function CopyForm(b: CommandQueue; from_pos, to_pos, len: CommandQueue): Buffer; - - {$endregion 3#Copy} - - {$region Get} - - ///Выделяет область неуправляемой памяти и копирует в неё всё содержимое данного буфера - public function GetData: IntPtr; - - ///Выделяет область неуправляемой памяти и копирует в неё часть содержимого данного буфера - ///buff_offset указывает отступ от начала буфера, в байтах - ///len указывает кол-во задействованных байт буфера - public function GetData(buff_offset, len: CommandQueue): IntPtr; - - ///Читает значение указанного размерного типа из начала буфера - public function GetValue: TRecord; where TRecord: record; - - ///Читает значение указанного размерного типа из буфера - ///buff_offset указывает отступ от начала буфера, в байтах - public function GetValue(buff_offset: CommandQueue): TRecord; where TRecord: record; - - ///Создаёт массив максимального размера (на сколько хватит байт буфера) и копирует в него содержимое буфера - public function GetArray1: array of TRecord; where TRecord: record; - - ///Создаёт массив с указанным кол-вом элементов и копирует в него содержимое буфера - public function GetArray1(len: CommandQueue): array of TRecord; where TRecord: record; - - ///Создаёт массив с указанным кол-вом элементов и копирует в него содержимое буфера - public function GetArray2(len1,len2: CommandQueue): array[,] of TRecord; where TRecord: record; - - ///Создаёт массив с указанным кол-вом элементов и копирует в него содержимое буфера - public function GetArray3(len1,len2,len3: CommandQueue): array[,,] of TRecord; where TRecord: record; - - {$endregion Get} - - end; - - {$endregion Buffer} - - {$region SubBuffer} - - ///Представляет область памяти внутри другого буфера - SubBuffer = partial class(Buffer) - - private _parent: Buffer; - ///Возвращает родительский буфер - public property Parent: Buffer read _parent; - - ///Возвращает строку с основными данными о данном объекте - public function ToString: string; override := - $'{inherited ToString} inside {Parent}'; - - {$region constructor's} - - private constructor(parent: Buffer; reg: cl_buffer_region); - begin - inherited Create(reg.size); - - var parent_ntv := parent.ntv; - if parent_ntv=cl_mem.Zero then raise new InvalidOperationException($'Ожидался инициализированный буфер. Используйте .Init, или конструктор принимающий контекст'); - - var ec: ErrorCode; - self.ntv := cl.CreateSubBuffer(parent_ntv, MemFlags.MEM_READ_WRITE, BufferCreateType.BUFFER_CREATE_TYPE_REGION, reg, ec); - ec.RaiseIfError; - - self._parent := parent; - end; - ///Создаёт буфер из области памяти родительского буфера parent - ///origin указывает отступ в байтах от начала parent - ///size указывает размер нового буфера - ///Память parent должна быть выделена перед вызовом данного конструктора, - ///потому что новый буфер будет использовать память parent, вместо создания новой области памяти - public constructor(parent: Buffer; origin, size: UIntPtr) := Create(parent, new cl_buffer_region(origin, size)); - - ///Создаёт буфер из области памяти родительского буфера parent - ///origin указывает отступ в байтах от начала parent - ///size указывает размер нового буфера - ///Память parent должна быть выделена перед вызовом данного конструктора, - ///потому что новый буфер будет использовать память parent, вместо создания новой области памяти - public constructor(parent: Buffer; origin, size: UInt32) := Create(parent, new UIntPtr(origin), new UIntPtr(size)); - ///Создаёт буфер из области памяти родительского буфера parent - ///origin указывает отступ в байтах от начала parent - ///size указывает размер нового буфера - ///Память parent должна быть выделена перед вызовом данного конструктора, - ///потому что новый буфер будет использовать память parent, вместо создания новой области памяти - public constructor(parent: Buffer; origin, size: UInt64) := Create(parent, new UIntPtr(origin), new UIntPtr(size)); - - private procedure InitIgnoreOrErr := - if self.ntv=cl_mem.Zero then raise new NotSupportedException($'SubBuffer нельзя инициализировать, потому что он использует память другого буфера'); - ///-- - public procedure Init(c: Context); override := InitIgnoreOrErr; - ///-- - public procedure InitIfNeed(c: Context); override := InitIgnoreOrErr; - - {$endregion constructor's} - - end; - - {$endregion SubBuffer} - {$region ProgramCode} ///Представляет контейнер с откомпилированным кодом для GPU, содержащим подпрограммы-kernel'ы @@ -1195,19 +884,21 @@ type end; - ///Компилирует указанные тексты программ на указанном контексте + ///Компилирует указанные тексты программ в указанном контексте ///Внимание! Именно тексты, Не имена файлов - public constructor(c: Context; params files_texts: array of string); + public constructor(c: Context; params file_texts: array of string); begin var ec: ErrorCode; - self.ntv := cl.CreateProgramWithSource(c.ntv, files_texts.Length, files_texts, nil, ec); + self.ntv := cl.CreateProgramWithSource(c.ntv, file_texts.Length, file_texts, nil, ec); ec.RaiseIfError; self._c := c; self.Build; - end; + ///Компилирует указанные тексты программ в контексте Context.Default + ///Внимание! Именно тексты, Не имена файлов + public constructor(params file_texts: array of string) := Create(Context.Default, file_texts); private constructor(ntv: cl_program; c: Context); begin @@ -1507,6 +1198,512 @@ type {$endregion Kernel} + {$region MemorySegment} + + ///Представляет область памяти устройства OpenCL (обычно GPU) + MemorySegment = partial class + private ntv: cl_mem; + + private sz: UIntPtr; + ///Возвращает размер области памяти в байтах + public property Size: UIntPtr read sz; + ///Возвращает размер области памяти в байтах + public property Size32: UInt32 read sz.ToUInt32; + ///Возвращает размер области памяти в байтах + public property Size64: UInt64 read sz.ToUInt64; + + ///Возвращает строку с основными данными о данном объекте + public function ToString: string; override := + $'{self.GetType.Name}[{ntv.val}] of size {Size}'; + + {$region constructor's} + + ///Выделяет область памяти устройства OpenCL указанного в байтах размера + ///Память выделяется в указанном контексте + public constructor(size: UIntPtr; c: Context); + begin + + var ec: ErrorCode; + self.ntv := cl.CreateBuffer(c.ntv, MemFlags.MEM_READ_WRITE, size, IntPtr.Zero, ec); + ec.RaiseIfError; + + GC.AddMemoryPressure(size.ToUInt64); + + self.sz := size; + end; + ///Выделяет область памяти устройства OpenCL указанного в байтах размера + ///Память выделяется в указанном контексте + public constructor(size: integer; c: Context) := Create(new UIntPtr(size), c); + ///Выделяет область памяти устройства OpenCL указанного в байтах размера + ///Память выделяется в указанном контексте + public constructor(size: int64; c: Context) := Create(new UIntPtr(size), c); + + ///Выделяет область памяти устройства OpenCL указанного в байтах размера + ///Память выделяется в контексте Context.Default + public constructor(size: UIntPtr) := Create(size, Context.Default); + ///Выделяет область памяти устройства OpenCL указанного в байтах размера + ///Память выделяется в контексте Context.Default + public constructor(size: integer) := Create(new UIntPtr(size)); + ///Выделяет область памяти устройства OpenCL указанного в байтах размера + ///Память выделяется в контексте Context.Default + public constructor(size: int64) := Create(new UIntPtr(size)); + + private constructor(ntv: cl_mem; sz: UIntPtr); + begin + self.sz := sz; + self.ntv := ntv; + end; + private static function GetMemSize(ntv: cl_mem): UIntPtr; + begin + cl.GetMemObjectInfo(ntv, MemInfo.MEM_SIZE, new UIntPtr(Marshal.SizeOf&), Result, IntPtr.Zero).RaiseIfError; + end; + ///Создаёт обёртку для указанного неуправляемого объекта + ///При успешном создании обёртки вызывается cl.Retain + ///А во время вызова .Dispose - cl.Release + public constructor(ntv: cl_mem); + begin + Create(ntv, GetMemSize(ntv)); + cl.RetainMemObject(ntv).RaiseIfError; + GC.AddMemoryPressure(Size64); + end; + private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + {$endregion constructor's} + + {$region 1#Write&Read} + + ///Заполняет весь буфер данными, находящимися по указанному адресу в RAM + public function WriteData(ptr: CommandQueue): MemorySegment; + + ///Копирует всё содержимое буфера в RAM, по указанному адресу + public function ReadData(ptr: CommandQueue): MemorySegment; + + ///Заполняет часть буфер данными, находящимися по указанному адресу в RAM + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function WriteData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegment; + + ///Копирует часть содержимого буфера в RAM, по указанному адресу + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function ReadData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegment; + + ///Заполняет весь буфер данными, находящимися по указанному адресу в RAM + public function WriteData(ptr: pointer): MemorySegment; + + ///Копирует всё содержимое буфера в RAM, по указанному адресу + public function ReadData(ptr: pointer): MemorySegment; + + ///Заполняет часть буфер данными, находящимися по указанному адресу в RAM + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function WriteData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegment; + + ///Копирует часть содержимого буфера в RAM, по указанному адресу + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function ReadData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegment; + + ///Записывает указанное значение размерного типа в начало буфера + public function WriteValue(val: TRecord): MemorySegment; where TRecord: record; + + ///Записывает указанное значение размерного типа в буфер + ///buff_offset указывает отступ от начала буфера, в байтах + public function WriteValue(val: TRecord; mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает указанное значение размерного типа в начало буфера + public function WriteValue(val: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает указанное значение размерного типа в буфер + ///buff_offset указывает отступ от начала буфера, в байтах + public function WriteValue(val: CommandQueue; mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает весь массив в начало буфера + public function WriteArray1(a: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает весь массив в начало буфера + public function WriteArray2(a: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает весь массив в начало буфера + public function WriteArray3(a: CommandQueue): MemorySegment; where TRecord: record; + + ///Читает из буфера достаточно байт чтоб заполнить весь массив + public function ReadArray1(a: CommandQueue): MemorySegment; where TRecord: record; + + ///Читает из буфера достаточно байт чтоб заполнить весь массив + public function ReadArray2(a: CommandQueue): MemorySegment; where TRecord: record; + + ///Читает из буфера достаточно байт чтоб заполнить весь массив + public function ReadArray3(a: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает указанный участок массива в буфер + ///a_offset(-ы) указывают индекс в массиве + ///len указывает кол-во задействованных элементов массива + ///buff_offset указывает отступ от начала буфера, в байтах + public function WriteArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает указанный участок массива в буфер + ///a_offset(-ы) указывают индекс в массиве + ///len указывает кол-во задействованных элементов массива + ///buff_offset указывает отступ от начала буфера, в байтах + /// + ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально + ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] + ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку + public function WriteArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Записывает указанный участок массива в буфер + ///a_offset(-ы) указывают индекс в массиве + ///len указывает кол-во задействованных элементов массива + ///buff_offset указывает отступ от начала буфера, в байтах + /// + ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально + ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] + ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку + public function WriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Читает в буфер указанный участок массива + ///a_offset(-ы) указывают индекс в массиве + ///len указывает кол-во задействованных элементов массива + ///buff_offset указывает отступ от начала буфера, в байтах + public function ReadArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Читает в буфер указанный участок массива + ///a_offset(-ы) указывают индекс в массиве + ///len указывает кол-во задействованных элементов массива + ///buff_offset указывает отступ от начала буфера, в байтах + /// + ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально + ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] + ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку + public function ReadArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + ///Читает в буфер указанный участок массива + ///a_offset(-ы) указывают индекс в массиве + ///len указывает кол-во задействованных элементов массива + ///buff_offset указывает отступ от начала буфера, в байтах + /// + ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально + ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] + ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку + public function ReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegment; where TRecord: record; + + {$endregion 1#Write&Read} + + {$region 2#Fill} + + ///Читает pattern_len байт из RAM по указанному адресу и заполняет их копиями весь буфер + public function FillData(ptr: CommandQueue; pattern_len: CommandQueue): MemorySegment; + + ///Читает pattern_len байт из RAM по указанному адресу и заполняет их копиями часть буфера + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function FillData(ptr: CommandQueue; pattern_len, mem_offset, len: CommandQueue): MemorySegment; + + ///Заполняет весь буфер копиями указанного значения размерного типа + public function FillValue(val: TRecord): MemorySegment; where TRecord: record; + + ///Заполняет часть буфера копиями указанного значения размерного типа + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function FillValue(val: TRecord; mem_offset, len: CommandQueue): MemorySegment; where TRecord: record; + + ///Заполняет весь буфер копиями указанного значения размерного типа + public function FillValue(val: CommandQueue): MemorySegment; where TRecord: record; + + ///Заполняет часть буфера копиями указанного значения размерного типа + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function FillValue(val: CommandQueue; mem_offset, len: CommandQueue): MemorySegment; where TRecord: record; + + {$endregion 2#Fill} + + {$region 3#Copy} + + ///Копирует данные из текущего буфера в b + ///Если буферы имеют разный размер - в качестве объёма данных берётся размер меньшего буфера + public function CopyTo(mem: CommandQueue): MemorySegment; + + ///Копирует данные из b в текущий буфер + ///Если буферы имеют разный размер - в качестве объёма данных берётся размер меньшего буфера + public function CopyFrom(mem: CommandQueue): MemorySegment; + + ///Копирует данные из текущего буфера в b + ///from_pos указывает отступ в байтах от начала буфера, из которого копируют + ///to_pos указывает отступ в байтах от начала буфера, в который копируют + ///len указывает кол-во копируемых байт + public function CopyTo(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegment; + + ///Копирует данные из b в текущий буфер + ///from_pos указывает отступ в байтах от начала буфера, из которого копируют + ///to_pos указывает отступ в байтах от начала буфера, в который копируют + ///len указывает кол-во копируемых байт + public function CopyFrom(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegment; + + {$endregion 3#Copy} + + {$region Get} + + ///Выделяет область неуправляемой памяти и копирует в неё всё содержимое данного буфера + public function GetData: IntPtr; + + ///Выделяет область неуправляемой памяти и копирует в неё часть содержимого данного буфера + ///buff_offset указывает отступ от начала буфера, в байтах + ///len указывает кол-во задействованных байт буфера + public function GetData(mem_offset, len: CommandQueue): IntPtr; + + ///Читает значение указанного размерного типа из начала буфера + public function GetValue: TRecord; where TRecord: record; + + ///Читает значение указанного размерного типа из буфера + ///buff_offset указывает отступ от начала буфера, в байтах + public function GetValue(mem_offset: CommandQueue): TRecord; where TRecord: record; + + ///Создаёт массив максимального размера (на сколько хватит байт буфера) и копирует в него содержимое буфера + public function GetArray1: array of TRecord; where TRecord: record; + + ///Создаёт массив с указанным кол-вом элементов и копирует в него содержимое буфера + public function GetArray1(len: CommandQueue): array of TRecord; where TRecord: record; + + ///Создаёт массив с указанным кол-вом элементов и копирует в него содержимое буфера + public function GetArray2(len1,len2: CommandQueue): array[,] of TRecord; where TRecord: record; + + ///Создаёт массив с указанным кол-вом элементов и копирует в него содержимое буфера + public function GetArray3(len1,len2,len3: CommandQueue): array[,,] of TRecord; where TRecord: record; + + {$endregion Get} + + end; + + {$endregion MemorySegment} + + {$region MemorySubSegment} + + ///Представляет виртуальную область памяти, выделенную внутри MemorySegment + MemorySubSegment = partial class(MemorySegment) + + private _parent: MemorySegment; + ///Возвращает родительскую область памяти + public property Parent: MemorySegment read _parent; + + ///Возвращает строку с основными данными о данном объекте + public function ToString: string; override := + $'{inherited ToString} inside {Parent}'; + + {$region constructor's} + + private static function MakeSubNtv(ntv: cl_mem; reg: cl_buffer_region): cl_mem; + begin + var ec: ErrorCode; + Result := cl.CreateSubBuffer(ntv, MemFlags.MEM_READ_WRITE, BufferCreateType.BUFFER_CREATE_TYPE_REGION, reg, ec); + ec.RaiseIfError; + end; + private constructor(parent: MemorySegment; reg: cl_buffer_region); + begin + inherited Create(MakeSubNtv(parent.ntv, reg), reg.size); + self._parent := parent; + end; + ///Создаёт виртуальную область памяти, использующую указанную область из parent + ///origin указывает отступ в байтах от начала parent + ///size указывает размер новой области памяти + public constructor(parent: MemorySegment; origin, size: UIntPtr) := Create(parent, new cl_buffer_region(origin, size)); + + ///Создаёт виртуальную область памяти, использующую указанную область из parent + ///origin указывает отступ в байтах от начала parent + ///size указывает размер новой области памяти + public constructor(parent: MemorySegment; origin, size: UInt32) := Create(parent, new UIntPtr(origin), new UIntPtr(size)); + ///Создаёт виртуальную область памяти, использующую указанную область из parent + ///origin указывает отступ в байтах от начала parent + ///size указывает размер новой области памяти + public constructor(parent: MemorySegment; origin, size: UInt64) := Create(parent, new UIntPtr(origin), new UIntPtr(size)); + + {$endregion constructor's} + + end; + + {$endregion MemorySubSegment} + + {$region CLArray} + + ///Представляет массив записей, содержимое которого хранится на устройстве OpenCL (обычно GPU) + CLArray = partial class + where T: record; + private ntv: cl_mem; + + private len: integer; + ///Возвращает длину массива + public property Length: integer read len; + ///Возвращает размер области памяти, занимаемой массивом, в байтах + public property ByteSize: int64 read int64(len) * Marshal.SizeOf&; + + ///Возвращает строку с основными данными о данном объекте + public function ToString: string; override := + $'{self.GetType.Name.Remove(self.GetType.Name.IndexOf(''`''))}<{typeof(T).Name}>[{ntv.val}] of size {Length}'; + + {$region constructor's} + + private procedure InitByLen(c: Context); + begin + + var ec: ErrorCode; + self.ntv := cl.CreateBuffer(c.ntv, MemFlags.MEM_READ_WRITE, new UIntPtr(ByteSize), IntPtr.Zero, ec); + ec.RaiseIfError; + + GC.AddMemoryPressure(ByteSize); + end; + private procedure InitByVal(c: Context; var els: T); + begin + + var ec: ErrorCode; + self.ntv := cl.CreateBuffer(c.ntv, MemFlags.MEM_READ_WRITE + MemFlags.MEM_COPY_HOST_PTR, new UIntPtr(ByteSize), els, ec); + ec.RaiseIfError; + + GC.AddMemoryPressure(ByteSize); + end; + + ///Создаёт массив, указанной длины + ///Память выделяется в указанном контексте + public constructor(c: Context; len: integer); + begin + self.len := len; + InitByLen(c); + end; + ///Создаёт массив, указанной длины + ///Память выделяется в контексте Context.Default + public constructor(len: integer) := Create(Context.Default, len); + + ///Создаёт массив-копию указанного массива + ///Память выделяется в указанном контексте + public constructor(c: Context; els: array of T); + begin + self.len := els.Length; + InitByVal(c, els[0]); + end; + ///Создаёт массив-копию указанного массива + ///Память выделяется в контексте Context.Default + public constructor(els: array of T) := Create(Context.Default, els); + + ///Создаёт массив-копию участка указанного массива + ///Память выделяется в указанном контексте + public constructor(c: Context; els_from, len: integer; params els: array of T); + begin + self.len := len; + InitByVal(c, els[els_from]); + end; + ///Создаёт массив-копию участка указанного массива + ///Память выделяется в контексте Context.Default + public constructor(els_from, len: integer; params els: array of T) := Create(Context.Default, els_from, len, els); + + ///Создаёт обёртку для указанного неуправляемого объекта + ///При успешном создании обёртки вызывается cl.Retain + ///А во время вызова .Dispose - cl.Release + public constructor(ntv: cl_mem); + begin + + var byte_size: UIntPtr; + cl.GetMemObjectInfo(ntv, MemInfo.MEM_SIZE, new UIntPtr(Marshal.SizeOf&), byte_size, IntPtr.Zero).RaiseIfError; + + self.len := byte_size.ToUInt64 div Marshal.SizeOf&; + self.ntv := ntv; + + cl.RetainMemObject(ntv).RaiseIfError; + GC.AddMemoryPressure(ByteSize); + end; + private constructor := raise new System.InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + {$endregion constructor's} + + private function GetItemProp(ind: integer): T; + private procedure SetItemProp(ind: integer; value: T); + ///Возвращает или задаёт один элемент массива + ///Внимание! Данные свойство использует неявные очереди при каждом обращение, поэтому может быть очень не эффективным + public property Item[ind: integer]: T read GetItemProp write SetItemProp; default; + + private function GetSectionProp(range: IntRange): array of T; + private procedure SetSectionProp(range: IntRange; value: array of T); + ///Возвращает или задаёт элементы массива в заданном диапазоне + ///Внимание! Данные свойство использует неявные очереди при каждом обращение, поэтому может быть очень не эффективным + public property Section[range: IntRange]: array of T read GetSectionProp write SetSectionProp; + + {$region 1#Write&Read} + + ///Записывает указанное значение по индексу ind + public function WriteItem(val: &T; ind: CommandQueue): CLArray; + + ///Записывает указанное значение по индексу ind + public function WriteItem(val: CommandQueue<&T>; ind: CommandQueue): CLArray; + + ///Записывает весь указанный массив в начало данного объекта CLArray + public function WriteArray(a: CommandQueue): CLArray; + + ///Читает начало данного объекта CLArray в указанный массив + public function ReadArray(a: CommandQueue): CLArray; + + ///Записывает len элементов массива a, начиная с индекса a_ind, в данный объект CLArray по индексу ind + public function WriteArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArray; + + ///Читает len элементов данного объекта CLArray, начиная с индекса ind, в массив a по индексу a_ind + public function ReadArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArray; + + {$endregion 1#Write&Read} + + {$region 2#Fill} + + ///Заполняет весь массив копиями указанного значения + public function Fill(val: &T): CLArray; + + ///Заполняет len элементов начиная с индекса ind копиями указанного значения + public function Fill(val: &T; ind, len: CommandQueue): CLArray; + + ///Заполняет весь массив копиями указанного значения + public function Fill(val: CommandQueue<&T>): CLArray; + + ///Заполняет len элементов начиная с индекса ind копиями указанного значения + public function Fill(val: CommandQueue<&T>; ind, len: CommandQueue): CLArray; + + {$endregion 2#Fill} + + {$region 3#Copy} + + ///Копирует данные из текущего массива в a + ///Если у массивов разный размер - копируется кол-во элементов меньшего массива + public function CopyTo(a: CommandQueue>): CLArray; + + ///Копирует данные из a в текущий массив + ///Если у массивов разный размер - копируется кол-во элементов меньшего массива + public function CopyFrom(a: CommandQueue>): CLArray; + + ///Копирует данные из текущего массива в a + ///from_ind указывает индекс в массиве, из которого копируют + ///to_ind указывает индекс в массиве, в который копируют + ///len указывает кол-во копируемых элементов + public function CopyTo(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArray; + + ///Копирует данные из a в текущий массив + ///from_ind указывает индекс в массиве, из которого копируют + ///to_ind указывает индекс в массиве, в который копируют + ///len указывает кол-во копируемых элементов + public function CopyFrom(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArray; + + {$endregion 3#Copy} + + {$region Get} + + ///Читает элемент по указанному индексу + public function GetItem(ind: CommandQueue): &T; + + ///Читает весь CLArray как обычный массив array of T + public function GetArray: array of &T; + + ///Читает len элементов начиная с индекса ind из CLArray как обычный массив array of T + public function GetArray(ind, len: CommandQueue): array of &T; + + {$endregion Get} + + end; + + {$endregion CLArray} + {$region Common} ///Представляет платформу OpenCL, объединяющую одно или несколько устройств @@ -1581,27 +1778,27 @@ type end; - ///Представляет область памяти устройства OpenCL - Buffer = partial class + ///Представляет контейнер с откомпилированным кодом для GPU, содержащим подпрограммы-kernel'ы + ProgramCode = partial class ///Возвращает имя (дескриптор) неуправляемого объекта - public property Native: cl_mem read ntv; + public property Native: cl_program read ntv; - private prop: BufferProperties; - private function GetProperties: BufferProperties; + private prop: ProgramCodeProperties; + private function GetProperties: ProgramCodeProperties; begin - if prop=nil then prop := new BufferProperties(ntv); + if prop=nil then prop := new ProgramCodeProperties(ntv); Result := prop; end; ///Возвращает контейнер свойств неуправляемого объекта - public property Properties: BufferProperties read GetProperties; + public property Properties: ProgramCodeProperties read GetProperties; - public static function operator=(wr1, wr2: Buffer): boolean := wr1.ntv = wr2.ntv; - public static function operator<>(wr1, wr2: Buffer): boolean := wr1.ntv <> wr2.ntv; + public static function operator=(wr1, wr2: ProgramCode): boolean := wr1.ntv = wr2.ntv; + public static function operator<>(wr1, wr2: ProgramCode): boolean := wr1.ntv <> wr2.ntv; ///-- public function Equals(obj: object): boolean; override := - (obj is Buffer(var wr)) and (self = wr); + (obj is ProgramCode(var wr)) and (self = wr); end; @@ -1629,27 +1826,65 @@ type end; - ///Представляет контейнер с откомпилированным кодом для GPU, содержащим подпрограммы-kernel'ы - ProgramCode = partial class + ///Представляет область памяти устройства OpenCL (обычно GPU) + MemorySegment = partial class ///Возвращает имя (дескриптор) неуправляемого объекта - public property Native: cl_program read ntv; + public property Native: cl_mem read ntv; - private prop: ProgramCodeProperties; - private function GetProperties: ProgramCodeProperties; + private prop: MemorySegmentProperties; + private function GetProperties: MemorySegmentProperties; begin - if prop=nil then prop := new ProgramCodeProperties(ntv); + if prop=nil then prop := new MemorySegmentProperties(ntv); Result := prop; end; ///Возвращает контейнер свойств неуправляемого объекта - public property Properties: ProgramCodeProperties read GetProperties; + public property Properties: MemorySegmentProperties read GetProperties; - public static function operator=(wr1, wr2: ProgramCode): boolean := wr1.ntv = wr2.ntv; - public static function operator<>(wr1, wr2: ProgramCode): boolean := wr1.ntv <> wr2.ntv; + public static function operator=(wr1, wr2: MemorySegment): boolean := wr1.ntv = wr2.ntv; + public static function operator<>(wr1, wr2: MemorySegment): boolean := wr1.ntv <> wr2.ntv; ///-- public function Equals(obj: object): boolean; override := - (obj is ProgramCode(var wr)) and (self = wr); + (obj is MemorySegment(var wr)) and (self = wr); + + end; + + ///Представляет виртуальную область памяти, выделенную внутри MemorySegment + MemorySubSegment = partial class(MemorySegment) + + private prop: MemorySubSegmentProperties; + private function GetProperties: MemorySubSegmentProperties; + begin + if prop=nil then prop := new MemorySubSegmentProperties(ntv); + Result := prop; + end; + ///Возвращает контейнер свойств неуправляемого объекта + public property Properties: MemorySubSegmentProperties read GetProperties; + + end; + + ///Представляет массив записей, содержимое которого хранится на устройстве OpenCL (обычно GPU) + CLArray = partial class + + ///Возвращает имя (дескриптор) неуправляемого объекта + public property Native: cl_mem read ntv; + + private prop: CLArrayProperties; + private function GetProperties: CLArrayProperties; + begin + if prop=nil then prop := new CLArrayProperties(ntv); + Result := prop; + end; + ///Возвращает контейнер свойств неуправляемого объекта + public property Properties: CLArrayProperties read GetProperties; + + public static function operator=(wr1, wr2: CLArray): boolean := wr1.ntv = wr2.ntv; + public static function operator<>(wr1, wr2: CLArray): boolean := wr1.ntv <> wr2.ntv; + + ///-- + public function Equals(obj: object): boolean; override := + (obj is CLArray(var wr)) and (self = wr); end; @@ -1657,41 +1892,6 @@ type {$region Misc} - ///Представляет область памяти устройства OpenCL - Buffer = partial class - - ///Освобождает память, выделенную под данный буфер, если она выделена - ///Внимание, если снова использовать данный буфер - память выделится заново - public procedure Dispose; virtual := - if ntv<>cl_mem.Zero then lock self do - begin - if self.ntv=cl_mem.Zero then exit; // Во время ожидания lock могли удалить - self.prop := nil; - GC.RemoveMemoryPressure(Size64); - cl.ReleaseMemObject(ntv).RaiseIfError; - ntv := cl_mem.Zero; - end; - ///Освобождает неуправляемые ресурсы. Данный метод вызывается автоматически во время сборки мусора - ///Данный метод не должен вызываться из пользовательского кода. Он виден только на случай если вы хотите переопределить его в своём классе-наследнике - protected procedure Finalize; override := Dispose; - - end; - - ///Представляет область памяти внутри другого буфера - SubBuffer = partial class - - ///-- - public procedure Dispose; override := - if ntv<>cl_mem.Zero then lock self do - begin - if self.ntv=cl_mem.Zero then exit; // Во время ожидания lock могли удалить - self.prop := nil; - cl.ReleaseMemObject(ntv).RaiseIfError; - ntv := cl_mem.Zero; - end; - - end; - ///Представляет устройство, поддерживающее OpenCL Device = partial class @@ -1760,6 +1960,62 @@ type end; + ///Представляет область памяти устройства OpenCL (обычно GPU) + MemorySegment = partial class + + ///Позволяет OpenCL удалить неуправляемый объект + ///Данный метод вызывается автоматически во время сборки мусора, если объект ещё не удалён + public procedure Dispose; virtual := + if ntv<>cl_mem.Zero then lock self do + begin + if self.ntv=cl_mem.Zero then exit; // Во время ожидания lock могли удалить + self.prop := nil; + GC.RemoveMemoryPressure(Size64); + cl.ReleaseMemObject(ntv).RaiseIfError; + ntv := cl_mem.Zero; + end; + ///Освобождает неуправляемые ресурсы. Данный метод вызывается автоматически во время сборки мусора + ///Данный метод не должен вызываться из пользовательского кода. Он виден только на случай если вы хотите переопределить его в своём классе-наследнике + protected procedure Finalize; override := Dispose; + + end; + + ///Представляет виртуальную область памяти, выделенную внутри MemorySegment + MemorySubSegment = partial class + + ///Позволяет OpenCL удалить неуправляемый объект + ///Данный метод вызывается автоматически во время сборки мусора, если объект ещё не удалён + public procedure Dispose; override := + if ntv<>cl_mem.Zero then lock self do + begin + if self.ntv=cl_mem.Zero then exit; // Во время ожидания lock могли удалить + self.prop := nil; + cl.ReleaseMemObject(ntv).RaiseIfError; + ntv := cl_mem.Zero; + end; + + end; + + ///Представляет массив записей, содержимое которого хранится на устройстве OpenCL (обычно GPU) + CLArray = partial class + + ///Позволяет OpenCL удалить неуправляемый объект + ///Данный метод вызывается автоматически во время сборки мусора, если объект ещё не удалён + public procedure Dispose; virtual := + if ntv<>cl_mem.Zero then lock self do + begin + if self.ntv=cl_mem.Zero then exit; // Во время ожидания lock могли удалить + self.prop := nil; + GC.RemoveMemoryPressure(ByteSize); + cl.ReleaseMemObject(ntv).RaiseIfError; + ntv := cl_mem.Zero; + end; + ///Освобождает неуправляемые ресурсы. Данный метод вызывается автоматически во время сборки мусора + ///Данный метод не должен вызываться из пользовательского кода. Он виден только на случай если вы хотите переопределить его в своём классе-наследнике + protected procedure Finalize; override := Dispose; + + end; + {$endregion Misc} {$endregion Wrappers} @@ -2134,17 +2390,14 @@ type {$region CLTask event's} - private procedure WhenDoneBase(cb: Action); abstract; ///Добавляет подпрограмму-обработчик, которая будет вызвана когда выполнение очереди завершится (успешно или с ошибой) - public procedure WhenDone(cb: Action) := WhenDoneBase(cb); + public procedure WhenDoneBase(cb: Action); abstract; - private procedure WhenCompleteBase(cb: Action); abstract; ///Добавляет подпрограмму-обработчик, которая будет вызвана когда- и если выполнение очереди завершится успешно - public procedure WhenComplete(cb: Action) := WhenCompleteBase(cb); + public procedure WhenCompleteBase(cb: Action); abstract; - private procedure WhenErrorBase(cb: Action); abstract; ///Добавляет подпрограмму-обработчик, которая будет вызвана когда- и если при выполнении очереди будет вызвано исключение - public procedure WhenError(cb: Action) := WhenErrorBase(cb); + public procedure WhenErrorBase(cb: Action); abstract; /// True если очередь уже завершилась protected function AddEventHandler(ev: List; cb: T): boolean; where T: Delegate; @@ -2239,21 +2492,24 @@ type ///Добавляет подпрограмму-обработчик, которая будет вызвана когда выполнение очереди завершится (успешно или с ошибой) public procedure WhenDone(cb: Action>); reintroduce := if AddEventHandler(EvDone, cb) then cb(self); - private procedure WhenDoneBase(cb: Action); override := + ///-- + public procedure WhenDoneBase(cb: Action); override := WhenDone(cb as object as Action>); //ToDo #2221 private EvComplete := new List, T>>; ///Добавляет подпрограмму-обработчик, которая будет вызвана когда- и если выполнение очереди завершится успешно public procedure WhenComplete(cb: Action, T>); reintroduce := - if AddEventHandler(EvComplete, cb) then cb(self, q_res); - private procedure WhenCompleteBase(cb: Action); override := - WhenComplete(cb as object as Action, T>); //ToDo #2221 + if AddEventHandler(EvComplete, cb) and (err_lst.Count=0) then cb(self, q_res); + ///-- + public procedure WhenCompleteBase(cb: Action); override := + WhenComplete((tsk,res)->cb(tsk,res)); //ToDo #2221 private EvError := new List, array of Exception>>; ///Добавляет подпрограмму-обработчик, которая будет вызвана когда- и если при выполнении очереди будет вызвано исключение public procedure WhenError(cb: Action, array of Exception>); reintroduce := - if AddEventHandler(EvError, cb) then cb(self, GetErrArr); - private procedure WhenErrorBase(cb: Action); override := + if AddEventHandler(EvError, cb) and (err_lst.Count<>0) then cb(self, GetErrArr); + ///-- + public procedure WhenErrorBase(cb: Action); override := WhenError(cb as object as Action, array of Exception>); //ToDo #2221 {$endregion CLTask event's} @@ -2300,17 +2556,31 @@ type ///Представляет аргумент, передаваемый в вызов kernel-а KernelArg = abstract partial class - {$region Buffer} + {$region MemorySegment} - ///Создаёт аргумент kernel-а, представляющий буфер - public static function FromBuffer(b: Buffer): KernelArg; - public static function operator implicit(b: Buffer): KernelArg := FromBuffer(b); + ///Создаёт аргумент kernel-а, представляющий область памяти GPU + public static function FromMemorySegment(mem: MemorySegment): KernelArg; + public static function operator implicit(mem: MemorySegment): KernelArg := FromMemorySegment(mem); - ///Создаёт аргумент kernel-а, представляющий буфер - public static function FromBufferCQ(bq: CommandQueue): KernelArg; - public static function operator implicit(bq: CommandQueue): KernelArg := FromBufferCQ(bq); + ///Создаёт аргумент kernel-а, представляющий область памяти GPU + public static function FromMemorySegmentCQ(mem_q: CommandQueue): KernelArg; + public static function operator implicit(mem_q: CommandQueue): KernelArg := FromMemorySegmentCQ(mem_q); - {$endregion Buffer} + {$endregion MemorySegment} + + {$region CLArray} + + ///Создаёт агрумент kernel-а, представляющий массив данных, хранимых на GPU + public static function FromCLArray(a: CLArray): KernelArg; where T: record; + public static function operator implicit(a: CLArray): KernelArg; where T: record; + begin Result := FromCLArray(a); end; + + ///Создаёт агрумент kernel-а, представляющий массив данных, хранимых на GPU + public static function FromCLArrayCQ(a_q: CommandQueue>): KernelArg; where T: record; + public static function operator implicit(a_q: CommandQueue>): KernelArg; where T: record; + begin Result := FromCLArrayCQ(a_q); end; + + {$endregion CLArray} {$region Record} @@ -2388,114 +2658,179 @@ type {$endregion KernelArg} - {$region BufferCommandQueue} + {$region KernelCCQ} - ///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа Buffer - BufferCommandQueue = sealed partial class + ///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа Kernel + KernelCCQ = sealed partial class ///Создаёт контейнер команд, который будет применять команды к указанному объекту - public constructor(o: Buffer); + public constructor(o: Kernel); ///Создаёт контейнер команд, который будет применять команды к объекту, который вернёт указанная очередь ///За каждое одно выполнение контейнера - q выполнится ровно один раз - public constructor(q: CommandQueue); + public constructor(q: CommandQueue); private constructor; {$region Special .Add's} ///Добавляет выполнение очереди в список обычных команд для GPU - public function AddQueue(q: CommandQueueBase): BufferCommandQueue; + public function AddQueue(q: CommandQueueBase): KernelCCQ; ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU - public function AddProc(p: Buffer->()): BufferCommandQueue; + public function AddProc(p: Kernel->()): KernelCCQ; ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU - public function AddProc(p: (Buffer, Context)->()): BufferCommandQueue; + public function AddProc(p: (Kernel, Context)->()): KernelCCQ; ///Добавляет ожидание сигнала выполненности от всех заданных маркеров - public function AddWaitAll(params markers: array of WaitMarkerBase): BufferCommandQueue; + public function AddWaitAll(params markers: array of WaitMarkerBase): KernelCCQ; ///Добавляет ожидание сигнала выполненности от всех заданных маркеров - public function AddWaitAll(markers: sequence of WaitMarkerBase): BufferCommandQueue; + public function AddWaitAll(markers: sequence of WaitMarkerBase): KernelCCQ; ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров - public function AddWaitAny(params markers: array of WaitMarkerBase): BufferCommandQueue; + public function AddWaitAny(params markers: array of WaitMarkerBase): KernelCCQ; ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров - public function AddWaitAny(markers: sequence of WaitMarkerBase): BufferCommandQueue; + public function AddWaitAny(markers: sequence of WaitMarkerBase): KernelCCQ; ///Добавляет ожидание сигнала выполненности от заданного маркера - public function AddWait(marker: WaitMarkerBase): BufferCommandQueue; + public function AddWait(marker: WaitMarkerBase): KernelCCQ; + + {$endregion Special .Add's} + + {$region 1#Exec} + + ///Выполняет kernel с указанным кол-вом ядер и передаёт в него указанные аргументы + public function AddExec1(sz1: CommandQueue; params args: array of KernelArg): KernelCCQ; + + ///Выполняет kernel с указанным кол-вом ядер и передаёт в него указанные аргументы + public function AddExec2(sz1,sz2: CommandQueue; params args: array of KernelArg): KernelCCQ; + + ///Выполняет kernel с указанным кол-вом ядер и передаёт в него указанные аргументы + public function AddExec3(sz1,sz2,sz3: CommandQueue; params args: array of KernelArg): KernelCCQ; + + ///Выполняет kernel с расширенным набором параметров + ///Данная перегрузка используется в первую очередь для тонких оптимизаций + ///Если она вам понадобилась по другой причина - пожалуйста, напишите в issue + public function AddExec(global_work_offset, global_work_size, local_work_size: CommandQueue; params args: array of KernelArg): KernelCCQ; + + {$endregion 1#Exec} + + end; + + ///Представляет подпрограмму, выполняемую на GPU + Kernel = partial class + ///Создаёт новую очередь-контейнер для команд GPU, применяемых к данному объекту + public function NewQueue := new KernelCCQ(self); + end; + + {$endregion KernelCCQ} + + {$region MemorySegmentCCQ} + + ///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа MemorySegment + MemorySegmentCCQ = sealed partial class + + ///Создаёт контейнер команд, который будет применять команды к указанному объекту + public constructor(o: MemorySegment); + ///Создаёт контейнер команд, который будет применять команды к объекту, который вернёт указанная очередь + ///За каждое одно выполнение контейнера - q выполнится ровно один раз + public constructor(q: CommandQueue); + private constructor; + + {$region Special .Add's} + + ///Добавляет выполнение очереди в список обычных команд для GPU + public function AddQueue(q: CommandQueueBase): MemorySegmentCCQ; + + ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU + public function AddProc(p: MemorySegment->()): MemorySegmentCCQ; + ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU + public function AddProc(p: (MemorySegment, Context)->()): MemorySegmentCCQ; + + ///Добавляет ожидание сигнала выполненности от всех заданных маркеров + public function AddWaitAll(params markers: array of WaitMarkerBase): MemorySegmentCCQ; + ///Добавляет ожидание сигнала выполненности от всех заданных маркеров + public function AddWaitAll(markers: sequence of WaitMarkerBase): MemorySegmentCCQ; + + ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров + public function AddWaitAny(params markers: array of WaitMarkerBase): MemorySegmentCCQ; + ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров + public function AddWaitAny(markers: sequence of WaitMarkerBase): MemorySegmentCCQ; + + ///Добавляет ожидание сигнала выполненности от заданного маркера + public function AddWait(marker: WaitMarkerBase): MemorySegmentCCQ; {$endregion Special .Add's} {$region 1#Write&Read} ///Заполняет весь буфер данными, находящимися по указанному адресу в RAM - public function AddWriteData(ptr: CommandQueue): BufferCommandQueue; + public function AddWriteData(ptr: CommandQueue): MemorySegmentCCQ; ///Копирует всё содержимое буфера в RAM, по указанному адресу - public function AddReadData(ptr: CommandQueue): BufferCommandQueue; + public function AddReadData(ptr: CommandQueue): MemorySegmentCCQ; ///Заполняет часть буфер данными, находящимися по указанному адресу в RAM ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddWriteData(ptr: CommandQueue; buff_offset, len: CommandQueue): BufferCommandQueue; + public function AddWriteData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegmentCCQ; ///Копирует часть содержимого буфера в RAM, по указанному адресу ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddReadData(ptr: CommandQueue; buff_offset, len: CommandQueue): BufferCommandQueue; + public function AddReadData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegmentCCQ; ///Заполняет весь буфер данными, находящимися по указанному адресу в RAM - public function AddWriteData(ptr: pointer): BufferCommandQueue; + public function AddWriteData(ptr: pointer): MemorySegmentCCQ; ///Копирует всё содержимое буфера в RAM, по указанному адресу - public function AddReadData(ptr: pointer): BufferCommandQueue; + public function AddReadData(ptr: pointer): MemorySegmentCCQ; ///Заполняет часть буфер данными, находящимися по указанному адресу в RAM ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddWriteData(ptr: pointer; buff_offset, len: CommandQueue): BufferCommandQueue; + public function AddWriteData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegmentCCQ; ///Копирует часть содержимого буфера в RAM, по указанному адресу ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddReadData(ptr: pointer; buff_offset, len: CommandQueue): BufferCommandQueue; + public function AddReadData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegmentCCQ; ///Записывает указанное значение размерного типа в начало буфера - public function AddWriteValue(val: TRecord): BufferCommandQueue; where TRecord: record; + public function AddWriteValue(val: TRecord): MemorySegmentCCQ; where TRecord: record; ///Записывает указанное значение размерного типа в буфер ///buff_offset указывает отступ от начала буфера, в байтах - public function AddWriteValue(val: TRecord; buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteValue(val: TRecord; mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает указанное значение размерного типа в начало буфера - public function AddWriteValue(val: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteValue(val: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает указанное значение размерного типа в буфер ///buff_offset указывает отступ от начала буфера, в байтах - public function AddWriteValue(val: CommandQueue; buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteValue(val: CommandQueue; mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает весь массив в начало буфера - public function AddWriteArray1(a: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteArray1(a: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает весь массив в начало буфера - public function AddWriteArray2(a: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteArray2(a: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает весь массив в начало буфера - public function AddWriteArray3(a: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteArray3(a: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Читает из буфера достаточно байт чтоб заполнить весь массив - public function AddReadArray1(a: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddReadArray1(a: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Читает из буфера достаточно байт чтоб заполнить весь массив - public function AddReadArray2(a: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddReadArray2(a: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Читает из буфера достаточно байт чтоб заполнить весь массив - public function AddReadArray3(a: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddReadArray3(a: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает указанный участок массива в буфер ///a_offset(-ы) указывают индекс в массиве ///len указывает кол-во задействованных элементов массива ///buff_offset указывает отступ от начала буфера, в байтах - public function AddWriteArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает указанный участок массива в буфер ///a_offset(-ы) указывают индекс в массиве @@ -2505,7 +2840,7 @@ type ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function AddWriteArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Записывает указанный участок массива в буфер ///a_offset(-ы) указывают индекс в массиве @@ -2515,13 +2850,13 @@ type ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function AddWriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddWriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Читает в буфер указанный участок массива ///a_offset(-ы) указывают индекс в массиве ///len указывает кол-во задействованных элементов массива ///buff_offset указывает отступ от начала буфера, в байтах - public function AddReadArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddReadArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Читает в буфер указанный участок массива ///a_offset(-ы) указывают индекс в массиве @@ -2531,7 +2866,7 @@ type ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function AddReadArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddReadArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Читает в буфер указанный участок массива ///a_offset(-ы) указывают индекс в массиве @@ -2541,35 +2876,35 @@ type ///ВНИМАНИЕ! У многомерных массивов элементы распологаются так же как у одномерных, разделение на строки виртуально ///Это значит что, к примеру, чтение 4 элементов 2-х мерного массива начиная с индекса [0,1] ///прочитает элементы [0,1], [0,2], [1,0], [1,1]. Для чтения частей из нескольких строк массива - делайте несколько операций чтения, по 1 на строку - public function AddReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegmentCCQ; where TRecord: record; {$endregion 1#Write&Read} {$region 2#Fill} ///Читает pattern_len байт из RAM по указанному адресу и заполняет их копиями весь буфер - public function AddFillData(ptr: CommandQueue; pattern_len: CommandQueue): BufferCommandQueue; + public function AddFillData(ptr: CommandQueue; pattern_len: CommandQueue): MemorySegmentCCQ; ///Читает pattern_len байт из RAM по указанному адресу и заполняет их копиями часть буфера ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddFillData(ptr: CommandQueue; pattern_len, buff_offset, len: CommandQueue): BufferCommandQueue; + public function AddFillData(ptr: CommandQueue; pattern_len, mem_offset, len: CommandQueue): MemorySegmentCCQ; ///Заполняет весь буфер копиями указанного значения размерного типа - public function AddFillValue(val: TRecord): BufferCommandQueue; where TRecord: record; + public function AddFillValue(val: TRecord): MemorySegmentCCQ; where TRecord: record; ///Заполняет часть буфера копиями указанного значения размерного типа ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddFillValue(val: TRecord; buff_offset, len: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddFillValue(val: TRecord; mem_offset, len: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Заполняет весь буфер копиями указанного значения размерного типа - public function AddFillValue(val: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddFillValue(val: CommandQueue): MemorySegmentCCQ; where TRecord: record; ///Заполняет часть буфера копиями указанного значения размерного типа ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddFillValue(val: CommandQueue; buff_offset, len: CommandQueue): BufferCommandQueue; where TRecord: record; + public function AddFillValue(val: CommandQueue; mem_offset, len: CommandQueue): MemorySegmentCCQ; where TRecord: record; {$endregion 2#Fill} @@ -2577,23 +2912,23 @@ type ///Копирует данные из текущего буфера в b ///Если буферы имеют разный размер - в качестве объёма данных берётся размер меньшего буфера - public function AddCopyTo(b: CommandQueue): BufferCommandQueue; + public function AddCopyTo(mem: CommandQueue): MemorySegmentCCQ; ///Копирует данные из b в текущий буфер ///Если буферы имеют разный размер - в качестве объёма данных берётся размер меньшего буфера - public function AddCopyForm(b: CommandQueue): BufferCommandQueue; + public function AddCopyFrom(mem: CommandQueue): MemorySegmentCCQ; ///Копирует данные из текущего буфера в b ///from_pos указывает отступ в байтах от начала буфера, из которого копируют ///to_pos указывает отступ в байтах от начала буфера, в который копируют ///len указывает кол-во копируемых байт - public function AddCopyTo(b: CommandQueue; from_pos, to_pos, len: CommandQueue): BufferCommandQueue; + public function AddCopyTo(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegmentCCQ; ///Копирует данные из b в текущий буфер ///from_pos указывает отступ в байтах от начала буфера, из которого копируют ///to_pos указывает отступ в байтах от начала буфера, в который копируют ///len указывает кол-во копируемых байт - public function AddCopyForm(b: CommandQueue; from_pos, to_pos, len: CommandQueue): BufferCommandQueue; + public function AddCopyFrom(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegmentCCQ; {$endregion 3#Copy} @@ -2605,14 +2940,14 @@ type ///Выделяет область неуправляемой памяти и копирует в неё часть содержимого данного буфера ///buff_offset указывает отступ от начала буфера, в байтах ///len указывает кол-во задействованных байт буфера - public function AddGetData(buff_offset, len: CommandQueue): CommandQueue; + public function AddGetData(mem_offset, len: CommandQueue): CommandQueue; ///Читает значение указанного размерного типа из начала буфера public function AddGetValue: CommandQueue; where TRecord: record; ///Читает значение указанного размерного типа из буфера ///buff_offset указывает отступ от начала буфера, в байтах - public function AddGetValue(buff_offset: CommandQueue): CommandQueue; where TRecord: record; + public function AddGetValue(mem_offset: CommandQueue): CommandQueue; where TRecord: record; ///Создаёт массив максимального размера (на сколько хватит байт буфера) и копирует в него содержимое буфера public function AddGetArray1: CommandQueue; where TRecord: record; @@ -2630,83 +2965,146 @@ type end; - ///Представляет область памяти устройства OpenCL - Buffer = partial class - ///Создаёт новую очередь-контейнер для команд GPU, применяемых к данному буферу - public function NewQueue := new BufferCommandQueue(self); + ///Представляет область памяти устройства OpenCL (обычно GPU) + MemorySegment = partial class + ///Создаёт новую очередь-контейнер для команд GPU, применяемых к данному объекту + public function NewQueue := new MemorySegmentCCQ(self); end; ///Представляет аргумент, передаваемый в вызов kernel-а KernelArg = abstract partial class - public static function operator implicit(bq: BufferCommandQueue): KernelArg; + public static function operator implicit(mem_q: MemorySegmentCCQ): KernelArg; end; - {$endregion BufferCommandQueue} + {$endregion MemorySegmentCCQ} - {$region KernelCommandQueue} + {$region CLArrayCCQ} - ///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа Kernel - KernelCommandQueue = sealed partial class + ///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа CLArray + CLArrayCCQ = sealed partial class + where T: record; ///Создаёт контейнер команд, который будет применять команды к указанному объекту - public constructor(o: Kernel); + public constructor(o: CLArray); ///Создаёт контейнер команд, который будет применять команды к объекту, который вернёт указанная очередь ///За каждое одно выполнение контейнера - q выполнится ровно один раз - public constructor(q: CommandQueue); + public constructor(q: CommandQueue>); private constructor; {$region Special .Add's} ///Добавляет выполнение очереди в список обычных команд для GPU - public function AddQueue(q: CommandQueueBase): KernelCommandQueue; + public function AddQueue(q: CommandQueueBase): CLArrayCCQ; ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU - public function AddProc(p: Kernel->()): KernelCommandQueue; + public function AddProc(p: CLArray->()): CLArrayCCQ; ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU - public function AddProc(p: (Kernel, Context)->()): KernelCommandQueue; + public function AddProc(p: (CLArray, Context)->()): CLArrayCCQ; ///Добавляет ожидание сигнала выполненности от всех заданных маркеров - public function AddWaitAll(params markers: array of WaitMarkerBase): KernelCommandQueue; + public function AddWaitAll(params markers: array of WaitMarkerBase): CLArrayCCQ; ///Добавляет ожидание сигнала выполненности от всех заданных маркеров - public function AddWaitAll(markers: sequence of WaitMarkerBase): KernelCommandQueue; + public function AddWaitAll(markers: sequence of WaitMarkerBase): CLArrayCCQ; ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров - public function AddWaitAny(params markers: array of WaitMarkerBase): KernelCommandQueue; + public function AddWaitAny(params markers: array of WaitMarkerBase): CLArrayCCQ; ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров - public function AddWaitAny(markers: sequence of WaitMarkerBase): KernelCommandQueue; + public function AddWaitAny(markers: sequence of WaitMarkerBase): CLArrayCCQ; ///Добавляет ожидание сигнала выполненности от заданного маркера - public function AddWait(marker: WaitMarkerBase): KernelCommandQueue; + public function AddWait(marker: WaitMarkerBase): CLArrayCCQ; {$endregion Special .Add's} - {$region 1#Exec} + {$region 1#Write&Read} - ///Выполняет kernel с указанным кол-вом ядер и передаёт в него указанные аргументы - public function AddExec1(sz1: CommandQueue; params args: array of KernelArg): KernelCommandQueue; + ///Записывает указанное значение по индексу ind + public function AddWriteItem(val: &T; ind: CommandQueue): CLArrayCCQ; - ///Выполняет kernel с указанным кол-вом ядер и передаёт в него указанные аргументы - public function AddExec2(sz1,sz2: CommandQueue; params args: array of KernelArg): KernelCommandQueue; + ///Записывает указанное значение по индексу ind + public function AddWriteItem(val: CommandQueue<&T>; ind: CommandQueue): CLArrayCCQ; - ///Выполняет kernel с указанным кол-вом ядер и передаёт в него указанные аргументы - public function AddExec3(sz1,sz2,sz3: CommandQueue; params args: array of KernelArg): KernelCommandQueue; + ///Записывает весь указанный массив в начало данного объекта CLArray + public function AddWriteArray(a: CommandQueue): CLArrayCCQ; - ///Выполняет kernel с расширенным набором параметров - ///Данная перегрузка используется в первую очередь для тонких оптимизаций - ///Если она вам понадобилась по другой причина - пожалуйста, напишите в issue - public function AddExec(global_work_offset, global_work_size, local_work_size: CommandQueue; params args: array of KernelArg): KernelCommandQueue; + ///Читает начало данного объекта CLArray в указанный массив + public function AddReadArray(a: CommandQueue): CLArrayCCQ; - {$endregion 1#Exec} + ///Записывает len элементов массива a, начиная с индекса a_ind, в данный объект CLArray по индексу ind + public function AddWriteArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArrayCCQ; + + ///Читает len элементов данного объекта CLArray, начиная с индекса ind, в массив a по индексу a_ind + public function AddReadArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArrayCCQ; + + {$endregion 1#Write&Read} + + {$region 2#Fill} + + ///Заполняет весь массив копиями указанного значения + public function AddFill(val: &T): CLArrayCCQ; + + ///Заполняет len элементов начиная с индекса ind копиями указанного значения + public function AddFill(val: &T; ind, len: CommandQueue): CLArrayCCQ; + + ///Заполняет весь массив копиями указанного значения + public function AddFill(val: CommandQueue<&T>): CLArrayCCQ; + + ///Заполняет len элементов начиная с индекса ind копиями указанного значения + public function AddFill(val: CommandQueue<&T>; ind, len: CommandQueue): CLArrayCCQ; + + {$endregion 2#Fill} + + {$region 3#Copy} + + ///Копирует данные из текущего массива в a + ///Если у массивов разный размер - копируется кол-во элементов меньшего массива + public function AddCopyTo(a: CommandQueue>): CLArrayCCQ; + + ///Копирует данные из a в текущий массив + ///Если у массивов разный размер - копируется кол-во элементов меньшего массива + public function AddCopyFrom(a: CommandQueue>): CLArrayCCQ; + + ///Копирует данные из текущего массива в a + ///from_ind указывает индекс в массиве, из которого копируют + ///to_ind указывает индекс в массиве, в который копируют + ///len указывает кол-во копируемых элементов + public function AddCopyTo(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArrayCCQ; + + ///Копирует данные из a в текущий массив + ///from_ind указывает индекс в массиве, из которого копируют + ///to_ind указывает индекс в массиве, в который копируют + ///len указывает кол-во копируемых элементов + public function AddCopyFrom(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArrayCCQ; + + {$endregion 3#Copy} + + {$region Get} + + ///Читает элемент по указанному индексу + public function AddGetItem(ind: CommandQueue): CommandQueue<&T>; + + ///Читает весь CLArray как обычный массив array of T + public function AddGetArray: CommandQueue; + + ///Читает len элементов начиная с индекса ind из CLArray как обычный массив array of T + public function AddGetArray(ind, len: CommandQueue): CommandQueue; + + {$endregion Get} end; - ///Представляет подпрограмму, выполняемую на GPU - Kernel = partial class - ///Создаёт новую очередь-контейнер для команд GPU, применяемых к данному kernel-у - public function NewQueue := new KernelCommandQueue(self); + ///Представляет массив записей, содержимое которого хранится на устройстве OpenCL (обычно GPU) + CLArray = partial class + ///Создаёт новую очередь-контейнер для команд GPU, применяемых к данному объекту + public function NewQueue := new CLArrayCCQ(self); end; - {$endregion KernelCommandQueue} + ///Представляет аргумент, передаваемый в вызов kernel-а + KernelArg = abstract partial class + public static function operator implicit(a_q: CLArrayCCQ): KernelArg; where T: record; + end; + + {$endregion CLArrayCCQ} {$region Global subprograms} @@ -3083,65 +3481,38 @@ type {$endregion Base} -{$region Buffer} +{$region Platform} type - BufferProperties = sealed partial class(NtvPropertiesBase) + PlatformProperties = partial class(NtvPropertiesBase) - private static function clGetSize(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; - external 'opencl.dll' name 'clGetMemObjectInfo'; - private static function clGetVal(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; - external 'opencl.dll' name 'clGetMemObjectInfo'; + private static function clGetSize(ntv: cl_platform_id; param_name: PlatformInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; + external 'opencl.dll' name 'clGetPlatformInfo'; + private static function clGetVal(ntv: cl_platform_id; param_name: PlatformInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; + external 'opencl.dll' name 'clGetPlatformInfo'; - protected procedure GetSizeImpl(id: MemInfo; var sz: UIntPtr); override := + protected procedure GetSizeImpl(id: PlatformInfo; var sz: UIntPtr); override := clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; - protected procedure GetValImpl(id: MemInfo; sz: UIntPtr; var res: byte); override := + protected procedure GetValImpl(id: PlatformInfo; sz: UIntPtr; var res: byte); override := clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; end; -constructor BufferProperties.Create(ntv: cl_mem) := inherited Create(ntv); +constructor PlatformProperties.Create(ntv: cl_platform_id) := inherited Create(ntv); -function BufferProperties.GetType := GetVal&(MemInfo.MEM_TYPE); -function BufferProperties.GetFlags := GetVal&(MemInfo.MEM_FLAGS); -function BufferProperties.GetSize := GetVal&(MemInfo.MEM_SIZE); -function BufferProperties.GetHostPtr := GetVal&(MemInfo.MEM_HOST_PTR); -function BufferProperties.GetMapCount := GetVal&(MemInfo.MEM_MAP_COUNT); -function BufferProperties.GetReferenceCount := GetVal&(MemInfo.MEM_REFERENCE_COUNT); -function BufferProperties.GetUsesSvmPointer := GetVal&(MemInfo.MEM_USES_SVM_POINTER); -function BufferProperties.GetOffset := GetVal&(MemInfo.MEM_OFFSET); +function PlatformProperties.GetProfile := GetString(PlatformInfo.PLATFORM_PROFILE); +function PlatformProperties.GetVersion := GetString(PlatformInfo.PLATFORM_VERSION); +function PlatformProperties.GetName := GetString(PlatformInfo.PLATFORM_NAME); +function PlatformProperties.GetVendor := GetString(PlatformInfo.PLATFORM_VENDOR); +function PlatformProperties.GetExtensions := GetString(PlatformInfo.PLATFORM_EXTENSIONS); +function PlatformProperties.GetHostTimerResolution := GetVal&(PlatformInfo.PLATFORM_HOST_TIMER_RESOLUTION); -{$endregion Buffer} - -{$region Context} - -type - ContextProperties = sealed partial class(NtvPropertiesBase) - - private static function clGetSize(ntv: cl_context; param_name: ContextInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; - external 'opencl.dll' name 'clGetContextInfo'; - private static function clGetVal(ntv: cl_context; param_name: ContextInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; - external 'opencl.dll' name 'clGetContextInfo'; - - protected procedure GetSizeImpl(id: ContextInfo; var sz: UIntPtr); override := - clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; - protected procedure GetValImpl(id: ContextInfo; sz: UIntPtr; var res: byte); override := - clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; - - end; - -constructor ContextProperties.Create(ntv: cl_context) := inherited Create(ntv); - -function ContextProperties.GetReferenceCount := GetVal&(ContextInfo.CONTEXT_REFERENCE_COUNT); -function ContextProperties.GetNumDevices := GetVal&(ContextInfo.CONTEXT_NUM_DEVICES); -function ContextProperties.GetProperties := GetValArr&(ContextInfo.CONTEXT_PROPERTIES); - -{$endregion Context} +{$endregion Platform} {$region Device} type - DeviceProperties = sealed partial class(NtvPropertiesBase) + DeviceProperties = partial class(NtvPropertiesBase) private static function clGetSize(ntv: cl_device_id; param_name: DeviceInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; external 'opencl.dll' name 'clGetDeviceInfo'; @@ -3248,64 +3619,35 @@ function DeviceProperties.GetSubGroupIndependentForwardProgress := GetVal& {$endregion Device} -{$region Kernel} +{$region Context} type - KernelProperties = sealed partial class(NtvPropertiesBase) + ContextProperties = partial class(NtvPropertiesBase) - private static function clGetSize(ntv: cl_kernel; param_name: KernelInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; - external 'opencl.dll' name 'clGetKernelInfo'; - private static function clGetVal(ntv: cl_kernel; param_name: KernelInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; - external 'opencl.dll' name 'clGetKernelInfo'; + private static function clGetSize(ntv: cl_context; param_name: ContextInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; + external 'opencl.dll' name 'clGetContextInfo'; + private static function clGetVal(ntv: cl_context; param_name: ContextInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; + external 'opencl.dll' name 'clGetContextInfo'; - protected procedure GetSizeImpl(id: KernelInfo; var sz: UIntPtr); override := + protected procedure GetSizeImpl(id: ContextInfo; var sz: UIntPtr); override := clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; - protected procedure GetValImpl(id: KernelInfo; sz: UIntPtr; var res: byte); override := + protected procedure GetValImpl(id: ContextInfo; sz: UIntPtr; var res: byte); override := clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; end; -constructor KernelProperties.Create(ntv: cl_kernel) := inherited Create(ntv); +constructor ContextProperties.Create(ntv: cl_context) := inherited Create(ntv); -function KernelProperties.GetFunctionName := GetString(KernelInfo.KERNEL_FUNCTION_NAME); -function KernelProperties.GetNumArgs := GetVal&(KernelInfo.KERNEL_NUM_ARGS); -function KernelProperties.GetReferenceCount := GetVal&(KernelInfo.KERNEL_REFERENCE_COUNT); -function KernelProperties.GetAttributes := GetString(KernelInfo.KERNEL_ATTRIBUTES); +function ContextProperties.GetReferenceCount := GetVal&(ContextInfo.CONTEXT_REFERENCE_COUNT); +function ContextProperties.GetNumDevices := GetVal&(ContextInfo.CONTEXT_NUM_DEVICES); +function ContextProperties.GetProperties := GetValArr&(ContextInfo.CONTEXT_PROPERTIES); -{$endregion Kernel} - -{$region Platform} - -type - PlatformProperties = sealed partial class(NtvPropertiesBase) - - private static function clGetSize(ntv: cl_platform_id; param_name: PlatformInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; - external 'opencl.dll' name 'clGetPlatformInfo'; - private static function clGetVal(ntv: cl_platform_id; param_name: PlatformInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; - external 'opencl.dll' name 'clGetPlatformInfo'; - - protected procedure GetSizeImpl(id: PlatformInfo; var sz: UIntPtr); override := - clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; - protected procedure GetValImpl(id: PlatformInfo; sz: UIntPtr; var res: byte); override := - clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; - - end; - -constructor PlatformProperties.Create(ntv: cl_platform_id) := inherited Create(ntv); - -function PlatformProperties.GetProfile := GetString(PlatformInfo.PLATFORM_PROFILE); -function PlatformProperties.GetVersion := GetString(PlatformInfo.PLATFORM_VERSION); -function PlatformProperties.GetName := GetString(PlatformInfo.PLATFORM_NAME); -function PlatformProperties.GetVendor := GetString(PlatformInfo.PLATFORM_VENDOR); -function PlatformProperties.GetExtensions := GetString(PlatformInfo.PLATFORM_EXTENSIONS); -function PlatformProperties.GetHostTimerResolution := GetVal&(PlatformInfo.PLATFORM_HOST_TIMER_RESOLUTION); - -{$endregion Platform} +{$endregion Context} {$region ProgramCode} type - ProgramCodeProperties = sealed partial class(NtvPropertiesBase) + ProgramCodeProperties = partial class(NtvPropertiesBase) private static function clGetSize(ntv: cl_program; param_name: ProgramInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; external 'opencl.dll' name 'clGetProgramInfo'; @@ -3331,8 +3673,129 @@ function ProgramCodeProperties.GetScopeGlobalDtorsPresent := GetVal&(Progr {$endregion ProgramCode} +{$region Kernel} + +type + KernelProperties = partial class(NtvPropertiesBase) + + private static function clGetSize(ntv: cl_kernel; param_name: KernelInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; + external 'opencl.dll' name 'clGetKernelInfo'; + private static function clGetVal(ntv: cl_kernel; param_name: KernelInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; + external 'opencl.dll' name 'clGetKernelInfo'; + + protected procedure GetSizeImpl(id: KernelInfo; var sz: UIntPtr); override := + clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; + protected procedure GetValImpl(id: KernelInfo; sz: UIntPtr; var res: byte); override := + clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; + + end; + +constructor KernelProperties.Create(ntv: cl_kernel) := inherited Create(ntv); + +function KernelProperties.GetFunctionName := GetString(KernelInfo.KERNEL_FUNCTION_NAME); +function KernelProperties.GetNumArgs := GetVal&(KernelInfo.KERNEL_NUM_ARGS); +function KernelProperties.GetReferenceCount := GetVal&(KernelInfo.KERNEL_REFERENCE_COUNT); +function KernelProperties.GetAttributes := GetString(KernelInfo.KERNEL_ATTRIBUTES); + +{$endregion Kernel} + +{$region MemorySegment} + +type + MemorySegmentProperties = partial class(NtvPropertiesBase) + + private static function clGetSize(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; + external 'opencl.dll' name 'clGetMemObjectInfo'; + private static function clGetVal(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; + external 'opencl.dll' name 'clGetMemObjectInfo'; + + protected procedure GetSizeImpl(id: MemInfo; var sz: UIntPtr); override := + clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; + protected procedure GetValImpl(id: MemInfo; sz: UIntPtr; var res: byte); override := + clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; + + end; + +constructor MemorySegmentProperties.Create(ntv: cl_mem) := inherited Create(ntv); + +function MemorySegmentProperties.GetFlags := GetVal&(MemInfo.MEM_FLAGS); +function MemorySegmentProperties.GetHostPtr := GetVal&(MemInfo.MEM_HOST_PTR); +function MemorySegmentProperties.GetMapCount := GetVal&(MemInfo.MEM_MAP_COUNT); +function MemorySegmentProperties.GetReferenceCount := GetVal&(MemInfo.MEM_REFERENCE_COUNT); +function MemorySegmentProperties.GetUsesSvmPointer := GetVal&(MemInfo.MEM_USES_SVM_POINTER); + +{$endregion MemorySegment} + +{$region MemorySubSegment} + +type + MemorySubSegmentProperties = partial class(MemorySegmentProperties) + + private static function clGetSize(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; + external 'opencl.dll' name 'clGetMemObjectInfo'; + private static function clGetVal(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; + external 'opencl.dll' name 'clGetMemObjectInfo'; + + protected procedure GetSizeImpl(id: MemInfo; var sz: UIntPtr); override := + clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; + protected procedure GetValImpl(id: MemInfo; sz: UIntPtr; var res: byte); override := + clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; + + end; + +constructor MemorySubSegmentProperties.Create(ntv: cl_mem) := inherited Create(ntv); + +function MemorySubSegmentProperties.GetOffset := GetVal&(MemInfo.MEM_OFFSET); + +{$endregion MemorySubSegment} + +{$region CLArray} + +type + CLArrayProperties = partial class(NtvPropertiesBase) + + private static function clGetSize(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; param_value: IntPtr; var param_value_size_ret: UIntPtr): ErrorCode; + external 'opencl.dll' name 'clGetMemObjectInfo'; + private static function clGetVal(ntv: cl_mem; param_name: MemInfo; param_value_size: UIntPtr; var param_value: byte; param_value_size_ret: IntPtr): ErrorCode; + external 'opencl.dll' name 'clGetMemObjectInfo'; + + protected procedure GetSizeImpl(id: MemInfo; var sz: UIntPtr); override := + clGetSize(ntv, id, UIntPtr.Zero, IntPtr.Zero, sz).RaiseIfError; + protected procedure GetValImpl(id: MemInfo; sz: UIntPtr; var res: byte); override := + clGetVal(ntv, id, sz, res, IntPtr.Zero).RaiseIfError; + + end; + +constructor CLArrayProperties.Create(ntv: cl_mem) := inherited Create(ntv); + +function CLArrayProperties.GetFlags := GetVal&(MemInfo.MEM_FLAGS); +function CLArrayProperties.GetHostPtr := GetVal&(MemInfo.MEM_HOST_PTR); +function CLArrayProperties.GetMapCount := GetVal&(MemInfo.MEM_MAP_COUNT); +function CLArrayProperties.GetReferenceCount := GetVal&(MemInfo.MEM_REFERENCE_COUNT); +function CLArrayProperties.GetUsesSvmPointer := GetVal&(MemInfo.MEM_USES_SVM_POINTER); + +{$endregion CLArray} + {$endregion Properties} +{$region Wrappers} + +{$region CLArray} + +function CLArray.GetItemProp(ind: integer): T := +GetItem(ind); +procedure CLArray.SetItemProp(ind: integer; value: T) := +WriteItem(value, ind); + +function CLArray.GetSectionProp(range: IntRange): array of T := +GetArray(range.Low, range.High-range.Low+1); +procedure CLArray.SetSectionProp(range: IntRange; value: array of T) := +WriteArray(value, range.Low, range.High-range.Low+1, 0); + +{$endregion CLArray} + +{$endregion Wrappers} + {$region Util type's} {$region EventDebug}{$ifdef EventDebug} @@ -4194,6 +4657,8 @@ type CommandQueue = abstract partial class(CommandQueueBase) + //ToDo Нет никакой гарантии что Result.ev.abortable будет установлено + // - Но в нескольких местах, как в FinishAfterNewQ и CLTask.Create, стоит проверка и NotSupportedException protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; abstract; protected function InvokeBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueResBase; override := Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); @@ -4240,7 +4705,7 @@ type lock mw_evs do if not mw_evs.ContainsKey(tsk) then begin mw_evs[tsk] := new MWEventContainer; - tsk.WhenDone(tsk->lock mw_evs do mw_evs.Remove(tsk)); + tsk.WhenDoneBase(tsk->lock mw_evs do mw_evs.Remove(tsk)); end; private procedure AddMWHandler(tsk: CLTaskBase; handler: ()->boolean); @@ -4402,7 +4867,8 @@ type mu_res := nil; {$ifdef DEBUG} - if (qr.ev.count<>0) and not qr.ev.abortable then raise new NotSupportedException; + //ToDo +// if (qr.ev.count<>0) and not qr.ev.abortable then raise new NotSupportedException; {$endif DEBUG} //CQ.Invoke всегда выполняет UserEvent.EnsureAbortability, поэтому тут оно не нужно @@ -4506,16 +4972,16 @@ type {$region CLTask event's} protected EvDone := new List>; - protected procedure WhenDoneBase(cb: Action); override := + public procedure WhenDoneBase(cb: Action); override := if AddEventHandler(EvDone, cb) then cb(self); protected EvComplete := new List>; - protected procedure WhenCompleteBase(cb: Action); override := - if AddEventHandler(EvComplete, cb) then cb(self, q_res); + public procedure WhenCompleteBase(cb: Action); override := + if AddEventHandler(EvComplete, cb) and (err_lst.Count=0) then cb(self, q_res); protected EvError := new List>; - protected procedure WhenErrorBase(cb: Action); override := - if AddEventHandler(EvError, cb) then cb(self, GetErrArr); + public procedure WhenErrorBase(cb: Action); override := + if AddEventHandler(EvError, cb) and (err_lst.Count<>0) then cb(self, GetErrArr); {$endregion CLTask event's} @@ -5617,33 +6083,57 @@ type {$endregion Base} -{$region Buffer} +{$region MemorySegment} type - KernelArgBuffer = sealed class(ConstKernelArg) - private b: Buffer; + KernelArgMemorySegment = sealed class(ConstKernelArg) + private mem: MemorySegment; - public constructor(b: Buffer) := self.b := b; + public constructor(mem: MemorySegment) := self.mem := mem; private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - public procedure SetArg(k: cl_kernel; ind: UInt32; c: Context); override; - begin - b.InitIfNeed(c); - cl.SetKernelArg(k, ind, new UIntPtr(cl_mem.Size), b.ntv).RaiseIfError; - end; + public procedure SetArg(k: cl_kernel; ind: UInt32; c: Context); override := + cl.SetKernelArg(k, ind, new UIntPtr(cl_mem.Size), mem.ntv).RaiseIfError; private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; begin sb += ' => '; - sb.Append(b); + sb.Append(mem); sb += #10; end; end; -static function KernelArg.FromBuffer(b: Buffer) := new KernelArgBuffer(b); +static function KernelArg.FromMemorySegment(mem: MemorySegment) := new KernelArgMemorySegment(mem); -{$endregion Buffer} +{$endregion MemorySegment} + +{$region CLArray} + +type + KernelArgCLArray = sealed class(ConstKernelArg) + where T: record; + private a: CLArray; + + public constructor(a: CLArray) := self.a := a; + private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + public procedure SetArg(k: cl_kernel; ind: UInt32; c: Context); override := + cl.SetKernelArg(k, ind, new UIntPtr(cl_mem.Size), a.ntv).RaiseIfError; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += ' => '; + sb.Append(a); + sb += #10; + end; + + end; + +static function KernelArg.FromCLArray(a: CLArray): KernelArg; where T: record; +begin Result := new KernelArgCLArray(a); end; + +{$endregion CLArray} {$region Record} @@ -5717,16 +6207,16 @@ type {$endregion Base} -{$region Buffer} +{$region MemorySegment} type - KernelArgBufferCQ = sealed class(InvokeableKernelArg) - public q: CommandQueue; - public constructor(q: CommandQueue) := self.q := q; + KernelArgMemorySegmentCQ = sealed class(InvokeableKernelArg) + public q: CommandQueue; + public constructor(q: CommandQueue) := self.q := q; private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id): QueueRes; override := - q.InvokeNewQ(tsk, c, main_dvc, false, nil).LazyQuickTransform(b->new KernelArgBuffer(b) as ISetableKernelArg); + q.InvokeNewQ(tsk, c, main_dvc, false, nil).LazyQuickTransform(mem->new KernelArgMemorySegment(mem) as ISetableKernelArg); protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := q.RegisterWaitables(tsk, prev_hubs); @@ -5739,10 +6229,38 @@ type end; -static function KernelArg.FromBufferCQ(bq: CommandQueue) := -new KernelArgBufferCQ(bq); +static function KernelArg.FromMemorySegmentCQ(mem_q: CommandQueue) := +new KernelArgMemorySegmentCQ(mem_q); -{$endregion Buffer} +{$endregion MemorySegment} + +{$region CLArray} + +type + KernelArgCLArrayCQ = sealed class(InvokeableKernelArg) + where T: record; + public q: CommandQueue>; + public constructor(q: CommandQueue>) := self.q := q; + private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id): QueueRes; override := + q.InvokeNewQ(tsk, c, main_dvc, false, nil).LazyQuickTransform(a->new KernelArgCLArray(a) as ISetableKernelArg); + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := + q.RegisterWaitables(tsk, prev_hubs); + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + q.ToString(sb, tabs, index, delayed); + end; + + end; + +static function KernelArg.FromCLArrayCQ(a_q: CommandQueue>): KernelArg; where T: record; +begin Result := new KernelArgCLArrayCQ(a_q); end; + +{$endregion CLArray} {$region Record} @@ -6003,8 +6521,6 @@ type protected core: GPUCommandContainerCore; protected commands := new List>; - protected procedure InitObj(obj: T; c: Context); virtual := exit; - protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := core.Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); @@ -6047,7 +6563,6 @@ type protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin var res_obj := self.o; - cc.InitObj(res_obj, c); foreach var comm in cc.commands do prev_ev := comm.InvokeObj(res_obj, tsk, c, main_dvc, cq, prev_ev); @@ -6111,69 +6626,20 @@ type {$endregion Core} -{$region BufferCommandQueue} +{$region Kernel} type - BufferCommandQueue = sealed partial class(GPUCommandContainer) - - {$region constructor's} - - protected procedure InitObj(obj: Buffer; c: Context); override := obj.InitIfNeed(c); - protected static function InitBuffer(b: Buffer; c: Context): Buffer; - begin - b.InitIfNeed(c); - Result := b; - end; - - {$endregion constructor's} + KernelCCQ = sealed partial class(GPUCommandContainer) end; -static function KernelArg.operator implicit(bq: BufferCommandQueue): KernelArg := FromBufferCQ(bq); - -constructor BufferCommandQueue.Create(o: Buffer) := inherited; -constructor BufferCommandQueue.Create(q: CommandQueue) := inherited Create(q.ThenConvert(InitBuffer)); -constructor BufferCommandQueue.Create := inherited; +constructor KernelCCQ.Create(o: Kernel) := inherited; +constructor KernelCCQ.Create(q: CommandQueue) := inherited; +constructor KernelCCQ.Create := inherited; {$region Special .Add's} -function BufferCommandQueue.AddQueue(q: CommandQueueBase): BufferCommandQueue; -begin - Result := self; - if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди'); - if q is ICastQueue(var cq) then q := cq.GetQ; - commands.Add( new QueueCommand(q) ); -end; - -function BufferCommandQueue.AddProc(p: Buffer->()) := AddCommand(self, new ProcCommand((o,c)->p(o))); -function BufferCommandQueue.AddProc(p: (Buffer, Context)->()) := AddCommand(self, new ProcCommand(p)); - -function BufferCommandQueue.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); -function BufferCommandQueue.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); - -function BufferCommandQueue.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); -function BufferCommandQueue.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); - -function BufferCommandQueue.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); - -{$endregion Special .Add's} - -{$endregion BufferCommandQueue} - -{$region KernelCommandQueue} - -type - KernelCommandQueue = sealed partial class(GPUCommandContainer) - - end; - -constructor KernelCommandQueue.Create(o: Kernel) := inherited; -constructor KernelCommandQueue.Create(q: CommandQueue) := inherited; -constructor KernelCommandQueue.Create := inherited; - -{$region Special .Add's} - -function KernelCommandQueue.AddQueue(q: CommandQueueBase): KernelCommandQueue; +function KernelCCQ.AddQueue(q: CommandQueueBase): KernelCCQ; begin Result := self; if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди'); @@ -6181,20 +6647,97 @@ begin commands.Add( new QueueCommand(q) ); end; -function KernelCommandQueue.AddProc(p: Kernel->()) := AddCommand(self, new ProcCommand((o,c)->p(o))); -function KernelCommandQueue.AddProc(p: (Kernel, Context)->()) := AddCommand(self, new ProcCommand(p)); +function KernelCCQ.AddProc(p: Kernel->()) := AddCommand(self, new ProcCommand((o,c)->p(o))); +function KernelCCQ.AddProc(p: (Kernel, Context)->()) := AddCommand(self, new ProcCommand(p)); -function KernelCommandQueue.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); -function KernelCommandQueue.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); +function KernelCCQ.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); +function KernelCCQ.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); -function KernelCommandQueue.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); -function KernelCommandQueue.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); +function KernelCCQ.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); +function KernelCCQ.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); -function KernelCommandQueue.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); +function KernelCCQ.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); {$endregion Special .Add's} -{$endregion KernelCommandQueue} +{$endregion Kernel} + +{$region MemorySegment} + +type + MemorySegmentCCQ = sealed partial class(GPUCommandContainer) + + end; + +static function KernelArg.operator implicit(mem_q: MemorySegmentCCQ): KernelArg := FromMemorySegmentCQ(mem_q); + +constructor MemorySegmentCCQ.Create(o: MemorySegment) := inherited; +constructor MemorySegmentCCQ.Create(q: CommandQueue) := inherited; +constructor MemorySegmentCCQ.Create := inherited; + +{$region Special .Add's} + +function MemorySegmentCCQ.AddQueue(q: CommandQueueBase): MemorySegmentCCQ; +begin + Result := self; + if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди'); + if q is ICastQueue(var cq) then q := cq.GetQ; + commands.Add( new QueueCommand(q) ); +end; + +function MemorySegmentCCQ.AddProc(p: MemorySegment->()) := AddCommand(self, new ProcCommand((o,c)->p(o))); +function MemorySegmentCCQ.AddProc(p: (MemorySegment, Context)->()) := AddCommand(self, new ProcCommand(p)); + +function MemorySegmentCCQ.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); +function MemorySegmentCCQ.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); + +function MemorySegmentCCQ.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); +function MemorySegmentCCQ.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); + +function MemorySegmentCCQ.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); + +{$endregion Special .Add's} + +{$endregion MemorySegment} + +{$region CLArray} + +type + CLArrayCCQ = sealed partial class(GPUCommandContainer>) + + end; + +static function KernelArg.operator implicit(a_q: CLArrayCCQ): KernelArg; where T: record; +begin Result := FromCLArrayCQ(a_q); end; + +constructor CLArrayCCQ.Create(o: CLArray) := inherited; +constructor CLArrayCCQ.Create(q: CommandQueue>) := inherited; +constructor CLArrayCCQ.Create := inherited; + +{$region Special .Add's} + +function CLArrayCCQ.AddQueue(q: CommandQueueBase): CLArrayCCQ; +begin + Result := self; + if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди'); + if q is ICastQueue(var cq) then q := cq.GetQ; + commands.Add( new QueueCommand>(q) ); +end; + +function CLArrayCCQ.AddProc(p: CLArray->()) := AddCommand(self, new ProcCommand>((o,c)->p(o))); +function CLArrayCCQ.AddProc(p: (CLArray, Context)->()) := AddCommand(self, new ProcCommand>(p)); + +function CLArrayCCQ.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand>(new WCQWaiterAll(markers.ToArray))); +function CLArrayCCQ.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand>(new WCQWaiterAll(markers.ToArray))); + +function CLArrayCCQ.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand>(new WCQWaiterAny(markers.ToArray))); +function CLArrayCCQ.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand>(new WCQWaiterAny(markers.ToArray))); + +function CLArrayCCQ.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); + +{$endregion Special .Add's} + +{$endregion CLArray} {$endregion GPUCommandContainer} @@ -6385,2722 +6928,6 @@ type {$endregion GetCommand} -{$region Buffer} - -{$region Implicit} - -{$region 1#Write&Read} - -function Buffer.WriteData(ptr: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteData(ptr) as CommandQueue); - -function Buffer.ReadData(ptr: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadData(ptr) as CommandQueue); - -function Buffer.WriteData(ptr: CommandQueue; buff_offset, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteData(ptr, buff_offset, len) as CommandQueue); - -function Buffer.ReadData(ptr: CommandQueue; buff_offset, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadData(ptr, buff_offset, len) as CommandQueue); - -function Buffer.WriteData(ptr: pointer): Buffer := -WriteData(IntPtr(ptr)); - -function Buffer.ReadData(ptr: pointer): Buffer := -ReadData(IntPtr(ptr)); - -function Buffer.WriteData(ptr: pointer; buff_offset, len: CommandQueue): Buffer := -WriteData(IntPtr(ptr), buff_offset, len); - -function Buffer.ReadData(ptr: pointer; buff_offset, len: CommandQueue): Buffer := -ReadData(IntPtr(ptr), buff_offset, len); - -function Buffer.WriteValue(val: TRecord): Buffer := -WriteValue(val, 0); - -function Buffer.WriteValue(val: TRecord; buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteValue&(val, buff_offset) as CommandQueue); - -function Buffer.WriteValue(val: CommandQueue): Buffer := -WriteValue(val, 0); - -function Buffer.WriteValue(val: CommandQueue; buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteValue&(val, buff_offset) as CommandQueue); - -function Buffer.WriteArray1(a: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteArray1&(a) as CommandQueue); - -function Buffer.WriteArray2(a: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteArray2&(a) as CommandQueue); - -function Buffer.WriteArray3(a: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteArray3&(a) as CommandQueue); - -function Buffer.ReadArray1(a: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadArray1&(a) as CommandQueue); - -function Buffer.ReadArray2(a: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadArray2&(a) as CommandQueue); - -function Buffer.ReadArray3(a: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadArray3&(a) as CommandQueue); - -function Buffer.WriteArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteArray1&(a, a_offset, len, buff_offset) as CommandQueue); - -function Buffer.WriteArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteArray2&(a, a_offset1, a_offset2, len, buff_offset) as CommandQueue); - -function Buffer.WriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddWriteArray3&(a, a_offset1, a_offset2, a_offset3, len, buff_offset) as CommandQueue); - -function Buffer.ReadArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadArray1&(a, a_offset, len, buff_offset) as CommandQueue); - -function Buffer.ReadArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadArray2&(a, a_offset1, a_offset2, len, buff_offset) as CommandQueue); - -function Buffer.ReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddReadArray3&(a, a_offset1, a_offset2, a_offset3, len, buff_offset) as CommandQueue); - -{$endregion 1#Write&Read} - -{$region 2#Fill} - -function Buffer.FillData(ptr: CommandQueue; pattern_len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddFillData(ptr, pattern_len) as CommandQueue); - -function Buffer.FillData(ptr: CommandQueue; pattern_len, buff_offset, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddFillData(ptr, pattern_len, buff_offset, len) as CommandQueue); - -function Buffer.FillValue(val: TRecord): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val) as CommandQueue); - -function Buffer.FillValue(val: TRecord; buff_offset, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val, buff_offset, len) as CommandQueue); - -function Buffer.FillValue(val: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val) as CommandQueue); - -function Buffer.FillValue(val: CommandQueue; buff_offset, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val, buff_offset, len) as CommandQueue); - -{$endregion 2#Fill} - -{$region 3#Copy} - -function Buffer.CopyTo(b: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddCopyTo(b) as CommandQueue); - -function Buffer.CopyForm(b: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddCopyForm(b) as CommandQueue); - -function Buffer.CopyTo(b: CommandQueue; from_pos, to_pos, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddCopyTo(b, from_pos, to_pos, len) as CommandQueue); - -function Buffer.CopyForm(b: CommandQueue; from_pos, to_pos, len: CommandQueue): Buffer := -Context.Default.SyncInvoke(self.NewQueue.AddCopyForm(b, from_pos, to_pos, len) as CommandQueue); - -{$endregion 3#Copy} - -{$region Get} - -function Buffer.GetData: IntPtr := -Context.Default.SyncInvoke(self.NewQueue.AddGetData as CommandQueue); - -function Buffer.GetData(buff_offset, len: CommandQueue): IntPtr := -Context.Default.SyncInvoke(self.NewQueue.AddGetData(buff_offset, len) as CommandQueue); - -function Buffer.GetValue: TRecord := -GetValue&(0); - -function Buffer.GetValue(buff_offset: CommandQueue): TRecord := -Context.Default.SyncInvoke(self.NewQueue.AddGetValue&(buff_offset) as CommandQueue); - -function Buffer.GetArray1: array of TRecord := -Context.Default.SyncInvoke(self.NewQueue.AddGetArray1& as CommandQueue); - -function Buffer.GetArray1(len: CommandQueue): array of TRecord := -Context.Default.SyncInvoke(self.NewQueue.AddGetArray1&(len) as CommandQueue); - -function Buffer.GetArray2(len1,len2: CommandQueue): array[,] of TRecord := -Context.Default.SyncInvoke(self.NewQueue.AddGetArray2&(len1, len2) as CommandQueue); - -function Buffer.GetArray3(len1,len2,len3: CommandQueue): array[,,] of TRecord := -Context.Default.SyncInvoke(self.NewQueue.AddGetArray3&(len1, len2, len3) as CommandQueue); - -{$endregion Get} - -{$endregion Implicit} - -{$region Explicit} - -{$region 1#Write&Read} - -{$region WriteDataAutoSize} - -type - BufferCommandWriteDataAutoSize = sealed class(EnqueueableGPUCommand) - private ptr: CommandQueue; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(ptr: CommandQueue); - begin - self.ptr := ptr; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var ptr := ptr_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.NON_BLOCKING, - UIntPtr.Zero, o.Size, - ptr, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - ptr.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'ptr: '; - ptr.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteDataAutoSize} - -function BufferCommandQueue.AddWriteData(ptr: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteDataAutoSize(ptr)); - -{$region ReadDataAutoSize} - -type - BufferCommandReadDataAutoSize = sealed class(EnqueueableGPUCommand) - private ptr: CommandQueue; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(ptr: CommandQueue); - begin - self.ptr := ptr; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var ptr := ptr_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.NON_BLOCKING, - UIntPtr.Zero, o.Size, - ptr, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - ptr.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'ptr: '; - ptr.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadDataAutoSize} - -function BufferCommandQueue.AddReadData(ptr: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadDataAutoSize(ptr)); - -{$region WriteData} - -type - BufferCommandWriteData = sealed class(EnqueueableGPUCommand) - private ptr: CommandQueue; - private buff_offset: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 3; - public function ParamCountL2: integer; override := 0; - - public constructor(ptr: CommandQueue; buff_offset, len: CommandQueue); - begin - self. ptr := ptr; - self.buff_offset := buff_offset; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var ptr := ptr_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.NON_BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len), - ptr, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - ptr.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'ptr: '; - ptr.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteData} - -function BufferCommandQueue.AddWriteData(ptr: CommandQueue; buff_offset, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteData(ptr, buff_offset, len)); - -{$region ReadData} - -type - BufferCommandReadData = sealed class(EnqueueableGPUCommand) - private ptr: CommandQueue; - private buff_offset: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 3; - public function ParamCountL2: integer; override := 0; - - public constructor(ptr: CommandQueue; buff_offset, len: CommandQueue); - begin - self. ptr := ptr; - self.buff_offset := buff_offset; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var ptr := ptr_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.NON_BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len), - ptr, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - ptr.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'ptr: '; - ptr.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadData} - -function BufferCommandQueue.AddReadData(ptr: CommandQueue; buff_offset, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadData(ptr, buff_offset, len)); - -function BufferCommandQueue.AddWriteData(ptr: pointer): BufferCommandQueue := -AddWriteData(IntPtr(ptr)); - -function BufferCommandQueue.AddReadData(ptr: pointer): BufferCommandQueue := -AddReadData(IntPtr(ptr)); - -function BufferCommandQueue.AddWriteData(ptr: pointer; buff_offset, len: CommandQueue): BufferCommandQueue := -AddWriteData(IntPtr(ptr), buff_offset, len); - -function BufferCommandQueue.AddReadData(ptr: pointer; buff_offset, len: CommandQueue): BufferCommandQueue := -AddReadData(IntPtr(ptr), buff_offset, len); - -function BufferCommandQueue.AddWriteValue(val: TRecord): BufferCommandQueue := -AddWriteValue(val, 0); - -{$region WriteValue} - -type - BufferCommandWriteValue = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private val: ^TRecord := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&)); - private buff_offset: CommandQueue; - - protected procedure Finalize; override; - begin - Marshal.FreeHGlobal(new IntPtr(val)); - end; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(val: TRecord; buff_offset: CommandQueue); - begin - self. val^ := val; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var buff_offset_qr := buff_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var buff_offset := buff_offset_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.NON_BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(Marshal.SizeOf&), - new IntPtr(val), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'val: '; - sb.Append(val^); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteValue} - -function BufferCommandQueue.AddWriteValue(val: TRecord; buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteValue(val, buff_offset)); - -function BufferCommandQueue.AddWriteValue(val: CommandQueue): BufferCommandQueue := -AddWriteValue(val, 0); - -{$region WriteValueQ} - -type - BufferCommandWriteValueQ = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private val: CommandQueue; - private buff_offset: CommandQueue; - - public function ParamCountL1: integer; override := 2; - public function ParamCountL2: integer; override := 1; - - public constructor(val: CommandQueue; buff_offset: CommandQueue); - begin - self. val := val; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&?evs_l2:evs_l1).Add(val_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var val := val_qr.ToPtr; - var buff_offset := buff_offset_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.NON_BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(Marshal.SizeOf&), - new IntPtr(val.GetPtr), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - var val_hnd := GCHandle.Alloc(val); - - EventList.AttachFinallyCallback(res_ev, ()-> - begin - val_hnd.Free; - end, tsk, false{$ifdef EventDebug}, nil{$endif}); - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - val.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'val: '; - val.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteValueQ} - -function BufferCommandQueue.AddWriteValue(val: CommandQueue; buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteValueQ(val, buff_offset)); - -{$region WriteArray1AutoSize} - -type - BufferCommandWriteArray1AutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue); - begin - self.a := a; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.BLOCKING, - UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), - a[0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteArray1AutoSize} - -function BufferCommandQueue.AddWriteArray1(a: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteArray1AutoSize(a)); - -{$region WriteArray2AutoSize} - -type - BufferCommandWriteArray2AutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue); - begin - self.a := a; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.BLOCKING, - UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), - a[0,0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteArray2AutoSize} - -function BufferCommandQueue.AddWriteArray2(a: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteArray2AutoSize(a)); - -{$region WriteArray3AutoSize} - -type - BufferCommandWriteArray3AutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue); - begin - self.a := a; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.BLOCKING, - UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), - a[0,0,0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteArray3AutoSize} - -function BufferCommandQueue.AddWriteArray3(a: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteArray3AutoSize(a)); - -{$region ReadArray1AutoSize} - -type - BufferCommandReadArray1AutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue); - begin - self.a := a; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), - a[0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadArray1AutoSize} - -function BufferCommandQueue.AddReadArray1(a: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadArray1AutoSize(a)); - -{$region ReadArray2AutoSize} - -type - BufferCommandReadArray2AutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue); - begin - self.a := a; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), - a[0,0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadArray2AutoSize} - -function BufferCommandQueue.AddReadArray2(a: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadArray2AutoSize(a)); - -{$region ReadArray3AutoSize} - -type - BufferCommandReadArray3AutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue); - begin - self.a := a; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), - a[0,0,0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadArray3AutoSize} - -function BufferCommandQueue.AddReadArray3(a: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadArray3AutoSize(a)); - -{$region WriteArray1} - -type - BufferCommandWriteArray1 = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - private a_offset: CommandQueue; - private len: CommandQueue; - private buff_offset: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 4; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue; a_offset, len, buff_offset: CommandQueue); - begin - self. a := a; - self. a_offset := a_offset; - self. len := len; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - var a_offset_qr := a_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - var a_offset := a_offset_qr.GetRes; - var len := len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len*Marshal.SizeOf&), - a[a_offset], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - a_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset: '; - a_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteArray1} - -function BufferCommandQueue.AddWriteArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteArray1(a, a_offset, len, buff_offset)); - -{$region WriteArray2} - -type - BufferCommandWriteArray2 = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - private a_offset1: CommandQueue; - private a_offset2: CommandQueue; - private len: CommandQueue; - private buff_offset: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 5; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue); - begin - self. a := a; - self. a_offset1 := a_offset1; - self. a_offset2 := a_offset2; - self. len := len; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); - var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - var a_offset1 := a_offset1_qr.GetRes; - var a_offset2 := a_offset2_qr.GetRes; - var len := len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len*Marshal.SizeOf&), - a[a_offset1,a_offset2], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - a_offset1.RegisterWaitables(tsk, prev_hubs); - a_offset2.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset1: '; - a_offset1.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset2: '; - a_offset2.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteArray2} - -function BufferCommandQueue.AddWriteArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteArray2(a, a_offset1, a_offset2, len, buff_offset)); - -{$region WriteArray3} - -type - BufferCommandWriteArray3 = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - private a_offset1: CommandQueue; - private a_offset2: CommandQueue; - private a_offset3: CommandQueue; - private len: CommandQueue; - private buff_offset: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 6; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue); - begin - self. a := a; - self. a_offset1 := a_offset1; - self. a_offset2 := a_offset2; - self. a_offset3 := a_offset3; - self. len := len; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); - var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); - var a_offset3_qr := a_offset3.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset3_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - var a_offset1 := a_offset1_qr.GetRes; - var a_offset2 := a_offset2_qr.GetRes; - var a_offset3 := a_offset3_qr.GetRes; - var len := len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - - cl.EnqueueWriteBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len*Marshal.SizeOf&), - a[a_offset1,a_offset2,a_offset3], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - a_offset1.RegisterWaitables(tsk, prev_hubs); - a_offset2.RegisterWaitables(tsk, prev_hubs); - a_offset3.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset1: '; - a_offset1.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset2: '; - a_offset2.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset3: '; - a_offset3.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion WriteArray3} - -function BufferCommandQueue.AddWriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandWriteArray3(a, a_offset1, a_offset2, a_offset3, len, buff_offset)); - -{$region ReadArray1} - -type - BufferCommandReadArray1 = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - private a_offset: CommandQueue; - private len: CommandQueue; - private buff_offset: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 4; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue; a_offset, len, buff_offset: CommandQueue); - begin - self. a := a; - self. a_offset := a_offset; - self. len := len; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - var a_offset_qr := a_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - var a_offset := a_offset_qr.GetRes; - var len := len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len*Marshal.SizeOf&), - a[a_offset], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - a_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset: '; - a_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadArray1} - -function BufferCommandQueue.AddReadArray1(a: CommandQueue; a_offset, len, buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadArray1(a, a_offset, len, buff_offset)); - -{$region ReadArray2} - -type - BufferCommandReadArray2 = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - private a_offset1: CommandQueue; - private a_offset2: CommandQueue; - private len: CommandQueue; - private buff_offset: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 5; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue); - begin - self. a := a; - self. a_offset1 := a_offset1; - self. a_offset2 := a_offset2; - self. len := len; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); - var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - var a_offset1 := a_offset1_qr.GetRes; - var a_offset2 := a_offset2_qr.GetRes; - var len := len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len*Marshal.SizeOf&), - a[a_offset1,a_offset2], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - a_offset1.RegisterWaitables(tsk, prev_hubs); - a_offset2.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset1: '; - a_offset1.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset2: '; - a_offset2.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadArray2} - -function BufferCommandQueue.AddReadArray2(a: CommandQueue; a_offset1,a_offset2, len, buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadArray2(a, a_offset1, a_offset2, len, buff_offset)); - -{$region ReadArray3} - -type - BufferCommandReadArray3 = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private a: CommandQueue; - private a_offset1: CommandQueue; - private a_offset2: CommandQueue; - private a_offset3: CommandQueue; - private len: CommandQueue; - private buff_offset: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 6; - public function ParamCountL2: integer; override := 0; - - public constructor(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue); - begin - self. a := a; - self. a_offset1 := a_offset1; - self. a_offset2 := a_offset2; - self. a_offset3 := a_offset3; - self. len := len; - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); - var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); - var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); - var a_offset3_qr := a_offset3.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset3_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var a := a_qr.GetRes; - var a_offset1 := a_offset1_qr.GetRes; - var a_offset2 := a_offset2_qr.GetRes; - var a_offset3 := a_offset3_qr.GetRes; - var len := len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len*Marshal.SizeOf&), - a[a_offset1,a_offset2,a_offset3], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - a.RegisterWaitables(tsk, prev_hubs); - a_offset1.RegisterWaitables(tsk, prev_hubs); - a_offset2.RegisterWaitables(tsk, prev_hubs); - a_offset3.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'a: '; - a.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset1: '; - a_offset1.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset2: '; - a_offset2.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'a_offset3: '; - a_offset3.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion ReadArray3} - -function BufferCommandQueue.AddReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, buff_offset: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandReadArray3(a, a_offset1, a_offset2, a_offset3, len, buff_offset)); - -{$endregion 1#Write&Read} - -{$region 2#Fill} - -{$region FillDataAutoSize} - -type - BufferCommandFillDataAutoSize = sealed class(EnqueueableGPUCommand) - private ptr: CommandQueue; - private pattern_len: CommandQueue; - - public function ParamCountL1: integer; override := 2; - public function ParamCountL2: integer; override := 0; - - public constructor(ptr: CommandQueue; pattern_len: CommandQueue); - begin - self. ptr := ptr; - self.pattern_len := pattern_len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); - var pattern_len_qr := pattern_len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(pattern_len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var ptr := ptr_qr.GetRes; - var pattern_len := pattern_len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueFillBuffer( - cq, o.ntv, - ptr, new UIntPtr(pattern_len), - UIntPtr.Zero, o.Size, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - ptr.RegisterWaitables(tsk, prev_hubs); - pattern_len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'ptr: '; - ptr.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'pattern_len: '; - pattern_len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion FillDataAutoSize} - -function BufferCommandQueue.AddFillData(ptr: CommandQueue; pattern_len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandFillDataAutoSize(ptr, pattern_len)); - -{$region FillData} - -type - BufferCommandFillData = sealed class(EnqueueableGPUCommand) - private ptr: CommandQueue; - private pattern_len: CommandQueue; - private buff_offset: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 4; - public function ParamCountL2: integer; override := 0; - - public constructor(ptr: CommandQueue; pattern_len, buff_offset, len: CommandQueue); - begin - self. ptr := ptr; - self.pattern_len := pattern_len; - self.buff_offset := buff_offset; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); - var pattern_len_qr := pattern_len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(pattern_len_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var ptr := ptr_qr.GetRes; - var pattern_len := pattern_len_qr.GetRes; - var buff_offset := buff_offset_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueFillBuffer( - cq, o.ntv, - ptr, new UIntPtr(pattern_len), - new UIntPtr(buff_offset), new UIntPtr(len), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - ptr.RegisterWaitables(tsk, prev_hubs); - pattern_len.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'ptr: '; - ptr.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'pattern_len: '; - pattern_len.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion FillData} - -function BufferCommandQueue.AddFillData(ptr: CommandQueue; pattern_len, buff_offset, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandFillData(ptr, pattern_len, buff_offset, len)); - -{$region FillValueAutoSize} - -type - BufferCommandFillValueAutoSize = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private val: ^TRecord := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&)); - - protected procedure Finalize; override; - begin - Marshal.FreeHGlobal(new IntPtr(val)); - end; - - public function ParamCountL1: integer; override := 0; - public function ParamCountL2: integer; override := 0; - - public constructor(val: TRecord); - begin - self.val^ := val; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - - Result := (o, cq, tsk, c, evs)-> - begin - var res_ev: cl_event; - - cl.EnqueueFillBuffer( - cq, o.ntv, - new IntPtr(val), new UIntPtr(Marshal.SizeOf&), - UIntPtr.Zero, o.Size, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'val: '; - sb.Append(val^); - - end; - - end; - -{$endregion FillValueAutoSize} - -function BufferCommandQueue.AddFillValue(val: TRecord): BufferCommandQueue := -AddCommand(self, new BufferCommandFillValueAutoSize(val)); - -{$region FillValue} - -type - BufferCommandFillValue = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private val: ^TRecord := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&)); - private buff_offset: CommandQueue; - private len: CommandQueue; - - protected procedure Finalize; override; - begin - Marshal.FreeHGlobal(new IntPtr(val)); - end; - - public function ParamCountL1: integer; override := 2; - public function ParamCountL2: integer; override := 0; - - public constructor(val: TRecord; buff_offset, len: CommandQueue); - begin - self. val^ := val; - self.buff_offset := buff_offset; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var buff_offset_qr := buff_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(buff_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var buff_offset := buff_offset_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueFillBuffer( - cq, o.ntv, - new IntPtr(val), new UIntPtr(Marshal.SizeOf&), - new UIntPtr(buff_offset), new UIntPtr(len), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - buff_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'val: '; - sb.Append(val^); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion FillValue} - -function BufferCommandQueue.AddFillValue(val: TRecord; buff_offset, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandFillValue(val, buff_offset, len)); - -{$region FillValueAutoSizeQ} - -type - BufferCommandFillValueAutoSizeQ = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private val: CommandQueue; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 1; - - public constructor(val: CommandQueue); - begin - self.val := val; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&?evs_l2:evs_l1).Add(val_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var val := val_qr.ToPtr; - var res_ev: cl_event; - - cl.EnqueueFillBuffer( - cq, o.ntv, - new IntPtr(val.GetPtr), new UIntPtr(Marshal.SizeOf&), - UIntPtr.Zero, o.Size, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - var val_hnd := GCHandle.Alloc(val); - - EventList.AttachFinallyCallback(res_ev, ()-> - begin - val_hnd.Free; - end, tsk, false{$ifdef EventDebug}, nil{$endif}); - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - val.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'val: '; - val.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion FillValueAutoSizeQ} - -function BufferCommandQueue.AddFillValue(val: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandFillValueAutoSizeQ(val)); - -{$region FillValueQ} - -type - BufferCommandFillValueQ = sealed class(EnqueueableGPUCommand) - where TRecord: record; - private val: CommandQueue; - private buff_offset: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 3; - public function ParamCountL2: integer; override := 1; - - public constructor(val: CommandQueue; buff_offset, len: CommandQueue); - begin - self. val := val; - self.buff_offset := buff_offset; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&?evs_l2:evs_l1).Add(val_qr.ev); - var buff_offset_qr := buff_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(buff_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var val := val_qr.ToPtr; - var buff_offset := buff_offset_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueFillBuffer( - cq, o.ntv, - new IntPtr(val.GetPtr), new UIntPtr(Marshal.SizeOf&), - new UIntPtr(buff_offset), new UIntPtr(len), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - var val_hnd := GCHandle.Alloc(val); - - EventList.AttachFinallyCallback(res_ev, ()-> - begin - val_hnd.Free; - end, tsk, false{$ifdef EventDebug}, nil{$endif}); - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - val.RegisterWaitables(tsk, prev_hubs); - buff_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'val: '; - val.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion FillValueQ} - -function BufferCommandQueue.AddFillValue(val: CommandQueue; buff_offset, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandFillValueQ(val, buff_offset, len)); - -{$endregion 2#Fill} - -{$region 3#Copy} - -{$region CopyToAutoSize} - -type - BufferCommandCopyToAutoSize = sealed class(EnqueueableGPUCommand) - private b: CommandQueue; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(b: CommandQueue); - begin - self.b := b; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var b_qr := b.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(b_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var b := b_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueCopyBuffer( - cq, o.ntv,b.ntv, - UIntPtr.Zero, UIntPtr.Zero, - o.Size64); override; - begin - b.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'b: '; - b.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion CopyToAutoSize} - -function BufferCommandQueue.AddCopyTo(b: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandCopyToAutoSize(b)); - -{$region CopyFormAutoSize} - -type - BufferCommandCopyFormAutoSize = sealed class(EnqueueableGPUCommand) - private b: CommandQueue; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(b: CommandQueue); - begin - self.b := b; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var b_qr := b.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(b_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var b := b_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueCopyBuffer( - cq, b.ntv,o.ntv, - UIntPtr.Zero, UIntPtr.Zero, - o.Size64); override; - begin - b.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'b: '; - b.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion CopyFormAutoSize} - -function BufferCommandQueue.AddCopyForm(b: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandCopyFormAutoSize(b)); - -{$region CopyTo} - -type - BufferCommandCopyTo = sealed class(EnqueueableGPUCommand) - private b: CommandQueue; - private from_pos: CommandQueue; - private to_pos: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 4; - public function ParamCountL2: integer; override := 0; - - public constructor(b: CommandQueue; from_pos, to_pos, len: CommandQueue); - begin - self. b := b; - self.from_pos := from_pos; - self. to_pos := to_pos; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var b_qr := b.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(b_qr.ev); - var from_pos_qr := from_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(from_pos_qr.ev); - var to_pos_qr := to_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(to_pos_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var b := b_qr.GetRes; - var from_pos := from_pos_qr.GetRes; - var to_pos := to_pos_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueCopyBuffer( - cq, o.ntv,b.ntv, - new UIntPtr(from_pos), new UIntPtr(to_pos), - new UIntPtr(len), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - b.RegisterWaitables(tsk, prev_hubs); - from_pos.RegisterWaitables(tsk, prev_hubs); - to_pos.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'b: '; - b.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'from_pos: '; - from_pos.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'to_pos: '; - to_pos.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion CopyTo} - -function BufferCommandQueue.AddCopyTo(b: CommandQueue; from_pos, to_pos, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandCopyTo(b, from_pos, to_pos, len)); - -{$region CopyForm} - -type - BufferCommandCopyForm = sealed class(EnqueueableGPUCommand) - private b: CommandQueue; - private from_pos: CommandQueue; - private to_pos: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 4; - public function ParamCountL2: integer; override := 0; - - public constructor(b: CommandQueue; from_pos, to_pos, len: CommandQueue); - begin - self. b := b; - self.from_pos := from_pos; - self. to_pos := to_pos; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; - begin - var b_qr := b.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(b_qr.ev); - var from_pos_qr := from_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(from_pos_qr.ev); - var to_pos_qr := to_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(to_pos_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, c, evs)-> - begin - var b := b_qr.GetRes; - var from_pos := from_pos_qr.GetRes; - var to_pos := to_pos_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueCopyBuffer( - cq, b.ntv,o.ntv, - new UIntPtr(from_pos), new UIntPtr(to_pos), - new UIntPtr(len), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - b.RegisterWaitables(tsk, prev_hubs); - from_pos.RegisterWaitables(tsk, prev_hubs); - to_pos.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'b: '; - b.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'from_pos: '; - from_pos.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'to_pos: '; - to_pos.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion CopyForm} - -function BufferCommandQueue.AddCopyForm(b: CommandQueue; from_pos, to_pos, len: CommandQueue): BufferCommandQueue := -AddCommand(self, new BufferCommandCopyForm(b, from_pos, to_pos, len)); - -{$endregion 3#Copy} - -{$region Get} - -{$region GetDataAutoSize} - -type - BufferCommandGetDataAutoSize = sealed class(EnqueueableGetCommand) - - public function ParamCountL1: integer; override := 0; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue); - begin - inherited Create(ccq); - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - - Result := (o, cq, tsk, evs, own_qr)-> - begin - var res_ev: cl_event; - - var res := Marshal.AllocHGlobal(IntPtr(pointer(o.Size))); own_qr.SetRes(res); - //ToDo А что если результат уже получен и освобождёт сдедующей .ThenConvert - // - Вообще .WhenError тут (и в +1 месте) - говнокод - tsk.WhenError((tsk,err)->Marshal.FreeHGlobal(res)); - cl.EnqueueReadBuffer( - cq, o.Native, Bool.NON_BLOCKING, - UIntPtr.Zero, o.Size, - res, - evs.count, evs.evs, res_ev - ); - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := exit; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; - - end; - -{$endregion GetDataAutoSize} - -function BufferCommandQueue.AddGetData: CommandQueue := -new BufferCommandGetDataAutoSize(self) as CommandQueue; - -{$region GetData} - -type - BufferCommandGetData = sealed class(EnqueueableGetCommand) - private buff_offset: CommandQueue; - private len: CommandQueue; - - public function ParamCountL1: integer; override := 2; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue; buff_offset, len: CommandQueue); - begin - inherited Create(ccq); - self.buff_offset := buff_offset; - self. len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - var buff_offset_qr := buff_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(buff_offset_qr.ev); - var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, evs, own_qr)-> - begin - var buff_offset := buff_offset_qr.GetRes; - var len := len_qr.GetRes; - var res_ev: cl_event; - - var res := Marshal.AllocHGlobal(IntPtr(pointer(o.Size))); own_qr.SetRes(res); - tsk.WhenError((tsk,err)->Marshal.FreeHGlobal(res)); - cl.EnqueueReadBuffer( - cq, o.Native, Bool.NON_BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(len), - res, - evs.count, evs.evs, res_ev - ).RaiseIfError; - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - buff_offset.RegisterWaitables(tsk, prev_hubs); - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion GetData} - -function BufferCommandQueue.AddGetData(buff_offset, len: CommandQueue): CommandQueue := -new BufferCommandGetData(self, buff_offset, len) as CommandQueue; - -function BufferCommandQueue.AddGetValue: CommandQueue := -AddGetValue&(0); - -{$region GetValue} - -type - BufferCommandGetValue = sealed class(EnqueueableGetCommand) - where TRecord: record; - private buff_offset: CommandQueue; - - public function ForcePtrQr: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue; buff_offset: CommandQueue); - begin - inherited Create(ccq); - self.buff_offset := buff_offset; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - var buff_offset_qr := buff_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(buff_offset_qr.ev); - - Result := (o, cq, tsk, evs, own_qr)-> - begin - var buff_offset := buff_offset_qr.GetRes; - var res_ev: cl_event; - - cl.EnqueueReadBuffer( - cq, o.Native, Bool.NON_BLOCKING, - new UIntPtr(buff_offset), new UIntPtr(Marshal.SizeOf&), - new IntPtr((own_qr as QueueResDelayedPtr).ptr), - evs.count, evs.evs, res_ev - ).RaiseIfError; - - var own_qr_hnd := GCHandle.Alloc(own_qr); - - EventList.AttachFinallyCallback(res_ev, ()-> - begin - own_qr_hnd.Free; - end, tsk, false{$ifdef EventDebug}, nil{$endif}); - - Result := res_ev; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - buff_offset.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'buff_offset: '; - buff_offset.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion GetValue} - -function BufferCommandQueue.AddGetValue(buff_offset: CommandQueue): CommandQueue := -new BufferCommandGetValue(self, buff_offset) as CommandQueue; - -{$region GetArray1AutoSize} - -type - BufferCommandGetArray1AutoSize = sealed class(EnqueueableGetCommand) - where TRecord: record; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 0; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue); - begin - inherited Create(ccq); - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - - Result := (o, cq, tsk, evs, own_qr)-> - begin - - var len := o.Size64 div Marshal.SizeOf&; - var res := new TRecord[len]; own_qr.SetRes(res); - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(0), new UIntPtr(len * Marshal.SizeOf&), - res[0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := exit; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; - - end; - -{$endregion GetArray1AutoSize} - -function BufferCommandQueue.AddGetArray1: CommandQueue := -new BufferCommandGetArray1AutoSize(self) as CommandQueue; - -{$region GetArray1} - -type - BufferCommandGetArray1 = sealed class(EnqueueableGetCommand) - where TRecord: record; - private len: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 1; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue; len: CommandQueue); - begin - inherited Create(ccq); - self.len := len; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - var len_qr := len.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(len_qr.ev); - - Result := (o, cq, tsk, evs, own_qr)-> - begin - var len := len_qr.GetRes; - - var res := new TRecord[len]; own_qr.SetRes(res); - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(0), new UIntPtr(int64(len) * Marshal.SizeOf&), - res[0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - len.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'len: '; - len.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion GetArray1} - -function BufferCommandQueue.AddGetArray1(len: CommandQueue): CommandQueue := -new BufferCommandGetArray1(self, len) as CommandQueue; - -{$region GetArray2} - -type - BufferCommandGetArray2 = sealed class(EnqueueableGetCommand) - where TRecord: record; - private len1: CommandQueue; - private len2: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 2; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue; len1,len2: CommandQueue); - begin - inherited Create(ccq); - self.len1 := len1; - self.len2 := len2; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - var len1_qr := len1.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(len1_qr.ev); - var len2_qr := len2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len2_qr.ev); - - Result := (o, cq, tsk, evs, own_qr)-> - begin - var len1 := len1_qr.GetRes; - var len2 := len2_qr.GetRes; - - var res := new TRecord[len1,len2]; own_qr.SetRes(res); - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(0), new UIntPtr(int64(len1)*len2 * Marshal.SizeOf&), - res[0,0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - len1.RegisterWaitables(tsk, prev_hubs); - len2.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'len1: '; - len1.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len2: '; - len2.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion GetArray2} - -function BufferCommandQueue.AddGetArray2(len1,len2: CommandQueue): CommandQueue := -new BufferCommandGetArray2(self, len1, len2) as CommandQueue; - -{$region GetArray3} - -type - BufferCommandGetArray3 = sealed class(EnqueueableGetCommand) - where TRecord: record; - private len1: CommandQueue; - private len2: CommandQueue; - private len3: CommandQueue; - - public function NeedThread: boolean; override := true; - - public function ParamCountL1: integer; override := 3; - public function ParamCountL2: integer; override := 0; - - public constructor(ccq: BufferCommandQueue; len1,len2,len3: CommandQueue); - begin - inherited Create(ccq); - self.len1 := len1; - self.len2 := len2; - self.len3 := len3; - end; - private constructor := raise new System.InvalidOperationException; - - protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (Buffer, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; - begin - var len1_qr := len1.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(len1_qr.ev); - var len2_qr := len2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len2_qr.ev); - var len3_qr := len3.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len3_qr.ev); - - Result := (o, cq, tsk, evs, own_qr)-> - begin - var len1 := len1_qr.GetRes; - var len2 := len2_qr.GetRes; - var len3 := len3_qr.GetRes; - - var res := new TRecord[len1,len2,len3]; own_qr.SetRes(res); - cl.EnqueueReadBuffer( - cq, o.Native, Bool.BLOCKING, - new UIntPtr(0), new UIntPtr(int64(len1)*len2*len3 * Marshal.SizeOf&), - res[0,0,0], - evs.count, evs.evs, IntPtr.Zero - ).RaiseIfError; - - Result := cl_event.Zero; - end; - - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; - begin - len1.RegisterWaitables(tsk, prev_hubs); - len2.RegisterWaitables(tsk, prev_hubs); - len3.RegisterWaitables(tsk, prev_hubs); - end; - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - - sb.Append(#9, tabs); - sb += 'len1: '; - len1.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len2: '; - len2.ToString(sb, tabs, index, delayed, false); - - sb.Append(#9, tabs); - sb += 'len3: '; - len3.ToString(sb, tabs, index, delayed, false); - - end; - - end; - -{$endregion GetArray3} - -function BufferCommandQueue.AddGetArray3(len1,len2,len3: CommandQueue): CommandQueue := -new BufferCommandGetArray3(self, len1, len2, len3) as CommandQueue; - -{$endregion Get} - -{$endregion Explicit} - -{$endregion Buffer} - {$region Kernel} {$region Implicit} @@ -9108,16 +6935,20 @@ new BufferCommandGetArray3(self, len1, len2, len3) as CommandQueue; params args: array of KernelArg): Kernel := -Context.Default.SyncInvoke(self.NewQueue.AddExec1(sz1, args) as CommandQueue); +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddExec1(sz1, args) as object as CommandQueue); function Kernel.Exec2(sz1,sz2: CommandQueue; params args: array of KernelArg): Kernel := -Context.Default.SyncInvoke(self.NewQueue.AddExec2(sz1, sz2, args) as CommandQueue); +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddExec2(sz1, sz2, args) as object as CommandQueue); function Kernel.Exec3(sz1,sz2,sz3: CommandQueue; params args: array of KernelArg): Kernel := -Context.Default.SyncInvoke(self.NewQueue.AddExec3(sz1, sz2, sz3, args) as CommandQueue); +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddExec3(sz1, sz2, sz3, args) as object as CommandQueue); function Kernel.Exec(global_work_offset, global_work_size, local_work_size: CommandQueue; params args: array of KernelArg): Kernel := -Context.Default.SyncInvoke(self.NewQueue.AddExec(global_work_offset, global_work_size, local_work_size, args) as CommandQueue); +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddExec(global_work_offset, global_work_size, local_work_size, args) as object as CommandQueue); {$endregion 1#Exec} @@ -9211,11 +7042,11 @@ type end; -{$endregion Exec1} - -function KernelCommandQueue.AddExec1(sz1: CommandQueue; params args: array of KernelArg): KernelCommandQueue := +function KernelCCQ.AddExec1(sz1: CommandQueue; params args: array of KernelArg): KernelCCQ := AddCommand(self, new KernelCommandExec1(sz1, args)); +{$endregion Exec1} + {$region Exec2} type @@ -9309,11 +7140,11 @@ type end; -{$endregion Exec2} - -function KernelCommandQueue.AddExec2(sz1,sz2: CommandQueue; params args: array of KernelArg): KernelCommandQueue := +function KernelCCQ.AddExec2(sz1,sz2: CommandQueue; params args: array of KernelArg): KernelCCQ := AddCommand(self, new KernelCommandExec2(sz1, sz2, args)); +{$endregion Exec2} + {$region Exec3} type @@ -9416,11 +7247,11 @@ type end; -{$endregion Exec3} - -function KernelCommandQueue.AddExec3(sz1,sz2,sz3: CommandQueue; params args: array of KernelArg): KernelCommandQueue := +function KernelCCQ.AddExec3(sz1,sz2,sz3: CommandQueue; params args: array of KernelArg): KernelCCQ := AddCommand(self, new KernelCommandExec3(sz1, sz2, sz3, args)); +{$endregion Exec3} + {$region Exec} type @@ -9523,17 +7354,4114 @@ type end; -{$endregion Exec} - -function KernelCommandQueue.AddExec(global_work_offset, global_work_size, local_work_size: CommandQueue; params args: array of KernelArg): KernelCommandQueue := +function KernelCCQ.AddExec(global_work_offset, global_work_size, local_work_size: CommandQueue; params args: array of KernelArg): KernelCCQ := AddCommand(self, new KernelCommandExec(global_work_offset, global_work_size, local_work_size, args)); +{$endregion Exec} + {$endregion 1#Exec} {$endregion Explicit} {$endregion Kernel} +{$region MemorySegment} + +{$region Implicit} + +{$region 1#Write&Read} + +function MemorySegment.WriteData(ptr: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteData(ptr) as object as CommandQueue); + +function MemorySegment.ReadData(ptr: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadData(ptr) as object as CommandQueue); + +function MemorySegment.WriteData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteData(ptr, mem_offset, len) as object as CommandQueue); + +function MemorySegment.ReadData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadData(ptr, mem_offset, len) as object as CommandQueue); + +function MemorySegment.WriteData(ptr: pointer): MemorySegment := +WriteData(IntPtr(ptr)); + +function MemorySegment.ReadData(ptr: pointer): MemorySegment := +ReadData(IntPtr(ptr)); + +function MemorySegment.WriteData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegment := +WriteData(IntPtr(ptr), mem_offset, len); + +function MemorySegment.ReadData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegment := +ReadData(IntPtr(ptr), mem_offset, len); + +function MemorySegment.WriteValue(val: TRecord): MemorySegment := +WriteValue(val, 0); + +function MemorySegment.WriteValue(val: TRecord; mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteValue&(val, mem_offset) as object as CommandQueue); + +function MemorySegment.WriteValue(val: CommandQueue): MemorySegment := +WriteValue(val, 0); + +function MemorySegment.WriteValue(val: CommandQueue; mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteValue&(val, mem_offset) as object as CommandQueue); + +function MemorySegment.WriteArray1(a: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray1&(a) as object as CommandQueue); + +function MemorySegment.WriteArray2(a: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray2&(a) as object as CommandQueue); + +function MemorySegment.WriteArray3(a: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray3&(a) as object as CommandQueue); + +function MemorySegment.ReadArray1(a: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray1&(a) as object as CommandQueue); + +function MemorySegment.ReadArray2(a: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray2&(a) as object as CommandQueue); + +function MemorySegment.ReadArray3(a: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray3&(a) as object as CommandQueue); + +function MemorySegment.WriteArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray1&(a, a_offset, len, mem_offset) as object as CommandQueue); + +function MemorySegment.WriteArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray2&(a, a_offset1, a_offset2, len, mem_offset) as object as CommandQueue); + +function MemorySegment.WriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray3&(a, a_offset1, a_offset2, a_offset3, len, mem_offset) as object as CommandQueue); + +function MemorySegment.ReadArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray1&(a, a_offset, len, mem_offset) as object as CommandQueue); + +function MemorySegment.ReadArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray2&(a, a_offset1, a_offset2, len, mem_offset) as object as CommandQueue); + +function MemorySegment.ReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray3&(a, a_offset1, a_offset2, a_offset3, len, mem_offset) as object as CommandQueue); + +{$endregion 1#Write&Read} + +{$region 2#Fill} + +function MemorySegment.FillData(ptr: CommandQueue; pattern_len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFillData(ptr, pattern_len) as object as CommandQueue); + +function MemorySegment.FillData(ptr: CommandQueue; pattern_len, mem_offset, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFillData(ptr, pattern_len, mem_offset, len) as object as CommandQueue); + +function MemorySegment.FillValue(val: TRecord): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val) as object as CommandQueue); + +function MemorySegment.FillValue(val: TRecord; mem_offset, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val, mem_offset, len) as object as CommandQueue); + +function MemorySegment.FillValue(val: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val) as object as CommandQueue); + +function MemorySegment.FillValue(val: CommandQueue; mem_offset, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFillValue&(val, mem_offset, len) as object as CommandQueue); + +{$endregion 2#Fill} + +{$region 3#Copy} + +function MemorySegment.CopyTo(mem: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyTo(mem) as object as CommandQueue); + +function MemorySegment.CopyFrom(mem: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyFrom(mem) as object as CommandQueue); + +function MemorySegment.CopyTo(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyTo(mem, from_pos, to_pos, len) as object as CommandQueue); + +function MemorySegment.CopyFrom(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegment := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyFrom(mem, from_pos, to_pos, len) as object as CommandQueue); + +{$endregion 3#Copy} + +{$region Get} + +function MemorySegment.GetData: IntPtr := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetData as object as CommandQueue); + +function MemorySegment.GetData(mem_offset, len: CommandQueue): IntPtr := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetData(mem_offset, len) as object as CommandQueue); + +function MemorySegment.GetValue: TRecord := +GetValue&(0); + +function MemorySegment.GetValue(mem_offset: CommandQueue): TRecord := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetValue&(mem_offset) as object as CommandQueue); + +function MemorySegment.GetArray1: array of TRecord := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetArray1& as object as CommandQueue); + +function MemorySegment.GetArray1(len: CommandQueue): array of TRecord := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetArray1&(len) as object as CommandQueue); + +function MemorySegment.GetArray2(len1,len2: CommandQueue): array[,] of TRecord := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetArray2&(len1, len2) as object as CommandQueue); + +function MemorySegment.GetArray3(len1,len2,len3: CommandQueue): array[,,] of TRecord := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetArray3&(len1, len2, len3) as object as CommandQueue); + +{$endregion Get} + +{$endregion Implicit} + +{$region Explicit} + +{$region 1#Write&Read} + +{$region WriteDataAutoSize} + +type + MemorySegmentCommandWriteDataAutoSize = sealed class(EnqueueableGPUCommand) + private ptr: CommandQueue; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(ptr: CommandQueue); + begin + self.ptr := ptr; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ptr := ptr_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.NON_BLOCKING, + UIntPtr.Zero, o.Size, + ptr, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ptr.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ptr: '; + ptr.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteData(ptr: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteDataAutoSize(ptr)); + +{$endregion WriteDataAutoSize} + +{$region ReadDataAutoSize} + +type + MemorySegmentCommandReadDataAutoSize = sealed class(EnqueueableGPUCommand) + private ptr: CommandQueue; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(ptr: CommandQueue); + begin + self.ptr := ptr; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ptr := ptr_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.NON_BLOCKING, + UIntPtr.Zero, o.Size, + ptr, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ptr.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ptr: '; + ptr.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadData(ptr: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadDataAutoSize(ptr)); + +{$endregion ReadDataAutoSize} + +{$region WriteData} + +type + MemorySegmentCommandWriteData = sealed class(EnqueueableGPUCommand) + private ptr: CommandQueue; + private mem_offset: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 3; + public function ParamCountL2: integer; override := 0; + + public constructor(ptr: CommandQueue; mem_offset, len: CommandQueue); + begin + self. ptr := ptr; + self.mem_offset := mem_offset; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ptr := ptr_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len), + ptr, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ptr.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ptr: '; + ptr.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteData(ptr, mem_offset, len)); + +{$endregion WriteData} + +{$region ReadData} + +type + MemorySegmentCommandReadData = sealed class(EnqueueableGPUCommand) + private ptr: CommandQueue; + private mem_offset: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 3; + public function ParamCountL2: integer; override := 0; + + public constructor(ptr: CommandQueue; mem_offset, len: CommandQueue); + begin + self. ptr := ptr; + self.mem_offset := mem_offset; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ptr := ptr_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len), + ptr, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ptr.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ptr: '; + ptr.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadData(ptr: CommandQueue; mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadData(ptr, mem_offset, len)); + +{$endregion ReadData} + +{$region WriteData} + +function MemorySegmentCCQ.AddWriteData(ptr: pointer): MemorySegmentCCQ := +AddWriteData(IntPtr(ptr)); + +{$endregion WriteData} + +{$region ReadData} + +function MemorySegmentCCQ.AddReadData(ptr: pointer): MemorySegmentCCQ := +AddReadData(IntPtr(ptr)); + +{$endregion ReadData} + +{$region WriteData} + +function MemorySegmentCCQ.AddWriteData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddWriteData(IntPtr(ptr), mem_offset, len); + +{$endregion WriteData} + +{$region ReadData} + +function MemorySegmentCCQ.AddReadData(ptr: pointer; mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddReadData(IntPtr(ptr), mem_offset, len); + +{$endregion ReadData} + +{$region WriteValue} + +function MemorySegmentCCQ.AddWriteValue(val: TRecord): MemorySegmentCCQ := +AddWriteValue(val, 0); + +{$endregion WriteValue} + +{$region WriteValue} + +type + MemorySegmentCommandWriteValue = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private val: ^TRecord := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&)); + private mem_offset: CommandQueue; + + protected procedure Finalize; override; + begin + Marshal.FreeHGlobal(new IntPtr(val)); + end; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(val: TRecord; mem_offset: CommandQueue); + begin + self. val^ := val; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var mem_offset_qr := mem_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var mem_offset := mem_offset_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(Marshal.SizeOf&), + new IntPtr(val), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + sb.Append(val^); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteValue(val: TRecord; mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteValue(val, mem_offset)); + +{$endregion WriteValue} + +{$region WriteValueQ} + +function MemorySegmentCCQ.AddWriteValue(val: CommandQueue): MemorySegmentCCQ := +AddWriteValue(val, 0); + +{$endregion WriteValueQ} + +{$region WriteValueQ} + +type + MemorySegmentCommandWriteValueQ = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private val: CommandQueue; + private mem_offset: CommandQueue; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 1; + + public constructor(val: CommandQueue; mem_offset: CommandQueue); + begin + self. val := val; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&?evs_l2:evs_l1).Add(val_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var val := val_qr.ToPtr; + var mem_offset := mem_offset_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(Marshal.SizeOf&), + new IntPtr(val.GetPtr), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var val_hnd := GCHandle.Alloc(val); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + val_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + val.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + val.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteValue(val: CommandQueue; mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteValueQ(val, mem_offset)); + +{$endregion WriteValueQ} + +{$region WriteArray1AutoSize} + +type + MemorySegmentCommandWriteArray1AutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteArray1(a: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteArray1AutoSize(a)); + +{$endregion WriteArray1AutoSize} + +{$region WriteArray2AutoSize} + +type + MemorySegmentCommandWriteArray2AutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0,0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteArray2(a: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteArray2AutoSize(a)); + +{$endregion WriteArray2AutoSize} + +{$region WriteArray3AutoSize} + +type + MemorySegmentCommandWriteArray3AutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0,0,0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteArray3(a: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteArray3AutoSize(a)); + +{$endregion WriteArray3AutoSize} + +{$region ReadArray1AutoSize} + +type + MemorySegmentCommandReadArray1AutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadArray1(a: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadArray1AutoSize(a)); + +{$endregion ReadArray1AutoSize} + +{$region ReadArray2AutoSize} + +type + MemorySegmentCommandReadArray2AutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0,0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadArray2(a: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadArray2AutoSize(a)); + +{$endregion ReadArray2AutoSize} + +{$region ReadArray3AutoSize} + +type + MemorySegmentCommandReadArray3AutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0,0,0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadArray3(a: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadArray3AutoSize(a)); + +{$endregion ReadArray3AutoSize} + +{$region WriteArray1} + +type + MemorySegmentCommandWriteArray1 = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + private a_offset: CommandQueue; + private len: CommandQueue; + private mem_offset: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; a_offset, len, mem_offset: CommandQueue); + begin + self. a := a; + self. a_offset := a_offset; + self. len := len; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var a_offset_qr := a_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var a_offset := a_offset_qr.GetRes; + var len := len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len*Marshal.SizeOf&), + a[a_offset], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + a_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset: '; + a_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteArray1(a, a_offset, len, mem_offset)); + +{$endregion WriteArray1} + +{$region WriteArray2} + +type + MemorySegmentCommandWriteArray2 = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + private a_offset1: CommandQueue; + private a_offset2: CommandQueue; + private len: CommandQueue; + private mem_offset: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 5; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue); + begin + self. a := a; + self. a_offset1 := a_offset1; + self. a_offset2 := a_offset2; + self. len := len; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); + var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var a_offset1 := a_offset1_qr.GetRes; + var a_offset2 := a_offset2_qr.GetRes; + var len := len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len*Marshal.SizeOf&), + a[a_offset1,a_offset2], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + a_offset1.RegisterWaitables(tsk, prev_hubs); + a_offset2.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset1: '; + a_offset1.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset2: '; + a_offset2.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteArray2(a, a_offset1, a_offset2, len, mem_offset)); + +{$endregion WriteArray2} + +{$region WriteArray3} + +type + MemorySegmentCommandWriteArray3 = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + private a_offset1: CommandQueue; + private a_offset2: CommandQueue; + private a_offset3: CommandQueue; + private len: CommandQueue; + private mem_offset: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 6; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue); + begin + self. a := a; + self. a_offset1 := a_offset1; + self. a_offset2 := a_offset2; + self. a_offset3 := a_offset3; + self. len := len; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); + var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); + var a_offset3_qr := a_offset3.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset3_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var a_offset1 := a_offset1_qr.GetRes; + var a_offset2 := a_offset2_qr.GetRes; + var a_offset3 := a_offset3_qr.GetRes; + var len := len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len*Marshal.SizeOf&), + a[a_offset1,a_offset2,a_offset3], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + a_offset1.RegisterWaitables(tsk, prev_hubs); + a_offset2.RegisterWaitables(tsk, prev_hubs); + a_offset3.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset1: '; + a_offset1.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset2: '; + a_offset2.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset3: '; + a_offset3.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddWriteArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandWriteArray3(a, a_offset1, a_offset2, a_offset3, len, mem_offset)); + +{$endregion WriteArray3} + +{$region ReadArray1} + +type + MemorySegmentCommandReadArray1 = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + private a_offset: CommandQueue; + private len: CommandQueue; + private mem_offset: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; a_offset, len, mem_offset: CommandQueue); + begin + self. a := a; + self. a_offset := a_offset; + self. len := len; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var a_offset_qr := a_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var a_offset := a_offset_qr.GetRes; + var len := len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len*Marshal.SizeOf&), + a[a_offset], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + a_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset: '; + a_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadArray1(a: CommandQueue; a_offset, len, mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadArray1(a, a_offset, len, mem_offset)); + +{$endregion ReadArray1} + +{$region ReadArray2} + +type + MemorySegmentCommandReadArray2 = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + private a_offset1: CommandQueue; + private a_offset2: CommandQueue; + private len: CommandQueue; + private mem_offset: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 5; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue); + begin + self. a := a; + self. a_offset1 := a_offset1; + self. a_offset2 := a_offset2; + self. len := len; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); + var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var a_offset1 := a_offset1_qr.GetRes; + var a_offset2 := a_offset2_qr.GetRes; + var len := len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len*Marshal.SizeOf&), + a[a_offset1,a_offset2], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + a_offset1.RegisterWaitables(tsk, prev_hubs); + a_offset2.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset1: '; + a_offset1.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset2: '; + a_offset2.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadArray2(a: CommandQueue; a_offset1,a_offset2, len, mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadArray2(a, a_offset1, a_offset2, len, mem_offset)); + +{$endregion ReadArray2} + +{$region ReadArray3} + +type + MemorySegmentCommandReadArray3 = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private a: CommandQueue; + private a_offset1: CommandQueue; + private a_offset2: CommandQueue; + private a_offset3: CommandQueue; + private len: CommandQueue; + private mem_offset: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 6; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue); + begin + self. a := a; + self. a_offset1 := a_offset1; + self. a_offset2 := a_offset2; + self. a_offset3 := a_offset3; + self. len := len; + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var a_offset1_qr := a_offset1.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset1_qr.ev); + var a_offset2_qr := a_offset2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset2_qr.ev); + var a_offset3_qr := a_offset3.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_offset3_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var a_offset1 := a_offset1_qr.GetRes; + var a_offset2 := a_offset2_qr.GetRes; + var a_offset3 := a_offset3_qr.GetRes; + var len := len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len*Marshal.SizeOf&), + a[a_offset1,a_offset2,a_offset3], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + a_offset1.RegisterWaitables(tsk, prev_hubs); + a_offset2.RegisterWaitables(tsk, prev_hubs); + a_offset3.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset1: '; + a_offset1.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset2: '; + a_offset2.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_offset3: '; + a_offset3.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddReadArray3(a: CommandQueue; a_offset1,a_offset2,a_offset3, len, mem_offset: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandReadArray3(a, a_offset1, a_offset2, a_offset3, len, mem_offset)); + +{$endregion ReadArray3} + +{$endregion 1#Write&Read} + +{$region 2#Fill} + +{$region FillDataAutoSize} + +type + MemorySegmentCommandFillDataAutoSize = sealed class(EnqueueableGPUCommand) + private ptr: CommandQueue; + private pattern_len: CommandQueue; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 0; + + public constructor(ptr: CommandQueue; pattern_len: CommandQueue); + begin + self. ptr := ptr; + self.pattern_len := pattern_len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); + var pattern_len_qr := pattern_len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(pattern_len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ptr := ptr_qr.GetRes; + var pattern_len := pattern_len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + ptr, new UIntPtr(pattern_len), + UIntPtr.Zero, o.Size, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ptr.RegisterWaitables(tsk, prev_hubs); + pattern_len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ptr: '; + ptr.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'pattern_len: '; + pattern_len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddFillData(ptr: CommandQueue; pattern_len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandFillDataAutoSize(ptr, pattern_len)); + +{$endregion FillDataAutoSize} + +{$region FillData} + +type + MemorySegmentCommandFillData = sealed class(EnqueueableGPUCommand) + private ptr: CommandQueue; + private pattern_len: CommandQueue; + private mem_offset: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(ptr: CommandQueue; pattern_len, mem_offset, len: CommandQueue); + begin + self. ptr := ptr; + self.pattern_len := pattern_len; + self. mem_offset := mem_offset; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ptr_qr := ptr.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ptr_qr.ev); + var pattern_len_qr := pattern_len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(pattern_len_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ptr := ptr_qr.GetRes; + var pattern_len := pattern_len_qr.GetRes; + var mem_offset := mem_offset_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + ptr, new UIntPtr(pattern_len), + new UIntPtr(mem_offset), new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ptr.RegisterWaitables(tsk, prev_hubs); + pattern_len.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ptr: '; + ptr.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'pattern_len: '; + pattern_len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddFillData(ptr: CommandQueue; pattern_len, mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandFillData(ptr, pattern_len, mem_offset, len)); + +{$endregion FillData} + +{$region FillValueAutoSize} + +type + MemorySegmentCommandFillValueAutoSize = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private val: ^TRecord := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&)); + + protected procedure Finalize; override; + begin + Marshal.FreeHGlobal(new IntPtr(val)); + end; + + public function ParamCountL1: integer; override := 0; + public function ParamCountL2: integer; override := 0; + + public constructor(val: TRecord); + begin + self.val^ := val; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + + Result := (o, cq, tsk, c, evs)-> + begin + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val), new UIntPtr(Marshal.SizeOf&), + UIntPtr.Zero, o.Size, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + sb.Append(val^); + + end; + + end; + +function MemorySegmentCCQ.AddFillValue(val: TRecord): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandFillValueAutoSize(val)); + +{$endregion FillValueAutoSize} + +{$region FillValue} + +type + MemorySegmentCommandFillValue = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private val: ^TRecord := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&)); + private mem_offset: CommandQueue; + private len: CommandQueue; + + protected procedure Finalize; override; + begin + Marshal.FreeHGlobal(new IntPtr(val)); + end; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 0; + + public constructor(val: TRecord; mem_offset, len: CommandQueue); + begin + self. val^ := val; + self.mem_offset := mem_offset; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var mem_offset_qr := mem_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var mem_offset := mem_offset_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val), new UIntPtr(Marshal.SizeOf&), + new UIntPtr(mem_offset), new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + mem_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + sb.Append(val^); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddFillValue(val: TRecord; mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandFillValue(val, mem_offset, len)); + +{$endregion FillValue} + +{$region FillValueAutoSizeQ} + +type + MemorySegmentCommandFillValueAutoSizeQ = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private val: CommandQueue; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 1; + + public constructor(val: CommandQueue); + begin + self.val := val; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&?evs_l2:evs_l1).Add(val_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var val := val_qr.ToPtr; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val.GetPtr), new UIntPtr(Marshal.SizeOf&), + UIntPtr.Zero, o.Size, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var val_hnd := GCHandle.Alloc(val); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + val_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + val.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + val.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddFillValue(val: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandFillValueAutoSizeQ(val)); + +{$endregion FillValueAutoSizeQ} + +{$region FillValueQ} + +type + MemorySegmentCommandFillValueQ = sealed class(EnqueueableGPUCommand) + where TRecord: record; + private val: CommandQueue; + private mem_offset: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 3; + public function ParamCountL2: integer; override := 1; + + public constructor(val: CommandQueue; mem_offset, len: CommandQueue); + begin + self. val := val; + self.mem_offset := mem_offset; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&?evs_l2:evs_l1).Add(val_qr.ev); + var mem_offset_qr := mem_offset.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(mem_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var val := val_qr.ToPtr; + var mem_offset := mem_offset_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val.GetPtr), new UIntPtr(Marshal.SizeOf&), + new UIntPtr(mem_offset), new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var val_hnd := GCHandle.Alloc(val); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + val_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + val.RegisterWaitables(tsk, prev_hubs); + mem_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + val.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddFillValue(val: CommandQueue; mem_offset, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandFillValueQ(val, mem_offset, len)); + +{$endregion FillValueQ} + +{$endregion 2#Fill} + +{$region 3#Copy} + +{$region CopyToAutoSize} + +type + MemorySegmentCommandCopyToAutoSize = sealed class(EnqueueableGPUCommand) + private mem: CommandQueue; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(mem: CommandQueue); + begin + self.mem := mem; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var mem_qr := mem.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var mem := mem_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, o.ntv,mem.ntv, + UIntPtr.Zero, UIntPtr.Zero, + o.Size64); override; + begin + mem.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'mem: '; + mem.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddCopyTo(mem: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandCopyToAutoSize(mem)); + +{$endregion CopyToAutoSize} + +{$region CopyFromAutoSize} + +type + MemorySegmentCommandCopyFromAutoSize = sealed class(EnqueueableGPUCommand) + private mem: CommandQueue; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(mem: CommandQueue); + begin + self.mem := mem; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var mem_qr := mem.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var mem := mem_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, mem.ntv,o.ntv, + UIntPtr.Zero, UIntPtr.Zero, + o.Size64); override; + begin + mem.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'mem: '; + mem.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddCopyFrom(mem: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandCopyFromAutoSize(mem)); + +{$endregion CopyFromAutoSize} + +{$region CopyTo} + +type + MemorySegmentCommandCopyTo = sealed class(EnqueueableGPUCommand) + private mem: CommandQueue; + private from_pos: CommandQueue; + private to_pos: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(mem: CommandQueue; from_pos, to_pos, len: CommandQueue); + begin + self. mem := mem; + self.from_pos := from_pos; + self. to_pos := to_pos; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var mem_qr := mem.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_qr.ev); + var from_pos_qr := from_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(from_pos_qr.ev); + var to_pos_qr := to_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(to_pos_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var mem := mem_qr.GetRes; + var from_pos := from_pos_qr.GetRes; + var to_pos := to_pos_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, o.ntv,mem.ntv, + new UIntPtr(from_pos), new UIntPtr(to_pos), + new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + mem.RegisterWaitables(tsk, prev_hubs); + from_pos.RegisterWaitables(tsk, prev_hubs); + to_pos.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'mem: '; + mem.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'from_pos: '; + from_pos.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'to_pos: '; + to_pos.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddCopyTo(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandCopyTo(mem, from_pos, to_pos, len)); + +{$endregion CopyTo} + +{$region CopyFrom} + +type + MemorySegmentCommandCopyFrom = sealed class(EnqueueableGPUCommand) + private mem: CommandQueue; + private from_pos: CommandQueue; + private to_pos: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(mem: CommandQueue; from_pos, to_pos, len: CommandQueue); + begin + self. mem := mem; + self.from_pos := from_pos; + self. to_pos := to_pos; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var mem_qr := mem.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_qr.ev); + var from_pos_qr := from_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(from_pos_qr.ev); + var to_pos_qr := to_pos.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(to_pos_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var mem := mem_qr.GetRes; + var from_pos := from_pos_qr.GetRes; + var to_pos := to_pos_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, mem.ntv,o.ntv, + new UIntPtr(from_pos), new UIntPtr(to_pos), + new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + mem.RegisterWaitables(tsk, prev_hubs); + from_pos.RegisterWaitables(tsk, prev_hubs); + to_pos.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'mem: '; + mem.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'from_pos: '; + from_pos.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'to_pos: '; + to_pos.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddCopyFrom(mem: CommandQueue; from_pos, to_pos, len: CommandQueue): MemorySegmentCCQ := +AddCommand(self, new MemorySegmentCommandCopyFrom(mem, from_pos, to_pos, len)); + +{$endregion CopyFrom} + +{$endregion 3#Copy} + +{$region Get} + +{$region GetDataAutoSize} + +type + MemorySegmentCommandGetDataAutoSize = sealed class(EnqueueableGetCommand) + + public function ParamCountL1: integer; override := 0; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ); + begin + inherited Create(ccq); + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var res_ev: cl_event; + + var res := Marshal.AllocHGlobal(IntPtr(pointer(o.Size))); own_qr.SetRes(res); + //ToDo А что если результат уже получен и освобождёт сдедующей .ThenConvert + // - Вообще .WhenError тут (и в +1 месте) - говнокод + tsk.WhenErrorBase((tsk,err)->Marshal.FreeHGlobal(res)); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.NON_BLOCKING, + UIntPtr.Zero, o.Size, + res, + evs.count, evs.evs, res_ev + ); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := exit; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; + + end; + +function MemorySegmentCCQ.AddGetData: CommandQueue := +new MemorySegmentCommandGetDataAutoSize(self) as CommandQueue; + +{$endregion GetDataAutoSize} + +{$region GetData} + +type + MemorySegmentCommandGetData = sealed class(EnqueueableGetCommand) + private mem_offset: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ; mem_offset, len: CommandQueue); + begin + inherited Create(ccq); + self.mem_offset := mem_offset; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + var mem_offset_qr := mem_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_offset_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var mem_offset := mem_offset_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + var res := Marshal.AllocHGlobal(IntPtr(pointer(o.Size))); own_qr.SetRes(res); + tsk.WhenErrorBase((tsk,err)->Marshal.FreeHGlobal(res)); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(len), + res, + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + mem_offset.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddGetData(mem_offset, len: CommandQueue): CommandQueue := +new MemorySegmentCommandGetData(self, mem_offset, len) as CommandQueue; + +{$endregion GetData} + +{$region GetValue} + +function MemorySegmentCCQ.AddGetValue: CommandQueue := +AddGetValue&(0); + +{$endregion GetValue} + +{$region GetValue} + +type + MemorySegmentCommandGetValue = sealed class(EnqueueableGetCommand) + where TRecord: record; + private mem_offset: CommandQueue; + + public function ForcePtrQr: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ; mem_offset: CommandQueue); + begin + inherited Create(ccq); + self.mem_offset := mem_offset; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + var mem_offset_qr := mem_offset.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(mem_offset_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var mem_offset := mem_offset_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(mem_offset), new UIntPtr(Marshal.SizeOf&), + new IntPtr((own_qr as QueueResDelayedPtr).ptr), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var own_qr_hnd := GCHandle.Alloc(own_qr); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + own_qr_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + mem_offset.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'mem_offset: '; + mem_offset.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddGetValue(mem_offset: CommandQueue): CommandQueue := +new MemorySegmentCommandGetValue(self, mem_offset) as CommandQueue; + +{$endregion GetValue} + +{$region GetArray1AutoSize} + +type + MemorySegmentCommandGetArray1AutoSize = sealed class(EnqueueableGetCommand) + where TRecord: record; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 0; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ); + begin + inherited Create(ccq); + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + + Result := (o, cq, tsk, evs, own_qr)-> + begin + + var len := o.Size64 div Marshal.SizeOf&; + var res := new TRecord[len]; own_qr.SetRes(res); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(0), new UIntPtr(len * Marshal.SizeOf&), + res[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := exit; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; + + end; + +function MemorySegmentCCQ.AddGetArray1: CommandQueue := +new MemorySegmentCommandGetArray1AutoSize(self) as CommandQueue; + +{$endregion GetArray1AutoSize} + +{$region GetArray1} + +type + MemorySegmentCommandGetArray1 = sealed class(EnqueueableGetCommand) + where TRecord: record; + private len: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ; len: CommandQueue); + begin + inherited Create(ccq); + self.len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + var len_qr := len.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var len := len_qr.GetRes; + + var res := new TRecord[len]; own_qr.SetRes(res); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(0), new UIntPtr(int64(len) * Marshal.SizeOf&), + res[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddGetArray1(len: CommandQueue): CommandQueue := +new MemorySegmentCommandGetArray1(self, len) as CommandQueue; + +{$endregion GetArray1} + +{$region GetArray2} + +type + MemorySegmentCommandGetArray2 = sealed class(EnqueueableGetCommand) + where TRecord: record; + private len1: CommandQueue; + private len2: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ; len1,len2: CommandQueue); + begin + inherited Create(ccq); + self.len1 := len1; + self.len2 := len2; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + var len1_qr := len1.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(len1_qr.ev); + var len2_qr := len2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len2_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var len1 := len1_qr.GetRes; + var len2 := len2_qr.GetRes; + + var res := new TRecord[len1,len2]; own_qr.SetRes(res); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(0), new UIntPtr(int64(len1)*len2 * Marshal.SizeOf&), + res[0,0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + len1.RegisterWaitables(tsk, prev_hubs); + len2.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'len1: '; + len1.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len2: '; + len2.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddGetArray2(len1,len2: CommandQueue): CommandQueue := +new MemorySegmentCommandGetArray2(self, len1, len2) as CommandQueue; + +{$endregion GetArray2} + +{$region GetArray3} + +type + MemorySegmentCommandGetArray3 = sealed class(EnqueueableGetCommand) + where TRecord: record; + private len1: CommandQueue; + private len2: CommandQueue; + private len3: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 3; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: MemorySegmentCCQ; len1,len2,len3: CommandQueue); + begin + inherited Create(ccq); + self.len1 := len1; + self.len2 := len2; + self.len3 := len3; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (MemorySegment, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + var len1_qr := len1.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(len1_qr.ev); + var len2_qr := len2.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len2_qr.ev); + var len3_qr := len3.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len3_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var len1 := len1_qr.GetRes; + var len2 := len2_qr.GetRes; + var len3 := len3_qr.GetRes; + + var res := new TRecord[len1,len2,len3]; own_qr.SetRes(res); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(0), new UIntPtr(int64(len1)*len2*len3 * Marshal.SizeOf&), + res[0,0,0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + len1.RegisterWaitables(tsk, prev_hubs); + len2.RegisterWaitables(tsk, prev_hubs); + len3.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'len1: '; + len1.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len2: '; + len2.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len3: '; + len3.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function MemorySegmentCCQ.AddGetArray3(len1,len2,len3: CommandQueue): CommandQueue := +new MemorySegmentCommandGetArray3(self, len1, len2, len3) as CommandQueue; + +{$endregion GetArray3} + +{$endregion Get} + +{$endregion Explicit} + +{$endregion MemorySegment} + +{$region CLArray} + +{$region Implicit} + +{$region 1#Write&Read} + +function CLArray.WriteItem(val: &T; ind: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteItem(val, ind) as object as CommandQueue>); + +function CLArray.WriteItem(val: CommandQueue<&T>; ind: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteItem(val, ind) as object as CommandQueue>); + +function CLArray.WriteArray(a: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray(a) as object as CommandQueue>); + +function CLArray.ReadArray(a: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray(a) as object as CommandQueue>); + +function CLArray.WriteArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddWriteArray(a, ind, len, a_ind) as object as CommandQueue>); + +function CLArray.ReadArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddReadArray(a, ind, len, a_ind) as object as CommandQueue>); + +{$endregion 1#Write&Read} + +{$region 2#Fill} + +function CLArray.Fill(val: &T): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFill(val) as object as CommandQueue>); + +function CLArray.Fill(val: &T; ind, len: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFill(val, ind, len) as object as CommandQueue>); + +function CLArray.Fill(val: CommandQueue<&T>): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFill(val) as object as CommandQueue>); + +function CLArray.Fill(val: CommandQueue<&T>; ind, len: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddFill(val, ind, len) as object as CommandQueue>); + +{$endregion 2#Fill} + +{$region 3#Copy} + +function CLArray.CopyTo(a: CommandQueue>): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyTo(a) as object as CommandQueue>); + +function CLArray.CopyFrom(a: CommandQueue>): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyFrom(a) as object as CommandQueue>); + +function CLArray.CopyTo(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyTo(a, from_ind, to_ind, len) as object as CommandQueue>); + +function CLArray.CopyFrom(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArray := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddCopyFrom(a, from_ind, to_ind, len) as object as CommandQueue>); + +{$endregion 3#Copy} + +{$region Get} + +function CLArray.GetItem(ind: CommandQueue): &T := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetItem(ind) as object as CommandQueue<&T>); + +function CLArray.GetArray: array of &T := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetArray as object as CommandQueue); + +function CLArray.GetArray(ind, len: CommandQueue): array of &T := +//ToDo #2510 +Context.Default.SyncInvoke(self.NewQueue.AddGetArray(ind, len) as object as CommandQueue); + +{$endregion Get} + +{$endregion Implicit} + +{$region Explicit} + +{$region 1#Write&Read} + +{$region WriteItem} + +type + CLArrayCommandWriteItem = sealed class(EnqueueableGPUCommand>) + where T: record; + private val: ^&T := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&<&T>)); + private ind: CommandQueue; + + protected procedure Finalize; override; + begin + Marshal.FreeHGlobal(new IntPtr(val)); + end; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(val: &T; ind: CommandQueue); + begin + self.val^ := val; + self.ind := ind; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ind_qr := ind.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ind_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ind := ind_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(ind * Marshal.SizeOf&), new UIntPtr(Marshal.SizeOf&), + new IntPtr(val), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ind.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + sb.Append(val^); + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddWriteItem(val: &T; ind: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandWriteItem(val, ind)); + +{$endregion WriteItem} + +{$region WriteItemQ} + +type + CLArrayCommandWriteItemQ = sealed class(EnqueueableGPUCommand>) + where T: record; + private val: CommandQueue<&T>; + private ind: CommandQueue; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 1; + + public constructor(val: CommandQueue<&T>; ind: CommandQueue); + begin + self.val := val; + self.ind := ind; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&<&T>?evs_l2:evs_l1).Add(val_qr.ev); + var ind_qr := ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(ind_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var val := val_qr.ToPtr; + var ind := ind_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(ind * Marshal.SizeOf&), new UIntPtr(Marshal.SizeOf&), + new IntPtr(val.GetPtr), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var val_hnd := GCHandle.Alloc(val); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + val_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + val.RegisterWaitables(tsk, prev_hubs); + ind.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + val.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddWriteItem(val: CommandQueue<&T>; ind: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandWriteItemQ(val, ind)); + +{$endregion WriteItemQ} + +{$region WriteArrayAutoSize} + +type + CLArrayCommandWriteArrayAutoSize = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddWriteArray(a: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandWriteArrayAutoSize(a)); + +{$endregion WriteArrayAutoSize} + +{$region ReadArrayAutoSize} + +type + CLArrayCommandReadArrayAutoSize = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(a.Length*Marshal.SizeOf&), + a[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddReadArray(a: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandReadArrayAutoSize(a)); + +{$endregion ReadArrayAutoSize} + +{$region WriteArray} + +type + CLArrayCommandWriteArray = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue; + private ind: CommandQueue; + private len: CommandQueue; + private a_ind: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; ind, len, a_ind: CommandQueue); + begin + self. a := a; + self. ind := ind; + self. len := len; + self.a_ind := a_ind; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var ind_qr := ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var a_ind_qr := a_ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_ind_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var ind := ind_qr.GetRes; + var len := len_qr.GetRes; + var a_ind := a_ind_qr.GetRes; + + cl.EnqueueWriteBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(ind*Marshal.SizeOf&), new UIntPtr(len*Marshal.SizeOf&), + a[a_ind], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + a_ind.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_ind: '; + a_ind.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddWriteArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandWriteArray(a, ind, len, a_ind)); + +{$endregion WriteArray} + +{$region ReadArray} + +type + CLArrayCommandReadArray = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue; + private ind: CommandQueue; + private len: CommandQueue; + private a_ind: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue; ind, len, a_ind: CommandQueue); + begin + self. a := a; + self. ind := ind; + self. len := len; + self.a_ind := a_ind; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var ind_qr := ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + var a_ind_qr := a_ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(a_ind_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var ind := ind_qr.GetRes; + var len := len_qr.GetRes; + var a_ind := a_ind_qr.GetRes; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(ind*Marshal.SizeOf&), new UIntPtr(len*Marshal.SizeOf&), + a[a_ind], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + a_ind.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'a_ind: '; + a_ind.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddReadArray(a: CommandQueue; ind, len, a_ind: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandReadArray(a, ind, len, a_ind)); + +{$endregion ReadArray} + +{$endregion 1#Write&Read} + +{$region 2#Fill} + +{$region FillAutoSize} + +type + CLArrayCommandFillAutoSize = sealed class(EnqueueableGPUCommand>) + where T: record; + private val: ^&T := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&<&T>)); + + protected procedure Finalize; override; + begin + Marshal.FreeHGlobal(new IntPtr(val)); + end; + + public function ParamCountL1: integer; override := 0; + public function ParamCountL2: integer; override := 0; + + public constructor(val: &T); + begin + self.val^ := val; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + + Result := (o, cq, tsk, c, evs)-> + begin + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val), new UIntPtr(Marshal.SizeOf&<&T>), + UIntPtr.Zero, new UIntPtr(o.ByteSize), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + sb.Append(val^); + + end; + + end; + +function CLArrayCCQ.AddFill(val: &T): CLArrayCCQ := +AddCommand(self, new CLArrayCommandFillAutoSize(val)); + +{$endregion FillAutoSize} + +{$region Fill} + +type + CLArrayCommandFill = sealed class(EnqueueableGPUCommand>) + where T: record; + private val: ^&T := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&<&T>)); + private ind: CommandQueue; + private len: CommandQueue; + + protected procedure Finalize; override; + begin + Marshal.FreeHGlobal(new IntPtr(val)); + end; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 0; + + public constructor(val: &T; ind, len: CommandQueue); + begin + self.val^ := val; + self.ind := ind; + self.len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var ind_qr := ind.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var ind := ind_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val), new UIntPtr(Marshal.SizeOf&<&T>), + new UIntPtr(ind), new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + sb.Append(val^); + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddFill(val: &T; ind, len: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandFill(val, ind, len)); + +{$endregion Fill} + +{$region FillAutoSizeQ} + +type + CLArrayCommandFillAutoSizeQ = sealed class(EnqueueableGPUCommand>) + where T: record; + private val: CommandQueue<&T>; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 1; + + public constructor(val: CommandQueue<&T>); + begin + self.val := val; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&<&T>?evs_l2:evs_l1).Add(val_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var val := val_qr.ToPtr; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val.GetPtr), new UIntPtr(Marshal.SizeOf&<&T>), + UIntPtr.Zero, new UIntPtr(o.ByteSize), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var val_hnd := GCHandle.Alloc(val); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + val_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + val.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + val.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddFill(val: CommandQueue<&T>): CLArrayCCQ := +AddCommand(self, new CLArrayCommandFillAutoSizeQ(val)); + +{$endregion FillAutoSizeQ} + +{$region FillQ} + +type + CLArrayCommandFillQ = sealed class(EnqueueableGPUCommand>) + where T: record; + private val: CommandQueue<&T>; + private ind: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 3; + public function ParamCountL2: integer; override := 1; + + public constructor(val: CommandQueue<&T>; ind, len: CommandQueue); + begin + self.val := val; + self.ind := ind; + self.len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var val_qr := val.Invoke (tsk, c, main_dvc, True, cq, nil); (val_qr is QueueResDelayedPtr&<&T>?evs_l2:evs_l1).Add(val_qr.ev); + var ind_qr := ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var val := val_qr.ToPtr; + var ind := ind_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueFillBuffer( + cq, o.ntv, + new IntPtr(val.GetPtr), new UIntPtr(Marshal.SizeOf&<&T>), + new UIntPtr(ind), new UIntPtr(len), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var val_hnd := GCHandle.Alloc(val); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + val_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + val.RegisterWaitables(tsk, prev_hubs); + ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'val: '; + val.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddFill(val: CommandQueue<&T>; ind, len: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandFillQ(val, ind, len)); + +{$endregion FillQ} + +{$endregion 2#Fill} + +{$region 3#Copy} + +{$region CopyToAutoSize} + +type + CLArrayCommandCopyToAutoSize = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue>; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue>); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, o.ntv,a.ntv, + UIntPtr.Zero, UIntPtr.Zero, + new UIntPtr(Min(o.ByteSize, a.ByteSize)), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddCopyTo(a: CommandQueue>): CLArrayCCQ := +AddCommand(self, new CLArrayCommandCopyToAutoSize(a)); + +{$endregion CopyToAutoSize} + +{$region CopyFromAutoSize} + +type + CLArrayCommandCopyFromAutoSize = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue>; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue>); + begin + self.a := a; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, a.ntv,o.ntv, + UIntPtr.Zero, UIntPtr.Zero, + new UIntPtr(Min(o.ByteSize, a.ByteSize)), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddCopyFrom(a: CommandQueue>): CLArrayCCQ := +AddCommand(self, new CLArrayCommandCopyFromAutoSize(a)); + +{$endregion CopyFromAutoSize} + +{$region CopyTo} + +type + CLArrayCommandCopyTo = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue>; + private from_ind: CommandQueue; + private to_ind: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue>; from_ind, to_ind, len: CommandQueue); + begin + self. a := a; + self.from_ind := from_ind; + self. to_ind := to_ind; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var from_ind_qr := from_ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(from_ind_qr.ev); + var to_ind_qr := to_ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(to_ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var from_ind := from_ind_qr.GetRes; + var to_ind := to_ind_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, o.ntv,a.ntv, + new UIntPtr(from_ind*Marshal.SizeOf&), new UIntPtr(to_ind*Marshal.SizeOf&), + new UIntPtr(len*Marshal.SizeOf&), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + from_ind.RegisterWaitables(tsk, prev_hubs); + to_ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'from_ind: '; + from_ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'to_ind: '; + to_ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddCopyTo(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandCopyTo(a, from_ind, to_ind, len)); + +{$endregion CopyTo} + +{$region CopyFrom} + +type + CLArrayCommandCopyFrom = sealed class(EnqueueableGPUCommand>) + where T: record; + private a: CommandQueue>; + private from_ind: CommandQueue; + private to_ind: CommandQueue; + private len: CommandQueue; + + public function ParamCountL1: integer; override := 4; + public function ParamCountL2: integer; override := 0; + + public constructor(a: CommandQueue>; from_ind, to_ind, len: CommandQueue); + begin + self. a := a; + self.from_ind := from_ind; + self. to_ind := to_ind; + self. len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, Context, EventList)->cl_event; override; + begin + var a_qr := a.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(a_qr.ev); + var from_ind_qr := from_ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(from_ind_qr.ev); + var to_ind_qr := to_ind.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(to_ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, c, evs)-> + begin + var a := a_qr.GetRes; + var from_ind := from_ind_qr.GetRes; + var to_ind := to_ind_qr.GetRes; + var len := len_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueCopyBuffer( + cq, a.ntv,o.ntv, + new UIntPtr(from_ind*Marshal.SizeOf&), new UIntPtr(to_ind*Marshal.SizeOf&), + new UIntPtr(len*Marshal.SizeOf&), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + a.RegisterWaitables(tsk, prev_hubs); + from_ind.RegisterWaitables(tsk, prev_hubs); + to_ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'a: '; + a.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'from_ind: '; + from_ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'to_ind: '; + to_ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddCopyFrom(a: CommandQueue>; from_ind, to_ind, len: CommandQueue): CLArrayCCQ := +AddCommand(self, new CLArrayCommandCopyFrom(a, from_ind, to_ind, len)); + +{$endregion CopyFrom} + +{$endregion 3#Copy} + +{$region Get} + +{$region GetItem} + +type + CLArrayCommandGetItem = sealed class(EnqueueableGetCommand, &T>) + where T: record; + private ind: CommandQueue; + + public function ForcePtrQr: boolean; override := true; + + public function ParamCountL1: integer; override := 1; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: CLArrayCCQ; ind: CommandQueue); + begin + inherited Create(ccq); + self.ind := ind; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase<&T>)->cl_event; override; + begin + var ind_qr := ind.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ind_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var ind := ind_qr.GetRes; + var res_ev: cl_event; + + cl.EnqueueReadBuffer( + cq, o.Native, Bool.NON_BLOCKING, + new UIntPtr(int64(ind) * Marshal.SizeOf&), new UIntPtr(Marshal.SizeOf&), + new IntPtr((own_qr as QueueResDelayedPtr<&T>).ptr), + evs.count, evs.evs, res_ev + ).RaiseIfError; + + var own_qr_hnd := GCHandle.Alloc(own_qr); + + EventList.AttachFinallyCallback(res_ev, ()-> + begin + own_qr_hnd.Free; + end, tsk, false{$ifdef EventDebug}, nil{$endif}); + + Result := res_ev; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ind.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddGetItem(ind: CommandQueue): CommandQueue<&T> := +new CLArrayCommandGetItem(self, ind) as CommandQueue<&T>; + +{$endregion GetItem} + +{$region GetArrayAutoSize} + +type + CLArrayCommandGetArrayAutoSize = sealed class(EnqueueableGetCommand, array of &T>) + where T: record; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 0; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: CLArrayCCQ); + begin + inherited Create(ccq); + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + + Result := (o, cq, tsk, evs, own_qr)-> + begin + + var res := new T[o.Length]; own_qr.SetRes(res); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + UIntPtr.Zero, new UIntPtr(o.ByteSize), + res[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := exit; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; + + end; + +function CLArrayCCQ.AddGetArray: CommandQueue := +new CLArrayCommandGetArrayAutoSize(self) as CommandQueue; + +{$endregion GetArrayAutoSize} + +{$region GetArray} + +type + CLArrayCommandGetArray = sealed class(EnqueueableGetCommand, array of &T>) + where T: record; + private ind: CommandQueue; + private len: CommandQueue; + + public function NeedThread: boolean; override := true; + + public function ParamCountL1: integer; override := 2; + public function ParamCountL2: integer; override := 0; + + public constructor(ccq: CLArrayCCQ; ind, len: CommandQueue); + begin + inherited Create(ccq); + self.ind := ind; + self.len := len; + end; + private constructor := raise new System.InvalidOperationException; + + protected function InvokeParamsImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; evs_l1, evs_l2: List): (CLArray, cl_command_queue, CLTaskBase, EventList, QueueResDelayedBase)->cl_event; override; + begin + var ind_qr := ind.Invoke (tsk, c, main_dvc, False, cq, nil); evs_l1.Add(ind_qr.ev); + var len_qr := len.InvokeNewQ(tsk, c, main_dvc, False, nil); evs_l1.Add(len_qr.ev); + + Result := (o, cq, tsk, evs, own_qr)-> + begin + var ind := ind_qr.GetRes; + var len := len_qr.GetRes; + + var res := new T[len]; own_qr.SetRes(res); + cl.EnqueueReadBuffer( + cq, o.Native, Bool.BLOCKING, + new UIntPtr(int64(ind) * Marshal.SizeOf&), new UIntPtr(int64(len) * Marshal.SizeOf&), + res[0], + evs.count, evs.evs, IntPtr.Zero + ).RaiseIfError; + + Result := cl_event.Zero; + end; + + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; + begin + ind.RegisterWaitables(tsk, prev_hubs); + len.RegisterWaitables(tsk, prev_hubs); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + sb += 'ind: '; + ind.ToString(sb, tabs, index, delayed, false); + + sb.Append(#9, tabs); + sb += 'len: '; + len.ToString(sb, tabs, index, delayed, false); + + end; + + end; + +function CLArrayCCQ.AddGetArray(ind, len: CommandQueue): CommandQueue := +new CLArrayCommandGetArray(self, ind, len) as CommandQueue; + +{$endregion GetArray} + +{$endregion Get} + +{$endregion Explicit} + +{$endregion CLArray} + {$endregion Enqueueable's} {$region Global subprograms} diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index a298298e7..4864a4a54 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/PABCSystem.pas @@ -14068,7 +14068,8 @@ procedure __InitModule; begin try DefaultEncoding := Encoding.GetEncoding(1251); - System.Console.OutputEncoding := Encoding.UTF8; + if (System.Environment.OSVersion.Version.Major >= 6) and (System.Environment.OSVersion.Version.Minor >= 2) then + System.Console.OutputEncoding := Encoding.UTF8; except DefaultEncoding := Encoding.UTF8; end; diff --git a/TestSuite/CompilationSamples/School.pas b/TestSuite/CompilationSamples/School.pas index b958c0f34..6479f697c 100644 --- a/TestSuite/CompilationSamples/School.pas +++ b/TestSuite/CompilationSamples/School.pas @@ -111,7 +111,9 @@ function TrueTable(f: function(a, b, c, d, e: boolean): boolean): /// Выводит на монитор таблицу истинности /// f = 0 - только для значения функции False /// f = 1 - только для значения функции True -procedure TrueTablePrint(a: array[,] of boolean; f: integer := -1); +/// f = 2 (или не 0, 1, или отсутствует) - полная таблица истинности +/// s = 'abcde' использует указанные буквы для именования колонок. Может отсутствовать. +procedure TrueTablePrint(a: array[,] of boolean; f: integer := 2; s: string := 'abcde'); /// Заменяет последнее вхождение подстроки в строку procedure ReplaceLast(var Строка: string; ЧтоЗаменить, ЧемЗаменить: string); @@ -764,15 +766,17 @@ end; /// Выводит на монитор таблицу истинности /// f = 0 - только для значения функции False /// f = 1 - только для значения функции True -procedure TrueTablePrint(a: array[,] of boolean; f: integer); +/// f = 2 (или не 0, 1, или отсутствует) - полная таблица истинности +/// s = 'abcde' использует указанные буквы для именования колонок. Может отсутствовать. +procedure TrueTablePrint(a: array[,] of boolean; f: integer; s: string); begin var (n, c) := (a.ColCount, 'a'); - for var i := 0 to n - 2 do - begin - Write(' ' + c); - Inc(c) - end; - Writeln(' F'); + s := s?[:n]; + s := s.PadRight(n - 1, ' '); + Write(' '); + for var i := 1 to s.Length do + Print(s[i]); + Writeln('F'); Writeln(' ' + (2 * n - 1) * '-'); for var i := 0 to a.RowCount - 1 do if not (((f = 0) and a[i, n - 1]) or ((f = 1) and not a[i, n - 1])) then diff --git a/TestSuite/notin.pas b/TestSuite/notin.pas new file mode 100644 index 000000000..a6630efde --- /dev/null +++ b/TestSuite/notin.pas @@ -0,0 +1,6 @@ +begin + var a := Arr(1, 2, 3); + Assert(6 not in a); + Assert(4 not in a); + Assert(not (1 not in a)); +end. \ No newline at end of file diff --git a/bin/Lib/School.pas b/bin/Lib/School.pas index b958c0f34..6479f697c 100644 --- a/bin/Lib/School.pas +++ b/bin/Lib/School.pas @@ -111,7 +111,9 @@ function TrueTable(f: function(a, b, c, d, e: boolean): boolean): /// Выводит на монитор таблицу истинности /// f = 0 - только для значения функции False /// f = 1 - только для значения функции True -procedure TrueTablePrint(a: array[,] of boolean; f: integer := -1); +/// f = 2 (или не 0, 1, или отсутствует) - полная таблица истинности +/// s = 'abcde' использует указанные буквы для именования колонок. Может отсутствовать. +procedure TrueTablePrint(a: array[,] of boolean; f: integer := 2; s: string := 'abcde'); /// Заменяет последнее вхождение подстроки в строку procedure ReplaceLast(var Строка: string; ЧтоЗаменить, ЧемЗаменить: string); @@ -764,15 +766,17 @@ end; /// Выводит на монитор таблицу истинности /// f = 0 - только для значения функции False /// f = 1 - только для значения функции True -procedure TrueTablePrint(a: array[,] of boolean; f: integer); +/// f = 2 (или не 0, 1, или отсутствует) - полная таблица истинности +/// s = 'abcde' использует указанные буквы для именования колонок. Может отсутствовать. +procedure TrueTablePrint(a: array[,] of boolean; f: integer; s: string); begin var (n, c) := (a.ColCount, 'a'); - for var i := 0 to n - 2 do - begin - Write(' ' + c); - Inc(c) - end; - Writeln(' F'); + s := s?[:n]; + s := s.PadRight(n - 1, ' '); + Write(' '); + for var i := 1 to s.Length do + Print(s[i]); + Writeln('F'); Writeln(' ' + (2 * n - 1) * '-'); for var i := 0 to a.RowCount - 1 do if not (((f = 0) and a[i, n - 1]) or ((f = 1) and not a[i, n - 1])) then