* synchronized with trunk

git-svn-id: branches/z80@44754 -

.gitattributes

@@ -15306,7 +15306,9 @@ tests/test/toperator85.pp svneol=native#text/pascal
 tests/test/toperator86.pp svneol=native#text/pascal
 tests/test/toperator87.pp svneol=native#text/pascal
 tests/test/toperator88.pp svneol=native#text/pascal
+tests/test/toperator89.pp svneol=native#text/pascal
 tests/test/toperator9.pp svneol=native#text/pascal
+tests/test/toperator90.pp svneol=native#text/pascal
 tests/test/toperatorerror.pp svneol=native#text/plain
 tests/test/tover1.pp svneol=native#text/plain
 tests/test/tover2.pp svneol=native#text/plain

compiler/aarch64/aoptcpu.pas

@@ -376,6 +376,8 @@ Implementation
               Result:=OptPass1Data(p);
             A_UXTB:
               Result:=OptPass1UXTB(p);
+            A_UXTH:
+              Result:=OptPass1UXTH(p);
             A_SXTB:
               Result:=OptPass1SXTB(p);
             A_SXTH:

compiler/avr/cgcpu.pas

@@ -730,7 +730,7 @@ unit cgcpu;
                      if not(size in [OS_8,OS_S8]) then
                        begin
                          list.concat(taicpu.op_none(A_CLC));
-                         list.concat(taicpu.op_reg_const(A_SBRC,src,0));
+                         list.concat(taicpu.op_reg_const(A_SBRC,dst,0));
                          list.concat(taicpu.op_none(A_SEC));
                        end;
                      list.concat(taicpu.op_reg(A_ROR,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)));

compiler/htypechk.pas

@@ -618,6 +618,7 @@ implementation
         i : longint;
         eq : tequaltype;
         conv : tconverttype;
+        cdo : tcompare_defs_options;
         pd : tprocdef;
         oldcount,
         count: longint;
@@ -663,7 +664,10 @@ implementation
                 { assignment is a special case }
                 if optoken in [_ASSIGNMENT,_OP_EXPLICIT] then
                   begin
