← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/compiler/ncnv.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/compiler/ncnv.pas
37
37
          totypedef   : tdef;
38
38
          totypedefderef : tderef;
39
39
          convtype : tconverttype;
 
40
          warn_pointer_to_signed: boolean;
40
41
          constructor create(node : tnode;def:tdef);virtual;
41
42
          constructor create_explicit(node : tnode;def:tdef);
42
43
          constructor create_internal(node : tnode;def:tdef);
215
216
implementation
216
217
 
217
218
   uses
218
 
      cclasses,globtype,systems,
 
219
      globtype,systems,
219
220
      cutils,verbose,globals,widestr,
220
221
      symconst,symdef,symsym,symbase,symtable,
221
222
      ncon,ncal,nset,nadd,ninl,nmem,nmat,nbas,nutils,
294
295
        constsetlo,
295
296
        constsethi  : TConstExprInt;
296
297
 
297
 
        procedure update_constsethi(def:tdef);
 
298
        procedure update_constsethi(def:tdef; maybetruncenumrange: boolean);
298
299
          begin
299
 
            if ((def.typ=orddef) and
300
 
                (torddef(def).high>=constsethi)) then
 
300
            if (def.typ=orddef) and
 
301
               ((torddef(def).high>=constsethi) or
 
302
                (torddef(def).low <=constsetlo)) then
301
303
              begin
302
304
                if torddef(def).ordtype=uwidechar then
303
305
                  begin
304
306
                    constsethi:=255;
 
307
                    constsetlo:=0;
305
308
                    if hdef=nil then
306
309
                      hdef:=def;
307
310
                  end
308
311
                else
309
312
                  begin
310
 
                    constsethi:=torddef(def).high;
 
313
                    if (torddef(def).high>=constsethi) then
 
314
                      constsethi:=torddef(def).high;
 
315
                    if (torddef(def).low<=constsetlo) then
 
316
                      constsetlo:=torddef(def).low;
311
317
                    if hdef=nil then
312
318
                      begin
313
319
                         if (constsethi>255) or
318
324
                      end;
319
325
                    if constsethi>255 then
320
326
                      constsethi:=255;
 
327
                    if constsetlo<0 then
 
328
                      constsetlo:=0;
321
329
                  end;
322
330
              end
323
 
            else if ((def.typ=enumdef) and
324
 
                    (tenumdef(def).max>=constsethi)) then
 
331
            else if (def.typ=enumdef) and
 
332
                    ((tenumdef(def).max>=constsethi) or
 
333
                     (tenumdef(def).min<=constsetlo)) then
325
334
              begin
326
335
                 if hdef=nil then
327
336
                   hdef:=def;
328
 
                 constsethi:=tenumdef(def).max;
 
337
                 if (tenumdef(def).max>=constsethi) then
 
338
                   constsethi:=tenumdef(def).max;
 
339
                 if (tenumdef(def).min<=constsetlo) then
 
340
                   constsetlo:=tenumdef(def).min;
 
341
                 { for constant set elements, delphi allows the usage of elements of enumerations which
 
342
                   have value>255 if there is no element with a value > 255 used }
 
343
                 if (maybetruncenumrange) and
 
344
                    (m_delphi in current_settings.modeswitches) then
 
345
                   begin
 
346
                    if constsethi>255 then
 
347
                      constsethi:=255;
 
348
                    if constsetlo<0 then
 
349
                      constsetlo:=0;
 
350
                   end;
329
351
              end;
330
352
          end;
331
353
 
352
374
        new(constset);
353
375
        constset^:=[];
354
376
        hdef:=nil;
355
 
        constsetlo:=0;
 
377
        { make sure to set constsetlo correctly for empty sets }
 
378
        if assigned(tarrayconstructornode(p).left) then
 
379
          constsetlo:=high(aint)
 
380
        else
 
381
          constsetlo:=0;
356
382
        constsethi:=0;
