Merge branch 'main' into mos6502

compiler/Makefile

@@ -5409,6 +5409,11 @@ endif
 ifeq ($(COMPILEREXENAME),)
 COMPILEREXENAME:=$(EXENAME)
 endif
+ifeq ($(OS_SOURCE),morphos)
+COMPILEREXEDIR:=$(shell echo $(BASEDIR) | sed 's/\///;s/\//:/')
+else
+COMPILEREXEDIR:=$(BASEDIR)
+endif
 .PHONY : revision
 revision :
 	$(DEL) revision.inc
@@ -5429,7 +5434,7 @@ else
 endif
 	$(COMPILER) version.pas
 endif
-	$(COMPILER) -o$(BASEDIR)/$(COMPILEREXENAME) pp.pas
+	$(COMPILER) -o$(COMPILEREXEDIR)/$(COMPILEREXENAME) pp.pas
 	$(EXECPPAS)
 .PHONY: cycle full full_targets fullcycle wpocycle
 ifeq ($(CPU_SOURCE),$(PPC_TARGET))

compiler/Makefile.fpc

@@ -919,6 +919,12 @@ ifeq ($(COMPILEREXENAME),)
 COMPILEREXENAME:=$(EXENAME)
 endif
 
+ifeq ($(OS_SOURCE),morphos)
+COMPILEREXEDIR:=$(shell echo $(BASEDIR) | sed 's/\///;s/\//:/')
+else
+COMPILEREXEDIR:=$(BASEDIR)
+endif
+
 .PHONY : revision
 
 revision :
@@ -943,7 +949,7 @@ else
 endif
         $(COMPILER) version.pas
 endif
-        $(COMPILER) -o$(BASEDIR)/$(COMPILEREXENAME) pp.pas
+        $(COMPILER) -o$(COMPILEREXEDIR)/$(COMPILEREXENAME) pp.pas
         $(EXECPPAS)
 
 #####################################################################

compiler/aasmbase.pas

@@ -181,7 +181,9 @@ interface
          sec_heap,
          { dwarf based/gcc style exception handling }
          sec_gcc_except_table,
-         sec_arm_attribute
+         sec_arm_attribute,
+         { Used for GNU .note sections }
+         sec_note
        );
 
        TObjCAsmSectionType = sec_objc_class..sec_objc_protolist;

compiler/aasmcnst.pas

@@ -1021,7 +1021,7 @@ implementation
               if not(section in [low(TObjCAsmSectionType)..high(TObjCAsmSectionType)]) then
                 prelist.concat(tai_directive.Create(asd_reference,asmsym.name))
              end
-           else if section<>sec_fpc then
+           else if not(section in [sec_fpc,sec_note]) then
              internalerror(2015101402);
          end;
 

compiler/aggas.pas

@@ -206,6 +206,7 @@ implementation
            create_smartlink_sections and
            (atype<>sec_toc) and
            (atype<>sec_user) and
+           (atype<>sec_note) and
            { on embedded systems every byte counts, so smartlink bss too }
            ((atype<>sec_bss) or (target_info.system in (systems_embedded+systems_freertos)));
       end;
@@ -282,7 +283,8 @@ implementation
           '.stack',
           '.heap',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
         secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
           '.text',
@@ -343,7 +345,8 @@ implementation
           '.stack',
           '.heap',
           '.gcc_except_table',
-          '..ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
       var
         sep     : string[3];
@@ -398,6 +401,9 @@ implementation
         if atype=sec_user then
           secname:=aname;
 
+        if atype=sec_note then
+          secname:='.note'+aname;
+
         if is_smart_section(atype) and (aname<>'') then
           begin
             case aorder of
@@ -580,6 +586,7 @@ implementation
              if not(atype in [sec_data,sec_rodata,sec_rodata_norel]) and
                 not(asminfo^.id=as_solaris_as) and
                 not(atype=sec_fpc) and
+                not(atype=sec_note) and
                 not(target_info.system in (systems_embedded+systems_freertos)) then
                begin
                  usesectionflags:=true;
@@ -646,6 +653,8 @@ implementation
                     internalerror(2006031101);
                 end;
               end;
+            sec_note :
+              writer.AsmWrite(', "", @note');
           else
             { GNU AS won't recognize '.text.n_something' section name as belonging
               to '.text' and assigns default attributes to it, which is not
@@ -2264,7 +2273,8 @@ implementation
          sec_none (* sec_stack *),
          sec_none (* sec_heap *),
          sec_none (* gcc_except_table *),
-         sec_none (* sec_arm_attribute *)
+         sec_none (* sec_arm_attribute *),
+         sec_none (* sec_note *)
         );
       begin
         Result := inherited SectionName (SecXTable [AType], AName, AOrder);

compiler/aoptobj.pas

@@ -29,7 +29,7 @@ Unit AoptObj;
 
 {$i fpcdefs.inc}
 
-{$if not defined(JVM) and not defined(WASM) and not defined(POWERPC) and not defined (POWERPC64)}
+{$if not defined(JVM) and not defined(WASM)}
 {$define CPU_SUPPORTS_OPT_COND_JUMP}
 {$endif}
 
@@ -1261,13 +1261,28 @@ Unit AoptObj;
 
       class function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
       Var TempP: Tai;
+{$ifdef CPU_BC_HAS_SIZE_LIMIT}
+         count: ASizeUInt;
+{$endif CPU_BC_HAS_SIZE_LIMIT}
       Begin
         TempP := hp;
+{$ifdef CPU_BC_HAS_SIZE_LIMIT}
+        count:=0;
+{$endif CPU_BC_HAS_SIZE_LIMIT}
         While Assigned(TempP) and
+{$ifdef CPU_BC_HAS_SIZE_LIMIT}
+	     (count < BC_max_distance) and
+{$endif CPU_BC_HAS_SIZE_LIMIT}
              (TempP.typ In SkipInstr + [ait_label,ait_align]) Do
           If (TempP.typ <> ait_Label) Or
              (Tai_label(TempP).labsym <> L)
-            Then GetNextInstruction(TempP, TempP)
+            Then
+               begin
+                 GetNextInstruction(TempP, TempP);
+{$ifdef CPU_BC_HAS_SIZE_LIMIT}
+		 inc(count);
+{$endif CPU_BC_HAS_SIZE_LIMIT}
+               end
             Else
               Begin
                 hp := TempP;

compiler/avr/navrutil.pas

@@ -34,9 +34,14 @@ interface
 
 
   type
+
+    { tavrnodeutils }
+
     tavrnodeutils = class(tnodeutils)
     protected
       class procedure insert_init_final_table(main: tmodule; entries:tfplist); override;
+    public
+      class procedure InsertMemorySizes; override;
     end;
 
 implementation
@@ -108,6 +113,68 @@ implementation
       inherited insert_init_final_table(main,entries);
     end;
 
