* synchronized with trunk

git-svn-id: branches/wasm@48906 -

.gitattributes

@@ -712,6 +712,7 @@ compiler/riscv/nrvcnv.pas svneol=native#text/plain
 compiler/riscv/nrvcon.pas svneol=native#text/plain
 compiler/riscv/nrvinl.pas svneol=native#text/plain
 compiler/riscv/nrvset.pas svneol=native#text/plain
+compiler/riscv/rarv.pas svneol=native#text/pascal
 compiler/riscv/rarvgas.pas svneol=native#text/plain
 compiler/riscv/rgcpu.pas svneol=native#text/plain
 compiler/riscv32/aoptcpu.pas svneol=native#text/plain
@@ -731,8 +732,6 @@ compiler/riscv32/nrv32add.pas svneol=native#text/plain
 compiler/riscv32/nrv32cal.pas svneol=native#text/plain
 compiler/riscv32/nrv32cnv.pas svneol=native#text/plain
 compiler/riscv32/nrv32mat.pas svneol=native#text/plain
-compiler/riscv32/rarv32.pas svneol=native#text/plain
-compiler/riscv32/rarv32gas.pas svneol=native#text/plain
 compiler/riscv32/rrv32con.inc svneol=native#text/plain
 compiler/riscv32/rrv32dwa.inc svneol=native#text/plain
 compiler/riscv32/rrv32nor.inc svneol=native#text/plain
@@ -763,8 +762,6 @@ compiler/riscv64/nrv64cal.pas svneol=native#text/plain
 compiler/riscv64/nrv64cnv.pas svneol=native#text/plain
 compiler/riscv64/nrv64ld.pas svneol=native#text/plain
 compiler/riscv64/nrv64mat.pas svneol=native#text/plain
-compiler/riscv64/rarv.pas svneol=native#text/plain
-compiler/riscv64/rarv64gas.pas svneol=native#text/plain
 compiler/riscv64/rrv32con.inc svneol=native#text/plain
 compiler/riscv64/rrv32dwa.inc svneol=native#text/plain
 compiler/riscv64/rrv32nor.inc svneol=native#text/plain
@@ -13923,6 +13920,7 @@ tests/test/cg/obj/wince/arm/tcext4.o -text
 tests/test/cg/obj/wince/arm/tcext5.o -text
 tests/test/cg/ptest.pp svneol=native#text/plain
 tests/test/cg/taddbool.pp svneol=native#text/plain
+tests/test/cg/taddbyte.pp svneol=native#text/pascal
 tests/test/cg/taddcard.pp svneol=native#text/plain
 tests/test/cg/taddcurr.pp svneol=native#text/plain
 tests/test/cg/taddint.pp svneol=native#text/plain
@@ -18742,6 +18740,11 @@ tests/webtbs/tw38413.pp svneol=native#text/pascal
 tests/webtbs/tw38429.pp svneol=native#text/pascal
 tests/webtbs/tw38497.pp svneol=native#text/pascal
 tests/webtbs/tw38527.pp svneol=native#text/plain
+tests/webtbs/tw38549.pp svneol=native#text/plain
+tests/webtbs/tw38549a.pp svneol=native#text/plain
+tests/webtbs/tw38549b.pp svneol=native#text/plain
+tests/webtbs/tw38549c.pp svneol=native#text/plain
+tests/webtbs/tw38549d.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain

compiler/Makefile

@@ -4946,7 +4946,7 @@ endif
 	$(COMPILER) pp.pas
 	$(EXECPPAS)
 	$(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME)
-.PHONY: cycle fullcycle wpocycle
+.PHONY: cycle full full_targets fullcycle wpocycle
 ifeq ($(CPU_SOURCE),$(PPC_TARGET))
 ifeq ($(OS_SOURCE),$(OS_TARGET))
 ifndef NOWPOCYCLE
@@ -5113,6 +5113,8 @@ ifdef DOWPOCYCLE
 	$(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 endif
 	$(MAKE) $(FULL_TARGETS) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
+full_targets:
+	$(MAKE) $(FULL_TARGETS)
 htmldocs:
 	$(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas
 .PHONY: quickinstall exeinstall install installsymlink fullinstall fullinstallsymlink

compiler/Makefile.fpc

@@ -851,7 +851,7 @@ endif
 #
 #####################################################################
 
-.PHONY: cycle fullcycle wpocycle
+.PHONY: cycle full full_targets fullcycle wpocycle
 
 ifeq ($(CPU_SOURCE),$(PPC_TARGET))
 
@@ -1056,7 +1056,8 @@ cvstest:
 # unless FPC_SUPPORT_X87_TYPES_ON_WIN64 is set,
 # win64 cannot compile i386 or i8086 compiler
 # This is also the case for other CPUs that don't support
-# 80bit real type.
+# 80bit real type, unless -dFPC_SOFT_FPUX80
+# option is used.
 
 ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)
 ifeq ($(OS_SOURCE),win64)
@@ -1086,6 +1087,9 @@ ifdef DOWPOCYCLE
 endif
         $(MAKE) $(FULL_TARGETS) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 
+full_targets:
+	$(MAKE) $(FULL_TARGETS)
+
 #####################################################################
 # Docs
 #####################################################################

compiler/entfile.pas

@@ -380,6 +380,11 @@ end;
 destructor tentryfile.destroy;
 begin
   closefile;
+{$ifdef DEBUG_PPU}
+  if flog_open then
+    close(flog);
+  flog_open:=false;
+{$endif DEBUG_PPU}
   if assigned(buf) then
     freemem(buf,entryfilebufsize);
 end;
@@ -573,11 +578,6 @@ begin
        f.Free;
      mode:=0;
      closed:=true;
-{$ifdef DEBUG_PPU}
-     if flog_open then
-       close(flog);
-     flog_open:=false;
-{$endif DEBUG_PPU}
    end;
 end;
 
@@ -683,14 +683,6 @@ var
 begin
   p:=pchar(@b);
   pbuf:=@buf[bufidx];
-{$ifdef DEBUG_PPU}
-  if ppu_log_level <= 0 then
-    begin
-      ppu_log('writedata, length='+tostr(len)+' level='+tostr(ppu_log_level));
-      for i:=0 to len-1 do
-        ppu_log_val('p['+tostr(i)+']=$'+hexstr(byte(p[i]),2));
-    end;
-{$endif DEBUG_PPU}
   repeat
     left:=bufsize-bufidx;
     if len<left then
@@ -704,6 +696,14 @@ begin
       exit;
   until false;
   move(pbuf^,p^,len);
+{$ifdef DEBUG_PPU}
+  if ppu_log_level <= 0 then
+    begin
+      ppu_log('writedata, length='+tostr(len)+' level='+tostr(ppu_log_level));
+      for i:=0 to len-1 do
+        ppu_log_val('p['+tostr(i)+']=$'+hexstr(byte(p[i]),2));
+    end;
+{$endif DEBUG_PPU}
   inc(bufidx,len);
 end;
 

compiler/mips/ncpuadd.pas

@@ -36,7 +36,7 @@ type
   private
     procedure cmp64_lt(left_reg, right_reg: TRegister64;unsigned:boolean);
     procedure cmp64_le(left_reg, right_reg: TRegister64;unsigned:boolean);
-    procedure second_generic_cmp32(unsigned: boolean);
+    procedure second_generic_cmp32(unsigned,is_smallset: boolean);
     procedure second_mul64bit;
   protected
     procedure second_addfloat; override;
@@ -72,18 +72,31 @@ uses
                                tmipsaddnode
 *****************************************************************************}
 
-procedure tmipsaddnode.second_generic_cmp32(unsigned: boolean);
+procedure tmipsaddnode.second_generic_cmp32(unsigned,is_smallset: boolean);
 var
   cond: TOpCmp;
+  allow_constant : boolean;
+  dreg : tregister;
 begin
   pass_left_right;
-  force_reg_left_right(True, True);
+  allow_constant:=(not is_smallset) or not (nodetype in [lten,gten]);
+  force_reg_left_right(True, allow_constant);
   location_reset(location,LOC_FLAGS,OS_NO);
 
   cond:=cmpnode2topcmp(unsigned);
   if nf_swapped in flags then
     cond:=swap_opcmp(cond);
 
+  if is_smallset and (nodetype in [lten,gten]) then
+    begin
+      if ((nodetype=lten) and not (nf_swapped in flags)) or
+         ((nodetype=gten) and (nf_swapped in flags)) then
+        dreg:=right.location.register
+      else
+        dreg:=left.location.register;
+      current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,dreg,right.location.register,left.location.register));
+      cond:=OC_EQ;
+    end;
   location.resflags.cond:=cond;
   location.resflags.reg1:=left.location.register;
   location.resflags.use_const:=(right.location.loc=LOC_CONSTANT);
@@ -304,13 +317,13 @@ end;
 
 procedure tmipsaddnode.second_cmpboolean;
 begin
-  second_generic_cmp32(true);
+  second_generic_cmp32(true,false);
 end;
 
 
 procedure tmipsaddnode.second_cmpsmallset;
 begin
-  second_generic_cmp32(true);
+  second_generic_cmp32(true,true);
 end;
 
 
@@ -319,7 +332,7 @@ var
   unsigned: boolean;
 begin
   unsigned := not (is_signed(left.resultdef)) or not (is_signed(right.resultdef));
-  second_generic_cmp32(unsigned);
+  second_generic_cmp32(unsigned,false);
 end;
 
 

compiler/nadd.pas

@@ -1715,6 +1715,7 @@ implementation
              (left.resultdef.typ=orddef) and
              (left.nodetype=andn) and
              (right.nodetype=andn) and
+             (not(is_boolean(resultdef)) or not(might_have_sideeffects(self,[mhs_exceptions])) or not(doshortbooleval(self))) and
              { this test is not needed but it speeds up the test and allows to bail out early }
              ((taddnode(left).left.nodetype=notn) or (taddnode(left).right.nodetype=notn) or
               (taddnode(right).left.nodetype=notn) or (taddnode(right).right.nodetype=notn)

compiler/ncginl.pas

@@ -932,7 +932,8 @@ implementation
                  else
 {$endif not cpu64bitalu and not cpuhighleveltarget}
                    begin
-                     if not(op2.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                     if not(op2.location.loc in [LOC_REGISTER,LOC_CREGISTER]) or
+                       not(equal_defs(op2.resultdef,resultdef)) then
                        hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
                                                op2.resultdef,resultdef,true);
                      hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,resultdef,

compiler/options.pas

@@ -212,6 +212,7 @@ var
   p : pchar;
   hs,hs1,hs3,s : TCmdStr;
   J: longint;
+  xmloutput: Text;
 const
   NewLineStr = '$\n';
   OSTargetsPlaceholder = '$OSTARGETS';
@@ -407,6 +408,17 @@ const
      end;
   end;
 
+  procedure ListOptimizationsXML;
+  var
+    opt: toptimizerswitch;
+  begin
+    WriteLn(xmloutput,'<optimizations>');
+    for opt:=low(toptimizerswitch) to high(toptimizerswitch) do
+      if OptimizerSwitchStr[opt]<>'' then
+        WriteLn(xmloutput,'<optimization name="',OptimizerSwitchStr[opt],'"/>');
+    WriteLn(xmloutput,'</optimizations>');
+  end;
+
   procedure ListWPOptimizations (OrigString: TCmdStr);
   var
     wpopt: twpoptimizerswitch;
@@ -502,6 +514,23 @@ const
 {$POP}
   end;
 
+  procedure ListControllerTypesXML;
+  var
+    controllertype : tcontrollertype;
+  begin
+{$PUSH}
+ {$WARN 6018 OFF} (* Unreachable code due to compile time evaluation *)
+    if (ControllerSupport) then
+     begin
+      WriteLn(xmloutput,'<controllertypes>');
+      for controllertype:=low(tcontrollertype) to high(tcontrollertype) do
+        if embedded_controllers[controllertype].ControllerTypeStr<>'' then
+          WriteLn(xmloutput,'<controllertype name="',embedded_controllers[controllertype].ControllerTypeStr,'"/>');
+      WriteLn(xmloutput,'</controllertypes>');
+     end;
+{$POP}
+  end;
+
   procedure ListFeatures (OrigString: TCmdStr);
   var
     Feature: TFeature;
@@ -627,31 +656,44 @@ begin
        Comment(V_Normal,s);
      end;
    end
+  else if Copy(More,1,1) = 'x' then
+    begin
+      Assign(xmloutput,Copy(More,2,length(More)-1));
+      Rewrite(xmloutput);
+      WriteLn(xmloutput,'<?xml version="1.0" encoding="utf-8"?>');
+      WriteLn(xmloutput,'<fpcoutput>');
+      WriteLn(xmloutput,'<info>');
+      ListOptimizationsXML;
+      ListControllerTypesXML;
+      WriteLn(xmloutput,'</info>');
+      WriteLn(xmloutput,'</fpcoutput>');
+      Close(xmloutput);
+   end
   else
    begin
-    J := 1;
-    while J <= Length (More) do
-     begin
-      if J > 1 then
-       Comment(V_Normal,'');  (* Put empty line between multiple sections *)
-      case More [J] of
-       'a': ListABITargets ('');
-       'b': Comment(V_Normal, cgbackend2str[cgbackend]);
-       'c': ListCPUInstructionSets ('');
-       'f': ListFPUInstructionSets ('');
-       'i': ListAsmModes ('');
-       'm': ListModeswitches ('');
-       'o': ListOptimizations ('');
-       'r': ListFeatures ('');
-       't': ListOSTargets ('');
-       'u': ListControllerTypes ('');
-       'w': ListWPOptimizations ('');
-      else
-       IllegalPara ('-i' + More);
+     J := 1;
+     while J <= Length (More) do
+      begin
+       if J > 1 then
+        Comment(V_Normal,'');  (* Put empty line between multiple sections *)
+       case More [J] of
+        'a': ListABITargets ('');
+        'b': Comment(V_Normal, cgbackend2str[cgbackend]);
+        'c': ListCPUInstructionSets ('');
+        'f': ListFPUInstructionSets ('');
+        'i': ListAsmModes ('');
+        'm': ListModeswitches ('');
+        'o': ListOptimizations ('');
+        'r': ListFeatures ('');
+        't': ListOSTargets ('');
+        'u': ListControllerTypes ('');
+        'w': ListWPOptimizations ('');
+       else
+        IllegalPara ('-i' + More);
+       end;
+       Inc (J);
       end;
-      Inc (J);
-     end;
-   end;
+    end;
   StopOptions(0);
 end;
 
@@ -1955,7 +1997,7 @@ begin
            'i' :
              begin
                if (More='') or
-                    (More [1] in ['a', 'b', 'c', 'f', 'i', 'm', 'o', 'r', 't', 'u', 'w']) then
+                    (More [1] in ['a', 'b', 'c', 'f', 'i', 'm', 'o', 'r', 't', 'u', 'w', 'x']) then
                  WriteInfo (More)
                else
                  QuickInfo:=QuickInfo+More;

compiler/raatt.pas

@@ -53,7 +53,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_RVA,
+        AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_RVA,AS_DC_A,
         AS_SET,AS_WEAK,AS_SECTION,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,
@@ -80,7 +80,7 @@ unit raatt;
         '.byte','.word','.long','.quad','.globl',
         '.align','.balign','.p2align','.ascii',
         '.asciz','.lcomm','.comm','.single','.double','.tfloat','.tcfloat',
-        '.data','.text','.init','.fini','.rva',
+        '.data','.text','.init','.fini','.rva','.dc.a',
         '.set','.weak','.section','END',
         'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','reltype',
         'directive');
@@ -227,7 +227,7 @@ unit raatt;
               actasmpattern[len]:=c;
               { Let us point to the next character }
               c:=current_scanner.asmgetchar;
-              while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
+              while c in ['A'..'Z','a'..'z','0'..'9','_','$','.'] do
                begin
                  inc(len);
                  actasmpattern[len]:=c;
@@ -1076,6 +1076,7 @@ unit raatt;
        section    : tai_section;
        secflags   : TSectionFlags;
        secprogbits : TSectionProgbits;
+       i: Integer;
      Begin
        Message1(asmr_d_start_reading,'GNU AS');
        firsttoken:=TRUE;
@@ -1163,6 +1164,12 @@ unit raatt;
                BuildConstant(4);
              end;
 
+           AS_DC_A:
+             Begin
+               Consume(AS_DC_A);
+               BuildConstant(sizeof(aint));
+             end;
+
            AS_DQ:
              Begin
                Consume(AS_DQ);
@@ -1342,18 +1349,17 @@ unit raatt;
                    Consume(AS_COMMA);
                    if actasmtoken=AS_STRING then
                      begin
-                       case actasmpattern of
-                         'a':
-                           Include(secflags,SF_A);
-                         'w':
-                           Include(secflags,SF_W);
-                         'x':
-                           Include(secflags,SF_X);
-                         '':
-                           ;
-                         else
-                           Message(asmr_e_syntax_error);
-                       end;
+                       for i:=1 to length(actasmpattern) do
+                         case actasmpattern[i] of
+                           'a':
+                             Include(secflags,SF_A);
+                           'w':
+                             Include(secflags,SF_W);
+                           'x':
+                             Include(secflags,SF_X);
+                           else
+                             Message(asmr_e_syntax_error);
+                         end;
                        Consume(AS_STRING);
                        if actasmtoken=AS_COMMA then
                          begin

compiler/riscv/agrvgas.pas

@@ -130,7 +130,9 @@ unit agrvgas;
                  s:=s+gas_regname(base)+','+gas_regname(index)
                else
                  internalerror(2006052502);
-             end;
+             end
+           else
+             Internalerror(2021030602);
 
            case refaddr of
              addr_lo12: s:='%lo'+s;

compiler/riscv/cgrv.pas

@@ -258,6 +258,10 @@ unit cgrv;
 
 
     procedure tcgrv.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
+      var
+        name: String;
+        pd: tprocdef;
+        paraloc1, paraloc2: tcgpara;
       begin
         if op=OP_NOT then
           begin
@@ -295,6 +299,47 @@ unit cgrv;
               end
             else
 {$endif RISCV64}
+            if (op in [OP_IMUL,OP_MUL]) and not(CPURV_HAS_MUL in cpu_capabilities[current_settings.cputype]) then
+              begin
+                case size of
+                  OS_8:
+                    name:='fpc_mul_byte';
+                  OS_S8:
+                    name:='fpc_mul_shortint';
+                  OS_16:
+                    name:='fpc_mul_word';
+                  OS_S16:
+                    name:='fpc_mul_integer';
+                  OS_32:
+                    name:='fpc_mul_dword';
+                  OS_S32:
+                    name:='fpc_mul_longint';
+                  else
+                    Internalerror(2021030601);
+                end;
+
+//                if check_overflow then
+//                  name:=name+'_checkoverflow';
+
+                pd:=search_system_proc(name);
+                paraloc1.init;
+                paraloc2.init;
+                paramanager.getcgtempparaloc(list,pd,1,paraloc1);
+                paramanager.getcgtempparaloc(list,pd,2,paraloc2);
+                a_load_reg_cgpara(list,OS_8,src1,paraloc2);
+                a_load_reg_cgpara(list,OS_8,src2,paraloc1);
+                paramanager.freecgpara(list,paraloc2);
+                paramanager.freecgpara(list,paraloc1);
+                alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                a_call_name(list,upper(name),false);
+                dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+                cg.a_load_reg_reg(list,size,size,NR_FUNCTION_RESULT_REG,dst);
+                cg.a_reg_dealloc(list,NR_FUNCTION_RESULT_REG);
+                paraloc2.done;
+                paraloc1.done;
+              end
+            else
               begin
                 list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src2,src1));
                 maybeadjustresult(list,op,size,dst);

compiler/riscv/nrvadd.pas

@@ -34,7 +34,7 @@ unit nrvadd;
       trvaddnode = class(tcgaddnode)
         function pass_1: tnode; override;
       protected                            
-        procedure Cmp(signed: boolean);
+        procedure Cmp(signed,is_smallset: boolean);
 
         function use_mul_helper: boolean; override;
 
@@ -72,14 +72,17 @@ implementation
      low_value = {$ifdef CPU64BITALU} low(int64) {$else} low(longint) {$endif};
 {$endif}
 
-    procedure trvaddnode.Cmp(signed: boolean);
+    procedure trvaddnode.Cmp(signed,is_smallset: boolean);
       var
         flabel,tlabel: tasmlabel;
         op, opi: TAsmOp;
+        allow_constant : boolean;
       begin
         pass_left_right;
 
-        force_reg_left_right(true,true);
+        allow_constant:=(not is_smallset) or not (nodetype in [lten,gten]);
+
+        force_reg_left_right(true,allow_constant);
 
         if nf_swapped in flags then
           swapleftright;
@@ -164,12 +167,20 @@ implementation
               if (left.location.loc=LOC_CONSTANT) and
                  (not is_imm12(left.location.value)) then
                 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
-
-              if left.location.loc=LOC_CONSTANT then
-                current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,right.location.register,left.location.value))
+              if is_smallset then
+                begin
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,right.location.register,right.location.register,left.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_SUB,location.register,left.location.register,right.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                end
               else
-                current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,location.register,right.location.register,left.location.register));
-              current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                begin
+                  if left.location.loc=LOC_CONSTANT then
+                    current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,right.location.register,left.location.value))
+                  else
+                    current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,location.register,right.location.register,left.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                end;
             end;
           gten:
             begin
@@ -179,12 +190,20 @@ implementation
               if (right.location.loc=LOC_CONSTANT) and
                  (not is_imm12(right.location.value)) then
                 hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,false);