357
383
        constp:=csetconstnode.create(nil,hdef);
358
384
        constp.value_set:=constset;
386
412
                end;
387
413
              if codegenerror then
388
414
               break;
 
415
              current_filepos:=p2.fileinfo;
389
416
              case p2.resultdef.typ of
390
417
                 enumdef,
391
418
                 orddef:
392
419
                   begin
 
420
                      { widechars are not yet supported }
 
421
                      if is_widechar(p2.resultdef) then
 
422
                        begin
 
423
                          inserttypeconv(p2,cchartype);
 
424
                          if (p2.nodetype<>ordconstn) then
 
425
                            incompatibletypes(cwidechartype,cchartype);
 
426
                        end;
 
427
 
393
428
                      getrange(p2.resultdef,lr,hr);
394
429
                      if assigned(p3) then
395
430
                       begin
 
431
                         if is_widechar(p3.resultdef) then
 
432
                           begin
 
433
                             inserttypeconv(p3,cchartype);
 
434
                             if (p3.nodetype<>ordconstn) then
 
435
                               begin
 
436
                                 current_filepos:=p3.fileinfo;
 
437
                                 incompatibletypes(cwidechartype,cchartype);
 
438
                               end;
 
439
                           end;
396
440
                         { this isn't good, you'll get problems with
397
441
                           type t010 = 0..10;
398
442
                                ts = set of t010;
405
449
                         }
406
450
                         if assigned(hdef) and not(equal_defs(hdef,p3.resultdef)) then
407
451
                           begin
408
 
                              current_filepos:=p3.fileinfo;
409
 
                              CGMessage(type_e_typeconflict_in_set);
 
452
                              CGMessagePos(p3.fileinfo,type_e_typeconflict_in_set);
410
453
                           end
411
454
                         else
412
455
                           begin
427
470
                              end
428
471
                             else
429
472
                              begin
430
 
                                update_constsethi(p2.resultdef);
 
473
                                update_constsethi(p2.resultdef,false);
431
474
                                inserttypeconv(p2,hdef);
432
475
 
433
 
                                update_constsethi(p3.resultdef);
 
476
                                update_constsethi(p3.resultdef,false);
434
477
                                inserttypeconv(p3,hdef);
435
478
 
436
479
                                if assigned(hdef) then
447
490
                         if p2.nodetype=ordconstn then
448
491
                          begin
449
492
                            if not(is_integer(p2.resultdef)) then
450
 
                              begin
451
 
                                { for constant set elements, delphi allows the usage of elements of enumerations which
452
 
                                  have value>255 if there is no element with a value > 255 used }
453
 
                                if (m_delphi in current_settings.modeswitches) and (p2.resultdef.typ=enumdef) then
454
 
                                  begin
455
 
                                    if tordconstnode(p2).value>constsethi then
456
 
                                      constsethi:=tordconstnode(p2).value;
457
 
                                    if hdef=nil then
458
 
                                      hdef:=p2.resultdef;
459
 
                                  end
460
 
                                else
461
 
                                  update_constsethi(p2.resultdef);
462
 
                              end;
 
493
                              update_constsethi(p2.resultdef,true);
463
494
 
464
495
                            if assigned(hdef) then
465
496
                              inserttypeconv(p2,hdef)
471
502
                          end
472
503
                         else
473
504
                          begin
474
 
                            update_constsethi(p2.resultdef);
 
505
                            update_constsethi(p2.resultdef,false);
475
506
 
476
507
                            if assigned(hdef) then
477
508
                              inserttypeconv(p2,hdef)
519
550
           p.free;
520
551
         end;
521
552
        { set the initial set type }
522
 
        constp.resultdef:=tsetdef.create(hdef,constsethi);
 
553
        constp.resultdef:=tsetdef.create(hdef,constsetlo,constsethi);
523
554
        { determine the resultdef for the tree }
