Rebase to revision 19694

git-svn-id: branches/svenbarth/misc@19702 -

.gitattributes

@@ -266,8 +266,6 @@ compiler/mips/rmipsdwf.inc svneol=native#text/plain
 compiler/mips/rmipsgas.inc svneol=native#text/plain
 compiler/mips/rmipsgri.inc svneol=native#text/plain
 compiler/mips/rmipsgss.inc svneol=native#text/plain
-compiler/mips/rmipsmot.inc svneol=native#text/plain
-compiler/mips/rmipsmri.inc svneol=native#text/plain
 compiler/mips/rmipsnor.inc svneol=native#text/plain
 compiler/mips/rmipsnum.inc svneol=native#text/plain
 compiler/mips/rmipsrni.inc svneol=native#text/plain
@@ -1982,6 +1980,7 @@ packages/fcl-db/tests/Makefile.fpc -text
 packages/fcl-db/tests/README.txt svneol=native#text/plain
 packages/fcl-db/tests/XMLXSDExportTest.lpi svneol=native#text/plain
 packages/fcl-db/tests/XMLXSDExportTest.lpr svneol=native#text/plain
+packages/fcl-db/tests/bufdatasettoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
 packages/fcl-db/tests/dbfexporttest.lpi svneol=native#text/plain
 packages/fcl-db/tests/dbfexporttest.lpr svneol=native#text/plain
@@ -2774,39 +2773,6 @@ packages/fppkg/src/pkgmkconv.pp svneol=native#text/plain
 packages/fppkg/src/pkgoptions.pp svneol=native#text/plain
 packages/fppkg/src/pkgrepos.pp svneol=native#text/plain
 packages/fppkg/src/pkgwget.pp svneol=native#text/plain
-packages/fpvectorial/Makefile svneol=native#text/plain
-packages/fpvectorial/Makefile.fpc svneol=native#text/plain
-packages/fpvectorial/examples/fpce_mainform.lfm svneol=native#text/plain
-packages/fpvectorial/examples/fpce_mainform.pas svneol=native#text/plain
-packages/fpvectorial/examples/fpcorelexplorer.ico -text
-packages/fpvectorial/examples/fpcorelexplorer.lpi svneol=native#text/plain
-packages/fpvectorial/examples/fpcorelexplorer.lpr svneol=native#text/plain
-packages/fpvectorial/examples/fpvc_mainform.lfm svneol=native#text/plain
-packages/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain
-packages/fpvectorial/examples/fpvectorialconverter.ico -text
-packages/fpvectorial/examples/fpvectorialconverter.lpi svneol=native#text/plain
-packages/fpvectorial/examples/fpvectorialconverter.lpr svneol=native#text/plain
-packages/fpvectorial/examples/fpvmodifytest.lpi svneol=native#text/plain
-packages/fpvectorial/examples/fpvmodifytest.pas svneol=native#text/plain
-packages/fpvectorial/examples/fpvwritetest.lpi svneol=native#text/plain
-packages/fpvectorial/examples/fpvwritetest.pas svneol=native#text/plain
-packages/fpvectorial/fpmake.pp svneol=native#text/plain
-packages/fpvectorial/src/avisocncgcodereader.pas svneol=native#text/pascal
-packages/fpvectorial/src/avisocncgcodewriter.pas svneol=native#text/pascal
-packages/fpvectorial/src/avisozlib.pas svneol=native#text/pascal
-packages/fpvectorial/src/cdrvectorialreader.pas svneol=native#text/pascal
-packages/fpvectorial/src/dxfvectorialreader.pas svneol=native#text/pascal
-packages/fpvectorial/src/epsvectorialreader.pas svneol=native#text/pascal
-packages/fpvectorial/src/fpvectbuildunit.pas svneol=native#text/pascal
-packages/fpvectorial/src/fpvectorial.pas svneol=native#text/pascal
-packages/fpvectorial/src/fpvtocanvas.pas svneol=native#text/pascal
-packages/fpvectorial/src/fpvutils.pas svneol=native#text/pascal
-packages/fpvectorial/src/pdfvectorialreader.pas svneol=native#text/pascal
-packages/fpvectorial/src/pdfvrlexico.pas svneol=native#text/pascal
-packages/fpvectorial/src/pdfvrsemantico.pas svneol=native#text/pascal
-packages/fpvectorial/src/pdfvrsintatico.pas svneol=native#text/pascal
-packages/fpvectorial/src/svgvectorialreader.pas svneol=native#text/pascal
-packages/fpvectorial/src/svgvectorialwriter.pas svneol=native#text/pascal
 packages/fuse/Makefile svneol=native#text/plain
 packages/fuse/Makefile.fpc svneol=native#text/plain
 packages/fuse/fpmake_disabled.pp svneol=native#text/plain
@@ -5623,6 +5589,8 @@ packages/ptc/Makefile.fpc svneol=native#text/plain
 packages/ptc/docs/AUTHORS.txt svneol=native#text/plain
 packages/ptc/docs/CHANGES.txt svneol=native#text/plain
 packages/ptc/docs/INSTALL.txt svneol=native#text/plain
+packages/ptc/docs/INTF-CHANGES-0.99.12.txt svneol=native#text/plain
+packages/ptc/docs/INTF-CHANGES-FAQ-0.99.12.txt svneol=native#text/plain
 packages/ptc/docs/INTRO.txt svneol=native#text/plain
 packages/ptc/docs/README.txt svneol=native#text/plain
 packages/ptc/docs/TODO.txt svneol=native#text/plain
@@ -6765,6 +6733,7 @@ packages/winunits-jedi/src/jwawsrm.pas svneol=native#text/plain
 packages/winunits-jedi/src/jwawsvns.pas svneol=native#text/plain
 packages/winunits-jedi/src/jwawtsapi32.pas svneol=native#text/plain
 packages/winunits-jedi/src/jwazmouse.pas svneol=native#text/plain
+packages/winunits-jedi/tests/tjwapsapi1.pp svneol=native#text/pascal
 packages/x11/Makefile svneol=native#text/plain
 packages/x11/Makefile.fpc svneol=native#text/plain
 packages/x11/fpmake.pp svneol=native#text/plain
@@ -7843,6 +7812,7 @@ rtl/openbsd/i386/prt0.as svneol=native#text/plain
 rtl/openbsd/i386/sighnd.inc svneol=native#text/plain
 rtl/openbsd/osdefs.inc svneol=native#text/plain
 rtl/openbsd/pmutext.inc svneol=native#text/plain
+rtl/openbsd/pthread.inc svneol=native#text/plain
 rtl/openbsd/ptypes.inc svneol=native#text/plain
 rtl/openbsd/signal.inc svneol=native#text/plain
 rtl/openbsd/syscalls.inc svneol=native#text/plain
@@ -8599,6 +8569,7 @@ tests/tbf/tb0218.pp svneol=native#text/plain
 tests/tbf/tb0219.pp svneol=native#text/pascal
 tests/tbf/tb0220.pp svneol=native#text/plain
 tests/tbf/tb0221.pp svneol=native#text/plain
+tests/tbf/tb0222.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -9345,6 +9316,13 @@ tests/test/cg/obj/linux/x86_64/tcext5.o -text
 tests/test/cg/obj/linux/x86_64/tcext6.o -text
 tests/test/cg/obj/macos/powerpc/ctest.o -text
 tests/test/cg/obj/netbsd/m68k/ctest.o -text
+tests/test/cg/obj/openbsd/i386/cpptcl1.o -text
+tests/test/cg/obj/openbsd/i386/cpptcl2.o -text
+tests/test/cg/obj/openbsd/i386/ctest.o -text
+tests/test/cg/obj/openbsd/i386/tcext3.o -text
+tests/test/cg/obj/openbsd/i386/tcext4.o -text
+tests/test/cg/obj/openbsd/i386/tcext5.o -text
+tests/test/cg/obj/openbsd/i386/tcext6.o -text
 tests/test/cg/obj/os2/i386/ctest.o -text
 tests/test/cg/obj/readme.txt svneol=native#text/plain
 tests/test/cg/obj/solaris/i386/cpptcl1.o -text
@@ -9788,6 +9766,7 @@ tests/test/talign2.pp svneol=native#text/plain
 tests/test/targ1a.pp svneol=native#text/plain
 tests/test/targ1b.pp svneol=native#text/plain
 tests/test/tarray1.pp svneol=native#text/plain
+tests/test/tarray10.pp svneol=native#text/plain
 tests/test/tarray2.pp svneol=native#text/plain
 tests/test/tarray3.pp svneol=native#text/plain
 tests/test/tarray4.pp svneol=native#text/plain
@@ -9967,6 +9946,9 @@ tests/test/tcpstr12.pp svneol=native#text/pascal
 tests/test/tcpstr13.pp svneol=native#text/pascal
 tests/test/tcpstr14.pp svneol=native#text/pascal
 tests/test/tcpstr15.pp svneol=native#text/pascal
+tests/test/tcpstr16.pp svneol=native#text/pascal
+tests/test/tcpstr17.pp svneol=native#text/pascal
+tests/test/tcpstr18.pp svneol=native#text/pascal
 tests/test/tcpstr2.pp svneol=native#text/plain
 tests/test/tcpstr2a.pp svneol=native#text/plain
 tests/test/tcpstr3.pp svneol=native#text/plain
@@ -10818,9 +10800,6 @@ tests/test/units/sysutils/tlocale.pp svneol=native#text/plain
 tests/test/units/sysutils/trwsync.pp svneol=native#text/plain
 tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
-tests/test/units/sysutils/utf16.txt svneol=native#text/plain
-tests/test/units/sysutils/utf16be.txt svneol=native#text/plain
-tests/test/units/sysutils/utf8.txt svneol=native#text/plain
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
 tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
 tests/test/uobjc24.pp svneol=native#text/plain
@@ -11024,7 +11003,12 @@ tests/webtbf/tw2037.pp svneol=native#text/plain
 tests/webtbf/tw2046.pp svneol=native#text/plain
 tests/webtbf/tw2053.pp svneol=native#text/plain
 tests/webtbf/tw2053b.pp svneol=native#text/plain
+tests/webtbf/tw20580.pp svneol=native#text/pascal
+tests/webtbf/tw20661.pp svneol=native#text/plain
 tests/webtbf/tw2070.pp svneol=native#text/plain
+tests/webtbf/tw20721a.pp svneol=native#text/pascal
+tests/webtbf/tw20721b.pp svneol=native#text/pascal
+tests/webtbf/tw20721c.pp svneol=native#text/pascal
 tests/webtbf/tw2128.pp svneol=native#text/plain
 tests/webtbf/tw2129.pp svneol=native#text/plain
 tests/webtbf/tw2154.pp svneol=native#text/plain
@@ -11781,6 +11765,7 @@ tests/webtbs/tw17646.pp svneol=native#text/plain
 tests/webtbs/tw1765.pp svneol=native#text/plain
 tests/webtbs/tw17675.pp svneol=native#text/plain
 tests/webtbs/tw17675a.pp svneol=native#text/plain
+tests/webtbs/tw17685.pp svneol=native#text/pascal
 tests/webtbs/tw17710.pp svneol=native#text/pascal
 tests/webtbs/tw17714.pp svneol=native#text/plain
 tests/webtbs/tw17715.pp svneol=native#text/plain
@@ -11866,6 +11851,7 @@ tests/webtbs/tw1932.pp svneol=native#text/plain
 tests/webtbs/tw19325.pp svneol=native#text/pascal
 tests/webtbs/tw1935.pp svneol=native#text/plain
 tests/webtbs/tw1936.pp svneol=native#text/plain
+tests/webtbs/tw19368.pp svneol=native#text/pascal
 tests/webtbs/tw1938.pp svneol=native#text/plain
 tests/webtbs/tw1948.pp svneol=native#text/plain
 tests/webtbs/tw1950.pp svneol=native#text/plain
@@ -11874,6 +11860,7 @@ tests/webtbs/tw19555.pp svneol=native#text/pascal
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19700.pp svneol=native#text/plain
+tests/webtbs/tw19701.pas svneol=native#text/plain
 tests/webtbs/tw19851a.pp svneol=native#text/pascal
 tests/webtbs/tw19851b.pp svneol=native#text/pascal
 tests/webtbs/tw19864.pp svneol=native#text/pascal
@@ -11887,6 +11874,7 @@ tests/webtbs/tw20003.pp svneol=native#text/pascal
 tests/webtbs/tw20005.pp svneol=native#text/pascal
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
+tests/webtbs/tw20028.pp svneol=native#text/pascal
 tests/webtbs/tw20035a.pp svneol=native#text/pascal
 tests/webtbs/tw20035b.pp svneol=native#text/pascal
 tests/webtbs/tw20035c.pp svneol=native#text/pascal
@@ -11901,15 +11889,22 @@ tests/webtbs/tw2028.pp svneol=native#text/plain
 tests/webtbs/tw2030.pp svneol=native#text/plain
 tests/webtbs/tw2031.pp svneol=native#text/plain
 tests/webtbs/tw2037.pp svneol=native#text/plain
+tests/webtbs/tw20396.pp svneol=native#text/plain
 tests/webtbs/tw2040.pp svneol=native#text/plain
 tests/webtbs/tw2041.pp svneol=native#text/plain
 tests/webtbs/tw20421.pp svneol=native#text/pascal
 tests/webtbs/tw2045.pp svneol=native#text/plain
 tests/webtbs/tw2046a.pp svneol=native#text/plain
+tests/webtbs/tw20527.pp svneol=native#text/plain
+tests/webtbs/tw20557.pp svneol=native#text/pascal
 tests/webtbs/tw2059.pp svneol=native#text/plain
+tests/webtbs/tw20594.pp svneol=native#text/pascal
+tests/webtbs/tw20638.pp svneol=native#text/pascal
 tests/webtbs/tw2065.pp svneol=native#text/plain
 tests/webtbs/tw2069.pp svneol=native#text/plain
+tests/webtbs/tw20690.pp svneol=native#text/pascal
 tests/webtbs/tw2072.pp svneol=native#text/plain
+tests/webtbs/tw20744.pp svneol=native#text/plain
 tests/webtbs/tw2109.pp svneol=native#text/plain
 tests/webtbs/tw2110.pp svneol=native#text/plain
 tests/webtbs/tw2128.pp svneol=native#text/plain
@@ -12722,6 +12717,7 @@ tests/webtbs/uw18087b.pp svneol=native#text/pascal
 tests/webtbs/uw18909a.pp svneol=native#text/pascal
 tests/webtbs/uw18909b.pp svneol=native#text/pascal
 tests/webtbs/uw19159.pp svneol=native#text/pascal
+tests/webtbs/uw19701.pas svneol=native#text/plain
 tests/webtbs/uw19851.pp svneol=native#text/pascal
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain

.gitignore

@@ -1703,24 +1703,6 @@ packages/fpmkunit/src/build-stamp.*
 packages/fpmkunit/src/fpcmade.*
 packages/fpmkunit/src/units
 packages/fpmkunit/units
