Write real atomic operations, and add memory barrier operations.

Add support for fence, and acquire/release syntax to assembler reader.
Fix broken register aliases.

git-svn-id: branches/laksen/riscv_new@39524 -

compiler/aasmtai.pas

@@ -262,6 +262,9 @@ interface
        ,top_para
        ,top_asmlist
 {$endif llvm}
+{$if defined(riscv32) or defined(riscv64)}
+       ,top_fenceflags
+{$endif defined(riscv32) or defined(riscv64)}
        );
 
       { kinds of operations that an instruction can perform on an operand }
@@ -463,6 +466,9 @@ interface
             top_para   : (paras: tfplist);
             top_asmlist : (asmlist: tasmlist);
         {$endif llvm}
+        {$if defined(riscv32) or defined(riscv64)}
+            top_fenceflags : (fenceflags : TFenceFlags);
+        {$endif defined(riscv32) or defined(riscv64)}
         end;
         poper=^toper;
 

compiler/raatt.pas

@@ -330,6 +330,22 @@ unit raatt;
                end;
            end;
 {$endif aarch64}
+{$if defined(riscv32) or defined(riscv64)}
+           {
+             amo* instructions contain a postfix with size, and optionally memory ordering
+             fence* can contain memory type identifier
+             floating point instructions contain size, and optionally rounding mode
+           }
+           case c of
+             '.':
+               begin
+                 repeat
+                   actasmpattern:=actasmpattern+c;
+                   c:=current_scanner.asmgetchar;
+                 until not(c in ['a'..'z','A'..'Z','.']);
+               end;
+           end;
+{$endif riscv}
            { Opcode ? }
            If is_asmopcode(upper(actasmpattern)) then
             Begin

compiler/rautils.pas

@@ -45,7 +45,7 @@ type
   TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
             OPR_REFERENCE,OPR_REGISTER,OPR_COND,OPR_REGSET,
             OPR_SHIFTEROP,OPR_MODEFLAGS,OPR_SPECIALREG,
-            OPR_REGPAIR);
+            OPR_REGPAIR,OPR_FENCEFLAGS);
 
   TOprRec = record
     case typ:TOprType of
@@ -81,6 +81,9 @@ type
 {$ifdef aarch64}
       OPR_SHIFTEROP : (shifterop : tshifterop);
       OPR_COND      : (cc : tasmcond);
+{$endif aarch64}
+{$if defined(riscv32) or defined(riscv64)}
+      OPR_FENCEFLAGS: (fenceflags : TFenceFlags);
 {$endif aarch64}
   end;
 
@@ -1295,6 +1298,10 @@ end;
              OPR_COND:
                ai.loadconditioncode(i-1,cc);
 {$endif arm or aarch64}
+{$if defined(riscv32) or defined(riscv64)}
+             OPR_FENCEFLAGS:
+               ai.loadfenceflags(i-1,fenceflags);
+{$endif riscv32 or riscv64}
               { ignore wrong operand }
               OPR_NONE:
                 ;

compiler/riscv/aasmcpu.pas

@@ -39,6 +39,7 @@ uses
 
     type
       taicpu = class(tai_cpu_abstract_sym)
+         memoryordering: TMemoryOrdering;
          constructor op_none(op : tasmop);
 
          constructor op_reg(op : tasmop;_op1 : tregister);
@@ -81,6 +82,7 @@ uses
          constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : aint);
          constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:aint;const _op2 : treference);
 
+         procedure loadfenceflags(opidx:aint;_flags:TFenceFlags);
          procedure loadbool(opidx:aint;_b:boolean);
 
          function is_same_reg_move(regtype: Tregistertype):boolean; override;
@@ -386,6 +388,19 @@ uses cutils, cclasses;
       end;
 
 
+    procedure taicpu.loadfenceflags(opidx: aint; _flags: TFenceFlags);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_fenceflags then
+             clearop(opidx);
+           fenceflags:=_flags;
+           typ:=top_fenceflags;
+         end;
+      end;
+
+
 { ****************************** newra stuff *************************** }
 
     function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;

compiler/riscv/agrvgas.pas

@@ -167,6 +167,14 @@ unit agrvgas;
             end
           else
             getopstr:=getreferencestring(asminfo,o.ref^);
+        top_fenceflags:
+          begin
+            getopstr:='';
+            if ffI in o.fenceflags then getopstr:=getopstr+'i';
+            if ffO in o.fenceflags then getopstr:=getopstr+'o';
+            if ffR in o.fenceflags then getopstr:=getopstr+'r';
+            if ffW in o.fenceflags then getopstr:=getopstr+'w';
+          end
         else
           internalerror(2002070604);
       end;
@@ -184,6 +192,13 @@ unit agrvgas;
       if taicpu(hp).condition<>C_None then
         s:=s+cond2str[taicpu(hp).condition];
 