524
555
        typecheckpass(buildp);
525
556
        { set the new tree }
568
599
                  if is_constrealnode(p) and
569
600
                     not(nf_explicit in p.flags) then
570
601
                    MessagePos(p.fileinfo,type_w_double_c_varargs);
571
 
                  if (tfloatdef(p.resultdef).floattype in [{$ifndef x86_64}s32real,{$endif}s64currency]) or
572
 
                    { win64 requires the double type cast for singles as well }
573
 
                     ((tfloatdef(p.resultdef).floattype=s32real) and (target_info.system=system_x86_64_win64)) or
 
602
                  if (tfloatdef(p.resultdef).floattype in [s32real,s64currency]) or
574
603
                     (is_constrealnode(p) and
575
604
                      not(nf_explicit in p.flags)) then
576
605
                    p:=ctypeconvnode.create(p,s64floattype);
612
641
         if def=nil then
613
642
          internalerror(200103281);
614
643
         fileinfo:=node.fileinfo;
 
644
         {An attempt to convert the result of a floating point division
 
645
          (with the / operator) to an integer type will fail. Give a hint
 
646
          to use the div operator.}
 
647
         if (node.nodetype=slashn) and (def.typ=orddef) then
 
648
           cgmessage(type_h_use_div_for_int);
 
649
         {In expressions like int64:=longint+longint, an integer overflow could be avoided
 
650
          by simply converting the operands to int64 first. Give a hint to do this.}
 
651
         if (node.nodetype in [addn,subn,muln]) and
 
652
            (def.typ=orddef) and (node.resultdef<>nil) and (node.resultdef.typ=orddef) and
 
653
            ((Torddef(node.resultdef).low>=Torddef(def).low) and (Torddef(node.resultdef).high<=Torddef(def).high)) and
 
654
            ((Torddef(node.resultdef).low>Torddef(def).low) or (Torddef(node.resultdef).high<Torddef(def).high)) then
 
655
           case node.nodetype of
 
656
             addn:
 
657
               cgmessage1(type_h_convert_add_operands_to_prevent_overflow,def.gettypename);
 
658
             subn:
 
659
               cgmessage1(type_h_convert_sub_operands_to_prevent_overflow,def.gettypename);
 
660
             muln:
 
661
               cgmessage1(type_h_convert_mul_operands_to_prevent_overflow,def.gettypename);
 
662
           end;
615
663
      end;
616
664
 
617
665
 
767
815
    function ttypeconvnode.typecheck_chararray_to_string : tnode;
768
816
      var
769
817
        chartype : string[8];
 
818
        newblock : tblocknode;
 
819
        newstat  : tstatementnode;
 
820
        restemp  : ttempcreatenode;
770
821
      begin
771
822
        if is_widechar(tarraydef(left.resultdef).elementdef) then
772
823
          chartype:='widechar'
773
824
        else
774
825
          chartype:='char';
