Merge branch source:main into main

packages/ide/fpswitch.pas

@@ -239,7 +239,7 @@ const
       opt_allowmmxoperations = 'Allow MMX operations';
 
       opt_mode_freepascal = 'Free Pascal dialect';
-      opt_mode_objectpascal = 'Object Pascal extension on';
+      opt_mode_objectpascal = 'Object Pascal extension';
       opt_mode_turbopascal = 'Turbo Pascal compatible';
       opt_mode_delphi = 'Delphi compatible';
       opt_mode_delphiunicode = 'Delphi Unicode';
@@ -269,9 +269,11 @@ const
       opt_generatesmallercode = 'G~e~nerate smaller code';
       opt_useregistervariables = 'Use regis~t~er-variables';
       opt_uncertainoptimizations = '~U~ncertain optimizations';
+      opt_disableoptimizations = '~D~isable optimizations';
       opt_level1optimizations = 'Level ~1~ optimizations';
       opt_level2optimizations = 'Level ~2~ optimizations';
       opt_level3optimizations = 'Level ~3~ optimizations';
+      opt_level4optimizations = 'Level ~4~ optimizations';
       { optimization processor target }
       opt_i386486 = 'i~3~86/i486';
       opt_pentium = 'P~e~ntium (tm)';
@@ -1010,11 +1012,15 @@ var
   s : string;
   res : boolean;
   OldSwitchesMode,i : TSwitchMode;
+  oFileMode : byte;
 begin
+  oFileMode:=FileMode;   {save file open mode}
+  FileMode:=0;           {Reset will open file in read only mode }
   assign(CfgFile,fn);
   {$I-}
    reset(CfgFile);
   {$I+}
+  FileMode:=oFileMode;   {restore file open mode}
   if ioresult<>0 then
    begin
      SetDefaultSwitches;
@@ -1061,7 +1067,12 @@ begin
        'T' : res:=TargetSwitches^.ReadItemsCfg(s);
        'v' : res:=VerboseSwitches^.ReadItemsCfg(s);
        'X' : begin
-               res:=LibLinkerSwitches^.ReadItemsCfg(s);
+               { This is workaround. ReadItemsCfg do UpCase to S
+                   and our -Xs got lost because there are -XS as well.  M. }
+               if (s = 's') then   { -Xs defined }
+                 res:=OtherLinkerSwitches^.ReadItemsCfg(s);
+               if not res then
+                 res:=LibLinkerSwitches^.ReadItemsCfg(s);
                if not res then
                  res:=OtherLinkerSwitches^.ReadItemsCfg(s);
              end;
@@ -1264,12 +1275,16 @@ begin
   with OptimizationSwitches^ do
    begin
      AddBooleanItem(opt_generatesmallercode,'s',idNone);
+{$if defined(I386) or defined(x86_64) or defined(i8086)}
 {$ifdef I386}
      AddBooleanItem(opt_useregistervariables,'oregvar',idNone);
      AddBooleanItem(opt_uncertainoptimizations,'ouncertain',idNone);
+{$endif}
+     AddBooleanItem(opt_disableoptimizations,'-',idNone);
      AddBooleanItem(opt_level1optimizations,'1',idNone);
      AddBooleanItem(opt_level2optimizations,'2',idNone);
      AddBooleanItem(opt_level3optimizations,'3',idNone);
+     AddBooleanItem(opt_level4optimizations,'4',idNone);
 {$else not I386}
  {$ifdef m68k}
      AddBooleanItem(opt_level1optimizations,'a',idNone);

packages/ide/wini.pas

@@ -437,12 +437,16 @@ var f: text;
     S,TS: string;
     P: PINISection;
     I: integer;
+    oFileMode : byte;
 begin
   New(P, Init(MainSectionName));
   Sections^.Insert(P);
+  oFileMode:=FileMode;   {save file open mode}
+  FileMode:=0;           {Reset will open file in read only mode }
   Assign(f,FileName^);
 {$I-}
   Reset(f);
+  FileMode:=oFileMode;   {restore file open mode}
   OK:=EatIO=0;
   while OK and (Eof(f)=false) do
     begin

packages/rtl-console/src/go32v2/mouse.pp

@@ -80,6 +80,9 @@ const
   oldmousey : longint = -1;
   mouselock : boolean = false;
 
+  { mouse wheel scroll up or down }
+  MouseButton_4_5 = MouseButton4 or MouseButton5;
+
 {$ASMMODE ATT}
 { if the cursor is drawn by this the unit, we must be careful }
 { when drawing while the interrupt handler is called          }