+  class procedure tavrnodeutils.InsertMemorySizes;
+    var
+      tcb: ttai_typedconstbuilder;
+      notename, strtable: shortstring;
+      sym: tasmsymbol;
+      defstr, defu32: tdef;
+    begin
+      { Store device information in the .note.gnu.avr.deviceinfo section.
+
+        Layout of.note.gnu.avr.deviceinfo:
+         note_name_len: dword
+         note_desc_len: dword // Size of the Tavr_desc data record
+         note_type: dword = 1
+         Tavr_desc = record
+           note_name: char[note_name_len] = 'AVR'#0;
+           flash_start,
+           flash_size,
+           sram_start,
+           sram_size,
+           eeprom_start,
+           eeprom_size: dword;
+           offset_table_len: dword;
+           offset_table: char[] = #0+mcuname#0+#0;
+         end }
+
+      notename:='AVR'#0;
+      strtable:=#0+lower(embedded_controllers[current_settings.controllertype].controllertypestr)+#0#0;
+      tcb:=ctai_typedconstbuilder.create([tcalo_no_dead_strip]);
+      defu32:=corddef.create(u32bit,0,$FFFFFFFF,false);
+      tcb.maybe_begin_aggregate(defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(length(notename)),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(length(strtable)+32),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(1),defu32);
+      defstr:=carraydef.getreusable(cansichartype,length(notename));
+      tcb.maybe_begin_aggregate(defstr);
+      tcb.emit_tai(Tai_string.Create(notename),defstr);
+      tcb.maybe_begin_aggregate(defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(embedded_controllers[current_settings.controllertype].flashbase),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(embedded_controllers[current_settings.controllertype].flashsize),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(embedded_controllers[current_settings.controllertype].srambase),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(embedded_controllers[current_settings.controllertype].sramsize),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(embedded_controllers[current_settings.controllertype].eeprombase),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(embedded_controllers[current_settings.controllertype].eepromsize),defu32);
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(8),defu32);  // Size of string offset table
+      tcb.emit_tai(tai_const.Create_32bit_unaligned(1),defu32);  // Offset of string in table
+      tcb.maybe_begin_aggregate(defstr);
+      tcb.emit_tai(Tai_string.Create(strtable),defstr);
+      tcb.maybe_end_aggregate(defstr);
+      tcb.maybe_end_aggregate(defu32);
+      tcb.maybe_end_aggregate(defstr);
+      tcb.maybe_end_aggregate(defu32);
+
+      sym:=current_asmdata.DefineAsmSymbol('__AVR_deviceinfo',AB_LOCAL,AT_DATA,defstr);
+      current_asmdata.asmlists[al_globals].concatlist(
+        tcb.get_final_asmlist(sym,defstr,sec_note,'.gnu.avr.deviceinfo',const_align(32))
+      );
+      defu32.free;
+      tcb.free;
+
+      inherited InsertMemorySizes;
+    end;
+
 begin
   cnodeutils:=tavrnodeutils;
 end.

compiler/fpcdefs.inc

@@ -183,6 +183,7 @@
   {$define cpurefshaveindexreg}
   {$define SUPPORT_SAFECALL}
   {$define SUPPORT_GET_FRAME}
+  {$define CPU_BC_HAS_SIZE_LIMIT}
 {$endif powerpc}
 
 {$ifdef powerpc64}
@@ -196,6 +197,7 @@
   {$define cpurefshaveindexreg}
   {$define cpuno32bitops}
   {$define SUPPORT_SAFECALL}
+  {$define CPU_BC_HAS_SIZE_LIMIT}
 {$endif powerpc64}
 
 {$ifdef arm}

compiler/globals.pas

@@ -232,6 +232,15 @@ Const
 
     const
       LinkMapWeightDefault = 1000;
+{$ifdef CPU_BC_HAS_SIZE_LIMIT}
+    {$if defined(POWERPC) or defined(POWERPC64)}
+      { instructions are 4-byte long and relative jump distance
+        a signed 16-bit signed integer, code as
+        reduced by a small amount to avoid troubles
+        as distance can be modified by optimizations. }
+      BC_max_distance = ($8000 div 4) - $100;
+    {$endif}
+{$endif CPU_BC_HAS_SIZE_LIMIT}
 
     type
       TLinkRec = record

compiler/htypechk.pas

@@ -528,7 +528,8 @@ implementation
                  { <dyn. array> + <dyn. array> is handled by the compiler }
                  if (m_array_operators in current_settings.modeswitches) and
                      (treetyp=addn) and
-                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
+                     (is_dynamic_array(ld) or is_array_constructor(ld)) and
+                     (is_dynamic_array(rd) or is_array_constructor(rd)) then
                     begin
                       allowed:=false;
                       exit;

compiler/nadd.pas

@@ -2874,7 +2874,22 @@ const
                         inserttypeconv(right,left.resultdef)
                        else if is_voidpointer(left.resultdef) then
                         inserttypeconv(left,right.resultdef)
-                       else if not(equal_defs(ld,rd)) then
+                       else if not (
+                           { in Delphi two different pointer types can be compared
+                             if either $POINTERMATH is currently enabled or if
+                             both pointer defs were declared with $POINTERMATH
+                             enabled }
+                           (m_delphi in current_settings.modeswitches) and
+                           (ld.typ=pointerdef) and
+                           (rd.typ=pointerdef) and
+                           (
+                             (cs_pointermath in current_settings.localswitches) or
+                             (
+                               tpointerdef(ld).has_pointer_math and
+                               tpointerdef(rd).has_pointer_math
+                             )
+                           )
+                         ) and not(equal_defs(ld,rd)) then
                         IncompatibleTypes(ld,rd);
                      end
                     else

compiler/ncal.pas

@@ -4265,9 +4265,15 @@ implementation
 
                    { if the final procedure definition is not yet owned,
                      ensure that it is }
-                   procdefinition.register_def;
                    if (procdefinition.typ=procdef) and assigned(tprocdef(procdefinition).procsym) then
-                     tprocdef(procdefinition).procsym.register_sym;
+                     begin
+                       { if the procdef does not yet have an owner (e.g. because it has just been
+                         specialized) then insert it into the same owner as the procsym }
+                       if not assigned(procdefinition.owner) and assigned(tprocdef(procdefinition).procsym.owner) then
+                         tprocdef(procdefinition).procsym.owner.insertdef(procdefinition);
+                       tprocdef(procdefinition).procsym.register_sym;
+                     end;
+                   procdefinition.register_def;
 
                    if procdefinition.is_specialization and (procdefinition.typ=procdef) then
                      maybe_add_pending_specialization(procdefinition,candidates.para_anon_syms);

compiler/ogbase.pas

@@ -1532,7 +1532,8 @@ implementation
           {stack} [oso_load,oso_write],
           {heap} [oso_load,oso_write],
           {gcc_except_table} [oso_data,oso_load],
-          {arm_attribute} [oso_data]
+          {arm_attribute} [oso_data],
+          {note} [oso_Data,oso_note]
         );
       begin
         if target_asm.id in asms_int_coff then

compiler/ogcoff.pas

@@ -986,7 +986,8 @@ implementation
           '.stack',
           '.heap',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
 
 const go32v2stub : array[0..2047] of byte=(

compiler/ogelf.pas

@@ -568,7 +568,8 @@ implementation
           '.stack',
           '.heap',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
       var
         sep : string[3];

compiler/ogrel.pas

@@ -318,7 +318,8 @@ implementation
           '_STACK',
           '_HEAP',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
       begin
         if atype=sec_user then

compiler/ogwasm.pas

@@ -1015,7 +1015,8 @@ implementation
           '.stack',
           '.heap',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
       var
         sep     : string[3];

compiler/omfbase.pas

@@ -88,7 +88,8 @@ interface
       'stack',
       'heap',
       'gcc_except_table',
-      'ARM_attributes'
+      'ARM_attributes',
+      'note'
     );
 
     { OMF record types }
@@ -2966,7 +2967,8 @@ implementation
         {stack} 'STACK',
         {heap} 'HEAP',
         {gcc_except_table} 'DATA',
-        {ARM_attributes} 'DATA'
+        {ARM_attributes} 'DATA',
+        {note} 'DATA'
       );
     begin
       result:=segclass[atype];

compiler/pgentype.pas

@@ -27,6 +27,7 @@ interface
 
 uses
   cclasses,
+  tokens,
   globtype,
   symtype,symbase;
 
@@ -41,6 +42,7 @@ type
     oldgenericdummysyms   : tfphashobjectlist;
     oldspecializestate    : pspecializationstate;
     oldcurrent_genericdef : tdef;
+    oldoptoken            : ttoken;
   end;
 
   tspecializationcontext=class

compiler/pgenutil.pas

@@ -2784,6 +2784,8 @@ uses
       state.oldgenericdummysyms:=current_module.genericdummysyms;
       state.oldcurrent_genericdef:=current_genericdef;
       state.oldspecializestate:=pspecializationstate(current_module.specializestate);
+      state.oldoptoken:=optoken;
+      optoken:=NOTOKEN;
       current_module.specializestate:=@state;
       current_module.extendeddefs:=TFPHashObjectList.create(true);
       current_module.genericdummysyms:=tfphashobjectlist.create(true);
@@ -2821,23 +2823,18 @@ uses
               that we specialize a generic in a different unit that was used
               in the implementation section of the generic's unit and were the
               interface is still being parsed and thus the localsymtable is in