775
 
        result := ccallnode.createinternres(
776
 
           'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
777
 
           ccallparanode.create(cordconstnode.create(
778
 
             ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
779
 
           ccallparanode.create(left,nil)),resultdef);
780
 
        left := nil;
 
826
        if tstringdef(resultdef).stringtype=st_shortstring then
 
827
          begin
 
828
            newblock:=internalstatements(newstat);
 
829
            restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
 
830
            addstatement(newstat,restemp);
 
831
            addstatement(newstat,ccallnode.createintern('fpc_'+chartype+'array_to_shortstr',
 
832
              ccallparanode.create(cordconstnode.create(
 
833
                ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
 
834
              ccallparanode.create(left,ccallparanode.create(
 
835
              ctemprefnode.create(restemp),nil)))));
 
836
            addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
 
837
            addstatement(newstat,ctemprefnode.create(restemp));
 
838
            result:=newblock;
 
839
          end
 
840
        else
 
841
          result:=ccallnode.createinternres(
 
842
            'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
 
843
            ccallparanode.create(cordconstnode.create(
 
844
               ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
 
845
             ccallparanode.create(left,nil)),resultdef);
 
846
        left:=nil;
781
847
      end;
782
848
 
783
849
 
845
911
 
846
912
 
847
913
    function ttypeconvnode.typecheck_string_to_string : tnode;
848
 
 
849
914
      var
850
915
        procname: string[31];
851
 
        stringpara : tcallparanode;
852
 
 
 
916
        newblock : tblocknode;
 
917
        newstat  : tstatementnode;
 
918
        restemp  : ttempcreatenode;
853
919
      begin
854
920
         result:=nil;
855
 
         if left.nodetype=stringconstn then
856
 
          begin
 
921
         if (left.nodetype=stringconstn) and
 
922
            ((not is_widechararray(left.resultdef) and
 
923
              not is_widestring(left.resultdef)) or
 
924
             (tstringdef(resultdef).stringtype=st_widestring) or
 
925
             { non-ascii chars would be replaced with '?' -> loses info }
 
926
             not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str))) then
 
927
           begin
857
928
             tstringconstnode(left).changestringtype(resultdef);
858
929
             result:=left;
859
930
             left:=nil;
860
 
          end
 
931
           end
861
932
         else
862
933
           begin
863
934
             { get the correct procedure name }
864
935
             procname := 'fpc_'+tstringdef(left.resultdef).stringtypname+
865
936
                         '_to_'+tstringdef(resultdef).stringtypname;
866
937
 
867
 
             { create parameter (and remove left node from typeconvnode }
868
 
             { since it's reused as parameter)                          }
869
 
             stringpara := ccallparanode.create(left,nil);
870
 
             left := nil;
871
 
 
872
 
             { when converting to shortstrings, we have to pass high(destination) too }
873
 
             if (tstringdef(resultdef).stringtype = st_shortstring) then
874
 
               stringpara.right := ccallparanode.create(cinlinenode.create(
875
 
                 in_high_x,false,self.getcopy),nil);
876
 
 
877
 
             { and create the callnode }
878
 
             result := ccallnode.createinternres(procname,stringpara,resultdef);
 
938
             if tstringdef(resultdef).stringtype=st_shortstring then
 
939
               begin
 
940
                 newblock:=internalstatements(newstat);
 
941
                 restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
 
942
                 addstatement(newstat,restemp);
 
943
                 addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create(
 
944
                   ctemprefnode.create(restemp),nil))));
 
945
                 addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
 
946
                 addstatement(newstat,ctemprefnode.create(restemp));
 
947
                 result:=newblock;
 
948
               end
 
949
             else
 
950
               result := ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);
 
951
             left:=nil;
879
952
           end;
880
953
      end;
881
954
 
887
960
         para : tcallparanode;
888
961
         hp : tstringconstnode;
889
962
         ws : pcompilerwidestring;
 
963
         newblock : tblocknode;
 
964
         newstat  : tstatementnode;
 
965
         restemp  : ttempcreatenode;
890
966
 
891
967
      begin
892
968
         result:=nil;
893
 
         if left.nodetype=ordconstn then
 
969
         { we can't do widechar to ansichar conversions at compile time, since }
 
970
         { this maps all non-ascii chars to '?' -> loses information           }
 
971
         if (left.nodetype=ordconstn) and
 
972
            ((tstringdef(resultdef).stringtype=st_widestring) or
 
973
             (torddef(left.resultdef).ordtype=uchar) or
 
974
             { >=128 is destroyed }
 
975
             (tordconstnode(left).value<128)) then
894
976
           begin
895
977
              if tstringdef(resultdef).stringtype=st_widestring then
896
978
               begin
904
986
               end
905
987
              else
906
988
                begin
907
 
                  hp:=cstringconstnode.createstr(chr(tordconstnode(left).value));
 
989
                  if torddef(left.resultdef).ordtype=uwidechar then
 
990
                    hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value)))
 