@@ -176,13 +179,30 @@ asm
 .Lmouse_nocursor:
         cmpb    MouseEventBufSize,PendingMouseEvents
         je      .Lmouse_exit
+        leal    PendingMouseEvent,%eax
+
+        movl    PendingMouseTail,%edi
+        cmpl    %eax,%edi
+        jne     .Lmouse_tail_with_offset
+        addl    MouseEventBufSize*8,%edi
+.Lmouse_tail_with_offset:
+        subl    $8,%edi { previous event }
+        cmpw    %bx,(%edi)
+        jne     .Lmouse_add_event
+        cmpw    %cx,2(%edi)
+        jne     .Lmouse_add_event
+        cmpw    %dx,4(%edi)
+        jne     .Lmouse_add_event
+        testb   MouseButton_4_5, %bl
+        jne     .Lmouse_add_event
+        jmp     .Lmouse_exit  { mouse event isn't uniq, don't add it }
+.Lmouse_add_event:
         movl    PendingMouseTail,%edi
         movw    %bx,(%edi)
         movw    %cx,2(%edi)
         movw    %dx,4(%edi)
         movw    $0,6(%edi)
         addl    $8,%edi
-        leal    PendingMouseEvent,%eax
         addl    MouseEventBufSize*8,%eax
         cmpl    %eax,%edi
         jne     .Lmouse_nowrap
@@ -558,8 +578,14 @@ begin
     Mouse_Action($ffff, @MouseInt);                    { Set masks/interrupt }
   drawmousecursor:=false;
   CustomMouse_MouseIsVisible:=false;
+  {
   if (screenwidth>80) or (screenheight>50) then
     DoCustomMouse(true);
+  }
+  {
+  if (screenwidth=132){ or (screenheight>50)} then
+    DoCustomMouse(true);
+  }
   ShowMouse;
 end;
 
@@ -603,8 +629,8 @@ begin
           Dec(CustomMouse_HideCount);
         if (CustomMouse_HideCount=0) and not(CustomMouse_MouseIsVisible) then
           begin
-             oldmousex:=getmousex-1;
-             oldmousey:=getmousey-1;
+             oldmousex:=getmousex{-1};
+             oldmousey:=getmousey{-1};
              mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
                mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
              CustomMouse_MouseIsVisible:=true;
@@ -734,6 +760,10 @@ asm
         movw    y,%dx
         shll    $3,%ecx {character based convert to pixels: x * 8}
         shll    $3,%edx {character based convert to pixels: y * 8}
+        cmpw    $40,ScreenWidth
+        jne     .Lmorethan40cols
+        shll    $1,%ecx
+.Lmorethan40cols:
         movl    $4,%eax
         pushl   %ebp
         int     $0x33

packages/rtl-console/src/msdos/mouse.pp

@@ -61,6 +61,9 @@ const
   oldmousey : smallint = -1;
   mouselock : boolean = false;
 
+  { mouse wheel scroll up or down }
+  MouseButton_4_5 = MouseButton4 or MouseButton5;
+
 { if the cursor is drawn by this the unit, we must be careful }
 { when drawing while the interrupt handler is called          }
 procedure lockmouse;assembler;
@@ -193,6 +196,36 @@ asm
 @@mouse_nocursor:
         cmp     PendingMouseEvents, MouseEventBufSize
         je      @@mouse_exit
+        lea     ax, PendingMouseEvent
+{$if defined(FPC_MM_COMPACT) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)}
+        les     di, [PendingMouseTail]
+{$else}
+        mov     di, PendingMouseTail
+{$endif}
+        cmp     di, ax
+        jne     @@Lmouse_tail_with_offset
+        add     di, MouseEventBufSize*8
+@@Lmouse_tail_with_offset:
+        sub     di, 8 { previous event }
+{$if defined(FPC_MM_COMPACT) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)}
+        cmp     word ptr es:[di], bx
+        jne     @@mouse_add_event
+        cmp     word ptr es:[di+2], cx
+        jne     @@mouse_add_event
+        cmp     word ptr es:[di+4], dx
+{$else}
+        cmp     word ptr [di], bx
+        jne     @@mouse_add_event
+        cmp     word ptr [di+2], cx
+        jne     @@mouse_add_event
+        cmp     word ptr [di+4], dx
+{$endif}
+        jne     @@mouse_add_event
+        test    bl, MouseButton_4_5
+        jne     @@mouse_add_event
+        jmp     @@mouse_exit  { mouse event isn't uniq, don't add it }
+
+@@mouse_add_event:
 {$if defined(FPC_MM_COMPACT) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)}
         les     di, [PendingMouseTail]
         mov     word ptr es:[di], bx