-              reality the global symtable }
+              reality the global symtable
+
+              In addition to that it can also be the case that neither the
+              global- nor the localsymtable is set, namely when the compiler
+              didn't yet have the chance to process on of the units in the
+              (implementation) uses clause simply due to the orders, so don't
+              add anything of that unit yet (once routine bodies need to be
+              specialized everything needed should be in place however). }
             if pu.u.in_interface then
               begin
-                {
-                  MVC: The case where localsymtable is also nil can appear in complex cases and still produce valid code.
-                  In order to allow people in this case to continue, SKIP_INTERNAL20231102 can be defined.
-                  Default behaviour is to raise an internal error.
-                  See also
-                  https://gitlab.com/freepascal.org/fpc/source/-/issues/40502
-                }
-                {$IFDEF SKIP_INTERNAL20231102}
-                if (pu.u.localsymtable<>Nil) then
-                {$ELSE}
-                if (pu.u.localsymtable=Nil) then
-                  internalerror(20231102);
-                {$ENDIF}
-                  symtablestack.push(pu.u.localsymtable);
+                if assigned(pu.u.localsymtable) then
+                  symtablestack.push(pu.u.localsymtable)
               end
             else
               internalerror(200705153)
@@ -2865,6 +2862,7 @@ uses
       current_module.genericdummysyms.free;
       current_module.genericdummysyms:=state.oldgenericdummysyms;
       current_module.specializestate:=state.oldspecializestate;
+      optoken:=state.oldoptoken;
       symtablestack.free;
       symtablestack:=state.oldsymtablestack;
       { clear the state record to be on the safe side }

compiler/powerpc/agppcmpw.pas

@@ -123,6 +123,7 @@ interface
         '',
         '',
         '',
+        '',
         ''
       );
 

compiler/riscv/cgrv.pas

@@ -50,6 +50,8 @@ unit cgrv;
 
         procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); override;
         procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); override;
+        procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
+        procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
 
         procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
 
@@ -67,6 +69,8 @@ unit cgrv;
 
         procedure g_profilecode(list: TAsmList); override;
 
+        procedure g_overflowcheck_loc(list: TAsmList; const Loc: tlocation; def: tdef; ovloc: tlocation); override;
+
         { fpu move instructions }
         procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
         procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
@@ -216,64 +220,29 @@ unit cgrv;
 
     procedure tcgrv.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister);
       var
-        tmpreg: TRegister;
+        ovloc: tlocation;
       begin
-        optimize_op_const(size,op,a);
-
-        if op=OP_NONE then
-          begin
-            a_load_reg_reg(list,size,size,src,dst);
-            exit;
-          end;
-
-        if op=OP_SUB then
-          begin
-            op:=OP_ADD;
-            a:=-a;
-          end;
-
-{$ifdef RISCV64}
-        if (op=OP_SHL) and
-               (size=OS_S32) then
-          begin
-            list.concat(taicpu.op_reg_reg_const(A_SLLIW,dst,src,a));
-            maybeadjustresult(list,op,size,dst);
-          end
-        else if (op=OP_SHR) and
-               (size=OS_S32) then
-          begin
-            list.concat(taicpu.op_reg_reg_const(A_SRLIW,dst,src,a));
-            maybeadjustresult(list,op,size,dst);
-          end
-        else if (op=OP_SAR) and
-               (size=OS_S32) then
-          begin
-            list.concat(taicpu.op_reg_reg_const(A_SRAIW,dst,src,a));
-            maybeadjustresult(list,op,size,dst);
-          end
-        else
-{$endif RISCV64}
-        if (TOpCG2AsmConstOp[op]<>A_None) and
-           is_imm12(a) then
-          begin
-            list.concat(taicpu.op_reg_reg_const(TOpCG2AsmConstOp[op],dst,src,a));
-            maybeadjustresult(list,op,size,dst);
-          end
-        else
-          begin
-            tmpreg:=getintregister(list,size);
-            a_load_const_reg(list,size,a,tmpreg);
-            a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
-          end;
-      end;   
+        a_op_const_reg_reg_checkoverflow(list, op, size, a, src, dst, false, ovloc);
+      end;
 
 
-    procedure tcgrv.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
+    procedure tcgrv.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
       var
         name: String;
         pd: tprocdef;
         paraloc1, paraloc2: tcgpara;
+        ai: taicpu;
+        tmpreg1, tmpreg2: TRegister;
       begin
+        if setflags and
+          { do we know overflow checking for this operation? fix me! }(size in [OS_32,OS_S32]) and (op in [OP_ADD,OP_SUB,OP_MUL,OP_IMUL,OP_IDIV,OP_NEG]) then
+          begin
+            ovloc.loc:=LOC_JUMP;
+            current_asmdata.getjumplabel(ovloc.truelabel);
+            current_asmdata.getjumplabel(ovloc.falselabel);
+          end
+        else
+          ovloc.loc:=LOC_VOID;
         if op=OP_NOT then
           begin
             list.concat(taicpu.op_reg_reg_const(A_XORI,dst,src1,-1));
@@ -282,6 +251,15 @@ unit cgrv;
         else if op=OP_NEG then
           begin
             list.concat(taicpu.op_reg_reg_reg(A_SUB,dst,NR_X0,src1));
+
+            if setflags then
+              begin
+                { if dst and src are equal, an overflow happened }
+                a_cmp_reg_reg_label(list,OS_INT,OC_NE,dst,src1,ovloc.falselabel);
+
+                a_jmp_always(list,ovloc.truelabel);
+              end;
+
             maybeadjustresult(list,op,size,dst);
           end
         else
@@ -358,13 +336,168 @@ unit cgrv;
               end
             else
               begin
+                if setflags and (op=OP_MUL) and (size=OS_32) then
+                  begin
+                    tmpreg1:=getintregister(list,size);
+                    list.concat(taicpu.op_reg_reg_reg(A_MULHU,tmpreg1,src2,src1));
+                  end
+                else
+                  tmpreg1:=NR_NO;
                 list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src2,src1));