991
                  else
 
992
                    hp:=cstringconstnode.createstr(chr(tordconstnode(left).value));
908
993
                  tstringconstnode(hp).changestringtype(resultdef);
909
994
                end;
910
995
              result:=hp;
911
996
           end
912
997
         else
913
 
           { shortstrings are handled 'inline' }
914
 
           if tstringdef(resultdef).stringtype <> st_shortstring then
 
998
           { shortstrings are handled 'inline' (except for widechars) }
 
999
           if (tstringdef(resultdef).stringtype <> st_shortstring) or
 
1000
              (torddef(left.resultdef).ordtype = uwidechar) then
915
1001
             begin
916
 
               { create the parameter }
917
 
               para := ccallparanode.create(left,nil);
 
1002
               if (tstringdef(resultdef).stringtype <> st_shortstring) then
 
1003
                 begin
 
1004
                   { create the procname }
 
1005
                   if torddef(left.resultdef).ordtype<>uwidechar then
 
1006
                     procname := 'fpc_char_to_'
 
1007
                   else
 
1008
                     procname := 'fpc_wchar_to_';
 
1009
                   procname:=procname+tstringdef(resultdef).stringtypname;
 
1010
 
 
1011
                   { and the parameter }
 
1012
                   para := ccallparanode.create(left,nil);
 
1013
 
 
1014
                   { and finally the call }
 
1015
                   result := ccallnode.createinternres(procname,para,resultdef);
 
1016
                 end
 
1017
               else
 
1018
                 begin
 
1019
                   newblock:=internalstatements(newstat);
 
1020
                   restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
 
1021
                   addstatement(newstat,restemp);
 
1022
                   addstatement(newstat,ccallnode.createintern('fpc_wchar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
 
1023
                     ctemprefnode.create(restemp),nil))));
 
1024
                   addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
 
1025
                   addstatement(newstat,ctemprefnode.create(restemp));
 
1026
                   result:=newblock;
 
1027
                 end;
918
1028
               left := nil;
919
 
 
920
 
               { and the procname }
921
 
               procname := 'fpc_char_to_' +tstringdef(resultdef).stringtypname;
922
 
 
923
 
               { and finally the call }
924
 
               result := ccallnode.createinternres(procname,para,resultdef);
925
1029
             end
926
1030
           else
927
1031
             begin
964
1068
 
965
1069
      begin
966
1070
         result:=nil;
967
 
         if left.nodetype=ordconstn then
 
1071
         if (left.nodetype=ordconstn) and
 
1072
            ((torddef(resultdef).ordtype<>uchar) or
 
1073
             (torddef(left.resultdef).ordtype<>uwidechar) or
 
1074
             { >= 128 is replaced by '?' currently -> loses information }
 
1075
             (tordconstnode(left).value<128)) then
968
1076
           begin
969
1077
             if (torddef(resultdef).ordtype=uchar) and
970
1078
                (torddef(left.resultdef).ordtype=uwidechar) then
1138
1246
         else
1139
1247
           if is_pchar(resultdef) and
1140
1248
              is_widestring(left.resultdef) then
1141
 
             inserttypeconv(left,cansistringtype);
 
1249
             begin
 
1250
               inserttypeconv(left,cansistringtype);
 
1251
               { the second pass of second_cstring_to_pchar expects a  }
 
1252
               { strinconstn, but this may become a call to the        }
 
1253
               { widestring manager in case left contains "high ascii" }
 
1254
               if (left.nodetype<>stringconstn) then
 
1255
                 begin
 
1256
                   result:=left;
 
1257
                   left:=nil;
 
1258
                 end;
 
1259
             end;
1142
1260
      end;
1143
1261
 
1144
1262
 
1192
1310
 
1193
1311
 
1194
1312
    function ttypeconvnode.typecheck_pchar_to_string : tnode;
 
