administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Merge branch 'uses-in-new' into SearchDirectoryArg

Browse source 
# Conflicts:
#	Compiler/Compiler.cs
This commit is contained in:
SunSerega 2021-01-24 20:16:11 +02:00
parent 9fee3a29d0 41feb2828e
commit f6c08b9624
642 changed files with 121834 additions and 92694 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
.github/workflows/buildandruntests.yml vendored Normal file
View file

@ -0,0 +1,38 @@
name: Build & Run all tests (release)
on:
workflow_dispatch:
release:
types:
- created
defaults:
run:
shell: cmd
jobs:
build:
name: Prepare and build on Windows Server 2016 VM
runs-on: windows-2016
steps:
- uses: actions/checkout@v2
- name: Install dependencies into Virtual Environment...
run: _RegisterHelixNUnit.bat
- name: Build project in Release-mode, compile Pas-units, run tests
run: _RebuildReleaseAndRunTestsForGitHubActions.bat
timeout-minutes: 40
env:
PABCNET_BUILD_MODE: Release
PABCNET_RUN_TESTS: false
PABCNET_INC_BUILD: false
PABCNET_VERBOSE: false
#- name: Publish artifacts (5/5)...
# uses: actions/upload-artifact@v2
# with:
# name: All_distros
# path: Release

1
CodeCompletion/CodeCompletion.csproj
View file

@ -42,6 +42,7 @@
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
<UseVSHostingProcess>true</UseVSHostingProcess>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>

61
CodeCompletion/CodeFormatter.cs
View file

@ -416,7 +416,13 @@ namespace CodeFormatters
lines[i] = new string(' ', addit_pos_for_multiline) + lines[i];
}
else
{
lines[i] = new string(' ', off) + lines[i].Trim();
if (lines[i].EndsWith(" else"))
lines[i] += " ";
}
}
}
@ -484,7 +490,7 @@ namespace CodeFormatters
if (s.Length > 0 && !char.IsWhiteSpace(s[0]) && s[0] != '{' && !s.StartsWith("//") && !s.StartsWith("(*") && s[0] != ';' && !char.IsWhiteSpace(s[0]) && (sb.Length == 0 || !char.IsWhiteSpace(sb[sb.Length-1])))
sb.Append(' ');
}
else
else if (s.IndexOf("//") == -1)
s = s.TrimStart(' ', '\t');
sb.Append(s);
if (add_space_after)
@ -902,9 +908,11 @@ namespace CodeFormatters
add_newline_before = true;
}*/
visit_node(_statement_list.left_logical_bracket);
//add_space_before = true;
}
if (!in_one_row(_statement_list) && _statement_list.left_logical_bracket != null && _statement_list.subnodes.Count > 0 && _statement_list.subnodes[0].source_context != null && _statement_list.left_logical_bracket.source_context.end_position.line_num == _statement_list.subnodes[0].source_context.begin_position.line_num)
if (!in_one_row(_statement_list) && _statement_list.left_logical_bracket != null && _statement_list.subnodes.Count > 0 && _statement_list.subnodes[0].source_context != null && _statement_list.left_logical_bracket.source_context.end_position.line_num == _statement_list.subnodes[0].source_context.begin_position.line_num
&& !_statement_list.left_logical_bracket.text.StartsWith("##"))
add_newline_after = true;
else
add_space_after = true;
@ -1673,8 +1681,12 @@ namespace CodeFormatters
{
if (_program_module.program_name != null)
visit_node(_program_module.program_name);
if (_program_module.used_units != null)
visit_node(_program_module.used_units);
if (_program_module.used_units != null && _program_module.used_units.source_context != null)
{
if (_program_module.program_block != null && _program_module.program_block.program_code.left_logical_bracket.text.StartsWith("##"))
;
else visit_node(_program_module.used_units);
}
if (_program_module.program_block != null)
visit_node(_program_module.program_block);
//sb.Append(".");
@ -2385,6 +2397,14 @@ namespace CodeFormatters
WriteKeyword("begin");
IncOffset();
}
else if (string.Compare(_token_info.text, "##", true) == 0)
{
WriteKeyword("##\n");
}
else if (string.Compare(_token_info.text, "###", true) == 0)
{
WriteKeyword("###\n");
}
else if (string.Compare(_token_info.text, "initialization", true) == 0)
{
WriteKeyword("initialization");
@ -3054,8 +3074,8 @@ namespace CodeFormatters
add_space_after = true;
visit_node(_short_func_definition.procdef.proc_body);
if (!(_short_func_definition.procdef.proc_header is constructor))
IncOffset();
//if (!(_short_func_definition.procdef.proc_header is constructor))
IncOffset();
in_procedure = tmp_in_procedure;
multiline_stack_pop(_short_func_definition);
}
@ -3419,6 +3439,35 @@ namespace CodeFormatters
//sb.Append("|");
}
public override void visit(double_question_node dn)
{
visit_node(dn.left);
visit_node(dn.right);
}
public override void visit(bigint_const bi)
{
visit(new uint64_const(bi.val, bi.source_context));
//sb.Append("bi");
}
public override void visit(foreach_stmt_formatting fe)
{
WriteKeyword("foreach");
SetKeywordOffset("foreach");
sb.Append(" var (");
visit_node(fe.il);
add_space_after = true;
add_space_before = true;
visit_node(fe.in_what);
if (!in_one_row(fe.stmt))
add_newline_after = true;
add_space_before = true;
bool need_off = !(fe.stmt is statement_list);
if (need_off)
IncOffset();
visit_node(fe.stmt);
if (need_off)
DecOffset();
}
#endregion
}
}

35
CodeCompletion/DomSyntaxTreeVisitor.cs
View file

@ -2725,9 +2725,19 @@ namespace CodeCompletion
}
if (cur_scope != null && _program_module.program_block.program_code != null)
{
cur_scope.body_loc = new location(_program_module.program_block.program_code.left_logical_bracket.source_context.end_position.line_num,
_program_module.program_block.program_code.left_logical_bracket.source_context.end_position.column_num,
_program_module.program_block.program_code.source_context.end_position.line_num, _program_module.program_block.program_code.source_context.end_position.column_num,
var left_line_num = _program_module.program_block.program_code.left_logical_bracket.source_context.end_position.line_num;
var left_column_num = _program_module.program_block.program_code.left_logical_bracket.source_context.end_position.column_num;
var right_line_num = _program_module.program_block.program_code.source_context.end_position.line_num;
var right_column_num = _program_module.program_block.program_code.source_context.end_position.column_num;
if (_program_module.program_block.program_code.right_logical_bracket == null || _program_module.program_block.program_code.right_logical_bracket.source_context == null)
{
right_line_num += 2;
_program_module.program_block.program_code.source_context = new SourceContext(_program_module.program_block.program_code.source_context.begin_position.line_num,
_program_module.program_block.program_code.source_context.begin_position.column_num, right_line_num, right_column_num);
}
cur_scope.body_loc = new location(left_line_num,
left_column_num,
right_line_num, right_column_num,
doc);
_program_module.program_block.program_code.visit(this);
}
@ -2906,6 +2916,13 @@ namespace CodeCompletion
}
}
else if (returned_scope is ProcScope)
{
method_call mc = new method_call(_dot_node, new expression_list());
search_all = true;
mc.visit(this);
return;
}
}
if (returned_scope != null && returned_scope is ProcScope && (returned_scope as ProcScope).return_type != null)
@ -5583,6 +5600,18 @@ namespace CodeCompletion
cnst_val.prim_val = null;
}
public override void visit(bigint_const bi)
{
/*method_call mc = new method_call();
mc.parameters = new expression_list(new uint64_const(bi.val, bi.source_context),bi.source_context);
mc.dereferencing_value = new dot_node(new ident("System"), new ident("Numerics"), new ident("BigInteger"), new ident("Create"));
mc.visit(this);*/
var names = new List<ident> { new ident("System"), new ident("Numerics"), new ident("BigInteger") };
var ntr = new named_type_reference(names, bi.source_context);
var ne = new new_expr(ntr, new expression_list(new uint64_const(bi.val)), bi.source_context);
ne.visit(this);
}
}
}

6
CodeCompletion/ExpressionVisitor.cs
View file

@ -902,6 +902,12 @@ namespace CodeCompletion
return;
}
}
else if (ps != null)
{
method_call mc = new method_call(_dot_node, new expression_list());
mc.visit(this);
return;
}
if (tmp_tn is ElementScope && stv != null)
{
List<ProcScope> procs = stv.entry_scope.GetExtensionMethods((_dot_node.right as ident).name, (tmp_tn as ElementScope).sc as TypeScope);

2
CodeCompletion/Properties/AssemblyInfo.cs
View file

@ -12,7 +12,7 @@ using System.Runtime.InteropServices;
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("CodeCompletion")]
[assembly: AssemblyCopyright("Copyright © 2005-2020 by Ivan Bondarev, Stanislav Mikhalkovich")]
[assembly: AssemblyCopyright("Copyright © 2005-2021 by Ivan Bondarev, Stanislav Mikhalkovich")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]

31
CodeCompletion/SymTable.cs
View file

@ -2588,7 +2588,10 @@ namespace CodeCompletion
if (this.parameters[i].param_kind != ps.parameters[i].param_kind)
return false;
if (!this.parameters[i].sc.IsEqual(ps.parameters[i].sc))
return false;
if (this.parameters[i].sc is UnknownScope)
return true;
else
return false;
}
if (this.return_type == null)
if (ps.return_type != null)
@ -4355,8 +4358,25 @@ namespace CodeCompletion
ts.loc = this.loc;
for (int i = 0; i < gen_args.Count; i++)
{
ts.AddGenericInstanceParameter(gen_args[i].si.name);
ts.AddGenericInstanciation(gen_args[i]);
TypeScope gen_arg = gen_args[i];
if (gen_arg.instances != null && gen_arg.original_type != null)
{
if (gen_arg.original_type.generic_params != null && this.generic_params != null)
for (int j = 0; j < gen_arg.original_type.generic_params.Count; j++)
{
if (string.Compare(gen_arg.original_type.generic_params[j], this.generic_params[j], true) == 0)
{
ts.AddGenericInstanceParameter(gen_arg.instances[j].si.name);
ts.AddGenericInstanciation(gen_arg.instances[j]);
}
}
}
else
{
ts.AddGenericInstanceParameter(gen_args[i].si.name);
ts.AddGenericInstanciation(gen_args[i]);
}
}
ts.si.name = this.si.name;
ts.documentation = this.documentation;
@ -5587,6 +5607,11 @@ namespace CodeCompletion
}
}
protected override TypeScope simpleGetInstance(List<TypeScope> gen_args)
{
return this.GetInstance(gen_args);
}
public override TypeScope GetInstance(List<TypeScope> gen_args, bool exact = false)
{
Type t = this.ctn;

14
CodeCompletion/Testing.cs
View file

@ -261,10 +261,18 @@ namespace CodeCompletion
private static void assert(bool cond, string message=null)
{
#if DEBUG
if (message != null)
System.Diagnostics.Debug.Assert(cond, message);
else
System.Diagnostics.Debug.Assert(cond);
#else
if (message != null)
System.Diagnostics.Trace.Assert(cond, message);
else
System.Diagnostics.Trace.Assert(cond);
#endif
}
private static void TestVBNETExpressionExtract()
@ -1114,7 +1122,7 @@ namespace CodeCompletion
compilation_unit cu = CodeCompletionController.ParsersController.GetCompilationUnitForFormatter(s, Text, Errors, Warnings);
CodeFormatters.CodeFormatter cf = new CodeFormatters.CodeFormatter(2);
string Text2 = cf.FormatTree(Text, cu, 1, 1);
if (Text != Text2)
if (Text.Replace("\r\n","\n") != Text2.Replace("\r\n","\n"))
{
int line = 1;
for (int i = 0; i < Math.Min(Text.Length, Text2.Length); i++)
@ -1137,7 +1145,7 @@ namespace CodeCompletion
sr = new StreamReader(shouldFileName, System.Text.Encoding.GetEncoding(1251));
string shouldText = sr.ReadToEnd();
sr.Close();
if (Text != shouldText)
if (Text.Replace("\r\n","\n") != shouldText.Replace("\r\n","\n"))
{
sr = new StreamReader(s, System.Text.Encoding.UTF8);
Text = sr.ReadToEnd();
@ -1147,7 +1155,7 @@ namespace CodeCompletion
sr.Close();
}
if (Text != shouldText)
if (Text.Replace("\r\n","\n") != shouldText.Replace("\r\n","\n"))
log.WriteLine("Invalid formatting of File (text not equal) " + s);
}
}

291
Compiler/Compiler.cs
View file