-                    eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,[cdo_explicit]);
+                    cdo:=[];
+                    if optoken=_OP_EXPLICIT then
+                      include(cdo,cdo_explicit);
+                    eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,cdo);
                     result:=
                       (eq=te_exact) or
                       (

compiler/scanner.pas

@@ -1106,7 +1106,7 @@ type
 
   function texprvalue.evaluate(v:texprvalue;op:ttoken):texprvalue;
 
-    function check_compatbile: boolean;
+    function check_compatible: boolean;
       begin
         result:=(
                   (is_ordinal(v.def) or is_fpu(v.def)) and
@@ -1200,7 +1200,7 @@ type
             end;
         end;
         _EQ,_NE,_LT,_GT,_GTE,_LTE,_PLUS,_MINUS,_STAR,_SLASH,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR:
-        if check_compatbile then
+        if check_compatible then
           begin
             if (is_ordinal(def) and is_ordinal(v.def)) then
               begin

compiler/sparc64/tgcpu.pas

@@ -20,7 +20,7 @@
  ****************************************************************************
 }
 {
-  This unit handles the temporary variables stuff for i8086.
+  This unit handles the temporary variables stuff for sparc64.
 }
 unit tgcpu;
 

rtl/amicommon/athreads.pp

@@ -40,11 +40,13 @@ uses
 {$include doslibf.inc}
 
 {$ifdef cpum68k}
-{$if defined(amiga_v1_0_only) or defined(amiga_v1_2_only)}
+{$if defined(amiga_v1_0_only) or defined(amiga_v1_2_only) or defined(amiga_v2_0_only)}
 {$include legacyexech.inc}
+{$if not defined(amiga_v2_0_only)}
 {$include legacydosh.inc}
 {$endif}
 {$endif}
+{$endif}
 
 {$ENDIF}
 

rtl/amicommon/dos.pp

@@ -1081,40 +1081,40 @@ Var
   Res: Integer;
 begin
   SetLength(EnvList, 0);
+
+{$if not defined(AMIGA_V1_0_ONLY) and not defined(AMIGA_V1_2_ONLY)}
   // pr_LocalVars are introduced with OS2.0
-  {$ifdef AMIGA68k}
-  if PLibrary(AOS_ExecBase)^.lib_Version >= 36 then
-  {$endif}
+
+  ThisProcess := PProcess(FindTask(nil));  //Get the pointer to our process
+  LocalVars_List := @(ThisProcess^.pr_LocalVars);  //get the list of pr_LocalVars as pointer
+  LocalVar_Node  := pLocalVar(LocalVars_List^.mlh_head); //get the headnode of the LocalVars list
+
+  // loop through the localvar list
+  while ( Pointer(LocalVar_Node^.lv_node.ln_Succ) <> Pointer(LocalVars_List^.mlh_Tail)) do
   begin
-    ThisProcess := PProcess(FindTask(nil));  //Get the pointer to our process
-    LocalVars_List := @(ThisProcess^.pr_LocalVars);  //get the list of pr_LocalVars as pointer
-    LocalVar_Node  := pLocalVar(LocalVars_List^.mlh_head); //get the headnode of the LocalVars list
+    // make sure the active node is valid instead of empty
+    If not(LocalVar_Node <> nil) then
+      break;
 
-    // loop through the localvar list
-    while ( Pointer(LocalVar_Node^.lv_node.ln_Succ) <> Pointer(LocalVars_List^.mlh_Tail)) do
+    { - process the current node - }
+    If (LocalVar_Node^.lv_node.ln_Type = LV_Var) then
     begin
-      // make sure the active node is valid instead of empty
-      If not(LocalVar_Node <> nil) then
-        break;
+      FillChar(Buffer[0], Length(Buffer), #0); // clear Buffer
 
-      { - process the current node - }
-      If (LocalVar_Node^.lv_node.ln_Type = LV_Var) then
+      // get active node's name environment variable value ino buffer and make sure it's local
+      TempLen := GetVar(LocalVar_Node^.lv_Node.ln_Name, @Buffer[0], BUFFER_SIZE, GVF_LOCAL_ONLY);
+      If TempLen <> -1 then
       begin
-        FillChar(Buffer[0], Length(Buffer), #0); // clear Buffer
-
-        // get active node's name environment variable value ino buffer and make sure it's local
-        TempLen := GetVar(LocalVar_Node^.lv_Node.ln_Name, @Buffer[0], BUFFER_SIZE, GVF_LOCAL_ONLY);
-        If TempLen <> -1 then
-        begin
-          SetLength(EnvList, Length(EnvList) + 1);
-          EnvList[High(EnvList)].Name := LocalVar_Node^.lv_Node.ln_Name;
-          EnvList[High(EnvList)].Value := string(PChar(@Buffer[0]));
-          EnvList[High(EnvList)].Local := True;
-        end;
+        SetLength(EnvList, Length(EnvList) + 1);
+        EnvList[High(EnvList)].Name := LocalVar_Node^.lv_Node.ln_Name;
+        EnvList[High(EnvList)].Value := string(PChar(@Buffer[0]));
+        EnvList[High(EnvList)].Local := True;
       end;
-      LocalVar_Node := pLocalVar(LocalVar_Node^.lv_node.ln_Succ); //we need to get the next node
     end;
+    LocalVar_Node := pLocalVar(LocalVar_Node^.lv_node.ln_Succ); //we need to get the next node
   end;
+{$endif not defined(AMIGA_V1_0_ONLY) and not defined(AMIGA_V1_2_ONLY)}
+
   // search in env for all Variables
   FillChar(Anchor,sizeof(TAnchorPath),#0);
   Res := MatchFirst('ENV:#?', @Anchor);

rtl/amicommon/sysos.inc

@@ -32,12 +32,14 @@
 {$include doslibf.inc}
 
 {$ifdef cpum68k}
-{$if defined(amiga_v1_0_only) or defined(amiga_v1_2_only)}
+{$if defined(amiga_v1_0_only) or defined(amiga_v1_2_only) or defined(amiga_v2_0_only)}
 {$include legacyexec.inc}
+{$if not defined(amiga_v2_0_only)}
 {$include legacydos.inc}
 {$include legacyutil.inc}
 {$endif}
 {$endif}
+{$endif}
 
 {*****************************************************************************
                              CPU specific

rtl/amiga/m68k/legacydos.inc

@@ -23,10 +23,100 @@
 }
 
 
+procedure NextTag(var Tag: PTagItem); inline;
+begin
+  if Tag^.ti_Tag = TAG_END then
+    Exit;
+  Inc(Tag);
+  repeat
+    case Tag^.ti_Tag of
+      TAG_IGNORE: Inc(Tag);
+      TAG_SKIP: Inc(Tag, Tag^.ti_Data);
+      TAG_MORE: Tag := PTagItem(Tag^.ti_Data);
+      else
+        Break;
+    end;
+  until False;
+end;
+
+{$PACKRECORDS 2}
+type
+  TAmigaLegacyFakeSegList = record
+    length: DWord;
+    next: DWord;
+    jump: Word;
+    entry: Pointer;
+    pad: Word;
+  end;
+{$PACKRECORDS DEFAULT}
+
+var
+  __amiga_fake_seglist: TAmigaLegacyFakeSegList;
+  __amiga_fake_seglist_lock: TSignalSemaphore;
+  __amiga_fake_seglist_lock_inited: boolean = false;
+
 function CreateNewProc(tags: PTagItem): PProcess; public name '_fpc_amiga_createproc';
+var
+  seglistbptr: dword;
+  name: pchar;
+  entryfunc: pointer;
+  stacksize: dword;
+  m: pmsgport;
+  tag: ptagitem;
 begin
-{$warning CreateNewProc unimplemented!}
   CreateNewProc:=nil;
+
+  entryfunc:=nil;
+  stacksize:=4000;
+  name:='New Process';
+
+  tag := Tags;
+  if Assigned(tag) then
+  begin
+    repeat
+      case Tag^.ti_Tag of
+        NP_Entry: entryfunc := Pointer(Tag^.ti_Data);
+        NP_StackSize: stacksize := Tag^.ti_Data;
+      end;
+      NextTag(Tag);
+    until tag^.ti_Tag = TAG_END;
+  end;
+
+  if entryfunc = nil then
+    exit;
+
+  { This is a gigantic hack, and probably only works, because AThreads will always
+    feed the same function pointer in here (i.e. starts the same function multiple
+    times, which is a wrapper for FPC threads), and also waits for the subprocess
+    to properly start before trying to start a new one, but just in case, lets
+    still have proper-ish locking here, in case one spawns a subthread from a
+    subthread... (KB) }
+
+  if not __amiga_fake_seglist_lock_inited then
+    begin
+      InitSemaphore(@__amiga_fake_seglist_lock);
+      __amiga_fake_seglist_lock_inited:=true;
+    end;
+
+  ObtainSemaphore(@__amiga_fake_seglist_lock);
+
+  with __amiga_fake_seglist do
+    begin
+      length:=16;
+      next:=0;
+      jump:=$4ef9; { JMP }
+      entry:=entryfunc;
+      pad:=$4e71; { NOP }
+    end;
+
+  seglistbptr:=ptruint(@__amiga_fake_seglist) shr 2;
+  m:=CreateProc(name, 0, seglistbptr, stacksize);
+  if m <> nil then
+    { CreateProc returns the MsgPort inside the process structure.
+      recalculate to the address of the process instead... *yuck* (KB) }
+    CreateNewProc:=PProcess(pointer(m)-ptruint(@PProcess(nil)^.pr_MsgPort));
+
+  ReleaseSemaphore(@__amiga_fake_seglist_lock);
 end;
 
 function NameFromLock(lock  : LongInt;
@@ -258,22 +348,6 @@ begin
   end;
 end;
 
-procedure NextTag(var Tag: PTagItem); inline;
-begin
-  if Tag^.ti_Tag = TAG_END then
-    Exit;
-  Inc(Tag);
-  repeat
-    case Tag^.ti_Tag of
-      TAG_IGNORE: Inc(Tag);
-      TAG_SKIP: Inc(Tag, Tag^.ti_Data);
-      TAG_MORE: Tag := PTagItem(Tag^.ti_Data);
-      else
-        Break;
-    end;
-  until False;
-end;
-
 // we emulate that by the old execute command, should be enough for most cases
 function SystemTagList(command: PChar;
                        tags   : PTagItem): LongInt; public name '_fpc_amiga_systemtaglist';

tests/test/toperator89.pp

@@ -0,0 +1,16 @@
+{ %NORUN }
+
+program toperator89;
+
+{$mode objfpc}{$H+}
+
+{ overloading the implicit assignment is allowed }
+
+operator := (aArg: LongInt): Boolean;
+begin
+  Result := aArg <> 0;
+end;
+
+begin
+
+end.

tests/test/toperator90.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+program toperator90;
+
+{$mode objfpc}{$H+}
+
+{ overloading the explicit assignment is NOT allowed }
+
+operator Explicit (aArg: LongInt): Boolean;
+begin
+  Result := aArg <> 0;
+end;
+
+begin
+
+end.