-
-              if right.location.loc=LOC_CONSTANT then
-                current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,left.location.register,right.location.value))
+              if is_smallset then
+                begin
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,left.location.register,right.location.register,left.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_SUB,location.register,left.location.register,right.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                end
               else
-                current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,right.location.register));
-              current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                begin
+                   if right.location.loc=LOC_CONSTANT then
+                    current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,left.location.register,right.location.value))
+                  else
+                    current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,right.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                end;
             end;
         else
           Internalerror(2016061101);
@@ -194,9 +213,7 @@ implementation
 
     function trvaddnode.use_mul_helper: boolean;
       begin
-        if not (CPURV_HAS_MUL in cpu_capabilities[current_settings.cputype]) and
-           (nodetype=muln) and
-           not(torddef(resultdef).ordtype in [u8bit,s8bit]) then
+        if (nodetype=muln) and not(CPURV_HAS_MUL in cpu_capabilities[current_settings.cputype]) then
           result:=true
         else
           Result:=inherited use_mul_helper;
@@ -205,7 +222,7 @@ implementation
 
     procedure trvaddnode.second_cmpsmallset;
       begin
-        Cmp(true);
+        Cmp(false,true);
       end;
 
 
@@ -216,7 +233,7 @@ implementation
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
-        Cmp(not unsigned);
+        Cmp(not unsigned,false);
       end;
 
 
@@ -227,7 +244,7 @@ implementation
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
-        Cmp(not unsigned);
+        Cmp(not unsigned,false);
       end;                  
 
 

compiler/riscv/rarvgas.pas

@@ -26,12 +26,21 @@ unit rarvgas;
   interface
 
     uses
-      raatt,
+      raatt,rarv,
       cpubase;
 
     type
 
-      trvattreader = class(tattreader)
+      trvgasreader = class(tattreader)
+        actmemoryordering: TMemoryOrdering;
+        function is_register(const s: string): boolean; override;
+        function is_asmopcode(const s: string):boolean;override;
+        procedure handleopcode;override;
+        procedure BuildReference(oper : trvoperand);
+        procedure BuildOperand(oper : trvoperand);
+        procedure BuildOpCode(instr : trvinstruction);
+        procedure ReadAt(oper : trvoperand);
+        procedure ReadSym(oper : trvoperand);
         function is_targetdirective(const s: string): boolean; override;
         procedure HandleTargetDirective; override;
       end;
@@ -54,7 +63,7 @@ unit rarvgas;
       cgbase,cgobj,cgrv
       ;
 
-    function trvattreader.is_targetdirective(const s: string): boolean;
+    function trvgasreader.is_targetdirective(const s: string): boolean;
       begin
         case s of
           '.option':
@@ -64,7 +73,8 @@ unit rarvgas;
         end;
       end;
 
-    procedure trvattreader.HandleTargetDirective;
+
+    procedure trvgasreader.HandleTargetDirective;
       var
         id: string;
       begin
@@ -81,5 +91,806 @@ unit rarvgas;
         end;
       end;
 