@@ -207,7 +240,6 @@ asm
         mov     word ptr [di+6], 0
 {$endif}
         add     di, 8
-        lea     ax, PendingMouseEvent
         add     ax, MouseEventBufSize*8
         cmp     di, ax
         jne     @@mouse_nowrap
@@ -308,7 +340,7 @@ begin
     Mouse_Action($ffff, @MouseInt);                    { Set masks/interrupt }
   drawmousecursor:=false;
   CustomMouse_MouseIsVisible:=false;
-  if (screenwidth>80) or (screenheight>50) then
+  if (screenwidth=132){ or (screenheight>50)} then
     DoCustomMouse(true);
   ShowMouse;
 end;
@@ -349,8 +381,8 @@ begin
           Dec(CustomMouse_HideCount);
         if (CustomMouse_HideCount=0) and not(CustomMouse_MouseIsVisible) then
           begin
-             oldmousex:=getmousex-1;
-             oldmousey:=getmousey-1;
+             oldmousex:=getmousex{-1};
+             oldmousey:=getmousey{-1};
 
              mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
                mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
@@ -488,6 +520,16 @@ asm
         shl     dx, 1 {character based convert to pixels: y * 8}
         shl     dx, 1
         shl     dx, 1
+{$ifdef FPC_MM_HUGE}
+        mov     ax, SEG ScreenWidth
+        mov     es, ax
+        cmp     es:[ScreenWidth], 40
+{$else}
+        cmp     ScreenWidth, 40
+{$endif}
+        jne     @@morethan40cols
+        shl     cx, 1
+@@morethan40cols:
         mov     ax, 4
         push    bp
         int     33h

rtl/README.txt

@@ -21,7 +21,7 @@ The tree contains subdirectories for all the supported operating systems,
 as well as all processor architectures. The processor directories contain
 low-level routines which are required for the system unit (if they are not
 available in high-level language form), as well as optimized versions of