1313
      var
 
1314
        newblock : tblocknode;
 
1315
        newstat  : tstatementnode;
 
1316
        restemp  : ttempcreatenode;
1195
1317
      begin
1196
 
        result := ccallnode.createinternres(
1197
 
          'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
1198
 
          ccallparanode.create(left,nil),resultdef);
1199
 
        left := nil;
 
1318
        if tstringdef(resultdef).stringtype=st_shortstring then
 
1319
          begin
 
1320
            newblock:=internalstatements(newstat);
 
1321
            restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
 
1322
            addstatement(newstat,restemp);
 
1323
            addstatement(newstat,ccallnode.createintern('fpc_pchar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
 
1324
              ctemprefnode.create(restemp),nil))));
 
1325
            addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
 
1326
            addstatement(newstat,ctemprefnode.create(restemp));
 
1327
            result:=newblock;
 
1328
          end
 
1329
        else
 
1330
          result := ccallnode.createinternres(
 
1331
            'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
 
1332
            ccallparanode.create(left,nil),resultdef);
 
1333
        left:=nil;
1200
1334
      end;
1201
1335
 
1202
1336
 
1203
1337
    function ttypeconvnode.typecheck_interface_to_guid : tnode;
1204
1338
      begin
1205
1339
        if assigned(tobjectdef(left.resultdef).iidguid) then
1206
 
          result:=cguidconstnode.create(tobjectdef(left.resultdef).iidguid^);
 
1340
          begin
 
1341
            if not(oo_has_valid_guid in tobjectdef(left.resultdef).objectoptions) then
 
1342
              CGMessage1(type_interface_has_no_guid,tobjectdef(left.resultdef).typename);
 
1343
            result:=cguidconstnode.create(tobjectdef(left.resultdef).iidguid^);
 
1344
          end;
1207
1345
      end;
1208
1346
 
1209
1347
 
1222
1360
 
1223
1361
 
1224
1362
    function ttypeconvnode.typecheck_pwchar_to_string : tnode;
 
1363
      var
 
1364
        newblock : tblocknode;
 
1365
        newstat  : tstatementnode;
 
1366
        restemp  : ttempcreatenode;
1225
1367
      begin
1226
 
        result := ccallnode.createinternres(
1227
 
          'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
1228
 
          ccallparanode.create(left,nil),resultdef);
1229
 
        left := nil;
 
1368
        if tstringdef(resultdef).stringtype=st_shortstring then
 
1369
          begin
 
1370
            newblock:=internalstatements(newstat);
 
1371
            restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
 
1372
            addstatement(newstat,restemp);
 
1373
            addstatement(newstat,ccallnode.createintern('fpc_pwidechar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
 
1374
              ctemprefnode.create(restemp),nil))));
 
1375
            addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
 
1376
            addstatement(newstat,ctemprefnode.create(restemp));
 
1377
            result:=newblock;
 
1378
          end
 
1379
        else
 
1380
          result := ccallnode.createinternres(
 
1381
            'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
 
1382
            ccallparanode.create(left,nil),resultdef);
 
1383
        left:=nil;
1230
1384
      end;
1231
1385
 
1232
1386
 
1505
1659
            convtype:=tc_equal;
1506
1660
            if not(tstoreddef(resultdef).is_intregable) and
1507
1661
               not(tstoreddef(resultdef).is_fpuregable) then
1508
 
              make_not_regable(left,vr_addr);
 
1662
              make_not_regable(left,[ra_addr_regable]);
1509
1663
            exit;
1510
1664
          end;
1511
1665
 
1557
1711
 
1558
1712
              te_convert_l1,
1559
1713
              te_convert_l2,
1560
 
              te_convert_l3 :
 
1714
              te_convert_l3,
 
1715
              te_convert_l4,
 
1716
              te_convert_l5:
1561
1717
                begin