@ -164,6 +164,7 @@ using System.Reflection;
//using SyntaxTreeChanger;
using PascalABCCompiler.SyntaxTreeConverters;
using System.Text;
using PascalABCCompiler.TreeRealization;
using System.Linq;
namespace PascalABCCompiler
@ -398,18 +399,20 @@ namespace PascalABCCompiler
public class CompilationUnit
{
internal bool CaseSensitive = false;
public string CurrentUsesUnit;
public string CurrentUsesUnitId;
public PascalABCCompiler.Errors.SyntaxError syntax_error;
public string UnitName;
public string UnitFileName;
public List<Errors.Error> ErrorList=new List<Errors.Error>();
public bool Documented;
internal List<SyntaxTree.unit_or_namespace> PossibleNamespaces = new List<PascalABCCompiler.SyntaxTree.unit_or_namespace>();
//internal List<CompilationUnit> AssemblyReferences = new List<CompilationUnit>();
//private SemanticTree.compilation_unitArrayList _interfaceUsedUnits=new SemanticTree.compilation_unitArrayList();
//private SemanticTree.compilation_unitArrayList _interfaceUsedUnits=new SemanticTree.compilation_unitArrayList();
public Dictionary<unit_node, CompilationUnit> DirectInterfaceCompilationUnits { get; } = new Dictionary<unit_node, CompilationUnit>();
public PascalABCCompiler.TreeRealization.unit_node_list InterfaceUsedUnits { get; } = new PascalABCCompiler.TreeRealization.unit_node_list();
public Dictionary<unit_node, CompilationUnit> DirectImplementationCompilationUnits { get; } = new Dictionary<unit_node, CompilationUnit>();
public PascalABCCompiler.TreeRealization.unit_node_list ImplementationUsedUnits { get; } = new PascalABCCompiler.TreeRealization.unit_node_list();
private SyntaxTree.compilation_unit _syntaxTree=null;
@ -745,6 +748,8 @@ namespace PascalABCCompiler
public class Compiler : MarshalByRefObject, ICompiler
{
//public ISyntaxTreeChanger SyntaxTreeChanger = null; // SSM 17/08/15 - для операций над синтаксическим деревом после его построения
int pABCCodeHealth = 0;
public int PABCCodeHealth { get { return pABCCodeHealth; } }
public static string Version
{
@ -867,7 +872,7 @@ namespace PascalABCCompiler
supportedProjectFilesList.Add(new SupportedSourceFile(new string[1]{".pabcproj"},"PascalABC.NET"));
supportedProjectFiles = supportedProjectFilesList.ToArray();
}
private SupportedSourceFile[] supportedSourceFiles = null;
public SupportedSourceFile[] SupportedSourceFiles
{
@ -918,12 +923,11 @@ namespace PascalABCCompiler
public CodeGenerators.Controller CodeGeneratorsController = null;
//public LLVMConverter.Controller LLVMCodeGeneratorsController = null;
//public PascalToCppConverter.Controller PABCToCppCodeGeneratorsController = null;
private SyntaxTree.unit_or_namespace CurrentSyntaxUnit;
public SyntaxTree.unit_or_namespace CurrentSyntaxUnit;
private List<CompilationUnit> UnitsToCompile = new List<CompilationUnit>();
public Hashtable RecompileList = new Hashtable(StringComparer.OrdinalIgnoreCase);
private PascalABCCompiler.TreeRealization.unit_node_list Units;
private Hashtable CycleUnits = new Hashtable();
private CompilationUnit CurrentCompilationUnit = null;
public CompilationUnit CurrentCompilationUnit = null;
private CompilationUnit FirstCompilationUnit = null;
private bool PCUReadersAndWritersClosed;
public int beginOffset;
@ -1045,6 +1049,8 @@ namespace PascalABCCompiler
{
OnChangeCompilerState(this, CompilerState.Reloading, null);
pABCCodeHealth = 0;
//А это что?
TreeRealization.type_node tn = SystemLibrary.SystemLibrary.void_type;
@ -1184,6 +1190,7 @@ namespace PascalABCCompiler
CurrentCompilationUnit = null;
FirstCompilationUnit = null;
linesCompiled = 0;
pABCCodeHealth = 0;
PCUReadersAndWritersClosed = false;
ParsersController.Reset();
SyntaxTreeToSemanticTreeConverter.Reset();
@ -1812,10 +1819,12 @@ namespace PascalABCCompiler
{
PrepareCompileOptionsForProject();
}
Units = new PascalABCCompiler.TreeRealization.unit_node_list();
CurrentSyntaxUnit = new SyntaxTree.uses_unit_in(null, new SyntaxTree.string_const(Path.GetFullPath(CompilerOptions.SourceFileName)));
CompileUnit(Units, CurrentSyntaxUnit, null);
CompileUnit(
new PascalABCCompiler.TreeRealization.unit_node_list(),
new Dictionary<unit_node, CompilationUnit>(),
CurrentSyntaxUnit, null);
//Console.WriteLine(timer.ElapsedMilliseconds / 1000.0); //////
foreach (CompilationUnit CurrentUnit in UnitsToCompile)
@ -1840,11 +1849,11 @@ namespace PascalABCCompiler
for (int i = SyntaxUsesList.Count - 1; i >= 0; i--)
if (!IsPossibleNamespace(SyntaxUsesList[i], true, Path.GetDirectoryName(UnitName)))
{
CompileUnit(CurrentUnit.ImplementationUsedUnits, SyntaxUsesList[i], Path.GetDirectoryName(UnitName));
CompileUnit(CurrentUnit.ImplementationUsedUnits, CurrentUnit.DirectImplementationCompilationUnits, SyntaxUsesList[i], Path.GetDirectoryName(UnitName));
}
else
{
CurrentUnit.ImplementationUsedUnits.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(SyntaxUsesList[i])));
CurrentUnit.ImplementationUsedUnits.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(SyntaxUsesList[i])), null);
CurrentUnit.PossibleNamespaces.Add(SyntaxUsesList[i]);
}
}
@ -1876,7 +1885,7 @@ namespace PascalABCCompiler
CurrentUnit.State = UnitState.Compiled;
OnChangeCompilerState(this, CompilerState.EndCompileFile, UnitName);
//SavePCU(CurrentUnit, UnitName);
CurrentUnit.UnitName = UnitName;
CurrentUnit.UnitFileName = UnitName;
}
ClosePCUReadersAndWriters();
@ -1920,6 +1929,12 @@ namespace PascalABCCompiler
cdo.platformtarget = NETGenerator.CompilerOptions.PlatformTarget.x64;
else if (plt.Equals("anycpu"))
cdo.platformtarget = NETGenerator.CompilerOptions.PlatformTarget.AnyCPU;
else if (plt.Equals("dotnet5win"))
cdo.platformtarget = NETGenerator.CompilerOptions.PlatformTarget.dotnet5win;
else if (plt.Equals("dotnet5linux"))
cdo.platformtarget = NETGenerator.CompilerOptions.PlatformTarget.dotnet5linux;
else if (plt.Equals("dotnet5macos"))
cdo.platformtarget = NETGenerator.CompilerOptions.PlatformTarget.dotnet5macos;
}
if (this.compilerOptions.Only32Bit)
cdo.platformtarget = NETGenerator.CompilerOptions.PlatformTarget.x86;
@ -1983,7 +1998,7 @@ namespace PascalABCCompiler
else
ErrorsList.Add(new ResourceFileNotFound(cd.directive, cd.location));
}
}
}
string res_file = null;
if (project != null)
@ -2274,8 +2289,8 @@ namespace PascalABCCompiler
if (ClearAfterCompilation)
ClearAll();
OnChangeCompilerState(this, CompilerState.Ready, null);
if (!need_recompiled)
OnChangeCompilerState(this, CompilerState.Ready, null);
if (ErrorsList.Count > 0)
{
return null;
@ -2514,7 +2529,7 @@ namespace PascalABCCompiler
if (Path.IsPathRooted(path)) return path;
int i = 0;
for (; i < path.Length && path[i] == '.' && path[i + 1] == '.'; )
for (; dir!="" && i < path.Length && path[i] == '.' && path[i + 1] == '.'; )
{
dir = Path.GetDirectoryName(dir);
if (string.IsNullOrEmpty(dir)) return null;
@ -2525,6 +2540,52 @@ namespace PascalABCCompiler
return Path.Combine(dir, path.Substring(i));
}
public static string GetUnitPath(CompilationUnit u1, CompilationUnit u2)
{
if (u1 == null) throw new ArgumentException(nameof(u1));
if (u2 == null) throw new ArgumentException(nameof(u2));
if (u1.DirectInterfaceCompilationUnits .Values.Contains(u2)) return u1.InterfaceUsedUnits .unit_uses_paths[u2.SemanticTree];
if (u1.DirectImplementationCompilationUnits .Values.Contains(u2)) return u1.ImplementationUsedUnits .unit_uses_paths[u2.SemanticTree];
var last = new Dictionary<CompilationUnit, string>();
var done = new HashSet<CompilationUnit>();
foreach (var u in u1.DirectInterfaceCompilationUnits.Values.Concat(u1.DirectImplementationCompilationUnits.Values))
{
last.Add(u, u1.InterfaceUsedUnits.unit_uses_paths[u.SemanticTree]);
done.Add(u);
}
while (last.Count != 0)
{
var next = new Dictionary<CompilationUnit, string>();
foreach (var u in last.Keys)
{
foreach (var used_u in u.DirectInterfaceCompilationUnits.Values)
{
if (!done.Add(used_u)) continue;
var path = CombinePath(Path.GetDirectoryName(last[u]), u.InterfaceUsedUnits.unit_uses_paths[used_u.SemanticTree]);
if (used_u == u2) return path;
next.Add(used_u, path);
}
foreach (var used_u in u.DirectImplementationCompilationUnits.Values)
{
if (!done.Add(used_u)) continue;
var path = CombinePath(Path.GetDirectoryName(last[u]), u.ImplementationUsedUnits.unit_uses_paths[used_u.SemanticTree]);
if (used_u == u2) return path;
next.Add(used_u, path);
}
}
last = next;
}
throw new InvalidOperationException($"Could not find path to \"{u2.UnitFileName}\" relative to \"{u1.UnitFileName}\"");
}
private string FindFileInDirs(string FileName, params string[] Dirs)
{
foreach (string Dir in Dirs)
@ -2570,7 +2631,7 @@ namespace PascalABCCompiler
//\MikhailoMMX
var FullFileName = Path.Combine(curr_path, FileName);
if (System.IO.File.Exists(FullFileName)) // для отладки с *.inc файлами
if (System.IO.File.Exists(FullFileName))
{
var NewFileName = Path.Combine(compilerOptions.OutputDirectory, Path.GetFileName(FullFileName));
if (FullFileName != NewFileName) File.Copy(FullFileName, NewFileName, true);
@ -2598,14 +2659,6 @@ namespace PascalABCCompiler
if (SyntaxUsesUnit is SyntaxTree.uses_unit_in uui)
{
// Подключение .dll в uses-in. Зачем - не понятно, но было до меня, поэтому просто оставил
switch (Path.GetExtension(uui.in_file.Value).ToLower())
{
case ".dll":
case ".exe":
return GetReferenceFileName(uui.in_file.Value, uui.in_file.source_context, curr_path);
}
if (UnitName.ToLower() != Path.GetFileNameWithoutExtension(uui.in_file.Value).ToLower())
throw new UsesInWrongName(CurrentCompilationUnit.SyntaxTree.file_name, UnitName, Path.GetFileNameWithoutExtension(uui.in_file.Value), uui.in_file.source_context);
@ -2742,15 +2795,13 @@ namespace PascalABCCompiler
string UnitName = null;
try
{
// "loc == null" для стандартных .dll, как "System.dll"
//ToDo а loc.doc было null в тестранере, но я так и не понял почему. не смог воспроизвести в дебаг режиме
UnitName = GetReferenceFileName(cd.directive, sc, loc?.doc?.file_name == null ? CompilerOptions.OutputDirectory : Path.GetDirectoryName(loc.doc.file_name));
UnitName = GetReferenceFileName(cd.directive, sc, Path.GetDirectoryName(cd.source_file));
}
catch (AssemblyNotFound ex)
{
throw;
}
//ToDo плохо, пока дебажил - тут постоянно ловились другие исключения, не связанные с неправильным знаками в путик сборке
//ToDo плохо, пока дебажил - тут постоянно ловились другие исключения, не связанные с неправильным знаками в пути к сборке
catch (Exception ex)
{
throw new InvalidAssemblyPathError(CurrentCompilationUnit.SyntaxTree.file_name, sc);
@ -2759,7 +2810,7 @@ namespace PascalABCCompiler
if (UnitTable.Count == 0) throw new ProgramModuleExpected(UnitName, null);
if ((CurrentUnit = ReadDLL(UnitName)) != null)
{
Units.AddElement(CurrentUnit.SemanticTree);
Units.AddElement(CurrentUnit.SemanticTree, null);
UnitTable[UnitName] = CurrentUnit;
return CurrentUnit;
}
@ -2856,7 +2907,7 @@ namespace PascalABCCompiler
{
if (IsPossibleNamespace(name_space, false, Path.GetDirectoryName(file)))
{
ns.referenced_units.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(name_space), get_location_from_treenode(name_space, tree.file_name)));
ns.referenced_units.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(name_space), get_location_from_treenode(name_space, tree.file_name)), null);
}
else
{
@ -2904,6 +2955,7 @@ namespace PascalABCCompiler
{
string SourceText = GetSourceFileText(FileName);
List<string> DefinesList = new List<string>();
DefinesList.Add("PASCALABC"); // SSM 11/07/20
if (!compilerOptions.Debug && !compilerOptions.ForDebugging)
DefinesList.Add("RELEASE");
else
@ -2924,27 +2976,33 @@ namespace PascalABCCompiler
directives = (Unit.SemanticTree as TreeRealization.common_unit_node).compiler_directives;
else
directives = ConvertDirectives(Unit.SyntaxTree);
foreach (TreeRealization.compiler_directive cd in directives)
{
if (cd.name.ToLower() == TreeConverter.compiler_string_consts.compiler_directive_platformtarget && !string.IsNullOrEmpty(cd.directive) && cd.directive.IndexOf("dotnet5") != -1)
CompilerOptions.UseDllForSystemUnits = false;
}
if (CompilerOptions.UseDllForSystemUnits)
{
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\PABCRtl.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\mscorlib.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Core.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Numerics.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Windows.Forms.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Drawing.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\PABCRtl.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\mscorlib.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Core.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Numerics.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Windows.Forms.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\System.Drawing.dll", null, "."));
if (Unit.SyntaxTree is SyntaxTree.program_module && (Unit.SyntaxTree as SyntaxTree.program_module).used_units != null)
foreach (SyntaxTree.unit_or_namespace uui in (Unit.SyntaxTree as SyntaxTree.program_module).used_units.units)
{
if (uui.name.ToString() == "Graph3D")
{
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\PresentationFramework.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\WindowsBase.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\PresentationCore.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\HelixToolkit.Wpf.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\HelixToolkit.dll", null, null));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\PresentationFramework.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\WindowsBase.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\PresentationCore.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\HelixToolkit.Wpf.dll", null, "."));
directives.Add(new TreeRealization.compiler_directive("reference", "%GAC%\\HelixToolkit.dll", null, "."));
}
}
}
foreach (TreeRealization.compiler_directive cd in directives)
{
@ -2960,7 +3018,7 @@ namespace PascalABCCompiler
{
foreach (ReferenceInfo ri in project.references)
{
CompileReference(res,new TreeRealization.compiler_directive("reference",ri.full_assembly_name,null,null));
CompileReference(res, new TreeRealization.compiler_directive("reference", ri.full_assembly_name, null, project.MainFile));
}
}
return res;
@ -3080,7 +3138,17 @@ namespace PascalABCCompiler
OnChangeCompilerState(this, CompilerState.EndParsingFile, FileName);
//Вычисляем сколько строк скомпилировали
if (ErrorList.Count == 0 && cu != null && cu.source_context!=null)
{
linesCompiled += (uint)(cu.source_context.end_position.line_num - cu.source_context.begin_position.line_num + 1);
// 500 - это наибольшая программа для начинающих. БОльшая программа - здоровье кода только по кнопке (чтобы не замедлять)
if (linesCompiled <= 500)
{
// Это только для локального компилятора?
var stat = new SyntaxVisitors.ABCStatisticsVisitor();
stat.ProcessNode(cu);
pABCCodeHealth = stat.CalcHealth(out int neg, out int pos);
}
}
return cu;
}
@ -3102,60 +3170,42 @@ namespace PascalABCCompiler
return false;
}
public CompilationUnit CompileUnit(PascalABCCompiler.TreeRealization.unit_node_list Units, SyntaxTree.unit_or_namespace SyntaxUsesUnit, string prev_path)
public CompilationUnit CompileUnit(PascalABCCompiler.TreeRealization.unit_node_list Units, Dictionary<unit_node, CompilationUnit> DirectCompilationUnits, SyntaxTree.unit_or_namespace SyntaxUsesUnit, string prev_path)
{
string UnitName = GetUnitFileName(SyntaxUsesUnit, prev_path);
// имя папки, в которой лежит текущий модуль
// используется для подключения модулей, $include и т.п. из модуля, подключённого с uses-in
var curr_path = Path.GetDirectoryName(UnitName);
string UnitFileName = GetUnitFileName(SyntaxUsesUnit, prev_path);
string UnitId = Path.ChangeExtension(UnitFileName, null);
// Имя папки, в которой лежит текущий модуль
// Используется для подключения модулей, $include и т.п. из модуля, подключённого с uses-in
var curr_path = Path.GetDirectoryName(UnitFileName);
CompilationUnit CurrentUnit = UnitTable[UnitName];
CompilationUnit CurrentUnit = UnitTable[UnitId];
if (CurrentUnit != null && CurrentUnit.SemanticTree is PascalABCCompiler.TreeRealization.dot_net_unit_node
&& SyntaxUsesUnit is PascalABCCompiler.SyntaxTree.uses_unit_in ui && ui.in_file != null) // значит, это пространство имен и секция in у него должна отсутствовать
{
ErrorsList.Add(new NamespaceCannotHaveInSection(ui.in_file.source_context));
}
if (Path.GetExtension(UnitName).ToLower() == CompilerOptions.CompiledUnitExtension)
{
string sfn = FindSourceFileName(Path.ChangeExtension(UnitName, null), null, out _);
if (sfn != null && UnitTable[sfn] != null)
CurrentUnit = UnitTable[sfn];
}
if (CurrentUnit != null)
if (CurrentUnit.State != UnitState.BeginCompilation || CurrentUnit.SemanticTree != null) //ИЗБАВИТЬСЯ ОТ ВТОРОГО УСЛОВИЯ
{
Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath());
if (Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath()))
DirectCompilationUnits.Add(CurrentUnit.SemanticTree, CurrentUnit);
Units.AddRange(GetReferences(CurrentUnit));
return CurrentUnit;
}
if (UnitName.ToLower().LastIndexOf(".dll") >= 0 || UnitName.ToLower().LastIndexOf(".exe") >= 0)
if (File.Exists(UnitName))
if (CurrentUnit==null && Path.GetExtension(UnitFileName).ToLower() == CompilerOptions.CompiledUnitExtension)
if (File.Exists(UnitFileName))
{
if (UnitTable.Count == 0) throw new ProgramModuleExpected(UnitName, null);
if ((CurrentUnit = ReadDLL(UnitName)) != null)
{
Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath());
UnitTable[UnitName] = CurrentUnit;
return CurrentUnit;
}
else
//throw new DLLReadingError(UnitName);
throw new AssemblyReadingError(CurrentCompilationUnit.SyntaxTree.file_name, UnitName, SyntaxUsesUnit.source_context);
}
if (Path.GetExtension(UnitName).ToLower() == CompilerOptions.CompiledUnitExtension)
if (File.Exists(UnitName))
{
if (UnitTable.Count == 0) throw new ProgramModuleExpected(UnitName, null);
if (UnitTable.Count == 0) throw new ProgramModuleExpected(UnitFileName, null);
try
{
if ((CurrentUnit = ReadPCU(UnitName)) != null)
if ((CurrentUnit = ReadPCU(UnitFileName)) != null)
{
Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath());
if (Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath()))
DirectCompilationUnits.Add(CurrentUnit.SemanticTree, CurrentUnit);
Units.AddRange(GetReferences(CurrentUnit));
UnitTable[UnitName] = CurrentUnit;
UnitTable[UnitId] = CurrentUnit;
return CurrentUnit;
}
}
@ -3169,17 +3219,17 @@ namespace PascalABCCompiler
}
catch (Exception e)
{
OnChangeCompilerState(this, CompilerState.PCUReadingError, UnitName);
OnChangeCompilerState(this, CompilerState.PCUReadingError, UnitFileName);
#if DEBUG
if (!InternalDebug.SkipPCUErrors)
throw new Errors.CompilerInternalError("PCUReader", e);
#endif
}
string SourceFileName = FindSourceFileName(Path.ChangeExtension(UnitName, null), null, out _);
string SourceFileName = FindSourceFileName(Path.ChangeExtension(UnitFileName, null), null, out _);
if (SourceFileName == null)
throw new ReadPCUError(UnitName);
throw new ReadPCUError(UnitFileName);
else
UnitName = SourceFileName;
UnitFileName = SourceFileName;
}
string SourceText = null;
Dictionary<SyntaxTree.syntax_tree_node, string> docs = null;
@ -3189,19 +3239,20 @@ namespace PascalABCCompiler
CurrentUnit = new CompilationUnit();
if (FirstCompilationUnit == null)
FirstCompilationUnit = CurrentUnit;
OnChangeCompilerState(this, CompilerState.BeginCompileFile, UnitName);
SourceText = GetSourceFileText(UnitName);
OnChangeCompilerState(this, CompilerState.BeginCompileFile, UnitFileName);
SourceText = GetSourceFileText(UnitFileName);
if (SourceText == null)
if (CurrentUnit == FirstCompilationUnit)
throw new SourceFileNotFound(UnitName);
throw new SourceFileNotFound(UnitFileName);
else
throw new UnitNotFound(CurrentCompilationUnit.SyntaxTree.file_name, UnitName, SyntaxUsesUnit.source_context);
throw new UnitNotFound(CurrentCompilationUnit.SyntaxTree.file_name, UnitFileName, SyntaxUsesUnit.source_context);
List<string> DefinesList = new List<string>();
DefinesList.Add("PASCALABC");
if (!compilerOptions.Debug && !compilerOptions.ForDebugging)
DefinesList.Add("RELEASE");
else
DefinesList.Add("DEBUG");
CurrentUnit.SyntaxTree = InternalParseText(UnitName, SourceText, errorsList, warnings, DefinesList);
CurrentUnit.SyntaxTree = InternalParseText(UnitFileName, SourceText, errorsList, warnings, DefinesList);
if (errorsList.Count == 0) // SSM 2/05/16 - для преобразования синтаксических деревьев извне
{
@ -3264,13 +3315,13 @@ namespace PascalABCCompiler
throw errorsList[0];
}
UnitTable[UnitName] = CurrentUnit;
UnitTable[UnitId] = CurrentUnit;
if (UnitTable.Count > 1)//если это не главный модуль
if (CurrentUnit.SyntaxTree is SyntaxTree.program_module)
throw new UnitModuleExpected(UnitName, CurrentUnit.SyntaxTree.source_context.LeftSourceContext);
throw new UnitModuleExpected(UnitFileName, CurrentUnit.SyntaxTree.source_context.LeftSourceContext);
else if (is_dll(CurrentUnit.SyntaxTree))
throw new UnitModuleExpectedLibraryFound(UnitName, CurrentUnit.SyntaxTree.source_context.LeftSourceContext);
throw new UnitModuleExpectedLibraryFound(UnitFileName, CurrentUnit.SyntaxTree.source_context.LeftSourceContext);
//здесь в начало uses добавляем стандартные модули
#if DEBUG
if (InternalDebug.AddStandartUnits)
@ -3309,31 +3360,34 @@ namespace PascalABCCompiler
{
if (IsPossibleNamespace(SyntaxUsesList[i], true, curr_path) || namespaces.ContainsKey(SyntaxUsesList[i].name.idents[0].name))
{
CurrentUnit.InterfaceUsedUnits.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(SyntaxUsesList[i])));
CurrentUnit.InterfaceUsedUnits.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(SyntaxUsesList[i])), null);
CurrentUnit.PossibleNamespaces.Add(SyntaxUsesList[i]);
}
else
{
string CurrentSyntaxUnitName = GetUnitFileName(SyntaxUsesList[i], curr_path);
CurrentUnit.CurrentUsesUnit = CurrentSyntaxUnitName;
if (UnitTable[CurrentSyntaxUnitName] != null)
if (UnitTable[CurrentSyntaxUnitName].State == UnitState.BeginCompilation)
var CurrentSyntaxUnitFileName = GetUnitFileName(SyntaxUsesList[i], curr_path);
var CurrentSyntaxUnitId = Path.ChangeExtension(CurrentSyntaxUnitFileName, null);
CurrentUnit.CurrentUsesUnitId = CurrentSyntaxUnitId;
if (UnitTable[CurrentSyntaxUnitId] != null)
if (UnitTable[CurrentSyntaxUnitId].State == UnitState.BeginCompilation)
{
string CurrentSyntaxUnitNameCurrentUsesUnit = UnitTable[CurrentSyntaxUnitName].CurrentUsesUnit;
if (CurrentSyntaxUnitNameCurrentUsesUnit != null)
string CurrentSyntaxUnit_CurrentUsesUnitId = UnitTable[CurrentSyntaxUnitId].CurrentUsesUnitId;
if (CurrentSyntaxUnit_CurrentUsesUnitId != null)
{
//если сначало взали pcu а потом решили его перекомпилировать, поэтому в таблице его нет
if (UnitTable[CurrentSyntaxUnitNameCurrentUsesUnit] == null)
UnitTable[CurrentSyntaxUnitName].CurrentUsesUnit = FindSourceFileName(Path.ChangeExtension(CurrentSyntaxUnitNameCurrentUsesUnit, null), null, out _);
//если сначало взяли pcu а потом решили его перекомпилировать, поэтому в таблице его нет
if (UnitTable[CurrentSyntaxUnit_CurrentUsesUnitId] == null)
UnitTable[CurrentSyntaxUnitId].CurrentUsesUnitId = CurrentSyntaxUnit_CurrentUsesUnitId;
//далее финальная поверка на зацикливание
if (UnitTable[CurrentSyntaxUnitName].CurrentUsesUnit != null && UnitTable[UnitTable[CurrentSyntaxUnitName].CurrentUsesUnit].State == UnitState.BeginCompilation)
throw new CycleUnitReference(UnitName, SyntaxUsesList[i]);
if (UnitTable[CurrentSyntaxUnitId].CurrentUsesUnitId != null && UnitTable[UnitTable[CurrentSyntaxUnitId].CurrentUsesUnitId].State == UnitState.BeginCompilation)
throw new CycleUnitReference(UnitFileName, SyntaxUsesList[i]);
}
}
CompileUnit(CurrentUnit.InterfaceUsedUnits, SyntaxUsesList[i], curr_path);
CompileUnit(CurrentUnit.InterfaceUsedUnits, CurrentUnit.DirectInterfaceCompilationUnits, SyntaxUsesList[i], curr_path);
if (CurrentUnit.State == UnitState.Compiled)
{
Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath());
if (Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath()))
DirectCompilationUnits.Add(CurrentUnit.SemanticTree, CurrentUnit);
Units.AddRange(References);
return CurrentUnit;
}
@ -3356,7 +3410,7 @@ namespace PascalABCCompiler
{
if (CurrentUnit.State != UnitState.InterfaceCompiled)
{
OnChangeCompilerState(this, CompilerState.CompileInterface, UnitName);
OnChangeCompilerState(this, CompilerState.CompileInterface, UnitFileName);
PascalABCCompiler.TreeConverter.SemanticRules.SymbolTableCaseSensitive = CurrentUnit.CaseSensitive;
CurrentUnit.SemanticTree = SyntaxTreeToSemanticTreeConverter.CompileInterface(
CurrentUnit.SyntaxTree,
@ -3381,7 +3435,8 @@ namespace PascalABCCompiler
CurrentUnit.State = UnitState.InterfaceCompiled;
if (Units != null)
{
Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath());
if (Units.AddElement(CurrentUnit.SemanticTree, SyntaxUsesUnit.UsesPath()))
DirectCompilationUnits.Add(CurrentUnit.SemanticTree, CurrentUnit);
Units.AddRange(References);
}
SyntaxUsesList = GetSyntaxImplementationUsesList(CurrentUnit.SyntaxTree);
@ -3393,7 +3448,7 @@ namespace PascalABCCompiler
for (int i = SyntaxUsesList.Count - 1; i >= 0; i--)
if (!IsPossibleNamespace(SyntaxUsesList[i], true, curr_path))
{
cu = UnitTable[GetUnitFileName(SyntaxUsesList[i], curr_path)];
cu = UnitTable[Path.ChangeExtension(GetUnitFileName(SyntaxUsesList[i], curr_path), null)];
if (cu != null && cu.State == UnitState.BeginCompilation)
{
UnitsToCompile.Add(cu);
@ -3404,12 +3459,12 @@ namespace PascalABCCompiler
}
else
{
CompileUnit(CurrentUnit.ImplementationUsedUnits, SyntaxUsesList[i], curr_path);
CompileUnit(CurrentUnit.ImplementationUsedUnits, CurrentUnit.DirectImplementationCompilationUnits, SyntaxUsesList[i], curr_path);
}
}
else
{
CurrentUnit.ImplementationUsedUnits.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(SyntaxUsesList[i])));
CurrentUnit.ImplementationUsedUnits.AddElement(new TreeRealization.namespace_unit_node(GetNamespace(SyntaxUsesList[i])), null);
CurrentUnit.PossibleNamespaces.Add(SyntaxUsesList[i]);
}
}
@ -3438,7 +3493,7 @@ namespace PascalABCCompiler
if (InternalDebug.SemanticAnalysis)
#endif
{
OnChangeCompilerState(this, CompilerState.CompileImplementation, UnitName);
OnChangeCompilerState(this, CompilerState.CompileImplementation, UnitFileName);
PascalABCCompiler.TreeConverter.SemanticRules.SymbolTableCaseSensitive = CurrentUnit.CaseSensitive;
SyntaxTreeToSemanticTreeConverter.CompileImplementation(
(PascalABCCompiler.TreeRealization.common_unit_node)CurrentUnit.SemanticTree,
@ -3462,9 +3517,9 @@ namespace PascalABCCompiler
if (!UnitsSortedList.Contains(CurrentUnit))//vnimanie zdes inogda pri silnoj zavisimosti modulej moduli popadajut neskolko raz
UnitsSortedList.Add(CurrentUnit);
}
OnChangeCompilerState(this, CompilerState.EndCompileFile, UnitName);
OnChangeCompilerState(this, CompilerState.EndCompileFile, UnitFileName);
//SavePCU(CurrentUnit, UnitName);
CurrentUnit.UnitName = UnitName;
CurrentUnit.UnitFileName = UnitFileName;
return CurrentUnit;
/*if(CurrentUnit.State!=UnitState.Compiled)
{
@ -3520,7 +3575,7 @@ namespace PascalABCCompiler
foreach (TreeRealization.unit_node un in cu.InterfaceUsedUnits)
{
if (un is TreeRealization.dot_net_unit_node)
unl.AddElement(un);
unl.AddElement(un, null);
}
return unl;
}
@ -3562,14 +3617,14 @@ namespace PascalABCCompiler
dbginfo = InternalDebug.IncludeDebugInfoInPCU;
#endif
writer.SaveSemanticTree(Unit, Path.ChangeExtension(Unit.UnitName, CompilerOptions.CompiledUnitExtension), dbginfo);
writer.SaveSemanticTree(Unit, Path.ChangeExtension(Unit.UnitFileName, CompilerOptions.CompiledUnitExtension), dbginfo);
}
}
catch (Exception err)
{
//ErrorsList.Add(new Errors.CompilerInternalError(string.Format("Compiler.Compile[{0}]", Path.GetFileName(this.CurrentCompilationUnit.SyntaxTree.file_name)), err));
OnChangeCompilerState(this, CompilerState.PCUWritingError, Unit.UnitName);
OnChangeCompilerState(this, CompilerState.PCUWritingError, Unit.UnitFileName);
#if DEBUG
if (!InternalDebug.SkipPCUErrors)
throw new Errors.CompilerInternalError(string.Format("Compiler.Compile[{0}]", Path.GetFileName(this.CurrentCompilationUnit.SyntaxTree.file_name)), err);
@ -3791,7 +3846,7 @@ namespace PascalABCCompiler
string pas_name = FindSourceFileName(Path.ChangeExtension(pcu_name, null), null, out _);
var dir = Path.GetDirectoryName(pcu_name);
if (UnitTable[pas_name] != null)
if (UnitTable[Path.ChangeExtension(pas_name, null)] != null)
return true;
bool need = false;
@ -3799,12 +3854,12 @@ namespace PascalABCCompiler
{
//if (included[i].Contains("$"))
// continue;
var used_unit_fname = GetUnitFileName(null, included[i], dir, null);
var used_unit_fname = GetUnitFileName(Path.GetFileNameWithoutExtension(included[i]), included[i], dir, null);
var used_unit_is_pcu = Path.GetExtension(used_unit_fname) == CompilerOptions.CompiledUnitExtension;
if (!used_unit_is_pcu)
{
if (UnitTable[used_unit_fname] != null) return true;
if (UnitTable[Path.ChangeExtension(used_unit_fname, null)] != null) return true;
need = true;
RecompileList[pcu_name] = pcu_name;
}

5
Compiler/Compiler.csproj
View file

@ -69,6 +69,7 @@
<DebugType>full</DebugType>
<ErrorReport>prompt</ErrorReport>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
<UseVSHostingProcess>true</UseVSHostingProcess>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>..\bin\</OutputPath>
@ -147,6 +148,10 @@
<Project>{C2CAC65A-B2AE-4CCC-B067-E6B8E75DF73A}</Project>
<Package>{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}</Package>
</ProjectReference>
<ProjectReference Include="..\SyntaxVisitors\SyntaxVisitors.csproj">
<Project>{a9ab4282-83b4-41a7-86c3-e5bf6a45e7e2}</Project>
<Name>SyntaxVisitors</Name>
</ProjectReference>
<ProjectReference Include="..\TreeConverter\TreeConverter.csproj">
<Name>TreeConverter</Name>
<Project>{1C9C945A-586D-42A2-A06B-65D84FA7FF78}</Project>

2
Compiler/ConsoleCompilerCommands.cs
View file

@ -26,6 +26,7 @@ namespace PascalABCCompiler
public const int GetLastWriteTime = 186;
public const int VarBeginOffest = 187;
public const int InternalError = 188;
public const int PABCHealth = 189;
//2xx to pabcnetc.exe
@ -48,5 +49,6 @@ namespace PascalABCCompiler
public const int CompilerOptionsProjectCompiled = 225;
public const int UseDllForSystemUnits = 226;
public const int IDELocale = 227;
public const int CompilerLocale = 228;
}
}

8
Compiler/DocXml.cs
View file

@ -28,15 +28,15 @@ namespace PascalABCCompiler
XmlWriterSettings settings = new XmlWriterSettings();
settings.Encoding = Encoding.UTF8;
settings.Indent = true;
xtw = XmlTextWriter.Create(Path.ChangeExtension(cu.UnitName, ".xml"), settings);
unit_name = Path.GetFileNameWithoutExtension(cu.UnitName);
xtw = XmlTextWriter.Create(Path.ChangeExtension(cu.UnitFileName, ".xml"), settings);
unit_name = Path.GetFileNameWithoutExtension(cu.UnitFileName);
xtw.WriteStartDocument();
xtw.WriteStartElement("doc");
if (is_assembly)
{
xtw.WriteStartElement("assembly");
xtw.WriteStartElement("name");
xtw.WriteString(Path.GetFileNameWithoutExtension(cu.UnitName));
xtw.WriteString(Path.GetFileNameWithoutExtension(cu.UnitFileName));
xtw.WriteEndElement();
xtw.WriteEndElement();
}
@ -45,7 +45,7 @@ namespace PascalABCCompiler
xtw.WriteStartElement("unit");
xtw.WriteStartAttribute("name");
//xtw.WriteString((cu.SemanticTree as common_unit_node).unit_name);
xtw.WriteString(Path.GetFileNameWithoutExtension(cu.UnitName));
xtw.WriteString(Path.GetFileNameWithoutExtension(cu.UnitFileName));
xtw.WriteEndAttribute();
xtw.WriteString(cu.SemanticTree.documentation);
xtw.WriteEndElement();

14
Compiler/ICompiler.cs
View file

@ -14,6 +14,13 @@ namespace PascalABCCompiler
public enum CompilerType { Standart, Remote }
public interface ICompiler
{
/// Здоровье кода на всякий случай выносим в интерфейс компилятора
/// Реально оно будет использоваться только при запуске из под оболочки (Remote Compiler)
int PABCCodeHealth
{
get;
}
SyntaxTreeConvertersController SyntaxTreeConvertersController
{
get;
@ -32,7 +39,12 @@ namespace PascalABCCompiler
{
get;
}
/*SyntaxTree.syntax_tree_node SyntaxTree
{
get;
}*/
uint LinesCompiled
{
get;

2
Compiler/PCU/PCUFileFormatVersion.cs
View file

@ -6,6 +6,6 @@ namespace PascalABCCompiler.PCU
{
public static class PCUFileFormatVersion
{
public static System.Int16 Version = 115;
public static System.Int16 Version = 117;
}
}

385
Compiler/PCU/PCUReader.cs
View file

@ -82,7 +82,10 @@ namespace PascalABCCompiler.PCU
internal void AddVarToOrderList(var_definition_node vdn, int ind)
{
interf_var_list.Add(ind,vdn);
if (!interf_var_list.ContainsKey(ind))
interf_var_list.Add(ind, vdn);
else
interf_var_list[ind] = vdn;
}
internal void AddTypeToOrderList(common_type_node ctn, int ind)
@ -186,14 +189,6 @@ namespace PascalABCCompiler.PCU
return already_compiled[name] != null;
}
public static bool ContainsUnit(string FileName, out PCUReader pr)
{
string unit_name = System.IO.Path.GetFileNameWithoutExtension(FileName);
pr = (PCUReader)units[unit_name];
if (pr != null) return true;
return false;
}
public static void CloseUnits()
{
AllReadOrWritedDefinitionNodesOffsets.Clear();
@ -230,11 +225,24 @@ namespace PascalABCCompiler.PCU
if (FullUnitName == null) throw new FileNotFound(UnitName, null);
return FullUnitName;
}
//десериализация модуля
//читается только шапка PCU и заполняются имена сущностей модуля в таблицу символов
public CompilationUnit GetCompilationUnit(string FileName, bool readDebugInfo)
}
private PCUReader GetPCUReaderForUnitId(int id)
{
if (id == -1) return this;
string s = GetFullUnitName(pcu_file.incl_modules[id]);
var pr = (PCUReader)units[s];
if (pr == null)
{
pr = new PCUReader(this);
pr.GetCompilationUnit(s, this.readDebugInfo);
}
return pr;
}
//десериализация модуля
//читается только шапка PCU и заполняются имена сущностей модуля в таблицу символов
public CompilationUnit GetCompilationUnit(string FileName, bool readDebugInfo)
{
try
{
@ -255,16 +263,18 @@ namespace PascalABCCompiler.PCU
br = new BinaryReader(ms);
ReadPCUHeader();
units[FileName] = this;
if (NeedRecompiled())
{
CloseUnit();
need = true;
return null; // return comp.RecompileUnit(FileName);
}
unit = new CompilationUnit();
unit.UnitFileName = FileName;
cun = new common_unit_node();
cun.compiler_directives = pcu_file.compiler_directives;
unit.SemanticTree = cun;
if (NeedRecompiled())
{
CloseUnit();
this.unit = null;
need = true;
return null; // return comp.RecompileUnit(FileName);
}
ChangeState(this, PCUReaderWriterState.BeginReadTree, unit);
cun.scope = new WrappedUnitInterfaceScope(this);
@ -354,8 +364,13 @@ namespace PascalABCCompiler.PCU
if (used_units[used_unit_fname] == null)
{
used_units[used_unit_fname] = used_units;
if (already_compiled[used_unit_fname] == null)
pr.GetCompilationUnit(used_unit_fname, this.readDebugInfo);
if (already_compiled[used_unit_fname] == null)
{
var sub_u = pr.GetCompilationUnit(used_unit_fname, this.readDebugInfo);
if (sub_u == null) return true;
this.unit.DirectInterfaceCompilationUnits.Add(sub_u.SemanticTree, sub_u);
this.unit.InterfaceUsedUnits.AddElement(sub_u.SemanticTree, pcu_file.incl_modules[i]);
}
}
if (need == false) need = pr.need;
}
@ -591,14 +606,14 @@ namespace PascalABCCompiler.PCU
pcu_file.ref_assemblies[i] = br.ReadString();
}
ReadAllAssemblies();
int num_directives = br.ReadInt32();
pcu_file.compiler_directives = new List<compiler_directive>();
for (int i = 0; i < num_directives; i++)
{
pcu_file.compiler_directives.Add(new compiler_directive(br.ReadString(),br.ReadString(),ReadDebugInfo(), pcu_file.SourceFileName));
pcu_file.compiler_directives.Add(new compiler_directive(br.ReadString(),br.ReadString(),ReadDebugInfo(), this.FileName));
}
ReadAllAssemblies();
int num_imp_entity = br.ReadInt32();
ext_pos = (int)br.BaseStream.Position;
pcu_file.imp_entitles = new ImportedEntity[num_imp_entity];
@ -653,6 +668,16 @@ namespace PascalABCCompiler.PCU
//{
string name_with_path = Compiler.GetReferenceFileName(tmp + ".dll");
//Assembly a = Assembly.LoadFrom(name_with_path);
/*if (pcu_file.compiler_directives != null)
foreach (compiler_directive cd in pcu_file.compiler_directives)
{
if (cd.name == "reference" && cd.directive != null && cd.directive.IndexOf("\\") != -1 && cd.directive.IndexOf(tmp + ".dll") != -1)
{
name_with_path = Compiler.GetReferenceFileName(cd.directive);
if (name_with_path == null)
throw new AssemblyNotFound(unit_name, cd.directive, null);
}
}*/
Assembly a = NetHelper.NetHelper.LoadAssembly(name_with_path);
NetHelper.NetHelper.init_namespaces(a);
//}
@ -745,6 +770,8 @@ namespace PascalABCCompiler.PCU
for (int i = 0; i < template_types.Length; i++)
{
Type tt = FindTypeByHandle(pcu_file.dotnet_names[off].addit[i].offset);
if (tt != null && pcu_file.dotnet_names[pcu_file.dotnet_names[off].addit[i].offset].name.IndexOf(".") == -1)
tt = null;//generic parameter
if (tt == null)
{
tt = t.GetGenericArguments()[i];
@ -801,6 +828,8 @@ namespace PascalABCCompiler.PCU
}
if (t1.IsGenericParameter && t2.IsGenericParameter)
return true;
if (t1.FullName == t2.FullName && t1.AssemblyQualifiedName == t2.AssemblyQualifiedName)
return true;
return false;
}
@ -986,47 +1015,17 @@ namespace PascalABCCompiler.PCU
}
//получение импорт. типа
private type_node ReadCommonExtType()
{
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];//вдруг этот модуль уже читается
if (pr == null)//это по моему чёс, так как все модули уже добавлены
{
pr = new PCUReader(this);//если нет, то создаем ридер
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
type_node tn = pr.GetTypeReference(br.ReadInt32());
units[s] = pr;//добавляем в таблицу ридеров
return tn;
}
else
{
type_node tn = pr.GetTypeReference(br.ReadInt32());
return tn;
}
private type_node ReadCommonExtType()
{
var pr = GetPCUReaderForUnitId(br.ReadInt32());
return pr.GetTypeReference(br.ReadInt32());
}
//(ssyy) Получение шаблонного класса
private template_class ReadTemplateExtClass()
{
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];//вдруг этот модуль уже читается
if (pr == null)//это по моему чёс, так как все модули уже добавлены
{
pr = new PCUReader(this);//если нет, то создаем ридер
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
template_class tc = pr.GetTemplateClass(br.ReadInt32());
units[s] = pr;//добавляем в таблицу ридеров
return tc;
}
else
{
template_class tc = pr.GetTemplateClass(br.ReadInt32());
return tc;
}
var pr = GetPCUReaderForUnitId(br.ReadInt32());
return pr.GetTemplateClass(br.ReadInt32());
}
//получение откомпил. типа
@ -1094,68 +1093,28 @@ namespace PascalABCCompiler.PCU
ext_members[offset] = ctn;
br.BaseStream.Seek(tmp,SeekOrigin.Begin);
return ctn;
}
//получение импортируемой функции
private common_namespace_function_node ReadCommonExtNamespaceFunc()
}
//получение импортируемой функции
private common_namespace_function_node ReadCommonExtNamespaceFunc()
{
br.ReadByte();
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
int offset = br.ReadInt32();
common_namespace_function_node cffn = pr.GetNamespaceFunction(offset);
return cffn;
}
else
{
common_namespace_function_node cffn = pr.GetNamespaceFunction(br.ReadInt32());
return cffn;
}
var pr = GetPCUReaderForUnitId(br.ReadInt32());
return pr.GetNamespaceFunction(br.ReadInt32());
}
private namespace_variable ReadExtNamespaceVariable()
{
br.ReadByte();
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
namespace_variable nv = pr.GetNamespaceVariable(br.ReadInt32());
return nv;
}
else
{
namespace_variable nv = pr.GetNamespaceVariable(br.ReadInt32());
return nv;
}
var pr = GetPCUReaderForUnitId(br.ReadInt32());
return pr.GetNamespaceVariable(br.ReadInt32());
}
private namespace_constant_definition ReadExtNamespaceConstant()
{
br.ReadByte();
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
namespace_constant_definition nv = pr.GetConstantDefinition(br.ReadInt32());
return nv;
}
else
{
namespace_constant_definition nv = pr.GetConstantDefinition(br.ReadInt32());
return nv;
}
var pr = GetPCUReaderForUnitId(br.ReadInt32());
return pr.GetConstantDefinition(br.ReadInt32());
}
private common_namespace_event ReadCommonNamespaceExtEvent()
@ -1165,22 +1124,9 @@ namespace PascalABCCompiler.PCU
int tmp = (int)br.BaseStream.Position;
br.BaseStream.Seek(ext_pos + offset, SeekOrigin.Begin);
br.ReadByte();//DS Changed
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
var pr = GetPCUReaderForUnitId(br.ReadInt32());
br.BaseStream.Seek(tmp, SeekOrigin.Begin);
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
common_namespace_event ev = pr.GetNamespaceEventNode(br.ReadInt32());
return ev;
}
else
{
common_namespace_event ev = pr.GetNamespaceEventNode(br.ReadInt32());
return ev;
}
return pr.GetNamespaceEventNode(br.ReadInt32());
}
private common_event ReadCommonExtEvent()
@ -1190,22 +1136,9 @@ namespace PascalABCCompiler.PCU
int tmp = (int)br.BaseStream.Position;
br.BaseStream.Seek(ext_pos + offset, SeekOrigin.Begin);
br.ReadByte();//DS Changed
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
var pr = GetPCUReaderForUnitId(br.ReadInt32());
br.BaseStream.Seek(tmp, SeekOrigin.Begin);
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
common_event ev = pr.GetEventNode(br.ReadInt32());
return ev;
}
else
{
common_event ev = pr.GetEventNode(br.ReadInt32());
return ev;
}
return pr.GetEventNode(br.ReadInt32());
}
private class_field ReadCommonExtField()
@ -1215,22 +1148,9 @@ namespace PascalABCCompiler.PCU
int tmp = (int)br.BaseStream.Position;
br.BaseStream.Seek(ext_pos + offset, SeekOrigin.Begin);
br.ReadByte();//DS Changed
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
var pr = GetPCUReaderForUnitId(br.ReadInt32());
br.BaseStream.Seek(tmp, SeekOrigin.Begin);
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
class_field field = pr.GetClassField(br.ReadInt32());
return field;
}
else
{
class_field field = pr.GetClassField(br.ReadInt32());
return field;
}
return pr.GetClassField(br.ReadInt32());
}
private common_method_node ReadCommonExtMethod()
@ -1240,22 +1160,9 @@ namespace PascalABCCompiler.PCU
int tmp = (int)br.BaseStream.Position;
br.BaseStream.Seek(ext_pos + offset, SeekOrigin.Begin);
br.ReadByte();//DS Changed
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
var pr = GetPCUReaderForUnitId(br.ReadInt32());
br.BaseStream.Seek(tmp, SeekOrigin.Begin);
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
common_method_node meth = pr.GetClassMethod(br.ReadInt32());
return meth;
}
else
{
common_method_node meth = pr.GetClassMethod(br.ReadInt32());
return meth;
}
return pr.GetClassMethod(br.ReadInt32());
}
private common_property_node ReadCommonExtProperty()
@ -1265,22 +1172,9 @@ namespace PascalABCCompiler.PCU
int tmp = (int)br.BaseStream.Position;
br.BaseStream.Seek(ext_pos + offset, SeekOrigin.Begin);
br.ReadByte();//DS Changed
int pos = br.ReadInt32();
string s = GetFullUnitName(pcu_file.incl_modules[pos]);
PCUReader pr = (PCUReader)units[s];
var pr = GetPCUReaderForUnitId(br.ReadInt32());
br.BaseStream.Seek(tmp, SeekOrigin.Begin);
if (pr == null)
{
pr = new PCUReader(this);
CompilationUnit cu = pr.GetCompilationUnit(s, this.readDebugInfo);
common_property_node prop = pr.GetPropertyNode(br.ReadInt32());
return prop;
}
else
{
common_property_node prop = pr.GetPropertyNode(br.ReadInt32());
return prop;
}
return pr.GetPropertyNode(br.ReadInt32());
}
//получение типа, описанного в этом модуле (может вызываться извне)
@ -1400,6 +1294,8 @@ namespace PascalABCCompiler.PCU
return GetGenericParameterOfFunction();
case 11:
return GetGenericParameterOfMethod();
case 12:
return new lambda_any_type_node();
}
return null;
}
@ -2108,8 +2004,8 @@ namespace PascalABCCompiler.PCU
//}
}
private definition_node CreateInterfaceCommonType(string name, int offset)
{
private definition_node CreateInterfaceCommonType(string name, int offset)
{
definition_node dn = null;
if (members.TryGetValue(offset, out dn))
return dn as common_type_node;
@ -2117,7 +2013,7 @@ namespace PascalABCCompiler.PCU
bool is_interface = br.ReadBoolean();
int ind = br.ReadInt32();
if (is_interface)//пропускаем флаг - интерфейсности
{
name = GetString(br.ReadInt32());
@ -2126,10 +2022,12 @@ namespace PascalABCCompiler.PCU
{
name = br.ReadString();
}
//br.ReadInt32();
//br.ReadInt32();
//Читаем, является ли тип интерфейсом
bool type_is_interface = (br.ReadByte() == 1);
bool type_is_class = (br.ReadByte() == 1);
//Читаем, является ли тип делегатом
bool type_is_delegate = (br.ReadByte() == 1);
@ -2165,35 +2063,28 @@ namespace PascalABCCompiler.PCU
ctn.generic_params = type_params;
}
AddMember(ctn, offset);
int_members.Insert(0,ctn);
int_members.Insert(0, ctn);
common_type_node saved_ctn = ctn;
type_node base_type = GetTypeReference();
bool is_value_type = br.ReadBoolean();
//Читаем поддерживаемые интерфейсы
List<SemanticTree.ITypeNode> interf_implemented = ReadImplementingInterfaces();
//int interf_count = br.ReadInt32();
//List<SemanticTree.ITypeNode> interf_implemented = new List<SemanticTree.ITypeNode>(interf_count);
//for (int i = 0; i < interf_count; i++)
//{
// interf_implemented.Add(GetTypeReference());
//}
constant_node low_val=null;
constant_node upper_val=null;
constant_node low_val = null;
constant_node upper_val = null;
SemanticTree.type_access_level tal = (SemanticTree.type_access_level)br.ReadByte();
SemanticTree.type_special_kind tsk = (SemanticTree.type_special_kind)br.ReadByte();
ctn.SetIsSealed(br.ReadBoolean());
ctn.SetIsAbstract(br.ReadBoolean());
ctn.SetIsStatic(br.ReadBoolean());
ctn.IsPartial = br.ReadBoolean();
if (tsk == SemanticTree.type_special_kind.diap_type)
{
low_val = CreateExpression() as constant_node;
upper_val = CreateExpression() as constant_node;
low_val = CreateExpression() as constant_node;
upper_val = CreateExpression() as constant_node;
}
if (type_is_interface)
{
//Добавляем ссылки на области видимости предков интерфейса
@ -2204,17 +2095,19 @@ namespace PascalABCCompiler.PCU
}
iscope.TopInterfaceScopeArray = interf_scopes.ToArray();
}
//ctn = new wrapped_common_type_node(this, base_type, name, tal, cun.namespaces[0], scope, null, offset);
//AddMember(ctn, offset);
//int_members.Insert(0,ctn);
ctn.SetBaseType(base_type);
ctn.IsInterface = type_is_interface;
ctn.IsDelegate = type_is_delegate;
ctn.is_class = type_is_class;
ctn.ImplementingInterfaces.AddRange(interf_implemented);
ctn.internal_is_value = is_value_type;
ctn.type_special_kind = tsk;
if (ctn.full_name == "PABCSystem.BinaryFile")
ctn.type_special_kind = SemanticTree.type_special_kind.binary_file;
if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type)
{
SystemLibrary.SystemLibrary.init_reference_type(ctn);
}
if (type_is_generic_definition)
{
foreach (common_type_node par in type_params)
@ -2223,17 +2116,14 @@ namespace PascalABCCompiler.PCU
ReadTypeParameterEliminations(par);
}
}
type_node elemnet_type = null;
type_node element_type = null;
if (CanReadObject())
elemnet_type = GetTypeReference();
ctn.element_type = elemnet_type;
if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type)
{
SystemLibrary.SystemLibrary.init_reference_type(ctn);
}
element_type = GetTypeReference();
ctn.element_type = element_type;
if (ctn.type_special_kind == SemanticTree.type_special_kind.set_type)
{
ctn = compilation_context.AddTypeToSetTypeList(ctn);
ctn = compilation_context.AddTypeToSetTypeList(ctn);
if (saved_ctn != ctn)
{
RemoveMember(offset, saved_ctn);
@ -2243,7 +2133,7 @@ namespace PascalABCCompiler.PCU
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.typed_file)
{
ctn = compilation_context.AddTypeToTypedFileList(ctn);
ctn = compilation_context.AddTypeToTypedFileList(ctn);
if (saved_ctn != ctn)
{
RemoveMember(offset, saved_ctn);
@ -2253,50 +2143,45 @@ namespace PascalABCCompiler.PCU
}
br.ReadInt32();//comprehensive unit;
ctn.attributes.AddRange(GetAttributes());
//common_namespace_node ns = cun.namespaces[0];
byte flag = br.ReadByte();
int def_prop_off=0;
int def_prop_off = 0;
if (flag == 1)
{
def_prop_off = br.ReadInt32();
}
location loc= ReadDebugInfo();
location loc = ReadDebugInfo();
ctn.loc = loc;
if (type_is_delegate)
{
SystemLibrary.SystemLibrary.type_constructor.AddOperatorsToDelegate(ctn, loc);
}
//создаем scope для класса
//ctn = new wrapped_common_type_node(this, base_type, name, tal, ns, scope, loc, offset);
//members[offset] = ctn;
//AddMember(ctn, offset);
class_names[ctn] = AddClassMemberNames(scope);
if (flag == 1) ctn.default_property = GetPropertyNode(def_prop_off);
if (flag == 1) ctn.default_property = GetPropertyNode(def_prop_off);
//ivan
if (ctn.IsEnum)
if (ctn.IsEnum)
{
AddEnumOperators(ctn);
MakeTypeAsOrdinal(ctn,0,class_names.Count);
ctn.add_additional_enum_operations();
AddEnumOperators(ctn);
MakeTypeAsOrdinal(ctn, 0, class_names.Count);
ctn.add_additional_enum_operations();
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.diap_type)
{
type_constructor.add_convertions_to_diap(ctn,low_val,upper_val);
type_constructor.add_convertions_to_diap(ctn, low_val, upper_val);
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.array_kind)
{
if (!(ctn.element_type is compiled_type_node))
{
type_constructor.make_array_interface(ctn);
}
if (!(ctn.element_type is compiled_type_node))
{
type_constructor.make_array_interface(ctn);
}
}
if (ctn.is_value_type)
{
}
//RestoreAllFields(ctn);
if(!waited_types_to_restore_fields.Contains(ctn))
if (!waited_types_to_restore_fields.Contains(ctn))
waited_types_to_restore_fields.Add(ctn);
if (type_is_delegate)
@ -2309,19 +2194,14 @@ namespace PascalABCCompiler.PCU
dii.parameters.AddRange(invoke_method.parameters);
ctn.add_internal_interface(dii);
}
/*if (ctn.type_special_kind == PascalABCCompiler.SemanticTree.type_special_kind.array_wrapper)
{
bounded_array_interface bai = new bounded_array_interface(oti_indexer, ctn.element_type, cpn, oti_indexer.lower_value.type, int_arr);
ctn.add_internal_interface(bai);
}*/
if (type_is_interface)
{
RestoreAllFields(ctn);
}
if (ctn.is_value)
{
RestoreAllFields(ctn);
RestoreAllFields(ctn);
}
if (ctn.is_generic_type_definition)
{
@ -2334,13 +2214,9 @@ namespace PascalABCCompiler.PCU
}
}
}
/*if (ctn.type_special_kind == SemanticTree.type_special_kind.array_wrapper)
{
RestoreAllFields(ctn);
}*/
return ctn;
}
return ctn;
}
private void MakeTypeAsOrdinal(common_type_node ctn, int low_val, int upper_val)
{
@ -3520,7 +3396,12 @@ namespace PascalABCCompiler.PCU
{
return new question_colon_expression(CreateExpression(), CreateExpression(), CreateExpression(), null);
}
private double_question_colon_expression CreateDoubleQuestionColonExpression()
{
return new double_question_colon_expression(CreateExpression(), CreateExpression(), null);
}
private statements_expression_node CreateStatementsExpressionNode()
{
statement_node_list sl = new statement_node_list();
@ -3569,6 +3450,8 @@ namespace PascalABCCompiler.PCU
return CreateStatementsExpressionNode();
case semantic_node_type.question_colon_expression:
return CreateQuestionColonExpression();
case semantic_node_type.double_question_colon_expression:
return CreateDoubleQuestionColonExpression();
case semantic_node_type.sizeof_operator:
return CreateSizeOfOperator();
case semantic_node_type.is_node:

2
Compiler/PCU/PCUWrappers.cs
View file

@ -383,7 +383,7 @@ namespace PascalABCCompiler.PCU
if (this.base_generic_instance != null && sil != null)
{
var bsil = base_generic_instance.ConvertSymbolInfo(sil);
if (orig_generic_or_null == null)
if (orig_generic_or_null == null && name != "op_Implicit")
return bsil;
}
foreach (SymbolInfo si in sil)

192
Compiler/PCU/PCUWriter.cs
View file

@ -99,7 +99,8 @@ namespace PascalABCCompiler.PCU
ShortString = 8,
GenericParameterOfType = 9,
GenericParameterOfFunction = 10,
GenericParameterOfMethod = 11
GenericParameterOfMethod = 11,
LambdaAnyType = 12
}
public enum GenericParamKind
@ -876,14 +877,19 @@ namespace PascalABCCompiler.PCU
if (tn is common_type_node)
{
common_namespace_node comp_cnn = (tn as common_type_node).comprehensive_namespace;
if (comp_cnn != null && !ns_dict.ContainsKey(comp_cnn))
if (comp_cnn != null && !ns_dict.ContainsKey(comp_cnn) && unit.SemanticTree != comp_cnn.cont_unit)
{
var path = Compiler.GetUnitPath(unit, compiler.UnitsSortedList.Find(u => u.SemanticTree == comp_cnn.cont_unit));
if (interf)
unit.InterfaceUsedUnits.AddElement(comp_cnn.cont_unit);
unit.InterfaceUsedUnits.AddElement(comp_cnn.cont_unit, path);
else
unit.ImplementationUsedUnits.AddElement(comp_cnn.cont_unit);
unit.ImplementationUsedUnits.AddElement(comp_cnn.cont_unit, path);
ns_dict[comp_cnn] = true;
}
if (tn.base_type is common_type_node)
AddIndirectUsedUnitsForType(tn.base_type, ns_dict, interf);
}
}
@ -901,6 +907,25 @@ namespace PascalABCCompiler.PCU
foreach (statement_node st in stmt_list.statements)
AddIndirectUsedUnitsInStatement(st, ns_dict, interf);
}
/*else if (stmt is common_static_method_call)
{
common_static_method_call csmc = stmt as common_static_method_call;
AddIndirectUsedUnitsForType(csmc.common_type, ns_dict, interf);
}
else if (stmt is if_node)
{
if_node node = stmt as if_node;
AddIndirectUsedUnitsInStatement(node.condition, ns_dict, interf);
}
if (stmt is base_function_call)
{
base_function_call bfc = stmt as base_function_call;
foreach (var expr in bfc.parameters)
{
AddIndirectUsedUnitsInStatement(expr, ns_dict, interf);
}
}*/
}
@ -932,6 +957,8 @@ namespace PascalABCCompiler.PCU
common_namespace_node cnn = cun.namespaces[0];
foreach (common_type_node ctn in cnn.types)
{
if (ctn.base_type != null)
AddIndirectUsedUnitsForType(ctn.base_type, interf_ns_dict, true);
foreach (common_method_node cmn in ctn.methods)
{
if (cmn.is_constructor && cmn.function_code != null && cmn.function_code.location == null)
@ -980,6 +1007,8 @@ namespace PascalABCCompiler.PCU
common_namespace_node cnn = cun.namespaces[1];
foreach (common_type_node ctn in cnn.types)
{
if (ctn.base_type != null)
AddIndirectUsedUnitsForType(ctn.base_type, impl_ns_dict, true);
foreach (common_method_node cmn in ctn.methods)
{
if (cmn.is_constructor && cmn.function_code != null && cmn.function_code.location == null)
@ -1018,11 +1047,14 @@ namespace PascalABCCompiler.PCU
var incl_modules = new List<string>(c1 + c2);
foreach (var used_unit in unit.InterfaceUsedUnits.OfType<common_unit_node>())
{
// каждый модуль, зачем то, подключён сам к себе
// конечно, записи в unit_uses_paths для такого подключения - нет
{
// Каждый модуль, зачем то, подключён сам к себе
// Конечно, записи в unit_uses_paths для такого подключения - нет
if (unit.SemanticTree == used_unit) continue;
// AddIndirectInteraceUsedUnits может добавлять один и тот же модуль несколько раз
if (used_units.ContainsKey(used_unit)) continue;
// раньше вместо пути модуля - брало имя его первого пространства имён
// и сразу стояла эта проверка. Если будет тут вылетать - наверное надо заменить throw на continue
if (used_unit.namespaces.Count == 0) throw new InvalidOperationException();
@ -1034,15 +1066,17 @@ namespace PascalABCCompiler.PCU
foreach (var used_unit in unit.ImplementationUsedUnits.OfType<common_unit_node>())
{
if (unit.SemanticTree == used_unit) continue;
if (used_units.ContainsKey(used_unit)) continue; //AddIndirectImplementationUsedUnits может добавить модуль из uses из interface
if (used_units.ContainsKey(used_unit)) continue;
if (used_unit.namespaces.Count == 0) throw new InvalidOperationException();
this.used_units.Add(used_unit, used_units.Count);
incl_modules.Add(unit.ImplementationUsedUnits.unit_uses_paths[used_unit]);
}
pcu_file.incl_modules = incl_modules.ToArray();
used_units.Add(unit.SemanticTree as common_unit_node, -1);
pcu_file.incl_modules = incl_modules.ToArray();
pcu_file.used_namespaces = cun.used_namespaces.ToArray();
}
@ -1381,6 +1415,12 @@ namespace PascalABCCompiler.PCU
WriteTemplateInstance(c_t_n);
return;
}
if (type is lambda_any_type_node)
{
bw.Write((byte)TypeKind.LambdaAnyType);
return;
}
byte is_def = 0;
int offset = GetTypeReference(type, ref is_def);
@ -2459,23 +2499,19 @@ namespace PascalABCCompiler.PCU
return sizeof(byte) + sizeof(int);
}
private void VisitTypeDefinition(common_type_node type)
{
private void VisitTypeDefinition(common_type_node type)
{
int offset = 0;
if (is_interface == true) offset = SavePositionAndConstPool(type);
else offset = SavePositionAndImplementationPool(type);
bw.Write((byte)type.semantic_node_type);
bw.Write(is_interface);
else offset = SavePositionAndImplementationPool(type);
bw.Write((byte)type.semantic_node_type);
bw.Write(is_interface);
bw.Write(type_entity_index++);
if (is_interface == true)
bw.Write(GetNameIndex(type));
else
bw.Write(type.name);
/*if (type.base_type != null)
WriteTypeReference(type.base_type);
else*/
if (is_interface == true)
bw.Write(GetNameIndex(type));
else
bw.Write(type.name);
//Пишем, является ли данный класс интерфейсом
if (type.IsInterface)
{
bw.Write((byte)1);
@ -2485,7 +2521,15 @@ namespace PascalABCCompiler.PCU
bw.Write((byte)0);
}
//Пишем, является ли данный класс делегатом
if (type.is_class)
{
bw.Write((byte)1);
}
else
{
bw.Write((byte)0);
}
if (type.IsDelegate)
{
bw.Write((byte)1);
@ -2494,7 +2538,7 @@ namespace PascalABCCompiler.PCU
{
bw.Write((byte)0);
}
//Является ли тип описанием дженерика
if (type.is_generic_type_definition)
{
@ -2515,10 +2559,7 @@ namespace PascalABCCompiler.PCU
int base_class_off = (int)bw.BaseStream.Position;
bw.Seek(GetSizeOfReference(type.base_type), SeekOrigin.Current);
//(ssyy) На кой чёрт это надо?
//WriteTypeReference(SystemLibrary.SystemLibrary.object_type);
//WriteTypeReference(type.base_type);
bw.Write(type.internal_is_value);
//Пишем поддерживаемые интерфейсы
@ -2526,8 +2567,8 @@ namespace PascalABCCompiler.PCU
//WriteImplementingInterfaces(type);
int interface_impl_off = (int)bw.BaseStream.Position;
int seek_off = sizeof(int);
for (int k=0; k<type.ImplementingInterfaces.Count; k++)
seek_off += GetSizeOfReference(type.ImplementingInterfaces[k] as TreeRealization.type_node);
for (int k = 0; k < type.ImplementingInterfaces.Count; k++)
seek_off += GetSizeOfReference(type.ImplementingInterfaces[k] as TreeRealization.type_node);
bw.Seek(seek_off, SeekOrigin.Current);
bw.Write((byte)type.type_access_level);
bw.Write((byte)type.type_special_kind);
@ -2535,11 +2576,12 @@ namespace PascalABCCompiler.PCU
bw.Write(type.IsAbstract);
bw.Write(type.IsStatic);
bw.Write(type.IsPartial);
if (type.type_special_kind == SemanticTree.type_special_kind.diap_type)
{
ordinal_type_interface oti = type.get_internal_interface(internal_interface_kind.ordinal_interface) as ordinal_type_interface;
VisitExpression(oti.lower_value);
VisitExpression(oti.upper_value);
ordinal_type_interface oti = type.get_internal_interface(internal_interface_kind.ordinal_interface) as ordinal_type_interface;
VisitExpression(oti.lower_value);
VisitExpression(oti.upper_value);
}
if (type.is_generic_type_definition)
@ -2547,52 +2589,52 @@ namespace PascalABCCompiler.PCU
//Ограничители параметров
WriteTypeParamsEliminations(type.generic_params);
}
if(CanWriteObject(type.element_type))
if (CanWriteObject(type.element_type))
WriteTypeReference(type.element_type);
bw.Write(GetUnitReference(type.comprehensive_namespace));
SaveOffsetForAttribute(type);
bw.Write(GetUnitReference(type.comprehensive_namespace));
SaveOffsetForAttribute(type);
bw.Write(0);//attributes;
if (type.default_property != null)
if (type.default_property != null)
bw.Write((byte)1);
else
else
bw.Write((byte)0);
int def_prop_off = (int)bw.BaseStream.Position;
if (type.default_property != null)
bw.Write(0);//default_property
WriteDebugInfo(type.loc);
//заполнение списка имен членов этого класса
int num = type.const_defs.Count + type.fields.Count + type.properties.Count + type.methods.Count+type.events.Count;
NameRef[] names = new NameRef[num];
int pos = (int)bw.BaseStream.Position;
//заполнение списка имен членов этого класса
int num = type.const_defs.Count + type.fields.Count + type.properties.Count + type.methods.Count + type.events.Count;
NameRef[] names = new NameRef[num];
int pos = (int)bw.BaseStream.Position;
int int_size = System.Runtime.InteropServices.Marshal.SizeOf(typeof(int));
int size = int_size;
int i=0,j=0;
for (i=j; i<type.const_defs.Count+j; i++)
{
int i = 0, j = 0;
for (i = j; i < type.const_defs.Count + j; i++)
{
names[i] = new NameRef(type.const_defs[i - j].name, i);
name_pool[type.const_defs[i - j]] = names[i];
size += names[i].Size;
}
j=i;
for (i=j; i<type.fields.Count+j; i++)
{
}
j = i;
for (i = j; i < type.fields.Count + j; i++)
{
names[i] = new NameRef(type.fields[i - j].name, i, convert_field_access_level(type.fields[i - j].field_access_level), type.fields[i - j].semantic_node_type);
name_pool[type.fields[i - j]] = names[i];
names[i].is_static = type.fields[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_static;
size += names[i].Size;
}
j=i;
for (i=j; i<type.properties.Count+j; i++)
{
}
j = i;
for (i = j; i < type.properties.Count + j; i++)
{
names[i] = new NameRef(type.properties[i - j].name, i, convert_field_access_level(type.properties[i - j].field_access_level), type.properties[i - j].semantic_node_type);
name_pool[type.properties[i - j]] = names[i];
names[i].is_static = type.properties[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_static;
size += names[i].Size;
}
j=i;
for (i=j; i<type.methods.Count+j; i++)
{
}
j = i;
for (i = j; i < type.methods.Count + j; i++)
{
names[i] = new NameRef(type.methods[i - j].name, i, convert_field_access_level(type.methods[i - j].field_access_level), type.methods[i - j].semantic_node_type);
name_pool[type.methods[i - j]] = names[i];
if (type.methods[i - j].is_overload)
@ -2600,16 +2642,16 @@ namespace PascalABCCompiler.PCU
names[i].virtual_slot = type.methods[i - j].newslot_awaited || type.methods[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_virtual || type.methods[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_virtual_abstract || type.methods[i - j].is_constructor;
names[i].is_static = type.methods[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_static && !type.methods[i - j].is_constructor;
size += names[i].Size;
}
j=i;
for (i=j; i<type.events.Count+j; i++)
{
}
j = i;
for (i = j; i < type.events.Count + j; i++)
{
names[i] = new NameRef(type.events[i - j].name, i, convert_field_access_level(type.events[i - j].field_access_level), type.events[i - j].semantic_node_type);
name_pool[type.events[i - j]] = names[i];
size += names[i].Size;
}
bw.BaseStream.Seek(size,SeekOrigin.Current);
/*VisitConstantInTypeDefinitions(type);
}
bw.BaseStream.Seek(size, SeekOrigin.Current);
/*VisitConstantInTypeDefinitions(type);
VisitFieldDefinitions(type);
VisitMethodDefinitions(type);
VisitPropertyDefinitions(type);
@ -2628,9 +2670,9 @@ namespace PascalABCCompiler.PCU
bw.Write(names[i].offset);
}
bw.BaseStream.Seek(tmp,SeekOrigin.Begin);*/
ClassInfo ci = new ClassInfo(pos, def_prop_off, base_class_off, interface_impl_off,names);
ClassInfo ci = new ClassInfo(pos, def_prop_off, base_class_off, interface_impl_off, names);
class_info[type] = ci;
}
}
//ssyy
private void VisitLabelDeclaration(label_node ln)
@ -2958,7 +3000,7 @@ namespace PascalABCCompiler.PCU
bw.Write((byte)meth.polymorphic_state);
bw.Write(meth.num_of_default_variables);
bw.Write(meth.num_of_for_cycles);
bw.Write(meth.overrided_method != null && meth.name.IndexOf('.') != -1);
bw.Write(meth.overrided_method != null);
//ssyy-
//if (meth.pascal_associated_constructor != null)
@ -3173,7 +3215,7 @@ namespace PascalABCCompiler.PCU
{
VisitStatement(meth.function_code);
}
if (meth.overrided_method != null && meth.name.IndexOf('.') != -1)
if (meth.overrided_method != null)
WriteMethodReference(meth.overrided_method);
//}
}
@ -3588,7 +3630,13 @@ namespace PascalABCCompiler.PCU
VisitExpression(node.internal_ret_if_true);
VisitExpression(node.internal_ret_if_false);
}
private void VisitDoubleQuestionColonExpression(double_question_colon_expression node)
{
VisitExpression(node.internal_condition);
VisitExpression(node.internal_ret_if_null);
}
private void VisitStatementsExpressionNode(statements_expression_node node)
{
bw.Write(node.internal_statements.Count);
@ -3631,6 +3679,8 @@ namespace PascalABCCompiler.PCU
VisitStatementsExpressionNode((statements_expression_node)en); break;
case semantic_node_type.question_colon_expression:
VisitQuestionColonExpression((question_colon_expression)en); break;
case semantic_node_type.double_question_colon_expression:
VisitDoubleQuestionColonExpression((double_question_colon_expression)en); break;
case semantic_node_type.sizeof_operator:
VisitSizeOfOperator((sizeof_operator)en); break;
case semantic_node_type.is_node:

16
Compiler/RemoteCompiler.cs
View file

@ -128,6 +128,9 @@ namespace PascalABCCompiler
}
switch (command)
{
case ConsoleCompilerConstants.PABCHealth:
pABCCodeHealth = Convert.ToInt32(arg);
break;
case ConsoleCompilerConstants.LinesCompiled:
linesCompiled = Convert.ToUInt32(arg);
break;
@ -241,6 +244,10 @@ namespace PascalABCCompiler
}
}
// SSM 18/09/20
int pABCCodeHealth = 0;
public int PABCCodeHealth { get { return pABCCodeHealth; } }
CompilerInternalDebug internalDebug=new CompilerInternalDebug();
public CompilerInternalDebug InternalDebug
{
@ -363,6 +370,8 @@ namespace PascalABCCompiler
//sendCommand(ConsoleCompilerConstants.CompilerOptionsOutputDirectory, dir_name);
sendObjectAsByteArray(ConsoleCompilerConstants.CompilerOptionsOutputDirectory, compilerOptions.OutputDirectory);
sendCommand(ConsoleCompilerConstants.CompilerOptionsClearStandartModules);
if (compilerOptions.Locale != null)
sendCommand(ConsoleCompilerConstants.CompilerLocale, compilerOptions.Locale);
foreach (PascalABCCompiler.CompilerOptions.StandartModule sm in compilerOptions.StandartModules)
sendCommand(
ConsoleCompilerConstants.CompilerOptionsStandartModule,
@ -452,12 +461,6 @@ namespace PascalABCCompiler
}
}
public SupportedSourceFile[] SupportedSourceFiles
{
get
@ -527,6 +530,7 @@ namespace PascalABCCompiler
bool compilerReloading = true;
public void Reload()
{
pABCCodeHealth = 0;
compilerReloading = true;
stopCompiler();
pabcnetcProcess = new Process();

1
CompilerTools/CompilerTools.csproj
View file

@ -42,6 +42,7 @@
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
<UseVSHostingProcess>true</UseVSHostingProcess>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>

2
CompilerTools/Properties/AssemblyInfo.cs
View file

@ -9,7 +9,7 @@ using System.Runtime.InteropServices;
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("Localization")]
[assembly: AssemblyCopyright("Copyright © 2005-2020 by Ivan Bondarev, Stanislav Mikhalkovich")]
[assembly: AssemblyCopyright("Copyright © 2005-2021 by Ivan Bondarev, Stanislav Mikhalkovich")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]

8
Configuration/GlobalAssemblyInfo.cs
View file

@ -5,7 +5,7 @@ using System.Runtime.CompilerServices;
[assembly: AssemblyDelaySign(false)]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("PascalABC.NET Compiler")]
[assembly: AssemblyCopyright("Copyright © 2005-2019 by Ivan Bondarev, Stanislav Mihalkovich")]
[assembly: AssemblyCopyright("Copyright © 2005-2021 by Ivan Bondarev, Stanislav Mihalkovich")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
[assembly: AssemblyVersion(RevisionClass.FullVersion)]
@ -13,9 +13,9 @@ using System.Runtime.CompilerServices;
internal static class RevisionClass
{
public const string Major = "3";
public const string Minor = "6";
public const string Build = "3";
public const string Revision = "2564";
public const string Minor = "7";
public const string Build = "2";
public const string Revision = "2806";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

2
Configuration/GlobalAssemblyInfo.cs.tmpl
View file

@ -5,7 +5,7 @@ using System.Runtime.CompilerServices;
[assembly: AssemblyDelaySign(false)]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("PascalABC.NET Compiler")]
[assembly: AssemblyCopyright("Copyright © 2005-2019 by Ivan Bondarev, Stanislav Mihalkovich")]
[assembly: AssemblyCopyright("Copyright © 2005-2021 by Ivan Bondarev, Stanislav Mihalkovich")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
[assembly: AssemblyVersion(RevisionClass.FullVersion)]

6
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=3
%REVISION%=2564
%MINOR%=6
%COREVERSION%=2
%REVISION%=2806
%MINOR%=7
%MAJOR%=3

4
Debugger.Core/Src/Variables/Types/DebugType-Helpers.cs
View file

@ -61,8 +61,8 @@ namespace Debugger
case CorElementType.U8: return typeof(System.UInt64);
case CorElementType.R4: return typeof(System.Single);
case CorElementType.R8: return typeof(System.Double);
case CorElementType.I: return typeof(int);
case CorElementType.U: return typeof(uint);
case CorElementType.I: return typeof(IntPtr);
case CorElementType.U: return typeof(UIntPtr);//return System.Environment.Is64BitProcess?typeof(ulong):typeof(uint);
case CorElementType.SZARRAY:
case CorElementType.ARRAY: return typeof(System.Array);
case CorElementType.OBJECT: return typeof(System.Object);

2
Errors/Errors.cs
View file

@ -224,7 +224,7 @@ namespace PascalABCCompiler.Errors
}
public override string ToString()
{
return String.Format(StringResources.Get("COMPILER_INTERNAL_ERROR_IN_UNIT_{0}_:{1}"), Module, Message);
return String.Format(StringResources.Get("COMPILER_INTERNAL_ERROR_IN_UNIT_{0}_:{1}"), Module, Message+' '+ exception.ToString());
}
}

1
Errors/Errors.csproj
View file

@ -42,6 +42,7 @@
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
<UseVSHostingProcess>true</UseVSHostingProcess>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>

1
InstallerSamples/!MainFeatures/04_Units/NativeDll/CallNative.pas
View file

@ -1,3 +1,4 @@
{$platformtarget x86}
// Вызов функции из обычной dll
function add(a,b: integer): integer; external 'NativeDll.dll' name 'add'; // объявление внешней функции

6
InstallerSamples/Algorithms/Combinatorics/NextPerm.pas Normal file
View file

@ -0,0 +1,6 @@
begin
var a := Arr(1..4);
repeat
a.Println;
until not NextPermutation(a);
end.

16
InstallerSamples/Algorithms/Eratosthenes.pas
View file

@ -1,26 +1,24 @@
// "Решето Эратосфена" - вычисление простых чисел
const n = 100000;
var primes: set of integer;
begin
primes := [2..n];
var primes := HSet(2..n);
for var i:=2 to round(sqrt(n)) do
for var i:=2 to Round(Sqrt(n)) do
begin
if not (i in primes) then
continue;
var x := i*i;
while x<=n do
begin
Exclude(primes,x);
primes -= x;
x += i;
end;
end;
writeln('Простые числа < ',n,':');
writeln(primes);
writeln;
writeln('Время вычисления: ',Milliseconds/1000);
Writeln('Простые числа < ',n,':');
Writeln(primes);
Writeln;
Writeln('Время вычисления: ',Milliseconds/1000);
end.

2
InstallerSamples/Algorithms/FloodFillTuple.pas
View file

@ -47,7 +47,7 @@ begin
for var x := 0 to dimx-1 do
begin
var c := f.ReadChar;
a[y,x]:= c='*' ? 1 : 0;
a[y,x]:= if c='*' then 1 else 0;
end;
f.Readln
end;

14
InstallerSamples/Algorithms/SortArrays/QuickSortFunctional.pas Normal file
View file

@ -0,0 +1,14 @@
// Быстрая сортировка Ч. Хоара
// Неэффективный код, иллюстрирующий суть алгоритма
function QS(a: array of integer): array of integer :=
if a.Length < 2 then
a
else
QS(a[1:].FindAll(y->y<=a[0])) + a[:1] + QS(a[1:].FindAll(y->y>a[0]));
begin
var a := ArrRandom(20);
a.Println;
var b := QS(a);
b.Println;
end.

4
InstallerSamples/Algorithms/Sqrt2.pas Normal file
View file

@ -0,0 +1,4 @@
##
var x := 2.0;
SeqGen(6,x,a → (a + x/a) / 2).Last.Println;
x.Sqrt.Print;

61
InstallerSamples/Games/PifTableExam.pas Normal file
View file

@ -0,0 +1,61 @@
uses GraphWPF,Controls,Sounds;
var x, y: integer;
procedure NextQuestion;
begin
Window.Clear;
(x, y) := Random2(2, 9);
DrawText(GraphWindow.ClientRect,$'{x} × {y} = ?');
end;
function Оценка(ВерныхОтветов: integer): integer;
begin
case ВерныхОтветов of
10, 9: Оценка := 5;
8, 7: Оценка := 4;
4..6: Оценка := 3;
else Оценка := 2;
end;
end;
begin
Window.Title := 'Проверка таблицы умножения';
Font.Size := 40;
var l := LeftPanel(200);
l.FontSize := 16;
var sb := StatusBar;
NextQuestion;
var Результат := IntegerBox('Введите ответ:',0,100);
var b := Button('Ответить');
var КоличествоОтветов := IntegerBlock('Ответов:');
var ВерныхОтветов := IntegerBlock('Верных ответов:');
b.Click := procedure → begin
if x * y = Результат then
begin
sb.Text := 'Верно!';
ВерныхОтветов += 1;
end
else
begin
sb.Text := 'Неверно :(';
end;
КоличествоОтветов += 1;
Результат := 0;
if КоличествоОтветов = 10 then // Конец опроса
begin
MessageBox.Show('Тест окончен.'#10#10'Верных ответов: ' +
ВерныхОтветов.Value + #10#10 + 'Оценка: ' + Оценка(ВерныхОтветов));
// Переход к следующему тесту
ВерныхОтветов := 0;
КоличествоОтветов := 0;
end;
NextQuestion;
end;
OnResize := procedure → begin
Window.Clear;
DrawText(GraphWindow.ClientRect,$'{x} × {y} = ?');
end;
end.

63
InstallerSamples/Games/PifTableExam1.pas Normal file
View file

@ -0,0 +1,63 @@
uses GraphWPF,Controls,Sounds;
function Оценка(ВерныхОтветов: integer): integer;
begin
case ВерныхОтветов of
10, 9: Оценка := 5;
8, 7: Оценка := 4;
4..6: Оценка := 3;
else Оценка := 2;
end;
end;
begin
Window.Title := 'Проверка таблицы умножения';
Font.Size := 60;
var l := LeftPanel(200);
l.FontSize := 16;
var sb := StatusBar;
var Результат := IntegerBox('Введите ответ:',0,100);
var b := Button('Ответить');
var КоличествоОтветов := IntegerBlock('Ответов:');
var ВерныхОтветов := IntegerBlock('Верных ответов:');
var ТестОкончен := procedure → begin
MessageBox.Show('Тест окончен.'+#10#10+'Верных ответов: ' +
ВерныхОтветов.Value + #10#10 + 'Оценка: ' + Оценка(ВерныхОтветов));
// Переход к следующему тесту
ВерныхОтветов := 0;
КоличествоОтветов := 0;
end;
var x, y: integer; // сомножители
var НарисоватьТест := procedure → begin
Window.Clear;
DrawText(GraphWindow.ClientRect,$'{x} × {y} = ?');
end;
var СледующийВопрос := procedure → begin
(x, y) := Random2(2, 9);
НарисоватьТест;
end;
СледующийВопрос;
b.Click := procedure → begin
if x * y = Результат then
begin
sb.Text := 'Верно!';
ВерныхОтветов += 1;
end
else
begin
sb.Text := 'Неверно :(';
end;
КоличествоОтветов += 1;
Результат := 0;
if КоличествоОтветов = 10 then // Конец опроса
ТестОкончен;
СледующийВопрос;
end;
OnResize := НарисоватьТест;
end.

3
InstallerSamples/Graph3D/All3DPrimitives.pas
View file

@ -3,9 +3,6 @@ uses Graph3D;
begin
Window.Title := '3D-ďđčěčňčâű';
//var a := Any(0,0,0,Colors.Red);
//a.MoveOn(-5,2,0);
var rr := Rectangle3D(-3.5,-2,0,3,2,Colors.MediumPurple);
rr.Rotate(v3d(0,1,0),30);

4
InstallerSamples/Graph3D/Chess3D/game2.pas
View file

@ -49,7 +49,7 @@ begin
a[yy,xx] := Self;
var dx := xx - x;
var dy := yy - y;
f.MoveOn(-dx*2,-dy*2,0);
f.MoveBy(-dx*2,-dy*2,0);
(x,y) := (xx,yy);
Result := Self;
end;
@ -58,7 +58,7 @@ function ChessFigure.AnimMoveTo(xx,yy: integer): ChessFigure;
begin
var dx := xx - x;
var dy := yy - y;
f.AnimMoveOn(-dx*2,-dy*2,0,delay/1000).WhenCompleted(procedure -> begin
f.AnimMoveBy(-dx*2,-dy*2,0,delay/1000).WhenCompleted(procedure -> begin
a[y,x] := nil;
if a[yy,xx]<>nil then
a[yy,xx].Destroy;

15
InstallerSamples/Graph3D/ReGroup1.pas
View file

@ -1,5 +1,5 @@
uses Graph3D;
// îøèáêà!
uses Graph3D;
// ошибка!
begin
var b := Box(0,0,0,3,1,2,Colors.Blue);
var s := Sphere(0,0,2,1,Colors.Green);
@ -8,12 +8,7 @@ begin
var g := Group(b,s);
var g1 := Group(b1,s1);
g1.MoveOnY(3);
g.Add(g1[0]);// îí äîëæåí îòñîåäèíèòüñÿ îò g!
b1.MoveOnY(3);
{Print(g.l.Count);
Print(g1.l.Count);
Print(g[2].Position);}
//b1.MoveOnZ(3);
g1.MoveByY(3);
g.AddChild(g1[0]);// он должен отсоединиться от g!
b1.MoveByY(3);
end.

2
InstallerSamples/Graph3D/Анимация/Декораторы Анимаций/AnimAccelerationRatio1.pas
View file

@ -2,7 +2,7 @@
begin
var ss := Cube(0,0,0,1.5,Colors.Red);
var anim := ss.AnimMoveOnX(10).AutoReverse.Forever.AccelerationRatio(0.5,0.5);
var anim := ss.AnimMoveByX(10).AutoReverse.Forever.AccelerationRatio(0.5,0.5);
//var anim := ss.AnimScale(3).Forever.AutoReverse;
//var anim := ss.AnimRotate(OrtZ,360).Forever.AutoReverse;
//var anim := ss.AnimRotateAt(OrtZ,360,P3D(3,0,0),2).Forever;

2
InstallerSamples/Graph3D/Анимация/Декораторы Анимаций/ProbaGroup3.pas
View file

@ -2,6 +2,6 @@
begin
var bb := ArrGen(15,i -> Object3D(Box(0.5*i,0,0,0.1,6,2,RandomColor)));
var g := Group(bb).MoveOnX(-5);
var g := Group(bb).MoveByX(-5);
g.AnimRotateAt(ortZ,360,P3D(-1,0,0),2).Forever.Begin;
end.

4
InstallerSamples/Graph3D/Анимация/Простая Анимация/animSequence.pas
View file

@ -3,8 +3,8 @@ uses Graph3D;
begin
var s := Box(0,0,0,3,1,2,Colors.Blue);
var an := Animate.Sequence(
s.AnimMoveOnY(5),
s.AnimMoveOnX(5)
s.AnimMoveByY(5),
s.AnimMoveByX(5)
);
an.Begin;
end.

2
InstallerSamples/Graph3D/Анимация/Составные Анимации/AnimJump.pas
View file

@ -4,6 +4,6 @@ begin
var jmp := 0.3;
var time := 0.5;
var c := Box(0,0,2,1,2,4,Colors.Green);
var a := c.AnimMoveOnZ(-0.4,time).AutoReverse.Forever * c.AnimScaleZ(0.95,time).AutoReverse.Forever * c.AnimMoveOnX(1*10,time*10);
var a := c.AnimMoveByZ(-0.4,time).AutoReverse.Forever * c.AnimScaleZ(0.95,time).AutoReverse.Forever * c.AnimMoveByX(1*10,time*10);
a.Begin;
end.

2
InstallerSamples/Graph3D/Анимация/Составные Анимации/PlanetsRotate.pas
View file

@ -11,7 +11,7 @@ begin
var ss := Sphere(0,0,0,1,Colors.Blue);
Sphere(0,0,0,2,DiffuseMaterial(Colors.Yellow)+SpecularMaterial(32));
var g := Group(s,ss);
g.MoveOn(-7,0,0);
g.MoveBy(-7,0,0);
var anim := s.AnimRotateAt(OrtZ,360*100,P3D(-2,0,0),2*100)
* g.AnimRotateAt(OrtZ,360*100,P3D(7,0,0),10*100)
;

6
InstallerSamples/Graph3D/Анимация/Составные Анимации/ThenAnimMove.pas
View file

@ -1,9 +1,9 @@
uses Graph3D;
uses Graph3D;
begin
var s := Sphere(Origin,1,Colors.Green);
s.AnimMoveOnX(5).WhenCompleted(procedure->s.AnimMoveOnY(5).Begin).Begin;
s.AnimMoveByX(5).WhenCompleted(procedure->s.AnimMoveByY(5).Begin).Begin;
var s1 := s.Clone;
s1.Color := Colors.Blue;
s1.AnimMoveOnX(-5).WhenCompleted(procedure->s1.AnimMoveOnY(-5).Begin).Begin;
s1.AnimMoveByX(-5).WhenCompleted(procedure->s1.AnimMoveByY(-5).Begin).Begin;
end.

8
InstallerSamples/Graph3D/Группировка/GroupGroup.pas
View file

@ -1,13 +1,13 @@
uses Graph3D;
uses Graph3D;
begin
var b := Box(0,0,0,3,1,2,Colors.Blue);
var s := Sphere(0,0,2,1,Colors.Green);
var g := Group(b,s);
g.MoveOnY(-4);
g.MoveByY(-4);
var g1 := g.Clone;
g.MoveOnY(3);
g.MoveByY(3);
var gg := Group(g,g1);
gg.MoveOnX(3);
gg.MoveByX(3);
end.

4
InstallerSamples/Graph3D/Группировка/ReGroup2.pas
View file

@ -10,7 +10,7 @@ begin
var g1 := Group(b1,s1);
g.AddChild(g1[0]);// он должен отсоединиться от g!
Sleep(1000);
g.MoveOnX(3);
g.MoveByX(3);
Sleep(1000);
g1.MoveOnY(4);
g1.MoveByY(4);
end.

2
InstallerSamples/Graph3D/Клонирование/CloneAnim.pas
View file

@ -4,6 +4,6 @@ uses Graph3D;
begin
var b := Box(0,0,1,1,3,2,RandomColor);
var b1 := b.Clone;
b1.MoveOn(3,0,0);
b1.MoveBy(3,0,0);
b1.AnimRotate(OrtZ,90).Begin;
end.

4
InstallerSamples/Graph3D/Клонирование/CloneWithChildren.pas
View file

@ -7,9 +7,9 @@ begin
s.AddChild(c);
c.AddChild(p);
var s1 := s.Clone;
s1.MoveOnX(2);
s1.MoveByX(2);
var g := Group(s,s1);
var g1 := g.Clone;
g.MoveOnY(-4);
g.MoveByY(-4);
s1.AnimRotateAt(OrtZ,360,P3D(-2,0,0)).Begin;
end.

4
InstallerSamples/Graph3D/Клонирование/MovRot.pas
View file

@ -2,8 +2,8 @@
begin
var b := Box(0,0,0,3,1,2,Colors.Blue);
var b1 := b.Clone.RotateAt(OrtZ,90,P3D(1.5,0,0)).MoveOnX(-0.5);
b1 := b.Clone.RotateAt(OrtZ,-90,P3D(-1.5,0,0)).MoveOnX(0.5);
var b1 := b.Clone.RotateAt(OrtZ,90,P3D(1.5,0,0)).MoveByX(-0.5);
b1 := b.Clone.RotateAt(OrtZ,-90,P3D(-1.5,0,0)).MoveByX(0.5);
View3D.BackgroundColor := Colors.Black;
View3D.ShowGridLines := False;
end.

2
InstallerSamples/Graph3D/Проволочные Модели/WireFramePrism.pas
View file

@ -13,6 +13,6 @@ begin
Inc(m);
end;
var p1 := p.Clone;
p1.MoveOnX(-5);
p1.MoveByX(-5);
p1.AnimRotate(OrtZ,360,10).Forever.Begin;
end.

2
InstallerSamples/Graph3D/Производительность/Spheres.pas
View file

@ -17,7 +17,7 @@ begin
//end);
foreach var x in l do
x.AnimMoveOn(Random,Random,Random).AutoReverse.Forever.Begin;
x.AnimMoveBy(Random,Random,Random).AutoReverse.Forever.Begin;
//Print(Milliseconds);
end.

8
InstallerSamples/Graph3D/События клавиатуры/Key1.pas
View file

@ -5,10 +5,10 @@ begin
var s := Box(0,0,0,3,1,2,Colors.Blue);
OnKeyDown := k ->
case k of
Key.Left: s.MoveOn(1,0,0);
Key.Right: s.MoveOn(-1,0,0);
Key.Up: s.MoveOn(0,-1,0);
Key.Down: s.MoveOn(0,1,0);
Key.Left: s.MoveBy(1,0,0);
Key.Right: s.MoveBy(-1,0,0);
Key.Up: s.MoveBy(0,-1,0);
Key.Down: s.MoveBy(0,1,0);
Key.X: s.Rotate(OrtX,10);
Key.Y: s.Rotate(OrtY,10);
Key.Z: s.Rotate(OrtZ,10);

10
InstallerSamples/Graph3D/Фигуры/Замок.pas
View file

@ -6,7 +6,7 @@ begin
loop N-1 do
begin
c := c.Clone;
c.MoveOnX(-1.5);
c.MoveByX(-1.5);
if c is ObjectWithMaterial3D then
(c as ObjectWithMaterial3D).Color := RandomColor;
g.AddChild(c);
@ -21,11 +21,11 @@ begin
var g := MultipleClones(c,10);
var gp := MultipleClones(c1,10);
var gg := Group(g,b,gp);
var g1 := gg.Clone.MoveOnY(6);
var g2 := gg.Clone.MoveOnY(-6);
var g1 := gg.Clone.MoveByY(6);
var g2 := gg.Clone.MoveByY(-6);
gg.Rotate(OrtZ,90);
var g3 := gg.Clone.MoveOnX(-6);
gg.MoveOnX(6);
var g3 := gg.Clone.MoveByX(-6);
gg.MoveByX(6);
var ggg := Group(gg,g1,g2,g3);
ggg.Save('Замок.xaml');
//ggg.AnimRotate(OrtZ,360,10).Forever.begin;

27
InstallerSamples/Graphics/Controls/cc10_ComboBox.pas Normal file
View file

@ -0,0 +1,27 @@
// Модуль Controls - элемент управления "Список" и использование словаря
uses Controls,GraphWPF;
begin
Window.Title := 'Столицы стран';
LeftPanel(150,Colors.Orange);
var l := ComboBox('Список стран');
l.Tooltip := 'Выбери страну - отобразится столица';
l.Add('Россия');
l.Add('США');
l.Add('Китай');
l.Add('Германия');
l.Add('Франция');
var d := Dict(('Россия','Москва'),
('США','Вашингтон'),
('Китай','Пекин'),
('Германия','Берлин'),
('Франция','Париж')
);
Font.Size := 70;
l.SelectionChanged := procedure -> begin
Window.Clear;
DrawText(GraphWindow.ClientRect,d[l.SelectedText]);
end;
end.

22
InstallerSamples/Graphics/Controls/cc11_ComboBox2.pas Normal file
View file

@ -0,0 +1,22 @@
// Модуль Controls - элемент управления "ComboBox" и графики функций
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - элемент управления "ComboBox" и графики функций';
LeftPanel(150, Colors.Orange);
var cb := ComboBox('Графики функций');
cb.AddRange('x*sin(x)','exp(x)','x*x','sin(x)-cos(2.5*x)');
var Redraw: procedure := () -> begin
case cb.SelectedIndex of
0: DrawGraph(x->x*sin(x));
1: DrawGraph(x->exp(x));
2: DrawGraph(x->x*x);
3: DrawGraph(x->sin(x)-cos(2.5*x));
end;
end;
cb.SelectionChanged := Redraw;
OnResize := Redraw;
Redraw;
end.

18
InstallerSamples/Graphics/Controls/cc12_Wrapping.pas Normal file
View file

@ -0,0 +1,18 @@
// Модуль Controls - режим Wrapping для TextBlock
uses GraphWPF,Controls;
function R := Random(-7,7);
begin
Window.Title := 'Модуль Controls - режим Wrapping для TextBlock';
LeftPanel(150,Colors.Orange);
var b := Button('No Wrap');
b.Tooltip := 'Нажмите для изменения режима переноса слов';
var tb1 := TextBlock('Этот текст не помещается на одной строке и в режиме Wrapping автоматически переносится');
b.Click := procedure → begin
tb1.Wrapping := not tb1.Wrapping;
b.Text := if tb1.Wrapping then 'Wrap' else 'No Wrap';
end;
var tb := TextBlock('Этот текст усекается,'#10'но можно явно'#10'разделять на строки');
end.

32
InstallerSamples/Graphics/Controls/cc13_Заголовки.pas Normal file
View file

@ -0,0 +1,32 @@
// Модуль Controls - элементы управления с заголовками
uses Controls, GraphWPF;
begin
Window.Title := 'Модуль Controls - все элементы управления с заголовками';
LeftPanel(170, Colors.Orange);
var b := Button('Заголовки включены');
var tb := new TextBoxWPF('TextBox');
tb.Height := 40;
tb.Text := 'Несколько строк текста';
tb.Wrapping := True;
var ib := new IntegerBoxWPF('IntegerBox', 0, 10);
var lb := new ListBoxWPF('ListBox',100);
lb.AddRange('1 2 3 4 5'.ToWords);
var cb := new ComboBoxWPF('ComboBox');
cb.AddRange('1 2 3 4 5'.ToWords);
var sl := new SliderWPF('Slider:');
b.Click := procedure -> begin
if b.Text = 'Заголовки включены' then
b.Text := 'Заголовки выключены'
else b.Text := 'Заголовки включены';
tb.TitleVisible := not tb.TitleVisible;
ib.TitleVisible := not ib.TitleVisible;
lb.TitleVisible := not lb.TitleVisible;
cb.TitleVisible := not cb.TitleVisible;
sl.TitleVisible := not sl.TitleVisible;
end;
end.

17
InstallerSamples/Graphics/Controls/cc14_Canvas.pas Normal file
View file

@ -0,0 +1,17 @@
// Модуль Controls - замена графической панели на элемент управления "Канва"
uses Controls,GraphWPF;
begin
Window.Title := 'Модуль Controls - замена графической панели на элемент управления "Канва"';
var left := LeftPanel(150,Colors.Orange);
var can := SetMainControl.AsCanvas;
can.Color := Colors.AntiqueWhite;
Button(100,100,'На Канве можно располагать элементы');
Button(50,300,'в любом месте,');
TextBlock(150,500,'указывая их координаты');
// Смена активной панели
SetActivePanel(left);
Button('Закрыть').Click := procedure → Window.Close;
end.

23
InstallerSamples/Graphics/Controls/cc15_ListView.pas Normal file
View file

@ -0,0 +1,23 @@
// Модуль Controls - замена графического окна элементом "ListView"
uses Controls,GraphWPF;
type My = class
public
auto property Поле1: integer;
auto property Поле2: integer;
constructor (п1,п2: integer) := (Поле1,Поле2) := (п1,п2);
end;
begin
Window.Title := 'Модуль Controls - замена графического окна элементом "ListView"';
LeftPanel(150,Colors.Orange);
var l := SetMainControl.AsListView;
// Заполнение объектами класса, у которых есть публичные свойства
l.Fill(Arr(new My(2,5),new My(4,6)));
Button('Очистить список').Click := procedure -> l.Clear;
Button('Заполнить данными').Click := procedure -> l.Fill(|('Иванов',20),('Петров',19)|);
Button('Заполнить заголовки').Click := procedure -> l.SetHeaders('Фамилия','Возраст');
end.

19
InstallerSamples/Graphics/Controls/cc16_Countries.pas Normal file
View file

@ -0,0 +1,19 @@
// Модуль Controls - визуализация запросов к базе данных
uses GraphWPF,Controls,ABCDatabases;
begin
Window.Title := 'Модуль Controls - визуализация запросов к базе данных';
LeftPanel(150,Colors.Orange);
var l := SetMainControl.AsListView;
var страны := ЗаполнитьМассивСтран;
l.Fill(страны);
Button('Все').Click := procedure -> l.Fill(страны);
Button('Азия').Click := procedure ->
l.Fill(страны.Where(страна -> страна.Континент='Азия'));
Button('Сорт по населению').Click := procedure ->
l.Fill(страны.OrderByDescending(s -> s.Население));
end.

20
InstallerSamples/Graphics/Controls/cc16a_CountyCapital.pas Normal file
View file

@ -0,0 +1,20 @@
uses GraphWPF, Controls, ABCDatabases;
begin
Window.Title := 'Столицы стран';
LeftPanel(220, Colors.LightGoldenrodYellow);
var страны := ЗаполнитьМассивСтран;
var a := ListBox('Страны',550);
a.AddRange(страны.ConvertAll(страна -> страна.Название));
var d := DictStr;
foreach var страна in страны do
d[страна.Название] := страна.Столица;
Font.Size := 70;
a.SelectionChanged := procedure -> begin
Window.Clear;
DrawText(GraphWindow.ClientRect,d[a.SelectedText])
end;
end.

14
InstallerSamples/Graphics/Controls/cc17_CalcIdea.pas Normal file
View file

@ -0,0 +1,14 @@
// Модуль Controls - Калькулятор Light
uses Controls,GraphWPF;
begin
Window.Title := 'Калькулятор Light';
LeftPanel(150, Colors.Orange);
var tb := SetMainControl.AsTextBox;
tb.FontSize := 30;
var x := IntegerBox('X:',1,9);
var y := IntegerBox('Y:',1,9);
Button('Sum').Click := procedure -> begin
tb.Println($'{x.Value} + {y.Value} = {x.Value + y.Value}');
end;
end.

44
InstallerSamples/Graphics/Controls/cc18_SimpleCalc.pas Normal file
View file

@ -0,0 +1,44 @@
// Модуль Controls - Калькулятор
uses Controls,GraphWPF;
begin
Window.Title := 'Калькулятор с выводом в TextBox';
LeftPanel(150, Colors.Orange);
var tb := SetMainControl.AsTextBox;
tb.FontSize := 30;
var x := IntegerBox('X:');
var y := IntegerBox('Y:');
x.Value := Random(0,10);
y.Value := Random(0,10);
var cb := new ComboBoxWPF('Операция');
cb.AddRange('+','-','*','/');
var count := 0;
var sb := StatusBar;
sb.Text := 'Количество вычислений: ' + count;
var b := Button('+');
b.Click := procedure -> begin
case cb.SelectedText of
'+': tb.Println($'{x.Value} + {y.Value} = {x.Value + y.Value}');
'-': tb.Println($'{x.Value} - {y.Value} = {x.Value - y.Value}');
'*': tb.Println($'{x.Value} * {y.Value} = {x.Value * y.Value}');
'/': tb.Println($'{x.Value} / {y.Value} = {x.Value / y.Value}');
end;
x.Value := Random(0,10);
y.Value := Random(0,10);
count += 1;
sb.Text := 'Количество вычислений: ' + count;
end;
Button('Очистить').Click := () -> begin
count := 0;
sb.Text := 'Количество вычислений: ' + count;
tb.Clear;
end;
cb.SelectionChanged := procedure -> begin
b.Text := cb.SelectedText
end;
end.

17
InstallerSamples/Graphics/Controls/cc19_StatusBar.pas Normal file
View file

@ -0,0 +1,17 @@
// Модуль Controls - StatusBar
uses Controls,GraphWPF;
begin
Window.Title := 'Модуль Controls - StatusBar';
var l := LeftPanel(150,Colors.Orange);
l.Tooltip := 'Измените размеры окна';
var sb := StatusBar(24,55);
sb.AddText('',55);
Button('Очистить поле W').Click := procedure -> sb.ItemText[0] := '';
Button('Очистить поле H').Click := procedure -> sb.ItemText[1] := '';
OnResize := () -> begin
sb.ItemText[0] := 'W=' + Window.Width.Round;
sb.ItemText[1] := 'H=' + Window.Height.Round;
end;
OnResize();
end.

33
InstallerSamples/Graphics/Controls/cc1_All.pas Normal file
View file

@ -0,0 +1,33 @@
// Модуль Controls - все элементы управления
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - все элементы управления';
// Обычно элементы управления размещаются на панели - левой или правой
LeftPanel(160,Colors.Orange);
Button('Кнопка');
CheckBox('Флажок');
RadioButton('Переключатель 1');
RadioButton('Переключатель 2');
TextBox('Поле ввода текста');
var ib := IntegerBox('Поле ввода целого',0,10);
ib.Tooltip := 'Покрутите колёсико мыши для изменения значения';
var l := ListBox('Список стран');
l.Height := 110;
l.Add('Россия');
l.Add('США');
l.Add('Китай');
l.Add('Германия');
l.Add('Франция');
var cb := ComboBox('Выпадающий список');
cb.AddRange('Россия','США','Китай','Германия','Франция');
Slider('Слайдер:',0,10);
TextBlock('Блок текста');
IntegerBlock('Блок целого:',64);
RealBlock('Блок вещественного:',3.5);
var s := StatusBar;
s.Text := 'Строка статуса';
end.

17
InstallerSamples/Graphics/Controls/cc20_Menu.pas Normal file
View file

@ -0,0 +1,17 @@
// Модуль Controls - меню
uses Controls,GraphWPF;
begin
LeftPanel(150, Colors.Orange);
var m := new MenuWPF;
var mi1 := m.Add('File');
mi1.Add('New');
mi1.Add('Open');
mi1.Add('Save');
mi1.AddSeparator;
mi1.Add('Exit').Click := procedure->Window.Close;
//mi1.Add('Exit',procedure->Window.Close);
m.Add('Edit');
m.Add('Options');
var mi := m.Add('Help');
end.

10
InstallerSamples/Graphics/Controls/cc20_Menu2.pas Normal file
View file

@ -0,0 +1,10 @@
// Модуль Controls - меню 2
uses Controls,GraphWPF;
begin
LeftPanel(150, Colors.Orange);
var m := new MenuWPF;
m.AddRange('File','Edit','Options','Help');
m[0].AddRange('New','Open','Save','-','Exit');
m[0][3].Click := procedure->Window.Close;
end.

39
InstallerSamples/Graphics/Controls/cc21_FileDialogs.pas Normal file
View file

@ -0,0 +1,39 @@
// Модуль Controls - OpenFileDialog и SaveFileDialog
uses Controls,GraphWPF;
begin
Window.Title := 'Модуль Controls - OpenFileDialog и SaveFileDialog';
LeftPanel(150, Colors.Orange);
var tb := SetMainControl.AsTextBox;
tb.FontSize := 16;
tb.ReadOnly := False;
tb.FontName := 'Courier new Cyr';
var dopen := new OpenFileDialogWPF('c:\PABCWork.NET','Программы|*.pas');
var dSave := new SaveFileDialogWPF('c:\PABCWork.NET','Программы|*.pas');
var OpenHandler: procedure := procedure -> begin
var res := dopen.ShowDialog;
if res then
tb.Text := ReadAllText(dopen.FileName);
end;
var SaveHandler: procedure := procedure -> begin
var res := dSave.ShowDialog;
if res then
WriteAllText(dSave.FileName,tb.Text);
end;
var bOpen := Button('Open');
bOpen.Click := OpenHandler;
var bSave := Button('Save');
bSave.Click := SaveHandler;
var m := Menu;
var m1 := m.Add('File');
var mm1 := m1.Add('Open');
mm1.Click := OpenHandler;
m1.Add('Save',SaveHandler);
m1.AddSeparator;
m1.Add('Exit',procedure->Window.Close);
end.

19
InstallerSamples/Graphics/Controls/cc22_MsgBox.pas Normal file
View file

@ -0,0 +1,19 @@
// Модуль Controls - MessageBox
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - MessageBox';
LeftPanel(150, Colors.Orange);
Button('MsgBoxOK').Click := () -> MessageBox.Show('Сообщение','Заголовок');
Button('MsgBoxYesNo').Click := () -> begin
if MessageBox.Show('Сообщение','Заголовок',MessageBoxButton.YesNo) = MessageBoxResult.Yes then
Print('Yes')
else Print('No');
end;
Button('MsgBoxWithQuestion').Click := () -> begin
if MessageBox.Show('Вы уверены?','Заголовок',MessageBoxButton.YesNo,MessageBoxImage.Question)
= MessageBoxResult.Yes then
Print('Уверен')
else Print('Нет');
end;
end.

13
InstallerSamples/Graphics/Controls/cc23_Random3DSpheres.pas Normal file
View file

@ -0,0 +1,13 @@
// Случайные шары
uses Graph3D,Controls;
function R := Random(-7,7);
begin
Window.Title := 'Случайные шары';
LeftPanel(150,Colors.Orange);
var b := new ButtonWPF('Создать шар');
b.Click := () → begin
Sphere(P3D(R,R,R),1);
end;
end.

24
InstallerSamples/Graphics/Controls/cc24_RGB.pas Normal file
View file

@ -0,0 +1,24 @@
// Смешение цветов RGB
uses GraphWPF,Controls;
begin
Window.Title := 'Цвета';
Font.Size := 40;
LeftPanel(150);
var r := Slider('Красный: ',0,255,255,16);
var g := Slider('Зеленый: ',0,255,255,16);
var b := Slider('Синий: ',0,255,255,16);
Button('Выход').Click := procedure → Window.Close;
var p: procedure := () → begin
var c := RGB(r.Value,g.Value,b.Value);
Window.Clear(c);
DrawText(GraphWindow.ClientRect,$'R={c.R}, G={c.G}, B={c.B}');
end;
r.ValueChanged := p;
g.ValueChanged := p;
b.ValueChanged := p;
p;
end.

28
InstallerSamples/Graphics/Controls/cc25_Gr3DProperties.pas Normal file
View file

@ -0,0 +1,28 @@
// Модуль Controls
uses Graph3D, Controls;
begin
var l := LeftPanel(200, Colors.LightGoldenrodYellow);
var height := IntegerBox('Высота:', 1, 15);
height.Value := 5;
height.Tooltip := 'Покрутите колёсико мыши';
var radius := IntegerBox('Радиус:', 1, 6);
radius.Value := 2;
radius.Tooltip := 'Покрутите колёсико мыши';
var sides := Slider('Количество сторон: ', 3, 20);
sides.Frequency := 1;
sides.Value := 5;
var p := Pyramid(Origin, sides.Value, height.Value, radius.Value, Colors.Green);
height.ValueChanged := procedure -> begin
p.Height := height.Value;
end;
radius.ValueChanged := procedure -> begin
p.Radius := radius.Value;
end;
sides.ValueChanged := procedure -> begin
p.Sides := sides.Value;
end;
end.

57
InstallerSamples/Graphics/Controls/cc2_All2.pas Normal file
View file

@ -0,0 +1,57 @@
// Модуль Controls - элементы управления на основной панели
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - элементы управления на основной панели';
var x := 10;
var w := 140;
Button(x,10,'Кнопка',w);
CheckBox(x,43,'Флажок');
RadioButton(x,70,'Переключатель 1');
RadioButton(x,97,'Переключатель 2');
TextBox(x,120,'Поле ввода текста',w);
var ib0 := IntegerBox(x,172,'Поле ввода целого',0,10,w);
ib0.Tooltip := 'Покрутите колёсико мыши для изменения значения';
var l0 := ListBox(x,221,'Список стран',w);
l0.Height := 110;
l0.Add('Россия');
l0.Add('США');
l0.Add('Китай');
l0.Add('Германия');
l0.Add('Франция');
var cb0 := ComboBox(x,362,'Выпадающий список',w);
cb0.AddRange('Россия','США','Китай','Германия','Франция');
Slider(x,414,'Слайдер:',0,10,w);
TextBlock(x,469,'Блок текста',w);
IntegerBlock(x,497,'Блок целого:',w,64);
RealBlock(x,526,'Блок вещественного:',w,3.5);
LeftPanel(160,Colors.Orange);
Button('Кнопка');
CheckBox('Флажок');
RadioButton('Переключатель 1');
RadioButton('Переключатель 2');
TextBox('Поле ввода текста');
var ib := IntegerBox('Поле ввода целого',0,10);
ib.Tooltip := 'Покрутите колёсико мыши для изменения значения';
var l := ListBox('Список стран');
l.Height := 110;
l.Add('Россия');
l.Add('США');
l.Add('Китай');
l.Add('Германия');
l.Add('Франция');
var cb := ComboBox('Выпадающий список');
cb.AddRange('Россия','США','Китай','Германия','Франция');
Slider('Слайдер:',0,10);
TextBlock('Блок текста');
IntegerBlock('Блок целого:',64);
RealBlock('Блок вещественного:',3.5);
var s := StatusBar;
s.Text := 'Строка статуса';
end.

33
InstallerSamples/Graphics/Controls/cc3_All3.pas Normal file
View file

@ -0,0 +1,33 @@
// Модуль Controls - создание элементов вызовом конструктора
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - создание элементов вызовом конструктора + правая панель';
// Размещение элементов на правой ранели
new RightPanelWPF(160,Colors.Orange);
new ButtonWPF('Кнопка');
new CheckBoxWPF('Флажок');
new RadioButtonWPF('Переключатель 1');
new RadioButtonWPF('Переключатель 2');
new TextBoxWPF('Поле ввода текста');
var ib := new IntegerBoxWPF('Поле ввода целого',0,10);
ib.Tooltip := 'Покрутите колёсико мыши для изменения значения';
var l := new ListBoxWPF('Список стран');
l.Height := 110;
l.Add('Россия');
l.Add('США');
l.Add('Китай');
l.Add('Германия');
l.Add('Франция');
var cb := new ComboBoxWPF('Выпадающий список');
cb.AddRange('Россия','США','Китай','Германия','Франция');
new SliderWPF('Слайдер:',0,10);
new TextBlockWPF('Блок текста');
new IntegerBlockWPF('Блок целого:',64);
new RealBlockWPF('Блок вещественного:',3.5);
var s := new StatusBarWPF;
s.Text := 'Строка статуса';
end.

19
InstallerSamples/Graphics/Controls/cc4_ButtonClick.pas Normal file
View file

@ -0,0 +1,19 @@
// Модуль Controls - кнопки и их обработчики
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - кнопки и их обработчики';
var p := LeftPanel;
p.Color := Colors.Orange;
Button('Случайный цвет').Click := () -> begin
Window.Clear(RandomColor);
end;
var b2 := Button('Плюс');
b2.Click := procedure ->
if b2.Text = 'Плюс' then b2.Text := 'Минус' else b2.Text := 'Плюс';
var b1 := Button('Закрыть окно');
b1.Click := procedure -> Window.Close;
end.

20
InstallerSamples/Graphics/Controls/cc5_CheckBoxes.pas Normal file
View file

@ -0,0 +1,20 @@
// Модуль Controls - флажки
uses GraphWPF,Controls;
begin
Window.Title := 'Модуль Controls - флажки';
var p := LeftPanel(170,Colors.Orange);
var b1 := Button('Переключить флажок 1');
var b2 := Button('Переключить флажок 2');
var b3 := Button('Переключить флажок 3');
var cb1 := new CheckBoxWPF('Флажок 1');
var cb2 := new CheckBoxWPF('Флажок 2');
var cb3 := new CheckBoxWPF('Флажок 3');
b1.Click := procedure -> cb1.Checked := not cb1.Checked;
b2.Click := procedure -> cb2.Checked := not cb2.Checked;
b3.Click := procedure -> cb3.Checked := not cb3.Checked;
end.

33
InstallerSamples/Graphics/Controls/cc6_CheckBoxes2.pas Normal file
View file

@ -0,0 +1,33 @@
// Модуль Controls - флажки
uses WPFObjects,Controls;
begin
Window.Title := 'Модуль Controls - флажки';
LeftPanel(170);
var tb := TextBlock('Параметры круга:');
tb.Margin := 12;
var cb1 := new CheckBoxWPF('Заливка');
var cb2 := new CheckBoxWPF('Жирная граница');
var cb3 := new CheckBoxWPF('С текстом');
var c := new CircleWPF(GraphWindow.Center,60,Colors.White,1);
cb1.Click := procedure -> begin
if cb1.Checked then
c.Color := Colors.Green
else c.Color := Colors.White
end;
cb2.Click := procedure -> begin
if cb2.Checked then
c.BorderWidth := 4
else c.BorderWidth := 1
end;
cb3.Click := procedure -> begin
if cb3.Checked then
c.Text := 'Текст'
else c.Text := ''
end;
end.

26
InstallerSamples/Graphics/Controls/cc7_RadioButtons.pas Normal file
View file

@ -0,0 +1,26 @@
// Модуль Controls - переключатели
uses WPFObjects,Controls;
begin
Window.Title := 'Модуль Controls - переключатели';
LeftPanel(150,Colors.Beige);
var tb := TextBlock('Цвет круга:');
//tb.Margin := 12;
var rb1 := new RadioButtonWPF('Красный');
var rb2 := new RadioButtonWPF('Зелёный');
var rb3 := new RadioButtonWPF('Синий');
var c := new CircleWPF(GraphWindow.Center,60,Colors.White,1);
rb1.Click := procedure -> begin
c.Color := Colors.Red;
end;
rb2.Click := procedure -> begin
c.Color := Colors.Green;
end;
rb3.Click := procedure -> begin
c.Color := Colors.Blue;
end;
end.

28
InstallerSamples/Graphics/Controls/cc8_MoveObject.pas Normal file
View file

@ -0,0 +1,28 @@
// Модуль Controls - кнопки управления перемещением + клавиатура
uses WPFObjects,Controls;
begin
Window.Title := 'Модуль Controls - кнопки управления перемещением + клавиатура';
LeftPanel;
var c := new CircleWPF(GraphWindow.Center,30,Colors.Blue);
OnKeyDown := k -> begin
case k of
Key.Left: c.MoveBy(-2,0);
Key.Right: c.MoveBy(2,0);
Key.Up: c.MoveBy(0,-2);
Key.Down: c.MoveBy(0,2);
end;
end;
var l := Button('Left');
var r := Button('Right');
var u := Button('Up');
var d := Button('Down');
l.Click := ()->c.MoveBy(-2,0);
r.Click := ()->c.MoveBy(2,0);
u.Click := ()->c.MoveBy(0,-2);
d.Click := ()->c.MoveBy(0,2);
end.

27
InstallerSamples/Graphics/Controls/cc8a_MoveObject.pas Normal file
View file

@ -0,0 +1,27 @@
// Модуль Controls - IntegerBlock, IntegerBox и перемещение объекта
uses WPFObjects,Controls;
begin
Window.Title := 'Модуль Controls - IntegerBlock, IntegerBox и перемещение объекта';
LeftPanel;
var c := new CircleWPF(300,300,30,Colors.Blue);
var X := IntegerBox('X:',0,600);
X.Value := 300;
var Y := IntegerBox('Y:',0,600);
Y.Value := 300;
var XX := IntegerBlock('X:',300);
var YY := IntegerBlock('Y:',300);
X.ValueChanged := procedure → begin
c.Center := Pnt(X.Value,Y.Value);
XX.Value := X.Value;
end;
Y.ValueChanged := procedure → begin
c.Center := Pnt(X.Value,Y.Value);
YY.Value := Y.Value;
end;
end.

28
InstallerSamples/Graphics/Controls/cc9_ListBox.pas Normal file
View file

@ -0,0 +1,28 @@
// Модуль Controls - элемент управления "Список" и использование словаря
uses Controls,GraphWPF;
begin
Window.Title := 'Столицы стран';
LeftPanel(150,Colors.Orange);
var l := ListBox('Список стран');
//l.Tooltip := 'Выбери страну - отобразится столица';
l.Height := 110;
l.Add('Россия');
l.Add('США');
l.Add('Китай');
l.Add('Германия');
l.Add('Франция');
var d := Dict(('Россия','Москва'),
('США','Вашингтон'),
('Китай','Пекин'),
('Германия','Берлин'),
('Франция','Париж')
);
Font.Size := 70;
l.SelectionChanged := procedure -> begin
Window.Clear;
DrawText(GraphWindow.ClientRect,'Столица:'+#10+d[l.SelectedText]);
end;
end.

8
InstallerSamples/Graphics/WPFObjects/MovingFrameBasedTime.pas
View file

@ -3,11 +3,11 @@
begin
var c := new CircleWPF(Window.Center, 20, Colors.Green);
BeginFrameBasedAnimationTime(dt->begin
OnDrawFrame := dt → begin
c.MoveTime(dt);
end);
end;
OnKeyDown := k -> begin
OnKeyDown := k → begin
case k of
Key.Left: c.Direction := (-5, 0);
Key.Right: c.Direction := (5, 0);
@ -16,7 +16,7 @@ begin
end;
end;
OnKeyUp := k -> begin
OnKeyUp := k → begin
c.Direction := (0, 0);
end;
end.

4
InstallerSamples/Graphics/WPFObjects/Shooter.pas
View file

@ -26,7 +26,7 @@ begin
var kl,kr,ku,kd: boolean;
BeginFrameBasedAnimationTime(dt->begin
OnDrawFrame := dt -> begin
Window.Title := 'Количество объектов: '+Objects.Count;
// Перемещение игрока
if kr then
@ -53,7 +53,7 @@ begin
// Конец игры
end;
end);
end;
CreateTimerAndStart(100,procedure -> // Таймер убивания монстров и умирания объектов за пределами экрана
begin

197
InstallerSamples/Graphics/WPFObjects/ShooterWithInterface.pas Normal file
View file

@ -0,0 +1,197 @@
uses WPFObjects, Timers, Controls;
type
BulletWPF = class(CircleWPF) end;
MonsterWPF = class(SquareWPF) end;
PlayerWPF = class(EllipseWPF) end;
TGameState = (Paused, Started, EndOfGame);
var
// Состояние игры
GameState: TGameState := Paused;
// Глобальные интерфейсные объекты
sb: StatusBarWPF;
bstart, bstop, bnewgame: ButtonWPF;
// Глобальные игровые объекты
Player: PlayerWPF;
// Клавиатура
kl, kr, ku, kd: boolean;
procedure InitGame;
begin
Player := new PlayerWPF(GraphWindow.Center, 30, 50, RandomColor);
Player.Velocity := 100;
Player.Number := 0;
loop 10 do
begin
var m := new MonsterWPF(750, Random(10, 550), 30, RandomColor);
m.Velocity := 50;
end;
end;
procedure NewGame;
begin
sb.Text := '';
Objects.Clear;
InitGame;
end;
// Конец игры - игрок погиб
procedure GameOver;
begin
sb.Text := 'Игрок погиб';
GameState := EndOfGame;
bstart.Enabled := False;
bstop.Enabled := False;
bnewgame.Enabled := True;
Player.Color := Colors.Black;
end;
// Конец игры - победа!
procedure GameOverWin;
begin
sb.Text := 'Победа!';
GameState := EndOfGame;
bstart.Enabled := False;
bstop.Enabled := False;
bnewgame.Enabled := True;
Player.Color := Colors.Yellow;
end;
procedure InitInterface;
begin
Window.SetSize(1000, 600);
LeftPanel(200, Colors.Orange);
bstart := Button('Start');
bstop := Button('Stop');
bnewgame := Button('Новая игра');
bstop.Enabled := False;
bstart.Enabled := False;
bstart.Click := procedure → begin
GameState := Started;
bstart.Enabled := False;
bstop.Enabled := True;
end;
bstop.Click := procedure → begin
GameState := Paused;
bstart.Enabled := True;
bstop.Enabled := False;
end;
bNewGame.Click := procedure → begin
GameState := Started;
bnewgame.Enabled := False;
bstart.Enabled := False;
bstop.Enabled := True;
NewGame;
end;
sb := StatusBar;
end;
// Обработчик таймера убивания монстров и умирания объектов за пределами экрана
procedure KillMonstersHandler;
begin
if GameState <> Started then
exit;
// Удалить пули, вылетевшие за экран
Objects.DestroyAll(o → o.OutOfGraphWindow and not (o is PlayerWPF));
// Удалить монстра, убитого пулей, вместе с пулей
foreach var o in Objects do
begin
if o is BulletWPF then
foreach var x in o.IntersectionList do
if x is MonsterWPF then
begin
x.Destroy;
o.Destroy;
Player.Number += 1;
break;
end;
end;
end;
// Обработчик перерисовки экрана
procedure DrawFrame(dt: real);
begin
if GameState <> Started then exit;
Window.Title := 'Количество объектов: ' + Objects.Count;
// Перемещение игрока
if kr then
Player.Dx := 1
else if kl then
Player.Dx := -1
else Player.Dx := 0;
if ku then
Player.Dy := -1
else if kd then
Player.Dy := 1
else Player.Dy := 0;
// Перемещение остальных объектов
foreach var o in Objects do // все перемещаются в своём направлении со своей скоростью
begin
if o is MonsterWPF then
o.Direction := (Player.Center.X - o.Center.X, Player.Center.Y - o.Center.Y);
o.MoveTime(dt);
end;
// Проверка гибели игрока
if Player.IntersectionList.Any(o → o is MonsterWPF) then
GameOver;
// Проверка выигрыша игрока
if Player.Number >= 10 then
GameOverWin;
end;
/// Обработчик таймера рождения монстров
procedure CreateMonstersHandler;
begin
if GameState <> Started then exit;
var x := if Random(2) = 0 then 750 else 50;
var m := new MonsterWPF(x, Random(10, 550), 30, RandomColor);
m.Velocity := 50;
end;
begin
InitInterface;
CreateTimerAndStart(100, KillMonstersHandler);
CreateTimerAndStart(1000, CreateMonstersHandler);
// Обработчик перерисовки кадров
OnDrawFrame := DrawFrame;
// Обработчики мыши и клавиатуры
OnMouseMove := (x, y, mb) → begin
if GameState <> Started then exit;
Player.RotateToPoint(x, y);
end;
OnMouseDown := (x, y, mb) → begin
if GameState <> Started then exit;
var cc := new BulletWPF(Player.CenterTop, 5, Colors.Red);
cc.Direction := (x - Player.Center.X, y - Player.Center.Y);
cc.Velocity := 300;
end;
OnKeyDown := k → begin
case k of
Key.w, Key.Up: begin ku := true; kd := false; end;
Key.s, Key.Down: begin kd := true; ku := false; end;
Key.a, Key.Left: begin kl := true; kr := false; end;
Key.d, Key.Right: begin kr := true; kl := false end;
end;
end;
OnKeyUp := k → begin
case k of
Key.w, Key.Up: ku := false;
Key.s, Key.Down: kd := false;
Key.a, Key.Left: kl := false;
Key.d, Key.Right: kr := false;
end;
end;
end.

32
InstallerSamples/Graphics/WPFObjects/StartStopMoveRotation.pas Normal file
View file

@ -0,0 +1,32 @@
// Модуль Controls - StatusBar
uses Controls,WPFObjects;
// Управление свойствами объекта, связанными с перемещением и поворотом.
// В OnDrawFrame объект сам себя перерисовывает
begin
Window.Title := 'Модуль Controls - StatusBar';
var l := LeftPanel(180,Colors.Orange);
var c := new RectangleWPF(50,200,80,50,Colors.Green);
c.Direction := (1,0);
c.Velocity := 0;
c.Tag := 0; // скорость поворота
OnDrawFrame := dt -> begin
c.MoveTime(dt);
c.RotateAngle += integer(c.Tag) * dt;
end;
Button('Начать перемещение').Click := procedure -> begin
c.Velocity := 30;
end;
Button('Закончить перемещение').Click := procedure -> begin
c.Velocity := 0;
end;
Button('Начать поворот').Click := procedure -> begin
c.Tag := 30;
end;
Button('Закончить поворот').Click := procedure -> begin
c.Tag := 0;
end;
end.

4
InstallerSamples/Graphics/WPFObjects/gr_All_Brown_WPF.pas
View file

@ -5,7 +5,7 @@ uses WPFObjects;
procedure MoveAll(a,b: integer);
begin
for var j:=0 to Objects.Count-1 do
Objects[j].moveOn(a,b);
Objects[j].moveBy(a,b);
end;
begin
@ -33,7 +33,7 @@ begin
while True do
begin
for var j:=0 to Objects.Count-1 do
Objects[j].MoveOn(Random(-1,1),Random(-1,1));
Objects[j].MoveBy(Random(-1,1),Random(-1,1));
Sleep(10);
end;
end.

2
InstallerSamples/Graphics/WPFObjects/gr_IntersectWPF.pas
View file

@ -17,7 +17,7 @@ begin
loop 900 do
begin
Destroyer.MoveOn(1,0);
Destroyer.MoveBy(1,0);
CheckPulyaIntersects;
Sleep(1);
end;

2
InstallerSamples/Graphics/WPFObjects/gr_ObjectsAsSeq.pas
View file

@ -19,7 +19,7 @@ begin
foreach var o in Objects.Seq do
match o with
CircleWPF(c): c.Radius += 10;
EllipseWPF(e): e.AnimMoveOn(Random(-50,50),Random(-50,50),1);
EllipseWPF(e): e.AnimMoveBy(Random(-50,50),Random(-50,50),1);
RegularPolygonWPF(r) when r.Count<6: r.SetBorder;
end
end.

4
InstallerSamples/LINQ/First3Min.pas
View file

@ -1,4 +1,4 @@
// Первые 3 минимума
// Первые 3 минимума
begin
SeqRandom(20).Println.Sorted.Distinct.Take(3).Println;
ArrRandom(20).Println.Sorted.Distinct.Take(3).Println;
end.

2
InstallerSamples/LanguageFeatures/AutoClassPoint.pas
View file

@ -1,7 +1,7 @@
type
Point = auto class
x,y: integer;
procedure MoveOn(dx,dy: integer) := (x,y) := (x+dx,y+dy);
procedure MoveBy(dx,dy: integer) := (x,y) := (x+dx,y+dy);
function Distance(p: Point) := sqrt(sqr(x-p.x)+sqr(y-p.y));
class function operator implicit(t: (integer,integer)): Point := new Point(t[0],t[1]);
end;

9
InstallerSamples/OpenGL и OpenCL/OpenCL/MatrMlt.cl
View file

@ -1,11 +1,11 @@

#pragma OPENCL EXTENSION cl_khr_fp64: enable
__kernel void MatrMltMatr(__global double* A, __global double* B, __global double* C, __global int* gW)
__kernel void MatrMltMatr(__global double* A, __global double* B, __global double* C, int W)
{
int cX = get_global_id(0);
int cY = get_global_id(1);
int W = *gW;
double sum = 0.0;
for (int i=0; i<W; i++)
@ -14,10 +14,9 @@ __kernel void MatrMltMatr(__global double* A, __global double* B, __global doubl
C[cX + cY*W] = sum;
}
__kernel void MatrMltVec(__global double* C, __global double* V1, __global double* V2, __global int* gW)
__kernel void MatrMltVec(__global double* C, __global double* V1, __global double* V2, int W)
{
int i = get_global_id(0);
int W = *gW;
double sum = 0.0;
for (int j=0; j<W; j++)

15
InstallerSamples/OpenGL и OpenCL/OpenCL/MatrMlt.pas
View file

@ -19,8 +19,7 @@ begin
cl.GetPlatformIDs(1, platform, IntPtr.Zero).RaiseIfError;
var device: cl_device_id;
cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_DEFAULT, 1,device,IntPtr.Zero).RaiseIfError;
// cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_ALL, 1,device,IntPtr.Zero).RaiseIfError;
cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_ALL, 1,device,IntPtr.Zero).RaiseIfError;
var context := cl.CreateContext(nil, 1,device, nil,IntPtr.Zero, ec);
ec.RaiseIfError;
@ -31,7 +30,9 @@ begin
// Чтение и компиляция .cl файла
{$resource MatrMlt.cl}
var prog_str := System.IO.StreamReader.Create(GetResourceStream('MatrMlt.cl')).ReadToEnd;
var prog_str := System.IO.StreamReader.Create(
System.Reflection.Assembly.GetCallingAssembly.GetManifestResourceStream('MatrMlt.cl')
).ReadToEnd;
var prog := cl.CreateProgramWithSource(
context,
1,
@ -80,15 +81,13 @@ begin
ec.RaiseIfError;
var MatrWParam := MatrW;
var W_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE or MemFlags.MEM_USE_HOST_PTR, new UIntPtr(sizeof(integer)),new IntPtr(@MatrWParam), ec);
ec.RaiseIfError;
// Выполнение C := A*B
cl.SetKernelArg(MatrMltMatrKernel, 0, new UIntPtr(UIntPtr.Size), A_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 1, new UIntPtr(UIntPtr.Size), B_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 2, new UIntPtr(UIntPtr.Size), C_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 3, new UIntPtr(UIntPtr.Size), W_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 3, new UIntPtr(sizeof(integer)), @MatrWParam).RaiseIfError;
var k1_ev: cl_event;
cl.EnqueueNDRangeKernel(command_queue, MatrMltMatrKernel, 2, nil,new UIntPtr[](new UIntPtr(MatrW),new UIntPtr(MatrW)),nil, 0,nil,k1_ev).RaiseIfError;
@ -98,7 +97,7 @@ begin
cl.SetKernelArg(MatrMltVecKernel, 0, new UIntPtr(UIntPtr.Size), C_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 1, new UIntPtr(UIntPtr.Size), V1_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 2, new UIntPtr(UIntPtr.Size), V2_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 3, new UIntPtr(UIntPtr.Size), W_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 3, new UIntPtr(sizeof(integer)), @MatrWParam).RaiseIfError;
var k2_ev: cl_event;
cl.EnqueueNDRangeKernel(command_queue, MatrMltVecKernel, 1, nil,new UIntPtr[](new UIntPtr(MatrW)),nil, 1,k1_ev,k2_ev).RaiseIfError;
@ -113,7 +112,7 @@ begin
A.Println;
Writeln;
cl.EnqueueReadBuffer(command_queue, V2_buf, Bool.NON_BLOCKING, new UIntPtr(0), new UIntPtr(VecByteSize), V1[0], 1,k2_ev,IntPtr.Zero).RaiseIfError;
cl.EnqueueReadBuffer(command_queue, V2_buf, Bool.BLOCKING, new UIntPtr(0), new UIntPtr(VecByteSize), V1[0], 1,k2_ev,IntPtr.Zero).RaiseIfError;
Writeln('Вектор V2 = C*V1:');
V1.Println;

15
InstallerSamples/OpenGL и OpenCL/OpenCL/SimpleAddition.pas
View file

@ -15,15 +15,8 @@ begin
cl.GetPlatformIDs(1, platform, IntPtr.Zero).RaiseIfError;
var device: cl_device_id;
cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_DEFAULT, 1,device,IntPtr.Zero).RaiseIfError;
// DEVICE_TYPE_DEFAULT это, обычно, GPU
// Но, к примеру, в ноутбуке его может не быть
// Тогда надо хоть для чего то попытаться инициализировать
// DEVICE_TYPE_ALL выберет первое любое устройство, поддерживающее OpenCL
// cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_ALL, 1,device,IntPtr.Zero).RaiseIfError;
// Если всё ещё пишет что устройств нет - обновите драйверы,
// потому что даже встроенные видеокарты поддерживают OpenCL
cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_ALL, 1,device,IntPtr.Zero).RaiseIfError;
// Если пишет что устройств нет - обновите драйверы
var context := cl.CreateContext(nil, 1,device, nil,IntPtr.Zero, ec);
ec.RaiseIfError;
@ -34,7 +27,9 @@ begin
// Чтение и компиляция .cl файла
{$resource SimpleAddition.cl} // эта строчка засовывает SimpleAddition.cl внутрь .exe, чтоб не надо было таскать его вместе с .exe
var prog_str := System.IO.StreamReader.Create(GetResourceStream('SimpleAddition.cl')).ReadToEnd;
var prog_str := System.IO.StreamReader.Create(
System.Reflection.Assembly.GetCallingAssembly.GetManifestResourceStream('SimpleAddition.cl')
).ReadToEnd;
var prog := cl.CreateProgramWithSource(
context,
1,

9
InstallerSamples/OpenGL и OpenCL/OpenCLABC/0Простейшие примеры/MatrMlt.cl
View file

@ -1,11 +1,11 @@

#pragma OPENCL EXTENSION cl_khr_fp64: enable
__kernel void MatrMltMatr(__global double* A, __global double* B, __global double* C, __global int* gW)
__kernel void MatrMltMatr(__global double* A, __global double* B, __global double* C, int W)
{
int cX = get_global_id(0);
int cY = get_global_id(1);
int W = *gW;
double sum = 0.0;
for (int i=0; i<W; i++)
@ -14,10 +14,9 @@ __kernel void MatrMltMatr(__global double* A, __global double* B, __global doubl
C[cX + cY*W] = sum;
}
__kernel void MatrMltVec(__global double* C, __global double* V1, __global double* V2, __global int* gW)
__kernel void MatrMltVec(__global double* C, __global double* V1, __global double* V2, int W)
{
int i = get_global_id(0);
int W = *gW;
double sum = 0.0;
for (int j=0; j<W; j++)

38
InstallerSamples/OpenGL и OpenCL/OpenCLABC/0Простейшие примеры/MatrMlt.pas
View file

@ -6,9 +6,6 @@ const
VecByteSize = MatrW*8;
MatrByteSize = MatrW*MatrW*8;
//ToDo issue компилятора:
// - #1981
begin
try
Randomize(0); // делает так, чтобы каждое выполнение давало одинаковый результат
@ -19,9 +16,9 @@ begin
// Вообще лучше прекомпилировать .cl файл (загружать в переменную ProgramCode)
// И сохранять с помощью метода ProgramCode.SerializeTo
// А полученный бинарник уже подключать через $resource
var code := new ProgramCode(
var code := new ProgramCode(Context.Default,
System.IO.StreamReader.Create(
GetResourceStream('MatrMlt.cl')
System.Reflection.Assembly.GetExecutingAssembly.GetManifestResourceStream('MatrMlt.cl')
).ReadToEnd
);
@ -47,7 +44,7 @@ begin
var V2 := new Buffer(VecByteSize);
var N := new Buffer(4);
var W := KernelArg.FromRecord(MatrW);
// (запись значений в параметры - позже, в очередях)
@ -55,16 +52,15 @@ begin
var Calc_C_Q :=
code['MatrMltMatr'].NewQueue.AddExec2(MatrW, MatrW, // Выделяем ядра в форме квадрата, всего MatrW*MatrW ядер
A.NewQueue.AddWriteArray(A_Matr) as CommandQueue<Buffer>,
B.NewQueue.AddWriteArray(B_Mart) as CommandQueue<Buffer>,
A.NewQueue.AddWriteArray2&<real>(A_Matr), // Тип в &<> надо указывать явно, потому что компилятор не может вычислить его из типа элементов массива
B.NewQueue.AddWriteArray2&<real>(B_Mart),
C,
N.NewQueue.AddWriteValue(MatrW) as CommandQueue<Buffer>
) as CommandQueue<Kernel>;
W
);
var Otp_C_Q :=
C.NewQueue.AddReadArray(A_Matr) as CommandQueue<Buffer> +
C.NewQueue.AddReadArray2&<real>(A_Matr) +
HPQ(()->
lock output do
begin
'Матрица С = A*B:'.Println;
A_Matr.Println;
@ -74,15 +70,14 @@ begin
var Calc_V2_Q :=
code['MatrMltVec'].NewQueue.AddExec1(MatrW,
C,
V1.NewQueue.AddWriteArray(V1_Arr) as CommandQueue<Buffer>,
V1.NewQueue.AddWriteArray1&<real>(V1_Arr),
V2,
N // значение записывается в Calc_C_Q, тут можно использовать уже готовое
) as CommandQueue<Kernel>;
W
);
var Otp_V2_Q :=
V2.NewQueue.AddReadArray(V1_Arr) as CommandQueue<Buffer> +
V2.NewQueue.AddReadArray1&<real>(V1_Arr) +
HPQ(()->
lock output do
begin
'Вектор V2 = C*V1:'.Println;
V1_Arr.Println;
@ -94,13 +89,8 @@ begin
Context.Default.SyncInvoke(
Calc_C_Q +
(
Otp_C_Q * // выводить C и считать V2 можно одновременно, поэтому тут *, т.е. параллельное выполнение
(
Calc_V2_Q +
Otp_V2_Q
)
)
Calc_V2_Q * Otp_C_Q + // Считать V2 и выводить C можно одновременно, поэтому тут *, т.е. параллельное выполнение
Otp_V2_Q
);

13
InstallerSamples/OpenGL и OpenCL/OpenCLABC/0Простейшие примеры/SimpleAddition.pas
View file

@ -4,23 +4,24 @@ begin
// Чтение и компиляция .cl файла
var prog := new ProgramCode(ReadAllText('SimpleAddition.cl'));
var prog := new ProgramCode(Context.Default, ReadAllText('SimpleAddition.cl'));
// Подготовка параметров
var A := new Buffer( 10 * sizeof(integer) ); // Буфер достаточно размера, чтоб хранить 10 элементов типа "integer"
var A := new Buffer( 10 * sizeof(integer) ); // Буфер достаточного размера, чтобы хранить 10 элементов типа "integer"
// Выполнение
prog['TEST'].Exec1(10, // используем 10 ядер
prog['TEST'].Exec1(10, // Используем 10 ядер
A.NewQueue.AddFillValue(1) // заполняем весь буфер значениями (1), прямо перед выполнением. Тип значения integer, потому что это тип по-умолчанию для целых чисел
as CommandQueue<Buffer> //ToDo нужно только из за issue компилятора #1981, иначе получаем странную ошибку. Когда исправят - можно будет убрать
// Заполняем весь буфер значениями (1), прямо перед выполнением
// Тип значения integer, потому что это тип по-умолчанию для целых чисел
A.NewQueue.AddFillValue(1)
);
// Чтение и вывод результата
A.GetArray1&<integer>.Println; // читаем всё содержимое как одномерный массив с элементами типа "integer"
A.GetArray1&<integer>.Println; // Читаем всё содержимое как одномерный массив с элементами типа "integer"
end.

4
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/1.pas
View file

@ -23,7 +23,9 @@ begin
var F := NamedQ('F');
Context.Default.SyncInvoke(
(A + (B+D)*(C+F) ) *
A +
(B+D) *
(C+F) *
(WaitForAll(B,C) + E)
);

20
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/2.pas
View file

@ -4,24 +4,28 @@ uses NamedQData;
begin
// График выполнения очередей:
//
// A1--B1--C1------D1
// A1--B1--C1------E1
// \ /
// \ /
// A2------B2--C2--D2
// A2------C2--D2--E2
//
var A1 := NamedQ('A1');
var B1 := NamedQ('B1');
var C1 := NamedQ('C1');
var D1 := NamedQ('D1');
var A2 := NamedQ('A2');
var B2 := NamedQ('B2');
var B1 := NamedQ('B1');
var C1 := NamedQ('C1');
var C2 := NamedQ('C2');
var D2 := NamedQ('D2');
var E1 := NamedQ('E1');
var E2 := NamedQ('E2');
Context.Default.SyncInvoke(
( A1 + B1 + C1 + WaitFor(C2) + D1 ) *
( A2 + WaitFor(B1) + B2 + C2 + D2 )
( A1 + B1 + C1 + WaitFor(D2) + E1 ) *
( A2 + WaitFor(B1) + C2 + D2 + E2 )
);
end.

11
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Прекомпиляция ProgramCode/0.cl Normal file
View file

@ -0,0 +1,11 @@

__kernel void TEST(__global int* message)
{
int gid = get_global_id(0); // номер текущего вызова TEST
message[gid] += gid;
}

24
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Прекомпиляция ProgramCode/Использовать.pas Normal file
View file

@ -0,0 +1,24 @@
uses OpenCLABC;
begin
// Запустите "Прекомпилировать.pas", чтобы создать этот файл
{$resource 0.cl.temp_bin}
var prog := ProgramCode.DeserializeFrom(Context.Default,
System.Reflection.Assembly.GetExecutingAssembly.GetManifestResourceStream('0.cl.temp_bin')
);
// Дальше всё так же как в "0Простейшие примеры\SimpleAddition"
var A := new Buffer( 10 * sizeof(integer) );
prog['TEST'].Exec1(10,
A.NewQueue.AddFillValue(1)
);
A.GetArray1&<integer>.Println;
end.

8
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Прекомпиляция ProgramCode/Прекомпилировать.pas Normal file
View file

@ -0,0 +1,8 @@
uses OpenCLABC;
begin
var prog := new ProgramCode(Context.Default, ReadAllText('0.cl'));
var f := System.IO.File.Create('0.cl.temp_bin');
prog.SerializeTo(f);
f.Close;
end.

Some files were not shown because too many files have changed in this diff Show more