-the pascal generic routines (the generic routine source code is localed in
+the pascal generic routines (the generic routine source code is localized in
 the inc subdirectory).
 
 Enjoy.

rtl/aix/termios.inc

@@ -476,7 +476,7 @@ const
   VDISCRD = 12;
   VWERSE = 13;
   VLNEXT = 14;
-{ 5.4 compatability  }
+{ 5.4 compatibility  }
   VSTRT = VSTART;
 
 const

rtl/beos/tthread.inc

@@ -291,7 +291,7 @@ end;
   A thread is created using BeginThread, which in turn calls
   pthread_create. So the threads here are always posix threads.
   Posix doesn't define anything for suspending threads as this is
-  inherintly unsafe. Just don't suspend threads at points they cannot
+  inherently unsafe. Just don't suspend threads at points they cannot
   control. Therefore, I didn't implement .Suspend() if its called from
   outside the threads execution flow (except on Linux _without_ NPTL).
 

rtl/beos/unxfunc.inc

@@ -50,7 +50,7 @@ Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_
 {
   Sets up a pair of file variables, which act as a pipe. The first one can
   be read from, the second one can be written to.
-  If the operation was unsuccesful, linuxerror is set.
+  If the operation was unsuccessful, linuxerror is set.
 }
 var
   ret  : longint;

rtl/embedded/avr/at90pwm216.pp

@@ -336,7 +336,7 @@ const
   AMP1TS = 0; //
   // UCSRA
   RXC = 7; // USART Receive Complete
-  TXC = 6; // USART Transmitt Complete
+  TXC = 6; // USART Transmit Complete
   UDRE = 5; // USART Data Register Empty
   FE = 4; // Framing Error
   DOR = 3; // Data Overrun

rtl/embedded/avr/at90pwm2b.pp

@@ -336,7 +336,7 @@ const
   AMP1TS = 0; //
   // UCSRA
   RXC = 7; // USART Receive Complete
-  TXC = 6; // USART Transmitt Complete
+  TXC = 6; // USART Transmit Complete
   UDRE = 5; // USART Data Register Empty
   FE = 4; // Framing Error
   DOR = 3; // Data Overrun

rtl/embedded/avr/at90pwm316.pp

@@ -363,7 +363,7 @@ const
   AMP1TS = 0; //
   // UCSRA
   RXC = 7; // USART Receive Complete
-  TXC = 6; // USART Transmitt Complete
+  TXC = 6; // USART Transmit Complete
   UDRE = 5; // USART Data Register Empty
   FE = 4; // Framing Error
   DOR = 3; // Data Overrun

rtl/embedded/avr/at90pwm3b.pp

@@ -363,7 +363,7 @@ const
   AMP1TS = 0; //
   // UCSRA
   RXC = 7; // USART Receive Complete
-  TXC = 6; // USART Transmitt Complete
+  TXC = 6; // USART Transmit Complete
   UDRE = 5; // USART Data Register Empty
   FE = 4; // Framing Error
   DOR = 3; // Data Overrun

rtl/embedded/avr/atmega16hvb.pp

@@ -172,7 +172,7 @@ const
   // CADCSRB
   CADACIE = 6; //
   CADRCIE = 5; // Regular Current Interrupt Enable
-  CADICIE = 4; // CAD Instantenous Current Interrupt Enable
+  CADICIE = 4; // CAD Instantaneous Current Interrupt Enable
   CADACIF = 2; // CC-ADC Accumulate Current Interrupt Flag
   CADRCIF = 1; // CC-ADC Accumulate Current Interrupt Flag
   CADICIF = 0; // CC-ADC Instantaneous Current Interrupt Flag

rtl/embedded/avr/atmega32hvb.pp

@@ -172,7 +172,7 @@ const
   // CADCSRB
   CADACIE = 6; //
   CADRCIE = 5; // Regular Current Interrupt Enable
-  CADICIE = 4; // CAD Instantenous Current Interrupt Enable
+  CADICIE = 4; // CAD Instantaneous Current Interrupt Enable
   CADACIF = 2; // CC-ADC Accumulate Current Interrupt Flag
   CADRCIF = 1; // CC-ADC Accumulate Current Interrupt Flag
   CADICIF = 0; // CC-ADC Instantaneous Current Interrupt Flag

rtl/embedded/avr/atmega64hve2.pp

@@ -227,8 +227,8 @@ const
   WUTIF = $07;
   // Watchdog Timer Configuration Lock Register
   WDCLE = $00;
-  WDCL0 = $01;  // Watchdog Timer Comfiguration Lock bits
-  WDCL1 = $02;  // Watchdog Timer Comfiguration Lock bits
+  WDCL0 = $01;  // Watchdog Timer Configuration Lock bits
+  WDCL1 = $02;  // Watchdog Timer Configuration Lock bits
   // Power Reduction Register 0
   PRTIM0 = $00;
   PRTIM1 = $01;

rtl/embedded/avr/attiny2313.pp

@@ -129,7 +129,7 @@ const
   PCIF = 5; //
   // UCSRA
   RXC = 7; // USART Receive Complete
-  TXC = 6; // USART Transmitt Complete
+  TXC = 6; // USART Transmit Complete
   UDRE = 5; // USART Data Register Empty
   FE = 4; // Framing Error
   DOR = 3; // Data overRun

rtl/embedded/riscv32/gd32vf103xx.pp

@@ -15,7 +15,7 @@ type
     CLIC_BWEI_IRQn      = 17,    // Bus Error interrupt
     CLIC_PMOVI_IRQn     = 18,    // Performance Monitor
 
-    // interruput numbers
+    // interrupt numbers
     WWDGT_IRQn          = 19,    // window watchDog timer interrupt
     LVD_IRQn            = 20,    // LVD through EXTI line detect interrupt
     TAMPER_IRQn         = 21,    // tamper through EXTI line detect

rtl/haiku/unxfunc.inc

@@ -50,7 +50,7 @@ Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_
 {
   Sets up a pair of file variables, which act as a pipe. The first one can
   be read from, the second one can be written to.
-  If the operation was unsuccesful, linuxerror is set.
+  If the operation was unsuccessful, linuxerror is set.
 }
 var
   ret  : longint;

rtl/inc/cgeneric.inc

@@ -41,7 +41,7 @@ Procedure FillChar(var x;count: sizeint;value:byte);{$ifdef SYSTEMINLINE}inline;
 begin
   { don't exit if count is <= 0, this makes the compiler think x is uninitialized,
     as FillChar is probably rarely called with count <= 0, the performance hit is
-    probably neglible }
+    probably negligible }
   if count < 0 then
     count := 0;
   memset(x,value,size_t(count));