+      if taicpu(hp).memoryordering<>[] then
+        begin
+          s:=s+'.';
+          if moAq in taicpu(hp).memoryordering then s:=s+'aq';
+          if moRl in taicpu(hp).memoryordering then s:=s+'rl';
+        end;
+
       if taicpu(hp).ops<>0 then
         begin
           sep:=#9;

compiler/riscv64/cpubase.pas

@@ -160,6 +160,16 @@ type
         {$i rrv32dwa.inc}
       );
 
+{*****************************************************************************
+                                Operands
+*****************************************************************************}
+    type
+      TMemoryOrderingFlag = (moRl, moAq);
+      TMemoryOrdering = set of TMemoryOrderingFlag;
+
+      TFenceFlag = (ffI, ffO, ffR, ffW);
+      TFenceFlags = set of TFenceFlag;
+
 {*****************************************************************************
                                 Conditions
 *****************************************************************************}

compiler/riscv64/rarv.pas

@@ -34,9 +34,17 @@ type
   end;
 
   TRVInstruction = class(TInstruction)
+    ordering: TMemoryOrdering;
+    function ConcatInstruction(p: TAsmList): tai; override;
   end;
 
 implementation
 
+  function TRVInstruction.ConcatInstruction(p: TAsmList): tai;
+    begin
+      Result:=inherited ConcatInstruction(p);
+      (result as taicpu).memoryordering:=ordering;
+    end;
+
 end.
 

compiler/riscv64/rarv64gas.pas

@@ -26,10 +26,12 @@ unit rarv64gas;
   interface
 
     uses
-      raatt, rarv;
+      raatt, rarv,
+      cpubase;
 
     type
       trv64attreader = class(tattreader)
+        actmemoryordering: TMemoryOrdering;
         function is_register(const s: string): boolean; override;
         function is_asmopcode(const s: string):boolean;override;
         procedure handleopcode;override;
@@ -49,7 +51,7 @@ unit rarv64gas;
       globtype,globals,verbose,
       systems,
       { aasm }
-      cpubase,aasmbase,aasmtai,aasmdata,aasmcpu,
+      aasmbase,aasmtai,aasmdata,aasmcpu,
       { symtable }
       symconst,symsym,symdef,
       { parser }
@@ -372,6 +374,40 @@ unit rarv64gas;
           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;
@@ -438,6 +474,11 @@ unit rarv64gas;
 
           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
@@ -586,6 +627,7 @@ unit rarv64gas;
           begin
             Opcode:=ActOpcode;
             condition:=ActCondition;
+            ordering:=actmemoryordering;
           end;
 
         { We are reading operands, so opcode will be an AS_ID }
@@ -641,10 +683,10 @@ unit rarv64gas;
           (name: 'A1'; reg : NR_X11),
           (name: 'A2'; reg : NR_X12),
           (name: 'A3'; reg : NR_X13),
-          (name: 'A5'; reg : NR_X14),
-          (name: 'A6'; reg : NR_X15),
-          (name: 'A7'; reg : NR_X16),
-          (name: 'A8'; reg : NR_X17),
+          (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),
@@ -697,8 +739,8 @@ unit rarv64gas;
     function trv64attreader.is_asmopcode(const s: string):boolean;
       var
         cond  : tasmcond;
-        hs : string;
-
+        hs, postfix : string;
+        l: longint;
       Begin
         { making s a value parameter would break other assembler readers }
         hs:=s;
@@ -732,6 +774,33 @@ unit rarv64gas;
                   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;
 
 
@@ -749,6 +818,7 @@ unit rarv64gas;
         }
         instr.ConcatInstruction(curlist);
         instr.Free;
+        actmemoryordering:=[];
       end;
 
 

rtl/riscv64/riscv64.inc

@@ -44,81 +44,209 @@ function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;
 
 
 {$define FPC_SYSTEM_HAS_SPTR}
-Function Sptr : pointer;assembler;
+Function Sptr : pointer;assembler;nostackframe;
   asm
     addi a0, sp, 0
   end;
 
 