1562
1718
                  result := simplify;
1563
1719
                  if assigned(result) then
1658
1814
                         not(tstoreddef(resultdef).is_fpuregable)) or
1659
1815
                        ((left.resultdef.typ = floatdef) and
1660
1816
                         (resultdef.typ <> floatdef))  then
1661
 
                       make_not_regable(left,vr_addr);
 
1817
                       make_not_regable(left,[ra_addr_regable]);
1662
1818
 
1663
1819
                     { class/interface to class/interface, with checkobject support }
1664
1820
                     if is_class_or_interface(resultdef) and
1720
1876
 
1721
1877
                      else
1722
1878
                       begin
1723
 
                         { only if the same size or formal def }
 
1879
                         { only if the same size or formal def, and }
 
1880
                         { don't allow type casting of constants to }
 
1881
                         { structured types                         }
1724
1882
                         if not(
1725
1883
                                (left.resultdef.typ=formaldef) or
1726
1884
                                (
1727
1885
                                 not(is_open_array(left.resultdef)) and
1728
1886
                                 not(is_array_constructor(left.resultdef)) and
1729
 
                                 (left.resultdef.size=resultdef.size)
 
1887
                                 (left.resultdef.size=resultdef.size) and
 
1888
                                 { disallow casts of const nodes }
 
1889
                                 (not is_constnode(left) or
 
1890
                                   { however, there are some exceptions }
 
1891
                                   (not(resultdef.typ in [arraydef,recorddef,setdef,stringdef,
 
1892
                                                          filedef,variantdef,objectdef]) or
 
1893
                                   is_class_or_interface(resultdef) or
 
1894
                                   { the softfloat code generates casts <const. float> to record }
 
1895
                                   (nf_internal in flags)
 
1896
                                 ))
1730
1897
                                ) or
1731
1898
                                (
1732
1899
                                 is_void(left.resultdef)  and
1755
1922
            ((resultdef.typ=orddef) and
1756
1923
             (left.resultdef.typ in [pointerdef,procvardef,classrefdef]))) then
1757
1924
          begin
 
1925
            {Converting pointers to signed integers is a bad idea. Warn.}
 
1926
            warn_pointer_to_signed:=(resultdef.typ=orddef) and (Torddef(resultdef).ordtype in [s8bit,s16bit,s32bit,s64bit]);
1758
1927
            { Give a warning when sizes don't match, because then info will be lost }
1759
1928
            if left.resultdef.size=resultdef.size then
1760
1929
              CGMessage(type_h_pointer_to_longint_conv_not_portable)
2225
2394
 
2226
2395
 
2227
2396
    function ttypeconvnode.first_char_to_char : tnode;
2228
 
 
 
2397
      var
 
2398
        fname: string[18];
2229
2399
      begin
2230
 
         first_char_to_char:=first_int_to_int;
 
2400
        if (torddef(resultdef).ordtype=uchar) and
 
2401
           (torddef(left.resultdef).ordtype=uwidechar) then
 
2402
          fname := 'fpc_wchar_to_char'
 
2403
        else if (torddef(resultdef).ordtype=uwidechar) and
 
2404
           (torddef(left.resultdef).ordtype=uchar) then
 
2405
          fname := 'fpc_char_to_wchar'
 
2406
        else
 
2407
          internalerror(2007081201);
 
2408
 
 
2409
        result := ccallnode.createintern(fname,ccallparanode.create(left,nil));
 
2410
        left:=nil;
 
2411
        firstpass(result);
2231
2412
      end;
2232
2413
 
2233
2414
 
2265
2446
 
2266
2447
    function ttypeconvnode.first_set_to_set : tnode;
2267
2448
      var
2268
 
        srsym: ttypesym;
2269
2449
        newstatement : tstatementnode;
2270
 
        temp    : ttempcreatenode;
 
2450
        temp         : ttempcreatenode;
2271
2451
      begin
2272
2452
        { in theory, we should do range checking here,
2273
2453
          but Delphi doesn't do it either (FK) }
2280
2460
        { equal sets for the code generator? }
2281
2461
        else if (left.resultdef.size=resultdef.size) and
2282
2462
          (tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) then
 
2463
          {$warning This causes wrong (but Delphi-compatible) results for disjoint subsets}
 
2464
          { e.g., this prints true because of this:
 
2465
              var
 
2466
                sa: set of 1..2;
 
2467
                sb: set of 5..6;
 
2468
                b: byte;
 
2469
              begin
 
2470
                b:=1;
 
2471
                sa:=[1..2];
 
2472
                sb:=sa;
 
2473
                writeln(b in sb);
 
2474
              end.
 
2475
          }
2283
2476
          result:=left
2284
2477
        else
2285
2478
        // if is_varset(resultdef) then
2286
2479
          begin
2287
2480
            result:=internalstatements(newstatement);
2288
2481
 
 
2482
            { in case left is a smallset expression, it can be an addn or so. }
 
2483
            { fpc_varset_load expects a formal const parameter, which doesn't }
 
2484
            { accept set addn's -> assign to a temp first and pass the temp   }
 
2485
            if not(left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
 
2486
              begin
 
2487
                temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,false);
 
2488
                addstatement(newstatement,temp);
 
2489
                { temp := left }
 
2490
                addstatement(newstatement,cassignmentnode.create(
 
2491
                  ctemprefnode.create(temp),left));
 
2492
                addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
 
2493
                addstatement(newstatement,ctemprefnode.create(temp));
 
2494
                left:=result;
 
2495
                firstpass(left);
 
2496
                { recreate the result's internalstatements list }
 
2497
                result:=internalstatements(newstatement);
 
2498
              end;
 
2499
 
2289
2500
            { create temp for result }
2290
2501
            temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
2291
 
                          addstatement(newstatement,temp);
 
2502
            addstatement(newstatement,temp);
2292
2503
 
2293
2504
            addstatement(newstatement,ccallnode.createintern('fpc_varset_load',
 
2505
              ccallparanode.create(cordconstnode.create(tsetdef(left.resultdef).setbase div 8 - tsetdef(resultdef).setbase div 8,sinttype,false),
2294
2506
              ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
2295
2507
              ccallparanode.create(ctemprefnode.create(temp),
2296
2508
              ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
2297
 
              ccallparanode.create(left,nil)))))
 
2509
              ccallparanode.create(left,nil))))))
2298
2510
            );
2299
2511
            addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
2300
2512
            addstatement(newstatement,ctemprefnode.create(temp));
2512
2724
 
2513
2725
    function ttypeconvnode.pass_1 : tnode;
2514
2726
      begin
 
2727
        if warn_pointer_to_signed then
 
2728
          cgmessage(type_w_pointer_to_signed);
2515
2729
        result:=nil;
2516
2730
        firstpass(left);
2517
2731
        if codegenerror then
2553
2767
        { When using only a part of the value it can't be in a register since
2554
2768
          that will load the value in a new register first }
2555
2769
        if (resultdef.size<left.resultdef.size) then
2556
 
          make_not_regable(left,vr_addr);
 
2770
          make_not_regable(left,[ra_addr_regable]);
2557
2771
      end;
2558
2772
 
2559
2773
 
2925
3139
             begin
2926
3140
               if assigned(tobjectdef(right.resultdef).iidguid) then
2927
3141
                 begin
 
3142
                   if not(oo_has_valid_guid in tobjectdef(right.resultdef).objectoptions) then
 
3143
                     CGMessage1(type_interface_has_no_guid,tobjectdef(right.resultdef).typename);
2928
3144
                   hp:=cguidconstnode.create(tobjectdef(right.resultdef).iidguid^);
2929
3145
                   right.free;
2930
3146
                   right:=hp;