+                if setflags and (size in [OS_S32,OS_32]) then
+                  begin
+                    case op of
+                      OP_ADD:
+                        begin
+                          if size=OS_SINT then
+                            begin
+                              tmpreg1:=getintregister(list,size);
+                              list.concat(taicpu.op_reg_reg_reg(A_SLT,tmpreg1,dst,src2));
+                              tmpreg2:=getintregister(list,size);
+                              list.concat(taicpu.op_reg_reg_const(A_SLTI,tmpreg2,src1,0));
+                              a_cmp_reg_reg_label(list,OS_INT,OC_EQ,tmpreg1,tmpreg2,ovloc.falselabel)
+                            end
+                          else if size=OS_INT then
+                            begin
+                              ai:=taicpu.op_reg_reg_sym_ofs(A_Bxx,dst,src2,ovloc.falselabel,0);
+                              ai.condition:=C_GEU;
+                              list.concat(ai);
+                            end
+                          else
+                            Internalerror(2025102003);
+                          a_jmp_always(list,ovloc.truelabel);
+                        end;
+                      OP_SUB:
+                        begin
+                          if size=OS_S32 then
+                            begin
+                              tmpreg1:=getintregister(list,size);
+                              list.concat(taicpu.op_reg_reg_reg(A_SLT,tmpreg1,src2,dst));
+                              tmpreg2:=getintregister(list,size);
+                              list.concat(taicpu.op_reg_reg_const(A_SLTI,tmpreg2,src1,0));
+                              a_cmp_reg_reg_label(list,OS_INT,OC_EQ,tmpreg1,tmpreg2,ovloc.falselabel)
+                            end
+                          else if size=OS_32 then
+                            begin
+                              ai:=taicpu.op_reg_reg_sym_ofs(A_Bxx,src2,dst,ovloc.falselabel,0);
+                              ai.condition:=C_GEU;
+                              list.concat(ai);
+                            end
+                          else
+                            Internalerror(2025102002);
+                          a_jmp_always(list,ovloc.truelabel);
+                        end;
+                      OP_MUL:
+                        begin
+                          if size=OS_INT then
+                            a_cmp_reg_reg_label(list,OS_INT,OC_EQ,tmpreg1,NR_X0,ovloc.falselabel)
+                          else
+                            Internalerror(2025102002);
+                          a_jmp_always(list,ovloc.truelabel);
+                        end;
+                      OP_IMUL:
+                        begin
+                          if size=OS_SINT then
+                            begin
+                              tmpreg1:=getintregister(list,size);
+                              list.concat(taicpu.op_reg_reg_reg(A_MULH,tmpreg1,src2,src1));
+                              tmpreg2:=getintregister(list,size);
+                              list.concat(taicpu.op_reg_reg_const(A_SRAI,tmpreg2,dst,31));
+                              a_cmp_reg_reg_label(list,OS_INT,OC_EQ,tmpreg1,tmpreg2,ovloc.falselabel);
+                            end
+                          else
+                            Internalerror(2025102004);
+                          a_jmp_always(list,ovloc.truelabel);
+                        end;
+                      OP_IDIV:
+                        begin
+                          { Only overflow if dst is all 1's }
+                          tmpreg1:=getintregister(list,OS_INT);
+                          list.Concat(taicpu.op_reg_reg_const(A_ADDI,tmpreg1,dst,1));
+
+                          a_cmp_reg_reg_label(list,OS_INT,OC_NE,tmpreg1,NR_X0,ovloc.falselabel);
+
+                          a_jmp_always(list,ovloc.truelabel);
+                        end;
+                      else
+                        ;
+                    end
+                  end;
                 maybeadjustresult(list,op,size,dst);
               end;
           end;
       end;
 
 
+    procedure tcgrv.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
+      var
+        ovloc: tlocation;
+      begin
+        a_op_reg_reg_reg_checkoverflow(list, op, size, src1, src2, dst, false, ovloc);
+      end;
+
+
+    procedure tcgrv.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean;
+      var ovloc: tlocation);
+      var
+        tmpreg: TRegister;
+      begin
+        optimize_op_const(size,op,a);
+
+        if op=OP_NONE then
+          begin
+            a_load_reg_reg(list,size,size,src,dst);
+            exit;
+          end;
+
+        if op=OP_SUB then
+          begin
+            op:=OP_ADD;
+            a:=-a;
+          end;
+
+{$ifdef RISCV64}
+        if (op=OP_SHL) and
+               (size=OS_S32) then
+          begin
+            list.concat(taicpu.op_reg_reg_const(A_SLLIW,dst,src,a));
+            maybeadjustresult(list,op,size,dst);
+          end
+        else if (op=OP_SHR) and
+               (size=OS_S32) then
+          begin
+            list.concat(taicpu.op_reg_reg_const(A_SRLIW,dst,src,a));
+            maybeadjustresult(list,op,size,dst);
+          end
+        else if (op=OP_SAR) and
+               (size=OS_S32) then
+          begin
+            list.concat(taicpu.op_reg_reg_const(A_SRAIW,dst,src,a));
+            maybeadjustresult(list,op,size,dst);
+          end
+        else
+{$endif RISCV64}
+        if (TOpCG2AsmConstOp[op]<>A_None) and
+           is_imm12(a) and not(setflags) then
+          begin
+            list.concat(taicpu.op_reg_reg_const(TOpCG2AsmConstOp[op],dst,src,a));
+            maybeadjustresult(list,op,size,dst);
+          end
+        else if setflags then
+          begin
+            tmpreg:=getintregister(list,size);
+            a_load_const_reg(list,size,a,tmpreg);
+            a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,true,ovloc);
+          end
+        else
+          begin
+            tmpreg:=getintregister(list,size);
+            a_load_const_reg(list,size,a,tmpreg);
+            a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
+          end;
+      end;
+
+
     procedure tcgrv.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
       var
         href: treference;
@@ -727,6 +860,21 @@ unit cgrv;
       end;
 
 
+    procedure tcgrv.g_overflowcheck_loc(list: TAsmList; const Loc: tlocation; def: tdef; ovloc: tlocation);
+      begin
+        if not(cs_check_overflow in current_settings.localswitches) then
+          exit;
+        { no overflow checking yet generated }
+        if ovloc.loc=LOC_VOID then
+          exit;
+        if ovloc.loc<>LOC_JUMP then
+          Internalerror(2025102001);
+        a_label(list,ovloc.truelabel);
+        a_call_name(list,'FPC_OVERFLOW',false);
+        a_label(list,ovloc.falselabel);
+      end;
+
+
     procedure tcgrv.a_call_reg(list : TAsmList;reg: tregister);
       begin
         list.concat(taicpu.op_reg_reg(A_JALR,NR_RETURN_ADDRESS_REG,reg));

compiler/riscv64/cgcpu.pas

@@ -41,7 +41,6 @@ unit cgcpu;
         procedure a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;     
         procedure a_load_const_reg(list: TAsmList; size: tcgsize; a: tcgint; register: tregister); override;
 
-        procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
         procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
 
         procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
@@ -204,24 +203,6 @@ implementation
       end;
 
 
-    procedure tcgrv64.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
-      var
-        signed: Boolean;
-        l: TAsmLabel;
-        tmpreg: tregister;
-        ai: taicpu;
-      begin
-        if setflags then
-          begin
-            tmpreg:=getintregister(list,size);
-            a_load_const_reg(list,size,a,tmpreg);
-            a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc);
-          end
-        else
-          a_op_const_reg_reg(list,op,size,a,src,dst);
-      end;
-
-
     procedure tcgrv64.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
         var
         signed: Boolean;
@@ -230,6 +211,7 @@ implementation
         ai: taicpu;
       begin
         signed:=tcgsize2unsigned[size]<>size;
+        ovloc.loc:=LOC_VOID;
 
         if setflags then
           case op of
@@ -362,7 +344,7 @@ implementation
               internalerror(2019051032);
           end
         else
-          a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+          inherited a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
       end;
 
 

compiler/scandir.pas

@@ -475,6 +475,11 @@ unit scandir;
         do_delphiswitch('D');
       end;
 
+    procedure dir_definitioninfo;
+      begin
+        do_delphiswitch('Y');
+      end;
+
     procedure dir_denypackageunit;
       begin
         do_moduleflagswitch(mf_package_deny,true);
@@ -2015,6 +2020,11 @@ unit scandir;
         do_delphiswitch('J');
       end;
 
+    procedure dir_yd;
+      begin
+        HandleSwitch('Y','+');
+      end;
+
     procedure dir_z1;
       begin
         current_settings.packenum:=1;
@@ -2198,6 +2208,7 @@ unit scandir;
         AddDirective('COPYRIGHT',directive_all, @dir_copyright);
         AddDirective('D',directive_all, @dir_description);
         AddDirective('DEBUGINFO',directive_all, @dir_debuginfo);
+        AddDirective('DEFINITIONINFO',directive_all, @dir_definitioninfo);
         AddDirective('DENYPACKAGEUNIT',directive_all,@dir_denypackageunit);
         AddDirective('DESCRIPTION',directive_all, @dir_description);
         AddDirective('ENDREGION',directive_all, @dir_endregion);
@@ -2309,6 +2320,7 @@ unit scandir;
         AddDirective('WARNINGS',directive_all, @dir_warnings);
         AddDirective('WEAKPACKAGEUNIT',directive_all, @dir_weakpackageunit);
         AddDirective('WRITEABLECONST',directive_all, @dir_writeableconst);
+        AdDDirective('YD',directive_all, @dir_yd);
         AddDirective('Z1',directive_all, @dir_z1);
         AddDirective('Z2',directive_all, @dir_z2);
         AddDirective('Z4',directive_all, @dir_z4);

compiler/symdef.pas

@@ -2684,7 +2684,7 @@ implementation
            tmod:=find_module_from_symtable(owner);
             if assigned(tmod) and assigned(current_module) and (tmod<>current_module) then
               begin
-                comment(v_error,'Definition '+fullownerhierarchyname(false)+' from module '+tmod.mainsource+' regitered with current module '+current_module.mainsource);
+                comment(v_error,'Definition '+fullownerhierarchyname(false)+' from module '+tmod.mainsource+' registered with current module '+current_module.mainsource);
               end;
            if not assigned(tmod) then
              tmod:=current_module;

