- removed automatic int-string, string-int and int-array conversion for

    macpas after discussion on macpascal mailing list. The only thing left
    is automatic conversion of constant strings of length 4 to 32 bit ints.
  * adapted tests to this
  * fixed FOUR_CHAR_CODE and FCC functions in MacPas unit for little
    endian
  + FourCharArray type in macpas unit wich can be used to typecast
    int's "back" to an array[1..4] of char (though the characters
    will be in reverse on little endian systems in that case)

git-svn-id: trunk@5154 -

compiler/defcmp.pas

@@ -57,7 +57,6 @@ interface
           tc_pointer_2_array,
           tc_int_2_int,
           tc_int_2_bool,
-          tc_int_2_string,
           tc_bool_2_bool,
           tc_bool_2_int,
           tc_real_2_real,
@@ -370,13 +369,6 @@ implementation
                         doconv:=tc_char_2_string;
                         eq:=te_convert_l1;
                       end;
-                     if (m_mac in current_settings.modeswitches) and
-                        is_integer(def_from) and
-                        (def_from.size = 4) then
-                       begin
-                         doconv:=tc_int_2_string;
-                         eq:=te_convert_l3
-                       end;
                    end;
                  arraydef :
                    begin

compiler/ncnv.pas

@@ -63,7 +63,6 @@ interface
           function typecheck_char_to_string : tnode;
           function typecheck_char_to_chararray : tnode;
           function typecheck_int_to_real : tnode;
-          function typecheck_int_to_string : tnode;
           function typecheck_real_to_real : tnode;
           function typecheck_real_to_currency : tnode;
           function typecheck_cchar_to_pchar : tnode;
@@ -206,7 +205,6 @@ interface
     procedure inserttypeconv_internal(var p:tnode;def:tdef);
     procedure arrayconstructor_to_set(var p : tnode);
     procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
-    procedure int_to_4cc(var p: tnode);
 
 
 implementation
@@ -593,74 +591,6 @@ implementation
         typecheckpass(p);
       end;
 
-
-    procedure int_to_4cc(var p: tnode);
-      var
-        srsym: tsym;
-        srsymtable: tsymtable;
-        inttemp, chararrtemp: ttempcreatenode;
-        newblock: tblocknode;
-        newstatement: tstatementnode;
-      begin
-         if (m_mac in current_settings.modeswitches) and
-            is_integer(p.resultdef) and
-            (p.resultdef.size = 4) then
-           begin
-             if not searchsym_type('FPC_INTERNAL_FOUR_CHAR_ARRAY',srsym,srsymtable) then
-               internalerror(2006101802);
-             if (target_info.endian = endian_big) then
-               inserttypeconv_internal(p,ttypesym(srsym).typedef)
-             else
-               begin
-                 newblock := internalstatements(newstatement);
-                 inttemp := ctempcreatenode.create(p.resultdef,4,tt_persistent,true);
-                 chararrtemp := ctempcreatenode.create(ttypesym(srsym).typedef,4,tt_persistent,true);
-                 addstatement(newstatement,inttemp);
-                 addstatement(newstatement,cassignmentnode.create(
-                   ctemprefnode.create(inttemp),p));
-                 addstatement(newstatement,chararrtemp);
-
-                 addstatement(newstatement,cassignmentnode.create(
-                   cvecnode.create(ctemprefnode.create(chararrtemp),
-                     cordconstnode.create(1,u32inttype,false)),
-                   ctypeconvnode.create_explicit(
-                     cshlshrnode.create(shrn,ctemprefnode.create(inttemp),
-                       cordconstnode.create(24,s32inttype,false)),
-                     cchartype)));
-
-                 addstatement(newstatement,cassignmentnode.create(
-                   cvecnode.create(ctemprefnode.create(chararrtemp),
-                     cordconstnode.create(2,u32inttype,false)),
-                   ctypeconvnode.create_explicit(
-                     cshlshrnode.create(shrn,ctemprefnode.create(inttemp),
-                       cordconstnode.create(16,s32inttype,false)),
-                     cchartype)));
-
-                 addstatement(newstatement,cassignmentnode.create(
-                   cvecnode.create(ctemprefnode.create(chararrtemp),
-                     cordconstnode.create(3,u32inttype,false)),
-                   ctypeconvnode.create_explicit(
-                     cshlshrnode.create(shrn,ctemprefnode.create(inttemp),
-                       cordconstnode.create(8,s32inttype,false)),
-                     cchartype)));
-
-                 addstatement(newstatement,cassignmentnode.create(
-                   cvecnode.create(ctemprefnode.create(chararrtemp),
-                     cordconstnode.create(4,u32inttype,false)),
-                   ctypeconvnode.create_explicit(
-                     ctemprefnode.create(inttemp),cchartype)));
-
-                 addstatement(newstatement,ctempdeletenode.create(inttemp));
-                 addstatement(newstatement,ctempdeletenode.create_normal_temp(chararrtemp));
-                 addstatement(newstatement,ctemprefnode.create(chararrtemp));
-                 p := newblock;
-                 typecheckpass(p);
-               end;
-           end
-         else
-           internalerror(2006101803);
-      end;
-
 {*****************************************************************************
                            TTYPECONVNODE
 *****************************************************************************}