rtl/inc/osheap.inc

@@ -15,7 +15,7 @@
 
 {
   The OS heap manager is a small heap manager for smaller targets with an
-  operating system. It's similar in comcept to the "cmem" memory manager
+  operating system. It's similar in concept to the "cmem" memory manager
   for systems with libc support, but it aims systems that have a direct
   heap management API (Sinclair QL, AmigaOS, MacOS Classic, some
   embedded systems, etc), but not necessarily libc. It's also designed

rtl/netbsd/ptypes.inc

@@ -170,7 +170,7 @@ struct statfs12 {
     end;
    pmbstate_t = ^mbstate_t;
 
-{ records transcripted fromm NetBSD 5.1 libpthread sources }
+{ records transcribed fromm NetBSD 5.1 libpthread sources }
    pthread_t            = pointer;
    pthread_attr_t       = record
      pta_magic : cuint;

rtl/os2/doscall2.pas

@@ -845,7 +845,7 @@ DosGetProcessorStatus allows checking status of individual processors
 in a SMP machine.
 
 Parameters:
-ProcID = Procesor ID numbered 1 through n, where there are n processors in
+ProcID = Processor ID numbered 1 through n, where there are n processors in
          total.
 Status = Returned processor status defined as follows:
   PROC_OFFLINE 0x00000000 Processor is offline

rtl/ps1/psy-q-sdk/libsnd.pas

@@ -65,7 +65,7 @@ const
 
 // Vag & Vab Structure
 type
-	VabHdr = packed record			// VAB Bank Headdings
+	VabHdr = packed record			// VAB Bank Headings
 		form : longint;          	// always 'VABp'
 		ver : longint;           	// VAB file version number
 		id : longint;            	// VAB id

rtl/unix/sysdir.inc

@@ -61,7 +61,7 @@ End;
 // !! on special filesystems like NFS etc.
 // !! In the libc versions, the alt code is already integrated in the libc code.
 // !! Also significantly boosted buffersize. This will make failure of the
-// !! dos legacy api's better visibile due to cut-off path, instead of "empty"
+// !! dos legacy api's better visible due to cut-off path, instead of "empty"
 
 
 procedure do_getdir(drivenr : byte;var dir : rawbytestring);

rtl/unix/unixutil.pp

@@ -12,7 +12,7 @@
 
     The routines are fairly OS independent but can't move to
     OS independent because the lowlevel units baseunix/unix depend
-    on them. If they need to be generally accessable, copy these
+    on them. If they need to be generally accessible, copy these
     functions to a general purpose, OS independent, supportable unit.
 
     See the file COPYING.FPC, included in this distribution,

rtl/win16/win31.pp

@@ -978,7 +978,7 @@ function GetMessageExtraInfo: LPARAM; external 'USER';
 function GetQueueStatus(flags: UINT): DWORD; external 'USER';
 
 { Window class management }
-{ in Windows 3.1+, RegisterClass returns an ATOM that unquely identifies the
+{ in Windows 3.1+, RegisterClass returns an ATOM that uniquely identifies the
   class. In Windows 3.0 and earlier, the return value is BOOL. That's why we
   redefine this function in the win31 unit. }
 function RegisterClass(lpwc: LPWNDCLASS): ATOM; external 'USER';

rtl/win16/winprocsh.inc

@@ -792,7 +792,7 @@ procedure PostQuitMessage(nExitCode: SmallInt); external 'USER';
 
 { Window class management }
 
-{ in Windows 3.1+, RegisterClass returns an ATOM that unquely identifies the
+{ in Windows 3.1+, RegisterClass returns an ATOM that uniquely identifies the
   class. In Windows 3.0 and earlier, the return value is BOOL. That's why we
   redefine this function in the win31 unit. }
 function RegisterClass(lpwc: LPWNDCLASS): BOOL; external 'USER';

rtl/wince/wininc/defines.inc

@@ -869,7 +869,7 @@
      WS_EX_NODRAG           = $40000000;
      WS_EX_CAPTIONOKBTN     = $80000000;
 
-     WS_EX_NOINHERITLAYOUT  = $00100000; // Disable inheritence of mirroring by children
+     WS_EX_NOINHERITLAYOUT  = $00100000; // Disable inheritance of mirroring by children
      WS_EX_LAYOUTRTL        = $00400000; // Right to left mirroring