/*
//--------------------------------------------------------------------
// Delphi version: creates Delphi/Free Pascal project from a compiled 
// AL4 program, should be compiled by a compiled AL4DelphiCompiler.exe
//--------------------------------------------------------------------
// (C) by Vladimir Kladov, 2016-2023
//--------------------------------------------------------------------

CLASS {Generator|_for_Delphi_and_FPC},
	RECURSIVE, UNTESTED, STOPPING, BITWISE, BYTES :         

IMPORT: {Compiler}, {Type}, {Text_file}, {Variable}, {Function},
        {Statement}, {Assignment}, {For}, {Case}, {Expression}, {Limit},
        {Local}, {String_functions}, {System_functions}, {Console}, {File_path},
        {Parser}, {Text_parser}, {Localize_str}, {Load_source} .
IMPORT: {Memory_stream_contig}, {File_stream}, {Stream}, {Date_time}, 
		{Statistics}, {Testing}, {Mathematics} .

FUN Tests_available ==> BOOL := TRUE .

FUN Additional_classes|_maybe_add_Console_app(
{Compiler} C|ompiler_obj) : .

FUN Allow_optimizations(
{Compiler} C|ompiler_with_its_options,
STR Optimizations|_found) ==> STR
    :
    RESULT = Optimizations 
    CASE "$DEBUG" IN C.Defined_name[] ? 
         RESULT = RESULT.Replace("I", "").Replace("U", "") ; .


FUN TARGET_LANG|UAGE(
{Compiler} C|ompiler_with_options) ==> STR
	:
	RESULT = "Delphi"
	CASE ?
	["$FPC" IN C.Defined_name[]] ?
	     RESULT = "Free Pascal"
	["$KOL" IN C.Defined_name[]] ?
	     RESULT =_ ".KOL"
	; .
	     
CONST BOOL: ALLOW_EXIT_IN_NATIVE|_FUNCTIONS_BEFORE_NATIVE_CODE = TRUE .
CONST BOOL: SUPPORTS_NATIONAL_NAMES|_FOR_VARS_FUNCTIONS_TYPES = FALSE .

METHOD Need_compile({Type} C|lass_to_check) ==> BOOL :
	CASE "$REBUILD" IN Comp.Defined_name[] ? RESULT = TRUE ==> ;
	BOOL no_tests|_mode = !Need_any_tests(Comp)
	CASE !no_tests ? Comp.At_least_1_class_need_testing = TRUE ;
    //DEBUG: "Need_compile(" C.Names[0] ")? no_tests=" no_tests.S #NL ;
	CASE !Comp.Local_optimizations && Comp.Optimizations.Trim != "" ? 
	     RESULT = TRUE ==> ;
	STR class_path = Output_path_class(C)
    CASE !class_path.Exists ? RESULT = TRUE ==> ;
    CASE (!no_tests || Comp.TEST_value) && !Output_test_path_class(C).Exists ? 
         RESULT = TRUE ==> ;
    {File_path}.{file_detail} d_in|put_file = File_detail(C.Path) 
    CASE !no_tests && Output_test_path_class(C).Exists ? 
         {file_detail} d_out|_file = File_detail(Output_test_path_class(C))
         CASE d_out.Modified.Date_time .Compare(d_in.Modified.Date_time) < 0 ?
              RESULT = TRUE ==> ;
    ;
    d_out = File_detail(class_path)
    CASE d_out.Modified.Date_time .Compare(d_in.Modified.Date_time) > 0 ? ==> ;
    RESULT = TRUE .
    
METHOD Output_path_class|_compiled(
{Type} C|lass_to_path) ==> STR
    :
    STR path|_output = "unit" C.Final_name ".pas" 
    RESULT = Comp.Destination.Trailing_slash "" path.Extract_file_name .
        
METHOD Output_test_path_class|_compiled(
{Type} C|lass_to_path) ==> STR
    :
	CASE "TEST$" IN Comp.Destination ? RESULT = Output_path_class(C) ==> ;
    STR path|_output = "unit" C.Final_name ".pas"
     
    RESULT = Comp.Destination.Trailing_slash "TEST$".Trailing_slash 
    	"" path.Extract_file_name .
    	
{Compiler} Comp|iler
STR td|eclare_types_interface_part[]
STR fd|eclare_functions_and_vars  []
STR im|plementation_part[]
STR post|_code[]
STR spaces|_prefix

BOOL NOERR_option
BOOL NOEXCEPTIONS_option
STR SYSDCU_path
BOOL NOTRY_option
BOOL MEMDIAG|NOSTICS_OPTION

FUNCTION colored_mes|sage_to_console(
	{Console}.{colors} C|olor_of_message, 
	STR Text|_of_message)
	:
	Console_color(C)
	<< Text #NL .
	
STR Target|_only_FPC_can_compile_for_Linux = "WINDOWS"
STR Possible_platforms = "WINDOWS, LINUX"
BOOL alltogether|_initial_compiling_not_using_dll
STR real_type = "Double"

FUNCTION Prepare_project_generator(
	{Compiler} C|ompiler_obj) ==> {Generator}, NEW
	:
	g|enerator_temp = {Generator}(Comp = C,
    	alltogether = C.Changed_classes[].Count == 0)
    	
	FOR c IN C.All_classes[] :
	    //CASE c.Loaded_from_ccc ? g.Any_class_from_ccc = TRUE ;
		g.collect_defined_arrays(c) ; 
		
	RESULT = g .
	
FUNCTION Index_last(
STR A|rray_of_strings[*], STR S|tring_to_find_last) ==> INT
    :
    FOR a IN A[* DOWNTO 0] :
        CASE a == S ? RESULT = a.INDEX ==> ;
    ;
    RESULT = -1 .
	
//BOOL Any_class_from_ccc
BOOL FPC|_target
BOOL SMALLER_CODE
BOOL SMALLEST_CODE

FUNCTION Create_project(
	{Generator} G|enerator, {Compiler} C|ompiler_obj) ==> BOOL
	:
	{Generator} g|enerator_passed = G
	RESULT = FALSE
	//DEBUG: << "Destination=[" C.Destination "]"#NL ;
	------------------------------ 'fix some system functions'
	C.SYSFUN_Str.Final_name = "Int2Str"
	C.SYSFUN_RealStr.Final_name = "Real2Str"
	C.SYSFUN_BoolStr.Final_name = "Bool2Str"
	------------------------------ 'rename simple structures'
	BOOL c_st|ructure_as_class 
	c_st = C.Defined_name[0 TO *].Contains("$SCLASS", TRUE)
	c_st ||= C.Defined_name[0 TO *].Contains("$STRUCTUREASCLASS", TRUE)  
	CASE !c_st ?
		 FOR c IN C.All_classes[] :
		     FOR st IN c.Structures_[] :
		    	 CASE st.is_simple_struc ?
		    	      st.Final_name
		    	      = st.Final_name[0].Lower st.Final_name[1 TO *]
		    	 ;
		     ;
		 ;
	;
    ------------------------------------------- 'make generator'

    g.NOERR_option = "$NOERR" IN C.Defined_name[]
    g.NOEXCEPTIONS_option = "$NOEXCEPTIONS" IN C.Defined_name[]
    CASE "$SYSDCU" IN C.Defined_name[] ?
         g.SYSDCU_path = C.Defined_value[C.Defined_name[].Find("$SYSDCU")] ;
    g.NOTRY_option = "$NOTRY" IN C.Defined_name[]
    g.FPC = "$FPC" IN C.Defined_name[]
    FOR dfn IN C.Defined_name[] :
        CASE dfn !IN ["$KOL", "$ASM_VERSION", "$NOERR", "$NOEXCEPTIONS",
        	 "$SYSDCU", "$SMALLER_CODE", "$SMALLEST_CODE", "$NOTRY", "$UNICODE",
        	 "$KEY_PREVIEW", 
"$INC", "$INCREMENTAL", // leave the option here just to warn that it is abandoned 
        	 "$FPC", "$NOINTERFACES",
        	 "$MEM_DIAG", "$MEMORY_DIAGNOSTICS", "$TARGET", "$ICON", "$NOTDLL",
        	 "$NOLONGOP", "$FREE_NONE_OBJECTS", "$REPORT_LEAKS", "$MAXI2",
        	 "$REAL", "$VISUAL", "$ALLTESTS", "$NOTESTS", "$COMPILER",
        	 "$TEST_IN_WINDOWS", "$LINUX_LAZARUS_HOME", "$NO_STMT_NUM",
        	 "$baseutils", "$WRITE", "$WRITE_DIRECT", 
        	 "$BGRABITMAP", 
        	 "$KOLGRAPHIC", "$PNGOBJECT",
        	 "$RXGIF", "$DEFINE", "$NORTTI", "$SCLASS", "$STRUCTUREASCLASS",
        	 "$RTTIONLY", "$ALLARRAYS",
        	 "$PROFILER", "$DELPHI5", "$DELPHI3", "$CCC",
        	 "$NO_SIDE_EFFECTS", "$DEBUG", "$REBUILD", "$NOJMP"]
        	 ?
             C.Error("Unknown option: " dfn) ;
    ;
	CASE Get_environment_var("FORCE_DELPHI") ? 
	["5"]: C.Defined_name[] << "$DELPHI5"
		   C.Defined_value[] << ""
	["3"]: C.Defined_name[] << "$DELPHI5" << "$DELPHI3"
		   C.Defined_value[] << "" << ""
		   //DEBUG: << "forced delphi "  C.Defined_name[*] >> ;
	;     
	------------ 'CHECK /INT32'
	CASE !C.Int32 ? 
		 CASE "$DELPHI3" IN C.Defined_name[] ?
		      C.Error("Option /$DELPHI3 was specified but /int32 not: int64 "
		      "does not supported by Delphi 3 compiler"._EDelphi3_int64) ;
	;
	
    ----- 'smaller_code >= smallest_code'
    CASE "$SMALLER_CODE" IN C.Defined_name[] ? g.SMALLER_CODE = TRUE ;
    CASE "$SMALLEST_CODE" IN C.Defined_name[] ? 
         g.SMALLER_CODE = TRUE
         g.SMALLEST_CODE = TRUE ;
    CASE C.Verbose ?
         Console_color('LIME')
         CASE "$KOL" IN C.Defined_name[] ?
              colored_mes('LIME', "/$KOL option is set"._Mkol)
              CASE "$ASM_VERSION" IN C.Defined_name[] ?
                   colored_mes('LIME',
                   "/$ASM_VERSION option is set (use assembler code)"._Masm)
              ELSE colored_mes('RED', 
              	   "/$ASM_VERSION is not set, use PAS_VERSION"._Masm2)
              ;
              CASE "$NOERR" IN C.Defined_name[] ?
                   colored_mes('LIME',
                   "/$NOERR option is set (err wouldn't be used)"._Mnoerr)
              ELSE colored_mes('RED',
                   "/$NOERR is not set, err units are used"._Mnoerr2)
              ;
              CASE "$NOEXCEPTIONS" IN C.Defined_name[] ?
                   colored_mes('LIME',
                   "/$NOEXCEPTIONS is set (exceptions will not be used)"._Mnoex)
              ELSE colored_mes('RED',
                   "/$NOEXCEPTIONS is not set - exceptions are used"._Mnoex2)
              ;
              CASE "$SYSDCU" IN C.Defined_name[] ?
                   colored_mes('LIME', "/$SYSDCU option is set to"._Msysdcu 
                      ": " C.Defined_value[C.Defined_name[].Find(
                      "%SYSDCU")])
              ELSE colored_mes('RED',
                   "/$SYSDCU option is not set, use %KOLPATH% or $KOLPATH "
                      "directory only"._Msysdcu2)
              ;
              --------------------- 'more descripted options in terminal'
              CASE g.SMALLER_CODE ?
                   colored_mes('LIME', "/$SMALLER_CODE is set"._Msmaller)
              ELSE colored_mes('RED', "/$SMALLER_CODE is not set"._Msmaller2)
              ;
              CASE g.SMALLEST_CODE ?
                   colored_mes('LIME', "/$SMALLEST_CODE is set"._Msmallest)
              ELSE colored_mes('RED', "/$SMALLEST_CODE is not set"._Msmallest2)
              ;
              CASE "$NOTRY" IN C.Defined_name[] ?
                   colored_mes('LIME',
                   "/$NOTRY option is set: a bit dangerous but smaller code "
                   "will be provided"._Mnotry)
              ELSE colored_mes('RED',
                   "/$NOTRY option is not set - use try-finally to release "
                   "local variables"._Mnotry2)
              ;
              CASE "$UNICODE" IN C.Defined_name[] ?
                   colored_mes('CYAN',
                   "/$UNICODE option is set - unicode version of KOL "
                   "controls"._Municode ", "
                   "" ("but this is not implemented"._MbutNotImplement))
              ELSE colored_mes('RED',
              	   "/$UNICODE option is not set - ANSI version of KOL "
              	   "controls"._Municode2)
              ;
              CASE "$KEY_PREVIEW" IN C.Defined_name[] ?
                   colored_mes('CYAN',
                   "/$KEY_PREVIEW option is set"._Mkey_preview )
              ELSE colored_mes('RED',
              	   "/$KEY_PREVIEW option is not set"._Mno_key_preview)
              ;
              -------------------- 'incremental compiling: abandoned'
              CASE "$INC" IN C.Defined_name[] 
              	|| "$INCREMENTAL" IN C.Defined_name[]
              	   ?
              	   C.Error("$INCREMENTAL option is abandoned")
              ;
         ELSE
         	CASE g.FPC ? << "FPC prject is generating"._Mfpc #NL
         	ELSE << "VCL project is generating"._Mvcl #NL ;
         	
         	CASE ?
         	["$NOINTERFACES" IN C.Defined_name[]] ?
         	     colored_mes('LIME', "/$NOINTERFACES option is set - "
         	     "smaller FPC code will be produced"._Msmallerfpc)
         	["$FPC" IN C.Defined_name[]] ?
         		 colored_mes('RED', "/$NOINTERFACES option is not set: "
         		 "generating GUI application with FPC"._Mguifpc) ;
         ;
         -------------------- '$REAL=Extended'
         CASE "$REAL" IN C.Defined_name[] ?
              STR rt|ype_real = C.Defined_value[C.Defined_name[].Find("$REAL")]
              CASE rt.Upper IN ["SINGLE", "DOUBLE", "EXTENDED"] ?
                   colored_mes('LIME', "/$REAL=" rt " option is set"._MrealSet)
              ELSE colored_mes('RED', "/$REAL=" rt " option is set wrong") ;
              
         ELSE colored_mes('SILVER', "/$REAL option is not specified, DOUBLE "
         	  "is used by default)"._MrealDouble)
         ;    
         -------------------- '$MEMDIAG'
         CASE "$MEMDIAG" IN C.Defined_name[] || (
         	  "$MEMORY_DIAGNOSTICS" IN C.Defined_name[])
         	  ?
              colored_mes('LIME', "/$MEMORY_DIAGNOSTICS option is set to allow "
              "detecting memory leaks"._Mmemdiag_set)
         ELSE colored_mes('RED', "/$MEMDIAG option is not set"._Mmemdiag_notset)
    	 ;
         Console_color('SILVER')
    ;
    CASE "$NOTDLL" IN C.Defined_name[] ?
         STR s_not_dll|_classes_list = C.Defined_value[
           	  C.Defined_name[].Find("$NOTDLL")]
         Split(g.not_dll[], s_not_dll, ";")
         //DEBUG: << "not dll classes: " s_not_dll >> STR dummy_input ; 
    ;	
	CASE "$KOL" IN C.Defined_name[] && Get_environment_var("KOLPATH") == ""
	 	 ?
	     colored_mes('RED', "Option /$KOL is set but system variable "
	     "KOLPATH is not set. This may lead to fail of Delphi compiler to "
	     "compile the application."._MOptionKOL)
	;
    Console_color('SILVER')
    CASE "$REAL" IN C.Defined_name[] ?
         rt = C.Defined_value[C.Defined_name[].Find("$REAL")]
         CASE rt.Upper IN ["SINGLE", "DOUBLE", "EXTENDED"] ?
              g.real_type = rt ;
    ;
    CASE "$MEMDIAG" IN C.Defined_name[] || (
         	  "$MEMORY_DIAGNOSTICS" IN C.Defined_name[])
         	  ?
              g.MEMDIAG = TRUE ;
    ------------------------------------------- 'target'
    CASE "$TARGET" IN C.Defined_name[] ?
         CASE !g.FPC ?
              C.Error("Only free pascal ($FPC) allows selecting $TARGET"
              ""._EOnlyFPC)
         ;
		 g.Target = C.Defined_value[C.Defined_name[].Find("$TARGET")].Upper
		 CASE g.FPC && g.Target !IN ["WINDOWS", "LINUX"] ?
		      C.Error("Target platform is not supported"._EPlatformNotSupported
		      ": " g.Target " (" ("possible platforms are"._EPossiblePlatforms)
		      ": " g.Possible_platforms ")") ;
    ;
    CASE C.TEST_value && "$TEST_IN_WINDOWS" IN C.Defined_name[]
    	 ?
    	 g.Target = "WINDOWS" ;
    ------------------------------------------- 'delete old compilation'
    CASE C.Changed_classes[].Count == 0 ? 
	     g.Collect_pas_files(C.Destination.Trailing_slash)
    ;
    g.Delete_unnecessary_pas(C.Destination.Trailing_slash)
    ------------------------------------------- 'generate project'
    RESULT = g.do_generate
    CASE !RESULT || "test" IN Start_dir.Lower ? ==> ;
    ------------------------------------------- 'free pascal'
    CASE g.FPC && g.kol >= 0 ?
         C.Error("Options $KOL and $FPC are not compatible"._EKOLFPC) ;
    CASE g.Target != "WINDOWS" && "$FPC" !IN C.Defined_name[] ?
    	 C.Error("Option /$FPC must be set for all non-WINDOWS "
    	 "targets"._EOptionFPC) ;
    ------------------------------------------- 'optimize usingg jmp'
    CASE "$NOJMP" IN C.Defined_name[] ? 
         g.Use_jumps = FALSE ;
    ------------------------------------------- 'prepare parameters'
    STR dest|ination = C.Destination.Trailing_slash
    STR param|eters = dest C.Project ".dpr -E" dest
    CASE g.defines != "" ? param =_ " " g.defines ;
    CASE g.real_type.Upper ?
    ["EXTENDED"]: param =_ " -dREAL_EXTENDED"
    ["SINGLE"]: param =_ " -dREAL_SINGLE" ;
    ------------ 'additiona graphic formats which are optional'
    CASE "$BGRABITMAP" IN C.Defined_name[] ?
         param =_ " -dBGRABITMAP" ;
    CASE "$RXGIF" IN C.Defined_name[] ?
         param =_ " -DRXGIF"
         INT rx|_gif_index INDEXING STR = C.Defined_name[].Find("$RXGIF")
         CASE ?
         [C.Defined_value[rx] != ""] ?
              param =_ " -U" C.Defined_value[rx]
         [Get_environment_var("RXLIB") != ""] ?
              param =_ " -U" Get_environment_var("RXLIB")
              
         ELSE C.Error("/$RXLIB option is set but the environment variable "
         	  "RXLIB is not defined (it should define a path to RxLib units "
         	  "directory)"._WRxLib) 
         ;
    ;
    CASE "$PNGOBJECT" IN C.Defined_name[] ? 
         param =_ " -U" Get_environment_var("PNGOBJECT") ;
    CASE "$KOLGRAPHIC" IN C.Defined_name[] ?
         param =_ " -dKOLGRAPHIC -dNOCLASSES"
         " -U" Get_environment_var("KOLPATH").Trailing_slash 
         "Components\KOLGraphic"
    ;
    CASE "$DEFINE" IN C.Defined_name[] ?
         STR def|indes[].Split(
         	C.Defined_value[C.Defined_name[].Find("$DEFINE")], ",")
         	
         FOR dd IN def[] : param =_ " -d" dd ;
         CASE C.Defined_name[].Find(
              "$DEFINE") < Index_last(C.Defined_name[0 TO *], "$DEFINE")
              ?
              C.Error("All defines should be defined with a single /$DEFINE=..."
              " directive (comma separated)"._EMultipleDefine) ;
    ;

    CASE C.Defined_name[0 TO *].Contains("$SCLASS", TRUE) 
    	 || C.Defined_name[0 TO *].Contains("$STRUCTUREASCLASS", TRUE)
    	 ?
         param = param " -dSTRUCTUREASCLASS" ;
    ------------------------------------------- 'compile tests project'
    STR exe|_path = dest C.Project 
    CASE g.Target == "WINDOWS" ? exe = exe ".exe" ;
		FOR attempt IN [1 TO 2] :
		    CASE exe.Exists ?
		    	 Delete_file(exe) ;
		    CASE ?
		    [exe.Exists && attempt == 1] ?
		         Console_color('CYAN')
		         
		         << "Executable can not be deleted. Close application which "
		         	"opened it and press Enter"._MCannotdelete >>
		         	
		         Console_color('SILVER')
		         
		    [exe.Exists && attempt == 2] ?
		         C.Error("Can not delete"._Ecannot1 " " exe)
		         RESULT = FALSE ==>
		    ELSE BREAK attempt ;
		;
    Set_working_dir(dest)
    CASE g.FPC ?
         STR params|_in_file[] << @
         	 "-dfpc"
         	 "-MObjFPC"
         	 "-dOBJFPC"
         	 "-Scghi"
         	 "-O"
         CASE C.TEST_value ? 
              params[*] =_ "1"
              params[] << "-g" << "-gl"
         ELSE 
         	  CASE C.Optimizations IN ["", "-"] ?
         		   params[*] =_ "1"
         	  ELSE params[*] =_ "3" ;
         	  CASE C.Debugging ? params[] << "-g" << "-gl"
         	  ELSE params[] << "-Xs" << "-CX" << "-XX" ;
         ;
         CASE ?
         ["$NOINTERFACES" IN C.Defined_name[] && g.Target == "WINDOWS"] ?
              params[] << "-WG-"
         [g.Target == "WINDOWS"] ?
              params[] << "-WG"
         ;
         params[] << "-viewbq" 
         CASE "$DEFINE" IN C.Defined_name[] ?
              def[].Split(C.Defined_value[C.Defined_name[].Find("$DEFINE")],",")
              FOR dd IN def[] : params[] << "-d" dd ;
         ;
         -------------------------------- 'Lazarus home'
         STR laz|arus_home = Get_environment_var("LAZARUS_HOME")
         CASE "$LAZARUS_HOME" IN C.Defined_name[] ?
              laz = C.Defined_value[C.Defined_name[].Find("$LAZARUS_HOME")] ;
         CASE ?
         [laz == "" && g.Target == "WINDOWS"] ?
              C.Warning("Neither the LAZARUS_HOME environment variable "
              "nor the /$LAZARUS_HOME option is set, trying C:\lazarus\"._ELaz)
              laz = "C:\lazarus\"
              CASE !laz.Directory_exists ? 
                   C.Error("Directory does not exist"._EDirDoesNot
                   ": " laz) ;
         [laz == ""] ?
              << "$LAZARUS_HOME was not set, suppose "#QU laz #QU#NL
         ;
         CASE g.Target == "WINDOWS" && !laz.Directory_exists ?
              C.Error("Directory not found"._EDir ": " laz) ;
         CASE g.Target != "WINDOWS" && !C.TEST_value
         	  && "$TEST_IN_WINDOWS" IN C.Defined_name[]
         	  ?
              CASE "$LINUX_LAZARUS_HOME" IN C.Defined_name[] ?
                   laz = C.Defined_value[C.Defined_name[].Find(
                   		 "$LINUX_LAZARUS_HOME")]
              ;
         ;
         CASE g.Target == "WINDOWS" ?
              laz = laz.Add_trailing("\")
         ELSE laz = laz.Add_trailing("/") ;
         ------------------------- 'paths and params depending on $TARGET'
         CASE "typhon" IN laz ?
              STR baseutils = "BaseUtils"
         ELSE baseutils = "lazutils" ;
         CASE ? 
         [g.Target == "WINDOWS"] ?
	          params[] << @
	          	 "-dWIN32"
	         	 "-dLCL"
	         	 "-dLCLwin32" //necessary for openglcontext.pas
	         	 "-Filib\i386-win32"
	         	 "-Fu" laz "components\printers"
	         	 "-Fu" laz "components\printers\win32"
	         	 "-Fi" laz "components\printers\win32"
	         	 "-Fu" laz "components\datetimectrls"
         		 "-FU" C.Destination ""
         		 
	          params[] << @
	             "-Fu" laz "lcl\units\x86_64-win64"
	             "-Fu" laz "lcl\units\x86_64-win64\win32"
	             "-Fu" laz "components\" baseutils "\lib\x86_64-win64"
	             
	          params[] << @
                 "-Fu" laz "lcl\units\i386-win32"
                 "-Fu" laz "lcl\units\i386-win32\win32"
                 "-Fu" laz "components\" baseutils "\lib\i386-win32"
                 
              CASE "typhon" IN laz ?
                   params[] << "-Fu" laz "components\lz_DateTimeCtrls"
                   			   "\lib\x86_64-linux\gtk2\"
              ELSE
                   params[] << "-Fu" laz "components\datetimectrls"
              ;
               
         [g.Target == "LINUX"] ?
         	  params[] << @
	         	 "-dLCL"
	         	 "-dLCLgtk2"
	         	 "-dLINUX"
         		 "-FU."
	         	 "-Fu" laz "components/" baseutils "/lib/x86_64-linux"
	         	 "-Fu" laz "lcl/units/x86_64-linux"
	         	 
         	  params[] << @
         	  	"-Fu" laz "components/" baseutils "/lib/i386-linux"
         	  	"-Fu" laz "lcl/units/i386-linux"
         	  	
         	  CASE "$NOINTERFACES" IN C.Defined_name[] ?
         	   params[] << @
         "-Fu" laz "components/gtk2"
         "-Fu" laz "components/printers/lib/x86_64-linux/gtk2"
         "-Fu" laz "components/cairocanvas/lib/x86_64-linux/gtk2"
         "-Fu" laz "packager/units/x86_64-linux"
         	  ELSE     
         	   params[] << @
         "-Fu" laz "lcl/units/x86_64-linux/gtk2"
         "-Fu" laz "lcl/interfaces/gtk2"
         "-Fu" laz "components/printers/lib/x86_64-linux/gtk2"
         "-Fu" laz "components/cairocanvas/lib/x86_64-linux/gtk2"
         "-Fu" laz "packager/units/x86_64-linux"
         	  ;
         	  CASE ?
         	  ["$NOINTERFACES" !IN C.Defined_name[] && "typhon" IN laz] ?
         params[] << "-Fu" laz "components/lz_OpenGL"
                   			   "/lib/x86_64-linux/gtk2/"
                   			   
         			..[] << "-Fu" laz "components/opengl"
              ["$NOINTERFACES" !IN C.Defined_name[]] ?
         params[] << "-Fu" laz "components/datetimectrls/lib/x86_64-linux/gtk2/"
         			..[] << "-Fu" laz "components/opengl"
              ;
              CASE "$NOINTERFACES" IN C.Defined_name[] ?
         	   params[] << @
         "-Fu" laz "components/datetimectrls"
         "-Fu" laz "components/opengl"
              ELSE
         	   params[] << @
         "-Fu" laz "lcl/units/i386-linux/gtk2"
         "-Fu" laz "components/opengl"
         	  ;
              CASE "typhon" IN laz ?
                   params[] << "-Fu" laz "components/lz_DateTimeCtrls"
                   			   "/lib/x86_64-linux/gtk2/"
              ;
         	  STR lh|ome_of_lazarus_in_Windows 
         	  	= Get_environment_var("LAZARUS_HOME")
         	  	
         	  CASE lh == "" ? lh = "C:\lazarus\" ;
         	  CASE "$TEST_IN_WINDOWS" !IN C.Defined_name[]
         	  	   ?
         	  	   lh = laz.Add_trailing("/") 
         	  	   STR slash|_used = "/" 
         	  ELSE slash = "\"	   
         	  ;
         	  
         ELSE C.Error("Do not know which -Fu/-Fi parameters should be for "
         	  "target"._EDontknowParams " " g.Target)
         ;
         
         params[] << "-Fu."
         	
         CASE "$BGRABITMAP" IN C.Defined_name[] ?
              STR bgra_path = Get_environment_var("BGRABITMAP_UNITS")
               
              params[] << @
              "-Fu" bgra_path ""
              "-dBGRABITMAP"
              
              CASE bgra_path == "" ?
                   << "Environment variable BGRABITMAP_UNITS is not set" >>
              ;
		 ;         	
         CASE g.real_type.Upper ?
         ["EXTENDED"]: params[] << "-dREAL_EXTENDED"
         ["SINGLE"]: params[] << "-dREAL_SINGLE" ;
         CASE "$NOINTERFACES" IN C.Defined_name[] ?
              params[] << "-dNOINTERFACES" ;
         CASE " " IN  C.Destination ?
              C.Error("There are spaces in destination path"._ESpaces 
              ": " C.Destination) ;
         CASE "/"  IN laz ?
              replace_slashes(params[]) ;
         Text_save(C.Destination.Trailing_slash "_params.txt", params[])
         ----------------------------------- 'create batch file for compile'
         CASE g.Target == "LINUX" 
         	  && (C.TEST_value && "$TEST_IN_WINDOWS" !IN C.Defined_name[]
         	  || !C.TEST_value)
         	  ?
              INT redir|ect_compiler_output = 1
              BOOL in_linux = TRUE
         	  STR bat|ch_file[] << "#!/bin/bash" 
         ELSE redir = 1 ;
         bat[] << "fpc @_params.txt "#QU C.Project ".dpr"#QU 
         CASE "$PAUSE" IN C.Defined_name[] ?
              bat[] << "pause" ;
         CASE in_linux ?
              redir = 0
              STR compile_bat = C.Destination.Add_trailing("/") "_compile.sh"
              Unix_text_save(compile_bat, bat[])
         ELSE compile_bat = "_compile.bat"
         	  Text_save(C.Destination.Trailing_slash compile_bat, bat[]) ;
         //CASE g.alltogether || !g.incremental ?
         CASE g.alltogether ?
	          CASE g.Target == "LINUX" 
	    	 	   && "$TEST_IN_WINDOWS" IN C.Defined_name[]
	    	 	   && !C.TEST_value
	    	 	   ?
	    	       Console_colors('WHITE', 'MAROON')
	    	       
	    	       << "The target is not MS Windows system "
	    	       "(LINUX or MAC or another)"
	    	       " -- to compile the project, run in the target "
		     	   "environment"._MTargetNotWindows 
		     	   ": " C.Destination.Trailing_slash compile_bat
		     	   
	     	  	   Console_colors('SILVER', 'MAROON') 
	     	  	   RESULT = TRUE ==>
	          ;
	          CASE in_linux ?
	               NONE = Execute_program(
    	 	  		"/bin/bash", "-c 'chmod 0777 "
    	 	  		#QU compile_bat #QU"'", 0) //redir)
	          ;
    	 	  STR text_out|put_of_fpc_or_dcc = Execute_program(
    	 	  		compile_bat, "", redir)
    	 	  		
    	 	  CASE in_linux ?
    	 	  	   bat[] << "read -n1 -r -p "#QU"Press any key to continue..."#QU
    	 	  	   
    	 	  	   Unix_text_save(C.Destination.Trailing_slash compile_bat,
    	 	  	   	bat[])
    	 	  	   
    	 	  ELSE
    	 	  	   bat[] << "pause"
    	 	  	   Text_save(C.Destination.Trailing_slash compile_bat, bat[])
    	 	  ;
         ;

    ELSE // Delphi32
	     ------------------------------------------- 'find dcc32'
	     STR entire_text[]
	     STR text|_to_show[]
	     STR dcc|_path_to_dcc32_exe
	     STR dcc_p|ath_in_start_dir = Get_environment_var("DCC32")
	     CASE dcc_p != "" ?
	          //DEBUG: << "environment: dcc_p=" dcc_p #NL ;
	          dcc = dcc_p.Trailing_slash "dcc32.exe"
	     ELSE dcc = Start_dir.Trailing_slash "dcc32.cmd" ;
	     //DEBUG: << "dcc=" dcc >> ;
	     CASE !dcc.Exists ?
	          dcc_p = C.Destination
	          CASE !dcc_p.Directory_exists ? dcc_p.Create_dir ;
	          dcc = dcc_p.Trailing_slash "dcc32.cmd"
	          ------------------------------------------- 'create dcc32.cmd'
	          CASE ! dcc.Exists ?
	               STR dcc_t|ext[] << "dcc32.exe " #QU "%1" #QU
	               save_dcc|_temp = {Text_file}(Path = dcc) ;
	          CASE save_dcc != NONE && C.Verbose ?
	                    << "saving"._MSaving ": " dcc_p " ... " ;
	          CASE save_dcc != NONE ?
	               NONE = save_dcc.Save(dcc_t[])
	               dcc_t[].Clear 
	          ;
	          CASE save_dcc != NONE && C.Verbose ?
	                    << "saved"._MSaved #NL ;
	          ------------------------------ 'use dcc32.cmd or dcc32.exe ?'
	          CASE dcc == "" ?
	               C.Error("Can not compile (compiler dcc32.exe or dcc32.cmd was "
	               "not found"._Ecannot2 ) ==> ;
	     ;
	     redir = 1
	     --------------------------- 'compiling main program code'
	     //CASE g.alltogether || !g.incremental ?
	     CASE g.alltogether ?
	          bat[].Clear
	          bat[] << #QU dcc #QU " " param
	          bat[] << "pause"
	          Text_save(C.Destination.Trailing_slash "_compile.cmd", bat[])
		      CASE C.Verbose ?
		           << "Running"._Mrunn ":" #NL dcc " " param #NL ;
	          ---------------- 'execute compiler'
		      text_out = Execute_program(dcc, param, redir)
		      ---------------------------- 'out messages to console'
		      Split(text[], text_out, #LF)
		      g.out_messages_to_console(text[])
		      ---------------------------- 'fin out messages'
		      FOR ss IN text[] : entire_text[] << ss ;
		      wait_exists(exe, 1000)
	     ;
	     --------------------- 'end compiling'
    ;
    -------------------------------- 'save all messages'
    messages|_temp = {Text_file}(Path = dest C.Project
        ".compiler-messages.txt")
        
    NONE = messages.Save(entire_text[])
    STR tests|_temp = ""
    CASE C.TEST_value ? tests = "tests " ;
    CASE !exe.Exists ?
         C.Error("Can not compile"._Ecannot3 " " tests "(" ("file"._Efile ) 
         " " exe " " ("was not created"._Ewasnot ) ")")
         RESULT = FALSE ==> ;
    -------------------------- 'output statistics + info on size of executable'
    C.Executable = exe 
    C.Time_finished = Now
    C.Statistics_show 
    CASE !C.TEST_value && !C.Run ? ==> ;
    -------------------------------------------- 'run tests or compiled program'
    CASE C.Verbose && C.TEST_value ? << "Running tests"._Mrunn2 #NL ;
    CASE C.Verbose && !C.TEST_value && C.Run ?
         << "Running compiled application"._Mrunn3 #NL ;
    param = ""
    CASE !C.TEST_value?
         //DEBUG: << #NL"............................................"#NL
         //		      "passing params: [[" C.Param "]]"#NL
         //		      "............................................"#NL ;
         param = C.Param ;
    INT wait|_redirect_output_flag = 0
    CASE in_linux ? wait = 0 ;
    -------------------------------------------- 'save messages'
    STR mpath|_of_compiler_messages = dest.Remove_ending("TEST$".Trailing_slash)
    	"Compiler_messages.html"
    	
    {Memory_stream_contig} save_mes|sages_temp = File_to_memory(mpath)
    -------------------------------------------- 'execute test or program'
    text_out = Execute_program(exe, param, wait)
    Split(text[], text_out, #NL)
    g.out_messages_to_console(text[])
    Text_save(C.Destination.Trailing_slash "_running_output.txt", text[])
    -------------------------------------------- 'restore messages'
	{File_stream} fsave|_back_temp = Write_file_stream(mpath, FALSE)
	save_mes.Rewind
	fsave.Copy_stream(save_mes)
	fsave.Close
    -------------------------------------------- 'if report leaks was requested'
    CASE C.Defined_name[].Find("$REPORT_LEAKS") >= 0 ?
         STR path_rep|ort = C.Destination.Trailing_slash "Report_leaks.txt"
         CASE ! path_rep.Exists ?
              Console_color('RED')
              << "Could not report leaks (file " path_rep " was not found)" #NL
              Console_color('SILVER') ==> ;
         text[].Clear
         messages.Path = path_rep
         NONE = messages.Load_strings(text[])
         CASE text[].Count == 0 ?
              Console_color('GREEN')
              << "There were not leaks detected" #NL
              Console_color('SILVER')
         ELSE Console_color('RED')
              << "There were leaks in " (text[].Count-1).Str " classes" #NL
              Console_color('SILVER') ;
    ; .
    
BOOL Use_jumps|_assembler_command_for_Delphi_in_all_classes_methods
STR not_dll|_classes[]

METHOD Ide_debug ==> BOOL :
    = !Compiler.Final && "$DEBUG" IN Compiler.Defined_name[] .

METHOD class_in_not_dll({Type} C|lass_in_not_dll) ==> BOOL :
	 RESULT = C.Names[0] IN not_dll[] 
	 RESULT ||= C.Names[1] != "" && C.Names[1] IN not_dll[] .
	 
METHOD class_to_dll({Type} C|lass_to_dll) ==> BOOL :
	RESULT = !class_in_not_dll(C) .

FUN wait_exists(
	STR Path|_of_file_to_wait, INT Millisecond|s_wait)
	:
	------------------- 'wait executable created - about 1 sec more'
    FOR attempts|dummy IN [1 TO (Millisecond+9) / 10] :
        CASE Path.Exists ? ==> ;
        Sleep(100) ; .
 

FUN replace_slashes(STR Text|_commands_paths[]) :
	FOR s IN Text[]:
	    CASE "\" !IN s ? CONTINUE s ;
	    FOR i IN [0 TO s.Len-1]:
	        CASE s.[i] == "\" ? s = s.[0 TO i-1] "/" s.[i TO *] ;
		;	        
		Text[s.Index] = s ; .
		
STR list_pas|_files_in_target_directory[]
    
METHOD Collect_pas_files|_names_in_target_directory(
STR Path|_where)
	:
	list_pas[].Clear
	Catalog(Path, list_pas[])
	FOR s IN list_pas[* DOWNTO 0] :
	    CASE s.Lower.Ending(".pas") ? CONTINUE s ;
	    list_pas[].Delete(s.Index) ; .
	    
METHOD Delete_unnecessary_pas|_files_in_target_directory(
STR Path|_where)
	:
    //FOR c IN Comp.All_classes[] :
    //    CASE c.Loaded_from_ccc ? ==> ;
    //;
    CASE "$REBUILD" !IN Comp.Defined_name[] ? ==> ;
	----------------------- 'remove some pas files'
	STR bat|_file_deleting_unnecessary_pas_files[]
	FOR s IN list_pas[] :
	    CASE s.Lower IN ["al4.pas", "all_classes.pas"] ? CONTINUE s ;
	    FOR c IN Comp.All_classes[] :
	        STR n|ame_of_output_file = "unit" c.Final_name ".pas"
	        CASE n.Lower == s.Lower ? BREAK c, CONTINUE s ;
	    ;
	    FOR cf IN Comp.Copy_files[] :
	        cf = cf.Remove_starting("<bin>").Trim.Lower
	        CASE cf == s.Lower ? BREAK cf, CONTINUE s ;
	    ;
	    CASE Target == "WINDOWS" ?
	    	 bat[] << "del /q " #QU Path s.Change_ext(".*") #QU
	    ELSE
	    	 bat[] << "rm -f " #QU Path s.Change_ext(".ppu") #QU 
	    	 bat[] << "rm -f " #QU Path s.Change_ext(".o") #QU 
	    	 bat[] << "rm -f " #QU Path s #QU
	    ;
	;
	CASE bat[].Count == 0 ? ==> ;
    CASE Target == "WINDOWS" ?
         Text_save(Path "del_pas.bat", bat[])
         NONE = Execute_program(Path "del_pas.bat", "", 0)
    ELSE bat[].Insert(0, "#!/bin/bash")
         Unix_text_save(Path "del_pas.sh", bat[])
         NONE = Execute_program("/bin/bash", Path "del_pas.sh", 2) ; 
	.


METHOD out_messages_to_console(STR T|ext_messages[]) :
    Console_color('CYAN')
    FOR s IN T[] :
        s = s.RTrim
        CASE s.[0] == #CR ? s = s.[1 TO *] ;
        STR ss|_trimed = s.Trim
        CASE Starting(ss, "symbol  :") || (
             Starting(ss, "location:")) || (
             Starting(ss, "symbol:"))
             ?
             INT colon|_pos = s.Find(":")
             Console_color('YELLOW')
             << s.[0 TO colon]
             Console_color('CYAN')
             << s.[colon+1 TO *] #NL
             CONTINUE s ;
        CASE ?
        ["error:" IN s.Lower] ?
             STR error|_string = "error:"
        [FPC && "fatal:" IN s.Lower] ?
             error = "fatal:"
        ELSE error = "" ;
             
        CASE error != "" ?
             ------------------------------ 'red horizontal line'
             Console_color('RED')
             
             << "----------------------------------------"
             	"----------------------------------------"
             	
             Console_color('CYAN')
             ------------------------------ 'select error word with yellow'
             INT pos|ition_error = s.Lower.Find(error)
             << s.[0 TO pos-1]
             Console_color('YELLOW')
             << s.[pos TO pos+5]
             Console_color('CYAN')
             << s.[pos+6 TO *] #NL
        ELSE << s #NL ;
    ;
    Console_color('SILVER') .
    
METHOD unite_parts(STR Ou|tput_lines[]) :
	Ou[].Clear
	FOR s IN td[] : Ou[] << s ; 
	FOR s IN fd[] : Ou[] << s ; 
	FOR s IN im[] : Ou[] << s ; . 

STR suffix|es_dll_for_classes[]

METHOD do_generate ==> BOOL :
    ------------------------------ 'Before generating: fix some names of types'
    Comp.TYPE_INT.Final_name = "Integer"
    Comp.TYPE_BOOL.Final_name = "Boolean"
    Comp.THIS_var.Set_final_name("THIS")
    CASE !Comp.Destination.Directory_exists ?
         Comp.Destination.Create_dir
         //DEBUG: << "creating " Comp.Destination 
         //		   " result=" Comp.Destination.Directory_exists.S #NL ;
    ;
    ------------------------------ 'Fix final names for DATA in classes'
    FOR c IN Comp.All_classes[] :
        FOR fld IN c.Field[] :
            CASE fld.Names[0] != "DATA" ? CONTINUE fld ;
            DONE     
            fld.Set_final_name("DATA_" c.Final_name)
            BREAK fld ;
        FOR st IN c.Structures_[] :
            CASE "__" IN st.Final_name ? CONTINUE st ;
            st.Final_name =_ "__" c.Final_name ;
    ;
    FINAL_CODE = Comp.Final
    kol = Comp.Defined_name[].Find("$KOL")
    //DEBUG: << "before kol=" kol.S >> ;
    ----------------------------------------- 'setup profiler'
    CASE "$PROFILER" IN Comp.Defined_name[] ? 
         CASE Comp.Final ?
              Comp.Warning("Option /FINAL is set, so /$PROFILER is ignored"
              ""._Wfinal_Profiler_ignored)
              
         ELSE INT i_prof|iler INDEXING STR 
         	  i_prof = Comp.Defined_name[].Find("$PROFILER")
         	  use_profiler = Comp.Defined_value[i_prof].Upper
         	  CASE use_profiler == "" ? use_profiler = "FUNCTIONS" ;
         	  CASE use_profiler.[0] !IN "FCBLA" ?
         	       Comp.Warning("Unknown $PROFILER option"._WunknownProfiler 
         	       " " use_profiler ", " ("options allowed: FUNCTONS, COMMENTS"
         	       ", BRANCHES, LOOPS, ALL"._MallowedProfiler))
         	  ;
         ;
    ;
    ------------------------------ 'For all classes...'
    defined_arrays[].Clear
    suffix[].Clear
    FOR c IN Comp.All_classes[] :
        suffix[] << ""
        CASE !c.Compiled ?
             restore_ex_info(c)
             CONTINUE c ;
        STR path|_output = "unit" c.Final_name ".pas"
        //-------------------------------------- 'do not generate if from CCC?'
        STR ext|ention_generated_file = ".pas" 
        
        td[].Clear
        fd[].Clear
        im[].Clear   
        ------------------------------- 'clear ending lines ?'
        FOR s IN c.Ending_lines[] :
            CASE s.Trim == "*)" ?
                 INT closed_long_comm|ent_Pascal = closed_long_comm + 1
                 CONTINUE s ;
            CASE s.Trim != "" ?
                 BOOL lines_after_end|_are_present = TRUE
                 BREAK s ;
        ;
        CASE closed_long_comm > 1 ? lines_after_end = TRUE ;
        CASE !lines_after_end ? c.Ending_lines[].Clear ;
        -------------------------------- 'now generate'
        {Text_file} tf|ile_text_temp
        STR o|utput_lines[].Clear
        CASE !generate_class(c) ? ==> ;
        -------------------------------- 'save generated unit'
        PUSH unit_handling = c.Final_name " <-- " c.Names[0] :
             collect_defined_arrays(c)
             STR ex_o|out_lines[].Clear
             FOR ex IN c.Ex_info[] : 
             	 CASE "//" ex IN ex_o[] ? CONTINUE ex ;
                 ex_o[] << "//" ex ;
        ;
        unite_parts(o[])
        FOR ex IN ex_o[* DOWNTO 0]: o[].Insert(0, ex) ;
        split_long_lines(o[])
        STR unit_path = path.Extract_file_name
        unit_path = unit_path.Change_ext(ext)
             
        tf = {Text_file}(
                 Path = Comp.Destination.Trailing_slash unit_path)
	             
        CASE !tf.Path.Exists || file_changed(tf, o[]) ?
             //DEBUG: << "save generated souce file (pas): " tf.Path #NL ;
             save_text_to_file(o[], tf.Path)
        ;
        ------------------------------- 'save localizations in file'
        CASE c.Localize_n[].Count > 0 ? 
             o[].Clear
             FOR n IN c.Localize_n[] :
                 o[] << n "=" c.Localize_s[n.Index].Var_arg.Str_c ;
             tf.Path = tf.Path ".localize"
             NONE = tf.Save(o[])
        ;
    ;
    ---------------------------------- '/copy files specified'
    FOR sf IN Comp.Copy_files[] :
        CASE Starting(sf, "<bin>") ?
             STR dest|ination_name = sf.["<bin>".Len TO *].Extract_file_name
        ELSE dest = sf.Extract_file_name ;
        
        copy_file_removing_comments(sf,
            Comp.Destination.Trailing_slash dest)
            
        PUSH unit_handling = "///copy: " sf :
        	 collect_defined_arrays(NONE) 
        ;
    ;
    ------------------------------- 'all_classes.pas'
    td[].Clear
    fd[].Clear
    im[].Clear
    tf = {Text_file}(Path = Comp.Destination.Trailing_slash "All_classes.pas")
	generate_all_classes
	FOR ss IN im[* DOWNTO 0] :
	    CASE ss == "" || ss.Trim == "" ? im[].Delete(ss.Index) ;
	;
	unite_parts(o[])
    PUSH unit_handling = "All_classes.pas" :
    	 collect_defined_arrays(NONE) ;
    CASE file_changed(tf, o[]) ?
         CASE Comp.Verbose ? << "Saving"._MSaving7 ": " tf.Path " ... " ;
         save_text_to_file(o[], tf.Path)
         CASE Comp.Verbose ? << "saved" #NL ; 
    ;
    ---------------------------------- 'AL4.pas (modified) copy'
    o[].Clear
    copy_AL4_pas   
    ------------------------------ 'Generate project file'
    CASE Ide_debug ? 
         im[].Clear
         im[] << "*"
         
         save_text_to_file(im[], 
         	Comp.Destination.Trailing_slash "Breakpoints.txt")
    ;
    td[].Clear
    fd[].Clear
    im[].Clear
    generate_project
    RESULT = TRUE .
    
METHOD restore_ex_info({Type} C|lass_to_get_Ex_info) :
    STR cs|trings_compiled_unit[]
    {Text_file} tf|_load_temp = {Text_file}(Path= Output_path_class(C))
    NONE = tf.Load(cs[])
    FOR s IN cs[] :
        CASE !s.Starting("//use:") ? BREAK s ;
        C.Ex_info[] << s.[2 TO *]    
        CASE "DynA" IN s ?
             add_defined_dynamic_arrays(C, s) ;
        CASE "FixA" IN s ? 
             add_defined_fixed_arrays(C, s) ;
    ; .
    
//FUN time_file(STR path|_of_file) ==> STR :
//    RESULT = Get_file_modified_time_formatted(path) .
    	
METHOD save_text_to_file(
	STR Lines|_to_save[], STR Path|_of_file_to_save)
	:
    CASE Comp.Verbose ? 
         << "Saving"._MSaving2 ": " Path " (" Lines[].Count.Str ")" " ... "
    ;
    BOOL use_text_file = "$FPC" !IN Comp.Defined_name[] 
    	 || "linux" IN platform_info
    	 
    CASE use_text_file ?
         tf|ile_text_temp = {Text_file}(Path = Path)
         CASE "$FPC" IN Comp.Defined_name[] ? tf.Encoding = 'UTF8' ;
         //<< " use {Text_file}, Enc=" tf.Encoding.Name " "     
         NONE = tf.Save(Lines[])
    ELSE
    	 {Stream} sw|rite_stream_TEMP = Write_file_stream(Path, FALSE)
    	 sw.Set_encoding('UTF8')
    	 FOR s IN Lines[]:
    	     NONE = sw.Write_line(s) ;
    	 sw.Close
    ;
    CASE Comp.Verbose ? << "saved"#NL ; .

    
METHOD collect_defined_arrays({Type} C|lass_for_which):
	//DEBUG: 
	//	CASE C != NONE ?
	//       << "collect_defined_arrays for class " C.Whole_name
	//	   ", Loaded_from_ccc=" C.Loaded_from_ccc.S 
	//	   ", Ex_info[].Count=" C.Ex_info[].Count.S #NL ;
	//;
	CASE ?
	[C != NONE && (
	 "Free Pascal" IN Platform_info || "$ALLARRAYS" IN Comp.Defined_name[]
	 || Comp.TEST_value)] ?
	     CASE defined_arrays[].Count == 0 ?
	     	  --------------------------------- 'DynA...', REUSED     
	          add_def("DynAObj", "DynAObj", C)
	          add_def("DynAByte", "DynAByte", C)
	          add_def("DynAInt", "DynAInt", C)
	          add_def("DynAReal", "DynAReal", C)
	          ----------------------------------
	          LIKE .............. 'DynA...', BUT (Dyn==>Fix)*8
              //defined_arrays[] << "DynAObj" << "DynAByte" << "DynAInt" <<
              //  "DynAReal" << "DynAStr" <<
              //  "FixAObj" << "FixAByte" << "FixAInt" << "FixAReal" <<
              //  "FixAStr"
	     ;
    //[C != NONE && C.Loaded_from_ccc] ?
    //     FOR s IN C.Ex_info[] :
    //        //DEBUG: << "add_def==> " s #NL ;
    //         CASE s.Starting("use:") ?
    //              add_def(s.["use:".Len TO *], s, C) ;
    //     ;
	ELSE
	    FOR s IN im[] :
	        line_handling = s.Index+1
	        CASE "DynA" IN s ?
	             add_defined_dynamic_arrays(C, s) ;
	        CASE "FixA" IN s ? 
	             add_defined_fixed_arrays(C, s) ;
	    ; 
	; .
    
STR defined_arrays[]

METHOD add_defined_dynamic_arrays(
{Type} C|lass_add_for, STR S|tring_of_source )
	:
       add_def("DynAObj", S, C)
       add_def("DynAByte", S, C)
       add_def("DynAInt", S, C)
       add_def("DynAReal", S, C)
       add_def("DynAStr", S, C) .
       
METHOD add_defined_fixed_arrays(
{Type} C|lass_add_for, STR S|tring_of_source )
	:
       add_def("FixAObj", S, C)
       //DEBUG:
       //      CASE "FixAByte" IN S && "FixAByte" !IN defined_arrays[] ?
       //           << ":::::::::::::::::::::: " S  >>;
       //;
       add_def("FixAByte", S, C)
       add_def("FixAInt", S, C)
       add_def("FixAReal", S, C)
       add_def("FixAStr", S, C) .
       
       
METHOD add_def|ined_reference(
	STR Arr|ay_type,  STR S|tring_of_source, {Type} C|lass_add_for )
	:
	CASE C != NONE && "use:" Arr !IN C.Ex_info[] ?
	     C.Ex_info[] << "use:" Arr ;
    CASE Arr !IN defined_arrays[] && Arr IN S ?
		 //DEBUG:
		 //      CASE Arr == "DynAByte" ? NONE ;
		 //;
         report_adding_def(Arr)
         defined_arrays[] << Arr
         //DEBUG: " add to defined_arrays[] << " Arr 
         //		" from class " C.Whole_name >> ; 
         CASE Arr.Starting("FixA") ?
              STR dyn|_array_type = "Dyn" Arr.[3 TO *]
              CASE dyn !IN defined_arrays[] ?
              		report_adding_def(dyn)
                  defined_arrays[] << dyn ;
         ;
    ; .
    
STR unit_handling   
INT line_handling
	
METHOD report_adding_def(
	STR Arr|ay_name_kind)
	:
	CASE !Comp.Verbose2 ? ==> ;
	
	<< #NL "Adding reference to array type <" Arr ">: working under unit "
	    "" unit_handling " (Line: " line_handling.Str ")" #NL#NL .
    
METHOD file_changed(
	{Text_file} T|ext_file, STR Out|put_text[] ) ==> BOOL
	:
	CASE Target == "LINUX" ? RESULT = TRUE ==> ;
    ----------------------------------- 'split by #NL'
    FOR i IN [Out[].Count-1 DOWNTO 0] :
        STR line|_of_out = Out[i]
        CASE #NL !IN line ? CONTINUE i ;
        STR ss|plitted_line[]
        ss[].Clear
        Split(ss[], line, #NL)
        Out[].Delete(i)
        FOR s IN ss[] :
            Out[].Insert(i + s.Index, s) ;
    ;
    ----------------------------------- 'compare to old version'
    STR old|_lines[]
    NONE = T.Load_strings(old[])
    << "compare to old version (" T.Path ") size " old[].Count 
    	" --> " Out[].Count #NL
    	
    CASE old[].Count != Out[].Count ? RESULT = TRUE ==> ;
    FOR s IN old[] :
        CASE s != Out[s.Index] ? RESULT = TRUE ==> ;
    ; .
    
    

METHOD copy_file_removing_comments(
    STR Src|_file_path,
    STR Dst|_file_path)
    :
	//DEBUG: << "copy [" Src "] --> [ " Dst "]" >> ;
    ----------------------------------- 'remove old instance'
    CASE Dst.Exists ? Dst.Delete_file ;
    CASE Dst.Exists ? 
         Comp.Error("Can not remove old version of file"._Ecannot4 " " Dst)
    ;
    -------------------------------------- 'search  source file to copy'
    STR source|_actual = Src
    CASE Starting(Src, "<bin>") ?
         source = Src.["<bin>".Len TO *]
         CASE !source.Exists ?
              Comp.Error("File not found to copy"._ECannotCopy ": " source) ;
         Copy_file(source, Dst) ==> ;
    CASE "\" !IN Src && "/" !IN Src ?
         FOR s IN Comp.Source_paths[] :
             CASE (s.Trailing_slash Src).Exists ?
                  source = s.Trailing_slash Src
                  BREAK s ;
         ;
    ;
    CASE !source.Exists && source.Ending(".*") ?
         //DEBUG: << "source file changing from " source ; 
         source = source.Change_ext(".pas")
         //DEBUG: << " to " source #NL ;
    ;
    CASE !source.Exists ? Comp.Error("File not found to copy"._Efile2
                            ": " source) ==> ;
    //<< "copy source: " source #NL >>
    CASE Comp.Verbose ? << "COPY"._Mcopy ": " source " to " Dst " ... " ;
    --------------------------------------- 'load and remove comments'
    STR text|_copying[]
    Fast_load_text(text[], source, 'DEFAULT')
    CASE Comp.Verbose ? << "loaded ... " ;
    
    PUSH Comp.Additional_text = "(copying file:"._ECopying 
    	 " " Extract_file_name(Src) ")" :
         
    	 comment_unnecessary_parts(text[]) ;
    --------------------------------------- 'replace comments'
    FOR i IN [text[].Count-1 DOWNTO 0] :
        CASE ?
        [text[i].Trim == "//defines"] ?
             CASE "$NOLONGOP" IN Comp.Defined_name[] ?
                  text[i] = "{$DEFINE NOLONGOP}" text[i] ;
                  
             BOOL c_st|ruc_as_class 
             c_st = Comp.Defined_name[0 TO *].Contains("STRUCTUREASCLASS", TRUE)
             c_st ||= Comp.Defined_name[0 TO *].Contains("$SCLASS", TRUE)  
             CASE c_st ?
             	  STR s_text|_at_i_before = text[i]
                  text[i] = "{$DEFINE STRUCTUREASCLASS}" s_text ;
             CONTINUE i
        [text[i].[0 TO 1] == "//"] ?
             CASE Starting(text[i], "//?") || Starting(text[i], "//-->") || (
                  text[i].Trim == "//.")
                  ?
                  CONTINUE i ;
                  
             text[i] = "// this is a copy only - do not change: "
             "changes will not take effect on the next compile"._Mthisis
        ;
    ;
    -------------------------------- 'copy to o[] to collect arrays'
    im[].Clear
    FOR t IN text[]: im[] << t ;
    ------------------------------- 'save modified text'
    {Text_file} temp|_text_save = {Text_file}(Path = Dst)
    CASE Target == "LINUX" ? temp.Encoding = 'UTF8' ;
    STR dest|ination_directory = Dst.Extract_path
    //DEBUG: << "destination directory is " dest #NL ;
    CASE !dest.Directory_exists ?
         dest.Create_directory
         //DEBUG: << "destination directory created"#NL ; 
    ;
    BOOL saved|_okay = temp.Save(text[])
    CASE ?
    [!saved] ?
         Comp.Error("Can not save copy of"._Ecannot5 " " source " to " Dst)
         << #NL
    [Comp.Verbose] ? << "copied"#NL
    ; .
         
         
    FUN split_o_by_NL(STR o|ut_lines[]) :
        FOR i IN [o[].Count-1 DOWNTO 0] :
            STR prev|ios_line_of_o = o[i]
            CASE #NL !IN prev ? CONTINUE i ;
            STR splitted[]
            Split(splitted[], prev, #NL)
            o[].Delete(i)
            FOR s IN splitted[] :
                o[].Insert(i + s.Index, s) ;
        ; .
        
        
    METHOD comment_unnecessary_parts( 
    STR Lines|_of_code[] )
        :
            STR comment|ing_lines = ""
            FOR s IN Lines[] :
                CASE Starting(s, "//?") ?
                     STR w|ords_splitted[]
                     Split(w[], s.[3 TO *], ".")
                     STR nclass|_name = w[0].Trim
                     CASE !class_present(nclass) ?
                          comment = comment "."
                          CONTINUE s
                     ;
                     CASE w[].Count <= 1 ? CONTINUE s ;
                     ------------------------ '/ / {class}.method'
                     //DEBUG: << "+++++++++++++++++++++++++++++++++++++++++"#NL
                     //"check if method " w[1] " is overridden in descendants"
                     //" of class " w[0] #NL ;
                     STR m|ethod_to_check_if_overridden = w[1]
                     STR b|ase_class_to_check_descendants_of = w[0]
                     w[].Delete(1)
                     w[].Delete(0)
                     PUSH Comp.Current_class.Parse.Line = s.Index :
                          PUSH Comp.Additional_text:
                               CASE Comp.Additional_text != "" ?
                                    Comp.Additional_text =_ 
                                    " [" (s.Index+1).Str "]"
                               ;
		                       CASE !Comp.Overridden(m, b, w[]) ?
		                            comment = comment "." ;
	                      ;
                     ;
                     CONTINUE s ;
                CASE comment != "" ?
                     CASE Starting(s, "//.") && s.Trim == "//." ?
                          comment = comment.[0 TO *-1]
                     ELSE Lines[s.Index] = "//-->" s ;
                     CONTINUE s ;
            ; .

    METHOD class_present
    	|_in_All_classes( STR Name|_of_class ) ==> BOOL
    	:
        FOR t IN Comp.All_classes[] :
            CASE Name == t.Names[0] ? RESULT = TRUE ==> ;
        ; .
                    
         

METHOD split_long_lines(STR L|ines_to_split[]) :
    ------------------------------------ 'first split by #NL'
    CASE Target != "LINUX" ? 
	     FOR i IN [L[].Count-1 DOWNTO 0] :
	         CASE #NL !IN L[i] ? CONTINUE i ;
	         STR ss|plitted_by_NL[]
	         Split(ss[], L[i], #NL)
	         //DEBUG: << "." ss[].Count.S ;
	         L[].Delete(i)
	         FOR x IN ss[] :
	             L[].Insert(i + x.Index, x) ;
	     ;
	     STR eol|ine_end_symbol = #NL
    ELSE eol = #LF
    ;
    ---------------------------- 'For each line, from the last to the first...'
    CASE "Free Pascal" IN Platform_info ? INT limit|_length = 2047
    ELSE limit = 400 // 161 
    ;
    FOR i IN [L[].Count-1 DOWNTO 0] :
        CASE L[i].Len < limit ? CONTINUE i ;
        CASE L[i].Trim.Starting("/" "/") ? CONTINUE i ;
        //DEBUG: << ":" L[i].Len.S "(" i.S ":" L[i][0 TO 100] ")" ;
        INT spaces_c|ount = 0
        FOR j IN [0 TO L[i].Len-1] :
            CASE L[i].[j] IN " "#TAB ? spaces_c += 1
            ELSE BREAK j ;
        ;
        -------------------------- 'make s = L[i] w/strings filled by !'
        STR s|tring_without_comments = L[i]
        BOOL in_str|ing_constant = FALSE
        FOR j IN [0 TO s.Len-1] :
            CASE s.[j] IN [#13, #10] ? s.[j] = "," ;
            CASE in_str && s.[j] != "'" ? 
                 s.[j] = "!"
            ;
            CASE s.[j] != "'" ? CONTINUE j ;
            s.[j] = "!"
            in_str = !in_str ;
        CASE s != L[i] ?
             //DEBUG:
             //	L[].Insert(i+1, "//" s[0 TO 999] "\\") ;
             s = "  " s
             L[i] = "  " L[i] ;
        -------------------------- 'split by operation signs'
        INT len|gth_of_cutted_part = 0
        INT new_len|gth = 0
        //STR pref|ix_spaces = s[0 TO spaces_c-1]
        INT ending|_symbol = s.Find("//")-1
        CASE ending < 0 ? ending = s.Len-1 ;
        FOR j IN [ending DOWNTO 1] :
            CASE s.[j] IN "+*%()[]," ?
                 new_len = s.Len - j + spaces_c ;
            CASE new_len > len && (new_len < limit || len == 0) ?
                 len = new_len ;
            CASE new_len > limit-1 ?
                 L[i] = L[i].[0 TO j-1] eol L[i].[j TO *]
                 s = s.[0 TO j-1]
                 len = 0
                 new_len = 0 ;
        ;
        CASE new_len > 0 && s.Len > limit-1 ?
             INT k|_index_cut_from = s.Len - new_len + spaces_c
             L[i] = L[i].[0 TO k-1] eol L[i].[k TO *]
             s = s.[0 TO k-1] ;
    ; .
    
//INT total_split|ted_lines_count

METHOD kol_or_vcl( STR D|ata_line ) ==> STR :
    RESULT = D
    CASE ?
    [D.Starting("#VCL:")] ?
         CASE kol >= 0 ? RESULT = "" ==> ;
         RESULT = D.Remove_starting("#VCL:")
         CASE (RESULT.Starting("-D") || RESULT.Starting("Conditionals=")) && (
         	  MEMDIAG)
         	  ?
         	  RESULT =_ ";MEM_DIAG" ;
    [D.Starting("#KOL:")] ?
         CASE kol < 0 ? RESULT = "" ==> ;
         RESULT = D.Remove_starting("#KOL:") 
         -------------------------------- 'cfg changes:'
         CASE "%KOLPATH%" IN RESULT ?
              STR kolpath|_variable = Get_environment_var("KOLPATH")
              RESULT = RESULT.Replace("%KOLPATH%", kolpath.Trailing_slash)
              //DEBUG : << RESULT #NL ;
              CASE "$SYSDCU" IN Comp.Defined_name[] && RESULT.[*] == #QU ?
                   STR kol_sysdcu|_path = Comp.Defined_value[
                       Comp.Defined_name[].Find("$SYSDCU")]
                   //DEBUG: << "kol_sysdcu = " kol_sysdcu #NL ;
                   RESULT = RESULT.[0 TO *-1] ";" kol_sysdcu #QU 
                   //DEBUG: << "RESULT = " RESULT >> ;
              ;
              ==>
         ;
         -------------------------------- 'both cfg & dof:'
         CASE RESULT.Ending(";PAS_VERSION") ?
              CASE "$ASM_VERSION" IN Comp.Defined_name[] ?
                   //DEBUG: << "before replace ;PAS_VERSION: " RESULT #NL ;
                   RESULT = RESULT.Replace(";PAS_VERSION", "")
                   //DEBUG: << "after replace : " RESULT >> ;
              ;
              CASE MEMDIAG ?
                   RESULT =_ ";MEM_DIAG" ;
              CASE Comp.Defined_name[].Find("$UNICODE") >= 0 ?
                   RESULT =_ ";UNICODE_CTRLS" ;
              CASE NOERR_option ?
                   RESULT =_ ";NOERR;MATH_NOERR;" ;
              CASE NOEXCEPTIONS_option ?
                   RESULT = RESULT.Replace(";KOL_EXCEPTIONS", "")
                   RESULT =_ ";NOEXCEPTIONS" ;
              CASE NOTRY_option ?
                   RESULT =_ ";NOTRY" ;
              CASE Comp.Noconsole ?
                   RESULT =_ ";NOCONSOLE" ;
              //DEBUG: << RESULT >> ;
              ==>
         ;
         ---------------------------------- 'dof changes:'
         CASE RESULT.Trim == "SearchPath=" ?
              //DEBUG: << "option: " RESULT >> ;
              CASE "$SYSDCU" IN Comp.Defined_name[] ?
                   kol_sysdcu = Comp.Defined_value[
                       Comp.Defined_name[].Find("$SYSDCU")]
                   RESULT =_ kol_sysdcu
                   //DEBUG: << RESULT >> ;
              ;
              ==>
         ;
         CASE RESULT.Starting("Conditionals=") && MEMDIAG ?
              RESULT =_ ";MEM_DIAG" ;
    ; .

METHOD sysutils|_unit ==> STR :
	CASE kol >= 0 ? 
         RESULT = "KOL, err"
         CASE NOERR_option ? RESULT = "KOL" ;
    ELSE RESULT = "Classes, SysUtils" ; .

INT kol|_library_index_in_defined_names
STR defines|_in_command_line
STR o_c|lass_or_object = "class"

METHOD generate_project :
    ------------------------------- 'Initialize (clear o[] array)'
    STR o|utput_lines[]
    CASE kol >= 0 ? o_c = "object"
    ELSE o_c = "class" ;
    defines = ""

    	 generate_cfg
    	 generate_dof

    ------------------------------ 'KOL ?'
    CASE kol >= 0 ? 
         STR ex|ternal_defines_inc[]
         
         CASE "$DELPHI3" !IN Comp.Defined_name[] ?
         	  ex[] << "{$DEFINE STREAM_LARGE64}" ;
         	  
         ex[] << "{$DEFINE noKEY_PREVIEW}" <<
         "{$DEFINE USE_DROPDOWNCOUNT}" << "{$DEFINE KOL_EXCEPTIONS}" <<
         "{$DEFINE KOL}" << 
         "{$DEFINE NOT_USE_RICHEDIT}"
         ---------------------------- 'KEY_PREVIEW'
         CASE "$KEY_PREVIEW" IN Comp.Defined_name[] ?
              ex[] << "{$DEFINE KEY_PREVIEW}" ;
         ---------------------------- 'NIL_EVENTS'
 		 CASE SMALLER_CODE ?
 		      ex[] << "{$DEFINE noNIL_EVENTS}"
 		 ELSE ex[] << "{$DEFINE NIL_EVENTS}" ;
 		 ---------------------------- 'SMALLER_CODE / SMALLEST_CODE'
         CASE ?
              [SMALLEST_CODE] ?
                   ex[] << "{$DEFINE SMALLEST_CODE}"
              [SMALLER_CODE] ?
                   ex[] << "{$DEFINE SMALLER_CODE}"
         ;
         CASE Comp.Noconsole ?
              ex[] << "{$DEFINE NOCONSOLE}" ;
         ----------------------------- ''     
         CASE "$KOLGRAPHIC" IN Comp.Defined_name[] ?
              ex[] << "{$DEFINE KOLGRAPHIC}" << "{$DEFINE NOCLASSES}" ;
              
         CASE "$ICON" IN Comp.Defined_name[] ?
              ex[] << "{$DEFINE ICON_APPLICATION}" ;
              
         CASE "$DEFINE" IN Comp.Defined_name[] ?
         	  INT d_i|ndex_of_define INDEXING STR
         	  d_i = Comp.Defined_name[].Find("$DEFINE") 
              STR parsed|_defines[].Split(Comp.Defined_value[d_i], ";")
              FOR s IN parsed[] :
              	  ex[] << "{$DEFINE " s "}" ;
         ;
	     ------------------------------------- 'save external defines'
         tf|ile_text_temp = {Text_file}(
                Path = Comp.Destination.Trailing_slash "EXTERNAL_DEFINES.inc")
                
         CASE file_changed(tf, ex[]) ?
             CASE Comp.Verbose ? << "Saving"._MSaving5 ": " tf.Path #NL ;
             NONE = tf.Save(ex[]) ;
	;
    ------------------------------ 'project header'
    o[] << "Program " Comp.Project ";" << ""
    CASE !Comp.Noconsole || Comp.TEST_value ?
         CASE Target == "WINDOWS" ?
              CASE "$VISUAL" IN Comp.Defined_name[] ?
         	  	   o[] << "//{$APPTYPE CONSOLE}"
              ELSE o[] << "{$APPTYPE CONSOLE}" ;
         	  CASE "$VISUAL" !IN Comp.Defined_name[] ? 
         	  	   o[] << "{$DEFINE CONSOLE_APPLICATION}" ;
         	  o[] << "" ;
    ;
    o[] << "uses "
    CASE FPC && class_present("{Thread}") ?
         o[] << @
           "    {$IFDEF LINUX}"
           "                cthreads,"
           "    {$ENDIF}"
    ;
    
    o[*] =_ sysutils ", "
    o[] << "AL4 in 'AL4.pas', All_classes in 'All_classes.pas',"
    o[] << " {$IFDEF FPC}{$IFnDEF NOINTERFACES} Interfaces, {$ENDIF}{$ENDIF}"
    o[] << " {$IFDEF FPC} LCLType, lazutf8, {$ENDIF} "
    CASE kol < 0 && "$ICON" IN Comp.Defined_name[] ?
         o[*] =_ "Forms, "
         o[*] =_ "Graphics, "
         CASE Target == "WINDOWS" ? o[*] =_ "Windows, " ;
    ;
    FOR c IN Comp.All_classes[] :
        CASE o[*].Len >75 ? o[] << sp(4) ;
        o[*] =_ "unit" c.Final_name " in 'unit" c.Final_name ".pas', "
    ;
    //DEBUG: << "before adding ';':" #NL o[*] #NL ;
    o[*] = o[*].TrimR.Remove_ending(",") ";"
    //DEBUG: << "after adding: " #NL o[*] #NL ;
    add_off_warnings(o[])
    ------------------------------ 'application icon'
    CASE "$ICON" IN Comp.Defined_name[] && !Comp.TEST_value 
    	 && Target == "WINDOWS"
    	 ?
         STR ico|n_path = Comp.Defined_value[Comp.Defined_name[].Find("$ICON")]
         CASE ":" !IN ico ? ico = Comp.Source_paths[0].Trailing_slash ico ;
         CASE !ico.Exists ?
              Comp.Error("Can not find icon file"._EIcon ": ico") ;
         o[] << "{$R application_icon.res}" << ""
         ------------------------- 'prepare resource file'
         CASE kol < 0 ? 
              STR rc|_resource_compile[] << "APP_ICO ICON "#QU ico #QU
         ELSE rc[] << "MAIN ICON " #QU ico #QU ;
         
         STR rc_path|_resource_source = Comp.Destination "application_icon.rc" 
         Text_save(rc_path, rc[])
         NONE = Execute_program("brcc32.exe", rc_path, 0) ;
    ------------------------------ 'main body'
    CASE Comp.Defined_name[].Find("$REPORT_LEAKS") >= 0 ?
         generate_report_leaks(o[]) ;
    
    o[] << "begin"
    CASE (generating_class == NONE) ?
	     CASE !Comp.Noconsole || Comp.TEST_value ?
	          CASE Target == "LINUX" ?
	         	   o[] << @
	         	  	 "//AllocConsole;"
	         	  	 "IsConsole := true;"
	         	  	 "SysInitStdIO;"
	          ;
	     ;
	     generate_call_main(o[], Comp.All_classes[0]) ;
	     CASE use_profiler != "" ? 
	     	  o[] << "  Profiler_save_reset();"    
	     ;
    o[] << "end."
    ------------------------------- 'save project file'
    tf = {Text_file}(Path = Comp.Destination.Trailing_slash Comp.Project ".dpr")
    CASE !tf.Path.Exists || file_changed(tf, o[]) ?
         CASE Comp.Verbose ? << "Saving"._MSaving8 ": " tf.Path " ... " ;
         CASE !tf.Path.Extract_path.Directory_exists ?
              tf.Path.Extract_path.Create_dir ;
         BOOL r|esult_saveing = tf.Save(o[])
         CASE Comp.Verbose ?
              << "result saving: "
              CASE !r ? 
                   Console_color('RED')
                   
                   << "not saved! Dir(" tf.Path.Extract_path ").exists="
              			   "" tf.Path.Extract_path.Directory_exists.S
              			   
                   Console_color('SILVER')
                   
              ELSE Console_color('LIME')
              	   << "OK"
              	   Console_color('SILVER') ;
              << #NL ;
    ;
    o[].Clear .
    
STR use_profiler|_option_FUNCTIONS_COMMENTS_BRANCHES_LOOPS_ALL
    
METHOD generate_cfg :
    INT cfg1|_from = DATA[].Find("--cfg--(")
    INT cfg2|_ends = DATA[].Find("--cfg--)")
    STR o|utput_lines[]
    FOR i INDEXING STR IN [cfg1+1 TO cfg2-1] :
        STR d|ata_line = kol_or_vcl(DATA[i])
        CASE NOERR_option ?
             d = Replace(d, ", err", "") ;
        CASE ?
        [d.Starting("-D")] ?
             CASE  "$KOLGRAPHIC" IN Comp.Defined_name[] ?
	               d =_ ";KOLGRAPHIC"
	               
	               o[] << "-U" Get_environment_var("KOLPATH").Trailing_slash
	              		  "Components\KOLGraphic"
             ;
             CASE "$DEFINE" IN Comp.Defined_name[] ?
                  INT ind|ex_in_defined INDEXING STR 
                  ind = Comp.Defined_name[].Find("$DEFINE") 
                  d =_ ";" Comp.Defined_value[ind] ;
              		
             CASE "$RXGIF" IN Comp.Defined_name[] ?
	              d =_ ";RXGIF"
	              INT rx|_gif_index INDEXING STR 
	              rx = Comp.Defined_name[].Find("$RXGIF")
	              CASE ?
	              [Comp.Defined_value[rx] != ""] ?
	                   o[] << "-U" Comp.Defined_value[rx]
	              [Get_environment_var("RXLIB") != ""] ?
	                   o[] << "-U" Get_environment_var("RXLIB") ;
             ;
             CASE "$PNGOBJECT" IN Comp.Defined_name[] ?
                  d =_ ";PNGOBJECT"
                  o[] << "-U" Get_environment_var("PNGOBJECT")
             ;
             CASE defines != "" ? defines = defines.Add_trailing(";") ;
        	 defines =_ d
        [d == "-$O+"] ?
            CASE kol >= 0 && "$DELPHI5" IN Comp.Defined_name[]
                 ?
                 d = "-$O-"  ;
        ;
        o[] << d ;
        
    tf|ile_text_temp = {Text_file}(
            Path = Comp.Destination.Trailing_slash
            "" Comp.Project ".cfg")
            
    CASE file_changed(tf, o[]) ?
         CASE Comp.Verbose ? << "Saving"._MSaving3 ": " tf.Path #NL ;
         NONE = tf.Save(o[]) ; .
    
METHOD generate_dof :
    CASE kol >= 0 ?
        INT dof1|_from = DATA[].Find("--dof--(")
        INT dof2|_ends = DATA[].Find("--dof--)")
        STR o|utput_lines[]
        FOR i INDEXING STR IN [dof1+1 TO dof2-1] :
            STR d|ata_line = kol_or_vcl(DATA[i])
            CASE ?
            [d == "SearchPath=" && "$KOLGRAPHIC" IN Comp.Defined_name[]] ?
            	 INT d_i|ndex_defined_kolgraphic INDEXING STR 
            	 d_i = Comp.Defined_name[].Find("$KOLGRAPHIC")
            	 CASE Comp.Defined_value[d_i] == ""
            	 	  && Get_environment_var("KOLPATH") != ""
            	 	  ?
            	      STR p|ath_kol 
            	      = Get_environment_var("KOLPATH").Trailing_slash 
            	      "Components\KOLGraphic"
            	      
            	 ELSE p = Comp.Defined_value[d_i] ; 
            	 d =_ p
            [d == "O=1"] ?
                CASE kol >= 0 && "$DELPHI5" IN Comp.Defined_name[]
	                 ?
	                 d = "O=0"  ;
            ;
            o[] << d ;
                 
        tf|ile_text_temp = {Text_file}(
                Path = Comp.Destination.Trailing_slash
                "" Comp.Project ".dof")
                
        CASE file_changed(tf, o[]) ?
             CASE Comp.Verbose ? << "Saving"._MSaving9 ": " tf.Path #NL ;
             NONE = tf.Save(o[]) ;
        o[].Clear
    ; .

    
TODO: "for Free Pascal, use windres.exe instead of brcc32.exe "
	  "to compile resources" .
    
    
METHOD copy_AL4_pas :
    ------------------------------ 'copy AL4.pas to destination folder'
    STR o|utput_lines[]
    INT al4_pas|start = DATA[].Find("--AL4.pas--(")
    INT al4_end|_line = DATA[].Find("--AL4.pas--)")
    CASE Comp.TEST_value ? o[] << "{$DEFINE TEST_STAGE}" ;
    CASE Comp.Debugging || Ide_debug ?
         o[] << "{$DEFINE ARRAYDETAILS}"
         o[] << "{$DEFINE ONLY_INTERESTING_THREADS}"
    ;
	BOOL skipping|_until_dot_commented = FALSE
    //FOR c IN Comp.All_classes[] :
    //    CASE c.Loaded_from_ccc ?
    //         BOOL some_classes_from_ccc = TRUE
    //         BREAK c ;
    //;
    FOR i INDEXING STR IN [al4_pas + 1 TO al4_end-1] :
        //DEBUG:
        //      CASE o[].Count >= 5109 && o[].Count <= 5115 ?
        //           << "al4.pas[" o[].Count.S "]: " DATA[i] #NL ;
        //;
        STR d|data_line = kol_or_vcl(DATA[i])
        //DEBUG:
        //      CASE o[].Count >= 5109 && o[].Count <= 5115 ?
        //           Console_color('YELLOW')
        //           << "al4.pas[" o[].Count.S "]: " DATA[i] #NL 
        //           Console_color('SILVER')
        //      ;
        //;
        STR dtrim|med = d.Trim
		CASE d.Starting("#debug:") ?
             d = d.["#debug:".Len TO *]
             CASE !Comp.Debugging ? d = "" ;
		;
        CASE ?
        [d.Starting("@int32:")] ?
             CASE Comp.Int32 ? d = "       " d.["@int32:".Len TO *]
             ELSE d = "" ;
        [d.Starting("@int64:")] ?
             CASE !Comp.Int32 ? d = "       " d.["@int64:".Len TO *]
             ELSE d = "" ;
        [d == "//." && skipping] ?
             skipping = FALSE
        [skipping] ? CONTINUE i
        [Starting(d, "/" "/?{")] ?
             CASE !class_present(d.[3 TO *].Trim) ?
                  skipping = TRUE ;
        [d.Trim == "/" "/#RTTI_type_info_tables"
         && "$NORTTI" !IN Comp.Defined_name[]] ?
             output_RTTI_info_tables(o[])
             CONTINUE i
        [d.Trim == "/" "/#RTTI_type_info_methods1"] ?
             o[] << "{$IFDEF USERTTI}"
             output_RTTI_info_methods(o[], TRUE)
             o[] << "{$ENDIF} //USERTTI"
             CONTINUE i
        [d.Trim == "/" "/#RTTI_type_info_methods2"] ?
             o[] << "{$IFDEF USERTTI}"
             output_RTTI_info_methods(o[], FALSE)
             o[] << "{$ENDIF} //USERTTI"
             CONTINUE i
        [d.Trim == "#function_names:"] ?
             CASE Comp.Debugging || Ide_debug ?
                  o[] << "{$DEFINE DEBUG_STACK}"
             	  output_all_function_names(o[])
             ;
             CONTINUE i
             
        [d.Trim == "/" "/{$DEFINE WRITE_DIRECT}"] ?
             CASE "$WRITE_DIRECT" IN Comp.Defined_name[]
             	  || "$WRITE" IN Comp.Defined_name[]
             	  ?
                  d = d.Trim.Remove_starting("/" "/")
             ;
        [d.Trim == "/" "/{$DEFINE NO_RTTI}"] ?
             CASE "$NORTTI" IN Comp.Defined_name[] ?
                  d = d.Trim.Remove_starting("/" "/")
             ;
        [dtrim.Starting("{$DEFINE USE_") && "FirstByte" !IN d] ?
         //&& !some_classes_from_ccc] ?
             STR a|rray_name_of_type = dtrim.["{$DEFINE USE_".Len TO *-1]
             a = a.Remove_starting("cache_")
             CASE "_" IN a ? a = a.[0 TO a.Find("_")-1] ;
             CASE ?
             ["DynAInt" == a && class_present("{RTTI}")] ? NONE
             [a !IN defined_arrays[]] ?
                  //DEBUG:
                  //      "defined arrays: " defined_arrays[].Merge(" --"#NL)
                  //      #NL "a= " a " - not in defined_arrays" #NL
                  //;
                  d = "//" d " //-- NOT USED ACTUALLY: [" a "]"
                  //DEBUG: BOOL out_defined_arrays = TRUE ;
             //ELSE
                  //DEBUG:
                  //      "defined arrays: " defined_arrays[].Merge(" --"#NL)
                  //      #NL "a= " a " - IS in defined_arrays" #NL
                  //;
             ;
        ;
        //DEBUG:
        //SE out_defined_arrays ?
        //   out_defined_arrays = FALSE
        //   FOR aa IN defined_arrays[] :
        //       o[] << "//// defined_arrays[" aa.Index.S "]=" aa ";" ;
        //
        //
        //DEBUG:
        //      CASE o[].Count >= 5109 && o[].Count <= 5115 ?
        //           Console_color('CYAN')
        //           << "al4.pas[" o[].Count.S "]: " DATA[i] #NL 
        //           Console_color('SILVER')
        //      ;
        //;
        o[] << d ;
         
    tf|ile_temp = {Text_file}(Path = Comp.Destination.Trailing_slash "AL4.pas")
    CASE file_changed(tf, o[]) ?
         CASE Comp.Verbose ? << "Saving"._MSaving10 ": " tf.Path #NL ;
         NONE = tf.Save(o[]) ; .
    
METHOD output_RTTI_info_tables(STR o|utput_lines[]) :
	CASE "$NORTTI" IN Comp.Defined_name[] ? ==> ;
	STR all_r|ecords_and_enums_list[]
	STR all_e|num_items[]
	INT start|_line INDEXING STR = o[].Count
	CASE "$RTTIONLY" IN Comp.Defined_name[] ?
	     STR rtti_classes[].Split(Comp.Defined_value[Comp.Defined_name[].Find(
	     	 "$RTTIONLY")], ",")
	;
	------------------------------- 'table of types'
	o[] << sp(4) "const RTTI_type_len = "
	o[] << sp(4) "var RTTI_type_info: array[0..RTTI_type_len-1] of PChar = ("
	..[] << sp(8) "'{|Object}',"
	..[] << sp(8) "'BOOL|EAN',"
	..[] << sp(8) "'INT|EGER',"
	..[] << sp(8) "'REAL',"
	..[] << sp(8) "'STR|ING',"
	INT total|_index_counter = 6
	FOR c IN Comp.All_classes[] :
	    CASE rtti_classes[].Count > 0 && c.Names[0] !IN rtti_classes[] ?
	         CONTINUE c ;
	    c.Type_total_index = total
	    total += 1
	    o[] << sp(8) "'" c.Whole_name
	    CASE c.Base_ != NONE ?
	         o[*] =_ ",base:" (Comp.All_classes[].Find(c.Base_) + 6).Str ;
	    CASE c.Structures_[].Count + c.Enums_[].Count > 0 ?
	    	 o[*] =_ ",struc:" (6 + Comp.All_classes[].Count + all_r[].Count).Str
	    	 		 ",count:" c.Enums_[].Count.Str
	    	 //DEBUG:
	    	 //      o[*] << " //Type#" c.Type_total_index.S ;
	    	 FOR r IN c.Structures_[] :
	    	 	 r.Type_total_index = 6 
	    	 	 	+ Comp.All_classes[].Count + all_r[].Count
	    	     all_r[] << sp(12) "'" r.Whole_name "',"
	    	 ;
	    	 FOR e IN c.Enums_[] :
	    	 	 e.Type_total_index = 6 
	    	 	 	+ Comp.All_classes[].Count + all_r[].Count
	    	 	 	
	    	     all_r[] << sp(14) "'" e.Whole_name
	    	     			",items:" all_e[].Count.Str 
	    	     			",count:" e.Items[].Count.Str "',"
	    	     			
	    	     add_items_of_enum(all_e[], e)
	    	 ;
	    ;
	    o[*] =_ "'," ;
	--------------------------- 'add records & enums'
	FOR sr IN all_r[] :
	    o[] << sr
	    //DEBUG: o[*] << " //type#" (6 + Comp.All_classes[].Count + sr.Index).S 
	    //;
	;
	o[] << sp(8) "''"
	o[] << sp(4) ");"
	INT count|_items_in_array = o[].Count - start - 3
	o[start] =_ count.S ";"
	---------------------------- 'all enum item names'
	CASE "$NORTTI" IN Comp.Defined_name[] ? ==> ;
	start = o[].Count
	CASE all_e[].Count == 0 ? all_e[] << "''" ;
	o[] << sp(4) "const RTTI_enum_len = "     
	o[] << sp(4) "var RTTI_enum_items: array[0..RTTI_enum_len-1] of PChar = ("
	FOR se IN all_e[] : o[] << se ;
	o[*] = Remove_ending(o[*], ",")
	o[] << sp(4) ");"
	count = o[].Count - start - 3
	o[start] =_  count.S ";" 
	o[] << "" .
	    
FUNCTION add_items_of_enum(
STR List|_of_enum_items[], {Type} E|numeration)
	:
	FOR v IN E.Items[] :
		List[] << sp(8) "'"  v.Whole_name.double_apost "'" "," ; .
            
FUNCTION double_apost|rophes(STR S|tring_source) ==> STR :
	RESULT = S
	FOR i IN [S.Len-1 DOWNTO 0]:
	    CASE S.[i] == "'" ? RESULT = RESULT.[0 TO i]  RESULT.[i TO *] ;
	; .
	
	
	
METHOD output_RTTI_info_methods(
STR o|utput_lines[],
BOOL Decl|aration_only)
	:
	CASE ?
	["$NORTTI" IN Comp.Defined_name[]] ? ==>
	[Decl] ? STR public|_prefix = "public "
	["$KOL" IN Comp.Defined_name[]] ? STR al4_object|_prefix = "TAL4_object."
	ELSE al4_object = "AL4_object." ;
	---------------------------- 'base RTTI methods to work with fields'
	o[] << sp(4) public "function " al4_object "RTTI_object_field_count"
						"{$IFDEF _D5orHigher} () {$ENDIF}"
						": Integer;"
						
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := 0;"
		 o[] << sp(4) "end;" ;
	
	o[] << sp(4) public "function " al4_object "RTTI_object_field_name("
				 "index: Integer): String;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := '';"
		 o[] << sp(4) "end;" ;
	
	------------------------------- 'info on field (type index, is_array, ...)'
	o[] << sp(4) public "function " al4_object "RTTI_object_info_field("
				 "index: Integer; What: Integer): Integer;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := 0;"
		 o[] << sp(4) "end;" ;
		 
	------------------------------------ 'type bool'
	o[] << sp(4) public "function " al4_object "RTTI_object_get_bool("
				 "index: Integer; Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := false;"
		 o[] << sp(4) "end;" ;
		 
	o[] << sp(4) public "function " al4_object "RTTI_object_set_bool("
				 "index: Integer; Value: Boolean; "
				 "Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(4) "  Result := false;"
		 o[] << sp(4) "end;" ;
	------------------------------------ 'type byte'
	o[] << sp(4) public "function " al4_object "RTTI_object_get_byte("
				 "index: Integer; Index_in_array: Integer): Byte;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := 0;"
		 o[] << sp(4) "end;" ;
		 
	o[] << sp(4) public "function " al4_object "RTTI_object_set_byte("
				 "index: Integer; Value: Byte; "
				 "Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(4) " Result := false;"
		 o[] << sp(4) "end;" ;
	------------------------------------ 'type int'
	o[] << sp(4) public "function " al4_object "RTTI_object_get_int("
				 "index: Integer; Index_in_array: Integer): Integer;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := 0;"
		 o[] << sp(4) "end;" ;
		 
	o[] <<sp(4) public "function " al4_object "RTTI_object_set_int("
				 "index: Integer; Value: Integer; "
				 "Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin RESULT := false;"
		 o[] << sp(4) "end;" ;
	------------------------------------ 'type real'
	o[] << sp(4) public "function " al4_object "RTTI_object_get_real("
				 "index: Integer; Index_in_array: Integer): Double;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin"
		 o[] << sp(8) "Result := 0;"
		 o[] << sp(4) "end;" ;
		 
	o[] <<sp(4) public "function " al4_object "RTTI_object_set_real("
				 "index: Integer; Value: Double; "
				 "Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin RESULT := false;"
		 o[] << sp(4) "end;" ;
			 
	-------------------------------------- 'type STR'
	o[] << sp(4) public "function " al4_object "RTTI_object_get_string("
				 "index: Integer; Index_in_array: Integer): String;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin "
		 o[] << sp(8) "Result := '';"
		 o[] << sp(4) "end;" ;
		 
	o[] << sp(4) public "function " al4_object "RTTI_object_set_string("
				 "index: Integer; const Value: String; "
				 "Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin "
		 o[] << sp(8) "Result := false;"
		 o[] << sp(4) "end;" ;
 	
 	--------------------------------------- 'object fields'
	o[] << sp(4) public "function " al4_object "RTTI_object_get_object("
				 "index: Integer; Index_in_array: Integer): Ref_obj;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin "
		 o[] << sp(8) "Result := NoneObj_AL4_object.hard_link;"
		 o[] << sp(4) "end;" ;
		 
	o[] << sp(4) public "function " al4_object "RTTI_object_set_object("
				 "index: Integer; Value: Ref_obj; "
				 "Index_in_array: Integer): Boolean;"
				 
	CASE Decl ?
	     o[] << sp(8) "virtual;"
	ELSE
		 o[] << sp(4) "begin "
		 o[] << sp(8) "Result := false;"
		 o[] << sp(4) "end;" ;
	.
	
	
    
METHOD output_all_function_names(STR o|utput_lines[]):
	STR fn|ames_of_all_functions[]
	FOR c IN Comp.All_classes[] :
	    FOR f IN c.Method[] :
	        CASE f == NONE ? CONTINUE f ;
	        CASE f.Final_name == "-" ? CONTINUE f ;
	        FOR i|dummy IN [fn[].Count TO f.Global_n] :
	            fn[] << "?" ;
	        INT i_fn INDEXING STR = f.Global_n
	        fn[i_fn] = unique_class_name(c) "." 
	        CASE f.Is_operator ? 
	             CASE f.Param[].Count==1 ? 
	                  fn[i_fn] =_ "-" f.Param[0].Type_.Names[0] 
	             ELSE 
	                  fn[i_fn] =_ f.Param[0].Type_.Names[0]
	                  "" operator_op(f.Names[0]) f.Param[1].Type_.Names[0]
	             ;
	        ELSE fn[i_fn] =_ f.Names[0] ;
	    ;
	;
	o[] << "const Function_names: array[0.." (fn[].Count-1).Str "] of PChar = ("
	FOR s IN fn[]:
	    o[] << "'" s "'," ;
	CASE o[*].[*] == "," ? o[*] = o[*].[0 TO *-1] ;
	o[] << ");" .
	
FUN operator_op|eration(STR Name|_operator) ==> STR :
    CASE Name ? 
    ["_Plus"]: 		RESULT = "+" 
    ["_Minus"]: 	RESULT = "-"
    ["_Multiply"]: 	RESULT = "*"
    ["_Divide"]:	RESULT = "/" ; .
	
	
METHOD unique_class_name(
	{Type} Class|_which_name_needed) ==> STR
	:
	FOR c IN Comp.All_classes[]:
	    CASE c == Class ? CONTINUE c ;
	    CASE c.Names[0] == Class.Names[0] ?
	         RESULT = Class.Whole_name ==> ;
	;
	RESULT = Class.Names[0] .
	            


METHOD add_off_warnings|_and_maybe_noerr_define(STR o|utput_lines[]) :
    o[] << @""
           "{$IFDEF VER90}"
           "              {$DEFINE _D2}"
           "              {$DEFINE _D2orD3}"
           "              {$DEFINE _D2orD3orD4}"
           "{$ENDIF}"
           ""
           "{$IFDEF VER100}"
           "              {$DEFINE _D3}"
           "              {$DEFINE _D3orHigher}"
           "              {$DEFINE _D2orD3}"
           "              {$DEFINE _D2orD3orD4}"
           "              {$DEFINE _D3orD4}"
           "{$ENDIF}"
           ""
           "{$IFDEF VER120}"
           "              {$DEFINE _D3orHigher}"
           "              {$DEFINE _D3orD4}"
           "              {$DEFINE _D4}"
           "              {$DEFINE _D4orHigher}"
           "              {$DEFINE _D2orD3orD4}"
           "                  {$IFnDEF KOL_MCK}"
           "                           {$DEFINE INPACKAGE}"
           "                  {$ENDIF}"
           "{$ENDIF}"
           ""
           "{$IFDEF VER130}"
           "              {$DEFINE _D3orHigher}"
           "              {$DEFINE _D4orHigher}"
           "              {$DEFINE _D5}"
           "              {$DEFINE _D5orHigher}"  
           "{$ENDIF}"
           ""
           "{$IFDEF VER140}"
           "              {$DEFINE _D3orHigher}"
           "              {$DEFINE _D4orHigher}"
           "              {$DEFINE _D5orHigher}"
           "              {$DEFINE _D6}"
           "              {$DEFINE _D6orHigher}"
           "{$ENDIF}"
           ""
           "{$IFDEF VER150}"
           "              {$DEFINE _D3orHigher}"
           "              {$DEFINE _D4orHigher}"
           "              {$DEFINE _D5orHigher}"
           "              {$DEFINE _D6orHigher}"
           "              {$DEFINE _D7}"
           "              {$DEFINE _D7orHigher}"
           "{$WARN UNIT_DEPRECATED OFF}"
           "{$WARN SYMBOL_PLATFORM OFF}"
           "{$WARN UNSAFE_TYPE OFF}"
           "{$WARN UNSAFE_CAST OFF}"
           "{$WARN UNSAFE_CODE OFF}"
           "{$ENDIF}"
           "{$IFDEF FPC}"
           "		{$DEFINE MODERN_CODE}"
           "{$ELSE}"     
           "    {$IFDEF _D5orHigher}"
           "		    {$DEFINE MODERN_CODE}"     
           "    {$ENDIF}"     
           "{$ENDIF}"     
           ""
           "////////////////////////////////////////////////////////////////////////"
           "{$IFnDEF MODERN_CODE}"
           "        {$DEFINE USE_FirstByte}"
           "{$ENDIF}"

    CASE !FPC ?
         o[] << @
         	"{$IFDEF Delphi7}"
            "{$WARN UNSAFE_TYPE OFF}"
            "{$WARN UNSAFE_CAST OFF}"
            "{$WARN UNSAFE_CODE OFF}"
            "{$ENDIF}"     
    ;
    CASE NOERR_option ?
         o[] << "{$DEFINE NOERR}" ;
    CASE NOEXCEPTIONS_option ?
         o[] << "{$DEFINE NOEXCEPTIONS}" ;
    CASE NOTRY_option ?
         o[] << "{$DEFINE NOTRY}" ;
    CASE !Comp.Verbose?
         o[] << "{$HINTS OFF}" ;
     .

            
METHOD generate_report_leaks(STR o|utput_lines[]) :
    o[] << @"procedure Report_leaks;"
            "var RL: "
    CASE kol >= 0 ?
         o[*] =_ "PStrList;"
    ELSE o[*] =_ "TStringList;" ;
         
    o[] << @"    procedure add_report(const class_nm:String;"
            "              n_constr, n_destr:Integer);"
            "    begin"
            "        if n_constr = n_destr then Exit;"
            "        RL.Add(i2s(n_constr) + #9 +"
            "           i2s(n_destr) + #9 + class_nm);"
            "    end;"
            "begin"
            
    CASE kol >= 0 ?
         o[] << "    RL := NewStrList;"
    ELSE o[] << "    RL := TStringList.Create;" ;
    
    FOR c IN Comp.All_classes[] :
        CASE c.Construct == NONE || c.Destruct == NONE
             ? 
             CONTINUE c ;
        
        o[] << sp(4) "add_report('" c.Final_name "'" 
        ", unit" c.Final_name ".Get_CNT(0)"
        ", unit" c.Final_name ".Get_CNT(1));"
    ;
    o[] << @"    if RL.Count > 0 then"
            "    begin"
            "       RL.Insert(0, 'constr' + #9 + " 
            "           'destr' + #9 + 'class');"
            "    end;"
            "    RL.SaveToFile(" 
            "       '" Comp.Destination.Trailing_slash "Report_leaks.txt');"
            "    RL.Free;"
            "end;"
            "" .

METHOD generate_all_classes :
	//DEBUG:
	//      CASE Comp.Verbose2 ?
	//           <<" GENERATE ALL_CLASSES.PAS" 
	//           //>> STR dummy|_string
	//      ;
	//;
	td[].Clear
	fd[].Clear
	im[].Clear
	structures_generated[].Clear
    ---------------------------------- 'unit header, interface'
    td[] << "unit All_classes;" << ""
    add_off_warnings(td[])
	td[] << "interface" << ""
	td[] << "uses "
    CASE FPC ? 
         td[*] =_ "LCLType, "
    ELSE td[*] =_ "Windows, " ;
    td[*] =_ sysutils ", "
    td[*] =_ "AL4;"
    
    ----------------------------- 'Profiler_save_reset'
    td[] << "procedure Profiler_save_reset;" << ""
    -------------------- 'start types declaration'
    td[] << "type" << ""
    --------------------------------------------- 'implementation begins'
    im[] << "implementation" << "" 
    im[] << "uses "
    FOR c IN Comp.All_classes[] :
        CASE im[*].Len > 75 ? im[] << sp(6) ;
        im[*] =_ "unit" c.Final_name ", " 
    ;
	im[*] = im[*].TrimR.Remove_ending(",").TrimR
    CASE Target != "LINUX" ?
    	 im[] << #TAB", Messages"
	;
	im[*] =_ ";"
    ---------------------------------- 'structures'
    FOR c IN Comp.All_classes[] :
        CASE c == NONE ? CONTINUE c ;
        FOR st IN c.Structures_[] :
            td[] << "//// gen structure " st.Final_name //>> STR A11111111111
            //DEBUG: o[] << "(*" Trace_stack(100) "*)" ;
            gen_structure_decl(st) ;
    ;
    ---------------------------------- 'structures from removed classes'
    FOR c IN Comp.Removed_classes[] :
        CASE c == NONE ? CONTINUE c ;
        FOR st IN c.Structures_[] :
            gen_structure_decl(st) ;
    ;
    ------------ 'which classes should have rtti at all ?'
	CASE "$RTTIONLY" IN Comp.Defined_name[] ?
	     STR rtti_classes[].Split(Comp.Defined_value[Comp.Defined_name[].Find(
	     	 "$RTTIONLY")], ",")
	     	 
	     FOR rc IN rtti_classes[] :
	         BOOL rc_present = FALSE
	         FOR c IN Comp.All_classes[] :
	             CASE c.Names[0] != rc ? CONTINUE c ;
	             DONE     
		              rc_present = TRUE
		              BREAK c ;
	         CASE !rc_present ?
	              STR unknown_rtti =_ rc " " ;
	     ;
	     CASE unknown_rtti != "" ?
	     	  Comp.Error("Option $RTTIONLY refers to unknown classes:"
	              ""._RttiUnknown unknown_rtti)
	     ;
	;
    ---------------------------------- 'classes'
    {Type} all|_classes_to_generate[]
    FOR c IN Comp.All_classes[] :
        CASE c == NONE ? CONTINUE c ;
        CASE c == NONE && Comp.Removed_classes[c.Index] != NONE
        	 && Comp.TEST_value
        	 ?
             c = Comp.Removed_classes[c.Index] ;
        CASE kol >= 0 ? td[] << "  " c.Final_name " = ^o" c.Final_name ";"
        ELSE td[] << "  " c.Final_name " = " o_c ";" ;
        all[] << c ;
    td[] << ""
    FOR c IN all[] :
        CASE c == NONE ? CONTINUE c ;
        //DEBUG:
        //	o[] << "///////////////////////// gen_class_decl"
        //;
        gen_class_decl(c, all[], "$NORTTI" !IN Comp.Defined_name[]
        	&& (rtti_classes[].Count == 0 || c.Names[0] IN rtti_classes[])) ;
    ---------------------------------- 'names for enums'
    FOR c IN Comp.All_classes[] :
        FOR e IN c.Enums_[] :
            generate_enum(e) ;
    ;
    ---------------------------------- 'localization data arrays'
    add_localize_data(fd[])
    ------------ 'for localizable classes'
    FOR c IN Comp.All_classes[] :
        CASE c == NONE && Comp.Removed_classes[c.Index] != NONE ?
             c = Comp.Removed_classes[c.Index] ;
        CASE c.Localize_n[].Count > 0 ?
             td[] << "const " c.Final_name
                     "_Loc_1st_item = " c.Localize_1st_item.Str ";"
        ;
    ;
    
    -------------------------------- 'implementing methods'
    FOR c IN Comp.All_classes[] :
        CASE c == NONE ? CONTINUE c ;
        FOR f IN c.Field[] :
            CASE !Comp.Debugging && !Comp.TEST_value ? BREAK f ;
            CASE !f.Modifiers['TRAP'] ? CONTINUE f ;
            CASE f.Trap_read_ != NONE ?
            	 implementation_of_trap(f, TRUE) ;
            CASE f.Trap_write_ != NONE ?
                 implementation_of_trap(f, FALSE) ;
        ;
        FOR m IN c.Method[] :
            CASE m == NONE ? CONTINUE m ;
            CASE m.Final_name == "-" ? CONTINUE m ;
            CASE m.Overloaded_[].Count > 0 ? CONTINUE m ;
            im[] << ""
            method_implementation(m, "") 
            CASE m.Ancestor_ != NONE && m != c.Construct && m != c.Destruct ?
                 method_implementation(m, "inherited") ;
        ;
        CASE Comp.TEST_value ?
             FOR m IN c.Test[] :
                 im[] << ""
                 method_implementation(m, "") ;
        ;
        CASE rtti_classes[].Count > 0 && c.Names[0] !IN rtti_classes[] ? NONE
        ELSE
	         im[] << "{$IFDEF USERTTI}"
	         CASE "$KOL" IN Comp.Defined_name[] ?
	              STR o_pref|ix_before_type_name = "o" ;
	              
			 im[] << "function " o_pref c.Final_name 
			 				    ".RTTI_object_type: Integer;"
			 				    
			 im[] << " begin"
			 im[] << "	Result := " (Comp.All_classes[].Find(c)+7).Str ";"
			 im[] << " end;" << ""
			 generate_RTTI_methods(c, FALSE, im[])
			 im[] << "{$ENDIF}"
        ;                      
        generate_fun_new(c, TRUE)
        generate_fun_new(c, FALSE)
        generate_noneclass_methods(c, c) ;
    FOR c IN Comp.Removed_classes[] :
        FOR st IN c.Structures_[] :
     		generate_new_1obj(c, st, TRUE) 
     		generate_new_1obj(c, st, FALSE) 
    	;
    ;
    im[] << "" << "procedure Profiler_save_reset;"
    CASE use_profiler != "" ?
	     STR var_p|rofiler_counters = "var Profiler_counts: "
	     CASE kol > 0 ? var_p =_ "PStrList;"
	     ELSE var_p =_ "TStringList;" ;
	     im[] << var_p
	     ..[] << "begin"
	     ---------------------------- 'body of Profiler_save_reset'
     	 CASE kol > 0 ? 
     	      im[] << "  Profiler_counts := NewStrList;"
     	 ELSE im[] << "  Profiler_counts := TStringList.Create();" ;     
         FOR c IN Comp.All_classes[] :
             CASE c == NONE ? CONTINUE c ;
             im[] << "  unit" c.Final_name ".Collect_CNT(Profiler_counts);"     
         ;
         ---------- 'ending'
         im[] << "  Profiler_counts.SaveToFile('profiler_data.prof');"
         ..[] << "end;"
    ELSE im[] << "begin " << "end;"  ;
    im[] << "" << "end." .

    
    
METHOD add_localize_data(STR o|out_strings[]) :
    ----------------- 'if localized string are present?'
    FOR c IN Comp.All_classes[] :
        CASE c.Localize_n[].Count == 0 ? CONTINUE c ;
        INT total_entries += 1 + c.Localize_n[].Count ;
    CASE total_entries == 0 ? ==> ;
    
    STR l_names|_localize_strings[] << sp(4) "var Localize_name: array[0.."
         "" (total_entries - 1).S "] of String = ("
         
    o[] << sp(4) "var Localize_str: array[0.."
         "" (total_entries - 1).Str "] of String = ("
    
    PUSH generating_localized_strings = TRUE :
         INT start|_index_for_class = 0 
         FOR c IN Comp.All_classes[] :
             CASE c.Localize_n[].Count == 0 ? CONTINUE c ;
             o[] << sp(10) "'',"
             l_names[] << sp(10) "'[" c.Names[*] "]',"
             start += 1
             c.Localize_1st_item = start
             FOR ns IN c.Localize_s[] :
             	 l_names[] << sp(10) "'" c.Localize_n[ns.Index] "',"
                 o[] << sp(10) gen_expr(ns) ","
                 start += 1
             ;
         ;
    ;
    CASE start == 0 ? ==> ;
    
    --------------------------- 'finish localization arrays'
    o[*] = o[*].[0 TO *-1] ");"             
    l_names[*] = l_names[*].[0 TO *-1] ");"
    FOR s IN l_names[] : o[] << s ; .
    

METHOD check_fields_all_libraries, DEBUG
	:
	FOR c IN Comp.All_classes[] :
	    CASE !class_to_dll(c) ? CONTINUE c ;
	    
	    im[] << "procedure check_impl_fields_" c.Final_name 
	    			"(const R: Timpl_all_methods);" <<
	    	   "begin"
	    	   
	    FOR m IN c.Method[] :
	        CASE m == NONE ? CONTINUE m ;
	        CASE m.Final_name == "-" ? CONTINUE m ;
	        
	        im[] << "  if not assigned(R.impl_" c.Final_name "_" m.Final_name 
	        	   ") then begin" <<
	        	   "    WriteLn('impl_" c.Final_name "_" m.Final_name 
	        	   " IS NOT ASSIGNED!!!');" <<
	        	   "    Readln;" <<
	        	   "  end;"
	    ;
	    im[] << "end;" << ""
	; 
	im[] << "procedure check_impl_fields(const R: Timpl_all_methods);" <<
		   "begin"
		   
	FOR c IN Comp.All_classes[] :
	    CASE !class_to_dll(c) ? CONTINUE c ;
	    im[] << "  check_impl_fields_" c.Final_name "(R);" ;
	im[] << "end;" << "" .

    
METHOD implementation_of_trap(
	{Var} F|eild_trapping,
	BOOL Read|_trap)
	:
	CASE kol >= 0 ? 
	     STR o_pref|ix_class_name = "o"
	     STR dog_pref|ix_Self = "@"
	ELSE o_pref = "" ;
	CASE Read ?
	     im[] << "function " o_pref F.In_type_.Final_name 
	     		".Trap_read_" F.Final_name
	     CASE F.Is_array ? im[*] =_ "(Index: Integer)" ;
	     im[*] =_ ": " F.Type_.Final_name ";"
	     
	ELSE im[] << "procedure " o_pref F.In_type_.Final_name ".Trap_write_"
		 "" F.Final_name "("
		 
		 CASE F.Is_array ? im[*] =_ "Index: Integer; " ;
		 CASE F.Type_.Kind IN ['CLASS', 'STRUCTURE'] ?
		      im[*] =_ "Value: Ref_obj"
		 ELSE
			  im[*] =_ "const Value: " F.Type_.Final_name
		 ;
		 im[*] =_ ");"
	;
	im[] << "begin "
	CASE Read ?
	     im[] << sp(4) "unit" F.In_type_.Final_name
	     	 "." F.Trap_read_.Final_name "(" dog_pref "Self"
	     CASE F.Is_array ? im[*] =_ ", Index" ;
	     im[*] =_ ");"
	     im[] << sp(4) "RESULT := " F.Final_name 
	     CASE F.Is_array ?
	          CASE F.Type_.Kind ?
	          ['STR']: im[*] =_ ".GetStrings"
	          ['BOOL']: im[*] =_ ".GetBools"
	          ['ENUM']: im[*] =_ ".GetBytes"
	          ['INT']: im[*] =_ ".GetIntegers"
	          ['CLASS', 'STRUCTURE']: im[*] =_ ".GetObjects"
	          ['REAL']: im[*] =_ ".GetReals" ;
	          im[*] =_ "(Index)"
	     ;
	     im[*] =_ ";"
	     
	ELSE im[] << sp(4) "unit" F.In_type_.Final_name "." F.Trap_write_.Final_name 
				"(" dog_pref "Self"
				
		 CASE F.Is_array ? im[*] =_", Index" ;
		 im[*] =_ ", Value);"
		 ------------------------------------- 'write operation itself'
		 im[] << sp(4) F.Final_name
		 CASE F.Is_array ?
		      CASE F.Type_.Kind ?
		      ['BOOL']:			  im[*] =_ ".SetBools"
		      ['ENUM']:	  		  im[*] =_ ".SetBytes"
		      ['INT']:			  im[*] =_ ".SetIntegers"
		      ['REAL']:			  im[*] =_ ".SetReals"
		      ['STR']:			  im[*] =_ ".SetStrings"
		      ['CLASS', 'STRUCTURE']:im[*] =_ ".SetObjects" ;
		      im[*] =_ "(Index, Value);"
		 ELSE
		 	  CASE ?
		 	  [F.Type_.Kind IN ['CLASS', 'STRUCTURE'] && !F.Is_weak] ?
		 	       im[*] = sp(4) "Object_assign_hard(" F.Final_name 
		 	       ", Value.Obj);"
		 	  [F.Type_.Kind IN ['CLASS', 'STRUCTURE'] && F.Is_weak] ?
		 	       im[*] = sp(4) "Object_assign_weak(" F.Final_name
		 	       ", Value.Obj);"
		 	  ELSE im[*] =_ " := Value;" ;
		 ;
	;
	im[] << "end;" << "" .

METHOD method_implementation(
	{Fun} M|ethod_implement, STR Inh|erited)
	:
    ------------------ 'method header'
    CASE M.Modifiers['STATIC'] && kol >= 0 ? ==> ;
    im[] << ""
    CASE M.Modifiers['STATIC'] ? im[*] =_ "class " ;
    CASE M.Result != NONE ? im[*] =_ "function "
    ELSE im[*] =_ "procedure " ;
    {Type} c|lass_from = M.Class
    CASE kol >= 0 ? im[*] =_ "o" ;
    -------------------------------- 'parameters'
    im[*] =_ c.Final_name "." Inh M.Final_name "("
    FOR p IN M.Param[] :
        im[*] =_ "  " gen_param(p) ";" ;
    CASE M.Modifiers['STORE'] ?
        im[*] =_ "  var " M.Stored_param.Final_name ": Integer;" ; 
    CASE im[*].[*] == ";" ?
         im[*] = im[*].[0 TO *-1] ;
    im[*] =_ ")"
    ------------------------------- 'result type'
    CASE M.Result != NONE ?
         im[*] =_ ": " result_type_name(M) ;
    im[*] =_ ";"
    CASE Use_jumps
         && !FPC && M.Param[].Count <= 2 && M <> c.Construct && M <> c.Destruct
         && (c.Parse.Compiler_.{Compiler}.Int32 || M.Param[].Count <= 1
             && M.Result.Type_.Kind != 'INT')
         && M.Param[0].Type_.Kind !IN ['REAL', 'STRUCTURE']
         && !M.Param[0].Is_array
         && M.Param[1].Type_.Kind !IN ['REAL', 'STRUCTURE']
         && !M.Param[1].Is_array
         && M.Result.Type_.Kind !IN ['REAL', 'STR', 'STRUCTURE', 'CLASS', 
         	'ENUM']
         && (c.Parse.Compiler_.{Compiler}.Int32 
         	|| M.Param[0].Type_.Kind != 'INT' 
         	&& M.Param[1].Type_.Kind != 'INT')
         && (Inh == "" || find_base_implementing(M, c.Base_))
         
         //&& M.Param[].Count == 0
         //&& M.Result == NONE
         //&& !M.Modifiers['STATIC']
         ?
         im[] << "    asm" 
         im[] << "    jmp " 
         CASE Inh != "" ? im[*] =_ "unit" c.Base_.Final_name "."
         ELSE im[*] =_ "unit" c.Final_name "." ;
         im[*] = _ M.Final_name
         im[] << "    end;"
    ELSE
	     ------------------- 'BEGIN'
	     im[] << " begin " << "  "
	     -------------------------------- 'CONSTRUCT calls inherited on begin'
	     CASE M == c.Construct ?
	          im[*] =_ "inherited;" 
	          im[*] =_ "  " ;
	     ------------------- 'recall function placed in class unit'
	     //DEBUG: o[] << "asm" << "  jmp @@1" << "  DB '" M.Final_name "'" <<
	     //	   "  @@1:" << "end;" ;
		      CASE M.Result != NONE ? im[*] =_ "Result := " ;
		      CASE Inh != "" ? im[*] =_ Inh " "
		      ELSE im[*] =_ "unit" c.Final_name "." ;
		      im[*] =_ M.Final_name "( "
		      
		      CASE !M.Modifiers['STATIC'] && Inh == "" ?
		           CASE kol >= 0 ? im[*] =_ "@" ;
		           im[*] =_ "Self," ;
		      FOR p IN M.Param[] :
		          im[*] =_ sp(4) p.Final_name "," ;
		      CASE M.Modifiers['STORE'] ?
		          im[*] =_ sp(4) M.Stored_param.Final_name "," ;
		      im[*] = _.[0 TO *-1] ");"
	     --------------------------------- 'DESTRUCT calls inherited on end'
	     CASE M == c.Destruct ?
	          im[] << "  inherited;" ;
	     im[] << " end;"
    ; .
    
FUN find_base_implementing(
{Fun} Method|_to_find_implementation, {Type} Base_cl|ass) ==> BOOL
    :
    {Type} par|ent_class = Base_cl 
    //FOR i IN [0 TO 1_000] :
        //CASE par == NONE ? 
        //     << Cc('RED') "could not find base class implementing method "
        //     << Cc('SILVER') Method.Whole_name #NL
        //     RESULT = Base_cl.Final_name "{--ancestor not found--}" ==> ;
        FOR m IN par.Method[] :
            CASE Method.Ancestor_ == m ? 
                 RESULT = TRUE ==> ;
                 //RESULT = par.Final_name ==> ;
        ;
        //par = par.Base_
    //; 
    .


FUN is_simple_struc|ture_can_be_represented_by_RECORD(
{Type} St|ructure_type) ==> BOOL, RECURSIVE
	:
	FOR f IN St.Field[] :
	    CASE f.Is_array && !f.Is_fixed ? ==> ;
	    CASE f.Type_.Kind IN ['STR', 'CLASS'] ? ==> ;
	    CASE f.Type_.Kind == 'STRUCTURE' && !f.Type_.is_simple_struc ? ==> ;
	;
	RESULT = TRUE .

{Type} structures_generated[]
	
METHOD gen_structure_decl({Type} St|ructure_type), RECURSIVE :
PUSH Comp.Current_class = St.In_class_ :
	------------------------------------------ 'generate once'
	CASE St IN structures_generated[] ? ==> ;
	FOR f IN St.Field[] :
		CASE f.Type_.Kind == 'STRUCTURE' 
			 && f.Type_ !IN structures_generated[]
			 ?
			 gen_structure_decl(f.Type_)
		;
	;
	------------------------------------------ 'declare object'
	CASE ?
	[St.Final_name[0] == "s"] ?
	     BOOL simple|_structure = TRUE
	     td[] << "  P" St.Final_name " = ^" St.Final_name ";"
	     td[] << "  " St.Final_name " = record"
	     
	[kol >= 0] ?
	     td[] << "  P" St.Final_name " = ^" St.Final_name ";" <<
	            "  " St.Final_name " = object(TStructure_any)"
	            
	ELSE td[] << "  " St.Final_name " = class(Structure_any)" ; 
    FOR f IN St.Field[] :
        PUSH Comp.Current_class.Parse.Line = f.Line :
	         CASE f.Is_fixed ?
	              CASE f.Size_value == 0 ?
	              	   NONE = f.Provide_size_value
	              ;
	              STR t_name|_of_type = type_gen(f.Type_, {type_options}())
	              CASE f.Type_.Kind == 'ENUM' ? t_name = "Byte" ;
	              td[] << "    " f.Final_name ": array[0.." 
	             		 "" f.Provide_size_value.Str "-1] of "
	                     "" t_name ";"
	                     
	         ELSE t_name = var_type_gen(f, TRUE)
	         	  CASE ?
	         	  [f.Type_.Kind == 'INT' && !f.Is_array
	         	   && f.Type_indexing != ""] ?
	         	       t_name = "Integer"
	         	  [f.Type_.Kind == 'ENUM' && !f.Is_array] ? 
	         	       t_name = "Byte"
	         	  ;
	         	  td[] << "    " f.Final_name ": " t_name ";"
	         ;
        ;
    ;
    CASE !simple ?
	     CASE kol >= 0 && St.Kind == 'STRUCTURE' ? NONE
	     ELSE
	     	td[] << "      class function New_instance: Ref_obj; override;"
	     ;
	     td[] << sp(4) "function Clone"
	     CASE kol >= 0 ? td[*] =_ ": Ref_obj; virtual;"
	     ELSE td[*] =_ "{$IFDEF _D5orHigher}(){$ENDIF}: Ref_obj; override;" ; 
		 ----------------------------------------- 'none, new'
	     CASE kol >= 0 ?
	          td[] << sp(6) "class function NONE_obj_instance: Ref_obj; virtual;"
	          td[] << sp(6) "constructor Create;"
	          td[] << sp(6) "destructor Destroy; virtual;"
	     ELSE 
	     	  td[] << sp(6) "class function NONE_obj_instance: Ref_obj; override;" 
	          td[] << sp(6) "constructor Create; virtual;"
	          td[] << sp(6) "destructor Destroy; override;"
	     ;
    	 fd[] << " function " St.Final_name "_New_instance: Ref_obj;"
    	 
    	 im[] << "" << " function " St.Final_name "_New_instance: Ref_obj;"
    	 
    	 im[] << " begin"
    	 		 "	Result := New_" St.Final_name ".hard_link;"
    	 		 " end;"
    ;
	------------------------- 'end of object declaration'
    td[] << "  end;" << "" 
	------------------------------------------ 'mark as generated'
	structures_generated[] << St
; .
    

METHOD gen_class_decl(
	{Type} C|lass_generating, {Type} A|rray_classes[], BOOL need_rtti),
    RECURSIVE
    :
    ------------------ 'If the base class is not yet declared, declare it first'
    CASE C.Base_ != NONE && C.Base_ IN A[] ?
         gen_class_decl(C.Base_, A[], need_rtti) ;
    ---------------------------------- 'generate C'
    CASE kol >= 0 ? td[] << "  o" C.Final_name " = object"
    ELSE td[] << "  " C.Final_name " = class" ;
    C.check_fix_final_names
    CASE C.Base_ != NONE ?
         td[*] =_ "(" 
         CASE kol >= 0 ? td[*] =_ "o" ;
         td[*] =_ C.Base_.Final_name ")"
    ELSE 
         CASE kol >= 0 ? td[*] =_ "(TAL4_object)" 
         ELSE td[*] =_ "(AL4_object)" ;
    ;
    ---------------------------- 'declare fields'
    td[] << "  public"
    FOR f IN C.Field[] :
        CASE f.Names[0] == "DATA" ?
             CONTINUE f ;
        //DEBUG:
        //      CASE f.Names[0] == "File_menu" ? NONE ;
        //;
        td[] << sp(4) f.Final_name ": "
        BOOL a_obj|ects_array = FALSE
        CASE ?
        [f.Is_array] ?
             td[*] =_ "DynA"
             CASE f.Type_.Kind ?
                  ['BOOL']:        		td[*] =_ "Byte"
                  ['ENUM']:				td[*] =_ "Byte"
                  ['INT']:         		td[*] =_ "Int"
                  ['REAL']:		   		td[*] =_ "Real"
                  ['STR']: 		   		td[*] =_ "Str"
                  ['CLASS', 'STRUCTURE']:	td[*] =_ "Obj"
                                   a_obj = TRUE ;
             td[*] =_ ";"
        [f.Type_.Kind == 'STRUCTURE' && f.Type_.Final_name[0] == "s"] ?
             td[*] =_ " " f.Type_.Final_name ";"
        ELSE 
             CASE f.Type_.Kind ?
             ['ENUM']: td[*] =_ "Integer;"
             ['STRUCTURE', 'CLASS']: td[*] =_ "Ref_obj;"
             ['BOOL']:
                td[*] =_ f.Type_.Final_name ";"
             ['INT']:
             	STR i_type|_int = "IntegerValue"
             	CASE Comp.Int32 || f.Type_indexing != "" || f.Is_stored_param ? 
             	     i_type = "Integer" ;
                td[*] =_ i_type ";"
             ['STR']:
             	CASE FPC ? td[*] =_ "Str;" 
             	ELSE td[*] =_ f.Type_.Final_name ";" ;
             ['REAL']:
        		td[*] =_ real_type ";"
             ;
        ;
        td[*] =_ " // field decl: " f.Total_i.Str " " f.Names[0]
    ;
    ------------------------ 'declare traps for fields'
    FOR f IN C.Field[] :
    	CASE !Comp.Debugging && !Comp.TEST_value ? BREAK f ;
    	CASE !f.Modifiers['TRAP'] ? CONTINUE f ;
    	CASE f.Trap_read_ != NONE ?
    	     td[] << sp(4) "function Trap_read_" f.Final_name
    	     CASE f.Is_array ? td[*] =_ "(Index: Integer)" ;
    	     td[*] =_ ": " f.Type_.Final_name ";" ;
    	CASE f.Trap_write_ != NONE ?
    	     td[] << sp(4) "procedure Trap_write_" f.Final_name "("
    	     CASE f.Is_array ? td[*] =_ "Index: Integer; " ;
    	     CASE f.Type_.Kind IN ['CLASS', 'STRUCTURE'] ?
    	          td[*] =_ "Value: Ref_obj"
			 ELSE td[*] =_ "const Value: " f.Type_.Final_name ;
    	     td[*] =_ ");" ;
    ;
    ------------------------------------ 'class methods declarations'
    //DEBUG: << "*".Repeat(80) "generate methods declarations for class "
    //		  "" C.Whole_name #NL ;
    FOR m IN C.Method[] :
    	//DEBUG: << "generate decl " m.Index.Str "of method " m.Total_fn.Str 
    	//		  " " m.Whole_name ", Is_generic=" m.Is_generic.Str 
    	//		  #NL ;
    	CASE m == NONE ? CONTINUE m ;
        CASE m.Final_name == "-" ? CONTINUE m ;
        CASE m.Overloaded_[].Count > 0 ? CONTINUE m ;
        CASE Comp.Verbose2 ?
             << "........ gen method declaration: " C.Names[0] 
             	"." m.Whole_name #NL
        ;
        gen_method_declaration(m, FALSE)
        ------------------------------------------- 'to call inherited:'
        CASE m.Ancestor_ != NONE && m != C.Construct && m != C.Destruct ?
             td[] << sp(4) ""
             CASE m.Result != NONE ? td[*] =_ "function "
             ELSE td[*] =_ "procedure " ;
             td[*] =_ "inherited" m.Final_name "("
             FOR p IN m.Param[] :
                 td[] << sp(8) gen_param(p) ";" ;
             CASE td[*].[*] == ";" ?
                  td[*] = td[*].[0 TO *-1] ;
             td[*] =_ ")"
             CASE td[*].Ending("()") ? 
                  td[*] = td[*].[0 TO *-2] "{$IFDEF _D5orHigher}(){$ENDIF}" ;
             CASE m.Result != NONE ?
                  td[*] =_ ": " result_type_name(m) ;
             td[*] =_ ";"
             td[*] =_ "// call inherited method decl: " m.Total_fn.Str ;
    ;
    ----------------------------------------- 'RTTI'
    CASE need_rtti ?
    	 td[] << "{$IFDEF USERTTI}"
         td[] << sp(4) "public function RTTI_object_type(): Integer;"
         CASE "$KOL" IN Comp.Defined_name[] ? td[*] =_ " virtual;"
         ELSE td[*] =_ " override;" ;
         generate_RTTI_methods(C, TRUE, td[])
    	 td[] << "{$ENDIF}"
    ;
    ----------------------------------------- 'none, new'
    CASE do_need_none(C) ?
         CASE kol >= 0 ?
              td[] << sp(4) "class function NONE_obj_instance: Ref_obj; "
                     "virtual; {qq}"
    
              CASE C.Base_ != NONE ?
                   td[] << sp(4) "class function NONE_base_obj: AL4_object; "
                                "virtual; {pp}"
              ;
         ELSE
              td[] << sp(4) "class function New_instance: Ref_obj; override; "
                     "{oo}"
    
              td[] << sp(4) "class function NONE_obj_instance: Ref_obj; "
                           "override; {nn}"
    
              CASE C.Base_ != NONE ?
                   td[] << sp(4) "class function NONE_base_obj: AL4_object; "
                                "override; {mm}"
              ;
         ;
    ;
    ------------------------------ 'generate test functions'
    CASE Comp.TEST_value ?
         FOR m IN C.Test[] :
             gen_method_declaration(m, FALSE) ;
    ;
    td[] << "  end;" << ""
    CASE do_need_none(C) ?
         fd[] << "  function " C.Final_name "_New_instance: Ref_obj; {ooo}" 
         fd[] << "  function NoneClass_" C.Final_name "_New_instance: Ref_obj;" 
    ;
    
    ------------------------------ 'generate noneclass_'
    STR obj_n|ame_class
    
    FOR st IN C.Structures_[] :
        obj_n = st.Final_name
        CASE obj_n.[0] == "s" ? CONTINUE st ;
        CASE kol >= 0 ? 
             td[] << @"  Noneclass_" obj_n " = ^oNoneclass_" obj_n ";"
             td[] << @"  oNoneclass_" obj_n " = object(" obj_n ")"
        ELSE
             td[] << @"  Noneclass_" obj_n " = " o_c "(" obj_n ")"
        ;
        CASE kol >= 0 ?
        ELSE
             td[] << sp(4) "class function New_instance: Ref_obj; "
                    "override; {ll}"
        ;
        td[] << "  end;" << "" ;
    CASE do_need_none(C) ?
         STR n|ame_class = C.Final_name
         CASE kol >= 0 ? 
              td[] << @"  Noneclass_" n " = ^oNoneclass_" n ";"
              
              td[] << @"  oNoneclass_" n " = object(o" n ")"
                      "" sp(4) "public procedure Erase"
                      "{$IFDEF _D5orHigher}(){$ENDIF}; virtual;"
         ELSE
              td[] << @"  Noneclass_" n " = " o_c "(" n ")"
                      "" sp(4) "public procedure Erase"
                      "{$IFDEF _D5orHigher}(){$ENDIF}; override;"
         ;
         declare_noneclass_methods_decl(C, C)
         CASE kol >= 0 ?
         ELSE
              td[] << sp(4) "class function New_instance: Ref_obj;"
                     " override; {kk}"
         ;
         td[] << "  end;" << ""
    ;
    ------------------------------ 'remove C from A[]'
    INT pos|ition INDEXING {Type} = A[].Find(C)
    A[pos] = NONE .

METHOD declare_noneclass_methods_decl|arations(
{Type} C|lass_methods, 
{Type} Top|_class_declaring), RECURSIVE
    :
    ------------------------------------ 'declare ancestor methods'
    CASE C.Base_ != NONE ?
         declare_noneclass_methods_decl(C.Base_, Top) ;
    ------------------------------------ 'declare class methods'
    CASE C == Top ?
         td[] << "// NONE versions of own methods of " C.Final_name
         
    ELSE td[] << "// NONE versions of " C.Final_name 
         " (ancestor of " Top.Final_name ")"
    ;
    BOOL first|_method = TRUE
    FOR m IN C.Method[] :
        CASE ?
        [m == NONE] ? CONTINUE m
        [m.Final_name == "-"] ? CONTINUE m
        [m.Modifiers['STATIC']] ? CONTINUE m
        [m.Ancestor_ != NONE] ? CONTINUE m
        [m.Overloaded_[].Count > 0] ? CONTINUE m
        ; 
        CASE (m == C.Construct || m == C.Destruct) && C != Top ? CONTINUE m ;
        ----------------------------- 'comment on a class'
        CASE first ?
             first = FALSE
             
             td[] << "// noneclass methods for top class " Top.Names[0] 
             " (current class = " C.Names[0] ")"
        ;
        ----------------------------- 'declare single method'
        td[] << sp(4)
        CASE m.Result != NONE ? td[*] =_ "function "
        ELSE td[*] =_ "procedure " ;
        td[*] =_ m.Final_name "("
        FOR p IN m.Param[] : td[] << sp(6) gen_param(p) ";" ;
        CASE m.Modifiers['STORE'] ?
            td[] << sp(8) "var " m.Stored_param.Final_name ": Integer;" ;
        CASE td[*].[*] == ";" ? td[*] = td[*].[0 TO *-1] ;
        td[*] =_ ")"
        CASE td[*].Ending("()") ? 
             td[*] = td[*].[0 TO *-2] "{$IFDEF _D5orHigher}(){$ENDIF}" ;
        CASE m.Result != NONE ?
             td[*] =_ ": " result_type_name(m) ;
        ------------------------- 'specific for objects: always virtual'
        CASE m IN Comp.Functions_used[] || (
    	 	 m == m.Class.Construct || m == m.Class.Destruct) || (
    	 	 m.Ancestor_ != NONE || there_are_descendants_for_method(m))
    	 	 //|| Comp.Any_class_from_ccc
    	   	 ?
	         CASE kol >= 0 ? td[*] =_ "; virtual;"
	         ELSE            td[*] =_ "; override;" ;
        ELSE td[*] =_ ";" ;
    ; .
    

METHOD gen_method_declaration(
	{Fun} M|ethod_to_declare, BOOL As_type|_of_function_procedure)
	:
	//DEBUG:
	//      CASE M.Total_fn IN [10016, 10012, 10010, 10007, 10005] ?
	//           << "gen_method_declaration called for fn=" M.Total_fn.Str ": "
	//           	  "" Trace_stack(100) #NL >> ;
	//;
	CASE M.Overloaded_[].Count > 0 ? ==> ;
    ----------------------------------------------------- ''
    CASE kol >= 0 && M.Modifiers['STATIC'] ? ==> ;
    td[] << sp(4)
    CASE M.Modifiers['STATIC'] && !As_type ? td[*] =_ "class " ;
    CASE M.Result != NONE ? td[*] =_ "function "
    ELSE td[*] =_ "procedure " ;
    ------------------------------- 'parameters'
    CASE !As_type ? td[*] =_ M.Final_name ;
    td[*] =_ "("
    CASE As_type && !M.Modifiers['STATIC'] ?
         td[*] =_ "THIS: " M.Class.Final_name ";" ;
    FOR p IN M.Param[] :
        td[*] =_ sp(8) gen_param(p) ";" ;
    CASE M.Modifiers['STORE'] ?
        td[*] =_ sp(8) "var " M.Stored_param.Final_name ": Integer;" ;
    CASE td[*].[*] == ";" ?
         td[*] = td[*].[0 TO *-1] ;
    td[*] =_ ")"
    CASE td[*].Ending("()") ?
         td[*] = td[*].[0 TO *-2] "{$IFDEF _D5orHigher}(){$ENDIF}" ;
    ------------------------------- 'result type, then vitual/override'
    CASE M.Result != NONE ?
         td[*] =_ ": " result_type_name(M) ;
    td[*] =_ ";"
    //DEBUG:
    //      CASE M.Total_fn == 1005 ? NONE ;
    //;
    CASE !As_type && !M.Modifiers['STATIC'] && (M IN Comp.Functions_used[] || (
    	 M == M.Class.Construct || M == M.Class.Destruct) || (
    	 M.Ancestor_ != NONE || there_are_descendants_for_method(M))
    	 //|| Comp.Any_class_from_ccc
    	 )
    	 ?
         CASE kol < 0 && (M.Ancestor_ != NONE || (
              M == M.Class.Destruct || M == M.Class.Construct))
              ? 
              td[*] =_ " override;"
         ELSE td[*] =_ " virtual;" ;
    ;
    CASE !As_type ?
    	 td[*] =_ "/" "/ method decl: " M.Total_fn.Str ; .
    
METHOD there_are_descendants_for_method(
	{Fun} M|ethod_may_be_overridden) ==> BOOL
	:
	FOR c IN Comp.All_classes[]:
	    CASE c == M.Class ? CONTINUE c ;
	    CASE !c.Is_descend(M.Class, Comp) ? CONTINUE c ;
	    FOR m IN c.Method[] :
	        CASE m == NONE ? CONTINUE m ;
	        CASE m.Ancestor_ == M ? RESULT = TRUE ==> ;
	    ;
	; .
    

FUN check_fix_final_names({Type} C|lass_to_fix) :
    FOR f IN C.Field[] :
        STR n|ame_final = f.Final_name
        STR was_f_final_name = f.Final_name
        f.Set_final_name("")
             BOOL need|_to_fix = final_name_present(C, n)
        f.Set_final_name(was_f_final_name)
        CASE need && f.Line >= 0 ?
             f.Set_final_name(f.Final_name "_Line" f.Line.Str "_" n) ;
    ;
    FOR m IN C.Method[] :
        CASE m == NONE ? CONTINUE m ;
        n = m.Final_name
        CASE n == "-" ? CONTINUE m ;
        PUSH m.Final_name = "" :
             need = final_name_present(C, n) ;
        CASE need && m.Line_start >= 0 ?
             m.Final_name = "_Line" m.Line_start.Str "_" n ;
    ; .

FUN final_name_present({Type} C|lass_analyzing,
    STR N|ame_checking) ==> BOOL
    :
    ------------------------------------ 'Such final name already used?'
    STR lo|wered_name = N.Lower
    FOR f IN C.Field[] :
        CASE f.Final_name.Lower == lo ? RESULT = TRUE ==> ;
    ;
    FOR m IN C.Method[] :
        CASE m == NONE ? CONTINUE m ;
        CASE m.Final_name.Lower == lo ? RESULT = TRUE ==> ;
    ; .

METHOD result_type_name({Fun} M|ethod_handling) ==> STR :
    {Type} t|ype_of_result = M.Result.Type_
    CASE t.Kind ?
    ['ENUM']: RESULT = "Integer"
    ['CLASS']: RESULT = "Ref_obj"
    ['STRUCTURE']:
			CASE t.Final_name[0] == "s" ? RESULT = t.Final_name
			ELSE RESULT = "Ref_obj" ;
    ['BOOL', 'INT', 'STR']:
                RESULT = t.Final_name 
    ['REAL']: RESULT = real_type
    ; .

METHOD gen_param|eter_declaration(
{Var} V|ariable) ==> STR
	:
    CASE !V.Is_array && V.Type_.Kind == 'STR' ?
     	 RESULT = "const "
    ;
    RESULT =_ V.Final_name ": " type_gen_A(
    		V.Type_,
    		{type_options}(
    			StrToString= TRUE,
    			Array= V.Is_array,
    			Fixed= V.Is_fixed,
    			Weak= V.Is_weak,
    			Declare = TRUE)
    ) .

{Type} generating_class
	
METHOD generate_fun_new|_for_class(
	{Type} C|lass_to_create_object,
	BOOL Is_class_function)
	:
	FOR st IN C.Structures_[] :
	    generate_new_1obj(C, st, Is_class_function) 
	;
	PUSH generating_class = C :
	    --------------------------- 'Header of function {Type}.New_instance'
	    CASE !do_need_none(C) ?
	         CASE kol < 0 ?
	              im[] << "// class " C.Names[0] 
	              		  "does not need NONE, skip declaring:"
	              im[] << "// class function " C.Final_name ".New_instance"
	         ;
	    ==> ;
	    CASE kol >= 0 ?
	         CASE Is_class_function ?
	         	  BOOL dont|_create_class_functions = TRUE
	         ELSE 
	         	im[] << "" << "function " C.Final_name "_New_instance: Ref_obj;"
	         ;
	    ELSE
	    	 CASE Is_class_function ? 
                  im[] << "" << "class function " C.Final_name
                  ".New_instance: Ref_obj; {jj}"
	    	 	  
	    	 ELSE im[] << "" << "function " C.Final_name "_New_instance: Ref_obj;"
	    	 ;
	    ;
	    CASE !dont ?
	         im[] << "begin {CC}"
	         im[*] =_ " Result := unit" C.Final_name 
	         im[*] =_ ".New_" C.Final_name ".hard_link;"
	         im[*] =_ " end;" 
	         //im[] << "" 
	    ;
	    --------------------------- 'NoneObj_instance'
	    CASE Is_class_function ?
		     CASE kol >= 0 ?
		                im[] << "class function o" C.Final_name
		                   ".None_obj_instance: Ref_obj; {ii}"
		     
		           ELSE im[] << "class function " C.Final_name
		                   ".None_obj_instance: Ref_obj; {hh}"
		     ;
	    ELSE 
	    	 CASE kol >= 0 ?
		          im[] << "function o" C.Final_name
		             "_None_obj_instance: Ref_obj; {ii2}"
		             
		     ELSE im[] << "function " C.Final_name
		             "_None_obj_instance: Ref_obj; {hh2}"
		     ;
	    ;
	    im[] << "begin {DD}"
	    im[*] =_ " Result := NoneObj_" C.Final_name ".hard_link;"
	    im[*] =_ " end;" 
	    //<< ""
	    --------------------------- 'NONE_base_obj'
	    CASE C.Base_ != NONE ?
	         CASE Is_class_function ?
			      CASE kol >= 0 ?
	                   im[] << "class function o" C.Final_name
	                      ".NONE_base_obj: AL4_object; {gg}"
			      
	              ELSE im[] << "class function " C.Final_name
	                      ".NONE_base_obj: AL4_object; {ff}"
			      ;
	         ELSE
	         	  CASE kol >= 0 ?
			           im[] << "function o" C.Final_name
			              "_NONE_base_obj: AL4_object; {gg}"
			              
			      ELSE im[] << "function " C.Final_name
			              "_NONE_base_obj: AL4_object; {ff}"
			      ;
	         ;
		     im[] << "begin "
		     im[] << #TAB"Result := NoneObj_" C.Base_.Final_name ";"
		     im[] << "end;" << ""
		;	 
	    --------------------------- 'New_instance for Noneclass_...'
	    CASE kol >= 0 ?
	    	 CASE Is_class_function ?
	    	      dont = TRUE
	    	 ELSE
	    	 	  im[] << "function Noneclass_" C.Final_name 
			      "_New_instance: Ref_obj; {ee2kol}"
	    	 ;
	    ELSE
	    	 CASE Is_class_function ?
                  im[] << "class function Noneclass_" C.Final_name
                  ".New_instance: Ref_obj; {ee}"
	    	 ELSE
	    	 	  im[] << "function Noneclass_" C.Final_name 
			      "_New_instance: Ref_obj; {ee2}"
	    	 ;
	    ;
	    CASE !dont ?
	         im[] << " begin {EE}"
	         im[*] =_ " Result := unit" C.Final_name
	         im[*] =_ ".New_Noneclass_" C.Final_name ".hard_link;"
	         im[*] =_ " end;" ;
	; .
	    
METHOD generate_new_1obj(
{Type} C|lass_to_create_object,
{Type} obj|ect_of_structure,
BOOL Is_class_function)
	:
	CASE obj.Kind == 'STRUCTURE' && obj.Final_name[0] == "s" ? ==> ;
    PUSH generating_class = obj :
         CASE kol >= 0 ?
	          BOOL dont|_create_class_functions = TRUE
	          
	     ELSE
	     	  CASE Is_class_function ? 
                   im[] << "" << "class function " obj.Final_name
                   ".New_instance: Ref_obj; {dd}"
              ELSE dont = TRUE  ;
	     ;
	     CASE !dont ?
	          im[] << @"begin"

	          	   im[] << #TAB"Result := unit" C.Final_name 
	          			  ".New_" obj.Final_name ".hard_link;"
	          			  
	          im[] << "end;" << "" ;
	     CASE obj.Kind == 'STRUCTURE' && !Is_class_function ?
	          structure_Clone_function_implement(C, obj)
	     ; 
	     --------------------------- 'obj: None_obj_instance'
	     CASE Is_class_function ?
		      CASE kol >= 0 ?
		      	   im[] << "class function " obj.Final_name
		      	   	  ".None_obj_instance: Ref_obj; {cc}"
	          ELSE im[] << "class function " obj.Final_name
	                  ".None_obj_instance: Ref_obj; {bb}"
		      ;
	     ELSE
	     	  CASE kol >= 0 ?
		           im[] << "function " obj.Final_name
		              "_None_obj_instance: Ref_obj; {cc2}"
		      ELSE im[] << "function " obj.Final_name
		              "_None_obj_instance: Ref_obj; {bb2}"
		      ;
	     ;
	     im[] << @"begin"

	     	  im[] << #TAB"Result := NoneObj_" obj.Final_name 
	     			 ".hard_link;"

	     im[] << "end;" << ""
	     --------------------------- 'obj: New_instance for Noneclass_...'
	     dont = FALSE
	     CASE kol >= 0 ? dont = TRUE
	     ELSE
	     	  CASE Is_class_function ?
                   im[] << "class function Noneclass_" obj.Final_name
                   ".New_instance: Ref_obj; {aa}"
	     	  ELSE im[] << "function Noneclass_" obj.Final_name 
		           "_New_instance: Ref_obj; {aa2}"
	     	  ;
	     ;
	     CASE !dont ?
	          im[] << " begin"
	          im[*] =_ " Result := unit" C.Final_name 
	          im[*] =_ ".New_Noneclass_" obj.Final_name ".hard_link;"
	          im[*] =_ " end;" 
	          //<< "" 
	     ;
	     CASE Is_class_function ? ==> ;
	     --------------------------- 'obj: constructor'
	     im[] << "constructor " obj.Final_name ".Create;"
	     im[] << " begin"
	     im[] << "  inherited;"
	     im[] << " end;" << ""
	     --------------------------- 'obj: Destructor'
     	 im[] << "destructor " obj.Final_name ".Destroy;"
	     im[] << " begin"
	     FOR f IN obj.Field[] :
	         CASE ?
	         [f.Is_fixed && f.Size_n[0] == "{"] ?
	              CONTINUE f
	              
	         [f.Is_fixed && f.Type_.Kind IN ['BOOL', 'INT', 'REAL',
	          'ENUM']] ?
	              CONTINUE f
	              
	         [f.Is_array] ?
	              im[] << sp(4) f.Final_name ".Free;" 
	              
	         [f.Type_.Kind IN ['CLASS', 'STRUCTURE']
	          && f.Type_.Final_name[0] != "s"] ?
	              im[] << sp(4) f.Final_name ".Ref_dec_hard();"
	              
	         [f.Type_.Kind == 'STR' && kol >= 0] ?
	              im[] << sp(4) f.Final_name " := '';"
	              
	         [f.Type_.Kind == 'STR' && FPC] ?
	              im[] << sp(4) f.Final_name ".Free;"
	         ;		 
	     ;     
	     im[] << "  inherited;"
	     im[] << "end;" << ""
    ; .

METHOD structure_Clone_function_implement(
{Type} C|lass_to_create_object_DUMMY,
{Type} obj|ect_of_structure)
	:
	CASE kol >= 0 ? STR p|refix_P = "P" ;
    im[] << "function " obj.Final_name ".Clone(): Ref_obj; {AA}"
    ..[] << "var ret: " p obj.Final_name ";"
    ..[] << "begin"
    CASE kol >= 0 ?
         ..[] << "  ret := New_" obj.Final_name ";"
    ELSE 
    	 ..[] << "  ret := " p obj.Final_name 
    	 		 "(" obj.Final_name ".New_instance().Obj);" 
    ;
    ..[] << "//------------------------ fields:"
    ----------------------------------- 'fields copy'
    FOR f IN obj.Field[] :
        CASE ?
        [f.Is_fixed] ?
             ..[] << "    ret." f.Final_name " := " f.Final_name "; {2}"
             CONTINUE f
               		 
        [f.Is_array] ?
             CASE kol >= 0 ?
        	 	  ..[] << "    ret." f.Final_name ".Free;"
             ELSE ..[] << "    ret." f.Final_name ".Free();" ;
             
             ..[] << "    ret." f.Final_name " := " f.Final_name
               		 ".Clone_array(); {1}"
               		 
             CONTINUE f ;
        CASE f.Type_.Kind  ?
    	['BOOL', 'ENUM', 'INT', 'REAL']:
        	im[] << sp(12) "ret." f.Final_name " := " f.Final_name ";"
        	
    	['STR']:
    		CASE FPC ? 
	        	 im[] << sp(12) "ret." f.Final_name ".Assign_str(" 
	        	 im[*] =_ f.Final_name ");"
    		ELSE 
	        	 im[] << sp(12) "ret." f.Final_name " := " f.Final_name ";"
    		;
        	
    	['CLASS']:
    		CASE f.Is_weak ?
        		 im[] << sp(12) "Object_assign_weak("
    		ELSE im[] << sp(12) "Object_assign_hard(" ;
    		im[*] =_ "ret." f.Final_name ", " f.Final_name ".Obj);"
    		
    	['STRUCTURE']:
        	CASE f.Type_.Final_name[0] == "s" ?
	        	 im[] << sp(12) "ret." f.Final_name " := " f.Final_name ";"
	        			 
			ELSE im[] << sp(12) "ret." f.Final_name ".Ref_dec_hard();"
			
				 im[] << sp(12) "ret." f.Final_name " := "
	        			 "Structure_any(" f.Final_name ".Obj)"
	        			 ".Clone(); {BB}"
			;
    	;
    ;
    ..[] << "  Result := ret.hard_link;"
    ..[] << "end;" .


METHOD generate_noneclass_methods|_overriden(
{Type} C|lass_to_generate,
{Type} Top|_which_class), RECURSIVE
    :
    -------------------- 'override all methods of the base class to do nothing'
    CASE !do_need_none(C) ? ==> ;
    
    im[] << "" << "// methods of oNoneclass_" Top.Final_name 
    " // NoneClass_" C.Final_name  //<< ""
     
    CASE C.Base_ != NONE ?
         generate_noneclass_methods(C.Base_, Top)
    ELSE
         CASE kol >= 0 ?
              im[] << "procedure oNoneclass_" Top.Final_name ".Erase;"
                      " begin end;"
         ELSE 
              im[] << "procedure Noneclass_" Top.Final_name ".Erase;"
                      " begin end;" ;
    ;
    FOR m IN C.Method[] :
        CASE m == NONE ? CONTINUE m ;
        CASE m.Final_name == "-" ? CONTINUE m ;
        CASE m.Ancestor_ != NONE ? CONTINUE m ;
        CASE m.Modifiers['STATIC'] ? CONTINUE m ;
        CASE m.Overloaded_[].Count > 0 ? CONTINUE m ;
        CASE (m == C.Construct || m == C.Destruct) && C != Top ? CONTINUE m ;
        --------------------- 'ok. implementation needed'
        im[] << "" << ""
        CASE m.Result !=  NONE ? im[*] = "function "
        ELSE im[*] = "procedure " ;
        CASE kol >= 0? im[*] =_ "o" ;
        im[*] =_ "Noneclass_" Top.Final_name "." m.Final_name "("
        ------------------------- 'parameters'
        FOR p IN m.Param[] : im[*] =_ " " gen_param(p) ";" ;
        CASE m.Modifiers['STORE'] ?
            im[*] =_ " var " m.Stored_param.Final_name ": Integer;" ;
        CASE im[*].[*] == ";" ? im[*] = im[*].[0 TO *-1] ;
        im[*] =_ ")"
        CASE m.Result != NONE ? im[*] =_ ": " result_type_name(m) ; 
        im[*] =_ ";"
        ------------------------- 'body'
        CASE im[*].Len < 100 ? BOOL short_v|ersion = TRUE ;
        CASE short_v ? im[*] = _" begin" 
        ELSE im[] << " begin " ;
        CASE m.Result != NONE ?
        	 im[*] =_ " RESULT := " gen_none_val(m.Result.Type_) ";"
        ;
        im[*] =_ " end;" ;
    .


INT tcl|_test_counter_lines[]

FUN next_1000(INT C|ounter_value) ==> INT :
    RESULT = C + 999
    RESULT -= RESULT % 1000 .
    

METHOD generate_class(  
	{Type} Class|_to_generate) ==> BOOL
	: 
	td[].Clear
	fd[].Clear
	im[].Clear
	PUSH Comp.Current_class = Class:
	     RESULT = generate_class_unit(Class)
	; .
	
METHOD generate_class_unit(
{Type} Class|_to_generate) ==> BOOL
	: 
    ---------------------------------- 'Initialize'
    total_gen_field = (total_gen_field + 99)
    total_gen_field -= total_gen_field % 100
    total_init_var = next_1000(total_init_var)
    total_stmt = next_1000(total_stmt)
    local_var_index = next_1000(local_var_index) 
    tcl[].Clear
    ---------------------------------- 'begin generation'

    	 td[] << "unit unit" Class.Final_name ";"

    CASE kol >= 0 ? td[] << "{$I EXTERNAL_DEFINES.inc}" ;

         td[] << "interface" << "" 

    add_off_warnings(td[])
    ---------------------------------- 'uses'
    td[] << "uses "
    td[*] =_ "All_classes"
    td[*] =_ ", "
    td[*] =_ "AL4, " sysutils " {$IFDEF FPC} , LCLType, lazutf8 {$ENDIF} "
    FOR f IN Class.Method[] :
        CASE f == NONE ? CONTINUE f ;
        STR ncode|_native_trimmed = f.Native_code.Trim
        CASE f.Final_name == "-" && ncode.[0 TO 4] == "uses " ?
             //DEBUG: << #NL"---------------------------------------------------"
             //       << "add to uses of " Class.Final_name ": " ncode #NL
             //       BOOL uses_mod|ified = TRUE
             //       INT uses_at|_line = td[].Count-1 
             //;
             STR uses|_list = ncode.[5 TO *]
             CASE uses.[*] == ";" ? uses = uses.[0 TO *-1] ;
             td[*] =_ ", " uses
        ELSE BREAK f ;
    ;
    td[*] =_ ";"
    //DEBUG:
    //      CASE uses_mod ? 
    //      << "gggggggggggggggggggggggggggenerating class " Class.Final_name
    //          ": " #NL 
    //        << td[uses_at TO *].Merge(#NL) #NL >> 
    //      ;
    //;
    
    //CASE use_profiler != "" ? td[] << "" << "{$DEFINE PROFILER}" << "" ;
    CASE Comp.Int32 ? 
         td[] << "{$DEFINE INT_32}" ;
    ---------------------------------- 'root native code'
    FOR f IN Class.Method[] :
        CASE f == NONE ? CONTINUE f ;
        CASE f.Overloaded_[].Count > 0 ? CONTINUE f ;
        CASE f.Final_name == "-" ?
             ncode = f.Native_code.Trim
             CASE ncode.[0 TO 4] != "uses " ?
                  td[] << f.Native_code ;
        ELSE BREAK f ;
    ;
    ------------------------ 'constant arrays'
    FOR c IN Class.Constants[] :
        CASE !c.Is_array ? CONTINUE c ;
        
        td[] << "" << "const " c.Final_name ": array[0.." (c.Size_value-1).Str 
        	 "] of " (type_gen(c.Type_, {type_options}) " ").Replace(
        	 "Str ", "String ") " = ("
        	 
        td[] << #TAB
        FOR it IN c.Items_[] :
            CASE td[*].Len >= 64 ? td[] << #TAB ;
            STR v_gen|erated_constant = gen_const_value(it) 
            td[*] =_ v_gen ", " ;
        td[*] = _.TrimR.Remove_ending(",") ");" ;
    -------------------- 'for PROFILER'
    CASE use_profiler != "" ? 
         td[] << "" << "procedure Collect_CNT(Counters: "
         CASE kol > 0 ? td[*] =_ "PStrList);"
         ELSE td[*] =_ "TStringList);" ;     
    ;
    --------------------------------- 'implementation starts'
    //DEBUG: INT start_impl|emtation = o[].Count ;
	im[] << "" << "implementation" << ""
    im[] << "uses "
    STR uses_cont|ains[]
    FOR cl IN Comp.All_classes[] :
        CASE !Importing(Class, cl) ? CONTINUE cl ;
        CASE cl == Class ? CONTINUE cl ;
        CASE im[*].Len > 75 ? im[] << sp(4) ;
        CASE ?
        [cl.Final_name IN uses_cont[]] ?
             CONTINUE cl
        ;
        uses_cont[] << cl.Final_name
        im[*] =_ "unit" cl.Final_name ", " ;
    CASE uses_cont[].Count > 0 ?
         im[*] = _.[0 TO *-2] ";"
    ELSE im[*] = "" ;
    //DEBUG: << "implementation generated for " Class.Names[0] "("
    //		   "" Class.Final_name "):" #NL
    //;
    im[] << ""
    ---------------------------------- 'interface part'
    generate_NONE(Class)
    STR data_f|inal_name = "DATA_" Class.Final_name
    FOR v IN Class.Field[] :
        CASE v.Final_name == data_f ?
             CASE Class.Ending_lines[].Count > 0 ?
                  //DEBUG: 
                  //      o[] << "//generating DATA, Count=" 
                  //      "" Class.Ending_lines[].Count.Str ;
                  generate_field(v)
             //ELSE
             	//DEBUG: << "------------------------------------------"
             	//		"" v.Final_name " is not generating still there" 
             	//		"are no ending lines in " Class.Whole_name
             	//		#NL ; 
             ;
        ;
    ;
    FOR m IN Class.Method[] :
        CASE m == NONE ? CONTINUE m ;
        CASE m.Final_name == "-" ? CONTINUE m ;
        CASE m.Overloaded_[].Count > 0 ? CONTINUE m ;
        	 gen_fun_header(fd[], m)
    ;
    CASE Comp.Defined_name[].Find("$REPORT_LEAKS") >= 0 && (
         Class.Construct != NONE && Class.Destruct != NONE )
         ?
         BOOL report_leaks = TRUE
         fd[] << "function Get_CNT(index: Integer): Integer;"
    ;
    fd[] << "" <<
        "function New_" Class.Final_name ": " Class.Final_name "; {zz}"
        
    FOR st IN Class.Structures_[] :
        fd[] << "" << "function New_" st.Final_name ": "
        CASE ?
        [kol >= 0 && st.Final_name[0] == "s"] ?
             fd[*] =_ st.Final_name ";"
             CONTINUE st
        [kol >= 0] ?
             fd[*] =_ "P" st.Final_name ";"
        [st.Final_name[0] == "s"] ?
             fd[*] =_ st.Final_name ";"
             CONTINUE st
        ELSE fd[*] =_ st.Final_name ";"  
        ;
        fd[] <<
            "function New_Noneclass_" st.Final_name <<
            ": NoneClass_" st.Final_name "; // [" Class.Names[0] "]"
    ;
    CASE do_need_none(Class) ?
         fd[] <<
            "function New_Noneclass_" Class.Final_name <<
            ": NoneClass_" Class.Final_name ";"
    ELSE fd[] << " // class " Class.Names[0] " need not NONE," <<
     			 " // do not declare New_Noneclass_" Class.Final_name
    ;
    CASE Comp.TEST_value ?
         FOR m IN Class.Test[] :
             gen_fun_header(fd[], m)
         ;
         fd[] << #NL "procedure Do_tests;" 
    ;
    --------------------------------- 'init_class_....'
    FOR st IN Class.Structures_[] :
        CASE st.Final_name[0] == "s" ? CONTINUE st ;
    	fd[] << "" << "procedure init_class_" st.Final_name ";" ;
    CASE do_need_none(Class) ?
    	 fd[] << "" << "procedure init_class_" Class.Final_name ";"
    ;
    --------------------------------- 'methods'
    gen_implement_NONE(Class)
    BOOL root_outer|_code = TRUE
    FOR f IN Class.Method[] :
        CASE f == NONE ? CONTINUE f ;
        CASE f.Final_name == "-" && root_outer ? CONTINUE f ;
        CASE f.Overloaded_[].Count > 0 ? CONTINUE f ;
        root_outer = FALSE
        im[] << "// method[1] " f.Names[0]
        generate_method(f) ;
    gen_method_new(Class)
    FOR st IN Class.Structures_[] :
        gen_method_new(st) ;
    CASE report_leaks ?
         STR cc_w|hole_name = Class.Construct.Whole_name
          
         im[] << "" << "//construct:" Class.Construct.Total_fn.Str " "
                "" cc_w " line:" Class.Construct.Line_start.Str
                
         im[] << @""
                 "function Get_CNT(index: Integer): Integer;"
                 "begin"
                 "    if index = 0 then"
                 "       Result := CNT_CONSTRUCT_" Class.Final_name ""
                 "    else Result := CNT_DESTRUCT_" Class.Final_name ";"
                 "end;"
                 ""
    ;
    --------------------------------- 'tests'
    CASE Comp.TEST_value ?
         FOR t IN Class.Test[] :
             im[] << "// method[T] " t.Names[0]
             generate_method(t) ;
         im[] << #NL "procedure Do_tests;" << "begin"
         CASE Comp.Verbose ?
              im[] << "    Writeln('RUNNING TESTS OF CLASS " Class.Names[0] 
              		  "');"
         ;
         im[] << sp(4) "AL4.Clear_test_data(test_lines, " 
         		"LENGTH(test_lines));"
         		     
         CASE Class.Base_.Modifiers['ABSTRACT'] ?
              im[] << sp(4) "AL4.Clear_test_data("
              "unit" Class.Base_.Final_name ".test_lines," 
              "LENGTH(unit" Class.Base_.Final_name ".test_lines));"
                   
              FOR f IN Class.Method[] :
                  CASE f == NONE ? CONTINUE f ;
                  remove_overridden_method_lines_from_tests_of_base(f) ;
         ;
         FOR t IN Class.Test[] :
             CASE t.Param[].Count == 0 ?
                  BOOL has_tests|_without_params = TRUE
                  im[] << sp(4) t.Final_name ";" ;
         ;
         CASE has_tests ?
              CASE Comp.Verbose ?
                   im[] << "    AL4.Writeln('Saving test data: "
                          "" Comp.Destination.Trailing_slash
                          "" Class.Final_name ".test');"
              ;
              im[] << sp(4)"AL4.Output_test_data(test_lines," 
              "LENGTH(test_lines), test_assert, test_assert_failed_text, "
              "'" Comp.Destination.Trailing_slash Class.Final_name 
              ".test', '" Class.Path "');"
         ;
         CASE Class.Base_.Modifiers['ABSTRACT'] ?
              im[] << sp(4) "AL4.Output_test_data(" 
              "unit" Class.Base_.Final_name ".test_lines, "
              "LENGTH(unit" Class.Base_.Final_name ".test_lines),"     
              "unit" Class.Base_.Final_name ".test_assert, "
              "unit" Class.Base_.Final_name ".test_assert_failed_text, "
              "'" Comp.Destination.Trailing_slash Class.Base_.Final_name 
              ".test', '" Class.Base_.Path "');"
         ;
         im[] << "end;"
    ;
	-------------------- 'for PROFILER - implement Collect_CNT'
	CASE use_profiler != "" && !Comp.Final ?
	     INT pos|ition_procedure_collect_cnt = im[].Count
	     STR ccnt|_constant_names[] << "const cnt_names: array[0.."
	     ..[] << "] of String = ("
	     INT cur|rect_index_in_cnt_names = -1
	     ------------------------ 'procedure Collect_CNT'
         im[] << "" << "procedure Collect_CNT(Counters: "
         CASE kol > 0 ? im[*] =_ "PStrList);"
         ELSE im[*] =_ "TStringList);" ;
         STR c_w|hole_name = Class.Whole_name 
         	 c_w =_ " " Class.Path
         im[] << "begin "
         im[] << "  Counters.Add('');"
         im[] << "  Counters.Add('" c_w "');"
         //DEBUG: im[] << "//use_profiler=" use_profiler ;
         CASE use_profiler.[0] != "F" ? 
			  FOR s IN im[* DOWNTO 0] :
			      s = s.Trim
			      CASE !s.Starting("incr(CNT_") ? CONTINUE s ;
			      //DEBUG: im[] << "//s=" s " --> " s[s.Find("(")+1 TO s.Find(
			      //		")")-1] ;
			      s = s.[s.Find("(")+1 TO s.Find(")")-1]
			      ccnt[] << "'" s ":'," 
			      cur += 1
			      im[] << "  Counters.Add(cnt_names[" cur.S "] + " 
	              CASE kol > 0 ? im[*] =_ "Int64_2Str(PI64(@" s ")^));"
	              ELSE im[*] =_ "IntToStr(" s "));" ;
	              ---------------------- 'reset counter'
	              im[] << "  " s " := 0;"     
			  ;
         ELSE 
	          FOR m IN Class.Method[] :
	              CASE m == NONE || m.Final_name == "-" ? CONTINUE m ;
	              CASE m.Overloaded_[].Count > 0 ? CONTINUE m ;
	              STR sc|onstant = m.Whole_name 
	              ccnt[] << "'" sc ":',"
	              cur += 1 
	              im[] << "  Counters.Add(cnt_names[" cur.S "] + "
	              CASE m == m.Class.Construct || m == m.Class.Destruct ?
              		   STR suff|ix_cnt = "_" m.Class.Final_name ;
	              CASE kol > 0 ?
	                   im[*] =_ "Int64_2Str(PI64(@CNT_" m.Final_name suff ")^));"
	              ELSE im[*] =_ "IntToStr(CNT_" m.Final_name suff "));" ;  
	          ;
         ;
         im[] << "end;"
         --------------- 'finalize cnt_names[] and insert it'
         ccnt[0] =_ (cur + 1).S
         ccnt[*] =_ "'' );"
         FOR s IN ccnt[] : im[].Insert(pos + s.Index, s) ;
	;    
    -------------------------------- 'initialization'
    im[] << "" << "end."
    CASE Comp.TEST_value ?
	     ---------------------------- 'counters array'
	     fd[] << ""
	     
	     fd[] << "var test_lines: array[0.." tcl[].Count.Str
	        "] of Int64 = (" << "    "
	        
         FOR line IN tcl[] :
             CASE line >= 0 ?
                  Class.Total_lines_in_test = line.Index + 1 ;
             fd[*] =_ line.Str "{" line.Index.Str "}" ", "
             CASE fd[*].Len >= 64 ? fd[] << "    " ;
         ;
	     fd[] << "-1 );"
	     ---------------------------- 'assertions list'
	     CASE kol >= 0 ?
	          fd[] << "" << "var test_assert: PList;" <<
	                       "var test_assert_failed_text: PStrList;"
	     ELSE fd[] << "" << "var test_assert: TList;"
	     	  fd[] << "var test_assert_failed_text: TStringList;" ;
    ;
    --------------------------------- 'split by #NL'
    split_o_by_NL(im[])
    --------------------------- 'comment portions of code by conditions'
    comment_unnecessary_parts(im[])
    RESULT = Comp.Errors_count == 0 .
    
METHOD remove_overridden_method_lines_from_tests_of_base(
{Fun} F|unction)
    :
    {Fun} a|ncsector_method = F.Ancestor_
    CASE a == NONE || a.Class != F.Class.Base_ ? ==> ;
    STR a_w|hole_name = a.Whole_name
    STR b_w|hole_name = F.Class.Base_.Whole_name  
    STR f_w|hole_name = F.Whole_name      
    im[] << sp(4) "//--- remove ancestor method " a_w
    im[] << sp(4) "// from test data of class " b_w
    im[] << sp(4) "// (method " f_w ")"
    
    im[] << sp(4) "AL4.Remove_test_data(unit" F.Class.Base_.Final_name 
    ".test_lines, " a.Line_start.Str ", " a.Line_end.Str ");" .



METHOD gen_method_new|_in_class_unit(
{Type} C|lass_to_make_New_method)
    :
    ----------------------------- 'Header New_{Type}'
    im[] << "function New_" C.Final_name ": "
    CASE C.Kind == 'STRUCTURE' && kol >= 0 && C.Final_name[0] != "s" ?
         im[*] =_ "P" ;
    im[*] =_ C.Final_name ";" 
    im[] << "begin "
    CASE ?
    [C.Kind == 'STRUCTURE' && C.Final_name[0] == "s"] ?
         im[] << "    Zero_structure(Result, Sizeof(" C.Final_name "));"
    [kol >= 0] ?
         im[] << "    New(Result, Create);"
    ELSE im[] << "    Result := " C.Final_name ".Create;" ;
    ----------------------------- 'init fields here'
    STR gen|erated = gen_init_fields(C, FALSE) 
    im[] << gen
    gen_create_base(C)
    
    im[] <<@"end;"
            ""
            
    CASE do_need_none(C) && !(C.Kind == 'STRUCTURE' && C.Final_name[0] == "s") ? 
         im[] << @
               "function New_Noneclass_" C.Final_name 
               ": NoneClass_" C.Final_name "; // in class " C.Names[0] ""
               
         im[] << "begin "
         CASE kol >= 0 ?
              im[] << "    New(Result, Create);"
         ELSE im[] << "    Result := Noneclass_" C.Final_name ".Create;" ;
         im[] << "end;"
         
    ELSE im[] << "// class " C.Names[0] " need not NONE, do not generate" 
    	 im[] << "// function New_Noneclass_" C.Final_name
    ; .

METHOD Importing(
{Type} Class|_generating, {Type} Unit|_importing) ==> BOOL
    :
    CASE Unit == Class ? ==> ;
    {Type} c|lass_probe = Class
    FOR i|dummy IN [1 TO 1000] :
        CASE c == NONE ? ==> ;
        CASE Unit IN c.Import_[] ? RESULT = TRUE ==> ;
        CASE Unit IN c.Debug_import_[] ? RESULT = TRUE ==> ;
        CASE Unit IN c.Back_import_[] ? RESULT = TRUE ==> ;
        CASE !Comp.TEST_value ?
             c = c.Base_
             CONTINUE i ;
        CASE Unit IN Class.Test_import_[] ? RESULT = TRUE ==> ;
        c = c.Base_ ; .



FUN sp|aces_sequence(INT Count|_spaces) ==> STR :
    RESULT = Sp(Count) .



METHOD gen_create_base(
{Type} Class|_to_generate), RECURSIVE
	:
    CASE Class.Base_ != NONE ?
         gen_create_base(Class.Base_) ;
    INT from|_line = im[].Count
    PUSH new_init = Class.Create_base.Source :
         CASE new_init == NONE ? ==> ;
         im[] << "" << sp(4) "//-------- init base: " Class.Whole_name
         
         fun|ction_base_init_temp = {Fun}(Parse = Class.Parse,
         	A_Name_1 = "temp")
         	
         r|esult_def_temp = {Assign}(
         	Line = 0, Pos= 0,
         	Function_ = fun,
         	Level = 0,
            Dest = {Expr}(
            		Operation = 'VAR', 
            		Var_arg = {Var}(Line = 0,
                    				Type_ = Class)
            )
         )
                    
         r.Dest.Var_arg.Set_final_name("Result")
         im[] << gen_init_new_obj(r) ;
    FOR line IN [from TO im[].Count-1] :
        STR s|tring_line = im[line]
        CASE s.[0 TO 1] == "//" ? CONTINUE line ;
        INT dot|_position = s.Find(".write).")
        CASE dot > 0 ?
             im[line] = sp(4) "Result" s.[dot+7 TO *] ;
    ; .



INT total_init_fld

METHOD gen_init_fields({Type} Class|_to_generate_fields,
    BOOL Non|e_instance_initializing) ==> STR, RECURSIVE
    :
	CASE !Non && Class.Base_ != NONE ?
	     RESULT = gen_init_fields(Class.Base_, FALSE) ;
    ------------------------------------------- 'For each field in the class...'
    STR data_f|inal_name = "DATA_" Class.Final_name
    FOR f IN Class.Field[] :
        CASE f.Type_.Kind IN ['CLASS', 'STRUCTURE'] 
        	 && f.Type_.Path != "" && (
        	 f.Type_ !IN Comp.All_classes[])
        	 ?
        ------ 'skip objects of classes which are removed due to optimaizations'
        	 //DEBUG: RESULT << "// skip field " f.Names[*] " -- due to optimization"
        	 //	    #NL ;
        	 CONTINUE f ;
        CASE f.Final_name == data_f ? 
        	 //DEBUG: RESULT << "// skip field " f.Names[*] " -- it is DATA[]"
        	 //	    #NL ;
             CONTINUE f ;
        CASE f.Type_.Kind IN ['BOOL', 'INT', 'REAL'] 
        	 && !f.Is_array && (f.Initial_ == NONE || Non)
             ?
             //DEBUG:
             //      CASE f.Names[0] == "size_line_buf" ?
             //           << 'SAVE'.Con 'YELLOW'.Fg
             //           << "skip size_line_buf, f.Initial_==NONE?"
             //           	"" (f.Initial_ == NONE).Str 
             //           	" Non=" Non.Str 'PREV'.Con
             //           >> ;
             //;
        	 //DEBUG: RESULT << "// skip field " f.Names[*] " -- need not initialize"
        	 //	    #NL ;
             CONTINUE f ;
        CASE f.Type_.Kind == 'STR' && !f.Is_array 
        	 && (f.Initial_ == NONE) && !FPC
             ?
             CONTINUE f ;
        CASE Class.Kind == 'STRUCTURE' 
        	 && f.Is_fixed && f.Size_n[0] == "{"
        	 ?
        	 //DEBUG: RESULT << "// skip field " f.Names[*] " -- fixed size array of"
        	 //		"structures with indexes which are items of a enumeration"
        	 //	    #NL ;
             CONTINUE f
        ;
        STR comm|ent_to_add = #NL sp(4)
            "// init fld: " total_init_fld.Str
            " Total_i: " f.Total_i.Str #NL sp(4)
            
        CASE f.Total_i == 235 ?
             NONE ;
        //DEBUG: RESULT << #NL"//want " f.Final_name " " comm #NL ;
            
        total_init_fld += 1
        STR s|tring_to_add = "Result." f.Final_name " := "
        CASE ?
        [f.Is_array && !f.Is_fixed && f.Type_.Kind == 'STRUCTURE'
         && f.Type_.Final_name[0] == "s"] ?
             s =_ "New_DynARecord(@NoneObj_" f.Type_.Final_name
             	  ", Sizeof(" f.Type_.Final_name "));"
             RESULT =_ comm s
             	  
        [f.Is_array && !f.Is_fixed && f.Type_.Kind == 'STRUCTURE'
         && f.Type_.Final_name[0] == "S"] ?
             s =_ "New_DynAStruct(NoneObj_" f.Type_.Final_name ".hard_link);"
             RESULT =_ comm s
             	  
        [f.Is_array] ?
             CASE ?
             [f.Is_fixed && f.Type_.Kind IN ['BOOL','INT', 'REAL',
              'ENUM'] && Class.Kind == 'STRUCTURE'] ?
                  CONTINUE f
             [f.Is_fixed && f.Type_.Kind == 'STRUCTURE' 
              && f.Type_.is_simple_struc] ?
                  CONTINUE f
             ;
             ---------------------------------- 'array field initialization'
             CASE f.Type_.Kind ?
                 ['BOOL']: STR suf|fix_fn = "Byte"
                 ['ENUM']: suf = "Byte"
                 ['INT']: suf = "Int"
                 ['REAL']: suf = "Real"
                 ['STR']: suf = "Str"
                 ['CLASS', 'STRUCTURE']: suf = "Obj"  ;
             CASE suf == "Obj" && f.Is_weak ? suf =_ "Weak" ;
             CASE suf == "Obj" && ! f.Is_weak ? suf =_ "Hard" ;
             s =_ "New_"
             CASE f.Is_fixed ?
                  STR gen|erate_array = gen_fixed_array(f)
                  CASE gen == "[]" && f.Size_n.Int > 0 ?
                       STR init|_suffix = "_N"
                  ELSE init = "_init" ;
                  CASE init == "_N" ? gen = f.Size_n ;
                  RESULT =_ spaces s "FixA" suf init "(" //"nil"
                  CASE f.Type_.Kind == 'CLASS' && init=="_N" ? 
                       RESULT =_ "NoneObj_" f.Type_.Final_name ".hard_link"
                  ELSE RESULT =_ "nil" ;
                  RESULT =_ ", " gen ");"#NL
             	  CONTINUE f ;
             s =_ "DynA" suf
             ----------------------------------- 'KOL/VCL array'
             CASE ?
                       
             [f.Type_.Kind == 'CLASS'] ?
                  s =_ "(" unit_of_type(f.Type_)
                       ".NoneObjInit_" f.Type_.Final_name
                       ".hard_link)"
                       
             [f.Type_.Kind == 'STRUCTURE'] ?
                  s =_ "("
                       "NoneObjInit_" f.Type_.Final_name
                       ".hard_link)"
                       
             [f.Type_.Kind !IN ['CLASS', 'STRUCTURE']] ?
                  s =_ "()"
             ;
             //DEBUG: RESULT << "{-4-}" ;
             RESULT =_ comm s ";"
        [f.Constant_value != "" && f.Initial_ == NONE] ?
             ---------------------------------- 'scalar has initial value'
             RESULT =_ "// " s " [Value=" f.Constant_value "] but Initial_="
             
        [!Non && f.Initial_ != NONE] ?
            CASE FPC && f.Type_.Kind == 'STR' ? 
                 RESULT =_ comm "New_str(Result." f.Final_name 
                 RESULT =_ ", " gen_expr(f.Initial_) ");"
            ELSE RESULT =_ comm s gen_expr(f.Initial_) ";" ;
             
        [f.Type_.Kind IN ['BOOL', 'INT', 'REAL', 'ENUM']] ? CONTINUE f
        
        [f.Type_.Kind == 'CLASS' && f.Type_.Final_name == "AL4_object"] ?
             RESULT =_ comm s
                    "AL4.NoneObjInit_" f.Type_.Final_name ".hard_link;"
             			
        [f.Type_.Kind == 'CLASS'] ?
             RESULT =_ comm s "unit" f.Type_.Final_name
               ".NoneObjInit_" f.Type_.Final_name ".hard_link;"
               
        [f.Type_.Kind == 'STRUCTURE'] ?
             RESULT =_ comm s "unit" f.Type_.In_class_.Final_name
               ".New_" f.Type_.Final_name "()"
               
             CASE f.Type_.Final_name[0] != "s" ? RESULT =_ ".hard_link" ;
             RESULT =_ ";"
             //DEBUG: RESULT << "{-5-}" ;
             
        [f.Type_.Kind=='STR' && FPC] ?
             RESULT =_ comm "New_str(Result." f.Final_name ", '');"
        ELSE
        	 s =_ gen_none_val(f.Type_)
        	 RESULT =_ comm s ";"
        	 //DEBUG: RESULT << "{-6-}" ;
        ;
    ;
    CASE RESULT != "" ?
        RESULT = #NL sp(4)
        "//-------- init fields: " Class.Final_name comm #NL RESULT
        //DEBUG:  RESULT << "{-7-}" ;
    ;
    CASE Non && Class.Kind == 'CLASS' && Class.Base_ != NONE ?
        //RESULT = gen_init_fields(Class.Base_, Non) #NL RESULT
        RESULT =_ #NL"    NoneObjInitFields_" Class.Base_.Final_name "("
        	"NoneClass_" Class.Base_.Final_name "(Result)); {EE}" 
    ; .
        
        
FUNCTION unit_of_type({Type} T|ype_which_unit) ==> STR :
    CASE T.Final_name == "AL4_object" ? RESULT = "AL4" ==> ;
    RESULT = "unit" T.Final_name .
    

METHOD gen_fixed_array|_items_list({Var} F|ield_array) ==> STR :
    ------------------------------------- 'const, const, ...'
    CASE ?
    [F.Items_[].Count > 0] ?	
	     FOR i IN F.Items_[] :
	         CASE RESULT.Len >= 75 ? RESULT =_ #NL ;
	         RESULT =_ gen_const(i.Initial_) ", " ;
    ------------------------------------- 'no initial value but [ENUM]'
    [F.Size_type_.Kind == 'ENUM'] ?
         FOR v|dummy IN F.Size_type_.Items[] :
             CASE RESULT.Len >= 75 ? RESULT =_ #NL ;
             CASE F.Type_.Kind ?
             ['BOOL']: RESULT =_ " 0, "
             ['INT', 'REAL', 'ENUM']: RESULT =_ "0, "
             ['STR']: RESULT =_ "'', "
             ['CLASS', 'STRUCTURE']: RESULT =_ gen_none_val(F.Type_) ", " ;
         ;
    ELSE RESULT = "[]" ==> ;
    ------------------------------------- 'finalize'
    CASE RESULT.[*-1 TO *] == ", " ? RESULT = RESULT.[0 TO *-2] ;
    RESULT = "[" RESULT "]" .

BOOL why_need_none, DEBUG

METHOD need_none({Type} Class|_checking) ==> BOOL :
	CASE Class.Names[0] == "{Long_operation}" && kol >= 0 
		 && "$NOLONGOP" IN Comp.Defined_name[]
		 ?
	     ==> ;
	RESULT = do_need_none(Class)
	//DEBUG:
	//      CASE Class.Names[0] == "{Console}" ?
	//           << Class.Names[0] " need none? " RESULT.Str >> ;
	//;
	.
METHOD do_need_none({Type} Class|_checking) ==> BOOL :
	CASE ?
	//[Any_class_from_ccc] ? RESULT = TRUE ==>
	[Comp.Optimizations.Trim == ""] ?
	     //DEBUG:
	     //      CASE why_need_none ? o[] << "//BECAUSE Optimizations=[" 
	     //      	    "" Comp.Optimizations.Trim "]" ;
	     //;
	     RESULT = TRUE ==>
	[Comp.TEST_value] ? 
	     //DEBUG:
	     //      CASE why_need_none ? o[] << "//BECAUSE TEST_value=TRUE" ;
	     //;
	     RESULT = TRUE ==>
	[Class.Kind == 'STRUCTURE'] ?
	     //DEBUG:
	     //      CASE why_need_none ? o[] << "//BECAUSE Class.Kind=" 
	     //      "" Class.Kind.Name ;
	     //;
		 RESULT = TRUE ==> ;
    CASE !Class.Has_descendant && Class.Base_ == NONE && (
         !Class.Has_instances) 
         ?
         CASE ?
         //[incremental] ? NONE
         
         [Class.Modifiers['ABSTRACT'] && !Class.Has_descendant 
          && Class.Base_ == NONE] ? ==>
          
         [Class !IN Comp.Classes_used[]] ? ==> ;
    //ELSE
    	//DEBUG:
    	//      CASE Class.Has_descendant ? 
    	//           << #NL Class.Names[0] " ... has descendant, " ;
    	//      CASE Class.Base_ != NONE ? 
    	//           << #NL Class.Names[0] " ... has ancestor (" 
    	//           	  "" Class.Base_.Names[0] "), " ;
    	//      CASE Class.Has_instances ? 
    	//           << #NL Class.Names[0] " ... has instances, " ;
    	//;
    ;
    //DEBUG:
    //      CASE why_need_none ? o[] << "//BECAUSE Has_descendant="
    //      "" Class.Has_descendant.S " Base_==NONE?" (Class.Base_ == NONE).S
    //      " Has_instances=" Class.Has_instances.S
    //      " Class.Anyway?" Class.Anyway.S ;
    //;
    RESULT = TRUE .
         

METHOD generate_NONE({Type} Class|_to_generate) :
    STR forw|ard_declaration = "" //was used in dll only
    STR obj_n|ame_of_object
    
	FOR st IN Class.Structures_[] :
	    obj_n = st.Final_name
	    CASE obj_n.[0] == "s" ? 
		     fd[] << @""
	         "var NoneObj_" obj_n ": " obj_n ";"
	         CONTINUE st ;
	         
	    fd[] << @""
        "var NoneObj_" obj_n ": Noneclass_" obj_n ";"
        "var DummyObj_" obj_n ": Noneclass_" obj_n ";"
        "function Get_NoneObj_" obj_n ": Noneclass_" obj_n ";" forw "{19}"
        ""
        "function NoneObjInit_" obj_n ": Noneclass_" obj_n ";" forw ""
        "procedure NoneObjInitFields_" obj_n "(var Result: NoneClass_" obj_n
        ");" forw ""
        "procedure DummyObjInitFields_" obj_n "(var Result: Noneclass_" obj_n 
        ");" forw ""
        ""
	;
	//DEBUG: why_need_none = TRUE ;
    CASE !do_need_none(Class) ?
         //DEBUG: "class need not NONE: " Class.Whole_name #NL ;
         ==> ;
    //DEBUG: why_need_none = FALSE ;
    CASE Comp.Verbose2 ?
         fd[] << "//Class " Class.Names[0] 
            " has descendant: " Class.Has_descendant.Str #NL
            "//Class " Class.Names[0]
            " has base: " (Class.Base_ != NONE).Str #NL
            "//Class " Class.Names[0]
            " has instances: " Class.Has_instances.Str #NL
    ;
    STR n|ame_of_class = Class.Final_name
    
    fd[] << @""
        "var NoneObj_" n ": Noneclass_" n ";"
        "var DummyObj_" n ": Noneclass_" n ";"
        "function Get_NoneObj_" n ": Noneclass_" n ";" forw "{23}"
        ""
        "function NoneObjInit_" n ": Noneclass_" n ";" forw ""
        "procedure NoneObjInitFields_" n "(var Result: NoneClass_" n ")"
        ";" forw ""
        "procedure DummyObjInitFields_" n "(var Result: NoneClass_" n ")" 
        ";" forw ""
        "" .
        

METHOD gen_implement_NONE({Type} Class|_to_generate) :
    CASE kol >= 0 ? STR sref|erence_suffix = "^"
    ELSE sref = "" ;
	FOR st IN Class.Structures_[] :
	    gen_implement_NONE_1obj(Class, st) ;
    CASE !do_need_none(Class) ? ==> ;
    --------------------------- 'NONE and DUMMY object is single for each class'
    STR n|ame_of_class = Class.Final_name
    im[] << "procedure init_class_" n ";"
    im[] << "begin  "
         
    CASE !(Class.Modifiers['ABSTRACT'] && !Class.Has_descendant
    	 && Class.Base_ == NONE)
    	 ?
    	 im[] << "  NoneObjInit_" n ";"
    ;
    im[] << "end;" 
    im[] << ""
    -------------------------- 'Get_NoneObj_...'
    im[] << "function Get_NoneObj_" n ": Noneclass_" n ";{31}"
    im[] << "begin"
    im[] << "	Result := NoneObj_" n ";"
    im[] << "end;"
	im[] << ""
    ------------------------- 'NoneObjInit_...'
    im[] << "function NoneObjInit_" n ": Noneclass_" n ";"
    im[] << "begin"
    im[] << "  Result := Noneclass_" n "("
    im[] << "		do_NoneObjInit("
    im[] << "			AL4_object(NoneObj_" n "),"
    im[] << "			AL4_object(DummyObj_" n "),"
  		
  		CASE kol >= 0 ?
  		     im[*] =_ "@Noneclass_" n "_New_instance"
  		     
  		ELSE im[*] =_ "@Noneclass_" n "_New_instance"
  		;
    im[] << "		));" << "end;" << ""
    -------------------------------- 'NoneObjInitFields_...'
	im[] << "procedure NoneObjInitFields_" n "(var Result: NoneClass_" n ");"
    //DEBUG: << "...........................procedure NoneObjInitFields_" n #NL ;
    STR init|_fields_text = gen_init_fields(Class, TRUE)
    CASE init.Trim != "" ?
         im[] << "begin "
         im[] << init
    ELSE im[] << "begin "
    	 no_fields_to_init[] << Class 
    	 //DEBUG: im[] << "//class " Class.Names[0]
    	 //		" was added to no_fields_to_init[]"
    	 //		" " no_fields_to_init[].Count.S ;
    ;           
    im[] << "end;" 
    im[] << "" 
    ---------------------------- 'fields of dummy:'
    im[] << "procedure DummyObjInitFields_" n "(var Result: Noneclass_" n ");"
    ..[]<< "begin "

    gen_init_dummy_object_fields(Class)
    im[] << "end;" 
    im[] << "" .
    
{Type} no_fields_to_init|_classes_list[]
	    
	    
METHOD gen_implement_NONE_1obj(
{Type} Class|_to_generate_DUMMY,
{Type} obj|ect_type_to_implement_NONE)
	:
    CASE kol >= 0 ? STR sref|erence_suffix = "^"
    ELSE sref = "" ;
    STR obj_n|ame_of_class = obj.Final_name
    
    ----------------------------- 'skip simple structures implemented by RECORD'
    CASE obj_n.[0] == "s" ? ==> ;
    
    im[] << "procedure init_class_" obj_n ";"
    im[] << "begin "
         
    im[] << "  NoneObjInit_" obj_n ";"
    im[] << "end;"
    im[] << ""
    -------------------------- 'Get_NoneObj_...'
    im[] << "function Get_NoneObj_" obj_n ": Noneclass_" obj_n ";{29}"
    im[] << "begin"
    im[] << "	Result := NoneObj_" obj_n ";"
    im[] << "end;"
    im[] << ""
    ------------------------- 'NoneObjInit_...'
    im[] << "function NoneObjInit_" obj_n ": Noneclass_" obj_n ";"
    
    im[] << "begin " <<
    	"  Result := Noneclass_" obj_n "(" <<
    	"		do_NoneObjInit(" <<
    	"			AL4_object(NoneObj_" obj_n ")," <<
    	"			AL4_object(DummyObj_" obj_n ")," <<
    	"			@" obj_n "_New_instance" <<
    	"		));"
    	     
    im[*] =_ "end;" 
    im[]<< ""
    -------------------------------- 'NoneObjInitFields_...'
	im[] << "procedure NoneObjInitFields_" obj_n
	im[*] =_ "(var Result: NoneClass_" obj_n ");"
    //DEBUG: << "...........................procedure NoneObjInitFields_" n #NL ;
    STR init|_fields_text = gen_init_fields(obj, TRUE)
    CASE init.Trim != "" ?
         im[*] =_ "begin "
         im[*] =_ init
    ELSE im[*] =_ "begin "
    	 no_fields_to_init[] << obj 
    	 //DEBUG: im[] << "//structure " obj.Names[0]
    	 //		" was added to no_fields_to_init[]"
    	 //		" " no_fields_to_init[].Count.S ;
    ;
    im[*] =_ "end;" 
    im[] << "" 
    ---------------------------- 'fields of dummy:'
    im[] << "procedure DummyObjInitFields_" obj_n 
    	   "(var Result: Noneclass_" obj_n ");"
    ..[*]=_ "begin "
    gen_init_dummy_object_fields(obj)
    im[*] =_ "end;" 
    im[] << "" .
    

FUNCTION dynarray_type_name(
{Var} V|ariable_or_field) ==> STR
	:
	CASE !V.Is_array ? ==> ;
	CASE V.Is_fixed ? RESULT = "FixA"
	ELSE RESULT = "DynA" ;
	CASE V.Type_.Kind ?
	['BOOL']:	 RESULT =_ "Byte"
    ['ENUM']:	 RESULT =_ "Byte"
    ['INT']:			 RESULT =_ "Int"
    ['REAL']:			 RESULT =_ "Real"
    ['STR']:			 RESULT =_ "Str"
    ['CLASS', 'STRUCTURE']:RESULT =_ "Obj"
    	CASE V.Is_weak ? RESULT =_ "Weak"
    	ELSE RESULT =_ "Hard" ;
    ; .   
	

    
METHOD gen_init_dummy_object_fields(
{Type} Class|_init)
	:
    //DEBUG: im[] << "/" "/ want init class " Class.Names[0] " dummy object"
    //;
    CASE Class.Kind == 'CLASS' && Class.Base_ != NONE ?
         im[] <<     "DummyObjInitFields_" Class.Base_.Final_name "("
         	"NoneClass_" Class.Base_.Final_name "(Result));" 
    ;
    INT line|_start = im[].Count
    STR already_ini|tialized[]
    FOR f IN Class.Field[] :
        //DEBUG: im[] << "/" "/ want init field " f.Names[0] 
        //		": " f.Type_.Final_name
        //;
        CASE f.Names[0] == "DATA" ? //&& Class.Ending_lines[].Count == 0 ?
             CONTINUE f ;
             
    	//-------------- 'if the field`s class was removed due to optimization?'
    	//
    	// NO! removing it leads to crashes in the Compiler (Free Pascal) !!!
    	//
        //CASE f.Type_.Kind == 'CLASS' && f.Type_ !IN Comp.All_classes[] ?
        //     //DEBUG: << "-----------------------------------field " f.Names[0]
        //     //	 " of type " f.Type_.Names[0] " which is NOT in "
        //     //	 "All_classes[] is skept for NONE object "
        //     //	 "in class " Class.Names[0] #NL ;
        //     CONTINUE f ;
        
        
        //DEBUG: 
        //      CASE f.Type_.Kind == 'CLASS' ?
        //      	<< "ffffffffffffffffffffffffffffffffffffffffffield " f.Names[0]
        //		" of type " f.Type_.Names[0] " which is in All_classes[] "
        //		"is generating for NONE object in class " Class.Names[0] #NL ;
        //;
        CASE f.Is_fixed && f.Size_n [0] == "{" ? CONTINUE f ;
        CASE f.Is_fixed && f.Type_.Kind IN ['BOOL', 'INT', 'REAL', 'ENUM'] ?
             CONTINUE f ;
        //DEBUG: im[] << "/" "/ want init field " f.Names[0] 
        //		": " f.Type_.Final_name
        //;
        -------------- 'field of NONE object is initialized with NONE'
        CASE ?
        [f.Is_array && ! f.Is_fixed] ?
        	 STR global_d|array_name_suffix 
	        	  = dynarray_type_name(f).Remove_starting("DynA")
	        	  
             CASE global_d !IN already_ini[] ?
	              im[] << "	 if not Assigned(GlobalDummyArray" global_d ") then "
	             		 "GlobalDummyArray" global_d 
	             		 " := New_DynA" global_d
	             		 
	              already_ini[] << global_d
	              CASE f.Type_.Kind IN ['CLASS', 'STRUCTURE'] ?
	                   im[*] =_ "(NoneObj_AL4_object.hard_link);"
	              ELSE im[*] =_ "();"
	              ;
             ;
             im[] << "    Result." f.Final_name " := GlobalDummyArray" 
             im[*] =_ global_d ";"
             		
        [f.Is_array && f.Is_fixed && kol >= 0] ?
             im[] << "    New(Result." f.Final_name ", Create"
             CASE f.Type_.Kind == 'CLASS' ?
                  im[*] =_ "(NoneObj_AL4_object.hard_link)" ;
             im[*] =_ ");"
        [f.Is_array && f.Is_fixed] ?
             im[] << "    Result." f.Final_name " := New_DynA"
             CASE f.Type_.Kind ?
             ['BOOL']: im[*] =_ "Byte"
             ['ENUM']: im[*] =_ "Byte"
             ['INT']: im[*] =_ "Int"
             ['REAL']: im[*] =_ "Real"
             ['STR']: im[*] =_ "Str"
             ['CLASS']: im[*] =_ "Obj"
             			CASE f.Is_weak ? im[*] =_ "Weak"
             			ELSE im[*] =_ "Hard" ;    
             			im[*] =_ "(NoneObj_AL4_object.hard_link)" 
             ['STRUCTURE']: im[*] =_ "Obj" ;
             im[*] =_ ";"
        //[f.Type_.Kind IN ['CLASS', 'STRUCTURE'] && incremental] ?
        //     im[] << "    Result." f.Final_name
        //     " := impl_Get_NoneObj_" f.Type_.Final_name ".hard_link;"
             
        [f.Type_.Kind IN ['CLASS', 'STRUCTURE']] ?
             CASE f.Type_.Final_name[0] == "s" ?
                  im[] << "    Zero_structure(Result." f.Final_name 
                  		 ", Sizeof(" f.Type_.Final_name "));"
                  		 
             ELSE im[] << "    Result." f.Final_name
             			 " := NoneObj_" f.Type_.Final_name ".hard_link;"
             ;
        [FPC && f.Type_.Kind == 'STR'] ?
            im[] << "    New_str(Result." f.Final_name ", '');"
        ;
    ;
    CASE im[].Count > line ?
         im[].Insert(line, "// fields of " Class.Final_name) ; .

METHOD do_init_obj(STR o|utput_lines[],
	{Type} Obj|ects_to_init[], INT Index INDEXING {Type}),
	RECURSIVE
	:
	FOR f IN Obj[Index].Field[] :
	    CASE f.Type_.Kind == 'STRUCTURE' 
	    	 && f.Type_ != Obj[Index] && f.Type_ IN Obj[]
	    	 ?
	    	 INT x|_position INDEXING {Type} = Obj[].Find(f.Type_) 
	         do_init_obj(o[], Obj[], x) ;
	;
	STR obj_n|ame = Obj[Index].Final_name
	CASE obj_n.[0] != "s" ?
		 o[] << sp(12) "init_class_" obj_n "();"
	;
	Obj[Index] = NONE . 

METHOD generate_call_main(
STR o|utput_lines[], {Type} Class|_main)
	:
	PUSH Comp.Current_class = Comp.All_classes[0] :
    	 {Fun} f|unction_main = Class.Find_fun("Main", TRUE) ;
    CASE "$NOEXCEPTIONS" !IN Comp.Defined_name[] ?
         o[] << sp(8) "    try" ;
    ------------------------------------ 'set application icon ?'
    CASE kol < 0 && "$ICON" IN Comp.Defined_name[] ?
         o[] << sp(8) "Application.Icon := TIcon.Create;"
         CASE ?
         [Target == "WINDOWS" && kol < 0] ?
	          ..[] << sp(8) "Application.Icon.Handle := "
	           		   "LoadIcon(hInstance, 'APP_ICO');"
	           		   
         [Target == "WINDOWS"] ?
	          ..[] << sp(8) "Application.Icon.Handle := "
	           		   "LoadIcon(hInstance, 'MAIN');"
	           		   
         ELSE Comp.Warning("Option /$ICON is applicable only "
          			   "for Windows target, ignored"._WOptionIcon)
         ;
    ;
    -------------------------------------------------- 'initializations'
    {Type} list_obj|ect_types_to_init[]
    FOR c IN Comp.All_classes[] :
    	FOR st IN c.Structures_[] :
    		list_obj[] << st ; 
        CASE !need_none(c) ? CONTINUE c ;
        //DEBUG:
        //      CASE c.Names[0] == "{Console}" ?
        //           << "generate initialization of class " c.Names[0] 
        //           >> STR dummy_not_init ;
        //;
        o[] << #TAB"init_class_" c.Final_name "();"
    ;
    FOR x IN [0 TO list_obj[].Count-1] :
        CASE list_obj[x] == NONE ? CONTINUE x ;
        do_init_obj(o[], list_obj[], x) ;
    ---------------------------- 'initialize fields of None/ Dummy objects'
    FOR c IN Comp.All_classes[] :
        CASE need_none(c) ?
             //DEBUG:
             //      CASE c.Names[0] == "{Console}" ?
             //           << "generate iitialization of none/dummy of " c.Names[0] 
             //           >> STR dummy_not_init2 ;
             //;
             CASE !Comp.TEST_value && Comp.Optimizations.Trim != "" && (
         	  	  c !IN Comp.Classes_used[]) && !c.Has_instances
         	  	  ?
              	  o[] << "    {$IFDEF NO_OPTIMIZATIONS}"
              	  BOOL endif|_add = TRUE
             ELSE endif = FALSE ;
             
             CASE c !IN no_fields_to_init[] ?
	              o[] << sp(8) "NoneObjInitFields_" c.Final_name 
	              		"(NoneObj_" c.Final_name ");"
	               
	              o[] << sp(8) "DummyObjInitFields_" c.Final_name
	              		"(DummyObj_" c.Final_name ");"
             ;
	              
	         CASE endif ?
	              o[] << "    {$ENDIF}" ;
        ;
        FOR st IN c.Structures_[] :
            CASE st.Final_name[0] == "s" ? CONTINUE st ;
            CASE st !IN no_fields_to_init[] ?
	             o[] << sp(8) "NoneObjInitFields_" st.Final_name "("
	             	"NoneObj_" st.Final_name ");"
	              
	             o[] << sp(8) "DummyObjInitFields_" st.Final_name "("
	             	"DummyObj_" st.Final_name ");" ;
        ;
    ;
    CASE Comp.TEST_value ?
         FOR c IN Comp.All_classes[] :
             CASE !c.Class_needs_testing ?
                  //DEBUG: << ">>>>>>>> for " c.Names[0] " tests already done"
                  //	#NL ;
                  CONTINUE c ;
             CASE c.Test[].Count == 0 ? CONTINUE c ;
             o[] << sp(16) "unit" c.Final_name ".Do_tests();"
         ;
    ELSE o[] << sp(16) f.Final_name "();" ;
    CASE Ide_debug && !Comp.TEST_value ? 
         o[] << sp(16) "_out_('', '');" ;
    CASE Comp.Defined_name[].Find("$REPORT_LEAKS") >= 0 ?
         o[] << sp(16) "Report_leaks;" ;
    CASE Comp.Defined_name[].Find("$FREE_NONE_OBJECTS") >= 0 ?
         generate_free_none_objects(o[]) ;
    CASE "$NOEXCEPTIONS" !IN Comp.Defined_name[] ?
        o[] << @"" sp(8) "    except on S: Stop_exception do begin"
                "" sp(8) "        AL4.Any_exception(S);"
                "" sp(8) "        AL4.Writeln('STOP: ' + S.Message);"
                "" sp(8) "        Readln;"
                "" sp(8) "      end;"
                "" sp(8) "    end;"
                "" ;
    .

METHOD generate_free_none_objects(STR o|utput_lines[]) :
    PUSH spaces = sp(8) :
         FOR c IN Comp.All_classes[] :
             CASE need_none(c) ?
                  o[] << spaces "DummyObj_" c.Final_name ".Free;"
                  o[] << spaces "NoneObj_" c.Final_name ".Free;" ;
         ;
    ; .

METHOD generate_enum({Type} E|numeration) :
    td[] << "" << "var Names_" E.Final_name "__" E.Base_.Final_name
        ": array[0.." (E.Items[].Count-1).Str "] of "
        //"" if(FPC, "UTF8")     
        "String = ("
    //DEBUG:
    //      CASE E.Items[].Count-1 == 21 ?
    //           ------------------------- 'Names_E_code_trans__C_Tables_SUIK'
    //      ;
    //;
    FOR it IN E.Items[] :
        td[] << sp(4) it.Names[0].as_str "," ;
    td[*] = td[*].[0 TO *-1] ");"
    td[] << "" .



INT total_gen_field

METHOD generate_field({Var} V|ariable) :
    fd[] << sp(8) "// declare: " total_gen_field.Str
    total_gen_field += 1
    CASE V.Final_name == "DATA_" Comp.Current_class.Final_name ?
         CASE Comp.Current_class.Ending_lines[].Count == 0 ?
              fd[].Delete(fd[].Count-1) ==>
         ;
         fd[] << "const " V.Final_name ": array[0"
             ".." Comp.Current_class.Ending_lines[].Count.Str
             "] of PChar = ("
             
         FOR d IN Comp.Current_class.Ending_lines[] :
             fd[] << d.as_str "," ;
         fd[] << "'');" ==> ;
    fd[] << "var " V.Final_name ": " var_type_gen(V, TRUE)
    CASE V.Is_array ? fd[*] =_ ";" ==> ;
    CASE V.Type_.Kind ?
        ['STR']: 
                 fd[*] =_ " = '';"
                 
        ['BOOL', 'INT', 'REAL', 'ENUM', 'CLASS', 'STRUCTURE']:
                 fd[*] =_ ";" ; .
 
METHOD var_type_gen({Var} V|ariable, BOOL Decl|are_variable) ==> STR :
    RESULT = type_gen(V.Type_, {type_options}(Array=V.Is_array, 
            Fixed=V.Is_fixed, Weak=V.Is_weak, Declare=Decl)) " " .


STRUCTURE {type_options} :
	BOOL Array|_value
	BOOL Fixed|_array
	BOOL Weak|_object 
	BOOL StrToString
	BOOL Declare|_do_not_add_Hard_Weak_for_DynAObj .
                        
METHOD type_gen_A|rray_replace({Type} T|ype_of_var,
    {type_options} Op|tions_var) ==> STR
    :
    --------------------------------------------------------- ''
    CASE !Op.Array ? RESULT = type_gen(T, Op) ==> ;
    CASE Op.Fixed && !Op.Declare ? RESULT = "FixA"
    ELSE RESULT = "DynA" ;
    CASE T.Kind ?
    ['BOOL']:           RESULT =_ "Byte"
    ['ENUM']:   RESULT =_ "Byte"
    ['INT']:            RESULT =_ "Int"
    ['REAL']:           RESULT =_ "Real"
    ['STR']:            RESULT =_ "Str"
    ['CLASS', 'STRUCTURE']:RESULT =_ "Obj"
    	CASE !Op.Declare ?
             CASE Op.Weak ?   RESULT =_ "Weak"
             ELSE             RESULT =_ "Hard" ;
    	;
    ; .

METHOD type_gen|erate({Type} T|ype_of_var,
    {type_options} Op|tions_var) ==> STR
    :
    ------------------------------------ 'For a scalar:'
    CASE T.Kind ?
         ['BOOL']: RESULT = "Boolean"
         ['INT']:
             CASE Comp.Int32 ? 
                  RESULT = "Integer"
             ELSE RESULT = "Int64" ;
         ['ENUM']: RESULT = "Byte"
         ['REAL']: RESULT = real_type
         ['STR']: RESULT = "Str"
         	CASE Op.StrToString ? RESULT = "String" ;
         ['CLASS']: RESULT = "Ref_obj"
         ['STRUCTURE']:
			CASE T.Final_name[0] == "s" ? RESULT = T.Final_name
			ELSE RESULT = "Ref_obj" ;
    ;
    ------------------------------------ 'For an array:'
    CASE ! Op.Array ? ==> ;
    CASE ! Op.Fixed ?
         CASE T.Kind ?
              ['BOOL']: RESULT = "DynAByte"
              ['ENUM']: RESULT = "DynAByte"
              ['INT']: RESULT = "DynAInt"
              ['REAL']: RESULT = "DynAReal"
              ['STR']: RESULT = "DynAStr"
              ['CLASS', 'STRUCTURE']: RESULT = "DynAObj"
         ;
    ELSE
         CASE T.Kind ?
              ['BOOL']: RESULT = "FixAByte"
              ['ENUM']: RESULT = "FixAByte"
              ['INT']: RESULT = "FixAInt"
              ['REAL']: RESULT = "FixAReal"
              ['STR']: RESULT = "FixAStr"
              ['CLASS', 'STRUCTURE']: RESULT = "FixAObj" ;
    ;
 	CASE T.Kind IN ['CLASS', 'STRUCTURE'] && !Op.Declare ?
 	     CASE Op.Weak ? RESULT =_ "Weak"
 	     ELSE RESULT =_ "Hard" ;
 	; .





BOOL FINAL_CODE = TRUE

METHOD USE_STACK_OF_FUN|CTIONS ==> BOOL :
	RESULT = FALSE 
	//CASE Ide_debug || Comp.Debugging ? RESULT = TRUE ; .
	CASE Comp.Debugging ? RESULT = TRUE ; .

INT total_init_var
BOOL current_fun_has_push|statements
BOOL current_fun_has_intersect|ed_pushes
{Fun} current_generated_fun

METHOD generate_method|_or_functions(
	{Fun} F|unction)
	:
	INT start|_line_in_output = im[].Count
	BOOL was_present|_List_temps = list_temps_present(F)
	want_exit_declared = FALSE
	
	CASE Comp.Verbose2 ?
	     << "-------- generating function " F.Class.Whole_name
	     <<	"." F.Whole_name #NL ;

	PUSH current_generated_fun = F :
		 do_generate_method(F) 
	
		 FOR v IN F.Local_var[* DOWNTO 0] :
		     CASE v.Final_name.Starting("temp_obj_param")
		    	  || v.Final_name == "temp_bool_var"
		    	  || v.Final_name == "temp_int_var"
		    	  || v.Final_name == "temp_str_var"
		    	  || v.Final_name.Starting("temp_var_")
		    	  ?
		          F.Local_var[].Delete(v.Index) ;
		 ;
		 
		 CASE was_present ? ==> ;
		 BOOL now_present|_List_temps = list_temps_present(F)
		 ---------------------------- 'provide try - finally - end'
		 INT r|eplacements_count = 0
		 FOR i IN [im[].Count-1 DOWNTO start+1] :
		     STR s|tring_line_i = im[i].Trim
		     CASE s IN ["//try", "//finally", "//end;"] ?
		          CASE !now_present ?
		               im[].Delete(i)
		          ELSE im[i] = im[i].Replace("//", "") ;
		          CASE r >= 2 ? ==> ;
		          r += 1
		     ;
		 ; 
	; .
	
INT line_with_cnt
	
METHOD do_generate_method(
	{Fun} F|unction)
	:
	//DEBUG:
	//      CASE F.Total_fn == 27004 ? NONE ;
	//;
    ---------------------------- 'if a NATIVE directive then return'
    CASE F.Final_name == "-" ?
         im[] << F.Native_code ==> ;
    do_not_release[].Clear
    ---------------------------- 'initialize'
    Comp.Current_fun = F
    Comp.Current_class.Parse.Line = F.Line_start
    fix_method_final_names(F)
    im[] << ""
    im[] << "// fun: " F.Total_fn.Str " " F.Names[0] //" usage=" F.Usage_count.Str
    spaces = ""
    CASE !FINAL_CODE ?
         line_with_cnt = im[].Count
         CASE F == F.Class.Construct || F == F.Class.Destruct ?
              STR suff|ix_cnt_destruct_construct = "_" F.Class.Final_name
              CASE !F.Final_name.Ending(suff) ? 
	               im[*] =_ suff ;
         ;
         im[] << "var CNT_" F.Final_name suff
         CASE use_profiler != "" ?
              im[*] =_ ": {$IFDEF _D5orHigher} Int64 {$ELSE} Integer {$ENDIF};"
         ELSE im[*] =_ ": Integer;" ;
         im[] << "" ;
    ---------------------------- 'header of function'
    gen_fun_header(im[], F)
    ---------------------------- 'declare local vars'
    FOR iv IN [F.Local_var[].Count-1 DOWNTO 0] :
        {Var} vloc|al_var_iv = F.Local_var[iv]
        CASE vloc.Replaced || vloc.Names[0] == "RESULT" ? CONTINUE iv ;
        CASE vloc.Final_name == "this" ? vloc.Set_final_name("THIS") ;
        CASE vloc.Is_param ?
             CASE FPC && !vloc.Is_array && vloc.Type_.Kind == 'STR' ? 
                  // yes, declare X_name, then X_name.Assign_string(Str_X_name)
             ELSE CONTINUE iv ;
        ;
        CASE vloc.Names[0] == "THIS" ? CONTINUE iv ;
        CASE vloc.Declared_in_debug && Comp.Final ? CONTINUE iv ;
		CASE vloc.Is_fixed || vloc.Final_name == "List_temps" ?
			 BOOL fixed_arr = TRUE ;
		CASE vloc.Line == -2 ?
		     F.Local_var[].Delete(iv)
		     CONTINUE iv
		;
		--------------------- 'declare local var, but always Int for loop vars'
		STR v_type|_of_variable = type_gen(vloc.Type_, 
			{type_options}(Array=vloc.Is_array, 
			Fixed=FALSE, Weak=vloc.Is_weak, Declare = TRUE))
			
		CASE !Comp.Int32 && vloc.Type_.Kind == 'INT' && !vloc.Is_array && (
		     vloc.Is_loop || vloc.Type_indexing != "")
		     ?
		     v_type = "Integer" ;
        im[] << "var " vloc.Final_name ": " v_type ";"
                
        //DEBUG :
        //      o[*] << " // " vloc.Total_i.S 
        //      		  ": " vloc.First_index.Str "-" vloc.Last_index.Str ;
    ;
    ---------------------------- 'vars for native function'
    CASE F.Modifiers['NATIVE_FUN'] ?
         STR native|_code[]
         Split_string(native[], F.Native_code, #NL)
         INT last_var|iable_declaration = -1
         FOR s IN native[] :
         	 CASE s.Trim.Replace_all(#TAB, " ").Starting("var ") ?
         	      last_var = s.Index ;
         ;
         FOR s IN native[0 TO last_var] :
             CASE s == "" ? CONTINUE s ;
             im[] << s ;
         FOR s IN native[last_var DOWNTO 0] : native[].Delete(s.Index) ;
    ;
    ---------------------------- 'if use fin: label at the end of the function?'
    current_fun_has_push = function_has_push(F.Block[])
    current_fun_has_intersect = function_has_intersect(F.Block[])
    CASE NOTRY_option || current_fun_has_intersect ?
         //DEBUG:
         //      CASE current_fun_has_intersect ?
         //           << "*".Repeat(80) "Function " F.Class.Names[0] 
         //           "." F.Names[0] " --- has intersected PUSH statements"
         //           #NL ;
         //;
         im[] << "label fin;" ;
    CASE MEMDIAG ?
         im[] << "var save_memdiag: PChar;" ;
    ------------------- 'function to out local vars'
    CASE Ide_debug && !Comp.TEST_value ? function_out_vars(F) ;
    ---------------------------- 'let s begin'
    im[] << "begin " 
    ------------------------------------ 'LIMIT LOOPS present'
    CASE Comp.Has_LIMIT_FUNC ? 
         im[] << spaces sp(4) "inc(AL4.total_func);" ;
    CASE !FINAL_CODE ?
         im[] << "    incr(CNT_" F.Final_name suff ");"
         im[*] =_ "    if CNT_" F.Final_name suff " = 0 then"
         im[] << "    begin nop := 0; end;"
		 ---------------------------- 'functions stack needed ?'
         CASE Comp.Debugging && USE_STACK_OF_FUN ?
              BOOL stack_of_fun|ctions = TRUE
              
              im[]<< "	AL4.Stack_functions[AL4.SP_fun] "
              		 ":= " F.Global_n.Str ";"
              		      
              im[*]=_ "	AL4.Stack_functions[AL4.SP_fun+1] "
              		 ":= CNT_" F.Final_name suff ";"
              		 
              im[*]=_ "	inc(AL4.SP_fun, 2);"
              im[]<< "	try {1}"
              
              spaces = spaces sp(8)
         ;
    ;
    ---------------------------- 'recursive ?'
    spaces = sp(4)
    
    BOOL recur|sion = F.Modifiers['RECURSIVE_FUN'] || (
    	 F.Has_non_abstract_ancestor)
    	 
    ---------------------------- 'init local variables'
    object_var = FALSE
    dynamic_arr = FALSE
    release_str = FALSE
    list_temps_released = FALSE
    init_local_vars(F, NONE)
    CASE recur ?
         CASE "$NOEXCEPTIONS" IN Comp.Defined_name[] ?
              Comp.Warning("Function is recursive but recursion deep control "
              "is off with option $NOEXCEPTIONS set"._Wfun ": " F.Names[0])
         ELSE 
             im[] << spaces "if AL4.Recursion_counter"
                    " > AL4.Max_recursion_deep then" #NL
                    "" spaces sp(4) "raise "
                    "TooDeepRecursionException.Create("
             CASE kol >= 0 ? im[*] =_ "e_Custom, " ;
             im[*] =_ "'');"
             im[] << spaces "inc(AL4.Recursion_counter);" ;
    ;
    PUSH object_var :
    PUSH dynamic_arr :
    PUSH release_str :
	     ---------------------------- 'need try ?'
	     //+++
	     BOOL inc_ref_THIS = FALSE
		 CASE !F.Modifiers['STATIC'] && F.Is_deleting_obj 
		      && F.Class.Destruct != F
		      ?
		      inc_ref_THIS = TRUE
		      im[] << spaces "inc(THIS.hard_link.Count, 2);" ;
		 //===
	     CASE (recur || object_var || dynamic_arr || fixed_arr) 
	    	  && !NOTRY_option || MEMDIAG || release_str || inc_ref_THIS
	          ?
	          CASE MEMDIAG ?
	               im[] << spaces "save_memdiag := memdiag_fun1;"
	               im[] << spaces "memdiag_fun1 := memdiag_fun2;"
	               
	               im[] << spaces "memdiag_fun2 := '" F.Class.Final_name 
	              		  "." F.Final_name "';"
	          ;
	          im[] << spaces "try {2}"
	    	  spaces =_ sp(4) 
	     ELSE im[] << spaces "{try}"
	    	  spaces =_ sp(4)
	    	  BOOL no_finally = TRUE 
	     ;
	     function_body_in_try_finally(F, native[])
    ;
    ;
    ;
    ---------------------------- 'finally...'
    spaces = spaces.[0 TO *-4]
    CASE !no_finally ?
         im[] << spaces "finally {2}"
         spaces =_ sp(4)
         CASE MEMDIAG ?
              im[] << spaces "memdiag_fun2 := memdiag_fun1;"
              im[] << spaces "memdiag_fun1 := save_memdiag;" ;
         CASE recur ?
              im[] << spaces "  dec(AL4.Recursion_counter);" ;
         PUSH spaces = spaces sp(4) :
              {Type}.{kind_type} kinds|_of_dynamic_arrays_disposed[]
              kinds[].Clear
              
              {Var} remove_v|ariables[]
              
              //DEBUG: o[] << "// release vars "
              //		 FOR v IN F.Local_var[] : o[*] << v.Final_name " " ;
              //; 
              list_temps_released = FALSE
              ----------------------------------- 'free local vars', REUSED
              free_local_vars(F, NONE, remove_v[], kinds= kinds[])

              FOR v IN remove_v[] :
                  F.Local_var[].Remove(v) ;
                  
              gen_clean_global_dummy_arrays(kinds[])
              --------------------------------------- 'end of free'
         ;
         -------------------------------------- 'release List_temps', REUSED
		 CASE !list_temps_released && list_temps_present(F) ?
		 	  im[] << spaces "release_temp_lists(List_temps);"
		 	  list_temps_released = TRUE
		 ;
		 CASE inc_ref_THIS ?
		      im[] << spaces "THIS.hard_link.Ref_dec_hard();" ;
		 ---------------------------- 'end release List_temps'
         spaces = spaces.[0 TO * - 4] 
         im[] << spaces "end;" 
    ELSE  
    	 LIKE ........................ 'free local vars'
    	 LIKE ........................ 'release List_temps'
         im[] << "{end}"
    ;
    -------------------------------------- 'DESTRUCTOR?'
    CASE F == Comp.Current_class.Destruct ?
         ------------------------------------ 'clear all object fields'
         gen_unref_class_field_objects(Comp.Current_class) ;
    CASE !FINAL_CODE && stack_of_fun ?
                 spaces = spaces.[0 TO * - 8]
                 im[] << "	finally {1} "
                 ..[] << "		dec(AL4.SP_fun, 2);"
                 ..[] << "	end;" ;
    im[] << "end; {2}" .
    
{Fun} current_function_gen|erating
BOOL object_var|s_present
BOOL dynamic_arr|ays_present
BOOL release_str|ings_necessary
BOOL list_temps_released

METHOD init_local_vars(
{Fun} F|unction, {Local} Loc|al_block_for)
    :
    FOR v IN F.Local_var[] :
        CASE v.In_local_ != Loc ? CONTINUE v ;
        ----------------------------- 'skip initialization for some kinds of v'
        //DEBUG: o[] << "//want init var: " v.Final_name ;
        CASE v.Replaced ? CONTINUE v ;
        CASE v.Declared_in_debug && Comp.Final ? CONTINUE v ;
        CASE v.Is_param && v != F.Result ?
             CASE FPC && !v.Is_array && v.Type_.Kind == 'STR' ?
                  im[] << spaces "New_str(" v.Final_name ", Str_" v.Final_name
                  im[*] =_ ");" 
                  object_var = TRUE ;
             CONTINUE v
        ;
        CASE v.Names[*] == "THIS" ? CONTINUE v ;
        CASE v.Is_stored_param ? CONTINUE v ;
        CASE v.Really_temp && !v.Is_array
        	 && v.Type_.Kind !IN ['CLASS', 'STRUCTURE']
        	 && !(FPC && !v.Is_array && v.Type_.Kind == 'STR')
        	 ?
             CONTINUE v ;
        CASE v.Names[0].Starting("temp_inline") && v.Is_array ?
             im[] << spaces v.Final_name " := nil;"
             CONTINUE v ;
        ------------------------------ 'now init'
        im[] << spaces "// init var: " v.Names[0]
        	   
        CASE ?
        [v.Is_array && v.Type_.Kind == 'STRUCTURE'
         && v.Type_.Final_name[0]=="s"] ?
         	 im[] << spaces v.Final_name " := New_DynARecord("
         	 		"@NoneObj_" v.Type_.Final_name 
         	 		", Sizeof(" v.Type_.Final_name "));"
         	 		
         	 CONTINUE v
        [v.Is_array && v.Type_.Kind == 'STRUCTURE'
         && v.Type_.Final_name[0]=="S"] ?
         	 im[] << spaces v.Final_name " := New_DynAStruct("
         	 		"NoneObj_" v.Type_.Final_name ".hard_link);"
         	 		
         	 CONTINUE v
        [v.Is_array] ?
             dynamic_arr = TRUE
             
             im[] << spaces v.Final_name " := New_" type_gen(
             		v.Type_, {type_options}(Array=TRUE, 
             		Fixed=FALSE, Weak=FALSE))
             		
             CASE ?
             [v.Is_fixed && v.Size_type_.Kind == 'ENUM'] ?
                  im[*] = spaces v.Final_name " := New_" type_gen(
             		v.Type_, {type_options}(Array=TRUE, 
             		Fixed=TRUE, Weak=FALSE)) 
             		"_N(nil, " v.Size_type_.Items[].Count.Str ")"
                       
             [v.Type_.Kind IN ['STRUCTURE']] ?
                  im[*] =_ "(NoneObjInit_" v.Type_.Final_name ".hard_link)"
                  
             [v.Type_.Kind == 'CLASS'
              && v.Type_.Final_name != "AL4_object"] ?
                  im[*] =_ "(unit" v.Type_.Final_name
                       ".NoneObjInit_" v.Type_.Final_name
                       ".hard_link)"
                       
             [v.Type_.Kind IN ['CLASS', 'STRUCTURE']] ?
                  im[*] =_  "(NoneObj_AL4_object.hard_link)"
             ;
             im[*] =_ ";"
             CONTINUE v ;
        CASE v.Type_.Kind ?
        ['INT', 'REAL', 'ENUM']:
        	 im[] << spaces v.Final_name " := 0;"
        	 CASE !SMALLER_CODE ?
        	      im[*] =_ " if " v.Final_name " = 0 then;" ; 
        ['STR']:
             CASE FPC && v != F.Result ?
                  im[] << spaces "New_str(" v.Final_name ", '');"
             ELSE im[] << spaces v.Final_name " := '';" ;
        	 CASE !SMALLER_CODE && !FPC ?
        	      im[*] =_ " if " v.Final_name " = '' then;" ;
        	 CASE FPC ?
        	      release_str = TRUE ;
        ['BOOL']:
        	 im[] << spaces v.Final_name " := FALSE;"
        	 CASE !SMALLER_CODE ?
        	      im[*] =_ " if " v.Final_name " then;" ;
        ['CLASS']:
        	 im[] << spaces "AL4.Init_var_obj(" v.Final_name
             	     ", NoneObjInit_" v.Type_.Final_name ");"
        	 object_var = TRUE
        ['STRUCTURE']:
        	CASE ?
        	[v.Type_.Final_name[0] == "s"] ?
        	     im[] << spaces "Zero_structure(" v.Final_name 
        	     		", Sizeof(" v.Type_.Final_name "));"
        	     		
        	[kol >= 0] ?
	        	 im[] << spaces v.Final_name " := New_" v.Type_.Final_name 
	        	 		".hard_link;"
	        		    
        	ELSE im[] << spaces v.Final_name " := " v.Type_.Final_name
	        		    ".New_instance();"
        	;
        	object_var = TRUE
        ;
    ; .
    
METHOD free_local_vars(
{Fun} F|unction, {Local} Loc|al_block_for,
{Var} remove_v|ariables[],
{Type}.{kind_type} kinds|_of_dynamic_arrays_disposed[])
    :
	{Var} dispose_v|ariables[]
	FOR v IN F.Local_var[] :
		CASE v.In_local_ == Loc ?
	         CASE ?
	         [v.Replaced] ?
	              CONTINUE v
	         [v.Names[0] IN ["THIS", "RESULT"]
	          || v.Final_name.Starting("temp_obj_param")] ?
	              CONTINUE v
	         [v IN F.Param[]] ?
	              CASE FPC && !v.Is_array 
	                   && v.Type_.Kind == 'STR'
	                   ?
	                   im[] << spaces v.Final_name ".Free;" ;
	              CONTINUE v
	         [v.Final_name == "List_temps"] ?
	              list_temps_released = TRUE
	              im[] << spaces "release_temp_lists(List_temps);"
	              CONTINUE v
	         [v.Declared_in_debug && !Comp.Debugging] ?
	              CONTINUE v
	         [v IN do_not_release[]] ?
	              //DEBUG: im[] << "//" v.Final_name " in do_not_release"
	              //;
	              CONTINUE v
	         [v.Names[0].Starting("temp_inline")] ?
	              CONTINUE v
	         ;
	         CASE v.Is_array && ! v.Is_fixed && v.Type_.Kind !IN kinds[] ?
	              kinds[] << v.Type_.Kind ;
	         CASE v.Total_i < 0 ?
	              remove_v[] << v ;
	              
	         dispose_v[].Insert(0, v)
		;
	;
  
  	FOR v IN dispose_v[] :
     	 gen_dispose_var(v) ;
  	.
    
    
METHOD function_body_in_try_finally(
{Fun} F|unction_generating,
STR Native|_code_for_native_functions_only[])
	:
PUSH current_function_gen = F :
	CASE F.Has_add && "$NOEXCEPTIONS" !IN Comp.Defined_name[] ?
         im[] << spaces "try { except ...1 }"
         spaces =_ sp(4) ;
         
	BOOL recur|sion = F.Modifiers['RECURSIVE_FUN']||F.Has_non_abstract_ancestor
    CASE recur && "$NOEXCEPTIONS" !IN Comp.Defined_name[] ?
         im[] << spaces "try { except ...2 }"
         spaces =_ sp(4) ;
    ---------------------------- 'statements'
    FOR st IN F.Block[] :
        {Statement} last_st|atement = st
        statement_gen(st) ;
    after_last_statement(last_st)
    ---------------------------- 'native ?'
    CASE F.Modifiers['NATIVE_FUN'] ?
         INT line|_of_native_fun INDEXING INT = F.Line_start + 1
         CASE Comp.TEST_value && Comp.Generating_test && line > 0 ?
              im[] << spaces "{$IFDEF _D5orHigher}"
              CASE Comp.Current_class.Modifiers['ABSTRACT'] ?
              	   im[] << spaces "Test_caller := "
                   -------------- 'all tests of abstract class are secondary'
                   im[*] =_ "Test_caller mod Int64(1000000) + Int64(" line.Str 
                   ") * Int64(1000000);"
                   
              ELSE im[] << spaces "Test_caller := " line.Str ";" ;
              im[] << spaces "{$ELSE}"
              CASE Comp.Current_class.Modifiers['ABSTRACT'] ?
                   -------------- 'all tests of abstract class are secondary'
              	   im[] << spaces "Test_caller.Lo := "
                   im[*] =_ "Test_caller mod Int64(1000000);"
                   im[] << spaces "Test_caller.Hi := " line.Str ";"
                   
              ELSE im[] << spaces "Test_caller.Lo := " line.Str ";"
              	   im[] << spaces "Test_caller.Hi := 0;" 
              ;
              im[] << spaces "{$ENDIF}"
         ;
         CASE Comp.TEST_value && Comp.Current_class.Modifiers['TESTED'] ?
              FOR j|dummy IN [tcl[].Count TO line] : tcl[] << -1 ;
              tcl[line] = 0
              im[] << "    test_lines" "[" line.Str "] := Test_caller;" ;
         call_if_stop_then_out_vars(F, 0) //F.Line_start - F.Header_line)
		 -------------------------- 'native implementation'
         FOR i IN [0 TO Native[].Count-1] :
             im[] << Native[i] ;
    ;
    CASE NOTRY_option || current_fun_has_intersect ?
         CASE im[*].Trim == "if want_exit then goto fin;" ?
              im[].Delete(im[].Count-1) ;
         im[] << spaces "fin:" ;
    ----------------------------- 'catch OutOfMemory'
    CASE F.Has_add && "$NOEXCEPTIONS" !IN Comp.Defined_name[] ?
         spaces = spaces.[0 TO * - 4]
         
         im[] << spaces @"except on E: OutOfMemoryException do"
             "" spaces "  begin"
             "" spaces "    AL4.Any_exception(E);"
             "" spaces "    if AL4.Recursion_counter > 1 then"
             "" spaces "       raise;"
             
         CASE F.Result != NONE ?
              CASE F.Result.Type_.Kind == 'STRUCTURE'
              	   && F.Result.Type_.Final_name[0] == "s"
              	   ?
                   im[] << spaces sp(4) "Zero_structure(RESULT, Sizeof("
                   		  "" F.Result.Type_.Final_name "))"
                   		  
              ELSE im[] << spaces sp(4)
              			  "RESULT := " gen_none_val(F.Result.Type_)
              ;
         ;
         im[] << spaces "  end;"
         im[] << spaces "end;" ;
    ---------------------------- 'catch recursion too deep'
    CASE recur && "$NOEXCEPTIONS" !IN Comp.Defined_name[] ?
         spaces = spaces.[0 TO * - 4]
         im[] << spaces "except on E: TooDeepRecursionException do"
         im[] << spaces "  begin"
         im[] << spaces "    AL4.Any_exception(E);"
         
         im[] << @"" spaces "    if AL4.Recursion_counter > 1 then"
                 "" spaces "       raise;"
         
         CASE F.Result != NONE ?
              im[*] =_ "   RESULT := " gen_none_val(F.Result.Type_) ";"
         ;
         im[] << spaces "  end;"
         im[] << spaces "end;" ;
; .


FUNCTION list_temps_present|_in_variables(
	{Fun} F|unction) ==> BOOL
	:
    FOR v IN F.Local_var[] :
        CASE v.Final_name == "List_temps" ?
             RESULT = TRUE ==> ;
    ; .

    
FUNCTION function_has_push|_statements( 
    {Statement} Block|_of_statements[] ) ==> BOOL, RECURSIVE
    :
    FOR st IN Block[] :
        CASE st.Work == 'PUSH' ? RESULT = TRUE ==> ;
        RESULT = function_has_push(st.Block_[])
        CASE RESULT ? ==> ;
    ; .
    
FUNCTION function_has_intersect|ed_pushes( 
    {Statement} Block|_of_statements[]) ==> BOOL, RECURSIVE
    :
    FOR st IN Block[] :
        CASE st.Work == 'PUSH' && st.{Assign}.Intersect ? RESULT = TRUE ==> ;
        RESULT = function_has_intersect(st.Block_[])
        CASE RESULT ? ==> ;
    ; .
    
METHOD gen_unref_class_field_objects
	|_called_to_generate_DESTRUCT_only({Type} Class|_type)
	:
    FOR fld IN Class.Field[] :
        CASE ?
        [fld.Type_.Kind == 'CLASS' && fld.Type_ !IN Comp.All_classes[]] ? NONE
        [fld.Is_array && ! fld.Is_fixed] ?
             CASE fld.Type_.Kind == 'STRUCTURE' 
                  && fld.Type_.Final_name[0] == "S"
                  ?
                  im[] << spaces "    THIS." fld.Final_name ".Clear_struc;"
             ELSE
                  im[] << spaces "    THIS." fld.Final_name ".Clear;"
             ;
        [fld.Is_array && fld.Type_.Kind == 'CLASS'] ?
             im[] << spaces "    THIS." fld.Final_name ".Unref_"
             CASE fld.Is_weak ? im[*] =_ "weak"
             ELSE im[*] =_ "hard" ;     
             im[*] =_ ";"
        [fld.Type_.Kind == 'STRUCTURE' && fld.Type_.Final_name[0] == "S"] ?
             im[*] =_ spaces "THIS." fld.Final_name ".Discard_struct;"
        [fld.Type_.Kind == 'CLASS'] ?
             CASE fld.Is_weak ?
             	  im[] << spaces "    Object_assign_weak("
             ELSE im[] << spaces "    Object_assign_hard(" ;
        	 im[*] =_ "THIS." fld.Final_name ", "
        	 im[*] =_ "NoneObj_" fld.Type_.Final_name ");"
        [FPC && fld.Type_.Kind == 'STR' && !fld.Is_array] ?
             im[] << spaces "Dispose_str(THIS." fld.Final_name ");"
        ;
    ; .
               

METHOD gen_fun_header(STR o|utput_lines[], {Fun} F|unction_generating) :
    ---------------------------- 'header'
    //DEBUG:
    //      o[] << "//header fun#" F.Total_fn.S ":" F.Whole_name ;
    CASE F.Result != NONE ? o[] << "function "
    ELSE o[] << "procedure " ;
    o[*] =_ F.Final_name 
    CASE F.Param[].Count == 0 && F.Modifiers['STATIC']
         && F.Class.Construct != F && F.Class.Destruct != F
         ?
         o[*] =_ "{$IFDEF _D5orHigher}(){$ENDIF}"
    ELSE 
	     o[*] =_ "(" sp(1)
	     ---------------------------- 'parameters'
	     CASE !F.Modifiers['STATIC'] ? 
	          o[*] =_ "THIS: " Comp.Current_class.Final_name ";" ;
	     FOR p IN F.Param[] :
	         o[] << sp(8) 
	         CASE !p.Is_array && p.Type_.Kind == 'STR' ? o[*] =_ "const " ;
	         CASE FPC && p.Type_.Kind == 'STR' && !p.Is_array ? 
	              o[*] =_ "Str_" p.Final_name
	         ELSE o[*] =_ p.Final_name ;
	         
	         o[*] =_ ": " type_gen_A(p.Type_, {type_options}(Array= p.Is_array, 
			                 Fixed= p.Is_fixed, Weak= p.Is_weak, Declare= TRUE,
			                 StrToString= TRUE)) ";"
	     ;
	     CASE F.Modifiers['STORE'] ?
	          o[] << sp(8) "var " F.Stored_param.Final_name ": Integer;" ;
	     CASE o[*].[*] == ";" ?
	          o[*] = o[*].[0 TO *-1] ;
	     o[*] =_ ")" ;
    ---------------------------- 'resulting type'
    CASE F.Result != NONE ? 
         o[*] =_ ": " type_gen(F.Result.Type_,
         				{type_options}(
         					StrToString= TRUE,
			         		Array= FALSE, 
			                Fixed= FALSE,
			                Weak= FALSE))
    ;
    o[*] =_ ";" .

FUNCTION fix_method_final_names|_of_local_variables(
	{Fun} F|unction_to_fix)
	: 
    FOR v IN F.Local_var[] :
        CASE v.Final_name == "" ? 
             v.Set_final_name("X_" v.Names[0])
        ;
        CASE !F.Modifiers['NATIVE_FUN'] && !v.Is_param
        	 && v.Final_name.Starting("X_")
        	 ?
             v.Set_final_name("X" v.Final_name) ;
        CASE v.Is_param ? CONTINUE v ;
        FOR i INDEXING {Var} IN [0 TO v.Index-1] :
            CASE v.Final_name.Lower == F.Local_var[i].Final_name.Lower ?
                 BOOL reused|_name = TRUE
                 BREAK i ;
        ;
        CASE reused && v.Line >= 0 && v.Final_name != "THIS" ?
             v.Set_final_name(v.Final_name "_line" v.Line.Str) ;
    ; .



METHOD gen_dispose_var({Var} V|ariable_local) :
	//DEBUG: 
	//      CASE FPC && V.Type_.Kind == 'STR' && !V.Is_array ?
	//           im[] << spaces "// want dispose: " V.Final_name ;
	//;
    CASE ?
    [V.Is_fixed] ?
         im[] << spaces V.Final_name
         	CASE kol >= 0 ? im[*] =_ ".Free;"
         	ELSE im[*] =_ ".Free();" ;
    [V.Is_array] ?
         im[] << spaces V.Final_name ".Dispose();"
    [V.Type_.Kind == 'STRUCTURE' && V.Type_.Final_name[0] == "s"] ?
         ==>
    [V.Type_.Kind == 'STRUCTURE'] ?
         im[] << spaces V.Final_name ".Discard_struct();"
    [V.Type_.Kind == 'CLASS'] ?
         im[] << spaces V.Final_name ".Ref_dec_hard();"
    [FPC && V.Type_.Kind == 'STR' && !V.Is_array] ?
         im[] << spaces "Dispose_str(" V.Final_name ");"
    ELSE ==> ;
    im[*] =_ " // dispose var: " V.Total_i.Str .

    
METHOD gen_clean_global_dummy_arrays(
	{kind_type} Kinds|_of_arrays[])
	:
    FOR k IN Kinds[] :
        CASE k ?
        ['CLASS', 'STRUCTURE']: STR suffix_d|ynamic_array = "ObjHard"
        ['BOOL']:   suffix_d = "Byte"
        ['ENUM']: suffix_d = "Byte"
        ['INT']:    suffix_d = "Int"
        ['REAL']:   suffix_d = "Real"
        ['STR']:    suffix_d = "Str"
        ;
        CASE k IN ['CLASS', 'STRUCTURE'] ?
        	  im[] << spaces "if Assigned(GlobalDummyArrayObjHard) then"
        	  				" GlobalDummyArrayObjHard.Clear();"
        	  				
              im[] << spaces "if Assigned(GlobalDummyArrayObjWeak) then"
              				" GlobalDummyArrayObjWeak.Clear();"
              				
              CONTINUE k
        ;
        im[] << spaces "if Assigned(GlobalDummyArray" suffix_d ") then"
        			  " GlobalDummyArray" suffix_d ".Clear();"
        			  
        CASE im[*] == im[*-1] ? im[].Delete(im[].Count-1) ; 
    ; .

METHOD function_out_vars({Fun} F|unction) :
	im[] << "  function _vars_"
	CASE F.Result != NONE 
	     && F.Result.Type_.Kind != 'CLASS'
	     ?
	     im[*] =_ "(const r: "
	     CASE F.Result.Type_.Kind.Name ?
	     ["'BOOL'"]: im[*] =_ "Boolean"     
	     ["'INT'"]: im[*] =_ "Integer"
	     ["'REAL'"]: im[*] =_ "Double"
	     ["'STR'"]: im[*] =_ "String" 
	     ["'ENUM'"]: im[*] =_ "Byte" 
	     ["'STRUCTURE'"]:
	         CASE kol >= 0 && F.Result.Type_.Final_name[0]=="S" ? 
	              im[*] =_ "P" ;
	         im[*] =_ F.Result.Type_.Final_name ;
	     im[*] =_ ")" ;
	im[*] =_ ": String;" 
	im[] << "  begin"
	INT count_vars = 0
	FOR v IN F.Local_var[] : count_vars += out_var(v, "", count_vars==0) ;
	CASE !F.Modifiers['STATIC'] ? 
	     FOR v IN F.Class.Field[] : 
	         count_vars += out_var(v, "THIS.", count_vars==0) ;
	;
	CASE count_vars == 0 ? im[] << "    Result := '';" ;
	im[] << "  end;" .
	
METHOD out_var|iable_1(
{Var} v|ariable_or_field, STR prefix|_of_name, BOOL f1st|_variable) ==> INT
    :
	CASE v.Final_name == "RESULT" ? STR fn|ame_final = "r" 
	ELSE fn = prefix v.Final_name ;
    CASE ?
    [v.Names[].Count == 0 || "__" IN v.Final_name] ? ==>     
    [v.Is_array] ?
        CASE !v.Is_fixed ? 
	         --------------------------------- 'add var', REUSED
	         CASE f1st ? 
	              im[] << "  RESULT := "
	         ELSE im[] << "  RESULT := RESULT + " ;
	         ---------------------------------
	         im[*] =_ "#13#10'"
	         CASE v.Type_.Kind ? 
	         ['BOOL']: im[*] =_ "BOOL"     
	         ['INT']: im[*] =_ "INT"
	         ['REAL']: im[*] =_ "REAL"
	         ['STR']: im[*] =_ "STR"
	         ['ENUM', 'STRUCTURE', 'CLASS']: im[*] =_ v.Type_.Names[0]  ;
             im[*] =_ " " prefix v.Names[0] "[].Count=' + i2s(" fn ".Count());"     
        ;
    [v.Type_.Kind == 'INT'] ?
    	LIKE ............................ 'add var'
    	
        im[*] =_ "#13#10'INT" 
        		" " prefix v.Names[0] "=' + i2s(" fn ");"
        		     
    [v.Type_.Kind == 'REAL'] ?
    	LIKE ............................ 'add var'
    	im[*] =_ "_r_('" prefix v.Names[0] "', " fn ");"
    [v.Type_.Kind == 'STR'] ?
    	LIKE ............................ 'add var'
    	im[*] =_ "_s_('" prefix v.Names[0] "', " fn ");"
    [v.Type_.Kind == 'BOOL'] ?
    	LIKE ............................ 'add var'
    	im[*] =_ "_b_('" prefix v.Names[0] "', " fn ");"
    [v.Type_.Kind == 'ENUM'] ?
        LIKE ............................ 'add var'
        
        im[*] =_ "#13#10 + '" v.Type_.Names[0] 
        	     " " prefix v.Names[0] "=' + Names_" v.Type_.Final_name
        		 "__" v.Type_.Base_.Final_name
        		 "[" fn "];"       
        		      
    [v.Type_.Kind == 'STRUCTURE'] ?
        LIKE ............................ 'add var'
        
        im[*] =_ "#13#10 + '" v.Type_.Names[0] " " prefix v.Names[0] "='"
    	CASE ?
    	[fn == "r"] ?
    		 STR var_n|ame = fn
    	[v.Type_.Final_name[0] == "s"] ?
    	     var_n = v.Type_.Final_name "(" fn ")"
    	[kol >= 0] ?
    		 var_n = "P" v.Type_.Final_name "(" fn ".Obj)"
    	ELSE var_n = v.Type_.Final_name "(" fn ".Obj)" ;
        im[*] =_ structure_fields(v.Type_, "", var_n).Trim ";"
    ELSE ==> ;
    RESULT = 1 .
    
METHOD structure_fields(
{Type} Struc|ture_type, STR SN|ame_to_show, STR VN|ame_of_var) ==> STR,
RECURSIVE
    :
    FOR fld IN Struc.Field[] :
        CASE fld.Type_.Kind == 'CLASS' ? CONTINUE fld ;
        CASE fld.Is_array ? 
             CASE fld.Is_fixed ? CONTINUE fld ;
                  
             RESULT =_ "+ '" SN "." fld.Names[0] "[].Count=' + i2s(" 
             "" VN "." fld.Final_name ".Count) + '; '"
                  
             CONTINUE fld     
        ;
        CASE fld.Type_.Kind ? 
        ['INT']:
            ------------------------------------------- 'field name', REUSED
            RESULT =_ #NL"    + '" SN "." fld.Names[0] "=' + "
            -------------------------------------------
            RESULT =_ "i2s(" VN "." fld.Final_name ") + '; '"
        ['REAL']:
            LIKE ...................................... 'field name'
            CASE kol > 0 ? RESULT =_ "Extended2Str" 
            ELSE RESULT =_ "FloatToStr" ;
            RESULT =_ "(" VN "." fld.Final_name ") + '; '"
        ['BOOL']:
            LIKE ...................................... 'field name'
            RESULT =_ "_b2s_(" VN "." fld.Final_name ") + '; '"
        ['STR']:
            LIKE ...................................... 'field name'
            RESULT =_ "_s_quote_(" VN "." fld.Final_name ") + '; '"
        ['ENUM']:
            LIKE ...................................... 'field name'
            
            RESULT =_ "Names_" fld.Type_.Final_name 
	        		 "__" fld.Type_.Base_.Final_name
	        		 "[" VN "." fld.Final_name "] + '; '"
	        		      
        ['STRUCTURE']:
            //LIKE ...................................... 'field name'
            RESULT =_ #NL structure_fields(fld.Type_, fld.Names[0],
            	VN "." fld.Final_name) " + ' '"
            	
        ['CLASS']: NONE
        ;
    ;
    .

INT level_expr|ession
BOOL is_left_side
INT close_br|acket_right_side
INT total_close_br

METHOD next_close_br|acket_index ==> INT :
	total_close_br += 1
	RESULT = total_close_br .
	
INT total_stmt|_output_index
INT line_current_statement|_will_be_placed

METHOD statement_gen|erate(
{Statement} Stmt|_statement), RECURSIVE
	:
	im[] << spaces "// ---------- 'stmt: " Stmt.Total_stmt.Str 
         "(Line:" (Stmt.Line+1).Str ")"
         
	//DEBUG: im[] << spaces "check_something;" ;
              
    close_br = 0
    
    CASE Stmt.Inline_index != "" ?
         im[*] =_ " INLINE: " Stmt.Inline_index ;
         
    CASE Comp.TEST_value && Comp.Generating_test && Stmt.Line > 0 ?
         CASE Comp.Current_class.Modifiers['ABSTRACT'] ?
              im[] << spaces "Test_caller := Test_caller mod 1000000 + "
              "Int64(1000000) * " Stmt.Line.Str ";"
         ELSE im[] << spaces "Test_caller := " Stmt.Line.Str ";" ;
    ;
    
    CASE Comp.TEST_value && !Comp.Generating_test && Stmt.Line > 0 && (
         Stmt.Work != 'CASE') && Stmt.Work != 'COMMENT'
         ?
         FOR i|dummy IN [tcl[].Count TO Stmt.Line] : tcl[] << -1 ;
         CASE !(Comp.Current_fun.Is_trivial && (
              Comp.Current_class.Modifiers['NATIVE']))
              ?
              INT k INDEXING (STR,INT) = Stmt.Line
              tcl[k] = 0
         ;
         im[] << spaces "if test_lines[" Stmt.Line.Str "] = 0 then "
         		"test_lines[" Stmt.Line.Str "] := Test_caller;"
    ;
    line_current_statement = im[].Count
    ------------------------------------- 'if _stop_ then _out_(_vars_)', REUSED
    CASE Ide_debug && !Comp.TEST_value && Stmt.Line > 0 
         && Stmt.Work != 'DEBUG' 
         ?
         im[] << spaces "if _stop_(" Stmt.Function_.Global_n.S 
         		 "," (Stmt.Line - Stmt.Function_.Line_start).S ") "
         		 "then _out_('" Stmt.Function_.Global_n.S 
         		 "," (Stmt.Line - Stmt.Function_.Line_start).S
         		 ":" Stmt.Pos.S "'"
         		 ", _vars_"
         CASE Stmt.Function_.Result != NONE 
              && Stmt.Function_.Result.Type_.Kind IN [
              'BOOL', 'INT', 'REAL', 'STR', 'ENUM', 'STRUCTURE'] 
              ?
              CASE Stmt.Function_.Result.Type_.Kind == 'STRUCTURE'
                   && Stmt.Function_.Result.Type_.Final_name[0] == "S"
                   ? 
                   im[*] =_ "("
                   CASE kol >= 0 ? im[*] =_ "P" ;
                        
                   im[*] =_ Stmt.Function_.Result.Type_.Final_name 
                   			"(RESULT.Obj))" 
                   			     
              ELSE im[*] =_ "(RESULT)" ;
         ;
         im[*] =_ ");"
         
         FOR ss IN im[*-2 DOWNTO 0] :
             ss = ss.Trim.Lower
             //DEBUG: im[*] << "/" "/"  ss.INDEX.S ss.[0 TO 4]"..." ss.[*-4 TO *];
             CASE ?
             [ss.Starting("/" "/") && "line:0)" IN ss] ? 
                 INT move_before = ss.INDEX
             [ss.Starting("end") || ss.Starting("try") || ss.Starting("begin") 
             || ss.Starting("/" "/") && "line:" IN ss] ?
                 BREAK ss
             ;
         ;
         CASE move_before > 0 ? 
              im[].Insert(move_before, im[*]) 
              im[].Delete(.Count-1)
              //DEBUG:
              //      im[] << "//if _stop_... moved to: " move_before.S ; 
         ;
    ;
    ---------------------------------------- 'stmt'
    CASE Stmt.Total_stmt == 0 ? INT dummy_temp = 0 ;
    //DEBUG:
    //      CASE Stmt.Total_stmt == 10234 ?
    //           Stmt.Test_output ;
    //;
    CASE Stmt.Work ?
        ['ASSIGN']: STR text|_generated = generate_assign(Stmt.{Assign})
        		im[] << text
        ['APPEND']: text = generate_append(Stmt.{Assign})  
             		im[] << text
        ['OUTPUT']: generate_output(Stmt.{Assign})
        ['INPUT']:  generate_input(Stmt.{Assign})
        ['BREAK']:  generate_break(Stmt.{For})
        ['CONTINUE', 'NEXT']: generate_cont(Stmt.{For})
        ['RETURN']: generate_return(Stmt.{Case})
        ['CASE', 'ELSE']: gen_case(Stmt.{Case})
        ['LIMIT']: gen_limit(Stmt.{Limit})
        ['LOCAL']: gen_local(Stmt.{Local})
        ['FOR']: generate_for(Stmt.{For})
        ['PUSH']:   generate_push(Stmt.{Assign})
        ['STOP']:   generate_stop(Stmt.{Case})
        ['ASSERT']: generate_assert(Stmt.{Case})
        ['DEBUG']:  
                    CASE !Comp.Final ?
                         generate_block(Stmt.Block_[]) ;
        ['COMMENT']: gen_comment_block(Stmt.{Assign})
        ['CALL_NATIVE']: NONE ;
    FOR s IN post[] :
        //DEBUG: im[] << spaces "check_something;" ;
        im[] << s ;
    //DEBUG: im[] << spaces "check_something;" ;
    post[].Clear . 
    
METHOD after_last_statement(
{Statement} Stmt|_statement_was_last)
    :
	CASE Stmt.Line <= 0 ? ==> ;
	FOR i IN [Stmt.Line TO Comp.Current_class.Parse.Source[].Count-1] :
		STR s|tatement_str = Comp.Current_class.Parse.Source[i]
		s = s.TrimR
		CASE s.[*] == "." ?
		     INT line|_last = i
		     INT p|osition_ending = s.Len-1
		     BREAK i ;
	;
    LIKE statement_gen .................. 'if _stop_ then _out_(_vars_)',
    	BUT (Stmt.Pos.S ==> p.S), (Stmt.Line ==> line)*3 .
    
METHOD call_if_stop_then_out_vars(
{Fun} F|unction_native, INT Line_in_F)
    :
    {Statement} p_st|atetment_plug|TEMP = {Assign}(
        Line= F.Line_start + Line_in_F, Pos= 0, Function_= F, Level= 0)
        
    LIKE statement_gen ... 'if _stop_ then _out_(_vars_)', 
        BUT(Stmt==>p_st)*14 .

METHOD provide_list_temps :
	list_temps_used = TRUE
	FOR i IN [Comp.Current_fun.Local_var[].Count-1 DOWNTO 0] :
		{Var} v|ar_list_temps = Comp.Current_fun.Local_var[i]
		CASE v.Final_name == "List_temps" ? ==> ;
	;
	v = {Var}(Line = -2, In_fun_ = Comp.Current_fun,
		Type_ = Comp.TYPE_STR, Is_array = TRUE),
		>> Comp.Current_fun.Local_var[]
		
	v.Set_final_name("List_temps")
	------------------------------------ 'declare & init'
	FOR i IN [im[].Count-1 DOWNTO 0] :
		CASE ?
		[im[i].Starting("begin")] ?
		     BOOL begin_f|ound = TRUE
		
			 STR init|ialization_of_List_temps = "List_temps := "
				 "allocate_list_temps;"
							 
			 im[].Insert(i+1, spaces init)
			 INT ins|ert_declaration_at = i
			 CONTINUE i
		[!begin_f && im[i].Trim.Starting("List_temps := ")] ? ==>
		
		[begin_f && im[i].first_ident IN ["function", "procedure"]] ?
		     STR decl|aration_List_temps = "var List_temps: "
		     
		     CASE kol >= 0 ?
		          decl =_ "PList;"
		     ELSE decl =_ "TList;" ;
		     
		     im[].Insert(ins, decl) ==>
		;
	; .

	
FUN first_ident(STR S|tring_line) ==> STR :
	STR s|tring_tabs_replaced_by_spaces = S.Replace(#TAB, #SP)
	INT sf|irst_space_pos = S.Find(#SP)
	CASE sf < 0 ? RESULT = s ==> ;
	RESULT = s.[0 TO sf-1] .

BOOL noincref|_while_assigning_object
BOOL need_use_pass_through|_in_indexes

METHOD generate_assign(
	{Assign} A|ssignment) ==> STR, RECURSIVE
	:
	---------------- 'exclude trap_add_ functions if debugging is off'
	CASE !Comp.TEST_value && !Comp.Debugging 
		 && A.Source.Fun_.Modifiers['TRAP_FUN']
		 && A.Source.Fun_.Trap_field.Trap_add_ == A.Source.Fun_
		 ?
	     ==> ;
    --------------------------------------------------- 'If Dest present'
PUSH need_use_pass_through = FALSE :
	{Type} dest_type = A.Dest.Type_expr 
    CASE ?
    [A.Dest != NONE && A.Dest.Var_arg != Comp.NONE_c] ?
         ----------------------------------- 'assign to a single symbol'
         CASE A.Dest.Operation == 'INDEX' 
         	  && A.Dest.Arg1_.Operation == 'INDEX'
         	  ?
              RESULT =_ spaces 
              .. =_ gen_expr(A.Dest.Arg1_.Arg1_) ".SetStrings("
              .. =_ gen_expr(A.Dest.Arg1_.Arg2_) ", AL4.Change_single_symbol("
              .. =_ gen_expr(A.Dest.Arg1_.Arg1_) ".GetStrings"
              .. =_ "(" gen_expr(A.Dest.Arg1_.Arg2_) "), "
              .. =_ gen_expr(A.Dest.Arg2_) ", "
              .. =_ gen_expr(A.Source) "));" ==>
         ;
         CASE A.Dest.Operation == 'INDEX' && dest_type.Kind == 'STR' && (
              ! A.Dest.Arg1_.Is_array) && A.Dest.Arg3_ == NONE
              ?
              CASE FPC && A.Dest.Arg1_.Var_arg.Final_name != "RESULT" ? 
                   RESULT =_ spaces gen_expr(A.Dest.Arg1_)
                   RESULT =_ ".Assign_string(AL4.Change_single_symbol("
                   STR e|nding_brackets = "));"
              ELSE
	               RESULT =_ spaces gen_expr(A.Dest.Arg1_) 
	               " := AL4.Change_single_symbol("
	               e = ");"
              ;     
              PUSH is_left_side = TRUE :
              	   RESULT =_ gen_expr(A.Dest.Arg1_) ;
              RESULT =_ ", " gen_expr(A.Dest.Arg2_) ", " gen_expr(A.Source) e
              ==> ;
         ----------------------------------- 'to an object which can be NONE'
         {Type} a1_type|_dest_arg1 = A.Dest.Arg1_.Type_expr 
         CASE A.Dest.Operation == 'FIELD' && a1_type.Kind == 'CLASS'
         	  && dest_type.Kind == 'CLASS' && (
         	  a1_type.Has_destructors 
         	  //|| Comp.Any_class_from_ccc
         	  )
              ?
              STR text_arg1 = gen_expr(A.Dest.Arg1_) 
              RESULT =_ spaces "if not (" text_arg1 ")"
              CASE ! Ending(RESULT, "(Result)") ?
                   RESULT = (RESULT ".Obj").reduce_hardlink_obj
              ;
              RESULT =_ ".Is_NONE_object then" #NL "    " ;
         ----------------------------------- 'to an item of an objects array'
         CASE A.Dest.Operation == 'INDEX' && dest_type.Kind == 'CLASS' ?
              PUSH is_left_side = TRUE :
                   RESULT =_ spaces gen_expr(A.Dest) ;
              CASE close_br == 0 ? RESULT =_ " := " ;
              RESULT =_ spaces 
              RESULT =_ gen_obj_expr(A.Source, dest_type)
              CASE close_br != 0 ? RESULT =_ ")" ;
              RESULT =_ ";"
              close_br = 0
              ------------------- 'ref_dec ?'
              CASE A.Source.Operation == 'FUN' && ! A.Dest.Is_weak ?
                   RESULT =_ spaces gen_expr(A.Dest) ".Ref_dec_hard();" ;
              CASE A.Source.Operation == 'FUN' && A.Dest.Is_weak ?
                   RESULT =_ spaces gen_expr(A.Dest) ".Ref_dec_weak();" ;
              RESULT =_ finish_assign_object(A) ==> ;
         ----------------------------------- 'to a scalar object variable'
         CASE ?
         [! A.Dest.Is_array && A.Dest.Operation != 'INDEX'
          && dest_type.Kind == 'STRUCTURE'
          && dest_type.Final_name[0] == "s"] ?
              CASE ?
              [A.Source.Operation == 'CONST'] ?
                   RESULT =_ spaces "Zero_structure("gen_expr(A.Dest)
                          ", Sizeof(" dest_type.Final_name "));"
                          
              [A.Source.Operation == 'NEW_OBJ'] ?
              	   STR dest_v|ariable = gen_expr(A.Dest)
              	   
                   RESULT =_ spaces "Zero_structure(" dest_v
                          ", Sizeof(" dest_type.Final_name "));"
                          
                   RESULT =_ gen_assignments( dest_v, 
                   				A.Source.Assignments_[]) ";"
                   
              ELSE RESULT =_ spaces gen_expr(A.Dest) 
              				 " := " gen_expr(A.Source) ";"
              ;
              ==>
         [! A.Dest.Is_array && A.Dest.Operation != 'INDEX' && (
          //dest_type.Kind IN ['CLASS', 'STRUCTURE'])
          dest_type.Kind IN ['STRUCTURE'])
          && A.Source.Operation IN ['FUN', 'BASE_FUN', 'SYSTEM_FUN']] ?
              PUSH is_left_side = TRUE :
                   RESULT =_ spaces gen_expr(A.Dest) " := " ;
              RESULT =_ gen_obj_expr(A.Source, dest_type) ";"
              RESULT =_ finish_assign_object(A) ==> 
         [! A.Dest.Is_array && A.Dest.Operation != 'INDEX' && (
          dest_type.Kind IN ['CLASS', 'STRUCTURE'])] ?
              RESULT =_ spaces "Object_assign_"
              CASE A.Dest.Is_weak ? RESULT =_ "weak"
              ELSE RESULT =_ "hard" ;
              CASE A.Source.Operation == 'FUN' || noincref 
              	   || dest_type.Kind == 'STRUCTURE'
              	   ?
                   RESULT =_ "_noincref" ;
              PUSH is_left_side = TRUE :
                   RESULT =_ "(" gen_expr(A.Dest) ;
                   
              {Type} t_s|ource_type = A.Source.Type_expr 
              
              RESULT =_ ", " (gen_obj_expr(A.Source, t_s) //dest_type) 
              			".Obj").reduce_hardlink_obj ");"
              			
              RESULT =_ finish_assign_object(A) ==> ;
         PUSH is_left_side = TRUE :
              CASE A.Dest.Is_fixed && A.Source.Operation == 'INDEX' && (
                   A.Source.Arg3_ != NONE)
                   ?
                   ------ 'special assign A[x TO y] to temp fixed array'
                   RESULT =_ spaces gen_expr(A.Dest) ".Free;"
                   RESULT =_ spaces gen_expr(A.Dest) " := "
                   CASE A.Source.Arg1_.Var_arg.Names[0] == "DATA" ?
                        RESULT =_ "New_FixAStr_Array(nil, @"
                        "" gen_expr(A.Source.Arg1_)
                        ", " A.Source.Arg1_.Var_arg.Provide_size_value.Str
                   		", " gen_expr(A.Source.Arg2_)
                   		", " gen_expr(A.Source.Arg3_) ");" ==>
                   ;
                   RESULT =_ (
                   		"New_" type_gen(
                   			dest_type, {type_options}(
                   				Array=TRUE, Fixed=TRUE, Weak=FALSE
                   			 ))).Remove_ending("Hard")

                   CASE A.Source.Arg1_.Var_arg.Is_fixed
                   	    && A.Source.Arg1_.Var_arg.In_type_.Kind 
                   	    == 'STRUCTURE'
                   	    ?
                        RESULT =_ "_Array(nil, " 
                        "@" gen_expr(A.Source.Arg1_) "[0]"
                        "," A.Source.Arg1_.Var_arg.Size_value.S 
                   ELSE RESULT =_ "(nil, " gen_expr(A.Source.Arg1_) ;
                   
                   RESULT =_ ", " gen_expr(A.Source.Arg2_)
                   		", " gen_expr(A.Source.Arg3_) ");"
                   		
                   ==> ;
              CASE ?
              [A.Dest.Is_array && A.Source != NONE 
               && A.Source.Var_arg.Constant_value != "NONE"] ?
                   --------- 'array := array; for inline function call only'
                   do_not_release[] << A.Dest.Var_arg
                   
                   RESULT =_ spaces gen_expr(A.Dest) " := " 
                   		"" gen_expr(A.Source) ";" ==>
                   		
              [A.Dest.Is_array] ?
                   --------------- 'an array is just declared, clear it'
                   CASE A.Dest.Is_fixed ?
                   		RESULT =_ spaces gen_expr(A.Dest) ".Nullify();"
                   ELSE RESULT =_ spaces gen_expr(A.Dest) ".Clear();" ;
                   ==> ;
              CASE A.Dest.Operation == 'INDEX' && A.Dest.Arg3_ == NONE 
              	   && A.Dest.Arg1_.Is_fixed
              	   && A.Dest.Arg1_.Var_arg.In_type_.Kind == 'STRUCTURE'
              	   && !A.Dest.Arg1_.Var_arg.Modifiers['CLAMP']
              	   ?
                   INT size_v|alue = A.Dest.Arg1_.Var_arg.Provide_size_value
                   CASE size_v > 0 ?
	                    RESULT =_ "if Cardinal(" gen_expr(A.Dest.Arg2_) 
	                    		  ") < " size_v.S " then "
	                    		  
	                    need_use_pass_through = TRUE ;
              ;
              ---------------------------------- 'all other destinations'
              PUSH is_left_side = TRUE :
              	   RESULT =_ spaces gen_expr(A.Dest) ;
         ;
         need_use_pass_through = FALSE
         CASE close_br == 0 && A.Source != NONE ? RESULT =_ " := " ;
    [A.Dest.Operation == 'CONST' && A.Dest.Var_arg.Constant_value == "NONE" 
     && A.Source != NONE && A.Source.Operation != 'FUN'] ?
         STR dumm|_y_var = "set_none_" type_gen(A.Source.Type_expr, 
         	{type_options}(Array=FALSE, Fixed=FALSE, Weak=FALSE))
         CASE A.Source.Type_expr.Kind IN ['CLASS', 'STRUCTURE'] ?
              RESULT =_ spaces "Object_assign_hard(set_none_obj, "
              close_br += 1
         ELSE RESULT =_ spaces dumm " := " ;
         BOOL left_NONE = TRUE 
    ELSE RESULT =_ spaces
    	 BOOL no_left|_side = TRUE 
    ;
    ------------------------ 'assign right side'
    CASE A.Source != NONE ?
         PUSH A.Dest :
              {Var} temp_obj_v|ariable = NONE
        	  CASE left_NONE && A.Source.Operation == 'NEW_OBJ' ?
        	       STR var_type
        	       ------------------ 'create_temp_var', REUSED
        	       total_t += 1
        	       
                   temp_obj_v = {Var}(Line= 0,
                  	 Type_= A.Source.Type_expr,
                  	 Names[] << "temp_obj_param" total_t.S),
                  	 >> Comp.Current_fun.Local_var[]
                  	 
                   temp_obj_v.Set_final_name("temp_obj_param" total_t.S)
                   var_type = "Ref_obj{NoneObjInit_" 
                   var_type =_ A.Source.Type_expr.Final_name "}" 
                   
                   declare_local_var("temp_obj_param" total_t.S,
                  	 var_type, FALSE)
                   ------------------	 
                   RESULT = spaces temp_obj_v.Final_name " := " 
                   -------------------------- 'smaller_close_br', REUSED
                   CASE close_br > 0 ? close_br -= 1 ;
                   ----------------------------------------------
                   A.Dest = {Expr}(Operation = 'VAR', Var_arg= temp_obj_v)
        	  ;
	          CASE ?
	          [A.Source.Var_arg != NONE && (A.Source.Var_arg == Comp.NONE_c
	           || A.Source.Var_arg.Constant_value == "NONE")] ?
	               RESULT =_ gen_none_val(A.Dest.Type_expr)
	          [RESULT.Ending("{s}")] ?
	               RESULT =_ "Ref_obj("
	               STR aa|ssigned_value = gen_expr(A.Source).Remove_br
	               CASE A.Source.Type_expr.Final_name[0] == "s" ? 
	                    RESULT =_ "@"
	                     
	               ELSE aa ="Structure_any"  //A.Source.Type_expr.Final_name 
	               		"(" aa ".Obj).Clone()"
	               ;
	               RESULT =_ aa ")"
	          ELSE 
	          	   STR r|ight_side_expression = gen_expr(A.Source).Remove_br
	        	   CASE ?
	        	   [no_left && A.Source.Type_expr.Kind == 'CLASS'
	        	    && temp_obj_v == NONE] ?
        	           LIKE ...... 'create_temp_var'
        	       	   RESULT = spaces temp_obj_v.Final_name " := "
        	       	   LIKE ...... 'smaller_close_br'
	                   RESULT = spaces temp_obj_v.Final_name " := " r ";"
	                   post[] << spaces temp_obj_v.Final_name ".Ref_dec_hard();"
	                    
	        	   [no_left && A.Source.Type_expr.Kind == 'CLASS'] ?
	                   RESULT = spaces temp_obj_v.Final_name " := " r ";"
	                   post[] << spaces temp_obj_v.Final_name ".Ref_dec_hard();"
	                    
	        	   [dest_type.Kind == 'STRUCTURE' 
	        	    && RESULT.[*-1 TO *] == ", " && r.[*] == "^"] ?
	        	        RESULT =_ "Ref_obj(" r.[0 TO *-1] ")"
	        	        
	        	   [dest_type.Kind == 'STRUCTURE' 
	        	    && RESULT.[*-1 TO *] == ", " && r.[0 TO 2] != "St_"] ?
        	    	    LIKE ........ 'create_temp_var',
        	            BUT (var_type, ==> dest_type.Final_name, )
	        	    	STR a1|_to_temp = spaces temp_obj_v.Final_name ":=" r ";"
	        	    	a1 =_ " // " dest_type.Final_name
	        	    	RESULT = a1 #NL RESULT "Ref_obj(@" temp_obj_v.Final_name ")"
	        	        
	        	   [FPC && A.Dest.Var_arg.Type_.Kind == 'STR'
	        	    && A.Dest.Var_arg.Final_name != "RESULT"] ?
	                    RESULT = RESULT.TrimR.Remove_ending(":=").TrimR
	                    CASE A.Source.Var_arg != NONE
	                         && !A.Source.Var_arg.Is_const
	                         && A.Source.Var_arg.Final_name != "RESULT"
	                         ?
	                         RESULT =_ ".Assign_str(" r ")"
	                    ELSE RESULT =_ ".Assign_string(" r ")" ;
	                 
	        	   [r == "THIS.hard_link"] ? RESULT =_ "THIS"
	        	       
	        	   ELSE RESULT =_ r ; 
	          ;
	          CASE close_br != 0 ? RESULT =_ ")" ;
	          close_br = 0
	          RESULT =_ ";" finish_assign_object(A)
         ; 
    ;
    RESULT =_ ";"
    close_br = 0
    ---------------------- 'case of assigning new structure:'
    STR fin|ishing_operations = finish_assign_object(A)
    CASE fin != "" ? RESULT =_ #NL spaces fin ;
; .
    
METHOD gen_assignments
|_especial_for_structure_initialization
|_only_for_structures_implemented_as_RECORDs(
STR Prefix|_destination_variable, {Statement} Assign|ments_array[]) ==> STR,
	RECURSIVE
	:
	new_init = NONE
	FOR a IN Assign[] :
	    CASE ?
	    [a.{Assign}.Dest.Operation == 'FIELD'] ?
	         RESULT =_ #NL spaces Prefix "." a.{Assign}.Dest.Var_arg.Final_name 
	         RESULT =_ " := " gen_expr(a.{Assign}.Source) ";"
	         CASE new_init != NONE ?
	         	  PUSH spaces = spaces sp(4) :
		         	   RESULT =_ #NL gen_assignments(
		         		   Prefix "." a.{Assign}.Dest.Var_arg.Final_name, 
		         		   new_init.Assignments_[])
	         	  ;
	         ;
	         	
	    [a.{Assign}.Dest.Operation == 'INDEX'] ?
	         RESULT =_ #NL spaces Prefix 
	         RESULT =_ "." a.{Assign}.Dest.Arg1_.Var_arg.Final_name 
	         RESULT =_ "[" gen_expr(a.{Assign}.Dest.Arg2_) 
	         RESULT =_ "] := " gen_expr(a.{Assign}.Source)
	         	
	    [a.{Assign}.Dest.Operation == 'VAR'] ? // temporary variable assign __ extr...
	    	 {Var} v_dest|ination_var = a.{Assign}.Dest.Var_arg
	    	 CASE v_dest.Replace_to_ != NONE ? v_dest = v_dest.Replace_to_ ;
	    	  
	         RESULT =_ #NL spaces v_dest.Final_name 
	         RESULT =_ " := " gen_expr(a.{Assign}.Source) ";"
	         	
	    ELSE RESULT =_ #NL spaces "**CAN NOT ASSIGN DESTINATION** "
	    	 RESULT =_ "Operation=" a.{Assign}.Dest.Operation.Name
	    ;
	; .

    
FUNCTION reduce_hardlink_obj(
	STR S|tring_to_reduce) ==> STR
	:
	RESULT = S.Remove_ending(".hard_link.Obj") . 
    
{Var} do_not_release|_arrays_assigned_inline_parameters[]
        
 METHOD gen_obj_expr(
 	{Expr} E|xpression, {Type} T|ype_of_object) ==> STR
 	:
     ------------------------------------ 'NONE'
     CASE E.Var_arg == Comp.NONE_c ?
          RESULT = gen_none_val(T)
     ------------------------------------ 'not NONE'
     ELSE RESULT = gen_expr(E) ; 
     ------------------------------------ '{new object}(), OWNED BY'
     CASE E.Owned_ != NONE ?
          RESULT =_ ".Owned_by(" gen_expr(E.Owned_) ")" ; .
    
    
    
 METHOD finish_assign_object({Assign} A|ssignment) ==> STR :
    ------------------------ 'assign of new obj, init its fields'
    CASE new_init != NONE ?
         {Type} t|ype_object = new_init.Type_expr
         CASE t.Kind == 'STRUCTURE' && t.Final_name[0] == "s" ? NONE
         ELSE RESULT =_ #NL gen_init_new_obj(A)
         	  CASE A.Dest != NONE && A.Source.Operation != 'FUN' ?
         	       STR call|_construct = gen_call_construct(t, gen_expr(A.Dest))
         	  ;
         	  CASE call != "" ? RESULT =_ #NL spaces call ;
         ;
    ;
    ------------------------ ', >> array[]'
    CASE A.Source.Array_ != NONE ?
         RESULT =_ #NL spaces 
         RESULT =_ gen_expr(A.Source.Array_)
         RESULT =_ ".Add(MAXINT, " gen_expr(A.Dest) ");" ; .


FUN gen_call_construct({Type} C|lass_constructing_obj,
    STR Th|is_obj) ==> STR
    :
    ------------------------------------ 'Calling a constructor of a class'
    {Type} cf|un_class = C
    FOR i|dummy IN [0 TO MAX_INT-1] :
        CASE cf == NONE ? BREAK i ;
        CASE cf.Construct != NONE ?
            RESULT = "(" cf.Final_name "(" Th
            CASE Th != "THIS" ? RESULT = (RESULT ".Obj").reduce_hardlink_obj ;
            RESULT =_ "))." cf.Construct.Final_name "();" ==> ;
        cf = cf.Base_
    ; .


TODO: "Generate calling TRAP for write on a field initialization when an object"
	  " is created" .

METHOD gen_init_new_obj({Assign} A|ssignment) ==> STR :
    {Expr} init_expr = new_init
    new_init = NONE
    FOR a IN init_expr.Assignments_[] :
        {Assign} aa|ssign_a = a.{Assign}
        CASE aa.Dest.Operation ?
            ['FIELD']:
                PUSH aa.Dest.Arg1_ = A.Dest :
                     RESULT =_ #NL generate_assign_or_append(aa) ;
            ['UNKNOWN']:
        		CASE aa.Source.Operation == 'FUN' ?
        		     PUSH aa.Source.This_ = A.Dest :
                     	  RESULT =_ #NL generate_assign(aa) ; 
        		ELSE  RESULT =_ #NL generate_assign(aa) ; 
            ['INDEX']:
                CASE aa.Dest.Arg1_.Operation == 'FIELD' ?
                     PUSH aa.Dest.Arg1_.Arg1_ = A.Dest :
                          RESULT =_ #NL generate_assign_or_append(aa) ;
                          
                ELSE Comp.Error("Init indexed"._Einit
                     " " aa.Dest.Arg1_.Operation.Name "?")
                ;
            ['VAR']:
                PUSH init_expr = NONE :
                     RESULT =_ #NL generate_assign_or_append(aa) ;
                     
            ['BINARY', 'FUN', 'BASE_FUN', 'SYSTEM_FUN', 'NEW_OBJ', 'ARRAY', 
             'AS', 'CONSTANT', 'INT2REAL', 'NOT_B', 'NOT', 'NEG']:
                Comp.Error("Unknown init of"._Eunk " "
                "" aa.Dest.Operation.Name) ;
    ; .



METHOD generate_assign_or_append(
	{Assign} A|ssign_or_append) ==> STR
	:
    CASE A.Work ?
        ['ASSIGN']: RESULT = generate_assign(A)
        
        ['APPEND']: RESULT = generate_append(A)
        
        ['OUTPUT', 'INPUT', 'BREAK', 'NEXT', 'CONTINUE', 'RETURN', 'CASE',
         'ELSE', 'FOR', 'PUSH', 'STOP', 'ASSERT', 'LIMIT', 'LOCAL',
         'COMMENT', 'DEBUG', 'CALL_NATIVE']:
           Comp.Error("Invalid  field initialization operation"._Einvalid ) ; .


METHOD generate_append({Assign} A|ppend_stmt) ==> STR :
    PUSH is_left_side = TRUE : STR left|_side = gen_expr(A.Dest) ;
    CASE A.Dest.Is_array ?
         RESULT =_ spaces left ".Add"
         CASE A.Dest.Type_expr.Kind == 'STRUCTURE' ?
              BOOL simple_record = A.Dest.Type_expr.Final_name[0] == "s"
              CASE simple_record ?
              	   RESULT =_ "_record"
              ELSE RESULT =_ "_noincref"
              	   BOOL need_clone = TRUE ;
         ;
         RESULT =_ "(MAXINT, "
          
         CASE ?
         [simple_record] ?
         	  STR a|dding_value = gen_expr(A.Source).Remove_br
         [A.Source.Var_arg == Comp.NONE_c] ?
              a = gen_none_val(A.Dest.Type_expr)
              need_clone = FALSE
         ELSE a = gen_expr(A.Source).Remove_br ;
         STR right|_assigned_value = a
         CASE ?
         [A.Dest.Type_expr.Kind == 'BOOL'] ? a = "Byte(" a ")" 
         [need_clone] ? a = "Structure_any(" a ".Obj).Clone()" ;
         RESULT =_ a ");"
         
         CASE !simple_record && A.Source.Operation == 'VAR' 
         	  && A.Source.Var_arg.Names[0].Starting("_extr")
         	  ?
         	  CASE simple_record ? 
         	       RESULT =_ #NL spaces right " := " 
         	       RESULT =_ gen_none_val(A.Dest.Type_expr) ";"
         	  ELSE RESULT =_ #NL spaces "Object_assign_hard(" right ", "
         	  
         	  	   RESULT =_ gen_none_val(A.Dest.Type_expr).Remove_ending(
         	  	   			 ".hard_link") ");"
         	  ;
         ;
              
    ELSE
    	 CASE ?
    	 [close_br != 0] ?
    	      RESULT = spaces left
    	      PUSH is_left_side = FALSE :
    	           RESULT =_ gen_expr(A.Dest) 
    	           " + " gen_expr(A.Source).Remove_br ");"
    	      ;
    	      close_br = 0
    	      
         [FPC && A.Dest.Var_arg.Type_.Kind == 'STR'
          && A.Dest.Var_arg.Final_name != "RESULT"] ?
             RESULT = spaces left
             RESULT =_ ".Append_string(" gen_expr(A.Source).Remove_br ");"
             
    	 ELSE RESULT = spaces left " := " left " + " 
    	 	  RESULT =_ gen_expr(A.Source).Remove_br ";" 
    	 ;
    ; .



METHOD generate_output({Assign} A|_output) :
	STR out|_what = gen_expr(A.Source).Remove_br
	 im[] << spaces "AL4Write(" out ");" .

INT input_total|_index

METHOD generate_input({Assign} A|_input_stmt) :
    CASE A.Dest == NONE ?
         im[] << spaces "ReadLine;" ==> ;
    CASE A.Dest.Type_expr.Kind == 'STR' ?
         STR d|estination = gen_expr(A.Dest)
         CASE FPC && A.Dest.Var_arg.Final_name != "RESULT" 
              && A.Dest.Var_arg.Type_.Kind == 'STR'
              ?
              im[] << spaces d ".Assign_string(ReadLine);"
         ELSE im[] << spaces d ":= ReadLine;" ;
         ==> ;
    STR temp|_name = "tmpin_" input_total.Str
    input_total += 1
    --------------------------------------------------------
    Comp.Error("Reading to non-string is not implemented!")
    im[] << spaces "string " temp ";"
    im[] << spaces "Readln(" temp ");"
    PUSH is_left_side = TRUE : im[] << spaces gen_expr(A.Dest) ;
    im[*] =_ " = Safe_convert(" temp ");" .

-------------------------------- 'clear these arrays after correspondent PUSHes'
{Assign} pushes_want_br|eak_stmt[]
{For} push_break_over[]
STR pushes_want_flag_br|eaks[]

{Assign} pushes_want_cont|inue_stmt[]
{For} push_continue_over[]
STR pushes_want_flag_cont|inues[]

INT total_push_flags


METHOD generate_break({For} Br|eak_stmt) :
	------------------------------------- 'find intersecting PUSHes', REUSED
	FOR st IN nesting_block[* DOWNTO 0] :
	    CASE st == Br.Loop_ ? BREAK st ;
	    CASE st.Work == 'PUSH' ? 
	         BOOL over_push = TRUE
	         total_push_flags += 1
			 STR name_fl|ag_variable = "want_brk_" total_push_flags.S 
			 .. =_ "_from_" st.Total_stmt.S
	         pushes_want_br[] << st.{Assign}
	         push_break_over[] << Br
	         pushes_want_flag_br[] << name_fl
	         STR set_flags[] << name_fl 
	    ;
	;
	-------------------------------------------------- 'simplest case'
	CASE !over_push ?
		 STR suff|ix_variable_name = Br.Loop_.Total_FOR.Str
		 CASE Br.Loop_.Inline_index != "" ?
		      suff =_ "_inline" Br.Loop_.Inline_index ;
	     im[] << spaces "goto Brk_" suff ";" ==> ;
	------------------------ 'PUSHes in between', REUSED     
	CASE set_flags[].Count == 1 ?
	     name_fl = set_flags[0]
		 declare_local_var(name_fl, "Boolean", FALSE)
		 im[] << spaces "begin " name_fl ":=true; goto "
		 im[*] =_ "end_push_" nesting_push[*].Total_stmt.Str "; end;" ==> ;
		 
	im[] << spaces "begin"
	FOR s IN set_flags[] :
	    declare_local_var(s, "Boolean", FALSE)
	    im[] << spaces "  " s ":=true;"  ;
	im[] << spaces "  goto end_push_" nesting_push[*].Total_stmt.Str ";"
	im[] << spaces "end;"
	-------------------- 
	.
	     


METHOD generate_cont({For} Cont|inue_stmt) :
	LIKE generate_break ............. 'find intersecting PUSHes',
		BUT (Br ==> Cont) * 2,
			(pushes_want_br ==> pushes_want_cont),
			(push_break_over ==> push_continue_over),
			(pushes_want_flag_br ==> pushes_want_flag_cont),
			(want_brk_ ==> want_cont_)
			
	CASE Cont.Work == 'NEXT' ? 
		 STR i|ndex_var = Cont.Loop_.Var.Final_name
		 CASE Cont.Loop_.Array != NONE ? i = Cont.Loop_.Index_var ;
	     im[] << spaces i " := " i
         CASE Cont.Loop_.Downto ? 
              im[*] =_ " - "
         ELSE im[*] =_ " + " ;
         im[*] << "imax(0, " gen_expr(Cont.By) "-1);"
	;
			
	CASE !over_push ? 
		 STR suff|ix_variable_name = Cont.Loop_.Total_FOR.Str
		 CASE Cont.Loop_.Inline_index != "" ?
		      suff =_ "_inline" Cont.Loop_.Inline_index ;
	     im[] << spaces "goto " Cont.Loop_.Continue_label ";" ==> ; 
	     
	LIKE generate_break ......... 'PUSHes in between' . 



METHOD generate_return({Case} Ret|urn_dummy) :
    CASE NOTRY_option && !current_fun_has_push || current_fun_has_intersect ?
         CASE nesting_push[].Count > 0 ?
              im[] << spaces "begin"
              im[] << spaces #TAB"want_exit := true;"
              
              im[] << spaces #TAB"goto end_push_" nesting_push[*].Total_stmt.Str
              					";"
              					
              im[] << spaces "end;"
         ELSE im[] << spaces "goto fin;" ;
    ELSE im[] << spaces "EXIT;" ; .
    
METHOD gen_temp_bool :
	FOR v IN Comp.Current_fun.Local_var[] :
	    CASE v.Final_name == "temp_bool_var" ? ==> ;
	;
	declare_local_var("temp_bool_var", "Boolean", FALSE) .

METHOD gen_temp_int :
	FOR v IN Comp.Current_fun.Local_var[] :
	    CASE v.Final_name == "temp_int_var" ? ==> ;
	;
	declare_local_var("temp_int_var", "Integer", FALSE) .

METHOD gen_temp_str :
	FOR v IN Comp.Current_fun.Local_var[] :
	    CASE v.Final_name == "temp_str_var" ? ==> ;
	;
	declare_local_var("temp_str_var", "String", FALSE) .


METHOD gen_sequential_case(
	{Case} Sw|itch_stmt,
	INT Index|_in_block_of_sw INDEXING {Statement}), RECURSIVE
	:
	CASE Sw.Block_[Index].Work != 'ELSE' ?
		 STR text_cond = gen_expr(Sw.Block_[Index].{Case}.Condition).Remove_br  
		 im[] << spaces "if " text_cond " then begin"
		 BOOL close_if = TRUE
		 CASE use_profiler.[0] IN "BA" && !FINAL_CODE ? 
              NONE = make_cnt(Sw.Block_[Index].Line)
         ;
	;
	generate_block(Sw.Block_[Index].{Case}.Block_[])
	CASE close_if ?
		 im[] << spaces "end" ;
	CASE Index >= Sw.Block_[].Count-1 ?
	     CASE close_if  ? im[*] =_ ";" ;
	     ==> ;
	im[] << spaces "else begin"
	PUSH line_current_statement = im[].Count :
		 PUSH spaces = spaces sp(4) :
		      gen_sequential_case(Sw, Index+1) ;
	;
	im[] << spaces "end;" .
	
INT unique_cnt|_index
	
METHOD make_cnt(INT Line|_cnt) ==> STR :
	unique_cnt += 1
	STR name|_cnt = Comp.Current_fun.Final_name "_Line" (Line+1).S
	name =_ "__" unique_cnt.S
	RESULT = name
	td[] << "var CNT_" name ":"
	CASE use_profiler != "" ?
		 td[*] =_ "{$IFDEF _D5orHigher}Int64{$ELSE}Integer{$ENDIF};"
	ELSE td[*] =_ "Integer;" ;
	im[] << spaces "incr(CNT_" name ");" .

METHOD gen_case({Case} Sw|itch_stmt) :
	CASE Sw.Block_[].Count == 0 ? ==> ;
    ------------------------------------- 'sequential ?'
    CASE Sw.Condition == NONE ?
         gen_sequential_case(Sw, 0) ==> ;
    ------------------------------------- 'by type of expression'
    CASE Sw.Condition.Type_expr.Kind ?
        ['BOOL']:
			STR cond|ition_expresion = gen_expr(Sw.Condition).Remove_br
            //CASE Sw.Condition.Type_expr.Kind=='BOOL' 
            //     && Sw.Condition.Operation !IN ['FUN', 'BASE_FUN', 'SYSTEM_FUN',
            //     'BINARY']
            //     && !(cond.[0]=="C" && cond.Starting("Compare_strings("))
            //     ? cond = "(" _ ") <> 0" ;
            CASE post[].Count > 0 ?
                 gen_temp_bool
                 im[] << spaces "temp_bool_var := " cond ";"
                 FOR s IN post[] : im[] << spaces s ;
			     post[].Clear 
			     cond = "temp_bool_var" ;
            im[] << spaces "if " cond " then begin"
            CASE Sw.Block_[0].Work != 'ELSE' ?
                 CASE use_profiler.[0] IN "BA" && !FINAL_CODE ? 
                      NONE = make_cnt(Sw.Block_[0].Line)
                 ;
                 generate_block(Sw.Block_[0].Block_[]) ;
            CASE Sw.Block_[*].Work == 'ELSE' ?
                 im[] << spaces "end else begin"
                 CASE use_profiler.[0] IN "BA" && !FINAL_CODE ? 
                      NONE = make_cnt(Sw.Block_[*].Line)
                 ;
                 generate_block(Sw.Block_[*].Block_[]) ;
        ['STR']:
            STR t|emp_index = total_case_index.Str
            total_case_index += 1
            CASE Sw.Inline_index != "" ? t =_ "_inline" Sw.Inline_index ;
            declare_local_var("tmp" t, "Integer", FALSE)
            declare_local_var("str" t, "String", FALSE)
            im[] << spaces "tmp" t " := -1;"
            cond = gen_expr(Sw.Condition) 
            im[] << spaces "str" t " := " cond ";"
            ------------------------------------ 'finalize from post[]'
            FOR s IN post[] : im[] << spaces s ;
            post[].Clear
            ------------------------------------ 'first case to calculate index'
            gen_calc_str_index(Sw, t)
            im[] << spaces "case tmp" t " of"
            FOR cas IN Sw.Block_[] :
                CASE cas.Work != 'ELSE' ?
                     im[] << spaces sp(4) cas.Index.Str ":"
                ELSE im[] << spaces sp(4) "else" ;
                im[] << spaces sp(4) "begin"
                CASE use_profiler.[0] IN "BA" && !FINAL_CODE ? 
                     NONE = make_cnt(cas.Line) ;
                PUSH spaces = spaces sp(8) :
                    generate_block(cas.Block_[]) ;
                im[] << spaces sp(4) "end;"
            ;
        ['ENUM', 'INT']:
        	cond = gen_expr(Sw.Condition)
        	CASE post[].Count > 0 ?
        	     gen_temp_int
        	     im[] << spaces "temp_int_var := " cond ";"
        	     FOR s IN post[] : im[] << spaces s ;
        	     post[].Clear
        	     cond = "temp_int_var" ;
            im[] << spaces "case " cond " of"
            gen_switch_int_enum_cases(Sw)
        ['REAL', 'CLASS', 'STRUCTURE']: NONE ;
    im[] << spaces "end;" .

INT local_var_index|_total
INT total_case_index

METHOD declare_local_var|iavle(
STR N|ame_of_var,
STR T|ype_of_var
	 |Pass_additionally_name_of_NONE_object_in_figure_brackets_of_Ref_obj,
BOOL Init|ialize_variable)
	:
	//DEBUG:
	//      BOOL is_t|emp_bool_var = N == "temp_bool_var" ;
    ----------------------------------- 'local variable is added to var section'
    FOR i IN [im[].Count-1 DOWNTO 0] :
        CASE im[i].Starting("begin") ?
             INT line_begin = i
             BREAK i ;
    ;
    FOR i IN [line_begin-1 DOWNTO 0] :
        CASE im[i].Starting("var " N ": " T ";") ? ==> ;
        CASE !im[i].Starting("var ") ? BREAK i ;
    ;
    CASE Init ?
    	 CASE T ?
    	 ["Boolean"]: STR v|alue_initial = "FALSE"
    	 ["Integer", "Double"]: v = "0"
    	 ["String"]: v = "''"
    	 ELSE v = T.[T.Find("{")+1 TO *-1] ".hard_link"
    	 ;
    	 CASE v != "" ?
         	  im[].Insert(line_begin+1, #TAB N " := " v ";") ;
    ;
    FOR line INDEXING STR IN [line_begin-1 DOWNTO 0] :
        //DEBUG:
        //      CASE is_t ?
        //      		<< "[[ " im[line] " ]]"#NL ;
        //;
        CASE !im[line].Starting("var ") && !im[line].Starting("label ") ?
             BREAK line ;
        CASE im[line].Starting("var " N ": " T ";") ? ==> ;
    ;
    im[].Insert(line_begin, "var " N ": " T ";"
             " // local var: " local_var_index.Str)
    //DEBUG: 
    //      CASE is_t ?
    //      		<< "insert[[ " im[line_begin] " ]]" #NL ;
    //;
             
    local_var_index += 1 .

METHOD declare_local_const(
STR N|ame_of_var,
STR T|ype_of_var
	 |Pass_additionally_name_of_NONE_object_in_figure_brackets_of_Ref_obj,
STR Init|ialization_value)
	:
	//DEBUG:
	//      BOOL is_t|emp_bool_var = N == "temp_bool_var" ;
    ----------------------------------- 'local variable is added to var section'
    FOR i IN [im[].Count-1 DOWNTO 0] :
        CASE im[i].Starting("begin") ?
             INT line_begin = i
             BREAK i ;
    ;
    FOR i IN [line_begin-1 DOWNTO 0] :
        CASE im[i].Starting("const " N ":") ? ==> ;
        CASE !im[i].Starting("var ") ? BREAK i ;
    ;
    FOR line INDEXING STR IN [line_begin-1 DOWNTO 0] :
        //DEBUG:
        //      CASE is_t ?
        //      		<< "[[ " im[line] " ]]"#NL ;
        //;
        CASE !im[line].Starting("var ") && !im[line].Starting("label ") ?
             BREAK line ;
        CASE im[line].Starting("const " N ":") ? ==> ;
    ;
    im[].Insert(line_begin, "const " N ": " T "=" Init ";") .

METHOD declare_label(STR L|abel_identifier) :
    FOR i IN [im[].Count-1 DOWNTO 0] :
        CASE im[i].Starting("begin") ?
             im[].Insert(i, "label " L ";") ==> ;
    ; .


INT total_case|_count

METHOD gen_calc_str_index(
{Case} Sw|itch_by_str, STR T|emp_index)
    :
    im[] << spaces "case ((str" T " + #0)["
    im[*] =_ "1"
    im[*] =_ "]) of"
    STR all_s|trings[]
    INT all_i|ndexes[]
    FOR cas IN Sw.Block_[] :
        FOR val IN cas.{Case}.Values[] :
            all_s[] << val.Str_c
            all_i[] << cas.Index ;
    ;
    FOR s IN all_s[] :
        CASE all_i[s.Index] < 0 ? CONTINUE s ;
        im[] << spaces
        CASE FPC ?
             BYTE buf|fer_utf8[]
        	 Bytes_from_utf8(buf[], s.[0]) ;
        CASE !FPC || s.Ord < 128 ?
        	 im[*] =_ s.as_char
        ELSE im[*] =_ "char(" buf[0].Int.Str ")" ; 
        im[*] =_ ": // case " total_case.Str
        total_case += 1
        
        im[] << spaces sp(4) "if (str" T " = " s.as_str.Remove_br ") "
        CASE s == #0 ? im[*] =_ " or (str" T "= '') " ;
        im[*] =_ "then tmp" T " := " all_i[s.Index].Str
            
        FOR i INDEXING (INT,STR) IN [s.Index+1 TO all_s[].Count-1] :
            //DEBUG: << "Line=" Sw.Line.Str (FPC.Str)[0]
            //	" s=[" s "], s[0].Ord&0xFF=" (s.Ord).Str
            //	" all_s[i].Ord&0xFF=[" all_s[i] "]=" (all_s[i].Ord).Str #NL ;
            CASE !FPC && s.[0] != all_s[i].[0] ? CONTINUE i ;
            CASE FPC ?
	             BYTE buf2|fer_utf_8[]
	             Bytes_from_utf8(buf2[], all_s[i].[0]) ;
            //DEBUG: << " buf[0]=" buf[0].Str " buf2[0]=" buf2[0].Str #NL ;
            CASE FPC && buf[0] != buf2[0] ? CONTINUE i
            //ELSE
                 //DEBUG: << "s=[" s "], s[0].Ord&0xFF=" 
                 //"" buf[0].Str
                 //" all_s[i].Ord&0xFF=" buf2[0].Str 
                 //#NL ; 
            ;
            //DEBUG: << "[" all_s[i].as_str "]" #NL ;
            
            im[] << spaces sp(4) "else if (str" T " = " all_s[i].as_str ") "
            CASE all_s[i] == #0 ? im[*] =_ " or (str" T " = '') " ;
            im[*] =_ "then tmp" T " := " all_i[i].Str
                   
            all_i[i] = -1 ;
        im[] << spaces sp(4) ";" ;
    im[] << spaces "end;" .



METHOD gen_switch_int_enum_cases({Case} Sw|itch_stmt) :
    FOR cas IN Sw.Block_[] :
        {Case} c|ase_of_switch = cas.{Case}
        CASE c.Work == 'CASE' && c.Values[].Count > 0 ?
             im[] << spaces sp(4)
             FOR v IN cas.{Case}.Values[] :
                 im[*] =_ v.Int_c.Str "," ;
             im[*] = im[*].[0 TO *-1] ":" ;
        CASE c.Work == 'CASE' && c.Values[].Count == 0 ?
             im[] << spaces sp(4)
             
             FOR r IN [c.Range1.Var_arg.Int_c TO (
                       c.Range2.Var_arg.Int_c)] :
                 
                 im[*] =_ r.Str "," ;
             im[*] = im[*].[0 TO *-1] ":" ;
        CASE cas.Work == 'ELSE' ?
             im[] << spaces sp(4) "else " ;
        im[] << spaces sp(4) "begin"
        CASE use_profiler.[0] IN "BA" && !FINAL_CODE ? 
             NONE = make_cnt(cas.Line)
        ;
        PUSH spaces = spaces sp(8) :
             generate_block(cas.Block_[]) ;
        im[] << spaces sp(4) "end;"
    ; .



FUNCTION as_char|acter(STR S|tr_where_from) ==> STR :
    CASE S == "" ? RESULT = "Char(0)" ==> ;
    CASE S.[0].Ord < " ".Ord || S.[0] IN [ #QU, "\", "'" ] ? //|| S[0].Ord > 255 ?
        RESULT = "Char(" S.[0].Ord.Str ")" ==> ;
    RESULT = "'" S.[0] "'" .



FUNCTION as_str|ing(STR S|tr_where_from) ==> STR :
    RESULT = "'"
    BOOL in_str|ing = TRUE
    INT  len|gth_string_literal = 0
    FOR i IN [0 TO S.Len-1] :
        CASE S.[i].Ord < " ".Ord ?
             CASE in_str ?
                  in_str = FALSE
                  RESULT =_ "'"
                  len = 0 ;
             RESULT =_ " + Char(" S.[i].Ord.Str ")"
        ELSE 
             CASE !in_str ?
                  in_str = TRUE
                  RESULT =_ " + '"
                  len = 0 ;
             RESULT =_ S.[i]
             len += 1
             CASE S.[i] == "'" ? RESULT =_ "'" ;
        ;
        CASE len >= 100 && in_str ?
             RESULT =_ "'"
             len = 0
             in_str = FALSE ;
    ;
    CASE in_str ? RESULT =_ "'" ;
    CASE "+" IN RESULT ? RESULT = "(" RESULT ")" ; .

INT total_lim|it_statements
	
METHOD gen_limit({Limit} Lim|it_statement) :
    total_lim += 1
	STR tl|_variable = "limit_st" total_lim.S
	declare_local_var(tl, "Integer", FALSE)
    im[] << spaces tl " := AL4.limit_by_"
    CASE Lim.By_what ? 
    ['TIME']: im[*] =_ "time"
    ['FUNC']: im[*] =_ "func"
    ['LOOPS']: im[*] =_ "loop" ;
	im[*] =_ "(" gen_expr(Lim.Condition)
	CASE Lim.By_what == 'TIME' ? 
	     im[*] =_ ", " 
	     CASE Lim.Units ? 
	     ['MILLISEC']: im[*] =_ "0"
	     ['SEC']: im[*] =_ "1"
	     ['MIN']: im[*] =_ "2"
	     ['HOUR']: im[*] =_ "3"
	     ['DAYS']: im[*] =_ "4" ;
	;
	im[*] =_ ");"
	-------------------- 'block of code in LIMIT'
	im[] << spaces "try"
	PUSH spaces = spaces #TAB :
	     im[] << spaces "try"
	     PUSH spaces = spaces #TAB :
	          generate_block(Lim.Block_[]) ;
	     im[] << spaces "except on eL: E_Limit_exceeded do begin "
	     im[] << spaces #TAB "if eL.id <> " tl " then raise;"
	     im[] << spaces #TAB "end;"
	     im[] << spaces "end;"
	;
	im[] << spaces "finally"
	im[] << spaces #TAB "AL4.dismiss_limit(" tl ");"
	im[] << spaces "end;" .

METHOD gen_local||generate_local(
{Local} Loc|al_statement)
    :
	-------------------- 'block of code in LIMIT'
	im[] << spaces "begin"
	PUSH spaces = spaces "    " :
		 INT line_begin = im[].Count     
		 init_local_vars(current_function_gen, Loc)
		 BOOL need_try = im[].Count > line_begin
		 CASE need_try ? 
		      im[] << spaces "try" ;
		 PUSH spaces = spaces #TAB :
		      im[] << spaces "begin"
		      PUSH spaces = spaces #TAB :
		     	   init_local_vars(current_function_gen, Loc)
		           generate_block(Loc.Block_[]) ;
	          im[] << spaces "end;"
		 ;
		 CASE need_try ? 
		      im[] << spaces "finally"
		      {Var} dumm_vars[]
		      {kind_type} dumm_kinds[]
		      free_local_vars(current_function_gen, Loc, dumm_vars[], 
		     	 kinds= dumm_kinds[])
		     	 
	     	  im[] << spaces "end;"
		 ;
	;
    im[] << spaces "end;"
	.


{For} nesting_for|_statements[]
INT total_for|_index
BOOL list_temps_used|_so_on_each_step_call_clear_list_temps

{Statement} nesting_block[]
INT local_const_total|_count

METHOD generate_for({For} F|or_loop) :
	F.Total_FOR  = total_for
    STR suf|fix_for_vars = "_" F.Total_FOR.Str
    total_for += 1
    CASE F.Inline_index != "" ?
         suf =_ "_inline" F.Inline_index ;
    {Var} var|_of_FOR = F.Var
    CASE var.Replaced ? var = var.Replace_to_ ;
    STR v|ar_loop_name = var.Final_name
PUSH list_temps_used = FALSE :
    nesting_for[] << F
    nesting_block[] << F
    CASE F.Unroll && "U" IN Comp.Optimizations ?
         unroll_for(F, v, suf) ==> ;
    CASE ?
    [F.Infinite] ?
            BOOL inf|initive = TRUE
            im[] << spaces "while true do begin"
            
    [F.Range1 != NONE] ?
         declare_local_var("from" suf, "Integer", FALSE)
         declare_local_var("to" suf, "Integer", FALSE)
         ----------------------------------- 'from'
         im[] << spaces "from" suf " := "
         CASE ?
         [F.Array.Operation == 'CONSTANT'] ?
         	  im[*] =_ gen_expr(F.Range1).Remove_br ";"
         [F.Array != NONE && F.Downto] ?
              STR high|_value = gen_expr(F.Array)
              CASE F.Array.Var_arg.Names[0] == "DATA" ?
                   high = "High(" high ")"
              ELSE high =_ ".Count() - 1" ; 
              im[*] =_ min_max("imin", gen_expr(F.Range1).Remove_br, high) ";"
         [F.Array != NONE] ?
              im[*] =_ min_max("imax", gen_expr(F.Range1).Remove_br, "0") ";"
         ELSE STR temp_range_1 = gen_expr(F.Range1).Remove_br 
         	  im[*] =_ temp_range_1 ";" ;
    	 ----------------------------------- 'to'
         im[] << spaces "to" suf " := "
         CASE ?
         [F.Array.Operation == 'CONSTANT'] ?
              im[*] =_ gen_expr(F.Range2).Remove_br ";"
         [F.Array != NONE && F.Downto] ?
              im[*] =_ min_max("imax", gen_expr(F.Range2).Remove_br, "0") ";"
         [F.Array != NONE] ?
              high = gen_expr(F.Array)
              CASE F.Array.Var_arg.Names[0] == "DATA"
                   || F.Array.Is_fixed && !F.Array.Var_arg.Is_param
                   ?
                   high = "High(" high ")"
              ELSE high =_ ".Count() - 1" ;
              im[*] =_ min_max("imin", gen_expr(F.Range2).Remove_br, high) ";"
         ELSE STR temp_range_2 = gen_expr(F.Range2).Remove_br 
         	  im[*] =_ temp_range_2 ";" ;
         ----------------------------------- 'header'
         CASE ?
         [F.Array != NONE || F.Has_next] ?
              ------------------------- 'index variable'
              CASE F.Array != NONE ? 
	               STR i|ndex_var = "idx" suf
		    	   F.Index_var = i
		           declare_local_var(i, "Integer", FALSE)
		           declare_local_var("count" suf, "Integer", FALSE)
              ELSE i = v ;
	          CASE F.Has_next ?
	          ---------------------- 'i := ...; WHILE i </> ... do begin'
	          	   im[] << spaces i " := from" suf
	          	   CASE F.Downto ? im[*] = _ "+1;" 
	          	   ELSE im[*] = _ "-1;" ;
	          	   im[] << spaces "while true do begin"
	          	   ------------------ 'cont:'
	          	   F.Continue_label = "cont" suf
	          	   declare_label(F.Continue_label)
	          	   im[] << spaces F.Continue_label ": "
	          	   CASE F.Downto ? im[*] = _ "dec(" i ");" 
	          	   ELSE im[*] = _ "inc(" i ");" ;
	          	   ------------------ 'continue?'
	          	   im[] << spaces "if " i
	          	   CASE F.Downto ? 
	          	        im[*] = _ " < to" suf " then goto Brk" suf ";"
	          	   ELSE im[*] = _ " > to" suf " then goto Brk" suf ";" 
	          	   ;
	          ELSE
	          ---------------------- 'for i := ... TO/DOWNTO ... do begin'
		           im[] << spaces "for " i " := from" suf
		           CASE F.Downto ? im[*] =_ " DOWNTO "
		           ELSE im[*] =_ " TO " ;
		           im[*] =_ " to" suf " do begin"
		           STR dot|_when_not_data = ".Get"
	          ;
         ELSE 
	          CASE F.Downto ?
	               im[] << spaces "for " v
	               //DEBUG: o[*] << "{" F.Var.Total_i.Str 
	               //		 CASE F.Var.Total_i != var.Total_i ? 
	               //		      o[*] << "/" var.Total_i.Str ;
	               //		 o[*] << "}" ;
	               im[*] =_ " := from" suf
	                      " downto to" suf " do begin"
	                      
	          ELSE im[] << spaces "for " v 
	               //DEBUG: o[*] << "{" F.Var.Total_i.Str 
	               //		 CASE F.Var.Total_i != var.Total_i ? 
	               //		      o[*] << "/" var.Total_i.Str ;
	               //		 o[*] << "}" ;
	         	   im[*] =_ " := from" suf
	                      " to to" suf " do begin" ;
         ;
                     
    ELSE i = "idx" suf
    	 F.Index_var = i
         declare_local_var(i, "Integer", FALSE)
         declare_local_var("count" suf, "Integer", FALSE)
         ---------------------------------------- 'count of items in array'
         im[] << spaces "count" suf " := "
         dot = ".Get"
         CASE ?
         [F.Array.Operation == 'CONSTANT'] ?
              im[*] =_ F.Array.Var_arg.Items_[].Count.S ";"
         [F.Array.Var_arg.Names[0] == "DATA"] ?
              dot = ""
              im[*] =_ "LENGTH(" F.Array.Var_arg.Final_name ");"
         [F.Array.Var_arg.Is_fixed
          && F.Array.Var_arg.In_type_.Kind == 'STRUCTURE'] ?
              dot = ""
              im[*] =_ "LENGTH(" gen_expr(F.Array) ");"
         ELSE im[*] =_ gen_expr(F.Array) ".Count();" ;
         CASE F.Has_next ? 
         ---------------------------------------- 'while'
         	  im[] << spaces i " := -1;"
         	  im[] << spaces "while true do begin"
         	  F.Continue_label = "cont" suf
	          declare_label(F.Continue_label)
	          im[] << spaces F.Continue_label ": inc(" i ");"
         	  im[] << spaces "if " i " >= count" suf " then goto Brk" suf ";" 
         ELSE
         ---------------------------------------- 'for header'
	          im[] << spaces "for " i 
	          im[*] =_ " := 0 to count" suf "-1 do begin"
         ;
    ;
    CASE use_profiler.[0] IN "LA" && !FINAL_CODE ? 
    	 NONE = make_cnt(F.Line)
    ;
    CASE F.Array != NONE ?
         CASE ?
         [F.Array.Operation == 'CONSTANT'] ?
             local_const_total += 1
             FOR ii IN [0 TO F.Array.Var_arg.Items_[].Count-1] :
                 STR init_nlc =_ #NL sp(8) gen_const_value(
             			 F.Array.Var_arg.Items_[ii])
                 
                 CASE ii < F.Array.Var_arg.Items_[].Count-1 ? 
                      init_nlc =_ "," ;
             ;
             STR nlc|_name_local_const = "for_array_" local_const_total.S
             
             declare_local_const(nlc, "array [0.." 
             	"" (F.Array.Var_arg.Items_[].Count-1).S "] of " 
             	"" (type_gen(F.Array.Type_expr, {type_options}()) 
             		" ").Replace("Str ", "String "), 
             	"(" init_nlc ")")
             	
             STR t_a|rray_items_type = F.Array.Var_arg.Type_.Names[0]
             CASE FPC ?  t_a = (t_a " ").Replace("STR ", "String_Str ") 
             ELSE t_a = (t_a " ").Replace("STR ", "String ") ;
             CASE ?
             [F.Array.Type_expr.Kind == 'STR' && FPC] ?
             	  im[] << spaces sp(4) v ":= Array_item_String_Str(@" nlc "[0], "
             	  "" F.Array.Var_arg.Items_[].Count.S ", " i ");"
             [F.Array.Type_expr.Kind == 'STR'] ?
             	  im[] << spaces sp(4) v ":= Array_item_String(@" nlc "[0], "
             	  "" F.Array.Var_arg.Items_[].Count.S ", " i ");"
             [F.Array.Type_expr.Kind IN ['ENUM', 'BOOL']] ?
             	  im[] << spaces sp(4) v ":= Array_item_byte(@" nlc "[0], "
             	  "" F.Array.Var_arg.Items_[].Count.S ", " i ");"
             ELSE im[] << spaces sp(4) v ":= Array_item_" t_a "(@" nlc "[0], "
             	  im[*] =_ F.Array.Var_arg.Items_[].Count.S ", " i ");"
             ;
         [F.Array.Var_arg.Names[0] == "DATA"] ?
             CASE FPC ? im[] << spaces sp(4) v ".Assign_PChar("
             	  im[*] =_ F.Array.Var_arg.Final_name "[" i "]);"
             ELSE im[] << spaces sp(4) v " := " 
             	  im[*] =_ F.Array.Var_arg.Final_name "[" i "];" ;
         [F.Array.Type_expr.Kind == 'STRUCTURE' 
          && F.Array.Type_expr.Final_name[0] == "s"] ?
              im[] << spaces sp(4) v " := P" F.Array.Type_expr.Final_name
              		 "(" gen_expr(F.Array) ".GetObjects(" i "))^;"
         [F.Array.Var_arg.Is_fixed
          && F.Array.Var_arg.In_type_.Kind == 'STRUCTURE'] ?
              im[] << spaces sp(4) v " := " gen_expr(F.Array) "[" i "];"
         ELSE    
	          CASE F.Array.Type_expr.Kind ?
	          ['CLASS', 'STRUCTURE']:
	               im[] << spaces sp(4) "Object_assign_hard(" v 
	               ", " gen_expr(F.Array) ".GetObjects(" i ").Obj);"
	               
	          ['BOOL', 'INT', 'ENUM', 'REAL']:
	               im[] << spaces sp(4) v " := " gen_expr(F.Array) 
	               "" dot items_name(F.Array) "(" i ");"
	                    
	          ['STR']:
	              CASE FPC && var.Type_.Kind == 'STR' 
	                   &&  var.Final_name != "RESULT"
	                   ?
	                   im[] << spaces sp(4) v ".Assign_string(" 
	                   "" gen_expr(F.Array) dot items_name(F.Array) 
	                   "(" i "));"        
	                   
	              ELSE im[] << spaces sp(4) v " := " gen_expr(F.Array) 
	               	   "" dot items_name(F.Array) "(" i ");"
	              ; 
	          ;
         ;
    ;
    ------------------------------------ 'LIMIT LOOPS present'
    CASE Comp.Has_LIMIT_LOOPS ? 
         im[] << spaces sp(4) "inc(AL4.total_loops);" ;
    ------------------------------------ 'do not stop response'
    CASE "$NOLONGOP" !IN Comp.Defined_name[] ?
         CASE !warning_nolongop ?
              warning_nolongop = TRUE
              
              << "Option $NOLONGOP is not set: checking for long operations "
              	 "is provided"._MOptionNolongop #NL
         ;
	     im[] << spaces sp(4) "inc(global_activity_counter);"
	     im[] << spaces sp(4) "if global_activity_counter > 65535 then"
	     im[] << spaces sp(8) "check_long_operation;"
	     //DEBUG: << ">" ; 
    ;
    ------------------------------------ 'body of for'
    INT first_line|_of_for_block_code INDEXING STR = im[].Count
    im[] << "//***"
    F.Continue_label = "Cont" suf
    generate_block(F.Block_[])
    ---------------------- 'call clear_list_temps if necessary, on each pass'
    FOR j IN [first_line TO im[].Count-1] :
        CASE im[j] == "//***" ? first_line = j
        						BREAK j ;
    ;
    //CASE list_temps_used ?
    //     im[].Insert(first_line, spaces "clear_list_temps(List_temps);")
    //     first_line += 1 ;
    CASE im[first_line] == "//***" ? im[].Delete(first_line) ;
	---------------------- 'ending the for loop'
    CASE !inf && F.Continued && !F.Has_next ?
         declare_label(F.Continue_label)
         im[] << spaces sp(4) F.Continue_label ": ;" ;
    im[] << spaces "end;"
    CASE !inf && F.Breaked || F.Has_next ?
         declare_label("Brk" suf)
         im[] << spaces "Brk" suf ": ;" ;
    nesting_block[].Remove(F)
    nesting_for[].Remove(F)
; .

FUNCTION min_max|_may_be_not_call(
STR F|un_min_max, STR A|_operand1, STR B|_operand2) ==> STR
	:
	CASE A == B ? RESULT = A ==> ;
	RESULT = F "(" A ", " B ")" .

METHOD unroll_for(
	{For} F|or_statement,
	STR V|ariable_name,
	STR Suffix|_for_vars)
	:
	{Expr} r1|_start = F.Range1
	{Expr} r2|_finish = F.Range2
	CASE r1.Operation == 'CONST' && r2.Operation == 'CONST' ?
	     CASE F.Downto ?
	          INT count|_pass = r1.Var_arg.Int_c - r2.Var_arg.Int_c + 1
	     ELSE count = r2.Var_arg.Int_c - r1.Var_arg.Int_c + 1 ;
	     CASE count == F.Unroll_factor && F.Unroll_factor <= 1024 || (
	     	  F.Unroll_factor == 0 && count <= 1024)
	     	  ?
	          unroll_all(F, count) ==> ;
	;
	//total_for++
	STR t|mp_indx = Suffix
    CASE r1 != NONE ?
         declare_local_var("from" Suffix, "Integer", FALSE)
         declare_local_var("to" Suffix, "Integer", FALSE)
         STR text_r1|_generated = gen_expr(r1).Remove_br
         STR text_r2|_generated = gen_expr(r2).Remove_br  
         CASE F.Downto ?
              im[] << spaces V " := " text_r1 ";"
              im[] << spaces "to" t " := " text_r2 " + " F.Unroll_factor.S ";"
              im[] << spaces "while " V " >= to" t " do begin" 
         ELSE 
              im[] << spaces V " := " text_r1 ";"
              im[] << spaces "to" t " := " text_r2 " - " F.Unroll_factor.S ";"
              im[] << spaces "while " V " <= to" t " do begin"
         ;
    ELSE STR i|ndex_var = "idx" t Suffix
    	 F.Index_var = i
    	 im[] << spaces i " := 0;"
    	 declare_local_var("to" Suffix, "Integer", FALSE)
    	 STR text_a|rray_generated = gen_expr(F.Array) 
    	 im[] << spaces "to" Suffix " := " text_a ".Count - 1;"
         ..[] << spaces "while " i " <= to" Suffix " - " F.Unroll_factor.S
         ..[*] =_ " do begin"
    ;
    ------------------------------------ 'do not stop response', REUSED
    im[] << spaces sp(4) "inc(global_activity_counter);"
    im[] << spaces sp(4) "if global_activity_counter > 65535 then"
    im[] << spaces sp(8) "check_long_operation();"
    ------------------------------------ 'generate block'
    INT first_line INDEXING STR
PUSH list_temps_used = FALSE :
    FOR j IN [0 TO F.Unroll_factor-1] :
        im[] << "// step #" (j+1).Str " from " F.Unroll_factor.Str
        STR dot|_when_not_data = ".Get"
        CASE F.Array.Var_arg.Names[0] == "DATA" ? dot = "" ;
        CASE ?
        [r1 != NONE] ? NONE
        [F.Array.Var_arg.Names[0] == "DATA"] ?
     	 	  im[] << spaces sp(4) V " := " gen_expr(F.Array) "[" i "];"
        ELSE
        	------------------------------- 'assign next item', REUSED
    		CASE F.Array.Type_expr.Kind ?
            ['CLASS', 'STRUCTURE']:
                 im[] << spaces sp(4) "Object_assign_hard(" V 
                 ", " gen_expr(F.Array) ".GetObjects(" i ").Obj);" 
            ['BOOL', 'INT', 'ENUM', 'REAL', 'STR']:
                 im[] << spaces sp(4) V " := " gen_expr(F.Array) 
                 "" dot items_name(F.Array) "(" i ");" ;
            -------------------------------- 'assigned'
        ;
        total_for_label += 1
        F.Continue_label = "Cont_" F.Total_stmt.Str "_" total_for_label.Str
	    ------- 'generate block, call clear_list_temps if necessary', REUSED
        im[] << "//***"
        first_line = im[].Count
        CASE use_profiler.[0] IN "LA" && !FINAL_CODE ? 
        	 NONE = make_cnt(F.Line) ;
        generate_block(F.Block_[])
	    FOR k IN [first_line TO im[].Count-1] :
	        CASE im[k] == "//***" ? first_line = k
	        						BREAK k ;
	    ;
        //CASE list_temps_used ?
        //     im[].Insert(first_line, spaces "clear_list_temps(List_temps);")
        //     first_line += 1 ;
	    CASE im[first_line] == "//***" ? im[].Delete(first_line) ;
	    ---------------------- 'continue:'
	    CASE F.Continued ?
        	 declare_label(F.Continue_label)
	         im[] << spaces F.Continue_label ": ;" ;
	    CASE i != "" ? im[] << spaces "inc(" i ");"
	    ELSE 
	    	 CASE !F.Downto ?
	    	      im[] << spaces "inc(" V ");"
	    	 ELSE im[] << spaces "dec(" V ");" ;
	    ;
    ;
;
    im[] << spaces "end;"
    ---------------------- 'finish by a usual loop portion'
PUSH list_temps_used = FALSE :
    CASE F.Range1 != NONE ?
         CASE F.Downto ?
              im[] << spaces "for " V " := " V " downto to" t 
              		 " - " F.Unroll_factor.S " do begin"
              		 
         ELSE im[] << spaces "for " V " := " V " to to" t 
         			" + " F.Unroll_factor.S " do begin"
         ;
         			 
    ELSE im[] << spaces "for " i " := " i " to to" t " + " F.Unroll_factor.S 
    			" do begin"
    			
    	 LIKE ......................... 'assign next item'
    ;
    LIKE ............................... 'do not stop response'
    ------------------------------------ 'generate block'
    F.Continue_label = "Cont" t
    LIKE ............... 'generate block, call clear_list_temps if necessary'
    //BOOL inf|inite = FALSE
    STR suf|fix_for_vars = "_" F.Total_FOR.Str
    //LIKE generate_for .... 'ending the for loop'
	CASE F.Continued ?
         declare_label(F.Continue_label)
         im[] << spaces sp(4) F.Continue_label ": ;" ;
    im[] << spaces "end;"
    CASE F.Breaked ?
         declare_label("Brk" suf)
         im[] << spaces "Brk" suf ": ;" ;
    nesting_block[].Remove(F)
    nesting_for[].Remove(F)    
    //CASE F.Continued ?
    //     declare_label(F.Continue_label)
    //     im[] << spaces F.Continue_label ": ;" ;
    //im[] << spaces "end;"
    //CASE F.Breaked ?
    //     declare_label("Brk" "_" F.Total_stmt.Str)
    //     im[] << spaces "Brk" "_" F.Total_stmt.Str ": ;" ;
;
	.
	
INT total_for_label
	
METHOD unroll_all(
	{For} F|or_statement, INT Count_unroll)
	:
	BOOL dumm|_y_for_variable = "dummy" IN F.Var.Names[*]
	INT curr|ent_var_value = F.Range1.Var_arg.Int_c
	STR v|ar_loop = F.Var.Final_name
	CASE F.Var.Replaced ? v = F.Var.Replace_to_.Final_name ;
	//DEBUG: v << "{" F.Var.Total_i.Str "}" ;
	FOR pass|dummy IN [0 TO Count_unroll-1] :
	    CASE !dumm ?
	         im[] << spaces v " := " curr.Str ";" ;
	    PUSH F.Var.Is_const = TRUE :
	         F.Var.Int_c = curr
	         total_for_label += 1
	         F.Continue_label = "Cont_" F.Total_stmt.Str "_" total_for_label.Str
	         CASE use_profiler.[0] IN "LA" && !FINAL_CODE ? 
		    	  NONE = make_cnt(F.Line) ;
	         generate_block(F.Block_[]) ;
	    CASE F.Continued ?
	         declare_label(F.Continue_label)
	         im[] << spaces F.Continue_label ": ;" ;
	    CASE F.Downto ? curr -= 1
	    ELSE curr += 1 ;
	;
	STR suf|fix_for_vars = "_" F.Total_FOR.Str
	//LIKE generate_for ................. 'ending the for loop' 
    //im[] << spaces "end;"
    CASE F.Breaked ?
         declare_label("Brk" suf)
         im[] << spaces "Brk" suf ": ;" ;
    nesting_block[].Remove(F)
    nesting_for[].Remove(F)    
    //CASE F.Breaked ?
    //     declare_label("Brk_" F.Total_stmt.Str)
    //     im[] << spaces "Brk_" F.Total_stmt.Str ": ;" ;
	.   
	
    
BOOL warning_nolongop
    
FUN items_name|_except_DATA(
	{Expr} Array|_which_items_are) ==> STR
	:
    CASE Array.Var_arg.Names[0] == "DATA" ? ==> ;
    RESULT = array_items_name(Array) .

METHOD String_len|gth_Length_or_UTF8Length ==> STR:
	CASE FPC ? RESULT = "UTF8Length"
	ELSE RESULT = "Length" ; .
	
INT total_push|_index
{Assign} nesting_push|_statements_generating[]
BOOL want_exit_declared|_in_current_function

METHOD generate_save_variable(
{Assign} A|_push_stmt,
{Expr} S|ource_assign_from,
STR Temp|orary_variable_name)
	:
	STR typ|e_temp = type_gen(S.Type_expr, {type_options}(
	    Array=FALSE, Fixed=FALSE, Weak=FALSE))
	declare_local_var(Temp, typ.Trim, FALSE)
	CASE ?
	[A.Dest.Type_expr.Kind == 'CLASS'] ?
	  im[] << spaces Temp " := " gen_none_val(A.Dest.Type_expr) ";" ;
	{Type} dtyp|e_destination = A.Dest.Type_expr
	CASE FPC && dtyp.Kind == 'STR' ?
	     STR expression_s|tring = gen_expr(S) 
	     im[] << spaces "New_str(" Temp ", "
	     im[*] =_ expression_s ");" ==> ;
	--------------------------------- 'usual save variable (except Str in FPC)'
	
	sav|e_statement_temp = {Assign}(Line = 0, Pos= 0, 
			Function_ = Comp.Current_fun,
	        Level = A.Level,
	        Dest = {Expr}(Operation = 'VAR',
	           Var_arg = {Var}(Line = 0, Type_ = dtyp)), 
	        Source = S)
	        
	sav.Dest.Var_arg.Set_final_name(Temp)
	STR text|_generated = generate_assign(sav) 
	im[] << text .


METHOD generate_push({Assign} A|_push_stmt) :
    nesting_push[] << A
    nesting_block[] << A
    STR tmp|_save_var = "save" total_push.Str
    total_push += 1
    {Type} dest_type = A.Dest.Type_expr
    ------------------------------------ 'insert unique marker to insert before'
    INT saved_push_index = total_push
    im[] << "//--push--stmt--" total_push.S
    INT im_start|_line = im[].Count
    CASE ?
    [A.Dest.Operation == 'FUN'] ?
         CASE A.Dest.Fun_.Pop_method_ == NONE ?
              CASE ?
              [A.Dest.Fun_.Getter_field_ != NONE 
               && A.Dest.Fun_.Getter_field_.Type_.Kind == 'STRUCTURE'] ?
                   {Expr} structure_ge|xpression_temp = {Expr}(
                   		Operation = 'FIELD',
                   		Var_arg = A.Dest.Fun_.Getter_field_,
                   		Arg1_ = A.Dest.This_)
                   		
                   ge|xpression_source_getter_temp = {Expr}(Operation = 'FUN',
                   		Fun_ = Comp.SYSFUN_Clone, Items_[] << structure_ge,
                   		Type_obj_ = A.Dest.Fun_.Getter_field_.Type_)
                   
                   generate_save_variable(A, ge, tmp)
                   generate_init_temp_struct(tmp)
                   BOOL restore_dismiss|_structure = TRUE
                   
              [A.Dest.Fun_.Getter_field_ != NONE] ?
                   ge = {Expr}(Operation = 'FIELD',
                   		Var_arg = A.Dest.Fun_.Getter_field_,
                   		Arg1_ = A.Dest.This_)
                   
                   generate_save_variable(A, ge, tmp)
                   
              [A.Dest.Fun_.Getter_method_ != NONE] ?
                   ge = {Expr}(Operation = 'FUN',
                   		Fun_= A.Dest.Fun_.Getter_method_,
                   		This_ = A.Dest.This_)
                   generate_save_variable(A, ge, tmp) ;
         ;
         ------------------------------------- 'call method'
         {Fun} pop|_method = A.Dest.Fun_.Pop_method_
         STR text_pop|_method_called = gen_fun_call(A.Dest) 
         im[] << spaces text_pop ";"
         
    [dest_type.Kind == 'STRUCTURE' && dest_type.Final_name[0] != "s"] ?
         
         structure_ge = {Expr}(Operation = 'SYSTEM_FUN',
         	Fun_ = Comp.SYSFUN_Clone, Items_[] << A.Dest,
         	Type_obj_ = dest_type)
         	
         generate_init_temp_struct(tmp)
    	 generate_save_variable(A, structure_ge, tmp)
    	 restore_dismiss = TRUE
         
    ELSE
    	 generate_save_variable(A, A.Dest, tmp)
    ;
    ------------------------------------------ 'PUSH block in try-finally'
	STR label_end|_of_push = "end_push_" A.Total_stmt.Str
    declare_label(label_end)
	CASE NOTRY_option || A.Intersect ?
         CASE !want_exit_declared ?
              want_exit_declared = TRUE
         	  declare_local_var("want_exit", "Boolean", TRUE) ;
    ;
    
    ----------------------- 'TRY'
    //CASE !A.Intersect ?
    	 im[] << spaces "try" 
    //;
    PUSH spaces = spaces sp(4) :
         CASE A.Source != NONE ? im[] << generate_assign(A) ;
         generate_block(A.Block_[]) 
         //nesting_block[].Remove(A)
    ;
    
    im[] << spaces label_end ": ;"
	     
	----------------------- 'FINALLY'
	//CASE !A.Intersect ?
		 im[] << spaces "finally" 
	//;
    	 
	PUSH noincref :
		 CASE restore_dismiss ? noincref = TRUE ;
	     CASE ?
	     [pop != NONE] ?
	          ------------------------------------- 'pop method'
	          {Expr} call|_pop_method_TEMP = {Expr}(Operation = 'FUN',
	          		Fun_ = pop, This_ = A.Dest.This_)
	                 
	          CASE pop !IN Comp.Current_fun.Call_functions_[] ?
	                       Comp.Current_fun.Call_functions_[] << pop ;
	          im[] << spaces sp(4) gen_fun_call(call) ";"
	          
	     [A.Dest.Fun_ != NONE] ?
	          res|tore_source_temp = {Expr}(Operation = 'VAR',
	                     Var_arg = {Var}(Line = 0,
	                     Type_ = A.Dest.Type_expr))
	          res.Var_arg.Set_final_name(tmp)
	          CASE restore_dismiss ?
	               {Expr} vres|tore_variable = res
	               
	               res = {Expr}(Operation = 'SYSTEM_FUN',
	               		Fun_ = Comp.SYSFUN_Dismiss, Items_[] << vres)
	          ;
	          PUSH A.Dest.Items_[0] = res :
	         	   im[] << spaces gen_fun_call(A.Dest) ;	
	     ELSE
	          ------------------------------------- 'restore variable'
	          b|ack_assign_temp = {Assign}(Dest= A.Dest, Line= 0, Pos= 0,
	                 Function_ = A.Function_, Level = A.Level,
	                 Source = {Expr}(Operation = 'VAR', 
	                     Var_arg = {Var}(Line = 0,
	                     Type_ = A.Dest.Type_expr)) )
	                     
	          b.Source.Var_arg.Set_final_name(tmp)
	          
	          CASE restore_dismiss ?
	               vres = b.Source
	               
	               b.Source = {Expr}(Operation = 'SYSTEM_FUN',
	              	 Fun_ = Comp.SYSFUN_Dismiss, Items_[] << vres)
	          ;
	          PUSH spaces = spaces sp(4) :
	               im[] << generate_assign(b) ;
	     ;
	;
    
    ---------------------- 'END'
    //CASE !A.Intersect ?
    	 im[] << spaces "end;" 
    //;
    nesting_push[].Remove(A)
    nesting_block[].Remove(A)
    CASE NOTRY_option || A.Intersect || current_fun_has_intersect ?
         CASE nesting_push[].Count > 0 ?
              im[] << spaces "if want_exit then goto "
              				"end_push_" nesting_push[*].Total_stmt.Str ";"
         ELSE im[] << spaces "if want_exit then goto fin;" ;
    ;
    ----------------------------- 'check continues', REUSED
    FOR p IN pushes_want_cont[* DOWNTO 0] :
        CASE p != A ? CONTINUE p ;
        FOR i IN [im_start TO im[].Count-1] :
            CASE im[i] == "//--push--stmt--" saved_push_index.S ? 
                 im_start = i
                 BREAK i ;
        ;
        im[].Insert(im_start, spaces pushes_want_flag_cont[p.Index] ":=false;")
        im[] << spaces "if " pushes_want_flag_cont[p.Index] " then begin"
        PUSH spaces = spaces #SP.Repeat(4) :
             generate_cont(push_continue_over[p.Index]) ;
        im[] << spaces "end;" 
        pushes_want_cont[].Delete(p.Index)
        pushes_want_flag_cont[].Delete(p.Index)
        push_continue_over[].Delete(p.Index)     
    ;
    ----
    LIKE ......................... 'check continues',
    	BUT (pushes_want_cont ==> pushes_want_br) * 2,
    		(pushes_want_flag_cont ==> pushes_want_flag_br) * 3,
    		(push_continue_over ==> push_break_over) * 2,
    		(generate_cont ==> generate_break)
    .
    
METHOD generate_init_temp_struct|ure_variable(
	STR Temp|_variable_name)
	:
	im[] << spaces Temp " := NoneObj_AL4_object.hard_link;" .



METHOD generate_stop({Case} Stop|_statement) :
	STR text_stop = gen_expr(Stop.Condition) 
    im[] << spaces "AL4.STOP(" text_stop ");" .



METHOD generate_assert({Case} A|ssert_stmt) :
	STR text_cond|ition = gen_expr(A.Condition) 
    im[] << spaces "if not " text_cond " then begin"
    CASE A.Formatted != NONE ?
         STR f|ormatted = gen_expr(A.Formatted)
    ELSE f = "''" ;
    
    CASE post[].Count > 0 ?
         gen_temp_str
	     im[] << spaces "temp_str_var := " f ";"
	     FOR s IN post[] : im[] << spaces s ;
	     post[].Clear 
	     f = "temp_str_var" ;
	     
    im[] << spaces "   AL4.Assertion_failed(" A.Line.Str
        ", test_assert, test_assert_failed_text, " f  ");"
        
    im[] << spaces "end;"
    
    FOR s IN post[] : im[] << s ;
    post[].Clear .

METHOD gen_comment_block(
{Assign} A|_comment_block)
	:
    im[] << spaces "//----------------------- " A.Source.Var_arg.Str_c 
	CASE FINAL_CODE ? ==> ;
	STR name|_cnt = make_cnt(A.Line)
    //CASE !FINAL_CODE ?
         im[] << "    incr(CNT_" name ");"
         im[] << "    if CNT_" name " = 0 then"
         im[] << "    begin nop := 0; end;"
    //; 
    ------------------------- 'if trace blocks on ...'
    im[] << spaces "if (Level_trace_blocks > 0) and "
    im[*] =_ "(Get_SP_fun < Level_trace_blocks) then"
    im[] << spaces "   WriteLn('"
    {Fun} f|unction_currently_generated = current_generated_fun
    STR t|ext_to_out = f.Class.Names[0] "." f.Names[0]
    INT len|gth_rest = 80 - t.Len - A.Source.Var_arg.Str_c.Len - 2
    CASE len < 3 ? len = 3 ;
    ------------------------- '... write text of comment'     
    im[*] =_ t " " Repeat("-", len) " " 
    t = A.Source.Var_arg.Str_c.Replace_all("'", #1) 
    im[*] =_ Replace_all(t , #1, "''")  
    im[*] =_ "');" 
    .
    


METHOD generate_block|_of_statements(
{Statement} Block|_of_stmt[])
	:
    PUSH spaces = spaces sp(4) :
        FOR s IN Block[] : statement_gen(s) ;
    ; .

BOOL generating_localized_strings
BOOL debug_gen|enrating_expression, DEBUG

METHOD gen_expr|ession(
{Expr} E|xpression) ==> STR, RECURSIVE
    :
	//DEBUG:
	//      CASE E.Total_obj_index == 0 && total_debug_expr == 0 ?
	//           NONE ;
	//;
	PUSH debug_gen :
	     //DEBUG:
	     //      CASE Total_obj_index(E) == 26171 ? debug_gen = TRUE ;
	     //;
	     -------------------------------------- 'generate Before_assign_[] ?'
	     CASE E.Before_assign_[].Count > 0 ?
	          PUSH close_br = 0 :
		           STR save_lines|_already_added[]
		           FOR i IN [line_current_statement TO im[].Count-1] :
		               save_lines[] << im[i] ;
		           FOR i IN [im[].Count-1 DOWNTO line_current_statement] :
		               im[].Delete(i) ;
		           {Assign} a|ssignments[]
		           FOR x IN E.Before_assign_[] : a[] << x.{Assign} ;
		           E.Before_assign_[].Clear
		           FOR y IN a[] : im[] << generate_assign(y) ;
		           ------------------- 'restore im[] and E.Before_assign_[]'
		           line_current_statement = im[].Count
		           FOR s IN save_lines[] : im[] << s ;
		           FOR y IN a[] : E.Before_assign_[] << y ;
	          ;
	     ;
	     --------------------------------------- 'localized string constant?'
	     CASE E.Localize_n != "" && !generating_localized_strings ?
	          RESULT = "Localize_str[" E.Localize_i.Str 
	          " + " Comp.Current_class.Final_name "_Loc_1st_item]" ==> ;
	     --------------------------------------- 'generate expression'
	     CASE E.Replace_index != "" ?
	          RESULT = "{R:" E.Replace_index "}"
	          STR initial|_result = RESULT ;
	     PUSH level_expr = level_expr + 1 :
	         CASE E.Operation ?
             ['BINARY']:  RESULT =_ gen_binary(E)
             ['FUN', 'BASE_FUN', 'SYSTEM_FUN']: RESULT =_ gen_fun_call(E)
             ['VAR']:     STR v|ariable_expression = gen_variable(E)
                          CASE v IN ["THIS", "this"] ? 
                               v =_ ".hard_link" ; 
                          RESULT =_ v
             ['INDEX']:   RESULT =_ gen_index(E)
             ['FIELD']:   RESULT =_ gen_field(E)
             ['NEW_OBJ']: RESULT =_ gen_new_obj(E)
             ['ARRAY']:   RESULT =_ gen_array(E)
             ['AS']:      RESULT =_ gen_as_obj(E)
             ['CONST']:   RESULT =_ gen_const(E)
             ['INT2REAL']: RESULT =_ gen_expr(E.Arg1_)
             ['NOT_B', 'NOT']:	  RESULT =_ "not(" gen_expr(E.Arg1_) ")"
             ['NEG']:	  RESULT =_ "-(" gen_expr(E.Arg1_) ")"
             ['UNKNOWN']:
          		Comp.Error("Generating unknown operation"._Egen ) ;
	         CASE RESULT == "" || RESULT == initial ?
	              {Parser} p|arser_of_cur_class = Comp.Current_class.Parse
	              PUSH p.Line = E.At_line :
	                   PUSH p.Pos = E.At_pos :
	                        Comp.Error("Error generating expression"._Eerr 
	                        ": " p.Next20) ;
	              ;
	         ;
	         //DEBUG:
	         //      CASE !RESULT.Starting("THIS") ?
	         //      		RESULT = "{ex" E.Total_obj_index.Str
	         //      		":" total_debug_expr++.Str "}" RESULT ;
	         //;
	     ;
	; .

//INT total_debug_expr

METHOD gen_binary({Expr} E|xpression) ==> STR :
    --------------------------------- 'special case: long concatenation'
	CASE E.Sign == 'CONCAT' && E.Items_[].Count > 0 ?
		 RESULT = "("
		 FOR i IN E.Items_[] : RESULT =_ gen_expr(i) " + " ;
		 RESULT = RESULT.[0 TO *-3] ")" ==> ;
	--------------------------------- 'other operations'
	CASE E.Sign ?
		 ['UNDEFINED']: NONE     
         ['PLUS', 'CONCAT']: 
		     		 STR s|ign_operation = "+"
         ['MINUS']:  s = "-"
         			 //STR prefix_s|ign = "-"
         ['MULT']:	 s = "*"
         ['DIV']:    RESULT = "AL4.Safe_div"
         			 {Type} arg1_type = E.Arg1_.Type_expr
         			 {Type} arg2_type = E.Arg2_.Type_expr
                     CASE arg1_type.Kind == 'INT' && arg2_type.Kind == 'INT'
                          ?
                          RESULT =_ "_int" ;
                          
                     RESULT =_ "(" gen_expr(E.Arg1_)
                     RESULT =_ ", " gen_expr(E.Arg2_) ")" ==>
                     
         ['REST']:   RESULT = "AL4.Safe_rest(" gen_expr(E.Arg1_)
                     RESULT =_ ", " gen_expr(E.Arg2_) ")" ==>
                     
         ['AND_B']:  s = " and "
         			 BOOL bitwise_op|eration = TRUE
         ['OR_B']:   s = " or "
         			 bitwise_op = TRUE
         ['XOR_B']:  s = " xor "
         			 bitwise_op = TRUE
         ['AND']:    s = " and "
         ['OR']:     s = " or "
         ['IN', 'NOT_IN']:     
                     CASE E.Sign == 'NOT_IN' ? RESULT = "not " ;
                     CASE ?
                     [E.Arg2_.Is_array] ?
                          CASE E.Arg2_.Operation == 'ARRAY' && (
                               E.Arg2_.Type_expr.Kind IN ['INT', 'STR', 'ENUM'])
                               ?
                               RESULT =_ "ArrayContains" 
                               RESULT =_ kind_to_name(E.Arg2_.Type_expr.Kind) 
                               RESULT =_ "(" gen_const_array(E.Arg2_) 
                               RESULT =_ ", " gen_expr(E.Arg1_) ")" ==>
                          ;
                          RESULT =_ gen_expr(E.Arg2_) ".Contains(" 
                          RESULT =_ gen_expr(E.Arg1_) ")" ==>
                          
                     [E.Arg2_.Type_expr.Kind == 'STR'] ?
                     	  RESULT =_ "({1}"
                     	  CASE !E.Arg1_.Var_arg.Is_const ? 
                     	       CASE FPC && !E.Arg1_.Var_arg.Is_param
                     	            && E.Arg1_.Operation !IN ['INDEX', 
                     	            'FUN', 'BASE_FUN', 'SYSTEM_FUN']
                     	            && !(E.Arg1_.Operation == 'BINARY' 
             							 && E.Arg1_.Sign == 'CONCAT')
                     	            //&& !E.Arg1_.Var_arg.Is_const
                     	            ?
		                     	    RESULT =_  
		                     	    "({x2}({x3}" gen_expr(E.Arg1_) 
		                     	    "{3x}).Len > 0{2x}) and ({y2}"
	                     	   ELSE
		                     	    RESULT =_ "({z2}" String_len 
		                     	    .. =_ "({z3}" gen_expr(E.Arg1_) 
		                     	    	  "{3z}) > 0{2z}) and ({w2}" 
	                     	   ;
                     	  ELSE RESULT =_ "({2}"
                     	  ;
                     	  CASE FPC ? RESULT =_ "({3}Utf8Pos"
                     	  ELSE RESULT =_ "({3}pos" ;
                     	  
                     	  RESULT =_ "({4}" gen_expr(E.Arg1_)  
                     	  RESULT =_ ", " gen_expr(E.Arg2_) "{4})>0{3}){2}){1})" 
                     	  ==>
                          
                     ELSE RESULT =_ "("
                     	  CASE FPC ? RESULT =_ "Utf8Pos"
                     	  ELSE RESULT =_ "pos" ;
                     	  
                     	  RESULT =_ "(" gen_expr(E.Arg1_)  
                     	  RESULT =_ ", " gen_expr(E.Arg2_) ")>0)" ==>
                     ;
         ['LIKE', 'UNLIKE']:
         	RESULT = if(E.Sign=='UNLIKE',"not ") "like_str(" gen_expr(E.Arg1_) 
         	RESULT =_ ", " gen_expr(E.Arg2_) ")" ==>
         ['EQUAL']:  RESULT = gen_compare(E, "=") ==>
         ['NOT_EQ']: RESULT = gen_compare(E, "<>") ==>
         ['LESS']:   RESULT = gen_compare(E, "<") ==>
         ['LESS_OR_EQ']: RESULT = gen_compare(E, "<=") ==>
         ['GREATER']:RESULT = gen_compare(E, ">") ==>
         ['GREATER_OR_EQ']:  RESULT = gen_compare(E, ">=") ==> ;
	PUSH generating_bitwise_op = bitwise_op :
	     STR x|operand = gen_expr(E.Arg1_)
	     STR y|operand = gen_expr(E.Arg2_) ;
    CASE x == "" || y == "" ? RESULT = "" ==> ;
    //RESULT = "(" prefix_s y " " s " " x ")"
    RESULT = "(" x " " s " " y ")" .

FUN kind_to_name|byte_int_str( {kind_type} K|ind_of_type_int_byte_str ) ==> STR
    :
    ----------------------------- 'Suffix for name of function ArrayContainsXXX'
    CASE K.Name ?
    ["'ENUM'"]: RESULT = "Byte"
    ["'INT'"]: RESULT = "Int"
    ["'STR'"]: RESULT = "Str" ; .


METHOD gen_compare(
	{Expr} E|xpression, STR S|ign_compare) ==> STR
	:
    CASE E.Arg1_.Type_expr.Kind ?
        ['BOOL', 'INT', 'REAL', 'ENUM', 'STR']: NONE
        
        ['CLASS', 'STRUCTURE']:
            CASE ?
            [E.Arg1_.Var_arg == Comp.NONE_c] ?
                 CASE S ?
                 ["<>"]: RESULT = "not AL4.Is_none(" gen_expr(E.Arg2_) ")"
                 ["="]: RESULT = "AL4.Is_none(" gen_expr(E.Arg2_) ")"
                 ELSE Comp.Error("INCORRECT COMPARE") ;
            [E.Arg2_.Var_arg == Comp.NONE_c] ?
                 CASE S ?
                 ["<>"]: RESULT = "not AL4.Is_none(" gen_expr(E.Arg1_) ")"
                 ["="]: RESULT = "AL4.Is_none(" gen_expr(E.Arg1_) ")"
                 ELSE Comp.Error("INCORRECT COMPARE") ;
                 
            ELSE RESULT = "(" (gen_expr(E.Arg2_) ".Obj").reduce_hardlink_obj 
            	 RESULT =_ " " S " " 
            	 RESULT =_ (gen_expr(E.Arg1_) ".Obj").reduce_hardlink_obj ")"
            ;
        	==> 
    ;
    {Type} type1|_argument = E.Arg1_.Type_expr
    {Type} type2|_argument = E.Arg2_.Type_expr
    CASE ?
    [FALSE && FPC && (
     type1.Kind == 'REAL' || type2.Kind == 'REAL')] ?
         CASE E.Arg1_.Operation IN ['VAR', 'FIELD', 'CONST'] 
         	  && E.Arg2_.Operation IN ['VAR', 'FIELD', 'CONST']
         	  ?
         	  RESULT = "(Safe_cmp(" gen_expr(E.Arg1_) 
         	  RESULT =_ ", " gen_expr(E.Arg2_) ")) " S " 0"
         	  		
         ELSE RESULT = "0.0" S "(Safe_cmp(" gen_expr(E.Arg2_) ", "
         	  RESULT =_ gen_expr(E.Arg1_) "))"
         ;
	[type1.Kind == 'STR'] ?
	     RESULT = "("
	     RESULT =_ "Compare_strings"
	     RESULT =_ "(" gen_expr(E.Arg1_) ", "
	     RESULT =_ gen_expr(E.Arg2_) ") " S " 0)"
	     
    [S IN ["<>", "="]] ?
    	 CASE E.Arg1_.Operation IN ['VAR', 'FIELD', 'CONST']
    	  	  && E.Arg2_.Operation IN ['VAR', 'FIELD', 'CONST']
    	  	  ?
         	  RESULT = "(" gen_expr(E.Arg1_) S 
         	  RESULT =_ gen_expr(E.Arg2_) ")"
         	  
    	 ELSE RESULT = "(" gen_expr(E.Arg2_) S 
    	 	  RESULT =_ gen_expr(E.Arg1_) ")" ;
    ELSE
    	CASE E.Arg1_.Operation IN ['VAR', 'FIELD', 'CONST'] 
    	 	 && E.Arg2_.Operation IN ['VAR', 'FIELD', 'CONST']
    	 	 ?
    	     RESULT = "(" gen_expr(E.Arg1_) S
    	     RESULT =_ gen_expr(E.Arg2_) ")"
    	     
    	ELSE RESULT = "(0" S gen_expr(E.Arg2_) 
    		 RESULT =_ "-" gen_expr(E.Arg1_) ")" ; 
    ; .

INT Total_fixed_array_tmp = 1

METHOD gen_fun_call({Expr} E|xpr_calling_fun) ==> STR :
    ------------------------------------------------------ 'system?'
    CASE E.Fun_.Final_name == "" && E.Fun_.Is_system ?
        RESULT = gen_system_fun(E) ==> ;
    ------------------------------------------------------ 'function or method'
    CASE E.Fun_.Modifiers['STATIC'] ?
         CASE ?
         [E.Fun_.Is_system] ?
              RESULT = "AL4."
         ELSE RESULT = "unit" E.Fun_.Class.Final_name "." ;
    ELSE 
         CASE E.This_ != Comp.THIS_expr && E.This_ != NONE ?
              STR obj|ect_which_method_is_calling = gen_expr(E.This_)
              CASE ? 
              [obj == "THIS.hard_link" || obj == "this.hard_link"] ?
                   RESULT = "THIS."
                   
              [obj.Ending(".hard_link")] ?
                   RESULT = obj.Remove_ending(".hard_link")
                   
              ELSE RESULT = E.This_.Type_expr.Final_name 
              		"(" (obj ".Obj").reduce_hardlink_obj " )."
              ;
         ELSE RESULT = "THIS." ;
    ;
    {Type} fclass|_of_calling_function = E.Fun_.Class
    CASE E.Operation == 'BASE_FUN' ?
         fclass = Comp.Current_class 
         RESULT =_ "inherited" ;
    ----------------------- 'for TRAP function replace it to caller of TRAP fun'
    CASE ?
    [E.Fun_.Modifiers['TRAP_FUN']] ?
         {Var} tf|eild_trapping = E.Fun_.Trap_field
         CASE ?
         [tf.Trap_read_ == E.Fun_] ?
         	  RESULT =_ "Trap_read_" tf.Final_name "("
         [tf.Trap_write_ == E.Fun_] ? 
		 	  RESULT =_ "Trap_write_" tf.Final_name "("
		 	  CASE tf.Type_.Kind == 'CLASS' ?
		 	       RESULT =_ "(" tf.Type_.Final_name ")" ;
         ELSE RESULT =_ E.Fun_.Final_name "(";
    ELSE RESULT =_ E.Fun_.Final_name "(" ;
    ----------------------------------------------------- 'pass parameters'
    PUSH is_left_side = FALSE :
	     CASE E.Fun_.Param[].Count > 0 ?
	         FOR p IN E.Items_[] :
	             CASE ?
	             [p.Var_arg == Comp.NONE_c] ?
	                  RESULT =_ gen_none_val(E.Fun_.Param[p.Index].Type_) ","
	                  
	             [p.Var_arg.In_type_.Kind == 'STRUCTURE' && p.Is_fixed] ?
	                  provide_list_temps
	                  
	                  RESULT =_ "New_" type_gen_A(p.Type_expr,
	                 	 {type_options}(Array = TRUE, Fixed = TRUE,
	                 	 Weak = p.Is_weak)) 
	                 	 "_array(List_temps, "
	                 	 "@" gen_expr(p).Remove_brackets "[0]"
	                 	 ", " p.Var_arg.Size_value.S
	                 	 ", 0, " (p.Var_arg.Size_value-1).S 
	                 	 "),"
	                 	 
	             [p.Fun_.Result.Type_.Kind == 'CLASS'] ?
	             	  total_t += 1
	             	  
	                  temp_obj_v|ariable = {Var}(Line= 0,
	                  	Type_= p.Fun_.Result.Type_,
	                  	Names[] << "temp_obj_param" total_t.S),
	                  	>> Comp.Current_fun.Local_var[]
	                  	
	                  temp_obj_v.Set_final_name("temp_obj_param" total_t.S)
	                  	
	                  declare_local_var("temp_obj_param" total_t.S,
	                  	"Ref_obj{NoneObjInit_" 
	                  	"" p.Fun_.Result.Type_.Final_name "}", FALSE)
	                  	
                      im[] << spaces temp_obj_v.Final_name " := "
                      	"" gen_expr(p).Remove_brackets ";"
	                  		 
	                  RESULT =_ temp_obj_v.Final_name ","
	                  
	                  post[] << spaces temp_obj_v.Final_name ".Ref_dec_hard();"
	                 	 
	             ELSE RESULT =_ gen_expr(p).Remove_brackets "," ;
	         ;
	     ;
    ;
    RESULT = RESULT.Remove_ending(",") ")"
    //CASE want_bracket ? RESULT << ")" ; 
    .

INT total_t|emp_new_objects


METHOD gen_system_fun|ction_special_call(
	{Expr} E|xpr_calling) ==> STR
	:
    CASE E.Fun_.System_fun ?
    ['SYSFUN_Len']:
        CASE FPC && !E.Items_[0].Var_arg.Is_param 
             && !E.Items_[0].Var_arg.Is_const 
             && E.Items_[0].Operation !IN ['INDEX', 'FUN', 'BASE_FUN', 
             'SYSTEM_FUN']
             && !(E.Items_[0].Operation == 'BINARY' 
             && E.Items_[0].Sign == 'CONCAT')
             ?
             RESULT = "(" gen_expr(E.Items_[0]) ").Len" 
        ELSE RESULT = String_len "(" gen_expr(E.Items_[0]) ")" ;
    
    ['SYSFUN_Name']:
		RESULT = "get_name(@Names_" E.Items_[0].Type_expr.Final_name
        .. =_ "__" E.Items_[0].Type_expr.Base_.Final_name "[0]"
        .. =_ ", "
        CASE E.Items_[0].Type_expr.Kind == 'BOOL' ? .. =_ "Integer" ;
        .. =_ "(" gen_expr(E.Items_[0]).Remove_br ")"
        .. =_ ", " (E.Items_[0].Type_expr.Items[].Count-1).Str ")"
                
    ['SYSFUN_Clear']:
		RESULT = gen_expr(E.Items_[0]) ".Clear()"
		
    ['SYSFUN_Count']:
        CASE E.Items_[0].Operation == 'CONSTANT' ? 
             RESULT = E.Items_[0].Var_arg.Items_[].Count.S ==> ;
		BOOL is_data|_array = E.Items_[0].Var_arg.Names[0] == "DATA"
		CASE !is_data ? 
			 BOOL simple_st|ructure_field = E.Items_[0].Operation == 'FIELD'
			 	  simple_st &&= E.Items_[0].Var_arg.Is_fixed
			 	  
			 	  simple_st &&= E.Items_[0].Type_expr.Kind IN ['BOOL',
			 			'INT', 'REAL', 'ENUM', 'STRUCTURE']
			 			
			 	  CASE E.Items_[0].Type_expr.Kind == 'STRUCTURE' ?
			 	       simple_st &&= E.Items_[0].Type_expr.is_simple_struc ;
			 			
			 	  simple_st &&= E.Items_[0].Arg1_.Type_expr.Kind == 'STRUCTURE'
		;
		CASE is_data || simple_st ?
		     RESULT = "LENGTH(" gen_expr(E.Items_[0]) ")"
		ELSE RESULT = gen_expr(E.Items_[0]) ".Count()" ;
		
    ['SYSFUN_Insert']:
		RESULT = gen_expr(E.Items_[0]) ".Add"
		{Type} type_0|_item = E.Items_[0].Type_expr 
        CASE ?
        [type_0.Kind == 'BOOL'] ?
             RESULT =_ "(" gen_expr(E.Items_[1]) 
             RESULT =_ ", Byte(" gen_expr(E.Items_[2]) "))"
             		   
        [type_0.Kind == 'STRUCTURE' && type_0.Final_name[0] == "s"] ?
             RESULT =_ "_record(" gen_expr(E.Items_[1]) 
             CASE E.Items_[2].Operation IN ['VAR', 'FIELD'] ?
             	  RESULT =_ ", " gen_expr(E.Items_[2]) ")"
             ELSE 
             	  ------------- 'create temp variable'
             	  total_t += 1
        	       
                  temp_struct_v|ariable = {Var}(Line= 0,
	                  	Type_= type_0,
	                  	Names[] << "temp_struct_param" total_t.S),
	                  	>> Comp.Current_fun.Local_var[]
                  	
                  temp_struct_v.Set_final_name("temp_struct_param" total_t.S)
                  	
                  declare_local_var("temp_struct_param" total_t.S,
                  	type_0.Final_name, FALSE)
                  	
                  STR gen_temp|_variable = spaces temp_struct_v.Final_name 
                  gen_temp =_ " := " gen_expr(E.Items_[2]) ";"#NL
                  	   
                  RESULT = gen_temp RESULT 
                  ------------ 'and use it'
                  RESULT =_ ", " temp_struct_v.Final_name ")" ;
             		   
        [type_0.Kind == 'STRUCTURE' && type_0.Final_name[0] == "S"
         && E.Items_[2].Fun_.System_fun != 'SYSFUN_Clone'] ?
              {Expr} e_clone|_before_insert = {Expr}(
					 	Operation= 'SYSTEM_FUN', Fun_= Comp.SYSFUN_Clone,
					 	Items_[] << E.Items_[2]),
					 	>> Comp.Current_fun.All_expr[]
            
              RESULT =_ "(" gen_expr(E.Items_[1]) 
              RESULT =_ ", " gen_expr(e_clone) ")"
              
        ELSE RESULT =_ "(" gen_expr(E.Items_[1]) 
        	 RESULT =_ ", " gen_expr(E.Items_[2]) ")"
        ;
                
    ['SYSFUN_Allocate']:
		RESULT =_ gen_expr(E.Items_[0]) 
		RESULT =_ ".Allocate(" gen_expr(E.Items_[1]) ")"
                
    ['SYSFUN_Delete']:
		RESULT =_ gen_expr(E.Items_[0]) 
		RESULT =_ ".Delete(" gen_expr(E.Items_[1])
        CASE E.Items_[].Count == 2 ? RESULT =_ ", 1)"
        ELSE RESULT =_ ", " gen_expr(E.Items_[2]) ")" ;
                
    ['SYSFUN_Remove']:
		RESULT = gen_expr(E.Items_[0]) 
		RESULT =_ ".Remove(" gen_expr(E.Items_[1]) ")"
                
    ['SYSFUN_Find_item']: 
        CASE E.Items_[0].Is_array ?
             RESULT = gen_expr(E.Items_[0])
             CASE E.Items_[0].Var_arg.Names[0] == "DATA" ?
                  RESULT = "AL4.IndexOfStr(" RESULT ", "
                  RESULT =_ gen_expr(E.Items_[1]) ")" ==> 
             ;
             RESULT =_ ".IndexOf(" gen_expr(E.Items_[1]) ")"
             
        ELSE
        	 CASE FPC ? 
        	 	  RESULT = "Utf8pos(" gen_expr(E.Items_[1])
        	 ELSE RESULT = "pos(" gen_expr(E.Items_[1]) ;
             RESULT =_ ", " gen_expr(E.Items_[0]) ")"
        ;
        
    ['SYSFUN_Index']:  
        FOR f IN nesting_for[] :
            CASE E.Items_[0].Var_arg != f.Var ? CONTINUE f ;
            DONE     
	             RESULT = f.Index_var
	             ==>
        ;
        Comp.Error("Can not find Index of FOR loop"._Ecannot6 )
        
    ['SYSFUN_Swap']:
    	RESULT = gen_expr(E.Items_[0])
    	RESULT =_ ".Swap(" gen_expr(E.Items_[1])
    	RESULT =_ ", " gen_expr(E.Items_[2]) ")"
    			
    ['SYSFUN_First']: RESULT = "0"
    
    ['SYSFUN_Last']: RESULT = (E.Items_[0].Type_expr.Items[].Count-1).S
    
    ['SYSFUN_Previous']:
    	RESULT = "imax(0, " gen_expr(E.Items_[0]) "-1)"
    
    ['SYSFUN_Next']:
    	RESULT = "imin(" (E.Items_[0].Type_expr.Items[].Count-1).S
    	RESULT =_ ", " gen_expr(E.Items_[0]) "+1)"
    		  
    ['SYSFUN_Find_str']: NONE
    			 
    ['SYSFUN_Str', 'SYSFUN_RealStr', 'SYSFUN_BoolStr']: NONE
    
    ['SYSFUN_StrInt', 'SYSFUN_RealInt', 'SYSFUN_EnumInt', 
     'SYSFUN_StrHex16', 'SYSFUN_Shl', 'SYSFUN_Shr', 'SYSFUN_Rol', 'SYSFUN_Ror']: 
        NONE
        
    ['SYSFUN_Byte']:
        RESULT = gen_expr(E.Items_[0])
     
    ['SYSFUN_Compare_substrings', 'SYSFUN_Compare_substr1']: NONE
    		  
    ['SYSFUN_Clone']:
    	type_0 = E.Items_[0].Type_expr 
    	CASE type_0.Kind == 'STRUCTURE' && type_0.Final_name[0] == "s" ?
    	     RESULT = gen_expr(E.Items_[0])
    	ELSE RESULT = "(Structure_any(" gen_expr(E.Items_[0]) ".Obj).Clone())"
    	;
    	
    ['SYSFUN_Dismiss']:
    	type_0 = E.Items_[0].Type_expr
    	CASE ?
    	[type_0.Kind == 'STRUCTURE' && type_0.Final_name[0] == "s"] ?
    	     RESULT = gen_expr(E.Items_[0])
    	     
    	[E.Items_[0].Operation == 'INDEX'] ?
    	     RESULT = "Dismiss_array_item("
    	     RESULT =_ gen_expr(E.Items_[0].Arg1_) 
    	     RESULT =_ " ," gen_expr(E.Items_[0].Arg2_) ")"
    	     
    	ELSE RESULT = "Dismiss_structure("
    		 RESULT =_ gen_expr(E.Items_[0]) ")" ;
        		
    ['SYSFUN_UNDEFINED']:
    	Comp.Error("Don't know how to call system function"._Edont ": "
    	"" E.Fun_.Names[0]) ; .


METHOD gen_variable({Expr} E|_variable) ==> STR :
	{Var} v|ariable_generating = E.Var_arg
	FOR i|dummy IN [1 TO 101] :
		CASE v.Replaced ? v = v.Replace_to_
		ELSE BREAK i ;
	;
	CASE v.Replaced ?
	     Comp.Error("Internal error -- could not generate variable") ;
    CASE v.In_type_.Kind == 'CLASS' && v.Names[0] != "DATA" ?
         RESULT = "THIS." ;
    RESULT =_ v.Final_name
    .
    

METHOD gen_index({Expr} E|_index_operation) ==> STR :
	//DEBUG:
	//      CASE debug_gen ?
	//           << "generating INDEX expression " Total_obj_index(E).Str
	//           	  " type kind=" E.Type_expr.Kind.Name
	//           	  " Arg1_.Is_array=" E.Arg1_.Is_array.Str #NL ;
	//; 

    CASE !E.Arg1_.Is_array ?
	     CASE E.Arg3_ != NONE ?
	         RESULT = "AL4.Substring(" gen_expr(E.Arg1_).Remove_br
	         RESULT =_ ", " gen_expr(E.Arg2_).Remove_br
	         RESULT =_ ", " gen_expr(E.Arg3_).Remove_br ")" ==>
	     ;
	     CASE level_expr == 1 && is_left_side ?
	         close_br = next_close_br
	         PUSH is_left_side = FALSE:
		          RESULT = gen_expr(E.Arg1_).Remove_br
		          " := AL4.Replace_symbol(" gen_expr(E.Arg1_).Remove_br
		          ", " gen_expr(E.Arg2_).Remove_br ","
	         ;
	         ==> ;
	         
	     CASE !FPC || E.Arg1_.Var_arg.Final_name == "RESULT"
	          || E.Arg1_.Var_arg == NONE || E.Arg1_.Var_arg.Is_const
	          ?
	          RESULT = "AL4.Single_symbol(" gen_expr(E.Arg1_).Remove_br ", "
	     ELSE RESULT = gen_expr(E.Arg1_).Remove_br ".CharAt(" ;
	     RESULT =_ gen_expr(E.Arg2_).Remove_br ")" ==>
    ;
	     
    -------------------------------------- 'arrays' 
    
    //DEBUG:
    //      CASE debug_gen ?
    //           << "Arg1_.Is_fixed=" E.Arg1_.Is_fixed.Str #NL
    //           CASE E.Arg3_ != NONE ?
    //                << "Arg3_ is not none!" #NL ;
    //      ;
    //;
    
    CASE E.Arg1_.Is_array && !E.Arg1_.Var_arg.Is_fixed ?
         CASE E.Arg3_ != NONE && E.Arg2_.Operation == 'CONST' && (
	          E.Arg2_.Var_arg.Type_.Kind == 'INT') && (
	          E.Arg2_.Var_arg.Int_c == 0) && (
	          E.Arg3_.Is_star_operation)
	          ?
	          RESULT =_ gen_expr(E.Arg1_) ==> ;
    ;
         
    CASE E.Arg3_ != NONE ?
         RESULT =_ "New_FixA" array_type_name(E.Arg1_.Type_expr)
         PUSH is_left_side = FALSE :
              provide_list_temps
              CASE ?
              //[E.Arg1_.Var_arg.Modifiers['CLAMP']] ?
              //     STR is_array = "_clamp"
              [E.Arg1_.Var_arg.Is_fixed
               && E.Arg1_.Var_arg.In_type_.Kind == 'STRUCTURE'
               || E.Arg1_.Var_arg.Names[0] == "DATA"] ?
                   BOOL is_array = TRUE // "_array"
                   RESULT =_ "_array"
              ;
         	  RESULT =_ "(List_temps, "
         	  
         	  CASE is_array ?
         	  	   RESULT =_ "@" gen_expr(E.Arg1_) "[0], "
         	  		"" E.Arg1_.Var_arg.Size_value.S
         	  //["_clamp"]: RESULT << "@" gen_expr(E.Arg1_) "[0]"
         	  ELSE RESULT =_ gen_expr(E.Arg1_) ;
         	  
         	  RESULT =_ "," gen_expr(E.Arg2_) ", " gen_expr(E.Arg3_) ")" ==>
         ;
    ;
    
    {Type} a1_type|_expr = E.Arg1_.Type_expr

    CASE a1_type.Kind == 'STRUCTURE' && a1_type.Final_name[0] == "S" ?
         CASE is_left_side ?
              PUSH is_left_side = FALSE :
              	   RESULT = gen_expr(E.Arg1_) ".SetObjects("
              	   RESULT =_ gen_expr(E.Arg2_) ", {s}" 
              	   // IMPORTANT!!! do not remove {s}
              	   close_br = next_close_br ==> ;
         ;
         RESULT = gen_expr(E.Arg1_)
         PUSH is_left_side = FALSE :
         	  RESULT =_ ".GetObjects(" gen_expr(E.Arg2_) ")" ==> ;
    ;

	{Type} a1_a1_type = E.Arg1_.Arg1_.Type_expr
	CASE E.Arg1_.Is_fixed && (
         E.Arg1_.Operation == 'FIELD' 
         && a1_a1_type.Kind == 'STRUCTURE'
         || E.Arg1_.Var_arg.Names[0] == "DATA"
         || E.Arg1_.Var_arg.Is_const)
         ? 
 		 CASE is_left_side && E.Arg1_.Var_arg.Modifiers['CLAMP'] ?
 		      PUSH is_left_side = FALSE :
 		           STR t|ype_of_result = type_gen(E.Type_expr, 
		      			{type_options}(Array = FALSE))
                   RESULT = "P" t "({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}"
                   			"(@" gen_expr(E.Arg1_) "[0])" 
                   			" + (" gen_expr(E.Arg2_) 
                   			" and " (
                   			E.Arg1_.Var_arg.Provide_size_value - 1).Str
                   			") * sizeof(" t "))^" ==> ;
 		 ;
	
         CASE is_left_side && E.Arg1_.Var_arg.Modifiers['CLAMP'] ?
              PUSH is_left_side = FALSE :
                   RESULT = "Set_fixed_" items_name(E.Arg1_)
                   
                   CASE E.Arg1_.Var_arg.Modifiers['CLAMP'] ?
                        RESULT =_ "_clamp"
                        BOOL is_clamp|_array = TRUE ;
                        
                   RESULT =_ "(@" gen_expr(E.Arg1_) 
                   			 "[0], " (
                   			 E.Arg1_.Var_arg.Provide_size_value - 1).Str
                   			 ", " gen_expr(E.Arg2_) ", "
                   			 
                   CASE is_clamp ?
                        RESULT =_ (
                        E.Arg1_.Var_arg.Provide_size_value - 1).Str ", "
                   ;
                   close_br = next_close_br ==> ;
         ;
              
		 CASE ?
		 [E.Arg1_.Var_arg.Modifiers['CLAMP']] ?
		      t = type_gen(E.Type_expr, 
		      		{type_options}(Array = FALSE))
		      		
		      RESULT = "P" t "("
		      RESULT =_ "{$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}"
		      RESULT =_ "(@" gen_expr(E.Arg1_) "[0]) + "
		      PUSH is_left_side = FALSE :
		      	   RESULT =_ "((" gen_expr(E.Arg2_) ;
		      RESULT =_ ") and " (E.Arg1_.Var_arg.Provide_size_value - 1).Str 
		      RESULT =_ ") * sizeof(" t "))^" ==>
		      		
         [E.Arg1_.Var_arg.Names[0] == "DATA"] ?
              RESULT = "Fixed_" array_items_name(E.Arg1_)
              RESULT =_ "(@" gen_expr(E.Arg1_)
              RESULT =_ "[0], " (E.Arg1_.Var_arg.Provide_size_value - 1).Str
              PUSH is_left_side = TRUE :
              	   RESULT =_ ", " gen_expr(E.Arg2_) ")" ==> ;
                       
         [need_use_pass_through] ?
              RESULT = gen_expr(E.Arg1_) "[pass_through("
              PUSH is_left_side = FALSE :
              	   RESULT =_ gen_expr(E.Arg2_) ")]" ==> ;
              		   
         [E.Arg1_.Operation == 'CONSTANT' && E.Arg1_.Type_expr.Kind == 'STR'
          && FPC] ?
              RESULT = "Array_item_Str(@" E.Arg1_.Var_arg.Final_name "[0]" 
              RESULT =_ ", " E.Arg1_.Var_arg.Items_[].Count.S 
              RESULT =_ ", " gen_expr(E.Arg2_) ")" ==>
         [E.Arg1_.Is_fixed] ?
              CASE E.Arg1_.Operation == 'CONSTANT' ? 
                   STR a1|_argument1 = E.Arg1_.Var_arg.Final_name
              ELSE a1 = gen_expr(E.Arg1_) ; 
         	  RESULT = "Array_item_"
         	  CASE ?
         	  [E.Arg1_.Type_expr.Kind IN ['ENUM', 'BOOL']] ?
         	      .. =_ "Byte"
         	  [!FPC] ?
         	  	.. =_ (E.Arg1_.Type_expr.Names[0] " ").Replace("STR ", "String")
         	  ELSE .. =_ E.Arg1_.Type_expr.Names[0] 
         	  ; 
         	  .. =_ "(@" a1 "[0], LENGTH(" a1 ")," gen_expr(E.Arg2_) ")" 
         	  CASE E.Arg1_.Type_expr.Kind=='BOOL' ? 
         	       .. = "("_" <> 0)" ;
         	  ==>
              
         ELSE RESULT = gen_expr(E.Arg1_) 
         	  PUSH is_left_side = FALSE :
         	  	   RESULT =_ "[" gen_expr(E.Arg2_) "]" ==> ;
         ;
	;
	
	-------------------------------------------- 'Arg1_.Set(Arg2_, ...)'
	PUSH is_left_side = FALSE :
         RESULT = gen_expr(E.Arg1_) ;
	CASE is_left_side ?
	     RESULT =_ ".Set"
		 BOOL set_values = TRUE
		 
	ELSE RESULT =_ ".Get" ;
	
	RESULT =_ items_name(E.Arg1_)
	PUSH is_left_side = FALSE :
	     RESULT =_ "(" gen_expr(E.Arg2_) ;
	CASE set_values ? RESULT =_ ", "
					  close_br = next_close_br
	ELSE 
		 RESULT =_ ")"
		 {Type} et|ype_of_expression = E.Type_expr
		 CASE et.Kind == 'STRUCTURE' && et.Final_name[0] == "s" ?
		      RESULT = "P" E.Type_expr.Final_name "(" RESULT ")^" ;
	; .
        
    
//INT temp_fixed_a|rray_var_index

FUNCTION array_type_name(
{Type} T|ype_to_array_name) ==> STR
	:
	CASE T.Kind ?
    ['BOOL']: RESULT =_ "Byte"
    ['ENUM']: RESULT =_ "Byte"
    ['INT']: RESULT =_ "Int"
    ['STR']: RESULT =_ "Str"
    ['REAL']: RESULT =_ "Real"
    ['CLASS', 'STRUCTURE']: RESULT =_ "Obj" ; .


FUN array_items_name({Expr} E|xpression_array) ==> STR :
    CASE E.Type_expr.Kind ?
    ['BOOL']:           RESULT =_ "Bools"
    ['ENUM']:   RESULT =_ "Bytes"
    ['INT']:            RESULT =_ "Integers"
    ['STR']:            RESULT =_ "Strings"
    ['REAL']:           RESULT =_ "Reals"
    ['CLASS', 'STRUCTURE']:RESULT =_ "Objects" ;
    CASE RESULT == "" ? RESULT = "Strings" ; .

    
    
FUNCTION gen_none_val({Type} T|ype_NONE) ==> STR :
    CASE T.Kind ?
        ['BOOL']: RESULT = "false"
        ['INT', 'REAL', 'ENUM']: RESULT = "0"
        ['STR']: RESULT = "''"
        ['CLASS', 'STRUCTURE']: 
        	CASE ?
            //[incremental && T.Final_name != "AL4_object"] ?
            //     RESULT = "impl_Get_NoneObj_" T.Final_name ".hard_link"
        	[T.Final_name[0] == "s"] ?
        		 RESULT = "NoneObj_" T.Final_name
        	ELSE RESULT = "NoneObj_" T.Final_name ".hard_link" ;
    ; .



METHOD gen_field({Expr} E|_field_of_obj) ==> STR :
    {Type} t1|_type_of_arg1 = E.Arg1_.Type_expr
    CASE ?
    [t1.Kind == 'STRUCTURE' && t1.Final_name[0] == "s"] ?
         PUSH is_left_side = FALSE :
         	  RESULT = gen_expr(E.Arg1_) ; 
         RESULT =_ "." E.Var_arg.Final_name ==>
         
    [kol >= 0 && t1.Kind == 'STRUCTURE'] ?
      	 BOOL left_side|_of_assignment = is_left_side
    	 PUSH is_left_side = FALSE :
	          RESULT = "P" t1.Final_name "(" gen_expr(E.Arg1_)
	          CASE E.Arg1_.Var_arg.Final_name != "Result" ? 
	               RESULT = (RESULT ".Obj").reduce_hardlink_obj ;
	          CASE left_side ? RESULT =_ ".write" ;
	          RESULT =_ ")." E.Var_arg.Final_name ==> ;
    [t1.Kind IN ['CLASS', 'STRUCTURE']] ?
    	 -------------------------------------------------- 'field of object'
    	 left_side = is_left_side
    	 PUSH is_left_side = FALSE :
    	      CASE E.Var_arg.Names[0] == "DATA" ?
    	           RESULT = E.Var_arg.Final_name ==> ;
	          RESULT = t1.Final_name "(" gen_expr(E.Arg1_)
	          CASE E.Arg1_.Var_arg.Final_name != "Result" ? 
	               RESULT = (RESULT ".Obj").reduce_hardlink_obj ;
	          CASE left_side ? RESULT =_ ".write" ;
	          RESULT =_ ")." E.Var_arg.Final_name ==> ;
    ;
    //RESULT = "" //"{field of record " t1.Kind.Name "} "
    //         "" t1.Final_name "__" t1.Base_.Final_name 
    //         "(" gen_expr(E.Arg1_) ")." E.Var_arg.Final_name
    -------------------------------------------------- 'field of record'
    PUSH is_left_side = FALSE :
	     RESULT = "" //"{field of record " t1.Kind.Name "} "
	              "" t1.Final_name "__" t1.Base_.Final_name 
	              "(" gen_expr(E.Arg1_) ")." E.Var_arg.Final_name
    ;
    CASE E.Type_expr.Kind == 'STR' && !is_left_side ?
         RESULT = "String(" RESULT ")" 
    ; .

BOOL generating_bitwise_op|eration_All_int_constants_generated_in_hex

METHOD gen_const({Expr} E|_constant) ==> STR :
	RESULT = gen_const_value(E.Var_arg) .
	
METHOD gen_const_value({Var} V|alue_to_generate) ==> STR :
	STR cv|alue_direct = V.Constant_value
	CASE cv.[0]==" " ? cv = "" ;
    CASE V.Type_.Kind ?
        ['BOOL']: 
                  CASE V.Int_c != 0 ? RESULT = "true"
                  ELSE RESULT = "false" ;
        		 CASE cv !IN ["TRUE", "FALSE"] 
        		      && V.Names[0] !IN ["", "TRUE", "FALSE"]
        		      ?
        		      Comp.Error("expression can be used for "
        		      "boolean constant (" V.Names[0] "=" cv ")") ;
                  
        ['ENUM']: RESULT = V.Int_c.Str
        		 CASE cv != "" && V.Names[0] != "" ? 
        		      Comp.Error("expression can be used for "
        		      "enum constant (" V.Names[0] ")") ;
        ['INT']:
        		CASE cv == "" || V.Int_c != 0 ? 
					CASE generating_bitwise_op || V.Int_c & 0x8000_0000 != 0 ?
						 RESULT = "Integer($" V.Int_c.Hex(2) ")"
					ELSE RESULT = V.Int_c.Str ;
        		ELSE RESULT = "(" cv ")" ;
					
        ['REAL']:
            	CASE cv IN ["", "Double.NaN"] ? 
            		 RESULT = Replace(V.Real_c.Str, ",", ".")
	                 CASE ?
	                 [V == Comp.INFINITY_c] ?
	                      RESULT = "Infinity"
	                 [V.Real_c.Is_INF] ?
	                      RESULT = "Infinity"
	                      CASE V.Real_c < 0 ? RESULT = "-" RESULT ;
	                 [V == Comp.NAN_c || V.Real_c.Is_NAN] ?
	                      RESULT = "NAN_constant"
	                 ["." !IN RESULT && "e" !IN RESULT.Lower] ?
	                      RESULT =_ ".0" ;
            	ELSE RESULT = "(" cv.Replace_all("_", "") ")" ;
                       
        ['STR']: RESULT = V.Str_c.as_str
        		 CASE cv != "" && V.Names[0] != "" && cv.to_str_value != RESULT ? 
        		      Comp.Error("expression can not be used for "
        		      "string constant (" V.Names[0] "==[" cv "])") ;
        ['CLASS', 'STRUCTURE']:
			Comp.Current_class.Parse.Line = V.Line
            Comp.Error("Generating class constant!"._Egen3 ) ; .

FUN to_str_value(STR str_c|onstant_value) ==> STR :
    CASE str_c.[0]==#QU==str_c.[*] ? 
         RESULT = "'" str_c.[1 TO *-1] "'"
    ELSE RESULT = "'" str_c "'" ; .

METHOD gen_as_obj({Expr} E|_as_operation) ==> STR :
    STR t|ype_final_name = E.Type_expr.Final_name
    //CASE incremental && t != "AL4_object" ?
    //     RESULT = "AL4.As_obj(" gen_expr(E.Arg1_)
    //     ", impl_Get_NoneObj_" t ".hard_link)"
    //ELSE
    	 RESULT = "AL4.As_obj(" gen_expr(E.Arg1_)
	     ", NoneObj_" t ".hard_link)" 
    //;
    .


INT total_const_arr|ay_index

METHOD gen_array({Expr} E|_array_obj) ==> STR :
    CASE E.Type_expr.Kind ?
        ['BOOL']: STR n|ame_typ = "Byte"
        ['ENUM']: n = "Byte"
        ['INT']: n = "Int"
        ['REAL']: n = "Real"
        ['STR']: n = "Str"
        ['CLASS', 'STRUCTURE']: 
				   Comp.Error("Constant array of objects?"._Econst2 ) ;
    ----------------------------------- 'declare constant array'
    STR nconst|ant_name = "const_arr" total_const_arr.Str
    total_const_arr += 1
    
    STR decl|aration_of_const_arr = "const " nconst ": array[0.."
    	"" (E.Items_[].Count-1).Str "] of "
    	
    CASE E.Type_expr.Kind == 'STR' ? decl =_ "String"
    
    ELSE decl =_ type_gen(E.Type_expr,
    	{type_options}(Array = FALSE, Declare=TRUE))
    ;
    decl =_ " = (" 
    FOR it IN E.Items_[] :
        decl =_ gen_expr(it) ", " ;
    decl = decl.Remove_ending(", ") ");"
    ----------------------------------- 'injection of the declaration'
    FOR i IN [im[].Count-1 DOWNTO 0] :
        CASE im[i].Starting("begin") ?
             im[].Insert(i, decl)
             BREAK i ;
    ;
    provide_list_temps
    
    RESULT = "New_FixA" n "_Array(List_temps, @" nconst 
    		 "[0], " E.Items_[].Count.Str ", 0, " (E.Items_[].Count-1).Str ")"
    .

METHOD gen_const_array({Expr} E|_array_obj) ==> STR :
    RESULT = "["
    FOR it IN E.Items_[] :
        RESULT =_ gen_expr(it) ", " ;
    RESULT = RESULT.[0 TO *-2] "]" .



{Expr} new_init|_statement

METHOD gen_new_obj({Expr} E|_new_obj) ==> STR :
    new_init = E
    CASE ?
    [E.Type_obj_.Kind == 'STRUCTURE' && E.Type_obj_.Final_name[0] == "s"] ?
         RESULT = "unit" E.Type_obj_.In_class_.Final_name 
         		  ".New_" E.Type_obj_.Final_name "()"
    
    [kol >= 0 && E.Type_obj_.Kind == 'STRUCTURE'] ?
         RESULT = "unit" E.Type_obj_.In_class_.Final_name 
         		  ".New_" E.Type_obj_.Final_name ".hard_link"
    [kol >= 0] ?
         RESULT = "unit" E.Type_obj_.Final_name 
         		  ".New_" E.Type_obj_.Final_name ".hard_link"
    ELSE RESULT = E.Type_obj_.Final_name ".New_instance()" ; .


ENUM {what_return} :
	'FIELD_COUNT',
	'FIELD_NAME',
	'FIELD_INFO',
	'SET_BOOL',
	'SET_INT',
	'SET_REAL',
	'GET_STRING',
	'SET_STRING',
	'GET_OBJECT',
	'SET_OBJECT' .
	
METHOD generate_RTTI_methods(
{Type} Class|_generate_for,
BOOL Decl|aration_only,
STR ou|tput_lines[])
	:
	PUSH RTTI_decl = Decl :
	PUSH RTTI_Class = Class :
		 generate_1_RTTI_method(
			 "RTTI_object_field_count", "Integer", 'FIELD_COUNT', ou=ou[])
			 
		 generate_1_RTTI_method(
			 "RTTI_object_field_name", "String", 'FIELD_NAME', ou=ou[])
		 ---------------------- 'simple types except STR'
		 generate_1_RTTI_method(
			 "RTTI_object_info_field", "Integer", 'FIELD_INFO', ou=ou[])
			 
		 generate_1_RTTI_method(
			 "RTTI_object_set_bool", "Boolean", 'SET_BOOL', ou=ou[])
			 
		 generate_1_RTTI_method(
			 "RTTI_object_set_int", "Boolean", 'SET_INT', ou=ou[])
			 
		 generate_1_RTTI_method(
			 "RTTI_object_set_real", "Boolean", 'SET_REAL', ou=ou[])
		 ----------------------- 'strings'
		 generate_1_RTTI_method(
			 "RTTI_object_get_string", "String", 'GET_STRING', ou=ou[])
			 
		 generate_1_RTTI_method(
			 "RTTI_object_set_string", "Boolean", 'SET_STRING', ou=ou[])
		 ----------------------- 'objects'
		 generate_1_RTTI_method(
			 "RTTI_object_get_object", "Ref_obj", 'GET_OBJECT', ou=ou[])
			 
		 generate_1_RTTI_method(
			 "RTTI_object_set_object", "Boolean", 'SET_OBJECT', ou=ou[])
	;
	; .
	
BOOL RTTI_decl|aration_only
{Type} RTTI_Class|_generating
	
METHOD generate_1_RTTI_method(
STR Method_name|_together_with_return_type,
STR TFun|ction_type,
{what_return} What|_return_or_do_in_method,
STR ou|tput_lines[])
	:
	ou[] << "function "
	CASE !RTTI_decl ?
	     CASE "$KOL" IN Comp.Defined_name[] ? ou[*] =_ "o" ;
	     ou[*] =_ RTTI_Class.Final_name "." ;
	-------------------------------------- 'parameters'
	ou[*] =_ Method_name "("
	CASE What != 'FIELD_COUNT' ? ou[*] =_ "index: Integer" ;
	CASE What ?
	['SET_BOOL']: ou[*] =_ "; Value: Boolean"
	['SET_INT']: ou[*] =_ "; Value: IntegerValue"
	['SET_REAL']: ou[*] =_ "; Value: Double"
	['SET_STRING']: ou[*] =_ "; const Value: String"
	['SET_OBJECT']: ou[*] =_ "; Value: Ref_obj"
	['FIELD_INFO']: ou[*] =_ "; What: Integer"
	['FIELD_NAME', 'FIELD_COUNT', 'GET_STRING', 'GET_OBJECT']: NONE ;
	
	CASE What IN ['SET_BOOL', 'SET_INT', 'SET_REAL',
		 'GET_STRING', 'SET_STRING', 'GET_OBJECT', 'SET_OBJECT']
		 ?
	     ou[*] =_ "; Index_in_array: Integer" ;
	ou[*] =_ ")"
	----------------------------- 'result'
	CASE TFun != "" ? ou[*] =_ ": " TFun ;
	ou[*] =_ ";"
	CASE RTTI_decl ? 
		 CASE "$KOL" IN Comp.Defined_name[] ? ou[*] =_ " virtual;"
		 ELSE ou[*] =_ " override;" ;
	     ==> ;
	-------- 'RTTI_object_field_name: const names: array[0..x] of String = ...'
	CASE What == 'FIELD_NAME' ? 
	     ou[] << "const nm:array[0.." (RTTI_Class.Field[].Count-1).Str 
	     		 "] of String = ("
	     FOR fld IN RTTI_Class.Field[] :
	     	 CASE fld.Index > 0 ? ou[*] =_ "," ;
	     	 CASE ou[*].Len + fld.Names[0].Len + 3 > 1020 ? ou[] << "" ;
	         ou[*] =_ "'" fld.Names[0] "'" ;
	     ou[*] =_ ");"
	;
	-------------------------------------- 'body'
	ou[] << "begin "
	CASE What !IN ['FIELD_COUNT', 'FIELD_NAME'] ?
		 ou[] << sp(8) "case index of"
		 NONE = generate_RTTI_fields(RTTI_Class, 0, What) ;
	CASE What ?
	['FIELD_COUNT']:
		STR rtti_f|ields = generate_RTTI_fields(RTTI_Class, 0, 'FIELD_COUNT').S 
		ou[] << sp(4) "Result := " rtti_f ";"
		ou[] << "end;" << "" ==>
	['FIELD_NAME']:
	    ou[] << sp(4) "Result := nm[index];"
	['GET_STRING']:
		ou[] << sp(4) "else Result := '';"
	['SET_BOOL', 'SET_INT', 'SET_REAL', 'SET_STRING', 'SET_OBJECT']:
		ou[] << sp(4) "else Result := false; {x02}"
	['GET_OBJECT']:
		ou[] << sp(4) "else Result := NoneObj_AL4_object.hard_link;"
	['FIELD_INFO']: NONE ;
	ou[] << sp(4) "end;"
	ou[] << "end;" << "" .
	
STR RTTI_field_prefix|_for_field_names
	
METHOD generate_RTTI_fields(
{Type} Class|_or_record_generate_for,
INT Case|_start_from,
{what_return} What|_return) ==> INT RESULT|_continue_case_from, RECURSIVE
	:
	CASE "$NORTTI" IN Comp.Defined_name[] ? ==> ;
	INT current|_case = Case
	CASE Class.Kind == 'CLASS' && Class.Base_ != NONE ?
		 current = generate_RTTI_fields(Class.Base_, current, What) ;
	FOR f IN Class.Field[] :
	    CASE What == 'FIELD_COUNT' ? current += 1
		ELSE im[] << sp(12) current.Str ":"
			 current += 1 ;
	    CASE What ?
	    ['FIELD_COUNT']:
	    	CONTINUE f
	    	
	    ['FIELD_NAME']: 
	    	im[] << sp(16) "Result := '" RTTI_field_prefix f.Names[0] "';"
	    	CONTINUE f
	    	
		['SET_BOOL', 'SET_INT', 'SET_REAL']:
			CASE f.Type_.Kind == 'BOOL' && What != 'SET_BOOL' || (
	    		 f.Type_.Kind == 'REAL' && What != 'SET_REAL') || (
	    		 f.Type_.Kind IN ['INT', 'ENUM'] && What != 'SET_INT')
	    		 ?
	    	     im[].Delete(im[].Count-1)
	    	     CONTINUE f ;
	    	im[] << sp(12) "begin"
	    	CASE ?
	    	[!f.Is_array && f.Type_.Kind IN ['CLASS', 'STR']] ?
	    	     im[].Delete(im[].Count-1)
	    	     CONTINUE f
	    	[f.Is_array && f.Type_.Kind == 'BOOL'] ?
	    	     im[] << sp(16) RTTI_field_prefix f.Final_name 
	    	     		".SetBools(Index_in_array, Value);"
	    	     -------------------------------- 'finish SET_SIMPLE', REUSED
	    	     im[] << sp(16) "Result := true;"
	    		 im[] << sp(12) "end;"
	    		 CONTINUE f
	    		 -------------------------------- 'finished'
	    	[f.Is_array && f.Type_.Kind == 'ENUM'] ?
	    	     im[] << sp(16) RTTI_field_prefix f.Final_name 
	    	     		".SetBytes(Index_in_array, Value);"
	    	     LIKE ........................... 'finish SET_SIMPLE'
	    	[f.Is_array && f.Type_.Kind == 'INT'] ?
	    	     im[] << sp(16) RTTI_field_prefix f.Final_name 
	    	     		".SetIntegers(Index_in_array, Value);"
	    	     LIKE ........................... 'finish SET_SIMPLE'
	    	[f.Is_array && f.Type_.Kind == 'REAL'] ?
	    	     im[] << sp(16) RTTI_field_prefix f.Final_name 
	    	     		".SetReals(Index_in_array, Value);"
	    	     LIKE ........................... 'finish SET_SIMPLE'
	    	;
	    	im[] << sp(16) RTTI_field_prefix f.Final_name " := "
	    	CASE f.Type_.Kind ?
	    	['BOOL']: im[*] =_ "Value;"
	    	['ENUM']: im[*] =_ "Byte(Value);"
	    	['INT']: im[*] =_ "Value;"
	    	['REAL']: im[*] =_ "Value;"
	    	['STR', 'CLASS', 'STRUCTURE']: 
	    	          im[].Delete(im[].Count-1)
	    	          CONTINUE f
	    	;
	    	im[] << sp(16) "Result := true;"
	    	im[] << sp(12) "end;"
	    	CONTINUE f
		['GET_STRING']:
	    	CASE ?
	    	[!f.Is_array && f.Type_.Kind == 'STR'] ?
	    	     im[] << sp(16) "Result := " RTTI_field_prefix f.Final_name ";"
	    	[f.Is_array && f.Type_.Kind == 'STR' && f.Names[0] != "DATA"] ?
	    	     im[] << sp(16) "Result := " RTTI_field_prefix f.Final_name 
	    	     		".GetStrings(Index_in_array);"
	    	[f.Is_array && f.Type_.Kind == 'STR' && (
	    	 f.Names[0] == "DATA" && Class.Ending_lines[].Count > 0)] ?
	    	     im[] << sp(16) "Result := " RTTI_field_prefix f.Final_name 
	    	     		"[Index_in_array];"
	    	ELSE im[].Delete(im[].Count-1) 
			;
	    	CONTINUE f
		['SET_STRING']:
	    	im[] << sp(12) "begin" " {SET_STRING}"
	    	CASE ?
	    	[!f.Is_array && f.Type_.Kind == 'STR'] ?
	    	     im[*] =_ sp(16) RTTI_field_prefix f.Final_name " := Value;"
	    	[f.Is_array && f.Type_.Kind == 'STR' && (
	    	 f.Names[0] != "DATA")] ?
	    	     im[*] =_ sp(16) RTTI_field_prefix f.Final_name
	    	     		".SetStrings(Index_in_array, Value);"
	    	ELSE im[].Delete(im[].Count-1)
		    	 CONTINUE f
	    	;
	    	im[] << sp(16) "Result := true;"
			im[] << sp(12) "end;"
	    	CONTINUE f
		['GET_OBJECT']:
	    	CASE ?
	    	[!f.Is_array && f.Type_.Kind == 'STRUCTURE' 
	    	 && f.Type_.Final_name[0] == "s"] ?
                 im[] << sp(16) "begin"
                 
                 im[]<< sp(20) "Result := "
                        "{$IFDEF FPC}Ref_obj{$ENDIF}" 
                        "(@" RTTI_field_prefix f.Final_name ");"
                        
                 im[] << sp(16) "end;"
                 
	    	[!f.Is_array && f.Type_.Kind IN ['CLASS', 'STRUCTURE']] ?
                 im[] << sp(16) "begin"
                 
                 im[]<< sp(20) "Result := "
                        "" RTTI_field_prefix f.Final_name ";"
                        
                 im[]<< sp(20) "Result.Ref_inc_hard;"
                 im[] << sp(16) "end;"
                 
	    	[f.Is_array && f.Type_.Kind IN ['CLASS', 'STRUCTURE']] ?
                 im[] << sp(16) "begin"
                 
	    	     im[] << sp(20) "RESULT := " 
	    	     		"" RTTI_field_prefix f.Final_name 
	    	     		".GetObjects(Index_in_array);"
	    	     		
                 im[]<< sp(20) "Result.Ref_inc_hard;"
                 im[] << sp(16) "end;"
                 
	    	ELSE //im[*] << sp(16) "Result := NoneObj_AL4_object.hard_link;"
	    		 im[].Delete(im[].Count-1) 
	    	;
	    	CONTINUE f
		['SET_OBJECT']:
	    	im[] << sp(12) "begin " //"//SET_OBJECT"
	    	CASE ?
	    	[!f.Is_array && f.Type_.Kind == 'CLASS'] ?
	    	     im[*] =_ sp(16) "Object_assign_hard(" 
	    	     		"" RTTI_field_prefix f.Final_name ", Value.Obj);"
	    	[f.Is_array && f.Type_.Kind == 'CLASS'] ?
	    	     im[*] =_ sp(16) RTTI_field_prefix f.Final_name
	    	     		".SetObjects(Index_in_array, Value);"
	    	ELSE im[].Delete(im[].Count-1)
		    	 CONTINUE f
	    	;
	    	im[*] =_ sp(16) "Result := true;"
			im[*] =_ sp(12) "end;"
	    	CONTINUE f
	    ['FIELD_INFO']: NONE ;
	    
	    im[] << sp(12) "begin {FIELD_INFO:}" f.Names[0]
	    im[] << sp(16) "case What of "
	    ---------------------------------- 'TYPE_INDEX'
	    im[] << sp(16) "0: {TYPE_INDEX}"
	    im[] << sp(20) "RESULT := " f.Type_.Type_total_index.Str ";"
	    ---------------------------------- 'IS_ARRAY'
	    im[] << sp(16) "1: {IS_ARRAY}"
	    im[] << sp(20) "RESULT := " f.Is_array.bool_as_int.Str ";"
	    ---------------------------------- 'IS_FIXED|_ARRAY'
	    im[] << sp(16) "2: {IS_FIXED}"
	    im[] << sp(20) "RESULT := " f.Is_fixed.bool_as_int.Str ";"
	    ---------------------------------- 'IS_PUBLIC'
	    im[] << sp(16) "3: {IS_PUBLIC}"
		BOOL pub|lic_name = f.Names[0].[0].Upper == f.Names[0].[0] 
	    im[] << sp(20) "RESULT := " pub.bool_as_int.Str ";"
	    ---------------------------------- 'SIZE_ARRAY'
	    im[] << sp(16) "4: {SIZE_ARRAY}"
	    CASE ?
	    [f.Final_name == "DATA_" Class.Final_name 
	     && Class.Ending_lines[].Count == 0]
	    ?
	    ------------------------------------------------ 'no DATA'
	    im[] << sp(20) "RESULT := 0;"
	    [f.Final_name == "DATA_" Class.Final_name]
	    ?
	    ------------------------------------------------ 'DATA'
	    im[] << sp(20) "RESULT := High(" f.Final_name ");"
	    [f.Is_array]
	    ?
	    ------------------------------------------------ 'Array[]'
	    im[] << sp(20) "RESULT := " f.Final_name ".Count();"
	    ------------------------------------------------ 'scalar'
	    ELSE
	    im[] << sp(20) "RESULT := 0;" ;
	    ---------------------------------- 'else'
	    im[] << sp(16) "else RESULT := 0;"
	    im[] << sp(16) "end;"
    	im[] << sp(12) "end;"
	;
	RESULT = current .
	    	     
FUN bool_as_int(BOOL V|alue_to_int) ==> INT :
	CASE V ? RESULT = 1 ; .


END


Lines after the END are automatically stored in the DATA[] strings array
without any changes, so those can be used to store text portions needed by
a class (like in our case, to generate another texts).

--cfg--(
-$A8
-$B-
-$C-
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-GD
-cg
#VCL:-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
#KOL:-AClasses=;mirror=
-H+
-W+
-M
-$M16384,1048576
-K$00400000
#KOL:-U"%KOLPATH%"
#KOL:-O"%KOLPATH%"
#KOL:-I"%KOLPATH%"
#KOL:-R"%KOLPATH%"
#KOL:-DEXTERNAL_DEFINES;KOL;KOL_EXCEPTIONS;PAS_VERSION
#VCL:-DVCL
-w-GARBAGE
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST
--cfg--)
LE"s:\program files\borland\delphi7\Projects\Bpl"
-LN"s:\program files\borland\delphi7\Projects\Bpl"
--cfg--)

--dof--(
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=0
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=3
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
#KOL:SearchPath=
#VCL:SearchPath=
Packages=vclx;vcl;rtl;dsnapcon;dsnap;dbrtl;vcldb;adortl;bdertl;vcldbx;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;FLV_7PackD7_all;FastTypePackageD7
#KOL:Conditionals=EXTERNAL_DEFINES;KOL;KOL_EXCEPTIONS;PAS_VERSION
#VCL:Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
#KOL:RootDir=C:\Borland\Delphi7\Bin\
#VCL:RootDir=C:\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1049
CodePage=1251
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
--dof--)

--AL4.pas--(
//---------------- AL4.PAS --------------------  version 2016-12-18 (A)
unit AL4;
#KOL:	{$I EXTERNAL_DEFINES.inc}
@int32:	{$DEFINE INT_32}
@int64:	{$DEFINE INT_64}
{$IFDEF VER90}
              {$DEFINE _D2}
              {$DEFINE _D2orD3}
              {$DEFINE _D2orD3orD4}
{$ENDIF}

{$IFDEF VER100}
              {$DEFINE _D3}
              {$DEFINE _D3orHigher}
              {$DEFINE _D2orD3}
              {$DEFINE _D2orD3orD4}
              {$DEFINE _D3orD4}
{$ENDIF}

{$IFDEF VER120}
              {$DEFINE _D3orHigher}
              {$DEFINE _D3orD4}
              {$DEFINE _D4}
              {$DEFINE _D4orHigher}
              {$DEFINE _D2orD3orD4}
                  {$IFnDEF KOL_MCK}
                           {$DEFINE INPACKAGE}
                  {$ENDIF}
{$ENDIF}

{$IFDEF VER130}
              {$DEFINE _D3orHigher}
              {$DEFINE _D4orHigher}
              {$DEFINE _D5}
              {$DEFINE _D5orHigher}
{$ENDIF}

{$IFDEF VER140}
              {$DEFINE _D3orHigher}
              {$DEFINE _D4orHigher}
              {$DEFINE _D5orHigher}
              {$DEFINE _D6}
              {$DEFINE _D6orHigher}
{$ENDIF}

{$IFDEF VER150}
              {$DEFINE _D3orHigher}
              {$DEFINE _D4orHigher}
              {$DEFINE _D5orHigher}
              {$DEFINE _D6orHigher}
              {$DEFINE _D7}
              {$DEFINE _D7orHigher}
{$WARN UNIT_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
{$ENDIF}

////////////////////////////////////////////////////////////////////////

{$IFDEF FPC}
		{$DEFINE DOG}
		{$DEFINE MODERN_CODE}
{$ELSE}
	{$IFDEF _D5orHigher}
			{$DEFINE MODERN_CODE}
	{$ELSE}
			{$DEFINE USE_FirstByte}
	{$ENDIF}
{$ENDIF}

{$IFDEF FPC}
	{$IF DEFINED(CPUX86_64) OR DEFINED(CPUAMD64) OR DEFINED(CPUIA64) OR DEFINED(CPUPOWERPC64)}
		{$DEFINE CPU64}
	{$IFEND}
{$ENDIF}

//------------ do not remove these comments!
//{$DEFINE WRITE_DIRECT}
//{$DEFINE NO_RTTI}

interface uses 
#VCL:	Classes, SysUtils, Math
#KOL:   KOL {$IFNDEF NOERR} , err {$ENDIF}
		{$IFDEF FPC} {$IFNDEF NOINTERFACES} , Interfaces {$ENDIF} {$ENDIF}
		{$IFDEF FPC} 
				, lazutf8, LCLType
		{$ENDIF}
		{$IFDEF LINUX}
		{$ELSE} , Windows
        {$ENDIF}
        ;
        
{$IFNDEF NO_RTTI}
	{$DEFINE USERTTI}
{$ENDIF}


{$DEFINE USE_DynAObj}
{$DEFINE USE_DynAByte}
{$DEFINE USE_DynAInt}
{$IFDEF USERTTI}
	{$DEFINE use_dynaint}
{$ENDIF}
{$DEFINE USE_DynAReal}
{$DEFINE USE_DynAStr}

{$DEFINE USE_FixAObj}
{$DEFINE USE_FixAByte}
{$DEFINE USE_FixAInt}
{$DEFINE USE_FixAReal}
{$DEFINE USE_FixAStr}

{$IFDEF MEM_DIAG}
var memdiag_fun1: PChar;
	memdiag_fun2: PChar;
	memdiag_line: Integer;
{$ENDIF}

{$IFDEF REAL_EXTENDED}
type Real = Extended;
{$ENDIF}

{$IFDEF REAL_SINGLE}
type Real = Single;
{$ENDIF}

{$IFNDEF REAL_EXTENDED}
	{$IFNDEF REAL_SINGLE}
	type Real = Double;
	{$ENDIF}
{$ENDIF}

{$IFDEF KOL}
type
	{$IFDEF _D5orHigher}
  PStrListAlt = ^TStrListAlt;
  TStrListAlt = object(TObj)
  protected
    fArray: array of Ansistring;
    fCount: Integer;
  protected
    function Get(Idx: integer): Ansistring;
    procedure Put(Idx: integer; const Value: Ansistring);
    destructor Destroy; virtual;
    function getCapacity: Integer;
    procedure setCapacity(Value: Integer);
  public
    function Add(const S: Ansistring): integer;
    procedure Clear;
    procedure Delete(Idx: integer);
    function IndexOf(const S: AnsiString): integer;
    procedure Insert(Idx: integer; const S: Ansistring);
    property Count: integer read fCount;
    property Items[Idx: integer]: Ansistring read Get write Put; default;
    property Capacity: Integer read getCapacity write setCapacity;
  end;
  	{$ELSE}
  PStrListAlt = PStrList;
  TStrListAlt = TStrList;
  	{$ENDIF}
{$ELSE}
var App_closed: Boolean;
{$ENDIF}

//------------------------------------------------------------------------------
type
	{$IFDEF FPC}
	Str = class
	public
		Value: String;
		Cursor_point: Integer;
		Cursor_index: Integer;
		_Len: Integer;
		function Len: Integer;
		procedure Assign_str(From: Str);
		procedure Assign_PChar(From: PChar);
		procedure Assign_String(const From: String);
		procedure Append_String(const From: String);
		function CharAt(i: Integer): String;
		procedure ReplaceChar(At: Integer; c: Str);
		function Compare(With_str: Str): Integer;
		function Compare_substr(From, To_: Integer; With_str: Str;
			With_from, With_to: Integer): Integer;
		function Substr(From, To_: Integer): String;
		function As_string: String;
		function Like_s(With_s: Str): Boolean;
		function ToUpper: String;
		function ToLower: String;
	end;
	procedure Dispose_str(var S: Str);
	type
	{$ELSE}
	Str = String;
	{$ENDIF}

	{$IFDEF _D5orHigher}
    Tarray_of_integer = array of integer;
    {$ELSE}
    Tarray_of_integer = array[0..32767] of integer;
    {$ENDIF}
    
    PByte_Array = ^TByte_Array;
    TByte_Array = array[0..32767] of Byte;    
    

#VCL:   AL4_object = class; // forward declaration
#KOL:   AL4_object = ^TAL4_object; // forward declaration
#VCL:    Ref_obj = class
#KOL:    Ref_obj = ^TRef_obj;
#KOL:    TRef_obj = object(TObj)
	        public Obj: AL4_object;
	        public Count: Integer;
//?{Thread}        
		public Thread_handle: Cardinal;
		public Migrated_ref: Ref_obj;
		public Parent_ref: Ref_obj;
//.
	        public procedure Ref_dec_weak {$IFDEF _D5orHigher} () {$ENDIF} ;
//?{Thread}
				virtual;
//.
	        public procedure Ref_dec_hard {$IFDEF _D5orHigher} () {$ENDIF};
//?{Thread}
				virtual;
//.
	        public procedure Ref_inc_hard {$IFDEF _D5orHigher} () {$ENDIF};
//?{Thread}
				virtual;
//.
			public procedure Discard_struct();
	        public function Owned_by(owner: Ref_obj): Ref_obj;
		{$IFDEF DEBUG}
		public Index_ref_obj: Integer;
		public Count_created: Integer;
		{$ENDIF}
    	 end;
    	 
#VCL:   Ref_obj_weak = class(Ref_obj)
#VCL:	end;

#KOL:	AL4_handler = ^TAL4_handler;
#VCL:	AL4_handler = class
#KOL:	TAL4_handler = object(TObj)
			public procedure Handler; virtual;
		end;
		
//------------------------------------------------------------------------------
{$IFDEF KOL}
	DynamicArray = ^TDynamicArray;
	TDynamicArray = object(TObj)
		Shared_array: Boolean;
		procedure Discard; virtual;
	end;
{$ELSE}
	DynamicArray = class
		Tag: {$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF};
		Shared_array: Boolean;
		procedure Discard; virtual;
	end;
{$ENDIF}

{$IFDEF USE_DynAObj}

#VCL:     DynAObj = class(DynamicArray)
#KOL:     DynAObj = ^TDynAObj;
#KOL:     TDynAObj = object(TDynamicArray)
        public none_obj: Ref_obj;
        protected record_len: Integer;
        public
#VCL:        List: TList;
#KOL:        List: PList;
			{$IFDEF ARRAYDETAILS}
				Array_index: Integer;
				Info: PChar;
			{$ENDIF}
		Base_DynAObj: DynAObj;
		Start_index: Integer;
		Count_fixed: Integer;
		Is_weak: Boolean;
        public constructor Create(none_: Ref_obj);
        
		PUBLIC
        Count: function: Integer of object; 
        GetObjects: function(Idx: Integer): Ref_obj of object;
        SetObjects: procedure(Idx: Integer; Value: Ref_obj) of object;
        Add: procedure(Index: Integer; X: Ref_obj) of object;
        Add_noincref: procedure(Index: Integer; X: Ref_obj) of object;
        Delete: procedure(Index, Count_delete: Integer) of object;
        IndexOf: function(Obj: Ref_obj): Integer of object;
        Swap: procedure(i, j: Integer) of object;
        Clear: procedure of object;
        
        PUBLIC
		function DynAObj_Count: Integer;
		function DynAObj_Get(Idx: Integer): Ref_obj; 
		procedure DynAObjHard_Put(Idx: Integer; Value: Ref_obj); 
		procedure DynAObjHardWeak_Add(Idx: Integer; Value: Ref_obj); 
		procedure DynAObj_Add_noincref(Idx: Integer; Value: Ref_obj); 
		procedure DynAObjHard_Delete(Idx: Integer; Count_delete: Integer); 
		function DynAObj_IndexOf(Value: Ref_obj): Integer;
		procedure DynAObj_Swap(i, j: Integer);
		procedure DynAObjWeak_Put(Idx: Integer; Value: Ref_obj); 
		procedure DynAObjWeak_Delete(Idx: Integer; Count_delete: Integer);
		procedure DynAObj_Clear; 
		
		procedure DynARecord_Put(Idx: Integer; Value: Ref_obj);
		procedure DynARecord_Add_clonerec(Idx: Integer; Value: Ref_obj);
		procedure Add_record(Idx: Integer; const Value);
		procedure DynAObjRecord_Delete_release(Idx: Integer; Count_delete: Integer);

		function FixAObj_Count: Integer;
		function FixAObj_Get(Idx: Integer): Ref_obj; 
		procedure FixAObj_Put(Idx: Integer; Value: Ref_obj); 
		function FixAObj_IndexOf(Value: Ref_obj): Integer;
		procedure FixAObj_Swap(i, j: Integer);
		procedure FixAObj_Clear;
		
        // Used only in case when new object is added to an array
        // of hard links, to provide correct usage Count value:
        public procedure Ref_dec_last{$IFDEF _D5orHigher} () {$ENDIF};
        function Contains(Obj: Ref_obj): Boolean;
        public procedure Remove(Obj: Ref_obj);
        public procedure Dispose;
        destructor Destroy;
#VCL:            override;
#KOL:            virtual;
		procedure Discard; 
#VCL:            override;
#KOL:            virtual;
		procedure Copy(To_index: Integer; Source: DynAObj);
		procedure Fill(To_index: Integer; Obj: Ref_obj; Fill_count: Integer);
		procedure Repeat_(To_index: Integer; Source: DynAObj; Count_repeat: Integer);
		procedure Extend(Obj: Ref_obj; Count_extend: Integer);
		procedure Append(Source: DynAObj; Count_append: Integer);
		
		public Clone_array: function: DynAObj of object;
		function DynARecord_Clone_array: DynAObj;
		function DynAObjHard_Clone_array: DynAObj;
		function DynAObjWeak_Clone_array: DynAObj;
		function FixAObjHard_Clone_array: DynAObj;
		
		procedure Allocate(New_size: Integer);
		procedure Unref_hard;
		procedure Unref_weak;
		
		procedure Clear_struc;
     end;
     
{$ENDIF}


//------------------------------------------------------------------------------
{$IFDEF KOL}
	{$IFnDEF _D6orHigher}
	PInteger = ^Integer;
	{$ENDIF}
{$ENDIF}

{$IFDEF USE_DynAInt}
	{$IFDEF INT_32}
	IntegerValue = Integer;
	{$ELSE}
	IntegerValue = Int64;
	{$ENDIF}
	PIntegerValue = ^IntegerValue;

#VCL:     DynAInt = class(DynamicArray)
#KOL:     DynAInt = ^TDynAInt;
#KOL:     TDynAInt = object(TDynamicArray)
			 {$IFDEF INT_32}
#VCL:        List: TList;
#KOL:        List: PList;
			 {$ELSE}
			 Ai64: array of Int64;
			 {$ENDIF}
			{$IFDEF ARRAYDETAILS}
				Array_index: Integer;
				Info: PChar;
			{$ENDIF}
			Base_DynAInt: DynAInt;
			Base_Pointer: PIntegerValue;
			Start_index: Integer;
			Count_fixed: Integer;
			Clamp_mask: Integer;
        public constructor Create;
        
        PUBLIC
		Count: function: Integer of object; 
        GetIntegers: function(Idx: Integer): IntegerValue of object; 
        SetIntegers: procedure(Idx: Integer; Value: IntegerValue) of object; 
        Add: procedure(Idx: Integer; Value: IntegerValue) of object;
        Delete: procedure(Idx: Integer; Count: Integer) of object; 
        IndexOf: function(Value: IntegerValue): Integer of object;
        Swap: procedure(i, j: Integer) of object;
        
		PUBLIC
		function DynAInt_Count: Integer;
		function DynAInt_Get(Idx: Integer): IntegerValue;
		procedure DynAInt_Put(Idx: Integer; Value: IntegerValue);
		procedure DynAInt_Add(Idx: Integer; Value: IntegerValue);
		function DynAInt_IndexOf(Value: IntegerValue): Integer;
		procedure DynAInt_Delete(Idx: Integer; Count_delete: Integer);
		procedure DynAInt_Swap(i, j: Integer);
		
		function FixAInt_Count: Integer;
		function FixAInt_Get(Idx: Integer): IntegerValue; 
		procedure FixAInt_Put(Idx: Integer; Value: IntegerValue); 
		function FixAInt_IndexOf(Value: IntegerValue): Integer;
		procedure FixAInt_Swap(i, j: Integer);

		function FixAInt_Array_Get(Idx: Integer): IntegerValue; 
		procedure FixAInt_Array_Put(Idx: Integer; Value: IntegerValue);
		procedure FixAInt_Array_Swap(i, j: Integer);

		function FixAInt_Clamp_Get(Idx: Integer): IntegerValue; 
		procedure FixAInt_Clamp_Put(Idx: Integer; Value: IntegerValue);
		procedure FixAInt_Clamp_Swap(i, j: Integer); 

		public procedure Dispose;
        public destructor Destroy; 
#VCL:            override;
#KOL:            virtual;
		procedure Discard; 
#VCL:            override;
#KOL:            virtual;
        procedure Clear;
        procedure Nullify;

        procedure Remove(Value: IntegerValue); 
		function Contains(Value: IntegerValue): Boolean;
		procedure Fill(To_index: Integer; Value: IntegerValue; Fill_count: Integer);
        procedure Copy(To_index: Integer; Source: DynAInt);
		procedure Repeat_(To_index: Integer; Source: DynAInt; Count_repeat: Integer);
		public procedure Extend(Value: IntegerValue; Count_extend: Integer);
		public procedure Append(Source: DynAInt; Count_append: Integer);
		
		public Clone_array: function: DynAInt of object;
		function DynAInt_Clone_array: DynAInt;
		function FixAInt_Clone_array: DynAInt;
		
		procedure Allocate(New_size: Integer);
     end;
     
{$ENDIF}

//------------------------------------------------------------------------------
  
#VCL:    AL4_object = class
#KOL:    TAL4_object = object(TObj)

{$IFDEF USERTTI}
		public function RTTI_object_type: Integer; virtual;

//#RTTI_type_info_methods1

{$ENDIF}
        //just for debugging:
        public TOTAL_obj_index: Integer;
        public constructor Create{$IFDEF _D5orHigher} () {$ENDIF};

        // Fastest way to check if a variable is referencing the NONE
        public Is_NONE_object: Boolean;

        // Back reference to a Ref_obj, containing a hard link onto the object
        private h_link: Ref_obj;

        public property hard_link: Ref_obj
            read h_link
            write h_link;

        // Back reference to a Ref_obj, containing a weak link to the object
        public weak_link: Ref_obj;

        // Additional link onto the object itself to make changes in fields.
        // For the NONE object, it is referencing the dummy_obj, so NONE is never
        // changed (though it is not necessary to check value for NONE).
        public write: AL4_object;

        //------------- for OWNED BY children:
#VCL:        protected children: TList;
#KOL:        protected children: PList;

        public class function NONE_obj_instance{$IFDEF _D5orHigher} () {$ENDIF}
        	   : Ref_obj; virtual;

        public function Dummy_obj_instance{$IFDEF _D5orHigher} () {$ENDIF}
        	   : Ref_obj; virtual;

        public class function NONE_base_obj{$IFDEF _D5orHigher} () {$ENDIF}
        	   : AL4_object; virtual;


        public procedure CONSTRUCT; virtual;
        public procedure DESTRUCT; virtual;
        
        public procedure Erase{$IFDEF _D5orHigher} () {$ENDIF}; virtual;
        //public OnErase: TNotifyEvent;

#VCL:   class function New_instance: Ref_obj; virtual;
    end;
    
#VCL:    Noneclass_AL4_object = class(AL4_object)
#KOL:    Noneclass_AL4_object = ^TNoneclass_AL4_object;
#KOL:    TNoneclass_AL4_object = object(TAL4_object)
        public procedure Erase{$IFDEF _D5orHigher} () {$ENDIF};
#VCL:        override;
#KOL:        virtual;
        procedure CONSTRUCT{$IFDEF _D5orHigher} () {$ENDIF}; 
#VCL:        override;
#KOL:        virtual;
        procedure DESTRUCT{$IFDEF _D5orHigher} () {$ENDIF}; 
#VCL:        override;
#KOL:        virtual;
#VCL:        class function New_instance: Ref_obj;
#VCL:        override;
    end;
    
    {$IFNDEF NOEXCEPTIONS}
    AL4_Exception = class(Exception)
    end;
    
    Stop_exception = class(AL4_Exception)
        public constructor Create(msg: String);
    end;

    TooDeepRecursionException = class(AL4_Exception)
    end;

    OutOfMemoryException = class(AL4_Exception)
    end;
    {$ENDIF}
    
#VCL:	Structure_any = class(AL4_object)
#KOL:	Structure_any = ^TStructure_any;
#KOL:	TStructure_any = object(TAL4_object)
			constructor Create{$IFDEF _D5orHigher} () {$ENDIF};
			public function Clone{$IFDEF _D5orHigher} () {$ENDIF}
				   : Ref_obj; virtual;
		end;
		
#KOL:	var fun_dynaobj_discard_enter: procedure; 
#KOL:	var fun_dynaobj_discard_leave: procedure; 

procedure Zero_structure(var St; Size: Integer);

{$IFDEF USE_DynAObj}
function Dismiss_structure(var source: Ref_obj): Ref_obj;
function Dismiss_array_item(a: DynAObj; index: Integer): Ref_obj;
{$ENDIF}

function new_Ref_obj(obj_: AL4_object; count_: Integer): Ref_obj;
#VCL: function new_Ref_obj_weak(obj_: AL4_object; count_: Integer): Ref_obj_weak;

threadvar List_ref_obj_free: {$IFDEF KOL} PList
						     {$ELSE} TList
						     {$ENDIF} ;
    
const MAX_CACHED_ARRAYS = 1024;
threadvar List_lists_temps: {$IFDEF KOL} PList 
							{$ELSE} TList 
							{$ENDIF} ;

{$IFDEF USERTTI}
//#RTTI_type_info_tables
function RTTI_type_name(index, flags: Integer): string;
function RTTI_type_kind(index: Integer): Integer;
function RTTI_count_classes{$IFDEF _D5orHigher} () {$ENDIF}: Integer;
function RTTI_base_class(class_index: Integer): Integer;
function RTTI_starting_class_record_index(class_index: Integer): Integer;
function RTTI_count_class_records(class_index: Integer): Integer;
procedure RTTI_class_records(class_index: Integer; records: DynAInt);
procedure RTTI_class_enums(class_index: Integer; enums: DynAInt);
function RTTI_starting_enum_items_index(enum_type_index: Integer): Integer;
function RTTI_enum_count(enum_type_index: Integer): Integer;
function RTTI_enum_item(enum_type_index, index_item: Integer): String;
{$ENDIF}

{$IFDEF USE_DynAInt}
function New_DynAInt: DynAInt;

function New_FixAInt(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAInt; Index_from, Index_To: Integer): DynAInt;
function New_FixAInt_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAInt;
function New_FixAInt_init(List_temps: {$IFDEF KOL}PList
									  {$ELSE}TList
									  {$ENDIF};
	const X: array of Integer): DynAInt;
function New_FixAInt_Array(List_temps: {$IFDEF KOL}PList
									   {$ELSE}TList
									   {$ENDIF};
	X: PIntegerValue; Total_count, Start_index, End_index: Integer): DynAInt;
function New_FixAInt_Clamp(List_temps: {$IFDEF KOL}PList
								       {$ELSE}TList
								       {$ENDIF};
	X: PIntegerValue; Start_index, End_index: Integer): DynAInt;
	
procedure Copy_to_array_Int(Dest: PInteger; To_index, Dest_size: Integer;
	Source: DynAInt);
{$ENDIF}	


{$IFDEF USE_DynAObj}
function New_DynARecord(none_record: Pointer; rec_len: Integer): DynAObj;

function New_DynAObjHard(none_obj: Ref_obj): DynAObj;
function New_DynAObjWeak(none_obj: Ref_obj): DynAObj;
function New_DynAStruct(none_obj: Ref_obj): DynAObj;

function New_FixAObj(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAObj; From_index, To_index: Integer): DynAObj;
function New_FixAObjWeak(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAObj;
function New_FixAObjHard_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Ref_obj): DynAObj;
function New_FixAObjWeak_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Ref_obj): DynAObj;
	
function New_FixAObjHard_N(none_obj: Ref_obj; count_items: Integer): DynAObj;
function New_FixAObjWeak_N(none_obj: Ref_obj; count_items: Integer): DynAObj;
{$ENDIF}
    
type TCreateNewNoneclass = function: Ref_obj;
function do_NoneObjInit(
	var none_obj_ret: AL4_object;
	var dummy_obj_ret: AL4_object; 
	create_new_noneclass: TCreateNewNoneclass): AL4_object;
	
function NoneObjInit_AL4_object: Noneclass_AL4_object;

function New_AL4_object: AL4_object;
function New_Noneclass_AL4_object: NoneClass_AL4_object;
function New_Noneclass_AL4_object_ref: Ref_obj;

var NoneObj_AL4_object: Noneclass_AL4_object;
var DummyObj_AL4_object: Noneclass_AL4_object;
    
procedure Object_assign_hard(var Dest: Ref_obj; Src: AL4_object);
//procedure Object_assign_hard(var Dest: Ref_obj; Src: Ref_obj); overload;
procedure Object_assign_weak(var Dest: Ref_obj; Src: AL4_object);
procedure Object_assign_hard_noincref(var Dest: Ref_obj; Src: AL4_object);
procedure Object_assign_weak_noincref(var Dest: Ref_obj; Src: AL4_object);

{$IFnDEF _D5orHigher}
{$IFnDEF FPC}
type
  Int64 = record
    Lo, Hi: LONGWORD; 
  end;
  PInt64 = ^Int64;
  
//function StrToInt64(const S: string): Int64;
{$ENDIF}
{$ENDIF}

var Test_caller: Int64;

threadvar Recursion_counter: Integer;

var Max_recursion_deep: Integer = 128;

threadvar total_obj_counter: Integer;
        // Object NONE instance (single for a class)
threadvar None_obj: Ref_obj;
        // Object Dummy instance (single for a class)
threadvar dummy_obj: Ref_obj;

#KOL:type    POverList = ^TOverList;
#KOL:        TOverList = object(TList)
#KOL:           property List: PPointerList read fItems;
#KOL:        end;

procedure release_temp_lists(List: 
	{$IFDEF KOL} PList
	{$ELSE} TList
	{$ENDIF});
procedure clear_list_temps(List: 
	{$IFDEF KOL} PList
	{$ELSE} TList 
	{$ENDIF});
function allocate_list_temps: 
	{$IFDEF KOL} PList
	{$ELSE} TList 
	{$ENDIF};
 
//------------------------------------------------------------------------------
{$IFDEF USE_DynAReal}
type
	PReal = ^Double;
#VCL:     DynAReal = class(DynamicArray)
#KOL:     DynAReal = ^TDynAReal;
#KOL:     TDynAReal = object(TDynamicArray)
			{$IFDEF FPC}
			Arr: array of Double;
			{$ELSE}
        	Arr: PReal;
        	Arr_len: Integer;
        	Arr_count: Integer;
        	{$ENDIF}
			{$IFDEF ARRAYDETAILS}
				Array_index: Integer;
				Info: PChar;
			{$ENDIF}
			Base_DynAReal: DynAReal;
			Base_Pointer: PDouble;
			Start_index: Integer;
			Count_fixed: Integer;
			Clamp_mask: Integer;
        public constructor Create;
        
        PUBLIC
		Count: function: Integer of object; 
        GetReals: function(Idx: Integer): Real of object;
        SetReals: procedure(Idx: Integer; Value: Real) of object; 
        Add: procedure(Index: Integer; Value: Real) of object;
        Delete: procedure(Idx: Integer; Count: Integer) of object; 
        IndexOf: function(Value: Real): Integer of object;
        Swap: procedure(i, j: Integer) of object;
        
		PUBLIC
		function DynAReal_Count: Integer;
		function DynAReal_Get(Idx: Integer): Real;
		procedure DynAReal_Put(Idx: Integer; Value: Real);
		procedure DynAReal_Add(Idx: Integer; Value: Real);
		procedure DynAReal_Delete(Idx: Integer; Count_delete: Integer);
		procedure DynAReal_Swap(i, j: Integer);
		
		function FixAReal_Count: Integer;
		function FixAReal_Get(Idx: Integer): Real; 
		procedure FixAReal_Put(Idx: Integer; Value: Real);
		procedure FixAReal_Swap(i, j: Integer);

		function FixAReal_Array_Get(Idx: Integer): Real; 
		procedure FixAReal_Array_Put(Idx: Integer; Value: Real); 

		function FixAReal_Clamp_Get(Idx: Integer): Real; 
		procedure FixAReal_Clamp_Put(Idx: Integer; Value: Real);
		procedure FixAReal_Clamp_Swap(i, j: Integer); 

		public procedure Dispose;
        public destructor Destroy; 
#VCL:            override;
#KOL:            virtual;
		procedure Discard; 
#VCL:            override;
#KOL:            virtual;
        procedure Clear;
        procedure Nullify;
        procedure Copy(To_index: Integer; Source: DynAReal);
		procedure Fill(To_index: Integer; Value: Real; Fill_count: Integer);
		procedure Repeat_(To_index: Integer; Source: DynAReal; Count_repeat: Integer);
        //public procedure Extend(Value: Real; Count_extend: Integer);
        //public procedure Append(Source: DynAReal; Count_append: Integer);
		
		public Clone_array: function: DynAReal of object;
		function DynAReal_Clone_array: DynAReal;
		function FixAReal_Clone_array: DynAReal;
		
		procedure Allocate(New_size: Integer);
     end;
     
function New_DynAReal: DynAReal;

function New_FixAReal(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAReal; Index_from, Index_To: Integer): DynAReal;
function New_FixAReal_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAReal;
function New_FixAReal_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PDouble; Start_index, End_index: Integer): DynAReal;
function New_FixAReal_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Real): DynAReal;
	
function New_FixAReal_Clamp(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PDouble; Start_index, End_index: Integer): DynAReal;
{$ENDIF}


//------------------------------------------------------------------------------
{$IFDEF USE_DynAByte}

{$IFDEF USE_FirstByte}
	{$DEFINE DECLARE_FirstByte}
{$ENDIF}

type
#VCL:     DynAByte = class(DynamicArray)
#KOL:     DynAByte = ^TDynAByte;
#KOL:     TDynAByte = object(TDynamicArray)
#VCL:       List: TList;
#KOL:       List: PList;
        	fCount: Integer;
			{$IFDEF ARRAYDETAILS}
				Array_index: Integer;
				Info: PChar;
			{$ENDIF}
			Base_DynAByte: DynAByte;
			Base_Pointer: PByte;
			Start_index: Integer;
			Clamp_mask: Integer;
        public constructor Create;
        
        PUBLIC
		Count: function: Integer of object; 
        GetBytes: function(Idx: Integer): Byte of object; 
        SetBytes: procedure(Idx: Integer; Value: Byte) of object;
        Add: procedure(Index: Integer; Value: Byte) of object;
        Delete: procedure(Idx: Integer; Count_delete: Integer) of object;
        Swap: procedure(i, j: Integer) of object;
        {$IFDEF DECLARE_FirstByte}
        FirstByte: function: PByte of object;
        {$ENDIF}
        First_Byte: function: PByte of object;
        
        function GetBools(Idx: Integer): Boolean; 
        procedure SetBools(Idx: Integer; Value: Boolean);
		function IndexOf(Value: Byte): Integer;
        
		PUBLIC
		function DynAByte_Count: Integer;
		function DynAByte_Get(Idx: Integer): Byte;
		procedure DynAByte_Put(Idx: Integer; Value: Byte);
		procedure DynAByte_Add(Idx: Integer; Value: Byte);
		procedure DynAByte_Delete(Idx: Integer; Count_delete: Integer);
		procedure DynAByte_Swap(i, j: Integer);
		{$IFDEF DECLARE_FirstByte}
		function DynAByte_FirstByte: PByte;
		{$ENDIF}
		function DynAByte_First_Byte: PByte;
		
		function FixAByte_Count: Integer;
		function FixAByte_Get(Idx: Integer): Byte; 
		procedure FixAByte_Put(Idx: Integer; Value: Byte);
		{$IFDEF DECLARE_FirstByte} 
		function FixAByte_FirstByte: PByte;
		{$ENDIF}
		function FixAByte_First_Byte: PByte;

		function FixAByte_Array_Get(Idx: Integer): Byte; 
		procedure FixAByte_Array_Put(Idx: Integer; Value: Byte);
		{$IFDEF DECLARE_FirstByte} 
		function FixAByte_Array_FirstByte: PByte;
		{$ENDIF}
		function FixAByte_Array_First_Byte: PByte;

		function FixAByte_Clamp_Get(Idx: Integer): Byte; 
		procedure FixAByte_Clamp_Put(Idx: Integer; Value: Byte);
		procedure FixAByte_Clamp_Swap(i, j: Integer);

		public procedure Dispose;
        public destructor Destroy; 
#VCL:            override;
#KOL:            virtual;
		procedure Discard; 
#VCL:            override;
#KOL:            virtual;
        procedure Remove(Value: Byte); 
        procedure Clear;
        procedure Nullify;
		function Contains(Value: Byte): Boolean;
        procedure Copy(To_index: Integer; Source: DynAByte);
		procedure Fill(To_index: Integer; Value: Byte; Fill_count: Integer);
		procedure Repeat_(To_index: Integer; Source: DynAByte; Count_repeat: Integer);
		public procedure Extend(Value: Byte; Count_extend: Integer);
		public procedure Append(Source: DynAByte; Count_append: Integer);

		public Clone_array: function: DynAByte of object;
		function DynAByte_Clone_array: DynAByte;
		function FixAByte_Clone_array: DynAByte;
		
		procedure Allocate(New_size: Integer);
     end;
     
function New_DynAByte: DynAByte;

function New_FixAByte_bools(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const a: array of Boolean): DynAByte;
function New_FixAByte(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAByte; Index_from, Index_To: Integer): DynAByte; 
function New_FixAByte_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAByte; 
function New_FixAByte_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PByte; Total_items, Start_index, End_index: Integer): DynAByte;
function New_FixAByte_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Byte): DynAByte;
function New_FixAByte_Clamp(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PByte; Start_index, End_index: Integer): DynAByte;
	
procedure Copy_to_array(Dest: PByte; To_index, Dest_size: Integer;
	Source: DynAByte);
{$ENDIF USE_DynAByte}
     

//------------------------------------------------------------------------------
{$IFDEF USE_DynAStr}
type
 	PPchar = ^PChar;
	
#VCL:     DynAStr = class(DynamicArray)
#KOL:     DynAStr = ^TDynAStr;
#KOL:     TDynAStr = object(TDynamicArray)
#VCL:        public List: TStringList;
#KOL:        public List: PStrListAlt;
			{$IFDEF ARRAYDETAILS}
				Array_index: Integer;
				Info: PChar;
			{$ENDIF}
			Base_DynAStr: DynAStr;
			Base_array: PPChar;
			Start_index: Integer;
			Count_fixed: Integer;
        public constructor Create;
        
        PUBLIC
		Count: function: Integer of object; 
        GetStrings: function(Idx: Integer): String of object; 
        SetStrings: procedure(Idx: Integer; const Value: String) of object; 
        Add: procedure(Idx: Integer; const Value: String) of object;
        Delete: procedure(Idx: Integer; Count_delete: Integer) of object; 
        IndexOf: function(const Value: String): Integer of object;
        Swap: procedure(i, j: Integer) of object;
        
		PUBLIC
		function DynAStr_Count: Integer;
		function dynAStr_Get(Idx: Integer): String;
		procedure DynAStr_Put(Idx: Integer; const Value: String);
		procedure DynAStr_Add(Idx: Integer; const Value: String);
		procedure DynAStr_Delete(Idx: Integer; Count_delete: Integer);
		function DynAStr_IndexOf(const Value: String): Integer;
		procedure DynAStr_Swap(i, j: Integer);
		function FixAStr_Count: Integer;
		function FixAStr_Get(Idx: Integer): String; 
		procedure FixAStr_Put(Idx: Integer; const Value: String);
		procedure FixAStr_Swap(i, j: Integer);
		function FixAStr_IndexOf(const Value: String): Integer;

		function FixAStr_Array_Get(Idx: Integer): String; 

        public procedure Dispose;
        public destructor Destroy; 
#VCL:            override;
#KOL:            virtual;
		procedure Discard; 
#VCL:            override;
#KOL:            virtual;
        procedure Remove(const Value: String); 
        procedure Clear;
        procedure Nullify;
		function Contains(const Value: String): Boolean;
        procedure Copy(To_index: Integer; Source: DynAStr);
		procedure Fill(To_index: Integer; const Value: String; Fill_count: Integer);
		procedure Repeat_(To_index: Integer; Source: DynAStr; Count_repeat: Integer);
		public procedure Extend(const Value: String; Count_extend: Integer);
		public procedure Append(Source: DynAStr; Count_append: Integer);
		{$IFDEF DEBUG}
		public function Get_items(Idx: Integer): String;
		public property Items[Idx: Integer]: String read Get_items;
		public function Get_text: String;
		public property Text_: String read Get_text;
		public function Get_count: Integer; 
		public property Count_: Integer read Get_count;
		{$ENDIF}
		
		public Clone_array: function: DynAStr of object;
		function DynAStr_Clone_array: DynAStr;
		function FixAStr_Clone_array: DynAStr;
		
		procedure Allocate(New_size: Integer);
     end;
function New_DynAStr: DynAStr;

function New_FixAStr(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAStr; Index_from, Index_To: Integer): DynAStr;
function New_FixAStr_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAStr;
function New_FixAStr_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X:array of String): DynAStr;
function New_FixAStr_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	a: PPchar; a_size, Index_from, Index_To: Integer): DynAStr;
	
procedure Do_split_string(
	X_L: DynAStr; const X_S, X_By: String);	
{$ENDIF}

//------------------------------------------------------------------------------
procedure Init_var_int(var i: IntegerValue);
procedure Init_var_byte(var i: Byte);
procedure Init_var_real(var r: Real);
procedure Init_var_str(var s: String);
procedure Init_var_bool(var b: Boolean);
procedure Init_var_obj(var obj: Ref_obj; none_obj: AL4_object);

{$IFDEF USE_DynAStr} procedure Init_var_dynastr(var A: DynAStr); {$ENDIF}
{$IFDEF USE_DynAInt} procedure Init_var_dynaint(var A: DynAInt); {$ENDIF}
{$IFDEF USE_DynAByte} procedure Init_var_dynabyte(var A: DynAByte); {$ENDIF}
{$IFDEF USE_DynAReal} procedure Init_var_dynareal(var A: DynAReal); {$ENDIF}
{$IFDEF USE_DynAObj} 
procedure Init_var_hard(var A: DynAObj; none_obj: AL4_object);
procedure Init_var_weak(var A: DynAObj; none_obj: AL4_object);
{$ENDIF}

type PBooleanArray = ^TBooleanArray;
     TBooleanArray = array[0..65535] of Boolean;
     PBoolean = ^Boolean;
     
     PIntegerArray = ^TIntegerArray;
     TIntegerArray = array[0..65535] of Integer;
     
     PDoubleArray = ^TDoubleArray;
     TDoubleArray = array[0..65535] of Double;
     
     PStringArray = ^TStringArray;
     TStringArray = array[0..65535] of String;

function Fixed_Bytes(A: PByte; max_sz: Integer; i: Integer): Byte;
function Fixed_Bools(A: PBoolean; max_sz: Integer; i: Integer): Boolean;
function Fixed_Reals(A: PDouble; max_sz: Integer; i: Integer): Real;
function Fixed_Integers(A: PInteger; max_sz: Integer; i: Integer): Integer;

{$IFDEF USE_DynAStr}
function Fixed_Strings(A: PPChar; max_sz: Integer; i: Integer): String;
{$ENDIF}

procedure Set_fixed_Bytes(A: PByte; max_sz: Integer; i: Integer; value: Byte);
procedure Set_fixed_Bools(A: PBoolean; max_sz: Integer; i: Integer; value: Boolean);
procedure Set_fixed_Reals(A: PDoubleArray; max_sz: Integer; i: Integer; value: Real);
procedure Set_fixed_Integers(A: PIntegerArray; max_sz: Integer; i: Integer; value: Integer);

function Single_symbol(S: String; Pos: Integer): String;
function Change_single_symbol(S: String; Pos: Integer; const sym: String): String;
{$IFDEF FPC}
function Change_single_symbol_str(S: Str; Pos: Integer; const sym: String): String;
{$ENDIF}
function Substring(S: String; from: Integer; to_: Integer): String;
function CompareSubstrings(const S1, S2: String;
    from1, to1, from2, to2: Integer): Integer;
function CompareSubstrWithStr(const S1: String;  
    from1, to1: Integer; const S2: String): Integer;
function like_str(const S1: String; const S2: String): Boolean;
function ArrayContainsInt(const A: array of Integer; X: Integer): Boolean;
function ArrayContainsByte(const A: array of Byte; X: Byte): Boolean;
function ArrayContainsStr(const A: array of String; const X: String): Boolean;
function Replace_symbol(S: String; i: Integer; r: String): String;
{$IFDEF FPC}
type P_UTF8Char = ^TUTF8Char;
{$ENDIF}
function s2i(const s: String): Integer;
function i2s(i: Integer): String;
function Int2Str(x: Integer): String;
function Real2Str(x: Real): String;
function Bool2Str(x: Boolean): String;
function Int(const s: String): Integer;
function RealAsInt(X: Real): Integer;
function EnumAsInt(X: Integer): Integer;

function hex16(value16: Integer): String;
function StrHex16(const s: string): String;

function ShiftLeft(i, n: Integer): Integer;
function ShiftRight(i, n: Integer): Integer;
function RotateLeft(i, m: Integer): Integer;
function RotateRight(i, m: Integer): Integer;
function Find_str(S: String; Pattern: String): Integer;
#VCL:procedure Split_string(L: TStringList; const S: String; const By_pattern: String);
#KOL:procedure Split_string(L: PStrList; const S: String; const By_pattern: String);
function IndexOfStr(const A: array of PChar; const S: String): Integer;
function Is_none(obj: Ref_obj): Boolean;
function Inc_var(var i: Integer): Integer;
function Dec_var(var i: Integer): Integer;
function Safe_div(X: Real; Y: Real): Real;
{$IFDEF FPC_LAZARUS_DOES_NOT_LIKE_NAN}
function Safe_mul(X: Real; Y: Real): Real;
function Safe_add(X: Real; Y: Real): Real;
function Safe_sub(X: Real; Y: Real): Real;
function Safe_cmp(X: Real; Y: Real): Real;
{$ENDIF}
function Safe_div_int(X: Integer; Y: Integer): Integer;
function Safe_rest(X: Integer; Y: Integer): Integer;
procedure STOP(msg: String);
function Infinity: Real;
function NAN_constant: Real;

{$IFnDEF _D6orHigher}
const
	NaN         =  0.0 / 0.0;
	NegInfinity = -1.0 / 0.0;

function IsNan(const AValue: Double): Boolean;
{$ENDIF}

#VCL:threadvar Errors: TStringList;
#KOL:threadvar Errors: PStrList;

{$IFNDEF NOEXCEPTIONS}
procedure Any_exception(e: Exception);
procedure Add_error_descr(s: String);
{$ENDIF}
procedure Reset_errors;
function Errors_count: Integer;
function Error_info(index: Integer): String;

function As_obj(X:Ref_obj; None_y: Ref_obj): Ref_obj;
procedure Clear_test_data(var test_lines: array of Int64; Len: Integer);
procedure Remove_test_data(var test_lines: array of Int64; from, to_: Integer);
procedure Output_test_data(const test_lines: array of Int64; Len: Integer;
#VCL:   test_assert: TList; 
#VCL:	test_assert_failed_text: TStringList;
#KOL:            test_assert: PList; test_assert_failed_text: PStrList;
            Class_test_file: String; Class_path_source: String);
procedure Assertion_failed(line:Integer;
#VCL:  var test_assert: TList; 
#VCL:  var test_assert_failed_text: TStringList;
#KOL:          var test_assert: PList; var test_assert_failed_text: PStrList;
          const assert_failed_text: String);

var sim_Write: procedure(const s: String);
	dup_Write: Boolean;
	
{$IFnDEF WRITE_DIRECT}
procedure Write_direct(const s: String);
type RedirectWrite = procedure (const s: String);
var Redirect_write: RedirectWrite = {$IFDEF FPC}@{$ENDIF} Write_direct;
{$ENDIF}
	
procedure AL4Write(const s: String);
procedure WriteLn(const s: String);
function ReadLine: String;

threadvar 
    {$IFDEF USE_DynAByte}    GlobalDummyArrayByte: DynAByte; {$ENDIF}
    {$IFDEF USE_DynAInt}     GlobalDummyArrayInt: DynAInt; {$ENDIF}
    {$IFDEF USE_DynAReal}    GlobalDummyArrayReal: DynAReal; {$ENDIF}
    {$IFDEF USE_DynAStr}     GlobalDummyArrayStr: DynAStr; {$ENDIF}
    {$IFDEF USE_DynAObj}     GlobalDummyArrayObjHard: DynAObj; 
                             GlobalDummyArrayObjWeak: DynAObj; {$ENDIF}
    dummy_var: Integer;
    
function Is_TEST_stage: Boolean;

procedure GetMemZ(var Buf: Pointer; Size: Integer);

threadvar global_activity_counter: Integer; 

#VCL: var long_operation_handlers: TList;
#KOL: var long_operation_handlers: PList;

#KOL: function NewStrListAlt: PStrListAlt;

procedure check_long_operation;

#debug:var Stack_functions: array[0..4095] of Integer;
#debug:var Stack_lines: array[0..4095] of Integer;
#debug:var SP_fun: Integer;

function Get_SP_fun: Integer;

// all function names are inserted here:
//==//==//==//==//==//==//==//==//==//==//==//==//==//==//==//==//==//==//==//==
#function_names:
        
function Get_trace_levels: Integer;
function Get_trace_fun(level: Integer): String;
function Get_trace_counter(level: Integer): Integer;

//------------------------------ 'debugging from IDE'

{$IFDEF DEBUG_STACK}
var stop_each_stmt: Boolean;
var stop_stack_level: Integer;
var stop_out_fun: Integer;
var stop_in_fun: Integer;
var breakpoints_functions: array of Integer;
var breakpoints_lines: array of Integer;

function _stop_(fun_index: Integer; line: Integer): Boolean;
procedure _out_(const fun_line: String; const vars: String);
function _i_(const name_var: String; value: Integer): String;
function _r_(const name_var: String; value: double): String;
function _s_(const name_var: String; const value: String): String;
function _s_quote_(s: String): String;
function _b_(const name_var: String; value: Boolean): String;
function _b2s_(value: Boolean): String;
{$ENDIF}

//------------------------------
	
var nop: Integer;

// to implement .Name for enumeration items:

function Get_name(
	const Names: {$IFDEF FPC} PString
				 {$ELSE}	PStringArray
				 {$ENDIF}; Index, Max_index: Integer): String;
	
//{$DEFINE SAFEARRAYS} 
 
var set_none_boolean: Boolean;
	set_none_byte: Byte;
	set_none_integer: Integer;
	set_none_string: String;
	set_none_Double: Real;
	set_none_obj: Ref_obj;


function get_new_dll(var dll_handle: THandle; const base_dll_name: string): String;
function imin(x, y: IntegerValue): IntegerValue;
function imax(x, y: IntegerValue): IntegerValue;

function Array_item_Bool(A: PBoolean; A_Count, i: Integer): Boolean;
function Array_item_Byte(A: PByte; A_Count, i: Integer): Byte;
function Array_item_Int(A: PIntegerValue; A_Count, i: Integer): IntegerValue;
function Array_item_Real(A: PDouble; A_Count, i: Integer): Double;
function Array_item_String(A: PString; A_Count, i: Integer): String;
{$IFDEF FPC}
function Array_item_Str(A: PString; A_Count: Integer; i: Integer): Str;
function Array_item_String_Str(A: PString; A_Count, i: Integer): Str;
{$ENDIF}

function getDateTime(d: Double): TDateTime;

function pass_through(i: Integer): Integer;
function item_of_array_b(i: Integer; C: Cardinal; V: Boolean): Boolean;
function item_of_array_i(i: Integer; C: Cardinal; V: Integer): Integer;
function item_of_array_r(i: Integer; C: Cardinal; V: Double): Double;
function item_of_array_s(i: Integer; C: Cardinal; V: String): String;
function item_of_array_rec(
i: Integer; C: Cardinal; V: Pointer; none_V: Pointer): Pointer;
function dummy_record(size: Integer): Pointer;

var common_dummy_record: Pointer;
	dummy_record_size: Integer;

{$IFDEF ONLY_INTERESTING_THREADS}
var Interesting_ThreadId: Integer;
procedure Set_interesting_thread;
{$ENDIF}

{$IFDEF KOL}
{$IFDEF PUREPASCAL} // to work with PUREPASCAL defined
function Str2Int64( const S: AnsiString ): I64;
function Mul64i( const X: I64; Mul: Integer ): I64;
function Mul64EDX( const X: I64; M: Integer ): I64;
procedure IncInt64( var I64: I64; Delta: Integer );
function Neg64( const X: I64 ): I64;
{$ENDIF}
{$ENDIF}

{$IFDEF FPC}
  procedure New_str(var v: Str; const s: String);
  operator +(A: Str; B: Str): String;
  operator +(A: Str; B: String): String;
  operator +(A: String; B: Str): String;
  operator :=(const B: Str): String;
{$ENDIF}
  
  function Compare_strings(const A, B: String): Integer;
{$IFDEF FPC}                                             overload;
  function Compare_strings(const A: String; B: Str): Integer; overload;
  function Compare_strings(A: Str; const B: String): Integer; overload;
  function Compare_strings(A: Str; B: Str): Integer; overload;        
{$ENDIF}
  
  {$IFDEF _D5orHigher}
  procedure incr(var i: Int64); overload;
  procedure incr(var i: Integer); overload;
  {$ELSE}
  	{$DEFINE OLD_DELPHI}
  procedure incr(var i: Integer);
  {$ENDIF}
  
  {$IFnDEF _D5orHigher}
  procedure FreeAndNil(var Obj: TObject);
  {$ENDIF}
  
{$IFnDEF NOEXCEPTIONS}
  {$IFnDEF OLD_DELPHI}
	var id_limits: {$IFDEF KOL} PList {$ELSE} TList {$ENDIF};
	var kind_limits: {$IFDEF KOL} PList {$ELSE} TList {$ENDIF};
	var value_limits: array of Int64;
	
	var total_id_limits: Integer;
	var total_func: Int64;
	var total_loops: Int64;
  {$ENDIF}

	function limit_by_time(time: Double; units: Integer): Integer;
	function limit_by_func(limit_func: Integer): Integer;
	function limit_by_loops(limit_loops: Integer): Integer;
	procedure dismiss_limit(id: Integer);

type E_Limit_exceeded = class(AL4_Exception)
    	public id: Integer;
    	constructor Create_id(c_id: integer);
	 end;

#KOL:	Limit_handler = ^TLimit_handler;
#VCL:	Limit_handler = class(AL4_handler)
#KOL:	TLimit_handler = object(TAL4_handler)
			public procedure Handler; 
{$IFDEF KOL} virtual; {$ELSE} override; {$ENDIF}
		end;
{$ENDIF}

var Level_trace_blocks: Integer;
		
//==============================================================================
implementation
//==============================================================================

//?{String_functions}
uses unitC_String_functions;
//.

  {$IFnDEF _D5orHigher}
  procedure FreeAndNil(var Obj: TObject);
  var O2: TObject;
  begin
  		O2 := Obj;
  		Obj := nil;
  		O2.Free;
  end;
  {$ENDIF}


  {$IFDEF _D5orHigher}
   procedure incr(var i: Int64);
   begin
	   //inc(i.Lo);
	   //if i.Lo = 0 then inc(i.Hi);
	   inc(i);
   end;
   procedure incr(var i: Integer);
   begin
   	   inc(i);
   end;
  {$ELSE}
   procedure incr(var i: Integer);
   begin
   	   inc(i);
   end;
  {$ENDIF}
  

	
{$IFDEF FPC}
  //---------- implementing Str class
  
  procedure New_str(
  var v: Str; const s: String);
  begin
  	v := Str.Create;
  	v.Value := s;
  end;
  
  operator +(A: Str; B: Str): String;
  begin
  	Result := A.As_string + B.As_string;
  end;
  
  operator +(A: Str; B: String): String;
  begin
  	Result := A.As_string + B;
  end;
  
  operator +(A: String; B: Str): String;
  begin
  	Result := A + B.As_string;
  end;

  operator :=(const B: Str): String;
  begin
  	if B = nil then Result := ''
  	else Result := B.As_string;
  end;
{$ENDIF}
  
  function Compare_strings(const A, B: String): Integer;
  begin
  	Result := 
  		{$IFDEF KOL} StrComp(PChar(A), PChar(B))
  		{$ELSE} CompareStr(A, B) 
  		{$ENDIF} ;
  end;
  
{$IFDEF FPC}
  function Compare_strings(const A: String; B: Str): Integer;
  begin
  	Result := CompareStr(A, B.As_string); 
  end;
  
  function Compare_strings(A: Str; const B: String): Integer;
  begin
  	Result := CompareStr(A.As_string, B); 
  end;
  
  function Compare_strings(A: Str; B: Str): Integer;
  begin
  	Result := A.Compare(B); 
  end;
  
  procedure Dispose_str(var S: Str);
  begin
  	S.Free;
  	S := nil;
  end;
  
  function Str.Len: Integer;
  begin
  	if _Len = 0 then _Len := UTF8Length(Value);
  	Result := _Len;
  end;
  
  procedure Str.Assign_str(From: Str);
  begin
  	Value := From.Value;
  	_Len := From._Len;
  	Cursor_index := From.Cursor_index;
  	Cursor_point := From.Cursor_point;
  end;
  
  procedure Str.Assign_String(
  const From: String);
  begin
  	Value := From;
  	_Len := 0;
  	Cursor_index := 0;
  	Cursor_point := 0;
  end;
  
  procedure Str.Append_String(
  const From: String);
  begin
  	Value := Value + From;
  	_Len := 0;
  end;
  
  procedure Str.Assign_PChar(From: PChar);
  begin
  	Value := From;
  	_Len := 0;
  	Cursor_index := 0;
  	Cursor_point := 0;
  end;
  
  function Str.CharAt(
  i: Integer): String;
  var cLen, j: Integer;
  	  p, old: PChar;
  begin
  	if (i < 0) or (i >= Len) then 
  	begin Result := #0''; Exit;
  	end;
  	if Len = Length(Value) then begin
  		Result := PChar(Value)[i]; Exit;
  	end;
  	if (i = _Len-1) and (i <> Cursor_index) and (_Len >= 8) then
  	begin
  		Cursor_index := _Len;
  		Cursor_point := Length(Value);
  	end;
  	if i < Cursor_index then
  	begin
  		if (Cursor_point >= 8) and (i = Cursor_index - 1) then
  		begin
  			old := @PChar(Value)[Cursor_point];
  			p := @PChar(Value)[Cursor_point - 8];
  			p := @PChar(Value)[UTF8FindNearestCharStart(p, 8, 0)];
  			for j := 1 to 8 do
  			begin
  				Cursor_point := p - PChar(Value);
  				p := UTF8CharStart(p, _Len-Cursor_point, 1); 
  				if p = old then
  				begin
  					Cursor_index := i;
  					break;	
  				end;
  			end;
  		end;
  		if Cursor_index <> i then
  		begin
	  		Cursor_index := 0;
	  		Cursor_point := 0;
  		end;
  	end;
  	if i > Cursor_index then
  	begin
		//p := UTF8CodepointStart(@PChar(Value)[Cursor_point],
		p := UTF8CharStart(@PChar(Value)[Cursor_point],
			Length(Value)-Cursor_point, i-Cursor_index);
		if p = nil then begin RESULT := ''#0; Exit; end;
		
		Cursor_index := i;
		Cursor_point := p - PChar(Value);
  	end;
  	//if i = Cursor_index then --- now this is correct anyway
  	begin
  		p := @PChar(Value)[Cursor_point];
		//cLen := UTF8CodepointSize(p); 
		cLen := UTF8CharacterLength(p); 
		if cLen = 1 then Result := p^
		else Result := Copy(p, 1, cLen);
  	end;
  end;
  
  procedure Str.ReplaceChar(
  At: Integer; c: Str);
  var dummy: String;
  begin
  	  if (At < 0) or (At >= Len) then Exit;
  	  dummy := CharAt(At);
  	  if (Length(dummy) = 1) and (Length(c.Value) = 1) then
  	  begin
  	  	 UniqueString(Value);
  	  	 Move(PChar(c.Value)[c.Cursor_point], 
  	  	 	  PChar(Value)[Cursor_point],
  	  	 	  Length(c.Value));
  	  	 Exit;
  	  end;
  	  if (c.Len = Length(c.Value)) and (c.Len = 1) and (Len = Length(Value)) then
  	  begin
  	  	UniqueString(Value);
  	  	PChar(Value)[At] := PChar(c.Value)^;
  	  	Exit;
  	  end
  	  else
  	  begin
  	  Value := UTF8Copy(Value,1,At) + c.Value + UTF8Copy(Value, At+2, Len-At-1);
  	  end;
  	  Cursor_point := 0;
  	  Cursor_index := 0;
  end;
  
  function Str.Compare(
  With_str: Str): Integer;
  begin
  	if (Length(Value) = Len) and (Length(With_str.Value) = With_str.Len) then
  	begin
  		Result := StrLComp(PChar(Value), PChar(With_str.Value), 
  			Min(_Len, With_str._Len));
  	end
  	else begin
  		Result := UTF8CompareStr(Value, With_str.Value);
  	end;
	if Result = 0 then
	begin
		if _Len < With_str.Len then Result := -1
		else if _Len > With_str._Len then Result := +1;
	end;
  end;
  
  function Str.Compare_substr(
  From, To_: Integer; With_str: Str;
	  With_from, With_to: Integer): Integer;
  var L, With_L: Integer;
  begin
  	//--------------------- range value
  	if From < 0 then From := 0;
  	if From > Len then begin
  		From := _Len; To_ := _Len-1; 
  	end;
  	L := To_ - From + 1;
  	if L > _Len - From then L := _Len - From;
  	if L < 0 then L := 0; 
  	//---------------------- range With_str value
  	if With_from < 0 then With_from := 0;
  	if With_from > With_str.Len then begin
  		With_from := With_str._Len; With_to := With_str._Len - 1;
  	end;
  	With_L := With_to - With_from + 1;
  	if With_L < 0 then With_L := 0;
  	if With_L > With_str._Len - With_from then
  		With_L := With_str._Len - With_from;
  	//----------------------
  	if (L = 0) and (With_L = 0) then begin
  		Result := 0; Exit;
  	end;
  	if L = 0 then begin
  		Result := -1; Exit;
  	end;
  	if With_L = 0 then begin
  		Result := +1; Exit;
  	end;
  	if (Length(Value) = Len) and (Length(With_str.Value) = With_str.Len) then
  	begin
  		Result := StrLComp(
  			@PChar(Value)[From], 
  			@PChar(With_str.Value)[With_from],
  			min(L, With_L));
  		if Result = 0 then begin
  			if L < With_L then Result := -1
  			else if L > With_L then Result := +1;
  		end;
  		Exit;
  	end;
  	Result := UTF8CompareStr(
  		@PChar(Value)[From], L, 
  		@PChar(With_str.Value)[With_from], With_L);
  end;
  
  function Str.Substr(
  From, To_: Integer): String;
  var L: Integer;
  begin
  	if From < 0 then From := 0;
  	if From >= Len then L := 0
  	else begin
	  	L := To_ - From + 1;
	  	if L + From > Len then L := Len - From;
  	end;
  	if L <= 0 then begin 
  		Result := ''; Exit; 
  	end;
  	if _Len = Length(Value) then
  	begin
  		Result := Copy(Value, From+1, L); Exit;
  	end;
  	Result := UTF8Copy(Value, From+1, L);
  end;
  
  function Str.As_string: String;
  begin
  	if Self = nil then Result := ''
  	else Result := Value;
  end;
  
  function Str.Like_s(
  With_s: Str): Boolean;
  var a1, a2: String;
  	  //x1, x2: Str;
  begin
	  a1 := UTF8UpperCase(Value);
	  a2 := UTF8UpperCase(With_s.Value);
	  RESULT := a1 = a2;
//?{String_functions}
	  if RESULT then Exit;
	  if (UTF8Pos('%', a2) <= 0) and (UTF8Pos('?', a2) <= 0) then Exit;
	  
	  RESULT := unitC_String_functions.M_Like(a1, a2);
      //New_str(x1, a1);
      //New_str(x2, a2);
      //RESULT := unitC_String_functions.M_Like(x1, x2);
      //x1.Free;
      //x2.Free;
//.
  end;
  
  function Str.ToUpper: String;
  begin
  		if Len = Length(Value) then Result := AnsiUpperCase(Value)
  		else Result := UTF8UpperCase(Value);
  end;
  
  function Str.ToLower: String;
  begin
  		if Len = Length(Value) then Result := AnsiLowerCase(Value)
  		else Result := UTF8LowerCase(Value);
  end;
  
{$ENDIF}

{$IFDEF KOL}
{$IFDEF PUREPASCAL}

function Str2Int64( const S: AnsiString ): I64;
var I: Integer;
    M: Boolean;
begin
  Result.Lo := 0;
  Result.Hi := 0;
  I := 1;
  if S = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  M := FALSE;
  if  S[ 1 ] = '-' then
  begin
      M := TRUE;
      Inc( I );
  end else if S[ 1 ] = '+' then
      Inc( I );
  while I <= Length( S ) do
  begin
    if  (S[ I ] < '0') or (S[ I ] > '9') then
        break;
    Result := Mul64i( Result, 10 );
    IncInt64( Result, Integer( S[ I ] ) - Integer( '0' ) );
    Inc( I );
  end;
  if M then
    Result := Neg64( Result );
end;

function Mul64i( const X: I64; Mul: Integer ): I64;
var Minus: Boolean;
begin
  Minus := FALSE;
  if Mul < 0 then
  begin
    Minus := TRUE;
    Mul := -Mul;
  end;
  Result := Mul64EDX( X, Mul );
  if Minus then
    Result := Neg64( Result );
end;

function Mul64EDX( const X: I64; M: Integer ): I64;
asm
  PUSH  ESI
  PUSH  EDI
  XCHG  ESI, EAX
  MOV   EDI, ECX
  MOV   ECX, EDX
  LODSD
  MUL   ECX
  STOSD
  XCHG  EDX, ECX
  LODSD
  MUL  EDX
  ADD   EAX, ECX
  STOSD
  POP   EDI
  POP   ESI
end;

procedure IncInt64( var I64: I64; Delta: Integer );
asm
  ADD  [EAX], EDX
  ADC  LONGWORD ptr [EAX+4], 0
end;

function Neg64( const X: I64 ): I64;
asm
  MOV  ECX, [EAX]
  NEG  ECX
  MOV  [EDX], ECX
  MOV  ECX, 0
  SBB  ECX, [EAX+4]
  MOV  [EDX+4], ECX
end;

{$ENDIF}
{$ENDIF}

{$IFDEF ONLY_INTERESTING_THREADS}
procedure Set_interesting_thread;
begin
	Interesting_ThreadId := GetCurrentThreadId;
end;
{$ENDIF}

function pass_through(i: Integer): Integer;
begin
	Result := i;
end;

function Array_item_Bool(A: PBoolean; A_Count, i: Integer): Boolean;
begin
	if Cardinal(i) < A_Count then
    begin
      inc(A, i);
      Result := A^;
    end else Result := false;
end;

function Array_item_Byte(A: PByte; A_Count, i: Integer): Byte;
begin
	if Cardinal(i) < A_Count then
    begin
      inc(A, i);
      Result := A^;
    end else Result := 0;
end;

function Array_item_Int(A: PIntegerValue; A_Count, i: Integer): IntegerValue;
begin
	if Cardinal(i) < A_Count then
    begin
      inc(A, i);
      Result := A^;
    end else Result := 0;
end;

function Array_item_Real(A: PDouble; A_Count, i: Integer): Double;
begin
	if Cardinal(i) < A_Count then
    begin
      inc(A, i);
      Result := A^;
    end else Result := 0;
end;

function Array_item_String(A: PString; A_Count, i: Integer): String;
begin
	if Cardinal(i) < A_Count then
    begin
      inc(A, i);
      Result := A^;
    end else Result := '';
end;

{$IFDEF FPC}
function Array_item_Str(A: PString; A_Count: Integer; i: Integer): Str;
begin
	if Cardinal(i) < A_Count then New_str(Result, A[i]) 
	else New_str(Result, '');
end;

function Array_item_String_Str(A: PString; A_Count, i: Integer): Str;
begin
	if Cardinal(i) < A_Count then
    begin
      inc(A, i);
      New_str(Result, A^)
    end
	else New_str(Result, '');
end;
{$ENDIF}


function item_of_array_b(i: Integer; C: Cardinal; V: Boolean): Boolean;
begin
	if Cardinal(i) < C then Result := V else Result := false;
end;

function item_of_array_i(i: Integer; C: Cardinal; V: Integer): Integer;
begin
	if Cardinal(i) < C then Result := V else Result := 0;
end;

function item_of_array_r(i: Integer; C: Cardinal; V: Double): Double;
begin
	if Cardinal(i) < C then Result := V else Result := 0;
end;

function item_of_array_s(i: Integer; C: Cardinal; V: String): String;
begin
	if Cardinal(i) < C then Result := V else Result := '';
end;

function item_of_array_rec(i: Integer; C: Cardinal; V: Pointer; 
none_V: Pointer): Pointer;
begin
	if Cardinal(i) < C then Result := V else Result := none_V;
end;

function dummy_record(size: Integer): Pointer;
begin
	if size > dummy_record_size then
	begin
		if common_dummy_record <> nil then
			FreeMem(common_dummy_record);
		GetMem(common_dummy_record, size);
		dummy_record_size := size;
	end;
	Result := common_dummy_record;
end;

function s2i(const s: String): Integer;
var i: Integer;
begin
	Result := 0;
	for i := 1 to Length(s) do begin
		if (s[i] < '0') or (s[i] > '9') then break;
		Result := Result * 10 + Ord(s[i]) - Ord('0');
	end;
end;

        //----------------------
        // Convert int to string
        
function i2s(i: Integer): String;
begin
#KOL: RESULT := Int2Str(i);
#VCL: RESULT := IntToStr(i);
end;

function Int2Str(x: Integer): String;
begin
#VCL:     RESULT := IntToStr(x);
#KOL:     RESULT := KOL.Int2Str(x);
end;



function SysErrorMessage(ErrorCode: Integer): String;
{$IFDEF LINUX}
{$ELSE}
var
  Len: Integer;
  Buffer: array[0..4095] of Char;
{$ENDIF}
begin
  {$IFDEF LINUX}
  Result := 'ERROR#' + IntToStr(ErrorCode);
  {$ELSE}
  	
  	  {$IFNDEF KOL}
  	  Buffer[0] := #0;
  	  {$ENDIF}
	  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
	    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
	    SizeOf(Buffer), nil);
	  while (Len > 0) and ((Buffer[Len - 1] <= ' ')) do Dec(Len);
	  SetString(Result, Buffer, Len);

  {$ENDIF}
end;

function Start_dir: String;
begin
	Result := ExtractFilePath(ParamStr(0));
end;

function get_new_dll(var dll_handle: THandle; const base_dll_name: string): String;
{$IFDEF LINUX}
{$ELSE}
var s, e: String;
	i: Integer;
	buf: array[0..MAX_PATH] of Char; 
	old_h: THandle;
{$ENDIF}
begin
	{$IFDEF LINUX}
	{$ELSE}
 	//_________________________________________________
 	//Writeln('try to get_new_dll for ' + base_dll_name);
	
	i := 1;
	if dll_handle = 0 then i := 1
	else begin
		if GetModuleFileName(dll_handle, buf, Sizeof(buf))> 0 then begin
			s := buf;
			//_________________________________________________________
			//Writeln('module name is ' + s);		
	
			i := pos('.', s);
			s := Copy(s, i+1, MAXINT);
			i := pos('.', s);
			s := Copy(s, 1, i-1);
			try
				if s = '' then i := 0
				else i := {$IFDEF KOL} Str2Int {$ELSE} StrToInt {$ENDIF} (s);
			except
			end; 
		end;
	end;
	e := '';
	//------------------------------------------------ 
	//Writeln('search from index ' + IntToStr(i));
	
	for i := i to i+100 do 
	begin
		s := base_dll_name + '.' + i2s(i) + '.dll';
		if not FileExists(PChar(s)) and
		   FileExists(PChar(Start_dir + s)) then
		   s := Start_dir + s;
		if FileExists(PChar(s)) then
		begin
			e := s;
			//------------------------------------
			//Writeln('found existing: ' + e);
		end
		else if (e <> '') then break;
	end;
	if e <> '' then
	begin
		old_h := dll_handle;
		
		dll_handle := LoadLibrary(PChar(e));
		if dll_handle = old_h then
		begin
			FreeLibrary(old_h);
			//Result := '';
			//Exit;
		end;
		//______________________________________
		//Writeln('after loading ' + e + ': dll_handle=' + i2s(dll_handle));	
	
		if dll_handle <> 0 then //FreeLibrary(old_h)
			Result := e
		else
		begin
			i := GetLastError;
			WriteLn('could not load library ' + e + ', error: ' 
				+ i2s(i) + ' -- ' + SysErrorMessage(i)); 
			dll_handle := old_h;
			Result := '';
		end;
		Exit;
	end;
	{$ENDIF}
	Result := '';
end;

function imin(x, y: IntegerValue): IntegerValue;
begin
	Result := x;
	if y < x then Result := y;
end;

function imax(x, y: IntegerValue): IntegerValue;
begin
	Result := x;
	if y > x then Result := y;
end;

function getDateTime(d: Double): TDateTime;
begin
	Result := TDateTime(d);
end;

function Get_name(const Names: 
	{$IFDEF FPC} PString
	{$ELSE}	PStringArray
	{$ENDIF}; Index, Max_index: Integer): String;
begin
	Result := '';
	if (Index < 0) or (Index > Max_index) then Exit;
	Result := Names[Index];
end;	

function Get_SP_fun: Integer;
begin
	{$IFDEF DEBUG_STACK}
		Result := SP_fun;
	{$ELSE}
		Result := 0;
	{$ENDIF} 
end;

function Get_trace_levels: Integer;
begin
	{$IFDEF DEBUG_STACK}
	Result := SP_fun div 2;
	{$ELSE}
	Result := 0;
	{$ENDIF}
end;
		
function Get_trace_fun(level: Integer): String;
begin
	{$IFDEF DEBUG_STACK}
	if (level >= 0) and (level < SP_fun div 2) then
		Result := Function_names[Stack_functions[SP_fun - 2 - level * 2]]
				+ ' (' + i2s(Stack_lines[SP_fun - 2 - level * 2]) + ')'
	else
	{$ENDIF} 
		Result := '';
end;
		
function Get_trace_counter(level: Integer): Integer;
begin
	{$IFDEF DEBUG_STACK}
	if (level >= 0) and (level < SP_fun div 2) then
		Result := Stack_functions[SP_fun - 1 - level * 2]
	else
	{$ENDIF} 
		Result := 0;
end;

procedure load_breakpoints;
{$IFDEF KOL}
	var sL: PStrList;
{$ELSE}
	var sL: TStringList;
{$ENDIF}
var i, j, u, line: Integer;
	s: String;
begin 
	{$IFDEF DEBUG_STACK}
	sL := {$IFDEF KOL} NewStrList {$ELSE} TStringList.Create {$ENDIF};
	try
		if FileExists('Breakpoints.txt') then
			sL.LoadFromFile('Breakpoints.txt');
		SetLength(breakpoints_functions, sL.Count);
		SetLength(breakpoints_lines, sL.Count);
		stop_each_stmt := false; 
		stop_stack_level := 0;
		stop_out_fun := 0;
		stop_in_fun := 0;
		for i := 0 to sL.Count-1 do begin
			s := sL {$IFDEF KOL} .Items {$ENDIF} [i];
			if s = '' then continue;
			if Trim(s) = '*' then begin
				stop_each_stmt := true;
				continue;
			end;
			if s[1] = '#' then begin
				stop_stack_level := s2i(Copy(s, 2, Length(s)-1));
				continue;
			end;
			if s[1] = '~' then begin
				stop_out_fun := s2i(Copy(s, 2, Length(s)-1));
				continue;
			end;
			if s[1] = ':' then begin
				stop_in_fun := s2i(Copy(s, 2, Length(s)-1));
				continue;
			end;
			j := Pos(' ', s);
			if j <= 0 then continue;
			u := s2i(Copy(s, 1, j));
			line := s2i(Copy(s, j+1, Length(s)-j));
			breakpoints_functions[i] := u;
			breakpoints_lines[i] := line;
		end;
	finally
		sL.Free;
	end;
	{$ENDIF}
end;

{$IFDEF DEBUG_STACK}	
var last_breakpoints_modified_time: 
       	{$IFDEF LINUX} Integer
       	{$ELSE} TFileTime
       	{$ENDIF};
var last_time_check_breakpoints: Integer;

function _stop_(fun_index: Integer; line: Integer): Boolean;
{$IFDEF KOL}
	var ffd: TFindFileData;
{$ELSE}
	var sr: TSearchRec;
{$ENDIF}
{$IFDEF LINUX}
	var ft: Integer;
{$ELSE}
	var ft: TFileTime;
{$ENDIF}
var ok: Boolean;
	i: Integer;
begin
	if AL4.SP_fun >= 2 then AL4.Stack_lines[AL4.SP_fun-2] := line;
	Result := true;
	if stop_each_stmt then begin
		stop_each_stmt := false; 
		Exit;
	end;
	if (stop_stack_level >= Get_SP_fun) and (Get_SP_fun > 0) then begin
		stop_in_fun := 0;
		stop_stack_level := 0;
		Result := true;
		Exit;
	end;
	if (stop_in_fun > 0) and (fun_index = stop_in_fun) then begin
		stop_in_fun := 0;
		stop_stack_level := 0;
		Result := true;
		Exit;
	end;
	if (stop_out_fun > 0) and (fun_index <> stop_out_fun) then begin
		stop_out_fun := 0;
		Result := true;
		Exit;
	end;
	Result := false;
	ok := false;
	{$IFDEF DEBUG_STACK}
	if GetTickCount - last_time_check_breakpoints >= 100 then begin
		{$IFDEF KOL}
			if Find_First('Breakpoints.txt', ffd) then begin
				ft := ffd.ftLastWriteTime;
				Find_Close(ffd);
				ok := true;
			end;
		{$ELSE}
			if SysUtils.FindFirst('Breakpoints.txt', faAnyFile, sr) 
				= 0 then begin
				{$IFDEF LINUX}
					ft := sr.Time;
				{$ELSE}
					ft := sr.FindData.ftLastAccessTime;
				{$ENDIF}
				SysUtils.FindClose(sr);
				ok := true;
			end;
		{$ENDIF}	
		if ok and 
			{$IFDEF LINUX}
			(last_breakpoints_modified_time <> ft)
			{$ELSE} 
			not CompareMem(@last_breakpoints_modified_time, @ft, Sizeof(ft))
			{$ENDIF}
			then begin
			load_breakpoints;
			last_breakpoints_modified_time := ft;
		end;
		last_time_check_breakpoints := GetTickCount;
	end;
	if stop_each_stmt then begin
		Result := true;
		Exit;
	end;
	for i := 0 TO High(breakpoints_functions) do begin
		if (breakpoints_functions[i] = fun_index) and
		   ((breakpoints_lines[i] = line) or (line = 0)) then begin
		    Result := true; Exit;
		end;
	end;
	{$ENDIF}
end;

procedure _out_(const fun_line: String; const vars: String);
{$IFDEF DEBUG_STACK}
var SL: {$IFDEF KOL}PStrList{$ELSE}TStringList{$ENDIF};
	i: Integer;
{$ENDIF}
begin
	{$IFDEF DEBUG_STACK}
	SL := {$IFDEF KOL}NewStrList{$ELSE}TStringList.Create{$ENDIF};
	try
		if fun_line <> '' then begin
			SL.Add(fun_line);
			SL.Add(vars);
			SL.Add('---------------------- stack:');
			for i := 0 to SP_fun-1 do begin
				if i mod 2 = 1 then continue;
				SL.Add(Function_names[Stack_functions[i]] + ' (' 
						+ i2s(Stack_lines[i]) + ')');
			end;
		end
			else
		begin
			SL.Add('-999');
		end;
		SL.SaveTofile('stopped.txt');
	finally
		SL.Free;
	end;
	if fun_line = '' then Exit;
	while true do begin
		Sleep(100);
		if not FileExists('stopped.txt') then break;
	end;
	load_breakpoints;
	{$ENDIF}
end;

function _i_(const name_var: String; value: Integer): String;
begin
	Result := #13#10'INT ' + name_var + '=' + i2s(value);
end;

function _r_(const name_var: String; value: double): String;
begin
	Result := #13#10'REAL ' + name_var + '=' 
	+ {$IFDEF KOL}Extended2Str{$ELSE}FloatToStr{$ENDIF}(value);
end;

function _s_(const name_var: String; const value: String): String;
begin
	Result := #13#10'STR ' + name_var + '=' + value;
end;

function _s_quote_(s: String): String;
var i, len: Integer;
begin
	len := Length(s);
	if len > 100 then
		s := Copy(s, 1, 97) + '...';
  	Result := s;
  	if Pos('"', s) <= 0 then begin
  		Result := '"' + s + '".Len=' + i2s(len); Exit;
  	end;
  	Result := '"';
	for i := 1 to Length(s) do begin
		if s[i] <> '"' then Result := Result + s[i]
		else Result := Result + '"#QU"';
	end;
	Result := Result + '".Len=' + i2s(len);
end;

function _b_(const name_var: String; value: Boolean): String;
begin
	Result := #13#10'BOOL ' + name_var + '=' + _b2s_(value);
end;

function _b2s_(value: Boolean): String;
begin
	if value then Result := 'TRUE'
			 else Result := 'FALSE';
end;

{$ENDIF DEBUG_STACK}

{$IFDEF KOL}
//------------------------------------------------------------------------------
function NewStrListAlt: PStrListAlt;
begin
	{$IFDEF _D5orHigher}
  New( Result, Create );
  	{$ELSE}
  Result := NewStrList;
  	{$ENDIF}
end;

{$IFDEF _D5orHigher}
destructor TStrListAlt.Destroy;
begin
  Clear;
  inherited;
end;

function TStrListAlt.Add(const S: Ansistring): integer;
begin
  Result := fCount;
  Insert( Result, S );
end;

procedure TStrListAlt.Clear;
begin
	if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;
	try
  		SetLength(fArray, 0);
  		fCount := 0;
	finally
	if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;
	end;
end;

procedure TStrListAlt.Delete(Idx: integer);
var I: Integer;
begin
  if (Idx <0) or (Idx >= fCount) then Exit;
  if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;
  try
	  for I := Idx to fCount-2 do
	  	  fArray[I] := fArray[I+1];
	  dec(fCount);
  finally
  if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;
  end;
end;

function TStrListAlt.Get(Idx: integer): Ansistring;
begin
  if (Idx < 0) or (Idx >= fCount) then Result := ''
  else
  begin 
  		Result := fArray[Idx];
  end;
end;

function TStrListAlt.IndexOf(const S: AnsiString): integer;
begin
  for Result := 0 to fCount - 1 do
  	  if fArray[Result] = S then Exit;
  Result := -1;
end;

procedure TStrListAlt.Insert(Idx: integer; const S: Ansistring);
var I: Integer;
begin
  if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;
  try
	  if Length(fArray) = fCount then
	  	 {$IFDEF SMALLER_CODE}
	  	 {$ELSE}
	  	 if fCount >= 1024 then
	  	 	SetLength(fArray, (Length(fArray) div 128) * 128 + 128)
	  	 else 
	  	 {$ENDIF}
	  	 SetLength(fArray, Length(fArray) + 1 + Length(fArray) div 4);
	  for I := fCount downto Idx+1 do
	  	  fArray[I] := fArray[I-1];
	  fArray[Idx] := S;
	  inc(fCount);
  finally
  if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;
  end;
end;

procedure TStrListAlt.Put(Idx: integer; const Value: Ansistring);
begin
  if Idx <= Count-1 then
  begin
  	if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;
  	try
  	 fArray[Idx] := Value
  	finally
  	if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;
  	end;
  end
  else
  begin
	  Delete( Idx );
	  Insert( Idx, Value );
  end;
end;

function TStrListAlt.getCapacity: Integer;
begin
	Result := Length(fArray);
end;

procedure TStrListAlt.setCapacity(Value: Integer);
begin
	if Value < Count then Exit;
	if Value > MAXINT div 4 then Exit;
	if Value > Count * 10 then Value := Count * 10;
	if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;
	try
	{$IFDEF SMALLER_CODE}
		SetLength(fArray, Value);
	{$ELSE}
		{$IFDEF NOEXCEPTIONS}
			SetLength(fArray, Value);
		{$ELSE}
		try
			SetLength(fArray, Value);
		except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
		end;
		{$ENDIF}
	{$ENDIF}
	finally
	if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;
	end;
end;
{$ENDIF _D5orHigher}

//------------------------------------------------------------------------------
{$ENDIF KOL}

procedure check_long_operation;
var i: Integer;
	h: AL4_handler;
begin
	global_activity_counter := 0;
	for i := long_operation_handlers.Count-1 downto 0 do
	begin
		h := AL4_handler(long_operation_handlers.Items[i]);
		h.Handler;
	end;
end;



#VCL: procedure AL4_handler.Handler;
#KOL: procedure TAL4_handler.Handler;
begin end;

procedure init_class_AL4_object;
begin
  NoneObjInit_AL4_object;
end;

#VCL: constructor Structure_any.Create();
#KOL: constructor TStructure_any.Create;
begin
	inherited;
	hard_link.Count := 1; 
	//2;
end;

#VCL: function Structure_any.Clone(): Ref_obj;
#KOL: function TStructure_any.Clone(): Ref_obj;
begin
	Result := nil;
end;

procedure Zero_structure(var St; Size: Integer);
begin
	FillChar(St, Size, 0);
end;

{$IFDEF USE_DynAObj}
function Dismiss_structure(var source: Ref_obj): Ref_obj;
var ret: Structure_any;
begin
	ret := Structure_any(source.Obj);
	source := source.Obj.NONE_obj_instance();  
	Result := ret.hard_link;
end;

function Dismiss_array_item(a: DynAObj; index: Integer): Ref_obj;
var ret: Structure_any;
begin
	ret := Structure_any(a.GetObjects(Index).Obj);
	{$IFDEF DEBUG}
		ret.hard_link.Ref_inc_hard();
	{$ELSE}
		inc(ret.hard_link.Count, 2);
	{$ENDIF}
	if not ret.Is_NONE_object then
 		a.SetObjects(Index, ret.NONE_obj_instance());  
	Result := ret.hard_link;
end;
{$ENDIF}

function do_NoneObjInit(
	var none_obj_ret: AL4_object;
	var dummy_obj_ret: AL4_object; 
	create_new_noneclass: TCreateNewNoneclass): AL4_object;
begin
  if Assigned(none_obj_ret) then begin
  	 Result := none_obj_ret; Exit;
  end;
  none_obj_ret := create_new_noneclass.Obj;
  none_obj_ret.Is_NONE_object := TRUE;
  none_obj_ret.hard_link.Count := -1;
  dummy_obj_ret := create_new_noneclass.Obj;
  dummy_obj_ret.hard_link.Count := -1;
  none_obj_ret.write := dummy_obj_ret;
  Result := none_obj_ret;
end;

function NoneObjInit_AL4_object: Noneclass_AL4_object;
begin
  Result := Noneclass_AL4_object(
  	do_NoneObjInit(AL4_object(NoneObj_AL4_object), 
  	AL4_object(DummyObj_AL4_object),
#VCL: @New_Noneclass_AL4_object_ref
#KOL:  @New_Noneclass_AL4_object_ref
		));
end;

#VCL:procedure Noneclass_AL4_object.Erase;
#KOL:procedure TNoneclass_AL4_object.Erase;
begin end;

#VCL:procedure Noneclass_AL4_object.CONSTRUCT;
#KOL:procedure TNoneclass_AL4_object.CONSTRUCT;
begin end;

#VCL:procedure Noneclass_AL4_object.DESTRUCT;
#KOL:procedure TNoneclass_AL4_object.DESTRUCT;
begin end;

#VCL:class function Noneclass_AL4_object.New_instance: Ref_obj;
#VCL:begin
#VCL:    Result := New_Noneclass_AL4_object.hard_link;
#VCL:end;

function New_AL4_object: AL4_object;
begin
#VCL:    Result := AL4_object.Create;
#KOL:    new(Result, Create);
end;

function New_Noneclass_AL4_object: NoneClass_AL4_object;
begin
#VCL:    Result := Noneclass_AL4_object.Create;
#KOL:    new(Result, Create);
end;

function New_Noneclass_AL4_object_ref: Ref_obj;
begin
	Result := New_Noneclass_AL4_object.hard_link;
end;

function Is_TEST_stage: Boolean;
begin
    {$IFDEF TEST_STAGE}
    Result := TRUE;
    {$ELSE}
    Result := FALSE;
    {$ENDIF}
end;

procedure GetMemZ(var Buf: Pointer; Size: Integer);
begin
    GetMem(Buf, Size);
    FillChar(Buf^, Size, 0);
end;



          //--------------------------------- init variables
procedure Init_var_int(var i: IntegerValue);
begin
    i := 0;
end;

procedure Init_var_byte(var i: Byte);
begin
    i := 0;
end;

procedure Init_var_real(var r: Real);
begin
	{$IFNDEF FPC}
	
    asm finit end; // this solves problems with NAN left on FPU top

    {$ENDIF}
    r := 0;
end;

procedure Init_var_str(var s: String);
begin
    s := '';
end;

procedure Init_var_bool(var b: Boolean);
begin
    b := FALSE;
end;

procedure Init_var_obj(var obj: Ref_obj; none_obj: AL4_object);
begin
    obj := none_obj.hard_link;
end;

{$IFDEF USE_DynAInt}
procedure Init_var_dynaint(var A: DynAInt);
begin
#VCL:    A := DynAInt.Create;
#KOL:    new(A, Create);
end;
{$ENDIF}

{$IFDEF USE_DynAStr}
procedure Init_var_dynastr(var A: DynAStr);
begin
#VCL:    A := DynAStr.Create;
#KOL:    new(A, Create);
end;
{$ENDIF}

{$IFDEF USE_DynAByte}
procedure Init_var_dynabyte(var A: DynAByte);
begin
#VCL:    A := DynAByte.Create;
#KOL:    new(A, Create);
end;
{$ENDIF}

{$IFDEF USE_DynaReal}
procedure Init_var_dynareal(var A: DynAReal);
begin
#VCL:    A := DynAReal.Create;
#KOL:    new(A, Create);
end;
{$ENDIF}

{$IFDEF USE_DynAObj}
procedure Init_var_hard(var A: DynAObj; none_obj: AL4_object);
begin
	A := New_DynAObjHard(none_obj.hard_link);
end;

procedure Init_var_weak(var A: DynAObj; none_obj: AL4_object);
begin
	A := New_DynAObjWeak(none_obj.weak_link);
end;

{$ENDIF}



        //------------------------------------------
        // Find substring first position in a string
function Find_str(S: String; Pattern: String): Integer;
begin
     {$IFDEF FPC}
     RESULT := UTF8pos(Pattern, S) - 1;
     {$ELSE}
     RESULT := pos(Pattern, S) - 1;
     {$ENDIF}
end;

#VCL:procedure Split_string(L: TStringList; const S: String; const By_pattern: String);
#KOL:procedure Split_string(L: PStrList; const S: String; const By_pattern: String);
var i, prev: Integer;
begin
    if  By_pattern = '' then
    begin
        L.Add(S);
        Exit;
    end;
    prev := 1;
    i := 1;
    while i <= Length(S)+1 do
    begin
        if  (i = Length(S)+1) or
            (S[i] = By_pattern[1]) and
            (Copy(S, i, Length(By_pattern)) = By_pattern) then
        begin
            if  prev > 0 then
                L.Add(Copy(S, prev, i - prev));
            prev := i+Length(By_pattern);
            inc(i, Length(By_pattern)-1);
        end;
        inc(i);
    end;
end;

function IndexOfStr(const A: array of PChar; const S: String): Integer;
var i: Integer;
begin
    for i := 0 to High(A) do
        if  A[i] = S then
        begin
            Result := i; Exit;
        end;
    Result := -1;
end;

        //--------------------------------------
        // Is object variable referencing NONE ?
function Is_none(obj: Ref_obj): Boolean;
begin
     RESULT := {$IFnDEF KOL} (obj.Obj = nil) or {$ENDIF} obj.Obj.Is_NONE_object;
end;

function Inc_var(var i: Integer): Integer;
begin
    Result := i;
    inc(i);
end;

function Dec_var(var i: Integer): Integer;
begin
    Result := i;
    dec(i);
end;


        //---------------------------------------------------------------
        // Safe division of real numbers. Returns INF or NaN in bad cases
function Safe_div(X: Real; Y: Real): Real;
begin
	//{$IFDEF FPC}
	if IsNaN(X) or IsNaN(Y) then begin
		Result := NAN_constant; Exit;
	end;
	//{$ENDIF}
     if (Y = 0) then
     begin
        if (X > 0) then RESULT := INFINITY
        else RESULT := - Infinity;
        EXIT;
     end;
     {$IFNDEF NOEXCEPTIONS}
     try
     {$ENDIF}
        RESULT := X / Y;
     {$IFNDEF NOEXCEPTIONS}
     except {$IFNDEF NOERR} on E: Exception {$ENDIF} do 
            begin
            	if E is AL4_Exception then raise;
            {$IFNDEF NOERR} Any_exception(E); {$ENDIF}
            	{$IFDEF FPC}
            	RESULT := 0;
            	{$ELSE}
                RESULT := NAN_constant;
                {$ENDIF}
            end;
     end;
     {$ENDIF}
end;

{$IFDEF FPC_LAZARUS_DOES_NOT_LIKE_NAN}
function Safe_mul(X: Real; Y: Real): Real;
begin
	if IsNaN(X) or IsNaN(Y) then begin
		Result := NaN; Exit;
	end;
	Result := X * Y;
end;

function Safe_add(X: Real; Y: Real): Real;
begin
	if IsNaN(X) or IsNaN(Y) then begin
		Result := NaN; Exit;
	end;
	Result := X + Y;
end;

function Safe_sub(X: Real; Y: Real): Real;
begin
	if IsNaN(X) or IsNaN(Y) then begin
		Result := NaN; Exit;
	end;
	Result := X - Y;
end;
	
function Safe_cmp(X: Real; Y: Real): Real;
begin
	if IsNaN(X) or IsNaN(Y) then begin
		Result := 0.0; Exit;
	end;
	Result := X - Y;
end;
	
{$ENDIF}

	



        //-------------------------------------------------
        // Safe division of int numbers. Returns very large 
        // or negative large integer number in bad cases.
function Safe_div_int(X: Integer; Y: Integer): Integer;
begin
     if (Y = 0) then begin
        if X > 0 then RESULT := MAXINT
        else          RESULT := Integer($FFFFFFFF);
        EXIT;
     end;
     RESULT := X div Y;
end;

        //---------------------------------
        // Safe rest of division operation.
function Safe_rest(X: Integer; Y: Integer): Integer;
begin
     if (Y = 0) then RESULT := X
     else RESULT := X mod Y;
end;

        //-----------------------
        // STOP operation
procedure STOP(msg: String);
begin
     {$IFDEF NOEXCEPTIONS}
     Halt;
     {$ELSE}
     raise Stop_exception.Create(msg);
     {$ENDIF}
end;

        //-----------------------
        // Infinity constant
function Infinity: Real;
const c_Infinity = 1.0 / 0.0;
begin
	{$IFnDEF NOEXCEPTIONS}
	Result := 0;
	try                  
	{$ENDIF}
   	 Result := c_Infinity;
	{$IFnDEF NOEXCEPTIONS}
	except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end 
	end;
	{$ENDIF}
end;

        //-----------------------
        // NAN constant
function NAN_constant: Real;
begin
	{$IFDEF FPC}
	Result := NaN;
	{$ENDIF}
    Result := NaN;
end;

{$IFnDEF _D6orHigher}
function IsNan(const AValue: Double): Boolean;
{$IFnDEF _D5orHigher}
type Td64 = record Lo, Hi: LONGWORD end;
	 Pd64 = ^Td64;
var v: Td64;
{$ENDIF}
begin
	{$IFDEF _D5orHigher}
  Result := ((PInt64(@AValue)^ and $7FF0000000000000)  = $7FF0000000000000) and
            ((PInt64(@AValue)^ and $000FFFFFFFFFFFFF) <> $0000000000000000);
  	{$ELSE}
  		v := Pd64(@AValue)^;
  		Result := ((v.Hi and $7FF00000) = $7FF00000)
  		and (((v.Hi and $000FFFFF) <> 0) or (v.Lo <> 0));
  	{$ENDIF}
end;

{$ENDIF}

        //-----------------------
        // Should be called on any exception to collect errors:
        // maximum 10 errors are stored
        // If there were more then 10, middle errors are removed and 
        // then Errors list contains:
        // 0 to 4 - first 5 errors from Reset_errors
        // 5 - empty (to signal that Errors count > 10)
        // 6 TO 9 - last 4 errors
{$IFNDEF NOEXCEPTIONS}
procedure Any_exception(e: Exception);
begin
    if Errors = nil then
#VCL:       Errors := TStringList.Create;
#KOL:       Errors := NewStrList;
    if Errors.Count >= 10 then
    begin
       Errors.Delete(5);
#VCL:       Errors[5] := '';
#KOL:       Errors.Items[5] := '';
    end;
    Errors.Add(e.ClassName + ': ' + e.Message);
end;

procedure Add_error_descr(s: String);
begin
    if Errors = nil then
#VCL:       Errors := TStringList.Create;
#KOL:       Errors := NewStrList;
    if Errors.Count >= 10 then
    begin
       Errors.Delete(5);
#VCL:       Errors[5] := '';
#KOL:       Errors.Items[5] := '';
    end;
    Errors.Add(s);
end;
{$ENDIF}

        //-----------------------
        // Call to reset errors
procedure Reset_errors;
begin 
	{$IFDEF _D5orHigher}
#VCL:    FreeAndNil(Errors);
#KOL:    Free_And_Nil(Errors);
	{$ELSE}
		Errors.Free;		
		Errors := nil;
	{$ENDIF}
end;

        //-----------------------
        // Call to get count of errors
function Errors_count: Integer;
begin 
    Result := 0;
    if Errors <> nil then Result := Errors.Count;
end;

        //-----------------------
        // Call to get info on certain error
function Error_info(index: Integer): String;
begin
    Result := '';
    if (Errors = nil) or (index < 0) or (index >= Errors.Count) then Exit;
#VCL:    Result := Errors[index];
#KOL:    Result := Errors.Items[index];
end;

        //------------------------------------------------------------
        // Operation X.{Type}. Returns NONE is X is not of type {Type}.
function As_obj(X: Ref_obj; None_y: Ref_obj): Ref_obj;
var probe: AL4_object;
	test: Ref_obj;
begin
     probe := X.Obj;
     while (probe <> nil) do
     begin
		  test := probe.None_obj_instance();
          //if (None_y.Obj = nil) or (test.Obj = nil) then
          //begin
          //  asm
          //      nop
          //  end;
          //   RESULT := X; EXIT;
          //end;
          if (test.Obj = None_y.Obj) then 
          begin
             RESULT := X; EXIT;
          end;
          probe := probe.NONE_base_obj();
     end;
     RESULT := None_y;
end;

        //------------------------------------------------------------
        // Write a string to a FileStream
#VCL:procedure WriteString(sw: TFileStream; s: String);
#KOL:procedure WriteString(sw: PStream; s: String);
begin
    if  s = '' then EXIT;
    sw.Write(s[1], Length(s));
end;

        //---------------------------------------------------------
        // Clear test data
procedure Clear_test_data(var test_lines: array of Int64; Len: Integer);
var i: Integer;
begin
     for i := 0 to Len-1 do
     begin
     	  {$IFDEF MODERN_CODE}
	          if (test_lines[i] < 0) then continue;
	          test_lines[i] := 0;
          {$ELSE}
          	  if (test_lines[i].Lo < 0) then continue;
	          test_lines[i].Lo := 0;
	          test_lines[i].Hi := 0;
          {$ENDIF}
     end;
end;

        //---------------------------------------------------------
        // Remove test data for the ancestor class
procedure Remove_test_data(var test_lines: array of Int64; from, to_: Integer);
var i: Integer;
begin
    for i := from to to_-1 do
    begin
    	{$IFDEF MODERN_CODE}
        	test_lines[i] := -from;
        {$ELSE}
	        test_lines[i].Lo := -from;
	        test_lines[i].Hi := 0;
        {$ENDIF}
    end;
end;


        //---------------------------------------------------------
        // Output test data of class
procedure Output_test_data(const test_lines: array of Int64; Len: Integer;
#VCL:   test_assert: TList; 
#VCL:	test_assert_failed_text: TStringList;
#KOL:            test_assert: PList; test_assert_failed_text: PStrList;
            Class_test_file: String; Class_path_source: String);
var path, s: String;
#VCL:    sw: TFileStream;
#KOL:    sw: PStream;
    i: Integer;
begin
     path := Class_test_file;
     s := '';
#VCL:     sw := TFileStream.Create(path, fmCreate);
#KOL:     sw := NewWriteFileStream(path);
     {$IFNDEF NOTRY}
     try
     {$ENDIF}
     	WriteString(sw, 'source: ' + Class_path_source + #13#10);
        for i := 0 to Len-1 do
        begin
        		{$IFDEF MODERN_CODE}
             		s := s + i2s(test_lines[i]) + ' ';
				{$ELSE}
				    s := s + i2s(test_lines[i].Hi) + '.' +
						     i2s(test_lines[i].Lo) + ' ';
				{$ENDIF}
             if (Length(s) >= 75) then
             begin
                  WriteString(sw, s + #13#10);
                  s := '';
             end;
        end;
        if (s <> '') then WriteString(sw, s + #13#10);
        if (test_assert <> nil) then
        begin
             WriteString(sw, '* assertions failed in lines:' + #13#10);
             for i := 0 to test_assert.Count-1 do
             begin
#VCL:                  WriteString(sw,
#VCL:		IntToStr({$IFDEF CPU64}Int64{$ELSE}Integer{$ENDIF}(test_assert[i])));
#KOL:                  WriteString(sw, Int2Str(Integer(test_assert.Items[i])));
#VCL:                  if test_assert_failed_text[i] <> '' then
#KOL:                  if test_assert_failed_text.Items[i] <> '' then
#VCL:                     WriteString(sw, ' ' + test_assert_failed_text[i]);
#KOL:                     WriteString(sw, ' ' + test_assert_failed_text.Items[i]);
                  WriteString(sw, #13#10);
             end;
        end;
     {$IFNDEF NOTRY}
     finally
     {$ENDIF}
             sw.Free;
     {$IFNDEF NOTRY}
     end;
     {$ENDIF}
end;

function Fixed_Bytes(A: PByte; max_sz: Integer; i: Integer): Byte;
begin
    if (i < 0) or (i > max_sz) then Result := 0
    else 
    	Result := (PByte({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A) 
    	+ LONGWORD( i*sizeof(Byte) )))^;
end;

function Fixed_Bools(A: PBoolean; max_sz: Integer; i: Integer): Boolean;
begin
    if (i < 0) or (i > max_sz) then Result := FALSE
    else
    	Result := (PByte({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A) 
    	+ LONGWORD( i*sizeof(Boolean) )))^ <> 0;
end;

function Fixed_Reals(A: PDouble; max_sz: Integer; i: Integer): Real;
begin
    if (i < 0) or (i > max_sz) then Result := 0
    else Result := (PDouble({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A) 
    + LONGWORD( i*sizeof(Double) )))^;
end;

function Fixed_Integers(A: PInteger; max_sz: Integer; i: Integer): Integer;
begin
    if (i < 0) or (i > max_sz) then Result := 0
    else Result := (PInteger({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A)
    +  LONGWORD( i*sizeof(Integer) )))^;
end;

{$IFDEF USE_DynAStr}
function Fixed_Strings(A: PPChar; max_sz: Integer; i: Integer): String;
begin
    if (i < 0) or (i > max_sz) then Result := ''
    else Result := (PPChar({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A)
    + LONGWORD( i*sizeof(String) )))^;
end;
{$ENDIF}

procedure Set_fixed_Bytes(A: PByte; max_sz: Integer; i: Integer; value: Byte);
begin
    if (i < 0) or (i > max_sz) then Exit
    else (PByte({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A)
    + LONGWORD( i*sizeof(Byte) )))^ := value;
end;

procedure Set_fixed_Bools(A: PBoolean; max_sz: Integer; i: Integer; value: Boolean);
begin
    if (i < 0) or (i > max_sz) then Exit
    else (PByte({$IFDEF CPU64} QWORD {$ELSE} LONGWORD{$ENDIF}(A)
    + LONGWORD( i*sizeof(Boolean) )))^ := Byte(value);
end;

procedure Set_fixed_Reals(A: PDoubleArray; max_sz: Integer; i: Integer; value: Real);
begin
    if (i < 0) or (i > max_sz) then Exit
    else (PDouble({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A)
    + LONGWORD( i*sizeof(Double) )))^ := value;
end;

procedure Set_fixed_Integers(A: PIntegerArray; max_sz: Integer; i: Integer; value: Integer);
begin
    if (i < 0) or (i > max_sz) then Exit
    else (PInteger({$IFDEF CPU64} QWORD {$ELSE} LONGWORD {$ENDIF}(A)
    + LONGWORD( i*sizeof(Integer) )))^ := value;
end;

        // adding an assertion failed to list of failed assertions:
procedure Assertion_failed(line:Integer;
#VCL:  var test_assert: TList; 
#VCL:  var test_assert_failed_text: TStringList;
#KOL:          var test_assert: PList; var test_assert_failed_text: PStrList;
          const assert_failed_text: String);
begin
     if test_assert = nil then
#VCL:        test_assert := TList.Create;
#KOL:        test_assert := NewList;
     if test_assert_failed_text = nil then
#VCL:        test_assert_failed_text := TStringList.Create;
#KOL:        test_assert_failed_text := NewStrList;
#VCL:     test_assert.Add(Pointer({$IFDEF FPC}PtrUInt{$ENDIF}(line)));
#KOL:     test_assert.Add(Pointer(line));
     test_assert_failed_text.Add(assert_failed_text);
end;

  //-------------------------------------
  // Safe operation S[i] (string S, int i)
  
function Single_symbol(S: String; Pos: Integer): String;
var exceeds: Boolean;
	L: Integer;
	{$IFDEF FPC}
    p: PChar;
    cLen: Integer;
    {$ENDIF}
begin
    {$IFDEF FPC}
        L := UTF8Length(S);
    {$ELSE}
		L := Length(S);
    {$ENDIF}
	exceeds := (Pos < 0) or (Pos >= L);
    if not exceeds then
    begin
	    {$IFDEF FPC}
			L := Length(S);
	    {$ENDIF}
        {$IFDEF FPC}
           p := UTF8CharStart(PChar(S), L, Pos);
           //p := UTF8CodepointStart(PChar(S), L, Pos);
	       if p = nil then begin RESULT := '' + #0; Exit; end;
	       
	       cLen := UTF8CharacterLength(p); 
	       //cLen := UTF8CodepointSize(p); 
	       if cLen = 1 then
	           RESULT := p^
	       else RESULT := Copy(p, 1, cLen);
	       
        {$ELSE}
           RESULT := S[Pos + 1] + '';
       {$ENDIF}
       EXIT;
    end;
    RESULT := #0 + '';
end;

  //-------------------------------------
  // Safe operation S[i] := sym
function Change_single_symbol(S: String; Pos: Integer; const sym: String): String;
var L: Integer;
	exceeds: Boolean;
begin 
    Result := S;
	{$IFDEF FPC}
		L := UTF8Length(S); 
	{$ELSE}
		L := Length(S);
	{$ENDIF}
	exceeds := (Pos < 0) or (Pos >= L);
     if not exceeds then
     begin
     	{$IFDEF FPC}
     	RESULT := UTF8Copy(S, 1, Pos) + sym + UTF8Copy(S, Pos+2, L - Pos - 1);
     	{$ELSE}
        Result[Pos + 1] := (sym + #0)[ 1 ];
        {$ENDIF}
     end;
end;

{$IFDEF FPC}
function Change_single_symbol_str(S: Str; Pos: Integer; const sym: String): String;
var L: Integer;
	exceeds: Boolean;
begin 
    Result := S.Value;
    L := UTF8Length(S); 
	exceeds := (Pos < 0) or (Pos >= L);
     if not exceeds then
     begin
     	RESULT := UTF8Copy(Result, 1, Pos) + sym + UTF8Copy(Result, Pos+2, 
     		L - Pos - 1);
     end;
end;
{$ENDIF}


        //---------------------------
        // Safe Substring() of string
function Substring(S: String; from: Integer; to_: Integer): String;
var exceeds: Boolean;
	L: Integer;
	{$IFDEF FPC} pos1, pos2: Integer; {$ENDIF}
begin
	{$IFDEF FPC}
	L := UTF8Length(S); 
	{$ELSE}
	L := Length(S);
	{$ENDIF}
     if (from < 0) then from := 0;
	 exceeds := (to_ < from) or (from >= L);
     if exceeds then
     begin
         //RESULT := ''; EXIT;
         L := from;
     end;
     if (L <= to_) then to_ := L - 1;
     {$IFDEF FPC}
	     RESULT := Utf8Copy(S, from+1, to_ - from + 1);
     {$ELSE}
     	 RESULT := Copy(S, from+1, to_ - from + 1);
     {$ENDIF}
end;

//---------------------------
// Optimized comparison of two sub-strings
	
function CompareSubstrings(const S1, S2: String;
    from1, to1, from2, to2: Integer): Integer;
var last1, last2, i, j: Integer;
	L1, L2, chL1, chL2: Integer;
	{$IFDEF FPC}
	pos1, pos2: PChar;
	p1, p2: PByte;
	k: Integer;
	{$ENDIF}
begin
    if (from1 < 0) then from1 := 0;
    if (from2 < 0) then from2 := 0;
    last1 := to1;
    {$IFDEF FPC}
    L1 := UTF8Length(S1);
    L2 := UTF8Length(S2);
    {$ELSE}
    L1 := Length(S1);
    L2 := Length(S2);
    {$ENDIF}
    if (last1 >= L1) then last1 := L1 - 1;
    last2 := to2;
    if (last2 >= L2) then last2 := L2 - 1;
    
	{$IFDEF FPC}
	pos1 := UTF8CharStart(PChar(S1), Length(S1), from1);
	//pos1 := UTF8CodepointStart(PChar(S1), Length(S1), from1);
	pos2 := UTF8CharStart(PChar(S2), Length(S2), from2);
	//pos2 := UTF8CodepointStart(PChar(S2), Length(S2), from2);
	if (pos1 = nil) then
        if (pos2 = nil) then begin Result := 0; Exit; end 
        else begin Result := -1; Exit; end
    else if pos2 = nil then begin Result := 1; Exit; end;
	j := from2;
	for i := from1 to last1 do
	begin
		if (j > last2) then
		begin
			if (i <= last1) then begin Result := 1; Exit; end;
			break;
		end;
		chL1 := UTF8CharacterLength(pos1);
		chL2 := UTF8CharacterLength(pos2); 
		Result := chL1 - chL2;
		if Result <> 0 then Exit;
		if chL1 = 1 then begin
			Result := Ord(pos1^) - Ord(pos2^);
		end else
		if chL1 = 2 then begin
			Result := PWord(pos1)^ - PWord(pos2)^;
		end else begin
			p1 := PByte(pos1);
			p2 := PByte(pos2);
			for k := 1 to chL1 do
			begin
				Result := ShortInt(p1^) - ShortInt(p2^);
				if Result <> 0 then Exit;
				inc(p1);
				inc(p2);
			end;
		end;
		
		if Result <> 0 then Exit;
		inc(j);
		inc(Pos1, chL1);
		inc(Pos2, chL2);
	end;
	{$ELSE}
    j := from2;
    for i := from1 to last1 do 
    begin
        if (j > last2) then
        begin
            if (i <= last1) then begin Result := 1; Exit; end;
            break;
        end;
        Result := Ord(S1[i+1]) - Ord(S2[j+1]);
        if (Result <> 0) then Exit;
        inc(j);
    end;
    {$ENDIF}
    if (j <= last2) then Result := -1
    else Result := 0;
end;

//---------------------------
// Optimized comparison of a sub-string with a string
function CompareSubstrWithStr(const S1: String;  
    from1, to1: Integer; const S2: String): Integer;
{$IFDEF FPC}
{$ELSE}
var i, j, last1: Integer;
{$ENDIF}
begin
	{$IFDEF FPC}
	RESULT := CompareSubstrings(S1, S2, from1, to1, 0, UTF8Length(S2)-1);
	Exit;
	{$ELSE}
    last1 := to1;
    if (from1 < 0) then from1 := 0;
    if (last1 >= Length(S1)) then last1 := Length(S1) - 1;
    j := 0;
    for i := from1 to last1 do  
    begin
        if (j >= Length(S2)) then 
        begin
            if (i <= last1) then begin Result := 1; Exit; end;
            break;
        end;
        Result := Ord(S1[i+1]) - Ord(S2[j+1]);
        if (Result <> 0) then Exit;
        inc(j);
    end;
    if (j < Length(S2)) then Result := -1
    else Result := 0;
    {$ENDIF}
end;

function like_pattern(S1: PChar; S2: PChar): Boolean;
var i, j: Integer;
	any, single: Boolean;
begin
	RESULT := false;
	while S1^ <> #0 do
	begin
		if S2^ = #0 then Exit;
		if (S1^ = S2^) or (S2^ = '?') then
		begin inc(S1); inc(S2); continue;
		end;
		if S2^ = '%' then
		begin
			if S2[1] = #0 then 
			begin RESULT := true; Exit; 
			end;
			inc(S2);
			any := StrScan(S2, '%') <> nil;
			single := StrScan(S2, '?') <> nil; 
			if not any and not single then
			begin
				i := StrLen(S1);
				j := StrLen(S2);
				if i > j then inc(S1, i-j);
			end;
			RESULT := like_pattern(S1, S2);
			if RESULT then Exit;
			if any then
			begin
				inc(S1);
				while S1^ <> #0 do
				begin
					RESULT := like_pattern(S1, S2);
					if RESULT then Exit;
					inc(S1);
				end;
			end;
			Exit;
		end;
		Exit;
	end;
	if (S1^ = #0) and (S2^ = #0) then
	begin RESULT := true; Exit;
	end;
	if S2^ = '%' then
	begin
		inc(S2);
		RESULT := like_pattern('', S2);
	end;
end;

//?{Thread}
	{$DEFINE MULTI_THREADED}
//.

function like_str(const S1: String; const S2: String): Boolean;
var a1, a2: String;
begin
	a1 := AnsiUpperCase(S1);
	a2 := AnsiUpperCase(S2);
	RESULT := a1 = a2;
//?{String_functions}
	if RESULT then Exit;
	if (pos('%', a2) <= 0) and (pos('?', a2) <= 0) then Exit;
	RESULT := unitC_String_functions.M_Like(a1, a2);
//.
end;

//--------------------------------------------
// Optimized x IN A[]
function ArrayContainsInt(const A: array of Integer; X: Integer): Boolean;
var i: Integer;
begin
    for i := 0 to High(A) do
        if A[i] = X then begin Result := TRUE; Exit; end;
    Result := FALSE;
end;

function ArrayContainsByte(const A: array of Byte; X: Byte): Boolean;
var i: Integer;
begin
    for i := 0 to High(A) do
        if A[i] = X then begin Result := TRUE; Exit; end;
    Result := FALSE;
end;

function ArrayContainsStr(const A: array of String; const X: String): Boolean;
var i: Integer;
begin
    for i := 0 to High(A) do
        if A[i] = X then begin Result := TRUE; Exit; end;
    Result := FALSE;
end;


        //-----------------------------------------
        // Operation S[i] = c (not available in C#)
function Replace_symbol(S: String; i: Integer; r: String): String;
var L: Integer;
	exceeds: Boolean;
	{$IFDEF FPC} pos1, pos2: Integer; {$ENDIF}
begin
	{$IFDEF FPC}
	L := UTF8Length(S); 
	{$ELSE}
	L := Length(S);
	{$ENDIF}
	exceeds := (i < 0) or (i >= L);
	if exceeds then begin
       RESULT := S; EXIT;
    end;
    {$IFDEF FPC}
    pos1 := UTF8CharToByteIndex(PChar(S), Length(S), i);
    pos2 := UTF8CharToByteIndex(PChar(S), Length(S), i+1);
     if (i >= L-1) then pos2 := Length(S);
     RESULT := Copy(S, 1, pos1) + r + Copy(S, pos2+1); 
    {$ELSE}
    RESULT := Copy(S, 1, i) + r + Copy(S, i + 2, MaxInt);
    {$ENDIF}
end;

{$IFDEF KOL}
function Extended2Str( E: Extended ): KOLString;
    function UnpackFromBuf( const Buf: array of Byte; N: Integer ): KOLString;
    var I, J, K, L: Integer;
    begin
      SetLength( Result, 16 );
      J := 1;
      for I := 7 downto 0 do
      begin
        K := Buf[ I ] shr 4;
        Result[ J ] := KOLChar( Ord('0') + K );
        Inc( J );
        K := Buf[ I ] and $F;
        Result[ J ] := KOLChar( Ord('0') + K );
        Inc( J );
      end;
      Delete( Result, 1, 1 );
      if  N <= 0 then
      begin
          while N < 0 do
          begin
              Result := '0' + Result;
              Inc( N );
          end;
          Result := '0.' + Result;
      end else
      if  N < Length( Result ) then
      begin
          Result := Copy( Result, 1, N ) + '.' + CopyEnd( Result, N + 1 );
      end else
      begin
          while N > Length( Result ) do
          begin
            Result := Result + '0';
          end;
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      L := Length( Result );
      while L > 1 do
      begin
        if  (Result[ L ] <> '0')
        and (Result[ L ] <> '.') then
            break;
        Dec( L );
        if Result[ L + 1 ] = '.' then break;
      end;
      if L < Length( Result ) then Delete( Result, L + 1, MaxInt );
    end;
var
  S: Boolean;
var F: Extended;
    N: Integer;
    Buf1: array[ 0..9 ] of Byte;
    I10: Integer;
begin
  Result := '0';
  if E = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  S := E < 0;
  if S then E := -E;

  N := 15;
  F := 5E12;
  I10 := 10;
  while E < F do
  begin
    Dec( N );
    E := E * I10;
  end;
  if N = 15 then
  while E >= 1E13 do
  begin
    Inc( N );
    E := E / I10;
  end;

  while TRUE do
  begin
    {$IFDEF PAS_ONLY}
    if TRUNC(Abs(E)) >= 10000000 then
       break;
    {$ENDIF}
    asm
      FLD    [E]
      FBSTP  [Buf1]
    end;
    if Buf1[ 7 ] <> 0 then break;
    //{$ENDIF}
    E := E * I10;
    Dec( N );
  end;
  Result := UnpackFromBuf( Buf1, N );
  if S then Result := '-' + Result;
end;
{$ENDIF}

        
        //----------------------
        // Convert real to string
        
function Real2Str(x: Real): String;
#VCL:var i: Integer;
begin
#VCL:     RESULT := FloatToStr(x);
#VCL:	  i := pos(',', RESULT);	  
#VCL:	  if i > 0 then RESULT[i] := '.';
#KOL:     RESULT := Extended2Str(x);
end;

        //----------------------
        // Convert Boolean to string
function Bool2Str(X: Boolean): String;
begin
    Result := 'FALSE';
    if X then Result := 'TRUE';
end;

        //------------------------------------------------------------
        // Convert string to int (no exceptions!)

function Int(const s: String): Integer;
var i: Integer;
    Neg: Boolean;
begin
    Result := 0;
    Neg := FALSE;
    if  s = '' then Exit;
    i := 1;
    if  s[i] = '-'  then
    begin
        inc(i);
        Neg := TRUE;
    end
    else if  s[i] = '+' then
        inc(i);
    for i := i to Length(s) do
    begin
        if  s[i] = '_' then continue;
        if  (s[i] >= '0') and (s[i] <= '9') then
            Result := Result * 10 + Ord(s[i]) - Ord('0')
        else break;
    end;
    if  Neg then Result := -Result;
end;

        //------------------------------------------------------------
        // Convert Real to Int
function RealAsInt(X: Real): Integer;
begin
	{$IFDEF KOL}
    	Result := Trunc(X);
	{$ELSE}
		{$IFDEF FPC}
			if IsNaN(X) then Result := 0
			else if X = Infinity then Result := MAXINT
			else if X = -Infinity then Result := -MAXINT-1
			else Result := Trunc(X);
		{$ELSE}
			try
		    	Result := Trunc(X);
			except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
					Result := 0;
			   end;
			end;
		{$ENDIF}
	{$ENDIF}
end;

function EnumAsInt(X: Integer): Integer;
begin
	RESULT := X;
end;

//------------- 'string as a sequence of hexadecimal, 4 digits per char'
function hex16(value16: Integer): String;
var i, digit: Integer;
begin
    Result := '';
    for i := 0 to 3 do
    begin
        digit := (value16 shr 12) and $f;
        value16 := value16 shl 4;
        if digit < 10 then Result := Result + Char(Ord('0') + digit)
        else Result := Result + Char(Ord('A') + digit - 10);
    end;
end;

function StrHex16(const s: string): String;
var i: Integer;
begin
    Result := '';
    for i := 1 to Length(s) do
        Result := Result + hex16(Ord(s[i]));
end;

        //------------------------------------------------------------
        // shl
function ShiftLeft(i, n: Integer): Integer;
begin
    Result := i shl n;
end;

        //------------------------------------------------------------
        // shr
function ShiftRight(i, n: Integer): Integer;
begin
    Result := i shr n;
end;

        //------------------------------------------------------------
        // rotate bits left
function RotateLeft(i, m: Integer): Integer;
var mask: Integer;
begin
    mask := (-1 shl (m-1)) shl 1;
    Result := (i and mask)
    or (i shl 1) and not (mask) 
    or ((i and not mask) shr (m-1));
end;

        //------------------------------------------------------------
        // rotate bits right
function RotateRight(i, m: Integer): Integer;
var mask: Integer;
begin
    mask := (-1 shl (m-1)) shl 1;
    Result := (i and mask)
    or ((i shl (m-1)) and not mask)
    or ((i and not mask) shr 1);
end;

        //------------------------------------------------------------
        // constructor of a reference mini-object
{$IFDEF DEBUG}
var Total_ref_obj_count: Integer;
var First_block_of_refs: array[0..89999] of Integer;
var List_unallocated_refs: array[0..89999] of Integer;

procedure Fill_list_unallocated_refs;
var i, d: Integer;
begin
	d := 0;
	for i := 0 to High(First_block_of_refs) do
		if First_block_of_refs[i] = i then
		begin
			List_unallocated_refs[d] := i;
			inc(d);
		end;
	asm nop end;
end;

var Interest_count_created: Integer;
{$ENDIF}

        
function new_Ref_obj(obj_: AL4_object; count_: Integer): Ref_obj;
begin
//?{Thread}
		if List_ref_obj_free = nil then
#KOL:		List_ref_obj_free := NewList;
#VCL:		List_ref_obj_free := TList.Create;
//.
    	if List_ref_obj_free.Count = 0 then
    	begin
#KOL:		new(Result, Create);
#VCL:		Result := Ref_obj.Create();
			{$IFDEF DEBUG}
				inc(Total_ref_obj_count);
				Result.Index_ref_obj := Total_ref_obj_count;
				if Total_ref_obj_count < Length(First_block_of_refs) then
					First_block_of_refs[Total_ref_obj_count] := Total_ref_obj_count;
			{$ENDIF}
    	end	else
    	begin
#VCL: 		Result := Ref_obj(List_ref_obj_free[List_ref_obj_free.Count-1]);
#KOL: 		Result := List_ref_obj_free.Items[List_ref_obj_free.Count-1];
    		List_ref_obj_free.Delete(List_ref_obj_free.Count-1);
    	end;
    	Result.Obj := obj_;
    	Result.Count := count_;
    	{$IFDEF DEBUG}
    	inc(Result.Count_created);
    	
		if Result.Index_ref_obj < Length(First_block_of_refs) then
			First_block_of_refs[Result.Index_ref_obj] := Result.Index_ref_obj;
        //if Result.Index_ref_obj = 1001 then
        //begin
        //    asm nop end;
        //    Interest_count_created := Result.Count_created;
        //    if (Result.Count_created = 0) then
        //    asm nop end;
        //end;
    	{$ENDIF}
end;

#VCL: function new_Ref_obj_weak(obj_: AL4_object; count_: Integer): Ref_obj_weak;
#VCL: begin
//?{Thread}
#VCL:		if List_ref_obj_free = nil then
#VCL:		List_ref_obj_free := TList.Create;
//.
#VCL:  	if List_ref_obj_free.Count = 0 then
#VCL:  	begin
#VCL:		Result := Ref_obj_weak.Create();
#VCL:		{$IFDEF DEBUG}
#VCL:			inc(Total_ref_obj_count);
#VCL:			Result.Index_ref_obj := Total_ref_obj_count;
#VCL:			if Total_ref_obj_count < Length(First_block_of_refs) then
#VCL:		   		First_block_of_refs[Total_ref_obj_count] := Total_ref_obj_count;
#VCL:		{$ENDIF}
#VCL:  	end	else
#VCL:  	begin
#VCL: 		Result := Ref_obj_weak(List_ref_obj_free[List_ref_obj_free.Count-1]);
#VCL:  		List_ref_obj_free.Delete(List_ref_obj_free.Count-1);
#VCL:  	end;
#VCL:   Result.Obj := obj_;
#VCL:   Result.Count := count_;
#VCL:    	{$IFDEF DEBUG}
#VCL:    	if Result.Index_ref_obj = 1001 then
#VCL:    	asm nop end;
#VCL:    	{$ENDIF}
#VCL: end;

#VCL:    procedure Ref_obj.Ref_dec_weak();
#KOL:    procedure TRef_obj.Ref_dec_weak();
    begin
    		if {$IFDEF KOL}@{$ENDIF} Self=nil then Exit;
    		{$IFnDEF KOL}
    		if Obj = nil then Exit;
    		{$ENDIF}
    	    {$IFDEF DEBUG}
    		if Obj.weak_link.Index_ref_obj = 1001 then
    		asm nop end;
    		{$ENDIF}
            dec({$IFnDEF FPC} Obj.weak_link. {$ENDIF} Count, 2);
            if ({$IFnDEF FPC} Obj.weak_link. {$ENDIF} Count = 0) then
            begin
                // in platforms without garbage collector,
                // place here code to destroy this Ref_obj
                // representing Weak reference to the object
                // which was already destroyed
                
                //Free;
                Obj := nil;
                List_ref_obj_free.Add({$IFDEF KOL}@{$ENDIF} Self);
                {$IFDEF DEBUG}
				if Index_ref_obj < Length(First_block_of_refs) then
					First_block_of_refs[Index_ref_obj] := 0;
				{$ENDIF}

                // in case of DotNet platform, it will be
                // destroyed automatically since there are
                // no more references to it.
            end;
    end;

#VCL:    procedure Ref_obj.Ref_dec_hard();
#KOL:    procedure TRef_obj.Ref_dec_hard();
    var weak_before_erase: Ref_obj;
    begin
    		if {$IFDEF KOL}@{$ENDIF}Self=nil then Exit;
    	    {$IFDEF DEBUG}
    		if Index_ref_obj = 1001 then
    		asm nop end;
    		{$ENDIF}
            //dec(Obj.hard_link.Count, 2);
            {$IFnDEF NOTRY}
            try
            {$ENDIF}
	            dec(Count, 2);
	            if (Count = 0) then
	            begin
	                //weak_before_erase := Obj.Weak_link.Obj.weak_link;
	                weak_before_erase := Obj.Weak_link;
	                Obj.Erase();
	                weak_before_erase.Count := (weak_before_erase.Count or 1) + 1;
	                dec(weak_before_erase.Count, 2);
	                if weak_before_erase.Count = 0 then
	                begin
	                	weak_before_erase.Obj := nil;
	                	List_ref_obj_free.Add(weak_before_erase);
		                {$IFDEF DEBUG}
						if weak_before_erase.Index_ref_obj < Length(First_block_of_refs) then
							First_block_of_refs[weak_before_erase.Index_ref_obj] := 0;
						{$ENDIF}
	                end;
	                
	                List_ref_obj_free.Add({$IFDEF KOL}@{$ENDIF} Self);
	                Obj := nil; 
	                {$IFDEF DEBUG}
					if Index_ref_obj < Length(First_block_of_refs) then
						First_block_of_refs[Index_ref_obj] := 0;
					{$ENDIF}
	            end;
            {$IFnDEF NOTRY}
            except on E: Exception do
            	begin
            		if E is AL4_Exception then raise;
	            	{$IFnDEF KOL}
	            	{$IFnDEF FPC}
	            	if App_closed then
	            		TerminateProcess(GetCurrentProcess, 0);
	            	{$ENDIF}
	            	{$ENDIF}
            	end;
            end;
            {$ENDIF}
    end;
    
#VCL:    procedure Ref_obj.Ref_inc_hard();
#KOL:    procedure TRef_obj.Ref_inc_hard();
    begin
    	{$IFDEF DEBUG}
    	if Index_ref_obj = 1001 then
    	asm nop end;
    	{$ENDIF}
            inc(Count, 2);
    end;
    
{$IFDEF USERTTI}
#VCL:	function AL4_object.RTTI_object_type: Integer;
#KOL:	function TAL4_object.RTTI_object_type: Integer;
begin
	Result := 0;
end;

function RTTI_type_name(index, flags: Integer): string;
var info: String;
	p_comma, p_beam: Integer;
begin
	info := RTTI_type_info[index];
	p_comma := pos(',', info);
	if p_comma > 0 then
		info := Copy(info, 1, p_comma-1);
	
	Result := info;
	p_beam := pos('|', info);
	case (flags) of
	0: if (p_beam > 0) then
	   begin
		   Result := Copy(Result, 1, p_beam-1);
		   if (Result[1] = '{') then Result := Result + '}';
	   end;
	1: if (p_beam > 0) then
		  Result := Copy(Result, 1, p_beam) + Copy(Result, p_beam+1, MAXINT);
	end;
end;

function RTTI_type_kind(index: Integer): Integer;
var info: String;
	p_comma: Integer;
begin
	info := RTTI_type_info[index];
	p_comma := pos(',', info);
	if p_comma > 0 then
		info := Copy(info, 1, p_comma-1);
	
	Result := 0; if (info[1] <> '{') then Exit;
	
	Result := 3;
	if UpperCase(info[2] + '') = info[2] + '' then Exit;
	
	Result := 1;
	if (pos(',items:', RTTI_type_info[index]) > 0) then Exit;
	
	Result := 2;
end;
	
function RTTI_count_classes(): Integer;
begin
	Result := RTTI_type_len;
end;
	
function RTTI_base_class(class_index: Integer): Integer;
var info: String;
	p_base, p_comma: Integer;
begin
	info := RTTI_type_info[class_index];
	p_base := pos(',base:', info);
	if (p_base <= 0) then begin Result := -1; Exit; end;
	info := Copy(info, p_base+6, MAXINT);
	p_comma := pos(',', info);
	info := Copy(info, 1, p_comma-1);
	{$IFDEF KOL} Result := Str2Int(info);
	{$ELSE} Result := StrToInt(info);
	{$ENDIF}
end;
	
function RTTI_starting_class_record_index(class_index: Integer): Integer;
var info: String;
	p_rec, p_comma: Integer;
begin
	info := RTTI_type_info[class_index];
	p_rec := pos(',rec:', info);
	if (p_rec <= 0) then begin Result := -1; Exit; end;
	info := Copy(info, p_rec + 5, MAXINT);
	p_comma := pos(',', info);
	info := Copy(info, 1, p_comma-1);
	{$IFDEF KOL} Result := Str2Int(info);
	{$ELSE} Result := StrToInt(info);
	{$ENDIF}
end;
			   
function RTTI_count_class_records(class_index: Integer): Integer;
var info: String;
	p_rec, p_comma: Integer;
begin
	info := RTTI_type_info[class_index];
	p_rec := pos(',rec:', info);
	if (p_rec <= 0) then begin Result := -1; Exit; end;
	info := Copy(info, p_rec + 5, MAXINT);
	p_comma := pos(',', info);
	info := Copy(info, p_comma+1, MAXINT);
	if Copy(info, 1, 6) <> 'count:' then begin Result := -1; Exit; end;
	info := Copy(info, 7, MAXINT);
	{$IFDEF KOL} Result := Str2Int(info);
	{$ELSE} Result := StrToInt(info);
	{$ENDIF}
end;

procedure RTTI_class_records(class_index: Integer; records: DynAInt);
var base_index, start, count, i: Integer;
	info: String;
begin
	records.Clear();
	base_index := RTTI_base_class(class_index);
	if (base_index >= 0) then
		RTTI_class_records(base_index, records);
	
	start := RTTI_starting_class_record_index(class_index);
	count := RTTI_count_class_records(class_index);
	
	for i := start to start + count - 1 do
	begin
		info := RTTI_type_info[i];
		if (pos(',items:', info) > 0) then continue;
		records.Add(MAXINT, i);
	end;
end;

procedure RTTI_class_enums(class_index: Integer; enums: DynAInt);
var base_index, start, count, i: Integer;
	info: String;
begin
	enums.Clear();
	base_index := RTTI_base_class(class_index);
	if (base_index >= 0) then
		RTTI_class_enums(base_index, enums);
	
	start := RTTI_starting_class_record_index(class_index);
	count := RTTI_count_class_records(class_index);
	
	for i := start to start + count - 1 do
	begin
		info := RTTI_type_info[i];
		if pos(',items:', info) <= 0 then continue;
		enums.Add(MAXINT, i);
	end;
end;

	
function RTTI_starting_enum_items_index(enum_type_index: Integer): Integer;
var info: String;
	p_items, p_comma: Integer;
begin
	info := RTTI_type_info[enum_type_index];
	p_items := pos(',items:', info);
	if (p_items <= 0) then begin Result := -1; Exit; end;
	info := Copy(info, p_items + 7, MAXINT);
	p_comma := pos(',', info);
	info := Copy(info, 1, p_comma-1);
	{$IFDEF KOL} Result := Str2Int(info);
	{$ELSE} Result := StrToInt(info);
	{$ENDIF}
end;

function RTTI_enum_count(enum_type_index: Integer): Integer;
var info: String;
	p_comma: Integer;
begin
	info := RTTI_type_info[enum_type_index];
	p_comma := pos(',count:', info);
	if (p_comma <= 0) then begin Result := -1; Exit; end;
	info := Copy(info, p_comma+7, MAXINT);
	{$IFDEF KOL} Result := Str2Int(info);
	{$ELSE} Result := StrToInt(info);
	//writeln('get RTTI_enum_count for ' + IntToStr(enum_type_index) + ': ' +
	//	'[' + RTTI_type_info[enum_type_index] + '] --> [' + info + '] --> ' +
	//	IntToStr(Result));
	{$ENDIF}
end;

function RTTI_enum_item(enum_type_index, index_item: Integer): String;
var start, count: Integer;
begin
	start := RTTI_starting_enum_items_index(enum_type_index);
	count := RTTI_enum_count(enum_type_index);
	if (index_item < 0) or (index_item >= count) then Result := ''
	else Result := RTTI_enum_items[start + index_item];
end;

//#RTTI_type_info_methods2

{$ENDIF}

////////////////////////////////////////////////////////////////////////////////
var None_al4_obj: AL4_object;

#VCL:    constructor AL4_object.Create();
#KOL:    constructor TAL4_object.Create();
        begin
            inherited Create;
#VCL:            hard_link := new_Ref_obj(Self, 0);
#KOL:            hard_link := new_Ref_obj( @ Self, 0);
#VCL:            weak_link := new_Ref_obj(Self, 1);
#KOL:            weak_link := new_Ref_obj( @ Self, 1);

#VCL:            write := Self;
#KOL:            write := @Self;
            inc(total_obj_counter);
            TOTAL_obj_index := total_obj_counter;
            if (TOTAL_obj_index = 999) {= 999} then
            begin
            	nop := 0;
            end;
        end;

#VCL:    class function AL4_object.NONE_obj_instance(): Ref_obj;
#KOL:    class function TAL4_object.NONE_obj_instance(): Ref_obj;
        begin
            RESULT := None_obj;
        end;

#VCL:    function AL4_object.Dummy_obj_instance(): Ref_obj;
#KOL:    function TAL4_object.Dummy_obj_instance(): Ref_obj;
        begin
            RESULT := dummy_obj;
        end;

#VCL:    class function AL4_object.NONE_base_obj(): AL4_object;
#KOL:    class function TAL4_object.NONE_base_obj(): AL4_object;
        begin
            RESULT := nil;
        end;
        
#VCL:    procedure AL4_object.CONSTRUCT;
#KOL:    procedure TAL4_object.CONSTRUCT;
        begin
        end;

#VCL:    procedure AL4_object.DESTRUCT;
#KOL:    procedure TAL4_object.DESTRUCT;
        begin
        end;

#VCL:    procedure AL4_object.Erase{$IFDEF _D5orHigher}(){$ENDIF};
#KOL:    procedure TAL4_object.Erase{$IFDEF _D5orHigher}(){$ENDIF};
        var i: Integer;
            c: Ref_obj;
            none_: Ref_obj;
            this: AL4_object;
        begin
            //if (TOTAL_obj_index = 37) then
            //begin end;
            
            //if Assigned(OnErase) then
            //    OnErase(Self);

#VCL:		this := Self;
#KOL:		this := @Self;

            // 1st, destroy children if those are present:
            if (children <> nil) then
            begin
                for i := 0 to children.Count-1 do
                begin
#VCL:                     c := Ref_obj(children[i]);
#KOL:                     c := children.Items[i];
                     c.Obj.Erase();
                end;
                children.Clear();
            end;
            
#VCL:		{$IFDEF _D5orHigher}
#VCL:            FreeAndNil(children);
#VCL:		{$ELSE}
#VCL:            children.Free;
#VCL:            children := nil;
#VCL:		{$ENDIF}

#KOL:            Free_And_Nil(children);
            
            DESTRUCT;

            // destroy the object removing all three references onto it:
            none_ := NONE_obj_instance();

            weak_link.Obj := none_.Obj;
            //todo: Ref_dec_weak_link(weak_link); // !weak_link mini-object ia dereferenced
            hard_link.Obj := none_.Obj;
            //todo: Ref_dec_hard_link(hard_link); // !hard_link mini-object is dereferenced
            write := none_.Obj.write;

            hard_link := none_;
            weak_link := none_;
            
            this.Free;
        end;
        
        procedure Object_assign_hard(var Dest: Ref_obj; Src: AL4_object);
        begin
            { In case when an object is assigned to a field of NONE:
              the worst is what happened: a leak of an object created and 
              assigned to such field but no memory corruption occur. } 
            if Dest = nil then Exit;
            if Src = nil then Exit;
            { First increment source counter, so in case when a variable gets
              as a new value itself, nothing bad is occur. }
            if assigned(src) then
            begin
            	{$IFDEF DEBUG}
            		Src.hard_link.Ref_inc_hard();
            	{$ELSE}
        	    	inc(Src.hard_link.Count, 2);
            	{$ENDIF}
            	{ Increment by 2, since 1 is used as a flag (In hard refs - as 
              	  a flag that an object is owned and it should not be released
              	  until its owner is released. In weak refs it is always set.) }
            	Dest.Ref_dec_hard;
            	Dest := Src.hard_link;
            end;
        end;
        
        //procedure Object_assign_hard(var Dest: Ref_obj; Src: Ref_obj);
        //begin
        //    Object_assign_hard(Dest, Src.Obj);
        //end;

        
        procedure Object_assign_weak(var Dest: Ref_obj; Src: AL4_object);
        begin
            if Dest = nil then Exit;
            if Src = nil then Exit;
            {$IFDEF DEBUG}
            	Src.weak_link.Ref_inc_hard();
            {$ELSE}
            	inc(Src.weak_link.Count, 2);
            {$ENDIF}
            Dest.Ref_dec_weak;
            Dest := Src.weak_link;
        end;
        
        { These versions are used to assign a result of a function returning
          an object. RESULT object's usage counter is not decremented, so we
          can suppose that the counter is already incremented. }
        procedure Object_assign_hard_noincref(var Dest: Ref_obj; Src: AL4_object);
        begin
            if Dest = nil then Exit;
            Dest.Ref_dec_hard;
            Dest := Src.hard_link;
        end;
        
        procedure Object_assign_weak_noincref(var Dest: Ref_obj; Src: AL4_object);
        begin
            if Dest = nil then Exit;
            Dest.Ref_dec_weak;
            Dest := Src.weak_link;
        end;
        
#VCL:	procedure Ref_obj.Discard_struct();        
#KOL:	procedure TRef_obj.Discard_struct();
		begin
			if Obj.Is_NONE_object then Exit;
			Count := 2;
			Ref_dec_hard();
		end;        

#VCL:        function Ref_obj.Owned_by(owner: Ref_obj): Ref_obj;
#KOL:        function TRef_obj.Owned_by(owner: Ref_obj): Ref_obj;
        begin
#VCL:            Result := Self;
#KOL:            Result := @Self;
            if (owner.Obj.Is_NONE_object) then EXIT;
            if (owner.Obj.children = nil) then
#VCL:          owner.Obj.children := TList.Create();
#KOL:          owner.Obj.children := NewList;
#VCL:            owner.Obj.children.Add(Self);
#KOL:            owner.Obj.children.Add(@Self);
            Self.Count := Self.Count or 1;
        end;

        {$IFNDEF NOEXCEPTIONS}
        constructor Stop_exception.Create(msg: String);
        begin
#VCL:            Message := msg;
#KOL:            inherited Create(e_Custom, msg);
        end;
        {$ENDIF}
        
procedure release_temp_lists(List: 
	{$IFDEF KOL} PList
	{$ELSE} TList
	{$ENDIF});
var i: Integer;
begin
	for i := List.Count-1 downto 0 do
	begin
#VCL:	TObject(List.Items[i]).Free;
#KOL:	PObj(List.Items[i]).Free;
	end;
	List.Clear;
	if List_lists_temps.Count < MAX_CACHED_ARRAYS then
		List_lists_temps.Add(List)
	else List.Free;
end;

procedure clear_list_temps(List: 
	{$IFDEF KOL} PList
	{$ELSE} TList 
	{$ENDIF});
var i: Integer;
	{$IFDEF SMALLER_CODE}
	{$ELSE}
		{$IFDEF  KOL}
		L: PList;
		{$ELSE}
		L: TList;
		{$ENDIF}
		A: DynamicArray;
	{$ENDIF}
begin
	for i := List.Count-1 downto 0 do
	begin
		{$IFDEF SMALLER_CODE}
#VCL:	TObject(List.Items[i]).Free;
#KOL:	PObj(List.Items[i]).Free;
        {$ELSE}
            A := DynamicArray(List.Items[i]);
            A.Discard;
            {$IFDEF KOL}
                L := PList(PObj(List.Items[i]).Tag);
                if (L <> nil) and (L.Count < MAX_CACHED_ARRAYS) then
                    L.Add(List.Items[i])
                else PObj(List.Items[i]).Free;
            {$ELSE}
                L := TList({$IFDEF FPC} PtrUInt {$ENDIF} (A.Tag));
                if (L <> nil) and (L.Count < MAX_CACHED_ARRAYS) then
                    L.Add(List.Items[i])
                else TObject(List.Items[i]).Free;
            {$ENDIF}
        {$ENDIF}
	end;
	List.Clear;
end;	

function allocate_list_temps: 
	{$IFDEF KOL} PList
	{$ELSE} TList 
	{$ENDIF};
begin
	if List_lists_temps = nil then
	begin
		{$IFDEF KOL} List_lists_temps := NewList;
		{$ELSE} List_lists_temps := TList.Create();
		{$ENDIF}
	end;
	if List_lists_temps.Count > 0 then
	begin
		Result := {$IFDEF FPC} TList {$ENDIF}
			(List_lists_temps.Items[List_lists_temps.Count-1]);
		List_lists_temps.Delete(List_lists_temps.Count-1);
		Exit;
	end;
	Result := {$IFDEF KOL} NewList
			  {$ELSE} TList.Create()
			  {$ENDIF};
end;

#VCL:procedure DynamicArray.Discard;
#KOL:procedure TDynamicArray.Discard;
begin
end;
        
{$IFDEF USE_DynAObj} 
#VCL:constructor DynAObj.Create(none_: Ref_obj);
#KOL:constructor TDynAObj.Create(none_: Ref_obj);
begin
    inherited Create;
    none_obj := none_;
#VCL:    List := TList.Create;
#KOL:    List := NewList;
end;
////////////////////////////////////////////////////////////////////////////////

				 	  /////////////
#VCL:function DynAObj.DynAObj_Count: Integer;
#KOL:function TDynAObj.DynAObj_Count: Integer;
begin
	Result := 0;
	if List <> nil then Result := List.Count;
end;

				 	  ///////////
#VCL:function DynAObj.DynAObj_Get(Idx: Integer): Ref_obj;
#KOL:function TDynAObj.DynAObj_Get(Idx: Integer): Ref_obj;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Result := none_obj
	else Result := Ref_obj(List.Items[Idx]);
end;

				  	   ///////////////
#VCL:procedure DynAObj.DynAObjHard_Put(Idx: Integer; Value: Ref_obj);
#KOL:procedure TDynAObj.DynAObjHard_Put(Idx: Integer; Value: Ref_obj);
var old: Ref_obj;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	old := Ref_obj(List.Items[Idx]);
	List.Items[Idx] := Value;
	{$IFDEF DEBUG}
		Value.Ref_inc_hard();
	{$ELSE}
		inc(Value.Count, 2);
	{$ENDIF}
	old.Ref_dec_hard;
end;

#VCL: procedure DynAObj.DynARecord_Put(Idx: Integer; Value: Ref_obj);
#KOL: procedure TDynAObj.DynARecord_Put(Idx: Integer; Value: Ref_obj);
var old, clone: Pointer;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	old := List.Items[Idx];
	FreeMem(old);
	GetMem(clone, record_len);
	Move(Pointer(Value)^, clone^, record_len);
	List.Items[Idx] := clone;
end;

#VCL: procedure DynAObj.DynARecord_Add_clonerec(Idx: Integer; Value: Ref_obj); 
#KOL: procedure TDynAObj.DynARecord_Add_clonerec(Idx: Integer; Value: Ref_obj); 
var clone: Pointer;
begin
	if LONGWORD(Idx) > LONGWORD(Count()) then Idx := Count();
	GetMem(clone, record_len);
	Move(Pointer(Value)^, clone^, record_len);
#KOL:	if List.Capacity <= List.Count then
#KOL:		List.Capacity := List.Capacity + 4 + List.Capacity div 2 ; 
	List.Insert(Idx, clone);
end;

#VCL: procedure DynAObj.Add_record(Idx: Integer; const Value); 
#KOL: procedure TDynAObj.Add_record(Idx: Integer; const Value); 
begin
	DynARecord_Add_clonerec(Idx, {$IFDEF FPC} Ref_obj {$ENDIF} (@Value) );
end;

					   ///////////////////
#VCL:procedure DynAObj.DynAObjHardWeak_Add(Idx: Integer; Value: Ref_obj);
#KOL:procedure TDynAObj.DynAObjHardWeak_Add(Idx: Integer; Value: Ref_obj);
begin
	if LONGWORD(Idx) > LONGWORD(Count()) then Idx := Count();
#KOL:	if List.Capacity <= List.Count then
#KOL:		List.Capacity := List.Capacity + 4 + List.Capacity div 2 ; 
	List.Insert(Idx, Value);
	{$IFDEF DEBUG}
		Value.Ref_inc_hard();
	{$ELSE}
		inc(Value.Count, 2);
	{$ENDIF}
end;

					   ////////////////////
#VCL:procedure DynAObj.DynAObj_Add_noincref(Idx: Integer; Value: Ref_obj);
#KOL:procedure TDynAObj.DynAObj_Add_noincref(Idx: Integer; Value: Ref_obj);
begin
	if LONGWORD(Idx) > LONGWORD(Count()) then Idx := Count();
#KOL:	if List.Capacity <= List.Count then
#KOL:		List.Capacity := List.Capacity + 4 + List.Capacity div 2 ; 
	List.Insert(Idx, Value);
end;

#VCL: procedure DynAObj.DynAObjRecord_Delete_release(Idx: Integer; Count_delete: Integer);
#KOL: procedure TDynAObj.DynAObjRecord_Delete_release(Idx: Integer; Count_delete: Integer);
var i: Integer;
	Value: Pointer;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	if Idx + Count_delete > Count() then Count_delete := Count() - Idx;
	for i := Idx + Count_delete - 1 downto Idx do
	begin 
		if i >= List.Count then continue;
		Value := List.Items[i];
		List.Delete(i);
		FreeMem(Value);
	end;
end;

		  		  	   //////////////////
#VCL:procedure DynAObj.DynAObjHard_Delete(Idx, Count_delete: Integer);
#KOL:procedure TDynAObj.DynAObjHard_Delete(Idx, Count_delete: Integer);
var i: Integer;
	Value: Ref_obj;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	if Idx + Count_delete > Count() then Count_delete := Count() - Idx;
	for i := Idx + Count_delete - 1 downto Idx do
	begin 
		if i >= List.Count then continue;
		Value := Ref_obj(List.Items[i]);
		Value.Ref_dec_hard;
		if i < List.Count then
			List.Delete(i);
	end;
end;

					  ///////////////
#VCL:function DynAObj.DynAObj_IndexOf(Value: Ref_obj): Integer;
#KOL:function TDynAObj.DynAObj_IndexOf(Value: Ref_obj): Integer;
var i: Integer;
	Stored: Ref_obj;
begin
	for i := 0 to List.Count-1 do
	begin
		Stored := Ref_obj(List.Items[i]);
		if Stored.Obj = Value.Obj then
		begin
			Result := i;
			Exit;
		end;
	end;
	Result := -1;
end;

	      ///////////////
#VCL:procedure DynAObj.DynAObj_Swap(i, j: Integer);
#KOL:procedure TDynAObj.DynAObj_Swap(i, j: Integer);
var X, Y: Ref_obj;
begin
	if (Cardinal(i) >= Cardinal(List.Count))
	or (Cardinal(j) >= Cardinal(List.Count)) then Exit;
	X := Ref_obj(List.Items[i]);
	Y := Ref_obj(List.Items[j]);
	List.Items[i] := Y;
	List.Items[j] := X;
end;

					   ///////////////
#VCL:procedure DynAObj.DynAObjWeak_Put(Idx: Integer; Value: Ref_obj);
#KOL:procedure TDynAObj.DynAObjWeak_Put(Idx: Integer; Value: Ref_obj);
var old: Ref_obj;	  
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	old := Ref_obj(List.Items[Idx]);
	List.Items[Idx] := Value;
	{$IFDEF DEBUG}
		Value.Ref_inc_hard();
	{$ELSE}
		inc(Value.Count, 2);
	{$ENDIF}
	old.Ref_dec_weak;
end;

					  //////
#VCL:procedure DynAObj.DynAObjWeak_Delete(Idx, Count_delete: Integer);
#KOL:procedure TDynAObj.DynAObjWeak_Delete(Idx, Count_delete: Integer);
var i: Integer;
	Value: Ref_obj;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	if Idx + Count_delete > Count() then Count_delete := Count() - Idx;
	for i := Idx + Count_delete - 1 downto Idx do
	begin 
		if i >= List.Count then continue;
		Value := Ref_obj(List.Items[i]);
		Value.Ref_dec_weak;
		if i < List.Count then
			List.Delete(i);
	end;
end;



////////////////////////////////////////////////////////////////////////////////

#VCL:procedure DynAObj.Ref_dec_last();
#KOL:procedure TDynAObj.Ref_dec_last();
begin
    if Count() = 0 then EXIT;
    GetObjects(Count() - 1).Ref_dec_hard();
end;
	

#VCL:procedure DynAObj.Allocate(New_size: Integer);
#KOL:procedure TDynAObj.Allocate(New_size: Integer);
var i: Integer;
	clone: Pointer;
begin
	if New_size > Count() then
		List.Capacity := New_size;
	for i := List.Count to New_size-1 do
	begin
		if record_len=0 then
			List.Add(none_obj)
		else begin
			clone := AllocMem(record_len);
			Move(Pointer(none_obj)^, clone^, record_len);
			List.Add(clone);
		end;
	end;
	for i := List.Count-1 downto New_size do
	begin
		if record_len=0 then
			SetObjects(i, none_obj)
		else FreeMem(Pointer(List{$IFDEF KOL}.Items{$ENDIF}[i]));
		List.Delete(i);
	end; 
end;

#VCL:procedure DynAObj.Unref_hard;
#KOL:procedure TDynAObj.Unref_hard;
var i: Integer;
begin
	for i := List.Count-1 downto 0 do
		GetObjects(i).Ref_dec_hard();
	Clear;
end;

#VCL:procedure DynAObj.Unref_weak;
#KOL:procedure TDynAObj.Unref_weak;
var i: Integer;
begin
	for i := List.Count-1 downto 0 do
		GetObjects(i).Ref_dec_weak();
	Clear;
end;

#VCL:procedure DynAObj.Clear_struc;
#KOL:procedure TDynAObj.Clear_struc;
var i: Integer;
begin
	for i := List.Count-1 downto 0 do
		GetObjects(i).Discard_struct();
	List.Clear;
end;



/////////////////////////////////////////////////////
{$IFDEF ARRAYDETAILS}
var Global_array_index: Integer;

procedure Set_array_index(var Index: Integer);
begin
	{$IFDEF ONLY_INTERESTING_THREADS}
	if GetCurrentThreadId = Interesting_ThreadId then Exit;
	{$ENDIF}
	inc(Global_array_index); Index := Global_array_index;
	if Global_array_index = 0 then
	begin nop := 0; end;
end;
{$ENDIF}

function New_DynARecord(none_record: Pointer; rec_len: Integer): DynAObj;
begin
#VCL:	Result := DynAObj.Create(Ref_obj(none_record));
#KOL:	new(Result , Create(none_record));
    Result.record_len := rec_len;
    {$IFDEF ARRAYDETAILS}
    Set_array_index(Result.Array_index);
    Result.Info := 'DynAObjRecord';
    {$ENDIF}
        Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Count;
        Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Get;
        Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynARecord_Put;
        Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynARecord_Add_clonerec;
        Result.Add_noincref := {$IFDEF DOG}@{$ENDIF} Result.DynARecord_Add_clonerec;
        Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAObjRecord_Delete_release;
        Result.IndexOf := nil;
        Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Swap;
        Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Clear;
		
        Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynARecord_Clone_array;
end;

function New_DynAObjHard(none_obj: Ref_obj): DynAObj;
begin
#VCL:	Result := DynAObj.Create(none_obj);
#KOL:	new(Result , Create(none_obj));
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAObjHard';
	{$ENDIF}
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHard_Put; 
		Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHardWeak_Add; 
		Result.Add_noincref := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Add_noincref; 
		Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHard_Delete; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Clear;
		
		Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHard_Clone_array;
end;	

function New_FixAObjHard_N(none_obj: Ref_obj; count_items: Integer): DynAObj;
var i: Integer; 
begin
	{$IFDEF USE_cache_FixAObj}
	if cache_FixAObj.Count > 0 then
	begin
		Result := DynAObj(cache_FixAObj.Items[cache_FixAObj.Count-1]);
		cache_FixAObj.Delete(cache_FixAObj.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAObj.Create(None_al4_obj.hard_link);
#KOL:	new(Result , Create(None_al4_obj.hard_link));
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAObj';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Clear;
	end;
	
	Result.Base_DynAObj := New_DynAObjHard(none_obj);
	for i := 0 to count_items-1 do
		Result.Base_DynAObj.Add(MAXINT, none_obj);
	Result.Count_fixed := count_items;
			
		{$IFDEF USE_cache_FixAObj}
		Result.Tag := 0
		{$ENDIF}
	;
			
end;	

function New_FixAObjWeak_N(none_obj: Ref_obj; count_items: Integer): DynAObj;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAObj}
	if cache_FixAObj.Count > 0 then
	begin
		Result := DynAObj(cache_FixAObj.Items[cache_FixAObj.Count-1]);
		cache_FixAObj.Delete(cache_FixAObj.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAObj.Create(None_al4_obj.hard_link);
#KOL:	new(Result , Create(None_al4_obj.hard_link));
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAObj';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Clear;
	end;
	
	Result.Base_DynAObj := New_DynAObjWeak(none_obj);
	for i := 0 to count_items-1 do
		Result.Base_DynAObj.Add(MAXINT, none_obj);
	Result.Count_fixed := count_items;
			
		{$IFDEF USE_cache_FixAObj}
		Result.Tag := 0
		{$ENDIF}
	;
			
end;




////////////////////////////////////////////////////
function New_DynAObjWeak(none_obj: Ref_obj): DynAObj;
begin
#VCL:	Result := DynAObj.Create(none_obj);
#KOL:	new(Result , Create(none_obj));
	Result.Is_weak := TRUE;
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAObjWeak';
	{$ENDIF}
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObjWeak_Put; 
		Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHardWeak_Add; 
		Result.Add_noincref := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Add_noincref; 
		Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAObjWeak_Delete; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_IndexOf; 
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Clear;
		
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAObjWeak_Clone_array;
end;	

function New_DynAStruct(none_obj: Ref_obj): DynAObj;
begin
#VCL:	Result := DynAObj.Create(none_obj);
#KOL:	new(Result , Create(none_obj));
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAObjHard';
	{$ENDIF}
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHard_Put; 
		Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHardWeak_Add; 
		Result.Add_noincref := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Add_noincref; 
		Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHard_Delete; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.Clear_struc;
		
		Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAObjHard_Clone_array;

end;	

				  	  ////////
#VCL:function DynAObj.Contains(Obj: Ref_obj): Boolean;
#KOL:function TDynAObj.Contains(Obj: Ref_obj): Boolean;
begin
	Result := IndexOf(Obj) >= 0;
end;

					   /////
#VCL:procedure DynAObj.DynAObj_Clear;
#KOL:procedure TDynAObj.DynAObj_Clear;
var i: Integer;
begin
	if Assigned(Delete) then
		Delete(0, Count())
	else
		for i := Count()-1 downto 0 do
			SetObjects(i, none_obj);
end;
	
					   //////
#VCL:procedure DynAObj.Remove(Obj: Ref_obj);
#KOL:procedure TDynAObj.Remove(Obj: Ref_obj);
var i: Integer;
begin
	for i := Count()-1 downto 0 do
		if GetObjects(i).Obj = Obj.Obj then Delete(i, 1);
end;

					   ////
#VCL:procedure DynAObj.Copy(To_index: Integer; Source: DynAObj);
#KOL:procedure TDynAObj.Copy(To_index: Integer; Source: DynAObj);
var i, j, last: Integer;
begin
	j := 0;
	if To_index < 0 then
	begin
		j := -To_index;
		To_index := 0;
	end;
	last := To_index + Source.Count() - j - 1;
	if last >= Count() then last := Count()-1;
	for i := To_index to last do
	begin
		SetObjects(i, Source.GetObjects(j));
		inc(j);
	end;
end;

					   /////
#VCL:procedure DynAObj.Fill(To_index: Integer; Obj: Ref_obj; Fill_count: Integer);
#KOL:procedure TDynAObj.Fill(To_index: Integer; Obj: Ref_obj; Fill_count: Integer);
var i: Integer;
begin
	for i := To_index to To_index + Fill_count - 1 do
	begin
		if i >= Count() then Exit; 
		SetObjects(i, Obj);
	end;
end;

					   ///////
#VCL:procedure DynAObj.Repeat_(To_index: Integer; Source: DynAObj;
#KOL:procedure TDynAObj.Repeat_(To_index: Integer; Source: DynAObj;
			Count_repeat: Integer);
var i, j, k: Integer;
begin
	i := To_index;
	for k := 1 to Count_repeat do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			if i >= Count() then Exit;
			SetObjects(i, Source.GetObjects(j));
			inc(i);
		end;
	end;
end;

					   //////
#VCL:procedure DynAObj.Extend(Obj: Ref_obj; Count_extend: Integer);
#KOL:procedure TDynAObj.Extend(Obj: Ref_obj; Count_extend: Integer);
var i: Integer;
begin
	List.Capacity := Count() + Count_extend;
	for i := 1 to Count_extend do
	begin
		List.Add(Obj);
	end;
end;
	
#VCL:procedure DynAObj.Append(Source: DynAObj; Count_append: Integer);
#KOL:procedure TDynAObj.Append(Source: DynAObj; Count_append: Integer);
var j, k: Integer;
begin
	List.Capacity := Count() + Count_append * Source.Count();
	for k := 1 to Count_append do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			List.Add(Source.GetObjects(j));
		end;
	end;
end;

#VCL:function DynAObj.DynARecord_Clone_array(): DynAObj;
#KOL:function TDynAObj.DynARecord_Clone_array(): DynAObj;
var i, cnt: Integer;
begin
    Result := New_DynARecord(none_obj, record_len);
    Result.List.Capacity := Count();
    cnt := Count();
    for i := 0 to cnt-1 do
        Result.Add(i, GetObjects(i));
end;

#VCL:function DynAObj.DynAObjHard_Clone_array(): DynAObj;
#KOL:function TDynAObj.DynAObjHard_Clone_array(): DynAObj;
var i: Integer;
begin
	Result := New_DynAObjHard(none_obj);
	Result.Clear := Clear;
	Result.List.Capacity := Count();
	for i := 0 to Count()-1 do
		Result.Add(i, GetObjects(i));
end;

#VCL:function DynAObj.DynAObjWeak_Clone_array(): DynAObj;
#KOL:function TDynAObj.DynAObjWeak_Clone_array(): DynAObj;
var i: Integer;
begin
	Result := New_DynAObjWeak(none_obj); 
	Result.List.Capacity := Count();
	for i := 0 to Count()-1 do
		Result.Add(i, GetObjects(i));
end;

#VCL:function DynAObj.FixAObjHard_Clone_array(): DynAObj;
#KOL:function TDynAObj.FixAObjHard_Clone_array(): DynAObj;
begin
	Result := New_FixAObj(nil, {$IFDEF KOL}@{$ENDIF} Self, 0, Count()-1);
end;


////////////////////////////////
#VCL:procedure DynAObj.Dispose;
#KOL:procedure TDynAObj.Dispose;
begin
		Free;
end;

#VCL:destructor DynAObj.Destroy;
#KOL:destructor TDynAObj.Destroy;
begin
#KOL: if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;
#KOL: try
#KOL: if fRefCount <> -2 then Exit;
  Discard;
  inherited;
#KOL: finally
#KOL:	if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;
#KOL: end;
end;

#VCL:procedure DynAObj.Discard;
#KOL:procedure TDynAObj.Discard;
begin
	Clear;
	if not Shared_array then
	begin
#VCL:	{$IFDEF _D5orHigher}
#VCL:	 FreeAndNil(Base_DynAObj);
#VCL:	{$ELSE}
#VCL:	 Base_DynAObj.Free;
#VCL:	 Base_DynAObj := nil;
#VCL:	{$ENDIF}
#KOL:	 Free_And_Nil(Base_DynAObj);
	end;
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(List);
#VCL:	{$ELSE}
#VCL:	List.Free;
#VCL:	List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(List);
end;

////////////////////////////////////////////////////////////////////////////////

				 /////
#VCL:function DynAObj.FixAObj_Count: Integer;
#KOL:function TDynAObj.FixAObj_Count: Integer;
begin
	Result := Count_fixed;
end;

				 ///
#VCL:function DynAObj.FixAObj_Get(Idx: Integer): Ref_obj;
#KOL:function TDynAObj.FixAObj_Get(Idx: Integer): Ref_obj;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Result := none_obj
	else Result := Base_DynAObj.DynAObj_Get(Idx + Start_index);
end;

					  ///
#VCL:procedure DynAObj.FixAObj_Put(Idx: Integer; Value: Ref_obj);
#KOL:procedure TDynAObj.FixAObj_Put(Idx: Integer; Value: Ref_obj);
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Exit;
	if Base_DynAObj.Is_weak then
		 Base_DynAObj.DynAObjWeak_Put(Idx + Start_index, Value)
	else Base_DynAObj.DynAObjHard_Put(Idx + Start_index, Value);
end;
	
					  ///////
#VCL:function DynAObj.FixAObj_IndexOf(Value: Ref_obj): Integer;
#KOL:function TDynAObj.FixAObj_IndexOf(Value: Ref_obj): Integer;
var i: Integer;
begin
    for i := 0 to Count()-1 do
        if  FixAObj_Get(i).Obj = Value.Obj then
        begin
            Result := i; Exit;
        end;
    Result := -1;
end;
	
	      ///////////////
#VCL:procedure DynAObj.FixAObj_Swap(i, j: Integer);
#KOL:procedure TDynAObj.FixAObj_Swap(i, j: Integer);
var X, Y: Ref_obj;
begin
	if (Cardinal(i) >= Cardinal(Count())) 
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	X := FixAObj_Get(i);
	Y := FixAObj_Get(j);
	FixAObj_Put(i, Y);
	FixAObj_Put(j, X);
end;

					   /////
#VCL:procedure DynAObj.FixAObj_Clear;
#KOL:procedure TDynAObj.FixAObj_Clear;
begin
	Count_fixed := 0;
end;

	
////////////////////////////////////////////////////

{$IFDEF SMALLER_CODE}
{$ELSE}
//?{Thread}
	{$DEFINE DONTUSECACHES}
//.
	{$IFnDEF DONTUSECACHES}
		{$DEFINE USE_cache_FixAObj}
	{$ENDIF}
	var cache_FixAObj: {$IFDEF KOL} PList 
					   {$ELSE} TList 
					   {$ENDIF};
{$ENDIF}	
	
function New_FixAObj(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAObj; From_index, To_index: Integer): DynAObj;
begin
	{$IFDEF USE_cache_FixAObj}
	if cache_FixAObj.Count > 0 then
	begin
		Result := DynAObj(cache_FixAObj.Items[cache_FixAObj.Count-1]);
		cache_FixAObj.Delete(cache_FixAObj.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAObj.Create(OnBase.none_obj);
#KOL:	new(Result , Create(OnBase.none_obj));
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAObj';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Clear;
	end;
	
	Result.Shared_array := true;
	if From_index < 0 then From_index := 0;
	if To_index >= OnBase.Count() then To_index := OnBase.Count()-1;
	if OnBase.Shared_array then
	begin
		Result.Base_DynAObj := OnBase.Base_DynAObj;
		Result.Start_index := From_index + OnBase.Start_index;
	end
	else
	begin		
		Result.Base_DynAObj := OnBase;
		Result.Start_index := From_index;
	end;
	Result.Count_fixed := To_index - From_index + 1;
	if Result.Count_fixed < 0 then Result.Count_fixed := 0;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAObj}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAObj);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAObj}
		else Result.Tag := 0
		{$ENDIF}
	; 
end;

var dummy_fixed_obj_array: DynAObj;

function New_FixAObjWeak(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAObj;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAObj}
	if cache_FixAObj.Count > 0 then
	begin
		Result := DynAObj(cache_FixAObj.Items[cache_FixAObj.Count-1]);
		cache_FixAObj.Delete(cache_FixAObj.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAObj.Create(None_al4_obj.hard_link);
#KOL:	new(Result , Create(None_al4_obj.hard_link));
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAObj';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Clear;
	end;

	Result.Base_DynAObj := New_DynAObjHard(NoneObj_AL4_object.hard_link);
	for i := 1 to n do
		Result.Base_DynAObj.Add(MAXINT, NoneObj_AL4_object.hard_link);
	Result.Count_fixed := n;
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAObj}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAObj);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAObj}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAObjHard_Clone_array;
end;

function New_FixAObjHard_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Ref_obj): DynAObj;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAObj}
	if cache_FixAObj.Count > 0 then
	begin
		Result := DynAObj(cache_FixAObj.Items[cache_FixAObj.Count-1]);
		cache_FixAObj.Delete(cache_FixAObj.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAObj.Create(None_al4_obj.hard_link);
#KOL:	new(Result , Create(None_al4_obj.hard_link));
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAObj';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Clear;
	end;
	
	Result.Base_DynAObj := New_DynAObjHard(NoneObj_AL4_object.hard_link);
	for i := 0 to High(X) do
		Result.Base_DynAObj.Add(MAXINT, X[i]);
	Result.Count_fixed := High(X) + 1;
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAObj}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAObj);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAObj}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	//Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAObjWeak_Clone_array;
end;

function New_FixAObjWeak_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Ref_obj): DynAObj;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAObj}
	if cache_FixAObj.Count > 0 then
	begin
		Result := DynAObj(cache_FixAObj.Items[cache_FixAObj.Count-1]);
		cache_FixAObj.Delete(cache_FixAObj.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAObj.Create(None_al4_obj.hard_link);
#KOL:	new(Result , Create(None_al4_obj.hard_link));
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAObj';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Count;
		Result.GetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Get; 
		Result.SetObjects := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Swap;
		Result.Clear := {$IFDEF DOG}@{$ENDIF} Result.FixAObj_Clear;
	end;
	
	Result.Base_DynAObj := New_DynAObjHard(NoneObj_AL4_object.hard_link);
	for i := 0 to High(X) do
		Result.Base_DynAObj.Add(MAXINT, X[i]);
	Result.Count_fixed := High(X) + 1;
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAObj}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAObj);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAObj}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	//Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAObjWeak_Clone_array;
end;

{$ENDIF}

function calculate_clamp_mask(cnt: Integer): Integer;
begin
	Result := 0;
	dec(cnt);
	while cnt > 0 do
	begin
		Result := (Result shl 1) or 1;
		cnt := cnt shr 1;
	end;
end;	

{$IFDEF USE_DynAInt}
////////////////////////////////////////////////////////////////////////////////

		 	  /////////////////////
#VCL:function DynAInt.DynAInt_Count: Integer;
#KOL:function TDynAInt.DynAInt_Count: Integer;
begin
	{$IFDEF INT_32}
    Result := List.Count;
    {$ELSE}
    Result := Length(Ai64);
    {$ENDIF}
end;

		 	  ///////////
#VCL:function DynAInt.DynAInt_Get(Idx: Integer): IntegerValue;
#KOL:function TDynAInt.DynAInt_Get(Idx: Integer): IntegerValue;
begin
	if LONGWORD(Idx) >=
	   {$IFDEF INT_32} 
	   LONGWORD(List.Count)
	   {$ELSE}
	   LONGWORD(Length(Ai64))
	   {$ENDIF} 
	   then 
	begin Result := 0; Exit; end;
	{$IFDEF INT_32}
    Result := Integer({$IFDEF FPC} PtrUInt {$ENDIF}(List.Items[Idx]));
    {$ELSE}
    Result := Ai64[Idx];
    {$ENDIF}
end;

#KOL: type PHackList = ^THackList;
#KOL: 	   THackList = object(TList)
#KOL:	   end;	

		  	   ///////////
#VCL:procedure DynAInt.DynAInt_Put(Idx: Integer; Value: IntegerValue);
#KOL:procedure TDynAInt.DynAInt_Put(Idx: Integer; Value: IntegerValue);
begin
	{$IFDEF INT_32}
	if LONGWORD(Idx) >= LONGWORD(List.Count) then Exit;
    List.Items[Idx] := Pointer({$IFDEF FPC} PtrUInt {$ENDIF}(Value));
    {$ELSE}
    if LONGWORD(Idx) >= LONGWORD(Length(Ai64)) then Exit;
    Ai64[Idx] := Value;
    {$ENDIF}
end;

			   ///////////
#VCL:procedure DynAInt.DynAInt_Add(Idx: Integer; Value: IntegerValue);
#KOL:procedure TDynAInt.DynAInt_Add(Idx: Integer; Value: IntegerValue);
{$IFnDEF INT_32}
var i: Integer;
{$ENDIF}
begin
	{$IFDEF INT_32}
	if LONGWORD(Idx) > LONGWORD(List.Count) then Idx := List.Count;
#KOL:	if List.Capacity <= List.Count then
#KOL:		List.Capacity := List.Capacity + 4 + List.Capacity div 2 ; 
    List.Insert(Idx, Pointer({$IFDEF FPC} PtrUInt {$ENDIF}(Value)));
	{$ELSE}
		if LONGWORD(Idx) > LONGWORD(Length(Ai64)) then Idx := Length(Ai64);
		SetLength(Ai64, Length(Ai64)+1);
		for i := Length(Ai64)-1 downto Idx+1 do
			Ai64[i] := Ai64[i-1];
		Ai64[Idx] := Value;
	{$ENDIF}
end;
	
		  	   		   //////////////
#VCL:procedure DynAInt.DynAInt_Delete(Idx: Integer; Count_delete: Integer);
#KOL:procedure TDynAInt.DynAInt_Delete(Idx: Integer; Count_delete: Integer);
var i: Integer;
	c: Integer;
begin
	{$IFDEF INT_32}
		c := List.Count;
		if LONGWORD(Idx) >= LONGWORD(c) then Exit;
		if Idx + Count_delete > c then
			Count_delete := c - Idx;
		for i := Idx + Count_delete to c-1 do
			List.Items[i - Count_delete] := List.Items[i];
		for i := c-1 downto c - Count_delete do
			List.Delete(i);
	{$ELSE}
		c := Length(Ai64);
		if LONGWORD(Idx) >= LONGWORD(c) then Exit;
		if Idx + Count_delete > c then
			Count_delete := c - Idx;
		if Count_delete <= 0 then Exit;
		for i := Idx + Count_delete to c-1 do
			Ai64[i - Count_delete] := Ai64[i];
		SetLength(Ai64, Length(Ai64) - Count_delete);
	{$ENDIF}
end;

			  		  ///////////////
#VCL:function DynAInt.DynAInt_IndexOf(Value: IntegerValue): Integer;
#KOL:function TDynAInt.DynAInt_IndexOf(Value: IntegerValue): Integer;
{$IFnDEF INT_32}
var i: Integer;
{$ENDIF}
begin
	{$IFDEF INT_32}
    	Result := List.IndexOf(Pointer({$IFDEF FPC} PtrUInt {$ENDIF}(Value)));
	{$ELSE}
		for i := 0 to Length(Ai64)-1 do
			if Ai64[i] = Value then
			begin
				Result := i;
				Exit;
			end;
		Result := -1;
	{$ENDIF}
end;

			  		  ///////////////
#VCL:procedure DynAInt.DynAInt_Swap(i, j: Integer);
#KOL:procedure TDynAInt.DynAInt_Swap(i, j: Integer);
var X, Y: IntegerValue;
begin
	{$IFDEF INT_32}
		if (Cardinal(i) >= Cardinal(List.Count))
		or (Cardinal(j) >= Cardinal(List.Count)) then Exit;
		X := Integer({$IFDEF FPC} PtrUInt {$ENDIF}(List.Items[i]));
		Y := Integer({$IFDEF FPC} PtrUInt {$ENDIF}(List.Items[j]));
		List.Items[i] := Pointer({$IFDEF FPC} PtrUInt {$ENDIF}(Y));
		List.Items[j] := Pointer({$IFDEF FPC} PtrUInt {$ENDIF}(X));
	{$ELSE}
		if (Cardinal(i) >= Cardinal(Length(Ai64)))
		or (Cardinal(j) >= Cardinal(Length(Ai64))) then Exit;
		X := Ai64[i];
		Y := Ai64[j];
		Ai64[i] := Y;
		Ai64[j] := X;
	{$ENDIF}
end;

/////////////////////////////////////
	
				 ///////////////
#VCL:constructor DynAInt.Create;
#KOL:constructor TDynAInt.Create;
begin
	inherited;
	{$IFDEF INT_32}
#VCL:  List := TList.Create;
#KOL:  List := NewList;
	{$ENDIF}
end;

//////////////////////////////
function New_DynAInt: DynAInt;
begin
#VCL: Result := DynAInt.Create;
#KOL: new(Result, Create);
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAInt';
	{$ENDIF}
	Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Count;
	Result.GetIntegers := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Get;
	Result.SetIntegers := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Put;
	Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Add;
	Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Delete;
	Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_IndexOf;
	Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Swap;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAInt_Clone_array;
end;

					  ////////
#VCL:function DynAInt.Contains(Value: IntegerValue): Boolean;
#KOL:function TDynAInt.Contains(Value: IntegerValue): Boolean;
begin
    Result := IndexOf(Value) >= 0;
end;

					   //////
#VCL:procedure DynAInt.Remove(Value: IntegerValue);
#KOL:procedure TDynAInt.Remove(Value: IntegerValue);
var i: Integer;
begin
	for i := Count()-1 downto 0 do
		if GetIntegers(i) = Value then
			Delete(i, 1);
end;

#VCL:procedure DynAInt.Clear;
#KOL:procedure TDynAInt.Clear;
begin
	if Assigned(Delete) then
		DynAInt_Delete(0, Count());
end;
	
#VCL:procedure DynAInt.Nullify;
#KOL:procedure TDynAInt.Nullify;
var i: Integer;
begin
	for i := 0 to Count()-1 do
		SetIntegers(i, 0);
end;
	

				///////////////
#VCL:procedure DynAInt.Dispose;
#KOL:procedure TDynAInt.Dispose;
begin
		Free;
end;

#VCL:destructor DynAInt.Destroy;
#KOL:destructor TDynAInt.Destroy;
begin
  Discard;
  inherited;
end;

#VCL:procedure DynAInt.Discard;
#KOL:procedure TDynAInt.Discard;
begin
	Clear;
	if not Shared_array then
	begin
#VCL:	{$IFDEF _D5orHigher}
#VCL:	 FreeAndNil(Base_DynAInt);
#VCL:	{$ELSE}
#VCL:	 Base_DynAInt.Free;
#VCL:	 Base_DynAInt := nil;
#VCL:	{$ENDIF}
#KOL:	 Free_And_Nil(Base_DynAInt);
	end;
	{$IFDEF INT_32}
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(List);
#VCL:	{$ELSE}
#VCL:	List.Free;
#VCL:	List := nil;
#VCL:	{$ENDIF}
#KOL:Free_And_Nil(List);
	{$ELSE}
	SetLength(Ai64, 0);
	{$ENDIF}
end;

			   		   /////
#VCL:procedure DynAInt.Copy(To_index: Integer; Source: DynAInt);
#KOL:procedure TDynAInt.Copy(To_index: Integer; Source: DynAInt);
var i, j, last: Integer;
begin
	j := 0;
	if To_index < 0 then
	begin
		j := -To_index;
		To_index := 0;
	end;
	last := To_index + Source.Count() - j - 1;
	if last >= Count() then last := Count()-1;
	for i := To_index to last do
	begin
		SetIntegers(i, Source.GetIntegers(j));
		inc(j);
	end;
end;

					   ////
#VCL:procedure DynAInt.Fill(To_index: Integer; Value: IntegerValue; Fill_count: Integer);
#KOL:procedure TDynAInt.Fill(To_index: Integer; Value: IntegerValue; Fill_count: Integer);
var i, last: Integer;
begin
	if To_index < 0 then
	begin
		inc(Fill_count, To_index);
		To_index := 0;
	end;
	last := To_index + Fill_count - 1;
	if last >= Count() then last := Count() - 1; 
	for i := To_index to last do
	begin
		SetIntegers(i, Value);
	end;
end;

					   //////
#VCL:procedure DynAInt.Repeat_(To_index: Integer; Source: DynAInt;
#KOL:procedure TDynAInt.Repeat_(To_index: Integer; Source: DynAInt;
			Count_repeat: Integer);
var i, j, k: Integer;
begin
	i := To_index;
	for k := 1 to Count_repeat do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			if i >= Count() then Exit;
			SetIntegers(i, Source.GetIntegers(j));
			inc(i);
		end;
	end;
end;

						//////
#VCL:procedure DynAInt.Extend(Value: IntegerValue; Count_extend: Integer);
#KOL:procedure TDynAInt.Extend(Value: IntegerValue; Count_extend: Integer);
var i: Integer;
begin
	i := Count();
	{$IFDEF INT_32}
		List.Capacity := Count() + Count_extend;
		for i := i to i + Count_extend - 1 do
		begin
			List.Add(Pointer({$IFDEF FPC} PtrUInt {$ENDIF}(Value)));
		end;
	{$ELSE}
		SetLength(Ai64, Length(Ai64) + Count_extend);
		for i := i to i + Count_extend - 1 do
			Ai64[i] := Value;
	{$ENDIF}
end;
	
						//////
#VCL:procedure DynAInt.Append(Source: DynAInt; Count_append: Integer);
#KOL:procedure TDynAInt.Append(Source: DynAInt; Count_append: Integer);
var j, k: Integer;
	{$IFnDEF INT_32}
	n: Integer;
	{$ENDIF}
begin
	{$IFDEF INT_32}
		List.Capacity := Count() + Count_append * Source.Count();
		for k := 1 to Count_append do
		begin
			for j := 0 to Source.Count()-1 do
			begin
				List.Add(Pointer(
						 {$IFDEF FPC} PtrUInt {$ENDIF}(Source.GetIntegers(j))));
			end;
		end;
	{$ELSE}
		n := Length(Ai64);
		SetLength(Ai64, Length(Ai64) + Count_append * Source.Count());
		for k := 1 to Count_append do
		begin
			for j := 0 to Source.Count()-1 do
			begin
				Ai64[n] := Source.GetIntegers(j);
				inc(n);
			end;
		end;
	{$ENDIF}
end;

#VCL:function DynAInt.DynAInt_Clone_array(): DynAInt;
#KOL:function TDynAInt.DynAInt_Clone_array(): DynAInt;
var i: Integer;
begin
	Result := New_DynAInt();
	{$IFDEF INT_32}
		Result.List.Capacity := Count();
		for i := 0 to Count()-1 do
			Result.Add(i, GetIntegers(i));
	{$ELSE}
		SetLength(Result.Ai64, Length(Ai64));
		for i := 0 to Count()-1 do
			Result.Ai64[i] := Ai64[i];
	{$ENDIF}
end;

#VCL:function DynAInt.FixAInt_Clone_array(): DynAInt;
#KOL:function TDynAInt.FixAInt_Clone_array(): DynAInt;
begin
	Result := New_FixAInt(nil, {$IFDEF KOL}@{$ENDIF} Self, 0, Count()-1);
end;

#VCL:procedure DynAInt.Allocate(New_size: Integer);
#KOL:procedure TDynAInt.Allocate(New_size: Integer);
var i: Integer;
begin
	{$IFDEF INT_32}
		if New_size > Count() then
			List.Capacity := New_size;
		for i := List.Count to New_size-1 do
			List.Add(nil);
		for i := List.Count-1 downto New_size do
			List.Delete(i);
	{$ELSE}
		//if New_size <= Count() then Exit;
		i := Length(Ai64);
		SetLength(Ai64, New_size);
		for i := i to New_size-1 do
			Ai64[i] := 0;
	{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
{$IFDEF SMALLER_CODE}
{$ELSE}
	{$IFnDEF DONTUSECACHES}
		{$DEFINE USE_cache_FixAInt}
	{$ENDIF}
	{$IFDEF USE_cache_FixAInt}
		var cache_FixAInt: {$IFDEF KOL} PList 
						   {$ELSE} TList 
						   {$ENDIF};
	{$ENDIF}
{$ENDIF}
	
function New_FixAInt(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAInt; Index_from, Index_To: Integer): DynAInt;
begin
	{$IFDEF USE_cache_FixAInt}
	if (cache_FixAInt.Count > 0) then
	begin
		Result := DynAInt(cache_FixAInt.Items[cache_FixAInt.Count-1]);
		cache_FixAInt.Delete(cache_FixAInt.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAInt.Create;
#KOL:	new(Result, Create);
		{$IFDEF INT_32}
#VCL:		{$IFDEF _D5orHigher}
#VCL:		FreeAndNil(Result.List);
#VCL:		{$ELSE}
#VCL:		Result.List.Free;
#VCL:		Result.List := nil;
#VCL:		{$ENDIF}
#KOL:		Free_And_Nil(Result.List);
		{$ENDIF}

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAInt';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Count;
		Result.GetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Get; 
		Result.SetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Swap;
	end;
			
	if Index_from < 0 then Index_from := 0;
	Result.Shared_array := true;
	if Index_to >= OnBase.Count() then 
		Index_to := OnBase.Count()-1;
	if OnBase.Shared_array then
	begin
		Result.Base_DynAInt := OnBase.Base_DynAInt;
		Result.Start_index := Index_from + OnBase.Start_index;
	end
		else
	begin
		Result.Base_DynAInt := OnBase;
		Result.Start_index := Index_from;
	end;
	Result.Count_fixed := Index_to - Index_from + 1;
	if Result.Count_fixed < 0 then Result.Count_fixed := 0;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAInt}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAInt);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAInt}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Clone_array;
end;

{$IFDEF _D5orHigher}
var dummy_fixed_int_array: DynAInt;
{$ENDIF}

function New_FixAInt_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAInt;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAInt}
	if (cache_FixAInt.Count > 0) then
	begin
		Result := DynAInt(cache_FixAInt.Items[cache_FixAInt.Count-1]);
		cache_FixAInt.Delete(cache_FixAInt.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAInt.Create;
#KOL:	new(Result, Create);
		{$IFDEF INT_32}
#VCL:		{$IFDEF _D5orHigher}
#VCL:		FreeAndNil(Result.List);
#VCL:		{$ELSE}
#VCL:		Result.List.Free;
#VCL:		Result.List := nil;
#VCL:		{$ENDIF}
#KOL:		Free_And_Nil(Result.List);
		{$ENDIF}
		
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAInt';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Count;
		Result.GetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Get; 
		Result.SetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Swap;
		
	end;
	
	Result.Base_DynAInt := New_DynAInt();
	for i := 1 to n do
		Result.Base_DynAInt.Add(MAXINT, 0);
	Result.Count_fixed := n;
	Result.Shared_array := false;
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAInt}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAInt);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAInt}
		else Result.Tag := 0
		{$ENDIF}
	;
	 
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Clone_array;
end;

function New_FixAInt_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Integer): DynAInt;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAInt}
	if (cache_FixAInt.Count > 0) then
	begin
		Result := DynAInt(cache_FixAInt.Items[cache_FixAInt.Count-1]);
		cache_FixAInt.Delete(cache_FixAInt.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAInt.Create;
#KOL:	new(Result, Create);
		{$IFDEF INT_32}
#VCL:		{$IFDEF _D5orHigher}
#VCL:		FreeAndNil(Result.List);
#VCL:		{$ELSE}
#VCL:		Result.List.Free;
#VCL:		Result.List := nil;
#VCL:		{$ENDIF}
#KOL:		Free_And_Nil(Result.List);
        {$ENDIF}
		
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAInt';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Count;
		Result.GetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Get; 
		Result.SetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Swap;
		
	end;
	
	Result.Base_DynAInt := New_DynAInt();
	for i := 0 to High(X) do
		Result.Base_DynAInt.Add(MAXINT, X[i]);
	Result.Count_fixed := Result.Base_DynAInt.Count();
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAInt}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAInt);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAInt}
		else Result.Tag := 0
		{$ENDIF}
	;
	 
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Clone_array;
end;

#VCL:function DynAInt.FixAInt_Count: Integer;
#KOL:function TDynAInt.FixAInt_Count: Integer;
begin
	Result := Count_fixed;
end;

#VCL:function DynAInt.FixAInt_Get(Idx: Integer): IntegerValue;
#KOL:function TDynAInt.FixAInt_Get(Idx: Integer): IntegerValue;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then begin Result := 0; Exit; end;
	//if (Idx >= 64) or (Idx < Count - 64) then
		Result := Base_DynAInt.GetIntegers(Start_index + Idx)
	//else Result := Base_DynAInt.Safe_GetIntegers(Start_index + Idx);
end; 

#VCL:procedure DynAInt.FixAInt_Put(Idx: Integer; Value: IntegerValue);
#KOL:procedure TDynAInt.FixAInt_Put(Idx: Integer; Value: IntegerValue);
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Exit;
	//if (Idx >= 64) or (Idx < Count - 64) then
		Base_DynAInt.SetIntegers(Start_index + Idx, Value)
	//else Base_DynAInt.Safe_PutIntegers(Start_index + Idx, Value);
end; 
 
#VCL:function DynAInt.FixAInt_IndexOf(Value: IntegerValue): Integer;
#KOL:function TDynAInt.FixAInt_IndexOf(Value: IntegerValue): Integer;
var i: Integer;
begin
	for i := 0 to Count()-1 do
		if Base_DynAInt.DynAInt_Get(Start_index + i) = Value then 
		begin 
			Result := i; Exit;
		end;
	Result := -1;
end;

			  		  ///////////////
#VCL:procedure DynAInt.FixAInt_Swap(i, j: Integer);
#KOL:procedure TDynAInt.FixAInt_Swap(i, j: Integer);
var X, Y: IntegerValue;
begin
	if (Cardinal(i) >= Cardinal(Count()))
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	X := Base_DynAInt.GetIntegers(Start_index + i);
	Y := Base_DynAInt.GetIntegers(Start_index + j);
	Base_DynAInt.SetIntegers(Start_index + i, Y);
	Base_DynAInt.SetIntegers(Start_index + j, X);
end;

function New_FixAInt_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PIntegerValue; Total_count, Start_index, End_index: Integer): DynAInt;
begin
	{$IFDEF USE_cache_FixAInt}
	if (cache_FixAInt.Count > 0) then
	begin
		Result := DynAInt(cache_FixAInt.Items[cache_FixAInt.Count-1]);
		cache_FixAInt.Delete(cache_FixAInt.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAInt.Create;
#KOL:	new(Result, Create);
		{$IFDEF INT_32}
#VCL:		{$IFDEF _D5orHigher}
#VCL:		FreeAndNil(Result.List);
#VCL:		{$ELSE}
#VCL:		Result.List.Free;
#VCL:		Result.List := nil;
#VCL:		{$ENDIF}
#KOL:		Free_And_Nil(Result.List);
		{$ENDIF}
		
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAInt_Array';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Count;
		Result.GetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Array_Get; 
		Result.SetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Array_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Array_Swap;
	end;		
	Result.Base_Pointer := X;
	Result.Start_index := Start_index;
	if End_index >= Total_count then End_index := Total_count - 1;
	Result.Count_fixed := End_index - Start_index + 1;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAInt}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAInt);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAInt}
		else Result.Tag := 0
		{$ENDIF}
	; 
end;

#VCL:function DynAInt.FixAInt_Array_Get(Idx: Integer): IntegerValue;
#KOL:function TDynAInt.FixAInt_Array_Get(Idx: Integer): IntegerValue;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then begin Result := 0; Exit; end;
	Result := PIntegerValue({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) + 
		LONGWORD(Idx+Start_index) * Sizeof(IntegerValue))^;
end; 

#VCL:procedure DynAInt.FixAInt_Array_Put(Idx: Integer; Value: IntegerValue);
#KOL:procedure TDynAInt.FixAInt_Array_Put(Idx: Integer; Value: IntegerValue);
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Exit;
	PIntegerValue({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) + 
		LONGWORD(Idx+Start_index) * Sizeof(IntegerValue))^ := Value;
end;

#VCL:procedure DynAInt.FixAInt_Array_Swap(i, j: Integer);
#KOL:procedure TDynAInt.FixAInt_Array_Swap(i, j: Integer);
var X, Y: IntegerValue;
begin
	if (Cardinal(i) >= Cardinal(Count()))
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	X := GetIntegers(i);
	Y := GetIntegers(j);
	SetIntegers(i, Y);
	SetIntegers(j, X);
end;
 
function New_FixAInt_Clamp(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PIntegerValue; Start_index, End_index: Integer): DynAInt;
begin
	{$IFDEF USE_cache_FixAInt}
	if (cache_FixAInt.Count > 0) then
	begin
		Result := DynAInt(cache_FixAInt.Items[cache_FixAInt.Count-1]);
		cache_FixAInt.Delete(cache_FixAInt.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAInt.Create;
#KOL:	new(Result, Create);
		{$IFDEF INT_32}
#VCL:		{$IFDEF _D5orHigher}
#VCL:		FreeAndNil(Result.List);
#VCL:		{$ELSE}
#VCL:		Result.List.Free;
#VCL:		Result.List := nil;
#VCL:		{$ENDIF}
#KOL:		Free_And_Nil(Result.List);
		{$ENDIF}
		
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAInt_Clamp';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Count;
		Result.GetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Clamp_Get; 
		Result.SetIntegers := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Clamp_Put; 
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_IndexOf;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAInt_Clamp_Swap;
	end;
	
	Result.Base_Pointer := X;
	Result.Start_index := Start_index;
	Result.Count_fixed := End_index - Start_index + 1;
	Result.Clamp_mask := calculate_clamp_mask(Result.Count_fixed);
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAInt_Clamp}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAInt_Clamp);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAInt_Clamp}
		else Result.Tag := 0
		{$ENDIF}
	; 
end;

#VCL:function DynAInt.FixAInt_Clamp_Get(Idx: Integer): IntegerValue;
#KOL:function TDynAInt.FixAInt_Clamp_Get(Idx: Integer): IntegerValue;
begin
	Idx := (Start_index + Idx) and Clamp_mask;
	Result := PIntegerValue({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(
		Base_Pointer) + LONGWORD( Idx * Sizeof(IntegerValue) ))^;
end; 

#VCL:procedure DynAInt.FixAInt_Clamp_Put(Idx: Integer; Value: IntegerValue);
#KOL:procedure TDynAInt.FixAInt_Clamp_Put(Idx: Integer; Value: IntegerValue);
begin
	Idx := (Start_index + Idx) and Clamp_mask;
	PIntegerValue({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) 
		+ LONGWORD( Idx * Sizeof(IntegerValue) ))^ := Value;
end;

			  		  ///////////////
#VCL:procedure DynAInt.FixAInt_Clamp_Swap(i, j: Integer);
#KOL:procedure TDynAInt.FixAInt_Clamp_Swap(i, j: Integer);
var X, Y: IntegerValue;
begin
	X := FixAInt_Clamp_Get(i);
	Y := FixAInt_Clamp_Get(j);
	FixAInt_Clamp_Put(i, Y);
	FixAInt_Clamp_Put(j, X);
end;	

procedure Copy_to_array_Int(Dest: PInteger; To_index, Dest_size: Integer;
	Source: DynAInt);
var count_copy: Integer;
	Addr_to: PIntegerValue; 
	i: Integer;
begin
	if To_index < 0 then
	begin
		inc(Dest_size, To_index);
		To_index := 0;
	end;
	if To_index >= Dest_size then Exit;
	
	count_copy := Source.Count();
	if To_index + count_copy > Dest_size then
		count_copy := Dest_size - To_index;
	if count_copy <= 0 then Exit;
	
	Addr_to := PIntegerValue({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Dest) + 
		LONGWORD(To_index) * Sizeof(IntegerValue));
	for i := 0 to count_copy-1 do
	begin
		Addr_to^ := Source.GetIntegers(i);
		inc(Addr_to);
	end; 
end;
{$ENDIF USE_DynAInt}
 


{$IFDEF USE_DynAReal}
////////////////////////////////////////////////////////////////////////////////

#VCL:function DynAReal.DynAReal_Count: Integer;
#KOL:function TDynAReal.DynAReal_Count: Integer;
begin 
    RESULT := {$IFDEF FPC} Length(Arr) {$ELSE} Arr_count {$ENDIF};
end;

#VCL:function DynAReal.DynAReal_Get(Idx: Integer): Real;
#KOL:function TDynAReal.DynAReal_Get(Idx: Integer): Real;
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) 
	then Result := 0
	else Result := 
	     {$IFDEF FPC} Arr[Idx]
	     {$ELSE} PReal(Integer(Arr) + Idx * Sizeof(Double))^
	     {$ENDIF} ;
end;

#VCL:procedure DynAReal.DynAReal_Put(Idx: Integer; Value: Real);
#KOL:procedure TDynAReal.DynAReal_Put(Idx: Integer; Value: Real);
begin
	if LONGWORD(Idx) >= LONGWORD(Count())
	then Exit;
	{$IFDEF FPC}
	Arr[Idx] := Value;
	{$ELSE}
	Preal(Integer(Arr) + Idx * Sizeof(Double))^ := Value;
	{$ENDIF}
end;

#VCL:procedure DynAReal.DynAReal_Add(Idx: Integer; Value: Real);
#KOL:procedure TDynAReal.DynAReal_Add(Idx: Integer; Value: Real);
begin
	if LONGWORD(Idx) > LONGWORD(Count()) then Idx := Count();
	{$IFDEF FPC}
	    SetLength(Arr, Length(Arr)+1);
	    Move(Arr[Idx], Arr[Idx+1], Sizeof(Double) * (Count() - Idx - 1) );
	    Arr[Idx] := Value;
    {$ELSE}
    	if Idx >= Arr_len then
    	begin
    		Arr_len := Arr_len + (Arr_len + 64) div 2;
    		ReallocMem(Arr, Arr_len * Sizeof(Double));
    	end;
    	if Count() > Idx + 1 then
	       Move( PReal( Integer(Arr) + Idx * Sizeof(Double))^,
	    		 PReal( Integer(Arr) + (Idx+1) * Sizeof(Double))^,
	    		 Sizeof(Double) * (Count() - Idx - 1) );
	    PReal( Integer(Arr) + Idx * Sizeof(Double))^ := Value;
	    inc(Arr_count);
    {$ENDIF}
end;

#VCL:procedure DynAReal.DynAReal_Delete(Idx: Integer; Count_delete: Integer);
#KOL:procedure TDynAReal.DynAReal_Delete(Idx: Integer; Count_delete: Integer);
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	if Idx + Count_delete > Count() then
		Count_delete := Count() - Idx;
	if Count_delete <= 0 then Exit; 
	{$IFDEF FPC}
		Move(Arr[Idx+Count_delete], Arr[Idx], 
			sizeof(Double) * (Count() - Idx - Count_delete));
		SetLength(Arr, Length(Arr)-Count_delete);
	{$ELSE}
		Move(PReal(Integer(Arr) + (Idx+Count_delete)*Sizeof(Double))^,
			 PReal(Integer(Arr) + Idx * Sizeof(Double))^, 
			 SizeOf(Double) * (Count() - Idx - Count_delete));
		Arr_count :=  Arr_count - Count_delete;
		if Arr_count = 0 then
		begin
			Arr_len := 0;
			FreeMem(Arr);
			Arr := nil;
		end;
	{$ENDIF}
end;

	      ///////////////
#VCL:procedure DynAReal.DynAReal_Swap(i, j: Integer);
#KOL:procedure TDynAReal.DynAReal_Swap(i, j: Integer);
var X, Y: Real;
begin
	if (Cardinal(i) >= Cardinal(Count()))
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	{$IFDEF FPC}
		X := Arr[i];
		Y := Arr[j];
		Arr[i] := Y;
		Arr[j] := X;
	{$ELSE}
		X := PReal(Integer(Arr)+ i*Sizeof(Double))^;
		Y := PReal(Integer(Arr)+ j*Sizeof(Double))^;
		PReal(Integer(Arr)+ i*Sizeof(Double))^ := Y;
		PReal(Integer(Arr)+ j*Sizeof(Double))^ := X;
	{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////

//-----------------------------------------------------------------------------
#VCL:constructor DynAReal.Create;
#KOL:constructor TDynAReal.Create;
begin
  inherited;
end;

////////////////////////////////
function New_DynAReal: DynAReal;
begin
#VCL:	Result := DynAReal.Create;
#KOL:	new(Result, Create);
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAReal';
	{$ENDIF}
	Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Count;
	Result.GetReals := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Get;
	Result.SetReals := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Put;
	Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Add;
	Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Delete;
	Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Swap;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAReal_Clone_array;
end;

#VCL:procedure DynAReal.Clear;
#KOL:procedure TDynAReal.Clear;
begin 
	{$IFDEF FPC}
    	SetLength(Arr, 0);
	{$ELSE}
		FreeMem(Arr);
		Arr := nil;
		Arr_len := 0;
		Arr_count := 0;
	{$ENDIF}
end;

#VCL:procedure DynAReal.Nullify;
#KOL:procedure TDynAReal.Nullify;
var i: Integer;
begin
	for i := 0 to Count()-1 do
		SetReals(i, 0);
end;
	
#VCL:procedure DynAReal.Dispose;
#KOL:procedure TDynAReal.Dispose;
begin
		Free;
end;

#VCL:destructor DynAReal.Destroy;
#KOL:destructor TDynAReal.Destroy;
begin
  	Discard;
  	inherited;
end;

#VCL:procedure DynAReal.Discard;
#KOL:procedure TDynAReal.Discard;
begin
	Clear;
    if not Shared_array then
    begin	
#VCL:	{$IFDEF _D5orHigher}
#VCL:   FreeAndNil(Base_DynAReal);
#VCL:	{$ELSE}
#VCL:   Base_DynAReal.Free;
#VCL:   Base_DynAReal := nil;
#VCL:	{$ENDIF}
#KOL:   Free_And_Nil(Base_DynAReal);
    end;
end;



#VCL:procedure DynAReal.Copy(To_index: Integer; Source: DynAReal);
#KOL:procedure TDynAReal.Copy(To_index: Integer; Source: DynAReal);
var i, j, last: Integer;
begin
	j := 0;
	if To_index < 0 then
	begin
		j := -To_index;
		To_index := 0;
	end;
	last := To_index + Source.Count() - j - 1;
	if last >= Count() then last := Count()-1;
	for i := To_index to last do
	begin
		SetReals(i, Source.GetReals(j));
		inc(j);
	end;
end;

#VCL:procedure DynAReal.Fill(To_index: Integer; Value: Real; Fill_count: Integer);
#KOL:procedure TDynAReal.Fill(To_index: Integer; Value: Real; Fill_count: Integer);
var i, last: Integer;
begin
	if To_index < 0 then
	begin
		inc(Fill_count, To_index);
		To_index := 0;
	end;
	last := To_index + Fill_count - 1; 
	if last >= Count() then
		last := Count() - 1;
	for i := To_index to last do
	begin
		SetReals(i, Value);
	end;
end;

#VCL:procedure DynAReal.Repeat_(To_index: Integer; Source: DynAReal;
#KOL:procedure TDynAReal.Repeat_(To_index: Integer; Source: DynAReal;
			Count_repeat: Integer);
var i, j, k: Integer;
begin
	i := To_index;
	for k := 1 to Count_repeat do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			if i >= Count() then Exit;
			SetReals(i, Source.GetReals(j));
			inc(i);
		end;
	end;
end;


#VCL:function DynAReal.DynAReal_Clone_array(): DynAReal;
#KOL:function TDynAReal.DynAReal_Clone_array(): DynAReal;
var i: Integer;
begin
	Result := New_DynAReal();
	{$IFDEF FPC}
	SetLength(Result.Arr, Count());
	{$ELSE}
	GetMem(Result.Arr, Count() * Sizeof(Double));
	Result.Arr_len := Count();
	Result.Arr_count := Count();
	{$ENDIF}
	for i := 0 to Count()-1 do
		Result.SetReals(i, GetReals(i));
end;

#VCL:function DynAReal.FixAReal_Clone_array(): DynAreal;
#KOL:function TDynAReal.FixAReal_Clone_array(): DynAReal;
begin
	Result := New_FixAReal(nil, {$IFDEF KOL}@{$ENDIF} Self, 0, Count()-1);
end;

#VCL:procedure DynAReal.Allocate(New_size: Integer);
#KOL:procedure TDynAReal.Allocate(New_size: Integer);
var i: Integer;
begin
	{$IFDEF FPC}
	SetLength(Arr, New_size);
	{$ELSE}
	if Arr_count = New_size then Exit;
	if New_size < Arr_len then
	begin
		Arr_count := New_size;
		Exit;
	end;
	ReallocMem(Arr, New_size * Sizeof(Double));
	i := Arr_count;
	Arr_len := New_size;
	Arr_count := New_size;
	for i := i to New_size-1 do
		SetReals(i, 0.0);
	{$ENDIF} 
end;

{$ENDIF}

{$IFDEF USE_DynAReal}

{$IFDEF SMALLER_CODE}
{$ELSE}
	{$IFnDEF DONTUSECACHES}
		{$DEFINE USE_cache_FixAReal}
	{$ENDIF}
	{$IFDEF USE_cache_FixAReal}
	var cache_FixAReal: {$IFDEF KOL} PList 
						{$ELSE} TList 
						{$ENDIF};
	{$ENDIF}
{$ENDIF}
	
function New_FixAReal(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAReal; Index_from, Index_To: Integer): DynAReal;
begin
	{$IFDEF USE_cache_FixAReal}
	if (cache_FixAReal.Count > 0) then
	begin
		Result := DynAReal(cache_FixAReal.Items[cache_FixAReal.Count-1]);
		cache_FixAReal.Delete(cache_FixAReal.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAReal.Create;
#KOL:	new(Result, Create);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAReal';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Count;
		Result.GetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Get; 
		Result.SetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Swap;
	end;
			
	Result.Shared_array := true;
	if Index_from < 0 then Index_from := 0;
	if Index_to >= OnBase.Count() then Index_to := OnBase.Count()-1;
	if OnBase.Shared_array then
	begin
		Result.Base_DynAReal := OnBase.Base_DynAReal;
		Result.Start_index := Index_from + OnBase.Start_index;
	end
		else
	begin
		Result.Base_DynAReal := OnBase;
		Result.Start_index := Index_from;
	end;
	Result.Count_fixed := Index_to - Index_from + 1;
	if Result.Count_fixed < 0 then Result.Count_fixed := 0;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAReal}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAReal);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAReal}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clone_array;
end;

{$IFDEF USE_cache_FixAReal}
{$IFDEF _D5orHigher}
var dummy_fixed_real_array: DynAReal;
{$ENDIF}
{$ENDIF}

function New_FixAReal_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAReal;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAReal}
	if (cache_FixAReal.Count > 0) then
	begin
		Result := DynAReal(cache_FixAReal.Items[cache_FixAReal.Count-1]);
		cache_FixAReal.Delete(cache_FixAReal.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAReal.Create;
#KOL:	new(Result, Create);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAReal';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Count;
		Result.GetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Get; 
		Result.SetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Swap;
	end;
	
	Result.Base_DynAReal := New_DynAReal();
	for i := 1 to n do
		Result.Base_DynAReal.Add(MAXINT, 0);
	Result.Count_fixed := n;
	Result.Shared_array := false;

	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAReal}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAReal);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAReal}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clone_array;
end;

function New_FixAReal_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Real): DynAReal;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAReal}
	if (cache_FixAReal.Count > 0) then
	begin
		Result := DynAReal(cache_FixAReal.Items[cache_FixAReal.Count-1]);
		cache_FixAReal.Delete(cache_FixAReal.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAReal.Create;
#KOL:	new(Result, Create);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAReal';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Count;
		Result.GetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Get; 
		Result.SetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Swap;
	end;
	
	Result.Base_DynAReal := New_DynAReal();
	for i := 0 to High(X) do
		Result.Base_DynAReal.Add(MAXINT, X[i]);
	Result.Count_fixed := High(X) + 1;
	Result.Shared_array := false;

	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAReal}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAReal);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAReal}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clone_array;
end;

function New_FixAReal_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PDouble; Start_index, End_index: Integer): DynAReal;
begin
	{$IFDEF USE_cache_FixAReal}
	if (cache_FixAReal.Count > 0) then
	begin
		Result := DynAReal(cache_FixAReal.Items[cache_FixAReal.Count-1]);
		cache_FixAReal.Delete(cache_FixAReal.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAReal.Create;
#KOL:	new(Result, Create);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAReal_Array';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Count;
		Result.GetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Array_Get; 
		Result.SetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Array_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Swap;
	end;
	
	Result.Base_Pointer := X;
	Result.Start_index := Start_index;
	Result.Count_fixed := End_index - Start_index + 1;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAReal}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAReal);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAReal}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clone_array;
end;

#VCL:function DynAReal.FixAReal_Count: Integer;
#KOL:function TDynAReal.FixAReal_Count: Integer;
begin
	Result := Count_fixed;
end;

#VCL:function DynAReal.FixAReal_Get(Idx: Integer): Real;
#KOL:function TDynAReal.FixAReal_Get(Idx: Integer): Real;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then begin Result := 0; Exit; end;
	Result := Base_DynAReal.GetReals(Start_index + Idx);
end; 

#VCL:procedure DynAReal.FixAReal_Put(Idx: Integer; Value: Real);
#KOL:procedure TDynAReal.FixAReal_Put(Idx: Integer; Value: Real);
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Exit;
	Base_DynAReal.SetReals(Start_index + Idx, Value);
end; 
 
	      ///////////////
#VCL:procedure DynAReal.FixAReal_Swap(i, j: Integer);
#KOL:procedure TDynAReal.FixAReal_Swap(i, j: Integer);
var X, Y: Real;
begin
	if (Cardinal(i) >= Cardinal(Count()))
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	X := Base_DynAReal.GetReals(i);
	Y := Base_DynAReal.GetReals(j);
	Base_DynAReal.SetReals(i, Y);
	Base_DynAReal.SetReals(j, X)
end;

#VCL:function DynAReal.FixAReal_Array_Get(Idx: Integer): Real;
#KOL:function TDynAReal.FixAReal_Array_Get(Idx: Integer): Real;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then begin Result := 0; Exit; end;
	Result := PDouble({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) 
		+ LONGWORD(Idx+Start_index) * Sizeof(Double))^;
end; 

#VCL:procedure DynAReal.FixAReal_Array_Put(Idx: Integer; Value: Real);
#KOL:procedure TDynAReal.FixAReal_Array_Put(Idx: Integer; Value: Real);
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Exit;
	PDouble({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) 
		+ LONGWORD(Idx+Start_index) * Sizeof(Double))^ := Value;
end;
 
function New_FixAReal_Clamp(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PDouble; Start_index, End_index: Integer): DynAReal;
begin
	{$IFDEF USE_cache_FixAReal}
	if (cache_FixAReal.Count > 0) then
	begin
		Result := DynAReal(cache_FixAReal.Items[cache_FixAReal.Count-1]);
		cache_FixAReal.Delete(cache_FixAReal.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAReal.Create;
#KOL:	new(Result, Create);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAReal_Clamp';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Count;
		Result.GetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clamp_Get; 
		Result.SetReals := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clamp_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAReal_Clamp_Swap;
	end;
			
	Result.Base_Pointer := X;
	Result.Start_index := Start_index;
	Result.Count_fixed := End_index - Start_index + 1;
	Result.Clamp_mask := calculate_clamp_mask(Result.Count_fixed);
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAReal}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAReal);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAReal}
		else Result.Tag := 0
		{$ENDIF}
	; 
end;

#VCL:function DynAReal.FixAReal_Clamp_Get(Idx: Integer): Real;
#KOL:function TDynAReal.FixAReal_Clamp_Get(Idx: Integer): Real;
begin
	Idx := (Start_index + Idx) and Clamp_mask;
	Result := PDouble({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) 
		+ LONGWORD(Idx) * Sizeof(Double))^;
end; 

#VCL:procedure DynAReal.FixAReal_Clamp_Put(Idx: Integer; Value: Real);
#KOL:procedure TDynAReal.FixAReal_Clamp_Put(Idx: Integer; Value: Real);
begin
	Idx := (Start_index + Idx) and Clamp_mask;
	PDouble({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer) 
		+ LONGWORD(Idx) * Sizeof(Double))^ := Value;
end;

#VCL:procedure DynAReal.FixAReal_Clamp_Swap(i, j: Integer);
#KOL:procedure TDynAReal.FixAReal_Clamp_Swap(i, j: Integer);
var X, Y: Real;
begin
	X := FixAReal_Clamp_Get(i);
	Y := FixAReal_Clamp_Get(j);
	FixAReal_Clamp_Put(i, Y);
	FixAReal_Clamp_Put(j, X)
end;

	
{$ENDIF USE_DynAReal}	

	
	

{$IFDEF USE_DynAByte} 
////////////////////////////////////////////////////////////////////////////////

#VCL:function DynAByte.GetBools(Idx: Integer): Boolean;
#KOL:function TDynAByte.GetBools(Idx: Integer): Boolean;
begin
	Result := Boolean(GetBytes(Idx));
end;

#VCL:procedure DynAByte.SetBools(Idx: Integer; Value: Boolean);
#KOL:procedure TDynAByte.SetBools(Idx: Integer; Value: Boolean);
begin
	if Value then
		SetBytes(Idx, 1)
	else SetBytes(Idx, 0);
end;

#VCL:function DynAByte.DynAByte_Count: Integer;
#KOL:function TDynAByte.DynAByte_Count: Integer;
begin 
    Result := fCount;
end;

#VCL:function DynAByte.DynAByte_Get(Idx: Integer): Byte;
#KOL:function TDynAByte.DynAByte_Get(Idx: Integer): Byte;
begin
	if LONGWORD(Idx) >= LONGWORD(fCount) then begin Result := 0; Exit; end;
#VCL:   RESULT := Byte(LONGWORD( List[Idx div 4] ) shr (8 * (Idx mod 4)));
#KOL:   RESULT := LONGWORD( List.Items[Idx div 4] ) shr (8 * (Idx mod 4));
end;

#VCL:procedure DynAByte.DynAByte_Put(Idx: Integer; Value: Byte);
#KOL:procedure TDynAByte.DynAByte_Put(Idx: Integer; Value: Byte);
const mask: array[ 0..3 ] of LONGWORD = (
      $FFFFFF00, $FFFF00FF, $FF00FFFF, $00FFFFFF);
begin
	if LONGWORD(Idx) >= LONGWORD(fCount) then Exit;
	
#VCL:   List[Idx div 4] := Pointer( LONGWORD(List[Idx div 4]) 
#KOL:   List.Items[Idx div 4] := Pointer( LONGWORD(List.Items[Idx div 4]) 
           and mask[Idx mod 4]
           or (Value shl (8 * (Idx mod 4))) );

end;


{$IFDEF SAFEARRAYS}
		{$DEFINE SAFE_ADD}
{$ENDIF}
{$IFNDEF USE_FirstByte}
		{$DEFINE SAFE_ADD}
{$ENDIF}

#VCL:procedure DynAByte.DynAByte_Add(Idx: Integer; Value: Byte);
#KOL:procedure TDynAByte.DynAByte_Add(Idx: Integer; Value: Byte);
{$IFDEF SAFE_ADD}
var i: Integer;
{$ELSE}
var From, To_addr: PByte;
{$ENDIF}
begin
	if LONGWORD(Idx) > LONGWORD(Count()) then Idx := Count();
	
	if  Count() mod 4 = 0 then
        List.Add(Pointer(Longint(Value)));

	inc(fCount);
	{$IFDEF SAFE_ADD}
		for i := fCount-1 downto Idx+1 do
			SetBytes(i, GetBytes(i-1));
	{$ELSE}
	if Idx < fCount-1 then begin
	
			From := PByte(Integer(FirstByte()) + Idx*Sizeof(Byte));
			To_addr := PByte(Integer(FirstByte()) + (Idx+1)*Sizeof(Byte));
			Move(From^, To_addr^, (fCount-1-Idx)*Sizeof(Byte));
			
	end;
	{$ENDIF}

	SetBytes(Idx, Value);
end;


{$IFDEF SAFEARRAYS}
		{$DEFINE SAFE_DELETE}
{$ENDIF}
{$IFNDEF USE_FirstByte}
		{$DEFINE SAFE_DELETE}
{$ENDIF}

#VCL:procedure DynAByte.DynAByte_Delete(Idx: Integer; Count_delete: Integer);
#KOL:procedure TDynAByte.DynAByte_Delete(Idx: Integer; Count_delete: Integer);
{$IFDEF SAFE_DELETE}
var i: Integer;
{$ELSE}
var From, To_addr: PByte;
{$ENDIF}
begin
	if LONGWORD(Idx) >= LONGWORD(Count()) then Exit;
	
	if Idx + Count_delete > fCount then
		Count_delete := fCount - Idx;
		
	{$IFDEF SAFE_DELETE}
		for i := Idx to Count()-1 - Count_delete do
			SetBytes(i, GetBytes(i+Count_delete));
	{$ELSE}
		From := PByte(Integer(FirstByte()) + (Idx + Count_delete)*Sizeof(Byte));
		To_addr := PByte(Integer(FirstByte()) + Idx*Sizeof(Byte));
		Move(From^, To_addr^, (fCount - (Idx + Count_delete))*Sizeof(Byte));
	{$ENDIF}

	dec(fCount, Count_delete);
	
	while List.Count > (fCount + 3) div 4 do
		List.Delete(List.Count-1);
end;

#VCL:procedure DynAByte.DynAByte_Swap(i, j: Integer);
#KOL:procedure TDynAByte.DynAByte_Swap(i, j: Integer);
var X, Y: Byte;
begin
	if (Cardinal(i) >= Cardinal(Count()))
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	X := GetBytes(i);
	Y := GetBytes(j);
	SetBytes(i, Y);
	SetBytes(j, X);
end;

////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

//-----------------------------------------------------------------------------
#VCL:constructor DynAByte.Create;
#KOL:constructor TDynAByte.Create;
begin
  inherited;
#VCL:	List := TList.Create;
#KOL:	List := NewList;
end;

////////////////////////////////
function New_DynAByte: DynAByte;
begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAByte';
	{$ENDIF}
	Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Count;
	Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Get;
	Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Put;
	Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Add;
	Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Delete;
	Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Swap;
	{$IFDEF DECLARE_FirstByte}
	Result.FirstByte := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_FirstByte;
	{$ENDIF} 
	Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_First_Byte;
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Clone_array;
end;

#VCL:procedure DynAByte.Clear;
#KOL:procedure TDynAByte.Clear;
begin 
	if Assigned(List) then List.Clear;
	fCount := 0;
end;

#VCL:procedure DynAByte.Nullify;
#KOL:procedure TDynAByte.Nullify;
var i: Integer;
begin
	for i := 0 to Count()-1 do
		SetBytes(i, 0);
end;
	
#VCL:procedure DynAByte.Remove(Value: Byte);
#KOL:procedure TDynAByte.Remove(Value: Byte);
var i: Integer;
begin 
	for i := Count()-1 downto 0 do
		if GetBytes(i) = Value then Delete(i, 1);
end;

#VCL:procedure DynAByte.Dispose;
#KOL:procedure TDynAByte.Dispose;
begin
		Free;
end;

#VCL:destructor DynAByte.Destroy;
#KOL:destructor TDynAByte.Destroy;
begin
  	Discard;
	inherited;
end;

#VCL:procedure DynAByte.Discard;
#KOL:procedure TDynAByte.Discard;
begin
	Clear;
	if not Shared_array then
	begin	
#VCL:	{$IFDEF _D5orHigher}
#VCL:   FreeAndNil(Base_DynAByte);
#VCL:	{$ELSE}
#VCL:   Base_DynAByte.Free;
#VCL:   Base_DynAByte := nil;
#VCL:	{$ENDIF}
#KOL:   Free_And_Nil(Base_DynAByte);
    end;
   
#VCL: {$IFDEF _D5orHigher}
#VCL: FreeAndNil(List);
#VCL: {$ELSE}
#VCL:	List.Free;
#VCL:	List := nil;
#VCL: {$ENDIF}
#KOL: Free_And_Nil(List);

	fCount := 0;
end;



#VCL:procedure DynAByte.Copy(To_index: Integer; Source: DynAByte);
#KOL:procedure TDynAByte.Copy(To_index: Integer; Source: DynAByte);
var from, last: Integer;
	{$IFDEF USE_FirstByte}
		From_addr, To_addr: PByte;
	{$ELSE}
		i: Integer;
	{$ENDIF}
begin
	from := 0;
	if To_index < 0 then
	begin
		inc(from, To_index);
		To_index := 0; 
	end;
	last := To_index + Source.Count() - 1;
	if last >= Count() then last := Count()-1;
	if last < To_index then Exit;
	{$IFDEF USE_FirstByte}
		From_addr := PByte(Integer(Source.FirstByte()) + from*Sizeof(Byte));
		To_addr := PByte(Integer(FirstByte()) + To_index * Sizeof(Byte));
		Move(From_addr^, To_addr^, (last - To_index + 1)*Sizeof(Byte));
	{$ELSE}
		for i := To_index to last do
		begin
			SetBytes(i, Source.GetBytes(from));
			inc(from);
		end;
	{$ENDIF}
end;
 

#VCL:procedure DynAByte.Fill(To_index: Integer; Value: Byte; Fill_count: Integer);
#KOL:procedure TDynAByte.Fill(To_index: Integer; Value: Byte; Fill_count: Integer);
var last: Integer;
	{$IFDEF USE_FirstByte}
		To_addr: PByte;
	{$ELSE}
		i: Integer;
	{$ENDIF}
begin
	if To_index < 0 then
	begin
		inc(Fill_count, To_index);
		To_index := 0;
	end;
	last := To_index + Fill_count - 1; 
	if last >= Count() then
		last := Count() - 1;
	if last < To_index then Exit;
	{$IFDEF USE_FirstByte}
		To_addr := PByte(Integer(FirstByte()) + To_index*Sizeof(Byte));
		FillChar(To_addr^, last - To_index + 1, Value);
	{$ELSE}
		for i := To_index to last do
			SetBytes(i, Value);
	{$ENDIF}
end;

#VCL:procedure DynAByte.Repeat_(To_index: Integer; Source: DynAByte;
#KOL:procedure TDynAByte.Repeat_(To_index: Integer; Source: DynAByte;
			Count_repeat: Integer);
var i, k: Integer;
	count_copy: Integer;
	{$IFDEF USE_FirstByte}
		To_addr: PByte;
	{$ELSE}
		j: Integer;
	{$ENDIF}
begin
	i := To_index;
	for k := 1 to Count_repeat do
	begin
		count_copy := Source.Count();
		if i + count_copy > fCount then
			count_copy := fCount - i;
		{$IFDEF USE_FirstByte}
			To_addr := PByte(Integer(FirstByte()) + i*Sizeof(Byte));
			Move(Source.FirstByte()^, To_addr^, count_copy*Sizeof(Byte));
		{$ELSE}
			for j := i to i + count_copy-1 do
				SetBytes(j, Source.GetBytes(j-i));
		{$ENDIF}
		inc(i, count_copy);
	end;
end;

#VCL:procedure DynAByte.Extend(Value: Byte; Count_extend: Integer);
#KOL:procedure TDynAByte.Extend(Value: Byte; Count_extend: Integer);
var i: Integer;
begin
#KOL:	List.Capacity := (Count() + Count_extend + 3) div 4;

	i := Count();
	for i := i to i + Count_extend - 1 do
	begin
		Add(i, Value);
	end;
end;
	
#VCL:procedure DynAByte.Append(Source: DynAByte; Count_append: Integer); 
#KOL:procedure TDynAByte.Append(Source: DynAByte; Count_append: Integer); 
var i, j, k: Integer;
begin
#KOL:	List.Capacity := (Count() + Count_append * Source.Count() + 3) div 4;
	i := Count();
	for k := 1 to Count_append do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			Add(i, Source.GetBytes(j));
			inc(i);
		end;
	end;
end;

#VCL:function DynAByte.DynAByte_Clone_array(): DynAByte;
#KOL:function TDynAByte.DynAByte_Clone_array(): DynAByte;
var i: Integer;
begin
	Result := New_DynAByte();
 
#VCL:	Result.List.Capacity := Count();
#KOL:	Result.List.Capacity := Count();

	for i := 0 to Count()-1 do
		Result.Add(i, GetBytes(i));
end;

#VCL:function DynAByte.FixAByte_Clone_array(): DynAByte;
#KOL:function TDynAByte.FixAByte_Clone_array(): DynAByte;
begin
	Result := New_FixAByte(nil, {$IFDEF KOL}@{$ENDIF} Self, 0, Count()-1);
end;

{$IFDEF DECLARE_FirstByte}
#VCL:function DynAByte.DynAByte_FirstByte: PByte; 
#KOL:function TDynAByte.DynAByte_FirstByte: PByte; 
begin
#VCL:    Result := List.List[0];
#KOL:    Result := @POverList(List).List[0];
end;	
{$ENDIF}

#VCL:procedure DynAByte.Allocate(New_size: Integer);
#KOL:procedure TDynAByte.Allocate(New_size: Integer);
#VCL: var i: Integer;
	  var old: Integer;
begin
		old := Count();
#VCL:	if New_size > old then
#VCL:		List.Capacity := New_size;
#VCL:	for i := fCount to New_size-1 do Add(-1, 0);
#KOL:   ReallocMem(POverList(List).fItems, New_size);
#KOL:	POverList(List).fCount := New_size;
#KOL:	if New_size > old then 
#KOL:	   FillChar(POverList(List).fItems[old], New_size - old, 0);
		fCount := New_size; 
end;

#VCL:function DynAByte.DynAByte_First_Byte: PByte; 
#KOL:function TDynAByte.DynAByte_First_Byte: PByte; 
begin
#VCL:    Result := {$IFDEF FPC}@{$ENDIF} List.List[0];
#KOL:    Result := @POverList(List).List[0];
end;	


#VCL:function DynAByte.IndexOf(Value: Byte): Integer;
#KOL:function TDynAByte.IndexOf(Value: Byte): Integer;
var i: Integer;
	{$IFDEF USE_FirstByte}
		At_addr: PByte;
	{$ENDIF}
begin
	{$IFDEF USE_FirstByte}
		At_addr := FirstByte();
		for i := 0 to fCount-1 do
		begin
			if At_addr^ = Value then begin Result := i; Exit; end;
			inc(At_addr);
		end;
	{$ELSE}
		for i := 0 to fCount-1 do
		begin
			if GetBytes(i) = Value then begin Result := i; Exit; end;
		end;
	{$ENDIF}
	Result := -1;
end; 
	
#VCL:function DynAByte.Contains(Value: Byte): Boolean;
#KOL:function TDynAByte.Contains(Value: Byte): Boolean;
begin
	Result := IndexOf(Value) >= 0;
end; 
	
////////////////////////////////////////////////////////////////////////////////

function New_FixAByte_bools(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const a: array of Boolean): DynAByte;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAByte}
	if (cache_FixAByte.Count > 0) then
	begin
		Result := DynAByte(cache_FixAByte.Items[cache_FixAByte.Count-1]);
		cache_FixAByte.Delete(cache_FixAByte.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAByte on array of Boolean';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Count;
		Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Get;
		Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Swap;
		{$IFDEF DECLARE_FirstByte}
		Result.FirstByte := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_FirstByte;
												  ////// important: use own List !
		{$ENDIF}
		Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_First_Byte;
		Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Add;
		Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clone_array;
	end;
	
	Result.List.Capacity := (High(a) + 4) div 4;
	for i := 0 to High(a) do
		Result.Add(i, Byte(a[i]));

	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAByte}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAByte);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAByte}
		else Result.Tag := 0
		{$ENDIF}
	;
end;

{$IFDEF SMALLER_CODE}
{$ELSE}
	{$IFnDEF DONTUSECACHES}
		{$DEFINE USE_cache_FixAByte}
	{$ENDIF}
	{$IFDEF USE_cache_FixAByte}
	var cache_FixAByte: 
			{$IFDEF KOL} PList
			{$ELSE} TList 
			{$ENDIF};
	{$ENDIF}
{$ENDIF}
	
function New_FixAByte(List_temps: {$IFDEF KOL} PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAByte; Index_from, Index_To: Integer): DynAByte;
begin
	{$IFDEF USE_cache_FixAByte}
	if (cache_FixAByte.Count > 0) then
	begin
		Result := DynAByte(cache_FixAByte.Items[cache_FixAByte.Count-1]);
		cache_FixAByte.Delete(cache_FixAByte.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);

#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAByte';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Count;
		Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Get; 
		Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Swap;
		Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_First_Byte;
	end;
			
	Result.Shared_array := true;
	if Index_from < 0 then Index_from := 0;
	if Index_to >= OnBase.Count() then Index_to := OnBase.Count()-1;
	if OnBase.Shared_array then
	begin
		Result.Base_DynAByte := OnBase.Base_DynAByte;
		Result.Start_index := Index_from + OnBase.Start_index;
	end
		else
	begin
		Result.Base_DynAByte := OnBase;
		Result.Start_index := Index_from;
	end;
	Result.fCount := Index_to - Index_from + 1;
	if Result.fCount < 0 then Result.fCount := 0;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAByte}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAByte);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAByte}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clone_array;
end;

{$IFDEF USE_cache_FixAByte}
{$IFDEF _D5orHigher}
var dummy_fixed_byte_array: DynAByte;
{$ENDIF}
{$ENDIF}

function New_FixAByte_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAByte;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAByte}
	if (cache_FixAByte.Count > 0) then
	begin
		Result := DynAByte(cache_FixAByte.Items[cache_FixAByte.Count-1]);
		cache_FixAByte.Delete(cache_FixAByte.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);

#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAByte';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Count;
		Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Get; 
		Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Swap;
		{$IFDEF DECLARE_FirstByte} 
		Result.FirstByte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_FirstByte;
		{$ENDIF}
		Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_First_Byte;
	end;
	
	Result.Base_DynAByte := New_DynAByte();
	for i := 1 to n do
		Result.Base_DynAByte.Add(MAXINT, 0);
	Result.fCount := n;
	Result.Shared_array := false;
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAByte}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAByte);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAByte}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clone_array;
end;

function New_FixAByte_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X: array of Byte): DynAByte;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAByte}
	if (cache_FixAByte.Count > 0) then
	begin
		Result := DynAByte(cache_FixAByte.Items[cache_FixAByte.Count-1]);
		cache_FixAByte.Delete(cache_FixAByte.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);

#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAByte';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Count;
		Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Get; 
		Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Swap;
		{$IFDEF DECLARE_FirstByte} 
		Result.FirstByte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_FirstByte;
		{$ENDIF}
		Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_First_Byte;
	end;
	
	Result.Base_DynAByte := New_DynAByte();
	for i := 0 to High(X) do
		Result.Base_DynAByte.Add(MAXINT, X[i]); 
	Result.fCount := Result.Base_DynAByte.Count();
			
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAByte}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAByte);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAByte}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clone_array;
end;

#VCL:function DynAByte.FixAByte_Count: Integer;
#KOL:function TDynAByte.FixAByte_Count: Integer;
begin
	Result := fCount;
end; 

#VCL:function DynAByte.FixAByte_Get(Idx: Integer): Byte;
#KOL:function TDynAByte.FixAByte_Get(Idx: Integer): Byte;
begin
	if LONGWORD(Idx) >= LONGWORD(fCount) then begin Result := 0; Exit; end;
	Result := Base_DynAByte.GetBytes(Start_index + Idx);
end; 

#VCL:procedure DynAByte.FixAByte_Put(Idx: Integer; Value: Byte);
#KOL:procedure TDynAByte.FixAByte_Put(Idx: Integer; Value: Byte);
begin
	if LONGWORD(Idx) >= LONGWORD(fCount) then Exit;
	Base_DynAByte.SetBytes(Start_index + Idx, Value);
end; 
 
{$IFDEF DECLARE_FirstByte}
#VCL:function DynAByte.FixAByte_FirstByte: PByte; 
#KOL:function TDynAByte.FixAByte_FirstByte: PByte; 
begin
	Result := PByte({$IFDEF CPU64}QWORD{$ELSE}Integer{$ENDIF}(Base_DynAByte.FirstByte())
			  + Start_index*Sizeof(Byte));
end;	
{$ENDIF}

#VCL:function DynAByte.FixAByte_First_Byte: PByte; 
#KOL:function TDynAByte.FixAByte_First_Byte: PByte; 
begin
	Result := PByte({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(
			  Base_DynAByte.First_Byte()) + LONGWORD(Start_index)*Sizeof(Byte));
end;
	
function New_FixAByte_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PByte; Total_items, Start_index, End_index: Integer): DynAByte;
begin
	{$IFDEF USE_cache_FixAByte}
	if (cache_FixAByte.Count > 0) then
	begin
		Result := DynAByte(cache_FixAByte.Items[cache_FixAByte.Count-1]);
		cache_FixAByte.Delete(cache_FixAByte.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);
		Result.Shared_array := false;

#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAByte_Array';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Count;
		Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Array_Get; 
		Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Array_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAByte_Swap;
		{$IFDEF DECLARE_FirstByte}
		Result.FirstByte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Array_FirstByte;
		{$ENDIF}
		Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Array_First_Byte;
	end;
			
	Result.Base_Pointer := PByte( {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(X)
						   + LONGWORD(Start_index) );
	if End_index >= Total_items then End_index := Total_items - 1; 
	Result.fCount := End_index - Start_index + 1;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAByte}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAByte);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAByte}
		else Result.Tag := 0
		{$ENDIF}
	;
end;

#VCL:function DynAByte.FixAByte_Array_Get(Idx: Integer): Byte;
#KOL:function TDynAByte.FixAByte_Array_Get(Idx: Integer): Byte;
begin
	if LONGWORD(Idx) >= LONGWORD(fCount) then begin Result := 0; Exit; end;
	Result := PByte({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer)
			+ LONGWORD(Idx+Start_index) * Sizeof(Byte))^;
end; 

#VCL:procedure DynAByte.FixAByte_Array_Put(Idx: Integer; Value: Byte);
#KOL:procedure TDynAByte.FixAByte_Array_Put(Idx: Integer; Value: Byte);
begin
	if LONGWORD(Idx) >= LONGWORD(fCount) then Exit;
	PByte({$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(Base_Pointer)
		  + LONGWORD(Idx+Start_index) * Sizeof(Byte))^ := Value;
end;

	{$IFDEF DECLARE_FirstByte}
#VCL:function DynAByte.FixAByte_Array_FirstByte: PByte; 
#KOL:function TDynAByte.FixAByte_Array_FirstByte: PByte; 
begin
	Result := PByte({$IFDEF CPU64}QWORD{$ELSE}Integer{$ENDIF}(Base_Pointer));
end;	
	{$ENDIF}
	
#VCL:function DynAByte.FixAByte_Array_First_Byte: PByte; 
#KOL:function TDynAByte.FixAByte_Array_First_Byte: PByte; 
begin
	Result := PByte({$IFDEF CPU64}QWORD{$ELSE}Integer{$ENDIF}(Base_Pointer));
end;
	
function New_FixAByte_Clamp(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	X: PByte; Start_index, End_index: Integer): DynAByte;
begin
	{$IFDEF USE_cache_FixAByte}
	if (cache_FixAByte.Count > 0) then
	begin
		Result := DynAByte(cache_FixAByte.Items[cache_FixAByte.Count-1]);
		cache_FixAByte.Delete(cache_FixAByte.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAByte.Create;
#KOL:	new(Result, Create);

#KOL:	Free_And_Nil(Result.List);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAByte_Clamp';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Count;
		Result.GetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clamp_Get; 
		Result.SetBytes := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clamp_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Clamp_Swap;
		{$IFDEF DECLARE_FirstByte} 
		Result.FirstByte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Array_FirstByte;
		{$ENDIF}
		Result.First_Byte := {$IFDEF DOG}@{$ENDIF} Result.FixAByte_Array_First_Byte;
	end;
			
	Result.Base_Pointer := X;
	Result.Start_index := Start_index;
	Result.fCount := End_index - Start_index + 1;
	Result.Clamp_mask := calculate_clamp_mask(Result.fCount);
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAByte}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAByte);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAByte}
		else Result.Tag := 0
		{$ENDIF}
	;
end;

#VCL:function DynAByte.FixAByte_Clamp_Get(Idx: Integer): Byte;
#KOL:function TDynAByte.FixAByte_Clamp_Get(Idx: Integer): Byte;
begin
	Idx := (Start_index + Idx) and Clamp_mask;
	Result := PByte({$IFDEF CPU64}QWORD{$ELSE}Integer{$ENDIF}(Base_Pointer)
			  + (Idx) * Sizeof(Byte))^;
end; 

#VCL:procedure DynAByte.FixAByte_Clamp_Put(Idx: Integer; Value: Byte);
#KOL:procedure TDynAByte.FixAByte_Clamp_Put(Idx: Integer; Value: Byte);
begin
	Idx := (Start_index + Idx) and Clamp_mask;
	PByte({$IFDEF CPU64}QWORD{$ELSE}Integer{$ENDIF}(Base_Pointer) 
		  + (Idx) * Sizeof(Byte))^ := Value;
end; 

#VCL:procedure DynAByte.FixAByte_Clamp_Swap(i, j: Integer);
#KOL:procedure TDynAByte.FixAByte_Clamp_Swap(i, j: Integer);
var X, Y: Byte;
begin
	X := FixAByte_Clamp_Get(i);
	Y := FixAByte_Clamp_Get(j);
	FixAByte_Clamp_Put(i, Y);
	FixAByte_Clamp_Put(j, X);
end;

procedure Copy_to_array(Dest: PByte; To_index, Dest_size: Integer;
	Source: DynAByte);
var count_copy: Integer;
	Addr_to: PByte; 
	{$IFDEF USE_FirstByte}
	{$ELSE}
		i: Integer;
	{$ENDIF}
begin
	if To_index < 0 then
	begin
		inc(Dest_size, To_index);
		To_index := 0;
	end;
	if To_index >= Dest_size then Exit;
	
	count_copy := Source.Count();
	if To_index + count_copy > Dest_size then
		count_copy := Dest_size - To_index;
	if count_copy <= 0 then Exit;
	
	Addr_to := PByte(Integer(Dest) + To_index * Sizeof(Byte));
	{$IFDEF USE_FirstByte}
		Move(Source.FirstByte()^, Addr_to^, count_copy * Sizeof(Byte));
	{$ELSE}
		for i := To_index to To_index + count_copy - 1 do
		begin
			Addr_to^ := Source.GetBytes(i - To_index);
			inc(Addr_to);
		end;
	{$ENDIF}
end;
{$ENDIF USE_DynAByte}


{$IFDEF USE_DynAStr}
////////////////////////////////////////////////////////////////////////////////
 
#VCL:function DynAStr.DynAStr_Count: Integer;
#KOL:function TDynAStr.DynAStr_Count: Integer;
begin 
    RESULT := List.Count;
end;

#VCL:function DynAStr.DynAStr_Get(Idx: Integer): String;
#KOL:function TDynAStr.DynAStr_Get(Idx: Integer): String;
begin
	if LONGWORD(Idx) >= LONGWORD(List.Count) then Result := ''
	else 
#VCL:	Result := List[Idx];
#KOL:	Result := List.Items[Idx];
end;

#VCL:procedure DynAStr.DynAStr_Put(Idx: Integer; const Value: String);
#KOL:procedure TDynAStr.DynAStr_Put(Idx: Integer; const Value: String);
begin
	if LONGWORD(Idx) >= LONGWORD(List.Count) then Exit;
#VCL:	List[Idx] := Value; 
#KOL:	List.Items[Idx] := Value; 
end;

#VCL:procedure DynAStr.DynAStr_Add(Idx: Integer; const Value: String);
#KOL:procedure TDynAStr.DynAStr_Add(Idx: Integer; const Value: String);
begin
	if LONGWORD(Idx) > LONGWORD(List.Count) then Idx := Count();
#KOL:	{$IFDEF _D5orHigher}
#KOL:	if List.Capacity <= List.Count then
#KOL:		List.Capacity := List.Capacity + 4 + List.Capacity div 2 ;
#KOL:	{$ENDIF} 
	List.Insert(Idx, Value);
end;

#VCL:procedure DynAStr.DynAStr_Delete(Idx: Integer; Count_delete: Integer);
#KOL:procedure TDynAStr.DynAStr_Delete(Idx: Integer; Count_delete: Integer);
var i: Integer;
begin
	if LONGWORD(Idx) >= LONGWORD(List.Count) then Exit;
	if Idx + Count_delete > Count() then Count_delete := Count() - Idx;
{$IFDEF SMALLER_CODE}
	for i := Idx + Count_delete-1 downto Idx do
		List.Delete(i);
{$ELSE}
	for i := Idx + Count_delete to Count() - 1 do
		SetStrings(i - Count_delete, GetStrings(i));
	for i := Count()-1 downto Count() - Count_delete do
		List.Delete(i);
{$ENDIF}
end;

#VCL:function DynAStr.DynAStr_IndexOf(const Value: String): Integer;
#KOL:function TDynAStr.DynAStr_IndexOf(const Value: String): Integer;
begin
    Result := List.IndexOf(Value);
end;

#VCL:procedure DynAStr.Remove(const Value: String);
#KOL:procedure TDynAStr.Remove(const Value: String);
var i: Integer;
begin
	for i := 0 to Count()-1 do
		if GetStrings(i) = Value then 
		begin 
			Delete(i, 1);
			Exit;
		end;
end;

#VCL:procedure DynAStr.DynAStr_Swap(i, j: Integer);
#KOL:procedure TDynAStr.DynAStr_Swap(i, j: Integer);
var X: String;
begin
	X := DynAStr_Get(i);
	DynAStr_Put(i, DynAStr_Get(j));
	DynAStr_Put(j, X);
end;

////////////////////////////////////////////////////////////////////////////////

#VCL:function DynAStr.Contains(const Value: String): Boolean;
#KOL:function TDynAStr.Contains(const Value: String): Boolean;
begin
	Result := IndexOf(Value) >= 0;
end;

//-----------------------------------------------------------------------------
#VCL:constructor DynAStr.Create;
#KOL:constructor TDynAStr.Create;
begin
  inherited;
#VCL:    List := TStringList.Create;
#VCL:	{$IFDEF _D6orHigher}
#VCL:    List.CaseSensitive := TRUE;
#VCL:	{$ENDIF}
#VCL:	{$IFDEF FPC}
#VCL:    List.CaseSensitive := TRUE;
#VCL:	{$ENDIF}
#KOL:    List := NewStrListAlt;
end;

////////////////////////////////
function New_DynAStr: DynAStr;
begin
#VCL:	Result := DynAStr.Create;
#KOL:	new(Result, Create);
	{$IFDEF ARRAYDETAILS}
	Set_array_index(Result.Array_index);
	Result.Info := 'DynAStr';
	{$ENDIF}
	Result.Count := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Count;
	Result.GetStrings := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Get;
	Result.SetStrings := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Put;
	Result.Add := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Add;
	Result.Delete := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Delete;
	Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_IndexOf;
	Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Swap;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.DynAStr_Clone_array;
end;

#VCL:procedure DynAStr.Clear;
#KOL:procedure TDynAStr.Clear;
begin 
	if Assigned(List) then
    	List.Clear;
end;

#VCL:procedure DynAStr.Nullify;
#KOL:procedure TDynAStr.Nullify;
var i: Integer;
begin
	for i := 0 to Count()-1 do
		SetStrings(i, '');
end;
	
#VCL:procedure DynAStr.Dispose;
#KOL:procedure TDynAStr.Dispose;
begin
		Free;
end;

#VCL:destructor DynAStr.Destroy;
#KOL:destructor TDynAStr.Destroy;
{$IFDEF DEBUG}
var dummy_i: Integer;
	dummy_s: String;
{$ENDIF}
begin
{$IFDEF DEBUG} // to prevent Linker to eliminate:
	dummy_i := Count_;
	if dummy_i = 0 then ;
	dummy_s := Text_;
	if dummy_s = '' then ;
	if dummy_i > 0 then
		dummy_s := Items[0];
	if dummy_s = '' then ;
{$ENDIF}
  	Discard;
	inherited;
end;

#VCL:procedure DynAStr.Discard;
#KOL:procedure TDynAStr.Discard;
begin
	Clear;
    if not Shared_array then
	begin	
#VCL:	{$IFDEF _D5orHigher}
#VCL:   FreeAndNil(Base_DynAStr);
#VCL:	{$ELSE}
#VCL:   Base_DynAStr.Free;
#VCL:   Base_DynAStr := nil;
#VCL:	{$ENDIF}
#KOL:   Free_And_Nil(Base_DynAStr);
    end;   
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(List);
#VCL:	{$ELSE}
#VCL:	List.Free;
#VCL:	List := nil;
#VCL:	{$ENDIF}
#KOL: Free_And_Nil(List);
end;



#VCL:procedure DynAStr.Copy(To_index: Integer; Source: DynAStr);
#KOL:procedure TDynAStr.Copy(To_index: Integer; Source: DynAStr);
var i, j, last: Integer;
begin
	j := 0;
	if To_index < 0 then
	begin
		j := -To_index;
		To_index := 0;
	end;
	last := To_index + Source.Count() - j - 1;
	if last >= Count() then last := Count()-1;
	for i := To_index to last do
	begin
		SetStrings(i, Source.GetStrings(j));
		inc(j);
	end;
end;

#VCL:procedure DynAStr.Fill(To_index: Integer; const Value: String; Fill_count: Integer);
#KOL:procedure TDynAStr.Fill(To_index: Integer; const Value: String; Fill_count: Integer);
var i, last: Integer;
begin
	if To_index < 0 then
	begin
		inc(Fill_count, To_index);
		To_index := 0;
	end;
	last := To_index + Fill_count - 1; 
	if last >= Count() then
		last := Count() - 1;
	for i := To_index to last do
	begin
		SetStrings(i, Value);
	end;
end;

#VCL:procedure DynAStr.Repeat_(To_index: Integer; Source: DynAStr;
#KOL:procedure TDynAStr.Repeat_(To_index: Integer; Source: DynAStr;
			Count_repeat: Integer);
var i, j, k: Integer;
begin
	i := To_index;
	for k := 1 to Count_repeat do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			if i >= Count() then Exit;
			SetStrings(i, Source.GetStrings(j));
			inc(i);
		end;
	end;
end;

#VCL:procedure DynAStr.Extend(const Value: String; Count_extend: Integer);
#KOL:procedure TDynAStr.Extend(const Value: String; Count_extend: Integer);
var i: Integer;
begin
	i := Count();
#VCL: List.Capacity := Count() + Count_extend;
	for i := i to i + Count_extend - 1 do
	begin
		Add(i, Value);
	end;
end;
	
#VCL:procedure DynAStr.Append(Source: DynAStr; Count_append: Integer); 
#KOL:procedure TDynAStr.Append(Source: DynAStr; Count_append: Integer); 
var i, j, k: Integer;
begin
	i := Count();
#VCL: List.Capacity := Count() + Count_append * Source.Count();
	for k := 1 to Count_append do
	begin
		for j := 0 to Source.Count()-1 do
		begin
			Add(i, Source.GetStrings(j));
			inc(i);
		end;
	end;
end;

#VCL:function DynAStr.DynAStr_Clone_array(): DynAStr;
#KOL:function TDynAStr.DynAStr_Clone_array(): DynAStr;
var i: Integer;
begin
//#VCL:	Result := DynAStr.Create();
//#KOL:	new(Result, Create());
	Result := New_DynAStr();
#KOL: {$IFDEF _D5orHigher}
	Result.List.Capacity := Count();
#KOL: {$ENDIF}
	for i := 0 to Count()-1 do
		Result.Add(i, GetStrings(i));
end;

#VCL:function DynAStr.FixAStr_Clone_array(): DynAStr;
#KOL:function TDynAStr.FixAStr_Clone_array(): DynAStr;
begin
	Result := New_FixAStr(nil, {$IFDEF KOL}@{$ENDIF} Self, 0, Count()-1);
end;

#VCL:function DynAStr.FixAStr_IndexOf(const Value: String): Integer;
#KOL:function TDynAStr.FixAStr_IndexOf(const Value: String): Integer;
begin
    Result := Base_DynAStr.IndexOf(Value);
    if Result >= 0 then Result := Result + Start_index;
end;

#VCL:procedure DynAStr.Allocate(New_size: Integer);
#KOL:procedure TDynAStr.Allocate(New_size: Integer);
var i: Integer;
begin
#KOL: {$IFDEF _D5orHigher}
	if New_size > Count() then
		List.Capacity := New_size;
#KOL: {$ENDIF}
	for i := List.Count to New_size-1 do
		List.Add('');
	for i := List.Count-1 downto New_size do
		List.Delete(i); 
end;



{$IFDEF SMALLER_CODE}
{$ELSE}
	{$IFnDEF DONTUSECACHES}
		{$DEFINE USE_cache_FixAStr}
	{$ENDIF}
	{$IFDEF USE_cache_FixAStr}
	var cache_FixAStr: {$IFDEF KOL} PList 
					   {$ELSE} TList 
					   {$ENDIF};
	{$ENDIF}
{$ENDIF}

function New_FixAStr(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	OnBase: DynAStr; Index_from, Index_To: Integer): DynAStr;
begin
	{$IFDEF USE_cache_FixAStr}
	if (cache_FixAStr.Count > 0) then
	begin
		Result := DynAStr(cache_FixAStr.Items[cache_FixAStr.Count-1]);
		cache_FixAStr.Delete(cache_FixAStr.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAStr.Create;
#KOL:	new(Result, Create);
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAStr';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Count;
		Result.GetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Get; 
		Result.SetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Swap;
		Result.IndexOf := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_IndexOf;
	end;
			
	Result.Shared_array := true;
	if Index_from < 0 then Index_from := 0;
	if OnBase.Shared_array then
	begin
		Result.Base_DynAStr := OnBase.Base_DynAStr;
		if Index_to >= Result.Base_DynAStr.Count() then 
			Index_to := Result.Base_DynAStr.Count()-1;
		Result.Start_index := Index_from + OnBase.Start_index;
	end
		else
	begin
		Result.Base_DynAStr := OnBase;
		if Index_to >= OnBase.Count() then Index_to := OnBase.Count()-1;
		Result.Start_index := Index_from;
	end;
	Result.Count_fixed := Index_to - Index_from + 1;
	if Result.Count_fixed < 0 then Result.Count_fixed := 0;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAStr}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAStr);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAStr}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Clone_array;
end;

{$IFDEF USE_cache_FixAStr}
{$IFDEF _D5orHigher}
var dummy_fixed_str_array: DynAStr;
{$ENDIF}
{$ENDIF}

function New_FixAStr_N(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	n: Integer): DynAStr;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAStr}
	if (cache_FixAStr.Count > 0) then
	begin
		Result := DynAStr(cache_FixAStr.Items[cache_FixAStr.Count-1]);
		cache_FixAStr.Delete(cache_FixAStr.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAStr.Create;
#KOL:	new(Result, Create);
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAStr';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Count;
		Result.GetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Get; 
		Result.SetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Swap;
	end;
	
	Result.Base_DynAStr := New_DynAStr();
	for i := 1 to n do
		Result.Base_DynAStr.Add(MAXINT, '');
	Result.Count_fixed := n;
	Result.Shared_array := false;

	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAStr}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAStr);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAStr}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Clone_array;
end;

function New_FixAStr_init(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	const X:array of String): DynAStr;
var i: Integer;
begin
	{$IFDEF USE_cache_FixAStr}
	if (cache_FixAStr.Count > 0) then
	begin
		Result := DynAStr(cache_FixAStr.Items[cache_FixAStr.Count-1]);
		cache_FixAStr.Delete(cache_FixAStr.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAStr.Create;
#KOL:	new(Result, Create);
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);
		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAStr';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Count;
		Result.GetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Get; 
		Result.SetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Put;
		Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Swap;
	end;
	
	Result.Base_DynAStr := New_DynAStr();
	for i := 0 to High(X) do
		Result.Base_DynAStr.Add(MAXINT, X[i]);
	Result.Count_fixed := High(X) + 1;
	Result.Shared_array := false;

	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAStr}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAStr);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAStr}
		else Result.Tag := 0
		{$ENDIF}
	;
	
	Result.Clone_array := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Clone_array;
end;

#VCL:function DynAStr.FixAStr_Count: Integer;
#KOL:function TDynAStr.FixAStr_Count: Integer;
begin
	Result := Count_fixed;
end;

#VCL:function DynAStr.FixAStr_Get(Idx: Integer): String;
#KOL:function TDynAStr.FixAStr_Get(Idx: Integer): String;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then begin Result := ''; Exit; end;
	//Result := Base_DynAStr.DynAStr_Get(Start_index + Idx);
	Result := Base_DynAStr.GetStrings(Start_index + Idx);
end; 

#VCL:procedure DynAStr.FixAStr_Put(Idx: Integer; const Value: String);
#KOL:procedure TDynAStr.FixAStr_Put(Idx: Integer; const Value: String);
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then Exit;
	//Base_DynAStr.DynAStr_Put(Start_index + Idx, Value);
	Base_DynAStr.SetStrings(Start_index + Idx, Value);
end;

#VCL:procedure DynAStr.FixAStr_Swap(i, j: Integer);
#KOL:procedure TDynAStr.FixAStr_Swap(i, j: Integer);
var X, Y: String;
begin
	if (Cardinal(i) >= Cardinal(Count()))
	or (Cardinal(j) >= Cardinal(Count())) then Exit;
	X := Base_DynAStr.GetStrings(Start_index + i);
	Y := Base_DynAStr.GetStrings(Start_index + j);
	Base_DynAStr.SetStrings(Start_index + i, Y);
	Base_DynAStr.SetStrings(Start_index + j, X);
end;

function New_FixAStr_Array(List_temps: {$IFDEF KOL}PList
								 {$ELSE}TList
								 {$ENDIF};
	a: PPchar; a_size, Index_from, Index_To: Integer): DynAStr;
begin
	{$IFDEF USE_cache_FixAStr}
	if (cache_FixAStr.Count > 0) then
	begin
		Result := DynAStr(cache_FixAStr.Items[cache_FixAStr.Count-1]);
		cache_FixAStr.Delete(cache_FixAStr.Count-1);
	end
		else
	{$ENDIF}
	begin
#VCL:	Result := DynAStr.Create;
#KOL:	new(Result, Create);
#VCL:	{$IFDEF _D5orHigher}
#VCL:	FreeAndNil(Result.List);
#VCL:	{$ELSE}
#VCL:	Result.List.Free;
#VCL:	Result.List := nil;
#VCL:	{$ENDIF}
#KOL:	Free_And_Nil(Result.List);

		{$IFDEF ARRAYDETAILS}
		Set_array_index(Result.Array_index);
		Result.Info := 'FixAStr_Array';
		{$ENDIF}
		
		Result.Count := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Count;
		Result.GetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Array_Get; 
		//Result.SetStrings := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Array_Put;
		//Result.Swap := {$IFDEF DOG}@{$ENDIF} Result.FixAStr_Swap;
	end;
			
	if Index_from < 0 then Index_from := 0;
	if Index_to >= a_size then
		Index_to := a_size - 1;

	Result.Base_array := a;
	Result.Start_index := Index_from;
	Result.Count_fixed := Index_to - Index_from + 1;
	
	if Assigned(List_temps) then
	begin
		List_temps.Add(Result);
		{$IFDEF USE_cache_FixAStr}
		Result.Tag := {$IFDEF CPU64}QWORD{$ELSE}LONGWORD{$ENDIF}(cache_FixAStr);
		{$ENDIF}
	end
		{$IFDEF USE_cache_FixAStr}
		else Result.Tag := 0
		{$ENDIF}
	;
end;
	
#VCL:function DynAStr.FixAStr_Array_Get(Idx: Integer): String;
#KOL:function TDynAStr.FixAStr_Array_Get(Idx: Integer): String;
var item_ptr: PPChar;
begin
	if LONGWORD(Idx) >= LONGWORD(Count_fixed) then begin Result := ''; Exit; end;
	{$IFDEF FPC}
    	item_ptr := Base_array + Start_index + Idx;
	{$ELSE}
	    item_ptr := PPChar({$IFDEF CPU64}QWORD{$ELSE}Integer{$ENDIF}(Base_array)
	            + Sizeof(PChar) * (Idx + Start_index));
	{$ENDIF}
	Result := item_ptr^;
end; 

function SubChar(s: PChar; from, to_: Integer): String;
begin
	SetLength(Result, to_ - from + 1);
	Move(s[from], Result[1], to_ - from + 1);
end;

/////////////////////////// move here from {String_functions}
// to prevent adding a reference to DynAStr only because that
// class was used: ------------------------------------------
procedure Do_split_string(
	X_L: DynAStr; const X_S, X_By: String);
var i, j, pass, {$IFDEF _D5orHigher} cnt_lines, {$ENDIF}  L, L_By: Integer;
	start: PChar;
	a: String;
begin
     if  X_By = '' then
     begin
         X_L.Add(X_L.Count(), X_S);
         Exit;
     end;
     {$IFDEF _D5orHigher}
     cnt_lines := 0;
     {$ENDIF}
     L := Length(X_S);
     L_By := Length(X_By);
     for pass := 1 to 2 do
     begin
	     i := 0;
	     j := 0;
	     start := @X_S[1];
	     while i <= L do
	     begin
	         if  (i = L) or
	             (SubChar(start, j, j+L_By-1) = X_By) 
	             then
	         begin
	         	 if pass = 1 then
	         	 	{$IFDEF _D5orHigher} 
	         	 	inc(cnt_lines)
	         	 	{$ENDIF}
	         	 else
	         	 begin
	         	 	a := SubChar(start, 0, j-1); 
	         	  	X_L.Add(X_L.Count(), a);
	         	 end;
	             inc(start, j + L_By);
	             inc(i, L_By);
	             j := 0;
	             continue;
	         end;
	         inc(i);
	         inc(j);
	     end;
		{$IFDEF _D5orHigher}
	     if (pass = 1) and (X_L.List <> nil) then 
	     	X_L.List.Capacity := cnt_lines;
		{$ENDIF}
     end;
end;

{$IFDEF DEBUG}
#VCL:function DynAStr.Get_items(Idx: Integer): String;
#KOL:function TDynAStr.Get_items(Idx: Integer): String;
begin
	Result := GetStrings(Idx);
end;

#VCL: function DynAStr.Get_text: String;
#KOL: function TDynAStr.Get_text: String;
var i: Integer;
begin
	Result := '';
	for i := 0 to Count()-1 do
	begin
		if Result <> '' then Result := Result + ';';
		Result := Result + GetStrings(i);
	end;
end;

#VCL: function DynAStr.Get_count: Integer;
#KOL: function TDynAStr.Get_count: Integer;
begin
	Result := Count();
end;

{$ENDIF}


{$ENDIF USE_DynAStr}	


{$IFDEF WINDOWS}
var OutputCP_set: Boolean = FALSE;
{$ENDIF}

{$IFDEF WRITE_DIRECT} //////////////////////////////////////////////////////////
procedure AL4Write(const s: String);

{$ELSE}

procedure AL4Write(const s: String);
begin
	Redirect_Write(s);  
end;

{$IFDEF FPC}
var console_allocated: Boolean;
{$ENDIF}

procedure Write_direct(const s: String);
{$ENDIF} ///////////////////////////////////////////////////////////////////////
{$IFDEF LINUX}
	var i: Integer;
{$ELSE WINDOWS}
	{$IFNDEF NOCONSOLE}
	var r: Integer;
	    oem: String;
	    {$IFDEF KOL}
	    written: LONGWORD;
	    {$ENDIF}
	{$ENDIF}
{$ENDIF WINDOWS}
begin /////////////////////////////////////////////////////////////////////////
	if Assigned(sim_Write) then
	begin
		sim_Write(s);
		if not dup_Write then Exit;
	end;
{$IFNDEF NOCONSOLE}

{$IFDEF LINUX}
	for i := 1 to Length(S) do
		System.Write(S[i]);
{$ELSE WINDOWS}
	   {$IFNDEF NOEXCEPTIONS}
	   TRY
	   {$ENDIF}
	    
       r := GetStdHandle(STD_OUTPUT_HANDLE);
       if  (r = Integer(INVALID_HANDLE_VALUE)) or (r = 0) then
       begin
            if not AllocConsole then Exit;
            r := GetStdHandle(STD_OUTPUT_HANDLE);
            if  (r = Integer(INVALID_HANDLE_VALUE)) or (r = 0) then Exit;
       end;
	
	   {$IFDEF FPC}
	   //----------- FREE PASCAL + WINDOWS ---------------- ONLY
	       if not console_allocated and not IsConsole then begin
   				  console_allocated := TRUE;
   				  AllocConsole;
   				  IsConsole := true;
   				  SysInitStdIO;
   		   end;
		   oem := s; UniqueString(oem);
		   if not OutputCP_set then
		   begin
			   OutputCP_set := TRUE;
			   //SetConsoleOutputCP(65001 {utf-8});
			   SetConsoleOutputCP(65002 {utf-8});
			   // which CP corresponds to utf-8 - 65001 or 65002 ???
			   //-----------------------------------------------
			   // if set 65001 then hieroglyphes are shown instead of
			   // Russian letters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
		   end;
	   {$ELSE}
#VCL:  oem := s; UniqueString(oem);
#VCL:  if oem <> '' then CharToOEM(PChar(s), PChar(oem));
#KOL:  {$IFDEF SMALLEST_CODE}      
#KOL:  		oem := s;
#KOL:  {$ELSE}      
#KOL:  		oem := Ansi2OEM(s);
#KOL:  {$ENDIF}
	   {$ENDIF}
   
	   {$IFDEF KOL}
	           WriteFile(r, oem[1], Length(oem), written, nil);
	   {$ELSE}
	      if (Length(oem) >= 2) and (oem[Length(oem)] = #13) and (
	         oem[Length(oem)-1] = #10) then
	           System.Writeln(Copy(oem, 1, Length(oem)-2))
	      else System.Write(oem);
	   {$ENDIF}
	   
	   {$IFNDEF NOEXCEPTIONS}
	   EXCEPT on E: Exception do
	   		begin
	   			if E is AL4_Exception then raise; 
	       		Any_exception(E);
	   		end;
	   END;
	   {$ENDIF}
{$ENDIF WINDOWS}
{$ENDIF CONSOLE}
end;

procedure WriteLn(const s: String);
begin
{$IFNDEF NOCONSOLE}
    AL4Write(s + #13#10);
{$ENDIF}
end;


function ReadLine: String;
{$IFNDEF NOCONSOLE}
	{$IFDEF KOL}
	var r: Integer;
	    buf: array[ 0..1 ] of Char;
	    count_read: LONGWORD;
	{$ENDIF}
{$ENDIF}
begin
{$IFDEF NOCONSOLE}
		Result := '';
{$ELSE}
	{$IFDEF KOL}
		Result := '';
	    r := GetStdHandle(STD_INPUT_HANDLE);
	    buf[0] := #0;
	    while ReadFile(r, buf, 1, count_read, nil) do
	    begin
	        if  buf[0] = #13 then break;
	        if  buf[0] <= ' ' then continue;
	        Result := Result + buf[0];
	    end;
	{$ELSE}
	    ReadLn(Result);
	{$ENDIF}
{$ENDIF}
end;


#VCL:class function AL4_object.New_instance: Ref_obj;
//#KOL:class function TAL4_object.New_instance: Ref_obj;
#VCL:begin
#VCL:    Result := new_Ref_obj(None_al4_obj, 0);
#VCL:end;

{$IFnDEF NOEXCEPTIONS}
	var limit_handler_added: Boolean;
	procedure add_limit_handler;
	var lh: Limit_handler;
	begin
		{$IFnDEF OLD_DELPHI}
			if (limit_handler_added) then Exit;
			limit_handler_added := true;
			{$IFDEF KOL}
				new(lh, Create);
			{$ELSE}
				lh := Limit_handler.Create;
			{$ENDIF}
			long_operation_handlers.Add(lh);
		{$ENDIF}
	end;
    
	function limit_by_time(time: Double; units: Integer): Integer;
	var id: Integer;
		span: Integer;
	begin
		{$IFnDEF OLD_DELPHI}
		inc(total_id_limits);
		id := total_id_limits;
		id_limits.Add(Pointer(id));
		kind_limits.Add(nil);
			
		span := GetTickCount;
		case (units) of
		0: inc(span, Trunc(time));
		1: inc(span, Trunc(time) * 1000);
		2: inc(span, Trunc(time) * 60000);
		3: inc(span, Trunc(time * 3600000));
		4: inc(span, Trunc(time * 3600000 * 24));
		end;

		SetLength(value_limits, Length(value_limits) + 1);
		value_limits[Length(value_limits)-1] := span;
		Result := id;
		{$ELSE}
		Result := 0;
		{$ENDIF}
	end;
		

	function limit_by_func(limit_func: Integer): Integer;
	var id: Integer;
	begin
		{$IFnDEF OLD_DELPHI}
		inc(total_id_limits);
		id := total_id_limits;
		id_limits.Add(Pointer(id));
		kind_limits.Add(Pointer(1));
		
		SetLength(value_limits, Length(value_limits) + 1);
		value_limits[Length(value_limits)-1] := total_func + limit_func;
		Result := id;
		{$ELSE}
		Result := 0;
		{$ENDIF}
	end;
	
	function limit_by_loops(limit_loops: Integer): Integer;
	var id: Integer;
	begin
		{$IFnDEF OLD_DELPHI}
		inc(total_id_limits);
		id := total_id_limits;
		id_limits.Add(Pointer(id));
		kind_limits.Add(Pointer(2));
		
		SetLength(value_limits, Length(value_limits) + 1);
		value_limits[Length(value_limits)-1] := total_loops + limit_loops;
		Result := id;
		{$ELSE}
		Result := 0;
		{$ENDIF}
	end;
	
	procedure dismiss_limit(id: Integer);
	var i, j: Integer;
	begin
		{$IFnDEF OLD_DELPHI}
		for i := id_limits.Count-1 downto 0 do
		begin
			if Integer(id_limits.Items[i] ) <> id then continue;
			id_limits.Delete(i);
			kind_limits.Delete(i);
			for j := i to Length(value_limits)-2 do 
				value_limits[j] := value_limits[j+1];
			SetLength(value_limits, Length(value_limits)-1);
			Exit;
		end;
		{$ENDIF}
	end;
	
	constructor E_Limit_exceeded.Create_id(c_id: integer);
	begin
#VCL:	    inherited Create('');
#KOL:	    inherited Create(e_Custom, '');
	    id := c_id;
	end;

#KOL:	procedure TLimit_handler.Handler;
#VCL:	procedure Limit_handler.Handler;
		var i, span: Integer;
		begin
		{$IFnDEF NOEXCEPTIONS}
		{$IFnDEF OLD_DELPHI}
    		for i := 0 to id_limits.Count-1 do
    		begin
    			case integer(kind_limits.Items[i]) of
    			0:	begin
		                 span := GetTickCount;
		                 if (span > value_limits[i]) then
		                 	raise E_Limit_exceeded.Create_id(Integer(id_limits.Items[i]));
    				end;
    			1:	begin
		    			 if total_func > value_limits[i] then
		                 	raise E_Limit_exceeded.Create_id(Integer(id_limits.Items[i]));
    				end;
    			2:	begin
		    			 if total_loops > value_limits[i] then
		                 	raise E_Limit_exceeded.Create_id(Integer(id_limits.Items[i]));
    				end;
    			end;
            end;
		{$ENDIF}
		{$ENDIF}
    	end;
{$ENDIF}
    

initialization

{$IFnDEF NOEXCEPTIONS}
{$IFnDEF OLD_DELPHI}
#VCL:	id_limits := TList.Create();
#VCL:	kind_limits := TList.Create();
#KOL:	id_limits := NewList;
#KOL:	kind_limits := NewList;
{$ENDIF}
{$ENDIF}

		List_ref_obj_free := 
                	{$IFDEF KOL} NewList
                	{$ELSE} TList .Create()
                	{$ENDIF} ;

#VCL:	long_operation_handlers := TList.Create;
#KOL:	long_operation_handlers := NewList;

#VCL:    None_al4_obj := AL4_object.Create;
#KOL:    New(None_al4_obj, Create);

    None_obj := new_Ref_obj(None_al4_obj, -1);

    None_obj.Obj.Is_NONE_object := TRUE;
    init_class_AL4_object;

{$IFDEF USE_DynAByte}
	GlobalDummyArrayByte := New_DynAByte;
{$ENDIF}

{$IFDEF USE_DynAInt}
	GlobalDummyArrayInt := New_DynAInt;
{$ENDIF}

{$IFDEF USE_DynAReal}
    GlobalDummyArrayReal := New_DynAReal;
{$ENDIF}

{$IFDEF USE_DynAStr}
    GlobalDummyArrayStr := New_DynAStr;
{$ENDIF}

{$IFDEF USE_DynARec}
    GlobalDummyArrayRec := New_DynARec(4096);
{$ENDIF}

{$IFDEF USE_DynAObj}
GlobalDummyArrayObjWeak := New_DynAObjWeak(None_obj);
GlobalDummyArrayObjHard := New_DynAObjHard(None_obj);
{$ENDIF}

#VCL: List_lists_temps := TList.Create;
#KOL: List_lists_temps := NewList;

	{$IFDEF SMALLER_CODE}
	{$ELSE}
		{$IFDEF USE_DynAObj}
	cache_FixAObj := {$IFDEF KOL} NewList 
					  {$ELSE} TList.Create 
					  {$ENDIF};
		{$ENDIF}
		{$IFDEF USE_cache_FixAInt}	
	cache_FixAInt := {$IFDEF KOL} NewList 
					 {$ELSE} TList.Create 
					 {$ENDIF};
		{$ENDIF}
		{$IFDEF USE_cache_FixAReal}	
	cache_FixAReal := {$IFDEF KOL} NewList 
					  {$ELSE} TList.Create 
					  {$ENDIF};	
		{$ENDIF}
		{$IFDEF USE_cache_FixAByte}	
	cache_FixAByte := {$IFDEF KOL} NewList
					  {$ELSE} TList.Create 
					  {$ENDIF};	
		{$ENDIF}
		{$IFDEF USE_cache_FixAStr}	
	cache_FixAStr :=  {$IFDEF KOL} NewList 
					  {$ELSE} TList.Create 
					  {$ENDIF};		
		{$ENDIF}
	{$ENDIF}
	
	Init_var_obj(set_none_obj, None_obj.Obj);
	
{$IFDEF DEBUG}
FINALIZATION
	Fill_list_unallocated_refs;
	
{$ENDIF}
	
end.
--AL4.pas--)
<ItemGroup>
    <None Include="app.config" />
</ItemGroup>
*/