compiler/symsym.pas

@@ -751,7 +751,7 @@ implementation
             tmod:=find_module_from_symtable(owner);
             if assigned(tmod) and assigned(current_module) and (tmod<>current_module) then
               begin
-                comment(v_error,'Symbol '+realname+' from module '+tmod.mainsource+' regitered with current module '+current_module.mainsource);
+                comment(v_error,'Symbol '+realname+' from module '+tmod.mainsource+' registered with current module '+current_module.mainsource);
               end;
 	    if not assigned(tmod) then
               tmod:=current_module;

compiler/symtable.pas

@@ -4275,6 +4275,16 @@ implementation
         if result=nil then
           result:=search_specific_assignment_operator(_ASSIGNMENT,from_def,to_def);
 
+        { if we're assigning to a typed pointer, but we did not find a suitable assignement
+          operator then we also check for a untyped pointer assignment operator }
+        if not assigned(result) and is_pointer(to_def) and not is_voidpointer(to_def) then
+          begin
+            if explicit then
+              result:=search_specific_assignment_operator(_OP_EXPLICIT,from_def,voidpointertype);
+            if not assigned(result) then
+              result:=search_specific_assignment_operator(_ASSIGNMENT,from_def,voidpointertype);
+          end;
+
         { restore symtable stack }
         if to_def.typ in [recorddef,objectdef] then
           symtablestack.pop(tabstractrecorddef(to_def).symtable);

compiler/x86/agx86int.pas

@@ -154,6 +154,7 @@ implementation
         '',
         '',
         '',
+        '',
         ''
       );
 
@@ -210,6 +211,7 @@ implementation
         '',
         '',
         '',
+        '',
         ''
       );
 

compiler/x86/agx86nsm.pas

@@ -592,7 +592,8 @@ interface
           '.stack',
           '.heap',
           ',gcc_except_table',
-          ',ARM_attributes'
+          ',ARM_attributes',
+          ',note'
         );
       var
         secname,secgroup: string;

compiler/z80/agsdasz80.pas

@@ -273,7 +273,8 @@ unit agsdasz80;
           '_STACK',
           '_HEAP',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
       begin
         if atype=sec_user then

compiler/z80/agz80vasm.pas

@@ -289,7 +289,8 @@ unit agz80vasm;
           '.stack',
           '.heap',
           '.gcc_except_table',
-          '.ARM.attributes'
+          '.ARM.attributes',
+          '.note'
         );
       var
         sep: string[3];

packages/fcl-jsonschema/src/fpjson.schema.codegen.pp

@@ -20,9 +20,9 @@ interface
 
 uses
   {$IFDEF FPC_DOTTEDUNITS}
-  System.Classes, System.SysUtils, System.DateUtils, Pascal.CodeGenerator,
+  System.Classes, System.SysUtils, System.DateUtils, Pascal.CodeGenerator,  System.Contnrs,
   {$ELSE}
-  Classes, SysUtils, dateutils, pascodegen,
+  Classes, SysUtils, dateutils, pascodegen, contnrs,
   {$ENDIF}
   fpjson.schema.types,
   fpjson.schema.Pascaltypes;
@@ -58,15 +58,22 @@ Type
   TTypeCodeGenerator = class(TJSONSchemaCodeGenerator)
   private
     FTypeParentClass: string;
+    FGenerated : TFPObjectHashTable;
+    procedure GenerateClassForwardTypes(aData: TSchemaData);
     procedure GenerateClassTypes(aData: TSchemaData);
+    procedure GenerateIntegerTypes(aData: TSchemaData);
     procedure GeneratePascalArrayTypes(aData: TSchemaData);
     procedure GenerateStringTypes(aData: TSchemaData);
     procedure WriteDtoConstructor(aType: TPascalTypeData); virtual;
     procedure WriteDtoField(aType: TPascalTypeData; aProperty: TPascalPropertyData); virtual;
     procedure WriteDtoType(aType: TPascalTypeData); virtual;
+    procedure WriteDtoForwardType(aType: TPascalTypeData); virtual;
     procedure WriteDtoArrayType(aType: TPascalTypeData); virtual;
+    procedure WriteDtoArrayRefType(aType: TPascalTypeData); virtual;
     procedure WriteStringArrayType(aType: TPascalTypeData);
+    procedure WriteIntegerArrayType(aType: TPascalTypeData);
     procedure WriteStringType(aType: TPascalTypeData); virtual;
+    procedure WriteIntegerType(aType: TPascalTypeData); virtual;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Execute(aData: TSchemaData);
@@ -275,6 +282,7 @@ var
   I: integer;
 
 begin
+  fGenerated.Add(aType.PascalName,aType);
   if WriteClassType then
     Addln('%s = Class(%s)', [aType.PascalName, TypeParentClass])
   else
@@ -289,17 +297,38 @@ begin
   Addln('');
 end;
 
+procedure TTypeCodeGenerator.WriteDtoForwardType(aType: TPascalTypeData);
+begin
+  Addln('%s = class;',[aType.PascalName]);
+end;
+
 procedure TTypeCodeGenerator.WriteDtoArrayType(aType: TPascalTypeData);
 
 var
   Fmt : String;
 
+begin
+  if FGenerated.Items[aType.PascalName]<>Nil then
+    exit;
+  FGenerated.Add(aType.PascalName,aType);
+  if DelphiCode then
+    Fmt:='%s = TArray<%s>;'
+  else
+    Fmt:='%s = Array of %s;';
+  Addln(Fmt,[aType.PascalName,aType.ElementTypeData.PascalName]);
+end;
+
+procedure TTypeCodeGenerator.WriteDtoArrayRefType(aType: TPascalTypeData);
+var
+  Fmt : String;
+  lName : string;
 begin
   if DelphiCode then
     Fmt:='%s = TArray<%s>;'
   else
     Fmt:='%s = Array of %s;';
   Addln(Fmt,[aType.PascalName,aType.ElementTypeData.PascalName]);
+
 end;
 
 procedure TTypeCodeGenerator.WriteStringArrayType(aType: TPascalTypeData);
@@ -308,12 +337,53 @@ begin
   WriteDtoArrayType(aType);
 end;
 
+procedure TTypeCodeGenerator.WriteIntegerArrayType(aType: TPascalTypeData);
+begin
+  WriteDtoArrayType(aType);
+end;
+
 procedure TTypeCodeGenerator.WriteStringType(aType: TPascalTypeData);
 
 begin
+  FGenerated.Add(aType.PascalName,aType);
   Addln('%s = string;',[aType.PascalName]);
 end;
 
+procedure TTypeCodeGenerator.WriteIntegerType(aType: TPascalTypeData);
+var
+  I,lEl,lMin,lMax : Integer;
+  lName: string;
+begin
+  lMin:=0;
+  lMax:=0;
+  FGenerated.Add(aType.PascalName,aType);
+  if aType.Schema.Validations.HasKeywordData(jskEnum) and
+     (aType.Schema.Validations.Enum.Count>0) then
+    begin
+    lMin:=aType.Schema.Validations.Enum.Items[0].AsInteger;
+    lMax:=aType.Schema.Validations.Enum.Items[0].AsInteger;
+    for I:=1 to aType.Schema.Validations.Enum.Count-1 do
+      begin
+      lEl:=aType.Schema.Validations.Enum.Items[i].AsInteger;
+      if lEl<lMin then
+        lMin:=lEl;
+      if lEl>lMax then
+        lMax:=lEl;
+      end;
+    if (lMax-lMin+1)<>aType.Schema.Validations.Enum.Count then
+      begin
+      lMin:=0;
+      lMax:=0;
+      end;
+    end;
+  lName:=aType.PascalName;
+  if lMin<>lMax then
+    Addln('%s = %d..%d;',[lName,lMin,lMax])
+  else
+    Addln('%s = Integer;',[lName]);
+
+end;
+
 
 constructor TTypeCodeGenerator.Create(AOwner: TComponent);
 begin
@@ -348,6 +418,49 @@ begin
     AddLn('');
 end;
 
