mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 22:29:45 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			5221 lines
		
	
	
		
			204 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			5221 lines
		
	
	
		
			204 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     Copyright (c) 1998-2007 by Florian Klaempfl
 | |
| 
 | |
|     Type checking and register allocation for inline nodes
 | |
| 
 | |
|     This program is free software; you can redistribute it and/or modify
 | |
|     it under the terms of the GNU General Public License as published by
 | |
|     the Free Software Foundation; either version 2 of the License, or
 | |
|     (at your option) any later version.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | |
|     GNU General Public License for more details.
 | |
| 
 | |
|     You should have received a copy of the GNU General Public License
 | |
|     along with this program; if not, write to the Free Software
 | |
|     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | |
| 
 | |
|  ****************************************************************************
 | |
| }
 | |
| unit ninl;
 | |
| 
 | |
| {$i fpcdefs.inc}
 | |
| 
 | |
| interface
 | |
| 
 | |
|     uses
 | |
|        node,htypechk,symtype,compinnr;
 | |
|     type
 | |
|        tinlinenode = class(tunarynode)
 | |
|           inlinenumber : tinlinenumber;
 | |
|           constructor create(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
 | |
|           constructor createintern(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
 | |
|           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
 | |
|           procedure ppuwrite(ppufile:tcompilerppufile);override;
 | |
|           function dogetcopy : tnode;override;
 | |
|           procedure printnodeinfo(var t : text);override;
 | |
|           function pass_1 : tnode;override;
 | |
|           function pass_typecheck:tnode;override;
 | |
|           function pass_typecheck_cpu:tnode;virtual;
 | |
|           function simplify(forinline : boolean): tnode;override;
 | |
|           function docompare(p: tnode): boolean; override;
 | |
| 
 | |
|           { returns a node tree where the inc/dec are replaced by add/sub }
 | |
|           function getaddsub_for_incdec : tnode;
 | |
| 
 | |
|           { pack and unpack are changed into for-loops by the compiler }
 | |
|           function first_pack_unpack: tnode; virtual;
 | |
| 
 | |
|           property parameters : tnode read left write left;
 | |
|          protected
 | |
|           { All the following routines currently
 | |
|             call compilerprocs, unless they are
 | |
|             overridden in which case, the code
 | |
|             generator handles them.
 | |
|           }
 | |
|           function first_pi: tnode ; virtual;
 | |
|           function first_arctan_real: tnode; virtual;
 | |
|           function first_abs_real: tnode; virtual;
 | |
|           function first_sqr_real: tnode; virtual;
 | |
|           function first_sqrt_real: tnode; virtual;
 | |
|           function first_ln_real: tnode; virtual;
 | |
|           function first_cos_real: tnode; virtual;
 | |
|           function first_sin_real: tnode; virtual;
 | |
|           function first_exp_real: tnode; virtual;
 | |
|           function first_frac_real: tnode; virtual;
 | |
|           function first_round_real: tnode; virtual;
 | |
|           function first_trunc_real: tnode; virtual;
 | |
|           function first_int_real: tnode; virtual;
 | |
|           function first_abs_long: tnode; virtual;
 | |
|           function first_IncDec: tnode; virtual;
 | |
|           function first_IncludeExclude: tnode; virtual;
 | |
|           function first_get_frame: tnode; virtual;
 | |
|           function first_setlength: tnode; virtual;
 | |
|           function first_copy: tnode; virtual;
 | |
|           { This one by default generates an internal error, because such
 | |
|             nodes are not generated by the parser. It's however used internally
 | |
|             by the JVM backend to create new dynamic arrays. }
 | |
|           function first_new: tnode; virtual;
 | |
|           function first_length: tnode; virtual;
 | |
|           function first_box: tnode; virtual; abstract;
 | |
|           function first_unbox: tnode; virtual; abstract;
 | |
|           function first_assigned: tnode; virtual;
 | |
|           function first_assert: tnode; virtual;
 | |
|           function first_popcnt: tnode; virtual;
 | |
|           { override these for Seg() support }
 | |
|           function typecheck_seg: tnode; virtual;
 | |
|           function first_seg: tnode; virtual;
 | |
|           function first_sar: tnode; virtual;
 | |
|           function first_fma : tnode; virtual;
 | |
| {$ifndef cpu64bitalu}
 | |
|           function first_ShiftRot_assign_64bitint: tnode; virtual;
 | |
| {$endif not cpu64bitalu}
 | |
|           function first_AndOrXorShiftRot_assign: tnode; virtual;
 | |
|           function first_NegNot_assign: tnode; virtual;
 | |
|           function first_cpu : tnode; virtual;
 | |
| 
 | |
|           procedure CheckParameters(count : integer);
 | |
|         private
 | |
|           function handle_str: tnode;
 | |
|           function handle_reset_rewrite_typed: tnode;
 | |
|           function handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
 | |
|           function handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
 | |
|           function handle_read_write: tnode;
 | |
|           function handle_val: tnode;
 | |
|           function handle_default: tnode;
 | |
|           function handle_setlength: tnode;
 | |
|           function handle_copy: tnode;
 | |
|           function handle_box: tnode;
 | |
|           function handle_unbox: tnode;
 | |
|           function handle_insert:tnode;
 | |
|           function handle_delete:tnode;
 | |
|           function handle_concat:tnode;
 | |
|        end;
 | |
|        tinlinenodeclass = class of tinlinenode;
 | |
| 
 | |
|     var
 | |
|        cinlinenode : tinlinenodeclass = tinlinenode;
 | |
| 
 | |
|    function geninlinenode(number : tinlinenumber;is_const:boolean;l : tnode) : tinlinenode;
 | |
| 
 | |
| implementation
 | |
| 
 | |
|     uses
 | |
|       verbose,globals,systems,constexp,
 | |
|       globtype,cutils,cclasses,fmodule,
 | |
|       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
 | |
|       cpuinfo,
 | |
|       pass_1,
 | |
|       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
 | |
|       nobjc,objcdef,
 | |
|       cgbase,procinfo;
 | |
| 
 | |
|    function geninlinenode(number : tinlinenumber;is_const:boolean;l : tnode) : tinlinenode;
 | |
| 
 | |
|      begin
 | |
|         geninlinenode:=cinlinenode.create(number,is_const,l);
 | |
|      end;
 | |
| 
 | |
| {*****************************************************************************
 | |
|                            TINLINENODE
 | |
| *****************************************************************************}
 | |
| 
 | |
|     constructor tinlinenode.create(number : tinlinenumber;is_const:boolean;l : tnode);
 | |
| 
 | |
|       begin
 | |
|          inherited create(inlinen,l);
 | |
|          if is_const then
 | |
|            include(flags,nf_inlineconst);
 | |
|          inlinenumber:=number;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     constructor tinlinenode.createintern(number : tinlinenumber; is_const : boolean;
 | |
|      l : tnode);
 | |
|       begin
 | |
|          create(number,is_const,l);
 | |
|          include(flags,nf_internal);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
 | |
|       begin
 | |
|         inherited ppuload(t,ppufile);
 | |
|         inlinenumber:=tinlinenumber(ppufile.getlongint);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
 | |
|       begin
 | |
|         inherited ppuwrite(ppufile);
 | |
|         ppufile.putlongint(longint(inlinenumber));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.dogetcopy : tnode;
 | |
|       var
 | |
|          n : tinlinenode;
 | |
|       begin
 | |
|          n:=tinlinenode(inherited dogetcopy);
 | |
|          n.inlinenumber:=inlinenumber;
 | |
|          result:=n;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tinlinenode.printnodeinfo(var t : text);
 | |
|       begin
 | |
|         inherited;
 | |
|         write(t,', inlinenumber = ',inlinenumber);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function get_str_int_func(def: tdef): string;
 | |
|     var
 | |
|       ordtype: tordtype;
 | |
|     begin
 | |
|       ordtype := torddef(def).ordtype;
 | |
|       if not (ordtype in [scurrency,s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
 | |
|         internalerror(2013032603);
 | |
| 
 | |
|       if is_oversizedord(def) then
 | |
|         begin
 | |
|           case ordtype of
 | |
|             scurrency,
 | |
|             s64bit: exit('int64');
 | |
|             u64bit: exit('qword');
 | |
|             s32bit: exit('longint');
 | |
|             u32bit: exit('longword');
 | |
|             s16bit: exit('smallint');
 | |
|             u16bit: exit('word');
 | |
|             else
 | |
|               internalerror(2013032604);
 | |
|           end;
 | |
|         end
 | |
|       else
 | |
|         begin
 | |
|           if is_nativeuint(def) then
 | |
|             exit('uint')
 | |
|           else
 | |
|             exit('sint');
 | |
|         end;
 | |
|       internalerror(2013032605);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.handle_str : tnode;
 | |
|       var
 | |
|         lenpara,
 | |
|         fracpara,
 | |
|         newparas,
 | |
|         tmppara,
 | |
|         dest,
 | |
|         source  : tcallparanode;
 | |
|         procname: string;
 | |
|         is_real,is_enum : boolean;
 | |
|         rt : aint;
 | |
| 
 | |
|       begin
 | |
|         result := cerrornode.create;
 | |
| 
 | |
|         { get destination string }
 | |
|         dest := tcallparanode(left);
 | |
| 
 | |
|         { get source para (number) }
 | |
|         source := dest;
 | |
|         while assigned(source.right) do
 | |
|           source := tcallparanode(source.right);
 | |
| 
 | |
|         { destination parameter must be a normal (not a colon) parameter, this
 | |
|           check is needed because str(v:len) also has 2 parameters }
 | |
|         if (source=dest) or
 | |
|            (cpf_is_colon_para in tcallparanode(dest).callparaflags) then
 | |
|           begin
 | |
|             CGMessage1(parser_e_wrong_parameter_size,'Str');
 | |
|             exit;
 | |
|           end;
 | |
| 
 | |
|         { in case we are in a generic definition, we cannot
 | |
|           do all checks, the parameters might be type parameters }
 | |
|         if df_generic in current_procinfo.procdef.defoptions then
 | |
|           begin
 | |
|             result.Free;
 | |
|             result:=nil;
 | |
|             resultdef:=voidtype;
 | |
|             exit;
 | |
|           end;
 | |
| 
 | |
|         is_real:=(source.resultdef.typ = floatdef) or is_currency(source.resultdef);
 | |
|         is_enum:=source.left.resultdef.typ=enumdef;
 | |
| 
 | |
|         if ((dest.left.resultdef.typ<>stringdef) and
 | |
|             not(is_chararray(dest.left.resultdef))) or
 | |
|            not(is_real or is_enum or
 | |
|                (source.left.resultdef.typ=orddef)) then
 | |
|           begin
 | |
|             CGMessagePos(fileinfo,parser_e_illegal_expression);
 | |
|             exit;
 | |
|           end;
 | |
| 
 | |
|         { get len/frac parameters }
 | |
|         lenpara := nil;
 | |
|         fracpara := nil;
 | |
|         if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then
 | |
|           begin
 | |
|             lenpara := tcallparanode(dest.right);
 | |
| 
 | |
|             { we can let the callnode do the type checking of these parameters too, }
 | |
|             { but then the error messages aren't as nice                            }
 | |
|             if not is_integer(lenpara.resultdef) then
 | |
|               begin
 | |
|                 CGMessagePos1(lenpara.fileinfo,
 | |
|                   type_e_integer_expr_expected,lenpara.resultdef.typename);
 | |
|                 exit;
 | |
|               end;
 | |
|             if (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
 | |
|               begin
 | |
|                 { parameters are in reverse order! }
 | |
|                 fracpara := lenpara;
 | |
|                 lenpara := tcallparanode(lenpara.right);
 | |
|                 if not is_real then
 | |
|                   begin
 | |
|                     CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
 | |
|                     exit
 | |
|                   end;
 | |
|                 if not is_integer(lenpara.resultdef) then
 | |
|                   begin
 | |
|                     CGMessagePos1(lenpara.fileinfo,
 | |
|                       type_e_integer_expr_expected,lenpara.resultdef.typename);
 | |
|                     exit;
 | |
|                   end;
 | |
|               end;
 | |
|           end;
 | |
| 
 | |
|         { generate the parameter list for the compilerproc }
 | |
|         newparas := dest;
 | |
| 
 | |
|         { if we have a float parameter, insert the realtype, len and fracpara parameters }
 | |
|         if is_real then
 | |
|           begin
 | |
|             { insert realtype parameter }
 | |
|             if not is_currency(source.resultdef) then
 | |
|               begin
 | |
|                 rt:=ord(tfloatdef(source.left.resultdef).floattype);
 | |
|                 newparas.right := ccallparanode.create(cordconstnode.create(
 | |
|                   rt,s32inttype,true),newparas.right);
 | |
|                 tmppara:=tcallparanode(newparas.right);
 | |
|               end
 | |
|             else
 | |
|               tmppara:=newparas;
 | |
|             { if necessary, insert a fraction parameter }
 | |
|             if not assigned(fracpara) then
 | |
|               begin
 | |
|                 tmppara.right := ccallparanode.create(
 | |
|                   cordconstnode.create(int64(-1),s32inttype,false),
 | |
|                    tmppara.right);
 | |
|                 fracpara := tcallparanode(tmppara.right);
 | |
|               end;
 | |
|             { if necessary, insert a length para }
 | |
|             if not assigned(lenpara) then
 | |
|               fracpara.right := ccallparanode.create(
 | |
|                 cordconstnode.create(int64(-32767),s32inttype,false),
 | |
|                    fracpara.right);
 | |
|           end
 | |
|         else if is_enum then
 | |
|           begin
 | |
|             {Insert a reference to the ord2string index.}
 | |
|             newparas.right:=Ccallparanode.create(
 | |
|               Caddrnode.create_internal(
 | |
|                 Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_normal)
 | |
|               ),
 | |
|               newparas.right);
 | |
|             {Insert a reference to the typinfo.}
 | |
|             newparas.right:=Ccallparanode.create(
 | |
|               Caddrnode.create_internal(
 | |
|                 Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_ord2str)
 | |
|               ),
 | |
|               newparas.right);
 | |
|             {Insert a type conversion from the enumeration to longint.}
 | |
|             source.left:=Ctypeconvnode.create_internal(source.left,s32inttype);
 | |
|             typecheckpass(source.left);
 | |
| 
 | |
|             { if necessary, insert a length para }
 | |
|             if not assigned(lenpara) then
 | |
|               Tcallparanode(Tcallparanode(newparas.right).right).right:=
 | |
|                 Ccallparanode.create(
 | |
|                   cordconstnode.create(int64(-1),s32inttype,false),
 | |
|                   Tcallparanode(Tcallparanode(newparas.right).right).right
 | |
|                 );
 | |
|           end
 | |
|         else
 | |
|           { for a normal parameter, insert a only length parameter if one is missing }
 | |
|           if not assigned(lenpara) then
 | |
|             newparas.right := ccallparanode.create(cordconstnode.create(int64(-1),s32inttype,false),
 | |
|               newparas.right);
 | |
| 
 | |
|         { remove the parameters from the original node so they won't get disposed, }
 | |
|         { since they're reused                                                     }
 | |
|         left := nil;
 | |
| 
 | |
|         { create procedure name }
 | |
|         if is_chararray(dest.resultdef) then
 | |
|           procname:='fpc_chararray_'
 | |
|         else
 | |
|           procname := 'fpc_' + tstringdef(dest.resultdef).stringtypname+'_';
 | |
|         if is_real then
 | |
|           if is_currency(source.resultdef) then
 | |
|             procname := procname + 'currency'
 | |
|           else
 | |
|             procname := procname + 'float'
 | |
|         else if is_enum then
 | |
|           procname:=procname+'enum'
 | |
|         else
 | |
|           case torddef(source.resultdef).ordtype of
 | |
|             pasbool8,pasbool16,pasbool32,pasbool64,
 | |
|             bool8bit,bool16bit,bool32bit,bool64bit:
 | |
|               procname := procname + 'bool';
 | |
|             else
 | |
|               procname := procname + get_str_int_func(source.resultdef);
 | |
|           end;
 | |
| 
 | |
|         { for ansistrings insert the encoding argument }
 | |
|         if is_ansistring(dest.resultdef) then
 | |
|           newparas:=ccallparanode.create(cordconstnode.create(
 | |
|             getparaencoding(dest.resultdef),u16inttype,true),newparas);
 | |
| 
 | |
|         { free the errornode we generated in the beginning }
 | |
|         result.free;
 | |
|         { create the call node, }
 | |
|         result := ccallnode.createintern(procname,newparas);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.handle_default: tnode;
 | |
| 
 | |
|       function getdefaultvarsym(def:tdef):tnode;
 | |
|         var
 | |
|           hashedid : thashedidstring;
 | |
|           srsym : tsym;
 | |
|           srsymtable : tsymtable;
 | |
|           defaultname : tidstring;
 | |
|         begin
 | |
|           if not assigned(def) or
 | |
|               not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
 | |
|               ((def.typ=objectdef) and not is_object(def)) then
 | |
|             internalerror(201202101);
 | |
|           { extra '$' prefix because on darwin the result of makemangledname
 | |
|             is prefixed by '_' and hence adding a '$' at the start of the
 | |
|             prefix passed to makemangledname doesn't help (the whole point of
 | |
|             the copy() operation below is to ensure that the id does not start
 | |
|             with a '$', because that is interpreted specially by the symtable
 | |
|             routines -- that's also why we prefix with '$_', so it will still
 | |
|             work if make_mangledname() would somehow return a name that already
 | |
|             starts with '$' }
 | |
|           defaultname:='$_'+make_mangledname('zero',def.owner,def.typesym.Name);
 | |
|           { can't hardcode the position of the '$', e.g. on darwin an underscore
 | |
|             is added }
 | |
|           hashedid.id:=copy(defaultname,2,255);
 | |
|           { the default sym is always part of the current procedure/function }
 | |
|           srsymtable:=current_procinfo.procdef.localst;
 | |
|           srsym:=tsym(srsymtable.findwithhash(hashedid));
 | |
|           if not assigned(srsym) then
 | |
|             begin
 | |
|               { no valid default variable found, so create it }
 | |
|               srsym:=clocalvarsym.create(defaultname,vs_const,def,[],true);
 | |
|               srsymtable.insert(srsym);
 | |
|               { mark the staticvarsym as typedconst }
 | |
|               include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
 | |
|               include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
 | |
|               { The variable has a value assigned }
 | |
|               tabstractvarsym(srsym).varstate:=vs_initialised;
 | |
|               { the variable can't be placed in a register }
 | |
|               tabstractvarsym(srsym).varregable:=vr_none;
 | |
|             end;
 | |
|           result:=cloadnode.create(srsym,srsymtable);
 | |
|         end;
 | |
| 
 | |
|       var
 | |
|         def : tdef;
 | |
|       begin
 | |
|         if not assigned(left) or (left.nodetype<>typen) then
 | |
|           internalerror(2012032101);
 | |
|         def:=ttypenode(left).typedef;
 | |
|         result:=nil;
 | |
|         case def.typ of
 | |
|           enumdef,
 | |
|           orddef:
 | |
|             { don't do a rangecheck as Default will also return 0
 | |
|               for the following types (Delphi compatible):
 | |
|               TRange1 = -10..-5;
 | |
|               TRange2 = 5..10;
 | |
|               TEnum = (a:=5;b:=10); }
 | |
|             result:=cordconstnode.create(0,def,false);
 | |
|           classrefdef,
 | |
|           pointerdef:
 | |
|             result:=cpointerconstnode.create(0,def);
 | |
|           procvardef:
 | |
|             if tprocvardef(def).size<>sizeof(pint) then
 | |
|               result:=getdefaultvarsym(def)
 | |
|             else
 | |
|               result:=cpointerconstnode.create(0,def);
 | |
|           stringdef:
 | |
|             result:=cstringconstnode.createstr('');
 | |
|           floatdef:
 | |
|             result:=crealconstnode.create(0,def);
 | |
|           objectdef:
 | |
|             begin
 | |
|               if is_implicit_pointer_object_type(def) then
 | |
|                 result:=cpointerconstnode.create(0,def)
 | |
|               else
 | |
|                 if is_object(def) then
 | |
|                   begin
 | |
|                     { Delphi does not recursively check whether
 | |
|                       an object contains unsupported types }
 | |
|                     if not (m_delphi in current_settings.modeswitches) and
 | |
|                         not is_valid_for_default(def) then
 | |
|                       Message(type_e_type_not_allowed_for_default);
 | |
|                     result:=getdefaultvarsym(def);
 | |
|                   end
 | |
|                 else
 | |
|                   Message(type_e_type_not_allowed_for_default);
 | |
|             end;
 | |
|           variantdef,
 | |
|           recorddef:
 | |
|             begin
 | |
|               { Delphi does not recursively check whether a record
 | |
|                 contains unsupported types }
 | |
|               if (def.typ=recorddef) and not (m_delphi in current_settings.modeswitches) and
 | |
|                   not is_valid_for_default(def) then
 | |
|                 Message(type_e_type_not_allowed_for_default);
 | |
|               result:=getdefaultvarsym(def);
 | |
|             end;
 | |
|           setdef:
 | |
|             begin
 | |
|               result:=csetconstnode.create(nil,def);
 | |
|               New(tsetconstnode(result).value_set);
 | |
|               tsetconstnode(result).value_set^:=[];
 | |
|             end;
 | |
|           arraydef:
 | |
|             begin
 | |
|               { can other array types be parsed by single_type? }
 | |
|               if ado_isdynamicarray in tarraydef(def).arrayoptions then
 | |
|                 result:=cpointerconstnode.create(0,def)
 | |
|               else
 | |
|                 begin
 | |
|                   result:=getdefaultvarsym(def);
 | |
|                 end;
 | |
|             end;
 | |
|           undefineddef:
 | |
|             begin
 | |
|               if sp_generic_dummy in def.typesym.symoptions then
 | |
|                 begin
 | |
|                   { this matches the error messages that are printed
 | |
|                     in case of non-Delphi modes }
 | |
|                   Message(parser_e_no_generics_as_types);
 | |
|                   Message(type_e_type_id_expected);
 | |
|                 end
 | |
|               else
 | |
|                 result:=cpointerconstnode.create(0,def);
 | |
|             end;
 | |
|           else
 | |
|             Message(type_e_type_not_allowed_for_default);
 | |
|         end;
 | |
|         if not assigned(result) then
 | |
|           result:=cerrornode.create;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.handle_reset_rewrite_typed: tnode;
 | |
|       begin
 | |
|         { since this is a "in_xxxx_typedfile" node, we can be sure we have  }
 | |
|         { a typed file as argument and we don't have to check it again (JM) }
 | |
| 
 | |
|         { add the recsize parameter }
 | |
| 
 | |
|         { iso mode extension with name? }
 | |
|         if inlinenumber in [in_reset_typedfile_name,in_rewrite_typedfile_name] then
 | |
|           begin
 | |
|             left := ccallparanode.create(cordconstnode.create(
 | |
|               tfiledef(tcallparanode(tcallparanode(left).nextpara).paravalue.resultdef).typedfiledef.size,s32inttype,true),left);
 | |
|           end
 | |
|         else
 | |
|           begin
 | |
|             { note: for some reason, the parameter of intern procedures with only one }
 | |
|             {   parameter is gets lifted out of its original tcallparanode (see round }
 | |
|             {   line 1306 of ncal.pas), so recreate a tcallparanode here (JM)         }
 | |
|             left := ccallparanode.create(cordconstnode.create(
 | |
|               tfiledef(left.resultdef).typedfiledef.size,s32inttype,true),
 | |
|               ccallparanode.create(left,nil));
 | |
|           end;
 | |
|         { create the correct call }
 | |
|         if m_isolike_io in current_settings.modeswitches then
 | |
|           begin
 | |
|             case inlinenumber of
 | |
|               in_reset_typedfile:
 | |
|                 result := ccallnode.createintern('fpc_reset_typed_iso',left);
 | |
|               in_reset_typedfile_name:
 | |
|                 result := ccallnode.createintern('fpc_reset_typed_name_iso',left);
 | |
|               in_rewrite_typedfile:
 | |
|                 result := ccallnode.createintern('fpc_rewrite_typed_iso',left);
 | |
|               in_rewrite_typedfile_name:
 | |
|                 result := ccallnode.createintern('fpc_rewrite_typed_name_iso',left);
 | |
|               else
 | |
|                 internalerror(2016101501);
 | |
|             end;
 | |
|           end
 | |
|         else
 | |
|           begin
 | |
|             if inlinenumber=in_reset_typedfile then
 | |
|               result := ccallnode.createintern('fpc_reset_typed',left)
 | |
|             else
 | |
|               result := ccallnode.createintern('fpc_rewrite_typed',left);
 | |
|           end;
 | |
| 
 | |
|         { make sure left doesn't get disposed, since we use it in the new call }
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure maybe_convert_to_string(var n: tnode);
 | |
|       begin
 | |
|         { stringconstnodes are arrays of char. It's much more }
 | |
|         { efficient to write a constant string, so convert    }
 | |
|         { either to shortstring or ansistring depending on    }
 | |
|         { length                                              }
 | |
|         if (n.nodetype=stringconstn) then
 | |
|           if is_chararray(n.resultdef) then
 | |
|             if (tstringconstnode(n).len<=255) then
 | |
|               inserttypeconv(n,cshortstringtype)
 | |
|             else
 | |
|               inserttypeconv(n,getansistringdef)
 | |
|           else if is_widechararray(n.resultdef) then
 | |
|             inserttypeconv(n,cunicodestringtype);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure get_read_write_int_func(def: tdef; out func_suffix: string; out readfunctype: tdef);
 | |
|     var
 | |
|       ordtype: tordtype;
 | |
|     begin
 | |
|       ordtype := torddef(def).ordtype;
 | |
|       if not (ordtype in [s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
 | |
|         internalerror(2013032601);
 | |
| 
 | |
|       if is_oversizedint(def) then
 | |
|         begin
 | |
|           case ordtype of
 | |
|             s64bit:
 | |
|               begin
 | |
|                 func_suffix := 'int64';
 | |
|                 readfunctype:=s64inttype;
 | |
|               end;
 | |
|             u64bit :
 | |
|               begin
 | |
|                 func_suffix := 'qword';
 | |
|                 readfunctype:=u64inttype;
 | |
|               end;
 | |
|             s32bit:
 | |
|               begin
 | |
|                 func_suffix := 'longint';
 | |
|                 readfunctype:=s32inttype;
 | |
|               end;
 | |
|             u32bit :
 | |
|               begin
 | |
|                 func_suffix := 'longword';
 | |
|                 readfunctype:=u32inttype;
 | |
|               end;
 | |
|             s16bit:
 | |
|               begin
 | |
|                 func_suffix := 'smallint';
 | |
|                 readfunctype:=s16inttype;
 | |
|               end;
 | |
|             u16bit :
 | |
|               begin
 | |
|                 func_suffix := 'word';
 | |
|                 readfunctype:=u16inttype;
 | |
|               end;
 | |
|             else
 | |
|               internalerror(2013032602);
 | |
|           end;
 | |
|         end
 | |
|       else
 | |
|         begin
 | |
|           case ordtype of
 | |
|             s64bit,
 | |
|             s32bit,
 | |
|             s16bit,
 | |
|             s8bit:
 | |
|               begin
 | |
|                 func_suffix := 'sint';
 | |
|                 readfunctype := sinttype;
 | |
|               end;
 | |
|             u64bit,
 | |
|             u32bit,
 | |
|             u16bit,
 | |
|             u8bit:
 | |
|               begin
 | |
|                 func_suffix := 'uint';
 | |
|                 readfunctype := uinttype;
 | |
|               end;
 | |
|           end;
 | |
|         end;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|     function Tinlinenode.handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
 | |
| 
 | |
|     {Read(ln)/write(ln) for text files.}
 | |
| 
 | |
|     const  procprefixes:array[boolean] of string[15]=('fpc_write_text_','fpc_read_text_');
 | |
| 
 | |
|     var error_para,is_real,special_handling,found_error,do_read:boolean;
 | |
|         p1:Tnode;
 | |
|         nextpara,
 | |
|         indexpara,
 | |
|         lenpara,
 | |
|         para,
 | |
|         fracpara:Tcallparanode;
 | |
|         temp:Ttempcreatenode;
 | |
|         readfunctype:Tdef;
 | |
|         name:string[63];
 | |
|         func_suffix:string[8];
 | |
| 
 | |
|     begin
 | |
|       para:=Tcallparanode(params);
 | |
|       found_error:=false;
 | |
|       do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
 | |
|       name:='';
 | |
|       while assigned(para) do
 | |
|         begin
 | |
|           { is this parameter faulty? }
 | |
|           error_para:=false;
 | |
|           { is this parameter a real? }
 | |
|           is_real:=false;
 | |
|           { type used for the read(), this is used to check
 | |
|             whether a temp is needed for range checking }
 | |
|           readfunctype:=nil;
 | |
| 
 | |
|           { can't read/write types }
 | |
|           if (para.left.nodetype=typen) and not(ttypenode(para.left).typedef.typ=undefineddef) then
 | |
|             begin
 | |
|               CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
 | |
|               error_para := true;
 | |
|             end;
 | |
| 
 | |
|           { support writeln(procvar) }
 | |
|           if para.left.resultdef.typ=procvardef then
 | |
|             begin
 | |
|               p1:=ccallnode.create_procvar(nil,para.left);
 | |
|               typecheckpass(p1);
 | |
|               para.left:=p1;
 | |
|             end;
 | |
| 
 | |
|           if inlinenumber in [in_write_x,in_writeln_x] then
 | |
|             { prefer strings to chararrays }
 | |
|             maybe_convert_to_string(para.left);
 | |
| 
 | |
|           case para.left.resultdef.typ of
 | |
|             stringdef :
 | |
|               name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
 | |
|             pointerdef :
 | |
|               begin
 | |
|                 if (not is_pchar(para.left.resultdef)) or do_read then
 | |
|                   begin
 | |
|                     CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
 | |
|                     error_para := true;
 | |
|                   end
 | |
|                 else
 | |
|                   name:=procprefixes[do_read]+'pchar_as_pointer';
 | |
|               end;
 | |
|             floatdef :
 | |
|               begin
 | |
|                 is_real:=true;
 | |
|                 if Tfloatdef(para.left.resultdef).floattype=s64currency then
 | |
|                   name := procprefixes[do_read]+'currency'
 | |
|                 else
 | |
|                   begin
 | |
|                     name := procprefixes[do_read]+'float';
 | |
|                     readfunctype:=pbestrealtype^;
 | |
|                   end;
 | |
|                 { iso pascal needs a different handler }
 | |
|                 if (m_isolike_io in current_settings.modeswitches) and do_read then
 | |
|                   name:=name+'_iso';
 | |
|               end;
 | |
|             enumdef:
 | |
|               begin
 | |
|                 name:=procprefixes[do_read]+'enum';
 | |
|                 readfunctype:=s32inttype;
 | |
|               end;
 | |
|             orddef :
 | |
|               begin
 | |
|                 case Torddef(para.left.resultdef).ordtype of
 | |
|                   s8bit,
 | |
|                   s16bit,
 | |
|                   s32bit,
 | |
|                   s64bit,
 | |
|                   u8bit,
 | |
|                   u16bit,
 | |
|                   u32bit,
 | |
|                   u64bit:
 | |
|                     begin
 | |
|                       get_read_write_int_func(para.left.resultdef,func_suffix,readfunctype);
 | |
|                       name := procprefixes[do_read]+func_suffix;
 | |
|                       if (m_isolike_io in current_settings.modeswitches) and do_read then
 | |
|                         name:=name+'_iso';
 | |
|                     end;
 | |
|                   uchar :
 | |
|                     begin
 | |
|                       name := procprefixes[do_read]+'char';
 | |
|                       { iso pascal needs a different handler }
 | |
|                       if (m_isolike_io in current_settings.modeswitches) and do_read then
 | |
|                         name:=name+'_iso';
 | |
|                       readfunctype:=cansichartype;
 | |
|                     end;
 | |
|                   uwidechar :
 | |
|                     begin
 | |
|                       name := procprefixes[do_read]+'widechar';
 | |
|                       readfunctype:=cwidechartype;
 | |
|                     end;
 | |
|                   scurrency:
 | |
|                     begin
 | |
|                       name := procprefixes[do_read]+'currency';
 | |
|                       { iso pascal needs a different handler }
 | |
|                       if (m_isolike_io in current_settings.modeswitches) and do_read then
 | |
|                         name:=name+'_iso';
 | |
|                       readfunctype:=s64currencytype;
 | |
|                       is_real:=true;
 | |
|                     end;
 | |
|                   pasbool8,
 | |
|                   pasbool16,
 | |
|                   pasbool32,
 | |
|                   pasbool64,
 | |
|                   bool8bit,
 | |
|                   bool16bit,
 | |
|                   bool32bit,
 | |
|                   bool64bit:
 | |
|                     if do_read then
 | |
|                       begin
 | |
|                         CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
 | |
|                         error_para := true;
 | |
|                       end
 | |
|                     else
 | |
|                       begin
 | |
|                         name := procprefixes[do_read]+'boolean';
 | |
|                         readfunctype:=pasbool8type;
 | |
|                       end
 | |
|                   else
 | |
|                     begin
 | |
|                       CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
 | |
|                       error_para := true;
 | |
|                     end;
 | |
|                 end;
 | |
|               end;
 | |
|             variantdef :
 | |
|               name:=procprefixes[do_read]+'variant';
 | |
|             arraydef :
 | |
|               begin
 | |
|                 if is_chararray(para.left.resultdef) then
 | |
|                   name := procprefixes[do_read]+'pchar_as_array'
 | |
|                 else
 | |
|                   begin
 | |
|                     CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
 | |
|                     error_para := true;
 | |
|                   end
 | |
|               end;
 | |
|             { generic parameter }
 | |
|             undefineddef:
 | |
|               { don't try to generate any code for a writeln on a generic parameter }
 | |
|               error_para:=true;
 | |
|             else
 | |
|               begin
 | |
|                 CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
 | |
|                 error_para := true;
 | |
|               end;
 | |
|           end;
 | |
| 
 | |
|           { iso pascal needs a different handler }
 | |
|           if (m_isolike_io in current_settings.modeswitches) and not(do_read) then
 | |
|             name:=name+'_iso';
 | |
| 
 | |
|           { check for length/fractional colon para's }
 | |
|           fracpara:=nil;
 | |
|           lenpara:=nil;
 | |
|           indexpara:=nil;
 | |
|           if assigned(para.right) and
 | |
|              (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
 | |
|             begin
 | |
|               lenpara := tcallparanode(para.right);
 | |
|               if assigned(lenpara.right) and
 | |
|                  (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
 | |
|                 fracpara:=tcallparanode(lenpara.right);
 | |
|             end;
 | |
|           { get the next parameter now already, because we're going }
 | |
|           { to muck around with the pointers                        }
 | |
|           if assigned(fracpara) then
 | |
|             nextpara := tcallparanode(fracpara.right)
 | |
|           else if assigned(lenpara) then
 | |
|             nextpara := tcallparanode(lenpara.right)
 | |
|           else
 | |
|             nextpara := tcallparanode(para.right);
 | |
| 
 | |
|           { check if a fracpara is allowed }
 | |
|           if assigned(fracpara) and not is_real then
 | |
|             begin
 | |
|               CGMessagePos(fracpara.fileinfo,parser_e_illegal_colon_qualifier);
 | |
|               error_para := true;
 | |
|             end
 | |
|           else if assigned(lenpara) and do_read then
 | |
|             begin
 | |
|               { I think this is already filtered out by parsing, but I'm not sure (JM) }
 | |
|               CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
 | |
|               error_para := true;
 | |
|             end;
 | |
| 
 | |
|           { adjust found_error }
 | |
|           found_error := found_error or error_para;
 | |
| 
 | |
|           if not error_para then
 | |
|             begin
 | |
|               special_handling:=false;
 | |
|               { create dummy frac/len para's if necessary }
 | |
|               if not do_read then
 | |
|                 begin
 | |
|                   { difference in default value for floats and the rest :( }
 | |
|                   if not is_real then
 | |
|                     begin
 | |
|                       if not assigned(lenpara) then
 | |
|                         begin
 | |
|                           if m_isolike_io in current_settings.modeswitches then
 | |
|                             lenpara := ccallparanode.create(
 | |
|                               cordconstnode.create(-1,s32inttype,false),nil)
 | |
|                           else
 | |
|                             lenpara := ccallparanode.create(
 | |
|                               cordconstnode.create(0,s32inttype,false),nil);
 | |
|                         end
 | |
|                       else
 | |
|                         { make sure we don't pass the successive }
 | |
|                         { parameters too. We also already have a }
 | |
|                         { reference to the next parameter in     }
 | |
|                         { nextpara                               }
 | |
|                         lenpara.right := nil;
 | |
|                     end
 | |
|                   else
 | |
|                     begin
 | |
|                       if not assigned(lenpara) then
 | |
|                         lenpara := ccallparanode.create(
 | |
|                           cordconstnode.create(int64(-32767),s32inttype,false),nil);
 | |
|                       { also create a default fracpara if necessary }
 | |
|                       if not assigned(fracpara) then
 | |
|                         fracpara := ccallparanode.create(
 | |
|                           cordconstnode.create(int64(-1),s32inttype,false),nil);
 | |
|                       { add it to the lenpara }
 | |
|                       lenpara.right := fracpara;
 | |
|                       if not is_currency(para.left.resultdef) then
 | |
|                         begin
 | |
|                           { and add the realtype para (this also removes the link }
 | |
|                           { to any parameters coming after it)                    }
 | |
|                           fracpara.right := ccallparanode.create(
 | |
|                               cordconstnode.create(ord(tfloatdef(para.left.resultdef).floattype),
 | |
|                               s32inttype,true),nil);
 | |
|                         end
 | |
|                       else
 | |
|                         fracpara.right:=nil;
 | |
|                     end;
 | |
|                   if para.left.resultdef.typ=enumdef then
 | |
|                     begin
 | |
|                       {To write(ln) an enum we need a some extra parameters.}
 | |
|                       {Insert a reference to the ord2string index.}
 | |
|                       indexpara:=Ccallparanode.create(
 | |
|                         Caddrnode.create_internal(
 | |
|                           Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_normal)
 | |
|                         ),
 | |
|                         nil);
 | |
|                       {Insert a reference to the typinfo.}
 | |
|                       indexpara:=Ccallparanode.create(
 | |
|                         Caddrnode.create_internal(
 | |
|                          Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_ord2str)
 | |
|                         ),
 | |
|                         indexpara);
 | |
|                       {Insert a type conversion to to convert the enum to longint.}
 | |
|                       para.left:=Ctypeconvnode.create_internal(para.left,s32inttype);
 | |
|                       typecheckpass(para.left);
 | |
|                     end;
 | |
|                 end
 | |
|               else
 | |
|                 begin
 | |
|                   {To read(ln) an enum we need a an extra parameter.}
 | |
|                   if para.left.resultdef.typ=enumdef then
 | |
|                     begin
 | |
|                       {Insert a reference to the string2ord index.}
 | |
|                       indexpara:=Ccallparanode.create(Caddrnode.create_internal(
 | |
|                         Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_str2ord)
 | |
|                       ),nil);
 | |
|                       {Insert a type conversion to to convert the enum to longint.}
 | |
|                       para.left:=Ctypeconvnode.create_internal(para.left,s32inttype);
 | |
|                       typecheckpass(para.left);
 | |
|                     end;
 | |
|                   { special handling of reading small numbers, because the helpers  }
 | |
|                   { expect a longint/card/bestreal var parameter. Use a temp. can't }
 | |
|                   { use functions because then the call to FPC_IOCHECK destroys     }
 | |
|                   { their result before we can store it                             }
 | |
|                   if (readfunctype<>nil) and (para.left.resultdef<>readfunctype) then
 | |
|                     special_handling:=true;
 | |
|                 end;
 | |
|               if special_handling then
 | |
|                 begin
 | |
|                   { since we're not going to pass the parameter as var-parameter }
 | |
|                   { to the read function, manually check whether the parameter   }
 | |
|                   { can be used as var-parameter (e.g., whether it isn't a       }
 | |
|                   { property)                                                    }
 | |
|                   valid_for_var(para.left,true);
 | |
| 
 | |
|                   { create the parameter list: the temp ... }
 | |
|                   temp := ctempcreatenode.create(readfunctype,readfunctype.size,tt_persistent,false);
 | |
|                   addstatement(Tstatementnode(newstatement),temp);
 | |
| 
 | |
|                   { ... and the file }
 | |
|                   p1 := ccallparanode.create(ctemprefnode.create(temp),
 | |
|                     filepara.getcopy);
 | |
|                   Tcallparanode(Tcallparanode(p1).right).right:=indexpara;
 | |
| 
 | |
|                   { create the call to the helper }
 | |
|                   addstatement(Tstatementnode(newstatement),
 | |
|                     ccallnode.createintern(name,tcallparanode(p1)));
 | |
| 
 | |
|                   { assign the result to the original var (this automatically }
 | |
|                   { takes care of range checking)                             }
 | |
|                   addstatement(Tstatementnode(newstatement),
 | |
|                     cassignmentnode.create(para.left,
 | |
|                       ctemprefnode.create(temp)));
 | |
| 
 | |
|                   { release the temp location }
 | |
|                   addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp));
 | |
| 
 | |
|                   { statement of para is used }
 | |
|                   para.left := nil;
 | |
| 
 | |
|                   { free the enclosing tcallparanode, but not the }
 | |
|                   { parameters coming after it                    }
 | |
|                   para.right := nil;
 | |
|                   para.free;
 | |
|                 end
 | |
|               else
 | |
|                 { read of non s/u-8/16bit, or a write }
 | |
|                 begin
 | |
|                   { add the filepara to the current parameter }
 | |
|                   para.right := filepara.getcopy;
 | |
|                   {Add the lenpara and the indexpara(s) (fracpara and realtype are
 | |
|                    already linked with the lenpara if necessary).}
 | |
|                   if indexpara=nil then
 | |
|                     Tcallparanode(para.right).right:=lenpara
 | |
|                   else
 | |
|                     begin
 | |
|                       if lenpara=nil then
 | |
|                         Tcallparanode(para.right).right:=indexpara
 | |
|                       else
 | |
|                         begin
 | |
|                           Tcallparanode(para.right).right:=lenpara;
 | |
|                           lenpara.right:=indexpara;
 | |
|                         end;
 | |
| {                      indexpara.right:=lenpara;}
 | |
|                     end;
 | |
|                   { in case of writing a chararray, add whether it's zero-based }
 | |
|                   if para.left.resultdef.typ=arraydef then
 | |
|                     para := ccallparanode.create(cordconstnode.create(
 | |
|                       ord(tarraydef(para.left.resultdef).lowrange=0),pasbool8type,false),para)
 | |
|                   else
 | |
|                   { in case of reading an ansistring pass a codepage argument }
 | |
|                   if do_read and is_ansistring(para.left.resultdef) then
 | |
|                     para:=ccallparanode.create(cordconstnode.create(
 | |
|                       getparaencoding(para.left.resultdef),u16inttype,true),para);
 | |
|                   { create the call statement }
 | |
|                   addstatement(Tstatementnode(newstatement),
 | |
|                     ccallnode.createintern(name,para));
 | |
|                 end
 | |
|             end
 | |
|           else
 | |
|             { error_para = true }
 | |
|             begin
 | |
|               { free the parameter, since it isn't referenced anywhere anymore }
 | |
|               para.right := nil;
 | |
|               para.free;
 | |
|               if assigned(lenpara) then
 | |
|                 begin
 | |
|                   lenpara.right := nil;
 | |
|                   lenpara.free;
 | |
|                 end;
 | |
|               if assigned(fracpara) then
 | |
|                 begin
 | |
|                   fracpara.right := nil;
 | |
|                   fracpara.free;
 | |
|                 end;
 | |
|             end;
 | |
| 
 | |
|           { process next parameter }
 | |
|           para := nextpara;
 | |
|         end;
 | |
| 
 | |
|       { if no error, add the write(ln)/read(ln) end calls }
 | |
|       if not found_error then
 | |
|         begin
 | |
|           case inlinenumber of
 | |
|             in_read_x,
 | |
|             in_readstr_x:
 | |
|               name:='fpc_read_end';
 | |
|             in_write_x,
 | |
|             in_writestr_x:
 | |
|               name:='fpc_write_end';
 | |
|             in_readln_x:
 | |
|               begin
 | |
|                 name:='fpc_readln_end';
 | |
|                 if m_isolike_io in current_settings.modeswitches then
 | |
|                   name:=name+'_iso';
 | |
|               end;
 | |
|             in_writeln_x:
 | |
|               name:='fpc_writeln_end';
 | |
|           end;
 | |
|           addstatement(Tstatementnode(newstatement),ccallnode.createintern(name,filepara));
 | |
|         end;
 | |
|       handle_text_read_write:=found_error;
 | |
|     end;
 | |
| 
 | |
|     function Tinlinenode.handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
 | |
| 
 | |
|     {Read/write for typed files.}
 | |
| 
 | |
|     const  procprefixes:array[boolean,boolean] of string[19]=(('fpc_typed_write','fpc_typed_read'),
 | |
|                                                               ('fpc_typed_write','fpc_typed_read_iso'));
 | |
|            procnamesdisplay:array[boolean,boolean] of string[8] = (('Write','Read'),('WriteStr','ReadStr'));
 | |
| 
 | |
|     var found_error,do_read,is_rwstr:boolean;
 | |
|         para,nextpara:Tcallparanode;
 | |
|         p1:Tnode;
 | |
|         temp:Ttempcreatenode;
 | |
|     begin
 | |
|       found_error:=false;
 | |
|       para:=Tcallparanode(params);
 | |
|       do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
 | |
|       is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x];
 | |
|       temp:=nil;
 | |
|       { add the typesize to the filepara }
 | |
|       if filepara.resultdef.typ=filedef then
 | |
|         filepara.right := ccallparanode.create(cordconstnode.create(
 | |
|           tfiledef(filepara.resultdef).typedfiledef.size,s32inttype,true),nil);
 | |
| 
 | |
|       { check for "no parameters" (you need at least one extra para for typed files) }
 | |
|       if not assigned(para) then
 | |
|         begin
 | |
|           CGMessage1(parser_e_wrong_parameter_size,procnamesdisplay[is_rwstr,do_read]);
 | |
|           found_error := true;
 | |
|         end;
 | |
| 
 | |
|       { process all parameters }
 | |
|       while assigned(para) do
 | |
|         begin
 | |
|           { check if valid parameter }
 | |
|           if para.left.nodetype=typen then
 | |
|             begin
 | |
|               CGMessagePos(para.left.fileinfo,type_e_cant_read_write_type);
 | |
|               found_error := true;
 | |
|             end;
 | |
| 
 | |
|           { support writeln(procvar) }
 | |
|           if (para.left.resultdef.typ=procvardef) then
 | |
|             begin
 | |
|               p1:=ccallnode.create_procvar(nil,para.left);
 | |
|               typecheckpass(p1);
 | |
|               para.left:=p1;
 | |
|             end;
 | |
| 
 | |
|           if filepara.resultdef.typ=filedef then
 | |
|             inserttypeconv(para.left,tfiledef(filepara.resultdef).typedfiledef);
 | |
| 
 | |
|           if assigned(para.right) and
 | |
|             (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
 | |
|             begin
 | |
|               CGMessagePos(para.right.fileinfo,parser_e_illegal_colon_qualifier);
 | |
| 
 | |
|               { skip all colon para's }
 | |
|               nextpara := tcallparanode(tcallparanode(para.right).right);
 | |
|               while assigned(nextpara) and (cpf_is_colon_para in nextpara.callparaflags) do
 | |
|                 nextpara := tcallparanode(nextpara.right);
 | |
|               found_error := true;
 | |
|             end
 | |
|           else
 | |
|             { get next parameter }
 | |
|             nextpara := tcallparanode(para.right);
 | |
| 
 | |
|           { When we have a call, we have a problem: you can't pass the  }
 | |
|           { result of a call as a formal const parameter. Solution:     }
 | |
|           { assign the result to a temp and pass this temp as parameter }
 | |
|           { This is not very efficient, but write(typedfile,x) is       }
 | |
|           { already slow by itself anyway (no buffering) (JM)           }
 | |
|           { Actually, thge same goes for every non-simple expression    }
 | |
|           { (such as an addition, ...) -> put everything but load nodes }
 | |
|           { into temps (JM)                                             }
 | |
|           { of course, this must only be allowed for writes!!! (JM)     }
 | |
|           if not(do_read) and (para.left.nodetype <> loadn) then
 | |
|             begin
 | |
|               { create temp for result }
 | |
|               temp := ctempcreatenode.create(para.left.resultdef,
 | |
|                 para.left.resultdef.size,tt_persistent,false);
 | |
|               addstatement(Tstatementnode(newstatement),temp);
 | |
|               { assign result to temp }
 | |
|               addstatement(Tstatementnode(newstatement),
 | |
|                cassignmentnode.create(ctemprefnode.create(temp),
 | |
|                  para.left));
 | |
|               { replace (reused) paranode with temp }
 | |
|               para.left := ctemprefnode.create(temp);
 | |
|             end;
 | |
|           { add fileparameter }
 | |
|           para.right := filepara.getcopy;
 | |
| 
 | |
|           { create call statment                                             }
 | |
|           { since the parameters are in the correct order, we have to insert }
 | |
|           { the statements always at the end of the current block            }
 | |
|           addstatement(Tstatementnode(newstatement),
 | |
|             Ccallnode.createintern(procprefixes[m_isolike_io in current_settings.modeswitches,do_read],para
 | |
|           ));
 | |
| 
 | |
|           { if we used a temp, free it }
 | |
|           if para.left.nodetype = temprefn then
 | |
|             addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp));
 | |
| 
 | |
|           { process next parameter }
 | |
|           para := nextpara;
 | |
|         end;
 | |
| 
 | |
|       { free the file parameter }
 | |
|       filepara.free;
 | |
|       handle_typed_read_write:=found_error;
 | |
|     end;
 | |
| 
 | |
|     function tinlinenode.handle_read_write: tnode;
 | |
| 
 | |
|       var
 | |
|         filepara,
 | |
|         nextpara,
 | |
|         params   : tcallparanode;
 | |
|         newstatement  : tstatementnode;
 | |
|         newblock      : tblocknode;
 | |
|         filetemp      : Ttempcreatenode;
 | |
|         name          : string[31];
 | |
|         textsym       : ttypesym;
 | |
|         is_typed,
 | |
|         do_read,
 | |
|         is_rwstr,
 | |
|         found_error   : boolean;
 | |
|       begin
 | |
|         filepara := nil;
 | |
|         is_typed := false;
 | |
|         filetemp := nil;
 | |
|         do_read := inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
 | |
|         is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x];
 | |
| 
 | |
|         { if we fail, we can quickly exit this way. We must generate something }
 | |
|         { instead of the inline node, because firstpass will bomb with an      }
 | |
|         { internalerror if it encounters a read/write                          }
 | |
|         result := cerrornode.create;
 | |
| 
 | |
|         { reverse the parameters (needed to get the colon parameters in the }
 | |
|         { correct order when processing write(ln)                           }
 | |
|         left := reverseparameters(tcallparanode(left));
 | |
| 
 | |
|         if is_rwstr then
 | |
|           begin
 | |
|             filepara := tcallparanode(left);
 | |
|             { needs at least two parameters: source/dest string + min. 1 value }
 | |
|             if not(assigned(filepara)) or
 | |
|                not(assigned(filepara.right)) then
 | |
|               begin
 | |
|                 CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'ReadStr/WriteStr');
 | |
|                 exit;
 | |
|               end
 | |
|             else if (filepara.resultdef.typ <> stringdef) then
 | |
|               begin
 | |
|                 { convert chararray to string, or give an appropriate error message }
 | |
|                 { (if you want to optimize to use shortstring, keep in mind that    }
 | |
|                 {  readstr internally always uses ansistring, and to account for    }
 | |
|                 {  chararrays with > 255 characters)                                }
 | |
|                 inserttypeconv(filepara.left,getansistringdef);
 | |
|                 filepara.resultdef:=filepara.left.resultdef;
 | |
|                 if codegenerror then
 | |
|                   exit;
 | |
|               end
 | |
|           end
 | |
|         else if assigned(left) then
 | |
|           begin
 | |
|             { check if we have a file parameter and if yes, what kind it is }
 | |
|             filepara := tcallparanode(left);
 | |
| 
 | |
|             if (filepara.resultdef.typ=filedef) then
 | |
|               begin
 | |
|                 if (tfiledef(filepara.resultdef).filetyp=ft_untyped) then
 | |
|                   begin
 | |
|                     CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file);
 | |
|                     exit;
 | |
|                   end
 | |
|                 else
 | |
|                   begin
 | |
|                     if (tfiledef(filepara.resultdef).filetyp=ft_typed) then
 | |
|                       begin
 | |
|                         if (inlinenumber in [in_readln_x,in_writeln_x]) then
 | |
|                           begin
 | |
|                             CGMessagePos(fileinfo,type_e_no_readln_writeln_for_typed_file);
 | |
|                             exit;
 | |
|                           end;
 | |
|                         is_typed := true;
 | |
|                       end
 | |
|                   end;
 | |
|               end
 | |
|             else
 | |
|               filepara := nil;
 | |
|           end;
 | |
| 
 | |
|         { create a blocknode in which the successive write/read statements will be  }
 | |
|         { put, since they belong together. Also create a dummy statement already to }
 | |
|         { make inserting of additional statements easier                            }
 | |
|         newblock:=internalstatements(newstatement);
 | |
| 
 | |
|         if is_rwstr then
 | |
|           begin
 | |
|             { create a dummy temp text file that will be used to cache the
 | |
|               readstr/writestr state. Can't use a global variable in the system
 | |
|               unit because these can be nested (in case of parameters to
 | |
|               writestr that are function calls to functions that also call
 | |
|               readstr/writestr) }
 | |
|             textsym:=search_system_type('TEXT');
 | |
|             filetemp:=ctempcreatenode.create(textsym.typedef,textsym.typedef.size,tt_persistent,false);
 | |
|             addstatement(newstatement,filetemp);
 | |
| 
 | |
|             if (do_read) then
 | |
|               name:='fpc_setupreadstr_'
 | |
|             else
 | |
|               name:='fpc_setupwritestr_';
 | |
|             name:=name+tstringdef(filepara.resultdef).stringtypname;
 | |
|             { the file para is a var parameter, but it is properly initialized,
 | |
|               so it should be actually an out parameter }
 | |
|             if not(do_read) then
 | |
|               set_varstate(filepara.left,vs_written,[]);
 | |
|             { remove the source/destination string parameter from the }
 | |
|             { parameter chain                                         }
 | |
|             left:=filepara.right;
 | |
|             filepara.right:=ccallparanode.create(ctemprefnode.create(filetemp),nil);
 | |
|             { in case of a writestr() to an ansistring, also pass the string's
 | |
|               code page }
 | |
|             if not do_read and
 | |
|                is_ansistring(filepara.left.resultdef) then
 | |
|               filepara:=ccallparanode.create(genintconstnode(tstringdef(filepara.left.resultdef).encoding),filepara);
 | |
|             { pass the temp text file and the source/destination string to the
 | |
|               setup routine, which will store the string's address in the
 | |
|               textrec }
 | |
|             addstatement(newstatement,ccallnode.createintern(name,filepara));
 | |
|             filepara:=ccallparanode.create(ctemprefnode.create(filetemp),nil);
 | |
|           end
 | |
|         { if we don't have a filepara, create one containing the default }
 | |
|         else if not assigned(filepara) then
 | |
|           begin
 | |
|             { since the input/output variables are threadvars loading them into
 | |
|               a temp once is faster. Create a temp which will hold a pointer to the file }
 | |
|             filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
 | |
|             addstatement(newstatement,filetemp);
 | |
| 
 | |
|             { make sure the resultdef of the temp (and as such of the }
 | |
|             { temprefs coming after it) is set (necessary because the  }
 | |
|             { temprefs will be part of the filepara, of which we need  }
 | |
|             { the resultdef later on and temprefs can only be         }
 | |
|             { typecheckpassed if the resultdef of the temp is known) }
 | |
|             typecheckpass(tnode(filetemp));
 | |
| 
 | |
|             { assign the address of the file to the temp }
 | |
|             if do_read then
 | |
|               name := 'input'
 | |
|             else
 | |
|               name := 'output';
 | |
|             addstatement(newstatement,
 | |
|               cassignmentnode.create(ctemprefnode.create(filetemp),
 | |
|                 ccallnode.createintern('fpc_get_'+name,nil)));
 | |
| 
 | |
|             { create a new fileparameter as follows: file_type(temp^)    }
 | |
|             { (so that we pass the value and not the address of the temp }
 | |
|             { to the read/write routine)                                 }
 | |
|             textsym:=search_system_type('TEXT');
 | |
|             filepara := ccallparanode.create(ctypeconvnode.create_internal(
 | |
|               cderefnode.create(ctemprefnode.create(filetemp)),textsym.typedef),nil);
 | |
|           end
 | |
|         else
 | |
|           { remove filepara from the parameter chain }
 | |
|           begin
 | |
|             left := filepara.right;
 | |
|             filepara.right := nil;
 | |
|             { the file para is a var parameter, but it must be valid already }
 | |
|             set_varstate(filepara.left,vs_readwritten,[vsf_must_be_valid]);
 | |
|             { check if we should make a temp to store the result of a complex }
 | |
|             { expression (better heuristics, anyone?) (JM)                    }
 | |
|             if (filepara.left.nodetype <> loadn) then
 | |
|               begin
 | |
|                 { create a temp which will hold a pointer to the file }
 | |
|                 filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
 | |
| 
 | |
|                 { add it to the statements }
 | |
|                 addstatement(newstatement,filetemp);
 | |
| 
 | |
|                 { make sure the resultdef of the temp (and as such of the }
 | |
|                 { temprefs coming after it) is set (necessary because the  }
 | |
|                 { temprefs will be part of the filepara, of which we need  }
 | |
|                 { the resultdef later on and temprefs can only be         }
 | |
|                 { typecheckpassed if the resultdef of the temp is known) }
 | |
|                 typecheckpass(tnode(filetemp));
 | |
| 
 | |
|                 { assign the address of the file to the temp }
 | |
|                 addstatement(newstatement,
 | |
|                   cassignmentnode.create(ctemprefnode.create(filetemp),
 | |
|                     caddrnode.create_internal(filepara.left)));
 | |
|                 typecheckpass(newstatement.left);
 | |
|                 { create a new fileparameter as follows: file_type(temp^)    }
 | |
|                 { (so that we pass the value and not the address of the temp }
 | |
|                 { to the read/write routine)                                 }
 | |
|                 nextpara := ccallparanode.create(ctypeconvnode.create_internal(
 | |
|                   cderefnode.create(ctemprefnode.create(filetemp)),filepara.left.resultdef),nil);
 | |
| 
 | |
|                 { replace the old file para with the new one }
 | |
|                 filepara.left := nil;
 | |
|                 filepara.free;
 | |
|                 filepara := nextpara;
 | |
|               end;
 | |
|           end;
 | |
| 
 | |
|         { the resultdef of the filepara must be set since it's }
 | |
|         { used below                                            }
 | |
|         filepara.get_paratype;
 | |
| 
 | |
|         { now, filepara is nowhere referenced anymore, so we can safely dispose it }
 | |
|         { if something goes wrong or at the end of the procedure                   }
 | |
| 
 | |
|         { we're going to reuse the paranodes, so make sure they don't get freed }
 | |
|         { twice                                                                 }
 | |
|         params:=Tcallparanode(left);
 | |
|         left := nil;
 | |
| 
 | |
|         if is_typed then
 | |
|           found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),tnode(newstatement))
 | |
|         else
 | |
|           found_error:=handle_text_read_write(filepara,Ttertiarynode(params),tnode(newstatement));
 | |
| 
 | |
|         { if we found an error, simply delete the generated blocknode }
 | |
|         if found_error then
 | |
|           newblock.free
 | |
|         else
 | |
|           begin
 | |
|             { deallocate the temp for the file para if we used one }
 | |
|             if assigned(filetemp) then
 | |
|               addstatement(newstatement,ctempdeletenode.create(filetemp));
 | |
|             { otherwise return the newly generated block of instructions, }
 | |
|             { but first free the errornode we generated at the beginning }
 | |
|             result.free;
 | |
|             result := newblock
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function get_val_int_func(def: tdef): string;
 | |
|     var
 | |
|       ordtype: tordtype;
 | |
|     begin
 | |
|       ordtype := torddef(def).ordtype;
 | |
|       if not (ordtype in [s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
 | |
|         internalerror(2013032603);
 | |
| 
 | |
|       if is_oversizedint(def) then
 | |
|         begin
 | |
|           case ordtype of
 | |
|             s64bit: exit('int64');
 | |
|             u64bit: exit('qword');
 | |
|             s32bit: exit('longint');
 | |
|             u32bit: exit('longword');
 | |
|             s16bit: exit('smallint');
 | |
|             u16bit: exit('word');
 | |
|             else
 | |
|               internalerror(2013032604);
 | |
|           end;
 | |
|         end
 | |
|       else
 | |
|         begin
 | |
|           case ordtype of
 | |
|             s64bit,s32bit,s16bit,s8bit: exit('sint');
 | |
|             u64bit,u32bit,u16bit,u8bit: exit('uint');
 | |
|             else
 | |
|               internalerror(2013032604);
 | |
|           end;
 | |
|         end;
 | |
|       internalerror(2013032605);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.handle_val: tnode;
 | |
|       var
 | |
|         procname,
 | |
|         suffix        : string[31];
 | |
|         sourcepara,
 | |
|         destpara,
 | |
|         codepara,
 | |
|         sizepara,
 | |
|         newparas      : tcallparanode;
 | |
|         orgcode,tc    : tnode;
 | |
|         newstatement  : tstatementnode;
 | |
|         newblock      : tblocknode;
 | |
|         tempcode      : ttempcreatenode;
 | |
|         valsinttype   : tdef;
 | |
|       begin
 | |
|         { for easy exiting if something goes wrong }
 | |
|         result := cerrornode.create;
 | |
| 
 | |
|         { check the amount of parameters }
 | |
|         if not(assigned(left)) or
 | |
|            not(assigned(tcallparanode(left).right)) then
 | |
|          begin
 | |
|            CGMessage1(parser_e_wrong_parameter_size,'Val');
 | |
|            exit;
 | |
|          end;
 | |
| 
 | |
|          suffix:='';
 | |
| 
 | |
|          { in case we are in a generic definition, we cannot
 | |
|            do all checks, the parameters might be type parameters }
 | |
|          if df_generic in current_procinfo.procdef.defoptions then
 | |
|            begin
 | |
|              result.Free;
 | |
|              result:=nil;
 | |
|              resultdef:=voidtype;
 | |
|              exit;
 | |
|            end;
 | |
| 
 | |
|         { retrieve the ValSInt type }
 | |
|         valsinttype:=search_system_type('VALSINT').typedef;
 | |
| 
 | |
|         { reverse parameters for easier processing }
 | |
|         left := reverseparameters(tcallparanode(left));
 | |
| 
 | |
|         { get the parameters }
 | |
|         tempcode := nil;
 | |
|         orgcode := nil;
 | |
|         sizepara := nil;
 | |
|         sourcepara := tcallparanode(left);
 | |
|         destpara := tcallparanode(sourcepara.right);
 | |
|         codepara := tcallparanode(destpara.right);
 | |
| 
 | |
|         { check if codepara is valid }
 | |
|         if assigned(codepara) and
 | |
|            (
 | |
|             not is_integer(codepara.resultdef)
 | |
| {$ifndef cpu64bitaddr}
 | |
|             or is_64bitint(codepara.resultdef)
 | |
| {$endif not cpu64bitaddr}
 | |
|             ) then
 | |
|           begin
 | |
|             CGMessagePos1(codepara.fileinfo,type_e_integer_expr_expected,codepara.resultdef.typename);
 | |
|             exit;
 | |
|           end;
 | |
| 
 | |
|         { check if dest para is valid }
 | |
|         if not is_integer(destpara.resultdef) and
 | |
|            not is_currency(destpara.resultdef) and
 | |
|            not(destpara.resultdef.typ in [floatdef,enumdef]) then
 | |
|           begin
 | |
|             CGMessagePos(destpara.fileinfo,type_e_integer_or_real_expr_expected);
 | |
|             exit;
 | |
|           end;
 | |
| 
 | |
|         { we're going to reuse the exisiting para's, so make sure they }
 | |
|         { won't be disposed                                            }
 | |
|         left := nil;
 | |
| 
 | |
|         { create the blocknode which will hold the generated statements + }
 | |
|         { an initial dummy statement                                      }
 | |
| 
 | |
|         newblock:=internalstatements(newstatement);
 | |
| 
 | |
|         { do we need a temp for code? Yes, if no code specified, or if  }
 | |
|         { code is not a valsinttype sized parameter (we already checked }
 | |
|         { whether the code para, if specified, was an orddef)           }
 | |
|         if not assigned(codepara) or
 | |
|            (codepara.resultdef.size<>valsinttype.size) then
 | |
|           begin
 | |
|             tempcode := ctempcreatenode.create(valsinttype,valsinttype.size,tt_persistent,false);
 | |
|             addstatement(newstatement,tempcode);
 | |
|             { set the resultdef of the temp (needed to be able to get }
 | |
|             { the resultdef of the tempref used in the new code para) }
 | |
|             typecheckpass(tnode(tempcode));
 | |
|             { create a temp codepara, but save the original code para to }
 | |
|             { assign the result to later on                              }
 | |
|             if assigned(codepara) then
 | |
|               begin
 | |
|                 orgcode := codepara.left;
 | |
|                 codepara.left := ctemprefnode.create(tempcode);
 | |
|               end
 | |
|             else
 | |
|               codepara := ccallparanode.create(ctemprefnode.create(tempcode),nil);
 | |
|             { we need its resultdef later on }
 | |
|             codepara.get_paratype;
 | |
|           end
 | |
|         else if (torddef(codepara.resultdef).ordtype <> torddef(valsinttype).ordtype) then
 | |
|           { because code is a var parameter, it must match types exactly    }
 | |
|           { however, since it will return values >= 0, both signed and      }
 | |
|           { and unsigned ints of the same size are fine. Since the formal   }
 | |
|           { code para type is sinttype, insert a typecoversion to sint for  }
 | |
|           { unsigned para's  }
 | |
|           begin
 | |
|             codepara.left := ctypeconvnode.create_internal(codepara.left,valsinttype);
 | |
|             { make it explicit, oterwise you may get a nonsense range }
 | |
|             { check error if the cardinal already contained a value   }
 | |
|             { > $7fffffff                                             }
 | |
|             codepara.get_paratype;
 | |
|           end;
 | |
| 
 | |
|         { create the procedure name }
 | |
|         procname := 'fpc_val_';
 | |
| 
 | |
|         case destpara.resultdef.typ of
 | |
|           orddef:
 | |
|             begin
 | |
|               case torddef(destpara.resultdef).ordtype of
 | |
|                 s8bit,s16bit,s32bit,s64bit,
 | |
|                 u8bit,u16bit,u32bit,u64bit:
 | |
|                   begin
 | |
|                     suffix := get_val_int_func(destpara.resultdef) + '_';
 | |
|                     { we also need a destsize para in the case of sint }
 | |
|                     if suffix = 'sint_' then
 | |
|                       sizepara := ccallparanode.create(cordconstnode.create
 | |
|                         (destpara.resultdef.size,s32inttype,true),nil);
 | |
|                   end;
 | |
|                 scurrency: suffix := 'currency_';
 | |
|                 else
 | |
|                   internalerror(200304225);
 | |
|               end;
 | |
|             end;
 | |
|           floatdef:
 | |
|             suffix:='real_';
 | |
|           enumdef:
 | |
|             begin
 | |
|               suffix:='enum_';
 | |
|               sizepara:=Ccallparanode.create(Caddrnode.create_internal(
 | |
|                 Crttinode.create(Tenumdef(destpara.resultdef),fullrtti,rdt_str2ord)
 | |
|               ),nil);
 | |
|             end;
 | |
|         end;
 | |
| 
 | |
|         procname := procname + suffix;
 | |
| 
 | |
|         { play a trick to have tcallnode handle invalid source parameters: }
 | |
|         { the shortstring-longint val routine by default                   }
 | |
|         if (sourcepara.resultdef.typ = stringdef) then
 | |
|           procname := procname + tstringdef(sourcepara.resultdef).stringtypname
 | |
|         { zero-based arrays (of char) can be implicitely converted to ansistring, but don't do
 | |
|           so if not needed because the array is too short }
 | |
|         else if is_zero_based_array(sourcepara.resultdef) and (sourcepara.resultdef.size>255) then
 | |
|           procname := procname + 'ansistr'
 | |
|         else
 | |
|           procname := procname + 'shortstr';
 | |
| 
 | |
|         { set up the correct parameters for the call: the code para... }
 | |
|         newparas := codepara;
 | |
|         { and the source para }
 | |
|         codepara.right := sourcepara;
 | |
|         { sizepara either contains nil if none is needed (which is ok, since   }
 | |
|         { then the next statement severes any possible links with other paras  }
 | |
|         { that sourcepara may have) or it contains the necessary size para and }
 | |
|         { its right field is nil                                               }
 | |
|         sourcepara.right := sizepara;
 | |
| 
 | |
|         { create the call and assign the result to dest (val helpers are functions).
 | |
|           Use a trick to prevent a type size mismatch warning to be generated by the
 | |
|           assignment node. First convert implicitly to the resultdef. This will insert
 | |
|           the range check. The Second conversion is done explicitly to hide the implicit conversion
 | |
|           for the assignment node and therefor preventing the warning (PFV)
 | |
| 
 | |
|           The implicit conversion is avoided for enums because implicit conversion between
 | |
|           longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
 | |
|           possible. (DM).
 | |
| 
 | |
|           The implicit conversion is also avoided for COMP type if it is handled by FPU (x86)
 | |
|           to prevent warning about automatic type conversion. }
 | |
|         if (destpara.resultdef.typ=enumdef) or
 | |
|            ((destpara.resultdef.typ=floatdef) and (tfloatdef(destpara.resultdef).floattype=s64comp))
 | |
|           then
 | |
|             tc:=ccallnode.createintern(procname,newparas)
 | |
|         else
 | |
|           tc:=ctypeconvnode.create(ccallnode.createintern(procname,newparas),destpara.left.resultdef);
 | |
|         addstatement(newstatement,cassignmentnode.create(
 | |
|           destpara.left,ctypeconvnode.create_internal(tc,destpara.left.resultdef)));
 | |
| 
 | |
|         { dispose of the enclosing paranode of the destination }
 | |
|         destpara.left := nil;
 | |
|         destpara.right := nil;
 | |
|         destpara.free;
 | |
| 
 | |
|         { check if we used a temp for code and whether we have to store }
 | |
|         { it to the real code parameter                                 }
 | |
|         if assigned(orgcode) then
 | |
|           addstatement(newstatement,cassignmentnode.create(
 | |
|               orgcode,
 | |
|               ctypeconvnode.create_internal(
 | |
|                 ctemprefnode.create(tempcode),orgcode.resultdef)));
 | |
| 
 | |
|         { release the temp if we allocated one }
 | |
|         if assigned(tempcode) then
 | |
|           addstatement(newstatement,ctempdeletenode.create(tempcode));
 | |
| 
 | |
|         { free the errornode }
 | |
|         result.free;
 | |
|         { and return it }
 | |
|         result := newblock;
 | |
|       end;
 | |
| 
 | |
|     function tinlinenode.handle_setlength: tnode;
 | |
|       var
 | |
|         def: tdef;
 | |
|         destppn,
 | |
|         paras: tnode;
 | |
|         newstatement: tstatementnode;
 | |
|         ppn: tcallparanode;
 | |
|         counter,
 | |
|         dims: longint;
 | |
|         isarray: boolean;
 | |
|       begin
 | |
|         { for easy exiting if something goes wrong }
 | |
|         result:=cerrornode.create;
 | |
|         resultdef:=voidtype;
 | |
|         paras:=left;
 | |
|         dims:=0;
 | |
|         if assigned(paras) then
 | |
|          begin
 | |
|            { check type of lengths }
 | |
|            ppn:=tcallparanode(paras);
 | |
|            while assigned(ppn.right) do
 | |
|             begin
 | |
|               set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
 | |
|               inserttypeconv(ppn.left,sinttype);
 | |
|               inc(dims);
 | |
|               ppn:=tcallparanode(ppn.right);
 | |
|             end;
 | |
|          end
 | |
|         else
 | |
|          internalerror(2013112912);
 | |
|         if dims=0 then
 | |
|          begin
 | |
|            CGMessage1(parser_e_wrong_parameter_size,'SetLength');
 | |
|            exit;
 | |
|          end;
 | |
|         { last param must be var }
 | |
|         destppn:=ppn.left;
 | |
|         valid_for_var(destppn,true);
 | |
|         set_varstate(destppn,vs_written,[vsf_must_be_valid]);
 | |
|         { first param must be a string or dynamic array ...}
 | |
|         isarray:=is_dynamic_array(destppn.resultdef);
 | |
|         if not((destppn.resultdef.typ=stringdef) or
 | |
|                isarray) then
 | |
|           begin
 | |
|             { possibly generic involved? }
 | |
|             if df_generic in current_procinfo.procdef.defoptions then
 | |
|               result:=internalstatements(newstatement)
 | |
|             else
 | |
|               CGMessage(type_e_mismatch);
 | |
|             exit;
 | |
|           end;
 | |
| 
 | |
|         { only dynamic arrays accept more dimensions }
 | |
|         if (dims>1) then
 | |
|          begin
 | |
|            if (not isarray) then
 | |
|             CGMessage(type_e_mismatch)
 | |
|            else
 | |
|             begin
 | |
|               { check if the amount of dimensions is valid }
 | |
|               def:=tarraydef(destppn.resultdef).elementdef;
 | |
|               counter:=dims;
 | |
|               while counter > 1 do
 | |
|                 begin
 | |
|                   if not(is_dynamic_array(def)) then
 | |
|                     begin
 | |
|                       CGMessage1(parser_e_wrong_parameter_size,'SetLength');
 | |
|                       break;
 | |
|                     end;
 | |
|                   dec(counter);
 | |
|                   def:=tarraydef(def).elementdef;
 | |
|                 end;
 | |
|             end;
 | |
|          end;
 | |
|         result.free;
 | |
|         result:=nil;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.handle_copy: tnode;
 | |
|       var
 | |
|         paras   : tnode;
 | |
|         ppn     : tcallparanode;
 | |
|         paradef : tdef;
 | |
|         counter : integer;
 | |
|       begin
 | |
|         result:=nil;
 | |
|         { determine copy function to use based on the first argument,
 | |
|           also count the number of arguments in this loop }
 | |
|         counter:=1;
 | |
|         paras:=left;
 | |
|         ppn:=tcallparanode(paras);
 | |
|         while assigned(ppn.right) do
 | |
|          begin
 | |
|            inc(counter);
 | |
|            set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
 | |
|            ppn:=tcallparanode(ppn.right);
 | |
|          end;
 | |
|         set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
 | |
|         paradef:=ppn.left.resultdef;
 | |
|         if is_ansistring(paradef) then
 | |
|           // set resultdef to argument def
 | |
|           resultdef:=paradef
 | |
|         else if (is_chararray(paradef) and (paradef.size>255)) or
 | |
|            ((cs_refcountedstrings in current_settings.localswitches) and is_pchar(paradef)) then
 | |
|           // set resultdef to ansistring type since result will be in ansistring codepage
 | |
|           resultdef:=getansistringdef
 | |
|         else
 | |
|          if is_widestring(paradef) then
 | |
|            resultdef:=cwidestringtype
 | |
|         else
 | |
|          if is_unicodestring(paradef) or
 | |
|             is_widechararray(paradef) or
 | |
|             is_pwidechar(paradef) then
 | |
|            resultdef:=cunicodestringtype
 | |
|         else
 | |
|          if is_char(paradef) then
 | |
|            resultdef:=cshortstringtype
 | |
|         else
 | |
|          if is_dynamic_array(paradef) then
 | |
|           begin
 | |
|             { Only allow 1 or 3 arguments }
 | |
|             if not(counter in [1..3]) then
 | |
|              begin
 | |
|                CGMessage1(parser_e_wrong_parameter_size,'Copy');
 | |
|                exit;
 | |
|              end;
 | |
|             resultdef:=paradef;
 | |
|           end
 | |
|         else
 | |
|          begin
 | |
|            { generic fallback that will give an error if a wrong
 | |
|              type is passed }
 | |
|            if (counter=3) then
 | |
|              resultdef:=cshortstringtype
 | |
|            else
 | |
|              CGMessagePos(ppn.left.fileinfo,type_e_mismatch);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| {$maxfpuregisters 0}
 | |
| 
 | |
|     function getpi : bestreal;
 | |
|       begin
 | |
|       {$ifdef x86}
 | |
|         { x86 has pi in hardware }
 | |
|         result:=pi;
 | |
|       {$else x86}
 | |
|         {$ifdef cpuextended}
 | |
|           result:=MathPiExtended.Value;
 | |
|         {$else cpuextended}
 | |
|           result:=MathPi.Value;
 | |
|         {$endif cpuextended}
 | |
|       {$endif x86}
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.simplify(forinline : boolean): tnode;
 | |
| 
 | |
|       function do_lowhigh(def:tdef) : tnode;
 | |
|         var
 | |
|            v    : tconstexprint;
 | |
|            enum : tenumsym;
 | |
|            hp   : tnode;
 | |
|            i    : integer;
 | |
|         begin
 | |
|            case def.typ of
 | |
|              orddef:
 | |
|                begin
 | |
|                   set_varstate(left,vs_read,[]);
 | |
|                   if inlinenumber=in_low_x then
 | |
|                     v:=torddef(def).low
 | |
|                   else
 | |
|                     v:=torddef(def).high;
 | |
|                   hp:=cordconstnode.create(v,def,true);
 | |
|                   typecheckpass(hp);
 | |
|                   do_lowhigh:=hp;
 | |
|                end;
 | |
|              enumdef:
 | |
|                begin
 | |
|                   set_varstate(left,vs_read,[]);
 | |
|                   if inlinenumber=in_high_x then
 | |
|                     v:=tenumdef(def).maxval
 | |
|                   else
 | |
|                     v:=tenumdef(def).minval;
 | |
|                   enum:=nil;
 | |
|                   for i := 0 to tenumdef(def).symtable.SymList.Count - 1 do
 | |
|                     if tenumsym(tenumdef(def).symtable.SymList[i]).value=v then
 | |
|                       begin
 | |
|                         enum:=tenumsym(tenumdef(def).symtable.SymList[i]);
 | |
|                         break;
 | |
|                       end;
 | |
|                   if not assigned(enum) then
 | |
|                     internalerror(309993)
 | |
|                   else
 | |
|                     hp:=genenumnode(enum);
 | |
|                   do_lowhigh:=hp;
 | |
|                end;
 | |
|            else
 | |
|              internalerror(87);
 | |
|            end;
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       function getconstrealvalue : bestreal;
 | |
|         begin
 | |
|            case left.nodetype of
 | |
|               ordconstn:
 | |
|                 getconstrealvalue:=tordconstnode(left).value;
 | |
|               realconstn:
 | |
|                 getconstrealvalue:=trealconstnode(left).value_real;
 | |
|               else
 | |
|                 internalerror(309992);
 | |
|            end;
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       procedure setconstrealvalue(r : bestreal);
 | |
|         begin
 | |
|            result:=crealconstnode.create(r,pbestrealtype^);
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       function handle_ln_const(r : bestreal) : tnode;
 | |
|         begin
 | |
|           if r<=0.0 then
 | |
|             if floating_point_range_check_error then
 | |
|                begin
 | |
|                  result:=crealconstnode.create(0,pbestrealtype^);
 | |
|                  CGMessage(type_e_wrong_math_argument)
 | |
|                end
 | |
|             else
 | |
|               begin
 | |
|                 if r=0.0 then
 | |
|                   result:=crealconstnode.create(MathNegInf.Value,pbestrealtype^)
 | |
|                 else
 | |
|                   result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^)
 | |
|               end
 | |
|           else
 | |
|             result:=crealconstnode.create(ln(r),pbestrealtype^)
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       function handle_sqrt_const(r : bestreal) : tnode;
 | |
|         begin
 | |
|           if r<0.0 then
 | |
|             if floating_point_range_check_error then
 | |
|                begin
 | |
|                  result:=crealconstnode.create(0,pbestrealtype^);
 | |
|                  CGMessage(type_e_wrong_math_argument)
 | |
|                end
 | |
|             else
 | |
|               result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^)
 | |
|           else
 | |
|             result:=crealconstnode.create(sqrt(r),pbestrealtype^)
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       function handle_const_sar : tnode;
 | |
|         var
 | |
|           vl,vl2    : TConstExprInt;
 | |
|           bits,shift: integer;
 | |
|           mask : qword;
 | |
|           def : tdef;
 | |
|         begin
 | |
|           result:=nil;
 | |
|           if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
 | |
|             begin
 | |
|               if (left.nodetype=callparan) and
 | |
|                  assigned(tcallparanode(left).right) then
 | |
|                 begin
 | |
|                   vl:=tordconstnode(tcallparanode(left).left).value;
 | |
|                   if forinline then
 | |
|                     case resultdef.size of
 | |
|                       1,2,4:
 | |
|                         vl:=vl and byte($1f);
 | |
|                       8:
 | |
|                         vl:=vl and byte($3f);
 | |
|                       else
 | |
|                         internalerror(2013122302);
 | |
|                     end;
 | |
|                   if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
 | |
|                     begin
 | |
|                       def:=tcallparanode(tcallparanode(left).right).left.resultdef;
 | |
|                       vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
 | |
|                     end
 | |
|                   else if vl=0 then
 | |
|                     begin
 | |
|                       result:=tcallparanode(tcallparanode(left).right).left;
 | |
|                       tcallparanode(tcallparanode(left).right).left:=nil;
 | |
|                       exit;
 | |
|                     end
 | |
|                   else
 | |
|                     exit;
 | |
|                 end
 | |
|               else
 | |
|                 begin
 | |
|                   def:=left.resultdef;
 | |
|                   vl:=1;
 | |
|                   vl2:=tordconstnode(left).value;
 | |
|                 end;
 | |
| 
 | |
|               bits:=def.size*8;
 | |
|               shift:=vl.svalue and (bits-1);
 | |
|               case bits of
 | |
|                  8:
 | |
|                    mask:=$ff;
 | |
|                  16:
 | |
|                    mask:=$ffff;
 | |
|                  32:
 | |
|                    mask:=$ffffffff;
 | |
|                  64:
 | |
|                    mask:=qword($ffffffffffffffff);
 | |
|                  else
 | |
|                    mask:=qword(1 shl bits)-1;
 | |
|               end;
 | |
| {$push}
 | |
| {$r-,q-}
 | |
|               if shift=0 then
 | |
|                 result:=cordconstnode.create(vl2.svalue,def,false)
 | |
|               else if vl2.svalue<0 then
 | |
|                 result:=cordconstnode.create(((vl2.svalue shr shift) or (mask shl (bits-shift))) and mask,def,false)
 | |
|               else
 | |
|                 result:=cordconstnode.create((vl2.svalue shr shift) and mask,def,false);
 | |
| {$pop}
 | |
|             end
 | |
|           else if (left.nodetype=callparan) and assigned(tcallparanode(left).right) and
 | |
|                   (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
 | |
|             begin
 | |
|               def:=tcallparanode(tcallparanode(left).right).left.resultdef;
 | |
|               vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
 | |
|               { sar(0,x) is 0 }
 | |
|               { sar32(ffffffff,x) is ffffffff, etc. }
 | |
|               if ((vl2=0) or
 | |
|                   ((resultdef.size=1) and (shortint(vl2.svalue)=-1)) or
 | |
|                   ((resultdef.size=2) and (smallint(vl2.svalue)=-1)) or
 | |
|                   ((resultdef.size=4) and (longint(vl2.svalue)=-1)) or
 | |
|                   ((resultdef.size=8) and (int64(vl2.svalue)=-1))) and
 | |
|                  ((cs_opt_level4 in current_settings.optimizerswitches) or
 | |
|                   not might_have_sideeffects(tcallparanode(left).left)) then
 | |
|                 begin
 | |
|                   if vl2=0 then
 | |
|                     result:=cordconstnode.create(0,resultdef,true)
 | |
|                   else
 | |
|                     result:=cordconstnode.create(-1,resultdef,true);
 | |
|                 end;
 | |
|             end;
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       function handle_const_rox : tnode;
 | |
|         var
 | |
|           vl,vl2    : TConstExprInt;
 | |
|           bits,shift: integer;
 | |
|           def : tdef;
 | |
|         begin
 | |
|           result:=nil;
 | |
|           if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
 | |
|             begin
 | |
|               if (left.nodetype=callparan) and
 | |
|                  assigned(tcallparanode(left).right) then
 | |
|                 begin
 | |
|                   vl:=tordconstnode(tcallparanode(left).left).value;
 | |
|                   if forinline then
 | |
|                     case resultdef.size of
 | |
|                       { unlike shifts, for rotates, when masking out the higher bits
 | |
|                         of the rotate count, we go all the way down to byte, because
 | |
|                         it doesn't matter, it produces the same result, since it's a rotate }
 | |
|                       1:
 | |
|                         vl:=vl and byte($07);
 | |
|                       2:
 | |
|                         vl:=vl and byte($0f);
 | |
|                       4:
 | |
|                         vl:=vl and byte($1f);
 | |
|                       8:
 | |
|                         vl:=vl and byte($3f);
 | |
|                       else
 | |
|                         internalerror(2013122302);
 | |
|                     end;
 | |
|                   if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
 | |
|                     begin
 | |
|                       def:=tcallparanode(tcallparanode(left).right).left.resultdef;
 | |
|                       vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
 | |
|                     end
 | |
|                   else if vl=0 then
 | |
|                     begin
 | |
|                       result:=tcallparanode(tcallparanode(left).right).left;
 | |
|                       tcallparanode(tcallparanode(left).right).left:=nil;
 | |
|                       exit;
 | |
|                     end
 | |
|                   else
 | |
|                     exit;
 | |
|                 end
 | |
|               else
 | |
|                 begin
 | |
|                   def:=left.resultdef;
 | |
|                   vl:=1;
 | |
|                   vl2:=tordconstnode(left).value;
 | |
|                 end;
 | |
| 
 | |
|               bits:=def.size*8;
 | |
|               shift:=vl.svalue and (bits-1);
 | |
| {$push}
 | |
| {$r-,q-}
 | |
|               if shift=0 then
 | |
|                 result:=cordconstnode.create(vl2.svalue,def,false)
 | |
|               else
 | |
|                 case inlinenumber of
 | |
|                   in_ror_x,in_ror_x_y:
 | |
|                     case def.size of
 | |
|                       1:
 | |
|                         result:=cordconstnode.create(RorByte(Byte(vl2.svalue),shift),def,false);
 | |
|                       2:
 | |
|                         result:=cordconstnode.create(RorWord(Word(vl2.svalue),shift),def,false);
 | |
|                       4:
 | |
|                         result:=cordconstnode.create(RorDWord(DWord(vl2.svalue),shift),def,false);
 | |
|                       8:
 | |
|                         result:=cordconstnode.create(RorQWord(QWord(vl2.svalue),shift),def,false);
 | |
|                       else
 | |
|                         internalerror(2011061903);
 | |
|                     end;
 | |
|                   in_rol_x,in_rol_x_y:
 | |
|                     case def.size of
 | |
|                       1:
 | |
|                         result:=cordconstnode.create(RolByte(Byte(vl2.svalue),shift),def,false);
 | |
|                       2:
 | |
|                         result:=cordconstnode.create(RolWord(Word(vl2.svalue),shift),def,false);
 | |
|                       4:
 | |
|                         result:=cordconstnode.create(RolDWord(DWord(vl2.svalue),shift),def,false);
 | |
|                       8:
 | |
|                         result:=cordconstnode.create(RolQWord(QWord(vl2.svalue),shift),def,false);
 | |
|                       else
 | |
|                         internalerror(2011061902);
 | |
|                     end;
 | |
|                   else
 | |
|                     internalerror(2011061901);
 | |
|                   end;
 | |
| {$pop}
 | |
|             end
 | |
|           else if (left.nodetype=callparan) and assigned(tcallparanode(left).right) and
 | |
|                   (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
 | |
|             begin
 | |
|               def:=tcallparanode(tcallparanode(left).right).left.resultdef;
 | |
|               vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
 | |
|               { rol/ror are unsigned operations, so cut off upper bits }
 | |
|               case resultdef.size of
 | |
|                 1:
 | |
|                   vl2:=vl2 and byte($ff);
 | |
|                 2:
 | |
|                   vl2:=vl2 and word($ffff);
 | |
|                 4:
 | |
|                   vl2:=vl2 and dword($ffffffff);
 | |
|                 8:
 | |
|                   vl2:=vl2 and qword($ffffffffffffffff);
 | |
|                 else
 | |
|                   internalerror(2017050101);
 | |
|               end;
 | |
|               { rol(0,x) and ror(0,x) are 0 }
 | |
|               { rol32(ffffffff,x) and ror32(ffffffff,x) are ffffffff, etc. }
 | |
|               if ((vl2=0) or
 | |
|                   ((resultdef.size=1) and (vl2=$ff)) or
 | |
|                   ((resultdef.size=2) and (vl2=$ffff)) or
 | |
|                   ((resultdef.size=4) and (vl2=$ffffffff)) or
 | |
|                   ((resultdef.size=8) and (vl2.uvalue=qword($ffffffffffffffff)))) and
 | |
|                  ((cs_opt_level4 in current_settings.optimizerswitches) or
 | |
|                   not might_have_sideeffects(tcallparanode(left).left)) then
 | |
|                 result:=cordconstnode.create(vl2,resultdef,true);
 | |
|             end;
 | |
|         end;
 | |
| 
 | |
|       var
 | |
|         hp        : tnode;
 | |
|         vl,vl2    : TConstExprInt;
 | |
|         vr        : bestreal;
 | |
| 
 | |
|       begin { simplify }
 | |
|          result:=nil;
 | |
|          { handle intern constant functions in separate case }
 | |
|          if nf_inlineconst in flags then
 | |
|           begin
 | |
|             { no parameters? }
 | |
|             if not assigned(left) then
 | |
|               internalerror(200501231)
 | |
|             else
 | |
|              begin
 | |
|                vl:=0;
 | |
|                vl2:=0; { second parameter Ex: ptr(vl,vl2) }
 | |
|                case left.nodetype of
 | |
|                  realconstn :
 | |
|                    begin
 | |
|                      { Real functions are all handled with internproc below }
 | |
|                      CGMessage1(type_e_integer_expr_expected,left.resultdef.typename)
 | |
|                    end;
 | |
|                  ordconstn :
 | |
|                    vl:=tordconstnode(left).value;
 | |
|                  callparan :
 | |
|                    begin
 | |
|                      { both exists, else it was not generated }
 | |
|                      vl:=tordconstnode(tcallparanode(left).left).value;
 | |
|                      vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
 | |
|                    end;
 | |
|                  else
 | |
|                    CGMessage(parser_e_illegal_expression);
 | |
|                end;
 | |
|                case inlinenumber of
 | |
|                  in_const_abs :
 | |
|                    if vl.signed then
 | |
|                      hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline)
 | |
|                    else
 | |
|                      hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline);
 | |
|                  in_const_sqr:
 | |
|                    if vl.signed then
 | |
|                      hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline)
 | |
|                    else
 | |
|                      hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline);
 | |
|                  in_const_odd :
 | |
|                    hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool8type,true);
 | |
|                  in_const_swap_word :
 | |
|                    hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resultdef,true);
 | |
|                  in_const_swap_long :
 | |
|                    hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resultdef,true);
 | |
|                  in_const_swap_qword :
 | |
|                    hp:=cordconstnode.create((vl and $ffffffff) shl 32+(vl shr 32),left.resultdef,true);
 | |
|                  in_const_ptr:
 | |
|                    begin
 | |
|                      {Don't construct pointers from negative values.}
 | |
|                      if (vl.signed and (vl.svalue<0)) or (vl2.signed and (vl2.svalue<0)) then
 | |
|                        cgmessage(parser_e_range_check_error);
 | |
| {$if defined(i8086)}
 | |
|                      hp:=cpointerconstnode.create((vl2.uvalue shl 16)+vl.uvalue,voidfarpointertype);
 | |
| {$elseif defined(i386)}
 | |
|                      hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidnearfspointertype);
 | |
| {$else}
 | |
|                      hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidpointertype);
 | |
| {$endif}
 | |
|                    end
 | |
|                  else
 | |
|                    internalerror(88);
 | |
|                end;
 | |
|              end;
 | |
|             if hp=nil then
 | |
|               hp:=cerrornode.create;
 | |
|             result:=hp;
 | |
|           end
 | |
|         else
 | |
|           begin
 | |
|             case inlinenumber of
 | |
|               in_lo_long,
 | |
|               in_hi_long,
 | |
|               in_lo_qword,
 | |
|               in_hi_qword,
 | |
|               in_lo_word,
 | |
|               in_hi_word :
 | |
|                 begin
 | |
|                   if left.nodetype=ordconstn then
 | |
|                     begin
 | |
|                       case inlinenumber of
 | |
|                         in_lo_word :
 | |
|                           result:=cordconstnode.create(tordconstnode(left).value and $ff,u8inttype,true);
 | |
|                         in_hi_word :
 | |
|                           result:=cordconstnode.create(tordconstnode(left).value shr 8,u8inttype,true);
 | |
|                         in_lo_long :
 | |
|                           result:=cordconstnode.create(tordconstnode(left).value and $ffff,u16inttype,true);
 | |
|                         in_hi_long :
 | |
|                           result:=cordconstnode.create(tordconstnode(left).value shr 16,u16inttype,true);
 | |
|                         in_lo_qword :
 | |
|                           result:=cordconstnode.create(tordconstnode(left).value and $ffffffff,u32inttype,true);
 | |
|                         in_hi_qword :
 | |
|                           result:=cordconstnode.create(tordconstnode(left).value shr 32,u32inttype,true);
 | |
|                       end;
 | |
|                     end;
 | |
|                 end;
 | |
|               in_ord_x:
 | |
|                 begin
 | |
|                   case left.resultdef.typ of
 | |
|                     orddef :
 | |
|                       begin
 | |
|                         case torddef(left.resultdef).ordtype of
 | |
|                           pasbool8,
 | |
|                           uchar:
 | |
|                             begin
 | |
|                               { change to byte() }
 | |
|                               result:=ctypeconvnode.create_internal(left,u8inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           pasbool16,
 | |
|                           uwidechar :
 | |
|                             begin
 | |
|                               { change to word() }
 | |
|                               result:=ctypeconvnode.create_internal(left,u16inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           pasbool32 :
 | |
|                             begin
 | |
|                               { change to dword() }
 | |
|                               result:=ctypeconvnode.create_internal(left,u32inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           pasbool64 :
 | |
|                             begin
 | |
|                               { change to qword() }
 | |
|                               result:=ctypeconvnode.create_internal(left,u64inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           bool8bit:
 | |
|                             begin
 | |
|                               { change to shortint() }
 | |
|                               result:=ctypeconvnode.create_internal(left,s8inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           bool16bit :
 | |
|                             begin
 | |
|                               { change to smallint() }
 | |
|                               result:=ctypeconvnode.create_internal(left,s16inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           bool32bit :
 | |
|                             begin
 | |
|                               { change to longint() }
 | |
|                               result:=ctypeconvnode.create_internal(left,s32inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           bool64bit :
 | |
|                             begin
 | |
|                               { change to int64() }
 | |
|                               result:=ctypeconvnode.create_internal(left,s64inttype);
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                           uvoid :
 | |
|                             CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
 | |
|                           else
 | |
|                             begin
 | |
|                               { all other orddef need no transformation }
 | |
|                               result:=left;
 | |
|                               left:=nil;
 | |
|                             end;
 | |
|                         end;
 | |
|                       end;
 | |
|                     enumdef :
 | |
|                       begin
 | |
|                         result:=ctypeconvnode.create_internal(left,s32inttype);
 | |
|                         left:=nil;
 | |
|                       end;
 | |
|                     pointerdef :
 | |
|                       begin
 | |
|                         if m_mac in current_settings.modeswitches then
 | |
|                           begin
 | |
|                             result:=ctypeconvnode.create_internal(left,ptruinttype);
 | |
|                             left:=nil;
 | |
|                           end
 | |
|                       end;
 | |
|                   end;
 | |
| (*
 | |
|                   if (left.nodetype=ordconstn) then
 | |
|                      begin
 | |
|                        result:=cordconstnode.create(
 | |
|                          tordconstnode(left).value,sinttype,true);
 | |
|                      end
 | |
|                    else if (m_mac in current_settings.modeswitches) and
 | |
|                            (left.ndoetype=pointerconstn) then
 | |
|                        result:=cordconstnode.create(
 | |
|                          tpointerconstnode(left).value,ptruinttype,true);
 | |
| *)
 | |
|                 end;
 | |
|               in_chr_byte:
 | |
|                 begin
 | |
|                    { convert to explicit char() }
 | |
|                    result:=ctypeconvnode.create_internal(left,cansichartype);
 | |
|                    left:=nil;
 | |
|                 end;
 | |
|               in_length_x:
 | |
|                 begin
 | |
|                   case left.resultdef.typ of
 | |
|                     stringdef :
 | |
|                       begin
 | |
|                         if (left.nodetype=stringconstn) then
 | |
|                           begin
 | |
|                             result:=cordconstnode.create(
 | |
|                               tstringconstnode(left).len,sinttype,true);
 | |
|                           end;
 | |
|                       end;
 | |
|                     orddef :
 | |
|                       begin
 | |
|                         { length of char is always one }
 | |
|                         if is_char(left.resultdef) or
 | |
|                            is_widechar(left.resultdef) then
 | |
|                          begin
 | |
|                            result:=cordconstnode.create(1,sinttype,false);
 | |
|                          end
 | |
|                       end;
 | |
|                     arraydef :
 | |
|                       begin
 | |
|                         if (left.nodetype=stringconstn) then
 | |
|                           begin
 | |
|                             result:=cordconstnode.create(
 | |
|                               tstringconstnode(left).len,sinttype,true);
 | |
|                           end
 | |
|                         else if not is_open_array(left.resultdef) and
 | |
|                            not is_array_of_const(left.resultdef) and
 | |
|                            not is_dynamic_array(left.resultdef) then
 | |
|                           result:=cordconstnode.create(tarraydef(left.resultdef).highrange-
 | |
|                             tarraydef(left.resultdef).lowrange+1,
 | |
|                             sinttype,true);
 | |
|                       end;
 | |
|                   end;
 | |
|                 end;
 | |
|               in_assigned_x:
 | |
|                 begin
 | |
|                   if is_constnode(tcallparanode(left).left) or
 | |
|                      (tcallparanode(left).left.nodetype = pointerconstn) then
 | |
|                     begin
 | |
|                       { let an add node figure it out }
 | |
|                       result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
 | |
|                       tcallparanode(left).left := nil;
 | |
|                     end;
 | |
|                 end;
 | |
|               in_pred_x,
 | |
|               in_succ_x:
 | |
|                 begin
 | |
|                   case left.nodetype of
 | |
|                     ordconstn:
 | |
|                       begin
 | |
|                         if inlinenumber=in_succ_x then
 | |
|                           vl:=tordconstnode(left).value+1
 | |
|                         else
 | |
|                           vl:=tordconstnode(left).value-1;
 | |
|                         if is_integer(left.resultdef) then
 | |
|                         { the type of the original integer constant is irrelevant,
 | |
|                           it should be automatically adapted to the new value
 | |
|                           (except when inlining) }
 | |
|                           result:=create_simplified_ord_const(vl,resultdef,forinline)
 | |
|                         else
 | |
|                           { check the range for enums, chars, booleans }
 | |
|                           result:=cordconstnode.create(vl,left.resultdef,not(nf_internal in flags))
 | |
|                       end;
 | |
|                     addn,
 | |
|                     subn:
 | |
|                       begin
 | |
|                         { fold succ/pred in child add/sub nodes with a constant if possible:
 | |
|                            - no overflow/range checking
 | |
|                            - equal types
 | |
|                         }
 | |
|                         if ([cs_check_overflow,cs_check_range]*current_settings.localswitches)=[] then
 | |
|                           begin
 | |
|                             if inlinenumber=in_succ_x then
 | |
|                               vl:=1
 | |
|                             else
 | |
|                               vl:=-1;
 | |
|                             if (taddnode(left).left.nodetype=ordconstn) and equal_defs(resultdef,taddnode(left).left.resultdef) then
 | |
|                               begin
 | |
|                                 tordconstnode(taddnode(left).left).value:=tordconstnode(taddnode(left).left).value+vl;
 | |
|                                 result:=left;
 | |
|                                 left:=nil;
 | |
|                               end
 | |
|                             else if (taddnode(left).right.nodetype=ordconstn) and equal_defs(resultdef,taddnode(left).right.resultdef) then
 | |
|                               begin
 | |
|                                 if left.nodetype=subn then
 | |
|                                   tordconstnode(taddnode(left).right).value:=tordconstnode(taddnode(left).right).value-vl
 | |
|                                 else
 | |
|                                   tordconstnode(taddnode(left).right).value:=tordconstnode(taddnode(left).right).value+vl;
 | |
|                                 result:=left;
 | |
|                                 left:=nil;
 | |
|                               end;
 | |
|                           end;
 | |
|                       end;
 | |
|                   end;
 | |
|                 end;
 | |
|               in_low_x,
 | |
|               in_high_x:
 | |
|                 begin
 | |
|                   case left.resultdef.typ of
 | |
|                     orddef,
 | |
|                     enumdef:
 | |
|                       begin
 | |
|                         result:=do_lowhigh(left.resultdef);
 | |
|                       end;
 | |
|                     setdef:
 | |
|                       begin
 | |
|                         result:=do_lowhigh(tsetdef(left.resultdef).elementdef);
 | |
|                       end;
 | |
|                     arraydef:
 | |
|                       begin
 | |
|                         if (inlinenumber=in_low_x) then
 | |
|                           begin
 | |
|                             result:=cordconstnode.create(int64(tarraydef(
 | |
|                              left.resultdef).lowrange),tarraydef(left.resultdef).rangedef,true);
 | |
|                           end
 | |
|                         else if not is_open_array(left.resultdef) and
 | |
|                                 not is_array_of_const(left.resultdef) and
 | |
|                                 not is_dynamic_array(left.resultdef) then
 | |
|                           result:=cordconstnode.create(int64(tarraydef(left.resultdef).highrange),
 | |
|                             tarraydef(left.resultdef).rangedef,true);
 | |
|                       end;
 | |
|                     stringdef:
 | |
|                       begin
 | |
|                         if inlinenumber=in_low_x then
 | |
|                           begin
 | |
|                             if is_dynamicstring(left.resultdef) and
 | |
|                               not(cs_zerobasedstrings in current_settings.localswitches) then
 | |
|                               result:=cordconstnode.create(1,u8inttype,false)
 | |
|                             else
 | |
|                               result:=cordconstnode.create(0,u8inttype,false);
 | |
|                           end
 | |
|                         else if not is_dynamicstring(left.resultdef) then
 | |
|                           result:=cordconstnode.create(tstringdef(left.resultdef).len,u8inttype,true)
 | |
|                       end;
 | |
|                     undefineddef:
 | |
|                       begin
 | |
|                         result:=cordconstnode.create(0,u8inttype,false);
 | |
|                       end;
 | |
|                   end;
 | |
|                 end;
 | |
|               in_exp_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     begin
 | |
|                       result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^);
 | |
|                       if (trealconstnode(result).value_real=MathInf.Value) and
 | |
|                          floating_point_range_check_error then
 | |
|                         begin
 | |
|                           result:=crealconstnode.create(0,pbestrealtype^);
 | |
|                           CGMessage(parser_e_range_check_error);
 | |
|                         end;
 | |
|                     end
 | |
|                 end;
 | |
|               in_trunc_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     begin
 | |
|                       vr:=getconstrealvalue;
 | |
|                       if (vr>=9223372036854775807.99) or (vr<=-9223372036854775808.0) then
 | |
|                         begin
 | |
|                           message3(type_e_range_check_error_bounds,realtostr(vr),'-9223372036854775808.0','9223372036854775807.99..');
 | |
|                           result:=cordconstnode.create(1,s64inttype,false)
 | |
|                         end
 | |
|                       else
 | |
|                         result:=cordconstnode.create(trunc(vr),s64inttype,true)
 | |
|                     end
 | |
|                 end;
 | |
|               in_round_real :
 | |
|                 begin
 | |
|                   { can't evaluate while inlining, may depend on fpu setting }
 | |
|                   if (not forinline) and
 | |
|                      (left.nodetype in [ordconstn,realconstn]) then
 | |
|                     begin
 | |
|                       vr:=getconstrealvalue;
 | |
|                       if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
 | |
|                         begin
 | |
|                           message3(type_e_range_check_error_bounds,realtostr(vr),'-9223372036854775808.49..','9223372036854775807.49..');
 | |
|                           result:=cordconstnode.create(1,s64inttype,false)
 | |
|                         end
 | |
|                       else
 | |
|                         result:=cordconstnode.create(round(vr),s64inttype,true)
 | |
|                     end
 | |
|                 end;
 | |
|               in_frac_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(frac(getconstrealvalue))
 | |
|                 end;
 | |
|               in_int_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(int(getconstrealvalue));
 | |
|                 end;
 | |
|               in_pi_real :
 | |
|                  begin
 | |
|                    if block_type=bt_const then
 | |
|                      setconstrealvalue(getpi)
 | |
|                  end;
 | |
|               in_cos_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(cos(getconstrealvalue))
 | |
|                 end;
 | |
|               in_sin_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(sin(getconstrealvalue))
 | |
|                 end;
 | |
|               in_arctan_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(arctan(getconstrealvalue))
 | |
|                 end;
 | |
|               in_abs_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(abs(getconstrealvalue))
 | |
|                 end;
 | |
|               in_abs_long:
 | |
|                 begin
 | |
|                   if left.nodetype=ordconstn then
 | |
|                     begin
 | |
|                       if tordconstnode(left).value<0 then
 | |
|                         result:=cordconstnode.create((-tordconstnode(left).value),resultdef,false)
 | |
|                       else
 | |
|                         result:=cordconstnode.create((tordconstnode(left).value),resultdef,false);
 | |
|                     end
 | |
|                 end;
 | |
|               in_sqr_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     setconstrealvalue(sqr(getconstrealvalue))
 | |
|                 end;
 | |
|               in_sqrt_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     result:=handle_sqrt_const(getconstrealvalue);
 | |
|                 end;
 | |
|               in_ln_real :
 | |
|                 begin
 | |
|                   if left.nodetype in [ordconstn,realconstn] then
 | |
|                     result:=handle_ln_const(getconstrealvalue);
 | |
|                 end;
 | |
|               in_assert_x_y :
 | |
|                 begin
 | |
|                   if not(cs_do_assertion in current_settings.localswitches) then
 | |
|                     { we need a valid node, so insert a nothingn }
 | |
|                     result:=cnothingnode.create;
 | |
|                 end;
 | |
|               in_sar_x,
 | |
|               in_sar_x_y :
 | |
|                 begin
 | |
|                   result:=handle_const_sar;
 | |
|                 end;
 | |
|               in_rol_x,
 | |
|               in_rol_x_y,
 | |
|               in_ror_x,
 | |
|               in_ror_x_y :
 | |
|                 result:=handle_const_rox;
 | |
|               in_bsf_x:
 | |
|                 begin
 | |
|                   if left.nodetype=ordconstn then
 | |
|                     begin
 | |
|                       case left.resultdef.size of
 | |
|                         1:
 | |
|                           result:=cordconstnode.create(BsfByte(Byte(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         2:
 | |
|                           result:=cordconstnode.create(BsfWord(Word(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         4:
 | |
|                           result:=cordconstnode.create(BsfDWord(DWord(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         8:
 | |
|                           result:=cordconstnode.create(BsfQWord(QWord(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         else
 | |
|                           internalerror(2017042401);
 | |
|                       end;
 | |
|                     end;
 | |
|                 end;
 | |
|               in_bsr_x :
 | |
|                 begin
 | |
|                   if left.nodetype=ordconstn then
 | |
|                     begin
 | |
|                       case left.resultdef.size of
 | |
|                         1:
 | |
|                           result:=cordconstnode.create(BsrByte(Byte(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         2:
 | |
|                           result:=cordconstnode.create(BsrWord(Word(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         4:
 | |
|                           result:=cordconstnode.create(BsrDWord(DWord(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         8:
 | |
|                           result:=cordconstnode.create(BsrQWord(QWord(tordconstnode(left).value.uvalue)),resultdef,false);
 | |
|                         else
 | |
|                           internalerror(2017042401);
 | |
|                       end;
 | |
|                     end;
 | |
|                 end;
 | |
|               in_popcnt_x :
 | |
|                 begin
 | |
|                   if left.nodetype=ordconstn then
 | |
|                     begin
 | |
|                       result:=cordconstnode.create(PopCnt(tordconstnode(left).value),resultdef,false);
 | |
|                     end;
 | |
|                 end;
 | |
|             end;
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| 
 | |
|     function tinlinenode.pass_typecheck:tnode;
 | |
| 
 | |
|       procedure setfloatresultdef;
 | |
|         var
 | |
|           hnode: tnode;
 | |
|         begin
 | |
|           { System unit declares internal functions like this:
 | |
|               function foo(x: valreal): valreal; [internproc: number];
 | |
|             Calls to such functions are initially processed by callnode,
 | |
|             which typechecks the arguments, possibly inserting conversion to valreal.
 | |
|             To handle smaller types without excess precision, we need to remove
 | |
|             these extra typecasts. }
 | |
|           if (left.nodetype=typeconvn) and
 | |
|             (ttypeconvnode(left).left.resultdef.typ=floatdef) and
 | |
|             (left.flags*[nf_explicit,nf_internal]=[]) and
 | |
|             (tfloatdef(ttypeconvnode(left).left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
 | |
|             begin
 | |
|               hnode:=ttypeconvnode(left).left;
 | |
|               ttypeconvnode(left).left:=nil;
 | |
|               left.free;
 | |
|               left:=hnode;
 | |
|               resultdef:=left.resultdef;
 | |
|             end
 | |
|           else if (left.resultdef.typ=floatdef) and
 | |
|             (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
 | |
|             resultdef:=left.resultdef
 | |
|           else
 | |
|             begin
 | |
|               if (left.nodetype <> ordconstn) then
 | |
|                 inserttypeconv(left,pbestrealtype^);
 | |
|               resultdef:=pbestrealtype^;
 | |
|             end;
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       procedure handle_pack_unpack;
 | |
|         var
 | |
|           source, target, index: tcallparanode;
 | |
|           unpackedarraydef, packedarraydef: tarraydef;
 | |
|           tempindex: TConstExprInt;
 | |
|         begin
 | |
|           resultdef:=voidtype;
 | |
| 
 | |
|           unpackedarraydef := nil;
 | |
|           packedarraydef := nil;
 | |
|           source := tcallparanode(left);
 | |
|           if (inlinenumber = in_unpack_x_y_z) then
 | |
|             begin
 | |
|               target := tcallparanode(source.right);
 | |
|               index := tcallparanode(target.right);
 | |
| 
 | |
|               { source must be a packed array }
 | |
|               if not is_packed_array(source.left.resultdef) then
 | |
|                 CGMessagePos2(source.left.fileinfo,type_e_got_expected_packed_array,'1',source.left.resultdef.typename)
 | |
|               else
 | |
|                 packedarraydef := tarraydef(source.left.resultdef);
 | |
|               { target can be any kind of array, as long as it's not packed }
 | |
|               if (target.left.resultdef.typ <> arraydef) or
 | |
|                  is_packed_array(target.left.resultdef) then
 | |
|                 CGMessagePos2(target.left.fileinfo,type_e_got_expected_unpacked_array,'2',target.left.resultdef.typename)
 | |
|               else
 | |
|                 unpackedarraydef := tarraydef(target.left.resultdef);
 | |
|             end
 | |
|           else
 | |
|             begin
 | |
|               index := tcallparanode(source.right);
 | |
|               target := tcallparanode(index.right);
 | |
| 
 | |
|               { source can be any kind of array, as long as it's not packed }
 | |
|               if (source.left.resultdef.typ <> arraydef) or
 | |
|                  is_packed_array(source.left.resultdef) then
 | |
|                 CGMessagePos2(source.left.fileinfo,type_e_got_expected_unpacked_array,'1',source.left.resultdef.typename)
 | |
|               else
 | |
|                 unpackedarraydef := tarraydef(source.left.resultdef);
 | |
|               { target must be a packed array }
 | |
|               if not is_packed_array(target.left.resultdef) then
 | |
|                 CGMessagePos2(target.left.fileinfo,type_e_got_expected_packed_array,'3',target.left.resultdef.typename)
 | |
|               else
 | |
|                 packedarraydef := tarraydef(target.left.resultdef);
 | |
|             end;
 | |
| 
 | |
|           if assigned(unpackedarraydef) then
 | |
|             begin
 | |
|               { index must be compatible with the unpacked array's indextype }
 | |
|               inserttypeconv(index.left,unpackedarraydef.rangedef);
 | |
| 
 | |
|               { range check at compile time if possible }
 | |
|               if assigned(packedarraydef) and
 | |
|                  (index.left.nodetype = ordconstn) and
 | |
|                  not is_special_array(unpackedarraydef) then
 | |
|                 begin
 | |
|                   testrange(unpackedarraydef,tordconstnode(index.left).value,false,false);
 | |
|                   tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
 | |
|                   testrange(unpackedarraydef,tempindex,false,false);
 | |
|                 end;
 | |
|             end;
 | |
| 
 | |
|           { source array is read and must be valid }
 | |
|           set_varstate(source.left,vs_read,[vsf_must_be_valid]);
 | |
|           { target array is written }
 | |
|           valid_for_assignment(target.left,true);
 | |
|           set_varstate(target.left,vs_written,[]);
 | |
|           { index in the unpacked array is read and must be valid }
 | |
|           set_varstate(index.left,vs_read,[vsf_must_be_valid]);
 | |
|           { if the size of the arrays is 0 (array of empty records), }
 | |
|           { do nothing                                               }
 | |
|           if (source.resultdef.size = 0) then
 | |
|             result:=cnothingnode.create;
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       function handle_objc_encode: tnode;
 | |
|         var
 | |
|           encodedtype: ansistring;
 | |
|           errordef: tdef;
 | |
|         begin
 | |
|           encodedtype:='';
 | |
|           if not objctryencodetype(left.resultdef,encodedtype,errordef) then
 | |
|             Message1(type_e_objc_type_unsupported,errordef.typename);
 | |
|           result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype),nil);
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       var
 | |
|          hightree,
 | |
|          hp        : tnode;
 | |
|          temp_pnode: pnode;
 | |
|       begin
 | |
|         result:=nil;
 | |
|         { when handling writeln "left" contains no valid address }
 | |
|         if assigned(left) then
 | |
|           begin
 | |
|             if left.nodetype=callparan then
 | |
|               tcallparanode(left).get_paratype
 | |
|             else
 | |
|               typecheckpass(left);
 | |
|           end;
 | |
| 
 | |
|         if not(nf_inlineconst in flags) then
 | |
|           begin
 | |
|             case inlinenumber of
 | |
|               in_lo_long,
 | |
|               in_hi_long,
 | |
|               in_lo_qword,
 | |
|               in_hi_qword,
 | |
|               in_lo_word,
 | |
|               in_hi_word :
 | |
|                 begin
 | |
|                   { give warning for incompatibility with tp and delphi }
 | |
|                   if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and
 | |
|                      ((m_tp7 in current_settings.modeswitches) or
 | |
|                       (m_delphi in current_settings.modeswitches)) then
 | |
|                     CGMessage(type_w_maybe_wrong_hi_lo);
 | |
|                   set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                   if not is_integer(left.resultdef) then
 | |
|                     CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
 | |
|                   case inlinenumber of
 | |
|                     in_lo_word,
 | |
|                     in_hi_word :
 | |
|                       resultdef:=u8inttype;
 | |
|                     in_lo_long,
 | |
|                     in_hi_long :
 | |
|                       resultdef:=u16inttype;
 | |
|                     in_lo_qword,
 | |
|                     in_hi_qword :
 | |
|                       resultdef:=u32inttype;
 | |
|                   end;
 | |
|                 end;
 | |
| 
 | |
|               in_sizeof_x:
 | |
|                 begin
 | |
|                   { the constant evaluation of in_sizeof_x happens in pexpr where possible }
 | |
|                   set_varstate(left,vs_read,[]);
 | |
|                   if (left.resultdef.typ<>undefineddef) and
 | |
|                       paramanager.push_high_param(vs_value,left.resultdef,current_procinfo.procdef.proccalloption) then
 | |
|                    begin
 | |
|                      { this should be an open array or array of const, both of
 | |
|                        which can only be simple load nodes of parameters }
 | |
|                      if left.nodetype<>loadn then
 | |
|                        internalerror(2014120701);
 | |
|                      hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
 | |
|                      if assigned(hightree) then
 | |
|                       begin
 | |
|                         hp:=caddnode.create(addn,hightree,
 | |
|                                          cordconstnode.create(1,sinttype,false));
 | |
|                         if (left.resultdef.typ=arraydef) then
 | |
|                           if not is_packed_array(tarraydef(left.resultdef)) then
 | |
|                             begin
 | |
|                               if (tarraydef(left.resultdef).elesize<>1) then
 | |
|                                 hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
 | |
|                                   left.resultdef).elesize,sinttype,true));
 | |
|                             end
 | |
|                           else if (tarraydef(left.resultdef).elepackedbitsize <> 8) then
 | |
|                             begin
 | |
|                               { no packed open array support yet }
 | |
|                               if (hp.nodetype <> ordconstn) then
 | |
|                                 internalerror(2006081511);
 | |
|                               hp.free;
 | |
|                               hp := cordconstnode.create(left.resultdef.size,sinttype,true);
 | |
| {
 | |
|                               hp:=
 | |
|                                  ctypeconvnode.create_explicit(sinttype,
 | |
|                                    cmoddivnode.create(divn,
 | |
|                                      caddnode.create(addn,
 | |
|                                        caddnode.create(muln,hp,cordconstnode.create(tarraydef(
 | |
|                                          left.resultdef).elepackedbitsize,s64inttype,true)),
 | |
|                                        cordconstnode.create(a,s64inttype,true)),
 | |
|                                      cordconstnode.create(8,s64inttype,true)),
 | |
|                                    sinttype);
 | |
| }
 | |
|                             end;
 | |
|                         result:=hp;
 | |
|                       end;
 | |
|                    end
 | |
|                   else
 | |
|                    resultdef:=sinttype;
 | |
|                 end;
 | |
| 
 | |
|               in_typeof_x:
 | |
|                 begin
 | |
|                   if target_info.system in systems_managed_vm then
 | |
|                     message(parser_e_feature_unsupported_for_vm);
 | |
|                   typecheckpass(left);
 | |
|                   set_varstate(left,vs_read,[]);
 | |
|                   if (left.resultdef.typ=objectdef) and
 | |
|                     not(oo_has_vmt in tobjectdef(left.resultdef).objectoptions) then
 | |
|                       message(type_e_typeof_requires_vmt);
 | |
|                   resultdef:=voidpointertype;
 | |
|                 end;
 | |
| 
 | |
|               in_ord_x:
 | |
|                 begin
 | |
|                    set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                    case left.resultdef.typ of
 | |
|                      orddef,
 | |
|                      enumdef :
 | |
|                        ;
 | |
|                      pointerdef :
 | |
|                        begin
 | |
|                          if not(m_mac in current_settings.modeswitches) then
 | |
|                            CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
 | |
|                        end
 | |
|                      else
 | |
|                        CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
 | |
|                    end;
 | |
|                 end;
 | |
| 
 | |
|              in_chr_byte:
 | |
|                begin
 | |
|                  set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                end;
 | |
| 
 | |
|               in_length_x:
 | |
|                 begin
 | |
|                   if ((left.resultdef.typ=arraydef) and
 | |
|                       (not is_special_array(left.resultdef) or
 | |
|                        is_open_array(left.resultdef))) or
 | |
|                      (left.resultdef.typ=orddef) then
 | |
|                     set_varstate(left,vs_read,[])
 | |
|                   else
 | |
|                     set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
| 
 | |
|                   case left.resultdef.typ of
 | |
|                     variantdef:
 | |
|                       begin
 | |
|                         inserttypeconv(left,getansistringdef);
 | |
|                       end;
 | |
| 
 | |
|                     stringdef :
 | |
|                       begin
 | |
|                         { we don't need string convertions here,  }
 | |
|                         { except if from widestring to ansistring }
 | |
|                         { and vice versa (that can change the     }
 | |
|                         { length)                                 }
 | |
|                         if (left.nodetype=typeconvn) and
 | |
|                            (ttypeconvnode(left).left.resultdef.typ=stringdef) and
 | |
|                            not(is_wide_or_unicode_string(left.resultdef) xor
 | |
|                                is_wide_or_unicode_string(ttypeconvnode(left).left.resultdef)) then
 | |
|                          begin
 | |
|                            hp:=ttypeconvnode(left).left;
 | |
|                            ttypeconvnode(left).left:=nil;
 | |
|                            left.free;
 | |
|                            left:=hp;
 | |
|                          end;
 | |
|                       end;
 | |
|                     orddef :
 | |
|                       begin
 | |
|                         { will be handled in simplify }
 | |
|                         if not is_char(left.resultdef) and
 | |
|                            not is_widechar(left.resultdef) then
 | |
|                           CGMessage(type_e_mismatch);
 | |
|                       end;
 | |
|                     pointerdef :
 | |
|                       begin
 | |
|                         if is_pchar(left.resultdef) then
 | |
|                          begin
 | |
|                             hp := ccallparanode.create(left,nil);
 | |
|                             result := ccallnode.createintern('fpc_pchar_length',hp);
 | |
|                             { make sure the left node doesn't get disposed, since it's }
 | |
|                             { reused in the new node (JM)                              }
 | |
|                             left:=nil;
 | |
|                             exit;
 | |
|                          end
 | |
|                         else if is_pwidechar(left.resultdef) then
 | |
|                          begin
 | |
|                             hp := ccallparanode.create(left,nil);
 | |
|                             result := ccallnode.createintern('fpc_pwidechar_length',hp);
 | |
|                             { make sure the left node doesn't get disposed, since it's }
 | |
|                             { reused in the new node (JM)                              }
 | |
|                             left:=nil;
 | |
|                             exit;
 | |
|                          end
 | |
|                         else
 | |
|                          CGMessage(type_e_mismatch);
 | |
|                       end;
 | |
|                     arraydef :
 | |
|                       begin
 | |
|                         if is_open_array(left.resultdef) or
 | |
|                            is_array_of_const(left.resultdef) then
 | |
|                          begin
 | |
|                            hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
 | |
|                            if assigned(hightree) then
 | |
|                              result:=caddnode.create(addn,hightree,
 | |
|                                cordconstnode.create(1,sinttype,false));
 | |
|                            exit;
 | |
|                          end
 | |
|                         { Length() for dynamic arrays is inlined }
 | |
|                         else
 | |
|                           begin
 | |
|                             { will be handled in simplify }
 | |
|                           end;
 | |
|                       end;
 | |
|                     undefineddef :
 | |
|                       begin
 | |
|                         if not (df_generic in current_procinfo.procdef.defoptions) then
 | |
|                           CGMessage(type_e_mismatch);
 | |
|                         { otherwise nothing }
 | |
|                       end;
 | |
|                     else
 | |
|                       CGMessage(type_e_mismatch);
 | |
|                   end;
 | |
| 
 | |
|                   { shortstring return an 8 bit value as the length
 | |
|                     is the first byte of the string }
 | |
|                   if is_shortstring(left.resultdef) then
 | |
|                     resultdef:=u8inttype
 | |
|                   else
 | |
|                     resultdef:=ossinttype;
 | |
|                 end;
 | |
| 
 | |
|               in_typeinfo_x:
 | |
|                 begin
 | |
|                   if target_info.system in systems_managed_vm then
 | |
|                     message(parser_e_feature_unsupported_for_vm);
 | |
|                    if (left.resultdef.typ=enumdef) and
 | |
|                       (tenumdef(left.resultdef).has_jumps) then
 | |
|                      CGMessage(type_e_no_type_info);
 | |
|                    set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                    resultdef:=voidpointertype;
 | |
|                 end;
 | |
| 
 | |
|               in_gettypekind_x:
 | |
|                 begin
 | |
|                   if target_info.system in systems_managed_vm then
 | |
|                     message(parser_e_feature_unsupported_for_vm);
 | |
|                   if (left.resultdef.typ=enumdef) and
 | |
|                      (tenumdef(left.resultdef).has_jumps) then
 | |
|                     CGMessage(type_e_no_type_info);
 | |
|                   set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                   resultdef:=typekindtype;
 | |
|                 end;
 | |
| 
 | |
|               in_assigned_x:
 | |
|                 begin
 | |
|                   { the parser has already made sure the expression is valid }
 | |
| 
 | |
|                   { in case of a complex procvar, only check the "code" pointer }
 | |
|                   if (tcallparanode(left).left.resultdef.typ=procvardef) and
 | |
|                      not tprocvardef(tcallparanode(left).left.resultdef).is_addressonly then
 | |
|                     begin
 | |
|                       inserttypeconv_explicit(tcallparanode(left).left,search_system_type('TMETHOD').typedef);
 | |
|                       tcallparanode(left).left:=csubscriptnode.create(tsym(tabstractrecorddef(tcallparanode(left).left.resultdef).symtable.find('CODE')),tcallparanode(left).left);
 | |
|                       tcallparanode(left).get_paratype;
 | |
|                     end;
 | |
| 
 | |
|                   { Postpone conversion into addnode until firstpass, so targets
 | |
|                     may override first_assigned and insert specific code. }
 | |
|                   set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
 | |
|                   resultdef:=pasbool8type;
 | |
|                 end;
 | |
| 
 | |
|               in_ofs_x :
 | |
|                 internalerror(2000101001);
 | |
| 
 | |
|               in_seg_x :
 | |
|                 begin
 | |
|                   result := typecheck_seg;
 | |
|                 end;
 | |
| 
 | |
|               in_pred_x,
 | |
|               in_succ_x:
 | |
|                 begin
 | |
|                    set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                    resultdef:=left.resultdef;
 | |
|                    if is_ordinal(resultdef) or is_typeparam(resultdef) then
 | |
|                      begin
 | |
|                        if (resultdef.typ=enumdef) and
 | |
|                           (tenumdef(resultdef).has_jumps) and
 | |
|                           not(m_delphi in current_settings.modeswitches) and
 | |
|                           not(nf_internal in flags) then
 | |
|                          CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible);
 | |
|                      end
 | |
|                    else
 | |
|                      CGMessage(type_e_ordinal_expr_expected)
 | |
|                 end;
 | |
| 
 | |
|               in_copy_x:
 | |
|                 result:=handle_copy;
 | |
| 
 | |
|               in_initialize_x,
 | |
|               in_finalize_x:
 | |
|                 begin
 | |
|                   { inlined from pinline }
 | |
|                   internalerror(200204231);
 | |
|                 end;
 | |
|               in_setlength_x:
 | |
|                 begin
 | |
|                   result:=handle_setlength;
 | |
|                 end;
 | |
|               in_inc_x,
 | |
|               in_dec_x:
 | |
|                 begin
 | |
|                   resultdef:=voidtype;
 | |
|                   if not(df_generic in current_procinfo.procdef.defoptions) then
 | |
|                     begin
 | |
|                       if assigned(left) then
 | |
|                         begin
 | |
|                            { first param must be var }
 | |
|                            valid_for_var(tcallparanode(left).left,true);
 | |
|                            set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
 | |
| 
 | |
|                            if (left.resultdef.typ in [enumdef,pointerdef]) or
 | |
|                               is_ordinal(left.resultdef) or
 | |
|                               is_currency(left.resultdef) then
 | |
|                             begin
 | |
|                               { value of left gets changed -> must be unique }
 | |
|                               set_unique(tcallparanode(left).left);
 | |
|                               { two paras ? }
 | |
|                               if assigned(tcallparanode(left).right) then
 | |
|                                begin
 | |
|                                  if is_integer(tcallparanode(left).right.resultdef) then
 | |
|                                    begin
 | |
|                                      set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
 | |
|                                      { when range/overflow checking is on, we
 | |
|                                        convert this to a regular add, and for proper
 | |
|                                        checking we need the original type }
 | |
|                                      if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then
 | |
|                                        if (tcallparanode(left).left.resultdef.typ=pointerdef) then
 | |
|                                          begin
 | |
|                                            { don't convert values added to pointers into the pointer types themselves,
 | |
|                                              because that will turn signed values into unsigned ones, which then
 | |
|                                              goes wrong when they have to be multiplied with the size of the elements
 | |
|                                              to which the pointer points in ncginl (mantis #17342) }
 | |
|                                            if is_signed(tcallparanode(tcallparanode(left).right).left.resultdef) then
 | |
|                                              inserttypeconv(tcallparanode(tcallparanode(left).right).left,tpointerdef(tcallparanode(left).left.resultdef).pointer_arithmetic_int_type)
 | |
|                                            else
 | |
|                                              inserttypeconv(tcallparanode(tcallparanode(left).right).left,tpointerdef(tcallparanode(left).left.resultdef).pointer_arithmetic_uint_type)
 | |
|                                          end
 | |
|                                        else if is_integer(tcallparanode(left).left.resultdef) then
 | |
|                                          inserttypeconv(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef)
 | |
|                                        else
 | |
|                                          inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef);
 | |
|                                      if assigned(tcallparanode(tcallparanode(left).right).right) then
 | |
|                                        { should be handled in the parser (JM) }
 | |
|                                        internalerror(2006020901);
 | |
|                                    end
 | |
|                                  else
 | |
|                                    CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
 | |
|                                end;
 | |
|                             end
 | |
|                            { generic type parameter? }
 | |
|                            else if is_typeparam(left.resultdef) then
 | |
|                              begin
 | |
|                                result:=cnothingnode.create;
 | |
|                                exit;
 | |
|                              end
 | |
|                            else
 | |
|                              begin
 | |
|                                hp:=self;
 | |
|                                if isunaryoverloaded(hp,[]) then
 | |
|                                  begin
 | |
|                                    { inc(rec) and dec(rec) assigns result value to argument }
 | |
|                                    result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);
 | |
|                                    exit;
 | |
|                                  end
 | |
|                                else
 | |
|                                  CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
 | |
|                              end;
 | |
|                         end
 | |
|                       else
 | |
|                         CGMessagePos(fileinfo,type_e_mismatch);
 | |
|                     end;
 | |
|                 end;
 | |
| 
 | |
|               in_and_assign_x_y,
 | |
|               in_or_assign_x_y,
 | |
|               in_xor_assign_x_y,
 | |
|               in_sar_assign_x_y,
 | |
|               in_shl_assign_x_y,
 | |
|               in_shr_assign_x_y,
 | |
|               in_rol_assign_x_y,
 | |
|               in_ror_assign_x_y:
 | |
|                 begin
 | |
|                   resultdef:=voidtype;
 | |
|                   if not(df_generic in current_procinfo.procdef.defoptions) then
 | |
|                     begin
 | |
|                       { first parameter must exist }
 | |
|                       if not assigned(left) or (left.nodetype<>callparan) then
 | |
|                         internalerror(2017032501);
 | |
|                       { second parameter must exist }
 | |
|                       if not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype<>callparan) then
 | |
|                         internalerror(2017032502);
 | |
|                       { third parameter must NOT exist }
 | |
|                       if assigned(tcallparanode(tcallparanode(left).right).right) then
 | |
|                         internalerror(2017032503);
 | |
| 
 | |
|                       valid_for_var(tcallparanode(tcallparanode(left).right).left,true);
 | |
|                       set_varstate(tcallparanode(tcallparanode(left).right).left,vs_readwritten,[vsf_must_be_valid]);
 | |
| 
 | |
|                       if is_integer(tcallparanode(left).right.resultdef) then
 | |
|                         begin
 | |
|                           { value of right gets changed -> must be unique }
 | |
|                           set_unique(tcallparanode(tcallparanode(left).right).left);
 | |
|                           if is_integer(left.resultdef) then
 | |
|                             begin
 | |
|                               set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
 | |
|                               { these nodes shouldn't be created, when range checking is on }
 | |
|                               if [cs_check_range,cs_check_overflow]*localswitches<>[] then
 | |
|                                 internalerror(2017032701);
 | |
|                               if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y] then
 | |
|                                 inserttypeconv(tcallparanode(left).left,sinttype)
 | |
|                               else
 | |
|                                 inserttypeconv(tcallparanode(left).left,tcallparanode(tcallparanode(left).right).left.resultdef);
 | |
|                             end
 | |
|                           else
 | |
|                             CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
 | |
|                         end
 | |
|                       { generic type parameter? }
 | |
|                       else if is_typeparam(tcallparanode(left).right.resultdef) then
 | |
|                         begin
 | |
|                           result:=cnothingnode.create;
 | |
|                           exit;
 | |
|                         end
 | |
|                       else
 | |
|                         CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
 | |
|                     end;
 | |
|                 end;
 | |
| 
 | |
|               in_neg_assign_x,
 | |
|               in_not_assign_x:
 | |
|                 begin
 | |
|                   resultdef:=voidtype;
 | |
|                   if not(df_generic in current_procinfo.procdef.defoptions) then
 | |
|                     begin
 | |
|                       valid_for_var(left,true);
 | |
|                       set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
 | |
| 
 | |
|                       if is_integer(left.resultdef) then
 | |
|                         begin
 | |
|                           { value of left gets changed -> must be unique }
 | |
|                           set_unique(left);
 | |
|                           { these nodes shouldn't be created, when range checking is on }
 | |
|                           if [cs_check_range,cs_check_overflow]*current_settings.localswitches<>[] then
 | |
|                             internalerror(2017040703);
 | |
|                         end
 | |
|                       { generic type parameter? }
 | |
|                       else if is_typeparam(left.resultdef) then
 | |
|                         begin
 | |
|                           result:=cnothingnode.create;
 | |
|                           exit;
 | |
|                         end
 | |
|                       else
 | |
|                         CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
 | |
|                     end;
 | |
|                 end;
 | |
| 
 | |
|               in_read_x,
 | |
|               in_readln_x,
 | |
|               in_readstr_x,
 | |
|               in_write_x,
 | |
|               in_writeln_x,
 | |
|               in_writestr_x :
 | |
|                 begin
 | |
|                   result := handle_read_write;
 | |
|                 end;
 | |
| 
 | |
|               in_settextbuf_file_x :
 | |
|                 begin
 | |
|                   if target_info.system in systems_managed_vm then
 | |
|                     message(parser_e_feature_unsupported_for_vm);
 | |
|                   resultdef:=voidtype;
 | |
|                   { now we know the type of buffer }
 | |
|                   hp:=ccallparanode.create(cordconstnode.create(
 | |
|                      tcallparanode(left).left.resultdef.size,s32inttype,true),left);
 | |
|                   result:=ccallnode.createintern('SETTEXTBUF',hp);
 | |
|                   left:=nil;
 | |
|                 end;
 | |
| 
 | |
|               { the firstpass of the arg has been done in firstcalln ? }
 | |
|               in_reset_typedfile,
 | |
|               in_rewrite_typedfile,
 | |
|               in_reset_typedfile_name,
 | |
|               in_rewrite_typedfile_name :
 | |
|                 begin
 | |
|                   result := handle_reset_rewrite_typed;
 | |
|                 end;
 | |
| 
 | |
|               in_str_x_string :
 | |
|                 begin
 | |
|                   result:=handle_str;
 | |
|                 end;
 | |
| 
 | |
|               in_val_x :
 | |
|                 begin
 | |
|                   result:=handle_val;
 | |
|                 end;
 | |
| 
 | |
|               in_include_x_y,
 | |
|               in_exclude_x_y:
 | |
|                 begin
 | |
|                   resultdef:=voidtype;
 | |
|                   { the parser already checks whether we have two (and exactly two) }
 | |
|                   { parameters (JM)                                                 }
 | |
|                   { first param must be var }
 | |
|                   valid_for_var(tcallparanode(left).left,true);
 | |
|                   set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
 | |
|                   { check type }
 | |
|                   if (left.resultdef.typ=setdef) then
 | |
|                     begin
 | |
|                       { insert a type conversion       }
 | |
|                       { to the type of the set elements  }
 | |
|                       set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
 | |
|                       inserttypeconv(tcallparanode(tcallparanode(left).right).left,
 | |
|                         tsetdef(left.resultdef).elementdef);
 | |
|                     end
 | |
|                   else
 | |
|                     CGMessage(type_e_mismatch);
 | |
|                 end;
 | |
|               in_pack_x_y_z,
 | |
|               in_unpack_x_y_z :
 | |
|                 begin
 | |
|                   handle_pack_unpack;
 | |
|                 end;
 | |
| 
 | |
|               in_slice_x:
 | |
|                 begin
 | |
|                   if target_info.system in systems_managed_vm then
 | |
|                     message(parser_e_feature_unsupported_for_vm);
 | |
|                   result:=nil;
 | |
|                   resultdef:=tcallparanode(left).left.resultdef;
 | |
|                   if (resultdef.typ <> arraydef) then
 | |
|                     CGMessagePos(left.fileinfo,type_e_mismatch)
 | |
|                   else if is_packed_array(resultdef) then
 | |
|                     CGMessagePos2(left.fileinfo,type_e_got_expected_unpacked_array,'1',resultdef.typename);
 | |
|                   if not(is_integer(tcallparanode(tcallparanode(left).right).left.resultdef)) then
 | |
|                     CGMessagePos1(tcallparanode(left).right.fileinfo,
 | |
|                       type_e_integer_expr_expected,
 | |
|                       tcallparanode(tcallparanode(left).right).left.resultdef.typename);
 | |
|                 end;
 | |
| 
 | |
|               in_new_x:
 | |
|                 resultdef:=left.resultdef;
 | |
| 
 | |
|               in_low_x,
 | |
|               in_high_x:
 | |
|                 begin
 | |
|                   case left.resultdef.typ of
 | |
|                     undefineddef,
 | |
|                     orddef,
 | |
|                     enumdef,
 | |
|                     setdef:
 | |
|                       ;
 | |
|                     arraydef:
 | |
|                       begin
 | |
|                         if (inlinenumber=in_low_x) then
 | |
|                           set_varstate(left,vs_read,[])
 | |
|                         else
 | |
|                          begin
 | |
|                            if is_open_array(left.resultdef) or
 | |
|                               is_array_of_const(left.resultdef) then
 | |
|                             begin
 | |
|                               set_varstate(left,vs_read,[]);
 | |
|                               result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
 | |
|                             end
 | |
|                            else
 | |
|                             if is_dynamic_array(left.resultdef) then
 | |
|                               begin
 | |
|                                 set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                                 { can't use inserttypeconv because we need }
 | |
|                                 { an explicit type conversion (JM)         }
 | |
|                                 hp := ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil);
 | |
|                                 result := ccallnode.createintern('fpc_dynarray_high',hp);
 | |
|                                 { make sure the left node doesn't get disposed, since it's }
 | |
|                                 { reused in the new node (JM)                              }
 | |
|                                 left:=nil;
 | |
|                               end
 | |
|                            else
 | |
|                             begin
 | |
|                               set_varstate(left,vs_read,[]);
 | |
|                             end;
 | |
|                          end;
 | |
|                       end;
 | |
|                     stringdef:
 | |
|                       begin
 | |
|                         if inlinenumber=in_low_x then
 | |
|                          begin
 | |
|                            set_varstate(left,vs_read,[]);
 | |
|                          end
 | |
|                         else
 | |
|                          begin
 | |
|                            if is_open_string(left.resultdef) then
 | |
|                             begin
 | |
|                               set_varstate(left,vs_read,[]);
 | |
|                               result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry))
 | |
|                             end
 | |
|                            else if is_dynamicstring(left.resultdef) then
 | |
|                               begin
 | |
|                                 result:=cinlinenode.create(in_length_x,false,left);
 | |
|                                 if cs_zerobasedstrings in current_settings.localswitches then
 | |
|                                   result:=caddnode.create(subn,result,cordconstnode.create(1,sinttype,false));
 | |
|                                 { make sure the left node doesn't get disposed, since it's }
 | |
|                                 { reused in the new node (JM)                              }
 | |
|                                 left:=nil;
 | |
|                               end
 | |
|                          end;
 | |
|                      end;
 | |
|                     else
 | |
|                       CGMessage(type_e_mismatch);
 | |
|                   end;
 | |
|                 end;
 | |
| 
 | |
|               in_exp_real,
 | |
|               in_frac_real,
 | |
|               in_int_real,
 | |
|               in_cos_real,
 | |
|               in_sin_real,
 | |
|               in_arctan_real,
 | |
|               in_ln_real :
 | |
|                 begin
 | |
|                   set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                   { converting an int64 to double on platforms without }
 | |
|                   { extended can cause precision loss                  }
 | |
|                   if not(left.nodetype in [ordconstn,realconstn]) then
 | |
|                     inserttypeconv(left,pbestrealtype^);
 | |
|                   resultdef:=pbestrealtype^;
 | |
|                 end;
 | |
| 
 | |
|               in_trunc_real,
 | |
|               in_round_real :
 | |
|                 begin
 | |
|                   { on i8086, the int64 result is returned in a var param, because
 | |
|                     it's too big to fit in a register or a pair of registers. In
 | |
|                     that case we have 2 parameters and left.nodetype is a callparan. }
 | |
|                   if left.nodetype = callparan then
 | |
|                     temp_pnode := @tcallparanode(left).left
 | |
|                   else
 | |
|                     temp_pnode := @left;
 | |
|                   set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
 | |
|                   { for direct float rounding, no best real type cast should be necessary }
 | |
|                   if not((temp_pnode^.resultdef.typ=floatdef) and
 | |
|                          (tfloatdef(temp_pnode^.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and
 | |
|                      { converting an int64 to double on platforms without }
 | |
|                      { extended can cause precision loss                  }
 | |
|                      not(temp_pnode^.nodetype in [ordconstn,realconstn]) then
 | |
|                     inserttypeconv(temp_pnode^,pbestrealtype^);
 | |
|                   resultdef:=s64inttype;
 | |
|                 end;
 | |
| 
 | |
|               in_pi_real :
 | |
|                 begin
 | |
|                   resultdef:=pbestrealtype^;
 | |
|                 end;
 | |
| 
 | |
|               in_abs_long:
 | |
|                 begin
 | |
|                   set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                   resultdef:=left.resultdef;
 | |
|                 end;
 | |
| 
 | |
|               in_abs_real,
 | |
|               in_sqr_real,
 | |
|               in_sqrt_real :
 | |
|                 begin
 | |
|                   set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                   setfloatresultdef;
 | |
|                 end;
 | |
| 
 | |
| {$ifdef SUPPORT_MMX}
 | |
|               in_mmx_pcmpeqb..in_mmx_pcmpgtw:
 | |
|                 begin
 | |
|                 end;
 | |
| {$endif SUPPORT_MMX}
 | |
|               in_aligned_x,
 | |
|               in_unaligned_x:
 | |
|                 begin
 | |
|                   resultdef:=left.resultdef;
 | |
|                 end;
 | |
|               in_assert_x_y :
 | |
|                 begin
 | |
|                   resultdef:=voidtype;
 | |
|                   if assigned(left) then
 | |
|                     begin
 | |
|                       set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
 | |
|                       { check type }
 | |
|                       if is_boolean(left.resultdef) or
 | |
|                           (
 | |
|                             (left.resultdef.typ=undefineddef) and
 | |
|                             (df_generic in current_procinfo.procdef.defoptions)
 | |
|                           ) then
 | |
|                         begin
 | |
|                            set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
 | |
|                            { must always be a string }
 | |
|                            inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype);
 | |
|                          end
 | |
|                        else
 | |
|                          CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
 | |
|                     end
 | |
|                   else
 | |
|                     CGMessage(type_e_mismatch);
 | |
| 
 | |
|                   if (cs_do_assertion in current_settings.localswitches) then
 | |
|                     include(current_procinfo.flags,pi_do_call);
 | |
|                 end;
 | |
|               in_prefetch_var:
 | |
|                 resultdef:=voidtype;
 | |
|               in_get_frame,
 | |
|               in_get_caller_frame,
 | |
|               in_get_caller_addr:
 | |
|                 begin
 | |
|                   resultdef:=voidpointertype;
 | |
|                 end;
 | |
|               in_rol_x,
 | |
|               in_ror_x,
 | |
|               in_sar_x:
 | |
|                 begin
 | |
|                   set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                   resultdef:=left.resultdef;
 | |
|                 end;
 | |
|               in_rol_x_y,
 | |
|               in_ror_x_y,
 | |
|               in_sar_x_y:
 | |
|                 begin
 | |
|                   set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
 | |
|                   set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
 | |
|                   resultdef:=tcallparanode(tcallparanode(left).right).left.resultdef;
 | |
|                 end;
 | |
|               in_bsf_x,
 | |
|               in_bsr_x:
 | |
|                  begin
 | |
|                    set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                    if not is_integer(left.resultdef) then
 | |
|                      CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
 | |
|                    if torddef(left.resultdef).ordtype in [u64bit, s64bit] then
 | |
|                      resultdef:=u64inttype
 | |
|                    else
 | |
|                      resultdef:=u32inttype
 | |
|                  end;
 | |
| 
 | |
|               in_popcnt_x:
 | |
|                  begin
 | |
|                    set_varstate(left,vs_read,[vsf_must_be_valid]);
 | |
|                    if not is_integer(left.resultdef) then
 | |
|                      CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
 | |
|                    resultdef:=left.resultdef;
 | |
|                  end;
 | |
| 
 | |
|               in_objc_selector_x:
 | |
|                 begin
 | |
|                   result:=cobjcselectornode.create(left);
 | |
|                   { reused }
 | |
|                   left:=nil;
 | |
|                 end;
 | |
|               in_objc_protocol_x:
 | |
|                 begin
 | |
|                   result:=cobjcprotocolnode.create(left);
 | |
|                   { reused }
 | |
|                   left:=nil;
 | |
|                 end;
 | |
|               in_objc_encode_x:
 | |
|                 begin
 | |
|                   result:=handle_objc_encode;
 | |
|                 end;
 | |
|               in_default_x:
 | |
|                 begin
 | |
|                   result:=handle_default;
 | |
|                 end;
 | |
|               in_box_x:
 | |
|                 begin
 | |
|                   result:=handle_box;
 | |
|                 end;
 | |
|               in_unbox_x_y:
 | |
|                 begin
 | |
|                   result:=handle_unbox;
 | |
|                 end;
 | |
|               in_fma_single,
 | |
|               in_fma_double,
 | |
|               in_fma_extended,
 | |
|               in_fma_float128:
 | |
|                 begin
 | |
|                   set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
 | |
|                   set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
 | |
|                   set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]);
 | |
|                   resultdef:=tcallparanode(left).left.resultdef;
 | |
|                 end;
 | |
|               in_delete_x_y_z:
 | |
|                 begin
 | |
|                   result:=handle_delete;
 | |
|                 end;
 | |
|               in_insert_x_y_z:
 | |
|                 begin
 | |
|                   result:=handle_insert;
 | |
|                 end;
 | |
|               in_concat_x:
 | |
|                 begin
 | |
|                   result:=handle_concat;
 | |
|                 end;
 | |
|               else
 | |
|                 result:=pass_typecheck_cpu;
 | |
|             end;
 | |
|           end;
 | |
| 
 | |
|         if not assigned(result) and not
 | |
|            codegenerror then
 | |
|           result:=simplify(false);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.pass_typecheck_cpu : tnode;
 | |
|       begin
 | |
|         Result:=nil;
 | |
|         internalerror(2017110102);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.pass_1 : tnode;
 | |
|       var
 | |
|          hp: tnode;
 | |
|          shiftconst: longint;
 | |
|          objdef: tobjectdef;
 | |
|          sym : tsym;
 | |
| 
 | |
|       begin
 | |
|          result:=nil;
 | |
|          { if we handle writeln; left contains no valid address }
 | |
|          if assigned(left) then
 | |
|            begin
 | |
|               if left.nodetype=callparan then
 | |
|                 tcallparanode(left).firstcallparan
 | |
|               else
 | |
|                 firstpass(left);
 | |
|            end;
 | |
| 
 | |
|          { intern const should already be handled }
 | |
|          if nf_inlineconst in flags then
 | |
|           internalerror(200104044);
 | |
|          case inlinenumber of
 | |
|           in_lo_qword,
 | |
|           in_hi_qword,
 | |
|           in_lo_long,
 | |
|           in_hi_long,
 | |
|           in_lo_word,
 | |
|           in_hi_word:
 | |
|             begin
 | |
|               shiftconst := 0;
 | |
|               case inlinenumber of
 | |
|                 in_hi_qword:
 | |
|                   shiftconst := 32;
 | |
|                 in_hi_long:
 | |
|                   shiftconst := 16;
 | |
|                 in_hi_word:
 | |
|                   shiftconst := 8;
 | |
|               end;
 | |
|               if shiftconst <> 0 then
 | |
|                 result := ctypeconvnode.create_internal(cshlshrnode.create(shrn,left,
 | |
|                     cordconstnode.create(shiftconst,sinttype,false)),resultdef)
 | |
|               else
 | |
|                 result := ctypeconvnode.create_internal(left,resultdef);
 | |
|               left := nil;
 | |
|               firstpass(result);
 | |
|             end;
 | |
| 
 | |
|           in_sizeof_x,
 | |
|           in_typeof_x:
 | |
|             begin
 | |
|               expectloc:=LOC_REGISTER;
 | |
|               case left.resultdef.typ of
 | |
|                 objectdef,classrefdef:
 | |
|                   begin
 | |
|                     if left.resultdef.typ=objectdef then
 | |
|                       begin
 | |
|                         result:=cloadvmtaddrnode.create(left);
 | |
|                         objdef:=tobjectdef(left.resultdef);
 | |
|                       end
 | |
|                     else
 | |
|                       begin
 | |
|                         result:=left;
 | |
|                         objdef:=tobjectdef(tclassrefdef(left.resultdef).pointeddef);
 | |
|                       end;
 | |
|                     left:=nil;
 | |
|                     if inlinenumber=in_sizeof_x then
 | |
|                       begin
 | |
|                         inserttypeconv_explicit(result,cpointerdef.getreusable(objdef.vmt_def));
 | |
|                         result:=cderefnode.create(result);
 | |
|                         result:=genloadfield(result,'VINSTANCESIZE');
 | |
|                       end
 | |
|                     else
 | |
|                       inserttypeconv_explicit(result,voidpointertype);
 | |
|                   end;
 | |
|                 undefineddef:
 | |
|                   ;
 | |
|                 else
 | |
|                   internalerror(2015122702);
 | |
|               end;
 | |
|             end;
 | |
| 
 | |
|           in_length_x:
 | |
|             begin
 | |
|                result:=first_length;
 | |
|             end;
 | |
| 
 | |
|           in_typeinfo_x:
 | |
|             begin
 | |
|               result:=caddrnode.create_internal(
 | |
|                 crttinode.create(tstoreddef(left.resultdef),fullrtti,rdt_normal)
 | |
|               );
 | |
|             end;
 | |
| 
 | |
|           in_gettypekind_x:
 | |
|             begin
 | |
|               sym:=tenumdef(typekindtype).int2enumsym(get_typekind(left.resultdef));
 | |
|               if not assigned(sym) then
 | |
|                 internalerror(2017081101);
 | |
|               if sym.typ<>enumsym then
 | |
|                 internalerror(2017081102);
 | |
|               result:=genenumnode(tenumsym(sym));
 | |
|             end;
 | |
| 
 | |
|           in_assigned_x:
 | |
|             begin
 | |
|               result:=first_assigned;
 | |
|             end;
 | |
| 
 | |
|           in_pred_x,
 | |
|           in_succ_x:
 | |
|             begin
 | |
|               expectloc:=LOC_REGISTER;
 | |
|               { in case of range/overflow checking, use a regular addnode
 | |
|                 because it's too complex to handle correctly otherwise }
 | |
| {$ifndef jvm}
 | |
|               { enums are class instances in the JVM -> always need conversion }
 | |
|               if (([cs_check_overflow,cs_check_range]*current_settings.localswitches)<>[]) and not(nf_internal in flags) then
 | |
| {$endif}
 | |
|                 begin
 | |
|                   { create constant 1 }
 | |
|                   hp:=cordconstnode.create(1,left.resultdef,false);
 | |
|                   typecheckpass(hp);
 | |
|                   if not is_integer(hp.resultdef) then
 | |
|                     inserttypeconv_internal(hp,sinttype);
 | |
| 
 | |
|                   { avoid type errors from the addn/subn }
 | |
|                   if not is_integer(left.resultdef) then
 | |
|                     inserttypeconv_internal(left,sinttype);
 | |
| 
 | |
|                   { addition/substraction depending on succ/pred }
 | |
|                   if inlinenumber=in_succ_x then
 | |
|                     hp:=caddnode.create(addn,left,hp)
 | |
|                   else
 | |
|                     hp:=caddnode.create(subn,left,hp);
 | |
| 
 | |
|                   { the condition above is not tested for jvm, so we need to avoid overflow checks here
 | |
|                     by setting nf_internal for the add/sub node as well }
 | |
|                   if nf_internal in flags then
 | |
|                     include(hp.flags,nf_internal);
 | |
| 
 | |
|                   { assign result of addition }
 | |
|                   if not(is_integer(resultdef)) then
 | |
|                     inserttypeconv(hp,corddef.create(
 | |
| {$ifdef cpu64bitaddr}
 | |
|                       s64bit,
 | |
| {$else cpu64bitaddr}
 | |
|                       s32bit,
 | |
| {$endif cpu64bitaddr}
 | |
|                       get_min_value(resultdef),
 | |
|                       get_max_value(resultdef),
 | |
|                       true))
 | |
|                   else
 | |
|                     inserttypeconv(hp,resultdef);
 | |
| 
 | |
|                   if nf_internal in flags then
 | |
|                     include(hp.flags,nf_internal);
 | |
| 
 | |
|                   { avoid any possible errors/warnings }
 | |
|                   inserttypeconv_internal(hp,resultdef);
 | |
| 
 | |
|                   { firstpass it }
 | |
|                   firstpass(hp);
 | |
| 
 | |
|                   { left is reused }
 | |
|                   left:=nil;
 | |
| 
 | |
|                   { return new node }
 | |
|                   result:=hp;
 | |
|                 end;
 | |
|             end;
 | |
| 
 | |
|           in_setlength_x:
 | |
|             result:=first_setlength;
 | |
|           in_copy_x:
 | |
|             result:=first_copy;
 | |
|           in_initialize_x,
 | |
|           in_finalize_x:
 | |
|             begin
 | |
|               expectloc:=LOC_VOID;
 | |
|             end;
 | |
| 
 | |
|           in_inc_x,
 | |
|           in_dec_x:
 | |
|             begin
 | |
|               result:=first_IncDec;
 | |
|             end;
 | |
| 
 | |
|           in_and_assign_x_y,
 | |
|           in_or_assign_x_y,
 | |
|           in_xor_assign_x_y,
 | |
|           in_sar_assign_x_y,
 | |
|           in_shl_assign_x_y,
 | |
|           in_shr_assign_x_y,
 | |
|           in_rol_assign_x_y,
 | |
|           in_ror_assign_x_y:
 | |
|             begin
 | |
|               result:=first_AndOrXorShiftRot_assign;
 | |
|             end;
 | |
| 
 | |
|           in_neg_assign_x,
 | |
|           in_not_assign_x:
 | |
|             begin
 | |
|               result:=first_NegNot_assign;
 | |
|             end;
 | |
| 
 | |
|          in_include_x_y,
 | |
|          in_exclude_x_y:
 | |
|            begin
 | |
|               result:=first_IncludeExclude;
 | |
|            end;
 | |
| 
 | |
|          in_pack_x_y_z,
 | |
|          in_unpack_x_y_z:
 | |
|            begin
 | |
|              result:=first_pack_unpack;
 | |
|            end;
 | |
| 
 | |
|          in_exp_real:
 | |
|            begin
 | |
|              result:= first_exp_real;
 | |
|            end;
 | |
| 
 | |
|          in_round_real:
 | |
|            begin
 | |
|              result:= first_round_real;
 | |
|            end;
 | |
| 
 | |
|          in_trunc_real:
 | |
|            begin
 | |
|              result:= first_trunc_real;
 | |
|            end;
 | |
| 
 | |
|          in_int_real:
 | |
|            begin
 | |
|              result:= first_int_real;
 | |
|            end;
 | |
| 
 | |
|          in_frac_real:
 | |
|            begin
 | |
|              result:= first_frac_real;
 | |
|            end;
 | |
| 
 | |
|          in_cos_real:
 | |
|            begin
 | |
|              result:= first_cos_real;
 | |
|            end;
 | |
| 
 | |
|          in_sin_real:
 | |
|            begin
 | |
|              result := first_sin_real;
 | |
|            end;
 | |
| 
 | |
|          in_arctan_real:
 | |
|            begin
 | |
|              result := first_arctan_real;
 | |
|            end;
 | |
| 
 | |
|          in_pi_real :
 | |
|            begin
 | |
|              result := first_pi;
 | |
|            end;
 | |
| 
 | |
|          in_abs_real:
 | |
|            begin
 | |
|              result := first_abs_real;
 | |
|            end;
 | |
| 
 | |
|          in_abs_long:
 | |
|            begin
 | |
|              result := first_abs_long;
 | |
|            end;
 | |
| 
 | |
|          in_sqr_real:
 | |
|            begin
 | |
|              result := first_sqr_real;
 | |
|            end;
 | |
| 
 | |
|          in_sqrt_real:
 | |
|            begin
 | |
|              result := first_sqrt_real;
 | |
|            end;
 | |
| 
 | |
|          in_ln_real:
 | |
|            begin
 | |
|              result := first_ln_real;
 | |
|            end;
 | |
| 
 | |
| {$ifdef SUPPORT_MMX}
 | |
|          in_mmx_pcmpeqb..in_mmx_pcmpgtw:
 | |
|            begin
 | |
|            end;
 | |
| {$endif SUPPORT_MMX}
 | |
| 
 | |
|          in_assert_x_y :
 | |
|             begin
 | |
|               result:=first_assert;
 | |
|             end;
 | |
| 
 | |
|           in_low_x,
 | |
|           in_high_x:
 | |
|             internalerror(200104047);
 | |
| 
 | |
|           in_slice_x:
 | |
|             internalerror(2005101501);
 | |
| 
 | |
|           in_ord_x,
 | |
|           in_chr_byte:
 | |
|             begin
 | |
|                { should not happend as it's converted to typeconv }
 | |
|                internalerror(200104045);
 | |
|             end;
 | |
| 
 | |
|           in_ofs_x :
 | |
|             internalerror(2000101001);
 | |
| 
 | |
|           in_seg_x :
 | |
|             begin
 | |
|               result:=first_seg;
 | |
|             end;
 | |
| 
 | |
|           in_settextbuf_file_x,
 | |
|           in_reset_typedfile,
 | |
|           in_rewrite_typedfile,
 | |
|           in_reset_typedfile_name,
 | |
|           in_rewrite_typedfile_name,
 | |
|           in_str_x_string,
 | |
|           in_val_x,
 | |
|           in_read_x,
 | |
|           in_readln_x,
 | |
|           in_write_x,
 | |
|           in_writeln_x :
 | |
|             begin
 | |
|               { should be handled by pass_typecheck }
 | |
|               internalerror(200108234);
 | |
|             end;
 | |
|          in_get_frame:
 | |
|             begin
 | |
|               result:=first_get_frame;
 | |
|             end;
 | |
|          in_get_caller_frame:
 | |
|             begin
 | |
|               expectloc:=LOC_REGISTER;
 | |
|             end;
 | |
|          in_get_caller_addr:
 | |
|             begin
 | |
|               expectloc:=LOC_REGISTER;
 | |
|             end;
 | |
|          in_prefetch_var:
 | |
|            begin
 | |
|              expectloc:=LOC_VOID;
 | |
|            end;
 | |
|          in_aligned_x,
 | |
|          in_unaligned_x:
 | |
|            begin
 | |
|              expectloc:=tcallparanode(left).left.expectloc;
 | |
|            end;
 | |
|          in_rol_x,
 | |
|          in_rol_x_y,
 | |
|          in_ror_x,
 | |
|          in_ror_x_y,
 | |
|          in_bsf_x,
 | |
|          in_bsr_x:
 | |
|            expectloc:=LOC_REGISTER;
 | |
|          in_sar_x,
 | |
|          in_sar_x_y:
 | |
|            result:=first_sar;
 | |
|          in_popcnt_x:
 | |
|            result:=first_popcnt;
 | |
|          in_new_x:
 | |
|            result:=first_new;
 | |
|          in_box_x:
 | |
|            result:=first_box;
 | |
|          in_unbox_x_y:
 | |
|            result:=first_unbox;
 | |
|          in_fma_single,
 | |
|          in_fma_double,
 | |
|          in_fma_extended,
 | |
|          in_fma_float128:
 | |
|            result:=first_fma;
 | |
|          else
 | |
|            result:=first_cpu;
 | |
|           end;
 | |
|        end;
 | |
| {$maxfpuregisters default}
 | |
| 
 | |
|     function tinlinenode.docompare(p: tnode): boolean;
 | |
|       begin
 | |
|         docompare :=
 | |
|           inherited docompare(p) and
 | |
|           (inlinenumber = tinlinenode(p).inlinenumber);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tinlinenode.first_pi : tnode;
 | |
|       begin
 | |
|         result:=crealconstnode.create(getpi,pbestrealtype^);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_arctan_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         first_arctan_real := ccallnode.createintern('fpc_arctan_real',
 | |
|                 ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_abs_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         first_abs_real := ctypeconvnode.create(ccallnode.createintern('fpc_abs_real',
 | |
|                 ccallparanode.create(left,nil)),resultdef);
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_sqr_real : tnode;
 | |
|       begin
 | |
| {$ifndef cpufpemu}
 | |
|         { this procedure might be only used for cpus definining cpufpemu else
 | |
|           the optimizer might go into an endless loop when doing x*x -> changes }
 | |
|         internalerror(2011092401);
 | |
| {$endif cpufpemu}
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         first_sqr_real := ctypeconvnode.create(ccallnode.createintern('fpc_sqr_real',
 | |
|                 ccallparanode.create(left,nil)),resultdef);
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_sqrt_real : tnode;
 | |
|       var
 | |
|         fdef: tdef;
 | |
|         procname: string[31];
 | |
|       begin
 | |
|         if ((cs_fp_emulation in current_settings.moduleswitches)
 | |
| {$ifdef cpufpemu}
 | |
|             or (current_settings.fputype=fpu_soft)
 | |
| {$endif cpufpemu}
 | |
|             ) and not (target_info.system in systems_wince) then
 | |
|           begin
 | |
|             case tfloatdef(left.resultdef).floattype of
 | |
|               s32real:
 | |
|                 begin
 | |
|                   fdef:=search_system_type('FLOAT32REC').typedef;
 | |
|                   procname:='float32_sqrt';
 | |
|                 end;
 | |
|               s64real:
 | |
|                 begin
 | |
|                   fdef:=search_system_type('FLOAT64').typedef;
 | |
|                   procname:='float64_sqrt';
 | |
|                 end;
 | |
|               {!!! not yet implemented
 | |
|               s128real:
 | |
|               }
 | |
|             else
 | |
|               internalerror(2014052101);
 | |
|             end;
 | |
|             first_sqrt_real:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
 | |
|                ctypeconvnode.create_internal(left,fdef),nil)),resultdef);
 | |
|           end
 | |
|         else
 | |
|           begin
 | |
|             { create the call to the helper }
 | |
|             { on entry left node contains the parameter }
 | |
|             first_sqrt_real := ctypeconvnode.create(ccallnode.createintern('fpc_sqrt_real',
 | |
|                 ccallparanode.create(left,nil)),resultdef);
 | |
|           end;
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_ln_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         first_ln_real := ccallnode.createintern('fpc_ln_real',
 | |
|                 ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_cos_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         first_cos_real := ccallnode.createintern('fpc_cos_real',
 | |
|                 ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_sin_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         first_sin_real := ccallnode.createintern('fpc_sin_real',
 | |
|                 ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_exp_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         result := ccallnode.createintern('fpc_exp_real',ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_int_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         result := ccallnode.createintern('fpc_int_real',ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_frac_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         result := ccallnode.createintern('fpc_frac_real',ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_round_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         result := ccallnode.createintern('fpc_round_real',ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_trunc_real : tnode;
 | |
|       begin
 | |
|         { create the call to the helper }
 | |
|         { on entry left node contains the parameter }
 | |
|         result := ccallnode.createintern('fpc_trunc_real',ccallparanode.create(left,nil));
 | |
|         left := nil;
 | |
|       end;
 | |
| 
 | |
|      function tinlinenode.first_abs_long : tnode;
 | |
|       begin
 | |
|         expectloc:=LOC_REGISTER;
 | |
|         result:=nil;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.getaddsub_for_incdec : tnode;
 | |
|        var
 | |
|          hp,hpp,resultnode  : tnode;
 | |
|          tempnode: ttempcreatenode;
 | |
|          newstatement: tstatementnode;
 | |
|          newblock: tblocknode;
 | |
|        begin
 | |
|          newblock := internalstatements(newstatement);
 | |
|          { extra parameter? }
 | |
|          if assigned(tcallparanode(left).right) then
 | |
|            begin
 | |
|              { Yes, use for add node }
 | |
|              hpp := tcallparanode(tcallparanode(left).right).left;
 | |
|              tcallparanode(tcallparanode(left).right).left := nil;
 | |
|              if assigned(tcallparanode(tcallparanode(left).right).right) then
 | |
|                CGMessage(parser_e_illegal_expression);
 | |
|            end
 | |
|          else
 | |
|            begin
 | |
|              { no, create constant 1 }
 | |
|              hpp := cordconstnode.create(1,tcallparanode(left).left.resultdef,false);
 | |
|            end;
 | |
|          typecheckpass(hpp);
 | |
| 
 | |
|          { make sure we don't call functions part of the left node twice (and generally }
 | |
|          { optimize the code generation)                                                }
 | |
|          { Storing address is not always an optimization: alignment of left is not known
 | |
|            at this point, so we must assume the worst and use an unaligned pointer.
 | |
|            This results in larger and slower code on alignment-sensitive targets.
 | |
|            Therefore the complexity condition below is questionable, maybe just filtering
 | |
|            out calls with "= NODE_COMPLEXITY_INF" is sufficient.
 | |
|            Value of 3 corresponds to subscript nodes, i.e. record field. }
 | |
|          if node_complexity(tcallparanode(left).left) > 3 then
 | |
|            begin
 | |
|              tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
 | |
|              addstatement(newstatement,tempnode);
 | |
|              addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
 | |
|                caddrnode.create_internal(tcallparanode(left).left.getcopy)));
 | |
|              hp := cderefnode.create(ctemprefnode.create(tempnode));
 | |
|              inserttypeconv_internal(hp,tcallparanode(left).left.resultdef);
 | |
|            end
 | |
|          else
 | |
|            begin
 | |
|              hp := tcallparanode(left).left.getcopy;
 | |
|              tempnode := nil;
 | |
|            end;
 | |
| 
 | |
|          resultnode := hp.getcopy;
 | |
|          { avoid type errors from the addn/subn }
 | |
|          if not is_integer(resultnode.resultdef) then
 | |
|            begin
 | |
|              inserttypeconv_internal(hp,sinttype);
 | |
|              inserttypeconv_internal(hpp,sinttype);
 | |
|            end;
 | |
| 
 | |
|          { addition/substraction depending on inc/dec }
 | |
|          if inlinenumber = in_inc_x then
 | |
|            hpp := caddnode.create_internal(addn,hp,hpp)
 | |
|          else
 | |
|            hpp := caddnode.create_internal(subn,hp,hpp);
 | |
| 
 | |
|          { assign result of addition }
 | |
| 
 | |
|          { inherit internal flag }
 | |
|          if not(is_integer(resultnode.resultdef)) then
 | |
|            begin
 | |
|              if nf_internal in flags then
 | |
|                inserttypeconv_internal(hpp,corddef.create(
 | |
| {$ifdef cpu64bitaddr}
 | |
|                  s64bit,
 | |
| {$else cpu64bitaddr}
 | |
|                  s32bit,
 | |
| {$endif cpu64bitaddr}
 | |
|                  get_min_value(resultnode.resultdef),
 | |
|                  get_max_value(resultnode.resultdef),
 | |
|                  true))
 | |
|              else
 | |
|                inserttypeconv(hpp,corddef.create(
 | |
| {$ifdef cpu64bitaddr}
 | |
|                  s64bit,
 | |
| {$else cpu64bitaddr}
 | |
|                  s32bit,
 | |
| {$endif cpu64bitaddr}
 | |
|                  get_min_value(resultnode.resultdef),
 | |
|                  get_max_value(resultnode.resultdef),
 | |
|                  true))
 | |
|            end
 | |
|          else
 | |
|            begin
 | |
|              if nf_internal in flags then
 | |
|                inserttypeconv_internal(hpp,resultnode.resultdef)
 | |
|              else
 | |
|                inserttypeconv(hpp,resultnode.resultdef);
 | |
|            end;
 | |
| 
 | |
|          { avoid any possible warnings }
 | |
|          inserttypeconv_internal(hpp,resultnode.resultdef);
 | |
| 
 | |
|          { get varstates right }
 | |
|          node_reset_flags(hpp,[nf_pass1_done,nf_modify,nf_write]);
 | |
|          do_typecheckpass(hpp);
 | |
| 
 | |
|          addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
 | |
| 
 | |
|          { force pass 1, so copied tries get first pass'ed as well and flags like nf_write, nf_call_unique
 | |
|            get set right }
 | |
|          node_reset_flags(newstatement.statement,[nf_pass1_done]);
 | |
|          { firstpass it }
 | |
|          firstpass(tnode(newstatement.left));
 | |
| 
 | |
|          { deallocate the temp }
 | |
|          if assigned(tempnode) then
 | |
|            addstatement(newstatement,ctempdeletenode.create(tempnode));
 | |
|          { firstpass it }
 | |
|          firstpass(tnode(newblock));
 | |
|          { return new node }
 | |
|          result := newblock;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_IncDec: tnode;
 | |
|        begin
 | |
|          expectloc:=LOC_VOID;
 | |
|          result:=nil;
 | |
| 
 | |
|          { range/overflow checking doesn't work properly }
 | |
|          { with the inc/dec code that's generated (JM)   }
 | |
|          if ((localswitches * [cs_check_overflow,cs_check_range] <> []) and
 | |
|            { No overflow check for pointer operations, because inc(pointer,-1) will always
 | |
|              trigger an overflow. For uint32 it works because then the operation is done
 | |
|              in 64bit. Range checking is not applicable to pointers either }
 | |
|              (tcallparanode(left).left.resultdef.typ<>pointerdef))
 | |
| {$ifdef jvm}
 | |
|              { enums are class instances on the JVM -> special treatment }
 | |
|              or (tcallparanode(left).left.resultdef.typ=enumdef)
 | |
| {$endif}
 | |
|             then
 | |
|              { convert to simple add (JM) }
 | |
|              result:=getaddsub_for_incdec
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_IncludeExclude: tnode;
 | |
|        begin
 | |
|          result:=nil;
 | |
|          expectloc:=LOC_VOID;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_get_frame: tnode;
 | |
|        begin
 | |
|          include(current_procinfo.flags,pi_needs_stackframe);
 | |
|          expectloc:=LOC_CREGISTER;
 | |
|          result:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_setlength: tnode;
 | |
|       var
 | |
|         paras   : tnode;
 | |
|         npara,
 | |
|         ppn     : tcallparanode;
 | |
|         dims,
 | |
|         counter : integer;
 | |
|         isarray : boolean;
 | |
|         destppn : tnode;
 | |
|         newstatement : tstatementnode;
 | |
|         temp    : ttempcreatenode;
 | |
|         newblock : tnode;
 | |
|       begin
 | |
|         paras:=left;
 | |
|         ppn:=tcallparanode(paras);
 | |
|         dims:=0;
 | |
|         while assigned(ppn.right) do
 | |
|           begin
 | |
|             inc(dims);
 | |
|             ppn:=tcallparanode(ppn.right);
 | |
|           end;
 | |
| 
 | |
|         destppn:=ppn.left;
 | |
|         isarray:=is_dynamic_array(destppn.resultdef);
 | |
|         { first param must be a string or dynamic array ...}
 | |
|         if isarray then
 | |
|          begin
 | |
|            { create statements with call initialize the arguments and
 | |
|              call fpc_dynarr_setlength }
 | |
|            newblock:=internalstatements(newstatement);
 | |
| 
 | |
|            { get temp for array of lengths }
 | |
|            temp:=ctempcreatenode.create(carraydef.getreusable(sinttype,dims),dims*sinttype.size,tt_persistent,false);
 | |
|            addstatement(newstatement,temp);
 | |
| 
 | |
|            { load array of lengths }
 | |
|            ppn:=tcallparanode(paras);
 | |
|            counter:=dims-1;
 | |
|            while assigned(ppn.right) do
 | |
|              begin
 | |
|                addstatement(newstatement,cassignmentnode.create(
 | |
|                    cvecnode.create(
 | |
|                      ctemprefnode.create(temp),
 | |
|                      genintconstnode(counter)
 | |
|                    ),
 | |
|                    ppn.left));
 | |
|                ppn.left:=nil;
 | |
|                dec(counter);
 | |
|                ppn:=tcallparanode(ppn.right);
 | |
|              end;
 | |
|            { destppn is also reused }
 | |
|            ppn.left:=nil;
 | |
| 
 | |
|            { create call to fpc_dynarr_setlength }
 | |
|            npara:=ccallparanode.create(caddrnode.create_internal(
 | |
|                      cvecnode.create(
 | |
|                        ctemprefnode.create(temp),
 | |
|                        genintconstnode(0)
 | |
|                      )),
 | |
|                   ccallparanode.create(cordconstnode.create
 | |
|                      (dims,sinttype,true),
 | |
|                   ccallparanode.create(caddrnode.create_internal
 | |
|                      (crttinode.create(tstoreddef(destppn.resultdef),initrtti,rdt_normal)),
 | |
|                   ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil))));
 | |
|            addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
 | |
|            addstatement(newstatement,ctempdeletenode.create(temp));
 | |
|          end
 | |
|         else if is_ansistring(destppn.resultdef) then
 | |
|          begin
 | |
|             newblock:=ccallnode.createintern(
 | |
|               'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
 | |
|               ccallparanode.create(
 | |
|                 cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true),
 | |
|                 paras
 | |
|               )
 | |
|             );
 | |
|             { we reused the parameters, make sure we don't release them }
 | |
|             left:=nil;
 | |
|          end
 | |
|         else
 | |
|          begin
 | |
|            { we can reuse the supplied parameters }
 | |
|            newblock:=ccallnode.createintern(
 | |
|               'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',paras);
 | |
|            { we reused the parameters, make sure we don't release them }
 | |
|            left:=nil;
 | |
|          end;
 | |
|         result:=newblock;
 | |
|       end;
 | |
| 
 | |
|     function tinlinenode.first_copy: tnode;
 | |
|       var
 | |
|         lowppn,
 | |
|         highppn,
 | |
|         npara,
 | |
|         paras   : tnode;
 | |
|         ppn     : tcallparanode;
 | |
|         paradef : tdef;
 | |
|         counter : integer;
 | |
|       begin
 | |
|         { determine copy function to use based on the first argument,
 | |
|           also count the number of arguments in this loop }
 | |
|         counter:=1;
 | |
|         paras:=left;
 | |
|         ppn:=tcallparanode(paras);
 | |
|         while assigned(ppn.right) do
 | |
|           begin
 | |
|             inc(counter);
 | |
|             ppn:=tcallparanode(ppn.right);
 | |
|           end;
 | |
|         paradef:=ppn.left.resultdef;
 | |
| 
 | |
|         { fill up third parameter }
 | |
|         if counter=2 then
 | |
|           begin
 | |
|             paras:=ccallparanode.create(cordconstnode.create(torddef(sinttype).high,sinttype,false),paras);
 | |
|             counter:=3;
 | |
|           end;
 | |
| 
 | |
|         if is_ansistring(resultdef) then
 | |
|           { keep the specific kind of ansistringdef as result }
 | |
|           result:=ccallnode.createinternres('fpc_ansistr_copy',paras,resultdef)
 | |
|         else if is_widestring(resultdef) then
 | |
|           result:=ccallnode.createintern('fpc_widestr_copy',paras)
 | |
|         else if is_unicodestring(resultdef) then
 | |
|           result:=ccallnode.createintern('fpc_unicodestr_copy',paras)
 | |
|           { can't check for resultdef = cansichartype, because resultdef=
 | |
|             cshortstringtype here }
 | |
|         else if is_char(paradef) then
 | |
|           result:=ccallnode.createintern('fpc_char_copy',paras)
 | |
|         else if is_dynamic_array(resultdef) then
 | |
|           begin
 | |
|             { create statements with call }
 | |
|             case counter of
 | |
|               1:
 | |
|                 begin
 | |
|                   { copy the whole array using [0..high(sizeint)] range }
 | |
|                   highppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
 | |
|                   lowppn:=cordconstnode.create(0,sinttype,false);
 | |
|                 end;
 | |
|               3:
 | |
|                 begin
 | |
|                   highppn:=tcallparanode(paras).left.getcopy;
 | |
|                   lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
 | |
|                 end;
 | |
|               else
 | |
|                 internalerror(2012100701);
 | |
|             end;
 | |
| 
 | |
|             { create call to fpc_dynarray_copy }
 | |
|             npara:=ccallparanode.create(highppn,
 | |
|                    ccallparanode.create(lowppn,
 | |
|                    ccallparanode.create(caddrnode.create_internal
 | |
|                       (crttinode.create(tstoreddef(paradef),initrtti,rdt_normal)),
 | |
|                    ccallparanode.create
 | |
|                       (ctypeconvnode.create_internal(ppn.left,voidpointertype),nil))));
 | |
|             result:=ccallnode.createinternres('fpc_dynarray_copy',npara,paradef);
 | |
| 
 | |
|             ppn.left:=nil;
 | |
|             paras.free;
 | |
|           end
 | |
|         else
 | |
|           result:=ccallnode.createintern('fpc_shortstr_copy',paras);
 | |
|         { parameters are reused }
 | |
|         left:=nil;
 | |
|      end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_new: tnode;
 | |
|        var
 | |
|          newstatement : tstatementnode;
 | |
|          newblock     : tblocknode;
 | |
|          temp         : ttempcreatenode;
 | |
|          para         : tcallparanode;
 | |
|        begin
 | |
|          { create statements with call to getmem+initialize }
 | |
|          newblock:=internalstatements(newstatement);
 | |
| 
 | |
|          { create temp for result }
 | |
|          temp := ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
 | |
|          addstatement(newstatement,temp);
 | |
| 
 | |
|          { create call to fpc_getmem }
 | |
|          para := ccallparanode.create(cordconstnode.create
 | |
|              (tpointerdef(left.resultdef).pointeddef.size,s32inttype,true),nil);
 | |
|          addstatement(newstatement,cassignmentnode.create(
 | |
|              ctemprefnode.create(temp),
 | |
|              ccallnode.createintern('fpc_getmem',para)));
 | |
| 
 | |
|          { create call to fpc_initialize }
 | |
|          if is_managed_type(tpointerdef(left.resultdef).pointeddef) then
 | |
|           begin
 | |
|             para := ccallparanode.create(caddrnode.create_internal(crttinode.create
 | |
|                        (tstoreddef(tpointerdef(left.resultdef).pointeddef),initrtti,rdt_normal)),
 | |
|                     ccallparanode.create(ctemprefnode.create
 | |
|                        (temp),nil));
 | |
|             addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
 | |
|           end;
 | |
| 
 | |
|          { the last statement should return the value as
 | |
|            location and type, this is done be referencing the
 | |
|            temp and converting it first from a persistent temp to
 | |
|            normal temp }
 | |
|          addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
 | |
|          addstatement(newstatement,ctemprefnode.create(temp));
 | |
|          result:=newblock;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_length: tnode;
 | |
|        begin
 | |
|          result:=nil;
 | |
|          if is_shortstring(left.resultdef) then
 | |
|           expectloc:=left.expectloc
 | |
|          else
 | |
|           begin
 | |
|             { ansi/wide string }
 | |
|             expectloc:=LOC_REGISTER;
 | |
|           end;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_assigned: tnode;
 | |
|        begin
 | |
|          { Comparison must not call procvars, indicate that with nf_load_procvar flag }
 | |
|          result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
 | |
|          include(result.flags,nf_load_procvar);
 | |
|          tcallparanode(left).left:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_assert: tnode;
 | |
|        var
 | |
|          paras: tcallparanode;
 | |
|        begin
 | |
|          paras:=tcallparanode(tcallparanode(left).right);
 | |
|          paras:=ccallparanode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),paras);
 | |
|          paras:=ccallparanode.create(genintconstnode(fileinfo.line),paras);
 | |
| {$ifdef SUPPORT_GET_FRAME}
 | |
|          paras:=ccallparanode.create(geninlinenode(in_get_frame,false,nil),paras);
 | |
| {$else}
 | |
|          paras:=ccallparanode.create(ccallnode.createinternfromunit('SYSTEM','GET_FRAME',nil),paras);
 | |
| {$endif}
 | |
|          result:=cifnode.create(cnotnode.create(tcallparanode(left).left),
 | |
|             ccallnode.createintern('fpc_assert',paras),nil);
 | |
|          include(result.flags,nf_internal);
 | |
|          tcallparanode(left).left:=nil;
 | |
|          tcallparanode(left).right:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_popcnt: tnode;
 | |
|        var
 | |
|          suffix : string;
 | |
|        begin
 | |
|          case torddef(left.resultdef).ordtype of
 | |
|            u8bit: suffix:='byte';
 | |
|            u16bit: suffix:='word';
 | |
|            u32bit: suffix:='dword';
 | |
|            u64bit: suffix:='qword';
 | |
|          else
 | |
|            internalerror(2012082601);
 | |
|          end;
 | |
|          result:=ccallnode.createintern('fpc_popcnt_'+suffix,ccallparanode.create(left,nil));
 | |
|          left:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.typecheck_seg: tnode;
 | |
|        begin
 | |
|          if target_info.system in systems_managed_vm then
 | |
|            message(parser_e_feature_unsupported_for_vm);
 | |
|          set_varstate(left,vs_read,[]);
 | |
|          result:=cordconstnode.create(0,s32inttype,false);
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_seg: tnode;
 | |
|        begin
 | |
|          internalerror(200104046);
 | |
|          result:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_sar: tnode;
 | |
|        begin
 | |
|          result:=nil;
 | |
|          expectloc:=LOC_REGISTER;
 | |
| {$if not defined(cpu64bitalu) and not defined(cpucg64shiftsupport)}
 | |
|          if is_64bitint(resultdef) then
 | |
|            begin
 | |
|              if (inlinenumber=in_sar_x) then
 | |
|                left:=ccallparanode.create(cordconstnode.create(1,u8inttype,false),
 | |
|                  ccallparanode.create(left,nil));
 | |
|              result:=ccallnode.createintern('fpc_sarint64',left);
 | |
|              left:=nil;
 | |
|            end;
 | |
| {$endif not defined(cpu64bitalu) and not defined(cpucg64shiftsupport)}
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.handle_box: tnode;
 | |
|        begin
 | |
|          result:=nil;
 | |
|          if not assigned(left) or
 | |
|             assigned(tcallparanode(left).right) then
 | |
|            CGMessage1(parser_e_wrong_parameter_size,'FpcInternalBox');
 | |
|          resultdef:=class_tobject;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.handle_unbox: tnode;
 | |
|        begin
 | |
|          result:=nil;
 | |
|          if not assigned(left) or
 | |
|             not assigned(tcallparanode(left).right) or
 | |
|             assigned(tcallparanode(tcallparanode(left).right).right) then
 | |
|            CGMessage1(parser_e_wrong_parameter_size,'FpcInternalUnBox');
 | |
|          if tcallparanode(left).left.nodetype<>typen then
 | |
|            internalerror(2011071701);
 | |
|          ttypenode(tcallparanode(left).left).allowed:=true;
 | |
|          resultdef:=tcallparanode(left).left.resultdef;
 | |
|        end;
 | |
| 
 | |
|      function tinlinenode.handle_insert: tnode;
 | |
| 
 | |
|        procedure do_error;
 | |
|          begin
 | |
|            CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Insert');
 | |
|            write_system_parameter_lists('fpc_shortstr_insert');
 | |
|            write_system_parameter_lists('fpc_shortstr_insert_char');
 | |
|            write_system_parameter_lists('fpc_unicodestr_insert');
 | |
|            if tf_winlikewidestring in target_info.flags then
 | |
|              write_system_parameter_lists('fpc_widestr_insert');
 | |
|            write_system_parameter_lists('fpc_ansistr_insert');
 | |
|            MessagePos1(fileinfo,sym_e_param_list,'Insert(Dynamic Array;var Dynamic Array;'+sinttype.typename+');');
 | |
|            MessagePos1(fileinfo,sym_e_param_list,'Insert(Element;var Dynamic Array;'+sinttype.typename+');');
 | |
|          end;
 | |
| 
 | |
|        var
 | |
|          procname : String;
 | |
|          c : longint;
 | |
|          n,
 | |
|          newn,
 | |
|          datan,
 | |
|          datacountn,
 | |
|          firstn,
 | |
|          secondn : tnode;
 | |
|          first,
 | |
|          second : tdef;
 | |
|          isconstr,
 | |
|          iscomparray,
 | |
|          iscompelem : boolean;
 | |
|          datatemp : ttempcreatenode;
 | |
|          insertblock : tblocknode;
 | |
|          insertstatement : tstatementnode;
 | |
|        begin
 | |
|          if not assigned(left) or
 | |
|              not assigned(tcallparanode(left).right) or
 | |
|              not assigned(tcallparanode(tcallparanode(left).right).right) or
 | |
|              assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
 | |
|            begin
 | |
|              do_error;
 | |
|              exit(cerrornode.create);
 | |
|            end;
 | |
|          { determine the correct function based on the second parameter }
 | |
|          firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
 | |
|          first:=firstn.resultdef;
 | |
|          secondn:=tcallparanode(tcallparanode(left).right).left;
 | |
|          second:=secondn.resultdef;
 | |
|          if is_shortstring(second) then
 | |
|            begin
 | |
|              if is_char(first) then
 | |
|                procname:='fpc_shortstr_insert_char'
 | |
|              else
 | |
|                procname:='fpc_shortstr_insert';
 | |
|            end
 | |
|          else if is_unicodestring(second) then
 | |
|            procname:='fpc_unicodestr_insert'
 | |
|          else if is_widestring(second) then
 | |
|            procname:='fpc_widestr_insert'
 | |
|          else if is_ansistring(second) then
 | |
|            procname:='fpc_ansistr_insert'
 | |
|          else if is_dynamic_array(second) then
 | |
|            begin
 | |
|              { The first parameter needs to be
 | |
|                a) a dynamic array of the same type
 | |
|                b) a single element of the same type
 | |
|                c) a static array of the same type (not Delphi compatible)
 | |
|              }
 | |
|              isconstr:=is_array_constructor(first);
 | |
|              iscomparray:=(first.typ=arraydef) and equal_defs(tarraydef(first).elementdef,tarraydef(second).elementdef);
 | |
|              iscompelem:=compare_defs(first,tarraydef(second).elementdef,niln)<>te_incompatible;
 | |
|              if not iscomparray
 | |
|                  and not iscompelem
 | |
|                  and not isconstr then
 | |
|                begin
 | |
|                  CGMessagePos(fileinfo,type_e_array_required);
 | |
|                  exit(cerrornode.create);
 | |
|                end;
 | |
|              insertblock:=internalstatements(insertstatement);
 | |
|              datatemp:=nil;
 | |
|              if iscomparray then
 | |
|                begin
 | |
|                  datatemp:=ctempcreatenode.create_value(first,first.size,tt_normal,false,firstn);
 | |
|                  addstatement(insertstatement,datatemp);
 | |
|                  if is_dynamic_array(first) then
 | |
|                    datan:=ctypeconvnode.create_internal(ctemprefnode.create(datatemp),voidpointertype)
 | |
|                  else
 | |
|                    datan:=caddrnode.create_internal(cvecnode.create(ctemprefnode.create(datatemp),cordconstnode.create(0,sizesinttype,false)));
 | |
|                  datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
 | |
|                end
 | |
|              else if isconstr then
 | |
|                begin
 | |
|                  inserttypeconv(firstn,second);
 | |
|                  datatemp:=ctempcreatenode.create_value(second,second.size,tt_normal,false,firstn);
 | |
|                  addstatement(insertstatement,datatemp);
 | |
|                  datan:=ctypeconvnode.create_internal(ctemprefnode.create(datatemp),voidpointertype);
 | |
|                  datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
 | |
|                end
 | |
|              else
 | |
|                begin
 | |
|                  if is_const(firstn) then
 | |
|                    begin
 | |
|                      datatemp:=ctempcreatenode.create_value(tarraydef(second).elementdef,tarraydef(second).elementdef.size,tt_normal,false,firstn);
 | |
|                      addstatement(insertstatement,datatemp);
 | |
|                      datan:=caddrnode.create_internal(ctemprefnode.create(datatemp));
 | |
|                    end
 | |
|                  else
 | |
|                    datan:=caddrnode.create_internal(ctypeconvnode.create_internal(firstn,tarraydef(second).elementdef));
 | |
|                  datacountn:=cordconstnode.create(1,sizesinttype,false);
 | |
|                end;
 | |
|              procname:='fpc_dynarray_insert';
 | |
|              { recreate the parameters as array pointer, source, data, count, typeinfo }
 | |
|              newn:=ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(second),initrtti,rdt_normal)),
 | |
|                      ccallparanode.create(datacountn,
 | |
|                        ccallparanode.create(datan,
 | |
|                          ccallparanode.create(tcallparanode(left).left,
 | |
|                            ccallparanode.create(ctypeconvnode.create_internal(secondn,voidpointertype),nil)))));
 | |
|              addstatement(insertstatement,ccallnode.createintern(procname,newn));
 | |
|              if assigned(datatemp) then
 | |
|                addstatement(insertstatement,ctempdeletenode.create(datatemp));
 | |
|              tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil; // insert idx
 | |
|              tcallparanode(tcallparanode(left).right).left:=nil; // dyn array
 | |
|              tcallparanode(left).left:=nil; // insert element/array
 | |
|              left.free;
 | |
|              left:=nil;
 | |
|              result:=insertblock;
 | |
|              exit; { ! }
 | |
|            end
 | |
|          else if second.typ=undefineddef then
 | |
|            { just pick one }
 | |
|            procname:='fpc_ansistr_insert'
 | |
|          else
 | |
|            begin
 | |
|              do_error;
 | |
|              exit(cerrornode.create);
 | |
|            end;
 | |
|          result:=ccallnode.createintern(procname,left);
 | |
|          left:=nil;
 | |
|        end;
 | |
| 
 | |
|      function tinlinenode.handle_delete: tnode;
 | |
| 
 | |
|        procedure do_error;
 | |
|          begin
 | |
|            CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Delete');
 | |
|            write_system_parameter_lists('fpc_shortstr_delete');
 | |
|            write_system_parameter_lists('fpc_unicodestr_delete');
 | |
|            if tf_winlikewidestring in target_info.flags then
 | |
|              write_system_parameter_lists('fpc_widestr_delete');
 | |
|            write_system_parameter_lists('fpc_ansistr_delete');
 | |
|            MessagePos1(fileinfo,sym_e_param_list,'Delete(var Dynamic Array;'+sinttype.typename+';'+sinttype.typename+');');
 | |
|          end;
 | |
| 
 | |
|        var
 | |
|          procname : String;
 | |
|          first : tdef;
 | |
|          firstn,
 | |
|          newn : tnode;
 | |
|        begin
 | |
|          if not assigned(left) or
 | |
|              not assigned(tcallparanode(left).right) or
 | |
|              not assigned(tcallparanode(tcallparanode(left).right).right) or
 | |
|              assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
 | |
|            begin
 | |
|              do_error;
 | |
|              exit(cerrornode.create);
 | |
|            end;
 | |
|          { determine the correct function based on the first parameter }
 | |
|          firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
 | |
|          first:=firstn.resultdef;
 | |
|          if is_shortstring(first) then
 | |
|            procname:='fpc_shortstr_delete'
 | |
|          else if is_unicodestring(first) then
 | |
|            procname:='fpc_unicodestr_delete'
 | |
|          else if is_widestring(first) then
 | |
|            procname:='fpc_widestr_delete'
 | |
|          else if is_ansistring(first) then
 | |
|            procname:='fpc_ansistr_delete'
 | |
|          else if is_dynamic_array(first) then
 | |
|            begin
 | |
|              procname:='fpc_dynarray_delete';
 | |
|              { recreate the parameters as array pointer, src, count, typeinfo }
 | |
|              newn:=ccallparanode.create(caddrnode.create_internal
 | |
|                   (crttinode.create(tstoreddef(first),initrtti,rdt_normal)),
 | |
|                     ccallparanode.create(tcallparanode(left).left,
 | |
|                       ccallparanode.create(tcallparanode(tcallparanode(left).right).left,
 | |
|                         ccallparanode.create(ctypeconvnode.create_internal(firstn,voidpointertype),nil))));
 | |
|              tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil;
 | |
|              tcallparanode(tcallparanode(left).right).left:=nil;
 | |
|              tcallparanode(left).left:=nil;
 | |
|              left.free;
 | |
|              left:=newn;
 | |
|            end
 | |
|          else if first.typ=undefineddef then
 | |
|            { just pick one }
 | |
|            procname:='fpc_ansistr_delete'
 | |
|          else
 | |
|            begin
 | |
|              do_error;
 | |
|              exit(cerrornode.create);
 | |
|            end;
 | |
|          result:=ccallnode.createintern(procname,left);
 | |
|          left:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.handle_concat:tnode;
 | |
| 
 | |
|        procedure do_error;
 | |
|          begin
 | |
|            CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Concat');
 | |
|            MessagePos1(fileinfo,sym_e_param_list,'Concat(String[;String;...])');
 | |
|            MessagePos1(fileinfo,sym_e_param_list,'Concat(Dynamic Array[;Dynamic Array;...])');
 | |
|          end;
 | |
| 
 | |
|        var
 | |
|          cpn : tcallparanode;
 | |
|          list : tfpobjectlist;
 | |
|          n,
 | |
|          arrn,
 | |
|          firstn : tnode;
 | |
|          startidx,
 | |
|          i : longint;
 | |
|          arrconstr : tarrayconstructornode;
 | |
|          newstatement : tstatementnode;
 | |
|          tempnode : ttempcreatenode;
 | |
|          lastchanged : boolean;
 | |
|        begin
 | |
|          if not assigned(left) then
 | |
|            begin
 | |
|              do_error;
 | |
|              exit(cerrornode.create);
 | |
|            end;
 | |
|          result:=nil;
 | |
|          { the arguments are right to left, but we need to work on them from
 | |
|            left to right, so insert them in a list and process that from back
 | |
|            to front }
 | |
|          list:=tfpobjectlist.create(false);
 | |
|          { remember the last (aka first) dynamic array parameter (important
 | |
|            in case of array constructors) }
 | |
|          arrn:=nil;
 | |
|          cpn:=tcallparanode(left);
 | |
|          while assigned(cpn) do
 | |
|            begin
 | |
|              list.add(cpn.left);
 | |
|              if is_dynamic_array(cpn.left.resultdef) then
 | |
|                arrn:=cpn.left;
 | |
|              cpn.left:=nil;
 | |
|              cpn:=tcallparanode(cpn.right);
 | |
|            end;
 | |
| 
 | |
|          if list.count=0 then
 | |
|            internalerror(2017100901);
 | |
| 
 | |
|          firstn:=tnode(list.last);
 | |
|          if not assigned(firstn) then
 | |
|            internalerror(2017100902);
 | |
| 
 | |
|          { are we dealing with strings or dynamic arrays? }
 | |
|          if is_dynamic_array(firstn.resultdef) or is_array_constructor(firstn.resultdef) then
 | |
|            begin
 | |
|              { try to combine all consecutive array constructors }
 | |
|              lastchanged:=false;
 | |
|              i:=0;
 | |
|              repeat
 | |
|                if lastchanged or is_array_constructor(tnode(list[i]).resultdef) then
 | |
|                  begin
 | |
|                    if (i<list.count-1) and is_array_constructor(tnode(list[i+1]).resultdef) then
 | |
|                      begin
 | |
|                        arrconstr:=tarrayconstructornode(list[i+1]);
 | |
|                        while assigned(arrconstr.right) do
 | |
|                          arrconstr:=tarrayconstructornode(arrconstr.right);
 | |
|                        arrconstr.right:=tnode(list[i]);
 | |
|                        list[i]:=list[i+1];
 | |
|                        list.delete(i+1);
 | |
|                        lastchanged:=true;
 | |
|                        tnode(list[i]).resultdef:=nil;
 | |
|                        { don't increase index! }
 | |
|                        continue;
 | |
|                      end;
 | |
|                    if lastchanged then
 | |
|                      begin
 | |
|                        { we concatted all consecutive ones, so typecheck the new one again }
 | |
|                        n:=tnode(list[i]);
 | |
|                        typecheckpass(n);
 | |
|                        list[i]:=n;
 | |
|                      end;
 | |
|                    lastchanged:=false;
 | |
|                  end;
 | |
|                inc(i);
 | |
|              until i=list.count;
 | |
| 
 | |
|              if list.count=1 then
 | |
|                begin
 | |
|                  { no need to call the concat helper }
 | |
|                  result:=firstn;
 | |
|                end
 | |
|              else
 | |
|                begin
 | |
|                  { if we reach this point then the concat list didn't consist
 | |
|                    solely of array constructors }
 | |
|                  if not assigned(arrn) then
 | |
|                    internalerror(2017101001);
 | |
| 
 | |
|                  result:=internalstatements(newstatement);
 | |
| 
 | |
|                  { generate the open array constructor for the source arrays
 | |
|                    note: the order needs to be swapped again here! }
 | |
|                  arrconstr:=nil;
 | |
|                  for i:=0 to list.count-1 do
 | |
|                    begin
 | |
|                      n:=tnode(list[i]);
 | |
|                      { first convert to the target type }
 | |
|                      if not is_array_constructor(n.resultdef) then
 | |
|                        inserttypeconv(n,arrn.resultdef);
 | |
|                      { we need to ensure that we get a reference counted
 | |
|                        assignement for the temp array }
 | |
|                      tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
 | |
|                      addstatement(newstatement,tempnode);
 | |
|                      addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),n));
 | |
|                      addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
 | |
|                      n:=ctemprefnode.create(tempnode);
 | |
|                      { then to a plain pointer for the helper }
 | |
|                      inserttypeconv_internal(n,voidpointertype);
 | |
|                      arrconstr:=carrayconstructornode.create(n,arrconstr);
 | |
|                    end;
 | |
|                  arrconstr.allow_array_constructor:=true;
 | |
| 
 | |
|                  { based on the code from nopt.genmultistringadd() }
 | |
|                  tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
 | |
|                  addstatement(newstatement,tempnode);
 | |
|                  { initialize the temp, since it will be passed to a
 | |
|                    var-parameter (and finalization, which is performed by the
 | |
|                    ttempcreate node and which takes care of the initialization
 | |
|                    on native targets, is a noop on managed VM targets) }
 | |
|                  if (target_info.system in systems_managed_vm) and
 | |
|                     is_managed_type(arrn.resultdef) then
 | |
|                    addstatement(newstatement,cinlinenode.create(in_setlength_x,
 | |
|                      false,
 | |
|                      ccallparanode.create(genintconstnode(0),
 | |
|                        ccallparanode.create(ctemprefnode.create(tempnode),nil))));
 | |
| 
 | |
|                  cpn:=ccallparanode.create(
 | |
|                          arrconstr,
 | |
|                          ccallparanode.create(
 | |
|                            caddrnode.create_internal(crttinode.create(tstoreddef(arrn.resultdef),initrtti,rdt_normal)),
 | |
|                              ccallparanode.create(ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidpointertype),nil))
 | |
|                        );
 | |
|                  addstatement(
 | |
|                    newstatement,
 | |
|                    ccallnode.createintern(
 | |
|                      'fpc_dynarray_concat_multi',
 | |
|                      cpn
 | |
|                    )
 | |
|                  );
 | |
|                  addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
 | |
|                  addstatement(newstatement,ctemprefnode.create(tempnode));
 | |
|                end;
 | |
|            end
 | |
|          else
 | |
|            begin
 | |
|              { enforce strings }
 | |
|              for i:=list.count-1 downto 0 do
 | |
|                begin
 | |
|                  if assigned(result) then
 | |
|                    result:=caddnode.create(addn,result,tnode(list[i]))
 | |
|                  else
 | |
|                    begin
 | |
|                      result:=tnode(list[i]);
 | |
|                      { Force string type if it isn't yet }
 | |
|                      if not(
 | |
|                             (result.resultdef.typ=stringdef) or
 | |
|                             is_chararray(result.resultdef) or
 | |
|                             is_char(result.resultdef)
 | |
|                            ) then
 | |
|                        inserttypeconv(result,cshortstringtype);
 | |
|                    end;
 | |
|                end;
 | |
|            end;
 | |
| 
 | |
|          list.free;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_pack_unpack: tnode;
 | |
|        var
 | |
|          loopstatement    : tstatementnode;
 | |
|          loop             : tblocknode;
 | |
|          loopvar          : ttempcreatenode;
 | |
|          tempnode,
 | |
|          source,
 | |
|          target,
 | |
|          index,
 | |
|          unpackednode,
 | |
|          packednode,
 | |
|          sourcevecindex,
 | |
|          targetvecindex,
 | |
|          loopbody         : tnode;
 | |
|          temprangedef     : tdef;
 | |
|          ulorange,
 | |
|          uhirange,
 | |
|          plorange,
 | |
|          phirange          : TConstExprInt;
 | |
|        begin
 | |
|          { transform into a for loop which assigns the data of the (un)packed }
 | |
|          { array to the other one                                             }
 | |
|          source := left;
 | |
|          if (inlinenumber = in_unpack_x_y_z) then
 | |
|            begin
 | |
|              target := tcallparanode(source).right;
 | |
|              index := tcallparanode(target).right;
 | |
|              packednode := tcallparanode(source).left;
 | |
|              unpackednode := tcallparanode(target).left;
 | |
|            end
 | |
|          else
 | |
|            begin
 | |
|              index := tcallparanode(source).right;
 | |
|              target := tcallparanode(index).right;
 | |
|              packednode := tcallparanode(target).left;
 | |
|              unpackednode := tcallparanode(source).left;
 | |
|            end;
 | |
|          source := tcallparanode(source).left;
 | |
|          target := tcallparanode(target).left;
 | |
|          index := tcallparanode(index).left;
 | |
| 
 | |
|          loop := internalstatements(loopstatement);
 | |
|          loopvar := ctempcreatenode.create(
 | |
|            tarraydef(packednode.resultdef).rangedef,
 | |
|            tarraydef(packednode.resultdef).rangedef.size,
 | |
|            tt_persistent,true);
 | |
|          addstatement(loopstatement,loopvar);
 | |
| 
 | |
|          { For range checking: we have to convert to an integer type (in case the index type }
 | |
|          { is an enum), add the index and loop variable together, convert the result         }
 | |
|          { implicitly to an orddef with range equal to the rangedef to get range checking   }
 | |
|          { and finally convert it explicitly back to the actual rangedef to avoid type      }
 | |
|          { errors                                                                            }
 | |
|          temprangedef:=nil;
 | |
|          getrange(unpackednode.resultdef,ulorange,uhirange);
 | |
|          getrange(packednode.resultdef,plorange,phirange);
 | |
|          { does not really need to be registered, but then we would have to
 | |
|            record it elsewhere so it still can be freed }
 | |
|          temprangedef:=corddef.create(torddef(sinttype).ordtype,ulorange,uhirange,true);
 | |
|          sourcevecindex := ctemprefnode.create(loopvar);
 | |
|          targetvecindex := ctypeconvnode.create_internal(index.getcopy,sinttype);
 | |
|          targetvecindex := caddnode.create(subn,targetvecindex,cordconstnode.create(plorange,sinttype,true));
 | |
|          targetvecindex := caddnode.create(addn,targetvecindex,ctemprefnode.create(loopvar));
 | |
|          targetvecindex := ctypeconvnode.create(targetvecindex,temprangedef);
 | |
|          targetvecindex := ctypeconvnode.create_explicit(targetvecindex,tarraydef(unpackednode.resultdef).rangedef);
 | |
| 
 | |
|          if (inlinenumber = in_pack_x_y_z) then
 | |
|            begin
 | |
|              { swap source and target vec indices }
 | |
|              tempnode := sourcevecindex;
 | |
|              sourcevecindex := targetvecindex;
 | |
|              targetvecindex := tempnode;
 | |
|            end;
 | |
| 
 | |
|          { create the assignment in the loop body }
 | |
|          loopbody :=
 | |
|            cassignmentnode.create(
 | |
|              cvecnode.create(target.getcopy,targetvecindex),
 | |
|              cvecnode.create(source.getcopy,sourcevecindex)
 | |
|            );
 | |
|          { create the actual for loop }
 | |
|          tempnode := cfornode.create(
 | |
|            ctemprefnode.create(loopvar),
 | |
|            cinlinenode.create(in_low_x,false,packednode.getcopy),
 | |
|            cinlinenode.create(in_high_x,false,packednode.getcopy),
 | |
|            loopbody,
 | |
|            false);
 | |
|          addstatement(loopstatement,tempnode);
 | |
|          { free the loop counter }
 | |
|          addstatement(loopstatement,ctempdeletenode.create(loopvar));
 | |
|          result := loop;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_fma: tnode;
 | |
|        begin
 | |
|          CGMessage1(cg_e_function_not_support_by_selected_instruction_set,'FMA');
 | |
|          result:=nil;
 | |
|        end;
 | |
| 
 | |
| 
 | |
| {$ifndef cpu64bitalu}
 | |
|      function tinlinenode.first_ShiftRot_assign_64bitint: tnode;
 | |
|        var
 | |
|          procname: string[31];
 | |
|        begin
 | |
| {$ifdef cpucg64shiftsupport}
 | |
|          if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y] then
 | |
|            begin
 | |
|              result:=nil;
 | |
|              expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
 | |
|              exit;
 | |
|            end;
 | |
| {$endif cpucg64shiftsupport}
 | |
|          result := nil;
 | |
|          if is_signed(tcallparanode(left).right.resultdef) then
 | |
|            procname:='int64'
 | |
|          else
 | |
|            procname:='qword';
 | |
|          case inlinenumber of
 | |
|            in_sar_assign_x_y:
 | |
|              procname := 'fpc_sar_assign_'+procname;
 | |
|            in_shl_assign_x_y:
 | |
|              procname := 'fpc_shl_assign_'+procname;
 | |
|            in_shr_assign_x_y:
 | |
|              procname := 'fpc_shr_assign_'+procname;
 | |
|            in_rol_assign_x_y:
 | |
|              procname := 'fpc_rol_assign_'+procname;
 | |
|            in_ror_assign_x_y:
 | |
|              procname := 'fpc_ror_assign_'+procname;
 | |
|            else
 | |
|              internalerror(2017041301);
 | |
|          end;
 | |
|          result := ccallnode.createintern(procname,ccallparanode.create(tcallparanode(left).left,
 | |
|            ccallparanode.create(tcallparanode(tcallparanode(left).right).left,nil)));
 | |
|          tcallparanode(tcallparanode(left).right).left := nil;
 | |
|          tcallparanode(left).left := nil;
 | |
|          firstpass(result);
 | |
|        end;
 | |
| {$endif not cpu64bitalu}
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_AndOrXorShiftRot_assign: tnode;
 | |
|        begin
 | |
| {$ifndef cpu64bitalu}
 | |
|          { 64 bit ints have their own shift handling }
 | |
|          if is_64bit(tcallparanode(left).right.resultdef) and
 | |
|             (inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y]) then
 | |
|            result := first_ShiftRot_assign_64bitint
 | |
|          else
 | |
| {$endif not cpu64bitalu}
 | |
|            begin
 | |
|              result:=nil;
 | |
|              expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
 | |
|            end;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_NegNot_assign: tnode;
 | |
|        begin
 | |
|          result:=nil;
 | |
|          expectloc:=left.expectloc;
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      function tinlinenode.first_cpu : tnode;
 | |
|        begin
 | |
|          Result:=nil;
 | |
|          internalerror(2017110101);
 | |
|        end;
 | |
| 
 | |
| 
 | |
|      procedure tinlinenode.CheckParameters(count: integer);
 | |
|        var
 | |
|          p: tnode;
 | |
|        begin
 | |
|          if count=1 then
 | |
|            set_varstate(left,vs_read,[vsf_must_be_valid])
 | |
|          else
 | |
|            begin
 | |
|              p:=left;
 | |
|              while count>0 do
 | |
|                begin
 | |
|                  set_varstate(tcallparanode(p).left,vs_read,[vsf_must_be_valid]);
 | |
| 
 | |
|                  p:=tcallparanode(p).right;
 | |
|                  dec(count);
 | |
|                end;
 | |
|            end;
 | |
|        end;
 | |
| 
 | |
| end.
 | |
| 
 | 