@@ -764,7 +694,6 @@ implementation
           'tc_pointer_2_array',
           'tc_int_2_int',
           'tc_int_2_bool',
-          'tc_int_2_string',
           'tc_bool_2_bool',
           'tc_bool_2_int',
           'tc_real_2_real',
@@ -1136,21 +1065,6 @@ implementation
       end;
 
 
-    function ttypeconvnode.typecheck_int_to_string : tnode;
-       begin
-         if (m_mac in current_settings.modeswitches) and
-            is_integer(left.resultdef) and
-            (left.resultdef.size = 4) then
-           begin
-             int_to_4cc(left);
-             inserttypeconv(left,resultdef);
-             result := left;
-             left := nil;
-           end
-         else
-           internalerror(2006101803);
-       end;
-
     function ttypeconvnode.typecheck_real_to_real : tnode;
       begin
          result:=nil;
@@ -1476,7 +1390,6 @@ implementation
           { pointer_2_array } nil,
           { int_2_int } @ttypeconvnode.typecheck_int_to_int,
           { int_2_bool } nil,
-          { int_2_string } @ttypeconvnode.typecheck_int_to_string,
           { bool_2_bool } nil,
           { bool_2_int } nil,
           { real_2_real } @ttypeconvnode.typecheck_real_to_real,
@@ -2428,7 +2341,6 @@ implementation
            @ttypeconvnode._first_pointer_to_array,
            @ttypeconvnode._first_int_to_int,
            @ttypeconvnode._first_int_to_bool,
-           nil, { removed in typecheck_int_to_string }
            @ttypeconvnode._first_bool_to_bool,
            @ttypeconvnode._first_bool_to_int,
            @ttypeconvnode._first_real_to_real,
@@ -2673,7 +2585,6 @@ implementation
            @ttypeconvnode._second_pointer_to_array,
            @ttypeconvnode._second_int_to_int,
            @ttypeconvnode._second_int_to_bool,
-           @ttypeconvnode._second_nothing, { int_to_string, handled in resultdef pass }
            @ttypeconvnode._second_bool_to_bool,
            @ttypeconvnode._second_bool_to_int,
            @ttypeconvnode._second_real_to_real,

compiler/pexpr.pas

@@ -1783,7 +1783,6 @@ implementation
           srsym  : tsym;
           srsymtable : tsymtable;
           classh     : tobjectdef;
-          ok: boolean;
 
         label
           skipreckklammercheck;
@@ -1853,7 +1852,6 @@ implementation
                       begin
                         consume(_LECKKLAMMER);
                         repeat
-                          ok := true;
                           case p1.resultdef.deftype of
                             pointerdef:
                               begin