-function InterLockedDecrement (var Target: longint) : longint;
-  begin
-    dec(Target);
-    Result:=Target;
+function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    addi a1, x0, -1
+    amoadd.w a0, a1, (a0)
+    addw a0, a0, a1
+{$else CPURV_HAS_ATOMIC}
+    lw a1, 0(a0)
+    addiw a1, a1, -1
+    sw a1, 0(a0)
+    addi a0, a1, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterLockedIncrement (var Target: longint) : longint;
-  begin
-    inc(Target);
-    Result:=Target;
+function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    addi a1, x0, 1
+    amoadd.w a0, a1, (a0)
+    addw a0, a0, a1
+{$else CPURV_HAS_ATOMIC}
+    lw a1, 0(a0)
+    addiw a1, a1, 1
+    sw a1, 0(a0)
+    addi a0, a1, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterLockedExchange (var Target: longint;Source : longint) : longint;
-  begin
-    Result:=Target;
-    Target:=Source;
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    amoswap.w a0, a1, (a0)
+{$else CPURV_HAS_ATOMIC}
+    lw a2, 0(a0)
+    sw a1, 0(a0)
+    addi a0, a2
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;
-  begin
-    Result:=Target;
-    if Target=Comperand then
-      Target:=NewValue;
+function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+  .LLoop:
+    lr.w a3, 0(a0)
+    bne a3, a2, .LFail
+    sc.w a4, a1, 0(a0)
+    bne a4, x0, .LLoop
+  .LFail:
+    addi a0, a3, 0
+{$else CPURV_HAS_ATOMIC}
+    lw a3, 0(a0)
+    bne a3, a2, .LFail
+    sw a1, 0(a0)
+  .LFail:
+    addi a0, a3, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
-  begin
-    Result:=Target;
-    inc(Target,Source);
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    amoadd.w a0, a1, (a0)
+{$else CPURV_HAS_ATOMIC}
+    lw a2, 0(a0)
+    addiw a2, a2, a1
+    sw a2, 0(a0)
+    addi a0, a2, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
 
-function InterLockedDecrement64 (var Target: int64) : int64;
-  begin
-    dec(Target);
-    Result:=Target;
+function InterLockedDecrement64 (var Target: int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    addi a1, x0, -1
+    amoadd.d a0, a1, (a0)
+    add a0, a0, a1
+{$else CPURV_HAS_ATOMIC}
+    ld a1, 0(a0)
+    addi a1, a1, -1
+    sd a1, 0(a0)
+    addi a0, a1, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterLockedIncrement64 (var Target: int64) : int64;
-  begin
-    inc(Target);
-    Result:=Target;
+function InterLockedIncrement64 (var Target: int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    addi a1, x0, 1
+    amoadd.d a0, a1, (a0)
+    add a0, a0, a1
+{$else CPURV_HAS_ATOMIC}
+    ld a1, 0(a0)
+    addi a1, a1, 1
+    sd a1, 0(a0)
+    addi a0, a1, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterLockedExchange64 (var Target: int64;Source : int64) : int64;
-  begin
-    Result:=Target;
-    Target:=Source;
+function InterLockedExchange64 (var Target: int64;Source : int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    amoswap.d a0, a1, (a0)
+{$else CPURV_HAS_ATOMIC}
+    ld a2, 0(a0)
+    sd a1, 0(a0)
+    addi a0, a2
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterlockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64;
-  begin
-    Result:=Target;
-    if Target=Comperand then
-      Target:=NewValue;
+function InterlockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+  .LLoop:
+    lr.d a3, 0(a0)
+    bne a3, a2, .LFail
+    sc.d a4, a1, 0(a0)
+    bne a4, x0, .LLoop
+  .LFail:
+    addi a0, a3, 0
+{$else CPURV_HAS_ATOMIC}
+    ld a3, 0(a0)
+    bne a3, a2, .LFail
+    sd a1, 0(a0)
+  .LFail:
+    addi a0, a3, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
 
-function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64;
-  begin
-    Result:=Target;
-    inc(Target,Source);
+function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPURV_HAS_ATOMIC}
+    amoadd.d a0, a1, (a0)
+{$else CPURV_HAS_ATOMIC}
+    ld a2, 0(a0)
+    addi a2, a2, a1
+    sd a2, 0(a0)
+    addi a0, a2, 0
+{$endif CPURV_HAS_ATOMIC}
   end;
 
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+  function declocked(var l: longint) : boolean; inline;
+  begin
+    Result:=InterLockedDecrement(l) = 0;
+  end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+  procedure inclocked(var l: longint); inline;
+  begin
+    InterLockedIncrement(l);
+  end;
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_INT64}
+function declocked(var l:int64):boolean;
+  begin
+    Result:=InterLockedDecrement64(l) = 0;
+  end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_INT64}
+procedure inclocked(var l:int64);
+  begin
+    InterLockedIncrement64(l);
+  end;
+
+
+{$define FPC_SYSTEM_HAS_MEM_BARRIER}
+
+procedure ReadBarrier; assembler; nostackframe;
+  asm
+    fence ir, ir
+  end;
+
+
+procedure ReadDependencyBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+  end;
+
+procedure ReadWriteBarrier; assembler; nostackframe;
+  asm
+    fence iorw, iorw
+  end;
+
+procedure WriteBarrier; assembler; nostackframe;
+  asm
+    fence ow, ow
+  end;