+procedure TTypeCodeGenerator.GenerateIntegerTypes(aData : TSchemaData);
+
+var
+  I,lCount: integer;
+  lType,lArray : TPascalTypeData;
+begin
+  lCount:=0;
+  for I := 0 to aData.TypeCount-1 do
+    begin
+    lType:=aData.Types[I];
+    if (lType.PascalType=ptInteger) then
+      begin
+      DoLog('Generating integer type %s', [lType.PascalName]);
+      WriteIntegerType(lType);
+      inc(lCount);
+      lArray:=aData.FindSchemaTypeData('['+lType.SchemaName+']');
+      if lArray<>Nil then
+        begin
+        WriteIntegerArrayType(lArray);
+        inc(lCount);
+        end;
+      end;
+    end;
+  if lCount>0 then
+    AddLn('');
+end;
+
+procedure TTypeCodeGenerator.GenerateClassForwardTypes(aData: TSchemaData);
+var
+  I: integer;
+  lArray : TPascalTypeData;
+  lName : string;
+begin
+  for I := 0 to aData.TypeCount-1 do
+    if aData.Types[I].PascalType in [ptSchemaStruct,ptAnonStruct] then
+      begin
+        DoLog('Generating DTO class forward type %s', [aData.Types[I].PascalName]);
+        lName:=aData.Types[I].PascalName;
+        WriteDtoForwardType(aData.Types[I]);
+      end
+
+end;
+
 procedure TTypeCodeGenerator.GenerateClassTypes(aData : TSchemaData);
 
 var
@@ -374,6 +487,7 @@ procedure TTypeCodeGenerator.GeneratePascalArrayTypes(aData : TSchemaData);
 var
   I, lCount: integer;
   lType : TPascalTypeData;
+  lName : string;
 
 begin
   lCount := 0;
@@ -383,13 +497,12 @@ begin
     // It is an array
     if (lType.PascalType=ptArray) then
       begin
-      // the element type is a standard type
-      if (lType.ElementTypeData.Schema=Nil) then
+      if (lType.ElementTypeData.PascalName<>'') then
         begin
         DoLog('Generating array type %s', [lType.PascalName]);
         WriteDtoArrayType(lType);
         inc(lCount);
-        end;
+        end
       end;
     end;
   if lCount>0 then
@@ -400,9 +513,11 @@ procedure TTypeCodeGenerator.Execute(aData: TSchemaData);
 
 var
   I: integer;
+  False: Boolean;
 
 begin
   FData := aData;
+  FGenerated:=TFPObjectHashTable.Create(False);
   GenerateHeader;
   try
     Addln('unit %s;', [OutputUnitName]);
@@ -419,6 +534,9 @@ begin
     EnsureSection(csType);
     Addln('');
     indent;
+    if WriteClassType then
+      GenerateClassForwardTypes(aData);
+    GenerateIntegerTypes(aData);
     GenerateStringTypes(aData);
     GeneratePascalArrayTypes(aData);
     GenerateClassTypes(aData);
@@ -951,6 +1069,8 @@ begin
 end;
 
 procedure TSerializerCodeGenerator.WriteArrayHelperSerializeArray(aType: TPascalTypeData);
+var
+  lSerializeCall : String;
 begin
   Addln('');
   Addln('function %s.SerializeArray : TJSONArray;',[aType.SerializerName]);
@@ -965,7 +1085,15 @@ begin
   indent;
   Addln('For I:=0 to length(Self)-1 do');
   Indent;
-  Addln('Result.Add(self[i]);');
+  if aType.ElementTypeData.Pascaltype in [ptSchemaStruct,ptAnonStruct] then
+    lSerializeCall:='.SerializeObject'
+  else  if aType.ElementTypeData.Pascaltype=ptArray then
+    lSerializeCall:='.SerializeArray'
+  else if aType.ElementTypeData.schema=Nil then
+    lSerializeCall:=''
+  else
+    Raise EJSONSchema.CreateFmt('Cannot decide how to serialize %',[aType.ElementTypeData.PascalName]);
+  Addln('Result.Add(self[i]%s);',[lSerializeCall]);
   undent;
   undent;
   Addln('except');
@@ -1150,6 +1278,7 @@ begin
               begin
               WriteArrayHelper(ElementTypeData);
               end;
+            WriteArrayHelper(lType);
             end;
     end;
     undent;
@@ -1186,6 +1315,7 @@ begin
             begin
             WriteArrayHelperImpl(lType.ElementTypeData);
             end;
+          WriteArrayHelperImpl(lType);
           end;
       end;
     end;

packages/fcl-jsonschema/src/fpjson.schema.pascaltypes.pp

@@ -63,8 +63,6 @@ Type
   TPropertyType = TPascalType;
   TPropertyTypes = TPascalTypes;
 
-  { TPascalProperty }
-
   { TPascalPropertyData }
 
   TPascalPropertyData = class(TObject)
@@ -674,12 +672,27 @@ procedure TSchemaData.CheckDependencies;
 var
   I : Integer;
   lData : TPascalTypeData;
+  lName : string;
 
 begin
   For I:=0 to TypeCount-1 do
     begin
     lData:=Types[I];
-    CheckProps(lData,lData);
+    Case lData.Pascaltype of
+      ptAnonStruct,
+      ptSchemaStruct:
+        CheckProps(lData,lData) ;
+      ptArray:
+        begin
+        // Resolve element type ref
+        if (lData.Schema.Items.Count=1) then
+          begin
+          lName:=lData.Schema.Items[0].Ref;
+          if lName<>'' then
+            lData.ElementTypeData:=GetPascalTypeDataFromRef(lName);
+          end;
+        end;
+    end;
     end;
 end;
 

packages/fcl-openapi/src/fpopenapi.generators.pp

@@ -23,7 +23,7 @@ uses
   {$IFDEF FPC_DOTTEDUNITS}
   System.Classes, System.SysUtils, System.DateUtils, System.Contnrs, Pascal.CodeGenerator,
   {$ELSE}
-  Classes, SysUtils, strutils, dateutils,  pascodegen, inifiles,
+  Classes, SysUtils, strutils, dateutils,  pascodegen,
   {$ENDIF}
   fpjson.schema.types,
   fpjson.schema.Pascaltypes,
@@ -411,7 +411,7 @@ begin
     lBodyType:=aMethod.RequestBodyDataType.GetTypeName(ntPascal);
   if lBodyType<>'' then
     AddTo(lParams, 'aRequest : '+lBodyType);
-  if aMethod.ResultDataType.BinaryData then
+  if Assigned(aMethod.ResultDataType) and aMethod.ResultDataType.BinaryData then
     AddTo(lParams, 'aResponseStream : TStream');
   if AsyncService then
     AddTo(lParams, 'aCallback : '+MethodResultCallbackName(aMethod));
@@ -805,10 +805,10 @@ begin
     lBodyArg:='aRequest.Serialize'
   else
     lBodyArg:='aRequest';
-  if aMethod.ResultDataType.BinaryData then
-    Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s,aResponseStream);', [lHTTPMethod, lBodyArg])
-  else
-    Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s);', [lHTTPMethod, lBodyArg]);
+  if Assigned(aMethod.ResultDataType) and aMethod.ResultDataType.BinaryData then
+      Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s,aResponseStream);', [lHTTPMethod, lBodyArg])
+    else
+      Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s);', [lHTTPMethod, lBodyArg]);
   AddLn('Result:=%s.Create(lResponse);', [GetMethodResultType(aMethod)]);
   lResultType:=aMethod.ResultDataType;
   if (aMethod.ResultDataType=nil) then
@@ -909,9 +909,9 @@ begin
   Addln('uses');
   indent;
   if DelphiCode then
-    Addln('System.SysUtils')
+    Addln('System.SysUtils, System.DateUtils')
   else
-    Addln('SysUtils');
+    Addln('SysUtils, DateUtils');
   Addln(', %s;', [SerializerUnit]);
   undent;
   Addln('');

packages/fcl-openapi/src/fpopenapi.pascaltypes.pp

@@ -408,12 +408,14 @@ var
   lType : TSchemaSimpleType;
 
 begin