+
+    procedure trvgasreader.ReadSym(oper : trvoperand);
+      var
+         tempstr, mangledname : string;
+         typesize,l,k : TCGInt;
+      begin
+        tempstr:=actasmpattern;
+        Consume(AS_ID);
+        { typecasting? }
+        if (actasmtoken=AS_LPAREN) and
+           SearchType(tempstr,typesize) then
+         begin
+           oper.hastype:=true;
+           Consume(AS_LPAREN);
+           BuildOperand(oper);
+           Consume(AS_RPAREN);
+           if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+             oper.SetSize(typesize,true);
+         end
+        else
+         if not oper.SetupVar(tempstr,false) then
+          Message1(sym_e_unknown_id,tempstr);
+        { record.field ? }
+        if actasmtoken=AS_DOT then
+         begin
+           BuildRecordOffsetSize(tempstr,l,k,mangledname,false);
+           if (mangledname<>'') then
+             Message(asmr_e_invalid_reference_syntax);
+           inc(oper.opr.ref.offset,l);
+         end;
+      end;
+
+
+    procedure trvgasreader.ReadAt(oper : trvoperand);
+      begin
+        { check for ...@ }
+        if actasmtoken=AS_AT then
+          begin
+            if (oper.opr.ref.symbol=nil) and
+               (oper.opr.ref.offset = 0) then
+              Message(asmr_e_invalid_reference_syntax);
+            Consume(AS_AT);
+            if actasmtoken=AS_ID then
+              begin
+                {if upper(actasmpattern)='L' then
+                  oper.opr.ref.refaddr:=addr_low
+                else if upper(actasmpattern)='HI' then
+                  oper.opr.ref.refaddr:=addr_high
+                else if upper(actasmpattern)='HA' then
+                  oper.opr.ref.refaddr:=addr_higha
+                else}
+                  Message(asmr_e_invalid_reference_syntax);
+                Consume(AS_ID);
+              end
+            else
+              Message(asmr_e_invalid_reference_syntax);
+          end;
+      end;
+
+
+    procedure trvgasreader.BuildReference(oper: trvoperand);
+
+      procedure Consume_RParen;
+        begin
+          if actasmtoken <> AS_RPAREN then
+           Begin
+             Message(asmr_e_invalid_reference_syntax);
+             RecoverConsume(true);
+           end
+          else
+           begin
+             Consume(AS_RPAREN);
+             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
+              Begin
+                Message(asmr_e_invalid_reference_syntax);
+                RecoverConsume(true);
+              end;
+           end;
+        end;
+
+      var
+        l : TCGInt;
+        relsym: string;
+        asmsymtyp: tasmsymtype;
+        isflags: tindsymflags;
+
+      begin
+        Consume(AS_LPAREN);
+        Case actasmtoken of
+          AS_INTNUM,
+          AS_MINUS,
+          AS_PLUS:
+            Begin
+              { offset(offset) is invalid }
+              If oper.opr.Ref.Offset <> 0 Then
+               Begin
+                 Message(asmr_e_invalid_reference_syntax);
+                 RecoverConsume(true);
+               End
+              Else
+               Begin
+                 oper.opr.Ref.Offset:=BuildConstExpression(false,true);
+                 Consume(AS_RPAREN);
+                 if actasmtoken=AS_AT then
+                   ReadAt(oper);
+               end;
+              exit;
+            End;
+          AS_REGISTER: { (reg ...  }
+            Begin
+              if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or
+                 ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then
+                message(asmr_e_cannot_index_relative_var);
+              oper.opr.ref.base:=actasmregister;
+              Consume(AS_REGISTER);
+              Consume_RParen;
+            end; {end case }
+          AS_ID:
+            Begin
+              ReadSym(oper);
+              case actasmtoken of
+                AS_PLUS:
+                  begin
+                    { add a constant expression? }
+                    l:=BuildConstExpression(true,true);
+                    case oper.opr.typ of
+                      OPR_CONSTANT :
+                        inc(oper.opr.val,l);
+                      OPR_LOCAL :
+                        inc(oper.opr.localsymofs,l);
+                      OPR_REFERENCE :
+                        inc(oper.opr.ref.offset,l);
+                      else
+                        internalerror(2003092016);
+                    end;
+                  end;
+                AS_MINUS:
+                  begin
+                    Consume(AS_MINUS);
+                    BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp);
+                    if (relsym<>'') then
+                      begin
+                        if (oper.opr.typ = OPR_REFERENCE) then
+                          oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym,AT_DATA)
+                        else
+                          begin
+                            Message(asmr_e_invalid_reference_syntax);
+                            RecoverConsume(false);
+                          end
+                      end
+                    else
+                      begin
+                        case oper.opr.typ of
+                          OPR_CONSTANT :
+                            dec(oper.opr.val,l);
+                          OPR_LOCAL :
+                            dec(oper.opr.localsymofs,l);
+                          OPR_REFERENCE :
+                            dec(oper.opr.ref.offset,l);
+                          else
+                            internalerror(2007092601);
+                        end;
+                      end;
+                  end;
+                else
+                  ;
+              end;
+              Consume(AS_RPAREN);
+              if actasmtoken=AS_AT then
+                ReadAt(oper);
+            End;
+          AS_COMMA: { (, ...  can either be scaling, or index }
+            Begin
+              Consume(AS_COMMA);
+              { Index }
+              if (actasmtoken=AS_REGISTER) then
+                Begin
+                  oper.opr.ref.index:=actasmregister;
+                  Consume(AS_REGISTER);
+                  { check for scaling ... }
+                  Consume_RParen;
+                end
+              else
+                begin
+                  Message(asmr_e_invalid_reference_syntax);
+                  RecoverConsume(false);
+                end;
+            end;
+        else
+          Begin
+            Message(asmr_e_invalid_reference_syntax);
+            RecoverConsume(false);
+          end;
+        end;
+      end;
+
+
+    procedure trvgasreader.BuildOperand(oper: trvoperand);
+      var
+        expr : string;
+        typesize,l : TCGInt;
+
+
+        procedure AddLabelOperand(hl:tasmlabel);
+          begin
+            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
+               is_calljmp(actopcode) then
+             begin
+               oper.opr.typ:=OPR_SYMBOL;
+               oper.opr.symbol:=hl;
+             end
+            else
+             begin
+               oper.InitRef;
+               oper.opr.ref.symbol:=hl;
+             end;
+          end;
+
+
+        procedure MaybeRecordOffset;
+          var
+            mangledname: string;
+            hasdot  : boolean;
+            l,
+            toffset,
+            tsize   : TCGInt;
+          begin
+            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
+             exit;
+            l:=0;
+            hasdot:=(actasmtoken=AS_DOT);
+            if hasdot then
+              begin
+                if expr<>'' then
+                  begin
+                    BuildRecordOffsetSize(expr,toffset,tsize,mangledname,false);
+                    if (oper.opr.typ<>OPR_CONSTANT) and
+                       (mangledname<>'') then
+                      Message(asmr_e_wrong_sym_type);
+                    inc(l,toffset);
+                    oper.SetSize(tsize,true);
+                  end;
+              end;
+            if actasmtoken in [AS_PLUS,AS_MINUS] then
+              inc(l,BuildConstExpression(true,false));
+            case oper.opr.typ of
+              OPR_LOCAL :
+                begin
+                  { don't allow direct access to fields of parameters, because that
+                    will generate buggy code. Allow it only for explicit typecasting }
+                  if hasdot and
+                     (not oper.hastype) and
+                     (tabstractvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
+                     (current_procinfo.procdef.proccalloption<>pocall_register) then
+                    Message(asmr_e_cannot_access_field_directly_for_parameters);
+                  inc(oper.opr.localsymofs,l)
+                end;
+              OPR_CONSTANT :
+                if (mangledname<>'') then
+                  begin
+                    if (oper.opr.val<>0) then
+                      Message(asmr_e_wrong_sym_type);
+                    oper.opr.typ:=OPR_SYMBOL;
+                    oper.opr.symbol:=current_asmdata.DefineAsmSymbol(mangledname,AB_EXTERNAL,AT_FUNCTION,voidcodepointertype);
+                  end
+                else
+                  inc(oper.opr.val,l);
+              OPR_REFERENCE :
+                inc(oper.opr.ref.offset,l);
+              OPR_SYMBOL:
+                Message(asmr_e_invalid_symbol_ref);
+              else
+                internalerror(200309221);
+            end;
+          end;
+
+
+        function MaybeBuildReference:boolean;
+          { Try to create a reference, if not a reference is found then false
+            is returned }
+          begin
+            MaybeBuildReference:=true;
+            case actasmtoken of
+              AS_INTNUM,
+              AS_MINUS,
+              AS_PLUS:
+                Begin
+                  oper.opr.ref.offset:=BuildConstExpression(True,False);
+                  if actasmtoken<>AS_LPAREN then
+                    Message(asmr_e_invalid_reference_syntax)
+                  else
+                    BuildReference(oper);
+                end;
+              AS_LPAREN:
+                BuildReference(oper);
+              AS_ID: { only a variable is allowed ... }
+                Begin
+                  ReadSym(oper);
+                  case actasmtoken of
+                    AS_END,
+                    AS_SEPARATOR,
+                    AS_COMMA: ;
+                    AS_LPAREN:
+                      BuildReference(oper);
+                  else
+                    Begin
+                      Message(asmr_e_invalid_reference_syntax);
+                      Consume(actasmtoken);
+                    end;
+                  end; {end case }
+                end;
+              else
+               MaybeBuildReference:=false;
+            end; { end case }
+          end;
+
+
+        function is_fenceflag(hs : string): boolean;
+          var
+            i: longint;
+            flags: TFenceFlags;
+          begin
+            is_fenceflag := false;
+
+            flags:=[];
+            hs:=lower(hs);
+
+            if (actopcode in [A_FENCE]) and (length(hs) >= 1) then
+              begin
+                for i:=1 to length(hs) do
+                  begin
+                    case hs[i] of
+                      'i':
+                        Include(flags,ffi);
+                      'o':
+                        Include(flags,ffo);
+                      'r':
+                        Include(flags,ffr);
+                      'w':
+                        Include(flags,ffw);
+                    else
+                      exit;
+                    end;
+                  end;
+                oper.opr.typ := OPR_FENCEFLAGS;
+                oper.opr.fenceflags := flags;
+                exit(true);
+              end;
+          end;
+
+
+      var
+        tempreg : tregister;
+        hl : tasmlabel;
+        ofs : aint;
+        refaddr: trefaddr;
+        entered_paren: Boolean;
+      Begin
+        expr:='';
+        entered_paren:=false;
+
+        refaddr:=addr_full;
+        if actasmtoken=AS_MOD then
+          begin
+            consume(AS_MOD);
+
+            if actasmtoken<>AS_ID then
+              begin
+                Message(asmr_e_invalid_reference_syntax);
+                RecoverConsume(false);
+              end
+            else
+              begin
+                if lower(actasmpattern)='pcrel_hi' then
+                  refaddr:=addr_pcrel_hi20
+                else if lower(actasmpattern)='pcrel_lo' then
+                  refaddr:=addr_pcrel_lo12
+                else if lower(actasmpattern)='hi' then
+                  refaddr:=addr_hi20
+                else if lower(actasmpattern)='lo' then
+                  refaddr:=addr_lo12
+                else
+                  begin
+                    Message(asmr_e_invalid_reference_syntax);
+                    RecoverConsume(false);
+                  end;
+
+                consume(AS_ID);
+                consume(AS_LPAREN);
+                entered_paren:=true;
+              end;
+          end;
+
+        case actasmtoken of
+          AS_LPAREN: { Memory reference or constant expression }
+            Begin
+              oper.InitRef;
+              BuildReference(oper);
+            end;
+
+          AS_INTNUM,
+          AS_MINUS,
+          AS_PLUS:
+            Begin
+              { Constant memory offset }
+              { This must absolutely be followed by (  }
+              oper.InitRef;
+              oper.opr.ref.offset:=BuildConstExpression(True,False);
+              if actasmtoken<>AS_LPAREN then
+                begin
+                  ofs:=oper.opr.ref.offset;
+                  BuildConstantOperand(oper);
+                  inc(oper.opr.val,ofs);
+                end
+              else
+                BuildReference(oper);
+            end;
+
+          AS_DOT,
+          AS_ID: { A constant expression, or a Variable ref.  }
+            Begin
+              if is_fenceflag(actasmpattern) then
+                begin
+                  consume(AS_ID);
+                end
+              else
+              { Local Label ? }
+              if is_locallabel(actasmpattern) then
+               begin
+                 CreateLocalLabel(actasmpattern,hl,false);
+                 Consume(AS_ID);
+                 AddLabelOperand(hl);
+               end
+              else
+               { Check for label }
+               if SearchLabel(actasmpattern,hl,false) then
+                begin
+                  Consume(AS_ID);
+                  AddLabelOperand(hl);
+                end
+              else
+               { probably a variable or normal expression }
+               { or a procedure (such as in CALL ID)      }
+               Begin
+                 { is it a constant ? }
+                 if SearchIConstant(actasmpattern,l) then
+                  Begin
+                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
+                     Message(asmr_e_invalid_operand_type);
+                    BuildConstantOperand(oper);
+                  end
+                 else
+                  begin
+                    expr:=actasmpattern;
+                    Consume(AS_ID);
+                    { typecasting? }
+                    if (actasmtoken=AS_LPAREN) and
+                       SearchType(expr,typesize) then
+                     begin
+                       oper.hastype:=true;
+                       Consume(AS_LPAREN);
+                       BuildOperand(oper);
+                       Consume(AS_RPAREN);
+                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+                         oper.SetSize(typesize,true);
+                     end
+                    else
+                     begin
+                       if oper.SetupVar(expr,false) then
+                         ReadAt(oper)
+                       else
+                        Begin
+                          { look for special symbols ... }
+                          if expr= '__HIGH' then
+                            begin
+                              consume(AS_LPAREN);
+                              if not oper.setupvar('high'+actasmpattern,false) then
+                                Message1(sym_e_unknown_id,'high'+actasmpattern);
+                              consume(AS_ID);
+                              consume(AS_RPAREN);
+                            end
+                          else
+                           if expr = '__RESULT' then
+                            oper.SetUpResult
+                          else
+                           if expr = '__SELF' then
+                            oper.SetupSelf
+                          else
+                           if expr = '__OLDEBP' then
+                            oper.SetupOldEBP
+                          else
+                            Message1(sym_e_unknown_id,expr);
+                        end;
+                     end;
+                  end;
+                  if actasmtoken=AS_DOT then
+                    MaybeRecordOffset;
+                  { add a constant expression? }
+                  if (actasmtoken=AS_PLUS) then
+                   begin
+                     l:=BuildConstExpression(true,entered_paren);
+                     case oper.opr.typ of
+                       OPR_CONSTANT :
+                         inc(oper.opr.val,l);
+                       OPR_LOCAL :
+                         inc(oper.opr.localsymofs,l);
+                       OPR_REFERENCE :
+                         inc(oper.opr.ref.offset,l);
+                       else
+                         internalerror(2003092017);
+                     end;
+                   end
+               end;
+              { Do we have a indexing reference, then parse it also }
+              if actasmtoken=AS_LPAREN then
+                begin
+                  oper.InitRef;
+                  BuildReference(oper);
+                end;
+            end;
+          AS_REGISTER: { Register, a variable reference or a constant reference  }
+            Begin
+              { save the type of register used. }
+              tempreg:=actasmregister;
+              Consume(AS_REGISTER);
+              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+                  begin
+                    if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
+                      Message(asmr_e_invalid_operand_type);
+                    oper.opr.typ:=OPR_REGISTER;
+                    oper.opr.reg:=tempreg;
+                  end
+              else
+                Message(asmr_e_syn_operand);
+            end;
+          AS_END,
+          AS_SEPARATOR,
+          AS_COMMA: ;
+        else
+          Begin
+            Message(asmr_e_syn_operand);
+            Consume(actasmtoken);
+          end;
+        end; { end case }
+
+        if refaddr<>addr_full then
+          begin
+            if oper.opr.typ<>OPR_REFERENCE then
+              oper.InitRef;
+
+            oper.opr.ref.refaddr:=refaddr;
+            Consume(AS_RPAREN);
+          end
+        else if (oper.opr.typ=OPR_REFERENCE) and
+           (oper.opr.ref.refaddr=addr_no) and
+           assigned(oper.opr.ref.symbol) then
+          oper.opr.ref.refaddr:=addr_full;
+      end;
+
+
+{*****************************************************************************
+                                trvgasreader
+*****************************************************************************}
+
+    procedure trvgasreader.BuildOpCode(instr : trvinstruction);
+      var
+        operandnum : longint;
+      Begin
+        { opcode }
+        if (actasmtoken<>AS_OPCODE) then
+         Begin
+           Message(asmr_e_invalid_or_missing_opcode);
+           RecoverConsume(true);
+           exit;
+         end;
+        { Fill the instr object with the current state }
+        with instr do
+          begin
+            Opcode:=ActOpcode;
+            condition:=ActCondition;
+            ordering:=actmemoryordering;
+          end;
+
+        { We are reading operands, so opcode will be an AS_ID }
+        operandnum:=1;
+        Consume(AS_OPCODE);
+        { Zero operand opcode ?  }
+        if actasmtoken in [AS_SEPARATOR,AS_END] then
+         begin
+           operandnum:=0;
+           exit;
+         end;
+        { Read the operands }
+        repeat
+          case actasmtoken of
+            AS_COMMA: { Operand delimiter }
+              Begin
+                if operandnum>Max_Operands then
+                  Message(asmr_e_too_many_operands)
+                else
+                  begin
+                    { condition operands doesn't set the operand but write to the
+                      condition field of the instruction
+                    }
+                    if instr.Operands[operandnum].opr.typ<>OPR_NONE then
+                      Inc(operandnum);
+                  end;
+                Consume(AS_COMMA);
+              end;
+            AS_SEPARATOR,
+            AS_END : { End of asm operands for this opcode  }
+              begin
+                break;
+              end;
+          else
+            BuildOperand(instr.Operands[operandnum] as trvoperand);
+          end; { end case }
+        until false;
+        if (operandnum=1) and (instr.Operands[operandnum].opr.typ=OPR_NONE) then
+          dec(operandnum);
+        instr.Ops:=operandnum;
+      end;
+
+    function trvgasreader.is_register(const s: string): boolean;
+      type
+        treg2str = record
+          name : string[3];
+          reg : tregister;
+        end;
+
+      const
+        extraregs : array[0..31] of treg2str = (
+          (name: 'A0'; reg : NR_X10),
+          (name: 'A1'; reg : NR_X11),
+          (name: 'A2'; reg : NR_X12),
+          (name: 'A3'; reg : NR_X13),
+          (name: 'A4'; reg : NR_X14),
+          (name: 'A5'; reg : NR_X15),
+          (name: 'A6'; reg : NR_X16),
+          (name: 'A7'; reg : NR_X17),
+          (name: 'RA'; reg : NR_X1),
+          (name: 'SP'; reg : NR_X2),
+          (name: 'GP'; reg : NR_X3),
+          (name: 'TP'; reg : NR_X4),
+          (name: 'T0'; reg : NR_X5),
+          (name: 'T1'; reg : NR_X6),
+          (name: 'T2'; reg : NR_X7),
+          (name: 'S0'; reg : NR_X8),
+          (name: 'FP'; reg : NR_X8),
+          (name: 'S1'; reg : NR_X9),
+          (name: 'S2'; reg : NR_X18),
+          (name: 'S3'; reg : NR_X19),
+          (name: 'S4'; reg : NR_X20),
+          (name: 'S5'; reg : NR_X21),
+          (name: 'S6'; reg : NR_X22),
+          (name: 'S7'; reg : NR_X23),
+          (name: 'S8'; reg : NR_X24),
+          (name: 'S9'; reg : NR_X25),
+          (name: 'S10';reg : NR_X26),
+          (name: 'S11';reg : NR_X27),
+          (name: 'T3'; reg : NR_X28),
+          (name: 'T4'; reg : NR_X29),
+          (name: 'T5'; reg : NR_X30),
+          (name: 'T6'; reg : NR_X31)
+          );
+
+      var
+        i : longint;
+
+      begin
+        result:=inherited is_register(s);
+        { reg found?
+          possible aliases are always 2 char
+        }
+        if result or (not (length(s) in [2,3])) then
+          exit;
+        for i:=low(extraregs) to high(extraregs) do
+          begin
+            if s=extraregs[i].name then
+              begin
+                actasmregister:=extraregs[i].reg;
+                result:=true;
+                actasmtoken:=AS_REGISTER;
+                exit;
+              end;
+          end;
+      end;
+
+
+    function trvgasreader.is_asmopcode(const s: string):boolean;
+      var
+        cond  : tasmcond;
+        hs, postfix : string;
+        l: longint;
+      Begin
+        { making s a value parameter would break other assembler readers }
+        hs:=s;
+        is_asmopcode:=false;
+
+        { clear op code }
+        actopcode:=A_None;
+        { clear condition }
+        fillchar(actcondition,sizeof(actcondition),0);
+
+        { check for direction hint }
+        actopcode := tasmop(ptruint(iasmops.find(hs)));
+        if actopcode <> A_NONE then
+          begin
+            actasmtoken:=AS_OPCODE;
+            is_asmopcode:=true;
+            exit;
+          end;
+        { not found, check branch instructions }
+        if hs[1]='B' then
+          begin
+            { we can search here without an extra table which is sorted by string length
+              because we take the whole remaining string without the leading B }
+            actopcode := A_Bxx;
+            for cond:=low(TAsmCond) to high(TAsmCond) do
+              if copy(hs,2,length(s)-1)=uppercond2str[cond] then
+                begin
+                  actcondition:=cond;
+                  actasmtoken:=AS_OPCODE;
+                  is_asmopcode:=true;
+                  exit;
+                end;
+          end;
+
+        { check atomic instructions }
+        if (pos('AMO',hs)=1) or
+           (pos('LR', hs)=1) or
+           (pos('SC', hs)=1) then
+          begin
+            l := length(hs)-1;
+            while l>1 do
+              begin
+                actopcode := tasmop(ptruint(iasmops.find(copy(hs,1,l))));
+                if actopcode <> A_None then
+                  begin
+                    postfix := copy(hs,l+1,length(hs)-l);
+
+                    if postfix='.AQRL' then actmemoryordering:=[moAq,moRl]
+                    else if postfix='.RL' then actmemoryordering:=[moRl]
+                    else if postfix='.AQ' then actmemoryordering:=[moAq]
+                    else
+                      exit;
+
+                    actasmtoken:=AS_OPCODE;
+                    is_asmopcode:=true;
+                    exit;
+                  end;
+                dec(l);
+              end;
+          end;
+      end;
+
+
+    procedure trvgasreader.handleopcode;
+      var
+        instr : trvinstruction;
+      begin
+        instr:=trvinstruction.Create(trvoperand);
+        BuildOpcode(instr);
+        instr.condition := actcondition;
+        {
+        instr.AddReferenceSizes;
+        instr.SetInstructionOpsize;
+        instr.CheckOperandSizes;
+        }
+        instr.ConcatInstruction(curlist);
+        instr.Free;
+        actmemoryordering:=[];
+      end;
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+      asmmode_rv64_standard_info : tasmmodeinfo =
+              (
+                id    : asmmode_standard;
+                idtxt : 'STANDARD';
+                casmreader : trvgasreader;
+              );
+
+      asmmode_rv32_standard_info : tasmmodeinfo =
+              (
+                id    : asmmode_standard;
+                idtxt : 'STANDARD';
+                casmreader : trvgasreader;
+              );
+
+initialization
+{$ifdef RISCV32}
+  RegisterAsmMode(asmmode_rv32_standard_info);
+{$endif RISCV32}
+{$ifdef RISCV64}
+  RegisterAsmMode(asmmode_rv64_standard_info);
+{$endif RISCV32}
 end.
 

compiler/riscv32/cputarg.pas

@@ -55,7 +55,7 @@ implementation
 **************************************}
 
   {$ifndef NoRaRVGas}
-       ,rarv32gas
+       ,rarvgas
   {$endif NoRaRVGas}
 
 {**************************************

compiler/riscv32/rarv32.pas

@@ -1,41 +0,0 @@
-{
-    Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman
-
-    Handles the common Risc-V32 assembler reader routines
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit rarv32;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-      aasmbase,aasmtai,aasmdata,aasmcpu,
-      cpubase,rautils,cclasses;
-
-    type
-      TRVOperand=class(TOperand)
-      end;
-
-      TRVInstruction=class(TInstruction)
-      end;
-
-  implementation
-
-end.

compiler/riscv32/rarv32gas.pas

@@ -1,780 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
-
-    Does the parsing for the Risc-V32 GNU AS styled inline assembler.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-Unit rarv32gas;
-
-{$i fpcdefs.inc}
-
-  Interface
-
-    uses
-      raatt,rarv32,rarvgas;
-
-    type
-      trv32attreader = class(trvattreader)                             
-        function is_register(const s: string): boolean; override;
-        function is_asmopcode(const s: string):boolean;override;
-        procedure handleopcode;override;
-        procedure BuildReference(oper : trvoperand);
-        procedure BuildOperand(oper : trvoperand);
-        procedure BuildOpCode(instr : trvinstruction);
-        procedure ReadAt(oper : trvoperand);
-        procedure ReadSym(oper : trvoperand);
-      end;
-
-
-  Implementation
-
-    uses
-      { helpers }
-      cutils,
-      { global }
-      globtype,globals,verbose,
-      systems,
-      { aasm }
-      cpubase,aasmbase,aasmtai,aasmdata,aasmcpu,
-      { symtable }
-      symconst,symdef,symsym,
-      { parser }
-      procinfo,
-      rabase,rautils,
-      cgbase,cgobj,cgrv
-      ;
-
-    procedure trv32attreader.ReadSym(oper : trvoperand);
-      var
-         tempstr, mangledname : string;
-         l,k,typesize : tcgint;
-      begin
-        tempstr:=actasmpattern;
-        Consume(AS_ID);
-        { typecasting? }
-        if (actasmtoken=AS_LPAREN) and
-           SearchType(tempstr,typesize) then
-         begin
-           oper.hastype:=true;
-           Consume(AS_LPAREN);
-           BuildOperand(oper);
-           Consume(AS_RPAREN);
-           if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-             oper.SetSize(typesize,true);
-         end
-        else
-         if not oper.SetupVar(tempstr,false) then
-          Message1(sym_e_unknown_id,tempstr);
-        { record.field ? }
-        if actasmtoken=AS_DOT then
-         begin
-           BuildRecordOffsetSize(tempstr,l,k,mangledname,false);
-           if (mangledname<>'') then
-             Message(asmr_e_invalid_reference_syntax);
-           inc(oper.opr.ref.offset,l);
-         end;
-      end;
-
-
-    procedure trv32attreader.ReadAt(oper : trvoperand);
-      begin
-        { check for ...@ }
-        if actasmtoken=AS_AT then
-          begin
-            if (oper.opr.ref.symbol=nil) and
-               (oper.opr.ref.offset = 0) then
-              Message(asmr_e_invalid_reference_syntax);
-            Consume(AS_AT);
-            if actasmtoken=AS_ID then
-              begin
-                {if upper(actasmpattern)='L' then
-                  oper.opr.ref.refaddr:=addr_low
-                else if upper(actasmpattern)='HI' then
-                  oper.opr.ref.refaddr:=addr_high
-                else if upper(actasmpattern)='HA' then
-                  oper.opr.ref.refaddr:=addr_higha
-                else}
-                  Message(asmr_e_invalid_reference_syntax);
-                Consume(AS_ID);
-              end
-            else
-              Message(asmr_e_invalid_reference_syntax);
-          end;
-      end;
-
-
-    Procedure trv32attreader.BuildReference(oper : trvoperand);
-
-      procedure Consume_RParen;
-        begin
-          if actasmtoken <> AS_RPAREN then
-           Begin
-             Message(asmr_e_invalid_reference_syntax);
-             RecoverConsume(true);
-           end
-          else
-           begin
-             Consume(AS_RPAREN);
-             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
-              Begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(true);
-              end;
-           end;
-        end;
-
-      var
-        l : tcgint;
-        relsym: string;
-        asmsymtyp: tasmsymtype;
-        isflags: tindsymflags;
-
-      begin
-        Consume(AS_LPAREN);
-        Case actasmtoken of
-          AS_INTNUM,
-          AS_MINUS,
-          AS_PLUS:
-            Begin
-              { offset(offset) is invalid }
-              If oper.opr.Ref.Offset <> 0 Then
-               Begin
-                 Message(asmr_e_invalid_reference_syntax);
-                 RecoverConsume(true);
-               End
-              Else
-               Begin
-                 oper.opr.Ref.Offset:=BuildConstExpression(false,true);
-                 Consume(AS_RPAREN);
-                 if actasmtoken=AS_AT then
-                   ReadAt(oper);
-               end;
-              exit;
-            End;
-          AS_REGISTER: { (reg ...  }
-            Begin
-              if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or
-                 ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then
-                message(asmr_e_cannot_index_relative_var);
-              oper.opr.ref.base:=actasmregister;
-              Consume(AS_REGISTER);
-              Consume_RParen;
-            end; {end case }
-          AS_ID:
-            Begin
-              ReadSym(oper);
-              case actasmtoken of
-                AS_PLUS:
-                  begin
-                    { add a constant expression? }
-                    l:=BuildConstExpression(true,true);
-                    case oper.opr.typ of
-                      OPR_CONSTANT :
-                        inc(oper.opr.val,l);
-                      OPR_LOCAL :
-                        inc(oper.opr.localsymofs,l);
-                      OPR_REFERENCE :
-                        inc(oper.opr.ref.offset,l);
-                      else
-                        internalerror(2003092008);
-                    end;
-                  end;
-                AS_MINUS:
-                  begin
-                    Consume(AS_MINUS);
-                    BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp);
-                    if (relsym<>'') then
-                      begin
-                        if (oper.opr.typ = OPR_REFERENCE) then
-                          oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym,AT_DATA)
-                        else
-                          begin
-                            Message(asmr_e_invalid_reference_syntax);
-                            RecoverConsume(false);
-                          end
-                      end
-                    else
-                      begin
-                        case oper.opr.typ of
-                          OPR_CONSTANT :
-                            dec(oper.opr.val,l);
-                          OPR_LOCAL :
-                            dec(oper.opr.localsymofs,l);
-                          OPR_REFERENCE :
-                            dec(oper.opr.ref.offset,l);
-                          else
-                            internalerror(2007092601);
-                        end;
-                      end;
-                  end;
-                else
-                  ;
-              end;
-              Consume(AS_RPAREN);
-              if actasmtoken=AS_AT then
-                ReadAt(oper);
-            End;
-          AS_COMMA: { (, ...  can either be scaling, or index }
-            Begin
-              Consume(AS_COMMA);
-              { Index }
-              if (actasmtoken=AS_REGISTER) then
-                Begin
-                  oper.opr.ref.index:=actasmregister;
-                  Consume(AS_REGISTER);
-                  { check for scaling ... }
-                  Consume_RParen;
-                end
-              else
-                begin
-                  Message(asmr_e_invalid_reference_syntax);
-                  RecoverConsume(false);
-                end;
-            end;
-        else
-          Begin
-            Message(asmr_e_invalid_reference_syntax);
-            RecoverConsume(false);
-          end;
-        end;
-      end;
-
-
-    Procedure trv32attreader.BuildOperand(oper : trvoperand);
-      var
-        expr : string;
-        typesize,l : tcgint;
-
-
-        procedure AddLabelOperand(hl:tasmlabel);
-          begin
-            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
-               is_calljmp(actopcode) then
-             begin
-               oper.opr.typ:=OPR_SYMBOL;
-               oper.opr.symbol:=hl;
-             end
-            else
-             begin
-               oper.InitRef;
-               oper.opr.ref.symbol:=hl;
-             end;
-          end;
-
-
-        procedure MaybeRecordOffset;
-          var
-            mangledname: string;
-            hasdot  : boolean;
-            l,
-            toffset,
-            tsize   : tcgint;
-          begin
-            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
-             exit;
-            l:=0;
-            hasdot:=(actasmtoken=AS_DOT);
-            if hasdot then
-              begin
-                if expr<>'' then
-                  begin
-                    BuildRecordOffsetSize(expr,toffset,tsize,mangledname,false);
-                    if (oper.opr.typ<>OPR_CONSTANT) and
-                       (mangledname<>'') then
-                      Message(asmr_e_wrong_sym_type);
-                    inc(l,toffset);
-                    oper.SetSize(tsize,true);
-                  end;
-              end;
-            if actasmtoken in [AS_PLUS,AS_MINUS] then
-              inc(l,BuildConstExpression(true,false));
-            case oper.opr.typ of
-              OPR_LOCAL :
-                begin
-                  { don't allow direct access to fields of parameters, because that
-                    will generate buggy code. Allow it only for explicit typecasting }
-                  if hasdot and
-                     (not oper.hastype) and
-                     (tabstractvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
-                     (current_procinfo.procdef.proccalloption<>pocall_register) then
-                    Message(asmr_e_cannot_access_field_directly_for_parameters);
-                  inc(oper.opr.localsymofs,l)
-                end;
-              OPR_CONSTANT :
-                if (mangledname<>'') then
-                  begin
-                    if (oper.opr.val<>0) then
-                      Message(asmr_e_wrong_sym_type);
-                    oper.opr.typ:=OPR_SYMBOL;
-                    oper.opr.symbol:=current_asmdata.DefineAsmSymbol(mangledname,AB_EXTERNAL,AT_FUNCTION,voidcodepointertype);
-                  end
-                else
-                  inc(oper.opr.val,l);
-              OPR_REFERENCE :
-                inc(oper.opr.ref.offset,l);
-              OPR_SYMBOL:
-                Message(asmr_e_invalid_symbol_ref);
-              else
-                internalerror(200309221);
-            end;
-          end;
-
-
-        function MaybeBuildReference:boolean;
-          { Try to create a reference, if not a reference is found then false
-            is returned }
-          begin
-            MaybeBuildReference:=true;
-            case actasmtoken of
-              AS_INTNUM,
-              AS_MINUS,
-              AS_PLUS:
-                Begin
-                  oper.opr.ref.offset:=BuildConstExpression(True,False);
-                  if actasmtoken<>AS_LPAREN then
-                    Message(asmr_e_invalid_reference_syntax)
-                  else
-                    BuildReference(oper);
-                end;
-              AS_LPAREN:
-                BuildReference(oper);
-              AS_ID: { only a variable is allowed ... }
-                Begin
-                  ReadSym(oper);
-                  case actasmtoken of
-                    AS_END,
-                    AS_SEPARATOR,
-                    AS_COMMA: ;
-                    AS_LPAREN:
-                      BuildReference(oper);
-                  else
-                    Begin
-                      Message(asmr_e_invalid_reference_syntax);
-                      Consume(actasmtoken);
-                    end;
-                  end; {end case }
-                end;
-              else
-               MaybeBuildReference:=false;
-            end; { end case }
-          end;
-
-
-      var
-        tempreg : tregister;
-        hl : tasmlabel;
-        ofs : aint;          
-        refaddr: trefaddr;
-        entered_paren: Boolean;
-      Begin
-        expr:='';             
-        entered_paren:=false;
-
-        refaddr:=addr_full;
-        if actasmtoken=AS_MOD then
-          begin
-            consume(AS_MOD);
-
-            if actasmtoken<>AS_ID then
-              begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(false);
-              end
-            else
-              begin
-                if lower(actasmpattern)='pcrel_hi' then
-                  refaddr:=addr_pcrel_hi20
-                else if lower(actasmpattern)='pcrel_lo' then
-                  refaddr:=addr_pcrel_lo12
-                else if lower(actasmpattern)='hi' then
-                  refaddr:=addr_hi20
-                else if lower(actasmpattern)='lo' then
-                  refaddr:=addr_lo12
-                else
-                  begin
-                    Message(asmr_e_invalid_reference_syntax);
-                    RecoverConsume(false);
-                  end;
-
-                consume(AS_ID);
-                consume(AS_LPAREN);
-                entered_paren:=true;
-              end;
-          end;
-
-        case actasmtoken of
-          AS_LPAREN: { Memory reference or constant expression }
-            Begin
-              oper.InitRef;
-              BuildReference(oper);
-            end;
-
-          AS_INTNUM,
-          AS_MINUS,
-          AS_PLUS:
-            Begin
-              { Constant memory offset }
-              { This must absolutely be followed by (  }
-              oper.InitRef;
-              oper.opr.ref.offset:=BuildConstExpression(True,False);
-              if actasmtoken<>AS_LPAREN then
-                begin
-                  ofs:=oper.opr.ref.offset;
-                  BuildConstantOperand(oper);
-                  inc(oper.opr.val,ofs);
-                end
-              else
-                BuildReference(oper);
-            end;
-
-          AS_ID: { A constant expression, or a Variable ref.  }
-            Begin
-              { Local Label ? }
-              if is_locallabel(actasmpattern) then
-               begin
-                 CreateLocalLabel(actasmpattern,hl,false);
-                 Consume(AS_ID);
-                 AddLabelOperand(hl);
-               end
-              else
-               { Check for label }
-               if SearchLabel(actasmpattern,hl,false) then
-                begin
-                  Consume(AS_ID);
-                  AddLabelOperand(hl);
-                end
-              else
-               { probably a variable or normal expression }
-               { or a procedure (such as in CALL ID)      }
-               Begin
-                 { is it a constant ? }
-                 if SearchIConstant(actasmpattern,l) then
-                  Begin
-                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
-                     Message(asmr_e_invalid_operand_type);
-                    BuildConstantOperand(oper);
-                  end
-                 else
-                  begin
-                    expr:=actasmpattern;
-                    Consume(AS_ID);
-                    { typecasting? }
-                    if (actasmtoken=AS_LPAREN) and
-                       SearchType(expr,typesize) then
-                     begin
-                       oper.hastype:=true;
-                       Consume(AS_LPAREN);
-                       BuildOperand(oper);
-                       Consume(AS_RPAREN);
-                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                         oper.SetSize(typesize,true);
-                     end
-                    else
-                     begin
-                       if oper.SetupVar(expr,false) then
-                         ReadAt(oper)
-                       else
-                        Begin
-                          { look for special symbols ... }
-                          if expr= '__HIGH' then
-                            begin
-                              consume(AS_LPAREN);
-                              if not oper.setupvar('high'+actasmpattern,false) then
-                                Message1(sym_e_unknown_id,'high'+actasmpattern);
-                              consume(AS_ID);
-                              consume(AS_RPAREN);
-                            end
-                          else
-                           if expr = '__RESULT' then
-                            oper.SetUpResult
-                          else
-                           if expr = '__SELF' then
-                            oper.SetupSelf
-                          else
-                           if expr = '__OLDEBP' then
-                            oper.SetupOldEBP
-                          else
-                            Message1(sym_e_unknown_id,expr);
-                        end;
-                     end;
-                  end;
-                  if actasmtoken=AS_DOT then
-                    MaybeRecordOffset;
-                  { add a constant expression? }
-                  if (actasmtoken=AS_PLUS) then
-                   begin
-                     l:=BuildConstExpression(true,entered_paren);
-                     case oper.opr.typ of
-                       OPR_CONSTANT :
-                         inc(oper.opr.val,l);
-                       OPR_LOCAL :
-                         inc(oper.opr.localsymofs,l);
-                       OPR_REFERENCE :
-                         inc(oper.opr.ref.offset,l);
-                       else
-                         internalerror(2003092009);
-                     end;
-                   end
-               end;
-              { Do we have a indexing reference, then parse it also }
-              if actasmtoken=AS_LPAREN then
-                BuildReference(oper);
-            end;
-
-          AS_REGISTER: { Register, a variable reference or a constant reference  }
-            Begin
-              { save the type of register used. }
-              tempreg:=actasmregister;
-              Consume(AS_REGISTER);
-              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
-                  begin
-                    if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
-                      Message(asmr_e_invalid_operand_type);
-                    oper.opr.typ:=OPR_REGISTER;
-                    oper.opr.reg:=tempreg;
-                  end
-              else
-                Message(asmr_e_syn_operand);
-            end;
-          AS_END,
-          AS_SEPARATOR,
-          AS_COMMA: ;
-        else
-          Begin
-            Message(asmr_e_syn_operand);
-            Consume(actasmtoken);
-          end;
-        end; { end case }  
-
-        if refaddr<>addr_full then
-          begin
-            if oper.opr.typ<>OPR_REFERENCE then
-              oper.InitRef;
-
-            oper.opr.ref.refaddr:=refaddr;
-            Consume(AS_RPAREN);
-          end
-        else if (oper.opr.typ=OPR_REFERENCE) and
-           (oper.opr.ref.refaddr=addr_no) and
-           assigned(oper.opr.ref.symbol) then
-          oper.opr.ref.refaddr:=addr_full;
-      end;
-
-
-{*****************************************************************************
-                                trv32attreader
-*****************************************************************************}
-
-    procedure trv32attreader.BuildOpCode(instr : trvinstruction);
-      var
-        operandnum : longint;
-      Begin
-        { opcode }
-        if (actasmtoken<>AS_OPCODE) then
-         Begin
-           Message(asmr_e_invalid_or_missing_opcode);
-           RecoverConsume(true);
-           exit;
-         end;
-        { Fill the instr object with the current state }
-        with instr do
-          begin
-            Opcode:=ActOpcode;
-            condition:=ActCondition;
-          end;
-
-        { We are reading operands, so opcode will be an AS_ID }
-        operandnum:=1;
-        Consume(AS_OPCODE);
-        { Zero operand opcode ?  }
-        if actasmtoken in [AS_SEPARATOR,AS_END] then
-         begin
-           operandnum:=0;
-           exit;
-         end;
-        { Read the operands }
-        repeat
-          case actasmtoken of
-            AS_COMMA: { Operand delimiter }
-              Begin
-                if operandnum>Max_Operands then
-                  Message(asmr_e_too_many_operands)
-                else
-                  begin
-                    { condition operands doesn't set the operand but write to the
-                      condition field of the instruction
-                    }
-                    if instr.Operands[operandnum].opr.typ<>OPR_NONE then
-                      Inc(operandnum);
-                  end;
-                Consume(AS_COMMA);
-              end;
-            AS_SEPARATOR,
-            AS_END : { End of asm operands for this opcode  }
-              begin
-                break;
-              end;
-          else
-            BuildOperand(instr.Operands[operandnum] as trvoperand);
-          end; { end case }
-        until false;
-        if (operandnum=1) and (instr.Operands[operandnum].opr.typ=OPR_NONE) then
-          dec(operandnum);
-        instr.Ops:=operandnum;
-      end;
-
-
-    function trv32attreader.is_register(const s: string): boolean;
-      type
-        treg2str = record
-          name : string[3];
-          reg : tregister;
-        end;
-
-      const
-        extraregs : array[0..31] of treg2str = (
-          (name: 'A0'; reg : NR_X10),
-          (name: 'A1'; reg : NR_X11),
-          (name: 'A2'; reg : NR_X12),
-          (name: 'A3'; reg : NR_X13),
-          (name: 'A4'; reg : NR_X14),
-          (name: 'A5'; reg : NR_X15),
-          (name: 'A6'; reg : NR_X16),
-          (name: 'A7'; reg : NR_X17),
-          (name: 'RA'; reg : NR_X1),
-          (name: 'SP'; reg : NR_X2),
-          (name: 'GP'; reg : NR_X3),
-          (name: 'TP'; reg : NR_X4),
-          (name: 'T0'; reg : NR_X5),
-          (name: 'T1'; reg : NR_X6),
-          (name: 'T2'; reg : NR_X7),
-          (name: 'S0'; reg : NR_X8),
-          (name: 'FP'; reg : NR_X8),
-          (name: 'S1'; reg : NR_X9),
-          (name: 'S2'; reg : NR_X18),
-          (name: 'S3'; reg : NR_X19),
-          (name: 'S4'; reg : NR_X20),
-          (name: 'S5'; reg : NR_X21),
-          (name: 'S6'; reg : NR_X22),
-          (name: 'S7'; reg : NR_X23),
-          (name: 'S8'; reg : NR_X24),
-          (name: 'S9'; reg : NR_X25),
-          (name: 'S10';reg : NR_X26),
-          (name: 'S11';reg : NR_X27),
-          (name: 'T3'; reg : NR_X28),
-          (name: 'T4'; reg : NR_X29),
-          (name: 'T5'; reg : NR_X30),
-          (name: 'T6'; reg : NR_X31)
-          );
-
-      var
-        i : longint;
-
-      begin
-        result:=inherited is_register(s);
-        { reg found?
-          possible aliases are always 2 char
-        }
-        if result or (not (length(s) in [2,3])) then
-          exit;
-        for i:=low(extraregs) to high(extraregs) do
-          begin
-            if s=extraregs[i].name then
-              begin
-                actasmregister:=extraregs[i].reg;
-                result:=true;
-                actasmtoken:=AS_REGISTER;
-                exit;
-              end;
-          end;
-      end;
-
-
-    function trv32attreader.is_asmopcode(const s: string):boolean;
-      var
-        cond  : tasmcond;
-        hs : string;
-
-      Begin
-        { making s a value parameter would break other assembler readers }
-        hs:=s;
-        is_asmopcode:=false;
-
-        { clear op code }
-        actopcode:=A_None;
-        { clear condition }
-        fillchar(actcondition,sizeof(actcondition),0);
-
-        { check for direction hint }
-	actopcode := tasmop(ptruint(iasmops.find(hs)));
-        if actopcode <> A_NONE then
-          begin
-            actasmtoken:=AS_OPCODE;
-            is_asmopcode:=true;
-            exit;
-          end;
-        { not found, check branch instructions }
-        if hs[1]='B' then
-          begin
-            { we can search here without an extra table which is sorted by string length
-              because we take the whole remaining string without the leading B }
-            actopcode := A_Bxx;
-            for cond:=low(TAsmCond) to high(TAsmCond) do
-              if copy(hs,2,length(s)-1)=uppercond2str[cond] then
-                begin
-                  actcondition:=cond;
-                  actasmtoken:=AS_OPCODE;
-                  is_asmopcode:=true;
-                  exit;
-                end;
-          end;
-      end;
-
-
-    procedure trv32attreader.handleopcode;
-      var
-        instr : trvinstruction;
-      begin
-        instr:=trvinstruction.Create(trvoperand);
-        BuildOpcode(instr);
-        instr.condition := actcondition;
-        {
-        instr.AddReferenceSizes;
-        instr.SetInstructionOpsize;
-        instr.CheckOperandSizes;
-        }
-        instr.ConcatInstruction(curlist);
-        instr.Free;
-      end;
-
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-const
-  asmmode_rv32_standard_info : tasmmodeinfo =
-          (
-            id    : asmmode_standard;
-            idtxt : 'STANDARD';
-            casmreader : trv32attreader;
-          );
-
-initialization
-  RegisterAsmMode(asmmode_rv32_standard_info);
-end.

compiler/riscv64/cputarg.pas

@@ -55,7 +55,7 @@ implementation
 **************************************}
 
   {$ifndef NoRaRVGas}
-       ,rarv64gas
+       ,rarvgas
   {$endif NoRaRVGas}
 
 {**************************************

compiler/riscv64/rarv64gas.pas

@@ -1,850 +0,0 @@
-{
-    Copyright (c) 2016 by Jeppe Johansen
-
-    Does the parsing for the RiscV64 GNU AS styled inline assembler.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit rarv64gas;
-
-{$I fpcdefs.inc}
-
-  interface
-
-    uses
-      raatt, rarvgas, rarv,
-      cpubase;
-
-    type
-      trv64attreader = class(trvattreader)
-        actmemoryordering: TMemoryOrdering;
-        function is_register(const s: string): boolean; override;
-        function is_asmopcode(const s: string):boolean;override;
-        procedure handleopcode;override;
-        procedure BuildReference(oper : trvoperand);
-        procedure BuildOperand(oper : trvoperand);
-        procedure BuildOpCode(instr : trvinstruction);
-        procedure ReadAt(oper : trvoperand);
-        procedure ReadSym(oper : trvoperand);
-     end;
-
-  implementation
-
-    uses
-      { helpers }
-      cutils,
-      { global }
-      globtype,globals,verbose,
-      systems,
-      { aasm }
-      aasmbase,aasmtai,aasmdata,aasmcpu,
-      { symtable }
-      symconst,symsym,symdef,
-      { parser }
-      procinfo,
-      rabase,rautils,
-      cgbase,cgobj,cgrv
-      ;
-
-    procedure trv64attreader.ReadSym(oper : trvoperand);
-      var
-         tempstr, mangledname : string;
-         typesize,l,k : aint;
-      begin
-        tempstr:=actasmpattern;
-        Consume(AS_ID);
-        { typecasting? }
-        if (actasmtoken=AS_LPAREN) and
-           SearchType(tempstr,typesize) then
-         begin
-           oper.hastype:=true;
-           Consume(AS_LPAREN);
-           BuildOperand(oper);
-           Consume(AS_RPAREN);
-           if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-             oper.SetSize(typesize,true);
-         end
-        else
-         if not oper.SetupVar(tempstr,false) then
-          Message1(sym_e_unknown_id,tempstr);
-        { record.field ? }
-        if actasmtoken=AS_DOT then
-         begin
-           BuildRecordOffsetSize(tempstr,l,k,mangledname,false);
-           if (mangledname<>'') then
-             Message(asmr_e_invalid_reference_syntax);
-           inc(oper.opr.ref.offset,l);
-         end;
-      end;
-
-
-    procedure trv64attreader.ReadAt(oper : trvoperand);
-      begin
-        { check for ...@ }
-        if actasmtoken=AS_AT then
-          begin
-            if (oper.opr.ref.symbol=nil) and
-               (oper.opr.ref.offset = 0) then
-              Message(asmr_e_invalid_reference_syntax);
-            Consume(AS_AT);
-            if actasmtoken=AS_ID then
-              begin
-                {if upper(actasmpattern)='L' then
-                  oper.opr.ref.refaddr:=addr_low
-                else if upper(actasmpattern)='HI' then
-                  oper.opr.ref.refaddr:=addr_high
-                else if upper(actasmpattern)='HA' then
-                  oper.opr.ref.refaddr:=addr_higha
-                else}
-                  Message(asmr_e_invalid_reference_syntax);
-                Consume(AS_ID);
-              end
-            else
-              Message(asmr_e_invalid_reference_syntax);
-          end;
-      end;
-
-
-    procedure trv64attreader.BuildReference(oper: trvoperand);
-
-      procedure Consume_RParen;
-        begin
-          if actasmtoken <> AS_RPAREN then
-           Begin
-             Message(asmr_e_invalid_reference_syntax);
-             RecoverConsume(true);
-           end
-          else
-           begin
-             Consume(AS_RPAREN);
-             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
-              Begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(true);
-              end;
-           end;
-        end;
-
-      var
-        l : aint;
-        relsym: string;
-        asmsymtyp: tasmsymtype;
-        isflags: tindsymflags;
-
-      begin
-        Consume(AS_LPAREN);
-        Case actasmtoken of
-          AS_INTNUM,
-          AS_MINUS,
-          AS_PLUS:
-            Begin
-              { offset(offset) is invalid }
-              If oper.opr.Ref.Offset <> 0 Then
-               Begin
-                 Message(asmr_e_invalid_reference_syntax);
-                 RecoverConsume(true);
-               End
-              Else
-               Begin
-                 oper.opr.Ref.Offset:=BuildConstExpression(false,true);
-                 Consume(AS_RPAREN);
-                 if actasmtoken=AS_AT then
-                   ReadAt(oper);
-               end;
-              exit;
-            End;
-          AS_REGISTER: { (reg ...  }
-            Begin
-              if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or
-                 ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then
-                message(asmr_e_cannot_index_relative_var);
-              oper.opr.ref.base:=actasmregister;
-              Consume(AS_REGISTER);
-              Consume_RParen;
-            end; {end case }
-          AS_ID:
-            Begin
-              ReadSym(oper);
-              case actasmtoken of
-                AS_PLUS:
-                  begin
-                    { add a constant expression? }
-                    l:=BuildConstExpression(true,true);
-                    case oper.opr.typ of
-                      OPR_CONSTANT :
-                        inc(oper.opr.val,l);
-                      OPR_LOCAL :
-                        inc(oper.opr.localsymofs,l);
-                      OPR_REFERENCE :
-                        inc(oper.opr.ref.offset,l);
-                      else
-                        internalerror(2003092016);
-                    end;
-                  end;
-                AS_MINUS:
-                  begin
-                    Consume(AS_MINUS);
-                    BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp);
-                    if (relsym<>'') then
-                      begin
-                        if (oper.opr.typ = OPR_REFERENCE) then
-                          oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym,AT_DATA)
-                        else
-                          begin
-                            Message(asmr_e_invalid_reference_syntax);
-                            RecoverConsume(false);
-                          end
-                      end
-                    else
-                      begin
-                        case oper.opr.typ of
-                          OPR_CONSTANT :
-                            dec(oper.opr.val,l);
-                          OPR_LOCAL :
-                            dec(oper.opr.localsymofs,l);
-                          OPR_REFERENCE :
-                            dec(oper.opr.ref.offset,l);
-                          else
-                            internalerror(2007092601);
-                        end;
-                      end;
-                  end;
-                else
-                  ;
-              end;
-              Consume(AS_RPAREN);
-              if actasmtoken=AS_AT then
-                ReadAt(oper);
-            End;
-          AS_COMMA: { (, ...  can either be scaling, or index }
-            Begin
-              Consume(AS_COMMA);
-              { Index }
-              if (actasmtoken=AS_REGISTER) then
-                Begin
-                  oper.opr.ref.index:=actasmregister;
-                  Consume(AS_REGISTER);
-                  { check for scaling ... }
-                  Consume_RParen;
-                end
-              else
-                begin
-                  Message(asmr_e_invalid_reference_syntax);
-                  RecoverConsume(false);
-                end;
-            end;
-        else
-          Begin
-            Message(asmr_e_invalid_reference_syntax);
-            RecoverConsume(false);
-          end;
-        end;
-      end;
-
-
-    procedure trv64attreader.BuildOperand(oper: trvoperand);
-      var
-        expr : string;
-        typesize,l : aint;
-
-
-        procedure AddLabelOperand(hl:tasmlabel);
-          begin
-            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
-               is_calljmp(actopcode) then
-             begin
-               oper.opr.typ:=OPR_SYMBOL;
-               oper.opr.symbol:=hl;
-             end
-            else
-             begin
-               oper.InitRef;
-               oper.opr.ref.symbol:=hl;
-             end;
-          end;
-
-
-        procedure MaybeRecordOffset;
-          var
-            mangledname: string;
-            hasdot  : boolean;
-            l,
-            toffset,
-            tsize   : aint;
-          begin
-            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
-             exit;
-            l:=0;
-            hasdot:=(actasmtoken=AS_DOT);
-            if hasdot then
-              begin
-                if expr<>'' then
-                  begin
-                    BuildRecordOffsetSize(expr,toffset,tsize,mangledname,false);
-                    if (oper.opr.typ<>OPR_CONSTANT) and
-                       (mangledname<>'') then
-                      Message(asmr_e_wrong_sym_type);
-                    inc(l,toffset);
-                    oper.SetSize(tsize,true);
-                  end;
-              end;
-            if actasmtoken in [AS_PLUS,AS_MINUS] then
-              inc(l,BuildConstExpression(true,false));
-            case oper.opr.typ of
-              OPR_LOCAL :
-                begin
-                  { don't allow direct access to fields of parameters, because that
-                    will generate buggy code. Allow it only for explicit typecasting }
-                  if hasdot and
-                     (not oper.hastype) and
-                     (tabstractvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
-                     (current_procinfo.procdef.proccalloption<>pocall_register) then
-                    Message(asmr_e_cannot_access_field_directly_for_parameters);
-                  inc(oper.opr.localsymofs,l)
-                end;
-              OPR_CONSTANT :
-                if (mangledname<>'') then
-                  begin
-                    if (oper.opr.val<>0) then
-                      Message(asmr_e_wrong_sym_type);
-                    oper.opr.typ:=OPR_SYMBOL;
-                    oper.opr.symbol:=current_asmdata.DefineAsmSymbol(mangledname,AB_EXTERNAL,AT_FUNCTION,voidcodepointertype);
-                  end
-                else
-                  inc(oper.opr.val,l);
-              OPR_REFERENCE :
-                inc(oper.opr.ref.offset,l);
-              OPR_SYMBOL:
-                Message(asmr_e_invalid_symbol_ref);
-              else
-                internalerror(200309221);
-            end;
-          end;
-
-
-        function MaybeBuildReference:boolean;
-          { Try to create a reference, if not a reference is found then false
-            is returned }
-          begin
-            MaybeBuildReference:=true;
-            case actasmtoken of
-              AS_INTNUM,
-              AS_MINUS,
-              AS_PLUS:
-                Begin
-                  oper.opr.ref.offset:=BuildConstExpression(True,False);
-                  if actasmtoken<>AS_LPAREN then
-                    Message(asmr_e_invalid_reference_syntax)
-                  else
-                    BuildReference(oper);
-                end;
-              AS_LPAREN:
-                BuildReference(oper);
-              AS_ID: { only a variable is allowed ... }
-                Begin
-                  ReadSym(oper);
-                  case actasmtoken of
-                    AS_END,
-                    AS_SEPARATOR,
-                    AS_COMMA: ;
-                    AS_LPAREN:
-                      BuildReference(oper);
-                  else
-                    Begin
-                      Message(asmr_e_invalid_reference_syntax);
-                      Consume(actasmtoken);
-                    end;
-                  end; {end case }
-                end;
-              else
-               MaybeBuildReference:=false;
-            end; { end case }
-          end;
-
-
-        function is_fenceflag(hs : string): boolean;
-          var
-            i: longint;
-            flags: TFenceFlags;
-          begin
-            is_fenceflag := false;
-
-            flags:=[];
-            hs:=lower(hs);
-
-            if (actopcode in [A_FENCE]) and (length(hs) >= 1) then
-              begin
-                for i:=1 to length(hs) do
-                  begin
-                    case hs[i] of
-                      'i':
-                        Include(flags,ffi);
-                      'o':
-                        Include(flags,ffo);
-                      'r':
-                        Include(flags,ffr);
-                      'w':
-                        Include(flags,ffw);
-                    else
-                      exit;
-                    end;
-                  end;
-                oper.opr.typ := OPR_FENCEFLAGS;
-                oper.opr.fenceflags := flags;
-                exit(true);
-              end;
-          end;
-
-
-      var
-        tempreg : tregister;
-        hl : tasmlabel;
-        ofs : aint;
-        refaddr: trefaddr;
-        entered_paren: Boolean;
-      Begin
-        expr:='';
-        entered_paren:=false;
-
-        refaddr:=addr_full;
-        if actasmtoken=AS_MOD then
-          begin
-            consume(AS_MOD);
-
-            if actasmtoken<>AS_ID then
-              begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(false);
-              end
-            else
-              begin
-                if lower(actasmpattern)='pcrel_hi' then
-                  refaddr:=addr_pcrel_hi20
-                else if lower(actasmpattern)='pcrel_lo' then
-                  refaddr:=addr_pcrel_lo12
-                else if lower(actasmpattern)='hi' then
-                  refaddr:=addr_hi20
-                else if lower(actasmpattern)='lo' then
-                  refaddr:=addr_lo12
-                else
-                  begin
-                    Message(asmr_e_invalid_reference_syntax);
-                    RecoverConsume(false);
-                  end;
-
-                consume(AS_ID);
-                consume(AS_LPAREN);
-                entered_paren:=true;
-              end;
-          end;
-
-        case actasmtoken of
-          AS_LPAREN: { Memory reference or constant expression }
-            Begin
-              oper.InitRef;
-              BuildReference(oper);
-            end;
-
-          AS_INTNUM,
-          AS_MINUS,
-          AS_PLUS:
-            Begin
-              { Constant memory offset }
-              { This must absolutely be followed by (  }
-              oper.InitRef;
-              oper.opr.ref.offset:=BuildConstExpression(True,False);
-              if actasmtoken<>AS_LPAREN then
-                begin
-                  ofs:=oper.opr.ref.offset;
-                  BuildConstantOperand(oper);
-                  inc(oper.opr.val,ofs);
-                end
-              else
-                BuildReference(oper);
-            end;
-
-          AS_DOT,
-          AS_ID: { A constant expression, or a Variable ref.  }
-            Begin
-              if is_fenceflag(actasmpattern) then
-                begin
-                  consume(AS_ID);
-                end
-              else
-              { Local Label ? }
-              if is_locallabel(actasmpattern) then
-               begin
-                 CreateLocalLabel(actasmpattern,hl,false);
-                 Consume(AS_ID);
-                 AddLabelOperand(hl);
-               end
-              else
-               { Check for label }
-               if SearchLabel(actasmpattern,hl,false) then
-                begin
-                  Consume(AS_ID);
-                  AddLabelOperand(hl);
-                end
-              else
-               { probably a variable or normal expression }
-               { or a procedure (such as in CALL ID)      }
-               Begin
-                 { is it a constant ? }
-                 if SearchIConstant(actasmpattern,l) then
-                  Begin
-                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
-                     Message(asmr_e_invalid_operand_type);
-                    BuildConstantOperand(oper);
-                  end
-                 else
-                  begin
-                    expr:=actasmpattern;
-                    Consume(AS_ID);
-                    { typecasting? }
-                    if (actasmtoken=AS_LPAREN) and
-                       SearchType(expr,typesize) then
-                     begin
-                       oper.hastype:=true;
-                       Consume(AS_LPAREN);
-                       BuildOperand(oper);
-                       Consume(AS_RPAREN);
-                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                         oper.SetSize(typesize,true);
-                     end
-                    else
-                     begin
-                       if oper.SetupVar(expr,false) then
-                         ReadAt(oper)
-                       else
-                        Begin
-                          { look for special symbols ... }
-                          if expr= '__HIGH' then
-                            begin
-                              consume(AS_LPAREN);
-                              if not oper.setupvar('high'+actasmpattern,false) then
-                                Message1(sym_e_unknown_id,'high'+actasmpattern);
-                              consume(AS_ID);
-                              consume(AS_RPAREN);
-                            end
-                          else
-                           if expr = '__RESULT' then
-                            oper.SetUpResult
-                          else
-                           if expr = '__SELF' then
-                            oper.SetupSelf
-                          else
-                           if expr = '__OLDEBP' then
-                            oper.SetupOldEBP
-                          else
-                            Message1(sym_e_unknown_id,expr);
-                        end;
-                     end;
-                  end;
-                  if actasmtoken=AS_DOT then
-                    MaybeRecordOffset;
-                  { add a constant expression? }
-                  if (actasmtoken=AS_PLUS) then
-                   begin
-                     l:=BuildConstExpression(true,entered_paren);
-                     case oper.opr.typ of
-                       OPR_CONSTANT :
-                         inc(oper.opr.val,l);
-                       OPR_LOCAL :
-                         inc(oper.opr.localsymofs,l);
-                       OPR_REFERENCE :
-                         inc(oper.opr.ref.offset,l);
-                       else
-                         internalerror(2003092017);
-                     end;
-                   end
-               end;
-              { Do we have a indexing reference, then parse it also }
-              if actasmtoken=AS_LPAREN then
-                BuildReference(oper);
-            end;
-
-          AS_REGISTER: { Register, a variable reference or a constant reference  }
-            Begin
-              { save the type of register used. }
-              tempreg:=actasmregister;
-              Consume(AS_REGISTER);
-              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
-                  begin
-                    if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
-                      Message(asmr_e_invalid_operand_type);
-                    oper.opr.typ:=OPR_REGISTER;
-                    oper.opr.reg:=tempreg;
-                  end
-              else
-                Message(asmr_e_syn_operand);
-            end;
-          AS_END,
-          AS_SEPARATOR,
-          AS_COMMA: ;
-        else
-          Begin
-            Message(asmr_e_syn_operand);
-            Consume(actasmtoken);
-          end;
-        end; { end case }
-
-        if refaddr<>addr_full then
-          begin
-            if oper.opr.typ<>OPR_REFERENCE then
-              oper.InitRef;
-
-            oper.opr.ref.refaddr:=refaddr;
-            Consume(AS_RPAREN);
-          end
-        else if (oper.opr.typ=OPR_REFERENCE) and
-           (oper.opr.ref.refaddr=addr_no) and
-           assigned(oper.opr.ref.symbol) then
-          oper.opr.ref.refaddr:=addr_full;
-      end;
-
-
-{*****************************************************************************
-                                trv64attreader
-*****************************************************************************}
-
-    procedure trv64attreader.BuildOpCode(instr : trvinstruction);
-      var
-        operandnum : longint;
-      Begin
-        { opcode }
-        if (actasmtoken<>AS_OPCODE) then
-         Begin
-           Message(asmr_e_invalid_or_missing_opcode);
-           RecoverConsume(true);
-           exit;
-         end;
-        { Fill the instr object with the current state }
-        with instr do
-          begin
-            Opcode:=ActOpcode;
-            condition:=ActCondition;
-            ordering:=actmemoryordering;
-          end;
-
-        { We are reading operands, so opcode will be an AS_ID }
-        operandnum:=1;
-        Consume(AS_OPCODE);
-        { Zero operand opcode ?  }
-        if actasmtoken in [AS_SEPARATOR,AS_END] then
-         begin
-           operandnum:=0;
-           exit;
-         end;
-        { Read the operands }
-        repeat
-          case actasmtoken of
-            AS_COMMA: { Operand delimiter }
-              Begin
-                if operandnum>Max_Operands then
-                  Message(asmr_e_too_many_operands)
-                else
-                  begin
-                    { condition operands doesn't set the operand but write to the
-                      condition field of the instruction
-                    }
-                    if instr.Operands[operandnum].opr.typ<>OPR_NONE then
-                      Inc(operandnum);
-                  end;
-                Consume(AS_COMMA);
-              end;
-            AS_SEPARATOR,
-            AS_END : { End of asm operands for this opcode  }
-              begin
-                break;
-              end;
-          else
-            BuildOperand(instr.Operands[operandnum] as trvoperand);
-          end; { end case }
-        until false;
-        if (operandnum=1) and (instr.Operands[operandnum].opr.typ=OPR_NONE) then
-          dec(operandnum);
-        instr.Ops:=operandnum;
-      end;
-
-    function trv64attreader.is_register(const s: string): boolean;
-      type
-        treg2str = record
-          name : string[3];
-          reg : tregister;
-        end;
-
-      const
-        extraregs : array[0..31] of treg2str = (
-          (name: 'A0'; reg : NR_X10),
-          (name: 'A1'; reg : NR_X11),
-          (name: 'A2'; reg : NR_X12),
-          (name: 'A3'; reg : NR_X13),
-          (name: 'A4'; reg : NR_X14),
-          (name: 'A5'; reg : NR_X15),
-          (name: 'A6'; reg : NR_X16),
-          (name: 'A7'; reg : NR_X17),
-          (name: 'RA'; reg : NR_X1),
-          (name: 'SP'; reg : NR_X2),
-          (name: 'GP'; reg : NR_X3),
-          (name: 'TP'; reg : NR_X4),
-          (name: 'T0'; reg : NR_X5),
-          (name: 'T1'; reg : NR_X6),
-          (name: 'T2'; reg : NR_X7),
-          (name: 'S0'; reg : NR_X8),
-          (name: 'FP'; reg : NR_X8),
-          (name: 'S1'; reg : NR_X9),
-          (name: 'S2'; reg : NR_X18),
-          (name: 'S3'; reg : NR_X19),
-          (name: 'S4'; reg : NR_X20),
-          (name: 'S5'; reg : NR_X21),
-          (name: 'S6'; reg : NR_X22),
-          (name: 'S7'; reg : NR_X23),
-          (name: 'S8'; reg : NR_X24),
-          (name: 'S9'; reg : NR_X25),
-          (name: 'S10';reg : NR_X26),
-          (name: 'S11';reg : NR_X27),
-          (name: 'T3'; reg : NR_X28),
-          (name: 'T4'; reg : NR_X29),
-          (name: 'T5'; reg : NR_X30),
-          (name: 'T6'; reg : NR_X31)
-          );
-
-      var
-        i : longint;
-
-      begin
-        result:=inherited is_register(s);
-        { reg found?
-          possible aliases are always 2 char
-        }
-        if result or (not (length(s) in [2,3])) then
-          exit;
-        for i:=low(extraregs) to high(extraregs) do
-          begin
-            if s=extraregs[i].name then
-              begin
-                actasmregister:=extraregs[i].reg;
-                result:=true;
-                actasmtoken:=AS_REGISTER;
-                exit;
-              end;
-          end;
-      end;
-
-
-    function trv64attreader.is_asmopcode(const s: string):boolean;
-      var
-        cond  : tasmcond;
-        hs, postfix : string;
-        l: longint;
-      Begin
-        { making s a value parameter would break other assembler readers }
-        hs:=s;
-        is_asmopcode:=false;
-
-        { clear op code }
-        actopcode:=A_None;
-        { clear condition }
-        fillchar(actcondition,sizeof(actcondition),0);
-
-        { check for direction hint }
-        actopcode := tasmop(ptruint(iasmops.find(hs)));
-        if actopcode <> A_NONE then
-          begin
-            actasmtoken:=AS_OPCODE;
-            is_asmopcode:=true;
-            exit;
-          end;
-        { not found, check branch instructions }
-        if hs[1]='B' then
-          begin
-            { we can search here without an extra table which is sorted by string length
-              because we take the whole remaining string without the leading B }
-            actopcode := A_Bxx;
-            for cond:=low(TAsmCond) to high(TAsmCond) do
-              if copy(hs,2,length(s)-1)=uppercond2str[cond] then
-                begin
-                  actcondition:=cond;
-                  actasmtoken:=AS_OPCODE;
-                  is_asmopcode:=true;
-                  exit;
-                end;
-          end;
-
-        { check atomic instructions }
-        if (pos('AMO',hs)=1) or
-           (pos('LR', hs)=1) or
-           (pos('SC', hs)=1) then
-          begin
-            l := length(hs)-1;
-            while l>1 do
-              begin
-                actopcode := tasmop(ptruint(iasmops.find(copy(hs,1,l))));
-                if actopcode <> A_None then
-                  begin
-                    postfix := copy(hs,l+1,length(hs)-l);
-
-                    if postfix='.AQRL' then actmemoryordering:=[moAq,moRl]
-                    else if postfix='.RL' then actmemoryordering:=[moRl]
-                    else if postfix='.AQ' then actmemoryordering:=[moAq]
-                    else
-                      exit;
-
-                    actasmtoken:=AS_OPCODE;
-                    is_asmopcode:=true;
-                    exit;
-                  end;
-                dec(l);
-              end;
-          end;
-      end;
-
-
-    procedure trv64attreader.handleopcode;
-      var
-        instr : trvinstruction;
-      begin
-        instr:=trvinstruction.Create(trvoperand);
-        BuildOpcode(instr);
-        instr.condition := actcondition;
-        {
-        instr.AddReferenceSizes;
-        instr.SetInstructionOpsize;
-        instr.CheckOperandSizes;
-        }
-        instr.ConcatInstruction(curlist);
-        instr.Free;
-        actmemoryordering:=[];
-      end;
-
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-    const
-      asmmode_rv64_standard_info : tasmmodeinfo =
-              (
-                id    : asmmode_standard;
-                idtxt : 'STANDARD';
-                casmreader : trv64attreader;
-              );
-
-initialization
-  RegisterAsmMode(asmmode_rv64_standard_info);
-end.
-

compiler/x86/aoptx86.pas

@@ -3076,6 +3076,55 @@ unit aoptx86;
             Result:=true;
             exit;
           end;
+
+{$ifdef x86_64}
+        { Convert:
+            movq x(ref),%reg64
+            shrq y,%reg64
+          To:
+            movq x+4(ref),%reg32
+            shrq y-32,%reg32 (Remove if y = 32)
+        }
+        if (taicpu(p).opsize = S_Q) and
+          (taicpu(p).oper[0]^.typ = top_ref) and { Second operand will be a register }
+          (taicpu(p).oper[0]^.ref^.offset <= $7FFFFFFB) and
+          MatchInstruction(hp1, A_SHR, [taicpu(p).opsize]) and
+          MatchOpType(taicpu(hp1), top_const, top_reg) and
+          (taicpu(hp1).oper[0]^.val >= 32) and
+          (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then
+          begin
+            RegName1 := debug_regname(taicpu(hp1).oper[1]^.reg);
+            PreMessage := 'movq ' + debug_operstr(taicpu(p).oper[0]^) + ',' + RegName1 + '; ' +
+              'shrq $' + debug_tostr(taicpu(hp1).oper[0]^.val) + ',' + RegName1 + ' -> movl ';
+
+            { Convert to 32-bit }
+            setsubreg(taicpu(p).oper[1]^.reg, R_SUBD);
+            taicpu(p).opsize := S_L;
+
+            Inc(taicpu(p).oper[0]^.ref^.offset, 4);
+
+            PreMessage := PreMessage + debug_operstr(taicpu(p).oper[0]^) + ',' + debug_regname(taicpu(p).oper[1]^.reg);
+            if (taicpu(hp1).oper[0]^.val = 32) then
+              begin
+                DebugMsg(SPeepholeOptimization + PreMessage + ' (MovShr2Mov)', p);
+                RemoveInstruction(hp1);
+              end
+            else
+              begin
+                { This will potentially open up more arithmetic operations since
+                  the peephole optimizer now has a big hint that only the lower
+                  32 bits are currently in use (and opcodes are smaller in size) }
+                setsubreg(taicpu(hp1).oper[1]^.reg, R_SUBD);
+                taicpu(hp1).opsize := S_L;
+
+                Dec(taicpu(hp1).oper[0]^.val, 32);
+                DebugMsg(SPeepholeOptimization + PreMessage +
+                  '; shrl $' + debug_tostr(taicpu(hp1).oper[0]^.val) + ',' + debug_regname(taicpu(hp1).oper[1]^.reg) + ' (MovShr2MovShr)', p);
+              end;
+            Result := True;
+            Exit;
+          end;
+{$endif x86_64}
       end;
 
 
@@ -7076,19 +7125,26 @@ unit aoptx86;
             movl/q %reg1,%reg2
           To:
             leal/q $-x(%reg1),%reg2
-            subl/q $x,%reg1
+            subl/q $x,%reg1 (can be removed if %reg1 or the flags are not used afterwards)
 
           Breaks the dependency chain and potentially permits the removal of
           a CMP instruction if one follows.
         }
         Result := False;
-        if not (cs_opt_size in current_settings.optimizerswitches) and
-          (taicpu(p).opsize in [S_L{$ifdef x86_64}, S_Q{$endif x86_64}]) and
+        if (taicpu(p).opsize in [S_L{$ifdef x86_64}, S_Q{$endif x86_64}]) and
           MatchOpType(taicpu(p),top_const,top_reg) and
           GetNextInstruction(p, hp1) and
           MatchInstruction(hp1, A_MOV, [taicpu(p).opsize]) and
           (taicpu(hp1).oper[1]^.typ = top_reg) and
-          MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[1]^.reg) then
+          MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[1]^.reg) and
+          (
+            { Don't do SubMov2LeaSub under -Os, but do allow SubMov2Lea }
+            not (cs_opt_size in current_settings.optimizerswitches) or
+            (
+              not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs) and
+              RegUsedAfterInstruction(NR_DEFAULTFLAGS, hp1, TmpUsedRegs)
+            )
+          ) then
           begin
             { Change the MOV instruction to a LEA instruction, and update the
               first operand }
@@ -7100,12 +7156,26 @@ unit aoptx86;
             taicpu(hp1).opcode := A_LEA;
             taicpu(hp1).loadref(0, NewRef);
 
-            { Move what is now the LEA instruction to before the SUB instruction }
-            Asml.Remove(hp1);
-            Asml.InsertBefore(hp1, p);
-            AllocRegBetween(taicpu(hp1).oper[1]^.reg, hp1, p, UsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
+            UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
+            if RegUsedAfterInstruction(NewRef.base, hp1, TmpUsedRegs) or
+              RegUsedAfterInstruction(NR_DEFAULTFLAGS, hp1, TmpUsedRegs) then
+              begin
+                { Move what is now the LEA instruction to before the SUB instruction }
+                Asml.Remove(hp1);
+                Asml.InsertBefore(hp1, p);
+                AllocRegBetween(taicpu(hp1).oper[1]^.reg, hp1, p, UsedRegs);
+
+                DebugMsg(SPeepholeOptimization + 'SubMov2LeaSub', p);
+                p := hp1;
+              end
+            else
+              begin
+                { Since %reg1 or the flags aren't used afterwards, we can delete p completely }
+                RemoveCurrentP(p, hp1);
+                DebugMsg(SPeepholeOptimization + 'SubMov2Lea', p);
+              end;
 
-            DebugMsg(SPeepholeOptimization + 'SubMov2LeaSub', p);
             Result := True;
           end;
       end;

compiler/x86/rgx86.pas

@@ -109,6 +109,14 @@ implementation
        function avx_opcode_only_op0_may_be_memref(opcode : TAsmOp) : boolean;
          begin
            case opcode of
+             A_VMAXPD,
+             A_VMAXPS,
+             A_VMAXSD,
+             A_VMAXSS,
+             A_VMINPD,
+             A_VMINPS,
+             A_VMINSD,
+             A_VMINSS,
              A_VMULSS,
              A_VMULSD,
              A_VSUBSS,
@@ -350,7 +358,15 @@ implementation
                               A_SHUFPD,
                               A_SHUFPS,
                               A_VCOMISD,
-                              A_VCOMISS:
+                              A_VCOMISS,
+                              A_MINSS,
+                              A_MINSD,
+                              A_MINPS,
+                              A_MINPD,
+                              A_MAXSS,
+                              A_MAXSD,
+                              A_MAXPS,
+                              A_MAXPD:
                                 replaceoper:=-1;
 
                               A_IMUL:

packages/fcl-db/src/base/sqlscript.pp

@@ -284,6 +284,7 @@ begin
   FUseDollarString:=AValue;
   RecalcSeps;
 end;
+
 function TCustomSQLScript.GetLine: Integer;
 begin
   Result:=FLine - 1;
@@ -507,6 +508,7 @@ begin
   FIsSkipping:=False;
   FSkipStackIndex:=0;
   Faborted:=False;
+  FLine:=1;
   DefaultDirectives;
   Repeat
     NextStatement();

packages/fcl-passrc/src/pasresolver.pp

@@ -6252,7 +6252,7 @@ procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
       begin
       List.Add(El);
       end;
-    El.AddRef{$IFDEF CheckPasTreeRefCount}aID{$ENDIF};
+    El.AddRef{$IFDEF CheckPasTreeRefCount}(aID){$ENDIF};
     El.Parent:=NewParent;
   end;
 
@@ -29123,20 +29123,23 @@ function TPasResolver.IsTGUID(RecTypeEl: TPasRecordType): boolean;
 var
   Members: TFPList;
   El: TPasElement;
+  i, MemberIndex: Integer;
 begin
   Result:=false;
   if not SameText(RecTypeEl.Name,'TGUID') then exit;
   if SameText(RecTypeEl.GetModule.Name,'system') then exit(true);
   Members:=RecTypeEl.Members;
-  if Members.Count<4 then exit;
-  El:=TPasElement(Members[0]);
-  if not SameText(El.Name,'D1') then exit;
-  El:=TPasElement(Members[1]);
-  if not SameText(El.Name,'D2') then exit;
-  El:=TPasElement(Members[2]);
-  if not SameText(El.Name,'D3') then exit;
-  El:=TPasElement(Members[3]);
-  if not SameText(El.Name,'D4') then exit;
+  i:=1;
+  for MemberIndex:=0 to Members.Count-1 do
+    begin
+    El:=TPasElement(Members[MemberIndex]);
+    if (El.ClassType<>TPasVariable) then continue;
+    if SameText(El.Name,'D'+IntToStr(i)) then
+      begin
+      if i=4 then exit(true);
+      inc(i);
+      end;
+    end;
   Result:=true;
 end;
 

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -262,7 +262,7 @@ type
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
-    procedure UseAttributes(El: TPasElement); virtual;
+    function UseAttributes(El: TPasElement): boolean; virtual;
     function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
     procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
     procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
@@ -1322,12 +1322,13 @@ begin
     UseTypeInfo(El.Parent);
 end;
 
-procedure TPasAnalyzer.UseAttributes(El: TPasElement);
+function TPasAnalyzer.UseAttributes(El: TPasElement): boolean;
 var
   Calls: TPasExprArray;
   i: Integer;
 begin
   Calls:=Resolver.GetAttributeCallsEl(El);
+  Result:=Calls<>nil;
   for i:=0 to length(Calls)-1 do
     UseExpr(Calls[i]);
 end;
@@ -2357,11 +2358,18 @@ begin
     else if IsModuleInternal(Member) then
       // private or strict private
       continue
-    else if (Mode=paumAllPasUsable) and FirstTime
-        and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
+    else if (Mode=paumAllPasUsable) and FirstTime then
       begin
-      // non private property can be used by typeinfo by descendants in other units
-      UseTypeInfo(Member);
+      if Member.ClassType=TPasProperty then
+        begin
+        // non private property can be used by typeinfo by descendants in other units
+        UseTypeInfo(Member);
+        end
+      else if Member is TPasType then
+        begin
+        // non private type can be used by descendants in other units
+        UseType(TPasType(Member),Mode);
+        end
       end
     else
       ; // else: class/record is in unit interface, mark all non private members
@@ -2405,7 +2413,9 @@ begin
         end;
     end;
 
-  UseAttributes(El);
+  if UseAttributes(El) and (El.ClassType=TPasClassType) then
+    UseTypeInfo(El); // class with attributes,
+        // typeinfo can be used at runtime via typeinfo(aClass) -> always mark
 end;
 
 procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);
@@ -2847,7 +2857,7 @@ begin
     begin
     // write without read
     if (vmExternal in El.VarModifiers)
-    or (El.ClassType=TPasProperty)
+        or (El.ClassType=TPasProperty)
         or ((El.Parent is TPasClassType) and TPasClassType(El.Parent).IsExternal) then
       exit;
     if El.Visibility in [visPrivate,visStrictPrivate] then

packages/fcl-passrc/tests/tcresolver.pas

@@ -175,7 +175,7 @@ type
     procedure AddSystemUnit(Parts: TSystemUnitParts = []);
     procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
     procedure StartLibrary(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
-    procedure StartUnit(NeedSystemUnit: boolean);
+    procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
     property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
     property ModuleCount: integer read GetModuleCount;
     property Hub: TPasResolverHub read FHub;
@@ -2345,10 +2345,11 @@ begin
   Add('library '+ExtractFileUnitName(MainFilename)+';');
 end;
 
-procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean);
+procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
 begin
   if NeedSystemUnit then
-    AddSystemUnit
+    AddSystemUnit(SystemUnitParts)
   else
     Parser.ImplicitUses.Clear;
   Add('unit '+ExtractFileUnitName(MainFilename)+';');

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -85,6 +85,7 @@ type
     procedure TestM_Class_PropertyInherited;
     procedure TestM_Class_MethodOverride;
     procedure TestM_Class_MethodOverride2;
+    procedure TestM_Class_NestedClass;
     procedure TestM_ClassInterface_Corba;
     procedure TestM_ClassInterface_NoHintsForMethod;
     procedure TestM_ClassInterface_NoHintsForImpl;
@@ -1321,6 +1322,36 @@ begin
   AnalyzeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestM_Class_NestedClass;
+begin
+  StartUnit(true,[supTObject]);
+  Add([
+  'interface',
+  'type',
+  '  TBird = class',
+  '  public type',
+  '    TWing = class',
+  '    private',
+  '      function GetCurrent: TBird;',
+  '    public',
+  '      function MoveNext: Boolean; reintroduce;',
+  '      property Current: TBird read GetCurrent;',
+  '    end;',
+  '  end;',
+  'implementation',
+  'function TBird.TWing.GetCurrent: TBird;',
+  'begin',
+  '  Result:=nil;',
+  'end;',
+  'function TBird.TWing.MoveNext: Boolean; reintroduce;',
+  'begin',
+  '  Result:=false;',
+  'end;',
+  '']);
+  AnalyzeUnit;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
 begin
   StartProgram(false);

packages/fcl-web/src/base/httpdefs.pp

@@ -2347,7 +2347,7 @@ begin
     if FSecure then
       AddToResult(SCookieSecure);
     if FSameSite<>ssEmpty then
-      AddToResult(SCookieSameSite+': '+SSameSiteValues[FSameSite]);
+      AddToResult(SCookieSameSite+'='+SSameSiteValues[FSameSite]);
   except
 {$ifdef cgidebug}
     On E : Exception do

packages/morphunits/src/amigados.pas

@@ -814,6 +814,24 @@ const
   ST_LINKFILE  = -4;
   ST_PIPEFILE  = -5;
 
+type
+  TCLIDataItem = record
+    cdi_CLINum: LongInt;              // CLI number of the CLI
+    cdi_DefaultStack: LongInt;        // cli_DefaultStack of the CLI
+    cdi_GlobVec: LongInt;             // pr_GlobVec[0] of the CLI
+    cdi_Future: LongWord;             // For future expansion, 0 for now
+    cdi_Pri: ShortInt;                // CLI priority
+    cdi_Flags: Byte;                  // If bit 0 is set cdi_command is valid
+    cdi_Command: array[0..0] of Char; // 0-terminated command being executed
+  end;
+  PCLIDataItem = ^TCLIDataItem;
+
+  TCLIData = record
+    cd_NumCLIs: LongWord; // Number of entries in cd_cli array
+    cd_CLI: array[0..100] of PCLIDataItem; // the entries (could be more than 101 though)
+  end;
+  PCLIData = ^TCLIData;
+
 
 
 { * dos asl definitions
@@ -1297,8 +1315,33 @@ const
   FSCONTEXTINFOTAG_NAME           = FSCONTEXTINFOTAG_Dummy + $1;
 
   SEGLISTTAG_Dummy                = TAG_USER + 3400;
-  // return the ObjData object when it exists or nil.
-  SEGLISTTAG_OBJDATA              = SEGLISTTAG_Dummy + $1;
+
+  SEGLISTTAG_OBJDATA              = SEGLISTTAG_Dummy + $1; // return the ObjData object when it exists or nil.
+  // V51.52
+  SEGLISTTAG_SEGLISTTYPE          = SEGLISTTAG_Dummy + $2; // return the seglist type, one of SEGLISTTYPE_*.
+  SEGLISTTAG_DOS_SEGINDEX         = SEGLISTTAG_Dummy + $3; // specify that segment index is the hunk number, starting from 0.
+  SEGLISTTAG_ELF_SEGINDEX         = SEGLISTTAG_Dummy + $4; // specify that the segment index is the elf segment number, starting from 1.
+  SEGLISTTAG_SEGSTART             = SEGLISTTAG_Dummy + $5; // return segment start address for segment specified by either SEGLISTTAG_DOS_SEGINDEX or SEGLISTTAG_ELF_SEGINDEX.
+                                                           // note that SEGLISTTAG_ELF_SEGINDEX segments might return a nil pointer, so be prepared for this.
+  SEGLISTTAG_SEGSIZE              = SEGLISTTAG_Dummy + $6; // return segment data size for segment specified by either SEGLISTTAG_DOS_SEGINDEX or SEGLISTTAG_ELF_SEGINDEX.
+  // V51.54
+  SEGLISTTAG_ELF_SEGTYPE          = SEGLISTTAG_Dummy + $7; // return ELF segment type (ELF SHT_*). Only applicable for ELF.
+  SEGLISTTAG_ELF_SEGOFFSET        = SEGLISTTAG_Dummy + $8; // return ELF segment file offset. Only applicable for ELF.
+  SEGLISTTAG_ELF_SEGFLAGS         = SEGLISTTAG_Dummy + $9; // return ELF segment flags. Meaning depends on segment type. Refer to ELF documentation for details. Only applicable for ELF.
+  SEGLISTTAG_ELF_SEGADDRALIGN     = SEGLISTTAG_Dummy + $a; // return ELF segment alignment. 0 and 1 mean unaligned. Only applicable for ELF.
+  SEGLISTTAG_ELF_SEGNAME          = SEGLISTTAG_Dummy + $b; // return ELF segname name. Only applicable for ELF.
+
+
+  // for tag SEGLISTTAG_SEGLISTTYPE
+  SEGLISTTYPE_ELF                 = 1;
+  SEGLISTTYPE_POWERUP             = 2;
+  SEGLISTTYPE_AMIGA               = 3;
+
+  // QueryCLIDataTagList tags (V51.51)
+  CLIDATATAG_Dummy = TAG_USER + 3500;
+  CLIDATATAG_CLINumber   = CLIDATATAG_Dummy + $1; // Return only CLI matching the given CLI number (returns 0 or 1 entries)
+  CLIDATATAG_CommandName = CLIDATATAG_Dummy + $2; // Return only CLIs matching the given command (0 to n entries possible)
+  CLIDATATAG_Sorted      = CLIDATATAG_Dummy + $3; // When ti_Data is TRUE, return results sorted by CLI number(default to FALSE)
 
 
 { * dos stdio definitions
@@ -2264,6 +2307,12 @@ function ExNext64(Lock: BPTR; Fib: PFileInfoBlock; Tags: PTagItem): LongInt; sys
 function ExNext64TagList(Lock: BPTR; Fib: PFileInfoBlock; Tags: PTagItem): LongInt; syscall BaseSysV MOS_DOSBase 1150;
 function ExamineFH64(Fh: BPTR; Fib: PFileInfoBlock; Tags: PTagItem): LongInt; syscall BaseSysV MOS_DOSBase 1156;
 function ExamineFH64TagList(Fh: BPTR; Fib: PFileInfoBlock; Tags: PTagItem): LongInt; syscall BaseSysV MOS_DOSBase 1156;
+// V51.51
+procedure ReleaseCLINumber(CLINum: LongInt); syscall BaseSysV MOS_DOSBase 1162;
+function QueryCLIDataTagList(Tags: PTagItem): PCLIData; syscall BaseSysV MOS_DOSBase 1168;
+procedure FreeCLIData(Data: PCLIData); syscall BaseSysV MOS_DOSBase 1174;
+// V51.52
+function GetSegListAttrTagList(SegList: BPTR; Attr: LongInt; Storage: APTR; StorageSize: LongInt; Tags: PTagItem): LongInt; syscall BaseSysV MOS_DOSBase 1180;
 
 
 { * dos global definitions (V50)
@@ -2301,6 +2350,9 @@ function Examine64Tags(Lock: BPTR; Fib: PFileInfoBlock; const Tags: array of Ptr
 function ExNext64Tags(Lock: BPTR; Fib: PFileInfoBlock; const Tags: array of PtrUInt): LongInt; inline;
 function ExamineFH64Tags(Fh: BPTR; Fib: PFileInfoBlock; const Tags: array of PtrUInt): LongInt; inline;
 
+function QueryCLIDataTags(const Tags: array of PtrUInt): PCLIData; inline;
+function GetSegListAttrTags(SegList: BPTR; Attr: LongInt; Storage: APTR; StorageSize: LongInt; const Tags: array of PtrUInt): LongInt; inline;
+
 implementation
 
 
@@ -2406,6 +2458,17 @@ begin
   ExamineFH64Tags := ExamineFH64(Fh, Fib, @Tags);
 end;
 
+function QueryCLIDataTags(const Tags: array of PtrUInt): PCLIData;
+begin
+  QueryCLIDataTags := QueryCLIDataTagList(@Tags);
+end;
+
+function GetSegListAttrTags(SegList: BPTR; Attr: LongInt; Storage: APTR; StorageSize: LongInt; const Tags: array of PtrUInt): LongInt; inline;
+begin
+  GetSegListAttrTags := GetSegListAttrTagList(SegList, Attr, Storage, StorageSize, @Tags);
+end;
+
+
 begin
   DosBase:=MOS_DOSBase;
 end.

packages/morphunits/src/asl.pas

@@ -397,7 +397,7 @@ const
   ASLSM_MaxWidth      = ASL_TB + 117; // Maximum display width to allow
   ASLSM_MinHeight     = ASL_TB + 118; // Minimum display height to allow
   ASLSM_MaxHeight     = ASL_TB + 119; // Maximum display height to allow
-  ASLSM_MinDepth      = ASL_TB + 120; // Minimum display depth
+  //ASLSM_MinDepth      = ASL_TB + 120; // Minimum display depth // obsolete due to a compatibility issue
   ASLSM_MaxDepth      = ASL_TB + 121; // Maximum display depth
   ASLSM_FilterFunc    = ASL_TB + 122; // Function to filter mode id's
 
@@ -406,8 +406,10 @@ const
   ASLSM_PopToFront = ASL_TB + 131; // Make the requester window visible when it opens
   // V45
   ASLSM_Activate = ASL_TB + 132; // Activate the requester window when it opens
+  // V51
+  ASLSM_MinDepth      = ASL_TB + 133; // Minimum display depth
 
-  ASL_LAST_TAG = ASL_TB + 133;
+  ASL_LAST_TAG = ASL_TB + 134;
 
 {***************************************************************************}
 

packages/morphunits/src/exec.pas

@@ -676,11 +676,15 @@ const
   TASKINFOTYPE_USERDATA              = $2b; // Get/Set task tc_UserData (LongWord)
   TASKINFOTYPE_RESURRECT_TASK        = $2c; // Tag used to restart a suspended task (LongWord)
   TASKINFOTYPE_EMULHANDLE            = $2d; // Get/Set task emulhandle (APTR)
+  // Added in exec 50.67
   TASKINFOTYPE_EXCEPTIONCOUNT        = $2e; // Get task exception count (LongWord)
   TASKINFOTYPE_HITCOUNT              = $2f; // Get task hit count (LongWord)
+  // Added in exec 51.3
   TASKINFOTYPE_MAXHITCOUNT           = $30; // Get/Set task max hit count. If more hits happen the task is put to sleep. (LongWord)
+  // Added in exec 51.13
   TASKINFOTYPE_ALERTCOUNT            = $31; // Get task alert count (LongWord)
   TASKINFOTYPE_MAXALERTCOUNT         = $32; // Get/Set task max alert count. If more alerts happen the task is put to sleep. (LongWord)
+  // Added in exec 51.14
   TASKINFOTYPE_PID                   = $33; // Get task unique ID. This ID is unique to every task. (LongWord)
 
   TASKINFOTYPE_68K_NEWFRAME  = $50;
@@ -1747,7 +1751,14 @@ const
   SYSTEMINFOTAG_MEMHEADER = SYSTEMINFOTAG_DUMMY + $1;
   SYSTEMINFOTAG_HOOK      = SYSTEMINFOTAG_DUMMY + $2;
 
+// TLSAlloc (V51.46)
+const
+  TLS_INVALID_INDEX = $ffffffff;
 
+// tags for TLSAlloc
+  TLSTAG_DUMMY = TAG_USER + $120000;
+  TLSTAG_DESTRUCTOR = TLSTAG_DUMMY + $0; // Destructor function to call on task termination if the TLS value is non-nil. The function is called with as: procedure(value: APTR; userdata: APTR);
+  TLSTAG_USERDATA   = TLSTAG_DUMMY + $1;  // Userdata for the destructor function. Defaults to nil.
 
 function Supervisor(userFunction: Pointer location 'a5'): Cardinal;
 SysCall MOS_ExecBase 030;
@@ -2331,6 +2342,14 @@ procedure PutMsgHead(Port: PMsgPort; Message: PMessage); SysCall BaseSysV MOS_Ex
 function NewGetTaskPIDAttrsA(PID: LongWord location 'd0'; Data: APTR location 'a0'; DataSize: LongWord location 'd1'; Type_: LongWord location 'd2'; Tags: PTagItem location 'a1'): LongWord; SysCall MOS_ExecBase 1068;
 function NewSetTaskPIDAttrsA(PID: LongWord location 'd0'; Data: APTR location 'a0'; DataSize: LongWord location 'd1'; Type_: LongWord location 'd2'; Tags: PTagItem location 'a1'): LongWord; SysCall MOS_ExecBase 1074;
 
+// added in V51.46
+function TLSAllocA(Tags: PTagItem): LongWord; SysCall BaseSysV MOS_ExecBase 1084;
+function TLSFree(Idx: LongWord): LongInt; SysCall BaseSysV MOS_ExecBase 1090;
+function TLSGetValue(Idx: LongWord): APTR; SysCall BaseSysV MOS_ExecBase 1096;
+function TLSSetValue(Idx: LongWord; Value: APTR): LongInt; SysCall BaseSysV MOS_ExecBase 1102;
+procedure TLSCallDestructors(Task: PTask); SysCall BaseSysV MOS_ExecBase 1108;
+
+
 
 function NewGetTaskAttrs(Task: PTask; Data: APTR; DataSize, TType: LongWord; const Tags: array of PtrUInt): LongWord; Inline;
 function NewSetTaskAttrs(Task: PTask; Data: APTR; DataSize, TType: Cardinal; const Tags: array of PtrUInt): LongWord; Inline;
@@ -2342,6 +2361,8 @@ function AddExecNode(InNode: APTR; const Tags: array of PtrUInt): APTR; inline;
 function NewGetTaskPIDAttrs(PID: LongWord; Data: APTR; DataSize, Type_: LongWord; const Tags: array of PtrUInt): LongWord; inline;
 function NewSetTaskPIDAttrs(PID: LongWord; Data: APTR; DataSize, Type_: LongWord; const Tags: array of PtrUInt): LongWord; inline;
 
+function TLSAlloc(const Tags: array of PtrUInt): LongWord; inline;
+
 function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
 procedure DeleteExtIO(ioReq: PIORequest);
 
@@ -2392,6 +2413,11 @@ begin
   NewSetTaskPIDAttrs := NewSetTaskPIDAttrsA(PID, Data, DataSize, Type_, @Tags);
 end;
 
+function TLSAlloc(const Tags: array of PtrUInt): LongWord; inline;
+begin
+  TLSAlloc := TLSAllocA(@Tags);
+end;
+
 function GetEmulHandle: PEmulHandle; assembler; nostackframe;
 asm
   mr r3,r2

packages/morphunits/src/intuition.pas

@@ -3336,6 +3336,7 @@ const
   MM_RunBlanker            = $406; // Start screensaver for this monitor
   MM_EnterPowerSaveMode    = $407; // Start power saving mode
   MM_ExitBlanker           = $408; // Stop screensaver or power saving mode
+  MM_Authorization         = $409; // Opens the user password authorization screen, added in 51.68
 
 type
   PmsGetRootBitMap = ^TmsGetRootBitMap;

packages/morphunits/src/locale.pas

@@ -187,6 +187,7 @@ const
   OC_Version         = OC_TagBase + 3; // catalog version number required
   OC_Language        = OC_TagBase + 4; // preferred language of catalog
   OC_CodeSet         = OC_TagBase + 5; // V51
+  OC_BuiltInStrings  = OC_TagBase + 6; // V52.3
 
   // Comparison types for StrnCmp()
   SC_ASCII    = 0;

packages/morphunits/src/workbench.pas

@@ -479,6 +479,10 @@ function MakeWorkbenchObjectVisibleA(Name: STRPTR location 'a0'; const Tags: PTa
 function OpenWorkbenchObjectA(Name: STRPTR location 'a0'; const Tags: PTagItem location 'a1'): LongBool; syscall WorkbenchBase 096;
 function RemoveAppWindowDropZone(Aw: PAppWindow location 'a0'; DropZone: PAppWindowDropZone location 'a1'): LongBool; syscall WorkbenchBase 120;
 function WorkbenchControlA(Name: STRPTR location 'a0'; const Tags: PTagItem location 'a1'): LongBool; syscall WorkbenchBase 108;
+// V51
+function ManageDesktopObjectA(Name: PChar; Action: LongInt; Tags: PTagItem): Boolean; syscall BaseSysV WorkbenchBase 148;
+function CreateDrawerA(Drawer: PChar; Tags: PTagItem): Boolean; syscall BaseSysV WorkbenchBase 154;
+function CreateIconA(Name: PChar; Tags: PTagItem): Boolean; syscall BaseSysV WorkbenchBase 160;
 
 function AddAppIcon(Id: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; Lock: BPTR; DiskObj: PDiskObject; const TagList: array of PtrUInt): PAppIcon; inline;
 function AddAppMenuItem(Id: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; const Tags: array of PtrUInt): PAppMenuItem; inline;
@@ -490,6 +494,10 @@ function WorkbenchControl(Name: PChar; const Tags: array of PtrUInt): LongBool;
 function AddAppWindowDropZone(Aw: PAppWindow; Id: LongWord; UserData: LongWord; const Tags: array of PtrUInt): PAppWindowDropZone; inline;
 function ChangeWorkbenchSelection(Name: STRPTR; Hook: PHook; const Tags: array of PtrUInt): LongBool; inline;
 function MakeWorkbenchObjectVisible(Name: STRPTR; const Tags: array of PtrUInt): LongBool; inline;
+// V51
+function ManageDesktopObjectTags(Name: PChar; Action: LongInt; const Tags: array of PtrUInt): Boolean; inline;
+function CreateDrawerTags(Drawer: PChar; const Tags: array of PtrUInt): Boolean; inline;
+function CreateIconTags(Name: PChar; const Tags: array of PtrUInt): Boolean; inline;
 
 implementation
 
@@ -538,6 +546,21 @@ begin
   MakeWorkbenchObjectVisible := MakeWorkbenchObjectVisibleA(Name, @Tags);
 end;
 
+function ManageDesktopObjectTags(Name: PChar; Action: LongInt; const Tags: array of PtrUInt): Boolean;
+begin
+  ManageDesktopObjectTags := ManageDesktopObjectA(Name, Action, @Tags);
+end;
+
+function CreateDrawerTags(Drawer: PChar; const Tags: array of PtrUInt): Boolean;
+begin
+  CreateDrawerTags := CreateDrawerA(Drawer, @Tags);
+end;
+
+function CreateIconTags(Name: PChar; const Tags: array of PtrUInt): Boolean;
+begin
+  CreateIconTags := CreateIconA(Name, @Tags);
+end;
+
 const
   LIBVERSION: LongWord = 0;
 

packages/os4units/src/intuition.pas

@@ -835,7 +835,7 @@ type
   TIntuiRawKeyData = record
     Version: Word;  // version of this structure (see below)
     Reserved: Word; // always 0, reserved for future use
-    Class: Word;    // copy of ie_SubClass (see IECLASS_EXTENDED_RAWKEY)
+    Class_: Word;    // copy of ie_SubClass (see IECLASS_EXTENDED_RAWKEY)
     Code: Word;     // rawkey code
     DeadKeys: TExtendedDeadKey; // deadkey information
   end;

packages/pastojs/src/fppas2js.pp

@@ -6877,20 +6877,22 @@ function TPas2JSResolver.IsTGUID(TypeEl: TPasRecordType): boolean;
 var
   Members: TFPList;
   El: TPasElement;
+  MemberIndex, i: Integer;
 begin
   Result:=false;
   if not SameText(TypeEl.Name,'TGUID') then exit;
   Members:=TypeEl.Members;
-  if Members.Count<4 then exit;
-  El:=TPasElement(Members[0]);
-  if not SameText(El.Name,'D1') then exit;
-  El:=TPasElement(Members[1]);
-  if not SameText(El.Name,'D2') then exit;
-  El:=TPasElement(Members[2]);
-  if not SameText(El.Name,'D3') then exit;
-  El:=TPasElement(Members[3]);
-  if not SameText(El.Name,'D4') then exit;
-  Result:=true;
+  i:=1;
+  for MemberIndex:=0 to Members.Count-1 do
+    begin
+    El:=TPasElement(Members[MemberIndex]);
+    if (El.ClassType<>TPasVariable) then continue;
+    if SameText(El.Name,'D'+IntToStr(i)) then
+      begin
+      if i=4 then exit(true);
+      inc(i);
+      end;
+    end;
 end;
 
 function TPas2JSResolver.GetAssignGUIDString(TypeEl: TPasRecordType;
@@ -15577,11 +15579,11 @@ begin
     RaiseNotSupported(El,AContext,20170927183645);
   if El.Parent is TProcedureBody then
     RaiseNotSupported(El,AContext,20181231004355);
+  if not aResolver.IsFullySpecialized(El) then exit;
   if El.IsForward then
     exit(ConvertClassForwardType(El,AContext))
   else if El.IsExternal then
     exit(ConvertExtClassType(El,AContext));
-  if not aResolver.IsFullySpecialized(El) then exit;
 
   if El.CustomData is TPas2JSClassScope then
     begin
@@ -20518,34 +20520,51 @@ function TPasToJSConverter.CreateGUIDObjLit(aTGUIDRecord: TPasRecordType;
   const GUID: TGUID; PosEl: TPasElement; AContext: TConvertContext
   ): TJSObjectLiteral;
 var
+  i: integer;
   Members: TFPList;
+
+  function GetMember(const aName: string): TPasElement;
+  begin
+    while i<Members.Count do
+      begin
+      Result:=TPasElement(Members[i]);
+      inc(i);
+      if (Result is TPasVariable) then
+        if SameText(Result.Name,aName) then
+          exit
+        else
+          RaiseInconsistency(20180415094721,PosEl);
+      end;
+    RaiseInconsistency(20210306223031,PosEl);
+  end;
+
+var
   PropEl: TJSObjectLiteralElement;
   MemberEl: TPasElement;
   ArrLit: TJSArrayLiteral;
-  i: Integer;
 begin
   Members:=aTGUIDRecord.Members;
   Result:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,PosEl));
+  i:=0;
+
   // D1: 0x12345678
+  MemberEl:=GetMember('D1');
   PropEl:=Result.Elements.AddElement;
-  MemberEl:=TPasElement(Members[0]);
-  if not SameText(MemberEl.Name,'D1') then
-    RaiseInconsistency(20180415094721,PosEl);
   PropEl.Name:=TJSString(TransformElToJSName(MemberEl,AContext));
   PropEl.Expr:=CreateLiteralHexNumber(PosEl,GUID.D1,8);
   // D2: 0x1234
+  MemberEl:=GetMember('D2');
   PropEl:=Result.Elements.AddElement;
-  MemberEl:=TPasElement(Members[1]);
   PropEl.Name:=TJSString(TransformElToJSName(MemberEl,AContext));
   PropEl.Expr:=CreateLiteralHexNumber(PosEl,GUID.D2,4);
   // D3: 0x1234
+  MemberEl:=GetMember('D3');
   PropEl:=Result.Elements.AddElement;
-  MemberEl:=TPasElement(Members[2]);
   PropEl.Name:=TJSString(TransformElToJSName(MemberEl,AContext));
   PropEl.Expr:=CreateLiteralHexNumber(PosEl,GUID.D3,4);
   // D4: [0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12]
+  MemberEl:=GetMember('D4');
   PropEl:=Result.Elements.AddElement;
-  MemberEl:=TPasElement(Members[3]);
   PropEl.Name:=TJSString(TransformElToJSName(MemberEl,AContext));
   ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,PosEl));
   PropEl.Expr:=ArrLit;

packages/pastojs/tests/tcmodules.pas

@@ -31794,6 +31794,9 @@ begin
   '  [TCustom(1)]',
   '  TMyClass = class',
   '  end;',
+  '  [TCustom(11)]',
+  '  TMyDescendant = class(TMyClass)',
+  '  end;',
   '  [TCustom(2)]',
   '  TRec = record',
   '  end;',
@@ -31826,6 +31829,10 @@ begin
     '  var $r = this.$rtti;',
     '  $r.attr = [$mod.TCustomAttribute, "Create", [1]];',
     '});',
+    'rtl.createClass(this, "TMyDescendant", this.TMyClass, function () {',
+    '  var $r = this.$rtti;',
+    '  $r.attr = [$mod.TCustomAttribute, "Create", [11]];',
+    '});',
     'rtl.recNewT(this, "TRec", function () {',
     '  this.$eq = function (b) {',
     '    return true;',

packages/rtl-extra/src/linux/unxsockh.inc

@@ -13,7 +13,21 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 
-Const
+type
+  Pucred = ^ucred;
+
+  ucred = record
+    pid: cuint32;
+    uid: cuint32;
+    gid: cuint32;
+  end;
+
+const
+
+  SCM_RIGHTS      = $01; { rw: access rights (array of int) }
+  SCM_CREDENTIALS = $02; { rw: struct ucred                 }
+  SCM_SECURITY    = $03; { rw: security label               }
+
 {* Supported address families. *}
   AF_UNSPEC     = 0;
   AF_UNIX       = 1;     { Unix domain sockets          }
@@ -38,14 +52,33 @@ Const
   AF_ASH        = 18;    { Ash                          }
   AF_ECONET     = 19;    { Acorn Econet                 }
   AF_ATMSVC     = 20;    { ATM SVCs                     }
+  AF_RDS        = 21;    { RDS sockets                  }
   AF_SNA        = 22;	 { Linux SNA Project (nutters!) }
   AF_IRDA       = 23;    { IRDA sockets                 }
   AF_PPPOX	= 24;    { PPPoX sockets                }
   AF_WANPIPE    = 25;    { Wanpipe API Sockets }
   AF_LLC        = 26;    { Linux LLC                    }
+  AF_IB         = 27;    { Native InfiniBand address    }
+  AF_MPLS       = 28;	   { MPLS                         }
+  AF_CAN        = 29;    { Controller Area Network      }
   AF_TIPC       = 30;    { TIPC sockets                 }
   AF_BLUETOOTH  = 31;    { Bluetooth sockets            }
-  AF_MAX        = 32;    { For now.. }
+  AF_IUCV       = 32;    { IUCV sockets                 }
+  AF_RXRPC      = 33;    { RxRPC sockets                }
+  AF_ISDN       = 34;    { mISDN sockets                }
+  AF_PHONET     = 35;    { Phonet sockets               }
+  AF_IEEE802154 = 36;    { IEEE802154 sockets           }
+  AF_CAIF       = 37;    { CAIF sockets                 }
+  AF_ALG        = 38;    { Algorithm sockets            }
+  AF_NFC        = 39;    { NFC sockets                  }
+  AF_VSOCK      = 40;    { vSockets                     }
+  AF_KCM        = 41;    { Kernel Connection Multiplexor}
+  AF_QIPCRTR    = 42;    { Qualcomm IPC Router          }
+  AF_SMC        = 43;    { smc sockets: reserve number for
+                           PF_SMC protocol family that
+                           reuses AF_INET address family}
+  AF_XDP        = 44;    { XDP sockets                  }
+  AF_MAX        = 45;    { For now..                    }
   
   SOCK_MAXADDRLEN = 255;             { longest possible addresses }
 
@@ -76,18 +109,35 @@ Const
   PF_ASH        = AF_ASH;
   PF_ECONET     = AF_ECONET;
   PF_ATMSVC     = AF_ATMSVC;
+  PF_RDS        = AF_RDS;
   PF_SNA        = AF_SNA;
   PF_IRDA       = AF_IRDA;
   PF_PPPOX	= AF_PPPOX;
   PF_WANPIPE    = AF_WANPIPE;
   PF_LLC        = AF_LLC;
+  PF_IB         = AF_IB;
+  PF_MPLS       = AF_MPLS;
+  PF_CAN        = AF_CAN;
   PF_TIPC       = AF_TIPC;
   PF_BLUETOOTH  = AF_BLUETOOTH;
+  PF_IUCV       = AF_IUCV;
+  PF_RXRPC      = AF_RXRPC;
+  PF_ISDN       = AF_ISDN;
+  PF_PHONET     = AF_PHONET;
+  PF_IEEE802154 = AF_IEEE802154;
+  PF_CAIF       = AF_CAIF;
+  PF_ALG        = AF_ALG;
+  PF_NFC        = AF_NFC;
+  PF_VSOCK      = AF_VSOCK;
+  PF_KCM        = AF_KCM;
+  PF_QIPCRTR    = AF_QIPCRTR;
+  PF_SMC        = AF_SMC;
+  PF_XDP        = AF_XDP;
   PF_MAX        = AF_MAX;
 
 
 { Maximum queue length specifiable by listen.  }
-  SOMAXCONN     = 128;
+  SOMAXCONN = 4096;
 
 { For setsockoptions(2) }
          SOL_SOCKET  =   1;
@@ -220,7 +270,52 @@ Const
         IP_PMTUDISC_DO          = 2;    { Always DF.  }
 
 { To select the IP level.  }
+{ Setsockoptions(2) level. Thanks to BSD these must match IPPROTO_xxx }
         SOL_IP                  = 0;
+        // SOL_ICMP	  =   1;  { No-no-no! Due to Linux :-) we cannot use SOL_ICMP=1 }
+	      SOL_TCP       =   6;
+	      SOL_UDP       =  17;
+
+{ Socket level values for IPv6.  }
+	      SOL_IPV6      =  41;
+	      SOL_ICMPV6    =  58;
+
+      	SOL_SCTP      = 132;
+	      SOL_UDPLITE   = 136;   { UDP-Lite (RFC 3828) }
+	      SOL_RAW       = 255;
+	      SOL_IPX       = 256;
+	      SOL_AX25      = 257;
+	      SOL_ATALK     = 258;
+	      SOL_NETROM    = 259;
+	      SOL_ROSE      = 260;
+	      SOL_DECNET    = 261;
+	      SOL_X25       = 262;
+	      SOL_PACKET    = 263;
+	      SOL_ATM       = 264;   { ATM layer (cell level) }
+	      SOL_AAL       = 265;   { ATM Adaption Layer (packet level) }
+	      SOL_IRDA      = 266;
+	      SOL_NETBEUI   = 267;
+	      SOL_LLC       = 268;
+	      SOL_DCCP      = 269;
+	      SOL_NETLINK   = 270;
+	      SOL_TIPC      = 271;
+	      SOL_RXRPC     = 272;
+	      SOL_PPPOL2TP  = 273;
+	      SOL_BLUETOOTH = 274;
+	      SOL_PNPIPE    = 275;
+	      SOL_RDS       = 276;
+	      SOL_IUCV      = 277;
+	      SOL_CAIF      = 278;
+	      SOL_ALG       = 279;
+	      SOL_NFC       = 280;
+	      SOL_KCM       = 281;
+	      SOL_TLS       = 282;
+	      SOL_XDP       = 283;
+
+
+{ IPX options }
+        IPX_TYPE = 1;
+
 
         IP_DEFAULT_MULTICAST_TTL = 1;
         IP_DEFAULT_MULTICAST_LOOP = 1;
@@ -274,10 +369,6 @@ Const
         IPV6_PMTUDISC_WANT      = 1;    { Use per route hints.  }
         IPV6_PMTUDISC_DO     = 2;    { Always DF.  }
 
-{ Socket level values for IPv6.  }
-        SOL_IPV6                 = 41;
-        SOL_ICMPV6               = 58;
-
 { Routing header options for IPv6.  }
         IPV6_RTHDR_LOOSE         = 0;   { Hop doesn't need to be neighbour. }
         IPV6_RTHDR_STRICT     = 1;    { Hop must be a neighbour.  }
@@ -285,24 +376,38 @@ Const
         IPV6_RTHDR_TYPE_0        = 0;    { IPv6 Routing header type 0.  }
         
   { Flags for send, recv etc. }
-  MSG_OOB      = $0001;              { Process out-of-band data}
-  MSG_PEEK     = $0002;              { Peek at incoming messages }
-  MSG_DONTROUTE= $0004;              { Don't use local routing }
+  MSG_OOB                = $00000001;              { Process out-of-band data}
+  MSG_PEEK               = $00000002;              { Peek at incoming messages }
+  MSG_DONTROUTE          = $00000004;              { Don't use local routing }
   MSG_TRYHARD  = MSG_DONTROUTE;
-  MSG_CTRUNC   = $0008;              { Control data lost before delivery }
-  MSG_PROXY    = $0010;              { Supply or ask second address }
-  MSG_TRUNC    = $0020;
-  MSG_DONTWAIT = $0040;              { Non-blocking I/O }
-  MSG_EOR      = $0080;              { End of record }
-  MSG_WAITALL  = $0100;              { Wait for a full request }
-  MSG_FIN      = $0200;
-  MSG_SYN      = $0400;
-  MSG_CONFIRM  = $0800;              { Confirm path validity }
-  MSG_RST      = $1000;
-  MSG_ERRQUERE = $2000;              { Fetch message from error queue }
-  MSG_NOSIGNAL = $4000;              { Do not generate SIGPIPE }
-  MSG_MORE     = $8000;              { Sender will send more }
+  MSG_CTRUNC             = $00000008;              { Control data lost before delivery }
+  MSG_PROXY              = $00000010;              { Supply or ask second address }
+  MSG_PROBE              = MSG_PROXY;              { Do not send. Only probe path f.e. for MTU }
+  MSG_TRUNC              = $00000020;
+  MSG_DONTWAIT           = $00000040;              { Non-blocking I/O }
+  MSG_EOR                = $00000080;              { End of record }
+  MSG_WAITALL            = $00000100;              { Wait for a full request }
+  MSG_FIN                = $00000200;
+  MSG_SYN                = $00000400;
+  MSG_CONFIRM            = $00000800;              { Confirm path validity }
+  MSG_RST                = $00001000;
+  MSG_ERRQUERE           = $00002000;              { Fetch message from error queue }
+  MSG_NOSIGNAL           = $00004000;              { Do not generate SIGPIPE }
+  MSG_MORE               = $00008000;              { Sender will send more }
+  MSG_WAITFORONE         = $00010000;              { recvmmsg(): block until 1+ packets avail }
+  MSG_SENDPAGE_NOPOLICY  = $00010000;              { sendpage() internal : do no apply policy }
+  MSG_SENDPAGE_NOTLAST   = $00020000;              { sendpage() internal : not the last page }
+  MSG_BATCH              = $00040000;              { sendmmsg(): more messages coming }
   MSG_EOF      = MSG_FIN;
+  MSG_NO_SHARED_FRAGS    = $00080000;              { sendpage() internal : page frags are not shared }
+  MSG_SENDPAGE_DECRYPTED = $00100000;              { sendpage() internal : page may carry
+                                                     plain text and require encryption }
+  MSG_ZEROCOPY           = $04000000;              { Use user data in kernel path }
+  MSG_FASTOPEN           = $20000000;              { Send data in TCP SYN }
+  MSG_CMSG_CLOEXEC       = $40000000;              { Set close_on_exec for file
+                                                     descriptor received through SCM_RIGHTS }
+  MSG_CMSG_COMPAT        = $0; {$80000000}         { This message would need 32 bit fixups, so use 0 instead }
+
   
      TCP_NODELAY = 1;
   { Limit MSS  }

packages/rtl-objpas/src/inc/fmtbcd.pp

@@ -797,10 +797,12 @@ INTERFACE
 {$endif}
 
   function __get_null : tBCD; Inline;
+  function __get_zero : tBCD; Inline;
   function __get_one : tBCD; Inline;
 
   PROPERTY
     NullBCD : tBCD Read __get_null;
+    ZeroBCD : tBCD Read __get_zero;
     OneBCD : tBCD Read __get_one;
 
 //{$define __lo_bh := 1 * ( -( MaxFmtBCDFractionSize * 1 + 2 ) ) }
@@ -887,16 +889,20 @@ IMPLEMENTATION
     OneBCD_ : tBCD;
 
   function __get_null : tBCD; Inline;
-
     begin
       __get_null := NullBCD_;
-     end;
+    end;
 
-  function __get_one : tBCD; Inline;
+  function __get_zero : tBCD; Inline;
+    begin
+      __get_zero := NullBCD_;
+      __get_zero.Precision := 1;
+    end;
 
+  function __get_one : tBCD; Inline;
     begin
       __get_one := OneBCD_;
-     end;
+    end;
 
   type
     range_digits = 1..maxfmtbcdfractionsize;
@@ -1584,7 +1590,7 @@ IMPLEMENTATION
     begin
       _SELECT
         _WHEN aValue = 0
-          _THEN result := NullBCD;
+          _THEN result := ZeroBCD;
         _WHEN aValue = 1
           _THEN result := OneBCD;
         _WHEN aValue = low ( myInttype )
@@ -4130,12 +4136,6 @@ begin
     else { array or something like that }
         not_implemented;
     end;
-  // peephole, avoids problems with databases, mantis #30853
-  if (Result.Precision = 0) and (Result.SignSpecialPlaces = 0) then 
-    begin
-      Result.Precision := 10;
-      Result.SignSpecialPlaces := 2;
-    end;
 end;
 
 function VarToBCD ( const aValue : Variant ) : tBCD;

packages/rtl-objpas/src/inc/strutils.pp

@@ -1051,7 +1051,7 @@ begin
   if (Length(AText) >= Length(ASubText)) and (ASubText <> '') then
     Result := StrLComp(PChar(ASubText), PChar(AText), Length(ASubText)) = 0
   else
-    Result := False;
+    Result := (AsubText='');
 end;
 
 

rtl/embedded/Makefile

@@ -502,6 +502,11 @@ override FPCOPT+=-Cprv32imac
 CPU_UNITS=fe310g000 fe310g002 gd32vf103xx
 CPU_UNITS_DEFINED=1
 endif
+ifeq ($(SUBARCH),rv32i)
+override FPCOPT+=-Cprv32i
+CPU_UNITS=
+CPU_UNITS_DEFINED=1
+endif
 ifeq ($(CPU_UNITS_DEFINED),)
 $(error No CPUs enabled for given SUBARCH, pass either a SUBARCH or set CPU_UNITS_DEFINED=1 if you know what you are doing)
 endif

rtl/embedded/Makefile.fpc

@@ -207,6 +207,11 @@ override FPCOPT+=-Cprv32imac
 CPU_UNITS=fe310g000 fe310g002 gd32vf103xx
 CPU_UNITS_DEFINED=1
 endif
+ifeq ($(SUBARCH),rv32i)
+override FPCOPT+=-Cprv32i
+CPU_UNITS=
+CPU_UNITS_DEFINED=1
+endif
 ifeq ($(CPU_UNITS_DEFINED),)
 $(error No CPUs enabled for given SUBARCH, pass either a SUBARCH or set CPU_UNITS_DEFINED=1 if you know what you are doing)
 endif
@@ -431,7 +436,7 @@ ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
 
 fpcylix$(PPUEXT) : fpcylix.pp cthreads$(PPUEXT) cwstring$(PPUEXT) dynlibs$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) fpcylix.pp
-	
+
 intrinsics$(PPUEXT) : $(PROCINC)/intrinsics.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(PROCINC)/intrinsics.pp
 
@@ -442,4 +447,4 @@ sortbase$(PPUEXT) : $(INC)/sortbase.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 avrsim$(PPUEXT): $(ARCH)/avrsim.pp heapmgr$(PPUEXT) consoleio$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(ARCH)/avrsim.pp
- 
+

rtl/linux/riscv64/si_c.inc

@@ -22,8 +22,10 @@ var
   BSS_START: record end; external name '__bss_start';
   STACK_PTR: record end; external name '__stkptr';
 
-  libc_init_proc: TProcedure; weakexternal name '_init';
-  libc_fini_proc: TProcedure; weakexternal name '_fini';
+  { as we do not call these procedures directly, calling conventions do not matter and
+    even if we did, we use c calling conventions anyways }
+  procedure __libc_csu_init; external name '__libc_csu_init';
+  procedure __libc_csu_fini; external name '__libc_csu_fini';
 
 procedure libc_start_main(main: TProcedure; argc: ptruint; argv: ppchar; init, fini, rtld_fini: TProcedure; stack_end: pointer); cdecl; external name '__libc_start_main';
 procedure libc_exit(code: ptruint); cdecl; external name 'exit';
@@ -41,7 +43,7 @@ procedure _FPC_rv_enter(at_exit: TProcedure; sp: pptruint);
     operatingsystem_parameter_argv:=argv;
     operatingsystem_parameter_envp:=@sp[argc+2];
 
-    libc_start_main(@PascalMain, argc, argv, libc_init_proc, libc_fini_proc, at_exit, sp);
+    libc_start_main(@PascalMain, argc, argv, @__libc_csu_init, @__libc_csu_fini, at_exit, sp);
   end;
 
 
@@ -51,7 +53,7 @@ procedure _FPC_proc_start; assembler; nostackframe; public name '_start';
     .option push
     .option norelax
 .L1:
-    auipc gp, %pcrel_hi(BSS_START+0x800)
+    auipc gp, %pcrel_hi(BSS_START+0x7f8)
     addi  gp, gp, %pcrel_lo(.L1)
     .option pop
 
@@ -79,3 +81,20 @@ procedure _FPC_proc_haltproc(e:longint); cdecl; public name '_haltproc';
         _FPC_rv_exit(e);
       end;
   end;
+
+
+ procedure initgp; assembler; nostackframe;
+   asm
+   .Linitgp:
+     .option push
+     .option norelax
+   .L1:
+     auipc gp, %pcrel_hi(BSS_START+0x7f8)
+     addi  gp, gp, %pcrel_lo(.L1)
+     .option pop
+     jalr x0, x1
+
+     .section ".preinit_array","aw"
+     .dc.a .Linitgp
+     .text
+ end;

rtl/objpas/sysutils/fina.inc

@@ -381,7 +381,7 @@ end;
 
 Procedure DoDirSeparators (Var FileName : PathStr); {$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif}
 
-VAr I : longint;
+Var I : longint;
 
 begin
   For I:=1 to Length(FileName) do

rtl/riscv32/setjump.inc

@@ -16,11 +16,124 @@
 
 function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;compilerproc;
   asm
-  end;
+    sw ra,   jmp_buf.ra(a0)
+    sw s0,   jmp_buf.s0(a0)
+    sw s1,   jmp_buf.s1(a0)
+    sw s2,   jmp_buf.s2(a0)
+    sw s3,   jmp_buf.s3(a0)
+    sw s4,   jmp_buf.s4(a0)
+    sw s5,   jmp_buf.s5(a0)
+    sw s6,   jmp_buf.s6(a0)
+    sw s7,   jmp_buf.s7(a0)
+    sw s8,   jmp_buf.s8(a0)
+    sw s9,   jmp_buf.s9(a0)
+    sw s10,  jmp_buf.s10(a0)
+    sw s11,  jmp_buf.s11(a0)
+    sw sp,   jmp_buf.sp(a0)
+
+{$if defined(FPUFD) or defined(FPUD)}
+    frcsr t0
+
+    sw t0,   jmp_buf.fcsr(a0)
+
+    fsd f8,  jmp_buf.f8(a0)
+    fsd f9,  jmp_buf.f9(a0)
+    fsd f18, jmp_buf.f18(a0)
+    fsd f19, jmp_buf.f19(a0)
+    fsd f20, jmp_buf.f20(a0)
+    fsd f21, jmp_buf.f21(a0)
+    fsd f22, jmp_buf.f22(a0)
+    fsd f23, jmp_buf.f23(a0)
+    fsd f24, jmp_buf.f24(a0)
+    fsd f25, jmp_buf.f25(a0)
+    fsd f26, jmp_buf.f26(a0)
+    fsd f27, jmp_buf.f27(a0)
+{$endif FPUFD or FPUD}
+{$if defined(FPUF)}
+    frcsr t0
+
+    sw t0,   jmp_buf.fcsr(a0)
+
+    fsw f8,  jmp_buf.f8(a0)
+    fsw f9,  jmp_buf.f9(a0)
+    fsw f18, jmp_buf.f18(a0)
+    fsw f19, jmp_buf.f19(a0)
+    fsw f20, jmp_buf.f20(a0)
+    fsw f21, jmp_buf.f21(a0)
+    fsw f22, jmp_buf.f22(a0)
+    fsw f23, jmp_buf.f23(a0)
+    fsw f24, jmp_buf.f24(a0)
+    fsw f25, jmp_buf.f25(a0)
+    fsw f26, jmp_buf.f26(a0)
+    fsw f27, jmp_buf.f27(a0)
+{$endif FPUF}
+
+    addi x10, x0, 0
+end;
 
 
 procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];compilerproc;
   asm
+    lw ra,  jmp_buf.ra(a0)
+    lw s0,  jmp_buf.s0(a0)
+    lw s1,  jmp_buf.s1(a0)
+    lw s2,  jmp_buf.s2(a0)
+    lw s3,  jmp_buf.s3(a0)
+    lw s4,  jmp_buf.s4(a0)
+    lw s5,  jmp_buf.s5(a0)
+    lw s6,  jmp_buf.s6(a0)
+    lw s7,  jmp_buf.s7(a0)
+    lw s8,  jmp_buf.s8(a0)
+    lw s9,  jmp_buf.s9(a0)
+    lw s10, jmp_buf.s10(a0)
+    lw s11, jmp_buf.s11(a0)
+
+{$if defined(FPUFD) or defined(FPUD)}
+    lw sp,   jmp_buf.fcsr(a0)
+
+    fld f8,  jmp_buf.f8(a0)
+    fld f9,  jmp_buf.f9(a0)
+    fld f18, jmp_buf.f18(a0)
+    fld f19, jmp_buf.f19(a0)
+    fld f20, jmp_buf.f20(a0)
+    fld f21, jmp_buf.f21(a0)
+    fld f22, jmp_buf.f22(a0)
+    fld f23, jmp_buf.f23(a0)
+    fld f24, jmp_buf.f24(a0)
+    fld f25, jmp_buf.f25(a0)
+    fld f26, jmp_buf.f26(a0)
+    fld f27, jmp_buf.f27(a0)
+
+    fscsr sp
+{$endif FPUFD or FPUD}
+{$if defined(FPUF)}
+    lw sp,   jmp_buf.fcsr(a0)
+
+    flw f8,  jmp_buf.f8(a0)
+    flw f9,  jmp_buf.f9(a0)
+    flw f18, jmp_buf.f18(a0)
+    flw f19, jmp_buf.f19(a0)
+    flw f20, jmp_buf.f20(a0)
+    flw f21, jmp_buf.f21(a0)
+    flw f22, jmp_buf.f22(a0)
+    flw f23, jmp_buf.f23(a0)
+    flw f24, jmp_buf.f24(a0)
+    flw f25, jmp_buf.f25(a0)
+    flw f26, jmp_buf.f26(a0)
+    flw f27, jmp_buf.f27(a0)
+
+    fscsr sp
+{$endif FPUF}
+    lw sp, jmp_buf.sp(a0)
+
+    beq a1, x0, .Lone
+    jal x0, .Lzero
+  .Lone:
+    addi a0, x0, 1
+    jal x0, .Lexit
+  .Lzero:
+    addi a0, a1, 0
+  .Lexit:
   end;
 
 

rtl/riscv32/setjumph.inc

@@ -15,11 +15,20 @@
  **********************************************************************}
 
 type
-   jmp_buf = packed record
+   jmp_buf = record
+    ra,s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,sp: dword;
+{$if defined(FPUFD) or defined(FPUD)}
+    fcsr,dummy : dword;
+    f8,f9,f18,f19,f20,f21,
+    f22,f23,f24,f25,f26,f27: qword;
+{$endif FPUFD or FPUD}
+{$if defined(FPUF)}
+    fcsr : dword;
+    f8,f9,f18,f19,f20,f21,
+    f22,f23,f24,f25,f26,f27: longword;
+{$endif FPUF}
    end;
    pjmp_buf = ^jmp_buf;
 
 function setjmp(var S : jmp_buf) : longint;[external name 'FPC_SETJMP'];
 procedure longjmp(var S : jmp_buf;value : longint);[external name 'FPC_LONGJMP'];
-
-

tests/test/cg/obj/readme.txt

@@ -54,7 +54,7 @@ OS/2 (os2-i386): original EMX port of GCC (GCC 2.8.1) except for tcext6.c which
 Data retieved from .comment or similar section:
 beos-i386 : GCC: (GNU) 2.95v.3-beos-060710
 android-arm-eabi : GCC: (GNU) 4.7.A*
-solaris-sparc : .acomp: WorkShop Compilers 4.2 30 Oct 1996 C 4.2
+solaris-sparc : GCC: (GNU) 5.5.0
 linux-arm : GCC: (GNU) 2.95.1 19990816 (release)
 linux-arm-eabi : GCC: (Debian 4.3.2-1) 4.3.2
 linux-powerpc : GCC: (GNU) 2.95.4 20011002 (Debian prerelease)

tests/test/cg/taddbyte.pp

@@ -0,0 +1,345 @@
+{ Program to test Code generator secondadd()                 }
+{ with Byte values                                       }
+{ FUNCTIONAL PRE-REQUISITES:                                 }
+{   - assignments function correctly.                        }
+{   - if statements function correctly.                      }
+{   - subroutine calls function correctly.                   }
+
+procedure fail;
+begin
+  WriteLn('Failed!');
+  halt(1);
+end;
+
+
+procedure ByteTestAdd;
+var
+ i: Byte;
+ j: Byte;
+ result : boolean;
+begin
+ Write('Byte + Byte test...');
+ result := true;
+ i:=0;
+ j:=0;
+ i := i + 100;
+ if i <> 100 then
+  result := false;
+ j := 32;
+ i := i + j;
+ if i <> 132 then
+  result := false;
+ i := i + j + 50;
+ if i <> 214 then
+  result := false;
+ i:=0;
+ j:=10;
+ i:= i + j + j + i + j;
+ if i <> 30 then
+  result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+
+procedure ByteTestSub;
+var
+ i, j, k : Byte;
+ result : boolean;
+begin
+ Write('Byte - Byte test...');
+ result := true;
+ i:=100;
+ j:=4;
+ k:=6;
+ i:= i - 10;
+ if i <> 90 then
+  result := false;
+ i := i - j - k - 11;
+ if i <> 69 then
+  result := false;
+ i:=10;
+ j:=100;
+ k:=10;
+ i:= j - i - k;
+ if i <> 80 then
+  result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+
+procedure ByteTestMul;
+var
+ i : Byte;
+ j : Byte;
+ k: Byte;
+ result: boolean;
+begin
+ Write('Byte * Byte test...');
+ result := true;
+ i:=0;
+ j:=0;
+ i:=i * 32;
+ if i <> 0 then
+   result := false;
+ i:=10;
+ i:=i * 16;
+ if i <> 160 then
+    result := false;
+ j:=10;
+ i:=10;
+ i:=i * j;
+ if i <> 100 then
+    result := false;
+ i:=1;
+ j:=10;
+ k:=16;
+ i := i * j * k;
+ if i <> 160 then
+    result := false;
+ i := 1;
+ j := 2;
+ k := 4;
+ i := i * 2 * j * i * j * 4 * k;
+ if i <> 128 then
+    result := false;
+ i := 50;
+ j := 5;
+ i := i * j;
+ if i <> 250 then
+   result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+procedure ByteTestXor;
+var
+ i, j : Byte;
+ result : boolean;
+begin
+ Write('Byte XOR Byte test...');
+ result := true;
+ i := 0;
+ j := 0;
+ i := i xor $11;
+ if i <> $11 then
+   result := false;
+ i:=0;
+ j:=$11;
+ i:=i xor j;
+ if i <> $11 then
+   result := false;
+
+ i := 0;
+ j := $55;
+ i := i xor j xor $AA;
+ if i <> $FF then
+   result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+
+procedure ByteTestOr;
+var
+ i,j : Byte;
+ result : boolean;
+Begin
+ Write('Byte OR Byte test...');
+ result := true;
+ i := 0;
+ j := 0;
+ i := i or $11;
+ if i <> $11 then
+   result := false;
+ i:=0;
+ j:=$11;
+ i:=i or j;
+ if i <> $11 then
+   result := false;
+
+ i := 0;
+ j := $55;
+ i := i or j or $AA;
+ if i <> $FF then
+   result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+
+
+procedure ByteTestAnd;
+var
+ i,j : Byte;
+ result : boolean;
+Begin
+ Write('Byte AND Byte test...');
+ result := true;
+ i := $11;
+ j := 0;
+ i := i and $11;
+ if i <> $11 then
+   result := false;
+ i:=0;
+ j:=$11;
+ i:=i and j;
+ if i <> 0 then
+   result := false;
+
+ i := $FF;
+ j := $55;
+ i := i and j;
+ if i <> $55 then
+   result := false;
+ i := $FF;
+ i := i and $AA;
+ if i <> $AA then
+   result := false;
+
+ i := 0;
+ j := $55;
+ i := i and j and $AA;
+ if i <> 0 then
+   result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+procedure ByteTestEqual;
+var
+ i,j : Byte;
+ result : boolean;
+Begin
+ Write('Byte = Byte test...');
+ result := true;
+ i := $11;
+ j := 0;
+ if i = 0 then
+   result := false;
+ if i = j then
+  result := false;
+ if j = i then
+  result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+
+procedure ByteTestNotEqual;
+var
+ i,j : Byte;
+ result : boolean;
+Begin
+ Write('Byte <> Byte test...');
+ result := true;
+ i := $11;
+ j := $11;
+ if i <> $11 then
+   result := false;
+ if i <> j then
+  result := false;
+ if j <> i then
+  result := false;
+ if not result then
+  Fail
+ else
+  WriteLn('Success.');
+end;
+
+procedure ByteTestLE;
+var
+ i, j: Byte;
+ result : boolean;
+begin
+{$ifndef tp}
+ Write('Byte <= Byte test...');
+ result := true;
+ i := $FF;
+ j := $FE;
+ if i <= j then
+   result := false;
+ i := $FE;
+ j := $F;
+ if i <= j then
+   result := false;
+ i := $FF;
+ if i <= $FE then
+    result := false;
+ j := $FF;
+ if i <= j then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+  Fail;
+{$endif}
+end;
+
+
+procedure ByteTestGE;
+var
+ i, j: Byte;
+ result : boolean;
+begin
+{$ifndef tp}
+ Write('Byte >= Byte test...');
+ result := true;
+ i := $FE;
+ j := $FF;
+ if i >= j then
+   result := false;
+ i := $FE;
+ j := $FF;
+ if i > j then
+   result := false;
+ i := $FE;
+ if i > $FE then
+    result := false;
+ i := $FF;
+ j := $FF;
+ if i >= j then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+  Fail;
+{$endif}
+end;
+
+
+Begin
+  { These should be tested first, since if they do not }
+  { work, they will false all other results.           }
+  ByteTestEqual;
+  ByteTestNotEqual;
+  ByteTestAdd;
+  ByteTestMul;
+  ByteTestOr;
+  ByteTestAnd;
+  ByteTestXor;
+  ByteTestLe;
+  ByteTestGe;
+  ByteTestSub;
+end.

tests/test/tandorandnot1.pp

@@ -1,34 +1,122 @@
 { test (a and b) or (c and not(b)) into c xor ((c xor a) and b) optimization with random values }
-var
-  i,a,b,c,_a,_b,_c : word;
+procedure test_word;
+  var
+    i,a,b,c,_a,_b,_c : word;
+  begin
+    for i:=1 to 1000 do
+      begin
+        a:=random(65536);
+        _a:=a;
+        b:=random(65536);
+        _b:=b;
+        c:=random(65536);
+        _c:=c;
+        if (a and b) or (c and not(b))<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(1);
+          end;
+        if (a and b) or (not(b) and c)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(1);
+          end;
+        if (not(b) and c) or (a and b)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(1);
+          end;
+        if (not(b) and c) or (b and a)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(1);
+          end;
+      end;
+  end;
+
+procedure test_boolean;
+  var
+    i : word;
+    a,b,c,_a,_b,_c : boolean;
+  begin
+    for i:=1 to 100 do
+      begin
+        a:=boolean(random(2));
+        _a:=a;
+        b:=boolean(random(2));
+        _b:=b;
+        c:=boolean(random(2));
+        _c:=c;
+        if (a and b) or (c and not(b))<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(11);
+          end;
+        if (a and b) or (not(b) and c)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(11);
+          end;
+        if (not(b) and c) or (a and b)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(11);
+          end;
+        if (not(b) and c) or (b and a)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a,'b=',b,'c=',c);
+            halt(11);
+          end;
+      end;
+  end;
+
+
+procedure test_pboolean;
+  var
+    i : word;
+    a,b,c : pboolean;
+    _a,_b,_c : boolean;
+  begin
+    new(a);
+    new(b);
+    for i:=1 to 100 do
+      begin
+        a^:=true;
+        _a:=a^;
+        b^:=true;
+        _b:=b^;
+        c:=nil;  
+        { c should not matter in this case }      
+        _c:=boolean(random(2));
+        if (a^ and b^) or (c^ and not(b^))<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a^,'b=',b^,'c=',c^);
+            halt(21);
+          end;
+        if (a^ and b^) or (not(b^) and c^)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a^,'b=',b^,'c=',c^);
+            halt(21);
+          end;
+        if (not(b^) and c^) or (a^ and b^)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a^,'b=',b^,'c=',c^);
+            halt(21);
+          end;
+        if (not(b^) and c^) or (b^ and a^)<>_c xor ((_c xor _a) and _b) then
+          begin
+            writeln('Error: ','a=',a^,'b=',b^,'c=',c^);
+            halt(21);
+          end;
+      end;
+    dispose(a);
+    dispose(b);
+  end;
+
+
 begin
-  for i:=1 to 1000 do
-    begin
-      a:=random(65536);
-      _a:=a;
-      b:=random(65536);
-      _b:=b;
-      c:=random(65536);
-      _c:=c;
-      if (a and b) or (c and not(b))<>_c xor ((_c xor _a) and _b) then
-        begin
-          writeln('Error: ','a=',a,'b=',b,'c=',c);
-          halt(1);
-        end;
-      if (a and b) or (not(b) and c)<>_c xor ((_c xor _a) and _b) then
-        begin
-          writeln('Error: ','a=',a,'b=',b,'c=',c);
-          halt(1);
-        end;
-      if (not(b) and c) or (a and b)<>_c xor ((_c xor _a) and _b) then
-        begin
-          writeln('Error: ','a=',a,'b=',b,'c=',c);
-          halt(1);
-        end;
-      if (not(b) and c) or (b and a)<>_c xor ((_c xor _a) and _b) then
-        begin
-          writeln('Error: ','a=',a,'b=',b,'c=',c);
-          halt(1);
-        end;
-    end;
+  test_word;
+  test_boolean;
+  test_pboolean;
 end.
+

tests/webtbs/tw38549.pp

@@ -0,0 +1,226 @@
+type
+
+{$ifdef SET_39}
+  {$define SET_31}
+{$endif}
+{$ifdef SET_31}
+  {$define SET_25}
+{$endif}
+{$ifdef SET_25}
+  {$define SET_23}
+{$endif}
+{$ifdef SET_23}
+  {$define SET_17}
+{$endif}
+{$ifdef SET_17}
+  {$define SET_15}
+{$endif}
+{$ifdef SET_15}
+  {$define SET_9}
+{$endif}
+
+  { options for symtables }
+  tsymtableoption = (
+    sto_has_helper,       { contains at least one helper symbol }
+    sto_has_generic,      { contains at least one generic symbol }
+    sto_has_operator,     { contains at least one operator overload }
+    sto_needs_init_final, { the symtable needs initialization and/or
+                            finalization of variables/constants }
+    sto_has_non_trivial_init, { contains at least on managed type that is not
+                               initialized to zero (e.g. a record with management
+                               operators }
+    sto_above
+{$ifdef SET_9}
+    ,sto_6
+    ,sto_7
+    ,sto_8
+    ,sto_9
+{$endif}
+{$ifdef SET_15}
+    ,sto_10
+    ,sto_11
+    ,sto_12
+    ,sto_13
+    ,sto_14
+    ,sto_15
+{$endif}
+{$ifdef SET_17}
+    ,sto_16
+    ,sto_17
+{$endif}
+{$ifdef SET_23}
+    ,sto_18
+    ,sto_19
+    ,sto_20
+    ,sto_21
+    ,sto_22
+    ,sto_23
+{$endif}
+{$ifdef SET_25}
+    ,sto_24
+    ,sto_25
+{$endif}
+{$ifdef SET_31}
+    ,sto_26
+    ,sto_27
+    ,sto_28
+    ,sto_29
+    ,sto_30
+    ,sto_31
+{$endif}
+{$ifdef SET_39}
+    ,sto_32
+    ,sto_33
+    ,sto_34
+    ,sto_35
+    ,sto_36
+    ,sto_37
+    ,sto_38
+    ,sto_39
+{$endif}
+  );
+  tsymtableoptions = set of tsymtableoption;
+
+const
+  ok_count : longint = 0;
+  error_count : longint = 0;
+
+procedure add_error;
+begin
+  writeln('New error');
+  inc(error_count);
+end; 
+
+procedure test(tableoptions : tsymtableoptions; expected : boolean);
+begin
+ if [sto_needs_init_final,sto_has_non_trivial_init] <= tableoptions then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end;
+ if tableoptions >= [sto_needs_init_final,sto_has_non_trivial_init] then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+end;
+
+procedure test2(tableoptions1, tableoptions2 : tsymtableoptions; expected : boolean);
+begin
+ if tableoptions1 <= tableoptions2 then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+end;
+
+var
+  tableoptions1, tableoptions2 : tsymtableoptions;
+
+begin
+  tableoptions1:=[];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_has_helper];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_has_non_trivial_init];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init,sto_above];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_has_non_trivial_init,sto_above];
+  test(tableoptions1,false);
+
+  tableoptions1:=[];
+  tableoptions2:=[];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,true);
+
+  tableoptions2:=[sto_has_helper];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_has_helper];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+  test2(tableoptions1,tableoptions1,true);
+  test2(tableoptions2,tableoptions2,true);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_above];
+  test2(tableoptions1,tableoptions2,false);
+  test2(tableoptions2,tableoptions1,false);
+
+  writeln('Test for sets of size : ',sizeof(tableoptions1));
+  if error_count > 0 then
+    begin
+      writeln(error_count,' test(s) failed');
+      writeln(ok_count,' test(s) OK');
+      halt(1);
+    end
+  else
+    writeln('Test OK: ',ok_count);
+end.
+

tests/webtbs/tw38549a.pp

@@ -0,0 +1,5 @@
+
+{$packset 1}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549b.pp

@@ -0,0 +1,5 @@
+
+{$packset 2}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549c.pp

@@ -0,0 +1,5 @@
+
+{$packset 4}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549d.pp

@@ -0,0 +1,5 @@
+
+{$packset 8}
+
+{$i tw38549.pp}
+