@@ -1881,76 +1879,57 @@ implementation
                                   p2:=crangenode.create(p2,comp_expr(true));
                                 p1:=cvecnode.create(p1,p2);
                               end;
-                            arraydef,
-                            orddef :
+                            arraydef:
                               begin
-                                { in MacPas mode, you can treat a 32bit int as }
-                                { an array[1..4] of char. The                  }
-                                { FPC_Internal_Four_Char_Array is defined in   }
-                                { the macpas unit                              }
-                                if (p1.resultdef.deftype = orddef) then
+                                p2:=comp_expr(true);
+                                { support SEG:OFS for go32v2 Mem[] }
+                                if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
+                                   (p1.nodetype=loadn) and
+                                   assigned(tloadnode(p1).symtableentry) and
+                                   assigned(tloadnode(p1).symtableentry.owner.name) and
+                                   (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
+                                   ((tloadnode(p1).symtableentry.name='MEM') or
+                                    (tloadnode(p1).symtableentry.name='MEMW') or
+                                    (tloadnode(p1).symtableentry.name='MEML')) then
                                   begin
-                                    if (m_mac in current_settings.modeswitches) and
-                                       is_integer(p1.resultdef) and
-                                       (p1.resultdef.size = 4) then
-                                      int_to_4cc(p1)
+                                    if try_to_consume(_COLON) then
+                                     begin
+                                       p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
+                                       p2:=comp_expr(true);
+                                       p2:=caddnode.create(addn,p2,p3);
+                                       if try_to_consume(_POINTPOINT) then
+                                         { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
+                                         p2:=crangenode.create(p2,caddnode.create(addn,comp_expr(true),p3.getcopy));
+                                       p1:=cvecnode.create(p1,p2);
+                                       include(tvecnode(p1).flags,nf_memseg);
+                                       include(tvecnode(p1).flags,nf_memindex);
+                                     end
                                     else
-                                      ok := false;
-                                  end;
-                                if ok then
+                                     begin
+                                       if try_to_consume(_POINTPOINT) then
+                                         { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
+                                         p2:=crangenode.create(p2,comp_expr(true));
+                                       p1:=cvecnode.create(p1,p2);
+                                       include(tvecnode(p1).flags,nf_memindex);
+                                     end;
+                                  end
+                                else
                                   begin
-                                    p2:=comp_expr(true);
-                                    { support SEG:OFS for go32v2 Mem[] }
-                                    if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
-                                       (p1.nodetype=loadn) and
-                                       assigned(tloadnode(p1).symtableentry) and
-                                       assigned(tloadnode(p1).symtableentry.owner.name) and
-                                       (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
-                                       ((tloadnode(p1).symtableentry.name='MEM') or
-                                        (tloadnode(p1).symtableentry.name='MEMW') or
-                                        (tloadnode(p1).symtableentry.name='MEML')) then
-                                      begin
-                                        if try_to_consume(_COLON) then
-                                         begin
-                                           p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
-                                           p2:=comp_expr(true);
-                                           p2:=caddnode.create(addn,p2,p3);
-                                           if try_to_consume(_POINTPOINT) then
-                                             { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
-                                             p2:=crangenode.create(p2,caddnode.create(addn,comp_expr(true),p3.getcopy));
-                                           p1:=cvecnode.create(p1,p2);
-                                           include(tvecnode(p1).flags,nf_memseg);
-                                           include(tvecnode(p1).flags,nf_memindex);
-                                         end
-                                        else
-                                         begin
-                                           if try_to_consume(_POINTPOINT) then
-                                             { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
-                                             p2:=crangenode.create(p2,comp_expr(true));
-                                           p1:=cvecnode.create(p1,p2);
-                                           include(tvecnode(p1).flags,nf_memindex);
-                                         end;
-                                      end
-                                    else
-                                      begin
-                                        if try_to_consume(_POINTPOINT) then
-                                          { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
-                                          p2:=crangenode.create(p2,comp_expr(true));
-                                        p1:=cvecnode.create(p1,p2);
-                                      end;
+                                    if try_to_consume(_POINTPOINT) then
+                                      { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
+                                      p2:=crangenode.create(p2,comp_expr(true));
+                                    p1:=cvecnode.create(p1,p2);
                                   end;
                               end;
                             else
-                              ok := false;
+                              begin
+                                Message(parser_e_invalid_qualifier);
+                                p1.destroy;
+                                p1:=cerrornode.create;
+                                comp_expr(true);
+                                again:=false;
+                              end;
                           end;
-                          if not ok then
-                            begin
-                              Message(parser_e_invalid_qualifier);
-                              p1.destroy;
-                              p1:=cerrornode.create;
-                              comp_expr(true);
-                              again:=false;
-                            end;
                           do_typecheckpass(p1);
                         until not try_to_consume(_COMMA);
                         consume(_RECKKLAMMER);

rtl/inc/macpas.pp

@@ -26,7 +26,7 @@ interface
 
 type
   LongDouble = ValReal;
-  FPC_Internal_Four_Char_Array = array[1..4] of Char;
+  FourCharArray = packed array[1..4] of char;
 
 {FourCharCode coercion
 This routine coreces string literals to a FourCharCode.}
@@ -35,10 +35,6 @@ function FCC(const literal: string): LongWord; {$ifdef systeminline}inline;{$end
 {Same as FCC, to be compatible with GPC}
 function FOUR_CHAR_CODE(const literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
 
-{This makes casts from ShortString to FourCharCode automatically,
- to emulate the behaviour of mac pascal compilers}
-operator := (const s: ShortString) res: LongWord; {$ifdef systeminline}inline;{$endif}
-
 { Same as the "is" operator }
 Function Member (Instance : TObject; AClass : TClass) : boolean; {$ifdef systeminline}inline;{$endif}
 
@@ -93,17 +89,20 @@ implementation
 
 function FCC(const literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
 begin
+{$ifdef FPC_LITTLE_ENDIAN}
+  FCC := (ord(literal[1]) shl 24) or (ord(literal[2]) shl 16) or ord(literal[3] shl 8) or ord(literal[4]);
+{$else FPC_LITTLE_ENDIAN}
   FCC := PLongWord(@literal[1])^;
+{$endif FPC_LITTLE_ENDIAN}
 end;
 
 function FOUR_CHAR_CODE(const literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
 begin
+{$ifdef FPC_LITTLE_ENDIAN}
+  FOUR_CHAR_CODE := (ord(literal[1]) shl 24) or (ord(literal[2]) shl 16) or ord(literal[3] shl 8) or ord(literal[4]);
+{$else FPC_LITTLE_ENDIAN}
   FOUR_CHAR_CODE := PLongWord(@literal[1])^;
-end;
-
-operator := (const s: ShortString) res: LongWord; {$ifdef systeminline}inline;{$endif}
-begin
-  res := PLongWord(@s[1])^;
+{$endif FPC_LITTLE_ENDIAN}
 end;
 
 Function Member (Instance : TObject; AClass : TClass) : boolean; {$ifdef systeminline}inline;{$endif}

tests/test/t4cc1.pp

@@ -1,3 +1,4 @@
+{ %fail }
 {$mode macpas}
 
 type

tests/test/tint2str1.pp

@@ -1,11 +1,5 @@
 {$mode macpas}
 
-procedure test(const s: string);
-begin
-  if s <> 'abcd' then
-    halt(1);
-end;
-
 procedure test2(c1,c2,c3,c4: char);
 begin
   if (c1 <> 'a') or (c2 <> 'b') or (c3 <> 'c') or (c4 <> 'd') then
@@ -17,6 +11,5 @@ var
   l: longint;
 begin
   l := 'abcd';
-  test(l);
   test2(char(l shr 24),char(l shr 16),char(l shr 8),char(l));
 end.