-  lType:=TAPITypeData.ExtractFirstType(FParameter.Schema);
-  case lType of
-    sstInteger : Result:=Format('IntToStr(%s)',[Name]); // Also handles int64
-    sstString :  Result:=Name;
-    sstNumber : Result:=Format('FloatToStr(%s,cRestFormatSettings)',[Name]);
-    sstBoolean : Result:=Format('cRESTBooleans[%s]',[Name]);
+  Case FArgType of
+    ptInteger,
+    ptInt64: Result:=Format('IntToStr(%s)',[Name]); // Also handles int64
+    ptString : Result:=Name;
+    ptDateTime : Result:=Format('DateToISO8601(%s)',[Name]);
+    ptFloat32,
+    ptFloat64 : Result:=Format('FloatToStr(%s,cRestFormatSettings)',[Name]);
+    ptBoolean : Result:=Format('cRESTBooleans[%s]',[Name]);
   else
     Result:=Name;
   end;
@@ -833,8 +835,10 @@ begin
       if NeedsDeserialize(lData) then
         Include(lSerTypes,stDeSerialize);
       end;
-    lData.SerializeTypes:=lSerTypes;
+    lData.SerializeTypes:=lData.SerializeTypes+lSerTypes;
     DoLog(etInfo,'%s needs serialize: %s, deserialize: %s',[lData.SchemaName,BoolToStr(stSerialize in lSerTypes,True),BoolToStr(stDeSerialize in lSerTypes,True)]);
+    if (lData.Pascaltype=ptArray) and Assigned(lData.ElementTypeData) then
+      lData.ElementTypeData.SerializeTypes:=lData.ElementTypeData.SerializeTypes+lSerTypes;
     end;
 end;
 
@@ -865,21 +869,55 @@ begin
     lName:=FAPI.Components.Schemas.Names[I];
     lSchema:=FAPI.Components.Schemas.Schemas[lName];
     lType:=lSchema.Validations.GetFirstType;
-    if (lType in [sstObject,sstString]) then
+    if (lType in [sstArray,sstObject,sstInteger,sstString]) then
       begin
       lTypeName:=EscapeKeyWord(ObjectTypePrefix+Sanitize(lName)+ObjectTypeSuffix);
       case lType of
-        sstObject : lData:=CreatePascalType(I,ptSchemaStruct,lName,lTypeName,lSchema);
+        sstObject :
+          lData:=CreatePascalType(I,ptSchemaStruct,lName,lTypeName,lSchema);
         sstString :
           begin
           lData:=CreatePascalType(I,ptString,lName,lTypeName,lSchema);
           end;
+        sstInteger:
+          lData:=CreatePascalType(I,ptInteger,lName,lTypeName,lSchema);
+        sstArray:
+          lData:=CreatePascalType(I,ptArray,lName,lTypeName,lSchema);
       end;
       ConfigType(lData);
       AddType(lName,lData);
       AddToTypeMap(lName,lData);
       end;
     end;
+  For I:=0 to FAPI.Components.Parameters.Count-1 Do
+    begin
+    lName:=FAPI.Components.Parameters.Names[I];
+    if FAPI.Components.Parameters.ParameterOrReferences[lName].HasReference then
+      Continue;
+    lSchema:=FAPI.Components.Parameters.ParameterOrReferences[lName].Schema;
+    if assigned(lSchema) then
+    lType:=lSchema.Validations.GetFirstType;
+    if (lType in [sstArray,sstObject,sstInteger,sstString]) then
+      begin
+      lTypeName:=EscapeKeyWord(ObjectTypePrefix+Sanitize(lName)+ObjectTypeSuffix);
+      case lType of
+        sstObject :
+          lData:=CreatePascalType(I,ptSchemaStruct,lName,lTypeName,lSchema);
+        sstString :
+          begin
+          lData:=CreatePascalType(I,ptString,lName,lTypeName,lSchema);
+          end;
+        sstInteger:
+          lData:=CreatePascalType(I,ptInteger,lName,lTypeName,lSchema);
+        sstArray:
+          lData:=CreatePascalType(I,ptArray,lName,lTypeName,lSchema);
+      end;
+      ConfigType(lData);
+      AddType(lName,lData);
+      AddToTypeMap(lName,lData);
+      end;
+    end;
+
   // We do this here, so all API type references can be resolved
   For I:=0 to APITypeCount-1 do
     AddProperties(APITypes[i]);
@@ -1070,28 +1108,29 @@ var
   S : String;
 
 begin
+  Result:=Nil;
   if AMethod.Operation.Responses.Count>0 then
     begin
     lResponse:=AMethod.Operation.Responses.ResponseByindex[0];
-    lMedia:=lResponse.Content.MediaTypes['application/json'];
-    if lMedia=Nil then
+    if lResponse.Content.Count<>0 then
       begin
-      // Check if we must stream
-      For S in StreamContentTypes do
+      lMedia:=lResponse.Content.MediaTypes['application/json'];
+      if lMedia=Nil then
         begin
-        lMedia:=lResponse.Content.MediaTypes[S];
-        if lMedia<>nil then
-          break;
+        // Check if we must stream
+        For S in StreamContentTypes do
+          begin
+          lMedia:=lResponse.Content.MediaTypes[S];
+          if lMedia<>nil then
+            break;
+          end;
+        if lMedia=nil then
+          Raise EGenAPI.CreateFmt('No application/json response media type for %s.%s',[aMethod.Service.ServiceName,aMethod.MethodName]);
+        Result:=GetStreamTypeData(S);
         end;
-      if lMedia=nil then
-        Raise EGenAPI.CreateFmt('No application/json response media type for %s.%s',[aMethod.Service.ServiceName,aMethod.MethodName]);
-      Result:=GetStreamTypeData(S);
-      end
-    else
       Result:=GetSchemaTypeData(Nil,lMedia.Schema,True) as TAPITypeData;
-    end
-  else
-    Result:=Nil; // FindApiType('boolean');
+      end;
+    end;
 end;
 
 function TAPIData.GetMethodResultType(aMethod : TAPIServiceMethod; aNameType : TNameType) : String;

packages/rtl-console/src/unix/keyboard.pp

@@ -2273,7 +2273,7 @@ var
 
     procedure DecodeAndPushWin32Key(const store: array of AnsiChar; arrayind: byte);
 
-      function VKToScanCode(vk: Word): Byte;
+      function VKToScanCode(vk: Word): Word;
       begin
         case vk of
           // Standard keys
@@ -2328,7 +2328,7 @@ var
       i, p_idx, code: Integer;
       st: string;
       ch: AnsiChar;
-      ScanCode: Byte;
+      ScanCode: Word;
       k: TEnhancedKeyEvent;
     begin
       // 1. Parse the parameters: Vk;Sc;Uc;Kd;Cs;Rc

rtl/inc/exeinfo.pp

@@ -1013,7 +1013,7 @@ begin
           end;
       end;
 
-    if ((found_addr=ptruint(-1)) or (found_addr < ptruint(phdr))) and (ptruint(phdr)<ptruint(addr)) then
+    if (found_addr=ptruint(-1)) or ((found_addr < ptruint(phdr)) and (ptruint(phdr)<ptruint(addr))) then
       found_addr:=ptruint(phdr);
     { Set pagesize to a default small value }
     if (pagesize=ptruint(-1)) then

rtl/morphos/si_prc.pp

@@ -41,7 +41,7 @@ procedure PascalMainEntry; cdecl; forward;
   all .text.* section, so if we link any object with an unnamed .text
   section, this won't be at the start of the executable, and we get
   crashes. (KB) }
-function _FPC_proc_start: longint; cdecl; public name '_start'; section '.text';
+function _FPC_proc_start: longint; cdecl; public name '_start'; {$IFNDEF VER3_2}section '.text';{$ENDIF}
 var
   sst: TStackSwapStruct;
   newStack: Pointer;

tests/tbs/tb0162.pp

@@ -79,6 +79,28 @@ begin
       doerror(8);
   end;
 
+  l := low(longint);
+  try
+    l := l div -1;
+    doerror(9);
+  except
+    on eintoverflow do
+      ;
+    else
+      doerror(10);
+  end;
+
+  l := low(longint);
+  try
+    l := -l;
+    doerror(109);
+  except
+    on eintoverflow do
+      ;
+    else
+      doerror(110);
+  end;
+
   c := high(cardinal);
   try
     c := c+1;