-packages/fpvectorial/*.bak
-packages/fpvectorial/*.exe
-packages/fpvectorial/*.o
-packages/fpvectorial/*.ppu
-packages/fpvectorial/*.s
-packages/fpvectorial/Package.fpc
-packages/fpvectorial/build-stamp.*
-packages/fpvectorial/fpcmade.*
-packages/fpvectorial/src/*.bak
-packages/fpvectorial/src/*.exe
-packages/fpvectorial/src/*.o
-packages/fpvectorial/src/*.ppu
-packages/fpvectorial/src/*.s
-packages/fpvectorial/src/Package.fpc
-packages/fpvectorial/src/build-stamp.*
-packages/fpvectorial/src/fpcmade.*
-packages/fpvectorial/src/units
-packages/fpvectorial/units
 packages/fuse/*.bak
 packages/fuse/*.exe
 packages/fuse/*.o

compiler/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/09/08]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/11/02]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -2434,10 +2434,12 @@ override FPCOPT+=-P$(ARCH)
 endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-XP$(BINUTILSPREFIX)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
 endif
 ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-Xr$(RLINKPATH)
@@ -2534,7 +2536,7 @@ override FPCOPT+=-Aas
 endif
 endif
 ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
-ifneq ($(findstring $(OS_TARGET),linux solaris),)
+ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif
@@ -3290,6 +3292,11 @@ ifdef CMP
 override DIFF:=$(CMP) -i218
 endif
 endif
+ifeq ($(findstring 2.4.,$(FPC_VERSION)),)
+ifndef ALLOW_WARNINGS
+override LOCALOPT+=-Sew
+endif
+endif
 override COMPILER+=$(LOCALOPT)
 PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc.exe,$(SEARCHPATH))))
 ifeq ($(PASDOC),)

compiler/Makefile.fpc

@@ -268,6 +268,14 @@ override DIFF:=$(CMP) -i218
 endif
 endif
 
+# Use -Sew option by default
+# Allow disabling by setting ALLOW_WARNINGS=1
+ifeq ($(findstring 2.4.,$(FPC_VERSION)),)
+ifndef ALLOW_WARNINGS
+override LOCALOPT+=-Sew
+endif
+endif
+
 # Add Local options
 override COMPILER+=$(LOCALOPT)
 

compiler/arm/cgcpu.pas

@@ -112,6 +112,8 @@ unit cgcpu;
         procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize;mmreg, intreg: tregister; shuffle : pmmshuffle); override;
 
         procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); override;
+        { Transform unsupported methods into Internal errors }
+        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
       private
         { clear out potential overflow bits from 8 or 16 bit operations  }
         { the upper 24/16 bits of a register after an operation          }
@@ -1352,6 +1354,11 @@ unit cgcpu;
       end;
 
 
+    procedure tcgarm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+      begin
+        Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented');
+      end;
+
     procedure tcgarm.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
       begin
         list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));

compiler/arm/cpuinfo.pas

@@ -202,6 +202,10 @@ Const
    );
 
 
+    { We know that there are fields after sramsize
+      but we don't care about this warning }
+    {$WARN 3177 OFF}
+
    embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
    ((
    	controllertypestr:'';

compiler/arm/raarmgas.pas

@@ -212,6 +212,8 @@ Unit raarmgas;
 
 
       procedure read_index_shift(require_rbracket : boolean);
+        var
+          shift : aint;
         begin
           case actasmtoken of
             AS_COMMA :
@@ -227,9 +229,10 @@ Unit raarmgas;
                         if not(actasmtoken=AS_HASH) then
                           do_error;
                         Consume(AS_HASH);
-                        oper.opr.ref.shiftimm := BuildConstExpression(false,true);
-                        if (oper.opr.ref.shiftimm<0) or (oper.opr.ref.shiftimm>32) then
+                        shift := BuildConstExpression(false,true);
+                        if (shift<0) or (shift>32) then
                           do_error;
+                        oper.opr.ref.shiftimm := shift;
                         test_end(require_rbracket);
                       end;
                    end

compiler/asmutils.pas

@@ -59,10 +59,6 @@ uses
             current_asmdata.getdatalabel(referencelab);
             list.concat(tai_label.create(referencelab));
           end;
-        if (encoding=0) then
-          encoding:=CP_NONE;
-        if (encoding=CP_NONE) and (m_systemcodepage in current_settings.modeswitches) then
-          encoding:=current_settings.sourcecodepage;
         list.concat(tai_const.create_16bit(encoding));
         list.concat(tai_const.create_16bit(1));
 {$ifdef cpu64bitaddr}

compiler/cgobj.pas

@@ -523,6 +523,11 @@ unit cgobj;
 
           { initialize the pic/got register }
           procedure g_maybe_got_init(list: TAsmList); virtual;
+          { allocallcpuregisters, a_call_name, deallocallcpuregisters sequence }
+          procedure g_call(list: TAsmList; const s: string);
+          { Generate code to exit an unwind-protected region. The default implementation
+            produces a simple jump to destination label. }
+          procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;
         protected
           procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: tcgsize; out extra_load: boolean);
           procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
@@ -3627,18 +3632,27 @@ implementation
       begin
         cgpara1.init;
         cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
          if is_ansistring(t) or
             is_widestring(t) or
             is_unicodestring(t) or
             is_interfacecom_or_dispinterface(t) or
             is_dynamic_array(t) then
            a_load_const_ref(list,OS_ADDR,0,ref)
+         else if t.typ=variantdef then
+           begin
+             paramanager.getintparaloc(pocall_default,1,cgpara1);
+             a_loadaddr_ref_cgpara(list,ref,cgpara1);
+             paramanager.freecgpara(list,cgpara1);
+             allocallcpuregisters(list);
+             a_call_name(list,'FPC_VARIANT_INIT',false);
+             deallocallcpuregisters(list);
+           end
          else
            begin
               if is_open_array(t) then
                 InternalError(201103052);
+              paramanager.getintparaloc(pocall_default,1,cgpara1);
+              paramanager.getintparaloc(pocall_default,2,cgpara2);
               reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
               a_loadaddr_ref_cgpara(list,href,cgpara2);
               a_loadaddr_ref_cgpara(list,ref,cgpara1);
@@ -3660,8 +3674,6 @@ implementation
       begin
         cgpara1.init;
         cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
          if is_ansistring(t) or
             is_widestring(t) or
             is_unicodestring(t) or
@@ -3670,10 +3682,21 @@ implementation
               g_decrrefcount(list,t,ref);
               a_load_const_ref(list,OS_ADDR,0,ref);
             end
+         else if t.typ=variantdef then
+           begin
+             paramanager.getintparaloc(pocall_default,1,cgpara1);
+             a_loadaddr_ref_cgpara(list,ref,cgpara1);
+             paramanager.freecgpara(list,cgpara1);
+             allocallcpuregisters(list);
+             a_call_name(list,'FPC_VARIANT_CLEAR',false);
+             deallocallcpuregisters(list);
+           end
          else
            begin
               if is_open_array(t) then
                 InternalError(201103051);
+              paramanager.getintparaloc(pocall_default,1,cgpara1);
+              paramanager.getintparaloc(pocall_default,2,cgpara2);
               reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
               a_loadaddr_ref_cgpara(list,href,cgpara2);
               a_loadaddr_ref_cgpara(list,ref,cgpara1);
@@ -4251,6 +4274,17 @@ implementation
       begin
       end;
 
+    procedure tcg.g_call(list: TAsmList;const s: string);
+      begin
+        allocallcpuregisters(list);
+        a_call_name(list,s,false);
+        deallocallcpuregisters(list);
+      end;
+
+    procedure tcg.g_local_unwind(list: TAsmList; l: TAsmLabel);
+      begin
+        a_jmp_always(list,l);
+      end;
 
     procedure tcg.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister; shuffle: pmmshuffle);
       begin

compiler/cmsgs.pas

@@ -361,6 +361,12 @@ begin
       begin
         { skip _ }
         inc(hp1);
+        { set default verbosity to off is '-' is found just after the '_' }
+        if hp1^='-' then
+         begin
+           msgstates[numpart]^[numidx]:=ms_off_global;
+           inc(hp1);
+         end;
         { put the address in the idx, the numbers are already checked }
         msgidx[numpart]^[numidx]:=hp1;
       end;

compiler/cp1251.pas

@@ -6,7 +6,7 @@ unit cp1251;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp1252.pp

@@ -6,7 +6,7 @@ unit CP1252;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp437.pas

@@ -6,7 +6,7 @@ unit cp437;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp850.pas

@@ -6,7 +6,7 @@ unit cp850;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp866.pas

@@ -6,7 +6,7 @@ unit cp866;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp8859_1.pas

@@ -6,7 +6,7 @@ unit cp8859_1;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+    {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp8859_5.pas

@@ -6,7 +6,7 @@ unit cp8859_5;
   implementation
 
   uses
-     {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cresstr.pas

@@ -40,7 +40,7 @@ uses
    aasmcpu,
 {$if FPC_FULLVERSION<20700}
    ccharset,
-{$endif }
+{$endif}
    asmutils;
 
     Type
@@ -150,7 +150,7 @@ uses
           make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0));
 
         { Write unitname entry }
-        namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),tstringdef(cansistringtype).encoding,False);
+        namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage,False);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(namelab));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
@@ -166,12 +166,12 @@ uses
             new_section(current_asmdata.asmlists[al_const],sec_rodata,make_mangledname('RESSTR',current_module.localsymtable,'d_'+r.name),sizeof(pint));
             { Write default value }
             if assigned(R.value) and (R.len<>0) then
-              valuelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,tstringdef(cansistringtype).encoding,False)
+              valuelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage,False)
             else
               valuelab:=nil;
             { Append the name as a ansistring. }
             current_asmdata.asmlists[al_const].concat(cai_align.Create(const_align(sizeof(pint))));
-            namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),tstringdef(cansistringtype).encoding,False);
+            namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage,False);
 
             {
               Resourcestring index:

compiler/dbgdwarf.pas

@@ -3478,12 +3478,12 @@ implementation
               current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0));
           end;
         if assigned(objectname) then
-          append_entry(DW_TAG_structure_type,true,[
+          append_entry(DW_TAG_class_type,true,[
             DW_AT_name,DW_FORM_string,objectname^+#0,
             DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
             ])
         else
-          append_entry(DW_TAG_structure_type,true,[
+          append_entry(DW_TAG_class_type,true,[
             DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
             ]);
         { Apple-specific tag that identifies it as an Objective-C class }

compiler/defcmp.pas

@@ -335,29 +335,46 @@ implementation
                      { Constant string }
                      if (fromtreetype=stringconstn) then
                       begin
-                        if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) then
+                        if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and
+                           ((tstringdef(def_from).stringtype<>st_ansistring) or
+                            (tstringdef(def_from).encoding=tstringdef(def_to).encoding)
+                           ) then
                           eq:=te_equal
                         else
                          begin
                            doconv:=tc_string_2_string;
-                           { Don't prefer conversions from widestring to a
-                             normal string as we can lose information }
-                           if (tstringdef(def_from).stringtype in [st_widestring,st_unicodestring]) and
-                             not (tstringdef(def_to).stringtype in [st_widestring,st_unicodestring]) then
-                             eq:=te_convert_l3
-                           else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] then
-                             eq:=te_convert_l2
+                           if (tstringdef(def_from).stringtype = st_ansistring) and
+                              (tstringdef(def_to).stringtype = st_ansistring) then
+                             if (tstringdef(def_to).encoding=globals.CP_UTF8) then
+                               eq:=te_convert_l1
+                             else
+                               eq:=te_convert_l2
                            else
-                             eq:=te_convert_l1;
+                            begin
+                              { Don't prefer conversions from widestring to a
+                                normal string as we can lose information }
+                              if (tstringdef(def_from).stringtype in [st_widestring,st_unicodestring]) and
+                                not (tstringdef(def_to).stringtype in [st_widestring,st_unicodestring]) then
+                                eq:=te_convert_l3
+                              else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] then
+                                eq:=te_convert_l2
+                              else
+                                eq:=te_convert_l1;
+                            end;
                          end;
                       end
                      else if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and
                              (tstringdef(def_from).stringtype=st_ansistring) then 
                       begin
+                        { don't convert ansistrings if any conditions is true:
+                          1) same encoding
+                          2) from explicit codepage ansistring to ansistring and vice versa
+                          3) from any ansistring to rawbytestring }
                         if (tstringdef(def_from).encoding=tstringdef(def_to).encoding) or
+                           ((tstringdef(def_to).encoding=0) and (tstringdef(def_from).encoding=getansistringcodepage)) or
+                           ((tstringdef(def_to).encoding=getansistringcodepage) and (tstringdef(def_from).encoding=0)) or
                            (tstringdef(def_to).encoding=globals.CP_NONE) then
                          begin
-                           //doconv := tc_string_2_string;
                            eq:=te_equal;
                          end
                         else

compiler/defutil.pas

@@ -169,6 +169,9 @@ interface
     {# Returns true if p is an ansi string type }
     function is_ansistring(p : tdef) : boolean;
 
+    {# Returns true if p is an ansi string type with codepage 0 }
+    function is_rawbytestring(p : tdef) : boolean;
+
     {# Returns true if p is a long string type }
     function is_longstring(p : tdef) : boolean;
 
@@ -617,6 +620,14 @@ implementation
                         (tstringdef(p).stringtype=st_ansistring);
       end;
 
+    { true if p is an ansi string def with codepage CP_NONE }
+    function is_rawbytestring(p : tdef) : boolean;
+      begin
+        is_rawbytestring:=(p.typ=stringdef) and
+                       (tstringdef(p).stringtype=st_ansistring) and
+                       (tstringdef(p).encoding=globals.CP_NONE);
+      end;
+
     { true if p is an long string def }
     function is_longstring(p : tdef) : boolean;
       begin

compiler/fmodule.pas

@@ -143,6 +143,7 @@ interface
         checkforwarddefs,
         deflist,
         symlist       : TFPObjectList;
+        ansistrdef    : tobject; { an ansistring def redefined for the current module }
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : TSymtable;{ pointer to the local symtable of this unit }
@@ -523,6 +524,7 @@ implementation
         derefdataintflen:=0;
         deflist:=TFPObjectList.Create(false);
         symlist:=TFPObjectList.Create(false);
+        ansistrdef:=nil;
         wpoinfo:=nil;
         checkforwarddefs:=TFPObjectList.Create(false);
         extendeddefs := TFPHashObjectList.Create(true);
@@ -634,6 +636,7 @@ implementation
         derefdata.free;
         deflist.free;
         symlist.free;
+        ansistrdef:=nil;
         wpoinfo.free;
         checkforwarddefs.free;
         globalsymtable.free;

compiler/fpcdefs.inc

@@ -59,6 +59,7 @@
   {$define SUPPORT_MMX}
   {$define cpumm}
   {$define fewintregisters}
+  {$define cpurox}
 {$endif i386}
 
 {$ifdef x86_64}
@@ -70,6 +71,7 @@
   {$define cpufloat128}
   {$define cputargethasfixedstack}
   {$define cpumm}
+  {$define cpurox}
 {$endif x86_64}
 
 {$ifdef alpha}
@@ -92,6 +94,7 @@
   {$define cpuflags}
   {$define cputargethasfixedstack}
   {$define cpumm}
+  {$define cpurox}
 {$endif powerpc}
 
 {$ifdef powerpc64}
@@ -100,6 +103,7 @@
   {$define cpuflags}
   {$define cputargethasfixedstack}
   {$define cpumm}
+  {$define cpurox}
 {$endif powerpc64}
 
 {$ifdef arm}
@@ -109,7 +113,12 @@
   {$define cpuflags}
   {$define cpufpemu}
   {$define cpuneedsdiv32helper}
+  {$define cpurox}
   {$define cputargethasfixedstack}
+  { default to armel }
+  {$if not(defined(CPUARM)) and not(defined(CPUARMEB)) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB))}
+    {$define FPC_ARMEL}
+  {$endif}
   { inherit FPC_ARMEL? }
   {$if defined(CPUARMEL) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB))}
     {$define FPC_ARMEL}
@@ -144,6 +153,7 @@
 {$endif mipsel}
 
 {$ifdef mips}
+  {$define cpu32bit}
   {$define cpu32bitalu}
   {$define cpu32bitaddr}
   { $define cpuflags}

compiler/globtype.pas

@@ -139,7 +139,7 @@ interface
          cs_support_c_operators,
          { generation }
          cs_profile,cs_debuginfo,cs_compilesystem,
-         cs_lineinfo,cs_implicit_exceptions,
+         cs_lineinfo,cs_implicit_exceptions,cs_explicit_codepage,
          { linking }
          cs_create_smart,cs_create_dynamic,cs_create_pic,
          { browser switches are back }

compiler/htypechk.pas

@@ -1481,7 +1481,7 @@ implementation
                         begin
                           { allow p^:= constructions with p is const parameter }
                           if gotderef or gotdynarray or (Valid_Const in opts) or
-                            (nf_isinternal_ignoreconst in tloadnode(hp).flags) then
+                            (loadnf_isinternal_ignoreconst in tloadnode(hp).loadnodeflags) then
                             result:=true
                           else
                             if report_errors then

compiler/i386/i386tab.inc

@@ -381,15 +381,22 @@
   (
     opcode  : A_CALL;
     ops     : 1;
-    optypes : (ot_immediate,ot_none,ot_none,ot_none);
-    code    : #208#1#232#52;
+    optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#130;
+    flags   : if_386 or if_nox86_64
+  ),
+  (
+    opcode  : A_CALL;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#130;
     flags   : if_8086
   ),
   (
     opcode  : A_CALL;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#130;
+    optypes : (ot_immediate,ot_none,ot_none,ot_none);
+    code    : #208#1#232#52;
     flags   : if_8086
   ),
   (
@@ -2537,8 +2544,15 @@
   (
     opcode  : A_JMP;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#132;
+    optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#132;
+    flags   : if_386 or if_nox86_64
+  ),
+  (
+    opcode  : A_JMP;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#132;
     flags   : if_8086
   ),
   (
@@ -2614,22 +2628,15 @@
   (
     opcode  : A_LCALL;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#130;
-    flags   : if_8086
-  ),
-  (
-    opcode  : A_LCALL;
-    ops     : 1;
-    optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none);
-    code    : #208#1#255#130;
-    flags   : if_8086
+    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#131;
+    flags   : if_386 or if_nox86_64
   ),
   (
     opcode  : A_LCALL;
     ops     : 1;
-    optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none);
-    code    : #208#1#255#131;
+    optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#131;
     flags   : if_8086
   ),
   (
@@ -2698,22 +2705,15 @@
   (
     opcode  : A_LJMP;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#133;
-    flags   : if_8086
-  ),
-  (
-    opcode  : A_LJMP;
-    ops     : 1;
-    optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none);
-    code    : #208#1#255#133;
-    flags   : if_8086
+    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#133;
+    flags   : if_386 or if_nox86_64
   ),
   (
     opcode  : A_LJMP;
     ops     : 1;
-    optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none);
-    code    : #208#1#255#132;
+    optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#133;
     flags   : if_8086
   ),
   (

compiler/link.pas

@@ -79,6 +79,7 @@ interface
          Constructor Create;override;
          Destructor Destroy;override;
          Function  FindUtil(const s:TCmdStr):TCmdStr;
+         Function  CatFileContent(para:TCmdStr):TCmdStr;
          Function  DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
          procedure SetDefaultInfo;virtual;
          Function  MakeStaticLibrary:boolean;override;
@@ -671,6 +672,39 @@ Implementation
       end;
 
 
+    Function TExternalLinker.CatFileContent(para : TCmdStr) : TCmdStr;
+      var
+        filecontent : TCmdStr;
+        f : text;
+        st : string;
+      begin
+        if not (tf_no_backquote_support in source_info.flags) then
+           begin
+             CatFileContent:='`cat '+MaybeQuoted(para)+'`';
+             Exit;
+           end;
+        assign(f,para);
+        filecontent:='';
+        {$push}{$I-}
+        reset(f);
+        {$pop}
+        if IOResult<>0 then
+          begin
+            Message1(exec_n_backquote_cat_file_not_found,para);
+          end
+        else
+          begin
+            while not eof(f) do
+              begin
+                readln(f,st);
+                if st<>'' then
+                  filecontent:=filecontent+' '+st;
+              end;
+            close(f);
+          end;
+        CatFileContent:=filecontent;
+      end;
+
     Function TExternalLinker.DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
       var
         exitcode: longint;

compiler/m68k/cpupara.pas

@@ -45,14 +45,15 @@ unit cpupara;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
-          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
+          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
+          function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
          private
           procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                                var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;
-          function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
-          function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
        end;
 
   implementation
@@ -89,7 +90,7 @@ unit cpupara;
 
       begin
          result:=LOC_REFERENCE;
-         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
+         (* Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
            if push_addr_param for the def is true
          case p.typ of
             orddef:
@@ -141,7 +142,7 @@ unit cpupara;
             else
               internalerror(2002071001);
          end;
-         }
+         *)
       end;
 
 
@@ -379,7 +380,7 @@ unit cpupara;
             while (paralen > 0) do
               begin
                 paraloc:=hp.paraloc[side].add_location;
-                {
+                (*
                   by default, the m68k doesn't know any register parameters  (FK)
                 if (loc = LOC_REGISTER) and
                    (nextintreg <= RS_D2) then
@@ -408,7 +409,7 @@ unit cpupara;
                     dec(paralen,tcgsize2size[paraloc^.size]);
                   end
                 else { LOC_REFERENCE }
-}
+                *)
                   begin
 {$ifdef DEBUG_CHARLIE}
 		    writeln('loc reference');
@@ -577,6 +578,22 @@ unit cpupara;
         inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
       end;
 
+    function tm68kparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+      var
+        cur_stack_offset: aword;
+        curintreg, curfloatreg: tsuperregister;
+      begin
+        init_values(curintreg,curfloatreg,cur_stack_offset);
+
+        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,cur_stack_offset);
+        if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+          { just continue loading the parameters in the registers }
+          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset)
+        else
+          internalerror(200410231);
+      end;
+
+
 begin
   paramanager:=tm68kparamanager.create;
 end.

compiler/mips/cgcpu.pas

@@ -86,6 +86,9 @@ type
     procedure g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint); override;
     procedure g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint);
     procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override;
+    { Transform unsupported methods into Internal errors }
+    procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
+    procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
   end;
 
   TCg64MPSel = class(tcg64f32)
@@ -1693,6 +1696,16 @@ begin
   List.concat(Tai_symbol_end.Createname(labelname));
 end;
 
+procedure TCgMPSel.g_stackpointer_alloc(list : TAsmList;localsize : longint);
+  begin
+    Comment(V_Error,'TCgMPSel.g_stackpointer_alloc method not implemented');
+  end;
+
+procedure TCgMPSel.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+  begin
+    Comment(V_Error,'TCgMPSel.a_bit_scan_reg_reg method not implemented');
+  end;
+
 {****************************************************************************
                                TCG64_MIPSel
 ****************************************************************************}

compiler/mips/rmipsmot.inc

@@ -1,75 +0,0 @@
-{ don't edit, this file is generated from mipsreg.dat }
-'INVALID',
-'r0',
-'r1',
-'r2',
-'r3',
-'r4',
-'r5',
-'r6',
-'r7',
-'r8',
-'r9',
-'r10',
-'r11',
-'r12',
-'r13',
-'r14',
-'r15',
-'r16',
-'r17',
-'r18',
-'r19',
-'r20',
-'r21',
-'r22',
-'r23',
-'r24',
-'r25',
-'r26',
-'r27',
-'r28',
-'r29',
-'r30',
-'r31',
-'F0',
-'F1',
-'F2',
-'F3',
-'F4',
-'F5',
-'F6',
-'F7',
-'F8',
-'F9',
-'F10',
-'F11',
-'F12',
-'F13',
-'F14',
-'F15',
-'F16',
-'F17',
-'F18',
-'F19',
-'F20',
-'F21',
-'F22',
-'F23',
-'F24',
-'F25',
-'F26',
-'F27',
-'F28',
-'F29',
-'F30',
-'F31',
-'PC',
-'HI',
-'LO',
-'CR',
-'FCR0',
-'FCR25',
-'FCR26',
-'FCR28',
-'FCSR'

compiler/mips/rmipsmri.inc

@@ -1,75 +0,0 @@
-{ don't edit, this file is generated from mipsreg.dat }
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0,
-0

compiler/msg/errore.msg

@@ -41,6 +41,9 @@
 #   x_   executable informations
 #   o_   normal (e.g., "press enter to continue")
 #
+# <type> can contain a minus sign at the beginning to mark that
+# the message is off by default. Look at type_w_explicit_string_cast
+# for example.
 
 #
 # General
@@ -537,7 +540,7 @@ parser_e_only_class_members_via_class_ref=03053_E_Only class methods, class prop
 % \end{verbatim}
 % \var{Free} is not a class method and hence cannot be called with a class
 % reference.
-parser_e_only_class_members=03054_E_Only class class methods, class properties and class variables can be accessed in class methods
+parser_e_only_class_members=03054_E_Only class methods, class properties and class variables can be accessed in class methods
 % This is related to the previous error. You cannot call a method of an object
 % from inside a class method. The following code would produce this error:
 % \begin{verbatim}
@@ -1406,7 +1409,7 @@ parser_e_invalid_codepage=03314_E_Invalid codepage
 % \end{description}
 # Type Checking
 #
-# 04100 is the last used one
+# 04108 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1770,6 +1773,24 @@ type_e_procedures_return_no_value=04103_E_Invalid assignment, procedures return
 % This error occurs when one tries to assign the result of a procedure or destructor call.
 % A procedure or destructor returns no value so this is not
 % possible.
+type_w_implicit_string_cast=04104_W_Implicit string type conversion from "$1" to "$2"
+% An implicit type conversion from an ansi string type to an unicode string type is
+% encountered. To avoid this warning perform an explicit type conversion.
+type_w_implicit_string_cast_loss=04105_W_Implicit string type conversion with potential data loss from "$1" to "$2"
+% An implicit type conversion from an unicode string type to an ansi string type is
+% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of
+% destination string type.
+type_w_explicit_string_cast=04106_-W_Explicit string typecast from "$1" to "$2"
+% An explicit typecast from an ansi string type to an unicode string type is
+% encountered. This warning is off by default. You can turn it on to see all suspicious string conversions.
+type_w_explicit_string_cast_loss=04107_-W_Explicit string typecast with potential data loss from "$1" to "$2"
+% An explicit typecast from an unicode string type to an ansi string type is
+% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of
+% destination string type. This warning is off by default. You can turn it on to see all the places with lossy string
+% conversions.
+type_w_unicode_data_loss=04108_W_Unicode constant cast with potential data loss
+% Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current
+% system codepage
 % \end{description}
 #
 # Symtable
@@ -2170,6 +2191,8 @@ cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Leaving procedur
 % Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures
 % which use automated types like ansistrings or class constructurs are affected by this too.
 % \end{description}
+cg_e_mod_only_defined_for_pos_quotient=06054_E_In ISO mode, the mod operator is defined only for positive quotient
+% In ISO pascal, only positive values are allowed for the quotient: \var{n mod m} is only valid if \var{m>0}.
 # EndOfTeX
 
 #
@@ -2442,6 +2465,7 @@ asmr_e_bad_seh_directive_register=07113_E_Invalid register for $1
 asmr_e_seh_in_pure_asm_only=07114_E_SEH directives are allowed only in pure assembler procedures
 % Win64 SEH directives are allowed only in pure assembler procedures, not in assembler
 % blocks of regular procedures.
+asmr_e_unsupported_directive=07115_E_Directive "$1" is not supported for the current target
 
 
 #
@@ -2479,17 +2503,20 @@ asmw_e_bad_reg_with_rex=08022_E_Asm: AH,BH,CH or DH cannot be used in an instruc
 % 8086 high byte registers (AH,BH,CH or DH) together with REX prefix in a single instruction.
 % The REX prefix is required whenever the instruction operand size is 64 bits, or
 % when it uses one of extended x86_64 registers (R8-R15 or XMM8-XMM15).
-asmw_w_missing_endprologue=08023_W_Missing .seh_endprologue directive
+asmw_e_missing_endprologue=08023_E_Missing .seh_endprologue directive
 % x86_64-win64 only: Normally, SEH directives are handled internally by compiler.
 % However, in pure assembler procedures .seh_endprologue directive is required
 % if other SEH directives are present.
-asmw_w_prologue_too_large=08024_W_Function prologue exceeds 255 bytes
+asmw_e_prologue_too_large=08024_E_Function prologue exceeds 255 bytes
 % x86_64-win64: .seh_prologue directive must be placed within 255 bytes from function start.
+asmw_e_handlerdata_no_handler=08025_E_.seh_handlerdata directive without preceding .seh_handler
+% x86_64-win64: If .seh_handlerdata directive is used, then a .seh_handler directive must be
+% present earlier in the same function.
 
 #
 # Executing linker/assembler
 #
-# 09032 is the last used one
+# 09033 is the last used one
 #
 # BeginOfTeX
 %
@@ -2579,6 +2606,8 @@ exec_e_cant_open_resource_file=09031_E_Can't open resource file "$1"
 % An error occurred resource file cannot be opened.
 exec_e_cant_write_resource_file=09032_E_Can't write resource file "$1"
 % An error occurred resource file cannot be written.
+exec_n_backquote_cat_file_not_found=09033_N_File "$1" not found for backquoted cat command
+% The compiler did not find the file that should be expanded into linker parameters
 %\end{description}
 # EndOfTeX
 
@@ -2934,10 +2963,10 @@ option_read_config_file=11034_D_Reading config file "$1"
 option_found_file=11035_D_found source file name "$1"
 % Additional information about options.
 % Displayed when you have the debug option turned on.
-option_code_page_not_available=11039_E_Unknown code page
-% An unknown code page for the source files was requested.
-% The compiler is compiled with support for several code pages built-in.
-% The requested code page is not in that list. You will need to recompile
+option_code_page_not_available=11039_E_Unknown codepage
+% An unknown codepage for the source files was requested.
+% The compiler is compiled with support for several codepages built-in.
+% The requested codepage is not in that list. You will need to recompile
 % the compiler with support for the codepage you need.
 option_config_is_dir=11040_F_Config file $1 is a directory
 % Directories cannot be used as configuration files.
@@ -2964,7 +2993,7 @@ option_ignored_target=11047_W_Option "$1" is ignored for the current target plat
 option_debug_external_unsupported=11048_W_Disabling external debug information because it is unsupported for the selected target/debug format combination.
 % Not all debug formats can be stored in an external file on all platforms. In particular, on
 % Mac OS X only DWARF debug information can be stored externally.
-option_dwarf_smartlink_creation=11049_N_DWARF debug information cannot be used with smart linking with external assembler, disabling static library creation.  
+option_dwarf_smartlink_creation=11049_N_DWARF debug information cannot be used with smart linking with external assembler, disabling static library creation.
 % Smart linking is currently incompatble with DWARF debug information on most
 % platforms, so smart linking is disabled in such cases.
 %\end{description}

compiler/msgidx.inc

@@ -500,6 +500,11 @@ const
   type_e_class_helper_must_extend_subclass=04101;
   type_e_record_helper_must_extend_same_record=04102;
   type_e_procedures_return_no_value=04103;
+  type_w_implicit_string_cast=04104;
+  type_w_implicit_string_cast_loss=04105;
+  type_w_explicit_string_cast=04106;
+  type_w_explicit_string_cast_loss=04107;
+  type_w_unicode_data_loss=04108;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -602,6 +607,7 @@ const
   cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051;
   cg_e_labels_cannot_defined_outside_declaration_scope=06052;
   cg_e_goto_across_procedures_with_exceptions_not_allowed=06053;
+  cg_e_mod_only_defined_for_pos_quotient=06054;
   asmr_d_start_reading=07000;
   asmr_d_finish_reading=07001;
   asmr_e_none_label_contain_at=07002;
@@ -712,6 +718,7 @@ const
   asmr_e_bad_seh_directive_offset=07112;
   asmr_e_bad_seh_directive_register=07113;
   asmr_e_seh_in_pure_asm_only=07114;
+  asmr_e_unsupported_directive=07115;
   asmw_f_too_many_asm_files=08000;
   asmw_f_assembler_output_not_supported=08001;
   asmw_f_comp_not_supported=08002;
@@ -735,8 +742,9 @@ const
   asmw_e_16bit_32bit_not_supported=08020;
   asmw_e_64bit_not_supported=08021;
   asmw_e_bad_reg_with_rex=08022;
-  asmw_w_missing_endprologue=08023;
-  asmw_w_prologue_too_large=08024;
+  asmw_e_missing_endprologue=08023;
+  asmw_e_prologue_too_large=08024;
+  asmw_e_handlerdata_no_handler=08025;
   exec_w_source_os_redefined=09000;
   exec_i_assembling_pipe=09001;
   exec_d_cant_create_asmfile=09002;
@@ -770,6 +778,7 @@ const
   exec_e_cant_call_resource_compiler=09030;
   exec_e_cant_open_resource_file=09031;
   exec_e_cant_write_resource_file=09032;
+  exec_n_backquote_cat_file_not_found=09033;
   execinfo_f_cant_process_executable=09128;
   execinfo_f_cant_open_executable=09129;
   execinfo_x_codesize=09130;
@@ -909,9 +918,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 61523;
+  MsgTxtSize = 62099;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,89,315,104,85,54,115,25,202,63,
+    26,89,315,109,85,55,116,26,202,63,
     50,20,1,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -861,7 +861,7 @@ implementation
               memory accesses while sqr(<real>) has no drawback }
             if
 {$ifdef cpufpemu}
-               (current_settings.fputype<>fpu_soft) and 
+               (current_settings.fputype<>fpu_soft) and
                not(cs_fp_emulation in current_settings.moduleswitches) and
 {$endif cpufpemu}
                (nodetype=muln) and
@@ -873,6 +873,75 @@ implementation
                 left:=nil;
                 exit;
               end;
+{$ifdef cpurox}
+            { optimize (i shl x) or (i shr (bitsizeof(i)-x)) into rol(x,i) (and different flavours with shl/shr swapped etc.) }
+            if (nodetype=orn)
+{$ifndef cpu64bitalu}
+               and (left.resultdef.typ=orddef) and
+               not(torddef(left.resultdef).ordtype in [s64bit,u64bit,scurrency])
+{$endif cpu64bitalu}
+              then
+              begin
+                if (left.nodetype=shrn) and (right.nodetype=shln) and
+                   is_constintnode(tshlshrnode(left).right) and
+                   is_constintnode(tshlshrnode(right).right) and
+                   (tordconstnode(tshlshrnode(right).right).value>0) and
+                   (tordconstnode(tshlshrnode(left).right).value>0) and
+                   tshlshrnode(left).left.isequal(tshlshrnode(right).left) and
+                   not(might_have_sideeffects(tshlshrnode(left).left)) then
+                   begin
+                     if tordconstnode(tshlshrnode(left).right).value=
+                       tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(right).right).value then
+                       begin
+                         result:=cinlinenode.create(in_ror_x_y,false,
+                           ccallparanode.create(tshlshrnode(left).right,
+                           ccallparanode.create(tshlshrnode(left).left,nil)));
+                         tshlshrnode(left).left:=nil;
+                         tshlshrnode(left).right:=nil;
+                         exit;
+                       end
+                     else if tordconstnode(tshlshrnode(right).right).value=
+                       tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(left).right).value then
+                       begin
+                         result:=cinlinenode.create(in_rol_x_y,false,
+                           ccallparanode.create(tshlshrnode(right).right,
+                           ccallparanode.create(tshlshrnode(left).left,nil)));
+                         tshlshrnode(left).left:=nil;
+                         tshlshrnode(right).right:=nil;
+                         exit;
+                       end;
+                   end;
+                if (left.nodetype=shln) and (right.nodetype=shrn) and
+                   is_constintnode(tshlshrnode(left).right) and
+                   is_constintnode(tshlshrnode(right).right) and
+                   (tordconstnode(tshlshrnode(right).right).value>0) and
+                   (tordconstnode(tshlshrnode(left).right).value>0) and
+                   tshlshrnode(left).left.isequal(tshlshrnode(right).left) and
+                   not(might_have_sideeffects(tshlshrnode(left).left)) then
+                   begin
+                     if tordconstnode(tshlshrnode(left).right).value=
+                       tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(right).right).value then
+                       begin
+                         result:=cinlinenode.create(in_rol_x_y,false,
+                           ccallparanode.create(tshlshrnode(left).right,
+                           ccallparanode.create(tshlshrnode(left).left,nil)));
+                         tshlshrnode(left).left:=nil;
+                         tshlshrnode(left).right:=nil;
+                         exit;
+                       end
+                     else if tordconstnode(tshlshrnode(right).right).value=
+                       tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(left).right).value then
+                       begin
+                         result:=cinlinenode.create(in_ror_x_y,false,
+                           ccallparanode.create(tshlshrnode(right).right,
+                           ccallparanode.create(tshlshrnode(left).left,nil)));
+                         tshlshrnode(left).left:=nil;
+                         tshlshrnode(right).right:=nil;
+                         exit;
+                       end;
+                   end;
+              end;
+{$endif cpurox}
           end;
       end;
 
@@ -1644,10 +1713,32 @@ implementation
                     end;
                   st_ansistring :
                     begin
-                      if not(is_ansistring(rd)) then
-                        inserttypeconv(right,cansistringtype);
-                      if not(is_ansistring(ld)) then
-                        inserttypeconv(left,cansistringtype);
+                      { use same code page if possible (don't force same code
+                        page in case both are ansistrings with code page <>
+                        CP_NONE, since then data loss can occur (the ansistring
+                        helpers will convert them at run time to an encoding
+                        that can represent both encodings) }
+                      if is_ansistring(ld) and
+                         (tstringdef(ld).encoding<>0) and
+                         (tstringdef(ld).encoding<>globals.CP_NONE) and
+                         (not is_ansistring(rd) or
+                          (tstringdef(rd).encoding=0) or
+                          (tstringdef(rd).encoding=globals.CP_NONE)) then
+                        inserttypeconv(right,ld)
+                      else if is_ansistring(rd) and
+                         (tstringdef(rd).encoding<>0) and
+                         (tstringdef(rd).encoding<>globals.CP_NONE) and
+                         (not is_ansistring(ld) or
+                          (tstringdef(ld).encoding=0) or
+                          (tstringdef(ld).encoding=globals.CP_NONE)) then
+                        inserttypeconv(left,rd)
+                      else
+                        begin
+                          if not is_ansistring(ld) then
+                            inserttypeconv(left,getansistringdef);
+                          if not is_ansistring(rd) then
+                            inserttypeconv(right,getansistringdef);
+                        end;
                     end;
                   st_longstring :
                     begin
@@ -1940,6 +2031,14 @@ implementation
                     { for strings, return is always a 255 char string }
                     if is_shortstring(left.resultdef) then
                       resultdef:=cshortstringtype
+                    else
+                    { for ansistrings set resultdef to assignment left node
+                      if it is an assignment and left node expects ansistring }
+                    if is_ansistring(left.resultdef) and
+                       assigned(aktassignmentnode) and
+                       (aktassignmentnode.right=self) and
+                       is_ansistring(aktassignmentnode.left.resultdef) then
+                      resultdef:=aktassignmentnode.left.resultdef
                     else
                       resultdef:=left.resultdef;
                   end;
@@ -2027,7 +2126,7 @@ implementation
                   if is_ansistring(resultdef) then
                     para:=ccallparanode.create(
                             cordconstnode.create(
-                              tstringdef(resultdef).encoding,
+                              getparaencoding(resultdef),
                               u16inttype,
                               true
                             ),
@@ -2055,7 +2154,7 @@ implementation
                   if is_ansistring(resultdef) then
                     para:=ccallparanode.create(
                             cordconstnode.create(
-                              tstringdef(resultdef).encoding,
+                              getparaencoding(resultdef),
                               u16inttype,
                               true
                             ),

compiler/ncal.pas

@@ -1836,7 +1836,8 @@ implementation
           realresdef:=tstoreddef(typedef);
         if realresdef.is_intregable then
           result:=LOC_REGISTER
-        else if realresdef.is_fpuregable then
+        else if (realresdef.typ=floatdef) and
+          not(cs_fp_emulation in current_settings.moduleswitches) then
           if use_vectorfpu(realresdef) then
             result:=LOC_MMREGISTER
           else
@@ -2092,7 +2093,8 @@ implementation
                   begin
                     if (current_procinfo.procdef.proctypeoption=potype_constructor) and
                        (procdefinition.proctypeoption=potype_constructor) and
-                       (nf_is_self in methodpointer.flags) then
+                       (methodpointer.nodetype=loadn) and
+                       (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then
                       vmttree:=cpointerconstnode.create(0,voidpointertype)
                     else
                       vmttree:=cpointerconstnode.create(1,voidpointertype);
@@ -2422,7 +2424,8 @@ implementation
           called, indirect constructor calls cannot be checked.
         }
         if assigned(methodpointer) and
-           not (nf_is_self in methodpointer.flags) then
+           not((methodpointer.nodetype=loadn) and
+               (loadnf_is_self in tloadnode(methodpointer).loadnodeflags)) then
           begin
             if (methodpointer.resultdef.typ = objectdef) then
               objectdf:=tobjectdef(methodpointer.resultdef)
@@ -2939,7 +2942,8 @@ implementation
               if (procdefinition.proctypeoption=potype_constructor) and
                  is_class(tprocdef(procdefinition).struct) and
                  assigned(methodpointer) and
-                 (nf_is_self in methodpointer.flags) then
+                 (methodpointer.nodetype=loadn) and
+                 (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then
                 resultdef:=voidtype
               else
                 resultdef:=procdefinition.returndef;
@@ -2967,6 +2971,14 @@ implementation
                   CGMessage(cg_e_cant_call_abstract_method);
               end;
 
+            { directly calling an interface/protocol/category/class helper
+              method via its type is not possible (always must be called via
+              the actual instance) }
+            if (methodpointer.nodetype=typen) and
+               (is_interface(methodpointer.resultdef) or
+                is_objc_protocol_or_category(methodpointer.resultdef)) then
+              CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
+
             { if an inherited con- or destructor should be  }
             { called in a con- or destructor then a warning }
             { will be made                                  }

compiler/ncgcal.pas

@@ -169,11 +169,16 @@ implementation
                  location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false,sizeof(pint));
                  if is_open_array(resultdef) then
                    begin
-                     if third=nil then
-                       InternalError(201103063);
-                     secondpass(third);
-                     cg.g_array_rtti_helper(current_asmdata.CurrAsmList,tarraydef(resultdef).elementdef,
-                       href,third.location,'FPC_DECREF_ARRAY');
+                     { if elementdef is not managed, omit fpc_decref_array
+                       because it won't do anything anyway }
+                     if is_managed_type(tarraydef(resultdef).elementdef) then
+                       begin
+                         if third=nil then
+                           InternalError(201103063);
+                         secondpass(third);
+                         cg.g_array_rtti_helper(current_asmdata.CurrAsmList,tarraydef(resultdef).elementdef,
+                           href,third.location,'FPC_DECREF_ARRAY');
+                       end;
                    end
                  else
                    cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
@@ -273,6 +278,10 @@ implementation
                              TCGCALLNODE
 *****************************************************************************}
 
+{$if first_mm_imreg = 0}
+  {$WARN 4044 OFF} { Comparison might be always false ... }
+{$endif}
+
     procedure tcgcallnode.extra_interrupt_code;
       begin
       end;

compiler/ncgcon.pas

@@ -282,12 +282,12 @@ implementation
               pool := current_asmdata.ConstPools[PoolMap[cst_type]];
 
               if cst_type in [cst_widestring, cst_unicodestring] then
-                entry := pool.FindOrAdd(pcompilerwidestring(value_str)^.data, len*cwidechartype.size)
+                entry := pool.FindOrAdd(pcompilerwidestring(value_str)^.data,len*cwidechartype.size)
               else
               if cst_type = cst_ansistring then
-                entry := PHashSetItem(TTagHashSet(pool).FindOrAdd(value_str, len, tstringdef(resultdef).encoding))
+                entry := PHashSetItem(TTagHashSet(pool).FindOrAdd(value_str,len,tstringdef(resultdef).encoding))
               else
-                entry := pool.FindOrAdd(value_str, len);
+                entry := pool.FindOrAdd(value_str,len);
 
               lab_str := TAsmLabel(entry^.Data);  // is it needed anymore?
 
@@ -458,7 +458,7 @@ implementation
 
 
 {*****************************************************************************
-                          TCGPOINTERCONSTNODE
+                          TCGGUIDCONSTNODE
 *****************************************************************************}
 
     procedure tcgguidconstnode.pass_generate_code;
@@ -469,7 +469,8 @@ implementation
         location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(16));
         { label for GUID }
         current_asmdata.getdatalabel(tmplabel);
-        current_asmdata.asmlists[al_typedconsts].concat(tai_align.create(const_align(16)));
+        maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
+        new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,tmplabel.name,const_align(16));
         current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(tmplabel));
         current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(longint(value.D1)));
         current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(value.D2));

compiler/ncgflw.pas

@@ -98,7 +98,7 @@ implementation
       nld,ncon,
       tgobj,paramgr,
       regvars,
-      cgutils,cgobj
+      cgutils,cgobj,nutils
       ;
 
 {*****************************************************************************
@@ -839,8 +839,10 @@ implementation
          include(flowcontrol,fc_exit);
          if assigned(left) then
            secondpass(left);
-
-         cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel);
+         if (fc_unwind in flowcontrol) then
+           cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel)
+         else
+           cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel);
        end;
 
 
@@ -858,7 +860,10 @@ implementation
 {$ifdef OLDREGVARS}
              load_all_regvars(current_asmdata.CurrAsmList);
 {$endif OLDREGVARS}
-             cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel)
+             if (fc_unwind in flowcontrol) then
+               cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel)
+             else
+               cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel)
            end
          else
            CGMessage(cg_e_break_not_allowed);
@@ -879,7 +884,10 @@ implementation
 {$ifdef OLDREGVARS}
              load_all_regvars(current_asmdata.CurrAsmList);
 {$endif OLDREGVARS}
-             cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel)
+             if (fc_unwind in flowcontrol) then
+               cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel)
+             else
+               cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel)
            end
          else
            CGMessage(cg_e_continue_not_allowed);
@@ -1031,22 +1039,26 @@ implementation
     { does the necessary things to clean up the object stack }
     { in the except block                                    }
     procedure cleanupobjectstack;
+      begin
+         cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+      end;
+
+    { generates code to be executed when another exeception is raised while
+      control is inside except block }
+    procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;entrylabel:TAsmLabel);
       var
-        paraloc1 : tcgpara;
+         exitlabel: tasmlabel;
       begin
-         cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK',false);
-         cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
-         paraloc1.init;
-         paramanager.getintparaloc(pocall_default,1,paraloc1);
-         cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
-         cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
-         paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-         cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
-         cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-         paraloc1.done;
+         { don't generate line info for internal cleanup }
+         list.concat(tai_marker.create(mark_NoLineInfoStart));
+         current_asmdata.getjumplabel(exitlabel);
+         cg.a_label(list,entrylabel);
+         free_exception(list,t,0,exitlabel,false);
+         { we don't need to save/restore registers here because reraise never }
+         { returns                                                            }
+         cg.a_call_name(list,'FPC_RAISE_NESTED',false);
+         cg.a_label(list,exitlabel);
+         cleanupobjectstack;
       end;
 
 
@@ -1061,7 +1073,6 @@ implementation
          exittrylabel,
          continuetrylabel,
          breaktrylabel,
-         doobjectdestroy,
          doobjectdestroyandreraise,
          oldCurrExitLabel,
          oldContinueLabel,
@@ -1070,7 +1081,6 @@ implementation
          exceptflowcontrol : tflowcontrol;
          destroytemps,
          excepttemps : texceptiontemps;
-         paraloc1 : tcgpara;
       label
          errorexit;
       begin
@@ -1158,63 +1168,40 @@ implementation
          { default handling except handling }
          if assigned(t1) then
            begin
-              { FPC_CATCHES must be called with
-                'default handler' flag (=-1)
+              { FPC_CATCHES with 'default handler' flag (=-1) need no longer be called,
+                it doesn't change any state and its return value is ignored (Sergei)
               }
-              paraloc1.init;
-              paramanager.getintparaloc(pocall_default,1,paraloc1);
-              cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,-1,paraloc1);
-              paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-              paraloc1.done;
 
               { the destruction of the exception object must be also }
-              { guarded by an exception frame                        }
-              current_asmdata.getjumplabel(doobjectdestroy);
-              current_asmdata.getjumplabel(doobjectdestroyandreraise);
+              { guarded by an exception frame, but it can be omitted }
+              { if there's no user code in 'except' block            }
 
-              get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
-              new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise);
-
-              { except block needs line info }
-              current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
-
-              { here we don't have to reset flowcontrol           }
-              { the default and on flowcontrols are handled equal }
-              secondpass(t1);
-              exceptflowcontrol:=flowcontrol;
+              if not (has_no_code(t1)) then
+               begin
+                 current_asmdata.getjumplabel(doobjectdestroyandreraise);
 
-              { don't generate line info for internal cleanup }
-              current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+                 get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
+                 new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise);
 
-              cg.a_label(current_asmdata.CurrAsmList,doobjectdestroyandreraise);
+                 { except block needs line info }
+                 current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
 
-              free_exception(current_asmdata.CurrAsmList,destroytemps,0,doobjectdestroy,false);
+                 { here we don't have to reset flowcontrol           }
+                 { the default and on flowcontrols are handled equal }
+                 secondpass(t1);
+                 exceptflowcontrol:=flowcontrol;
 
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+                 handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise);
 
-              paraloc1.init;
-              paramanager.getintparaloc(pocall_default,1,paraloc1);
-              cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
-              cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
-              paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-              paraloc1.done;
-              { we don't need to restore esi here because reraise never }
-              { returns                                                 }
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
-
-              cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
-              cleanupobjectstack;
-              unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
-              cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+                 unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
+                 cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+               end
+               else
+                 begin
+                   exceptflowcontrol:=flowcontrol;
+                   cleanupobjectstack;
+                   cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+                 end;
            end
          else
            begin
@@ -1228,9 +1215,7 @@ implementation
               cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
               { we must also destroy the address frame which guards }
               { exception object                                    }
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cleanupobjectstack;
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
@@ -1243,9 +1228,7 @@ implementation
               cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
               { we must also destroy the address frame which guards }
               { exception object                                    }
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cleanupobjectstack;
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
@@ -1258,9 +1241,7 @@ implementation
               cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
               { we must also destroy the address frame which guards }
               { exception object                                    }
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cleanupobjectstack;
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
@@ -1272,9 +1253,7 @@ implementation
            begin
               { do some magic for exit in the try block }
               cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
               { from g_exception_reason_load  }
@@ -1284,9 +1263,7 @@ implementation
          if fc_break in tryflowcontrol then
            begin
               cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
               { from g_exception_reason_load  }
@@ -1296,9 +1273,7 @@ implementation
          if fc_continue in tryflowcontrol then
            begin
               cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
               { from g_exception_reason_load  }
@@ -1337,11 +1312,9 @@ implementation
          oldCurrExitLabel,
          oldContinueLabel,
          doobjectdestroyandreraise,
-         doobjectdestroy,
          oldBreakLabel : tasmlabel;
          oldflowcontrol : tflowcontrol;
          excepttemps : texceptiontemps;
-         exceptref,
          href2: treference;
          paraloc1 : tcgpara;
          exceptvarsym : tlocalvarsym;
@@ -1358,9 +1331,7 @@ implementation
          paramanager.getintparaloc(pocall_default,1,paraloc1);
          cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc1);
          paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-         cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES',false);
-         cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+         cg.g_call(current_asmdata.CurrAsmList,'FPC_CATCHES');
 
          cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
          { is it this catch? No. go to next onlabel }
@@ -1378,11 +1349,6 @@ implementation
              exceptvarsym.localloc.size:=OS_ADDR;
              tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference);
              cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference);
-           end
-         else
-           begin
-             tg.GetTemp(current_asmdata.CurrAsmList,sizeof(pint),sizeof(pint),tt_normal,exceptref);
-             cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptref);
            end;
          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
 
@@ -1414,39 +1380,14 @@ implementation
               secondpass(right);
            end;
 
-         { don't generate lineinfo for internal cleanup }
-         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
-
-         current_asmdata.getjumplabel(doobjectdestroy);
-         cg.a_label(current_asmdata.CurrAsmList,doobjectdestroyandreraise);
+         handle_nested_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraise);
 
-         free_exception(current_asmdata.CurrAsmList,excepttemps,0,doobjectdestroy,false);
-
-         cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK',false);
-         cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
-         paramanager.getintparaloc(pocall_default,1,paraloc1);
-         cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
-         cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
-         paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-         cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
-         cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-         { we don't need to store/restore registers here because reraise never
-           returns                                                             }
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
-
-         cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
-         cleanupobjectstack;
          { clear some stuff }
          if assigned(exceptvarsym) then
            begin
              tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
              exceptvarsym.localloc.loc:=LOC_INVALID;
-           end
-         else
-           tg.Ungettemp(current_asmdata.CurrAsmList,exceptref);
+           end;
          cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
 
          if assigned(right) then
@@ -1616,28 +1557,31 @@ implementation
          else
            begin
              cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel);
-             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG);
-             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,reraiselabel);
-             if fc_exit in tryflowcontrol then
-               begin
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG);
-                  cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldCurrExitLabel);
-                  decconst:=1;
-               end
-             else
-               decconst:=2;
-             if fc_break in tryflowcontrol then
-               begin
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG);
-                  cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldBreakLabel);
-                  decconst:=1;
-               end
-             else
-               inc(decconst);
-             if fc_continue in tryflowcontrol then
+             if (tryflowcontrol*[fc_exit,fc_break,fc_continue]<>[]) then
                begin
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG);
-                  cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel);
+                 cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG);
+                 cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,reraiselabel);
+                 if fc_exit in tryflowcontrol then
+                   begin
+                     cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG);
+                     cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldCurrExitLabel);
+                     decconst:=1;
+                   end
+                 else
+                   decconst:=2;
+                 if fc_break in tryflowcontrol then
+                   begin
+                     cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG);
+                     cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldBreakLabel);
+                     decconst:=1;
+                   end
+                 else
+                   inc(decconst);
+                 if fc_continue in tryflowcontrol then
+                   begin
+                     cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG);
+                     cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel);
+                   end;
                end;
              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
              cg.a_label(current_asmdata.CurrAsmList,reraiselabel);

compiler/ncgld.pas

@@ -496,7 +496,7 @@ implementation
 
                      { virtual method ? }
                      if (po_virtualmethod in procdef.procoptions) and
-                        not(nf_inherited in flags) and
+                        not(loadnf_inherited in loadnodeflags) and
                         not is_objectpascal_helper(procdef.struct) then
                        begin
                          if (not assigned(current_procinfo) or

compiler/ncgutil.pas

@@ -190,6 +190,9 @@ implementation
 {*****************************************************************************
                                   Misc Helpers
 *****************************************************************************}
+{$if first_mm_imreg = 0}
+  {$WARN 4044 OFF} { Comparison might be always false ... }
+{$endif}
 
     procedure location_free(list: TAsmList; const location : TLocation);
       begin
@@ -1507,7 +1510,7 @@ implementation
         current_asmdata.CurrAsmList:=asmlist;
         hp:=cloadnode.create(sym,sym.owner);
         if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
-          include(hp.flags,nf_isinternal_ignoreconst);
+          include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
         hp:=finalize_data_node(hp);
         firstpass(hp);
         secondpass(hp);

compiler/ncnv.pas

@@ -269,7 +269,12 @@ implementation
           remain too so that not too many/few bits are laoded }
         if equal_defs(p.resultdef,def) and
            not is_bitpacked_access(p) then
-          p.resultdef:=def
+          begin
+            { don't replace encoded string constants to rawbytestring encoding.
+              preserve the codepage }
+            if not (is_rawbytestring(def) and (p.nodetype=stringconstn)) then
+              p.resultdef:=def
+          end
         else
          begin
            case convtype of
@@ -598,7 +603,7 @@ implementation
            (p.nodetype=stringconstn) and
            { don't cast to AnsiString if already casted to Wide/UnicodeString, issue #18266 }
            (tstringconstnode(p).cst_type in [cst_conststring,cst_shortstring,cst_longstring]) then
-          p:=ctypeconvnode.create_internal(p,cansistringtype)
+          p:=ctypeconvnode.create_internal(p,getansistringdef)
         else
           case p.resultdef.typ of
             enumdef :
@@ -933,7 +938,7 @@ implementation
                         ),
                         ccallparanode.create(
                           cordconstnode.create(
-                            tstringdef(resultdef).encoding,
+                            getparaencoding(resultdef),
                             u16inttype,
                             true
                           ),
@@ -994,7 +999,7 @@ implementation
              else
                begin
                  if tstringconstnode(left).len>255 then
-                   inserttypeconv(left,cansistringtype)
+                   inserttypeconv(left,getansistringdef)
                  else
                    inserttypeconv(left,cshortstringtype);
                end;
@@ -1025,23 +1030,14 @@ implementation
         newblock : tblocknode;
         newstat  : tstatementnode;
         restemp  : ttempcreatenode;
-        //sa : ansistring;
-        //cw : WideChar;
-        //l : SizeUInt;
+        sa : ansistring;
+        cw : tcompilerwidechar;
+        l : SizeUInt;
       begin
          result:=nil;
-         { we can't do widechar to ansichar conversions at compile time, since }
-         { this maps all non-ascii chars to '?' -> loses information           }
-
          if (left.nodetype=ordconstn) and
-            ((tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) or
-             (torddef(left.resultdef).ordtype=uchar) or
-             ((torddef(left.resultdef).ordtype=uwidechar) and
-              (current_settings.sourcecodepage<>CP_UTF8)
-             )
-            )
-             { widechar >=128 is destroyed }
-             {(tordconstnode(left).value.uvalue<128))} then
+            ((tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring,st_ansistring]) or
+             (torddef(left.resultdef).ordtype in [uchar,uwidechar])) then
            begin
               if (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
                begin
@@ -1057,22 +1053,29 @@ implementation
               else
                 begin
                   if (torddef(left.resultdef).ordtype=uwidechar) then
-                   begin
-                    if (current_settings.sourcecodepage<>CP_UTF8) then
-                      hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)))
-                    else
-                     begin
-                       exit;
-                       {Word(cw):=tcompilerwidechar(tordconstnode(left).value.uvalue);
-                       SetLength(sa,5);
-                       l:=UnicodeToUtf8(@(sa[1]),Length(sa),@cw,1);
-                       SetLength(sa,l-1);
-                       hp:=cstringconstnode.createstr(sa);}
-                     end
-                   end
+                    begin
+                      if (current_settings.sourcecodepage<>CP_UTF8) then
+                        begin
+                          if tordconstnode(left).value.uvalue>127 then
+                            Message(type_w_unicode_data_loss);
+                          hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)));
+                        end
+                      else
+                        begin
+                          cw:=tcompilerwidechar(tordconstnode(left).value.uvalue);
+                          SetLength(sa,5);
+                          l:=UnicodeToUtf8(@(sa[1]),Length(sa),@cw,1);
+                          SetLength(sa,l-1);
+                          hp:=cstringconstnode.createstr(sa);
+                        end
+                    end
                   else
                     hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue));
-                  tstringconstnode(hp).changestringtype(resultdef);
+                  { output string consts in local ansistring encoding }
+                  if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0) or (tstringdef(resultdef).encoding=globals.CP_NONE)) then
+                    tstringconstnode(hp).changestringtype(getansistringdef)
+                  else
+                    tstringconstnode(hp).changestringtype(resultdef);
                 end;
               result:=hp;
            end
@@ -1087,13 +1090,27 @@ implementation
                    para:=ccallparanode.create(left,nil);
                    { encoding required? }
                    if tstringdef(resultdef).stringtype=st_ansistring then
-                     para:=ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),para);
+                     para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para);
 
                    { create the procname }
                    if torddef(left.resultdef).ordtype<>uwidechar then
-                     procname:='fpc_char_to_'
+                     begin
+                       procname:='fpc_char_to_';
+                       if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then
+                         if nf_explicit in flags then
+                           Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
+                         else
+                           Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
+                     end
                    else
-                     procname:='fpc_uchar_to_';
+                     begin
+                       procname:='fpc_uchar_to_';
+                       if not (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
+                         if nf_explicit in flags then
+                           Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
+                         else
+                           Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
+                     end;
                    procname:=procname+tstringdef(resultdef).stringtypname;
 
                    { and finally the call }
@@ -1101,6 +1118,10 @@ implementation
                  end
                else
                  begin
+                   if nf_explicit in flags then
+                     Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
+                   else
+                     Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
                    newblock:=internalstatements(newstat);
                    restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
                    addstatement(newstat,restemp);
@@ -1133,14 +1154,11 @@ implementation
       begin
         result:=nil;
         if (left.nodetype=stringconstn) and
-           ((tstringdef(resultdef).stringtype=st_shortstring) or
-            ((tstringdef(resultdef).stringtype=st_ansistring) and
+           (((tstringdef(resultdef).stringtype=st_ansistring) and
              (tstringdef(resultdef).encoding<>CP_NONE)
             )
            ) and
-           ((tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
-            (current_settings.sourcecodepage<>CP_UTF8)
-           ) then
+           (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) then
           begin
             tstringconstnode(left).changestringtype(resultdef);
             Result:=left;
@@ -1163,7 +1181,34 @@ implementation
                       resultdef
                     );
             left:=nil;
-          end;
+          end
+        else if (left.nodetype=stringconstn) and
+                (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
+                (tstringdef(resultdef).stringtype=st_shortstring) then
+          begin
+            if not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str)) then
+              begin
+                tstringconstnode(left).changestringtype(resultdef);
+                Result:=left;
+                left:=nil;
+              end;
+          end
+        else if (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
+                not (tstringdef(resultdef).stringtype in [st_unicodestring,st_widestring]) then
+          begin
+            if nf_explicit in flags then
+              Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
+            else
+              Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
+          end
+        else if not (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
+                (tstringdef(resultdef).stringtype in [st_unicodestring,st_widestring]) then
+          begin
+            if nf_explicit in flags then
+              Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
+            else
+              Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
+          end
       end;
 
     function ttypeconvnode.typecheck_char_to_chararray : tnode;
@@ -1190,13 +1235,14 @@ implementation
             ((torddef(resultdef).ordtype<>uchar) or
              (torddef(left.resultdef).ordtype<>uwidechar) or
              (current_settings.sourcecodepage<>CP_UTF8))
-             { >= 128 is replaced by '?' currently -> loses information }
-             {(tordconstnode(left).value.uvalue<128))} then
+         then
            begin
              if (torddef(resultdef).ordtype=uchar) and
                 (torddef(left.resultdef).ordtype=uwidechar) and
                 (current_settings.sourcecodepage<>CP_UTF8) then
               begin
+                if tordconstnode(left).value.uvalue>127 then
+                  Message(type_w_unicode_data_loss);
                 hp:=cordconstnode.create(
                       ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue))),
                       cchartype,true);
@@ -1368,7 +1414,7 @@ implementation
               (is_widestring(left.resultdef) or
                is_unicodestring(left.resultdef)) then
              begin
-               inserttypeconv(left,cansistringtype);
+               inserttypeconv(left,getansistringdef);
                { the second pass of second_cstring_to_pchar expects a  }
                { strinconstn, but this may become a call to the        }
                { widestring manager in case left contains "high ascii" }
@@ -1451,7 +1497,7 @@ implementation
           result := ccallnode.createinternres(
                       'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
                       ccallparanode.create(
-                        cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),
+                        cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
                         ccallparanode.create(left,nil)
                       ),
                       resultdef
@@ -1524,7 +1570,7 @@ implementation
                         'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
                          ccallparanode.create(
                            cordconstnode.create(
-                             tstringdef(resultdef).encoding,
+                             getparaencoding(resultdef),
                              u16inttype,
                              true
                            ),
@@ -2269,15 +2315,17 @@ implementation
               (
                 ((not is_widechararray(left.resultdef) and
                   not is_wide_or_unicode_string(left.resultdef)) or
-                 (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) or
-                 (current_settings.sourcecodepage<>CP_UTF8)
+                 (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring,st_ansistring])
                 )
-                 { non-ascii chars would be replaced with '?' -> loses info }
-                 {not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str)))}
               ) then
               begin
-                tstringconstnode(left).changestringtype(resultdef);
+                { output string consts in local ansistring encoding }
+                if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0)or(tstringdef(resultdef).encoding=globals.CP_NONE)) then
+                  tstringconstnode(left).changestringtype(getansistringdef)
+                else
+                  tstringconstnode(left).changestringtype(resultdef);
                 result:=left;
+                resultdef:=left.resultdef;
                 left:=nil;
                 exit;
               end;
@@ -2982,15 +3030,9 @@ implementation
           end
         { encoding parameter required? }
         else if (tstringdef(resultdef).stringtype=st_ansistring) and
-            ((tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring]) or
-             { ansistring to ansistring and no RawByteString envolved? }
-             (//(tstringdef(resultdef).encoding<>65535) and
-              (tstringdef(left.resultdef).stringtype=st_ansistring)
-              //(tstringdef(left.resultdef).encoding<>65535)
-             )
-            ) then
+                (tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring,st_ansistring]) then
             result:=ccallnode.createinternres(procname,
-              ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),
+              ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
               ccallparanode.create(left,nil)),resultdef)
         else
           result:=ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);

compiler/ncon.pas

@@ -926,7 +926,7 @@ implementation
           cst_shortstring :
             resultdef:=cshortstringtype;
           cst_ansistring :
-            resultdef:=cansistringtype;
+            resultdef:=getansistringdef;
           cst_unicodestring :
             resultdef:=cunicodestringtype;
           cst_widestring :
@@ -993,7 +993,7 @@ implementation
            not(cst_type in [cst_widestring,cst_unicodestring]) then
           begin
             initwidestring(pw);
-            ascii2unicode(value_str,len,pw);
+            ascii2unicode(value_str,len,current_settings.sourcecodepage,pw);
             ansistringdispose(value_str,len);
             pcompilerwidestring(value_str):=pw;
           end
@@ -1002,26 +1002,25 @@ implementation
           if (cst_type in [cst_widestring,cst_unicodestring]) and
             not(tstringdef(def).stringtype in [st_widestring,st_unicodestring]) then
             begin
-              if (tstringdef(def).encoding=CP_UTF8) or
-                 (current_settings.sourcecodepage=CP_UTF8) then
+              cp1:=tstringdef(def).encoding;
+              if (cp1=CP_NONE) or (cp1=0) then
+                cp1:=current_settings.sourcecodepage;
+              if (cp1=CP_UTF8) then
                 begin
                   pw:=pcompilerwidestring(value_str);
-                  l:=(getlengthwidestring(pw)*4)+1;
+                  l2:=len;
+                  l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),l2);
                   getmem(pc,l);   
-                  l2:=UnicodeToUtf8(pc,l,PUnicodeChar(pw^.data),getlengthwidestring(pw));
-                  if (l<>l2) then
-                    ReAllocMem(pc,l2);
-                  len:=l2-1;
+                  UnicodeToUtf8(pc,l,PUnicodeChar(pw^.data),l2);
+                  len:=l-1;
                   donewidestring(pw);
                   value_str:=pc;
-                  if (tstringdef(def).encoding<>CP_UTF8) then
-                    tstringdef(def).encoding:=CP_UTF8;
                 end
               else
                 begin
                   pw:=pcompilerwidestring(value_str);
                   getmem(pc,getlengthwidestring(pw)+1);
-                  unicode2ascii(pw,pc,tstringdef(def).encoding);
+                  unicode2ascii(pw,pc,cp1);
                   donewidestring(pw);
                   value_str:=pc;
                 end;
@@ -1031,12 +1030,65 @@ implementation
              not(cst_type in [cst_widestring,cst_unicodestring]) then
             begin
               cp1:=tstringdef(def).encoding;
+              if cp1=0 then
+                cp1:=current_settings.sourcecodepage;
               if (cst_type = cst_ansistring) then
-                cp2:=tstringdef(resultdef).encoding
+                begin
+                  cp2:=tstringdef(resultdef).encoding;
+                  if cp2=0 then
+                    cp2:=current_settings.sourcecodepage;
+                end
               else if (cst_type in [cst_shortstring,cst_conststring,cst_longstring]) then
                 cp2:=current_settings.sourcecodepage;
-              if cpavailable(cp1) and cpavailable(cp2) then
-                changecodepage(value_str,len,cp2,value_str,cp1);
+              { don't change string if codepages are equal or string length is 0 }  
+              if (cp1<>cp2) and (len>0) then
+                begin
+                  if cpavailable(cp1) and cpavailable(cp2) then
+                    changecodepage(value_str,len,cp2,value_str,cp1)
+                  else if (cp1 <> CP_NONE) and (cp2 <> CP_NONE) then
+                    begin
+                      { if source encoding is UTF8 convert using UTF8->UTF16->destination encoding }
+                      if (cp2=CP_UTF8) then
+                        begin
+                          if not cpavailable(cp1) then
+                            Message1(option_code_page_not_available,IntToStr(cp1));
+                          initwidestring(pw);
+                          setlengthwidestring(pw,len);
+                          l:=Utf8ToUnicode(PUnicodeChar(pw^.data),len,value_str,len);
+                          if (l<>getlengthwidestring(pw)) then
+                            begin
+                              setlengthwidestring(pw,l);
+                              ReAllocMem(value_str,l);
+                            end;
+                          unicode2ascii(pw,value_str,cp1);
+                          donewidestring(pw);
+                        end
+                      else
+                      { if destination encoding is UTF8 convert using source encoding->UTF16->UTF8 }
+                      if (cp1=CP_UTF8) then
+                        begin
+                          if not cpavailable(cp2) then
+                            Message1(option_code_page_not_available,IntToStr(cp2));
+                          initwidestring(pw);
+                          setlengthwidestring(pw,len);
+                          ascii2unicode(value_str,len,cp2,pw);
+                          l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),len);
+                          if l<>len then
+                            ReAllocMem(value_str,l);
+                          len:=l-1;
+                          UnicodeToUtf8(value_str,PUnicodeChar(pw^.data),l);
+                          donewidestring(pw);
+                        end
+                      else
+                        begin
+                          { output error message that encoding is not available for the compiler }
+                          if not cpavailable(cp1) then
+                            Message1(option_code_page_not_available,IntToStr(cp1));
+                          if not cpavailable(cp2) then
+                            Message1(option_code_page_not_available,IntToStr(cp2));
+                        end;
+                    end;
+                end;
             end;
         cst_type:=st2cst[tstringdef(def).stringtype];
         resultdef:=def;

compiler/nflw.pas

@@ -1985,6 +1985,7 @@ implementation
       begin
          result:=nil;
          include(current_procinfo.flags,pi_do_call);
+         include(current_procinfo.flags,pi_uses_exceptions);
          expectloc:=LOC_VOID;
          firstpass(left);
          { on statements }
@@ -2003,6 +2004,7 @@ implementation
     constructor ttryfinallynode.create(l,r:tnode);
       begin
         inherited create(tryfinallyn,l,r,nil,nil);
+        include(current_procinfo.flags,pi_uses_exceptions);
         implicitframe:=false;
       end;
 

compiler/ninl.pas

@@ -325,7 +325,7 @@ implementation
         { for ansistrings insert the encoding argument }
         if is_ansistring(dest.resultdef) then
           newparas:=ccallparanode.create(cordconstnode.create(
-            tstringdef(dest.resultdef).encoding,u16inttype,true),newparas);
+            getparaencoding(dest.resultdef),u16inttype,true),newparas);
 
         { free the errornode we generated in the beginning }
         result.free;
@@ -378,7 +378,7 @@ implementation
             if (tstringconstnode(n).len<=255) then
               inserttypeconv(n,cshortstringtype)
             else
-              inserttypeconv(n,cansistringtype)
+              inserttypeconv(n,getansistringdef)
           else if is_widechararray(n.resultdef) then
             inserttypeconv(n,cwidestringtype);
       end;
@@ -759,7 +759,7 @@ implementation
                   { 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(
-                      tstringdef(para.left.resultdef).encoding,u16inttype,true),para);
+                      getparaencoding(para.left.resultdef),u16inttype,true),para);
                   { create the call statement }
                   addstatement(Tstatementnode(newstatement),
                     ccallnode.createintern(name,para));
@@ -967,7 +967,7 @@ implementation
                 { (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,cansistringtype);
+                inserttypeconv(filepara.left,getansistringdef);
                 filepara.resultdef:=filepara.left.resultdef;
                 if codegenerror then
                   exit;
@@ -2270,7 +2270,7 @@ implementation
                   case left.resultdef.typ of
                     variantdef:
                       begin
-                        inserttypeconv(left,cansistringtype);
+                        inserttypeconv(left,getansistringdef);
                       end;
 
                     stringdef :

compiler/nld.pas

@@ -33,13 +33,24 @@ interface
        symconst,symbase,symtype,symsym,symdef;
 
     type
-       Trttidatatype=(rdt_normal,rdt_ord2str,rdt_str2ord);
+       Trttidatatype = (rdt_normal,rdt_ord2str,rdt_str2ord);
+
+       tloadnodeflags = (
+         loadnf_is_self,
+         loadnf_load_self_pointer,
+         loadnf_inherited,
+         { the loadnode is generated internally and a varspez=vs_const should be ignore,
+           this requires that the parameter is actually passed by value
+           Be really carefull when using this flag! }
+         loadnf_isinternal_ignoreconst
+        );
 
        tloadnode = class(tunarynode)
        protected
           fprocdef : tprocdef;
           fprocdefderef : tderef;
        public
+          loadnodeflags : set of tloadnodeflags;
           symtableentry : tsym;
           symtableentryderef : tderef;
           symtable : TSymtable;
@@ -190,6 +201,7 @@ implementation
         ppufile.getderef(symtableentryderef);
         symtable:=nil;
         ppufile.getderef(fprocdefderef);
+        ppufile.getsmallset(loadnodeflags);
       end;
 
 
@@ -198,6 +210,7 @@ implementation
         inherited ppuwrite(ppufile);
         ppufile.putderef(symtableentryderef);
         ppufile.putderef(fprocdefderef);
+        ppufile.putsmallset(loadnodeflags);
       end;
 
 
@@ -245,7 +258,7 @@ implementation
         result:=(symtable.symtabletype=parasymtable) and
                 (symtableentry.typ=paravarsym) and
                 not(vo_has_local_copy in tparavarsym(symtableentry).varoptions) and
-                not(nf_load_self_pointer in flags) and
+                not(loadnf_load_self_pointer in loadnodeflags) and
                 paramanager.push_addr_param(tparavarsym(symtableentry).varspez,tparavarsym(symtableentry).vardef,tprocdef(symtable.defowner).proccalloption);
       end;
 
@@ -259,7 +272,7 @@ implementation
            constsym:
              begin
                if tconstsym(symtableentry).consttyp=constresourcestring then
-                 resultdef:=cansistringtype
+                 resultdef:=getansistringdef
                else
                  internalerror(22799);
              end;
@@ -309,7 +322,7 @@ implementation
                       (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
                      resultdef:=tclassrefdef.create(resultdef)
                    else if (is_object(resultdef) or is_record(resultdef)) and
-                           (nf_load_self_pointer in flags) then
+                           (loadnf_load_self_pointer in loadnodeflags) then
                      resultdef:=tpointerdef.create(resultdef);
                  end
                else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then
@@ -516,6 +529,7 @@ implementation
       var
         hp : tnode;
         useshelper : boolean;
+        oldassignmentnode : tassignmentnode;
       begin
         result:=nil;
         resultdef:=voidtype;
@@ -524,7 +538,14 @@ implementation
         set_unique(left);
 
         typecheckpass(left);
+
+        { PI. This is needed to return correct resultdef of add nodes for ansistrings
+          rawbytestring return needs to be replaced by left.resultdef }
+        oldassignmentnode:=aktassignmentnode;
+        aktassignmentnode:=self;
         typecheckpass(right);
+        aktassignmentnode:=oldassignmentnode;
+
         set_varstate(right,vs_read,[vsf_must_be_valid]);
         set_varstate(left,vs_written,[]);
         if codegenerror then
@@ -587,7 +608,9 @@ implementation
                   if (right.nodetype=stringconstn) and
                      (tstringconstnode(right).len=0) then
                     useshelper:=false;
-                end;
+                end
+              else if (tstringdef(right.resultdef).stringtype in [st_unicodestring,st_widestring]) then
+                Message2(type_w_implicit_string_cast_loss,right.resultdef.typename,left.resultdef.typename);
              { rest is done in pass 1 (JM) }
              if useshelper then
                exit;

compiler/nmat.pas

@@ -102,7 +102,7 @@ implementation
       defutil,
       htypechk,pass_1,
       cgbase,
-      ncon,ncnv,ncal,nadd,
+      ncon,ncnv,ncal,nadd,nld,nbas,nflw,
       nutils;
 
 {****************************************************************************
@@ -117,7 +117,8 @@ implementation
 
         if is_constintnode(right) then
           begin
-            if tordconstnode(right).value = 1 then
+            rv:=tordconstnode(right).value;
+            if rv = 1 then
               begin
                 case nodetype of
                   modn:
@@ -127,12 +128,19 @@ implementation
                 end;
                 exit;
               end;
-            if tordconstnode(right).value = 0 then
+            if rv = 0 then
               begin
                 Message(parser_e_division_by_zero);
                 { recover }
                 tordconstnode(right).value := 1;
               end;
+            if (nf_isomod in flags) and
+              (rv<=0) then
+               begin
+                 Message(cg_e_mod_only_defined_for_pos_quotient);
+                 { recover }
+                 tordconstnode(right).value := 1;
+               end;
           end;
 
         if is_constintnode(right) and is_constintnode(left) then
@@ -142,7 +150,18 @@ implementation
 
             case nodetype of
               modn:
-                result:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
+                if nf_isomod in flags then
+                  begin
+                    if lv>=0 then
+                      result:=create_simplified_ord_const(lv mod rv,resultdef,forinline)
+                    else
+                      if ((-lv) mod rv)=0 then
+                        result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline)
+                      else
+                        result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline);
+                  end
+                else
+                  result:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
               divn:
                 result:=create_simplified_ord_const(lv div rv,resultdef,forinline);
             end;
@@ -152,8 +171,12 @@ implementation
 
     function tmoddivnode.pass_typecheck:tnode;
       var
+        else_block,
         hp,t : tnode;
         rd,ld : torddef;
+        else_statements,
+        statements : tstatementnode;
+        result_data : ttempcreatenode;
       begin
          result:=nil;
          typecheckpass(left);
@@ -287,6 +310,42 @@ implementation
             include(hp.flags,nf_is_currency);
             result:=hp;
           end;
+
+         if (nodetype=modn) and (nf_isomod in flags) then
+           begin
+             result:=internalstatements(statements);
+             else_block:=internalstatements(else_statements);
+             result_data:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
+
+             { right <=0? }
+             addstatement(statements,cifnode.create(caddnode.create(lten,right.getcopy,cordconstnode.create(0,resultdef,false)),
+               { then: result:=left mod right }
+               ccallnode.createintern('fpc_divbyzero',nil),
+               nil
+               ));
+
+             { prepare else block }
+             { result:=(-left) mod right }
+             addstatement(else_statements,cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,cunaryminusnode.create(left.getcopy),right.getcopy)));
+             { result<>0? }
+             addstatement(else_statements,cifnode.create(caddnode.create(unequaln,ctemprefnode.create(result_data),cordconstnode.create(0,resultdef,false)),
+               { then: result:=right-result }
+               cassignmentnode.create(ctemprefnode.create(result_data),caddnode.create(subn,right.getcopy,ctemprefnode.create(result_data))),
+               nil
+               ));
+
+             addstatement(statements,result_data);
+             { if left>=0 }
+             addstatement(statements,cifnode.create(caddnode.create(gten,left.getcopy,cordconstnode.create(0,resultdef,false)),
+               { then: result:=left mod right }
+               cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,left.getcopy,right.getcopy)),
+               { else block }
+               else_block
+               ));
+
+             addstatement(statements,ctempdeletenode.create_normal_temp(result_data));
+             addstatement(statements,ctemprefnode.create(result_data));
+           end;
       end;
 
 

compiler/nmem.pas

@@ -782,7 +782,7 @@ implementation
             (tstringconstnode(left).cst_type=cst_conststring) then
            begin
              if tstringconstnode(left).len>255 then
-               inserttypeconv(left,cansistringtype)
+               inserttypeconv(left,getansistringdef)
              else
                inserttypeconv(left,cshortstringtype);
            end;

compiler/node.pas

@@ -224,21 +224,17 @@ interface
          nf_memseg,
          nf_callunique,
 
-         { tloadnode }
+         { tloadnode/ttypeconvnode }
          nf_absolute,
-         nf_is_self,
-         nf_load_self_pointer,
-         nf_inherited,
-         { the loadnode is generated internally and a varspez=vs_const should be ignore,
-           this requires that the parameter is actually passed by value
-           Be really carefull when using this flag! }
-         nf_isinternal_ignoreconst,
 
          { taddnode }
          nf_is_currency,
          nf_has_pointerdiv,
          nf_short_bool,
 
+         { tmoddivnode }
+         nf_isomod,
+
          { tassignmentnode }
          nf_assign_done_in_right,
 
@@ -1295,4 +1291,11 @@ implementation
             right.isequal(tbinopnode(p).left));
       end;
 
+begin
+{$push}{$warnings off}
+  { taitype should fit into a 4 byte set for speed reasons }
+  if ord(high(tnodeflags))>31 then
+    internalerror(201110301);
+{$pop}
 end.
+

compiler/nopt.pas

@@ -346,7 +346,7 @@ begin
       if is_ansistring(p.resultdef) then
         para:=ccallparanode.create(
                 cordconstnode.create(
-                  tstringdef(p.resultdef).encoding,
+                  getparaencoding(p.resultdef),
                   u16inttype,
                   true
                 ),
@@ -370,7 +370,7 @@ begin
       if is_ansistring(p.resultdef) then
         para:=ccallparanode.create(
                 cordconstnode.create(
-                  tstringdef(p.resultdef).encoding,
+                  getparaencoding(p.resultdef),
                   u16inttype,
                   true
                 ),

compiler/nutils.pas

@@ -454,7 +454,7 @@ implementation
         if assigned(srsym) then
           begin
             result:=cloadnode.create(srsym,srsym.owner);
-            include(result.flags,nf_is_self);
+            include(tloadnode(result).loadnodeflags,loadnf_is_self);
           end
         else
           begin
@@ -491,7 +491,7 @@ implementation
         if assigned(srsym) then
           begin
             result:=cloadnode.create(srsym,srsym.owner);
-            include(result.flags,nf_load_self_pointer);
+            include(tloadnode(result).loadnodeflags,loadnf_load_self_pointer);
           end
         else
           begin
@@ -602,6 +602,13 @@ implementation
                cnilnode.create
                );
           end
+        else if (p.resultdef.typ=variantdef) then
+          begin
+            result:=ccallnode.createintern('fpc_variant_init',
+              ccallparanode.create(
+                ctypeconvnode.create_internal(p,search_system_type('TVARDATA').typedef),
+              nil));
+          end
         else
           begin
             result:=ccallnode.createintern('fpc_initialize',
@@ -670,6 +677,13 @@ implementation
                cnilnode.create
                ));
           end
+        else if p.resultdef.typ=variantdef then
+          begin
+            result:=ccallnode.createintern('fpc_variant_clear',
+              ccallparanode.create(
+                ctypeconvnode.create_internal(p,search_system_type('TVARDATA').typedef),
+              nil));
+          end
         else
           result:=ccallnode.createintern('fpc_finalize',
                 ccallparanode.create(

compiler/ogcoff.pas

@@ -1629,6 +1629,8 @@ const pemagic : array[0..3] of byte = (
                rel_type:=RELOC_RVA;
              IMAGE_REL_ARM_BRANCH24:
                rel_type:=RELOC_RELATIVE_24;
+             IMAGE_REL_ARM_SECREL:
+               rel_type:=RELOC_SECREL32;
 {$endif arm}
 {$ifdef i386}
              IMAGE_REL_I386_PCRLONG :

compiler/ogelf.pas

@@ -1282,7 +1282,7 @@ implementation
             idtxt  : 'ELF';
             asmbin : '';
             asmcmd : '';
-            supported_targets : [system_x86_64_linux];
+            supported_targets : [system_x86_64_linux,system_x86_64_freebsd];
             flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
             labelprefix : '.L';
             comment : '';

compiler/options.pas

@@ -78,7 +78,7 @@ implementation
 
 uses
   widestr,
-  {$ifdef VER2_4}ccharset{$else VER2_4}charset{$endif VER2_4},
+  {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif},
   SysUtils,
   version,
   cutils,cmsgs,
@@ -867,11 +867,12 @@ begin
                  'c' :
                    begin
                      if (upper(more)='UTF8') or (upper(more)='UTF-8') then
-                        init_settings.sourcecodepage:=CP_UTF8
+                       init_settings.sourcecodepage:=CP_UTF8
                      else if not(cpavailable(more)) then
                        Message1(option_code_page_not_available,more)
                      else
                        init_settings.sourcecodepage:=codepagebyname(more);
+                     include(init_settings.moduleswitches,cs_explicit_codepage);
                    end;
                  'C' :
                    RCCompiler := More;
@@ -2508,7 +2509,7 @@ begin
   def_system_macro('FPC_HAS_RESSTRINITS');
 
 { these cpus have an inline rol/ror implementaion }
-{$if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64)}
+{$ifdef cpurox}
   def_system_macro('FPC_HAS_INTERNAL_ROX');
 {$endif}
 

compiler/opttail.pas

@@ -127,7 +127,7 @@ unit opttail;
 
                         { "cast" away const varspezs }
                         loadnode:=cloadnode.create(paranode.parasym,paranode.parasym.owner);
-                        include(loadnode.flags,nf_isinternal_ignoreconst);
+                        include(tloadnode(loadnode).loadnodeflags,loadnf_isinternal_ignoreconst);
 
                         addstatement(copystatements,
                           cassignmentnode.create(

compiler/paramgr.pas

@@ -238,6 +238,9 @@ implementation
         result:=[];
       end;
 
+{$if first_mm_imreg = 0}
+  {$WARN 4044 OFF} { Comparison might be always false ... }
+{$endif}
 
     procedure tparamanager.allocparaloc(list: TAsmList; const paraloc: pcgparalocation);
       begin
@@ -435,7 +438,7 @@ implementation
         p.init_paraloc_info(callbothsides);
         result:=p.calleeargareasize;
       end;
-      
+
 
     function tparamanager.parseparaloc(parasym: tparavarsym; const s: string): boolean;
       begin

compiler/pass_2.pas

@@ -35,6 +35,8 @@ uses
          fc_continue,
          fc_inflowcontrol,
          fc_gotolabel,
+         { in try block of try..finally }
+         fc_unwind,
          { the left side of an expression is already handled, so we are
            not allowed to do ssl }
          fc_lefthandled);
@@ -199,7 +201,7 @@ implementation
             if (not codegenerror) then
              begin
                if (p.location.loc<>p.expectloc) then
-                 Comment(V_Warning,'Location not equal to expectloc: '+nodetype2str[p.nodetype]);
+                 Comment(V_Warning,'Location ('+tcgloc2str[p.location.loc]+') not equal to expectloc ('+tcgloc2str[p.expectloc]+'): '+nodetype2str[p.nodetype]);
                if (p.location.loc=LOC_INVALID) then
                  Comment(V_Warning,'Location not set in secondpass: '+nodetype2str[p.nodetype]);
              end;

compiler/pdecl.pas

@@ -554,7 +554,7 @@ implementation
                                   Message(parser_e_invalid_codepage);
                                   tordconstnode(p).value:=0;
                                 end;
-                                tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
+                              tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
                             end;
                           p.free;
                         end;

compiler/pdecsub.pas

@@ -1222,7 +1222,7 @@ implementation
             { Add ObjectSymtable to be able to find nested type definitions }
             popclass:=0;
             if assigned(pd.struct) and
-               (pd.parast.symtablelevel=normal_function_level) and
+               (pd.parast.symtablelevel>=normal_function_level) and
                not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
               begin
                 popclass:=push_nested_hierarchy(pd.struct);
@@ -1276,7 +1276,7 @@ implementation
             { Add ObjectSymtable to be able to find generic type definitions }
             popclass:=0;
             if assigned(pd.struct) and
-               (pd.parast.symtablelevel=normal_function_level) and
+               (pd.parast.symtablelevel>=normal_function_level) and
                not (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
               begin
                 popclass:=push_nested_hierarchy(pd.struct);
@@ -3218,7 +3218,12 @@ const
                      po_comp:=[po_classmethod,po_methodpointer];
 
                    if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or
-                      (fwpd.proctypeoption <> currpd.proctypeoption) then
+                      (fwpd.proctypeoption <> currpd.proctypeoption) or
+                      { if the implementation version has an "overload" modifier,
+                        the interface version must also have it (otherwise we can
+                        get annoying crashes due to interface crc changes) }
+                      (not(po_overload in fwpd.procoptions) and
+                       (po_overload in currpd.procoptions)) then
                      begin
                        MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
                                    fwpd.fullprocname(false));
@@ -3358,7 +3363,7 @@ const
                   begin
                     MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
                     break;
-                  end;
+                  end
                end
               else
                begin

compiler/pdecvar.pas

@@ -401,6 +401,7 @@ implementation
                 not (m_delphi in current_settings.modeswitches) then
                 Message(parser_e_cant_publish_that_property);
               { create a list of the parameters }
+              p.parast:=tparasymtable.create(nil,0);
               symtablestack.push(p.parast);
               sc:=TFPObjectList.create(false);
               repeat
@@ -512,11 +513,10 @@ implementation
                   p.propdef:=tpropertysym(overridden).propdef;
                   p.index:=tpropertysym(overridden).index;
                   p.default:=tpropertysym(overridden).default;
-                  p.propoptions:=tpropertysym(overridden).propoptions;
-                  p.parast.free;
-                  p.parast:=tpropertysym(overridden).parast.getcopy;
+                  p.propoptions:=tpropertysym(overridden).propoptions + [ppo_overrides];
                   if ppo_hasparameters in p.propoptions then
                     begin
+                      p.parast:=tpropertysym(overridden).parast.getcopy;
                       add_parameters(p,readprocdef,writeprocdef);
                       paranr:=p.parast.SymList.Count;
                     end;

compiler/pexpr.pas

@@ -133,7 +133,7 @@ implementation
          else
            begin
              if cs_ansistrings in current_settings.localswitches then
-               def:=cansistringtype
+               def:=getansistringdef
              else
                def:=cshortstringtype;
            end;
@@ -923,7 +923,7 @@ implementation
                   the function directly and not through the vmt (PFV) }
                 if (cnf_inherited in callflags) then
                   begin
-                    include(p2.flags,nf_inherited);
+                    include(tloadnode(p2).loadnodeflags,loadnf_inherited);
                     p1.free;
                     p1:=load_self_node;
                   end;
@@ -1184,7 +1184,7 @@ implementation
     { the ID token has to be consumed before calling this function }
     procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags);
       var
-         isclassref  : boolean;
+        isclassref:boolean;
       begin
          if sym=nil then
            begin
@@ -1205,7 +1205,7 @@ implementation
                  isclassref:=(p1.resultdef.typ=classrefdef);
                end
               else
-               isclassref:=false;
+                isclassref:=false;
 
               { we assume, that only procsyms and varsyms are in an object }
               { symbol table, for classes, properties are allowed          }
@@ -1449,11 +1449,16 @@ implementation
                     p1:=nil;
                     if is_member_read(srsym,srsymtable,p1,hdef) then
                       begin
-                        { if the field was originally found in an    }
-                        { objectsymtable, it means it's part of self
-                          if only method from which it was called is
-                          not class static                          }
+                        { if the field was originally found in an     }
+                        { objectsymtable, it means it's part of self  }
+                        { if only method from which it was called is  }
+                        { not class static                            }
                         if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
+                          { if we are accessing a owner procsym from the nested }
+                          { class we need to call it as a class member          }
+                          if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
+                            p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
+                          else
                           if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
                             p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
                           else
@@ -1608,7 +1613,7 @@ implementation
                       begin
                         p1:=cloadnode.create(srsym,srsymtable);
                         do_typecheckpass(p1);
-                        p1.resultdef:=cansistringtype;
+                        p1.resultdef:=getansistringdef;
                       end
                     else
                       p1:=genconstsymtree(tconstsym(srsym));
@@ -1620,6 +1625,11 @@ implementation
                     { check if it's a method/class method }
                     if is_member_read(srsym,srsymtable,p1,hdef) then
                       begin
+                        { if we are accessing a owner procsym from the nested }
+                        { class we need to call it as a class member          }
+                        if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
+                          assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
+                          p1:=cloadvmtaddrnode.create(ctypenode.create(hdef));
                         { not srsymtable.symtabletype since that can be }
                         { withsymtable as well                          }
                         if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
@@ -1648,7 +1658,12 @@ implementation
                     if is_member_read(srsym,srsymtable,p1,hdef) then
                       begin
                         if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
-                           if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
+                          { if we are accessing a owner procsym from the nested }
+                          { class we need to call it as a class member          }
+                          if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
+                            p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
+                          else
+                          if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
                           { no self node in static class methods }
                             p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
                           else
@@ -3009,7 +3024,11 @@ implementation
                _OP_NOT :
                  p1:=cnotnode.create(p1);
                _OP_MOD :
-                 p1:=cmoddivnode.create(modn,p1,p2);
+                 begin
+                   p1:=cmoddivnode.create(modn,p1,p2);
+                   if m_iso in current_settings.modeswitches then
+                     include(p1.flags,nf_isomod);
+                 end;
                _OP_SHL :
                  p1:=cshlshrnode.create(shln,p1,p2);
                _OP_SHR :
@@ -3075,7 +3094,7 @@ implementation
            _ASSIGNMENT :
              begin
                 consume(_ASSIGNMENT);
-                if (p1.resultdef.typ=procvardef) then
+                if assigned(p1.resultdef) and (p1.resultdef.typ=procvardef) then
                   getprocvardef:=tprocvardef(p1.resultdef);
                 p2:=sub_expr(opcompare,true,false);
                 if assigned(getprocvardef) then

compiler/pinline.pas

@@ -57,7 +57,7 @@ implementation
        scanner,
        pbase,pexpr,
        { codegen }
-       cgbase
+       cgbase,procinfo
        ;
 
 
@@ -508,12 +508,22 @@ implementation
         isarray:=is_dynamic_array(destppn.resultdef);
         if not((destppn.resultdef.typ=stringdef) or
                isarray) then
-         begin
-           CGMessage(type_e_mismatch);
-           paras.free;
-           exit;
-         end;
-
+          begin
+            { possibly generic involved? }
+            if df_generic in current_procinfo.procdef.defoptions then
+              begin
+                result.free;
+                result:=internalstatements(newstatement);
+                paras.free;
+                exit;
+              end
+            else
+              begin
+                CGMessage(type_e_mismatch);
+                paras.free;
+                exit;
+              end;
+          end;
         { only dynamic arrays accept more dimensions }
         if (dims>1) then
          begin
@@ -581,10 +591,10 @@ implementation
             newblock:=ccallnode.createintern(
               'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
               ccallparanode.create(
-                cordconstnode.create(tstringdef(destppn.resultdef).encoding,u16inttype,true),
+                cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true),
                 paras
               )
-            );           
+            );
          end
         else
          begin

compiler/pmodules.pas

@@ -40,7 +40,7 @@ implementation
        wpoinfo,
        aasmtai,aasmdata,aasmcpu,aasmbase,
        cgbase,cgobj,
-       nbas,ncgutil,
+       nbas,nutils,ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
        pexports,
@@ -351,7 +351,7 @@ implementation
           ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0))
         else
           { Nil pointer to resource information }
-          {$IFDEF CPU32}
+          {$IFNDEF cpu64bitaddr}
           ResourceInfo.Concat(Tai_const.Create_32bit(0));
           {$ELSE}
           ResourceInfo.Concat(Tai_const.Create_64bit(0));
@@ -987,8 +987,6 @@ implementation
 
     function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo;
       begin
-        { update module flags }
-        current_module.flags:=current_module.flags or flag;
         { create procdef }
         case flag of
           uf_init :
@@ -1311,7 +1309,8 @@ implementation
 
          { should we force unit initialization? }
          { this is a hack, but how can it be done better ? }
-         if force_init_final and ((current_module.flags and uf_init)=0) then
+         { Now the sole purpose of this is to change 'init' to 'init_implicit', is it needed at all? (Sergei) }
+         if force_init_final and assigned(init_procinfo) and has_no_code(init_procinfo.code) then
            begin
              { first release the not used init procinfo }
              if assigned(init_procinfo) then
@@ -1321,9 +1320,6 @@ implementation
          { finalize? }
          if not current_module.interface_only and (token=_FINALIZATION) then
            begin
-              { the uf_finalize flag is only set after we checked that it
-                wasn't empty }
-
               { Compile the finalize }
               finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
@@ -1338,13 +1334,21 @@ implementation
            a register that is also used in the finalize body (PFV) }
          if assigned(init_procinfo) then
            begin
-             init_procinfo.generate_code;
+             if force_init_final or not(has_no_code(init_procinfo.code)) then
+               begin
+                 init_procinfo.generate_code;
+                 current_module.flags:=current_module.flags or uf_init;
+               end;
              init_procinfo.resetprocdef;
              release_main_proc(init_procinfo);
            end;
          if assigned(finalize_procinfo) then
            begin
-             finalize_procinfo.generate_code;
+             if force_init_final or not(has_no_code(finalize_procinfo.code)) then
+               begin
+                 finalize_procinfo.generate_code;
+                 current_module.flags:=current_module.flags or uf_finalize;
+               end;
              finalize_procinfo.resetprocdef;
              release_main_proc(finalize_procinfo);
            end;
@@ -2284,9 +2288,6 @@ implementation
          { finalize? }
          if token=_FINALIZATION then
            begin
-              { the uf_finalize flag is only set after we checked that it
-                wasn't empty }
-
               { Parse the finalize }
               finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
@@ -2312,13 +2313,19 @@ implementation
          release_main_proc(main_procinfo);
          if assigned(init_procinfo) then
            begin
+             { initialization can be implicit only }
+             current_module.flags:=current_module.flags or uf_init;
              init_procinfo.generate_code;
              init_procinfo.resetprocdef;
              release_main_proc(init_procinfo);
            end;
          if assigned(finalize_procinfo) then
            begin
-             finalize_procinfo.generate_code;
+             if force_init_final or not (has_no_code(finalize_procinfo.code)) then
+               begin
+                 finalize_procinfo.generate_code;
+                 current_module.flags:=current_module.flags or uf_finalize;
+               end;
              finalize_procinfo.resetprocdef;
              release_main_proc(finalize_procinfo);
            end;

compiler/powerpc/agppcmpw.pas

@@ -25,6 +25,9 @@
 unit agppcmpw;
 
 {$i fpcdefs.inc}
+ { We know that use_PR is a const boolean
+   but we don't care about this warning }
+ {$WARN 6018 OFF}
 
 interface
 

compiler/powerpc64/cgcpu.pas

@@ -192,7 +192,7 @@ begin
   two_N_minus_1 := aWord(1) shl (N-1);
 
   magic_add := false;
-  nc := - 1 - (-d) mod d;
+  nc := aWord(-1) - (-d) mod d;
   p := N-1; { initialize p }
   q1 := two_N_minus_1 div nc; { initialize q1 = 2p/nc }
   r1 := two_N_minus_1 - q1*nc; { initialize r1 = rem(2p,nc) }

compiler/pp.pas

@@ -144,6 +144,11 @@ program pp;
   {$endif i386}
 {$endif support_mmx}
 
+
+{ Don't care about minstacksize or maxstacksize not beeing supported by current OS }
+{$WARN 2077 OFF}
+{$WARN 2078 OFF}
+
 {$ifdef win32}
   { 256 MB stack }
   { under windows the stack can't grow }

compiler/ppcgen/cgppc.pas

@@ -22,7 +22,6 @@
 unit cgppc;
 
 {$i fpcdefs.inc}
-
   interface
 
     uses
@@ -62,6 +61,9 @@ unit cgppc;
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
 
         procedure g_maybe_got_init(list: TAsmList); override;
+        { Transform unsupported methods into Internal errors }
+        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
+        procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
        protected
         function  get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
         procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
@@ -109,6 +111,11 @@ unit cgppc;
        symconst,symsym,fmodule,
        rgobj,tgobj,cpupi,procinfo,paramgr;
 
+{ We know that macos_direct_globals is a const boolean
+  but we don't care about this warning }
+{$NOTE Is macos_direct_globals still useful?}
+{$WARN 6018 OFF}
+
 {$ifdef extdebug}
      function ref2string(const ref : treference) : string;
        begin
@@ -524,6 +531,16 @@ unit cgppc;
        end;
 
 
+  procedure tcgppcgen.g_stackpointer_alloc(list : TAsmList;localsize : longint);
+    begin
+      Comment(V_Error,'tcgppcgen.g_stackpointer_alloc method not implemented');
+    end;
+
+  procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+    begin
+      Comment(V_Error,'tcgppcgen.a_bit_scan_reg_reg method not implemented');
+    end;
+
   procedure tcgppcgen.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
     var
       fromsreg, tosreg: tsubsetregister;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 138;
+  CurrentPPUVersion = 140;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -290,14 +290,14 @@ type
   {read}
     function  openfile:boolean;
     procedure reloadbuf;
-    procedure readdata(var b;len:integer);
+    procedure readdata(out b;len:integer);
     procedure skipdata(len:integer);
     function  readentry:byte;
     function  EndOfEntry:boolean;
     function  entrysize:longint;
     function  entryleft:longint;
-    procedure getdatabuf(var b;len:integer;var res:integer);
-    procedure getdata(var b;len:integer);
+    procedure getdatabuf(out b;len:integer;out res:integer);
+    procedure getdata(out b;len:integer);
     function  getbyte:byte;
     function  getword:word;
     function  getdword:dword;
@@ -311,8 +311,8 @@ type
     function  getrealsize(sizeofreal : longint):ppureal;
     function  getstring:string;
     function  getansistring:ansistring;
-    procedure getnormalset(var b);
-    procedure getsmallset(var b);
+    procedure getnormalset(out b);
+    procedure getsmallset(out b);
     function  skipuntilentry(untilb:byte):boolean;
   {write}
     function  createfile:boolean;
@@ -528,7 +528,7 @@ begin
 end;
 
 
-procedure tppufile.readdata(var b;len:integer);
+procedure tppufile.readdata(out b;len:integer);
 var
   p,pbuf : pchar;
   left : integer;
@@ -623,7 +623,7 @@ begin
 end;
 
 
-procedure tppufile.getdatabuf(var b;len:integer;var res:integer);
+procedure tppufile.getdatabuf(out b;len:integer;out res:integer);
 begin
   if entryidx+len>entry.size then
    res:=entry.size-entryidx
@@ -634,7 +634,7 @@ begin
 end;
 
 
-procedure tppufile.getdata(var b;len:integer);
+procedure tppufile.getdata(out b;len:integer);
 begin
   if entryidx+len>entry.size then
    begin
@@ -957,7 +957,7 @@ begin
 end;
 
 
-procedure tppufile.getsmallset(var b);
+procedure tppufile.getsmallset(out b);
 var
   i : longint;
 begin
@@ -968,7 +968,7 @@ begin
 end;
 
 
-procedure tppufile.getnormalset(var b);
+procedure tppufile.getnormalset(out b);
 var
   i : longint;
 begin

compiler/pstatmnt.pas

@@ -821,8 +821,6 @@ implementation
          unit_found:boolean;
          oldcurrent_exceptblock: integer;
       begin
-         include(current_procinfo.flags,pi_uses_exceptions);
-
          p_default:=nil;
          p_specific:=nil;
 

compiler/psub.pas

@@ -204,12 +204,6 @@ implementation
                         { The library init code is already called and does not
                           need to be in the initfinal table (PFV) }
                         block:=statement_block(_INITIALIZATION);
-                        { optimize empty initialization block away }
-                        if (block.nodetype=blockn) and (tblocknode(block).left=nil) then
-                          FreeAndNil(block)
-                        else
-                          if not islibrary then
-                            current_module.flags:=current_module.flags or uf_init;
                      end
                    else if token=_FINALIZATION then
                      begin
@@ -217,25 +211,12 @@ implementation
                          point when we try to read the nonh existing initalization section
                          so we've to check if we are really try to parse the finalization }
                        if current_procinfo.procdef.proctypeoption=potype_unitfinalize then
-                         begin
-                           block:=statement_block(_FINALIZATION);
-                           { optimize empty finalization block away }
-                           if (block.nodetype=blockn) and (tblocknode(block).left=nil) then
-                             FreeAndNil(block)
-                           else
-                             current_module.flags:=current_module.flags or uf_finalize;
-                         end
-                         else
-                           block:=nil;
+                         block:=statement_block(_FINALIZATION)
+                       else
+                         block:=nil;
                      end
                    else
-                     begin
-                        { The library init code is already called and does not
-                          need to be in the initfinal table (PFV) }
-                        if not islibrary then
-                          current_module.flags:=current_module.flags or uf_init;
-                        block:=statement_block(_BEGIN);
-                     end;
+                     block:=statement_block(_BEGIN);
                 end;
             end
          else
@@ -303,7 +284,6 @@ implementation
               begin
                 if is_class(current_structdef) then
                   begin
-                    include(current_procinfo.flags,pi_needs_implicit_finally);
                     srsym:=search_struct_member(current_structdef,'NEWINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
@@ -479,8 +459,8 @@ implementation
       var
         newstatement : tstatementnode;
         { safecall handling }
-        exceptobjnode,exceptaddrnode: ttempcreatenode;
-        sym,exceptsym: tsym;
+        sym: tsym;
+        argnode: tnode;
       begin
         generate_except_block:=internalstatements(newstatement);
 
@@ -511,46 +491,13 @@ implementation
                 { SafecallException virtual method                       }
                 { In other case we return E_UNEXPECTED error value       }
                 if is_class(current_procinfo.procdef.struct) then
-                  begin
-                    { temp variable to store exception address }
-                    exceptaddrnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,
-                      tt_persistent,true);
-                    addstatement(newstatement,exceptaddrnode);
-                    addstatement(newstatement,
-                      cassignmentnode.create(
-                        ctemprefnode.create(exceptaddrnode),
-                        ccallnode.createintern('fpc_getexceptionaddr',nil)));
-                    { temp variable to store popped up exception }
-                    exceptobjnode:=ctempcreatenode.create(class_tobject,class_tobject.size,
-                      tt_persistent,true);
-                    addstatement(newstatement,exceptobjnode);
-                    addstatement(newstatement,
-                      cassignmentnode.create(
-                        ctemprefnode.create(exceptobjnode),
-                        ccallnode.createintern('fpc_popobjectstack', nil)));
-                    exceptsym:=search_struct_member(tobjectdef(current_procinfo.procdef.struct),'SAFECALLEXCEPTION');
-                    addstatement(newstatement,
-                      cassignmentnode.create(
-                        cloadnode.create(sym,sym.Owner),
-                        ccallnode.create(
-                          ccallparanode.create(ctemprefnode.create(exceptaddrnode),
-                          ccallparanode.create(ctemprefnode.create(exceptobjnode),nil)),
-                          tprocsym(exceptsym), tprocsym(exceptsym).owner,load_self_node,[])));
-                    addstatement(newstatement,ccallnode.createintern('fpc_destroyexception',
-                      ccallparanode.create(ctemprefnode.create(exceptobjnode),nil)));
-                    addstatement(newstatement,ctempdeletenode.create(exceptobjnode));
-                    addstatement(newstatement,ctempdeletenode.create(exceptaddrnode));
-                  end
+                  argnode:=load_self_node
                 else
-                  begin
-                    { pop up and destroy an exception }
-                    addstatement(newstatement,ccallnode.createintern('fpc_destroyexception',
-                      ccallparanode.create(ccallnode.createintern('fpc_popobjectstack', nil),nil)));
-                    addstatement(newstatement,
-                      cassignmentnode.create(
-                        cloadnode.create(sym,sym.Owner),
-                        genintconstnode(HResult($8000FFFF))));
-                  end;
+                  argnode:=cnilnode.create;
+                addstatement(newstatement,cassignmentnode.create(
+                  cloadnode.create(sym,sym.Owner),
+                  ccallnode.createinternres('fpc_safecallhandler',
+                    ccallparanode.create(argnode,nil),hresultdef)));
               end;
 {$endif}
           end;
@@ -751,7 +698,13 @@ implementation
           end
         else
           begin
-            maybe_add_constructor_wrapper(code,false);
+            { Constructors need the destroy-on-exception code even if they don't
+              use managed variables/temps. }
+            if (cs_implicit_exceptions in current_settings.moduleswitches) and
+               (is_class(procdef.struct) and (procdef.proctypeoption=potype_constructor)) then
+              maybe_add_constructor_wrapper(code,true)
+            else
+              maybe_add_constructor_wrapper(code,false);
             addstatement(newstatement,loadpara_asmnode);
             addstatement(newstatement,stackcheck_asmnode);
             addstatement(newstatement,entry_asmnode);

compiler/psystem.pas

@@ -167,7 +167,7 @@ implementation
         cshortstringtype:=tstringdef.createshort(255);
         { should we give a length to the default long and ansi string definition ?? }
         clongstringtype:=tstringdef.createlong(-1);
-        cansistringtype:=tstringdef.createansi;
+        cansistringtype:=tstringdef.createansi(0);
         if target_info.system in systems_windows then
           cwidestringtype:=tstringdef.createwide
         else

compiler/ptconst.pas

@@ -35,7 +35,7 @@ implementation
     uses
        SysUtils,
        globtype,systems,tokens,verbose,constexp,
-       cutils,globals,widestr,scanner,
+       cclasses,cutils,globals,widestr,scanner,
        symconst,symbase,symdef,symtable,
        aasmbase,aasmtai,aasmcpu,defutil,defcmp,
        { pass 1 }
@@ -896,7 +896,7 @@ implementation
                       1:
                         begin
                           if (tstringconstnode(n).cst_type in [cst_unicodestring,cst_widestring]) then
-                            inserttypeconv(n,cansistringtype);
+                            inserttypeconv(n,getansistringdef);
                           if n.nodetype<>stringconstn then
                             internalerror(2010033003);
                           ca:=pointer(tstringconstnode(n).value_str);
@@ -1094,9 +1094,21 @@ implementation
               Message(parser_e_improper_guid_syntax);
           end;
 
+        function get_next_varsym(const SymList:TFPHashObjectList; var symidx:longint):tsym;inline;
+          begin
+            while symidx<SymList.Count do
+              begin
+                result:=tsym(def.symtable.SymList[symidx]);
+                inc(symidx);
+                if result.typ=fieldvarsym then
+                  exit;
+              end;
+            result:=nil;
+          end;
+
         var
           i : longint;
-
+          SymList:TFPHashObjectList;
         begin
           { GUID }
           if (def=rec_tguid) and (token=_ID) then
@@ -1146,9 +1158,10 @@ implementation
           { normal record }
           consume(_LKLAMMER);
           curroffset:=0;
-          symidx:=0;
           sorg:='';
-          srsym:=tsym(def.symtable.SymList[symidx]);
+          symidx:=0;
+          symlist:=def.symtable.SymList;
+          srsym:=get_next_varsym(symlist,symidx);
           recsym := nil;
           startoffset:=hr.offset;
           while token<>_RKLAMMER do
@@ -1183,8 +1196,9 @@ implementation
                      {   const r: tr = (w1:1;w2:1;l2:5);                  }
                      (tfieldvarsym(recsym).fieldoffset = curroffset) then
                     begin
-                      srsym := recsym;
-                      symidx := def.symtable.SymList.indexof(srsym)
+                      srsym:=recsym;
+                      { symidx should contain the next symbol id to search }
+                      symidx:=SymList.indexof(srsym)+1;
                     end
                   { going backwards isn't allowed in any mode }
                   else if (tfieldvarsym(recsym).fieldoffset<curroffset) then
@@ -1256,12 +1270,7 @@ implementation
                   { record was initialized (JM)                    }
                   recsym := srsym;
                   { goto next field }
-                  inc(symidx);
-                  if symidx<def.symtable.SymList.Count then
-                    srsym:=tsym(def.symtable.SymList[symidx])
-                  else
-                    srsym:=nil;
-
+                  srsym:=get_next_varsym(SymList,symidx);
                   if token=_SEMICOLON then
                     consume(_SEMICOLON)
                   else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then

compiler/ptype.pas

@@ -586,7 +586,7 @@ implementation
                          if not(stoAllowTypeDef in options) then
                            Message(parser_e_no_local_para_def);
                          consume(_OF);
-                         single_type(t2,[]);
+                         single_type(t2,[stoAllowTypeDef]);
                          if is_managed_type(t2) then
                            Message(parser_e_no_refcounted_typed_file);
                          def:=tfiledef.createtyped(t2);
@@ -819,7 +819,7 @@ implementation
                       begin
                         if member_blocktype=bt_general then
                           begin
-                            if (not fields_allowed) then
+                            if (not fields_allowed)and(idtoken<>_CASE) then
                               Message(parser_e_field_not_allowed_here);
                             vdoptions:=[vd_record];
                             if classfields then
@@ -1241,38 +1241,42 @@ implementation
                        setdefdecl(pt.resultdef)
                      else
                        begin
-                         if (pt.nodetype=rangen) then
+                         if pt.nodetype=rangen then
                            begin
-                             if (trangenode(pt).left.nodetype=ordconstn) and
-                                (trangenode(pt).right.nodetype=ordconstn) then
+                             { check the expression only if we are not in a generic declaration }
+                             if not(parse_generic) then
                                begin
-                                 { make both the same type or give an error. This is not
-                                   done when both are integer values, because typecasting
-                                   between -3200..3200 will result in a signed-unsigned
-                                   conflict and give a range check error (PFV) }
-                                 if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
-                                   inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
-                                 lowval:=tordconstnode(trangenode(pt).left).value;
-                                 highval:=tordconstnode(trangenode(pt).right).value;
-                                 if highval<lowval then
-                                  begin
-                                    Message(parser_e_array_lower_less_than_upper_bound);
-                                    highval:=lowval;
-                                  end
-                                 else if (lowval<int64(low(asizeint))) or
-                                         (highval>high(asizeint)) then
+                                 if (trangenode(pt).left.nodetype=ordconstn) and
+                                    (trangenode(pt).right.nodetype=ordconstn) then
                                    begin
-                                     Message(parser_e_array_range_out_of_bounds);
-                                     lowval :=0;
-                                     highval:=0;
-                                   end;
-                                 if is_integer(trangenode(pt).left.resultdef) then
-                                   range_to_type(lowval,highval,indexdef)
+                                     { make both the same type or give an error. This is not
+                                       done when both are integer values, because typecasting
+                                       between -3200..3200 will result in a signed-unsigned
+                                       conflict and give a range check error (PFV) }
+                                     if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
+                                       inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
+                                     lowval:=tordconstnode(trangenode(pt).left).value;
+                                     highval:=tordconstnode(trangenode(pt).right).value;
+                                     if highval<lowval then
+                                      begin
+                                        Message(parser_e_array_lower_less_than_upper_bound);
+                                        highval:=lowval;
+                                      end
+                                     else if (lowval<int64(low(asizeint))) or
+                                             (highval>high(asizeint)) then
+                                       begin
+                                         Message(parser_e_array_range_out_of_bounds);
+                                         lowval :=0;
+                                         highval:=0;
+                                       end;
+                                     if is_integer(trangenode(pt).left.resultdef) then
+                                       range_to_type(lowval,highval,indexdef)
+                                     else
+                                       indexdef:=trangenode(pt).left.resultdef;
+                                   end
                                  else
-                                   indexdef:=trangenode(pt).left.resultdef;
-                               end
-                             else
-                               Message(type_e_cant_eval_constant_expr);
+                                   Message(type_e_cant_eval_constant_expr);
+                               end;
                            end
                          else
                            Message(sym_e_error_in_type_def)

compiler/raatt.pas

@@ -52,7 +52,7 @@ unit raatt;
         AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,
         AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII,
         AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,AS_CEXTENDED,
-        AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_END,
+        AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_RVA,AS_END,
         {------------------ Assembler Operators  --------------------}
         AS_TYPE,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT,
         AS_LO,AS_HI,
@@ -77,7 +77,7 @@ unit raatt;
         '.byte','.word','.long','.quad','.globl',
         '.align','.balign','.p2align','.ascii',
         '.asciz','.lcomm','.comm','.single','.double','.tfloat','.tcfloat',
-        '.data','.text','.init','.fini','END',
+        '.data','.text','.init','.fini','.rva','END',
         'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','lo','hi',
         'directive');
 
@@ -90,6 +90,7 @@ unit raatt;
          procedure BuildConstantOperand(oper : toperand);
          procedure BuildRealConstant(typ : tfloattype);
          procedure BuildStringConstant(asciiz: boolean);
+         procedure BuildRva;
          procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean);
          procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
          function BuildConstExpression(allowref,betweenbracket:boolean): aint;
@@ -1183,6 +1184,16 @@ unit raatt;
                Consume(AS_SEPARATOR);
              end;
 
+           AS_RVA:
+             begin
+               { .rva generally applies to systems with COFF output format,
+                 not just Windows. }
+               if not (target_info.system in systems_all_windows) then
+                 Message1(asmr_e_unsupported_directive,token2str[AS_RVA]);
+               Consume(AS_RVA);
+               BuildRva;
+             end;
+
            AS_TARGET_DIRECTIVE:
              HandleTargetDirective;
 
@@ -1592,4 +1603,43 @@ unit raatt;
          end;
       end;
 
+    procedure tattreader.BuildRva;
+      var
+       asmsymtyp : TAsmSymType;
+       asmsym: string;
+       value : aint;
+       ai:tai_const;
+      begin
+        repeat
+          case actasmtoken of
+            AS_INTNUM,
+            AS_PLUS,
+            AS_MINUS,
+            AS_LPAREN,
+            AS_ID :
+              Begin
+                BuildConstSymbolExpression(false,false,false,value,asmsym,asmsymtyp);
+                if asmsym<>'' then
+                 begin
+                   ai:=tai_const.create_type_sym(aitconst_rva_symbol,current_asmdata.RefAsmSymbol(asmsym));
+                   ai.value:=value;
+                   curlist.concat(ai);
+                 end
+                else
+                 Message(asmr_e_invalid_symbol_ref);
+              end;
+            AS_COMMA:
+              Consume(AS_COMMA);
+            AS_END,
+            AS_SEPARATOR:
+              break;
+            else
+              begin
+                Message(asmr_e_syn_constant);
+                RecoverConsume(false);
+              end
+          end; { end case }
+        until false;
+      end;
+
 end.

compiler/rautils.pas

@@ -34,6 +34,13 @@ Const
   RPNMax = 10;             { I think you only need 4, but just to be safe }
   OpMax  = 25;
 
+{$if max_operands = 2}
+  {$define MAX_OPER_2}
+{$endif}
+{$if max_operands = 3}
+  {$define MAX_OPER_3}
+{$endif}
+
 {---------------------------------------------------------------------
                        Local Label Management
 ---------------------------------------------------------------------}
@@ -1027,12 +1034,14 @@ end;
               Operands[1]:=Operands[2];
               Operands[2]:=p;
             end;
+{$ifndef MAX_OPER_2}
         3 : begin
               { 0,1,2 -> 2,1,0 }
               p:=Operands[1];
               Operands[1]:=Operands[3];
               Operands[3]:=p;
             end;
+{$ifndef MAX_OPER_3}
         4 : begin
               { 0,1,2,3 -> 3,2,1,0 }
               p:=Operands[1];
@@ -1042,6 +1051,8 @@ end;
               Operands[2]:=Operands[3];
               Operands[3]:=p;
             end;
+{$endif}
+{$endif}
         else
           internalerror(201108142);
       end;

compiler/scandir.pas

@@ -1298,6 +1298,21 @@ unit scandir;
         else
         if ident='ZERO_NIL_COMPAT' then
           recordpendingmessagestate(type_w_zero_to_nil, msgstate)
+        else
+        if ident='IMPLICIT_STRING_CAST' then
+          recordpendingmessagestate(type_w_implicit_string_cast, msgstate)
+        else
+        if ident='IMPLICIT_STRING_CAST_LOSS' then
+          recordpendingmessagestate(type_w_implicit_string_cast_loss, msgstate)
+        else
+        if ident='EXPLICIT_STRING_CAST' then
+          recordpendingmessagestate(type_w_explicit_string_cast, msgstate)
+        else
+        if ident='EXPLICIT_STRING_CAST_LOSS' then
+          recordpendingmessagestate(type_w_explicit_string_cast_loss, msgstate)
+        else
+        if ident='CVT_NARROWING_STRING_LOST' then
+          recordpendingmessagestate(type_w_unicode_data_loss, msgstate)
         else
           begin
             i:=0;
@@ -1370,14 +1385,15 @@ unit scandir;
           Message(scan_w_switch_is_global)
         else
           begin
-             current_scanner.skipspace;
-             s:=current_scanner.readcomment;
-             if (upper(s)='UTF8') or (upper(s)='UTF-8') then
-               current_settings.sourcecodepage:=CP_UTF8
-             else if not(cpavailable(s)) then
-               Message1(option_code_page_not_available,s)
-             else
-               current_settings.sourcecodepage:=codepagebyname(s);
+            current_scanner.skipspace;
+            s:=current_scanner.readcomment;
+            if (upper(s)='UTF8') or (upper(s)='UTF-8') then
+              current_settings.sourcecodepage:=CP_UTF8
+            else if not(cpavailable(s)) then
+              Message1(option_code_page_not_available,s)
+            else
+              current_settings.sourcecodepage:=codepagebyname(s);
+            include(current_settings.moduleswitches,cs_explicit_codepage);
           end;
       end;
 

compiler/scanner.pas

@@ -269,7 +269,7 @@ implementation
       { This is needed for tcputype }
       cpuinfo,
       fmodule
-{$ifdef VER2_4}
+{$if FPC_FULLVERSION<20700}
       ,ccharset
 {$endif}
       ;
@@ -348,8 +348,18 @@ implementation
         if m_systemcodepage in current_settings.modeswitches then
           begin
             current_settings.sourcecodepage:=DefaultSystemCodePage;
+            include(current_settings.moduleswitches,cs_explicit_codepage);
             if changeinit then
+            begin
               init_settings.sourcecodepage:=DefaultSystemCodePage;
+              include(init_settings.moduleswitches,cs_explicit_codepage);
+            end;
+          end
+        else
+          begin
+            exclude(current_settings.moduleswitches,cs_explicit_codepage);
+            if changeinit then
+              exclude(init_settings.moduleswitches,cs_explicit_codepage);
           end;
       end;
 
@@ -2650,6 +2660,7 @@ In case not, the value returned can be arbitrary.
                        inc(inputpointer,3);
                        message(scan_c_switching_to_utf8);
                        current_settings.sourcecodepage:=CP_UTF8;
+                       include(current_settings.moduleswitches,cs_explicit_codepage);
                      end;
 
                    line_no:=1;
@@ -4208,9 +4219,9 @@ In case not, the value returned can be arbitrary.
                                   if not iswidestring then
                                    begin
                                      if len>0 then
-                                       ascii2unicode(@cstringpattern[1],len,patternw)
+                                       ascii2unicode(@cstringpattern[1],len,current_settings.sourcecodepage,patternw)
                                      else
-                                       ascii2unicode(nil,len,patternw);
+                                       ascii2unicode(nil,len,current_settings.sourcecodepage,patternw);
                                      iswidestring:=true;
                                      len:=0;
                                    end;
@@ -4252,9 +4263,9 @@ In case not, the value returned can be arbitrary.
                                if not iswidestring then
                                  begin
                                    if len>0 then
-                                     ascii2unicode(@cstringpattern[1],len,patternw)
+                                     ascii2unicode(@cstringpattern[1],len,current_settings.sourcecodepage,patternw)
                                    else
-                                     ascii2unicode(nil,len,patternw);
+                                     ascii2unicode(nil,len,current_settings.sourcecodepage,patternw);
                                    iswidestring:=true;
                                    len:=0;
                                  end;

compiler/sparc/cgcpu.pas

@@ -90,6 +90,9 @@ interface
         procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);override;
         procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+        { Transform unsupported methods into Internal errors }
+        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
+        procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
        private
         g1_used : boolean;
       end;
@@ -904,7 +907,7 @@ implementation
                   tmpreg1:=GetIntRegister(list,OS_INT);
                   tmpreg2:=GetIntRegister(list,OS_INT);
                   list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
-                  list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2));
+                  list.concat(taicpu.op_reg_const_reg(A_SRA,dst,31,tmpreg2));
                   list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
                   ovloc.loc:=LOC_FLAGS;
                   ovloc.resflags:=F_NE;
@@ -1408,6 +1411,16 @@ implementation
         List.concat(Tai_symbol_end.Createname(labelname));
       end;
 
+    procedure tcgsparc.g_stackpointer_alloc(list : TAsmList;localsize : longint);
+      begin
+        Comment(V_Error,'tcgsparc.g_stackpointer_alloc method not implemented');
+      end;
+
+    procedure tcgsparc.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+      begin
+        Comment(V_Error,'tcgsparc.a_bit_scan_reg_reg method not implemented');
+      end;
+
 {****************************************************************************
                                TCG64Sparc
 ****************************************************************************}

compiler/symconst.pas

@@ -394,13 +394,13 @@ type
 
   { options for properties }
   tpropertyoption=(ppo_none,
-    ppo_indexed,
+    ppo_indexed,                  { delcared wwith "index" keyword }
     ppo_defaultproperty,
     ppo_stored,
-    ppo_hasparameters,
+    ppo_hasparameters,            { has parameters: prop[param1, param2: type] }
     ppo_implements,
-    ppo_enumerator_current,
-    ppo_dispid_read,              { no longer used }
+    ppo_enumerator_current,       { implements current property for enumerator }
+    ppo_overrides,                { overrides ancestor property }
     ppo_dispid_write              { no longer used }
   );
   tpropertyoptions=set of tpropertyoption;

compiler/symdef.pas

@@ -595,7 +595,7 @@ interface
           constructor loadshort(ppufile:tcompilerppufile);
           constructor createlong(l : asizeint);
           constructor loadlong(ppufile:tcompilerppufile);
-          constructor createansi;
+          constructor createansi(aencoding:tstringencoding);
           constructor loadansi(ppufile:tcompilerppufile);
           constructor createwide;
           constructor loadwide(ppufile:tcompilerppufile);
@@ -826,6 +826,10 @@ interface
 
     function use_vectorfpu(def : tdef) : boolean;
 
+    function getansistringcodepage:tstringencoding; inline;
+    function getansistringdef:tstringdef; inline;
+    function getparaencoding(def:tdef):tstringencoding; inline;
+
 implementation
 
     uses
@@ -848,6 +852,52 @@ implementation
                                   Helpers
 ****************************************************************************}
 
+    function getansistringcodepage:tstringencoding; inline;
+      begin
+        if cs_explicit_codepage in current_settings.moduleswitches then
+          result:=current_settings.sourcecodepage
+        else
+          result:=0;
+      end;
+
+    function getansistringdef:tstringdef; inline;
+      var
+        symtable:tsymtable;
+      begin
+        { if codepage is explicitly defined in this mudule we need to return
+          a replacement for ansistring def }
+        if cs_explicit_codepage in current_settings.moduleswitches then
+          begin
+            if not assigned(current_module) then
+              internalerror(2011101301);
+            { codepage can be redeclared only once per unit so we don't need a list of
+              redefined ansistring but only one pointer }
+            if not assigned(current_module.ansistrdef) then
+              begin
+                { if we did not create it yet we need to do this now }
+                if current_module.is_unit then
+                  symtable:=current_module.globalsymtable
+                else
+                  symtable:=current_module.localsymtable;
+                symtablestack.push(symtable);
+                current_module.ansistrdef:=tstringdef.createansi(current_settings.sourcecodepage);
+                symtablestack.pop(symtable);
+              end;
+            result:=tstringdef(current_module.ansistrdef);
+          end
+        else
+          result:=tstringdef(cansistringtype);
+      end;
+
+    function getparaencoding(def:tdef):tstringencoding; inline;
+      begin
+        { don't pass CP_NONE encoding to internal functions
+          they expect 0 encoding instead }
+        result:=tstringdef(def).encoding;
+        if result=CP_NONE then
+          result:=0
+      end;
+
     function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
       var
         s,hs,
@@ -1448,11 +1498,11 @@ implementation
       end;
 
 
-    constructor tstringdef.createansi;
+    constructor tstringdef.createansi(aencoding:tstringencoding);
       begin
          inherited create(stringdef);
          stringtype:=st_ansistring;
-         encoding:=0;
+         encoding:=aencoding;
          len:=-1;
          savesize:=sizeof(pint);
       end;
@@ -1690,10 +1740,10 @@ implementation
 
     procedure tenumdef.calcsavesize;
       begin
-{$IFDEF CPU32} {$push}{$warnings off} {$ENDIF} //comparison always false warning
+{$IFNDEF cpu64bitaddr} {$push}{$warnings off} {$ENDIF} //comparison always false warning
         if (current_settings.packenum=8) or (min<low(longint)) or (int64(max)>high(cardinal)) then
          savesize:=8
-{$IFDEF CPU32} {$pop} {$ENDIF}
+{$IFDEF not cpu64bitaddr} {$pop} {$ENDIF}
         else
          if (current_settings.packenum=4) or (min<low(smallint)) or (max>high(word)) then
           savesize:=4
@@ -1988,6 +2038,7 @@ implementation
       begin
         if (target_info.system in [system_i386_darwin,system_i386_iphonesim,system_arm_darwin]) then
           case floattype of
+            sc80real,
             s80real: result:=16;
             s64real,
             s64currency,
@@ -2140,9 +2191,9 @@ implementation
         case filetyp of
           ft_text :
             if target_info.system in [system_x86_64_win64,system_ia64_win64] then
-              savesize:=632{+8}
+              savesize:=634{+8}
             else
-              savesize:=628{+8};
+              savesize:=630{+8};
           ft_typed,
           ft_untyped :
             if target_info.system in [system_x86_64_win64,system_ia64_win64] then
@@ -2154,7 +2205,7 @@ implementation
 {$ifdef cpu32bitaddr}
         case filetyp of
           ft_text :
-            savesize:=592{+4};
+            savesize:=594{+4};
           ft_typed,
           ft_untyped :
             savesize:=332;

compiler/symsym.pas

@@ -394,14 +394,26 @@ implementation
 
 
     procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);
+      var
+        oldintfcrc : boolean;
       begin
          ppufile.putlongint(SymId);
          ppufile.putstring(realname);
          ppufile.putposinfo(fileinfo);
          ppufile.putbyte(byte(visibility));
+         { symoptions can differ between interface and implementation, except
+           for overload (this is checked in pdecsub.proc_add_definition() )
+
+           These differences can lead to compiler crashes, so ignore them.
+           This does mean that changing e.g. the "deprecated" state of a symbol
+           by itself will not trigger a recompilation of dependent units.
+         }
+         oldintfcrc:=ppufile.do_interface_crc;
+         ppufile.do_interface_crc:=false;
          ppufile.putsmallset(symoptions);
          if sp_has_deprecated_msg in symoptions then
            ppufile.putstring(deprecatedmsg^);
+         ppufile.do_interface_crc:=oldintfcrc;
       end;
 
 
@@ -945,7 +957,7 @@ implementation
          default:=0;
          propdef:=nil;
          indexdef:=nil;
-         parast:=tparasymtable.create(nil,0);
+         parast:=nil;
          for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
            propaccesslist[pap]:=tpropaccesslist.create;
       end;
@@ -957,15 +969,21 @@ implementation
       begin
          inherited ppuload(propertysym,ppufile);
          ppufile.getsmallset(propoptions);
-         ppufile.getderef(overriddenpropsymderef);
+         if ppo_overrides in propoptions then
+           ppufile.getderef(overriddenpropsymderef);
          ppufile.getderef(propdefderef);
          index:=ppufile.getlongint;
          default:=ppufile.getlongint;
          ppufile.getderef(indexdefderef);
          for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
            propaccesslist[pap]:=ppufile.getpropaccesslist;
-         parast:=tparasymtable.create(nil,0);
-         tparasymtable(parast).ppuload(ppufile);
+         if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
+           begin
+             parast:=tparasymtable.create(nil,0);
+             tparasymtable(parast).ppuload(ppufile);
+           end
+         else
+           parast:=nil;
       end;
 
 
@@ -984,12 +1002,15 @@ implementation
       var
         pap : tpropaccesslisttypes;
       begin
-        overriddenpropsymderef.build(overriddenpropsym);
         propdefderef.build(propdef);
         indexdefderef.build(indexdef);
         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
           propaccesslist[pap].buildderef;
-        tparasymtable(parast).buildderef;
+        if ppo_overrides in propoptions then
+          overriddenpropsymderef.build(overriddenpropsym)
+        else
+        if ppo_hasparameters in propoptions then
+          tparasymtable(parast).buildderef;
       end;
 
 
@@ -997,12 +1018,20 @@ implementation
       var
         pap : tpropaccesslisttypes;
       begin
-        overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve);
         indexdef:=tdef(indexdefderef.resolve);
         propdef:=tdef(propdefderef.resolve);
         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
           propaccesslist[pap].resolve;
-        tparasymtable(parast).deref;
+
+        if ppo_overrides in propoptions then
+          begin
+            overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve);
+            if ppo_hasparameters in propoptions then
+              parast:=overriddenpropsym.parast.getcopy;
+          end
+        else
+        if ppo_hasparameters in propoptions then
+          tparasymtable(parast).deref
       end;
 
 
@@ -1018,7 +1047,8 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putsmallset(propoptions);
-        ppufile.putderef(overriddenpropsymderef);
+        if ppo_overrides in propoptions then
+          ppufile.putderef(overriddenpropsymderef);
         ppufile.putderef(propdefderef);
         ppufile.putlongint(index);
         ppufile.putlongint(default);
@@ -1026,7 +1056,8 @@ implementation
         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
           ppufile.putpropaccesslist(propaccesslist[pap]);
         ppufile.writeentry(ibpropertysym);
-        tparasymtable(parast).ppuwrite(ppufile);
+        if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
+          tparasymtable(parast).ppuwrite(ppufile);
       end;
 
 

compiler/symtable.pas

@@ -1295,10 +1295,7 @@ implementation
                 end;
            end
          else
-           begin
-             if not(m_duplicate_names in current_settings.modeswitches) then
-               result:=inherited checkduplicate(hashedid,sym);
-           end;
+           result:=inherited checkduplicate(hashedid,sym);
       end;
 
 

compiler/systems.pas

@@ -148,8 +148,9 @@ interface
             tf_no_generic_stackcheck,
             tf_has_winlike_resources,
             tf_safecall_clearstack,             // With this flag set, after safecall calls the caller cleans up the stack
-            tf_safecall_exceptions              // Exceptions in safecall calls are not raised, but passed to the caller as an ordinal (hresult) in the function result.
+            tf_safecall_exceptions,             // Exceptions in safecall calls are not raised, but passed to the caller as an ordinal (hresult) in the function result.
                                                 // The original result (if it exists) is passed as an extra parameter
+            tf_no_backquote_support
        );
 
        psysteminfo = ^tsysteminfo;
@@ -717,6 +718,10 @@ begin
     default_target(system_i386_freebsd);
     {$define default_target_set}
    {$endif}
+   {$ifdef openbsd}
+    default_target(system_i386_openbsd);
+    {$define default_target_set}
+   {$endif}
    {$ifdef darwin}
     default_target(system_i386_darwin);
     {$define default_target_set}

compiler/systems/i_bsd.pas

@@ -156,7 +156,7 @@ unit i_bsd;
             Cprefix      : '';
             newline      : #10;
             dirsep       : '/';
-            assem        : as_gas;
+            assem        : as_x86_64_elf64;
             assemextern  : as_gas;
             link         : nil;
             linkextern   : nil;
@@ -252,7 +252,7 @@ unit i_bsd;
             system       : system_i386_OpenBSD;
             name         : 'OpenBSD for i386';
             shortname    : 'OpenBSD';
-            flags        : [tf_under_development,tf_files_case_sensitive,tf_smartlink_library,tf_has_winlike_resources];
+            flags        : [tf_pic_uses_got,tf_under_development,tf_files_case_sensitive,tf_smartlink_library,tf_has_winlike_resources];
             cpu          : cpu_i386;
             unit_env     : 'BSDUNITS';
             extradefines : 'UNIX;BSD;HASUNIX';
@@ -818,7 +818,7 @@ initialization
      set_source_info(system_i386_NetBSD_info);
   {$endif}
   {$ifdef OpenBSD}
-     set_source_info(system_i386_NetBSD_info);
+     set_source_info(system_i386_OpenBSD_info);
   {$endif}
   {$ifdef Darwin}
      set_source_info(system_i386_Darwin_info);

compiler/systems/i_linux.pas

@@ -289,7 +289,7 @@ unit i_linux;
             name         : 'Linux for PowerPC64';
             shortname    : 'Linux';
             flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
-                            tf_requires_proper_alignment,tf_smartlink_library,tf_has_winlike_resources];
+                            tf_requires_proper_alignment,tf_smartlink_sections,tf_has_winlike_resources];
             cpu          : cpu_powerpc64;
             unit_env     : '';
             extradefines : 'UNIX;HASUNIX';

compiler/systems/i_win.pas

@@ -39,7 +39,7 @@ unit i_win;
                             tf_winlikewidestring,tf_no_pic_supported,
                             tf_no_generic_stackcheck,tf_has_winlike_resources,
                             tf_dwarf_only_local_labels,
-                            tf_safecall_exceptions];
+                            tf_safecall_exceptions,tf_no_backquote_support];
             cpu          : cpu_i386;
             unit_env     : 'WIN32UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';
@@ -104,7 +104,8 @@ unit i_win;
                             tf_smartlink_sections,tf_smartlink_library,
                             tf_winlikewidestring,tf_no_pic_supported,
                             tf_dwarf_only_local_labels,
-                            tf_no_generic_stackcheck,tf_has_winlike_resources];
+                            tf_no_generic_stackcheck,tf_has_winlike_resources,
+                            tf_safecall_exceptions,tf_no_backquote_support];
             cpu          : cpu_x86_64;
             unit_env     : 'WIN64UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';
@@ -167,7 +168,8 @@ unit i_win;
             shortname    : 'WinCE';
             flags        : [tf_files_case_aware{,tf_winlikewidestring},
                             tf_smartlink_sections,tf_requires_proper_alignment,tf_no_pic_supported,
-                            tf_has_winlike_resources];
+                            tf_has_winlike_resources,
+                            tf_safecall_exceptions,tf_no_backquote_support];
             cpu          : cpu_arm;
             unit_env     : '';
             extradefines : 'UNDER_CE;WINDOWS;UNICODE';
@@ -230,7 +232,8 @@ unit i_win;
             shortname    : 'WinCE';
             flags        : [tf_files_case_aware
                             {,tf_winlikewidestring},tf_smartlink_sections,tf_no_pic_supported,
-                            tf_has_winlike_resources];
+                            tf_has_winlike_resources,
+                            tf_safecall_exceptions,tf_no_backquote_support];
             cpu          : cpu_i386;
             unit_env     : '';
             extradefines : 'UNDER_CE;WINDOWS;UNICODE';

compiler/systems/t_beos.pas

@@ -191,8 +191,8 @@ procedure TLinkerBeOS.SetDefaultInfo;
 begin
   with Info do
    begin
-     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE `cat $RES`';
-     DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE `cat $RES`';
+     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $CATRES';
+     DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $CATRES';
      DllCmd[2]:='strip --strip-unneeded $EXE';
 (*
      ExeCmd[1]:='sh $RES $EXE $OPT $STATIC $STRIP -L.';
@@ -351,7 +351,6 @@ begin
    end;
 
 { Write and Close response }
-  linkres.Add(' ');
   linkres.writetodisk;
   linkres.free;
 
@@ -363,7 +362,8 @@ function TLinkerBeOS.MakeExecutable:boolean;
 var
   binstr,
   cmdstr : TCmdStr;
-  success : boolean;
+  success,
+  useshell : boolean;
   DynLinkStr : string[60];
   GCSectionsStr,
   StaticStr,
@@ -403,12 +403,14 @@ begin
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
   Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,true);
+  useshell:=not (tf_no_backquote_support in source_info.flags);
+  success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,useshell);
 
 { Remove ReponseFile }
   if (success) and not(cs_link_nolink in current_settings.globalswitches) then
@@ -459,6 +461,7 @@ var
   SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
   Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);

compiler/systems/t_bsd.pas

@@ -145,8 +145,8 @@ begin
        begin
          if not(target_info.system in systems_darwin) then
            begin
-             ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE `cat $RES`';
-             DllCmd[1]:='ld $OPT -shared -L. -o $EXE `cat $RES`'
+             ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $CATRES';
+             DllCmd[1]:='ld $OPT -shared -L. -o $EXE $CATRES'
            end
          else
            begin
@@ -155,7 +155,7 @@ begin
                is loaded below that address. This avoids problems with the
                strange Windows-compatible resource handling that assumes
                that addresses below 64kb do not exist.
-               
+
                On 64bit systems, page zero is 4GB by default, so no problems
                there.
              }
@@ -165,16 +165,16 @@ begin
                programs with problems that require Valgrind will have more
                than 60KB of data (first 4KB of address space is always invalid)
              }
-               ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE `cat $RES`';
+               ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE $CATRES';
              if not(cs_gdb_valgrind in current_settings.globalswitches) then
                ExeCmd[1]:=ExeCmd[1]+' -pagezero_size 0x10000';
 {$else ndef cpu64bitaddr}
-             ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE `cat $RES`';
+             ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE $CATRES';
 {$endif ndef cpu64bitaddr}
              if (apptype<>app_bundle) then
-               DllCmd[1]:='ld $PRTOBJ $OPT $GCSECTIONS -dynamic -dylib -multiply_defined suppress -L. -o $EXE `cat $RES`'
+               DllCmd[1]:='ld $PRTOBJ $OPT $GCSECTIONS -dynamic -dylib -multiply_defined suppress -L. -o $EXE $CATRES'
              else
-               DllCmd[1]:='ld $PRTOBJ $OPT $GCSECTIONS -dynamic -bundle -multiply_defined suppress -L. -o $EXE `cat $RES`'
+               DllCmd[1]:='ld $PRTOBJ $OPT $GCSECTIONS -dynamic -bundle -multiply_defined suppress -L. -o $EXE $CATRES'
            end
        end
      else
@@ -186,6 +186,10 @@ begin
        DllCmd[2]:='strip --strip-unneeded $EXE'
      else
        DllCmd[2]:='strip -x $EXE';
+     { OpenBSD seems to use a wrong dynamic linker by default }
+     if target_info.system = system_i386_openbsd then
+      DynamicLinker:='/usr/libexec/ld.so'
+     else
       DynamicLinker:='';
    end;
 end;
@@ -244,7 +248,7 @@ begin
         end;
     end;
   result:=maybequoted(result);
-end;    
+end;
 
 
 Function TLinkerBSD.WriteResponseFile(isdll:boolean) : Boolean;
@@ -498,7 +502,7 @@ begin
      if not LdSupportsNoResponseFile then
        LinkRes.Add(')');
    end;
-   
+
   { frameworks for Darwin }
   if IsDarwin then
     while not FrameworkFiles.empty do
@@ -506,7 +510,7 @@ begin
         LinkRes.Add('-framework');
         LinkRes.Add(FrameworkFiles.GetFirst);
       end;
-     
+
   { objects which must be at the end }
   if linklibc and
      not IsDarwin Then
@@ -542,7 +546,8 @@ var
   GCSectionsStr,
   StaticStr,
   StripStr   : string[63];
-  success : boolean;
+  success,
+  useshell : boolean;
 begin
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename^);
@@ -593,6 +598,7 @@ begin
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
   Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);
@@ -628,7 +634,8 @@ begin
       CmdStr:='';
     end;
 
-  success:=DoExec(BinStr,CmdStr,true,LdSupportsNoResponseFile);
+  useshell:=not (tf_no_backquote_support in source_info.flags);
+  success:=DoExec(BinStr,CmdStr,true,LdSupportsNoResponseFile or useshell);
   if (success and
       (extdbgbinstr<>'') and
       (cs_link_nolink in current_settings.globalswitches)) then
@@ -642,7 +649,7 @@ begin
        begin
          DeleteFile(linkscript.fn);
          linkscript.free
-       end; 
+       end;
    end;
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }
@@ -691,6 +698,7 @@ begin
   Replace(cmdstr,'$EXE',maybequoted(ExpandFileName(current_module.sharedlibfilename^)));
 {$endif darwin}
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   Replace(cmdstr,'$INIT',InitStr);
   Replace(cmdstr,'$FINI',FiniStr);
@@ -766,7 +774,7 @@ begin
         end;
       if (target_info.system in systems_darwin) then
         DeleteFile(outputexedir+'linksyms.fpc');
-    end;     
+    end;
 
   MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
 end;

compiler/systems/t_haiku.pas

@@ -192,8 +192,8 @@ procedure TLinkerHaiku.SetDefaultInfo;
 begin
   with Info do
    begin
-     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE `cat $RES`';
-     DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE `cat $RES`';
+     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $CATRES';
+     DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $CATRES';
      DllCmd[2]:='strip --strip-unneeded $EXE';
 (*
      ExeCmd[1]:='sh $RES $EXE $OPT $STATIC $STRIP -L.';
@@ -351,7 +351,6 @@ begin
    end;
 
 { Write and Close response }
-  linkres.Add(' ');
   linkres.writetodisk;
   linkres.free;
 
@@ -363,7 +362,8 @@ function TLinkerHaiku.MakeExecutable:boolean;
 var
   binstr,
   cmdstr : TCmdStr;
-  success : boolean;
+  success,
+  useshell : boolean;
   DynLinkStr : string[60];
   GCSectionsStr,
   StaticStr,
@@ -403,12 +403,14 @@ begin
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
   Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,true);
+  useshell:=not (tf_no_backquote_support in source_info.flags);
+  success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,useshell);
 
 { Remove ReponseFile }
   if (success) and not(cs_link_nolink in current_settings.globalswitches) then
@@ -459,6 +461,7 @@ var
   SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
   Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);

compiler/utils/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/08/11]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/11/08]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -184,6 +184,12 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 TARGETSUFFIX=$(OS_TARGET)
 SOURCESUFFIX=$(OS_SOURCE)
@@ -1261,7 +1267,6 @@ SHAREDLIBPREFIX=libfp
 STATICLIBPREFIX=libp
 IMPORTLIBPREFIX=libimp
 RSTEXT=.rst
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
 ifeq ($(OS_TARGET),go32v1)
 STATICLIBPREFIX=
 SHORTSUFFIX=v1
@@ -1402,161 +1407,6 @@ EXEEXT=.dol
 SHAREDLIBEXT=.so
 SHORTSUFFIX=wii
 endif
-else
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-STATICLIBPREFIX=
-SHORTSUFFIX=v1
-IMPORTLIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v2)
-STATICLIBPREFIX=
-SHORTSUFFIX=dos
-IMPORTLIBPREFIX=
-endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-SHORTSUFFIX=wat
-IMPORTLIBPREFIX=
-endif
-ifeq ($(OS_TARGET),linux)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=lnx
-endif
-ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=fbs
-endif
-ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=nbs
-endif
-ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=obs
-endif
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-AOUTEXT=.out
-SMARTEXT=.sl2
-STATICLIBPREFIX=
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=os2
-ECHO=echo
-IMPORTLIBPREFIX=
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.library
-SHORTSUFFIX=amg
-endif
-ifeq ($(OS_TARGET),atari)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=.ttp
-SHORTSUFFIX=ata
-endif
-ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=be
-endif
-ifeq ($(OS_TARGET),solaris)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nw
-IMPORTLIBPREFIX=imp
-endif
-ifeq ($(OS_TARGET),netwlibc)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nwl
-IMPORTLIBPREFIX=imp
-endif
-ifeq ($(OS_TARGET),macos)
-BATCHEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-DEBUGSYMEXT=.xcoff
-SHORTSUFFIX=mac
-IMPORTLIBPREFIX=imp
-endif
-endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1746,15 +1596,6 @@ ASNAME=$(BINUTILSPREFIX)as
 LDNAME=$(BINUTILSPREFIX)ld
 ARNAME=$(BINUTILSPREFIX)ar
 RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),win32)
-ifeq ($(CROSSBINDIR),)
-ASNAME=asw
-LDNAME=ldw
-ARNAME=arw
-endif
-endif
-endif
 ifndef ASPROG
 ifdef CROSSBINDIR
 ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
@@ -2065,10 +1906,12 @@ override FPCOPT+=-P$(ARCH)
 endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-XP$(BINUTILSPREFIX)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
 endif
 ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-Xr$(RLINKPATH)
@@ -2165,7 +2008,7 @@ override FPCOPT+=-Aas
 endif
 endif
 ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
-ifneq ($(findstring $(OS_TARGET),linux solaris),)
+ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif
@@ -2586,6 +2429,8 @@ ifneq ($(wildcard fpcmake.loc),)
 include fpcmake.loc
 endif
 .NOTPARALLEL:
+REG_SOURCES=$(wildcard *reg.pp)
+REG_EXES=$(subst .pp,$(EXEEXT),$(REG_SOURCES))
 ifndef NOCPUDEF
 ppu$(PPUEXT): ../ppu.pas
 	$(MAKE) ppu$(PPUEXT) NOCPUDEF=1
@@ -2616,4 +2461,6 @@ fpcfg.inc : fpinc.cfg
 fpini.inc : fpinc.ini
 	$(DATA2INC) -b -s fpinc.ini fpini.inc fpini
 endif
+reg_exes: $(COMPILER_UNITTARGETDIR)
+	$(MAKE) $(REG_EXES)
 unexport PPUFILES PPUMOVE

compiler/utils/Makefile.fpc

@@ -34,6 +34,9 @@ build=n
 # due to overwriting each other's link.res file
 .NOTPARALLEL:
 
+REG_SOURCES=$(wildcard *reg.pp)
+REG_EXES=$(subst .pp,$(EXEEXT),$(REG_SOURCES))
+
 ifndef NOCPUDEF
 ppu$(PPUEXT): ../ppu.pas
 	$(MAKE) ppu$(PPUEXT) NOCPUDEF=1
@@ -79,6 +82,9 @@ fpini.inc : fpinc.ini
         $(DATA2INC) -b -s fpinc.ini fpini.inc fpini
 endif
 
+reg_exes: $(COMPILER_UNITTARGETDIR)
+	$(MAKE) $(REG_EXES)
+
 #
 # Don't export some tools, which are found in the current dir if it's in
 # the path, so are not valid for the subdirs

compiler/utils/mk68kreg.pp

@@ -12,6 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
 program mkspreg;
 
 const Version = '1.00';
@@ -40,9 +41,6 @@ end;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i]<>',') and (i<=length(s)) do
@@ -50,7 +48,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 
@@ -73,7 +70,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkarmins.pp

@@ -12,6 +12,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
+
 program mkarmins;
 
 const
@@ -89,7 +91,6 @@ function readnumber : longint;
 
   var
      base : longint;
-     result : longint;
 
   begin
      result:=0;
@@ -117,7 +118,6 @@ function readnumber : longint;
           end;
           inc(i);
        end;
-     readnumber:=result;
   end;
 
 function tostr(l : longint) : string;
@@ -132,9 +132,6 @@ function tostr(l : longint) : string;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do
@@ -142,7 +139,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 procedure skipspace;
@@ -152,7 +148,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkarmreg.pp

@@ -12,6 +12,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
+
 program mkspreg;
 
 const Version = '1.00';
@@ -40,9 +42,6 @@ end;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i]<>',') and (i<=length(s)) do
@@ -50,7 +49,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 
@@ -73,7 +71,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkavrreg.pp

@@ -12,6 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
 program mkspreg;
 
 const Version = '1.00';
@@ -39,9 +40,6 @@ end;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i]<>',') and (i<=length(s)) do
@@ -49,7 +47,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 
@@ -72,7 +69,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkmpsreg.pp

@@ -12,6 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
 program mkmipsreg;
 
 const Version = '1.00';
@@ -32,8 +33,7 @@ var s : string;
     stabs : array[0..max_regcount-1] of string[63];
     regnumber_index,
     std_regname_index,
-    gas_regname_index,
-    mot_regname_index : array[0..max_regcount-1] of byte;
+    gas_regname_index : array[0..max_regcount-1] of byte;
 
 function tostr(l : longint) : string;
 
@@ -43,9 +43,6 @@ end;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i]<>',') and (i<=length(s)) do
@@ -53,7 +50,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 
@@ -76,7 +72,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);
@@ -247,7 +243,7 @@ procedure write_inc_files;
 var
     norfile,stdfile,supfile,
     numfile,stabfile,confile,gasfile,dwarffile,
-    rnifile,srifile,mrifile,grifile : text;
+    rnifile,srifile,grifile : text;
     first:boolean;
 
 begin
@@ -263,7 +259,6 @@ begin
   openinc(rnifile,'rmipsrni.inc');
   openinc(srifile,'rmipssri.inc');
   openinc(grifile,'rmipsgri.inc');
-  openinc(mrifile,'rmipsmri.inc');
   first:=true;
   for i:=0 to regcount-1 do
     begin
@@ -277,7 +272,6 @@ begin
           writeln(rnifile,',');
           writeln(srifile,',');
           writeln(grifile,',');
-          writeln(mrifile,',');
         end
       else
         first:=false;
@@ -291,7 +285,6 @@ begin
       write(rnifile,regnumber_index[i]);
       write(srifile,std_regname_index[i]);
       write(grifile,gas_regname_index[i]);
-      write(mrifile,mot_regname_index[i]);
     end;
   write(norfile,regcount);
   close(confile);
@@ -305,7 +298,6 @@ begin
   closeinc(rnifile);
   closeinc(srifile);
   closeinc(grifile);
-  closeinc(mrifile);
   writeln('Done!');
   writeln(regcount,' registers procesed');
 end;

compiler/utils/mkppcreg.pp

@@ -12,6 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
 program mkppcreg;
 
 const Version = '1.00';
@@ -45,9 +46,6 @@ end;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i]<>',') and (i<=length(s)) do
@@ -55,7 +53,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 
@@ -78,7 +75,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkspreg.pp

@@ -12,6 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
 program mkspreg;
 
 const Version = '1.00';
@@ -41,9 +42,6 @@ end;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i]<>',') and (i<=length(s)) do
@@ -51,7 +49,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 
@@ -74,7 +71,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkx86ins.pp

@@ -12,6 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}
 program mkx86ins;
 
 const
@@ -103,8 +104,6 @@ function readnumber : longint;
 
   var
      base : longint;
-     result : longint;
-
   begin
      result:=0;
      if s[i]='\' then
@@ -131,7 +130,6 @@ function readnumber : longint;
           end;
           inc(i);
        end;
-     readnumber:=result;
   end;
 
 function tostr(l : longint) : string;
@@ -146,9 +144,6 @@ function tostr(l : longint) : string;
 
 function readstr : string;
 
-  var
-     result : string;
-
   begin
      result:='';
      while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do
@@ -156,7 +151,6 @@ function readstr : string;
           result:=result+s[i];
           inc(i);
        end;
-     readstr:=result;
   end;
 
 procedure skipspace;
@@ -166,7 +160,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);

compiler/utils/mkx86reg.pp

@@ -68,7 +68,7 @@ procedure skipspace;
        inc(i);
   end;
 
-procedure openinc(var f:text;const fn:string);
+procedure openinc(out f:text;const fn:string);
 begin
   writeln('creating ',fn);
   assign(f,fn);