* synchronized with trunk

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

.gitattributes

@@ -872,6 +872,7 @@ compiler/systems/i_nwl.pas svneol=native#text/plain
 compiler/systems/i_nwm.pas svneol=native#text/plain
 compiler/systems/i_os2.pas svneol=native#text/plain
 compiler/systems/i_palmos.pas svneol=native#text/plain
+compiler/systems/i_sinclairql.pas svneol=native#text/plain
 compiler/systems/i_sunos.pas svneol=native#text/plain
 compiler/systems/i_symbian.pas svneol=native#text/plain
 compiler/systems/i_wasi.pas svneol=native#text/plain
@@ -909,6 +910,7 @@ compiler/systems/t_nwl.pas svneol=native#text/plain
 compiler/systems/t_nwm.pas svneol=native#text/plain
 compiler/systems/t_os2.pas svneol=native#text/plain
 compiler/systems/t_palmos.pas svneol=native#text/plain
+compiler/systems/t_sinclairql.pas svneol=native#text/plain
 compiler/systems/t_sunos.pas svneol=native#text/plain
 compiler/systems/t_symbian.pas svneol=native#text/plain
 compiler/systems/t_wasi.pas svneol=native#text/plain
@@ -11937,6 +11939,18 @@ rtl/riscv64/setjump.inc svneol=native#text/plain
 rtl/riscv64/setjumph.inc svneol=native#text/plain
 rtl/riscv64/strings.inc svneol=native#text/plain
 rtl/riscv64/stringss.inc svneol=native#text/plain
+rtl/sinclairql/Makefile.fpc svneol=native#text/plain
+rtl/sinclairql/buildrtl.pp svneol=native#text/plain
+rtl/sinclairql/rtl.cfg svneol=native#text/plain
+rtl/sinclairql/rtldefs.inc svneol=native#text/plain
+rtl/sinclairql/si_prc.pp svneol=native#text/plain
+rtl/sinclairql/sysdir.inc svneol=native#text/plain
+rtl/sinclairql/sysfile.inc svneol=native#text/plain
+rtl/sinclairql/sysheap.inc svneol=native#text/plain
+rtl/sinclairql/sysos.inc svneol=native#text/plain
+rtl/sinclairql/sysosh.inc svneol=native#text/plain
+rtl/sinclairql/system.pp svneol=native#text/plain
+rtl/sinclairql/tthread.inc svneol=native#text/plain
 rtl/solaris/Makefile svneol=native#text/plain
 rtl/solaris/Makefile.fpc svneol=native#text/plain
 rtl/solaris/errno.inc svneol=native#text/plain
@@ -12698,6 +12712,7 @@ tests/tbf/tb0268.pp svneol=native#text/pascal
 tests/tbf/tb0269.pp svneol=native#text/pascal
 tests/tbf/tb0270.pp svneol=native#text/pascal
 tests/tbf/tb0271.pp svneol=native#text/pascal
+tests/tbf/tb0272.pp svneol=native#text/plain
 tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
@@ -16199,7 +16214,8 @@ tests/test/units/sysutils/twstralloc.pp svneol=native#text/plain
 tests/test/units/sysutils/twstrcmp.pp svneol=native#text/plain
 tests/test/units/types/ttbitconverter.pp svneol=native#text/pascal
 tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
-tests/test/units/unixutil/tepoch1.pp svneol=native#text/pascal
+tests/test/units/unix/tepoch1.pp svneol=native#text/pascal
+tests/test/units/unix/ttimezone1.pp svneol=native#text/pascal
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
 tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
 tests/test/units/variants/tw26370.pp svneol=native#text/plain
@@ -18440,6 +18456,7 @@ tests/webtbs/tw36212.pp svneol=native#text/pascal
 tests/webtbs/tw36215.pp svneol=native#text/pascal
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
+tests/webtbs/tw36381.pp svneol=native#text/plain
 tests/webtbs/tw36388.pp svneol=native#text/pascal
 tests/webtbs/tw36389.pp svneol=native#text/pascal
 tests/webtbs/tw36496a.pp svneol=native#text/pascal
@@ -18539,6 +18556,8 @@ tests/webtbs/tw37926.pp svneol=native#text/pascal
 tests/webtbs/tw37949.pp svneol=native#text/pascal
 tests/webtbs/tw3796.pp svneol=native#text/plain
 tests/webtbs/tw37969.pp svneol=native#text/pascal
+tests/webtbs/tw38012.pp svneol=native#text/pascal
+tests/webtbs/tw38022.pp svneol=native#text/pascal
 tests/webtbs/tw3805.pp svneol=native#text/plain
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain

.gitignore