tests/tbs/tb0723.pp

@@ -0,0 +1,17 @@
+{ %NORUN }
+{ %OPT=-Sew }
+
+{$warn 2041 off}
+program tb0723;
+
+
+{$YD}
+{$Y-}
+{$Y+}
+{$REFERENCEINFO ON}
+{$REFERENCEINFO OFF}
+{$DEFINITIONINFO ON}
+{$DEFINITIONINFO OFF}
+
+begin
+end.

tests/tbs/tb0724.pp

@@ -0,0 +1,23 @@
+unit tb0724;
+
+{$mode delphi}{$H+}
+
+interface
+
+type
+  ITest<T> = interface
+  end;
+
+implementation
+
+uses
+  { when the compiler reaches ucycleb then depending on the order either ub0724b
+    or ub0724c will have neither its global- nor localsymtable set when the
+    compiler specializes ITest<>, because the compiler didn't yet reach the
+    point to compile either ucyclec or ucycled }
+  ub0724b,
+  ub0724a,
+  ub0724c;
+
+end.
+

tests/tbs/ub0724a.pp

@@ -0,0 +1,17 @@
+unit ub0724a;
+
+{$mode delphi}{$H+}
+
+interface
+
+uses
+  tb0724;
+
+type
+  TTest = class(TInterfacedObject, ITest<TObject>)
+  end;
+
+implementation
+
+end.
+

tests/tbs/ub0724b.pp

@@ -0,0 +1,10 @@
+unit ub0724b;
+
+{$mode objfpc}{$H+}
+
+interface
+
+implementation
+
+end.
+

tests/tbs/ub0724c.pp

@@ -0,0 +1,10 @@
+unit ub0724c;
+
+{$mode objfpc}{$H+}
+
+interface
+
+implementation
+
+end.
+

tests/test/tgeneric128.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+
+program tgeneric128;
+
+{$mode delphi}
+
+type
+  Foo<T> = record
+  public
+    class operator Equal(const left: Foo<T>; const right: T): Boolean;
+  end;
+
+  Bar<T> = record
+  public
+    class operator Implicit(const value: Bar<T>): Foo<T>;
+  end;
+
+class operator Foo<T>.Equal(const left: Foo<T>; const right: T): Boolean;
+begin
+end;
+
+class operator Bar<T>.Implicit(const value: Bar<T>): Foo<T>;
+begin
+end;
+
+begin
+
+end.

tests/test/tgeneric129.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+
+program tgeneric129;
+
+{$mode delphi}
+
+type
+  Vector<T> = record
+  public
+    class operator Add(const left: TArray<T>; const right: Vector<T>): Vector<T>; inline;
+  end;
+
+class operator Vector<T>.Add(const left: TArray<T>; const right: Vector<T>): Vector<T>;
+begin
+end;
+
+begin
+end.

tests/test/toperator97.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program toperator97;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+    class operator :=(aArg: TTest): Pointer;
+  end;
+
+class operator TTest.:=(aArg: TTest): Pointer;
+begin
+end;
+
+var
+  b: PByte;
+  t: TTest;
+begin
+  b := t;
+end.

tests/test/tpointermath4.pp

@@ -0,0 +1,57 @@
+{ %NORUN }
+
+program tpointermath4;
+
+{$mode delphi}
+
+type
+{$POINTERMATH ON}
+  PMyCardinal = ^Cardinal;
+  PMyByte = ^Byte;
+  PMyString = ^String;
+{$POINTERMATH OFF}
+
+procedure Test;
+var
+  pc: PMyCardinal;
+  pb: PMyByte;
+  ps: PMyString;
+  b: Boolean;
+begin
+  b := pc > pb;
+  b := pc < pb;
+  b := ps < pb;
+  b := ps > pb;
+  b := pc < ps;
+  b := pc > ps;
+
+  b := pc >= pb;
+  b := pc <= pb;
+  b := ps <= pb;
+  b := ps >= pb;
+  b := pc <= ps;
+  b := pc >= ps;
+end;
+
+{$pointermath on}
+
+var
+  pc: PCardinal = Nil;
+  pb: PByte = Nil;
+  ps: PString = Nil;
+  b: Boolean;
+begin
+  b := pc > pb;
+  b := pc < pb;
+  b := ps < pb;
+  b := ps > pb;
+  b := pc < ps;
+  b := pc > ps;
+
+  b := pc >= pb;
+  b := pc <= pb;
+  b := ps <= pb;
+  b := ps >= pb;
+  b := pc <= ps;
+  b := pc >= ps;
+end.

tests/test/tpointermath5.pp

@@ -0,0 +1,27 @@
+{ %FAIL }
+
+program tpointermath5;
+
+{$mode delphi}
+
+{ both pointer types need to have POINTERMATH enabled for comparisons to be
+  supported between them }
+
+type
+  PMyCardinal = ^Cardinal;
+{$POINTERMATH ON}
+  PMyByte = ^Byte;
+{$POINTERMATH OFF}
+
+procedure Test;
+var
+  pc: PMyCardinal;
+  pb: PMyByte;
+  b: Boolean;
+begin
+  b := pc > pb;
+  b := pc < pb;
+end;
+
+begin
+end.

tests/test/tpointermath6.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+
+program tpointermath6;
+
+{$mode objfpc}
+{$pointermath on}
+
+var
+  pc: PCardinal;
+  pb: PByte;
+  b: Boolean;
+begin
+  b := pc < pb;
+end.
+

tests/webtbs/tw39917.pp

@@ -0,0 +1,68 @@
+{ %NORUN }
+{ %OPT=-O3 }
+
+program tw39917;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+{$optimization on}
+
+{ Test optimization.  The self param passed to DlgAsync() and Checkout() several
+  anon functions deep in TView.CopyFile cause compiler fatal internal error
+  200409241.  
+
+  If optimization is off there is no error.  If CopyFile is not an object method
+  then there is no problem (though values passed to DlgASync) and CheckOut must
+  be changed.  If DlgASync() and CheckOut() receive a value other than self there
+  is no problem.
+}
+
+type
+  TProc = reference to procedure;
+  TModalDoneProc = reference to procedure(ASuccess: Boolean);
+  TView = class(TObject)
+    procedure CopyFile;
+  end;
+
+procedure DlgAsync(AOwner: TObject; const AOnModalDone: TModalDoneProc);
+begin
+end;
+
+function Checkout(AOwner: TObject): Boolean;
+begin
+Result := True;
+end;
+
+procedure TView.CopyFile;
+
+  procedure Prompt(const AOnModalDone: TProc);
+  begin
+  end;
+
+begin
+Prompt(
+  procedure
+
+    procedure Prompt(const AOnModalDone: TProc);
+    begin
+    if True then
+      DlgAsync(Self,
+        procedure(ASuccess: Boolean)
+        begin
+        if ASuccess and CheckOut(Self) then
+          AOnModalDone()
+        end)
+    end;
+
+  begin
+  Prompt(
+    procedure
+    begin
+    end)
+  end)
+end;
+
+begin
+end.
+

tests/webtbs/tw41458.pp

@@ -0,0 +1,9 @@
+{ %NORUN }
+
+program tw41458;
+
+uses uw41458;
+
+begin
+end.
+

tests/webtbs/uw41458.pp

@@ -0,0 +1,35 @@
+unit uw41458;
+{$ifdef FPC}{$mode delphi}{$endif}
+
+interface
+
+type
+  TUtils = record
+    class procedure GenericMethod<T>; static;
+  end;
+  TMyObj = record
+    FAnsiString: AnsiString;
+    procedure method;
+  end;
+
+var
+  GlobObj: TMyObj;
+
+implementation
+
+class procedure TUtils.GenericMethod<T>;
+begin
+end;
+
+procedure impl_proc(a: Double; b: String);
+begin
+  TUtils.GenericMethod<byte>;
+end;
+
+procedure TMyObj.method;
+begin
+  impl_proc(1.2, '-');
+end;
+
+end.
+