@@ -3,6 +3,7 @@
 /*.o
 /*.ppu
 /*.s
+/bin
 /build-stamp.*
 compiler/*.bak
 compiler/*.exe

compiler/aasmcnst.pas

@@ -155,7 +155,7 @@ type
     private
      fnextfieldname: TIDString;
      function getcuroffset: asizeint;
-     procedure setnextfieldname(AValue: TIDString);
+     procedure setnextfieldname(const AValue: TIDString);
     protected
      { type of the aggregate }
      fdef: tdef;
@@ -217,7 +217,7 @@ type
     private
      function getcurragginfo: taggregateinformation;
      procedure set_next_field(AValue: tfieldvarsym);
-     procedure set_next_field_name(AValue: TIDString);
+     procedure set_next_field_name(const AValue: TIDString);
     protected
      { temporary list in which all data is collected }
      fasmlist: tasmlist;
@@ -538,7 +538,7 @@ implementation
       end;
 
 
-    procedure taggregateinformation.setnextfieldname(AValue: TIDString);
+    procedure taggregateinformation.setnextfieldname(const AValue: TIDString);
       begin
         if (fnextfieldname<>'') or
            not anonrecord then
@@ -862,7 +862,7 @@ implementation
      end;
 
 
-    procedure ttai_typedconstbuilder.set_next_field_name(AValue: TIDString);
+    procedure ttai_typedconstbuilder.set_next_field_name(const AValue: TIDString);
       var
         info: taggregateinformation;
       begin

compiler/aggas.pas

@@ -527,6 +527,7 @@ implementation
                    include(secflags,SF_W);
                end;
            end;
+         system_i386_go32v2,
          system_i386_win32,
          system_x86_64_win64,
          system_i386_wince,

compiler/armgen/aoptarm.pas

@@ -295,6 +295,8 @@ Implementation
   function TARMAsmOptimizer.RedundantMovProcess(var p: tai;hp1: tai):boolean;
     var
       I: Integer;
+      current_hp: tai;
+      LDRChange: Boolean;
     begin
       Result:=false;
       {
@@ -310,58 +312,269 @@ Implementation
       }
       if (taicpu(p).ops = 2) and
          (taicpu(p).oper[1]^.typ = top_reg) and
-         (taicpu(p).oppostfix = PF_NONE) and
+         (taicpu(p).oppostfix = PF_NONE) then
+        begin
 
-         MatchInstruction(hp1, [A_ADD, A_ADC,
+          if
+            MatchInstruction(hp1, [A_ADD, A_ADC,
 {$ifdef ARM}
-                                A_RSB, A_RSC,
+                                   A_RSB, A_RSC,
 {$endif ARM}
-                                A_SUB, A_SBC,
-                                A_AND, A_BIC, A_EOR, A_ORR, A_MOV, A_MVN],
-                          [taicpu(p).condition], []) and
-         { MOV and MVN might only have 2 ops }
-         (taicpu(hp1).ops >= 2) and
-         MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^.reg) and
-         (taicpu(hp1).oper[1]^.typ = top_reg) and
-         (
-           (taicpu(hp1).ops = 2) or
-           (taicpu(hp1).oper[2]^.typ in [top_reg, top_const, top_shifterop])
-         ) and
+                                   A_SUB, A_SBC,
+                                   A_AND, A_BIC, A_EOR, A_ORR, A_MOV, A_MVN],
+                             [taicpu(p).condition], []) and
+            { MOV and MVN might only have 2 ops }
+            (taicpu(hp1).ops >= 2) and
+            MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^.reg) and
+            (taicpu(hp1).oper[1]^.typ = top_reg) and
+            (
+              (taicpu(hp1).ops = 2) or
+              (taicpu(hp1).oper[2]^.typ in [top_reg, top_const, top_shifterop])
+            ) and
 {$ifdef AARCH64}
-         (taicpu(p).oper[1]^.reg<>NR_SP) and
+            (taicpu(p).oper[1]^.reg<>NR_SP) and
 {$endif AARCH64}
-         not(RegUsedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-        begin
-        { When we get here we still don't know if the registers match }
-          for I:=1 to 2 do
-            {
-              If the first loop was successful p will be replaced with hp1.
-              The checks will still be ok, because all required information
-              will also be in hp1 then.
-            }
-            if (taicpu(hp1).ops > I) and
-               MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[I]^.reg)
+            not(RegUsedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+            begin
+              { When we get here we still don't know if the registers match }
+              for I:=1 to 2 do
+                {
+                  If the first loop was successful p will be replaced with hp1.
+                  The checks will still be ok, because all required information
+                  will also be in hp1 then.
+                }
+                if (taicpu(hp1).ops > I) and
+                   MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[I]^.reg)
+{$ifdef ARM}
+                   { prevent certain combinations on thumb(2), this is only a safe approximation }
+                   and (not(GenerateThumbCode or GenerateThumb2Code) or
+                    ((getsupreg(taicpu(p).oper[1]^.reg)<>RS_R13) and
+                     (getsupreg(taicpu(p).oper[1]^.reg)<>RS_R15)))
+{$endif ARM}
+
+                then
+                  begin
+                    DebugMsg('Peephole RedundantMovProcess done', hp1);
+                    taicpu(hp1).oper[I]^.reg := taicpu(p).oper[1]^.reg;
+                    if p<>hp1 then
+                      begin
+                        asml.remove(p);
+                        p.free;
+                        p:=hp1;
+                        Result:=true;
+                      end;
+                  end;
+
+              if Result then Exit;
+            end
+          { Change:                   Change:
+              mov     r1, r0            mov     r1, r0
+              ...                       ...
+              ldr/str r2, [r1, etc.]    mov     r2, r1
+            To:                       To:
+              ldr/str r2, [r0, etc.]    mov     r2, r0
+          }
+          else if (taicpu(p).condition = C_None) and (taicpu(p).oper[1]^.typ = top_reg)
 {$ifdef ARM}
-               { prevent certain combinations on thumb(2), this is only a safe approximation }
-               and (not(GenerateThumbCode or GenerateThumb2Code) or
-                ((getsupreg(taicpu(p).oper[1]^.reg)<>RS_R13) and
-                 (getsupreg(taicpu(p).oper[1]^.reg)<>RS_R15)))
+            and not (getsupreg(taicpu(p).oper[0]^.reg) in [RS_PC, RS_R14, RS_STACK_POINTER_REG])
+            and (getsupreg(taicpu(p).oper[1]^.reg) <> RS_PC)
 {$endif ARM}
+{$ifdef AARCH64}
+            and (getsupreg(taicpu(p).oper[0]^.reg) <> RS_STACK_POINTER_REG)
+{$endif AARCH64}
+            then
+            begin
+              current_hp := p;
+              TransferUsedRegs(TmpUsedRegs);
 
-               then
-              begin
-                DebugMsg('Peephole RedundantMovProcess done', hp1);
-                taicpu(hp1).oper[I]^.reg := taicpu(p).oper[1]^.reg;
-                if p<>hp1 then
+              { Search local instruction block }
+              while GetNextInstruction(current_hp, hp1) and (hp1 <> BlockEnd) and (hp1.typ = ait_instruction) do
                 begin
-                  asml.remove(p);
-                  p.free;
-                  p:=hp1;
-                  Result:=true;
+                  UpdateUsedRegs(TmpUsedRegs, tai(current_hp.Next));
+                  LDRChange := False;
+
+                  if (taicpu(hp1).opcode in [A_LDR,A_STR]) and (taicpu(hp1).ops = 2) then
+                    begin
+
+                      { Change the registers from r1 to r0 }
+                      if (taicpu(hp1).oper[1]^.ref^.base = taicpu(p).oper[0]^.reg) and
+{$ifdef ARM}
+                        { This optimisation conflicts with something and raises
+                          an access violation - needs further investigation. [Kit] }
+                        (taicpu(hp1).opcode <> A_LDR) and
+{$endif ARM}
+                        { Don't mess around with the base register if the
+                          reference is pre- or post-indexed }
+                        (taicpu(hp1).oper[1]^.ref^.addressmode = AM_OFFSET) then
+                        begin
+                          taicpu(hp1).oper[1]^.ref^.base := taicpu(p).oper[1]^.reg;
+                          LDRChange := True;
+                        end;
+
+                      if taicpu(hp1).oper[1]^.ref^.index = taicpu(p).oper[0]^.reg then
+                        begin
+                          taicpu(hp1).oper[1]^.ref^.index := taicpu(p).oper[1]^.reg;
+                          LDRChange := True;
+                        end;
+
+                      if LDRChange then
+                        DebugMsg('Peephole Optimization: ' + std_regname(taicpu(p).oper[0]^.reg) + ' = ' + std_regname(taicpu(p).oper[1]^.reg) + ' (MovLdr2Ldr 1)', hp1);
+
+                      { Drop out if we're dealing with pre-indexed references }
+                      if (taicpu(hp1).oper[1]^.ref^.addressmode = AM_PREINDEXED) and
+                        (
+                          RegInRef(taicpu(p).oper[0]^.reg, taicpu(hp1).oper[1]^.ref^) or
+                          RegInRef(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[1]^.ref^)
+                        ) then
+                        begin
+                          { Remember to update register allocations }
+                          if LDRChange then
+                            AllocRegBetween(taicpu(p).oper[1]^.reg, p, hp1, UsedRegs);
+
+                          Break;
+                        end;
+
+                      { The register being stored can be potentially changed (as long as it's not the stack pointer) }
+                      if (taicpu(hp1).opcode = A_STR) and (getsupreg(taicpu(p).oper[1]^.reg) <> RS_STACK_POINTER_REG) and
+                        MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[0]^.reg) then
+                        begin
+                          DebugMsg('Peephole Optimization: ' + std_regname(taicpu(p).oper[0]^.reg) + ' = ' + std_regname(taicpu(p).oper[1]^.reg) + ' (MovLdr2Ldr 2)', hp1);
+                          taicpu(hp1).oper[0]^.reg := taicpu(p).oper[1]^.reg;
+                          LDRChange := True;
+                        end;
+
+                      if LDRChange and (getsupreg(taicpu(p).oper[1]^.reg) <> RS_STACK_POINTER_REG) then
+                        begin
+                          AllocRegBetween(taicpu(p).oper[1]^.reg, p, hp1, UsedRegs);
+                          if (taicpu(p).oppostfix = PF_None) and
+                            (
+                              (
+                                (taicpu(hp1).opcode = A_LDR) and
+                                MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[0]^.reg)
+                              ) or
+                              not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp1, TmpUsedRegs)
+                            ) and
+                            { Double-check to see if the old registers were actually
+                              changed (e.g. if the super registers matched, but not
+                              the sizes, they won't be changed). }
+                            (
+                              (taicpu(hp1).opcode = A_LDR) or
+                              not RegInOp(taicpu(p).oper[0]^.reg, taicpu(hp1).oper[0]^)
+                            ) and
+                            not RegInRef(taicpu(p).oper[0]^.reg, taicpu(hp1).oper[1]^.ref^) then
+                            begin
+                              DebugMsg('Peephole Optimization: RedundantMovProcess 2a done', p);
+                              RemoveCurrentP(p);
+                              Result := True;
+                              Exit;
+                            end;
+                        end;
+                    end
+                  else if (taicpu(hp1).opcode = A_MOV) and (taicpu(hp1).oppostfix = PF_None) and
+                    (taicpu(hp1).ops = 2) then
+                    begin
+                      if MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[0]^.reg) then
+                        begin
+                          { Found another mov that writes entirely to the register }
+                          if RegUsedBetween(taicpu(p).oper[0]^.reg, p, hp1) then
+                            begin
+                              { Register was used beforehand }
+                              if MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[1]^.reg) then
+                                begin
+                                  { This MOV is exactly the same as the first one.
+                                    Since none of the registers have changed value
+                                    at this point, we can remove it. }
+                                  DebugMsg('Peephole Optimization: RedundantMovProcess 3a done', hp1);
+                                  asml.Remove(hp1);
+                                  hp1.Free;
+
+                                  { We still have the original p, so we can continue optimising;
+                                   if it was -O2 or below, this instruction appeared immediately
+                                   after the first MOV, so we're technically not looking more
+                                   than one instruction ahead after it's removed! [Kit] }
+                                  Continue;
+                                end
+                              else
+                                { Register changes value - drop out }
+                                Break;
+                            end;
+
+                          { We can delete the first MOV (only if the second MOV is unconditional) }
+{$ifdef ARM}
+                          if (taicpu(p).oppostfix = PF_None) and
+                            (taicpu(hp1).condition = C_None) then
+{$endif ARM}
+                            begin
+                              DebugMsg('Peephole Optimization: RedundantMovProcess 2b done', p);
+                              RemoveCurrentP(p);
+                              Result := True;
+                            end;
+                          Exit;
+                        end
+                      else if MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) then
+                        begin
+                          if MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[1]^.reg)
+                            { Be careful - if the entire register is not used, removing this
+                              instruction will leave the unused part uninitialised }
+{$ifdef AARCH64}
+                            and (getsubreg(taicpu(p).oper[1]^.reg) = R_SUBQ)
+{$endif AARCH64}
+                            then
+                            begin
+                              { Instruction will become mov r1,r1 }
+                              DebugMsg('Peephole Optimization: Mov2None 2 done', hp1);
+                              asml.Remove(hp1);
+                              hp1.Free;
+                              Continue;
+                            end;
+
+                          { Change the old register (checking the first operand again
+                            forces it to be left alone if the full register is not
+                            used, lest mov w1,w1 gets optimised out by mistake. [Kit] }
+{$ifdef AARCH64}
+                          if not MatchOperand(taicpu(hp1).oper[0]^, taicpu(p).oper[1]^.reg) then
+{$endif AARCH64}
+                            begin
+                              DebugMsg('Peephole Optimization: ' + std_regname(taicpu(p).oper[0]^.reg) + ' = ' + std_regname(taicpu(p).oper[1]^.reg) + ' (MovMov2Mov 2)', hp1);
+                              taicpu(hp1).oper[1]^.reg := taicpu(p).oper[1]^.reg;
+                              AllocRegBetween(taicpu(p).oper[1]^.reg, p, hp1, UsedRegs);
+
+                              { If this was the only reference to the old register,
+                                then we can remove the original MOV now }
+
+                              if (taicpu(p).oppostfix = PF_None) and
+                                { A bit of a hack - sometimes registers aren't tracked properly, so do not
+                                  remove if the register was apparently not allocated when its value is
+                                  first set at the MOV command (this is especially true for the stack
+                                  register). [Kit] }
+                                (getsupreg(taicpu(p).oper[1]^.reg) <> RS_STACK_POINTER_REG) and
+                                RegInUsedRegs(taicpu(p).oper[0]^.reg, UsedRegs) and
+                                not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp1, TmpUsedRegs) then
+                                begin
+                                  DebugMsg('Peephole Optimization: RedundantMovProcess 2c done', p);
+                                  RemoveCurrentP(p);
+                                  Result := True;
+                                  Exit;
+                                end;
+                            end;
+                        end;
+                    end;
+
+                  { On low optimisation settions, don't search more than one instruction ahead }
+                  if not(cs_opt_level3 in current_settings.optimizerswitches) or
+                    { Stop at procedure calls and jumps }
+                    is_calljmp(taicpu(hp1).opcode) or
+                    { If the read register has changed value, or the MOV
+                      destination register has been used, drop out }
+                    RegInInstruction(taicpu(p).oper[0]^.reg, hp1) or
+                    RegModifiedByInstruction(taicpu(p).oper[1]^.reg, hp1) then
+                    Break;
+
+                  current_hp := hp1;
                 end;
-              end;
+            end;
         end;
-      end;
+    end;
 
 
   function TARMAsmOptimizer.OptPass1UXTB(var p : tai) : Boolean;

compiler/comphook.pas

@@ -173,6 +173,9 @@ implementation
 {$ifdef linux}
    ,termio
 {$endif linux}
+{$ifdef mswindows}
+   ,windows
+{$endif mswindows}
    ;
 
 {****************************************************************************
@@ -211,11 +214,12 @@ end;
 type
   TOutputColor = (oc_black,oc_red,oc_green,oc_orange,og_blue,oc_magenta,oc_cyan,oc_lightgray);
 
-{$ifdef linux}
+{$if defined(linux) or defined(MSWINDOWS)}
 const
   CachedIsATTY : Boolean = false;
   IsATTYValue : Boolean = false;
 
+{$ifdef linux}
 function IsATTY(var t : text) : Boolean;
   begin
     if not(CachedIsATTY) then
@@ -227,10 +231,33 @@ function IsATTY(var t : text) : Boolean;
   end;
 {$endif linux}
 
+{$ifdef MSWINDOWS}
+const ENABLE_VIRTUAL_TERMINAL_PROCESSING = $0004;
+
+function IsATTY(var t : text) : Boolean;
+  const dwMode: dword = 0;
+  begin
+    if not(CachedIsATTY) then
+      begin
+        IsATTYValue := false;
+        if GetConsoleMode(TextRec(t).handle, dwMode) then
+        begin
+          dwMode := dwMode or ENABLE_VIRTUAL_TERMINAL_PROCESSING;
+          if SetConsoleMode(TextRec(t).handle, dwMode) then
+            IsATTYValue := true;
+        end;
+        CachedIsATTY:=true;
+      end;
+    Result:=IsATTYValue;
+  end;
+{$endif MSWINDOWS}
+
+{$endif defined(linux) or defined(MSWINDOWS)}
+
 
 procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiString);
   begin
-{$ifdef linux}
+{$if defined(linux) or defined(mswindows)}
      if IsATTY(t) then
        begin
          case color of
@@ -252,9 +279,9 @@ procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiStrin
              write(t,#27'[1m'#27'[37m');
          end;
        end;
-{$endif linux}
+{$endif linux or mswindows}
     write(t,s);
-{$ifdef linux}
+{$if defined(linux) or defined(mswindows)}
     if IsATTY(t) then
       write(t,#27'[0m');
 {$endif linux}

compiler/cstreams.pas

@@ -104,11 +104,11 @@ type
 
   TCCustomFileStream = class(TCStream)
   protected
-    FFileName : String;
+    FFileName : AnsiString;
   public
-    constructor Create(const AFileName: string;{shortstring!} Mode: Word); virtual; abstract;
+    constructor Create(const AFileName: AnsiString; Mode: Word); virtual; abstract;
     function EOF: boolean; virtual; abstract;
-    property FileName : String Read FFilename;
+    property FileName : AnsiString Read FFilename;
   end;
 
 { TFileStream class }
@@ -119,7 +119,7 @@ type
   protected
     procedure SetSize(NewSize: Longint); override;
   public
-    constructor Create(const AFileName: string; Mode: Word); override;
+    constructor Create(const AFileName: AnsiString; Mode: Word); override;
     destructor Destroy; override;
     function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
@@ -378,7 +378,7 @@ implementation
 {*                             TCFileStream                                  *}
 {****************************************************************************}
 
-constructor TCFileStream.Create(const AFileName: string; Mode: Word);
+constructor TCFileStream.Create(const AFileName: AnsiString; Mode: Word);
 var
   oldfilemode : byte;
 begin

compiler/cutils.pas

@@ -92,10 +92,11 @@ interface
     function lower(const s : ansistring) : ansistring;
     function rpos(const needle: char; const haystack: shortstring): longint; overload;
     function rpos(const needle: shortstring; const haystack: shortstring): longint; overload;
-    function trimbspace(const s:string):string;
     function trimspace(const s:string):string;
+    function trimspace(const s:AnsiString):AnsiString;
     function space (b : longint): string;
     function PadSpace(const s:string;len:longint):string;
+    function PadSpace(const s:AnsiString;len:longint):AnsiString;
     function GetToken(var s:string;endchar:char):string;
     procedure uppervar(var s : string);
     function realtostr(e:extended):string;{$ifdef USEINLINE}inline;{$endif}
@@ -769,23 +770,24 @@ implementation
       end;
 
 
-    function trimbspace(const s:string):string;
+    function trimspace(const s:string):string;
     {
-      return s with all leading spaces and tabs removed
+      return s with all leading and ending spaces and tabs removed
     }
       var
         i,j : longint;
       begin
-        j:=1;
         i:=length(s);
+        while (i>0) and (s[i] in [#9,' ']) do
+         dec(i);
+        j:=1;
         while (j<i) and (s[j] in [#9,' ']) do
          inc(j);
-        trimbspace:=Copy(s,j,i-j+1);
+        trimspace:=Copy(s,j,i-j+1);
       end;
 
 
-
-    function trimspace(const s:string):string;
+    function trimspace(const s:AnsiString):AnsiString;
     {
       return s with all leading and ending spaces and tabs removed
     }
@@ -825,6 +827,18 @@ implementation
       end;
 
 
+    function PadSpace(const s:AnsiString;len:longint):AnsiString;
+    {
+      return s with spaces add to the end
+    }
+      begin
+         if length(s)<len then
+          PadSpace:=s+Space(len-length(s))
+         else
+          PadSpace:=s;
+      end;
+
+
     function GetToken(var s:string;endchar:char):string;
       var
         i : longint;

compiler/defcmp.pas

@@ -2622,8 +2622,9 @@ implementation
     function equal_genfunc_paradefs(fwdef,currdef:tdef;fwpdst,currpdst:tsymtable): boolean;
       begin
         result:=false;
-        if (sp_generic_para in fwdef.typesym.symoptions) and
-            (sp_generic_para in currdef.typesym.symoptions) and
+        { for open array parameters, typesym might not be assigned }
+        if assigned(fwdef.typesym) and (sp_generic_para in fwdef.typesym.symoptions) and
+           assigned(currdef.typesym) and (sp_generic_para in currdef.typesym.symoptions) and
             (fwdef.owner=fwpdst) and
             (currdef.owner=currpdst) then
           begin

compiler/fpcdefs.inc

@@ -39,7 +39,7 @@
 { This fake CPU is used to allow incorporation of globtype unit
   into utils/ppudump without any CPU specific code PM }
 {$ifdef generic_cpu}
-  {$define #cpu32bit}
+  {$define cpu32bit}
   {$define cpu32bitaddr}
   {$define cpu32bitalu}
   {$define cpuflags}

compiler/globtype.pas

@@ -787,7 +787,11 @@ interface
       TRADirection = (rad_forward, rad_backwards, rad_backwards_reinit);
 
     type
+{$ifndef symansistr}
       TIDString = string[maxidlen];
+{$else}
+      TIDString = TSymStr;
+{$endif}
 
       tnormalset = set of byte; { 256 elements set }
       pnormalset = ^tnormalset;

compiler/i386/cpuinfo.pas

@@ -67,7 +67,8 @@ Type
       fpu_sse41,
       fpu_sse42,
       fpu_avx,
-      fpu_avx2
+      fpu_avx2,
+      fpu_avx512f
      );
 
    tcontrollertype =
@@ -122,7 +123,7 @@ Const
      'COREAVX2'
    );
 
-   fputypestr : array[tfputype] of string[6] = (
+   fputypestr : array[tfputype] of string[7] = (
      'NONE',
 //     'SOFT',
      'X87',
@@ -133,13 +134,14 @@ Const
      'SSE41',
      'SSE42',
      'AVX',
-     'AVX2'
+     'AVX2',
+     'AVX512F'
    );
 
-   sse_singlescalar = [fpu_sse..fpu_avx2];
-   sse_doublescalar = [fpu_sse2..fpu_avx2];
+   sse_singlescalar = [fpu_sse..fpu_avx512f];
+   sse_doublescalar = [fpu_sse2..fpu_avx512f];
 
-   fpu_avx_instructionsets = [fpu_avx,fpu_avx2];
+   fpu_avx_instructionsets = [fpu_avx,fpu_avx2,fpu_avx512f];
 
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+
@@ -174,7 +176,7 @@ type
 
    tfpuflags =
       (FPUX86_HAS_AVXUNIT,
-       FPUX86_HAS_32MMREGS
+       FPUX86_HAS_AVX512F
       );
 
  const
@@ -202,7 +204,8 @@ type
       { fpu_sse41    } [],
       { fpu_sse42    } [],
       { fpu_avx      } [FPUX86_HAS_AVXUNIT],
-      { fpu_avx2     } [FPUX86_HAS_AVXUNIT]
+      { fpu_avx2     } [FPUX86_HAS_AVXUNIT],
+      { fpu_avx512   } [FPUX86_HAS_AVXUNIT,FPUX86_HAS_AVX512F]
    );
 
 Implementation

compiler/i386/i386prop.inc

@@ -1261,12 +1261,12 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/i8086/i8086prop.inc

@@ -1275,12 +1275,12 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/m68k/aasmcpu.pas

@@ -513,7 +513,8 @@ type
           A_FABS, A_FSABS, A_FDABS,
           A_FSQRT, A_FSSQRT, A_FDSQRT,
           A_FNEG, A_FSNEG, A_FDNEG,
-          A_FSIN, A_FCOS:
+          A_FSIN, A_FCOS,
+          A_FINT, A_FINTRZ:
              if ops = 1 then
                begin
                  if opnr = 0 then

compiler/m68k/ag68kvasm.pas

@@ -99,7 +99,9 @@ unit ag68kvasm;
           { a.out doesn't support named sections }
           system_m68k_amiga: objtype:='-Felf';
           { atari never had a standard object format, a.out is limited, vasm/vlink author recommends vobj }
-          system_m68k_atari: objtype:='-Fvobj';
+          system_m68k_atari,
+          { same with the QL }
+          system_m68k_sinclairql: objtype:='-Fvobj';
         else
           internalerror(2016052601);
         end;
@@ -133,7 +135,7 @@ unit ag68kvasm;
          idtxt  : 'VASM';
          asmbin : 'vasmm68k_std';
          asmcmd:  '-quiet -elfregs -gas $OTYPE $ARCH -o $OBJ $EXTRAOPT $ASM';
-         supported_targets : [system_m68k_amiga,system_m68k_atari];
+         supported_targets : [system_m68k_amiga,system_m68k_atari,system_m68k_sinclairql];
          flags : [af_needar,af_smartlink_sections];
          labelprefix : '.L';
          labelmaxlen : -1;

compiler/m68k/cpupara.pas

@@ -483,10 +483,7 @@ unit cpupara;
           pass all unhandled parameters are done }
         for pass:=1 to 2 do
           begin
-            if pass=1 then
-              i:=0
-            else
-              i:=paras.count-1;
+            i:=0;
             while true do
               begin
                 hp:=tparavarsym(paras[i]);
@@ -631,22 +628,9 @@ unit cpupara;
                             end;
                         end;
                   end;
-                case pass of
-                  1:
-                    begin
-                      if i=paras.count-1 then
-                        break;
-                      inc(i);
-                    end;
-                  2:
-                    begin
-                      if i=0 then
-                        break;
-                      dec(i);
-                    end;
-                  else
-                    ;
-                end;
+                if i=paras.count-1 then
+                  break;
+                inc(i);
               end;
           end;
         result:=cur_stack_offset;

compiler/m68k/cputarg.pas

@@ -53,6 +53,9 @@ implementation
     {$ifndef NOTARGETMACOS}
       ,t_macos
     {$endif}
+    {$ifndef NOTARGETSINCLAIRQL}
+      ,t_sinclairql
+    {$endif}
     {$ifndef NOTARGETEMBEDDED}
       ,t_embed
     {$endif}

compiler/msg/errore.msg

@@ -432,6 +432,7 @@ scan_w_setpeosversion_not_support=02103_W_SETPEOSVERSION is not supported by the
 scan_w_setpesubsysversion_not_support=02104_W_SETPESUBSYSVERSION is not supported by the target OS
 % The \var{\{\$SETPESUBSYSVERSION\}} directive is not supported by the target OS.
 scan_n_changecputype=02105_N_Changed CPU type to be consistent with specified controller
+scan_e_emptymacroname=02106_E_A macro/compiler variable name cannot be empty
 % \end{description}
 #
 # Parser
@@ -4150,6 +4151,7 @@ F*2P<x>_Set target CPU (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel,powerpc,
 6*2Tnetbsd_NetBSD
 6*2Tmacosclassic_Classic Mac OS
 6*2Tpalmos_PalmOS
+6*2Tql_Sinclair QL
 # i8086 targets
 8*2Tembedded_Embedded
 8*2Tmsdos_MS-DOS (and compatible)

compiler/msgidx.inc

@@ -129,6 +129,7 @@ const
   scan_w_setpeosversion_not_support=02103;
   scan_w_setpesubsysversion_not_support=02104;
   scan_n_changecputype=02105;
+  scan_e_emptymacroname=02106;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -1133,9 +1134,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 86403;
+  MsgTxtSize = 86477;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,360,130,99,63,145,36,223,68,
+    28,107,360,130,99,63,145,36,223,68,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/options.pas

@@ -3387,6 +3387,8 @@ begin
       lets disable the feature. }
     system_m68k_amiga:
       target_unsup_features:=[f_dynlibs];
+    system_m68k_sinclairql:
+      target_unsup_features:=[f_threading,f_dynlibs,f_commandargs,f_exitcode];
     system_z80_zxspectrum:
       target_unsup_features:=[f_threading,f_dynlibs{,f_fileio,f_textio},f_commandargs,f_exitcode];
     system_z80_msxdos:

compiler/pdecl.pas

@@ -613,7 +613,7 @@ implementation
 
     procedure types_dec(in_structure: boolean;out had_generic:boolean;var rtti_attrs_def: trtti_attribute_list);
 
-      function determine_generic_def(name:tidstring):tstoreddef;
+      function determine_generic_def(const name:tidstring):tstoreddef;
         var
           hashedid : THashedIDString;
           pd : tprocdef;

compiler/pdecsub.pas

@@ -683,7 +683,7 @@ implementation
             firstpart:=false;
           end;
 
-        function search_object_name(sp:TIDString;gen_error:boolean):tsym;
+        function search_object_name(const sp:TIDString;gen_error:boolean):tsym;
           var
             storepos:tfileposinfo;
             srsymtable:TSymtable;

compiler/ppu.pas

@@ -45,12 +45,12 @@ type
 const
   { only update this version if something change in the tppuheader:
      * the unit flags listed below
-     * the format of the header itslf
+     * the format of the header itself
     This number cannot become bigger than 255 (it's stored in a byte) }
   CurrentPPUVersion = 208;
   { for any other changes to the ppu format, increase this version number
     (it's a cardinal) }
-  CurrentPPULongVersion = 9;
+  CurrentPPULongVersion = 11;
 
 { unit flags }
   uf_big_endian          = $000004;

compiler/scanner.pas

@@ -2256,6 +2256,11 @@ type
       begin
         current_scanner.skipspace;
         hs:=current_scanner.readid;
+        if hs='' then
+          begin
+            Message(scan_e_emptymacroname);
+            exit;
+          end;
         mac:=tmacro(search_macro(hs));
         if not assigned(mac) or (mac.owner <> current_module.localmacrosymtable) then
           begin

compiler/symbase.pas

@@ -71,15 +71,15 @@ interface
       { this object is the base for all symbol objects }
       TSymEntry = class(TFPHashObject)
       private
-         FRealName : pshortstring;
-         function  GetRealname:shortstring;
-         procedure SetRealname(const ANewName:shortstring);
+         FRealName : {$ifdef symansistr}TSymStr{$else}pshortstring{$endif};
+         function  GetRealname: TSymStr;
+         procedure SetRealname(const ANewName: TSymStr);
       public
          typ   : tsymtyp;
          SymId : longint;
          Owner : TSymtable;
          destructor destroy;override;
-         property RealName:shortstring read GetRealName write SetRealName;
+         property RealName: TSymStr read GetRealName write SetRealName;
       end;
 
 {************************************************
@@ -167,6 +167,10 @@ implementation
     procedure THashedIDString.SetId(const s:TIDString);
       begin
         FId:=s;
+{$ifdef symansistr}
+        if length(FId)>maxidlen then
+          SetLength(FId,maxidlen);
+{$endif}
         FHash:=FPHash(s);
       end;
 
@@ -180,7 +184,9 @@ implementation
 {$ifdef MEMDEBUG}
         memrealnames.start;
 {$endif MEMDEBUG}
+{$ifndef symansistr}
         stringdispose(Frealname);
+{$endif}
 {$ifdef MEMDEBUG}
         memrealnames.stop;
 {$endif MEMDEBUG}
@@ -188,24 +194,34 @@ implementation
       end;
 
 
-    function TSymEntry.GetRealname:shortstring;
+    function TSymEntry.GetRealname:TSymStr;
       begin
+{$ifndef symansistr}
         if not assigned(FRealname) then
           internalerror(200611011);
         result:=FRealname^;
+{$else}
+       if FRealName='' then
+         internalerror(200611011);
+       result:=FRealName;
+{$endif}
       end;
 
 
-    procedure TSymEntry.SetRealname(const ANewName:shortstring);
+    procedure TSymEntry.SetRealname(const ANewName:TSymStr);
       begin
+{$ifndef symansistr}
         stringdispose(FRealname);
         FRealname:=stringdup(ANewName);
+{$else}
+        FRealname:=ANewName;
+{$endif}
         if Hash<>$ffffffff then
           begin
-            if FRealname^[1]='$' then
-              Rename(Copy(FRealname^,2,255))
+            if ANewName[1]='$' then
+              Rename(Copy(ANewName,2,length(ANewName)))
             else
-              Rename(Upper(FRealname^));
+              Rename(Upper(ANewName));
           end;
       end;
 

compiler/symdef.pas

@@ -217,6 +217,7 @@ interface
           constructor ppuload(ppufile:tcompilerppufile);
           function getcopy : tstoreddef;override;
           function GetTypeName:string;override;
+          function alignment : shortint;override;
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
@@ -3659,6 +3660,12 @@ implementation
       end;
 
 
+    function tvariantdef.alignment: shortint;
+      begin
+        result:=search_system_type('TVARDATA').typedef.alignment;
+      end;
+
+
     procedure tvariantdef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);

compiler/symsym.pas

@@ -48,7 +48,7 @@ interface
        public
           { this is Nil if the symbol has no RTTI attributes }
           rtti_attribute_list : trtti_attribute_list;
-          constructor create(st:tsymtyp;const n : string);
+          constructor create(st:tsymtyp;const n : TSymStr);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
@@ -76,7 +76,7 @@ interface
           { when the label is defined in an asm block, this points to the
             generated asmlabel }
           asmblocklabel : tasmlabel;
-          constructor create(const n : string);virtual;
+          constructor create(const n : TSymStr);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
@@ -87,7 +87,7 @@ interface
 
        tunitsym = class(Tstoredsym)
           module : tobject; { tmodule }
-          constructor create(const n : string;amodule : tobject);virtual;
+          constructor create(const n : TSymStr;amodule : tobject);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           { do not override this routine in platform-specific subclasses,
@@ -98,7 +98,7 @@ interface
 
        tprogramparasym = class(Tstoredsym)
           isoindex : dword;
-          constructor create(const n : string;i : dword);virtual;
+          constructor create(const n : TSymStr;i : dword);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           { do not override this routine in platform-specific subclasses,
@@ -110,7 +110,7 @@ interface
        tnamespacesym = class(Tstoredsym)
           unitsym:tsym;
           unitsymderef:tderef;
-          constructor create(const n : string);virtual;
+          constructor create(const n : TSymStr);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
@@ -132,7 +132,7 @@ interface
           FProcdefList   : TFPObjectList;
           FProcdefDerefList : TFPList;
        public
-          constructor create(const n : string);virtual;
+          constructor create(const n : TSymStr);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           { writes all declarations except the specified one }
@@ -162,7 +162,7 @@ interface
           typedef      : tdef;
           typedefderef : tderef;
           fprettyname : ansistring;
-          constructor create(const n : string;def:tdef);virtual;
+          constructor create(const n : TSymStr;def:tdef);virtual;
           destructor destroy;override;
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
@@ -182,7 +182,7 @@ interface
           {could also be part of tabstractnormalvarsym, but there's
            one byte left here till the next 4 byte alignment        }
           varsymaccess  : tvarsymaccessflags;
-          constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+          constructor create(st:tsymtyp;const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
@@ -226,7 +226,7 @@ interface
 {$else symansistr}
           cachedmangledname: pshortstring; { mangled name for ObjC or Java }
 {$endif symansistr}
-          constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
+          constructor create(const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
@@ -249,7 +249,7 @@ interface
           { the variable is not living at entry of the scope, so it does not need to be initialized if it is a reg. var
             (not written to ppu, because not important and would change interface crc) }
           noregvarinitneeded : boolean;
-          constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+          constructor create(st:tsymtyp;const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           function globalasmsym: boolean;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -258,7 +258,7 @@ interface
       end;
 
       tlocalvarsym = class(tabstractnormalvarsym)
-          constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
+          constructor create(const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
@@ -276,7 +276,7 @@ interface
 {$ifdef EXTDEBUG}
           eqval         : tequaltype;
 {$endif EXTDEBUG}
-          constructor create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
+          constructor create(const n : TSymStr;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           { do not override this routine in platform-specific subclasses,
@@ -306,10 +306,10 @@ interface
             to the symbol of the corresponding class field }
           fieldvarsym : tfieldvarsym;
           fieldvarsymderef : tderef;
-          constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
-          constructor create_dll(const n : string;vsp:tvarspez;def:tdef);virtual;
-          constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);virtual;
-          constructor create_from_fieldvar(const n:string;fieldvar:tfieldvarsym);virtual;
+          constructor create(const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
+          constructor create_dll(const n : TSymStr;vsp:tvarspez;def:tdef);virtual;
+          constructor create_C(const n: TSymStr; const mangled : TSymStr;vsp:tvarspez;def:tdef);virtual;
+          constructor create_from_fieldvar(const n: TSymStr;fieldvar:tfieldvarsym);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           { do not override this routine in platform-specific subclasses,
@@ -331,8 +331,8 @@ interface
          asmname : pshortstring;
          addroffset : PUint;
          ref     : tpropaccesslist;
-         constructor create(const n : string;def:tdef);virtual;
-         constructor create_ref(const n : string;def:tdef;_ref:tpropaccesslist);virtual;
+         constructor create(const n : TSymStr;def:tdef);virtual;
+         constructor create_ref(const n : TSymStr;def:tdef;_ref:tpropaccesslist);virtual;
          destructor  destroy;override;
          constructor ppuload(ppufile:tcompilerppufile);
          procedure buildderef;override;
@@ -362,7 +362,7 @@ interface
           dispid        : longint;
           propaccesslist: array[tpropaccesslisttypes] of tpropaccesslist;
           parast : tsymtable;
-          constructor create(const n : string);virtual;
+          constructor create(const n : TSymStr);virtual;
           destructor  destroy;override;
           constructor ppuload(ppufile:tcompilerppufile);
           function  getsize : asizeint;
@@ -397,12 +397,12 @@ interface
           constdefderef : tderef;
           consttyp    : tconsttyp;
           value       : tconstvalue;
-          constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);virtual;
-          constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);virtual;
-          constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);virtual;
-          constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
-          constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);virtual;
-          constructor create_undefined(const n : string;def:tdef);virtual;
+          constructor create_ord(const n : TSymStr;t : tconsttyp;v : tconstexprint;def:tdef);virtual;
+          constructor create_ordptr(const n : TSymStr;t : tconsttyp;v : tconstptruint;def:tdef);virtual;
+          constructor create_ptr(const n : TSymStr;t : tconsttyp;v : pointer;def:tdef);virtual;
+          constructor create_string(const n : TSymStr;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
+          constructor create_wstring(const n : TSymStr;t : tconsttyp;pw:pcompilerwidestring);virtual;
+          constructor create_undefined(const n : TSymStr;def:tdef);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           procedure buildderef;override;
@@ -417,7 +417,7 @@ interface
           value      : longint;
           definition : tenumdef;
           definitionderef : tderef;
-          constructor create(const n : string;def : tenumdef;v : longint);virtual;
+          constructor create(const n : TSymStr;def : tenumdef;v : longint);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
@@ -429,7 +429,7 @@ interface
 
        tsyssym = class(Tstoredsym)
           number : tinlinenumber;
-          constructor create(const n : string;l : tinlinenumber);virtual;
+          constructor create(const n : TSymStr;l : tinlinenumber);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           { do not override this routine in platform-specific subclasses,
@@ -458,7 +458,7 @@ interface
           is_used : boolean;
           buftext : pchar;
           buflen  : longint;
-          constructor create(const n : string);
+          constructor create(const n : TSymStr);
           constructor ppuload(ppufile:tcompilerppufile);
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
@@ -585,7 +585,7 @@ implementation
                           TSYM (base for all symtypes)
 ****************************************************************************}
 
-    constructor tstoredsym.create(st:tsymtyp;const n : string);
+    constructor tstoredsym.create(st:tsymtyp;const n : TSymStr);
       begin
          inherited create(st,n);
       end;
@@ -593,7 +593,11 @@ implementation
 
     constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
       begin
+{$ifdef symansistr}
+         inherited Create(st,ppufile.getansistring);
+{$else symansistr}
          inherited Create(st,ppufile.getstring);
+{$endif symansistr}
          SymId:=ppufile.getlongint;
          current_module.symlist[SymId]:=self;
          ppufile.getposinfo(fileinfo);
@@ -611,7 +615,11 @@ implementation
       var
         oldintfcrc : boolean;
       begin
+{$ifdef symansistr}
+         ppufile.putansistring(realname);
+{$else}
          ppufile.putstring(realname);
+{$endif}
          ppufile.putlongint(SymId);
          ppufile.putposinfo(fileinfo);
          ppufile.putbyte(byte(visibility));
@@ -705,7 +713,7 @@ implementation
                                  TLABELSYM
 ****************************************************************************}
 
-    constructor tlabelsym.create(const n : string);
+    constructor tlabelsym.create(const n : TSymStr);
       begin
          inherited create(labelsym,n);
          used:=false;
@@ -754,7 +762,7 @@ implementation
                                   TUNITSYM
 ****************************************************************************}
 
-    constructor tunitsym.create(const n : string;amodule : tobject);
+    constructor tunitsym.create(const n : TSymStr;amodule : tobject);
       begin
          inherited create(unitsym,n);
          module:=amodule;
@@ -783,7 +791,7 @@ implementation
                              TPROGRAMPARASYM
 ****************************************************************************}
 
-    constructor tprogramparasym.create(const n : string; i : dword);
+    constructor tprogramparasym.create(const n : TSymStr; i : dword);
       begin
          inherited create(programparasym,n);
          isoindex:=i;
@@ -811,7 +819,7 @@ implementation
                                 TNAMESPACESYM
 ****************************************************************************}
 
-    constructor tnamespacesym.create(const n : string);
+    constructor tnamespacesym.create(const n : TSymStr);
       begin
          inherited create(namespacesym,n);
          unitsym:=nil;
@@ -849,7 +857,7 @@ implementation
                                   TPROCSYM
 ****************************************************************************}
 
-    constructor tprocsym.create(const n : string);
+    constructor tprocsym.create(const n : TSymStr);
       var
         i: longint;
       begin
@@ -1387,7 +1395,7 @@ implementation
       end;
 
 
-    constructor tpropertysym.create(const n : string);
+    constructor tpropertysym.create(const n : TSymStr);
       var
         pap : tpropaccesslisttypes;
       begin
@@ -1650,7 +1658,7 @@ implementation
                             TABSTRACTVARSYM
 ****************************************************************************}
 
-    constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+    constructor tabstractvarsym.create(st:tsymtyp;const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(st,n);
          vardef:=def;
@@ -1846,7 +1854,7 @@ implementation
                                TFIELDVARSYM
 ****************************************************************************}
 
-    constructor tfieldvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+    constructor tfieldvarsym.create(const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(fieldvarsym,n,vsp,def,vopts);
          fieldoffset:=-1;
@@ -1936,7 +1944,7 @@ implementation
                         TABSTRACTNORMALVARSYM
 ****************************************************************************}
 
-    constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+    constructor tabstractnormalvarsym.create(st:tsymtyp;const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(st,n,vsp,def,vopts);
          fillchar(localloc,sizeof(localloc),0);
@@ -1998,7 +2006,7 @@ implementation
                              Tstaticvarsym
 ****************************************************************************}
 
-    constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+    constructor tstaticvarsym.create(const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(staticvarsym,n,vsp,def,vopts);
          fieldvarsymderef.reset;
@@ -2010,20 +2018,20 @@ implementation
       end;
 
 
-    constructor tstaticvarsym.create_dll(const n : string;vsp:tvarspez;def:tdef);
+    constructor tstaticvarsym.create_dll(const n : TSymStr;vsp:tvarspez;def:tdef);
       begin
          tstaticvarsym(self).create(n,vsp,def,[vo_is_dll_var]);
       end;
 
 
-    constructor tstaticvarsym.create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);
+    constructor tstaticvarsym.create_C(const n: TSymStr; const mangled : TSymStr;vsp:tvarspez;def:tdef);
       begin
          tstaticvarsym(self).create(n,vsp,def,[]);
          set_mangledname(mangled);
       end;
 
 
-    constructor tstaticvarsym.create_from_fieldvar(const n: string;fieldvar:tfieldvarsym);
+    constructor tstaticvarsym.create_from_fieldvar(const n: TSymStr;fieldvar:tfieldvarsym);
       begin
         create(internal_static_field_name(n),fieldvar.varspez,fieldvar.vardef,[]);
         fieldvarsym:=fieldvar;
@@ -2194,7 +2202,7 @@ implementation
                                TLOCALVARSYM
 ****************************************************************************}
 
-    constructor tlocalvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+    constructor tlocalvarsym.create(const n : TSymStr;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(localvarsym,n,vsp,def,vopts);
       end;
@@ -2218,7 +2226,7 @@ implementation
                               TPARAVARSYM
 ****************************************************************************}
 
-    constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
+    constructor tparavarsym.create(const n : TSymStr;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(paravarsym,n,vsp,def,vopts);
          if (vsp in [vs_var,vs_value,vs_const,vs_constref]) and
@@ -2313,14 +2321,14 @@ implementation
                                TABSOLUTEVARSYM
 ****************************************************************************}
 
-    constructor tabsolutevarsym.create(const n : string;def:tdef);
+    constructor tabsolutevarsym.create(const n : TSymStr;def:tdef);
       begin
         inherited create(absolutevarsym,n,vs_value,def,[]);
         ref:=nil;
       end;
 
 
-    constructor tabsolutevarsym.create_ref(const n : string;def:tdef;_ref:tpropaccesslist);
+    constructor tabsolutevarsym.create_ref(const n : TSymStr;def:tdef;_ref:tpropaccesslist);
       begin
         inherited create(absolutevarsym,n,vs_value,def,[]);
         ref:=_ref;
@@ -2403,7 +2411,7 @@ implementation
                                   TCONSTSYM
 ****************************************************************************}
 
-    constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
+    constructor tconstsym.create_ord(const n : TSymStr;t : tconsttyp;v : tconstexprint;def:tdef);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
@@ -2414,7 +2422,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
+    constructor tconstsym.create_ordptr(const n : TSymStr;t : tconsttyp;v : tconstptruint;def:tdef);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
@@ -2425,7 +2433,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
+    constructor tconstsym.create_ptr(const n : TSymStr;t : tconsttyp;v : pointer;def:tdef);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
@@ -2436,7 +2444,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def: tdef);
+    constructor tconstsym.create_string(const n : TSymStr;t : tconsttyp;str:pchar;l:longint;def: tdef);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
@@ -2451,7 +2459,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
+    constructor tconstsym.create_wstring(const n : TSymStr;t : tconsttyp;pw:pcompilerwidestring);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
@@ -2463,7 +2471,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_undefined(const n : string;def: tdef);
+    constructor tconstsym.create_undefined(const n : TSymStr;def: tdef);
       begin
         inherited create(constsym,n);
         fillchar(value,sizeof(value),#0);
@@ -2659,7 +2667,7 @@ implementation
                                   TENUMSYM
 ****************************************************************************}
 
-    constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
+    constructor tenumsym.create(const n : TSymStr;def : tenumdef;v : longint);
       begin
          inherited create(enumsym,n);
          definition:=def;
@@ -2703,7 +2711,7 @@ implementation
 ****************************************************************************}
 
 
-    constructor ttypesym.create(const n : string;def:tdef);
+    constructor ttypesym.create(const n : TSymStr;def:tdef);
 
       begin
         inherited create(typesym,n);
@@ -2771,7 +2779,7 @@ implementation
       syssym_list : TFPHashObjectList;
 
 
-    constructor tsyssym.create(const n : string;l : tinlinenumber);
+    constructor tsyssym.create(const n : TSymStr;l : tinlinenumber);
       var
         s : shortstring;
       begin
@@ -2821,7 +2829,7 @@ implementation
                                  TMacro
 *****************************************************************************}
 
-    constructor tmacro.create(const n : string);
+    constructor tmacro.create(const n : TSymStr);
       begin
          inherited create(macrosym,n);
          owner:=nil;

compiler/systems.inc

@@ -202,7 +202,8 @@
              system_z80_msxdos,         { 110 }
              system_aarch64_darwin,     { 111 }
              system_z80_amstradcpc,     { 112 }
-             system_wasm32_wasi         { 113 }
+             system_m68k_sinclairql,    { 113 }
+             system_wasm32_wasi         { 114 }
        );
 
      type
@@ -310,6 +311,7 @@
              ld_zxspectrum,
              ld_msxdos,
              ld_amstradcpc,
+             ld_sinclairql,
              ld_wasi
        );
 

compiler/systems.pas

@@ -347,6 +347,14 @@ interface
        { all native nt systems }
        systems_nativent = [system_i386_nativent];
 
+       { all i386 systems for which cmov instructions for alignment should not be used.
+         This is a problem for several emulators }
+       systems_i386_no_cmov_align = [system_i386_go32v2,
+                                     system_i386_watcom, system_i386_wdosx,
+                                     system_i386_os2, system_i386_emx,
+                                     system_i386_beos, system_i386_haiku,
+                                     system_i386_solaris];
+
        { systems supporting Objective-C }
        systems_objc_supported = systems_darwin;
 
@@ -380,7 +388,7 @@ interface
        systems_internal_sysinit = [system_i386_win32,system_x86_64_win64,
                                    system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux,
                                    system_xtensa_linux,
-                                   system_m68k_atari,system_m68k_palmos,
+                                   system_m68k_atari,system_m68k_palmos,system_m68k_sinclairql,
                                    system_i386_haiku,system_x86_64_haiku,
                                    system_i386_openbsd,system_x86_64_openbsd,
                                    system_riscv32_linux,system_riscv64_linux,

compiler/systems/i_linux.pas

@@ -442,7 +442,7 @@ unit i_linux;
                 constalignmin   : 0;
                 constalignmax   : 16;
                 varalignmin     : 0;
-                varalignmax     : 16;
+                varalignmax     : 64;
                 localalignmin   : 4;
                 localalignmax   : 16;
                 recordalignmin  : 0;

compiler/systems/i_sinclairql.pas

@@ -0,0 +1,107 @@
+{
+    Copyright (c) 2020 by Karoly Balogh
+
+    This unit implements support information structures for the Sinclair QL
+
+    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.
+ ****************************************************************************
+}
+{ This unit implements support information structures for the Sinclair QL. }
+unit i_sinclairql;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       systems;
+
+    const
+       system_m68k_sinclairql_info : tsysteminfo =
+          (
+            system       : system_m68k_sinclairql;
+            name         : 'Sinclair QL';
+            shortname    : 'ql';
+            flags        : [tf_use_8_3,tf_requires_proper_alignment,
+                            tf_smartlink_sections,tf_under_development];
+            cpu          : cpu_m68k;
+            unit_env     : '';
+            extradefines : '';
+            exeext       : '.bin';
+            defext       : '';
+            scriptext    : '';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            staticlibprefix : '';
+            sharedlibprefix : '';
+            sharedClibext : '.dll';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : '';
+            importlibprefix : 'libimp';
+            importlibext : '.a';
+            Cprefix      : '_';
+            newline      : #13#10;
+            dirsep       : '/'; { ... the underlying tools (binutils/vlink/vasm) prefer Unix paths }
+            assem        : as_m68k_as_aout;
+            assemextern  : as_m68k_as_aout;
+            link         : ld_none;
+            linkextern   : ld_sinclairql;
+            ar           : ar_gnu_ar;
+            res          : res_ext;
+            dbg          : dbg_stabs;
+            script       : script_unix;
+            endian       : endian_big;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                jumpalignskipmax    : 0;
+                coalescealign   : 0;
+                coalescealignskipmax: 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 0;
+                varalignmax     : 4;
+                localalignmin   : 0;
+                localalignmax   : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 8;
+            stacksize    : 16384;
+            stackalign   : 2;
+            abi : abi_default;
+            llvmdatalayout : 'todo';
+          );
+
+  implementation
+
+initialization
+{$ifdef cpu68}
+  {$ifdef atari}
+    set_source_info(system_m68k_sinclairql_info);
+  {$endif atari}
+{$endif cpu68}
+end.

compiler/systems/i_win.pas

@@ -157,7 +157,7 @@ unit i_win;
                 constalignmin   : 0;
                 constalignmax   : 16;
                 varalignmin     : 0;
-                varalignmax     : 16;
+                varalignmax     : 64;
                 localalignmin   : 4;
                 localalignmax   : 16;
                 recordalignmin  : 0;

compiler/systems/t_sinclairql.pas

@@ -0,0 +1,267 @@
+{
+    Copyright (c) 2020 by Free Pascal Development Team
+
+    This unit implements support import, export, link routines
+    for the m68k Sinclair QL target
+
+    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 t_sinclairql;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      rescmn, comprsrc, link;
+
+type
+  PLinkerSinclairQL = ^TLinkerSinclairQL;
+  TLinkerSinclairQL = class(texternallinker)
+    private
+      Origin: DWord;
+      UseVLink: boolean;
+      function WriteResponseFile(isdll: boolean): boolean;
+      procedure SetSinclairQLInfo;
+      function MakeSinclairQLExe: boolean;
+    public
+      constructor Create; override;
+      procedure SetDefaultInfo; override;
+      procedure InitSysInitUnitName; override;
+      function  MakeExecutable: boolean; override;
+  end;
+
+
+implementation
+
+    uses
+       sysutils,cutils,cfileutl,cclasses,aasmbase,
+       globtype,globals,systems,verbose,cscript,fmodule,i_sinclairql;
+
+
+    const
+       DefaultOrigin = $20000;
+
+
+constructor TLinkerSinclairQL.Create;
+begin
+  UseVLink:=(cs_link_vlink in current_settings.globalswitches);
+
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+end;
+
+
+procedure TLinkerSinclairQL.SetSinclairQLInfo;
+begin
+  if ImageBaseSetExplicity then
+    Origin:=ImageBase
+  else
+    Origin:=DefaultOrigin;
+
+  with Info do
+   begin
+    if not UseVLink then
+     begin
+      ExeCmd[1]:='ld $DYNLINK $OPT -d -n -o $EXE $RES';
+     end
+    else
+     begin
+      ExeCmd[1]:='vlink -b rawbin1 $FLAGS $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
+     end;
+   end;
+end;
+
+
+procedure TLinkerSinclairQL.SetDefaultInfo;
+begin
+  if target_info.system = system_m68k_sinclairql then
+    SetSinclairQLInfo;
+end;
+
+
+procedure TLinkerSinclairQL.InitSysInitUnitName;
+begin
+  sysinitunit:='si_prc';
+end;
+
+
+function TLinkerSinclairQL.WriteResponseFile(isdll: boolean): boolean;
+var
+  linkres  : TLinkRes;
+  i        : longint;
+  HPath    : TCmdStrListItem;
+  s        : string;
+  linklibc : boolean;
+begin
+  WriteResponseFile:=False;
+
+  { Open link.res file }
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
+
+  { Write path to search libraries }
+  HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+    begin
+      s:=HPath.Str;
+      if (cs_link_on_target in current_settings.globalswitches) then
+        s:=ScriptFixFileName(s);
+      LinkRes.Add('-L'+s);
+      HPath:=TCmdStrListItem(HPath.Next);
+    end;
+  HPath:=TCmdStrListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+    begin
+      s:=HPath.Str;
+      if s<>'' then
+        LinkRes.Add('SEARCH_DIR("'+s+'")');
+      HPath:=TCmdStrListItem(HPath.Next);
+    end;
+
+  LinkRes.Add('INPUT (');
+  { add objectfiles, start with prt0 always }
+  if not (target_info.system in systems_internal_sysinit) then
+    begin
+      s:=FindObjectFile('prt0','',false);
+      LinkRes.AddFileName(maybequoted(s));
+    end;
+  while not ObjectFiles.Empty do
+    begin
+      s:=ObjectFiles.GetFirst;
+      if s<>'' then
+        begin
+          { vlink doesn't use SEARCH_DIR for object files }
+          if UseVLink then
+             s:=FindObjectFile(s,'',false);
+          LinkRes.AddFileName(maybequoted(s));
+       end;
+    end;
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+    begin
+      { vlink doesn't need, and doesn't support GROUP }
+      if not UseVLink then
+        begin
+          LinkRes.Add(')');
+          LinkRes.Add('GROUP(');
+        end;
+      while not StaticLibFiles.Empty do
+        begin
+          S:=StaticLibFiles.GetFirst;
+          LinkRes.AddFileName(maybequoted(s));
+        end;
+    end;
+
+  LinkRes.Add(')');
+
+  with LinkRes do
+    begin
+      Add('');
+      Add('SECTIONS');
+      Add('{');
+      Add('  . = 0x'+hexstr(Origin,8)+';');
+      Add('  .text : { *(.text .text.* _CODE _CODE.* ) }');
+      Add('  .data : { *(.data .data.* .rodata .rodata.* .fpc.* ) }');
+      Add('  .bss  : { *(_BSS _BSS.*) *(.bss .bss.*) *(_BSSEND _BSSEND.*) *(_HEAP _HEAP.*) *(.stack .stack.*) *(_STACK _STACK.*) }');
+      Add('}');
+    end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.free;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerSinclairQL.MakeSinclairQLExe: boolean;
+var
+  BinStr,
+  CmdStr  : TCmdStr;
+  StripStr: string[40];
+  DynLinkStr : string;
+  GCSectionsStr : string;
+  FlagsStr : string;
+  ExeName: string;
+begin
+  StripStr:='';
+  GCSectionsStr:='';
+  DynLinkStr:='';
+  FlagsStr:='';
+
+  if (cs_link_strip in current_settings.globalswitches) then
+    StripStr:='-s';
+  if rlinkpath<>'' then
+    DynLinkStr:='--rpath-link '+rlinkpath;
+  if UseVLink then
+    begin
+      if create_smartlink_sections then
+        GCSectionsStr:='-gc-all -sc';
+    end;
+
+  ExeName:=current_module.exefilename;
+  if apptype = app_gui then
+    Replace(ExeName,target_info.exeext,'.prg');
+
+  { Call linker }
+  SplitBinCmd(Info.ExeCmd[1],BinStr,CmdStr);
+  binstr:=FindUtil(utilsprefix+BinStr);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(ExeName)));
+  Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName)));
+  Replace(cmdstr,'$FLAGS',FlagsStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+
+  MakeSinclairQLExe:=DoExec(BinStr,CmdStr,true,false);
+end;
+
+
+function TLinkerSinclairQL.MakeExecutable:boolean;
+var
+  success : boolean;
+begin
+  if not(cs_link_nolink in current_settings.globalswitches) then
+    Message1(exec_i_linking,current_module.exefilename);
+
+  { Write used files and libraries }
+  WriteResponseFile(false);
+
+  success:=MakeSinclairQLExe;
+
+  { Remove ReponseFile }
+  if (success) and not(cs_link_nolink in current_settings.globalswitches) then
+    DeleteFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+initialization
+  RegisterLinker(ld_sinclairql,TLinkerSinclairQL);
+  RegisterTarget(system_m68k_sinclairql_info);
+end.

compiler/utils/ppuutils/ppudump.pp

@@ -233,7 +233,8 @@ const
   { 110 } 'MSX-DOS-Z80',
   { 111 } 'Darwin-AArch64',
   { 112 } 'AmstradCPC-Z80',
-  { 113 } 'WASI-WASM32'
+  { 113 } 'SinclairQL-m68k',
+  { 114 } 'WASI-WASM32'
   );
 
 const
@@ -1814,9 +1815,9 @@ end;
 procedure readcommonsym(const s:string; Def: TPpuDef = nil);
 var
   i: integer;
-  n: string;
+  n: ansistring;
 begin
-  n:=ppufile.getstring;
+  n:=readsymstr(ppufile);
   if Def <> nil then
     Def.Name:=n;
   i:=ppufile.getlongint;

compiler/utils/ppuutils/ppuout.pp

@@ -122,7 +122,7 @@ type
 
   public
     DefType: TPpuDefType;
-    Name: string;
+    Name: ansistring;
     FilePos: TPpuFilePos;
     // Symbol/definition reference
     Ref: TPpuRef;

compiler/x86/aasmcpu.pas

@@ -963,7 +963,8 @@ implementation
            while (localsize>0) do
             begin
 {$ifndef i8086}
-              if CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype] then
+              if (CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype])
+                 {$ifdef i386} and not (target_info.system in systems_i386_no_cmov_align) {$endif} then
                 begin
                   for j:=low(alignarray_cmovcpus) to high(alignarray_cmovcpus) do
                    if (localsize>=length(alignarray_cmovcpus[j])) then

compiler/x86/aoptx86.pas

@@ -6211,11 +6211,11 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.PostPeepholeOptLea(var p : tai) : Boolean;
-
       var
-        hp1, hp2, hp3, hp4: tai;
+        hp1, hp2, hp3, hp4, hp5: tai;
       begin
         Result:=false;
+        hp5:=nil;
         { replace
             leal(q) x(<stackpointer>),<stackpointer>
             call   procname
@@ -6258,7 +6258,13 @@ unit aoptx86;
           GetNextInstruction(hp2, hp3) and
           { trick to skip label }
           ((hp3.typ=ait_instruction) or GetNextInstruction(hp3, hp3)) and
-          MatchInstruction(hp3,A_RET,[S_NO]) and
+          (MatchInstruction(hp3,A_RET,[S_NO]) or
+           (MatchInstruction(hp3,A_VZEROUPPER,[S_NO]) and
+            SetAndTest(hp3,hp5) and
+            GetNextInstruction(hp3,hp3) and
+            MatchInstruction(hp3,A_RET,[S_NO])
+           )
+          ) and
           (taicpu(hp3).ops=0) then
           begin
             taicpu(hp1).opcode := A_JMP;
@@ -6267,17 +6273,22 @@ unit aoptx86;
             RemoveCurrentP(p, hp4);
             RemoveInstruction(hp2);
             RemoveInstruction(hp3);
+            if Assigned(hp5) then
+              begin
+                AsmL.Remove(hp5);
+                ASmL.InsertBefore(hp5,hp1)
+              end;
             Result:=true;
           end;
       end;
 
 
     function TX86AsmOptimizer.PostPeepholeOptPush(var p : tai) : Boolean;
-
       var
-        hp1, hp2, hp3, hp4: tai;
+        hp1, hp2, hp3, hp4, hp5: tai;
       begin
         Result:=false;
+        hp5:=nil;
 {$ifdef x86_64}
         { replace
             push %rax
@@ -6309,7 +6320,13 @@ unit aoptx86;
           GetNextInstruction(hp2, hp3) and
           { trick to skip label }
           ((hp3.typ=ait_instruction) or GetNextInstruction(hp3, hp3)) and
-          MatchInstruction(hp3,A_RET,[S_NO]) and
+          (MatchInstruction(hp3,A_RET,[S_NO]) or
+           (MatchInstruction(hp3,A_VZEROUPPER,[S_NO]) and
+            SetAndTest(hp3,hp5) and
+            GetNextInstruction(hp3,hp3) and
+            MatchInstruction(hp3,A_RET,[S_NO])
+           )
+          ) and
           (taicpu(hp3).ops=0) then
           begin
             taicpu(hp1).opcode := A_JMP;
@@ -6318,6 +6335,11 @@ unit aoptx86;
             RemoveCurrentP(p, hp4);
             RemoveInstruction(hp2);
             RemoveInstruction(hp3);
+            if Assigned(hp5) then
+              begin
+                AsmL.Remove(hp5);
+                ASmL.InsertBefore(hp5,hp1)
+              end;
             Result:=true;
           end;
 {$endif x86_64}
@@ -6531,12 +6553,13 @@ unit aoptx86;
 
     function TX86AsmOptimizer.PostPeepholeOptCall(var p : tai) : Boolean;
       var
-        hp1 : tai;
+        hp1,hp3 : tai;
 {$ifndef x86_64}
         hp2 : taicpu;
 {$endif x86_64}
       begin
         Result:=false;
+        hp3:=nil;
 {$ifndef x86_64}
         { don't do this on modern CPUs, this really hurts them due to
           broken call/ret pairing }
@@ -6569,7 +6592,13 @@ unit aoptx86;
         if ((cs_opt_level4 in current_settings.optimizerswitches) or
           (po_noreturn in current_procinfo.procdef.procoptions)) and
           GetNextInstruction(p, hp1) and
-          MatchInstruction(hp1,A_RET,[S_NO]) and
+          (MatchInstruction(hp1,A_RET,[S_NO]) or
+           (MatchInstruction(hp1,A_VZEROUPPER,[S_NO]) and
+            SetAndTest(hp1,hp3) and
+            GetNextInstruction(hp1,hp1) and
+            MatchInstruction(hp1,A_RET,[S_NO])
+           )
+          ) and
           (taicpu(hp1).ops=0) then
           begin
             if (cs_opt_level4 in current_settings.optimizerswitches) and
@@ -6583,6 +6612,11 @@ unit aoptx86;
             else
               DebugMsg(SPeepholeOptimization + 'CallRet2Call done',p);
             RemoveInstruction(hp1);
+            if Assigned(hp3) then
+              begin
+                AsmL.Remove(hp3);
+                AsmL.InsertBefore(hp3,p)
+              end;
             Result:=true;
           end;
       end;

compiler/x86/cgx86.pas

@@ -1582,9 +1582,9 @@ unit cgx86;
                  if UseAVX then
                    begin
                      if GetRefAlignment(tmpref) = 64 then
-                       op := A_VMOVDQA
+                       op := A_VMOVDQA64
                      else
-                       op := A_VMOVDQU;
+                       op := A_VMOVDQU64;
                    end
                  else
                    { SSE doesn't support 512-bit vectors }
@@ -1674,9 +1674,9 @@ unit cgx86;
                  if UseAVX then
                  begin
                    if GetRefAlignment(tmpref) = 64 then
-                     op := A_VMOVDQA
+                     op := A_VMOVDQA64
                    else
-                     op := A_VMOVDQU;
+                     op := A_VMOVDQU64;
                  end else
                    { SSE doesn't support 512-bit vectors }
                    InternalError(2018012945);
@@ -2718,7 +2718,8 @@ unit cgx86;
         push_segment_size = S_W;
 {$endif}
 
-    type  copymode=(copy_move,copy_mmx,copy_string,copy_mm,copy_avx);
+    type
+      copymode=(copy_move,copy_mmx,copy_string,copy_mm,copy_avx,copy_avx512);
 
     var srcref,dstref,tmpref:Treference;
         r,r0,r1,r2,r3:Tregister;
@@ -2779,10 +2780,13 @@ unit cgx86;
 {$ifndef i8086}
       { avx helps only to reduce size, using it in general does at least not help on
         an i7-4770
-        but using the xmm registers reduces register pressure(FK) }
+        but using the xmm registers reduces register pressure (FK) }
       if (FPUX86_HAS_AVXUNIT in fpu_capabilities[current_settings.fputype]) and
-         ({$ifdef i386}(len=8) or{$endif i386}(len=16) or (len=24) or (len=32) or (len=40) or (len=48)) then
-         cm:=copy_avx
+        ((len mod 4)=0) and (len<=48) {$ifndef i386}and (len>=16){$endif i386} then
+        cm:=copy_avx
+      else if (FPUX86_HAS_AVX512F in fpu_capabilities[current_settings.fputype]) and
+        ((len mod 4)=0) and (len<=128) {$ifndef i386}and (len>=16){$endif i386} then
+        cm:=copy_avx512
       else
       { I'am not sure what CPUs would benefit from using sse instructions for moves
         but using the xmm registers reduces register pressure (FK) }
@@ -2949,10 +2953,22 @@ unit cgx86;
               end;
           end;
 
+        copy_avx512,
         copy_avx:
           begin
             hlist:=TAsmList.create;
-            while (len>=32) and (srcref.alignment>=32) and (dstref.alignment>=32) do
+            if cm=copy_avx512 then
+              while len>=64 do
+                begin
+                  r0:=getmmregister(list,OS_M512);
+                  a_loadmm_ref_reg(list,OS_M512,OS_M512,srcref,r0,nil);
+                  a_loadmm_reg_ref(hlist,OS_M512,OS_M512,r0,dstref,nil);
+                  inc(srcref.offset,64);
+                  inc(dstref.offset,64);
+                  dec(len,64);
+                  Include(current_procinfo.flags,pi_uses_ymm);
+                end;
+            while len>=32 do
               begin
                 r0:=getmmregister(list,OS_M256);
                 a_loadmm_ref_reg(list,OS_M256,OS_M256,srcref,r0,nil);
@@ -2980,6 +2996,15 @@ unit cgx86;
                 inc(dstref.offset,8);
                 dec(len,8);
               end;
+            if len>=4 then
+              begin
+                r0:=getintregister(list,OS_32);
+                a_load_ref_reg(list,OS_32,OS_32,srcref,r0);
+                a_load_reg_ref(hlist,OS_32,OS_32,r0,dstref);
+                inc(srcref.offset,4);
+                inc(dstref.offset,4);
+                dec(len,4);
+              end;
             list.concatList(hlist);
             hlist.free;
           end

compiler/x86/x86ins.dat

@@ -7767,7 +7767,7 @@ zmmreg_mz,zmmreg,xmmrm,imm8               \350\351\352\361\372\1\x38\75\120\27
 zmmreg_mz,zmmreg,ymmrm,imm8               \350\351\352\361\372\1\x3A\75\120\27      AVX512,T4
 
 [VMOVDQA32]
-(Ch_All)
+(Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \350\361\370\1\x6F\110                    AVX512,TFVM
 xmmrm_mz,xmmreg                           \350\361\370\1\x7F\101                    AVX512,TFVM
 ymmreg_mz,ymmrm                           \350\361\364\370\1\x6F\110                AVX512,TFVM
@@ -7776,7 +7776,7 @@ zmmreg_mz,zmmrm                           \350\351\361\370\1\x6F\110
 zmmrm_mz,zmmreg                           \350\351\361\370\1\x7F\101                AVX512,TFVM
 
 [VMOVDQA64]
-(Ch_All)
+(Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \350\352\361\370\1\x6F\110                AVX512,TFVM
 xmmrm_mz,xmmreg                           \350\352\361\370\1\x7F\101                AVX512,TFVM
 ymmreg_mz,ymmrm                           \350\352\361\364\370\1\x6F\110            AVX512,TFVM
@@ -7785,7 +7785,7 @@ zmmreg_mz,zmmrm                           \350\351\352\361\370\1\x6F\110
 zmmrm_mz,zmmreg                           \350\351\352\361\370\1\x7F\101            AVX512,TFVM
 
 [VMOVDQU16]
-(Ch_All)
+(Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \334\350\352\370\1\x6F\110                AVX512,TFVM
 xmmrm_mz,xmmreg                           \334\350\352\370\1\x7F\101                AVX512,TFVM
 ymmreg_mz,ymmrm                           \334\350\352\364\370\1\x6F\110            AVX512,TFVM
@@ -7794,7 +7794,7 @@ zmmreg_mz,zmmrm                           \334\350\351\352\370\1\x6F\110
 zmmrm_mz,zmmreg                           \334\350\351\352\370\1\x7F\101            AVX512,TFVM
 
 [VMOVDQU32]
-(Ch_All)
+(Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \333\350\370\1\x6F\110                    AVX512,TFVM
 xmmrm_mz,xmmreg                           \333\350\370\1\x7F\101                    AVX512,TFVM
 ymmreg_mz,ymmrm                           \333\350\364\370\1\x6F\110                AVX512,TFVM
@@ -7803,7 +7803,7 @@ zmmreg_mz,zmmrm                           \333\350\351\370\1\x6F\110
 zmmrm_mz,zmmreg                           \333\350\351\370\1\x7F\101                AVX512,TFVM
 
 [VMOVDQU64]
-(Ch_All)
+(Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \333\350\352\370\1\x6F\110                AVX512,TFVM
 xmmrm_mz,xmmreg                           \333\350\352\370\1\x7F\101                AVX512,TFVM
 ymmreg_mz,ymmrm                           \333\350\352\364\370\1\x6F\110            AVX512,TFVM
@@ -7812,7 +7812,7 @@ zmmreg_mz,zmmrm                           \333\350\351\352\370\1\x6F\110
 zmmrm_mz,zmmreg                           \333\350\351\352\370\1\x7F\101            AVX512,TFVM
 
 [VMOVDQU8]
-(Ch_All)
+(Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \334\350\370\1\x6F\110                    AVX512,TFVM
 xmmrm_mz,xmmreg                           \334\350\370\1\x7F\101                    AVX512,TFVM
 ymmreg_mz,ymmrm                           \334\350\364\370\1\x6F\110                AVX512,TFVM

compiler/x86_64/x8664pro.inc

@@ -1257,12 +1257,12 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
+(Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

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

@@ -107,11 +107,11 @@ const
       'fixedFMT',           // ftFmtBCD
       'string.uni',         // ftFixedWideChar
       'bin.hex:WideText',   // ftWideMemo
-      '',                   // ftOraTimeStamp
+      'SQLdateTime',        // ftOraTimeStamp
       '',                   // ftOraInterval
-      'i4',                 // ftLongWord
-      '',                   // ftShortint
-      '',                   // ftByte
+      'ui4',                // ftLongWord
+      'i1',                 // ftShortint
+      'ui1',                // ftByte
       ''                    // ftExtended
     );
 

packages/fcl-js/src/jstree.pp

@@ -230,7 +230,7 @@ Type
     Property Elements[AIndex : Integer] : TJSArrayLiteralElement Read GetE ; default;
   end;
 
-  { TJSArrayLiteral - [element1,...] }
+  { TJSArrayLiteral - [element1,...] or Args of a function }
 
   TJSArrayLiteral = Class(TJSElement)
   private
@@ -328,6 +328,7 @@ Type
   Public
     Destructor Destroy; override;
     procedure AddArg(El: TJSElement);
+    procedure InsertArg(Index: integer; El: TJSElement);
     Property Expr : TJSElement Read FExpr Write FExpr;
     Property Args : TJSArguments Read FArgs Write FArgs;
   end;
@@ -1698,6 +1699,14 @@ begin
   Args.Elements.AddElement.Expr:=El;
 end;
 
+procedure TJSCallExpression.InsertArg(Index: integer; El: TJSElement);
+var
+  NewEl: TJSArrayLiteralElement;
+begin
+  NewEl:=TJSArrayLiteralElement(Args.Elements.Insert(Index));
+  NewEl.Expr:=El;
+end;
+
 { TJSUnary }
 
 Class function TJSUnary.PrefixOperatorToken: tjsToken;

packages/fcl-passrc/src/pasresolver.pp

@@ -2341,8 +2341,9 @@ type
     function IsClassMethod(El: TPasElement): boolean;
     function IsClassField(El: TPasElement): boolean;
     function GetFunctionType(El: TPasElement): TPasFunctionType;
-    function MethodIsStatic(El: TPasProcedure): boolean;
+    function MethodIsStatic(El: TPasProcedure): boolean; // does not check if El is a method
     function IsMethod(El: TPasProcedure): boolean;
+    function IsMethod_SelfIsClass(El: TPasElement): boolean;
     function IsHelperMethod(El: TPasElement): boolean; virtual;
     function IsHelper(El: TPasElement): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
@@ -2372,6 +2373,7 @@ type
     function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
     function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
     function ProcNeedsParams(El: TPasProcedureType): boolean;
+    function ProcHasSelf(El: TPasProcedure): boolean; // returns false for local procs
     function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
     function GetTopLvlProc(El: TPasElement): TPasProcedure;
     function GetParentProc(El: TPasElement; GetDeclProc: boolean): TPasProcedure;
@@ -10836,6 +10838,30 @@ procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
       end;
   end;
 
+  procedure CheckIncompatibleProc(const CallName: string;
+    FoundProcType: TPasProcedureType; TemplParamsCnt: integer);
+  var
+    FoundTemplCnt: Integer;
+    aName: String;
+  begin
+    CheckCallProcCompatibility(FoundProcType,Params,true);
+    if FoundProcType.GenericTemplateTypes<>nil then
+      FoundTemplCnt:=FoundProcType.GenericTemplateTypes.Count
+    else
+      FoundTemplCnt:=0;
+    if TemplParamsCnt<>FoundTemplCnt then
+      begin
+      if FoundProcType.Parent is TPasProcedure then
+        aName:=FoundProcType.Parent.Name
+      else
+        aName:=FoundProcType.Name;
+      if aName='' then
+        aName:=GetObjPath(FoundProcType);
+      RaiseMsg(20201101205447,nXExpectedButYFound,sXExpectedButYFound,
+               [aName,CallName+GetGenericParamCommas(TemplParamsCnt)],Params);
+      end;
+  end;
+
 var
   FindCallData: TFindCallElData;
   Abort: boolean;
@@ -10880,7 +10906,7 @@ begin
     WriteScopes;
     {$ENDIF}
     if FoundEl is TPasProcedure then
-      CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true)
+      CheckIncompatibleProc(CallName,TPasProcedure(FoundEl).ProcType,TemplParamsCnt)
     else if FoundEl is TPasProcedureType then
       CheckTypeCast(TPasProcedureType(FoundEl),Params,true)
     else if FoundEl.ClassType=TPasUnresolvedSymbolRef then
@@ -10903,7 +10929,7 @@ begin
       begin
       TypeEl:=ResolveAliasType(TPasVariable(FoundEl).VarType);
       if TypeEl is TPasProcedureType then
-        CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
+        CheckIncompatibleProc(CallName,TPasProcedureType(TypeEl),TemplParamsCnt)
       else
         RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,
                  ['(',TypeEl.ElementTypeName],Params);
@@ -10912,7 +10938,7 @@ begin
       begin
       TypeEl:=ResolveAliasType(TPasArgument(FoundEl).ArgType);
       if TypeEl is TPasProcedureType then
-        CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
+        CheckIncompatibleProc(CallName,TPasProcedureType(TypeEl),TemplParamsCnt)
       else
         RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,
                  ['(',TypeEl.ElementTypeName],Params);
@@ -28418,7 +28444,7 @@ end;
 
 function TPasResolver.MethodIsStatic(El: TPasProcedure): boolean;
 begin
-  Result:=(ptmStatic in El.ProcType.Modifiers)
+  Result:=El.IsStatic
     or (El.ClassType=TPasClassConstructor)
     or (El.ClassType=TPasClassDestructor);
 end;
@@ -28435,6 +28461,16 @@ begin
   Result:=IsMethod(ProcScope.DeclarationProc);
 end;
 
+function TPasResolver.IsMethod_SelfIsClass(El: TPasElement): boolean;
+var
+  C: TClass;
+begin
+  if (El=nil) then exit(false);
+  C:=El.ClassType;
+  Result:=((C=TPasClassProcedure) or (C=TPasClassFunction) or (C=TPasClassOperator))
+      and not TPasProcedure(El).IsStatic;
+end;
+
 function TPasResolver.IsHelperMethod(El: TPasElement): boolean;
 begin
   Result:=(El is TPasProcedure) and (El.Parent is TPasClassType)
@@ -28995,6 +29031,21 @@ begin
   Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
 end;
 
+function TPasResolver.ProcHasSelf(El: TPasProcedure): boolean;
+var
+  C: TClass;
+begin
+  if El.IsStatic then
+    exit(false);
+  C:=El.Parent.ClassType;
+  if C.InheritsFrom(TPasSection) or (C=TProcedureBody) then
+    exit(false);
+  C:=El.ClassType;
+  if (C=TPasClassConstructor) or (C=TPasClassDestructor) then
+    exit(false);
+  Result:=true;
+end;
+
 function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
   ): boolean;
 var

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -2388,6 +2388,8 @@ begin
           RaiseNotSupported(20180328224632,aClass,GetObjName(o));
         end;
     end;
+
+  UseAttributes(El);
 end;
 
 procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);

packages/fcl-passrc/src/pscanner.pp

@@ -3424,6 +3424,12 @@ begin
     if p=StartP then
       Error(nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization']);
     OptName:=copy(Param,StartP,p-StartP);
+    if lowercase(LeftStr(OptName,2))='no' then
+      begin
+      Delete(OptName,1,2);
+      DoHandleOptimization(OptName,'-');
+      exit;
+      end;
     // skip whitespace
     while (p<=l) and (Param[p] in [' ',#9,#10,#13]) do
       inc(p);

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -138,6 +138,7 @@ type
     procedure TestGenProc_FunctionDelphi;
     procedure TestGenProc_OverloadDuplicate;
     procedure TestGenProc_MissingTemplatesFail;
+    procedure TestGenProc_SpecializeNonGenericFail;
     procedure TestGenProc_Forward;
     procedure TestGenProc_External;
     procedure TestGenProc_UnitIntf;
@@ -2216,6 +2217,19 @@ begin
   CheckParserException('Expected "<"',nParserExpectTokenError);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_SpecializeNonGenericFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Run;',
+  'begin',
+  'end;',
+  'begin',
+  '  specialize Run<word>();',
+  '']);
+  CheckResolverException('Run expected, but Run<> found',nXExpectedButYFound);
+end;
+
 procedure TTestResolveGenerics.TestGenProc_Forward;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -178,6 +178,7 @@ type
     procedure TestWP_Attributes;
     procedure TestWP_Attributes_ForwardClass;
     procedure TestWP_Attributes_Params;
+    procedure TestWP_Attributes_PublishedFields; // ToDo
 
     // scope references
     procedure TestSR_Proc_UnitVar;
@@ -3427,15 +3428,20 @@ begin
   '  TObject = class',
   '    constructor {#TObject_Create_used}Create;',
   '  end;',
+  '  {#TRedAttribute_notused}TRedAttribute = class',
+  '  end;',
   '  {#TCustomAttribute_used}TCustomAttribute = class',
   '  end;',
   '  [TCustom]',
   '  TBird = class;',
   '  TMyInt = word;',
   '  TBird = class end;',
-  'constructor TObject.Create; begin end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'var b: TBird;',
   'begin',
-  '  if typeinfo(TBird)=nil then ;',
+  '  b:=TBird.Create;',
   '']);
   AnalyzeWholeProgram;
 end;
@@ -3471,6 +3477,46 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_Attributes_PublishedFields;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#TObject_Create_notused}Create;',
+  '    destructor {#TObject_Destroy_used}Destroy; virtual;',
+  '  end;',
+  '  {#TCustomAttribute_used}TCustomAttribute = class',
+  '  end;',
+  '  {#BigAttribute_used}BigAttribute = class(TCustomAttribute)',
+  '    constructor {#Big_A_used}Create(Id: word = 3); overload;',
+  '    destructor {#Big_B_used}Destroy; override;',
+  '  end;',
+  '  {$M+}',
+  '  TBird = class',
+  '  public',
+  '    FColor: word;',
+  '  published',
+  '    Size: word;',
+  '    procedure Fly;',
+  '    [Big(3)]',
+  '    property Color: word read FColor;',
+  '  end;',
+  'constructor TObject.Create; begin end;',
+  'destructor TObject.Destroy; begin end;',
+  'constructor BigAttribute.Create(Id: word); begin end;',
+  'destructor BigAttribute.Destroy; begin end;',
+  'var',
+  '  b: TBird;',
+  'begin',
+  '  if typeinfo(b)=nil then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
 begin
   StartUnit(false);

packages/fcl-pdf/src/fppdf.pp

@@ -1294,7 +1294,7 @@ begin
     fmt := '%.2d:%.2d'
   else
     fmt := '%.2d''%.2d''';
-  i := GetLocalTimeOffset(ADate); //min
+  i := GetLocalTimeOffset(ADate, False); //min
   if i < 0 then
     Result := '+'
   else if i = 0 then begin

packages/fcl-res/src/coffconsts.pp

@@ -56,6 +56,7 @@ const
   IMAGE_FILE_MACHINE_EBC             = $0EBC;  // EFI Byte Code
 }
   IMAGE_FILE_MACHINE_AMD64           = $8664;  // AMD64 (K8)
+  IMAGE_FILE_MACHINE_ARM64           = $aa64;  // ARM64 little endian
 {
   IMAGE_FILE_MACHINE_M32R            = $9041;  // M32R little-endian
   IMAGE_FILE_MACHINE_CEE             = $C0EE;
@@ -159,6 +160,27 @@ const
   IMAGE_REL_AMD64_PAIR          = $000F;
   IMAGE_REL_AMD64_SSPAN32       = $0010;  // 32 bit signed span-dependent value applied at link time
 
+// aarch64 relocation types
+
+  IMAGE_REL_ARM64_ABSOLUTE      = $0000;  // The relocation is ignored.
+  IMAGE_REL_ARM64_ADDR32        = $0001;  // The 32-bit VA of the target.
+  IMAGE_REL_ARM64_ADDR32NB      = $0002;  // The 32-bit RVA of the target.
+  IMAGE_REL_ARM64_BRANCH26      = $0003;  // The 26-bit relative displacement to the target, for B and BL instructions.
+  IMAGE_REL_ARM64_PAGEBASE_REL21= $0004;  // The page base of the target, for ADRP instruction.
+  IMAGE_REL_ARM64_REL21         = $0005;  // The 12-bit relative displacement to the target, for instruction ADR
+  IMAGE_REL_ARM64_PAGEOFFSET_12A= $0006;  // The 12-bit page offset of the target, for instructions ADD/ADDS (immediate) with zero shift.
+  IMAGE_REL_ARM64_PAGEOFFSET_12L= $0007;  // The 12-bit page offset of the target, for instruction LDR (indexed, unsigned immediate).
+  IMAGE_REL_ARM64_SECREL        = $0008;  // The 32-bit offset of the target from the beginning of its section. This is used to support debugging information and static thread local storage.
+  IMAGE_REL_ARM64_SECREL_LOW12A = $0009;  // Bit 0:11 of section offset of the target, for instructions ADD/ADDS (immediate) with zero shift.
+  IMAGE_REL_ARM64_SECREL_HIGH12A= $000A;  // Bit 12:23 of section offset of the target, for instructions ADD/ADDS (immediate) with zero shift.
+  IMAGE_REL_ARM64_SECREL_LOW12L = $000B;  // Bit 0:11 of section offset of the target, for instruction LDR (indexed, unsigned immediate).
+  IMAGE_REL_ARM64_TOKEN         = $000C;  // CLR token.
+  IMAGE_REL_ARM64_SECTION       = $000D;  // The 16-bit section index of the section that contains the target. This is used to support debugging information.
+  IMAGE_REL_ARM64_ADDR64        = $000E;  // The 64-bit VA of the relocation target.
+  IMAGE_REL_ARM64_BRANCH19      = $000F;  // The 19-bit offset to the relocation target, for conditional B instruction.
+  IMAGE_REL_ARM64_BRANCH14      = $0010;  // The 14-bit offset to the relocation target, for instructions TBZ and TBNZ.
+  IMAGE_REL_ARM64_REL32         = $0011;  // The 32-bit relative address from the byte following the relocation.
+
 // AIX PPC32/PPC64 relocation types.
 
   IMAGE_REL_PPC_POS             = $1F00;  // A(sym) Positive Relocation

packages/fcl-res/src/cofftypes.pp

@@ -20,7 +20,7 @@ unit cofftypes;
 interface
 
 type
-  TCoffMachineType = (cmti386, cmtarm, cmtx8664, cmtppc32aix, cmtppc64aix);
+  TCoffMachineType = (cmti386, cmtarm, cmtx8664, cmtppc32aix, cmtppc64aix, cmtaarch64);
 
 type
   TSectionName = array [0..7] of char;

packages/fcl-res/src/coffwriter.pp

@@ -452,6 +452,7 @@ begin
     cmti386     : Result.machine:=IMAGE_FILE_MACHINE_I386;
     cmtarm      : Result.machine:=IMAGE_FILE_MACHINE_ARM;
     cmtx8664    : Result.machine:=IMAGE_FILE_MACHINE_AMD64;
+    cmtaarch64  : Result.machine:=IMAGE_FILE_MACHINE_ARM64;
     cmtppc32aix : Result.machine:=IMAGE_FILE_MACHINE_POWERPC32_AIX;
     cmtppc64aix : Result.machine:=IMAGE_FILE_MACHINE_POWERPC64_AIX;
   end;
@@ -527,7 +528,7 @@ procedure TCoffResourceWriter.SetMachineType(AValue: TCoffMachineType);
 begin
   fMachineType:=AValue;
 {$IFDEF ENDIAN_BIG}
-  if fMachineType in [cmti386,cmtx8664,cmtarm] then
+  if fMachineType in [cmti386,cmtx8664,cmtarm,cmtaarch64] then
     fOppositeEndianess:=true;
 {$ELSE}
   if fMachineType in [cmtppc32aix,cmtppc64aix] then
@@ -536,7 +537,8 @@ begin
   case fMachineType of
     cmti386,
     cmtx8664,
-    cmtarm:
+    cmtarm,
+    cmtaarch64:
       fSymStorageClass:=IMAGE_SYM_CLASS_STATIC;
     cmtppc32aix,
     cmtppc64aix:
@@ -737,6 +739,7 @@ begin
     cmti386     : reloctype:=IMAGE_REL_I386_DIR32NB;
     cmtarm      : reloctype:=IMAGE_REL_ARM_ADDR32NB;
     cmtx8664    : reloctype:=IMAGE_REL_AMD64_ADDR32NB;
+    cmtaarch64  : reloctype:=IMAGE_REL_ARM64_ADDR32NB;
     cmtppc32aix : reloctype:=IMAGE_REL_PPC_POS;
     cmtppc64aix : reloctype:=IMAGE_REL_PPC_POS;
   end;

packages/fpmkunit/src/fpmkunit.pp

@@ -2838,7 +2838,7 @@ begin
       powerpc64:result := GetGccDirArch('cpupowerpc64','-m64');
       arm:      result := GetGccDirArch('cpuarm','-marm -march=armv2');
       aarch64:  result := GetGccDirArch('cpuaarch64','-march=aarch64 -mcmodel=large');
-      m68k:     result := GetGccDirArch('cpum68k','');
+      m68k:     result := GetGccDirArch('cpum68k','-march=68020');
       mips:     result := GetGccDirArch('cpumips','-mips32 -EB -mabi=32');
       mipsel:   result := GetGccDirArch('cpumipsel','-mips32 -EL -mabi=32');
       riscv32:  result := GetGccDirArch('cpuriscv32','-march=rv32imafdc');

packages/libxml/src/xmlxsdparser.pas

@@ -14,7 +14,7 @@ interface
 
 uses
   {$IFDEF MSWINDOWS}windows,{$ENDIF}
-  {$IFDEF UNIX}unixutil,{$ENDIF}
+  {$IFDEF UNIX}unix,{$ENDIF}
   sysutils,
   dateutils,
   math,

packages/pastojs/src/fppas2js.pp

@@ -1387,8 +1387,7 @@ type
     coRTLVersionCheckMain, // insert rtl version check into main
     coRTLVersionCheckSystem, // insert rtl version check into system unit init
     coRTLVersionCheckUnit, // insert rtl version check into every unit init
-    coShortRefGlobals, // use short local variables for global identifiers
-    coShortRefGenFunc // create short local vars for generic methods
+    coShortRefGlobals // use short local variables for global identifiers
     );
   TPasToJsConverterOptions = set of TPasToJsConverterOption;
 const
@@ -1544,6 +1543,7 @@ type
     procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
       override;
     function SpecializeParamsNeedDelay(SpecializedItem: TPRSpecializedItem): TPasElement; virtual;
+    function IsSpecializedNonStaticMethod(ProcType: TPasProcedureType): boolean;
   protected
     const
       cJSValueConversion = 2*cTypeConversion;
@@ -2041,6 +2041,7 @@ type
     Function CreateStaticProcPath(El: TPasProcedure; AContext: TConvertContext): string; virtual;
     Function CreateGlobalElPath(El: TPasElement; AContext: TConvertContext): string; virtual;
     Function GetLocalName(El: TPasElement; const Filter: TCtxVarKinds; AContext: TConvertContext): string;
+    Function ProcCanHaveShortRef(Proc: TPasProcedure): boolean;
     Procedure StoreImplJSLocal(El: TPasElement; AContext: TConvertContext); virtual;
     Procedure StoreImplJSLocals(ModScope: TPas2JSModuleScope; IntfContext: TSectionContext); virtual;
     Procedure RestoreImplJSLocals(ModScope: TPas2JSModuleScope; IntfContext: TSectionContext); virtual;
@@ -2942,6 +2943,10 @@ procedure TPas2jsPasScanner.DoHandleOptimization(OptName, OptValue: string);
 
 begin
   case lowercase(OptName) of
+  'enumnumbers':
+    HandleBoolean(coEnumNumbers,true);
+  'usestrict':
+    HandleBoolean(coUseStrict,true);
   'jsshortrefglobals':
     HandleBoolean(coShortRefGlobals,true);
   else
@@ -5250,6 +5255,25 @@ begin
     end;
 end;
 
+function TPas2JSResolver.IsSpecializedNonStaticMethod(
+  ProcType: TPasProcedureType): boolean;
+var
+  Proc: TPasProcedure;
+  Scope: TPas2JSProcedureScope;
+begin
+  if not (ProcType.Parent is TPasProcedure) then
+    exit(false); // not a method
+  Proc:=TPasProcedure(ProcType.Parent);
+  if Proc.IsStatic or Proc.IsExternal then
+    exit(false);
+  if not (Proc.Parent is TPasMembersType) then
+    exit(false); // not a method
+  Scope:=TPas2JSProcedureScope(Proc.CustomData);
+  if Scope.SpecializedFromItem=nil then
+    exit(false);
+  Result:=true;
+end;
+
 function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType
   ): TResElDataPas2JSBaseType;
 var
@@ -8281,7 +8305,7 @@ end;
 function TPasToJSConverter.ConvertInlineSpecializeExpr(
   El: TInlineSpecializeExpr; AContext: TConvertContext): TJSElement;
 begin
-  Result:=ConvertElement(El.NameExpr,AContext);
+  Result:=ConvertExpression(El.NameExpr,AContext);
 end;
 
 function TPasToJSConverter.GetExpressionValueType(El: TPasExpr;
@@ -9499,6 +9523,20 @@ begin
     Result:=CreateDotNameExpr(El,LeftJS,TJSString(TransformElToJSName(RightRefDecl,AContext)));
     exit;
     end;
+  if RightRefDecl is TPasProcedure then
+    begin
+    Proc:=TPasProcedure(RightRefDecl);
+    if coShortRefGlobals in Options then
+      begin
+      if not aResolver.ProcHasSelf(Proc) then
+        begin
+        // a.StaticProc  ->  $lp(defaultargs)
+        // ToDo: check if left side has only types (no call nor field)
+        Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,aContext);
+        exit;
+        end;
+      end;
+    end;
 
   LeftJS:=nil;
   if aResolver.IsHelper(RightRefDecl.Parent) then
@@ -9579,9 +9617,9 @@ begin
       exit(DotContext.JS);
       end;
   finally
-    DotContext.Free;
-    if RightJS=nil then
+    if (RightJS=nil) and (DotContext.JSElement=LeftJS) then
       LeftJS.Free;
+    DotContext.Free;
   end;
   if RightJS is TJSLiteral then
     begin
@@ -9756,6 +9794,7 @@ function TPasToJSConverter.ConvertIdentifierExpr(El: TPasExpr;
   const aName: string; AContext: TConvertContext): TJSElement;
 var
   AssignContext: TAssignContext;
+  ApplyParam: TJSElement;
 
   procedure CallImplicit(Decl: TPasElement);
   var
@@ -9787,6 +9826,15 @@ var
     Call:=nil;
     try
       CreateProcedureCall(Call,nil,ProcType,AContext);
+      if ApplyParam<>nil then
+        begin
+        if Call.Args=nil then
+          Call.Args:=TJSArguments(CreateElement(TJSArguments,ProcType));
+        Call.InsertArg(0,ApplyParam);
+        ApplyParam:=nil;
+        if AContext is TDotContext then
+          TDotContext(AContext).JS:=Call;
+        end;
       Call.Expr:=Result;
       if NeedIntfRef then
         // $ir.ref(id,fnname())
@@ -9794,10 +9842,40 @@ var
       Result:=Call;
     finally
       if Result<>Call then
+        begin
         Call.Free;
+        ApplyParam.Free;
+        end;
     end;
   end;
 
+  function CreateShortRefImplictCall_Apply(TargetProc: TPasProcedure;
+    Ref: TResolvedReference): string;
+  var
+    ApplyPath: String;
+  begin
+    // ProcName; -> "$lp.apply(this,args);"  or  "$lp.apply($with,args);"
+    Result:=CreateStaticProcPath(TargetProc,AContext)+'.apply';
+
+    ApplyPath:=CreateReferencePath(TargetProc,AContext,rpkPath,false,Ref);
+    if AContext is TDotContext then
+      begin
+      ApplyParam:=AContext.JSElement;
+      AContext.JSElement:=nil;
+      if ApplyPath<>'' then
+        // e.g. "$class"
+        ApplyParam:=CreateDotNameExpr(El,ApplyParam,TJSString(ApplyPath));
+      end
+    else
+      begin
+      if ApplyPath='' then
+        RaiseNotSupported(El,AContext,20201101022637);
+      ApplyParam:=CreatePrimitiveDotExpr(ApplyPath,El);
+      end;
+    if ApplyParam=nil then
+      RaiseNotSupported(El,AContext,20201101021136);
+  end;
+
   procedure CallTypeSetter;
   var
     Call: TJSCallExpression;
@@ -9888,6 +9966,7 @@ begin
 
   Prop:=nil;
   AssignContext:=nil;
+  ApplyParam:=nil;
   IsImplicitCall:=rrfImplicitCallWithoutParams in Ref.Flags;
   if AContext.Access=caAssign then
     AssignContext:=AContext.AccessContext as TAssignContext;
@@ -10018,61 +10097,74 @@ begin
   //  end;
   {$ENDIF}
 
-  if Decl is TPasModule then
-    Name:=TransformModuleName(TPasModule(Decl),true,AContext)
-  else if (Decl is TPasResultElement) then
-    begin
-    Name:=ResolverResultVar;
-    Proc:=Decl.Parent.Parent as TPasProcedure;
-    FuncScope:=Proc.CustomData as TPas2JSProcedureScope;
-    if FuncScope.ImplProc<>nil then
-      FuncScope:=FuncScope.ImplProc.CustomData as TPas2JSProcedureScope;
-    if FuncScope.ResultVarName<>'' then
-      Name:=FuncScope.ResultVarName;
-    end
-  else if Decl.ClassType=TPasEnumValue then
-    begin
-    if UseEnumNumbers then
+  try
+    if Decl is TPasModule then
+      Name:=TransformModuleName(TPasModule(Decl),true,AContext)
+    else if (Decl is TPasResultElement) then
+      begin
+      Name:=ResolverResultVar;
+      Proc:=Decl.Parent.Parent as TPasProcedure;
+      FuncScope:=Proc.CustomData as TPas2JSProcedureScope;
+      if FuncScope.ImplProc<>nil then
+        FuncScope:=FuncScope.ImplProc.CustomData as TPas2JSProcedureScope;
+      if FuncScope.ResultVarName<>'' then
+        Name:=FuncScope.ResultVarName;
+      end
+    else if Decl.ClassType=TPasEnumValue then
       begin
-      Result:=CreateLiteralNumber(El,(Decl.Parent as TPasEnumType).Values.IndexOf(Decl));
-      exit;
+      if UseEnumNumbers then
+        begin
+        Result:=CreateLiteralNumber(El,(Decl.Parent as TPasEnumType).Values.IndexOf(Decl));
+        exit;
+        end
+      else
+        begin
+        // enums always need the full path
+        Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,true);
+        end;
+      end
+    else if Decl.ClassType=TPasArgument then
+      Name:=TransformArgName(TPasArgument(Decl),AContext)
+    else if Decl is TPasProcedure then
+      begin
+      Proc:=TPasProcedure(Decl);
+      if (coShortRefGlobals in Options)
+          and aResolver.IsSpecializedNonStaticMethod(Proc.ProcType) then
+        Name:=CreateShortRefImplictCall_Apply(Proc,Ref)
+      else
+        Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
       end
     else
-      begin
-      // enums always need the full path
-      Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,true);
-      end;
-    end
-  else if Decl.ClassType=TPasArgument then
-    Name:=TransformArgName(TPasArgument(Decl),AContext)
-  else
-    Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
-  if Name='' then
-    RaiseNotSupported(El,AContext,20180509134804,GetObjName(Decl));
+      Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
+    if Name='' then
+      RaiseNotSupported(El,AContext,20180509134804,GetObjName(Decl));
 
-  if Result=nil then
-    begin
-    if (Name[1]='[') and (Name[length(Name)]=']')
-        and (AContext is TDotContext)
-        and (AContext.JSElement<>nil) then
+    if Result=nil then
       begin
-      // e.g. Obj.A  with A having an external name '["name"]';
-      // -> Obj["name"]
-      if IsImplicitCall then
-        RaiseNotSupported(El,AContext,20180509134951,Name);
-      BracketExpr:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
-      TDotContext(AContext).JS:=BracketExpr;
-      BracketExpr.MExpr:=AContext.JSElement;
-      Result:=CreateLiteralCustomValue(El,TJSString(copy(Name,2,length(Name)-2)));
-      BracketExpr.Name:=Result;
-      exit;
+      if (Name[1]='[') and (Name[length(Name)]=']')
+          and (AContext is TDotContext)
+          and (AContext.JSElement<>nil) then
+        begin
+        // e.g. Obj.A  with A having an external name '["name"]';
+        // -> Obj["name"]
+        if IsImplicitCall then
+          RaiseNotSupported(El,AContext,20180509134951,Name);
+        BracketExpr:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+        TDotContext(AContext).JS:=BracketExpr;
+        BracketExpr.MExpr:=AContext.JSElement;
+        Result:=CreateLiteralCustomValue(El,TJSString(copy(Name,2,length(Name)-2)));
+        BracketExpr.Name:=Result;
+        exit;
+        end;
+      Result:=CreatePrimitiveDotExpr(Name,El);
       end;
-    Result:=CreatePrimitiveDotExpr(Name,El);
-    end;
 
-  if IsImplicitCall then
-    CallImplicit(Decl);
-  CallTypeSetter;
+    if IsImplicitCall then
+      CallImplicit(Decl);
+    CallTypeSetter;
+  finally
+    ApplyParam.Free;
+  end;
 end;
 
 function TPasToJSConverter.ConvertBoolConstExpression(El: TBoolConstExpr;
@@ -11270,10 +11362,43 @@ var
       Elements:=Call.Args.Elements;
   end;
 
+  procedure CreateShortRefApply(Value: TPasExpr; TargetProcType: TPasProcedureType);
+  var
+    TargetProc: TPasProcedure;
+    aName: String;
+    LeftJS: TJSElement;
+    Ref: TResolvedReference;
+  begin
+    // create  "$lp.apply(LeftJS,args);"
+    TargetProc:=TPasProcedure(TargetProcType.Parent);
+    aName:=CreateStaticProcPath(TargetProc,AContext);
+    Call.Expr:=CreatePrimitiveDotExpr(aName+'.apply',Value);
+    if DotBin<>nil then
+      begin
+      // a.b() -> "$lp.apply(a,args);"
+      LeftJS:=ConvertExpression(DotBin.left,AContext);
+      if LeftJS=nil then
+        RaiseNotSupported(DotBin,AContext,20201030235816);
+      end
+    else if Value.CustomData is TResolvedReference then
+      begin
+      // a() -> "$lp.apply(this,args);"  or  "$lp.apply($with,args);"
+      Ref:=TResolvedReference(Value.CustomData);
+      aName:=CreateReferencePath(TargetProc,AContext,rpkPath,false,Ref);
+      LeftJS:=CreatePrimitiveDotExpr(aName,Value);
+      if LeftJS=nil then
+        RaiseNotSupported(DotBin,AContext,20201031003202);
+      end
+    else
+      RaiseNotSupported(DotBin,AContext,202010310032046);
+    Elements.AddElement.Expr:=LeftJS;
+  end;
+
 var
   Decl: TPasElement;
   Ref: TResolvedReference;
   BuiltInProc: TResElDataBuiltInProc;
+  TargetProc: TPasProcedure;
   TargetProcType: TPasProcedureType;
   JsArrLit: TJSArrayLiteral;
   OldAccess: TCtxAccess;
@@ -11416,15 +11541,16 @@ begin
       end
     else if C.InheritsFrom(TPasProcedure) then
       begin
-      if aResolver.IsHelperMethod(Decl) then
+      TargetProc:=TPasProcedure(Decl);
+      if aResolver.IsHelperMethod(TargetProc) then
         begin
         // calling a helper method
-        Result:=CreateCallHelperMethod(TPasProcedure(Decl),El.Value,AContext);
+        Result:=CreateCallHelperMethod(TargetProc,El.Value,AContext);
         exit;
         end;
-      TargetProcType:=TPasProcedure(Decl).ProcType;
-      if aResolver.IsExternalBracketAccessor(Decl) then
+      if aResolver.IsExternalBracketAccessor(TargetProc) then
         exit(CreateExternalBracketAccessorCall(El,AContext));
+      TargetProcType:=TargetProc.ProcType;
       end
     else if (C=TPasClassType)
         or (C=TPasClassOfType)
@@ -11677,15 +11803,6 @@ begin
   OldAccess:=AContext.Access;
   try
     AContext.Access:=caRead;
-    if Call.Expr=nil then
-      begin
-      if DotBin<>nil then
-        Call.Expr:=ConvertSubIdentExprCustom(DotBin,AContext)
-      else
-        Call.Expr:=ConvertExpression(El.Value,AContext);
-      end;
-    //if Call.Expr is TPrimitiveExpr then
-    //  writeln('TPasToJSConverter.ConvertFuncParams ',TPrimitiveExpr(Call.Expr).GetDeclaration(true));
     if Call.Args=nil then
       begin
       // append ()
@@ -11694,12 +11811,26 @@ begin
       end
     else if Elements=nil then
       RaiseInconsistency(20180720154413,El);
+
+    if Call.Expr=nil then
+      begin
+      if (coShortRefGlobals in Options)
+          and aResolver.IsSpecializedNonStaticMethod(TargetProcType) then
+        CreateShortRefApply(Value,TargetProcType)
+      else if DotBin<>nil then
+        Call.Expr:=ConvertSubIdentExprCustom(DotBin,AContext)
+      else
+        Call.Expr:=ConvertExpression(Value,AContext);
+      end;
+    //if Call.Expr is TPrimitiveExpr then
+    //  writeln('TPasToJSConverter.ConvertFuncParams ',TPrimitiveExpr(Call.Expr).GetDeclaration(true));
     CreateProcedureCallArgs(Elements,El,TargetProcType,AContext);
     CallArgs:=Call.Args;
+
     if (Elements.Count=0)
-        and (CallArgs.Elements.Count>0)
-        then
+        and (CallArgs.Elements.Count>0) then
       begin
+      // for example: rrfNewInstance
       LastArg:=CallArgs.Elements[CallArgs.Elements.Count-1];
       if not (LastArg.Expr is TJSArrayLiteral) then
         RaiseNotSupported(El,AContext,20180720161317);
@@ -11708,6 +11839,7 @@ begin
         RaiseNotSupported(El,AContext,20180720161324);
       LastArg.Free;
       end;
+
     if CallArgs.Elements.Count=0 then
       begin
       CallArgs.Free;
@@ -14881,20 +15013,45 @@ Var
     i: Integer;
     P: TPasElement;
     C: TClass;
+    Proc: TPasProcedure;
+    aResolver: TPas2JSResolver;
   begin
+    aResolver:=AContext.Resolver;
     For i:=0 to Decls.Count-1 do
       begin
       P:=TPasElement(Decls[i]);
       if not IsElementUsed(P) then continue;
       C:=P.ClassType;
-      if (C=TPasClassType) and TPasClassType(P).IsForward then
-        continue;
       if (C=TPasClassType) or (C=TPasRecordType) or (C=TPasEnumType) then
         begin
+        if (C=TPasClassType) then
+          begin
+          if TPasClassType(P).IsForward then
+            continue;
+          if not aResolver.IsFullySpecialized(TPasClassType(P)) then
+            continue;
+          end
+        else if C=TPasRecordType then
+          begin
+          if not aResolver.IsFullySpecialized(TPasRecordType(P)) then
+            continue;
+          end;
         // add var $lt = null;
         CreateGlobalAliasNull(P,pbivnLocalTypeRef,SectionContext);
         if (C=TPasClassType) or (C=TPasRecordType) then
           InitForwards(TPasMembersType(P).Members,SectionContext);
+        end
+      else if C.InheritsFrom(TPasProcedure) then
+        begin
+        Proc:=TPasProcedure(P);
+        if Proc.IsForward or Proc.IsAbstract or Proc.IsExternal then
+          continue;
+        if TPas2JSProcedureScope(Proc.CustomData).SpecializedFromItem=nil then
+          continue;
+        if not aResolver.IsFullySpecialized(Proc) then
+          continue; // skip non specialized generics
+        // specialized proc: add var $lp = null;
+        CreateGlobalAliasNull(P,pbivnLocalProcRef,SectionContext);
         end;
       end;
   end;
@@ -15231,7 +15388,7 @@ begin
           RaiseNotSupported(El,AContext,20180405093512);
         end;
       NeedInitFunction:=(pcsfPublished in Scope.Flags) or HasTypeInfo(El,AContext)
-                        or (IntfKind<>'');
+                        or (IntfKind<>'') or (coShortRefGlobals in Options);
       end;
 
     if NeedInitFunction then
@@ -16387,7 +16544,7 @@ Var
   FS : TJSFunctionDeclarationStatement;
   FD : TJSFuncDef;
   n, i, Line, Col:Integer;
-  AssignSt: TJSSimpleAssignStatement;
+  AssignSt, AssignSt2: TJSSimpleAssignStatement;
   FuncContext, ConstContext: TFunctionContext;
   ProcScope, ImplProcScope: TPas2JSProcedureScope;
   Arg, SelfArg: TPasArgument;
@@ -16396,7 +16553,7 @@ Var
   BodyPas: TProcedureBody;
   PosEl, ThisPas: TPasElement;
   Call: TJSCallExpression;
-  ClassPath: String;
+  ClassPath, aName: String;
   ArgResolved: TPasResolverResult;
   Lit: TJSLiteral;
   ConstSrcElems: TJSSourceElements;
@@ -16476,6 +16633,19 @@ begin
     AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,ImplProc));
     Result:=AssignSt;
     AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext,ImplProc);
+
+    if (coShortRefGlobals in Options) then
+      begin
+      aName:=AContext.GetLocalName(El,[cvkGlobal]);
+      if aName<>'' then
+        begin
+        // this.FuncName = $lp = ...;
+        AssignSt2:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,ImplProc));
+        AssignSt.Expr:=AssignSt2;
+        AssignSt:=AssignSt2;
+        AssignSt.LHS:=CreatePrimitiveDotExpr(aName,El);
+        end;
+      end;
     end;
 
   FS:=CreateFunctionSt(ImplProc,ImplProc.Body<>nil);
@@ -18559,8 +18729,7 @@ begin
   aResolver:=AContext.Resolver;
 
   Proc:=TPasProcedure(ResolvedEl.IdentEl);
-  if (not (Proc.Parent is TPasMembersType))
-      or (ptmStatic in Proc.ProcType.Modifiers) then
+  if not aResolver.ProcHasSelf(Proc) then
     begin
     // not an "of object" method -> simply use the function
     Result:=CreateReferencePathExpr(Proc,AContext);
@@ -18571,6 +18740,9 @@ begin
   IsHelper:=aResolver.IsHelperMethod(Proc);
   NeedClass:=aResolver.IsClassMethod(Proc) and not aResolver.MethodIsStatic(Proc);
 
+  if Expr is TInlineSpecializeExpr then
+    Expr:=TInlineSpecializeExpr(Expr).NameExpr;
+
   // an of-object method -> create "rtl.createCallback(Target,func)"
   TargetJS:=nil;
   Call:=nil;
@@ -18655,8 +18827,17 @@ begin
     else
       begin
       // create  rtl.createCallback(target, "FunName")
-      FunName:=TransformElToJSName(Proc,AContext);
-      Call.AddArg(CreateLiteralString(Expr,FunName));
+      if (coShortRefGlobals in Options)
+          and (TPas2JSProcedureScope(Proc.CustomData).SpecializedFromItem<>nil) then
+        begin
+        FunName:=CreateStaticProcPath(Proc,AContext);
+        Call.AddArg(CreatePrimitiveDotExpr(FunName,Expr));
+        end
+      else
+        begin
+        FunName:=TransformElToJSName(Proc,AContext);
+        Call.AddArg(CreateLiteralString(Expr,FunName));
+        end;
       end;
 
     Result:=Call;
@@ -20818,7 +20999,7 @@ var
   Bin: TBinaryExpr;
   LeftResolved: TPasResolverResult;
   SelfJS: TJSElement;
-  PosEl: TPasExpr;
+  PosEl, NameExpr: TPasExpr;
   ProcPath: String;
   Call: TJSCallExpression;
   IdentEl: TPasElement;
@@ -20855,64 +21036,70 @@ begin
       PosEl:=Expr;
       aResolver.ComputeElement(Left,LeftResolved,[]);
       end
-    else if Expr is TBinaryExpr then
-      begin
-      // e.g. "path.proc(args)" or "path.proc"
-      Bin:=TBinaryExpr(Expr);
-      if Bin.OpCode<>eopSubIdent then
-        RaiseNotSupported(Expr,AContext,20190201163152);
-      Left:=Bin.left;
-      aResolver.ComputeElement(Left,LeftResolved,[]);
-      PosEl:=Bin.right;
-      if PosEl.CustomData is TResolvedReference then
-        Ref:=TResolvedReference(PosEl.CustomData);
-      end
-    else if aResolver.IsNameExpr(Expr) then
+    else
       begin
-      // e.g. "proc(args)"
-      PosEl:=Expr;
-      if not (Expr.CustomData is TResolvedReference) then
-        RaiseNotSupported(Expr,AContext,20190201163210);
-      Ref:=TResolvedReference(Expr.CustomData);
-      WithExprScope:=Ref.WithExprScope as TPas2JSWithExprScope;
-      if WithExprScope<>nil then
-        begin
-        // e.g. "with left do proc()"
-        // -> Left is the WithVarName
-        aResolver.ComputeElement(WithExprScope.Expr,LeftResolved,[]);
+      NameExpr:=Expr;
+      if NameExpr is TInlineSpecializeExpr then
+        NameExpr:=TInlineSpecializeExpr(NameExpr).NameExpr;
+      if NameExpr is TBinaryExpr then
+        begin
+        // e.g. "path.proc(args)" or "path.proc"
+        Bin:=TBinaryExpr(NameExpr);
+        if Bin.OpCode<>eopSubIdent then
+          RaiseNotSupported(NameExpr,AContext,20190201163152);
+        Left:=Bin.left;
+        aResolver.ComputeElement(Left,LeftResolved,[]);
+        PosEl:=Bin.right;
+        if PosEl.CustomData is TResolvedReference then
+          Ref:=TResolvedReference(PosEl.CustomData);
         end
-      else
-        begin
-        // inside helper method, no explicit left expression
-        if IsStatic then
-          LeftResolved:=default(TPasResolverResult)
+      else if aResolver.IsNameExpr(NameExpr) then
+        begin
+        // e.g. "proc(args)"
+        PosEl:=NameExpr;
+        if not (NameExpr.CustomData is TResolvedReference) then
+          RaiseNotSupported(NameExpr,AContext,20190201163210);
+        Ref:=TResolvedReference(NameExpr.CustomData);
+        WithExprScope:=Ref.WithExprScope as TPas2JSWithExprScope;
+        if WithExprScope<>nil then
+          begin
+          // e.g. "with left do proc()"
+          // -> Left is the WithVarName
+          aResolver.ComputeElement(WithExprScope.Expr,LeftResolved,[]);
+          end
         else
           begin
-          SelfScope:=aResolver.GetSelfScope(Expr);
-          if SelfScope=nil then
-            RaiseNotSupported(PosEl,AContext,20190205171529);
-          if SelfScope.SelfArg=nil then
-            RaiseNotSupported(PosEl,AContext,20190205171902,GetObjName(SelfScope.Element));
-          aResolver.ComputeElement(SelfScope.SelfArg,LeftResolved,[]);
+          // inside helper method, no explicit left expression
+          if IsStatic then
+            LeftResolved:=default(TPasResolverResult)
+          else
+            begin
+            SelfScope:=aResolver.GetSelfScope(NameExpr);
+            if SelfScope=nil then
+              RaiseNotSupported(PosEl,AContext,20190205171529);
+            if SelfScope.SelfArg=nil then
+              RaiseNotSupported(PosEl,AContext,20190205171902,GetObjName(SelfScope.Element));
+            aResolver.ComputeElement(SelfScope.SelfArg,LeftResolved,[]);
+            end;
           end;
+        end
+      else if NameExpr is TParamsExpr then
+        begin
+        // implicit call, e.g. default property  a[]
+        PosEl:=NameExpr;
+        if not (NameExpr.CustomData is TResolvedReference) then
+          RaiseNotSupported(NameExpr,AContext,20190208105144);
+        Ref:=TResolvedReference(PosEl.CustomData);
+        if Ref.Declaration.ClassType<>TPasProperty then
+          RaiseNotSupported(NameExpr,AContext,20190208105222);
+        Left:=TParamsExpr(NameExpr).Value;
+        aResolver.ComputeElement(Left,LeftResolved,[]);
+        end
+      else
+        begin
+        RaiseNotSupported(NameExpr,AContext,20190201163210);
+        LeftResolved:=default(TPasResolverResult);
         end;
-      end
-    else if Expr is TParamsExpr then
-      begin
-      // implicit call, e.g. default property  a[]
-      PosEl:=Expr;
-      if not (Expr.CustomData is TResolvedReference) then
-        RaiseNotSupported(Expr,AContext,20190208105144);
-      Ref:=TResolvedReference(PosEl.CustomData);
-      if Ref.Declaration.ClassType<>TPasProperty then
-        RaiseNotSupported(Expr,AContext,20190208105222);
-      Left:=TParamsExpr(Expr).Value;
-      aResolver.ComputeElement(Left,LeftResolved,[]);
-      end
-    else
-      begin
-      RaiseNotSupported(Expr,AContext,20190201163210);
-      LeftResolved:=default(TPasResolverResult);
       end;
 
     LoTypeEl:=LeftResolved.LoTypeEl;
@@ -21059,7 +21246,11 @@ begin
 
       // create HelperType.HelperCall.call(SelfJS)
       Call:=CreateCallExpression(Expr);
-      ProcPath:=CreateReferencePath(Proc,AContext,rpkPathAndName);
+      if (coShortRefGlobals in Options)
+          and (TPas2JSProcedureScope(Proc.CustomData).SpecializedFromItem<>nil) then
+        ProcPath:=CreateGlobalElPath(Proc,AContext)
+      else
+        ProcPath:=CreateReferencePath(Proc,AContext,rpkPathAndName);
       if not IsStatic then
         ProcPath:=ProcPath+'.call';
       Call.Expr:=CreatePrimitiveDotExpr(ProcPath,Expr);
@@ -24070,16 +24261,6 @@ var
     Result:=(C=TPasFunction) or (C=TPasProcedure) or (C=TPasConstructor) or (C=TPasDestructor);
   end;
 
-  function ProcSelfIsClassType(Proc: TPasElement): boolean;
-  var
-    C: TClass;
-  begin
-    if Proc=nil then exit(false);
-    C:=Proc.ClassType;
-    Result:=((C=TPasClassFunction) or (C=TPasClassProcedure) or (C=TPasClassOperator))
-         and not TPasProcedure(Proc).IsStatic;
-  end;
-
   function ProcHasNoSelf(Proc: TPasProcedure): boolean;
   begin
     if Proc=nil then exit(false);
@@ -24164,6 +24345,43 @@ var
     Result:=false;
   end;
 
+  function ShortRefGlobal: boolean;
+  var
+    ElClass: TClass;
+    Proc: TPasProcedure;
+  begin
+    ElClass:=El.ClassType;
+    if ElClass.InheritsFrom(TPasType) then
+      begin
+      if El.Parent.ClassType=TProcedureBody then
+        exit(false);
+      CreateReferencePath:=CreateGlobalTypePath(TPasType(El),AContext);
+      exit(true);
+      end
+    else if ElClass.InheritsFrom(TPasProcedure) then
+      begin
+      Proc:=TPasProcedure(El);
+      if ProcCanHaveShortRef(Proc) then
+        begin
+        if aResolver.ProcHasSelf(Proc) then
+          begin
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.CreateReferencePath El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Kind=',Kind,' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
+          {$ENDIF}
+          aResolver.RaiseNotYetImplemented(20201030233511,El);
+          end;
+        CreateReferencePath:=CreateStaticProcPath(Proc,AContext);
+        exit(true);
+        end;
+      end
+    else if (ElClass=TPasEnumValue) then
+      begin
+      CreateReferencePath:=CreateGlobalElPath(El,AContext);
+      exit(true);
+      end;
+    Result:=false;
+  end;
+
 var
   FoundModule: TPasModule;
   ParentEl, CurEl: TPasElement;
@@ -24206,7 +24424,7 @@ begin
           Append_GetClass(El);
           end;
         end
-      else if ProcSelfIsClassType(El)
+      else if aResolver.IsMethod_SelfIsClass(El)
           and aResolver.ResolvedElIsClassOrRecordInstance(Dot.LeftResolved) then
         // accessing a class method from an object, 'this' must be the class/record
         Append_GetClass(El);
@@ -24251,7 +24469,7 @@ begin
       RaiseNotSupported(WithData.Expr,AContext,20190209092506,GetObjName(El));
     Prepend(Result,WithData.WithVarName);
     if not (wesfOnlyTypeMembers in WithData.Flags)
-        and ProcSelfIsClassType(El) then
+        and aResolver.IsMethod_SelfIsClass(El) then
       begin
       // with Obj do NonStaticClassMethod -> append .$class
       Append_GetClass(El);
@@ -24267,22 +24485,7 @@ begin
 
     if (coShortRefGlobals in Options) and (Kind=rpkPathAndName) then
       begin
-      ElClass:=El.ClassType;
-      if ElClass.InheritsFrom(TPasType) then
-        begin
-        Result:=CreateGlobalTypePath(TPasType(El),AContext);
-        exit;
-        end
-      else if ElClass.InheritsFrom(TPasProcedure) and ProcHasNoSelf(TPasProcedure(El)) then
-        begin
-        Result:=CreateStaticProcPath(TPasProcedure(El),AContext);
-        exit;
-        end
-      else if (ElClass=TPasEnumValue) then
-        begin
-        Result:=CreateGlobalElPath(El,AContext);
-        exit;
-        end;
+      if ShortRefGlobal then exit;
       end;
 
     El:=ImplToDecl(El);
@@ -24373,7 +24576,7 @@ begin
             if ProcSelfIsInstance(SelfContext.PasElement) then
               begin
               // inside a method -> Self is a class instance
-              if ProcSelfIsClassType(El) then
+              if aResolver.IsMethod_SelfIsClass(El) then
                 Append_GetClass(El); // accessing a class function -> this.$class.procname
               end;
             Prepend(Result,ShortName);
@@ -24444,6 +24647,8 @@ begin
     if Result<>'' then Result:=Result+'.';
   rpkPathAndName:
     begin
+    if (coShortRefGlobals in Options) then
+      if ShortRefGlobal then exit;
     ShortName:=TransformElToJSName(El,AContext);
     if Result='' then
       Result:=ShortName
@@ -24485,9 +24690,14 @@ end;
 function TPasToJSConverter.CreateStaticProcPath(El: TPasProcedure;
   AContext: TConvertContext): string;
 begin
-  if (not El.IsStatic) and (El.Parent is TPasMembersType) then
+  if El.IsAbstract or El.IsExternal then
+    RaiseNotSupported(El,AContext,20201101185117)
+  else if El.IsStatic
+      or (El.Parent is TPasSection)
+      or (TPas2JSProcedureScope(El.CustomData).SpecializedFromItem<>nil) then
+    Result:=CreateGlobalElPath(El,AContext)
+  else
     RaiseNotSupported(El,AContext,20200925104007);
-  Result:=CreateGlobalElPath(El,AContext);
 end;
 
 function TPasToJSConverter.CreateGlobalElPath(El: TPasElement;
@@ -24571,6 +24781,28 @@ begin
   Result:=AContext.GetLocalName(El,Filter);
 end;
 
+function TPasToJSConverter.ProcCanHaveShortRef(Proc: TPasProcedure): boolean;
+var
+  C: TClass;
+begin
+  // can not:
+  if Proc.IsExternal or Proc.IsVirtual then
+    exit(false);
+  C:=Proc.Parent.ClassType;
+  if C=TProcedureBody then
+    exit(false);
+
+  // can:
+  if C.InheritsFrom(TPasSection) then
+    exit(true);
+  if Proc.IsStatic then
+    exit(true);
+  if TPas2JSProcedureScope(Proc.CustomData).SpecializedFromItem<>nil then
+    exit(true);
+
+  Result:=false;
+end;
+
 procedure TPasToJSConverter.StoreImplJSLocal(El: TPasElement;
   AContext: TConvertContext);
 var
@@ -26511,8 +26743,6 @@ end;
 function TPasToJSConverter.ElNeedsGlobalAlias(El: TPasElement): boolean;
 var
   C: TClass;
-  Proc: TPasProcedure;
-  ProcScope: TPas2JSProcedureScope;
 begin
   Result:=false;
   if El=nil then exit;
@@ -26523,26 +26753,8 @@ begin
     exit(false)
   else if C.InheritsFrom(TPasType) then
     exit(true)
-  else if (C=TPasConstructor)
-      or (C=TPasDestructor)
-      or (C=TPasClassConstructor)
-      or (C=TPasClassDestructor)
-      or (C=TPasClassProcedure)
-      or (C=TPasClassOperator)
-      or (C=TPasClassFunction) then
-    exit(true)
-  else if (C=TPasProcedure) or (C=TPasFunction) or (C=TPasOperator) then
-    begin
-    Proc:=TPasProcedure(El);
-    if Proc.IsStatic or (Proc.Parent is TPasSection) then
-      exit(true);
-    if coShortRefGenFunc in Options then
-      begin
-      ProcScope:=TPas2JSProcedureScope(Proc.CustomData);
-      if ProcScope.SpecializedFromItem<>nil then
-        exit(true);
-      end;
-    end
+  else if C.InheritsFrom(TPasProcedure) then
+    exit(ProcCanHaveShortRef(TPasProcedure(El)))
   else if C=TPasEnumValue then
     begin
     if not (coEnumNumbers in Options) then

packages/pastojs/src/pas2jscompiler.pp

@@ -43,8 +43,8 @@ uses
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
 
 const
-  VersionMajor = 1;
-  VersionMinor = 5;
+  VersionMajor = 2;
+  VersionMinor = 1;
   VersionRelease = 1;
   VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
@@ -3756,6 +3756,10 @@ begin
     begin
       Enable:=c='+';
       Delete(aValue,length(aValue),1);
+    end
+    else if lowercase(LeftStr(aValue,2))='no' then begin
+      Enable:=false;
+      Delete(aValue,1,2);
     end;
     Case LowerCase(aValue) of
      'enumnumbers': SetOption(coEnumValuesAsNumbers,Enable);
@@ -4738,7 +4742,8 @@ begin
   w('      -OoEnumNumbers[-]: write enum value as number instead of name. Default in -O1.');
   w('      -OoRemoveNotUsedPrivates[-]: Default is enabled');
   w('      -OoRemoveNotUsedDeclarations[-]: Default enabled for programs with -Jc');
-  w('      -OoShortRefGlobals[-]: Insert JS local var for types and modules. Default enabled in -O2');
+  w('      -OoRemoveNotUsedPublished[-] : Default is disabled');
+  w('      -OoShortRefGlobals[-]: Insert JS local var for types, modules and static functions. Default enabled in -O2');
   w('  -P<x>  : Set target processor. Case insensitive:');
   w('    -Pecmascript5: default');
   w('    -Pecmascript6');

packages/pastojs/src/pas2jsfiler.pp

@@ -243,7 +243,7 @@ const
     );
 
   PCUDefaultConverterOptions: TPasToJsConverterOptions =
-    [coUseStrict,coStoreImplJS,coShortRefGlobals,coShortRefGenFunc];
+    [coUseStrict,coStoreImplJS,coShortRefGlobals];
   PCUConverterOptions: array[TPasToJsConverterOption] of string = (
     'LowerCase',
     'SwitchStatement',
@@ -255,8 +255,7 @@ const
     'RTLVersionCheckMain',
     'RTLVersionCheckSystem',
     'RTLVersionCheckUnit',
-    'ShortRefGlobals',
-    'ShortRefGenFuncs'
+    'ShortRefGlobals'
     );
 
   PCUDefaultTargetPlatform = PlatformBrowser;
@@ -3979,7 +3978,7 @@ begin
     TemplObj:=TJSONObject.Create;
     Arr.Add(TemplObj);
     WritePasElement(TemplObj,Templ,aContext);
-    WriteElementArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext,true);
+    WriteElementArray(TemplObj,Templ,'Constraints',Templ.Constraints,aContext,true);
     end;
 end;
 
@@ -8204,7 +8203,7 @@ begin
     GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,Parent));
     GenericTemplateTypes.Add(GenType);
     ReadPasElement(TemplObj,GenType,aContext);
-    ReadElementArray(TemplObj,Parent,'Constraints',GenType.Constraints,
+    ReadElementArray(TemplObj,GenType,'Constraints',GenType.Constraints,
       {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
       aContext);
     end;

packages/pastojs/tests/tcfiler.pas

@@ -228,17 +228,11 @@ type
     procedure TestPC_InlineSpecialize_LocalTypeInUnit;
     procedure TestPC_Specialize_Array;
     procedure TestPC_Specialize_ProcType;
-    // ToDo: specialize extern generic type in unit interface
-    // ToDo: specialize extern generic type in unit implementation
-    // ToDo: specialize extern generic type in proc decl
-    // ToDo: specialize extern generic type in proc body
-    // ToDo: inline specialize extern generic type in unit interface
-    // ToDo: inline specialize extern generic type in unit implementation
-    // ToDo: inline specialize extern generic type in proc decl
-    // ToDo: inline specialize extern generic type in proc body
     // ToDo: half specialize TBird<T> = class a: TAnt<word,T>; end;
     // ToDo: no specialize: TBird<T> = class a: TBird<T>; end;
+    procedure TestPC_Constraints;
     // ToDo: constraints
+    // ToDo: unit impl declarations used by generics
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -422,7 +416,7 @@ var
 begin
   InitialParserOptions:=Parser.Options;
   Analyzer.Options:=Analyzer.Options+[paoSkipGenericProc];
-  Converter.Options:=Converter.Options+[coShortRefGlobals,coShortRefGenFunc];
+  Converter.Options:=Converter.Options+[coShortRefGlobals];
   ConvertUnit;
 
   FPCUWriter:=TPCUWriter.Create;
@@ -3507,6 +3501,35 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Constraints;
+begin
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TBird<T: class> = class',
+  '  end;',
+  '  TEagle<T: record> = class',
+  '  end;',
+  '  TAnt<T: constructor> = class',
+  '  end;',
+  '  TFish = class end;',
+  '  TBirdFish = TBird<TFish>;',
+  '  TAntFish = TAnt<TFish>;',
+  '  TWater<T: TFish> = class',
+  '  end;',
+  '  TRec = record end;',
+  'var',
+  '  bf: TBirdFish;',
+  '  af: TAntFish;',
+  '  er: TEagle<TRec>;',
+  '  wf: TWater<TFish>;',
+  'implementation',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',

packages/pastojs/tests/tcoptimizations.pas

@@ -60,7 +60,14 @@ type
     procedure TestOptShortRefGlobals_Program;
     procedure TestOptShortRefGlobals_Unit_FromIntfImpl_ToIntfImpl;
     procedure TestOptShortRefGlobals_Property;
+    procedure TestOptShortRefGlobals_ExternalAbstract;
     procedure TestOptShortRefGlobals_GenericFunction;
+    procedure TestOptShortRefGlobals_GenericMethod_Call;
+    procedure TestOptShortRefGlobals_GenericStaticMethod_Call;
+    // ToDo: GenericMethod_CallInherited ObjFPC+Delphi
+    procedure TestOptShortRefGlobals_GenericClassHelperMethod;
+    procedure TestOptShortRefGlobals_GenericMethod_ProcVar;
+    procedure TestOptShortRefGlobals_GenericStaticMethod_ProcVar;
     procedure TestOptShortRefGlobals_SameUnit_EnumType;
     procedure TestOptShortRefGlobals_SameUnit_ClassType;
     procedure TestOptShortRefGlobals_SameUnit_RecordType;
@@ -456,6 +463,94 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestOptShortRefGlobals_ExternalAbstract;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TBird = class',
+    '    generic function FlyExt<T>(a: word = 103): T; external name ''Flying'';',
+    '    class procedure JumpVirtual(a: word = 104); virtual; abstract;',
+    '    class procedure RunStaticExt(a: word = 105); static; external name ''Running'';',
+    '  end;',
+    'procedure SayExt(a: word = 106); external name ''Saying'';',
+    '']),
+  LinesToStr([
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    procedure Test;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Test;',
+  'begin',
+  '  specialize FlyExt<Word>;',
+  '  specialize FlyExt<Word>(1);',
+  '  specialize JumpVirtual;',
+  '  specialize JumpVirtual(2);',
+  '  specialize RunStaticExt;',
+  '  specialize RunStaticExt(3);',
+  '  specialize SayExt;',
+  '  specialize SayExt(4);',
+  '  Self.specialize FlyExt<Word>;',
+  '  Self.specialize FlyExt<Word>(11);',
+  '  Self.specialize JumpVirtual;',
+  '  Self.specialize JumpVirtual(12);',
+  '  Self.specialize RunStaticExt;',
+  '  Self.specialize RunStaticExt(13);',
+  '  with Self do begin',
+  '    specialize FlyExt<Word>;',
+  '    specialize FlyExt<Word>(21);',
+  '    specialize JumpVirtual;',
+  '    specialize JumpVirtual(22);',
+  '    specialize RunStaticExt;',
+  '    specialize RunStaticExt(23);',
+  '  end;',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_ExternalAbstract',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Test = function () {',
+    '    this.Flying(103);',
+    '    this.Flying(1);',
+    '    this.$class.JumpVirtual(104);',
+    '    this.$class.JumpVirtual(2);',
+    '    this.Running(105);',
+    '    this.Running(3);',
+    '    Saying(106);',
+    '    Saying(4);',
+    '    this.Flying(103);',
+    '    this.Flying(11);',
+    '    this.$class.JumpVirtual(104);',
+    '    this.$class.JumpVirtual(12);',
+    '    this.Running(105);',
+    '    this.Running(13);',
+    '    this.Flying(103);',
+    '    this.Flying(21);',
+    '    this.$class.JumpVirtual(104);',
+    '    this.$class.JumpVirtual(22);',
+    '    this.Running(105);',
+    '    this.Running(23);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestOptimizations.TestOptShortRefGlobals_GenericFunction;
 begin
   AddModuleWithIntfImplSrc('UnitA.pas',
@@ -503,6 +598,547 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestOptShortRefGlobals_GenericMethod_Call;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TBird = class',
+    '    generic function Fly<T>(a: word = 13): T;',
+    '    generic class function Jump<T>(b: word = 14): T;',
+    '  end;',
+    '']),
+  LinesToStr([
+    'generic function TBird.Fly<T>(a: word): T;',
+    'begin',
+    'end;',
+    'generic class function TBird.Jump<T>(b: word): T;',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    procedure Test;',
+  '    generic function Run<T>(c: word = 25): T;',
+  '    generic class function Sing<T>(d: word = 26): T;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Test;',
+  'begin',
+  '  specialize Run<Word>;',
+  '  specialize Run<Word>(1);',
+  '  specialize Sing<Word>;',
+  '  specialize Sing<Word>(2);',
+  '  specialize Fly<Word>;',
+  '  specialize Fly<Word>(3);',
+  '  specialize Jump<Word>;',
+  '  specialize Jump<Word>(4);',
+  '  Self.specialize Fly<Word>;',
+  '  Self.specialize Fly<Word>(5);',
+  '  Self.specialize Jump<Word>;',
+  '  Self.specialize Jump<Word>(6);',
+  '  with Self do begin',
+  '    specialize Fly<Word>;',
+  '    specialize Fly<Word>(7);',
+  '    specialize Jump<Word>;',
+  '    specialize Jump<Word>(8);',
+  '  end;',
+  'end;',
+  'generic function TEagle.Run<T>(c: word): T;',
+  'begin',
+  '  specialize Fly<T>;',
+  '  specialize Fly<T>(7);',
+  'end;',
+  'generic class function TEagle.Sing<T>(d: word): T;',
+  'begin',
+  '  specialize Jump<T>;',
+  '  specialize Jump<T>(8);',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_GenericMethod_Call',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lp = null;',
+    'var $lp1 = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'var $lp2 = $lt1.Fly$G1;',
+    'var $lp3 = $lt1.Jump$G1;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Test = function () {',
+    '    $lp.apply(this, 25);',
+    '    $lp.apply(this, 1);',
+    '    $lp1.apply(this.$class, 26);',
+    '    $lp1.apply(this.$class, 2);',
+    '    $lp2.apply(this, 13);',
+    '    $lp2.apply(this, 3);',
+    '    $lp3.apply(this.$class, 14);',
+    '    $lp3.apply(this.$class, 4);',
+    '    $lp2.apply(this, 13);',
+    '    $lp2.apply(this, 5);',
+    '    $lp3.apply(this.$class, 14);',
+    '    $lp3.apply(this, 6);',
+    '    $lp2.apply(this, 13);',
+    '    $lp2.apply(this, 7);',
+    '    $lp3.apply(this.$class, 14);',
+    '    $lp3.apply(this.$class, 8);',
+    '  };',
+    '  this.Run$G1 = $lp = function (c) {',
+    '    var Result = 0;',
+    '    $lp2.apply(this, 13);',
+    '    $lp2.apply(this, 7);',
+    '    return Result;',
+    '  };',
+    '  this.Sing$G1 = $lp1 = function (d) {',
+    '    var Result = 0;',
+    '    $lp3.apply(this, 14);',
+    '    $lp3.apply(this, 8);',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestOptimizations.TestOptShortRefGlobals_GenericStaticMethod_Call;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TBird = class',
+    '    generic class function Fly<T>(a: word = 13): T; static;',
+    '    class function Say(a: word = 13): word; static;',
+    '  end;',
+    '']),
+  LinesToStr([
+    'generic class function TBird.Fly<T>(a: word): T;',
+    'begin',
+    'end;',
+    'class function TBird.Say(a: word): word;',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    procedure Test;',
+  '    generic class function Run<T>(c: word = 25): T; static;',
+  '    class function Lay(c: word = 25): word; static;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Test;',
+  'begin',
+  '  specialize Fly<Word>;',
+  '  specialize Fly<Word>(31);',
+  '  Say;',
+  '  Say(32);',
+  '  specialize Run<Word>;',
+  '  specialize Run<Word>(33);',
+  '  Lay;',
+  '  Lay(34);',
+  '  self.specialize Fly<Word>;',
+  '  self.specialize Fly<Word>(41);',
+  '  self.Say;',
+  '  self.Say(42);',
+  '  self.specialize Run<Word>;',
+  '  self.specialize Run<Word>(43);',
+  '  with Self do begin',
+  '    specialize Fly<Word>;',
+  '    specialize Fly<Word>(51);',
+  '    Say;',
+  '    Say(52);',
+  '    specialize Run<Word>;',
+  '    specialize Run<Word>(53);',
+  '  end;',
+  'end;',
+  'generic class function TEagle.Run<T>(c: word): T;',
+  'begin',
+  'end;',
+  'class function TEagle.Lay(c: word): word;',
+  'begin',
+  '  TEagle.specialize Fly<Word>;',
+  '  TEagle.specialize Fly<Word>(61);',
+  '  TEagle.Say;',
+  '  TEagle.Say(62);',
+  '  TEagle.specialize Run<Word>;',
+  '  specialize Run<Word>(63);',
+  '  Lay;',
+  '  Lay(64);',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_GenericStaticMethod_Call',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lp = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'var $lp1 = $lt1.Fly$G1;',
+    'var $lp2 = $lt1.Say;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Test = function () {',
+    '    $lp1(13);',
+    '    $lp1(31);',
+    '    $lp2(13);',
+    '    $lp2(32);',
+    '    $lp(25);',
+    '    $lp(33);',
+    '    $lt.Lay(25);',
+    '    $lt.Lay(34);',
+    '    $lp1(13);',
+    '    $lp1(41);',
+    '    $lp2(13);',
+    '    $lp2(42);',
+    '    $lp(25);',
+    '    $lp(43);',
+    '    $lp1(13);',
+    '    $lp1(51);',
+    '    $lp2(13);',
+    '    $lp2(52);',
+    '    $lp(25);',
+    '    $lp(53);',
+    '  };',
+    '  this.Lay = function (c) {',
+    '    var Result = 0;',
+    '    $lp1(13);',
+    '    $lp1(61);',
+    '    $lp2(13);',
+    '    $lp2(62);',
+    '    $lp(25);',
+    '    $lp(63);',
+    '    $lt.Lay(25);',
+    '    $lt.Lay(64);',
+    '    return Result;',
+    '  };',
+    '  this.Run$G1 = $lp = function (c) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestOptimizations.TestOptShortRefGlobals_GenericClassHelperMethod;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TBird = class',
+    '  end;',
+    '  TBirdHelper = class helper for TBird',
+    '    generic function Fly<T>(a: word = 13): T;',
+    '    generic class function Say<T>(a: word = 13): T;',
+    '  end;',
+    '']),
+  LinesToStr([
+    'generic function TBirdHelper.Fly<T>(a: word): T;',
+    'begin',
+    'end;',
+    'generic class function TBirdHelper.Say<T>(a: word): T;',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    procedure Test;',
+  '    class procedure Lay;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Test;',
+  'begin',
+  '  specialize Fly<Word>;',
+  '  specialize Fly<Word>(31);',
+  '  specialize Say<word>;',
+  '  specialize Say<Word>(32);',
+  '  self.specialize Fly<Word>;',
+  '  self.specialize Fly<Word>(41);',
+  '  self.specialize Say<Word>;',
+  '  self.specialize Say<Word>(42);',
+  '  with Self do begin',
+  '    specialize Fly<Word>;',
+  '    specialize Fly<Word>(51);',
+  '    specialize Say<Word>;',
+  '    specialize Say<Word>(52);',
+  '  end;',
+  'end;',
+  'class procedure TEagle.Lay;',
+  'begin',
+  '  specialize Say<Word>;',
+  '  specialize Say<Word>(32);',
+  '  self.specialize Say<Word>;',
+  '  self.specialize Say<Word>(42);',
+  '  with Self do begin',
+  '    specialize Say<Word>;',
+  '    specialize Say<Word>(52);',
+  '  end;',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_GenericClassHelperMethod',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'var $lt2 = $lm.TBirdHelper;',
+    'var $lp = $lt2.Fly$G1;',
+    'var $lp1 = $lt2.Say$G1;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Test = function () {',
+    '    $lp.call(this, 13);',
+    '    $lp.call(this, 31);',
+    '    $lp1.call(this.$class, 13);',
+    '    $lp1.call(this.$class, 32);',
+    '    $lp.call(this, 13);',
+    '    $lp.call(this, 41);',
+    '    $lp1.call(this.$class, 13);',
+    '    $lp1.call(this.$class, 42);',
+    '    $lp.call(this, 13);',
+    '    $lp.call(this, 51);',
+    '    $lp1.call(this.$class, 13);',
+    '    $lp1.call(this.$class, 52);',
+    '  };',
+    '  this.Lay = function () {',
+    '    $lp1.call(this, 13);',
+    '    $lp1.call(this, 32);',
+    '    $lp1.call(this, 13);',
+    '    $lp1.call(this, 42);',
+    '    $lp1.call(this, 13);',
+    '    $lp1.call(this, 52);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestOptimizations.TestOptShortRefGlobals_GenericMethod_ProcVar;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    '{$mode delphi}',
+    'type',
+    '  TBird = class',
+    '    function Fly<T>(a: word = 13): T;',
+    '    class function Jump<T>(b: word = 14): T;',
+    '  end;',
+    '']),
+  LinesToStr([
+    'function TBird.Fly<T>(a: word): T;',
+    'begin',
+    'end;',
+    'class function TBird.Jump<T>(b: word): T;',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$mode delphi}',
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TFunc<T> = function(a: word): T of object;',
+  '  TEagle = class(TBird)',
+  '    procedure Test;',
+  '    function Run<T>(c: word = 25): T;',
+  '    class function Sing<T>(d: word = 26): T;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Test;',
+  'var f: TFunc<word>;',
+  'begin',
+  '  f:=@Run<Word>;',
+  '  f:=@Sing<Word>;',
+  '  f:=@Fly<Word>;',
+  '  f:=@Jump<Word>;',
+  '  f:[email protected]<Word>;',
+  '  f:[email protected]<Word>;',
+  '  with Self do begin',
+  '    f:=@Fly<Word>;',
+  '    f:=@Jump<Word>;',
+  '  end;',
+  'end;',
+  'function TEagle.Run<T>(c: word): T;',
+  'begin',
+  'end;',
+  'class function TEagle.Sing<T>(d: word): T;',
+  'var f: TFunc<T>;',
+  'begin',
+  '  f:=@Jump<T>;',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_GenericMethod_ProcVar',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lp = null;',
+    'var $lp1 = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'var $lp2 = $lt1.Fly$G1;',
+    'var $lp3 = $lt1.Jump$G1;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Test = function () {',
+    '    var f = null;',
+    '    f = rtl.createCallback(this, $lp);',
+    '    f = rtl.createCallback(this.$class, $lp1);',
+    '    f = rtl.createCallback(this, $lp2);',
+    '    f = rtl.createCallback(this.$class, $lp3);',
+    '    f = rtl.createCallback(this, $lp2);',
+    '    f = rtl.createCallback(this.$class, $lp3);',
+    '    f = rtl.createCallback(this, $lp2);',
+    '    f = rtl.createCallback(this.$class, $lp3);',
+    '  };',
+    '  this.Run$G1 = $lp = function (c) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.Sing$G1 = $lp1 = function (d) {',
+    '    var Result = 0;',
+    '    var f = null;',
+    '    f = rtl.createCallback(this, $lp3);',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestOptimizations.TestOptShortRefGlobals_GenericStaticMethod_ProcVar;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TBird = class',
+    '    generic class function Fly<T>(a: word = 13): T; static;',
+    '    class function Say(a: word = 13): word; static;',
+    '  end;',
+    '']),
+  LinesToStr([
+    'generic class function TBird.Fly<T>(a: word): T;',
+    'begin',
+    'end;',
+    'class function TBird.Say(a: word): word;',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TFunc = function(a: word): word;',
+  '  TEagle = class(TBird)',
+  '    procedure Test;',
+  '    generic class function Run<T>(c: word = 25): T; static;',
+  '    class function Lay(c: word = 25): word; static;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Test;',
+  'var f: TFunc;',
+  'begin',
+  '  F:=@specialize Fly<Word>;',
+  '  F:=@Say;',
+  '  F:=@specialize Run<Word>;',
+  '  F:=@Lay;',
+  '  F:[email protected] Fly<Word>;',
+  '  F:[email protected];',
+  '  F:[email protected] Run<Word>;',
+  '  with Self do begin',
+  '    F:=@specialize Fly<Word>;',
+  '    F:=@Say;',
+  '    F:=@specialize Run<Word>;',
+  '  end;',
+  'end;',
+  'generic class function TEagle.Run<T>(c: word): T;',
+  'begin',
+  'end;',
+  'class function TEagle.Lay(c: word): word;',
+  'var f: TFunc;',
+  'begin',
+  '  f:[email protected] Fly<Word>;',
+  '  f:[email protected];',
+  '  f:[email protected] Run<Word>;',
+  '  f:=@Lay;',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_GenericStaticMethod_ProcVar',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lp = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'var $lp1 = $lt1.Fly$G1;',
+    'var $lp2 = $lt1.Say;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Test = function () {',
+    '    var f = null;',
+    '    f = $lp1;',
+    '    f = $lp2;',
+    '    f = $lp;',
+    '    f = $lt.Lay;',
+    '    f = $lp1;',
+    '    f = $lp2;',
+    '    f = $lp;',
+    '    f = $lp1;',
+    '    f = $lp2;',
+    '    f = $lp;',
+    '  };',
+    '  this.Lay = function (c) {',
+    '    var Result = 0;',
+    '    var f = null;',
+    '    f = $lp1;',
+    '    f = $lp2;',
+    '    f = $lp;',
+    '    f = $lt.Lay;',
+    '    return Result;',
+    '  };',
+    '  this.Run$G1 = $lp = function (c) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestOptimizations.TestOptShortRefGlobals_SameUnit_EnumType;
 begin
   StartUnit(true,[supTObject]);

packages/rtl-objpas/src/inc/dateutil.inc

@@ -2257,7 +2257,7 @@ Var
 begin
   T:=aValue;
   if Not aInputisUTC then
-    T:=IncMinute(T,GetLocalTimeOffset(AValue));
+    T:=IncMinute(T,GetLocalTimeOffset(AValue, AInputisUTC));
   Result:=Round(DateTimeDiff(RecodeMillisecond(T,0),UnixEpoch)*SecsPerDay);
 end;
 
@@ -2267,7 +2267,7 @@ Function UnixToDateTime(const AValue: Int64; aReturnUTC : Boolean = true): TDate
 begin
   Result:=IncSecond(UnixEpoch, AValue);
   if Not aReturnUTC then
-    Result:=IncMinute(Result,-GetLocalTimeOffset(Result));
+    Result:=IncMinute(Result,-GetLocalTimeOffset(Result, True));
 end;
 
 
@@ -2668,7 +2668,7 @@ end;
 function UniversalTimeToLocal(UT: TDateTime): TDateTime;
 
 begin
-  Result:=SysUtils.UniversalTimeToLocal(UT,-GetLocalTimeOffset(UT));
+  Result:=SysUtils.UniversalTimeToLocal(UT,-GetLocalTimeOffset(UT, True));
 end;
 
 function UniversalTimeToLocal(UT: TDateTime; TZOffset : Integer): TDateTime;
@@ -2680,7 +2680,7 @@ end;
 Function LocalTimeToUniversal(LT: TDateTime): TDateTime;
 
 begin
-  Result:=SysUtils.LocalTimeToUniversal(LT,-GetLocalTimeOffset(LT));
+  Result:=SysUtils.LocalTimeToUniversal(LT,-GetLocalTimeOffset(LT, False));
 end;
 
 Function LocalTimeToUniversal(LT: TDateTime;TZOffset: Integer): TDateTime;
@@ -2703,7 +2703,7 @@ var
   Offset: Integer;
 begin
   Result := FormatDateTime(FmtUTC, ADate);
-  Offset := GetLocalTimeOffset(ADate);
+  Offset := GetLocalTimeOffset(ADate, AInputIsUTC);
   if AInputIsUTC or (Offset=0) then
     Result:=Result+'Z'
   else
@@ -2929,7 +2929,7 @@ begin
   if ReturnUTC then
     Offset:=0
   else
-    OffSet:=-GetLocalTimeOffset(ADateTime);
+    OffSet:=-GetLocalTimeOffset(ADateTime, True);
   aDateTime:=IncMinute(aDateTime,Offset);
   Result:=True;
 end;

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

@@ -355,7 +355,7 @@ type
     i: SizeInt;
   begin
     i:=0;
-    while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin
+    while (i<aPos) and (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) do begin
       inc(i);
     end;
     Result:=i;
@@ -493,7 +493,7 @@ type
     i: SizeInt;
   begin
     i:=0;
-    while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin
+    while (i<aPos) and (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) do begin
       inc(i);
     end;
     Result:=i;

rtl/aix/Makefile

@@ -3248,7 +3248,7 @@ unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(P
 		 unxconst.inc $(UNIXINC)/timezone.inc \
 		 unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unix.pp
-unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixutil.pp
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixcp.pp

rtl/aix/Makefile.fpc

@@ -160,7 +160,7 @@ unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(P
                  unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unix.pp
 
-unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixutil.pp
 
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)

rtl/android/unixandroid.inc

@@ -41,10 +41,6 @@ var
   ucal_inDaylightTime: function (cal: UCalendar; var status: UErrorCode): UBool; cdecl;
   ucal_get: function (cal: UCalendar; field: UCalendarDateFields; var status: UErrorCode): int32_t; cdecl;
 
-var
-  TZStandardName: utf8string;
-  TZDaylightName: utf8string;
-
   GetIcuProc: function (const Name: AnsiString; var ProcPtr; libId: longint): boolean; external name 'ANDROID_GET_ICU_PROC';
 
 procedure ReadTimeZoneFromICU;
@@ -52,8 +48,12 @@ var
   locale: utf8string;
   tz: unicodestring;
   res: unicodestring;
+  TZStandardName: utf8string;
+  TZDaylightName: utf8string;
   err: UErrorCode;
   cal: UCalendar;
+  lTZInfo: TTZInfo;
+  lTZInfoEx: TTZInfoEx;
 begin
   if not Assigned(GetIcuProc) then exit;
   if not GetIcuProc('ucal_open', ucal_open, 1) then exit;
@@ -68,21 +68,30 @@ begin
   cal:=ucal_open(PUnicodeChar(tz), Length(tz), PAnsiChar(locale), 0, err);
   if cal = nil then
     exit;
-  tzdaylight:=ucal_inDaylightTime(cal, err);
+  lTzinfo.daylight:=ucal_inDaylightTime(cal, err);
 
   SetLength(res, 200);
   SetLength(res, ucal_getTimeZoneDisplayName(cal, UCAL_SHORT_STANDARD, PAnsiChar(locale), PUnicodeChar(res), Length(res), err));
   TZStandardName:=utf8string(res);
-  tzname[False]:=PAnsiChar(TZStandardName);
+  lTZInfoEx.name[False]:=TZStandardName;
 
   SetLength(res, 200);
   SetLength(res, ucal_getTimeZoneDisplayName(cal, UCAL_SHORT_DST, PAnsiChar(locale), PUnicodeChar(res), Length(res), err));
   TZDaylightName:=utf8string(res);
-  tzname[True]:=PAnsiChar(TZDaylightName);
+  lTZInfoEx.name[True]:=TZDaylightName;
+
+  lTZInfoEx.leap_correct:=0;
+  lTZInfoEx.leap_hit:=0;
+
+  lTZInfo.seconds:=ucal_get(cal, UCAL_ZONE_OFFSET, err) div 1000;
+  if lTZInfo.daylight then
+    lTZInfo.seconds:=Tzinfo.seconds + ucal_get(cal, UCAL_DST_OFFSET, err) div 1000;
+
+  // ToDo: correct validsince/validuntil values
+  lTZInfo.validsince:=low(lTZInfo.validsince);
+  lTZInfo.validuntil:=high(lTZInfo.validuntil);
 
-  Tzseconds:=ucal_get(cal, UCAL_ZONE_OFFSET, err) div 1000;
-  if tzdaylight then
-    Tzseconds:=Tzseconds + ucal_get(cal, UCAL_DST_OFFSET, err) div 1000;
+  SetTZInfo(lTZInfo, lTZInfoEx);
 
   ucal_close(cal);
 end;
@@ -113,17 +122,25 @@ function ReadTimeZoneFromLibC: boolean;
 var
   t: time_t;
   tt: Ptm;
+  lTZInfo: TTZInfo;
+  lTZInfoEx: TTZInfoEx;
 begin
   ReadTimeZoneFromLibC:=False;
-  tzname[false]:=c_tzname[0];
-  tzname[true]:=c_tzname[1];
+  lTZInfo:=default(TTZInfo);
+  lTZInfoEx:=default(TTZInfoEx);
   t:=fptime;
   tt:=localtime(@t);
   if tt <> nil then
     begin
-      tzdaylight:=tt^.tm_isdst <> 0;
-      tzseconds:=tt^.tm_gmtoff;
-      ReadTimeZoneFromLibC:=tzname[false] <> nil;
+      lTZInfoEx.name[false]:=utf8string(c_tzname[0]);
+      lTZInfoEx.name[true]:=utf8string(c_tzname[1]);
+      lTZInfo.daylight:=tt^.tm_isdst <> 0;
+      lTZInfo.seconds:=tt^.tm_gmtoff;
+      // ToDo: correct validsince/validuntil values
+      lTZInfo.validsince:=low(lTZInfo.validsince);
+      lTZInfo.validuntil:=high(lTZInfo.validuntil);
+      SetTZInfo(lTZInfo, lTZInfoEx);
+      ReadTimeZoneFromLibC:=c_tzname[0] <> nil;
     end;
 end;
 

rtl/beos/bethreads.pp

@@ -168,6 +168,8 @@ Uses
            pthread_key_create(@TLSKey,nil);
            InitThreadVars(@CRelocateThreadvar);
 {$endif HASTHREADVAR}
+          { lazy initialize thread support }
+           LazyInitThreading;
            IsMultiThread:=true;
          end;
         { the only way to pass data to the newly created thread

rtl/darwin/Makefile

@@ -3266,7 +3266,7 @@ unix$(PPUEXT) : $(UNIXINC)/unix.pp unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$
 		 unxconst.inc $(UNIXINC)/timezone.inc \
 		 unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
-unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp  baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pas dl$(PPUEXT) objpas$(PPUEXT) rtlconsts$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT)
 	$(COMPILER) $<
@@ -3277,7 +3277,7 @@ unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) ba
 dos$(PPUEXT) : $(UNIXINC)/dos.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
 	       unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
-sysutils$(PPUEXT) : objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+sysutils$(PPUEXT) : objpas$(PPUEXT) initc$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 		    unixtype$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
 classes$(PPUEXT) : sysutils$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT) typinfo$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \

rtl/darwin/Makefile.fpc

@@ -180,7 +180,7 @@ unix$(PPUEXT) : $(UNIXINC)/unix.pp unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$
                  unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 
-unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp  baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pas dl$(PPUEXT) objpas$(PPUEXT) rtlconsts$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT)
@@ -209,7 +209,7 @@ dos$(PPUEXT) : $(UNIXINC)/dos.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(P
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+sysutils$(PPUEXT) : objpas$(PPUEXT) initc$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
                     unixtype$(PPUEXT)
         $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
 

rtl/freebsd/Makefile

@@ -3601,7 +3601,7 @@ linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixcp.pp
-unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
 	       unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/freebsd/Makefile.fpc

@@ -177,7 +177,7 @@ linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)
         $(COMPILER) $(UNIXINC)/unixcp.pp
 
-unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $<
 
 #

rtl/inc/file.inc

@@ -35,8 +35,16 @@ Begin
   InitFile(F);
 {$ifdef FPC_ANSI_TEXTFILEREC}
   FileRec(f).Name:=ToSingleByteFileSystemEncodedFileName(Name);
+{$ifdef USE_FILEREC_FULLNAME}
+  if Length(Name)>255 then
+    RawByteString(FileRec(f).FullName):=Name;
+{$endif USE_FILEREC_FULLNAME}
 {$else FPC_ANSI_TEXTFILEREC}
   FileRec(f).Name:=Name;
+{$ifdef USE_FILEREC_FULLNAME}
+  if Length(Name)>255 then
+    UnicodeString(FileRec(f).FullName):=Name;
+{$endif USE_FILEREC_FULLNAME}
 {$endif FPC_ANSI_TEXTFILEREC}
   { null terminate, since the name array is regularly used as p(wide)char }
   FileRec(f).Name[high(FileRec(f).Name)]:=#0;
@@ -54,8 +62,16 @@ Begin
 {$ifdef FPC_ANSI_TEXTFILEREC}
   { ensure the characters in the record's filename are encoded correctly }
   FileRec(f).Name:=ToSingleByteFileSystemEncodedFileName(Name);
+{$ifdef USE_FILEREC_FULLNAME}
+  if Length(Name)>255 then
+    RawbyteString(FileRec(f).FullName):=Name;
+{$endif USE_FILEREC_FULLNAME}
 {$else FPC_ANSI_TEXTFILEREC}
   FileRec(f).Name:=Name;
+{$ifdef USE_FILEREC_FULLNAME}
+  if Length(Name)>255 then
+    UnicodeString(FileRec(f).FullName):=Name;
+{$endif USE_FILEREC_FULLNAME}
 {$endif FPC_ANSI_TEXTFILEREC}
   { null terminate, since the name array is regularly used as p(wide)char }
   FileRec(f).Name[high(FileRec(f).Name)]:=#0;
@@ -119,7 +135,12 @@ Begin
   else
    Begin
      { Reopen with filemode 2, to be Tp compatible (PFV) }
-     Do_Open(f,PFileTextRecChar(@FileRec(f).Name),$1002,false);
+{$ifdef USE_FILEREC_FULLNAME}
+     if Assigned(FileRec(f).FullName) then
+       Do_Open(f,FileRec(f).FullName,$1002,false)
+     else
+{$endif USE_FILEREC_FULLNAME}
+       Do_Open(f,PFileTextRecChar(@FileRec(f).Name),$1002,false);
      FileRec(f).RecSize:=l;
    End;
 End;
@@ -145,7 +166,12 @@ Begin
    InOutRes:=2
   else
    Begin
-     Do_Open(f,PFileTextRecChar(@FileRec(f).Name),Filemode,false);
+{$ifdef USE_FILEREC_FULLNAME}
+     if Assigned(FileRec(f).FullName) then
+       Do_Open(f,FileRec(f).FullName,Filemode,false)
+     else
+{$endif USE_FILEREC_FULLNAME}
+       Do_Open(f,PFileTextRecChar(@FileRec(f).Name),Filemode,false);
      FileRec(f).RecSize:=l;
    End;
 End;
@@ -493,6 +519,11 @@ Begin
       end
     else InOutRes:=103;
   end;
+{$ifdef USE_FILEREC_FULLNAME}
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+  UnicodeString(FileRec(f).FullName):='';
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$endif USE_FILEREC_FULLNAME}
 End;
 
 
@@ -650,3 +681,15 @@ Begin
 End;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+Function GetFullName(var f:File) : UnicodeString;
+  begin
+{$ifdef USE_FILEREC_FULLNAME}
+  if Assigned(FileRec(f).FullName) then
+    Result:=UnicodeString(FileRec(f).FullName)
+  else
+{$endif USE_FILEREC_FULLNAME}
+    Result:=PFileTextRecChar(@FileRec(f).Name);
+  end;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+

rtl/inc/filerec.inc

@@ -40,5 +40,8 @@ type
     _private  : array[1..3 * SizeOf(SizeInt) + 5 * SizeOf (pointer)] of byte;
     UserData  : array[1..32] of byte;
     name      : array[0..filerecnamelength] of TFileTextRecChar;
+{$ifdef USE_FILEREC_FULLNAME}
+    FullName  : Pointer;
+{$endif USE_FILEREC_FULLNAME}
   End;
 

rtl/inc/systemh.inc

@@ -87,6 +87,13 @@
 {$define FPC_HAS_FEATURE_UNICODESTRINGS}
 {$endif VER2_6}
 
+{ for now, the presence of unicode strings is just an approximation,
+  USE_FILEREC_FULLNAME can be also enabled for other targets if
+  they need file names longer than 255 chars }
+{$if defined(FPC_HAS_FEATURE_UNICODESTRINGS)}
+{$define USE_FILEREC_FULLNAME}
+{$endif defined(FPC_HAS_FEATURE_UNICODESTRINGS)}
+
 {****************************************************************************
                          Global Types and Constants
 ****************************************************************************}
@@ -1372,6 +1379,9 @@ Procedure Seek(var f:File;Pos:Int64);
 Function  EOF(var f:File):Boolean;
 Procedure Erase(var f:File);
 Procedure Truncate (var F:File);
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+Function GetFullName(var f:File) : UnicodeString;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 
@@ -1431,6 +1441,9 @@ Procedure SetTextBuf(var f:Text; var Buf; Size:SizeInt);
 Procedure SetTextLineEnding(var f:Text; Ending:string);
 function GetTextCodePage(var T: Text): TSystemCodePage;
 procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+Function GetFullName(var T:Text) : UnicodeString;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
 {$endif FPC_HAS_FEATURE_TEXTIO}
 
 {****************************************************************************

rtl/inc/text.inc

@@ -57,7 +57,12 @@ Begin
      exit;
    end;
   End;
-  Do_Open(t,PFileTextRecChar(@t.Name),Flags,False);
+{$ifdef USE_FILEREC_FULLNAME}
+  if Assigned(t.FullName) then
+    Do_Open(t,PFileTextRecChar(t.FullName),Flags,False)
+  else
+{$endif USE_FILEREC_FULLNAME}
+    Do_Open(t,PFileTextRecChar(@t.Name),Flags,False);
   t.CloseFunc:=@FileCloseFunc;
   t.FlushFunc:=nil;
   if t.Mode=fmInput then
@@ -98,8 +103,16 @@ begin
   InitText(t);
 {$ifdef FPC_ANSI_TEXTFILEREC}
   TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
+{$ifdef USE_FILEREC_FULLNAME}
+  if length(s)>255 then
+    RawByteString(TextRec(t).FullName):=ToSingleByteFileSystemEncodedFileName(S);
+{$endif USE_FILEREC_FULLNAME}
 {$else FPC_ANSI_TEXTFILEREC}
   TextRec(t).Name:=S;
+{$ifdef USE_FILEREC_FULLNAME}
+  if length(s)>255 then
+    UnicodeString(TextRec(t).FullName):=S;
+{$endif USE_FILEREC_FULLNAME}
 {$endif FPC_ANSI_TEXTFILEREC}
   { null terminate, since the name array is regularly used as p(wide)char }
   TextRec(t).Name[high(TextRec(t).Name)]:=#0;
@@ -114,8 +127,16 @@ Begin
 {$ifdef FPC_ANSI_TEXTFILEREC}
   { ensure the characters in the record's filename are encoded correctly }
   TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
+{$ifdef USE_FILEREC_FULLNAME}
+  if length(s)>255 then
+    RawByteString(TextRec(t).FullName):=ToSingleByteFileSystemEncodedFileName(S);
+{$endif USE_FILEREC_FULLNAME}
 {$else FPC_ANSI_TEXTFILEREC}
   TextRec(t).Name:=S;
+{$ifdef USE_FILEREC_FULLNAME}
+  if length(s)>255 then
+    UnicodeString(TextRec(t).FullName):=S;
+{$endif USE_FILEREC_FULLNAME}
 {$endif FPC_ANSI_TEXTFILEREC}
   { null terminate, since the name array is regularly used as p(wide)char }
   TextRec(t).Name[high(TextRec(t).Name)]:=#0;
@@ -183,6 +204,13 @@ Begin
       End
     else inOutRes := 103;
   End;
+{$ifdef USE_FILEREC_FULLNAME}
+{$ifdef FPC_ANSI_TEXTFILEREC}
+  RawByteString(TextRec(t).FullName):='';
+{$else FPC_ANSI_TEXTFILEREC}
+  UnicodeString(TextRec(t).FullName):='';
+{$endif FPC_ANSI_TEXTFILEREC}
+{$endif USE_FILEREC_FULLNAME}
 End;
 
 
@@ -2618,6 +2646,17 @@ begin
 end;
 {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+Function GetFullName(var t:Text) : UnicodeString;
+  begin
+{$ifdef USE_FILEREC_FULLNAME}
+  if Assigned(TextRec(t).FullName) then
+    Result:=UnicodeString(TextRec(t).FullName)
+  else
+{$endif USE_FILEREC_FULLNAME}
+    Result:=PFileTextRecChar(@TextRec(t).Name);
+  end;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
 
 {*****************************************************************************
                                Initializing

rtl/inc/textrec.inc

@@ -57,5 +57,8 @@ type
 {$ifdef FPC_HAS_CPSTRING}
     CodePage  : TSystemCodePage;
 {$endif}
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+    FullName  : Pointer;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
   End;
 

rtl/inc/thread.inc

@@ -349,6 +349,63 @@ begin
   currenttm.RTLEventWaitForTimeout(state,timeout);
 end;
 
+{ ---------------------------------------------------------------------
+    lazy thread initialization support
+  ---------------------------------------------------------------------}
+
+type
+  PLazyInitThreadingProcInfo = ^TLazyInitThreadingProcInfo;
+  TLazyInitThreadingProcInfo = Record
+    Next     : PLazyInitThreadingProcInfo;
+    Proc     : TProcedure;
+  End;
+const
+  LazyInitThreadingProcList: PLazyInitThreadingProcInfo = nil;
+
+procedure FinalizeLazyInitThreading;
+var
+  p: PLazyInitThreadingProcInfo;
+begin
+  while assigned(LazyInitThreadingProcList) do
+    begin
+    p:=LazyInitThreadingProcList^.Next;
+    Dispose(LazyInitThreadingProcList);
+    LazyInitThreadingProcList:=p;
+    end;
+end;
+
+procedure RegisterLazyInitThreadingProc(const proc: TProcedure);
+var
+  p: PLazyInitThreadingProcInfo;
+begin
+  if IsMultiThread then
+    begin
+    { multithreading is already enabled - execute directly }
+    proc();
+    end
+  else
+    begin
+    if not assigned(LazyInitThreadingProcList) then
+      AddExitProc(@FinalizeLazyInitThreading);
+    new(p);
+    p^.Next:=LazyInitThreadingProcList;
+    p^.Proc:=proc;
+    LazyInitThreadingProcList:=p;
+    end;
+end;
+
+procedure LazyInitThreading;
+var
+  p: PLazyInitThreadingProcInfo;
+begin
+  p:=LazyInitThreadingProcList;
+  while assigned(p) do
+    begin
+    p^.Proc();
+    p:=p^.Next;
+    end;
+end;
+
 { ---------------------------------------------------------------------
     ThreadManager which gives run-time error. Use if no thread support.
   ---------------------------------------------------------------------}

rtl/inc/threadh.inc

@@ -183,3 +183,7 @@ procedure RTLEventResetEvent(state:pRTLEvent);
 procedure RTLEventWaitFor(state:pRTLEvent);
 procedure RTLEventWaitFor(state:pRTLEvent;timeout : longint);
 
+{ lazy thread initialization support }
+procedure RegisterLazyInitThreadingProc(const proc: TProcedure);
+{ do not call LazyInitThreading directly}
+procedure LazyInitThreading;

rtl/inc/ustrings.inc

@@ -1833,9 +1833,9 @@ end;
             if (IBYTE and $80) = 0 then
               begin
                 //One character US-ASCII, convert it to unicode
+(*
                 if IBYTE = 10 then
                   begin
-(*
                     If (PreChar<>13) and FALSE then
                       begin
                         //Expand to crlf, conform UTF-8.
@@ -1856,7 +1856,6 @@ end;
                           end;
                       end
                     else
-*)
                       begin
                         Dest[OutputUnicode]:=WideChar(IBYTE);
                         inc(OutputUnicode);
@@ -1864,6 +1863,7 @@ end;
                       end;
                   end
                 else
+*)
                   begin
                     Dest[OutputUnicode]:=WideChar(IBYTE);
                     inc(OutputUnicode);
@@ -1978,9 +1978,9 @@ end;
             if (IBYTE and $80) = 0 then
               begin
                 //One character US-ASCII, convert it to unicode
+(*
                 if IBYTE = 10 then
                   begin
-(*
                     if (PreChar<>13) and FALSE then
                       begin
                         //Expand to crlf, conform UTF-8.
@@ -1990,13 +1990,13 @@ end;
                         PreChar:=10;
                       end
                     else
-*)
                       begin
                         inc(OutputUnicode);
                         PreChar:=IBYTE;
                       end;
                   end
                 else
+*)
                   begin
                     inc(OutputUnicode);
                     PreChar:=IBYTE;

rtl/linux/Makefile

@@ -4338,13 +4338,13 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
 		   $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(INC)/strings.pp
-unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) syscall$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
 		 unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) unixutil$(PPUEXT) \
 		 unxfunc.inc
 	$(COMPILER) $(UNIXINC)/unix.pp
 syscall$(PPUEXT) : $(UNIXINC)/syscall.pp $(ARCH)/syscallh.inc $(SYSNRINC)  $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/syscall.pp
-unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(INC)/textrec.inc $(INC)/filerec.inc $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(INC)/textrec.inc $(INC)/filerec.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixutil.pp
 unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixtype.pp

rtl/linux/Makefile.fpc

@@ -332,7 +332,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 # $(SYSTEMUNIT) Dependent Units
 #
 
-unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) syscall$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
                  unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) unixutil$(PPUEXT) \
                  unxfunc.inc
 	$(COMPILER) $(UNIXINC)/unix.pp
@@ -340,7 +340,7 @@ unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/tex
 syscall$(PPUEXT) : $(UNIXINC)/syscall.pp $(ARCH)/syscallh.inc $(SYSNRINC)  $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/syscall.pp
 
-unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(INC)/textrec.inc $(INC)/filerec.inc $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(INC)/textrec.inc $(INC)/filerec.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixutil.pp
 
 unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)

rtl/netware/systhrd.inc

@@ -156,6 +156,8 @@ function SysBeginThread(sa : Pointer;stacksize : SizeUInt;
      if not IsMultiThread then
      begin
        InitThreadVars(@SysRelocateThreadvar);
+      { lazy initialize thread support }
+       LazyInitThreading;
        IsMultithread:=true;
      end;
      { the only way to pass data to the newly created thread }

rtl/netwlibc/systhrd.inc

@@ -133,6 +133,8 @@
           { We're still running in single thread mode, setup the TLS }
            pthread_key_create(@TLSKey,nil);
            InitThreadVars(@SysRelocateThreadvar);
+          { lazy initialize thread support }
+           LazyInitThreading;
            IsMultiThread:=true;
          end;
         { the only way to pass data to the newly created thread

rtl/objpas/sysutils/dati.inc

@@ -271,6 +271,17 @@ begin
   result := systemTimeToDateTime(SystemTime);
 end;
 
+{   NowUTC returns the current UTC Date and Time if available on the OS. If not, local date is returned   }
+
+function NowUTC: TDateTime;
+var
+  SystemTime: TSystemTime;
+begin
+  if not GetUniversalTime(SystemTime) then
+    GetLocalTime(SystemTime);
+  result := systemTimeToDateTime(SystemTime);
+end;
+
 {   IncMonth increments DateTime with NumberOfMonths months,
     NumberOfMonths can be less than zero   }
 
@@ -1525,16 +1536,21 @@ begin
   Result:=0;
 end;
 
-function GetLocalTimeOffset(const DateTime: TDateTime; out Offset: Integer): Boolean;
+function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: Boolean; out Offset: Integer): Boolean;
+begin
+  Result:=False;
+end;
+
+function GetUniversalTime(var SystemTime: TSystemTime): Boolean;
 begin
   Result:=False;
 end;
 {$ENDIF}
 
-function GetLocalTimeOffset(const DateTime: TDateTime): Integer;
+function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: Boolean): Integer;
 begin
-  if not GetLocalTimeOffset(DateTime, Result) then
-    Result:=GetLocalTimeOffset;
+  if not GetLocalTimeOffset(DateTime, InputIsUTC, Result) then
+    Result:=GetLocalTimeOffset();
 end;
 
 { Conversion of UTC to local time and vice versa }
@@ -1542,7 +1558,7 @@ end;
 function UniversalTimeToLocal(UT: TDateTime): TDateTime;
 
 begin
-  Result:=UniversalTimeToLocal(UT,-GetLocalTimeOffset(UT));
+  Result:=UniversalTimeToLocal(UT,-GetLocalTimeOffset(UT, True));
 end;
 
 function UniversalTimeToLocal(UT: TDateTime; TZOffset : Integer): TDateTime;
@@ -1559,7 +1575,7 @@ end;
 Function LocalTimeToUniversal(LT: TDateTime): TDateTime;
 
 begin
-  Result:=LocalTimeToUniversal(LT,-GetLocalTimeOffset(LT));
+  Result:=LocalTimeToUniversal(LT,-GetLocalTimeOffset(LT, False));
 end;
 
 Function LocalTimeToUniversal(LT: TDateTime;TZOffset: Integer): TDateTime;

rtl/objpas/sysutils/datih.inc

@@ -128,6 +128,7 @@ function DayOfWeek(DateTime: TDateTime): integer;
 function Date: TDateTime;
 function Time: TDateTime;
 function Now: TDateTime;
+function NowUTC: TDateTime;
 function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
 procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
 function IsLeapYear(Year: Word): boolean;
@@ -195,13 +196,14 @@ function StrToDateTimeDef(const S: AnsiString; const Defvalue : TDateTime; const
 function CurrentYear:Word;
 { FPC Extra }
 Procedure GetLocalTime(var SystemTime: TSystemTime);
+function GetUniversalTime(var SystemTime: TSystemTime): Boolean;
 
 procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime); inline;
 procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;
 
 function GetLocalTimeOffset: Integer;
-function GetLocalTimeOffset(const DateTime: TDateTime; out Offset: Integer): Boolean;
-function GetLocalTimeOffset(const DateTime: TDateTime): Integer;
+function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: Boolean; out Offset: Integer): Boolean;
+function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: Boolean = False): Integer;
 
 Function FileDateToUTC (Filedate : Int64) : TDateTime;
 

rtl/sinclairql/Makefile.fpc

@@ -0,0 +1,109 @@
+#
+#   Makefile.fpc for Free Pascal Sinclair QL RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=$(LOADERS)
+units=$(SYSTEMUNIT) fpextres uuchar objpas macpas iso7185 buildrtl cpall
+# extpas
+implicitunits=si_prc \
+      ctypes strings rtlconsts sysconst math types \
+      typinfo sortbase fgl classes charset character getopts fpwidestring \
+      cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
+      cp437 cp646 cp737 cp775 cp850 cp852 cp855 cp856 cp857 cp860 cp861 cp862 \
+      cp863 cp864 cp865 cp866 cp869 cp874 cp3021 cp8859_1 cp8859_2 cp8859_3 cp8859_4 \
+      cp8859_5 cp8859_6 cp8859_7 cp8859_8 cp8859_9 cp8859_10 cp8859_11 \
+      cp8859_13 cp8859_14 cp8859_15 cp8859_16 cpkoi8_r cpkoi8_u \
+      unicodedata unicodenumtable
+
+rsts=math rtlconsts typinfo classes sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=ql
+cpu=m68k
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(CPU_TARGET)
+sourcedir=$(INC) $(PROCINC) $(CPU_TARGET) $(COMMON)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+LOADERS=
+SYSTEMUNIT=system
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+[rules]
+.NOTPARALLEL:
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+        $(COMPILER) $(FPC_SYSTEM_OPT) -Us -Sg @rtl.cfg $(SYSTEMUNIT).pp $(REDIR)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
+
+uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/uuchar.pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
+
+macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) buildrtl$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/macpas.pp
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp buildrtl$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
+
+extpas$(PPUEXT) : $(INC)/extpas.pp buildrtl$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/extpas.pp
+
+buildrtl$(PPUEXT): buildrtl.pp system$(PPUEXT) objpas$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(OBJPASDIR)/classes -Fu$(CPU_TARGET) -Fu$(PROCINC) -Fu$(AMIINC) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
+
+fpextres$(PPUEXT) : $(INC)/fpextres.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/fpextres.pp
+
+cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) objpas$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas

rtl/sinclairql/buildrtl.pp

@@ -0,0 +1,16 @@
+unit buildrtl;
+
+  interface
+
+    uses
+      si_prc,
+
+      ctypes, strings,
+      rtlconsts, sysconst, math, types,
+      typinfo, sortbase, fgl, classes,
+      charset, character, getopts,
+      fpwidestring;
+
+  implementation
+
+end.

rtl/sinclairql/rtl.cfg

@@ -0,0 +1,4 @@
+# Some optional features for the Sinclair QL
+
+# Can be disabled to reduce binary sizes.
+#-SfNOUNICODESTRINGS

rtl/sinclairql/rtldefs.inc

@@ -0,0 +1,24 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2012 by Free Pascal development team
+
+    This file contains platform-specific defines that are used in
+    multiple RTL units.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{ the single byte OS APIs always use UTF-8 }
+{ define FPCRTL_FILESYSTEM_UTF8}
+
+{ The OS supports a single byte file system operations API that we use }
+{$define FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+
+{ The OS supports a two byte file system operations API that we use }
+{ define FPCRTL_FILESYSTEM_TWO_BYTE_API}

rtl/sinclairql/si_prc.pp

@@ -0,0 +1,42 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    System Entry point for the Sinclair QL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+unit si_prc;
+
+interface
+
+implementation
+
+var
+  procdesc: PPD; public name '__base';
+  stacktop: pointer;
+  stklen: longint; external name '__stklen';
+
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+
+{ this function must be the first in this unit which contains code }
+{$OPTIMIZATION OFF}
+procedure _FPC_proc_start(pd: PPD); cdecl; public name '_start';
+begin
+end;
+
+procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+end;
+
+
+end.

rtl/sinclairql/sysdir.inc

@@ -0,0 +1,37 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Free Pascal development team
+
+    Low level directory functions for the Sinclair QL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+procedure do_mkdir(const s : rawbytestring);
+begin
+end;
+
+
+procedure do_rmdir(const s : rawbytestring);
+begin
+end;
+
+
+procedure do_ChDir(const s: rawbytestring);
+begin
+end;
+
+
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+end;

rtl/sinclairql/sysfile.inc

@@ -0,0 +1,94 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Free Pascal development team
+
+    Low level file functions for the Sinclair QL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                        Low level File Routines
+               All these functions can set InOutRes on errors
+****************************************************************************}
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+begin
+end;
+
+
+procedure do_erase(p : pchar; pchangeable: boolean);
+begin
+end;
+
+
+procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean);
+begin
+end;
+
+
+function do_write(h: longint; addr: pointer; len: longint) : longint;
+begin
+  do_write:=-1;
+end;
+
+
+function do_read(h: longint; addr: pointer; len: longint) : longint;
+begin
+  do_read:=-1;
+end;
+
+
+function do_filepos(handle: longint) : longint;
+begin
+  do_filepos:=-1;
+end;
+
+
+procedure do_seek(handle, pos: longint);
+begin
+end;
+
+
+function do_seekend(handle: longint):longint;
+begin
+  do_seekend:=-1;
+end;
+
+
+function do_filesize(handle : THandle) : longint;
+begin
+  do_filesize:=-1;
+end;
+
+
+{ truncate at a given position }
+procedure do_truncate(handle, pos: longint);
+begin
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+begin
+end;
+
+
+function do_isdevice(handle: thandle): boolean;
+begin
+  do_isdevice:=false;
+end;

rtl/sinclairql/sysheap.inc

@@ -0,0 +1,29 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2005 by Free Pascal development team
+
+    Low level memory functions
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+      OS Memory allocation / deallocation
+ ****************************************************************************}
+
+
+function SysOSAlloc(size: ptruint): pointer;
+begin
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+end;

rtl/sinclairql/sysos.inc

@@ -0,0 +1,20 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+procedure Error2InOutRes(errno: longint);
+begin
+end;

rtl/sinclairql/sysosh.inc

@@ -0,0 +1,34 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+  THandle = Int64;
+{$else CPU64}
+  THandle = Longint;
+{$endif CPU64}
+  TThreadID = THandle;
+  TOSTimestamp = Longint;
+
+  PRTLCriticalSection = ^TRTLCriticalSection;
+  TRTLCriticalSection = record
+   Locked: boolean
+  end;
+
+
+

rtl/sinclairql/system.pp

@@ -0,0 +1,171 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    System unit for the Sinclair QL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+unit System;
+
+interface
+
+{$define FPC_IS_SYSTEM}
+{$define FPC_STDOUT_TRUE_ALIAS}
+{$define FPC_ANSI_TEXTFILEREC}
+{$define FPC_QL_USE_TINYHEAP}
+
+{$ifdef FPC_QL_USE_TINYHEAP}
+{$define HAS_MEMORYMANAGER}
+{$endif FPC_QL_USE_TINYHEAP}
+
+{$i systemh.inc}
+{$ifdef FPC_QL_USE_TINYHEAP}
+{$i tnyheaph.inc}
+{$endif FPC_QL_USE_TINYHEAP}
+
+{Platform specific information}
+const
+    LineEnding = #13#10;
+    LFNSupport = false;
+    CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+    DirectorySeparator = '\';
+    DriveSeparator = ':';
+    ExtensionSeparator = '.';
+    PathSeparator = ';';
+    AllowDirectorySeparators : set of char = ['\','/'];
+    AllowDriveSeparators : set of char = [':'];
+    FileNameCaseSensitive = false;
+    FileNameCasePreserving = false;
+    maxExitCode = 255;
+    MaxPathLen = 255;
+    AllFilesMask = '*.*';
+
+    sLineBreak = LineEnding;
+    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+const
+    UnusedHandle    = $ffff;
+    StdInputHandle  = 0;
+    StdOutputHandle = 1;
+    StdErrorHandle  = $ffff;
+
+var
+    args: PChar;
+    argc: LongInt;
+    argv: PPChar;
+    envp: PPChar;
+
+
+    {$if defined(FPUSOFT)}
+
+    {$define fpc_softfpu_interface}
+    {$i softfpu.pp}
+    {$undef fpc_softfpu_interface}
+
+    {$endif defined(FPUSOFT)}
+
+
+  implementation
+
+    {$if defined(FPUSOFT)}
+
+    {$define fpc_softfpu_implementation}
+    {$define softfpu_compiler_mul32to64}
+    {$define softfpu_inline}
+    {$i softfpu.pp}
+    {$undef fpc_softfpu_implementation}
+
+    { we get these functions and types from the softfpu code }
+    {$define FPC_SYSTEM_HAS_float64}
+    {$define FPC_SYSTEM_HAS_float32}
+    {$define FPC_SYSTEM_HAS_flag}
+    {$define FPC_SYSTEM_HAS_extractFloat64Frac0}
+    {$define FPC_SYSTEM_HAS_extractFloat64Frac1}
+    {$define FPC_SYSTEM_HAS_extractFloat64Exp}
+    {$define FPC_SYSTEM_HAS_extractFloat64Sign}
+    {$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
+    {$define FPC_SYSTEM_HAS_extractFloat32Exp}
+    {$define FPC_SYSTEM_HAS_extractFloat32Sign}
+
+    {$endif defined(FPUSOFT)}
+
+    {$i system.inc}
+    {$ifdef FPC_QL_USE_TINYHEAP}
+    {$i tinyheap.inc}
+    {$endif FPC_QL_USE_TINYHEAP}
+
+
+  function GetProcessID:SizeUInt;
+  begin
+    GetProcessID := 1;
+  end;
+
+
+  procedure SysInitParamsAndEnv;
+  begin
+  end;
+
+
+  procedure randomize;
+  begin
+    {$WARNING: randseed is uninitialized}
+    randseed:=0;
+  end;
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+procedure system_exit;
+begin
+end;
+
+{*****************************************************************************
+                         System Unit Initialization
+*****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+{$ifndef FPC_STDOUT_TRUE_ALIAS}
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{$endif FPC_STDOUT_TRUE_ALIAS}
+end;
+
+function CheckInitialStkLen (StkLen: SizeUInt): SizeUInt;
+begin
+  CheckInitialStkLen := StkLen;
+end;
+
+
+begin
+  StackLength := CheckInitialStkLen (InitialStkLen);
+{ Initialize ExitProc }
+  ExitProc:=Nil;
+{$ifndef FPC_QL_USE_TINYHEAP}
+{ Setup heap }
+  InitHeap;
+{$endif FPC_QL_USE_TINYHEAP}
+  SysInitExceptions;
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+  InitUnicodeStringManager;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+{ Setup stdin, stdout and stderr }
+  SysInitStdIO;
+{ Reset IO Error }
+  InOutRes:=0;
+{ Setup command line arguments }
+  SysInitParamsAndEnv;
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  InitSystemThreads;
+{$endif FPC_HAS_FEATURE_THREADING}
+end.

rtl/sinclairql/tthread.inc

@@ -0,0 +1,80 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+{****************************************************************************}
+{*                             TThread                                      *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+  GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt);
+
+begin
+ {IsMultiThread := TRUE; }
+end;
+
+
+procedure TThread.SysDestroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+  WaitFor:=0;
+end;
+
+

rtl/solaris/Makefile

@@ -3246,7 +3246,7 @@ unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(P
 		 unxconst.inc $(UNIXINC)/timezone.inc \
 		 unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unix.pp
-unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixutil.pp
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixcp.pp

rtl/solaris/Makefile.fpc

@@ -157,7 +157,7 @@ unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(P
                  unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unix.pp
 
-unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixutil.pp
 
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)

rtl/unix/cthreads.pp

@@ -357,7 +357,12 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
       { Initialize multithreading if not done }
       if not TLSInitialized then
         InitCTLS;
-      IsMultiThread:=true;
+      if not IsMultiThread then
+        begin
+          { We're still running in single thread mode, lazy initialize thread support }
+           LazyInitThreading;
+           IsMultiThread:=true;
+        end;
 
       { the only way to pass data to the newly created thread
         in a MT safe way, is to use the heap }

rtl/unix/dos.pp

@@ -57,7 +57,7 @@ Function AddDisk(const path:string) : byte; platform;
 Implementation
 
 Uses
-  UnixUtil, // tzSeconds
+  UnixUtil,
   Strings,
   Unix,
   {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF};
@@ -89,90 +89,6 @@ type
                         --- Info / Date / Time ---
 ******************************************************************************}
 
-
-Const
-{Date Calculation}
-  C1970 = 2440588;
-  D0    = 1461;
-  D1    = 146097;
-  D2    = 1721119;
-type
-  GTRec = packed Record
-    Year,
-    Month,
-    MDay,
-    WDay,
-    Hour,
-    Minute,
-    Second : Word;
-  End;
-
-Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
-Var
-  Century,XYear: LongInt;
-Begin
-  If Month<=2 Then
-   Begin
-     Dec(Year);
-     Inc(Month,12);
-   End;
-  Dec(Month,3);
-  Century:=(longint(Year Div 100)*D1) shr 2;
-  XYear:=(longint(Year Mod 100)*D0) shr 2;
-  GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
-End;
-
-
-Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
-{
-  Transforms local time (year,month,day,hour,minutes,second) to Epoch time
-   (seconds since 00:00, january 1 1970, corrected for local time zone)
-}
-Begin
-  LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
-                (LongInt(Hour)*3600)+(Longint(Minute)*60)+Second-TZSeconds;
-End;
-
-Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
-Var
-  YYear,XYear,Temp,TempMonth : LongInt;
-Begin
-  Temp:=((JulianDN-D2) shl 2)-1;
-  JulianDN:=Temp Div D1;
-  XYear:=(Temp Mod D1) or 3;
-  YYear:=(XYear Div D0);
-  Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
-  Day:=((Temp Mod 153)+5) Div 5;
-  TempMonth:=Temp Div 153;
-  If TempMonth>=10 Then
-   Begin
-     inc(YYear);
-     dec(TempMonth,12);
-   End;
-  inc(TempMonth,3);
-  Month := TempMonth;
-  Year:=YYear+(JulianDN*100);
-end;
-
-Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
-{
-  Transforms Epoch time into local time (hour, minute,seconds)
-}
-Var
-  DateNum: LongInt;
-Begin
-  inc(Epoch,TZSeconds);
-  Datenum:=(Epoch Div 86400) + c1970;
-  JulianToGregorian(DateNum,Year,Month,day);
-  Epoch:=Abs(Epoch Mod 86400);
-  Hour:=Epoch Div 3600;
-  Epoch:=Epoch Mod 3600;
-  Minute:=Epoch Div 60;
-  Second:=Epoch Mod 60;
-End;
-
-
-
 Function DosVersion:Word;
 Var
   Buffer : Array[0..255] of Char;