Explorar o código

* synchronized with trunk

git-svn-id: branches/wasm@47716 -
nickysn %!s(int64=4) %!d(string=hai) anos
pai
achega
dc5b78d5f0
Modificáronse 52 ficheiros con 2203 adicións e 753 borrados
  1. 4 0
      .gitattributes
  2. 1 1
      compiler/aarch64/cpupara.pas
  3. 2 0
      compiler/aoptobj.pas
  4. 1 1
      compiler/arm/aoptcpu.pas
  5. 12 3
      compiler/cgobj.pas
  6. 19 0
      compiler/compinnr.pas
  7. 22 0
      compiler/defutil.pas
  8. 18 18
      compiler/i386/i386prop.inc
  9. 18 18
      compiler/i8086/i8086prop.inc
  10. 173 36
      compiler/link.pas
  11. 3 0
      compiler/nadd.pas
  12. 37 3
      compiler/ncal.pas
  13. 2 1
      compiler/ncgbas.pas
  14. 2 0
      compiler/ncgflw.pas
  15. 16 0
      compiler/ncginl.pas
  16. 64 0
      compiler/nflw.pas
  17. 30 0
      compiler/ninl.pas
  18. 29 0
      compiler/nutils.pas
  19. 4 1
      compiler/optcse.pas
  20. 3 1
      compiler/pass_2.pas
  21. 80 0
      compiler/ppcppc64le.lpi
  22. 153 102
      compiler/psub.pas
  23. 2 1
      compiler/systems/t_linux.pas
  24. 144 0
      compiler/x86/nx86inl.pas
  25. 18 60
      compiler/x86/x86ins.dat
  26. 18 18
      compiler/x86_64/x8664pro.inc
  27. 3 2
      compiler/xtensa/cpuinfo.pas
  28. 63 0
      compiler/xtensa/ncpuinl.pas
  29. 1 1
      compiler/z80/raz80asm.pas
  30. 10 6
      packages/chm/src/chmreader.pas
  31. 2 1
      packages/fcl-passrc/src/pasresolveeval.pas
  32. 89 57
      packages/fcl-passrc/src/pasresolver.pp
  33. 19 10
      packages/fcl-passrc/src/pasuseanalyzer.pas
  34. 23 0
      packages/pastojs/src/fppas2js.pp
  35. 26 12
      packages/pastojs/src/pas2jscompiler.pp
  36. 166 59
      packages/pastojs/src/pas2jsfiler.pp
  37. 2 2
      packages/pastojs/src/pas2jslibcompiler.pp
  38. 24 0
      packages/pastojs/tests/tcfiler.pas
  39. 7 1
      packages/winunits-base/src/comobj.pp
  40. 35 0
      tests/test/tgenfunc23.pp
  41. 312 0
      tests/test/tminmax.pp
  42. 37 0
      tests/webtbs/tw38151.pp
  43. 139 124
      utils/fpdoc/dglobals.pp
  44. 156 170
      utils/fpdoc/dw_html.pp
  45. 10 9
      utils/fpdoc/dw_txt.pp
  46. 67 7
      utils/fpdoc/dwriter.pp
  47. 1 1
      utils/fpdoc/fpclasschart.pp
  48. 2 3
      utils/fpdoc/fpdoc.lpi
  49. 2 0
      utils/fpdoc/fpdoc.pp
  50. 106 23
      utils/fpdoc/fpdocclasstree.pp
  51. 25 0
      utils/fpdoc/mkfpdoc.pp
  52. 1 1
      utils/pas2js/pas2js.pp

+ 4 - 0
.gitattributes

@@ -675,6 +675,7 @@ compiler/ppcmips64el.lpi svneol=native#text/plain
 compiler/ppcmipsel.lpi svneol=native#text/plain
 compiler/ppcppc.lpi svneol=native#text/plain
 compiler/ppcppc64.lpi svneol=native#text/plain
+compiler/ppcppc64le.lpi svneol=native#text/plain
 compiler/ppcriscv32.lpi svneol=native#text/plain
 compiler/ppcriscv64.lpi svneol=native#text/plain
 compiler/ppcsparc.lpi svneol=native#text/plain
@@ -15211,6 +15212,7 @@ tests/test/tgenfunc2.pp svneol=native#text/pascal
 tests/test/tgenfunc20.pp svneol=native#text/pascal
 tests/test/tgenfunc21.pp svneol=native#text/pascal
 tests/test/tgenfunc22.pp svneol=native#text/pascal
+tests/test/tgenfunc23.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
 tests/test/tgenfunc5.pp svneol=native#text/pascal
@@ -15393,6 +15395,7 @@ tests/test/tmacprocvar.pp svneol=native#text/plain
 tests/test/tmainnam.pp svneol=native#text/plain
 tests/test/tmath1.pp svneol=native#text/plain
 tests/test/tmcbool2.pp svneol=native#text/plain
+tests/test/tminmax.pp svneol=native#text/pascal
 tests/test/tmmx1.pp svneol=native#text/plain
 tests/test/tmoperator1.pp svneol=native#text/pascal
 tests/test/tmoperator10.pp svneol=native#text/pascal
@@ -18638,6 +18641,7 @@ tests/webtbs/tw38122.pp svneol=native#text/pascal
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw38145a.pp svneol=native#text/pascal
 tests/webtbs/tw38145b.pp svneol=native#text/pascal
+tests/webtbs/tw38151.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain

+ 1 - 1
compiler/aarch64/cpupara.pas

@@ -349,7 +349,7 @@ unit cpupara;
         paracgsize, locsize: tcgsize;
         firstparaloc: boolean;
       begin
-        result.reset;
+        result.init;
 
         { currently only support C-style array of const,
           there should be no location assigned to the vararg array itself }

+ 2 - 0
compiler/aoptobj.pas

@@ -1506,6 +1506,8 @@ Unit AoptObj;
 
     procedure TAOptObj.RemoveCurrentP(var p: tai; const hp1: tai); inline;
       begin
+        if (p=hp1) then
+          internalerror(2020120501);
         UpdateUsedRegs(tai(p.Next));
         AsmL.Remove(p);
         p.Free;

+ 1 - 1
compiler/arm/aoptcpu.pas

@@ -1545,7 +1545,7 @@ Implementation
                       asml.InsertAfter(dealloc,hpfar1);
                     end;
 
-                  if not Assigned(hp1) then
+                  if (not Assigned(hp1)) or (p=hp1) then
                     GetNextInstruction(p, hp1);
 
                   RemoveCurrentP(p, hp1);

+ 12 - 3
compiler/cgobj.pas

@@ -2001,7 +2001,9 @@ implementation
         if assigned(ref.symbol)
           { for avrtiny, the code generator generates a ref which is Z relative and while using it,
             Z is changed, so the following code breaks }
-          {$ifdef avr}and not(CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]){$endif avr} then
+          {$ifdef avr}
+            and not((CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]) or (tcgsize2size[size]=1))
+          {$endif avr} then
           begin
             tmpreg:=getaddressregister(list);
             a_loadaddr_ref_reg(list,ref,tmpreg);
@@ -2037,7 +2039,9 @@ implementation
         if assigned(ref.symbol)
           { for avrtiny, the code generator generates a ref which is Z relative and while using it,
             Z is changed, so the following code breaks }
-          {$ifdef avr}and not(CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]){$endif avr} then
+          {$ifdef avr}
+            and not((CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]) or (tcgsize2size[size]=1))
+          {$endif avr} then
           begin
             tmpreg:=getaddressregister(list);
             a_loadaddr_ref_reg(list,ref,tmpreg);
@@ -2273,7 +2277,12 @@ implementation
       begin
         if not (Op in [OP_NOT,OP_NEG]) then
           internalerror(2020050710);
-        if assigned(ref.symbol) then
+        if assigned(ref.symbol)
+          { for avrtiny, the code generator generates a ref which is Z relative and while using it,
+            Z is changed, so the following code breaks }
+          {$ifdef avr}
+            and not((CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]) or (tcgsize2size[size]=1))
+          {$endif avr} then
           begin
             tmpreg:=getaddressregister(list);
             a_loadaddr_ref_reg(list,ref,tmpreg);

+ 19 - 0
compiler/compinnr.pas

@@ -154,6 +154,25 @@ type
      in_fma_extended     = 135,
      in_fma_float128     = 136,
 
+     { the min/max intrinsics must follow the x86 sse
+       behaviour of min/max regarding handling
+       NaN: in case of a NaN the result is always the second
+       operand. This allows a simple translation of
+       if a>b then result:=a else result:=b;
+       statements into these intrinsics
+
+       The min/max intrinsics are not supposed to
+       be exposed to the user but only
+       used internally by the compiler/optimizer }
+     in_max_single       = 137,
+     in_max_double       = 138,
+     in_min_single       = 139,
+     in_min_double       = 140,
+     in_min_dword        = 141,
+     in_min_longint      = 142,
+     in_max_dword        = 143,
+     in_max_longint      = 144,
+
 { MMX functions }
 { these contants are used by the mmx unit }
 

+ 22 - 0
compiler/defutil.pas

@@ -268,6 +268,12 @@ interface
     {# Returns true, if def is a 64 bit type }
     function is_64bit(def : tdef) : boolean;
 
+    { returns true, if def is a longint type }
+    function is_s32bitint(def : tdef) : boolean;
+
+    { returns true, if def is a dword type }
+    function is_u32bitint(def : tdef) : boolean;
+
     { true, if def1 and def2 are both integers of the same bit size and sign }
     function are_equal_ints(def1, def2: tdef): boolean;
 
@@ -1017,6 +1023,22 @@ implementation
       end;
 
 
+    { returns true, if def is a longint type }
+    function is_s32bitint(def : tdef) : boolean;
+      begin
+        result:=(def.typ=orddef) and
+          (torddef(def).ordtype=s32bit);
+      end;
+
+
+    { returns true, if def is a dword type }
+    function is_u32bitint(def : tdef) : boolean;
+      begin
+        result:=(def.typ=orddef) and
+          (torddef(def).ordtype=u32bit);
+      end;
+
+
     { true, if def1 and def2 are both integers of the same bit size and sign }
     function are_equal_ints(def1, def2: tdef): boolean;
       begin

+ 18 - 18
compiler/i386/i386prop.inc

@@ -431,10 +431,10 @@
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_ROp1, Ch_WOp2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -549,10 +549,10 @@
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_ROp1, Ch_WOp2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -805,6 +805,8 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -814,16 +816,14 @@
 (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_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),

+ 18 - 18
compiler/i8086/i8086prop.inc

@@ -431,10 +431,10 @@
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_ROp1, Ch_WOp2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -549,10 +549,10 @@
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_ROp1, Ch_WOp2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -805,6 +805,8 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -814,16 +816,14 @@
 (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_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),

+ 173 - 36
compiler/link.pas

@@ -993,7 +993,7 @@ Implementation
     function TExternalLinker.PostProcessELFExecutable(const fn : string;isdll:boolean):boolean;
       type
         TElf32header=packed record
-          magic0123         : longint;
+          magic0123         : array[0..3] of char;
           file_class        : byte;
           data_encoding     : byte;
           file_version      : byte;
@@ -1029,6 +1029,41 @@ Implementation
           sh_entsize        : longint;
         end;
 
+        telf64header=packed record
+          magic0123         : array[0..3] of char;
+          file_class        : byte;
+          data_encoding     : byte;
+          file_version      : byte;
+          padding           : array[$07..$0f] of byte;
+
+          e_type            : word;
+          e_machine         : word;
+          e_version         : longword;
+          e_entry           : qword;            { entrypoint }
+          e_phoff           : qword;            { program header offset }
+          e_shoff           : qword;            { sections header offset }
+          e_flags           : longword;
+          e_ehsize          : word;             { elf header size in bytes }
+          e_phentsize       : word;             { size of an entry in the program header array }
+          e_phnum           : word;             { 0..e_phnum-1 of entrys }
+          e_shentsize       : word;             { size of an entry in sections header array }
+          e_shnum           : word;             { 0..e_shnum-1 of entrys }
+          e_shstrndx        : word;             { index of string section header }
+        end;
+        TElf64sechdr=packed record
+          sh_name           : longword;
+          sh_type           : longword;
+          sh_flags          : qword;
+          sh_addr           : qword;
+          sh_offset         : qword;
+          sh_size           : qword;
+          sh_link           : longword;
+          sh_info           : longword;
+          sh_addralign      : qword;
+          sh_entsize        : qword;
+        end;
+
+
       function MayBeSwapHeader(h : telf32header) : telf32header;
         begin
           result:=h;
@@ -1051,6 +1086,30 @@ Implementation
               end;
         end;
 
+
+      function MayBeSwapHeader(h : telf64header) : telf64header;
+        begin
+          result:=h;
+          if source_info.endian<>target_info.endian then
+            with h do
+              begin
+                result.e_type:=swapendian(e_type);
+                result.e_machine:=swapendian(e_machine);
+                result.e_version:=swapendian(e_version);
+                result.e_entry:=swapendian(e_entry);
+                result.e_phoff:=swapendian(e_phoff);
+                result.e_shoff:=swapendian(e_shoff);
+                result.e_flags:=swapendian(e_flags);
+                result.e_ehsize:=swapendian(e_ehsize);
+                result.e_phentsize:=swapendian(e_phentsize);
+                result.e_phnum:=swapendian(e_phnum);
+                result.e_shentsize:=swapendian(e_shentsize);
+                result.e_shnum:=swapendian(e_shnum);
+                result.e_shstrndx:=swapendian(e_shstrndx);
+              end;
+        end;
+
+
       function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
         begin
           result:=h;
@@ -1070,6 +1129,26 @@ Implementation
               end;
         end;
 
+
+      function MaybeSwapSecHeader(h : telf64sechdr) : telf64sechdr;
+        begin
+          result:=h;
+          if source_info.endian<>target_info.endian then
+            with h do
+              begin
+                result.sh_name:=swapendian(sh_name);
+                result.sh_type:=swapendian(sh_type);
+                result.sh_flags:=swapendian(sh_flags);
+                result.sh_addr:=swapendian(sh_addr);
+                result.sh_offset:=swapendian(sh_offset);
+                result.sh_size:=swapendian(sh_size);
+                result.sh_link:=swapendian(sh_link);
+                result.sh_info:=swapendian(sh_info);
+                result.sh_addralign:=swapendian(sh_addralign);
+                result.sh_entsize:=swapendian(sh_entsize);
+              end;
+        end;
+
       var
         f : file;
 
@@ -1092,8 +1171,10 @@ Implementation
         end;
 
       var
-        elfheader : TElf32header;
-        secheader : TElf32sechdr;
+        elfheader32 : TElf32header;
+        secheader32 : TElf32sechdr;
+        elfheader64 : TElf64header;
+        secheader64 : TElf64sechdr;
         i : longint;
         stringoffset : longint;
         secname : string;
@@ -1106,39 +1187,95 @@ Implementation
         if ioresult<>0 then
           Message1(execinfo_f_cant_open_executable,fn);
         { read header }
-        blockread(f,elfheader,sizeof(tElf32header));
-        elfheader:=MayBeSwapHeader(elfheader);
-        seek(f,elfheader.e_shoff);
-        { read string section header }
-        seek(f,elfheader.e_shoff+sizeof(TElf32sechdr)*elfheader.e_shstrndx);
-        blockread(f,secheader,sizeof(secheader));
-        secheader:=MaybeSwapSecHeader(secheader);
-        stringoffset:=secheader.sh_offset;
-
-        seek(f,elfheader.e_shoff);
-        status.datasize:=0;
-        for i:=0 to elfheader.e_shnum-1 do
-          begin
-            blockread(f,secheader,sizeof(secheader));
-            secheader:=MaybeSwapSecHeader(secheader);
-            secname:=ReadSectionName(stringoffset+secheader.sh_name);
-            if secname='.text' then
-              begin
-                Message1(execinfo_x_codesize,tostr(secheader.sh_size));
-                status.codesize:=secheader.sh_size;
-              end
-            else if secname='.data' then
-              begin
-                Message1(execinfo_x_initdatasize,tostr(secheader.sh_size));
-                inc(status.datasize,secheader.sh_size);
-              end
-            else if secname='.bss' then
-              begin
-                Message1(execinfo_x_uninitdatasize,tostr(secheader.sh_size));
-                inc(status.datasize,secheader.sh_size);
-              end;
-
-          end;
+        blockread(f,elfheader32,sizeof(tElf32header));
+        with elfheader32 do
+          if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
+            Exit;
+        case elfheader32.file_class of
+          1:
+            begin
+              elfheader32:=MayBeSwapHeader(elfheader32);
+              seek(f,elfheader32.e_shoff);
+              { read string section header }
+              seek(f,elfheader32.e_shoff+sizeof(TElf32sechdr)*elfheader32.e_shstrndx);
+              blockread(f,secheader32,sizeof(secheader32));
+              secheader32:=MaybeSwapSecHeader(secheader32);
+              stringoffset:=secheader32.sh_offset;
+
+              seek(f,elfheader32.e_shoff);
+              status.datasize:=0;
+              for i:=0 to elfheader32.e_shnum-1 do
+                begin
+                  blockread(f,secheader32,sizeof(secheader32));
+                  secheader32:=MaybeSwapSecHeader(secheader32);
+                  secname:=ReadSectionName(stringoffset+secheader32.sh_name);
+                  case secname of
+                    '.text':
+                      begin
+                        Message1(execinfo_x_codesize,tostr(secheader32.sh_size));
+                        status.codesize:=secheader32.sh_size;
+                      end;
+                    '.fpcdata',
+                    '.rodata',
+                    '.data':
+                      begin
+                        Message1(execinfo_x_initdatasize,tostr(secheader32.sh_size));
+                        inc(status.datasize,secheader32.sh_size);
+                      end;
+                    '.bss':
+                      begin
+                        Message1(execinfo_x_uninitdatasize,tostr(secheader32.sh_size));
+                        inc(status.datasize,secheader32.sh_size);
+                      end;
+                  end;
+                end;
+            end;
+          2:
+            begin
+              seek(f,0);
+              blockread(f,elfheader64,sizeof(tElf64header));
+              with elfheader64 do
+                if not((magic0123[0]=#$7f) and (magic0123[1]='E') and (magic0123[2]='L') and (magic0123[3]='F')) then
+                  Exit;
+              elfheader64:=MayBeSwapHeader(elfheader64);
+              seek(f,elfheader64.e_shoff);
+              { read string section header }
+              seek(f,elfheader64.e_shoff+sizeof(TElf64sechdr)*elfheader64.e_shstrndx);
+              blockread(f,secheader64,sizeof(secheader64));
+              secheader64:=MaybeSwapSecHeader(secheader64);
+              stringoffset:=secheader64.sh_offset;
+
+              seek(f,elfheader64.e_shoff);
+              status.datasize:=0;
+              for i:=0 to elfheader64.e_shnum-1 do
+                begin
+                  blockread(f,secheader64,sizeof(secheader64));
+                  secheader64:=MaybeSwapSecHeader(secheader64);
+                  secname:=ReadSectionName(stringoffset+secheader64.sh_name);
+                  case secname of
+                    '.text':
+                      begin
+                        Message1(execinfo_x_codesize,tostr(secheader64.sh_size));
+                        status.codesize:=secheader64.sh_size;
+                      end;
+                    '.fpcdata',
+                    '.rodata',
+                    '.data':
+                      begin
+                        Message1(execinfo_x_initdatasize,tostr(secheader64.sh_size));
+                        inc(status.datasize,secheader64.sh_size);
+                      end;
+                    '.bss':
+                      begin
+                        Message1(execinfo_x_uninitdatasize,tostr(secheader64.sh_size));
+                        inc(status.datasize,secheader64.sh_size);
+                      end;
+                  end;
+                end;
+            end;
+          else
+            exit;
+        end;
         close(f);
         {$pop}
         if ioresult<>0 then

+ 3 - 0
compiler/nadd.pas

@@ -1549,6 +1549,9 @@ implementation
                (current_settings.fputype<>fpu_soft) and
                not(cs_fp_emulation in current_settings.moduleswitches) and
 {$endif cpufpemu}
+{$ifdef xtensa}
+               (FPUXTENSA_DOUBLE in fpu_capabilities[current_settings.fputype]) and
+{$endif xtensa}
                (nodetype=muln) and
                is_real(left.resultdef) and is_real(right.resultdef) and
                left.isequal(right) and

+ 37 - 3
compiler/ncal.pas

@@ -3575,6 +3575,18 @@ implementation
 
 
     function tcallnode.pass_typecheck:tnode;
+
+      function is_undefined_recursive(def:tdef):boolean;
+        begin
+          { might become more refined in the future }
+          if def.typ=undefineddef then
+            result:=true
+          else if def.typ=arraydef then
+            result:=is_undefined_recursive(tarraydef(def).elementdef)
+          else
+            result:=false;
+        end;
+
       var
         candidates : tcallcandidates;
         oldcallnode : tcallnode;
@@ -3584,6 +3596,7 @@ implementation
         paraidx,
         cand_cnt : integer;
         i : longint;
+        ignoregenericparacall,
         ignorevisibility,
         is_const : boolean;
         statements : tstatementnode;
@@ -3771,12 +3784,33 @@ implementation
                       { Multiple candidates left? }
                       if cand_cnt>1 then
                        begin
-                         CGMessage(type_e_cant_choose_overload_function);
+                         { if we're inside a generic and call another function
+                           with generic types as arguments we don't complain in
+                           the generic, but only during the specialization }
+                         ignoregenericparacall:=false;
+                         if df_generic in current_procinfo.procdef.defoptions then
+                           begin
+                             pt:=tcallparanode(left);
+                             while assigned(pt) do
+                              begin
+                                if is_undefined_recursive(pt.resultdef) then
+                                  begin
+                                    ignoregenericparacall:=true;
+                                    break;
+                                  end;
+                                pt:=tcallparanode(pt.right);
+                              end;
+                           end;
+
+                         if not ignoregenericparacall then
+                           begin
+                             CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
-                         candidates.dump_info(V_Hint);
+                             candidates.dump_info(V_Hint);
 {$else EXTDEBUG}
-                         candidates.list(false);
+                             candidates.list(false);
 {$endif EXTDEBUG}
+                           end;
                          { we'll just use the first candidate to make the
                            call }
                        end;

+ 2 - 1
compiler/ncgbas.pas

@@ -443,6 +443,7 @@ interface
             oldflowcontrol:=flowcontrol;
             { the nested block will not span an exit statement of the parent }
             exclude(flowcontrol,fc_exit);
+            include(flowcontrol,fc_block_with_exit);
           end;
 
         { do second pass on left node }
@@ -468,7 +469,7 @@ interface
             current_procinfo.CurrExitLabel:=oldexitlabel;
             { the exit statements inside this block are not exit statements }
             { out of the parent                                             }
-            flowcontrol:=oldflowcontrol+(flowcontrol - [fc_exit]);
+            flowcontrol:=oldflowcontrol+(flowcontrol - [fc_exit,fc_block_with_exit]);
           end;
       end;
 

+ 2 - 0
compiler/ncgflw.pas

@@ -409,6 +409,8 @@ implementation
       begin
          location_reset(location,LOC_VOID,OS_NO);
 
+         if fc_block_with_exit in flowcontrol then
+           include(flowcontrol,fc_gotolabel);
          include(flowcontrol,fc_exit);
          if assigned(left) then
            secondpass(left);

+ 16 - 0
compiler/ncginl.pas

@@ -67,6 +67,7 @@ interface
           procedure second_fma; virtual;
           procedure second_frac_real; virtual;
           procedure second_high; virtual;
+          procedure second_minmax; virtual;
        protected
           function  second_incdec_tempregdef: tdef;virtual;
        end;
@@ -216,6 +217,15 @@ implementation
             in_fma_extended,
             in_fma_float128:
                second_fma;
+            in_max_longint,
+            in_max_dword,
+            in_min_longint,
+            in_min_dword,
+            in_min_single,
+            in_min_double,
+            in_max_single,
+            in_max_double:
+               second_minmax;
             in_and_assign_x_y,
             in_or_assign_x_y,
             in_xor_assign_x_y,
@@ -975,6 +985,12 @@ implementation
         internalerror(2014032701);
       end;
 
+
+    procedure tcginlinenode.second_minmax;
+      begin
+        internalerror(2020120501);
+      end;
+
 begin
    cinlinenode:=tcginlinenode;
 end.

+ 64 - 0
compiler/nflw.pas

@@ -302,6 +302,9 @@ implementation
     {$ifdef i8086}
       cpuinfo,
     {$endif i8086}
+    {$if defined(xtensa) or defined(i386)}
+      cpuinfo,
+    {$endif defined(xtensa) or defined(i386)}
       cgbase,procinfo
       ;
 
@@ -1554,8 +1557,13 @@ implementation
 
 
     function tifnode.internalsimplify(warn: boolean) : tnode;
+      var
+        thenstmnt, elsestmnt: tnode;
+        in_nr: tinlinenumber;
+        paratype: tdef;
       begin
         result:=nil;
+        in_nr:=Default(tinlinenumber);
         { optimize constant expressions }
         if (left.nodetype=ordconstn) then
           begin
@@ -1580,6 +1588,62 @@ implementation
                     CGMessagePos(right.fileinfo,cg_w_unreachable_code);
                end;
           end;
+{$ifndef llvm}
+{$if defined(i386) or defined(x86_64) or defined(xtensa)}
+        { use min/max intrinsic? }
+        if (cs_opt_level2 in current_settings.optimizerswitches) and
+           (left.nodetype in [gtn,gten,ltn,lten]) and IsSingleStatement(right,thenstmnt) and IsSingleStatement(t1,elsestmnt) and
+          (thenstmnt.nodetype=assignn) and (elsestmnt.nodetype=assignn) and
+          not(might_have_sideeffects(left)) and
+          tassignmentnode(thenstmnt).left.isequal(tassignmentnode(elsestmnt).left) and
+{$if defined(i386) or defined(x86_64)}
+          { for now, limit it to fastmath mode as NaN handling is not implemented properly yet }
+          (cs_opt_fastmath in current_settings.optimizerswitches) and
+{$ifdef i386}
+          (((current_settings.fputype>=fpu_sse) and is_single(tassignmentnode(thenstmnt).left.resultdef)) or
+           ((current_settings.fputype>=fpu_sse2) and is_double(tassignmentnode(thenstmnt).left.resultdef))
+          ) and
+{$else i386}
+          (is_single(tassignmentnode(thenstmnt).left.resultdef) or is_double(tassignmentnode(thenstmnt).left.resultdef)) and
+{$endif i386}
+{$endif defined(i386) or defined(x86_64)}
+{$if defined(xtensa)}
+          (CPUXTENSA_HAS_MINMAX in cpu_capabilities[current_settings.cputype]) and is_32bitint(tassignmentnode(thenstmnt).right.resultdef) and
+{$endif defined(xtensa)}
+          ((tassignmentnode(thenstmnt).right.isequal(taddnode(left).left) and (tassignmentnode(elsestmnt).right.isequal(taddnode(left).right))) or
+           (tassignmentnode(thenstmnt).right.isequal(taddnode(left).right) and (tassignmentnode(elsestmnt).right.isequal(taddnode(left).left)))) then
+          begin
+            paratype:=tassignmentnode(thenstmnt).left.resultdef;
+            if (left.nodetype in [gtn,gten]) and
+              (tassignmentnode(thenstmnt).right.isequal(taddnode(left).left) and (tassignmentnode(elsestmnt).right.isequal(taddnode(left).right))) then
+              begin
+                if is_double(paratype) then
+                  in_nr:=in_max_double
+                else if is_single(paratype) then
+                  in_nr:=in_max_single
+                else if is_u32bitint(paratype) then
+                  in_nr:=in_max_dword
+                else if is_s32bitint(paratype) then
+                  in_nr:=in_max_longint;
+              end
+            else
+              begin
+                if is_double(paratype) then
+                  in_nr:=in_min_double
+                else if is_single(paratype) then
+                  in_nr:=in_min_single
+                else if is_u32bitint(paratype) then
+                  in_nr:=in_min_dword
+                else if is_s32bitint(paratype) then
+                  in_nr:=in_min_longint;
+              end;
+            Result:=cassignmentnode.create_internal(tassignmentnode(thenstmnt).left.getcopy,
+              cinlinenode.create(in_nr,false,ccallparanode.create(taddnode(left).right.getcopy,
+                    ccallparanode.create(taddnode(left).left.getcopy,nil)))
+              );
+          end;
+{$endif defined(i386) or defined(x86_64) or defined(xtensa)}
+{$endif llvm}
       end;
 
 

+ 30 - 0
compiler/ninl.pas

@@ -98,6 +98,7 @@ interface
           function first_seg: tnode; virtual;
           function first_sar: tnode; virtual;
           function first_fma : tnode; virtual;
+          function first_minmax: tnode; virtual;
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           function first_ShiftRot_assign_64bitint: tnode; virtual;
 {$endif not cpu64bitalu and not cpuhighleveltarget}
@@ -3758,6 +3759,19 @@ implementation
                   set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]);
                   resultdef:=tcallparanode(left).left.resultdef;
                 end;
+              in_max_longint,
+              in_max_dword,
+              in_min_longint,
+              in_min_dword,
+              in_max_single,
+              in_max_double,
+              in_min_single,
+              in_min_double:
+                begin
+                  set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
+                  set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
+                  resultdef:=tcallparanode(left).left.resultdef;
+                end;
               in_delete_x_y_z:
                 begin
                   result:=handle_delete;
@@ -4190,6 +4204,15 @@ implementation
          in_fma_extended,
          in_fma_float128:
            result:=first_fma;
+         in_max_longint,
+         in_max_dword,
+         in_min_longint,
+         in_min_dword,
+         in_min_single,
+         in_min_double,
+         in_max_single,
+         in_max_double:
+           result:=first_minmax;
          else
            result:=first_cpu;
           end;
@@ -5480,6 +5503,13 @@ implementation
          result:=nil;
        end;
 
+
+     function tinlinenode.first_minmax: tnode;
+       begin
+         CGMessage1(cg_e_function_not_support_by_selected_instruction_set,'MIN/MAX');
+         result:=nil;
+       end;
+
 //
 //||||||| .merge-left.r31134
 //

+ 29 - 0
compiler/nutils.pas

@@ -180,6 +180,9 @@ interface
       in a and the function returns true }
     function GetStatements(p : tnode;var a : array of tstatementnode) : Boolean;
 
+    { checks if p is a single statement, if yes, it is returned in s }
+    function IsSingleStatement(p : tnode;var s : tnode) : Boolean;
+
     type
       TMatchProc2 = function(n1,n2 : tnode) : Boolean is nested;
       TTransformProc2 = function(n1,n2 : tnode) : tnode is nested;
@@ -1643,6 +1646,32 @@ implementation
       end;
 
 
+    function IsSingleStatement(p: tnode; var s: tnode): Boolean;
+      begin
+        Result:=false;
+        if assigned(p) then
+          case p.nodetype of
+            blockn:
+              Result:=IsSingleStatement(tblocknode(p).statements,s);
+            statementn:
+              if not(assigned(tstatementnode(p).next)) then
+                begin
+                  Result:=true;
+                  s:=tstatementnode(p).statement;
+                end;
+            inlinen,
+            assignn,
+            calln:
+              begin
+                s:=p;
+                Result:=true;
+              end
+            else
+              ;
+          end;
+      end;
+
+
     function MatchAndTransformNodesCommutative(n1,n2 : tnode;matchproc : TMatchProc2;transformproc : TTransformProc2;var res : tnode) : Boolean;
       begin
         res:=nil;

+ 4 - 1
compiler/optcse.pas

@@ -70,7 +70,10 @@ unit optcse;
              in_abs_real,in_exp_real,in_ln_real,in_pi_real,in_popcnt_x,in_arctan_real,in_round_real,in_trunc_real,
              { cse on fma will still not work because it would require proper handling of call nodes
                with more than one parameter }
-             in_fma_single,in_fma_double,in_fma_extended,in_fma_float128])
+             in_fma_single,in_fma_double,in_fma_extended,in_fma_float128,
+             in_min_single,in_min_double,in_max_single,in_max_double,
+             in_max_longint,in_max_dword,in_min_longint,in_min_dword
+             ])
           ) or
           ((n.nodetype=callparan) and not(assigned(tcallparanode(n).right))) or
           ((n.nodetype=loadn) and

+ 3 - 1
compiler/pass_2.pas

@@ -43,7 +43,9 @@ uses
          fc_unwind_loop,
          { the left side of an expression is already handled, so we are
            not allowed to do ssl }
-         fc_lefthandled);
+         fc_lefthandled,
+         { in block which contains the exit statement }
+         fc_block_with_exit);
 
        tflowcontrol = set of tenumflowcontrol;
 

+ 80 - 0
compiler/ppcppc64le.lpi

@@ -0,0 +1,80 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="ppcppc64"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="powerpc64\cgcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="powerpc64\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="powerpc64"/>
+      <OtherUnitFiles Value="powerpc64;ppcgen;systems"/>
+      <UnitOutputDirectory Value="powerpc64\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CustomOptions Value="-dpowerpc64
+-dppc64le"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

+ 153 - 102
compiler/psub.pas

@@ -86,7 +86,7 @@ interface
         function has_assembler_child : boolean;
         procedure set_eh_info; override;
 {$ifdef DEBUG_NODE_XML}
-        procedure XMLPrintProc;
+        procedure XMLPrintProc(FirstHalf: Boolean);
 {$endif DEBUG_NODE_XML}
       end;
 
@@ -1128,13 +1128,11 @@ implementation
 
                 if not(procdef.stack_tainting_parameter(calleeside)) and
                    not(has_assembler_child)
-{$ifdef m68k}
                   { parasize must be really zero, this means also that no result may be returned
                     in a parameter }
                   and not((current_procinfo.procdef.proccalloption in clearstack_pocalls) and
                     not(current_procinfo.procdef.generate_safecall_wrapper) and
                     paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef))
-{$endif m68k}
                    {and (para_stack_size=0)} then
                   begin
                     { Only need to set the framepointer }
@@ -1439,15 +1437,19 @@ implementation
 
 
 {$ifdef DEBUG_NODE_XML}
-    procedure tcgprocinfo.XMLPrintProc;
+    procedure tcgprocinfo.XMLPrintProc(FirstHalf: Boolean);
       var
         T: Text;
         W: Word;
         syssym: tsyssym;
+        separate : boolean;
 
       procedure PrintType(Flag: string);
         begin
-          Write(T, ' type="', Flag, '"');
+          if df_generic in procdef.defoptions then
+            Write(T, ' type="generic ', Flag, '"')
+          else
+            Write(T, ' type="', Flag, '"');
         end;
 
       procedure PrintOption(Flag: string);
@@ -1469,109 +1471,132 @@ implementation
             Exit;
           end;
         {$pop}
-        Write(T, PrintNodeIndention, '<subroutine');
-
-        { Check to see if the procedure is a class or object method }
-        if Assigned(procdef.struct) then
-          begin
-            if Assigned(procdef.struct.objrealname) then
-              Write(T, ' struct="', SanitiseXMLString(procdef.struct.objrealname^), '"')
-            else
-              Write(T, ' struct="&lt;NULL&gt;"');
-          end;
 
-        case procdef.proctypeoption of
-          potype_none: { Do nothing };
+        separate := (df_generic in procdef.defoptions);
 
-          potype_procedure,
-          potype_function:
-            if po_classmethod in procdef.procoptions then
+        { First half prints the header and the nodes as a "code" tag }
+        if FirstHalf or separate then
+          begin
+            Write(T, PrintNodeIndention, '<subroutine');
+            { Check to see if the procedure is a class or object method }
+            if Assigned(procdef.struct) then
               begin
-                if po_staticmethod in procdef.procoptions then
-                  PrintType('static class method')
+                if Assigned(procdef.struct.objrealname) then
+                  Write(T, ' struct="', SanitiseXMLString(procdef.struct.objrealname^), '"')
                 else
-                  PrintType('class method');
+                  Write(T, ' struct="&lt;NULL&gt;"');
               end;
-            { Do nothing otherwise }
-
-          potype_proginit,
-          potype_unitinit:
-            PrintType('initialization');
-          potype_unitfinalize:
-            PrintType('finalization');
-          potype_constructor:
-            PrintType('constructor');
-          potype_destructor:
-            PrintType('destructor');
-          potype_operator:
-            PrintType('operator');
-          potype_class_constructor:
-            PrintType('class constructor');
-          potype_class_destructor:
-            PrintType('class destructor');
-          potype_propgetter:
-            PrintType('dispinterface getter');
-          potype_propsetter:
-            PrintType('dispinterface setter');
-          potype_exceptfilter:
-            PrintType('except filter');
-          potype_mainstub:
-            PrintType('main stub');
-          potype_libmainstub:
-            PrintType('library main stub');
-          potype_pkgstub:
-            PrintType('package stub');
-        end;
+            case procdef.proctypeoption of
+              potype_none:
+                { Do nothing - should this be an internal error though? };
+              potype_procedure,
+              potype_function:
+                if po_classmethod in procdef.procoptions then
+                  begin
+                    if po_staticmethod in procdef.procoptions then
+                      PrintType('static class method')
+                    else
+                      PrintType('class method');
+                  end
+                else if df_generic in procdef.defoptions then
+                  Write(T, ' type="generic"');
+              potype_proginit,
+              potype_unitinit:
+                PrintType('initialization');
+              potype_unitfinalize:
+                PrintType('finalization');
+              potype_constructor:
+                PrintType('constructor');
+              potype_destructor:
+                PrintType('destructor');
+              potype_operator:
+                PrintType('operator');
+              potype_class_constructor:
+                PrintType('class constructor');
+              potype_class_destructor:
+                PrintType('class destructor');
+              potype_propgetter:
+                PrintType('dispinterface getter');
+              potype_propsetter:
+                PrintType('dispinterface setter');
+              potype_exceptfilter:
+                PrintType('except filter');
+              potype_mainstub:
+                PrintType('main stub');
+              potype_libmainstub:
+                PrintType('library main stub');
+              potype_pkgstub:
+                PrintType('package stub');
+            end;
+
+            Write(T, ' name="', SanitiseXMLString(procdef.customprocname([pno_showhidden, pno_noclassmarker])), '"');
+            if po_hascallingconvention in procdef.procoptions then
+              Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+            WriteLn(T, '>');
 
-        Write(T, ' name="', SanitiseXMLString(procdef.customprocname([pno_showhidden, pno_noclassmarker])), '"');
-
-        if po_hascallingconvention in procdef.procoptions then
-          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
-
-        WriteLn(T, '>');
-
-        PrintNodeIndent;
-
-        if Assigned(procdef.returndef) and not is_void(procdef.returndef) then
-          WriteLn(T, PrintNodeIndention, '<returndef>', SanitiseXMLString(procdef.returndef.typesymbolprettyname), '</returndef>');
-
-        if po_reintroduce in procdef.procoptions then
-          PrintOption('reintroduce');
-        if po_virtualmethod in procdef.procoptions then
-          PrintOption('virtual');
-        if po_finalmethod in procdef.procoptions then
-          PrintOption('final');
-        if po_overridingmethod in procdef.procoptions then
-          PrintOption('override');
-        if po_overload in procdef.procoptions then
-          PrintOption('overload');
-        if po_compilerproc in procdef.procoptions then
-          PrintOption('compilerproc');
-        if po_assembler in procdef.procoptions then
-          PrintOption('assembler');
-        if po_nostackframe in procdef.procoptions then
-          PrintOption('nostackframe');
-        if po_inline in procdef.procoptions then
-          PrintOption('inline');
-        if po_noreturn in procdef.procoptions then
-          PrintOption('noreturn');
-        if po_noinline in procdef.procoptions then
-          PrintOption('noinline');
-
-        if Assigned(Code) then
-          begin
-            WriteLn(T, PrintNodeIndention, '<code>');
             PrintNodeIndent;
-            XMLPrintNode(T, Code);
+
+            if Assigned(procdef.returndef) and not is_void(procdef.returndef) then
+              WriteLn(T, PrintNodeIndention, '<returndef>', SanitiseXMLString(procdef.returndef.typesymbolprettyname), '</returndef>');
+
+            if po_reintroduce in procdef.procoptions then
+              PrintOption('reintroduce');
+            if po_virtualmethod in procdef.procoptions then
+              PrintOption('virtual');
+            if po_finalmethod in procdef.procoptions then
+              PrintOption('final');
+            if po_overridingmethod in procdef.procoptions then
+              PrintOption('override');
+            if po_overload in procdef.procoptions then
+              PrintOption('overload');
+            if po_compilerproc in procdef.procoptions then
+              PrintOption('compilerproc');
+            if po_assembler in procdef.procoptions then
+              PrintOption('assembler');
+            if po_nostackframe in procdef.procoptions then
+              PrintOption('nostackframe');
+            if po_inline in procdef.procoptions then
+              PrintOption('inline');
+            if po_noreturn in procdef.procoptions then
+              PrintOption('noreturn');
+            if po_noinline in procdef.procoptions then
+              PrintOption('noinline');
+          end;
+
+          if Assigned(Code) then
+            begin
+              if FirstHalf then
+                WriteLn(T, PrintNodeIndention, '<code>')
+              else
+                begin
+                  WriteLn(T); { Line for spacing }
+                  WriteLn(T, PrintNodeIndention, '<firstpass>');
+                end;
+
+              PrintNodeIndent;
+              XMLPrintNode(T, Code);
+              PrintNodeUnindent;
+
+              if FirstHalf then
+                WriteLn(T, PrintNodeIndention, '</code>')
+              else
+                WriteLn(T, PrintNodeIndention, '</firstpass>');
+            end
+          else { Code=Nil }
+            begin
+              { Don't print anything for second half - if there's no code, there's no firstpass }
+              if FirstHalf then
+                WriteLn(T, PrintNodeIndention, '<code />');
+            end;
+
+        { Print footer only for second half }
+        if (not FirstHalf) or separate then
+          begin
             PrintNodeUnindent;
-            WriteLn(T, PrintNodeIndention, '</code>');
-          end
-        else
-          WriteLn(T, PrintNodeIndention, '<code />');
+            WriteLn(T, PrintNodeIndention, '</subroutine>');
+            WriteLn(T); { Line for spacing }
+          end;
 
-        PrintNodeUnindent;
-        WriteLn(T, PrintNodeIndention, '</subroutine>');
-        WriteLn(T); { Line for spacing }
         Close(T);
       end;
 {$endif DEBUG_NODE_XML}
@@ -1791,7 +1816,14 @@ implementation
           don't need to generate anything. When it was an empty
           procedure there would be at least a blocknode }
         if not assigned(code) then
-          exit;
+          begin
+{$ifdef DEBUG_NODE_XML}
+            { Print out nodes as they appear after the first pass }
+            XMLPrintProc(True);
+            XMLPrintProc(False);
+{$endif DEBUG_NODE_XML}
+            exit;
+          end;
 
         { We need valid code }
         if Errorcount<>0 then
@@ -1885,6 +1917,10 @@ implementation
            (procdef.proccalloption=pocall_safecall) then
           include(flags, pi_needs_implicit_finally);
 {$endif}
+{$ifdef DEBUG_NODE_XML}
+        { Print out nodes as they appear after the first pass }
+        XMLPrintProc(True);
+{$endif DEBUG_NODE_XML}
         { firstpass everything }
         flowcontrol:=[];
         do_firstpass(code);
@@ -1914,7 +1950,14 @@ implementation
           do_optloadmodifystore(code);
 
         { only do secondpass if there are no errors }
-        if (ErrorCount=0) then
+        if (ErrorCount<>0) then
+          begin
+{$ifdef DEBUG_NODE_XML}
+            { Print out nodes as they appear after the first pass }
+            XMLPrintProc(False);
+{$endif DEBUG_NODE_XML}
+          end
+        else
           begin
             create_hlcodegen;
 
@@ -1964,6 +2007,11 @@ implementation
             if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
+{$ifdef DEBUG_NODE_XML}
+            { Print out nodes as they appear after the first pass }
+            XMLPrintProc(False);
+{$endif DEBUG_NODE_XML}
+
             { generate code for the node tree }
             do_secondpass(code);
             aktproccode.concatlist(current_asmdata.CurrAsmList);
@@ -2472,7 +2520,10 @@ implementation
            printproc( 'after parsing');
 
 {$ifdef DEBUG_NODE_XML}
-         XMLPrintProc;
+         { Methods of generic classes don't get any code generated, so output
+           the node tree here }
+         if (df_generic in procdef.defoptions) then
+           XMLPrintProc(True);
 {$endif DEBUG_NODE_XML}
 
          { ... remove symbol tables }

+ 2 - 1
compiler/systems/t_linux.pas

@@ -816,7 +816,8 @@ begin
   { Post process,
     as it only writes sections sizes so far, do this only if V_Info is set }
   if success and CheckVerbosity(V_Info) and not(cs_link_nolink in current_settings.globalswitches) then
-    success:=PostProcessExecutable(current_module.exefilename,false);
+    { do not change success here as we are only writing some info, so if this fails, it does not matter }
+    { success:= }PostProcessExecutable(current_module.exefilename,false);
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }
 end;

+ 144 - 0
compiler/x86/nx86inl.pas

@@ -54,6 +54,7 @@ interface
           function first_fma: tnode; override;
           function first_frac_real : tnode; override;
           function first_int_real : tnode; override;
+          function first_minmax: tnode; override;
 
           function simplify(forinline : boolean) : tnode; override;
 
@@ -79,6 +80,7 @@ interface
           procedure second_frac_real;override;
           procedure second_int_real;override;
           procedure second_high;override;
+          procedure second_minmax;override;
        private
           procedure load_fpu_location(lnode: tnode);
        end;
@@ -389,6 +391,27 @@ implementation
        end;
 
 
+     function tx86inlinenode.first_minmax: tnode;
+       begin
+{$ifndef i8086}
+         if
+{$ifdef i386}
+           ((current_settings.fputype>=fpu_sse) and is_single(resultdef)) or
+           ((current_settings.fputype>=fpu_sse2) and is_double(resultdef))
+{$else i386}
+           ((is_double(resultdef)) or (is_single(resultdef)))
+{$endif i386}
+           then
+           begin
+             expectloc:=LOC_MMREGISTER;
+             Result:=nil;
+           end
+         else
+{$endif i8086}
+           Result:=inherited first_minmax;
+       end;
+
+
      function tx86inlinenode.simplify(forinline : boolean) : tnode;
        var
          temp : tnode;
@@ -1401,4 +1424,125 @@ implementation
         location.register:=hregister;
       end;
 
+
+    procedure tx86inlinenode.second_minmax;
+      const
+        oparray : array[false..true,false..true,s32real..s64real] of TAsmOp =
+          (
+           (
+            (A_MINSS,A_MINSD),
+            (A_VMINSS,A_VMINSD)
+           ),
+           (
+            (A_MAXSS,A_MAXSD),
+            (A_VMAXSS,A_VMAXSD)
+           )
+          );
+
+      var
+        paraarray : array[1..2] of tnode;
+        memop,
+        i : integer;
+        gotmem : boolean;
+        op: TAsmOp;
+      begin
+{$ifndef i8086}
+         if
+{$ifdef i386}
+           ((current_settings.fputype>=fpu_sse) and is_single(resultdef)) or
+           ((current_settings.fputype>=fpu_sse2) and is_double(resultdef))
+{$else i386}
+           is_single(resultdef) or is_double(resultdef)
+{$endif i386}
+           then
+           begin
+             paraarray[1]:=tcallparanode(tcallparanode(parameters).nextpara).paravalue;
+             paraarray[2]:=tcallparanode(parameters).paravalue;
+
+             for i:=low(paraarray) to high(paraarray) do
+               secondpass(paraarray[i]);
+
+             { only one memory operand is allowed }
+             gotmem:=false;
+             memop:=0;
+             for i:=low(paraarray) to high(paraarray) do
+               begin
+                 if not(paraarray[i].location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
+                   begin
+                     if (paraarray[i].location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and not(gotmem) then
+                       begin
+                         memop:=i;
+                         gotmem:=true;
+                       end
+                     else
+                       hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,paraarray[i].location,paraarray[i].resultdef,true);
+                   end;
+               end;
+
+             { due to min/max behaviour that it loads always the second operand (must be the else assignment) into destination if
+               one of the operands is a NaN, we cannot swap operands to omit a mova operation in case fastmath is off }
+             if not(cs_opt_fastmath in current_settings.optimizerswitches) and gotmem and (memop=1) then
+               begin
+                 hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,paraarray[1].location,paraarray[1].resultdef,true);
+                 gotmem:=false;
+               end;
+
+             op:=oparray[inlinenumber in [in_max_single,in_max_double],UseAVX,tfloatdef(resultdef).floattype];
+
+             location_reset(location,LOC_MMREGISTER,paraarray[1].location.size);
+             location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
+
+             if gotmem then
+               begin
+                 if UseAVX then
+                   case memop of
+                     1:
+                       emit_ref_reg_reg(op,S_NO,
+                         paraarray[1].location.reference,paraarray[2].location.register,location.register);
+                     2:
+                       emit_ref_reg_reg(op,S_NO,
+                         paraarray[2].location.reference,paraarray[1].location.register,location.register);
+                     else
+                       internalerror(2020120504);
+                   end
+                 else
+                   case memop of
+                     1:
+                       begin
+                         hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,paraarray[2].resultdef,resultdef,
+                           paraarray[2].location.register,location.register,mms_movescalar);
+                         emit_ref_reg(op,S_NO,
+                           paraarray[1].location.reference,location.register);
+                       end;
+                     2:
+                       begin
+                         hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,paraarray[1].resultdef,resultdef,
+                           paraarray[1].location.register,location.register,mms_movescalar);
+                         emit_ref_reg(op,S_NO,
+                           paraarray[2].location.reference,location.register);
+                       end;
+                     else
+                       internalerror(2020120601);
+                   end;
+               end
+             else
+               begin
+                 if UseAVX then
+                   emit_reg_reg_reg(op,S_NO,
+                     paraarray[2].location.register,paraarray[1].location.register,location.register)
+                 else
+                   begin
+                     hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,paraarray[1].resultdef,resultdef,
+                       paraarray[1].location.register,location.register,mms_movescalar);
+                     emit_reg_reg(op,S_NO,
+                       paraarray[2].location.register,location.register)
+                   end;
+               end;
+           end
+         else
+{$endif i8086}
+           internalerror(2020120503);
+      end;
+
+
 end.

+ 18 - 60
compiler/x86/x86ins.dat

@@ -2372,19 +2372,19 @@ xmmreg,xmmrm          \336\333\2\x0F\x5E\110              KATMAI,SSE
 mem                   \2\x0F\xAE\202                  KATMAI,SSE,SD
 
 [MAXPS]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm          \331\2\x0F\x5F\110              KATMAI,SSE
 
 [MAXSS]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm          \336\333\2\x0F\x5F\110              KATMAI,SSE
 
 [MINPS]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm          \331\2\x0F\x5D\110              KATMAI,SSE
 
 [MINSS]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm          \336\333\2\x0F\x5D\110              KATMAI,SSE
 
 [MOVAPS]
@@ -2914,19 +2914,19 @@ xmmreg,xmmrm            \361\2\x0F\x5E\110            WILLAMETTE,SSE2,SM
 xmmreg,xmmrm            \337\334\2\x0F\x5E\110          WILLAMETTE,SSE2
 
 [MAXPD]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm            \361\2\x0F\x5F\110          WILLAMETTE,SSE2,SM
 
 [MAXSD]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm            \337\334\2\x0F\x5F\110          WILLAMETTE,SSE2
 
 [MINPD]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm            \361\2\x0F\x5D\110          WILLAMETTE,SSE2,SM
 
 [MINSD]
-(Ch_All)
+(Ch_Mop2, Ch_Rop1)
 xmmreg,xmmrm            \337\334\2\x0F\x5D\110          WILLAMETTE,SSE2
 
 [MOVAPD]
@@ -4108,8 +4108,6 @@ kreg_m,zmmreg,zmmreg_sae,imm8             \350\351\352\361\370\1\xC2\75\120\27
 xmmreg,xmmreg,xmmrm,imm8                  \361\362\370\1\xC2\75\120\27              AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm,imm8                  \361\362\364\370\1\xC2\75\120\27          AVX,SANDYBRIDGE
 
-
-
 [VCMPPS]
 (Ch_All)
 kreg_m,xmmreg,xmmrm,imm8                  \350\370\1\xC2\75\120\27                  AVX512,TFV
@@ -4122,7 +4120,6 @@ kreg_m,zmmreg,zmmreg_sae,imm8             \350\351\370\1\xC2\75\120\27
 xmmreg,xmmreg,xmmrm,imm8                  \362\370\1\xC2\75\120\27                  AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm,imm8                  \362\364\370\1\xC2\75\120\27              AVX,SANDYBRIDGE
 
-
 [VCMPSD]
 (Ch_All)
 kreg_m,xmmreg,mem64,imm8                  \334\350\352\370\1\xC2\75\120\27          AVX512,T1S
@@ -4130,7 +4127,6 @@ kreg_m,xmmreg,xmmreg_sae,imm8             \334\350\352\370\1\xC2\75\120\27
 xmmreg,xmmreg,xmmreg,imm8                 \334\362\370\1\xC2\75\120\27              AVX,SANDYBRIDGE
 xmmreg,xmmreg,mem64,imm8                  \334\362\370\1\xC2\75\120\27              AVX,SANDYBRIDGE
 
-
 [VCMPSS]
 (Ch_All)
 kreg_m,xmmreg,mem32,imm8                  \333\350\370\1\xC2\75\120\27              AVX512,T1S
@@ -4142,13 +4138,11 @@ xmmreg,xmmreg,xmmrm,imm8                  \336\333\362\370\1\xC2\75\120\27
 xmmreg,mem64                              \350\352\361\362\370\1\x2F\110            AVX,SANDYBRIDGE,T1S
 xmmreg,xmmreg_sae                         \350\352\361\362\370\1\x2F\110            AVX,SANDYBRIDGE
 
-
 [VCOMISS]
 (Ch_Rop1, Ch_Rop2, Ch_WFlags)
 xmmreg,mem32                              \350\362\370\1\x2F\110                    AVX,SANDYBRIDGE,T1S
 xmmreg,xmmreg_sae                         \350\362\370\1\x2F\110                    AVX,SANDYBRIDGE
 
-
 [VCVTDQ2PD]
 (Ch_Wop2, Ch_Rop1)
 xmmreg_mz,mem64                           \333\350\362\370\1\xE6\110                AVX,SANDYBRIDGE,THV
@@ -4161,8 +4155,6 @@ zmmreg_mz,mem256                          \333\350\351\370\1\xE6\110
 zmmreg_mz,ymmreg                          \333\350\351\370\1\xE6\110                AVX512
 zmmreg_mz,bmem32                          \333\350\351\370\1\xE6\110                AVX512,BCST8,THV
 
-
-
 [VCVTDQ2PS]
 (Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \350\362\370\1\x5B\110                    AVX,SANDYBRIDGE,TFV
@@ -4173,7 +4165,6 @@ zmmreg_mz,mem512                          \350\351\370\1\x5B\110
 zmmreg_mz,bmem32                          \350\351\370\1\x5B\110                    AVX512,TFV
 zmmreg_mz,zmmreg_er                       \350\351\370\1\x5B\110                    AVX512
 
-
 ; VCVTPD2DQ xmmreg_mz,mem256 must come first - map MemRefSize 256bits correct
 ;                                              map all other MemrefSize (without broasdcast MemRef) to xmmreg, xmmrm
 [VCVTPD2DQ,vcvtpd2dqN]
@@ -4188,7 +4179,6 @@ ymmreg_mz,mem512                          \334\350\351\352\370\1\xE6\110
 ymmreg_mz,bmem64                          \334\350\351\352\370\1\xE6\110            AVX512,BCST8,TFV
 ymmreg_mz,zmmreg_er                       \334\350\351\352\370\1\xE6\110            AVX512
 
-
 ; VCVTPD2PS xmmreg_mz,mem256 must come first - map MemRefSize 256bits correct
 ;                                              map all other MemrefSize (without broasdcast MemRef) to xmmreg, xmmrm
 [VCVTPD2PS,vcvtpd2psN]
@@ -4211,7 +4201,6 @@ ymmreg_mz,xmmreg                          \350\361\362\364\371\1\x13\110
 zmmreg_mz,mem256                          \350\351\361\371\1\x13\110                AVX512,THVM
 zmmreg_mz,ymmreg_sae                      \350\351\361\371\1\x13\110                AVX512
 
-
 [VCVTPS2DQ]
 (Ch_Wop2, Ch_Rop1)
 xmmreg_mz,xmmrm                           \350\361\362\370\1\x5B\110                AVX,SANDYBRIDGE,TFV
@@ -4222,7 +4211,6 @@ zmmreg_mz,mem512                          \350\351\361\370\1\x5B\110
 zmmreg_mz,bmem32                          \350\351\361\370\1\x5B\110                AVX512,TFV
 zmmreg_mz,zmmreg_er                       \350\351\361\370\1\x5B\110                AVX512
 
-
 [VCVTPS2PD]
 (Ch_Wop2, Ch_Rop1)
 xmmreg_mz,mem64                           \350\362\370\1\x5A\110                    AVX,SANDYBRIDGE,THV
@@ -4234,7 +4222,6 @@ zmmreg_mz,mem256                          \350\351\370\1\x5A\110
 zmmreg_mz,ymmreg_sae                      \350\351\370\1\x5A\110                    AVX512
 zmmreg_mz,bmem32                          \350\351\370\1\x5A\110                    AVX512,BCST8,THV
 
-
 [VCVTPS2PH]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 mem128_m,ymmreg,imm8                      \350\361\362\364\372\1\x1D\101\26         AVX,THVM
@@ -4244,7 +4231,6 @@ xmmreg_mz,xmmreg,imm8                     \350\361\362\372\1\x1D\101\26
 xmmreg_mz,ymmreg,imm8                     \350\361\362\364\372\1\x1D\101\26         AVX
 ymmreg_mz,zmmreg_sae,imm8                 \350\351\361\372\1\x1D\101\26             AVX512
 
-
 [VCVTSD2SI]
 (Ch_Wop2, Ch_Rop1)
 reg32,mem64                               \334\350\362\370\1\x2D\110                AVX,SANDYBRIDGE,T1F64
@@ -4252,13 +4238,11 @@ reg32,xmmreg_er                           \334\350\362\370\1\x2D\110
 reg64,mem64                               \334\350\352\362\363\370\1\x2D\110        AVX,SANDYBRIDGE,T1F64
 reg64,xmmreg_er                           \334\350\352\362\363\370\1\x2D\110        AVX,SANDYBRIDGE
 
-
 [VCVTSD2SS]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem64                    \334\350\352\362\370\1\x5A\75\120         AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_er                \334\350\352\362\370\1\x5A\75\120         AVX,SANDYBRIDGE
 
-
 [VCVTSI2SD,vcvtsi2sdX]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,reg32                       \334\350\362\370\1\x2A\75\120             AVX,SANDYBRIDGE,SD
@@ -4266,7 +4250,6 @@ xmmreg,xmmreg,mem32                       \334\350\362\370\1\x2A\75\120
 xmmreg,xmmreg_er,reg64                    \334\350\352\362\363\370\1\x2A\75\120     AVX,SANDYBRIDGE,X86_64
 xmmreg,xmmreg_er,mem64                    \334\350\352\362\363\370\1\x2A\75\120     AVX,SANDYBRIDGE,X86_64,T1S
 
-
 [VCVTSI2SS,vcvtsi2ssX]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,reg32                       \333\350\362\370\1\x2A\75\120             AVX,SANDYBRIDGE,SD
@@ -4274,13 +4257,11 @@ xmmreg,xmmreg,mem32                       \333\350\362\370\1\x2A\75\120
 xmmreg,xmmreg_er,reg64                    \333\350\352\362\363\370\1\x2A\75\120     AVX,SANDYBRIDGE,X86_64
 xmmreg,xmmreg_er,mem64                    \333\350\352\362\363\370\1\x2A\75\120     AVX,SANDYBRIDGE,X86_64,T1S
 
-
 [VCVTSS2SD]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem32                    \333\350\362\370\1\x5A\75\120             AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_sae               \333\350\362\370\1\x5A\75\120             AVX,SANDYBRIDGE
 
-
 [VCVTSS2SI]
 (Ch_Wop2, Ch_Rop1)
 reg32,mem32                               \333\350\362\370\1\x2D\110                AVX,SANDYBRIDGE,T1F32
@@ -4311,7 +4292,6 @@ zmmreg_mz,mem512                          \333\350\351\370\1\x5B\110
 zmmreg_mz,bmem32                          \333\350\351\370\1\x5B\110                AVX512,TFV
 zmmreg_mz,zmmreg_sae                      \333\350\351\370\1\x5B\110                AVX512
 
-
 [VCVTTSD2SI]
 (Ch_Wop2, Ch_Rop1)
 reg32,mem64                               \334\350\362\370\1\x2C\110                AVX,SANDYBRIDGE,T1F64
@@ -4319,7 +4299,6 @@ reg32,xmmreg_sae                          \334\350\362\370\1\x2C\110
 reg64,mem64                               \334\350\352\362\363\370\1\x2C\110        AVX,SANDYBRIDGE,T1F64
 reg64,xmmreg_sae                          \334\350\352\362\363\370\1\x2C\110        AVX,SANDYBRIDGE
 
-
 [VCVTTSS2SI]
 (Ch_Wop2, Ch_Rop1)
 reg32,mem32                               \333\350\362\370\1\x2C\110                AVX,SANDYBRIDGE,T1F32
@@ -4327,7 +4306,6 @@ reg32,xmmreg_sae                          \333\350\362\370\1\x2C\110
 reg64,mem32                               \333\350\352\362\363\370\1\x2C\110        AVX,SANDYBRIDGE,T1F32
 reg64,xmmreg_sae                          \333\350\352\362\363\370\1\x2C\110        AVX,SANDYBRIDGE
 
-
 [VDIVPD]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,xmmrm                    \350\352\361\362\370\1\x5E\75\120         AVX,SANDYBRIDGE,TFV
@@ -4338,7 +4316,6 @@ zmmreg_mz,zmmreg,mem512                   \350\351\352\361\370\1\x5E\75\120
 zmmreg_mz,zmmreg,bmem64                   \350\351\352\361\370\1\x5E\75\120         AVX512,TFV
 zmmreg_mz,zmmreg,zmmreg_er                \350\351\352\361\370\1\x5E\75\120         AVX512
 
-
 [VDIVPS]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,xmmrm                    \350\362\370\1\x5E\75\120                 AVX,SANDYBRIDGE,TFV
@@ -4349,19 +4326,16 @@ zmmreg_mz,zmmreg,mem512                   \350\351\370\1\x5E\75\120
 zmmreg_mz,zmmreg,bmem32                   \350\351\370\1\x5E\75\120                 AVX512,TFV
 zmmreg_mz,zmmreg,zmmreg_er                \350\351\370\1\x5E\75\120                 AVX512
 
-
 [VDIVSD]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem64                    \334\350\352\362\370\1\x5E\75\120         AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_er                \334\350\352\362\370\1\x5E\75\120         AVX,SANDYBRIDGE
 
-
 [VDIVSS]
 (Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem32                    \333\350\362\370\1\x5E\75\120             AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_er                \333\350\362\370\1\x5E\75\120             AVX,SANDYBRIDGE
 
-
 [VDPPD]
 (Ch_All)
 xmmreg,xmmreg,xmmrm,imm8             \361\362\372\1\x41\75\120\27         AVX,SANDYBRIDGE
@@ -4381,15 +4355,13 @@ mem32,xmmreg,imm8                         \350\361\362\372\1\x17\101\26
 reg32,xmmreg,imm8                         \350\361\362\372\1\x17\101\26             AVX,SANDYBRIDGE
 reg64,xmmreg,imm8                         \350\361\362\372\1\x17\101\26             AVX512
 
-
-
 [VHADDPD]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,xmmrm                  \361\362\370\1\x7C\75\120            AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm                  \361\362\364\370\1\x7C\75\120        AVX,SANDYBRIDGE
 
 [VHADDPS]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,xmmrm                  \334\362\370\1\x7C\75\120            AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm                  \334\362\364\370\1\x7C\75\120        AVX,SANDYBRIDGE
 
@@ -4412,7 +4384,6 @@ ymmreg,ymmreg,xmmrm,imm8             \361\362\364\372\1\x18\75\120\27     AVX,SA
 xmmreg,xmmreg,mem32,imm8                  \350\361\362\372\1\x21\75\120\27          AVX,SANDYBRIDGE,T1S
 xmmreg,xmmreg,xmmreg,imm8                 \350\361\362\372\1\x21\75\120\27          AVX,SANDYBRIDGE
 
-
 [VLDDQU]
 (Ch_All)
 xmmreg,mem128                        \334\362\370\1\xF0\110               AVX,SANDYBRIDGE
@@ -4441,7 +4412,7 @@ ymmreg,ymmreg,mem256                 \361\362\364\371\1\x2C\75\120        AVX,SA
 xmmreg,xmmreg,mem128                 \361\362\371\1\x2C\75\120            AVX,SANDYBRIDGE
 
 [VMAXPD]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,xmmrm               \350\352\361\362\370\1\x5F\75\120      AVX,SANDYBRIDGE,TFV
 xmmreg_mz,xmmreg,bmem64              \350\352\361\370\1\x5F\75\120          AVX512,TFV
 ymmreg_mz,ymmreg,ymmrm               \350\352\361\362\364\370\1\x5F\75\120  AVX,SANDYBRIDGE,TFV
@@ -4450,9 +4421,8 @@ zmmreg_mz,zmmreg,zmmreg_sae          \350\351\352\361\370\1\x5F\75\120      AVX5
 zmmreg_mz,zmmreg,mem512              \350\351\352\361\370\1\x5F\75\120      AVX512,TFV
 zmmreg_mz,zmmreg,bmem64              \350\351\352\361\370\1\x5F\75\120      AVX512,TFV
 
-
 [VMAXPS]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,xmmrm                    \350\362\370\1\x5F\75\120                 AVX,SANDYBRIDGE,TFV
 xmmreg_mz,xmmreg,bmem32                   \350\370\1\x5F\75\120                     AVX512,TFV
 ymmreg_mz,ymmreg,ymmrm                    \350\362\364\370\1\x5F\75\120             AVX,SANDYBRIDGE,TFV
@@ -4461,20 +4431,18 @@ zmmreg_mz,zmmreg,mem512                   \350\351\370\1\x5F\75\120
 zmmreg_mz,zmmreg,bmem32                   \350\351\370\1\x5F\75\120                 AVX512,TFV
 zmmreg_mz,zmmreg,zmmreg_sae               \350\351\370\1\x5F\75\120                 AVX512
 
-
 [VMAXSD]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem64                    \334\350\352\362\370\1\x5F\75\120         AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_sae               \334\350\352\362\370\1\x5F\75\120         AVX,SANDYBRIDGE
 
-
 [VMAXSS]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem32                    \333\350\362\370\1\x5F\75\120             AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_sae               \333\350\362\370\1\x5F\75\120             AVX,SANDYBRIDGE
 
 [VMINPD]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,xmmrm                    \350\352\361\362\370\1\x5D\75\120         AVX,SANDYBRIDGE,TFV
 xmmreg_mz,xmmreg,bmem64                   \350\352\361\370\1\x5D\75\120             AVX512,TFV
 ymmreg_mz,ymmreg,ymmrm                    \350\352\361\362\364\370\1\x5D\75\120     AVX,SANDYBRIDGE,TFV
@@ -4483,9 +4451,8 @@ zmmreg_mz,zmmreg,mem512                   \350\351\352\361\370\1\x5D\75\120
 zmmreg_mz,zmmreg,bmem64                   \350\351\352\361\370\1\x5D\75\120         AVX512,TFV
 zmmreg_mz,zmmreg,zmmreg_sae               \350\351\352\361\370\1\x5D\75\120         AVX512
 
-
 [VMINPS]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,xmmrm                    \350\362\370\1\x5D\75\120                 AVX,SANDYBRIDGE,TFV
 xmmreg_mz,xmmreg,bmem32                   \350\370\1\x5D\75\120                     AVX512,TFV
 ymmreg_mz,ymmreg,ymmrm                    \350\362\364\370\1\x5D\75\120             AVX,SANDYBRIDGE,TFV
@@ -4494,19 +4461,16 @@ zmmreg_mz,zmmreg,mem512                   \350\351\370\1\x5D\75\120
 zmmreg_mz,zmmreg,bmem32                   \350\351\370\1\x5D\75\120                 AVX512,TFV
 zmmreg_mz,zmmreg,zmmreg_sae               \350\351\370\1\x5D\75\120                 AVX512
 
-
 [VMINSD]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem64                    \334\350\352\362\370\1\x5D\75\120         AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_sae               \334\350\352\362\370\1\x5D\75\120         AVX,SANDYBRIDGE
 
-
 [VMINSS]
-(Ch_All)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg_mz,xmmreg,mem32                    \333\350\362\370\1\x5D\75\120             AVX,SANDYBRIDGE,T1S
 xmmreg_mz,xmmreg,xmmreg_sae               \333\350\362\370\1\x5D\75\120             AVX,SANDYBRIDGE
 
-
 [VMOVAPD]
 (Ch_Wop2, Ch_Rop1)
 xmmrm_mz,xmmreg                           \350\352\361\362\370\1\x29\101            AVX,SANDYBRIDGE,TFVM
@@ -4516,7 +4480,6 @@ xmmreg_mz,xmmrm                           \350\352\361\362\370\1\x28\110
 ymmreg_mz,ymmrm                           \350\352\361\362\364\370\1\x28\110        AVX,SANDYBRIDGE,TFVM
 zmmreg_mz,zmmrm                           \350\351\352\361\370\1\x28\110            AVX512,TFVM
 
-
 [VMOVAPS]
 (Ch_Wop2, Ch_Rop1)
 xmmrm_mz,xmmreg                           \350\362\370\1\x29\101                    AVX,SANDYBRIDGE,TFVM
@@ -4526,13 +4489,11 @@ xmmreg_mz,xmmrm                           \350\362\370\1\x28\110
 ymmreg_mz,ymmrm                           \350\362\364\370\1\x28\110                AVX,SANDYBRIDGE,TFVM
 zmmreg_mz,zmmrm                           \350\351\370\1\x28\110                    AVX512,TFVM
 
-
 [VMOVD]
 (Ch_Wop2, Ch_Rop1)
 rm32,xmmreg                               \350\361\362\370\1\x7E\101                AVX,SANDYBRIDGE,T1S
 xmmreg,rm32                               \350\361\362\370\1\x6E\110                AVX,SANDYBRIDGE,T1S
 
-
 [VMOVDDUP]
 (Ch_Wop2, Ch_Rop1)
 xmmreg_mz,mem64                           \334\350\352\362\370\1\x12\110            AVX,SANDYBRIDGE,TMDDUP
@@ -4540,7 +4501,6 @@ xmmreg_mz,xmmreg                          \334\350\352\362\370\1\x12\110
 ymmreg_mz,ymmrm                           \334\350\352\362\364\370\1\x12\110        AVX,SANDYBRIDGE,TMDDUP
 zmmreg_mz,zmmrm                           \334\350\351\352\370\1\x12\110            AVX512,TMDDUP
 
-
 [VMOVDQA]
 (Ch_Wop2, Ch_Rop1)
 ymmrm,ymmreg                         \361\362\364\370\1\x7F\101           AVX,SANDYBRIDGE
@@ -4564,13 +4524,11 @@ xmmreg,xmmreg,xmmreg                      \350\362\370\1\x12\75\120
 mem64,xmmreg                              \350\352\361\362\370\1\x17\101            AVX,SANDYBRIDGE,T1S
 xmmreg,xmmreg,mem64                       \350\352\361\362\370\1\x16\75\120         AVX,SANDYBRIDGE,T1S
 
-
 [VMOVHPS]
 (Ch_All)
 mem64,xmmreg                              \350\362\370\1\x17\101                    AVX,SANDYBRIDGE,T2
 xmmreg,xmmreg,mem64                       \350\362\370\1\x16\75\120                 AVX,SANDYBRIDGE,T2
 
-
 [VMOVLHPS]
 (Ch_All)
 xmmreg,xmmreg,xmmreg                      \350\362\370\1\x16\75\120                 AVX,SANDYBRIDGE

+ 18 - 18
compiler/x86_64/x8664pro.inc

@@ -417,10 +417,10 @@
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_ROp1, Ch_WOp2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -535,10 +535,10 @@
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_Mop2, Ch_Rop1]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
+(Ch: [Ch_Mop2, Ch_Rop1]),
 (Ch: [Ch_ROp1, Ch_WOp2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -801,6 +801,8 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
@@ -810,16 +812,14 @@
 (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_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
+(Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),
 (Ch: [Ch_Wop2, Ch_Rop1]),

+ 3 - 2
compiler/xtensa/cpuinfo.pas

@@ -141,7 +141,8 @@ Const
         CPUXTENSA_HAS_BOOLEAN_OPTION,
         CPUXTENSA_HAS_MUL32HIGH,
         CPUXTENSA_HAS_DIV,
-        CPUXTENSA_HAS_LOOPS
+        CPUXTENSA_HAS_LOOPS,
+        CPUXTENSA_HAS_MINMAX
       );
 
    tfpuflags =
@@ -155,7 +156,7 @@ Const
      (
        { cpu_none     } [],
        { cpu_lx106    } [],
-       { cpu_lx6      } [CPUXTENSA_REGWINDOW, CPUXTENSA_HAS_SEXT, CPUXTENSA_HAS_NSAx, CPUXTENSA_HAS_BOOLEAN_OPTION, CPUXTENSA_HAS_MUL32HIGH, CPUXTENSA_HAS_DIV, CPUXTENSA_HAS_LOOPS]
+       { cpu_lx6      } [CPUXTENSA_REGWINDOW, CPUXTENSA_HAS_SEXT, CPUXTENSA_HAS_NSAx, CPUXTENSA_HAS_BOOLEAN_OPTION, CPUXTENSA_HAS_MUL32HIGH, CPUXTENSA_HAS_DIV, CPUXTENSA_HAS_LOOPS, CPUXTENSA_HAS_MINMAX]
      );
 
    fpu_capabilities : array[tfputype] of set of tfpuflags =

+ 63 - 0
compiler/xtensa/ncpuinl.pas

@@ -35,6 +35,8 @@ unit ncpuinl;
         procedure second_abs_real; override;
         function first_fma: tnode; override;
         procedure second_fma; override;
+        function first_minmax: tnode; override;
+        procedure second_minmax; override;
       end;
 
   implementation
@@ -168,6 +170,67 @@ unit ncpuinl;
       end;
 
 
+    function tcpuinlinenode.first_minmax : tnode;
+      begin
+        if is_32bitint(resultdef) then
+          begin
+            expectloc:=LOC_REGISTER;
+            Result:=nil;
+          end
+        else
+          Result:=inherited first_minmax;
+      end;
+
+
+    procedure tcpuinlineNode.second_minmax;
+      var
+        paraarray : array[1..2] of tnode;
+        i: Integer;
+        ai: taicpu;
+        op: TAsmOp;
+      begin
+         if is_32bitint(resultdef) then
+           begin
+             paraarray[1]:=tcallparanode(tcallparanode(parameters).nextpara).paravalue;
+             paraarray[2]:=tcallparanode(parameters).paravalue;
+
+              for i:=low(paraarray) to high(paraarray) do
+               secondpass(paraarray[i]);
+
+             { no memory operand is allowed }
+             for i:=low(paraarray) to high(paraarray) do
+               begin
+                 if not(paraarray[i].location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                   hlcg.location_force_reg(current_asmdata.CurrAsmList,paraarray[i].location,
+                     paraarray[i].resultdef,resultdef,true);
+               end;
+
+             location_reset(location,LOC_REGISTER,paraarray[1].location.size);
+             location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+
+             case inlinenumber of
+               in_min_dword:
+                 op:=A_MINU;
+               in_max_dword:
+                 op:=A_MAXU;
+               in_min_longint:
+                 op:=A_MIN;
+               in_max_longint:
+                 op:=A_MAX;
+               else
+                 Internalerror(2020120505);
+             end;
+
+             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,
+               location.register,paraarray[1].location.register,paraarray[2].location.register));
+
+             cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
+           end
+         else
+           internalerror(2020120502);
+      end;
+
+
 begin
   cinlinenode:=tcpuinlinenode;
 end.

+ 1 - 1
compiler/z80/raz80asm.pas

@@ -2301,7 +2301,7 @@ Unit raz80asm;
                   begin
                     if constsize<>sizeof(pint) then
                       Message(asmr_w_32bit_const_for_address);
-                     ConcatConstSymbol(curlist,asmsym,asmsymtyp,value,constsize,true)
+                     ConcatConstSymbol(curlist,asmsym,'',asmsymtyp,value,constsize,true)
                   end
                 else
                   ConcatConstant(curlist,value,constsize);

+ 10 - 6
packages/chm/src/chmreader.pas

@@ -480,9 +480,8 @@ begin
 end;
 
 function TChmReader.ReadURLSTR ( APosition: DWord ) : String;
-var
-  URLStrURLOffset: DWord;
 begin
+  result:='';
   if not CheckCommonStreams then
     Exit;
 
@@ -1124,6 +1123,8 @@ var
 
 function readvalue:string;
 begin
+  result:='';
+  title:='';
   if head<tail Then
     begin
       ind:=LEToN(plongint(head)^);
@@ -1308,19 +1309,21 @@ var TryTextual : boolean;
 
 begin
    Result := nil;  SiteMap:=Nil;
-   lookup:=TDictionary<string,TLookupRec>.create;
    // First Try Binary
    Index := GetObject('/$WWKeywordLinks/BTree');
    if (Index = nil) or ForceXML then
    begin
-     Result:=AbortAndTryTextual;
+     Result:=AbortAndTryTextual; // frees index if needed
      Exit;
    end;
    if not CheckCommonStreams then
    begin
-     Result:=AbortAndTryTextual;
+     index.free;
+     Result:=AbortAndTryTextual; // frees index if needed
      Exit;
    end;
+
+   lookup:=TDictionary<string,TLookupRec>.create;
    SiteMap:=TChmSitemap.Create(StIndex);
    itemstack :=TObjectList.create(false);
    //Item   :=Nil;  // cached last created item, in case we need to make
@@ -1349,9 +1352,10 @@ begin
   if trytextual then
     begin
       sitemap.free;
-      Result:=AbortAndTryTextual;
+      Result:=AbortAndTryTextual; // frees index if needed
     end
   else Index.Free;
+  itemstack.free;
   lookup.free;
 end;
 

+ 2 - 1
packages/fcl-passrc/src/pasresolveeval.pas

@@ -1069,7 +1069,8 @@ begin
         begin
         GenType:=TPasGenericType(El);
         if (GenType.GenericTemplateTypes<>nil)
-            and (GenType.GenericTemplateTypes.Count>0) then
+            and (GenType.GenericTemplateTypes.Count>0)
+            and (Pos('<',El.Name)<1) then
           Result:=GetGenericParamCommas(GenType.GenericTemplateTypes.Count)+Result;
         end;
       if El.Name<>'' then

+ 89 - 57
packages/fcl-passrc/src/pasresolver.pp

@@ -1871,7 +1871,7 @@ type
     procedure SpecializeElArray(GenEl, SpecEl: TPasElement;
       GenList: TPasElementArray; var SpecList: TPasElementArray; AllowReferences: boolean
       {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
-    procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure; SpecializedItem: TPRSpecializedItem);
+    procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure; SpecializedItem: TPRSpecializedItem); virtual;
     procedure SpecializeOperator(GenEl, SpecEl: TPasOperator);
     procedure SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
     procedure SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
@@ -2375,6 +2375,7 @@ type
     function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
     function ProcNeedsParams(El: TPasProcedureType): boolean;
     function ProcHasSelf(El: TPasProcedure): boolean; // returns false for local procs
+    procedure CreateProcSelfArg(Proc: TPasProcedure); virtual;
     function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
     function GetTopLvlProc(El: TPasElement): TPasProcedure;
     function GetParentProc(El: TPasElement; GetDeclProc: boolean): TPasProcedure;
@@ -7318,6 +7319,7 @@ var
   i: Integer;
   ParentScope: TPasScope;
   TemplTypes: TFPList;
+  ClassRecType: TPasMembersType;
 begin
   if not (ptmStatic in Proc.ProcType.Modifiers) then
     Proc.ProcType.IsOfObject:=true;
@@ -7325,7 +7327,8 @@ begin
   ParentScope:=Scopes[ScopeCount-2];
   // ToDo: store the scanner flags *before* it has parsed the token after the proc
   StoreScannerFlagsInProc(ProcScope);
-  ClassOrRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope;
+  ClassRecType:=TPasMembersType(Proc.Parent);
+  ClassOrRecScope:=ClassRecType.CustomData as TPasClassOrRecordScope;
   ProcScope.ClassRecScope:=ClassOrRecScope;
 
   TemplTypes:=GetProcTemplateTypes(Proc);
@@ -7401,17 +7404,17 @@ begin
   if Proc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
     Insert(Proc,TPasClassScope(ClassOrRecScope).AbstractProcs,
            length(TPasClassScope(ClassOrRecScope).AbstractProcs));
+
+  CreateProcSelfArg(Proc);
 end;
 
 procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
 var
   ProcName: String;
-  ClassRecType: TPasMembersType;
   ImplProcScope, DeclProcScope: TPasProcedureScope;
   DeclProc: TPasProcedure;
   ClassOrRecScope: TPasClassOrRecordScope;
   SelfArg: TPasArgument;
-  SelfType, LoSelfType: TPasType;
   LastNamePart: TProcedureNamePart;
 begin
   if ImplProc.IsExternal then
@@ -7425,7 +7428,6 @@ begin
   ClassOrRecScope:=ImplProcScope.ClassRecScope;
   if ClassOrRecScope=nil then
     RaiseInternalError(20161013172346);
-  ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
   if ImplProcScope.GroupScope=nil then
     RaiseInternalError(20190120135017);
 
@@ -7440,6 +7442,8 @@ begin
     ProcName:=LastDottedIdentifier(ProcName);
     end;
 
+  DeclProc:=nil;
+  DeclProcScope:=nil;
   if ImplProcScope.DeclarationProc=nil then
     begin
     {$IFDEF VerbosePasResolver}
@@ -7494,54 +7498,14 @@ begin
   else
     RaiseNotYetImplemented(20190804181222,ImplProc);
 
-  if not DeclProc.IsStatic then
+  SelfArg:=DeclProcScope.SelfArg;
+  if SelfArg<>nil then
     begin
     // add 'Self'
-    if (DeclProc.ClassType=TPasClassConstructor)
-        or (DeclProc.ClassType=TPasClassDestructor) then
-      // actually class constructor/destructor are static
-    else if (DeclProc.ClassType=TPasClassProcedure)
-        or (DeclProc.ClassType=TPasClassFunction) then
-      begin
-      if (ClassOrRecScope is TPasClassScope)
-          and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
-        begin
-        // 'Self' in a class method is the hidden classtype argument
-        // Note: this is true in classes, adv records and helpers
-        SelfArg:=TPasArgument.Create('Self',DeclProc);
-        ImplProcScope.SelfArg:=SelfArg;
-        {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
-        SelfArg.Access:=argConst;
-        SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
-        SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
-        AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
-        end
-      else
-        RaiseInternalError(20190106121745);
-      end
-    else
-      begin
-      // 'Self' in a method is the hidden instance argument
-      SelfArg:=TPasArgument.Create('Self',DeclProc);
-      ImplProcScope.SelfArg:=SelfArg;
-      {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
-      SelfType:=ClassRecType;
-      if (SelfType.ClassType=TPasClassType)
-          and (TPasClassType(SelfType).HelperForType<>nil) then
-        begin
-        // in a helper Self is a var argument of the helped variable
-        SelfType:=TPasClassType(SelfType).HelperForType;
-        end;
-      LoSelfType:=ResolveAliasType(SelfType);
-      if (LoSelfType is TPasClassType)
-          and (TPasClassType(LoSelfType).ObjKind=okClass) then
-        SelfArg.Access:=argConst
-      else
-        SelfArg.Access:=argVar;
-      SelfArg.ArgType:=SelfType;
-      SelfType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
-      AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
-      end;
+    ImplProcScope.SelfArg:=SelfArg;
+    SelfArg.AddRef{$IFDEF CheckPasTreeRefCount}('TPasProcedureScope.SelfArg'){$ENDIF};
+    {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
+    AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
     end;
 
   {$IFDEF VerbosePasResolver}
@@ -16734,7 +16698,7 @@ function TPasResolver.CreateSpecializedTypeName(Item: TPRSpecializedItem): strin
       else
         Result:=aType.GetModule.Name;
       Result:=Result+'.'+aType.Name;
-      if aType.CustomData is TPasGenericScope then
+      if (aType.CustomData is TPasGenericScope) and (Pos('<',aType.Name)<1) then
         begin
         ChildItem:=TPasGenericScope(aType.CustomData).SpecializedFromItem;
         if ChildItem<>nil then
@@ -16744,7 +16708,13 @@ function TPasResolver.CreateSpecializedTypeName(Item: TPRSpecializedItem): strin
   end;
 
 begin
+  if Pos('<',Item.GenericEl.Name)>0 then
+    RaiseNotYetImplemented(20201203140102,Item.SpecializedEl,Item.GenericEl.Name);
+
   Result:=Item.GenericEl.Name+GetSpecParams(Item);
+
+  if Pos('><',Result)>0 then
+    RaiseNotYetImplemented(20201203140223,Item.SpecializedEl,Result);
 end;
 
 procedure TPasResolver.InitSpecializeScopes(El: TPasElement; out
@@ -17218,8 +17188,6 @@ begin
   SpecImplProcScope.BoolSwitches:=GenImplProcScope.BoolSwitches;
   SpecImplProcScope.VisibilityContext:=SpecClassOrRec;
   SpecImplProcScope.ClassRecScope:=SpecClassOrRecScope;
-  if GenDeclProcScope.SelfArg<>nil then
-    RaiseNotYetImplemented(20190922154603,GenImplProc);
 
   if SpecializedProcItem<>nil then
     begin
@@ -17662,8 +17630,6 @@ begin
     if GenProcScope.OverriddenProc<>nil then
       RaiseNotYetImplemented(20190920203536,SpecEl);
     SpecProcScope.ClassRecScope:=GenProcScope.ClassRecScope;
-    if GenProcScope.SelfArg<>nil then
-      RaiseNotYetImplemented(20190920203626,SpecEl);
     // SpecProcScope.Flags
     SpecProcScope.ModeSwitches:=GenProcScope.ModeSwitches;
     SpecProcScope.BoolSwitches:=GenProcScope.BoolSwitches;
@@ -18792,7 +18758,10 @@ begin
     begin
     // inside procedure: first param is function result
     ProcScope:=TPasProcedureScope(Scopes[i]);
-    CtxProc:=TPasProcedure(ProcScope.Element);
+    if ProcScope.DeclarationProc<>nil then
+      CtxProc:=ProcScope.DeclarationProc
+    else
+      CtxProc:=TPasProcedure(ProcScope.Element);
     if not (CtxProc.ProcType is TPasFunctionType) then
       begin
       if RaiseOnError then
@@ -29118,6 +29087,69 @@ begin
   Result:=true;
 end;
 
+procedure TPasResolver.CreateProcSelfArg(Proc: TPasProcedure);
+var
+  SelfArg: TPasArgument;
+  SelfType, LoSelfType: TPasType;
+  ProcScope: TPasProcedureScope;
+  ClassOrRecScope: TPasClassOrRecordScope;
+  ClassRecType: TPasMembersType;
+begin
+  if Proc.IsStatic or Proc.IsExternal then exit;
+
+  // add 'Self'
+  if (Proc.ClassType=TPasClassConstructor)
+      or (Proc.ClassType=TPasClassDestructor) then
+    // actually class constructor/destructor are static
+    exit;
+
+  ProcScope:=TPasProcedureScope(Proc.CustomData);
+  ClassOrRecScope:=ProcScope.ClassRecScope;
+  if ClassOrRecScope=nil then exit;
+  ClassRecType:=TPasMembersType(ClassOrRecScope.Element);
+
+  if (Proc.ClassType=TPasClassProcedure)
+      or (Proc.ClassType=TPasClassFunction) then
+    begin
+    if (ClassOrRecScope is TPasClassScope)
+        and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
+      begin
+      // 'Self' in a class method is the hidden classtype argument
+      // Note: this is true in classes, adv records and helpers
+      SelfArg:=TPasArgument.Create('Self',Proc);
+      ProcScope.SelfArg:=SelfArg;
+      {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
+      SelfArg.Access:=argConst;
+      SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
+      SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
+      end
+    else
+      RaiseInternalError(20190106121745);
+    end
+  else
+    begin
+    // 'Self' in a method is the hidden instance argument
+    SelfArg:=TPasArgument.Create('Self',Proc);
+    ProcScope.SelfArg:=SelfArg;
+    {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
+    SelfType:=ClassRecType;
+    if (SelfType.ClassType=TPasClassType)
+        and (TPasClassType(SelfType).HelperForType<>nil) then
+      begin
+      // in a helper Self is a var argument of the helped variable
+      SelfType:=TPasClassType(SelfType).HelperForType;
+      end;
+    LoSelfType:=ResolveAliasType(SelfType);
+    if (LoSelfType is TPasClassType)
+        and (TPasClassType(LoSelfType).ObjKind=okClass) then
+      SelfArg.Access:=argConst
+    else
+      SelfArg.Access:=argVar;
+    SelfArg.ArgType:=SelfType;
+    SelfType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
+    end;
+end;
+
 function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
   ): boolean;
 var

+ 19 - 10
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1281,7 +1281,7 @@ begin
     if CanSkipGenericType(ProcType) then exit;
     for i:=0 to ProcType.Args.Count-1 do
       UseSubEl(TPasArgument(ProcType.Args[i]).ArgType);
-    if El is TPasFunctionType then
+    if (El is TPasFunctionType) and (TPasFunctionType(El).ResultEl<>nil) then
       UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
     end
   else if C=TPasSpecializeType then
@@ -1543,12 +1543,15 @@ begin
     UseExpr(ForLoop.StartExpr);
     UseExpr(ForLoop.EndExpr);
     ForScope:=ForLoop.CustomData as TPasForLoopScope;
-    MarkImplScopeRef(ForLoop,ForScope.GetEnumerator,psraRead);
-    UseProcedure(ForScope.GetEnumerator);
-    MarkImplScopeRef(ForLoop,ForScope.MoveNext,psraRead);
-    UseProcedure(ForScope.MoveNext);
-    MarkImplScopeRef(ForLoop,ForScope.Current,psraRead);
-    UseVariable(ForScope.Current,rraRead,false);
+    if ForScope<>nil then
+      begin
+      MarkImplScopeRef(ForLoop,ForScope.GetEnumerator,psraRead);
+      UseProcedure(ForScope.GetEnumerator);
+      MarkImplScopeRef(ForLoop,ForScope.MoveNext,psraRead);
+      UseProcedure(ForScope.MoveNext);
+      MarkImplScopeRef(ForLoop,ForScope.Current,psraRead);
+      UseVariable(ForScope.Current,rraRead,false);
+      end;
     UseImplElement(ForLoop.Body);
     end
   else if C=TPasImplIfElse then
@@ -1650,12 +1653,14 @@ procedure TPasAnalyzer.UseExpr(El: TPasExpr);
     UseElement(SubEl,rraAssign,false);
   end;
 
-  procedure UseBuilInFuncTypeInfo;
+  procedure UseBuiltInFuncTypeInfo;
   var
     ParentParams: TPRParentParams;
     ParamResolved: TPasResolverResult;
     SubEl: TPasElement;
     Params: TPasExprArray;
+    ProcScope: TPasProcedureScope;
+    Proc: TPasProcedure;
   begin
     Resolver.GetParamsOfNameExpr(El,ParentParams);
     if ParentParams.Params=nil then
@@ -1672,7 +1677,11 @@ procedure TPasAnalyzer.UseExpr(El: TPasExpr);
     if (ParamResolved.IdentEl is TPasProcedure)
         and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
       begin
-      SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
+      Proc:=TPasProcedure(ParamResolved.IdentEl);
+      ProcScope:=Proc.CustomData as TPasProcedureScope;
+      if ProcScope.DeclarationProc<>nil then
+        Proc:=ProcScope.DeclarationProc;
+      SubEl:=TPasFunctionType(Proc.ProcType).ResultEl.ResultType;
       MarkImplScopeRef(El,SubEl,psraTypeInfo);
       UseTypeInfo(SubEl);
       end
@@ -1751,7 +1760,7 @@ begin
           end;
         bfTypeInfo:
           begin
-          UseBuilInFuncTypeInfo;
+          UseBuiltInFuncTypeInfo;
           exit;
           end;
         bfAssert:

+ 23 - 0
packages/pastojs/src/fppas2js.pp

@@ -1559,6 +1559,8 @@ type
       override;
     procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
       override;
+    procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure;
+      SpecializedItem: TPRSpecializedItem); override;
     function SpecializeParamsNeedDelay(SpecializedItem: TPRSpecializedItem): TPasElement; virtual;
     function IsSpecializedNonStaticMethod(ProcType: TPasProcedureType): boolean;
   protected
@@ -5267,6 +5269,22 @@ begin
     end;
 end;
 
+procedure TPas2JSResolver.SpecializeProcedure(GenEl, SpecEl: TPasProcedure;
+  SpecializedItem: TPRSpecializedItem);
+var
+  GenProcScope, SpecProcScope: TPas2JSProcedureScope;
+begin
+  GenProcScope:=GenEl.CustomData as TPas2JSProcedureScope;
+  SpecProcScope:=SpecEl.CustomData as TPas2JSProcedureScope;
+  if SpecializedItem=nil then
+    begin
+    SpecProcScope.OverloadName:=GenProcScope.OverloadName;
+    SpecProcScope.JSName:=GenProcScope.JSName;
+    // SpecProcScope.ResultVarName is set on demand
+    end;
+  inherited SpecializeProcedure(GenEl, SpecEl, SpecializedItem);
+end;
+
 function TPas2JSResolver.SpecializeParamsNeedDelay(
   SpecializedItem: TPRSpecializedItem): TPasElement;
 // finds first specialize param defined later than the generic
@@ -21148,7 +21166,12 @@ var
       if ProcScope.ImplProc<>nil then
         ProcScope:=ProcScope.ImplProc.CustomData as TPas2JSProcedureScope;
       if ProcScope.SelfArg=nil then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('CreateReference Proc=',GetObjPath(Proc),' Left=',GetObjPath(Left),' LeftResolved=',GetResolverResultDbg(LeftResolved),' ProcScope.DeclarationProc=',GetObjPath(ProcScope.DeclarationProc));
+        {$ENDIF}
         RaiseNotSupported(PosEl,AContext,20190209214906,GetObjName(Proc));
+        end;
       Result:=CreateProcCallArgRef(Left,LeftResolved,ProcScope.SelfArg,AContext);
       end;
   end;

+ 26 - 12
packages/pastojs/src/pas2jscompiler.pp

@@ -595,13 +595,13 @@ type
     function CreateMacroEngine: TPas2jsMacroEngine;virtual;
     function CreateSrcMap(const aFileName: String): TPas2JSSrcMap; virtual;
     function CreateOptimizer: TPas2JSAnalyzer;
-    // These are mandatory !
-    function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract;
-    function CreateFS: TPas2JSFS; virtual; abstract;
+    function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract;// mandatory !
+    function CreateFS: TPas2JSFS; virtual; abstract; // mandatory !
     function FormatPath(Const aPath: String): String;
     function FullFormatPath(Const aPath: String): String;
     procedure WritePrecompiledFormats; virtual;
     procedure WriteHelpLine(S: String);
+    function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile;
     // Override these for PCU format
     function CreateCompilerFile(const PasFileName, PCUFilename: String): TPas2jsCompilerFile; virtual;
     // Command-line option handling
@@ -2292,7 +2292,7 @@ begin
     if SrcMapInclude and FS.FileExists(LocalFilename) then
     begin
       // include source in SrcMap
-      aFile:=FS.LoadFile(LocalFilename);
+      aFile:=LoadFile(LocalFilename);
       SrcMap.SourceContents[i]:=aFile.Source;
     end;
     // translate local file name
@@ -2761,10 +2761,9 @@ procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; Combined
   end;
 
 Var
-  aFileWriter : TPas2JSMapper;
-  isSingleFile : Boolean;
-  ResFileName,MapFilename : String;
-
+  aFileWriter: TPas2JSMapper;
+  isSingleFile, JSFileWritten: Boolean;
+  ResFileName,MapFilename: String;
 begin
   aFileWriter:=CombinedFileWriter;
   try
@@ -2795,8 +2794,7 @@ begin
         PostProcessorSupport.CallPostProcessors(aFile.JSFilename,aFileWriter);
 
       // Give chance to descendants to write file
-      if DoWriteJSFile(aFile.JSFilename,aFileWriter) then
-        exit;// descendant has written -> finished
+      JSFileWritten:=DoWriteJSFile(aFile.JSFilename,aFileWriter);
 
       if (aFile.JSFilename='') and (MainJSFile='.') then
         WriteToStandardOutput(aFileWriter);
@@ -2807,7 +2805,8 @@ begin
       CheckOutputDir(aFileWriter.DestFileName);
 
       MapFilename:=aFileWriter.DestFilename+'.map';
-      WriteJSToFile(MapFileName,aFileWriter);
+      if not JSFileWritten then
+        WriteJSToFile(MapFileName,aFileWriter);
       if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then
         if FResourceStrings.StringsCount>0 then
           WriteResourceStrings(ChangeFileExt(aFileWriter.DestFileName,'.jrs'));
@@ -4549,6 +4548,7 @@ begin
     on E: Exception do begin
       if ShowDebug then
         Log.LogExceptionBackTrace(E);
+      Log.Log(mtFatal,E.Message);
       raise; // reraise unexpected exception
     end else begin
       if ShowDebug then
@@ -4629,6 +4629,20 @@ begin
   Log.LogRaw(s);
 end;
 
+function TPas2jsCompiler.LoadFile(Filename: string; Binary: boolean
+  ): TPas2jsFile;
+begin
+  try
+    Result:=FS.LoadFile(Filename,Binary);
+  except
+    on E: Exception do
+      begin
+      Log.Log(mtError,E.Message);
+      Terminate(ExitCodeFileNotFound);
+      end
+  end;
+end;
+
 procedure TPas2jsCompiler.WriteHelp;
 
   procedure w(s: string); inline;
@@ -5150,7 +5164,7 @@ begin
         Log.LogMsg(nCustomJSFileNotFound,[InsertFilenames[i]]);
         raise EFileNotFoundError.Create('');
       end;
-      aFile:=FS.LoadFile(Filename);
+      aFile:=LoadFile(Filename);
       if aFile.Source='' then continue;
       aWriter.WriteFile(aFile.Source,Filename);
     end

+ 166 - 59
packages/pastojs/src/pas2jsfiler.pp

@@ -81,6 +81,10 @@ unit Pas2JsFiler;
 
 {$mode objfpc}{$H+}
 
+{$IF FPC_FULLVERSION>30200}
+{$WARN 6060 off : case statement does not handle all possible cases}
+{$ENDIF}
+
 interface
 
 uses
@@ -794,6 +798,7 @@ type
     procedure WriteIdentifierScope(Obj: TJSONObject; Scope: TPasIdentifierScope; aContext: TPCUWriterContext); virtual;
     procedure WriteModuleScopeFlags(Obj: TJSONObject; const Value, DefaultValue: TPasModuleScopeFlags); virtual;
     procedure WriteModuleScope(Obj: TJSONObject; Scope: TPas2JSModuleScope; aContext: TPCUWriterContext); virtual;
+    procedure WriteModuleScopeLocalVars(Obj: TJSONObject; Scope: TPas2JSModuleScope); virtual;
     // element utilities
     procedure WriteSrcPos(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
     procedure WritePasElement(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
@@ -986,7 +991,7 @@ type
     Obj: TJSONObject;
     GenericEl: TPasGenericType;
     Id: integer;
-    Params: TFPList; // list of PCUReaderPendingSpecializedParams
+    Params: TFPList; // list of TPCUReaderPendingSpecializedParam
     RefEl: TPasElement; // a TInlineSpecializeExpr, TPasSpecializeType, TPasProcedure or TInitializationSection
     SpecName: string;
     Prev, Next: TPCUReaderPendingSpecialized;
@@ -1001,7 +1006,6 @@ type
     FJSON: TJSONObject;
     FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
     FPendingForwardProcs: TFPList; // list of TPasElement waiting for implementation of methods
-    FIntfSectionObj: TJSONObject;
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
@@ -2683,6 +2687,8 @@ begin
     WImplBlock(aModule.FinalizationSection,'Final');
     end;
 
+  WriteModuleScopeLocalVars(Obj,ModScope);
+
   //writeln('TPCUWriter.WriteModule WriteExternalReferences of implementation ',Resolver.RootElement.Name,' aContext.Section=',GetObjName(aContext.Section));
   WriteExternalReferences(aContext);
 
@@ -2795,10 +2801,6 @@ procedure TPCUWriter.WriteModuleScope(Obj: TJSONObject;
   Scope: TPas2JSModuleScope; aContext: TPCUWriterContext);
 var
   aModule: TPasModule;
-  i: Integer;
-  SubObj: TJSONObject;
-  LocalVar: TPas2JSStoredLocalVar;
-  LocalVars: TPas2JSStoredLocalVarArray;
 begin
   aModule:=Scope.Element as TPasModule;
   if Scope.FirstName<>FirstDottedIdentifier(aModule.Name) then
@@ -2814,6 +2816,19 @@ begin
   AddReferenceToObj(Obj,'SystemTVarRec',Scope.SystemTVarRec);
   AddReferenceToObj(Obj,'SystemVarRecs',Scope.SystemVarRecs);
 
+  // Scope.StoreJSLocalVars is written later, because some references need implementation units
+
+  WritePasScope(Obj,Scope,aContext);
+end;
+
+procedure TPCUWriter.WriteModuleScopeLocalVars(Obj: TJSONObject;
+  Scope: TPas2JSModuleScope);
+var
+  LocalVars: TPas2JSStoredLocalVarArray;
+  SubObj: TJSONObject;
+  i: Integer;
+  LocalVar: TPas2JSStoredLocalVar;
+begin
   // StoreJSLocalVars
   LocalVars:=Scope.StoreJSLocalVars;
   if length(LocalVars)>0 then
@@ -2830,8 +2845,6 @@ begin
       AddReferenceToObj(SubObj,LocalVar.Name,LocalVar.Element);
       end;
     end;
-
-  WritePasScope(Obj,Scope,aContext);
 end;
 
 procedure TPCUWriter.WriteSrcPos(Obj: TJSONObject; El: TPasElement;
@@ -3457,6 +3470,8 @@ begin
         ParentRef.Obj.Add('Specs',ParentRef.Specs);
         end;
       ParentRef.Specs.Add(Ref.Obj);
+      if (Ref.Id=0) then
+        CreateElReferenceId(Ref); // every specialization needs an ID
       end
     else
       begin
@@ -3474,7 +3489,7 @@ begin
     begin
     // indirectly used unit (refs to directly used units are created in WriteSection)
     if aContext.IndirectUsesArr=nil then
-      begin
+       begin
       if aContext.SectionObj=nil then
         RaiseMsg(20180314154428,El);
       //writeln('TPCUWriter.WriteExternalReference ',Resolver.RootElement.Name,' Section=',GetObjName(aContext.Section),' IndirectUses=',El.Name);
@@ -3950,9 +3965,8 @@ begin
       SubObj:=TJSONObject.Create;
       Arr.Add(SubObj);
       SubObj.Add('Name',RecValue.Name);
-      if (RecValue.ValueExp<>nil) and (RecValue.ValueExp.Name<>'') then
-        RaiseMsg(20180209192240,RecValue.ValueExp);
-      WriteElement(SubObj,RecValue.ValueExp,aContext);
+      WriteExpr(SubObj,Expr,'NameExpr',RecValue.NameExp,aContext);
+      WriteExpr(SubObj,Expr,'ValueExpr',RecValue.ValueExp,aContext);
       end;
     end;
 end;
@@ -4017,22 +4031,24 @@ var
 begin
   WriteAliasType(Obj,El,aContext);
   WriteElementList(Obj,El,'Params',El.Params,aContext,true);
+  if El.CustomData=nil then
+    exit; // SpecTypeData can be nil, when a generic A<T> refers to a generic B<T>
   if not (El.CustomData is TPasSpecializeTypeData) then
     RaiseMsg(20200219122421,El,GetObjName(El.CustomData));
   SpecTypeData:=TPasSpecializeTypeData(El.CustomData);
   SpecType:=SpecTypeData.SpecializedType;
   if SpecType=nil then
-    RaiseMsg(20200219122520,El,GetObjName(El.CustomData));
+    RaiseMsg(20201203093316,El);
   WriteElType(Obj,El,'SpecType',SpecType,aContext);
-  Obj.Add('SpecName',SpecType.Name);
+  Obj.Add('SpecTypeName',SpecType.Name);
 end;
 
 procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext);
 begin
   WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
-  WriteExpr(Obj,Expr,'Name',Expr.NameExpr,aContext);
-  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext,true);
+  WriteExpr(Obj,Expr,'ISEName',Expr.NameExpr,aContext);
+  WriteElementList(Obj,Expr,'ISEParams',Expr.Params,aContext,true);
 end;
 
 procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -4560,10 +4576,9 @@ begin
     RaiseMsg(20180219135933,Scope.Element);
   AddReferenceToObj(Obj,'ImplProc',Scope.ImplProc);
   AddReferenceToObj(Obj,'Overridden',Scope.OverriddenProc);
-  // ClassOrRecordScope: TPasClassScope; auto derived
-  if Scope.SelfArg<>nil then
-    RaiseMsg(20180211180457,Scope.Element); // SelfArg only valid for method implementation
-  // Mode: TModeSwitch: auto derived
+  // ClassOrRecordScope is auto derived
+  // SelfArg is auto derived
+  // Mode is auto derived
   WriteProcScopeFlags(Obj,'SFlags',Scope.Flags,[]);
   WriteBoolSwitches(Obj,'BoolSwitches',Scope.BoolSwitches,aContext.BoolSwitches);
   WriteModeSwitches(Obj,'ModeSwitches',Scope.ModeSwitches,aContext.ModeSwitches);
@@ -4594,6 +4609,7 @@ var
   OldInGeneric: Boolean;
 begin
   WritePasElement(Obj,El,aContext);
+
   Scope:=El.CustomData as TPas2JSProcedureScope;
   //writeln('TPCUWriter.WriteProcedure ',GetObjName(El),' ',GetObjName(Scope),' ',Resolver.GetElementSourcePosStr(El));
 
@@ -5551,7 +5567,7 @@ begin
     Param:=TPCUReaderPendingSpecializedParam(RefParams[i]);
     if Param.Element<>nil then continue;
     Ref:=GetElReference(Param.Id,RefEl);
-    if Ref=nil then
+    if (Ref=nil) or (Ref.Element=nil) then
       begin
       //writeln('TPCUReader.CreateSpecializedElement SpecName=',PendSpec.SpecName,' Id=',PendSpec.Id,' WAITING for param ',i,': ',Param.Id);
       exit(false);
@@ -5603,6 +5619,92 @@ begin
 end;
 
 procedure TPCUReader.ResolveSpecializedElements(Complete: boolean);
+
+  function GetErrMsg(UnresolvedSpec: TPCUReaderPendingSpecialized): string;
+  var
+    i: Integer;
+    Param: TPCUReaderPendingSpecializedParam;
+    Ref: TPCUFilerElementRef;
+  begin
+    Result:=UnresolvedSpec.SpecName
+         +' Id='+IntToStr(UnresolvedSpec.Id)
+         +' RefEl='+GetObjPath(UnresolvedSpec.RefEl)
+         +' GenericEl='+GetObjPath(UnresolvedSpec.GenericEl)
+         +' Params=<';
+    for i:=0 to UnresolvedSpec.Params.Count-1 do
+      begin
+      if i>0 then Result:=Result+',';
+      Param:=TPCUReaderPendingSpecializedParam(UnresolvedSpec.Params[i]);
+      if Param.Element<>nil then
+        Result:=Result+GetObjPath(Param.Element)
+      else
+        begin
+        Result:=Result+'Id='+IntToStr(Param.Id);
+        if Param.Id<1 then
+          continue;
+        Ref:=GetElReference(Param.Id,UnresolvedSpec.GenericEl);
+        if Ref=nil then
+          begin
+          Result:=Result+',Ref=nil';
+          continue;
+          end;
+        Result:=Result+',Ref.Element='+GetObjPath(Ref.Element);
+        end;
+      end;
+    Result:=Result+'>';
+  end;
+
+  function PushRefElToParamSpec(PendSpec: TPCUReaderPendingSpecialized): boolean;
+  // For example: A<B<...>>
+  // B<...> RefEl is A<...>
+  // push RefEl of A<...> to B<...>, so that B<...> is created
+  var
+    i: Integer;
+    Param: TPCUReaderPendingSpecializedParam;
+    Ref: TPCUFilerElementRef;
+    OtherPendSpec: TPCUReaderPendingSpecialized;
+  begin
+    Result:=false;
+    if PendSpec.RefEl=nil then exit;
+    for i:=0 to PendSpec.Params.Count-1 do
+      begin
+      Param:=TPCUReaderPendingSpecializedParam(PendSpec.Params[i]);
+      Ref:=GetElReference(Param.Id,PendSpec.GenericEl);
+      if (Ref=nil) or (Ref.Element<>nil) then continue;
+      OtherPendSpec:=FPendingSpecialize;
+      while OtherPendSpec<>nil do
+        begin
+        if (OtherPendSpec.Id=Param.Id) and (OtherPendSpec.RefEl=nil) then
+          begin
+          OtherPendSpec.RefEl:=PendSpec.RefEl;
+          Result:=true;
+          end;
+        OtherPendSpec:=OtherPendSpec.Next;
+        end;
+      end;
+  end;
+
+  function FreeTemplateSpecialization(PendSpec: TPCUReaderPendingSpecialized): boolean;
+  // checks if PendSpec params are only TPasGenericTemplateType
+  // if yes, frees this PendSpec
+  var
+    i: Integer;
+    Param: TPCUReaderPendingSpecializedParam;
+    Ref: TPCUFilerElementRef;
+  begin
+    Result:=true;
+    for i:=0 to PendSpec.Params.Count-1 do
+      begin
+      Param:=TPCUReaderPendingSpecializedParam(PendSpec.Params[i]);
+      Ref:=GetElReference(Param.Id,PendSpec.GenericEl);
+      if Ref=nil then
+        exit(false);
+      if not (Ref.Element is TPasGenericTemplateType) then
+        exit(false);
+      end;
+    DeletePendingSpecialize(PendSpec);
+  end;
+
 var
   PendSpec, NextPendSpec, UnresolvedSpec: TPCUReaderPendingSpecialized;
   Changed: Boolean;
@@ -5615,6 +5717,7 @@ begin
     while PendSpec<>nil do
       begin
       NextPendSpec:=PendSpec.Next;
+
       if PendSpec.RefEl=nil then
         begin
         // no referrer -> use the first element, waiting for this ID
@@ -5627,8 +5730,16 @@ begin
         if CreateSpecializedElement(PendSpec) then
           // Note: PendSpec has been freed
           Changed:=true
+        else if PushRefElToParamSpec(PendSpec) then
+          // one param was a pending specialize waiting for its RefEl
+          Changed:=true
         else
           UnresolvedSpec:=PendSpec;
+        end
+      else if Complete and (PendSpec.RefEl=nil) then
+        begin
+        if FreeTemplateSpecialization(PendSpec) then
+          Changed:=true;
         end;
       PendSpec:=NextPendSpec;
       end;
@@ -5643,13 +5754,13 @@ begin
     while PendSpec<>nil do
       begin
       {AllowWriteln}
-      writeln('TPCUReader.ResolveSpecializedElements PENDING: ',PendSpec.SpecName+' Id='+IntToStr(PendSpec.Id)+' RefEl='+GetObjPath(PendSpec.RefEl)+' GenericEl='+GetObjPath(PendSpec.GenericEl));;
+      writeln('TPCUReader.ResolveSpecializedElements PENDING: ',GetErrMsg(PendSpec));
       {AllowWriteln-}
       PendSpec:=PendSpec.Next;
       end;
     {$ENDIF}
     // a pending specialize cannot resolve its params
-    RaiseMsg(20200531101924,UnresolvedSpec.GenericEl,UnresolvedSpec.SpecName+' Id='+IntToStr(UnresolvedSpec.Id)+' RefEl='+GetObjPath(UnresolvedSpec.RefEl)+' GenericEl='+GetObjPath(UnresolvedSpec.GenericEl));
+    RaiseMsg(20200531101924,UnresolvedSpec.GenericEl,GetErrMsg(UnresolvedSpec));
     end;
 end;
 
@@ -6696,7 +6807,7 @@ begin
   if not ReadInteger(Obj,'Id',Id,GenEl) then
     RaiseMsg(20200531085133,GenEl);
   if not ReadString(Obj,'SpecName',SpecName,GenEl) then
-    RaiseMsg(20200531085133,GenEl);
+    RaiseMsg(20200531085134,GenEl);
 
   PendSpec:=PromiseSpecialize(Id,SpecName,nil,GenEl);
   PendSpec.Obj:=Obj;
@@ -6901,7 +7012,7 @@ begin
       RaiseMsg(20180313134142,Section,GetObjName(Section.PendingUsedIntf));
     if Arr.Count<>length(Section.UsesClause) then
       RaiseMsg(20180313134338,IntToStr(Arr.Count)+'<>'+IntToStr(length(Section.UsesClause)));
-      for i:=0 to Arr.Count-1 do
+    for i:=0 to Arr.Count-1 do
     begin
       Data:=Arr[i];
       if not (Data is TJSONObject) then
@@ -6918,15 +7029,7 @@ begin
     end;
 
   // read external refs from indirectly used units
-  if Section.ClassType=TInterfaceSection then
-    FIntfSectionObj:=Obj
-  else if Section.ClassType=TImplementationSection then
-    begin
-    ReadIndirectUsedUnits(FIntfSectionObj,Section,true);
-    ReadIndirectUsedUnits(Obj,Section,true);
-    end
-  else
-    ReadIndirectUsedUnits(Obj,Section,true);
+  ReadIndirectUsedUnits(Obj,Section,true);
 
   Scope.UsesFinished:=true;
 
@@ -8257,7 +8360,6 @@ var
   i: Integer;
   Data: TJSONData;
   SubObj: TJSONObject;
-  SubEl: TPasElement;
   aName: string;
 begin
   ReadPasExpr(Obj,Expr,pekListOfExp,aContext);
@@ -8270,13 +8372,10 @@ begin
       if not (Data is TJSONObject) then
         RaiseMsg(20180210173636,Expr,'['+IntToStr(i)+'] is '+GetObjName(Data));
       SubObj:=TJSONObject(Data);
-      if ReadString(SubObj,'Name',aName,Expr) then
-        Expr.Fields[i].Name:=aName;
-      SubEl:=ReadNewElement(SubObj,Expr);
-      if not (SubEl is TPasExpr) then
-        RaiseMsg(20180210174041,Expr,'['+IntToStr(i)+'] is '+GetObjName(SubEl));
-      Expr.Fields[i].ValueExp:=TPasExpr(SubEl);
-      ReadElement(SubObj,SubEl,aContext);
+      if not ReadString(SubObj,'Name',aName,Expr) then
+        RaiseMsg(20201204144308,Expr);
+      Expr.Fields[i].NameExp:=ReadExpr(SubObj,Expr,'NameExpr',aContext) as TPrimitiveExpr;
+      Expr.Fields[i].ValueExp:=ReadExpr(SubObj,Expr,'ValueExpr',aContext);
       end;
     end;
 end;
@@ -8366,16 +8465,22 @@ begin
     if El.Params[i]=nil then
       RaiseMsg(20200512232836,El,GetObjPath(El.DestType)+' Params['+IntToStr(i)+']=nil');
 
+  if not ReadInteger(Obj,'SpecType',SpecId,El) then
+    begin
+    if Obj.Find('SpecType')<>nil then
+      RaiseMsg(20201203092759,El,GetObjName(Obj.Find('SpecType')));
+    exit; // generic reference to a generic
+    end;
+
   // El.Data TPasSpecializeTypeData
   Data:=TPasSpecializeTypeData.Create;
   // add to free list
   Resolver.AddResolveData(El,Data,lkModule);
-  if not ReadInteger(Obj,'SpecType',SpecId,El) then
-    RaiseMsg(20200514130230,El,'SpecType');
+
   PromiseSetElReference(SpecId,@Set_SpecializeTypeData,Data,El);
 
   // check old specialized name
-  if not ReadString(Obj,'SpecName',SpecName,El) then
+  if not ReadString(Obj,'SpecTypeName',SpecName,El) then
     RaiseMsg(20200219122919,El);
   if SpecName='' then
     RaiseMsg(20200530134152,El);
@@ -8390,12 +8495,21 @@ end;
 
 procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext);
+var
+  Parent: TPasElement;
 begin
+  ReadPasElement(Obj,Expr,aContext);
   Expr.Kind:=pekSpecialize;
-  Expr.NameExpr:=ReadExpr(Obj,Expr,'Name',aContext);
-  ReadElementList(Obj,Expr,'Params',Expr.Params,
+  Expr.NameExpr:=ReadExpr(Obj,Expr,'ISEName',aContext);
+  ReadElementList(Obj,Expr,'ISEParams',Expr.Params,
     {$IFDEF CheckPasTreeRefCount}'TInlineSpecializeExpr.Params'{$ELSE}true{$ENDIF},
     aContext);
+  Parent:=Expr.Parent;
+  while Parent<>nil do
+    begin
+    if Parent is TProcedureBody then exit; // inside generic method -> ok
+    Parent:=Parent.Parent;
+    end;
   // ToDo: create specialized type
   RaiseMsg(20200512233430,Expr);
 end;
@@ -9377,12 +9491,15 @@ begin
     Scope.ClassRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope // no AddRef
   else
     ; // set via Set_ProcedureScope_ImplProc
-  // Scope.SelfArg only valid for method implementation
 
   Scope.Flags:=ReadProcScopeFlags(Obj,Proc,'SFlags',[]);
   Scope.BoolSwitches:=ReadBoolSwitches(Obj,Proc,'BoolSwitches',aContext.BoolSwitches);
   Scope.ModeSwitches:=ReadModeSwitches(Obj,Proc,'ModeSwitches',aContext.ModeSwitches);
 
+  // Scope.SelfArg
+  if (Scope.ClassRecScope<>nil) and (Scope.DeclarationProc=nil) then
+    Resolver.CreateProcSelfArg(Proc);
+
   //ReadIdentifierScope(Obj,Scope,aContext);
 end;
 
@@ -9513,17 +9630,6 @@ begin
 
     El.ProcType:=TPasProcedureType(CreateElement(TPasProcedureTypeClass(DeclProc.ProcType.ClassType),'',El));
     El.Modifiers:=ReadProcedureModifiers(Obj,El,'PMods',DeclProc.Modifiers*PCUProcedureModifiersImplProc);
-
-    if HasBody then
-      begin
-      // not a precompiled proc -> copy signature
-      //if El.ProcType is TPasFunctionType then
-      //  begin
-      //  FuncType:=TPasFunctionType(El.ProcType);
-      //  FuncType.ResultEl:=TPasResultElement(CreateElement(TPasResultElement,
-      //    TPasFunctionType(DeclProc.ProcType).ResultEl.Name,FuncType));
-      //  end;
-      end;
     end
   else
     begin
@@ -9556,6 +9662,7 @@ begin
       end;
     DefProcMods:=GetDefaultProcModifiers(El);
     El.Modifiers:=ReadProcedureModifiers(Obj,El,'PMods',DefProcMods);
+
     // read ProcType after El.Modifiers
     El.ProcType:=TPasProcedureType(ReadElementProperty(
                                  Obj,El,'ProcType',TPasProcedureType,aContext));

+ 2 - 2
packages/pastojs/src/pas2jslibcompiler.pp

@@ -143,7 +143,7 @@ begin
   Result:=Assigned(OnWriteJSCallBack);
   if Result then
     try
-      Src:=aWriter.{$IF FPC_FULLVERSION>30300}AsString{$ELSE}AsAnsistring{$ENDIF};
+      Src:=aWriter.{$IF FPC_FULLVERSION>30101}AsString{$ELSE}AsAnsistring{$ENDIF};
       OnWriteJSCallBack(OnWriteJSData,PAnsiChar(DestFileName),Length(DestFileName),PAnsiChar(Src),Length(Src));
     except
       Result:=False;
@@ -264,7 +264,7 @@ begin
       if Not Result then
         begin
         LastError:=Format('Compiler exited with exit code %d',[ExitCode]);
-        LastErrorClass:=ECompilerTerminate.ClassName;
+        LastErrorClass:='';
         end;
     except
       On E : Exception do

+ 24 - 0
packages/pastojs/tests/tcfiler.pas

@@ -233,6 +233,7 @@ type
     procedure TestPC_Constraints;
     // ToDo: constraints
     // ToDo: unit impl declarations used by generics
+    procedure TestPC_GenericClass_InlineSpecialize;
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -3530,6 +3531,29 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_GenericClass_InlineSpecialize;
+begin
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TBird<T: class> = class',
+  '  end;',
+  '  TEagle<T: class> = class(TBird<T>)',
+  '  type',
+  '    TMyEagle = TEagle<T>;',
+  '    function Fly(v: T): T;',
+  '  end;',
+  'implementation',
+  'function TEagle<T>.Fly(v: T): T;',
+  'begin',
+  '  TEagle<T>.Create;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',

+ 7 - 1
packages/winunits-base/src/comobj.pp

@@ -1381,7 +1381,13 @@ HKCR
           case InvokeKind of
             DISPATCH_PROPERTYPUT:
               begin
-                if (Arguments[0].VType and varTypeMask) = varDispatch then
+                if ((Arguments[0].VType and varTypeMask) in [varDispatch]) or
+                    { if we have a variant that's passed as a reference we pass it
+                      to the property as a reference as well }
+                    (
+                      ((Arguments[0].VType and varTypeMask) in [varVariant]) and
+                      ((CallDesc^.argtypes[0] and $80) <> 0)
+                    ) then
                   InvokeKind:=DISPATCH_PROPERTYPUTREF;
                 { first name is actually the name of the property to set }
                 DispIDs^[0]:=DISPID_PROPERTYPUT;

+ 35 - 0
tests/test/tgenfunc23.pp

@@ -0,0 +1,35 @@
+program tgenfunc;
+
+{$mode objfpc}
+
+var
+  TestTCalled: LongInt;
+  TestArrayOfTCalled: LongInt;
+
+generic procedure Test<T>(const aArg: T);
+begin
+  Inc(TestTCalled);
+end;
+
+generic procedure Test<T>(const aArg: array of T);
+var
+  i: SizeInt;
+begin
+  for i := 0 to High(aArg) do begin
+    specialize Test<T>(aArg[i]);
+  end;
+  Inc(TestArrayOfTCalled);
+end;
+
+begin
+  TestTCalled := 0;
+  TestArrayOfTCalled := 0;
+  specialize Test<LongInt>(1);
+  if TestTCalled <> 1 then
+    Halt(1);
+  specialize Test<LongInt>([1, 2, 3]);
+  if TestArrayOfTCalled <> 1 then
+    Halt(2);
+  if TestTCalled <> 4 then
+    Halt(3);
+end.

+ 312 - 0
tests/test/tminmax.pp

@@ -0,0 +1,312 @@
+{$mode objfpc}
+procedure TestSingle;
+
+  function Min1(a, b: Single): Single; inline;
+    begin
+      if a < b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max1(a, b: Single): Single; inline;
+    begin
+      if a > b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  function Min2(a, b: Single): Single; inline;
+    begin
+      if a <= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max2(a, b: Single): Single; inline;
+    begin
+      if a >= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  var
+    v1,v3 : Single;
+
+  begin
+    v1:=1;
+    v3:=3;
+    if Min1(1,3)<>1 then
+      halt(1);
+    if Max1(1,3)<>3 then
+      halt(2);
+    if Min2(1,3)<>1 then
+      halt(3);
+    if Max2(1,3)<>3 then
+      halt(4);
+    if Min1(1,v3)<>1 then
+      halt(11);
+    if Max1(1,v3)<>3 then
+      halt(12);
+    if Min2(1,v3)<>1 then
+      halt(13);
+    if Max2(1,v3)<>3 then
+      halt(14);
+    if Min1(1,v3)<>1 then
+      halt(21);
+    if Max1(1,v3)<>v3 then
+      halt(22);
+    if Min2(1,v3)<>1 then
+      halt(23);
+    if Max2(1,v3)<>v3 then
+      halt(24);
+    if Min1(v1,v3)<>v1 then
+      halt(31);
+    if Max1(v1,v3)<>v3 then
+      halt(32);
+    if Min2(v1,v3)<>v1 then
+      halt(33);
+    if Max2(v1,v3)<>v3 then
+      halt(34);
+  end;
+
+procedure TestDouble;
+
+  function Min1(a, b: Double): Double; inline;
+    begin
+      if a < b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max1(a, b: Double): Double; inline;
+    begin
+      if a > b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  function Min2(a, b: Double): Double; inline;
+    begin
+      if a <= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max2(a, b: Double): Double; inline;
+    begin
+      if a >= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  var
+    v1,v3 : Double;
+
+  begin
+    v1:=1;
+    v3:=3;
+    if Min1(1,3)<>1 then
+      halt(1);
+    if Max1(1,3)<>3 then
+      halt(2);
+    if Min2(1,3)<>1 then
+      halt(3);
+    if Max2(1,3)<>3 then
+      halt(4);
+    if Min1(1,v3)<>1 then
+      halt(111);
+    if Max1(1,v3)<>3 then
+      halt(112);
+    if Min2(1,v3)<>1 then
+      halt(113);
+    if Max2(1,v3)<>3 then
+      halt(114);
+    if Min1(1,v3)<>1 then
+      halt(121);
+    if Max1(1,v3)<>v3 then
+      halt(122);
+    if Min2(1,v3)<>1 then
+      halt(123);
+    if Max2(1,v3)<>v3 then
+      halt(124);
+    if Min1(v1,v3)<>v1 then
+      halt(131);
+    if Max1(v1,v3)<>v3 then
+      halt(132);
+    if Min2(v1,v3)<>v1 then
+      halt(133);
+    if Max2(v1,v3)<>v3 then
+      halt(134);
+  end;
+
+
+procedure TestDWord;
+
+  function Min1(a, b: DWord): DWord; inline;
+    begin
+      if a < b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max1(a, b: DWord): DWord; inline;
+    begin
+      if a > b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  function Min2(a, b: DWord): DWord; inline;
+    begin
+      if a <= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max2(a, b: DWord): DWord; inline;
+    begin
+      if a >= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  var
+    v1,v3 : DWord;
+
+  begin
+    v1:=1;
+    v3:=3;
+    if Min1(1,3)<>1 then
+      halt(1);
+    if Max1(1,3)<>3 then
+      halt(2);
+    if Min2(1,3)<>1 then
+      halt(3);
+    if Max2(1,3)<>3 then
+      halt(4);
+    if Min1(1,v3)<>1 then
+      halt(211);
+    if Max1(1,v3)<>3 then
+      halt(212);
+    if Min2(1,v3)<>1 then
+      halt(213);
+    if Max2(1,v3)<>3 then
+      halt(214);
+    if Min1(1,v3)<>1 then
+      halt(221);
+    if Max1(1,v3)<>v3 then
+      halt(222);
+    if Min2(1,v3)<>1 then
+      halt(223);
+    if Max2(1,v3)<>v3 then
+      halt(224);
+    if Min1(v1,v3)<>v1 then
+      halt(231);
+    if Max1(v1,v3)<>v3 then
+      halt(232);
+    if Min2(v1,v3)<>v1 then
+      halt(233);
+    if Max2(v1,v3)<>v3 then
+      halt(234);
+  end;
+
+procedure TestLongint;
+
+  function Min1(a, b: Longint): Longint; inline;
+    begin
+      if a < b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max1(a, b: Longint): Longint; inline;
+    begin
+      if a > b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  function Min2(a, b: Longint): Longint; inline;
+    begin
+      if a <= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+
+  function Max2(a, b: Longint): Longint; inline;
+    begin
+      if a >= b then
+        Result := a
+      else
+        Result := b;
+    end;
+
+  var
+    v1,v3 : Longint;
+
+  begin
+    v1:=1;
+    v3:=3;
+    if Min1(1,3)<>1 then
+      halt(1);
+    if Max1(1,3)<>3 then
+      halt(2);
+    if Min2(1,3)<>1 then
+      halt(3);
+    if Max2(1,3)<>3 then
+      halt(4);
+    if Min1(1,v3)<>1 then
+      halt(311);
+    if Max1(1,v3)<>3 then
+      halt(312);
+    if Min2(1,v3)<>1 then
+      halt(313);
+    if Max2(1,v3)<>3 then
+      halt(314);
+    if Min1(1,v3)<>1 then
+      halt(321);
+    if Max1(1,v3)<>v3 then
+      halt(322);
+    if Min2(1,v3)<>1 then
+      halt(323);
+    if Max2(1,v3)<>v3 then
+      halt(324);
+    v1:=1;
+    if Min1(v1,v3)<>v1 then
+      halt(331);
+    if Max1(v1,v3)<>v3 then
+      halt(332);
+    if Min2(v1,v3)<>v1 then
+      halt(333);
+    if Max2(v1,v3)<>v3 then
+      halt(334);
+  end;
+
+begin
+  TestSingle;
+  TestDWord;
+  TestLongint;
+end.

+ 37 - 0
tests/webtbs/tw38151.pp

@@ -0,0 +1,37 @@
+{ %TARGET = win32,win64,wince }
+
+program tw38151;
+
+{$mode objfpc}{$H+}
+
+uses
+  ActiveX, ComObj, Variants;
+
+procedure TestVoice;
+var
+  SpVoice, SpVoicesList, Voice: Variant;
+begin
+  CoInitialize(Nil);
+  try
+    SpVoice := CreateOleObject('SAPI.SpVoice');
+    if VarIsNull(SpVoice) or VarIsEmpty(SpVoice) then
+      Exit;
+    SpVoicesList := SpVoice.GetVoices();
+    if VarIsNull(SpVoicesList) or VarIsEmpty(SpVoicesList) then
+      Exit;
+    if SpVoicesList.Count = 0 then
+      Exit;
+    SpVoice.Voice := SpVoicesList.Item(0);
+    Voice := SpVoicesList.Item(0);
+    SpVoice.Voice := Voice;
+  finally
+    VarClear(Voice);
+    VarClear(SpVoicesList);
+    VarClear(SpVoice);
+    CoUninitialize;
+  end;
+end;
+
+begin
+  TestVoice;
+end.

+ 139 - 124
utils/fpdoc/dglobals.pp

@@ -36,9 +36,12 @@ Var
 resourcestring
   // Output strings
   SDocPackageTitle           = 'Reference for package ''%s''';
+  SDocPackageMenuTitle       = 'Package ''%s''';
+  SDocPackageLinkTitle       = 'Package';
   SDocPrograms               = 'Programs';
   SDocUnits                  = 'Units';
   SDocUnitTitle              = 'Reference for unit ''%s''';
+  SDocUnitMenuTitle          = 'Unit ''%s''';
   SDocInheritanceHierarchy   = 'Inheritance Hierarchy';
   SDocInterfaceSection       = 'Interface section';
   SDocImplementationSection  = 'Implementation section';
@@ -205,7 +208,9 @@ resourcestring
 Const
   SVisibility: array[TPasMemberVisibility] of string =
        ('Default', 'Private', 'Protected', 'Public',
-       'Published', 'Automated','Strict Private','Strict Protected','Required','Optional');
+       'Published', 'Automated','Strict Private','Strict Protected',
+       'Required', 'Optional' // ObjCClass
+       );
 
 type
   TBufType = Array[1..ContentBufSize-1] of byte;
@@ -319,9 +324,9 @@ type
     FAlwaysVisible : TStringList;
     DescrDocs: TObjectList;             // List of XML documents
     DescrDocNames: TStringList;         // Names of the XML documents
-    FRootLinkNode: TLinkNode;
-    FRootDocNode: TDocNode;
-    FPackages: TFPList;                   // List of TFPPackage objects
+    FRootLinkNode: TLinkNode;           // Global tree of TlinkNode from the imported .xct files
+    FRootDocNode: TDocNode;             // Global tree of TDocNode from the .xml documentation files
+    FPackages: TFPList;                 // Global list of TPasPackage objects and full tree of sources
     CurModule: TPasModule;
     CurPackageDocNode: TDocNode;
     function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual;
@@ -338,13 +343,16 @@ type
     constructor Create;
     destructor Destroy; override;
     procedure SetPackageName(const APackageName: String);
+    // process the import objects from external .xct file
     procedure ReadContentFile(const AFilename, ALinkPrefix: String);
+    // creation of an own .xct output file
     procedure WriteContentFile(const AFilename: String);
 
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility: TPasMemberVisibility;
       const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
       override;
+    function FindInModule(const AName: String ; AModule: TPasModule): TPasElement;
     function FindElement(const AName: String): TPasElement; override;
     function FindModule(const AName: String): TPasModule; override;
     Function HintsToStr(Hints : TPasMemberHints) : String;
@@ -660,7 +668,9 @@ end;
 procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
 var
   f: Text;
-  inheritanceinfo : TStringlist;
+  inheritanceinfo : TStringlist; // contents list of TPasClass with inheritance info
+                                 // like this #PackageName.ModuleName.ClassName
+  tmpLinkPrefix : string;
 
   procedure ReadLinkTree;
   var
@@ -708,8 +718,10 @@ var
       i := ThisSpaces + 1;
       while s[i] <> ' ' do
         Inc(i);
+      if ALinkPrefix <> '' then
+        tmpLinkPrefix := ExcludeTrailingPathDelimiter(ALinkPrefix)+'/';
       NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
-        ALinkPrefix + Copy(s, i + 1, Length(s)));
+        tmpLinkPrefix + Copy(s, i + 1, Length(s)));
       if pos(' ',newnode.link)>0 then
         writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"');
       if Assigned(PrevSibling) then
@@ -721,56 +733,57 @@ var
   end;
 
   function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String;
-    var
-      DotPos, DotPos2, i: Integer;
-      s: String;
-      HPackage: TPasPackage;
+  var
+    DotPos, DotPos2, i: Integer;
+    s: String;
+    HPackage: TPasPackage;
 
-    begin
-      pkg:=nil; module:=nil; result:='';
-
-      // Find or create package
-      DotPos := Pos('.', AName);
-      s := Copy(AName, 1, DotPos - 1);
-      HPackage := nil;
-      for i := 0 to FPackages.Count - 1 do
-        if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
-        begin
-          HPackage := TPasPackage(FPackages[i]);
-          break;
-        end;
-      if not Assigned(HPackage) then
+  begin
+    pkg:=nil; module:=nil; result:='';
+
+    // Find or create package
+    DotPos := Pos('.', AName);
+    s := Copy(AName, 1, DotPos - 1);
+    HPackage := nil;
+    for i := 0 to FPackages.Count - 1 do
+      if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
       begin
-        if not CreateNew then
-          exit;
-        HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
-          '', 0));
-        FPackages.Add(HPackage);
+        HPackage := TPasPackage(FPackages[i]);
+        break;
       end;
+    if not Assigned(HPackage) then
+    begin
+      if not CreateNew then
+        exit;
+      HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
+        '', 0));
+      FPackages.Add(HPackage);
+    end;
 
-      // Find or create module
-      DotPos2 := DotPos;
-      repeat
-        Inc(DotPos2);
-      until AName[DotPos2] = '.';
-      s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
-      Module := nil;
-      for i := 0 to HPackage.Modules.Count - 1 do
-        if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
-        begin
-          Module := TPasModule(HPackage.Modules[i]);
-          break;
-        end;
-      if not Assigned(Module) then
+    // Find or create module
+    DotPos2 := DotPos;
+    repeat
+      Inc(DotPos2);
+    until AName[DotPos2] = '.';
+    s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
+    Module := nil;
+    for i := 0 to HPackage.Modules.Count - 1 do
+      if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
       begin
-        if not CreateNew then
-          exit;
-        Module := TPasExternalModule.Create(s, HPackage);
-        Module.InterfaceSection := TInterfaceSection.Create('', Module);
-        HPackage.Modules.Add(Module);
+        Module := TPasModule(HPackage.Modules[i]);
+        break;
       end;
-     pkg:=hpackage;
-     result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
+    if not Assigned(Module) then
+    begin
+      if not CreateNew then
+        exit;
+      Module := TPasExternalModule.Create(s, HPackage);
+      Module.InterfaceSection := TInterfaceSection.Create('', Module);
+      Module.PackageName:= HPackage.Name;
+      HPackage.Modules.Add(Module);
+    end;
+    pkg:=hpackage;
+    result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
   end;
 
   function SearchInList(clslist:TFPList;s:string):TPasElement;
@@ -834,9 +847,9 @@ var
         InheritanceInfo.AddObject(Inheritancestr,result);
     end;
 
-   procedure splitalias(var instr:string;out outstr:string);
-   var i,j:integer;
-   begin 
+    procedure splitalias(var instr:string;out outstr:string);
+    var i,j:integer;
+    begin
      if length(instr)=0 then exit;
      instr:=trim(instr);
      i:=pos('(',instr);
@@ -848,10 +861,10 @@ var
         outstr:=copy(instr,i+1,j);
         delete(instr,i,j+2);
       end
-   end;
+    end;
 
-   Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
-   begin
+    Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
+    begin
      result:=TPasClassType(ResolveClassType(clname)); 
      if assigned(result) and not (cls=result) then  // save from tobject=implicit tobject
        begin
@@ -870,47 +883,47 @@ var
      else
        if cls<>result then
          DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]);
-end;
+    end;
 
-function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
-// create alias clname =  alname
-var 
-  pkg     : TPasPackage;
-  module  : TPasModule; 
-  s       : string;  
-begin
-    Result:=nil;
-    s:=ResolvePackageModule(Alname,pkg,module,True);
-    if not assigned(module) then
-      exit;
-    cl2:=TPasClassType(ResolveClassType(alname));
-    if assigned( cl2) and not (parentclass=cl2) then  
-      begin
-        result:=ResolveAliasType(clname);
-        if assigned(result) then
-          begin
-//            writeln('found alias ',clname,' (',s,') ',result.classname);  
-          end
-        else
+    function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
+    // create alias clname =  alname
+    var
+      pkg     : TPasPackage;
+      module  : TPasModule;
+      s       : string;
+    begin
+        Result:=nil;
+        s:=ResolvePackageModule(Alname,pkg,module,True);
+        if not assigned(module) then
+          exit;
+        cl2:=TPasClassType(ResolveClassType(alname));
+        if assigned( cl2) and not (parentclass=cl2) then  
           begin
-//            writeln('new alias ',clname,' (',s,') ');
-            cl2.addref;
-            Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
-            module.interfacesection.Declarations.Add(Result);
-            TPasAliasType(Result).DestType := cl2;
+            result:=ResolveAliasType(clname);
+            if assigned(result) then
+              begin
+    //            writeln('found alias ',clname,' (',s,') ',result.classname);
+              end
+            else
+              begin
+    //            writeln('new alias ',clname,' (',s,') ');
+                cl2.addref;
+                Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
+                module.interfacesection.Declarations.Add(Result);
+                TPasAliasType(Result).DestType := cl2;
+              end
           end
-      end
-end;
+    end;
 
-   procedure ProcessInheritanceStrings(inhInfo:TStringList);
+    procedure ProcessInheritanceStrings(inhInfo:TStringList);
 
-   var i,j : integer;
-       cls : TPasClassType;  
+    var i,j : integer;
+       cls : TPasClassType;
        cls2: TPasClassType;
        clname,
        alname : string;
        inhclass   : TStringList;
-   begin
+    begin
      inhclass:=TStringList.Create;
      inhclass.delimiter:=',';
      if InhInfo.Count>0 then
@@ -922,12 +935,12 @@ end;
 
            for j:= 0 to inhclass.count-1 do
              begin
-               //writeln('processing',inhclass[j]);
+               // writeln('processing',inhclass[j]);
                clname:=inhclass[j];
-               splitalias(clname,alname);               
+               splitalias(clname,alname);
                if alname<>'' then // the class//interface we refered to is an alias
                  begin
-                   // writeln('Found alias pair ',clname,' = ',alname);   
+                   // writeln('Found alias pair ',clname,' = ',alname);
                    if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
                       DoLog('Warning: creating alias %s for %s failed!',[alname,clname]);
                  end 
@@ -936,7 +949,7 @@ end;
              end;
          end;
     inhclass.free;
-   end;
+    end;
 
   var
     s, Name: String;
@@ -993,10 +1006,10 @@ end;
           CurClass.Members.Add(Member);
         end;
       end;
-     ProcessInheritanceStrings(Inheritanceinfo);
+      ProcessInheritanceStrings(Inheritanceinfo);
     finally
-     inheritanceinfo.Free;
-     end;
+      inheritanceinfo.Free;
+    end;
   end;
 
 var
@@ -1044,11 +1057,13 @@ var
     end;
   end;
 
-  function CheckImplicitInterfaceLink(const s : String):String;
+  function CheckImplicitLink(const s : String):String;
   begin
-   if uppercase(s)='IUNKNOWN' then
+    if uppercase(s)='IUNKNOWN' then
      Result:='#rtl.System.IUnknown'
-   else 
+    else if uppercase(s)='TOBJECT' then
+     Result:='#rtl.System.TObject'
+   else
      Result:=s;
   end;
 var
@@ -1096,13 +1111,13 @@ begin
           ClassLikeDecl:=MemberDecl as TPasClassType
         else
           ClassLikeDecl:=nil;
-        Write(ContentFile, CheckImplicitInterfaceLink(MemberDecl.PathName), ' ');
+        Write(ContentFile, CheckImplicitLink(MemberDecl.PathName), ' ');
         if Assigned(ClassLikeDecl) then
           begin
           if Assigned(ClassLikeDecl.AncestorType) then
             begin
             // simple aliases to class types are coded as "alias(classtype)"
-            Write(ContentFile, CheckImplicitInterfaceLink(ClassLikeDecl.AncestorType.PathName));
+            Write(ContentFile, CheckImplicitLink(ClassLikeDecl.AncestorType.PathName));
             if ClassLikeDecl.AncestorType is TPasAliasType then
                begin
                alias:= TPasAliasType(ClassLikeDecl.AncestorType);
@@ -1118,12 +1133,12 @@ begin
             begin
             for k:=0 to ClassLikeDecl.Interfaces.count-1 do
               begin
-                write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
+                write(contentfile,',',CheckImplicitLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
                 if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then
                   begin
                     alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]);
                     if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
-                      write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');   
+                      write(ContentFile,'(',CheckImplicitLink(alias.desttype.PathName),')');
                   end;
               end;
             end;
@@ -1173,41 +1188,41 @@ begin
   Result.SourceLinenumber := ASourceLinenumber;
 end;
 
-function TFPDocEngine.FindElement(const AName: String): TPasElement;
+function TFPDocEngine.FindInModule ( const AName: String; AModule: TPasModule
+  ) : TPasElement;
+var
+  l: TFPList;
+  i: Integer;
 
-  function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
-  
-  var
-    l: TFPList;
-    i: Integer;
-    
-  begin
-    If assigned(AModule.InterfaceSection) and 
-       Assigned(AModule.InterfaceSection.Declarations) then
+begin
+  If Assigned(AModule) and Assigned(AModule.InterfaceSection) and
+     Assigned(AModule.InterfaceSection.Declarations) then
+    begin
+    l:=AModule.InterfaceSection.Declarations;
+    for i := 0 to l.Count - 1 do
       begin
-      l:=AModule.InterfaceSection.Declarations;
-      for i := 0 to l.Count - 1 do
-        begin
-        Result := TPasElement(l[i]);
-        if  CompareText(Result.Name, LocalName) = 0 then
-          exit;
-        end;
-      end;  
-    Result := nil;
- end;
+      Result := TPasElement(l[i]);
+      if CompareText(Result.Name, AName) = 0 then
+        exit;
+      end;
+    end;
+  Result := nil;
+end;
+
+function TFPDocEngine.FindElement(const AName: String): TPasElement;
 
 var
   i: Integer;
   Module: TPasElement;
 begin
-  Result := FindInModule(CurModule, AName);
+  Result := FindInModule( AName, CurModule );
   if not Assigned(Result) and assigned (CurModule.InterfaceSection) then
     for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
     begin
       Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
       if Module.ClassType.InheritsFrom(TPasModule) then
       begin
-        Result := FindInModule(TPasModule(Module), AName);
+        Result := FindInModule(AName, TPasModule(Module));
         if Assigned(Result) then
           exit;
       end;

+ 156 - 170
utils/fpdoc/dw_html.pp

@@ -15,7 +15,7 @@
 {$mode objfpc}
 {$H+}
 
-unit dw_HTML;
+unit dw_html;
 {$WARN 5024 off : Parameter "$1" not used}
 interface
 
@@ -75,9 +75,7 @@ type
   THTMLWriter = class(TFPDocWriter)
   private
     FImageFileList: TStrings;
-
     FOnTest: TNotifyEvent;
-    FPackage: TPasPackage;
     FCharSet : String;
     procedure CreateMinusImage;
     procedure CreatePlusImage;
@@ -233,7 +231,7 @@ type
     procedure CreatePackagePageBody;
     procedure CreatePackageIndex;
     procedure CreatePackageClassHierarchy;
-    procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean);
+    procedure CreateClassHierarchyPage(AddUnit : Boolean);
     procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
     Procedure CreateTopicPageBody(AElement : TTopicElement);
     procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
@@ -244,9 +242,9 @@ type
     procedure CreateVarPageBody(AVar: TPasVariable);
     procedure CreateProcPageBody(AProc: TPasProcedureBase);
     Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
-    procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
     procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
   public
+    // Creating all module hierarchy classes is here !!!!
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     destructor Destroy; override;
 
@@ -254,7 +252,7 @@ type
     function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
     function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
 
-    // For producing complete package documentation
+    // Start producing html complete package documentation
     procedure WriteHTMLPages; virtual;
     procedure WriteXHTMLPages;
     function  ModuleForElement(AnElement:TPasElement):TPasModule;
@@ -266,7 +264,7 @@ type
     Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
     Property SearchPage: String Read FSearchPage Write FSearchPage;
     property Allocator: TFileAllocator read FAllocator;
-    property Package: TPasPackage read FPackage;
+
     property PageCount: Integer read GetPageCount;
     Property IncludeDateInFooter : Boolean Read FIDF Write FIDF;
     Property DateFormat : String Read FDateFormat Write FDateFormat;
@@ -326,13 +324,20 @@ function TLongNameFileAllocator.GetFilename(AElement: TPasElement; ASubindex: In
 var
   n,s: String;
   i: Integer;
-
+  excl: Boolean; //search
 begin
   Result:='';
+  excl := False;
   if AElement.ClassType = TPasPackage then
-    Result := 'index'
+  begin
+    Result := 'index';
+    excl := True;
+  end
   else if AElement.ClassType = TPasModule then
-    Result := LowerCase(AElement.Name) + PathDelim + 'index'
+  begin
+    Result := LowerCase(AElement.Name) + PathDelim + 'index';
+    excl := True;
+  end
   else
   begin
     if AElement is TPasOperator then
@@ -361,8 +366,12 @@ begin
       if (N<>'') and  (N[1]=':') then
         Delete(N,1,1);
       Result:=Result + '-'+ s + '-' + N;
-    end else
+    end
+      else
+    begin
       Result := LowerCase(AElement.PathName);
+      excl := (ASubindex > 0);
+    end;
     // searching for TPasModule - it is on the 2nd level
     if Assigned(AElement.Parent) then
       while Assigned(AElement.Parent.Parent) do
@@ -375,6 +384,14 @@ begin
       Inc(i);
     if (i <= Length(Result)) and (i > 0) then
       Result[i] := PathDelim;
+    if excl or (Length(Result)=0) then
+      begin
+        // exclude the from full text search index
+        s:= '.'+ExtractFileName(Result + '.');
+        n:= ExtractFileDir(Result);
+        Result := n + DirectorySeparator + s;
+        Result := Copy(Result, 1, Length(Result)-1);
+      end;
   end;
 
   if ASubindex > 0 then
@@ -632,7 +649,7 @@ var
   H : Boolean;
 
 begin
-  inherited ;
+  inherited Create(APackage, AEngine);
 
   // should default to true since this is the old behavior
   UseMenuBrackets:=True;
@@ -640,7 +657,6 @@ begin
   IndexColCount:=3;
   Charset:='iso-8859-1';
   CreateAllocator;
-  FPackage := APackage;
   OutputNodeStack := TList.Create;
 
   PageInfos := TObjectList.Create;
@@ -716,6 +732,7 @@ begin
   HTMLEl.AppendChild(BodyElement);
 
   CreatePageBody(AElement, ASubpageIndex);
+
   AppendFooter;
 
   HeadEl.AppendChild(El);
@@ -771,6 +788,7 @@ begin
         Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
         try
           CreatePath(Filename);
+          //writeln('Element: ',Element.PathName, ' FileName: ', Filename);
           WriteHTMLFile(PageDoc, Filename);
         except
           on E: Exception do
@@ -1534,7 +1552,8 @@ begin
   end;
 end;
 
-Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode);
+procedure THTMLWriter.AppendShortDescr ( AContext: TPasElement;
+  Parent: TDOMNode; DocNode: TDocNode ) ;
 
 Var
   N : TDocNode;
@@ -2093,7 +2112,7 @@ end;
 procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
 
 var
-  TableEl, TREl, ParaEl, TitleEl: TDOMElement;
+  TableEl, TREl, TRE2, ParaEl, TitleEl: TDOMElement;
 
   procedure AddLink(ALinkSubpageIndex: Integer; const AName: String);
   begin
@@ -2132,8 +2151,34 @@ begin
   TableEl['border'] := '0';
   TableEl['width'] := '100%';
   TableEl['class'] := 'bar';
+  // Title Row
   TREl := CreateTR(TableEl);
-  ParaEl := CreateEl(CreateTD(TREl), 'b');
+  // Menu title
+  ParaEl := CreateTD(TREl);
+  ParaEl['align'] := 'left';
+  TitleEl := CreateEl(ParaEl, 'span');
+  TitleEl['class'] := 'bartitle';
+  if Assigned(Module) then
+    AppendText(TitleEl, Format(SDocUnitMenuTitle, [Module.Name]))
+  else
+    AppendText(TitleEl, Format(SDocPackageMenuTitle, [Package.Name]));
+
+  // Package link title
+  ParaEl := CreateTD(TREl);
+  ParaEl['align'] := 'right';
+  TitleEl := CreateEl(ParaEl, 'span');
+  TitleEl['class'] := 'bartitle';
+  if Assigned(Module) and Assigned(Package) then // Displays a Package page
+  begin
+    AppendText(TitleEl, SDocPackageLinkTitle);
+  end;
+
+  // Links Row
+  TRE2 := CreateTR(TableEl);
+  ParaEl := CreateTD(TRE2);
+  ParaEl['align'] := 'left';
+  ParaEl := CreateEl(ParaEl, 'span');
+  ParaEl['class']:= 'bartitle';
 
   if Assigned(Module) then
     begin
@@ -2150,12 +2195,18 @@ begin
       AddLink(ProcsSubindex, SDocProceduresAndFunctions);
     if Module.InterfaceSection.Variables.Count > 0 then
       AddLink(VarsSubindex, SDocVariables);
-    AddLink(IndexSubIndex,SDocIdentifierIndex);  
+    AddLink(IndexSubIndex,SDocIdentifierIndex);
     AppendFragment(ParaEl, NavigatorHTML);
     end
   else
     begin
+    // Overview
+    AppendText(ParaEl, '[');
+    AppendHyperlink(ParaEl, Package).TextContent:= UTF8Decode(SDocOverview);
+    AppendText(ParaEl, ']');
+    //Index
     AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
+    // Class TObject tree
     AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
     AppendFragment(ParaEl, NavigatorHTML)
     end;
@@ -2168,17 +2219,16 @@ begin
     if FUseMenuBrackets then
       AppendText(ParaEl, ']');
   end;
-  ParaEl := CreateTD(TREl);
+
+  ParaEl := CreateTD(TRE2);
   ParaEl['align'] := 'right';
-  TitleEl := CreateEl(ParaEl, 'span');
-  TitleEl['class'] := 'bartitle';
-  if Assigned(Module) then
-    AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
-  if Assigned(Package) then
+  ParaEl := CreateEl(ParaEl, 'span');
+  ParaEl['class']:= 'bartitle';
+  if Assigned(Module) and Assigned(Package) then // Displays a Package page
   begin
-    AppendText(TitleEl, ' (');
-    AppendHyperlink(TitleEl, Package);
-    AppendText(TitleEl, ')');
+    AppendText(ParaEl, '[');
+    AppendHyperlink(ParaEl, Package);
+    AppendText(ParaEl, ']');
   end;
   AppendFragment(BodyElement,HeaderHTML);
 end;
@@ -2189,7 +2239,8 @@ begin
     [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
 end;
 
-Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
+procedure THTMLWriter.AppendSeeAlsoSection ( AElement: TPasElement;
+  DocNode: TDocNode ) ;
 
 var
   Node: TDOMNode;
@@ -2263,7 +2314,8 @@ begin
      end; // While
 end;
 
-Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
+procedure THTMLWriter.AppendExampleSection ( AElement: TPasElement;
+  DocNode: TDocNode ) ;
 
 var
   Node: TDOMNode;
@@ -2384,10 +2436,11 @@ begin
     end;
 end;
 
-procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean);
+procedure THTMLWriter.CreateClassHierarchyPage(AddUnit : Boolean);
+type
+  TypeEN = (NPackage, NModule, NName);
 
   Procedure PushClassElement;
-
   Var
     H : THTMLElement;
   begin
@@ -2403,7 +2456,6 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
   end;
 
   Procedure PushClassList;
-
   Var
     H : THTMLElement;
   begin
@@ -2412,32 +2464,39 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
     PushOutputNode(h);
   end;
 
-  Procedure AppendClass(E : TPasElementNode);
+  function ExtractName(APathName: String; Tp: TypeEN):String;
+  var
+  l:TStringList;
+  begin
+    Result:= Trim(APathName);
+    if Result = '' then exit;
+    l:=TStringList.Create;
+    try
+      l.AddDelimitedText(Result, '.', True);
+      if l.Count=3 then
+        Result:= l.Strings[Integer(Tp)]
+      else
+        Result:='';
+    finally
+      l.free;
+    end;
+  end;
+
+  Procedure AppendClass(EN : TPasElementNode);
 
   Var
-    N : TDomNode;
-    P,PM,M : TPasElement;
-    EN : String;
-    LL : TstringList;
-    I,J : Integer;
+    PE,PM : TPasElement;
+    I : Integer;
 
   begin
-    M:=E.Element.GetModule;
-    if (M<>Nil) then
-      EN:=Package.Name+'.'+UTF8Encode(M.Name)+'.'+UTF8Encode(E.Element.Name)
-    else
-      EN:=UTF8Encode(E.Element.Name);
-    J:=AList.IndexOf(EN);
-    If J<>-1 then
-      P:=AList.Objects[J] as TPasElement
-    else
-      P:=Engine.FindElement(EN);
+    if not Assigned(EN) then exit;
+    PE:=EN.Element;
     PushClassElement;
     try
-      if (P<>Nil) then
+      if (PE<>Nil) then
         begin
-        AppendHyperLink(CurOutputNode,P);
-        PM:=ModuleForElement(P);
+        AppendHyperLink(CurOutputNode,PE);
+        PM:=ModuleForElement(PE);
         if (PM<>Nil) then
           begin
           AppendText(CurOutputNode,' (');
@@ -2446,13 +2505,13 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
           end
         end
       else
-        AppendText(CurOutputNode,E.Element.Name);
-      if E.ChildCount>0 then
+        AppendText(CurOutputNode,EN.Element.Name);
+      if EN.ChildCount>0 then
         begin
         PushClassList;
         try
-          For I:=0 to E.ChildCount-1 do
-            AppendClass(E.Children[i] as TPasElementNode);
+          For I:=0 to EN.ChildCount-1 do
+            AppendClass(EN.Children[i] as TPasElementNode);
         finally
           PopOutputNode;
         end;
@@ -2462,29 +2521,12 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
     end;
   end;
 
-Var
-  B : TClassTreeBuilder;
-  E : TPasElementNode;
-
 begin
   PushOutputNode(BodyElement);
   try
-    B:=TClassTreeBuilder.Create(Package,okClass);
-    try
-      B.BuildTree(AList);
-      // Classes
-      // WriteXMLFile(B.ClassTree,'tree.xml');
-      // Dummy TObject
-      E:=B.RootNode;
-      PushClassList;
-      try
-        AppendClass(E);
-      finally
-        PopOutputNode;
-      end;
-    finally
-      B.Free;
-    end;
+    PushClassList;
+    AppendClass(TreeClass.RootNode);
+    //PopOutputNode;
   finally
     PopOutputNode;
   end;
@@ -2500,9 +2542,6 @@ Const
           '}';
 
 Var
-  L : TStringList;
-  I : Integer;
-  M : TPasModule;
   S : String;
   SE : THTMLElement;
 
@@ -2510,24 +2549,12 @@ begin
   SE := Doc.CreateElement('script');
   AppendText(SE,SFunc);
   HeadElement.AppendChild(SE);
-  L:=TStringList.Create;
-  try
-    L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
-    For I:=0 to Package.Modules.Count-1 do
-      begin
-      M:=TPasModule(Package.Modules[i]);
-      if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
-        Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
-      end;
-    AppendMenuBar(ClassHierarchySubIndex);
-    S:=Package.Name;
-    If Length(S)>0 then
-      Delete(S,1,1);
-    AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
-    CreateClassHierarchyPage(L,True);
-  Finally
-    L.Free;
-  end;
+  AppendMenuBar(ClassHierarchySubIndex);
+  S:=Package.Name;
+  If Length(S)>0 then
+    Delete(S,1,1);
+  AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
+  CreateClassHierarchyPage(True);
 end;
 
 procedure THTMLWriter.CreatePageBody(AElement: TPasElement;
@@ -2673,29 +2700,6 @@ begin
   end;  
 end;
 
-Procedure THTMLWriter.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False);
-
-Var
-  I : Integer;
-  El : TPasElement;
-  N : TDocNode;
-
-begin
-  For I:=0 to List.Count-1 do
-    begin
-    El:=TPasElement(List[I]);
-    N:=Engine.FindDocNode(El);
-    if (N=Nil) or (not N.IsSkipped) then
-      begin
-      if UsePathName then
-        L.AddObject(El.PathName,El)
-      else
-        L.AddObject(El.Name,El);
-      If el is TPasEnumType then
-        AddElementsFromList(L,TPasEnumType(el).Values);
-      end;
-    end;
-end;
 
 procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
 
@@ -2783,7 +2787,8 @@ begin
     end;
 end;
 
-Procedure THTMLWriter.CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
+procedure THTMLWriter.CreateTopicLinks ( Node: TDocNode;
+  PasElement: TPasElement ) ;
 
 var
   DocNode: TDocNode;
@@ -3351,10 +3356,9 @@ var
     i: Integer;
     ThisInterface,
     ThisClass: TPasClassType;
-    HaveSeenTObject: Boolean;
-    LName     : String;
-    ThisNode  : TPasUnresolvedTypeRef;
+    ThisTreeNode: TPasElementNode;
   begin
+    //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
     AppendMenuBar(-1);
     AppendTitle(UTF8Decode(AClass.Name),AClass.Hints);
 
@@ -3398,28 +3402,29 @@ var
     end;
     CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
 
-
-
     AppendText(CreateH2(BodyElement), UTF8Decode(SDocInheritance));
     TableEl := CreateTable(BodyElement);
-    HaveSeenTObject := AClass.ObjKind <> okClass;
-    // we try to track classes. But imported classes
-    // are TLinkNode's not the TPasClassType generated by the parser.
-    ThisClass := AClass; ThisNode := Nil;
+
+    // Now we are using only TreeClass for show inheritance
+
+    ThisClass := AClass; ThisTreeNode := Nil;
+    if AClass.ObjKind = okInterface then
+      ThisTreeNode := TreeInterface.GetPasElNode(AClass)
+    else
+      ThisTreeNode := TreeClass.GetPasElNode(AClass);
     while True do
     begin
       TREl := CreateTR(TableEl);
       TDEl := CreateTD_vtop(TREl);
       TDEl['align'] := 'center';
       CodeEl := CreateCode(CreatePara(TDEl));
-      if Assigned(ThisClass) then
-        LName:=ThisClass.Name
-      Else
-        LName:=ThisNode.Name;
+
+      // Show class item
       if Assigned(ThisClass) Then
-        AppendHyperlink(CodeEl, ThisClass)
-      else
-        AppendHyperlink(CodeEl, ThisNode);
+        AppendHyperlink(CodeEl, ThisClass);
+      //else
+      //  AppendHyperlink(CodeEl, ThisTreeNode);
+      // Show links to class interfaces
       if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
         begin
           for i:=0 to ThisClass.interfaces.count-1 do
@@ -3429,48 +3434,28 @@ var
               AppendHyperlink(CodeEl, ThisInterface);
             end;
         end;
-      AppendShortDescrCell(TREl, ThisClass);
-      if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then
-        HaveSeenTObject := True
-      else
-      begin
-        TDEl := CreateTD(CreateTR(TableEl));
-        TDEl['align'] := 'center';
-        AppendText(TDEl, '|');
-      end;
+      // short class description
+      if Assigned(ThisClass) then
+            AppendShortDescrCell(TREl, ThisClass);
 
-      if Assigned(ThisClass.AncestorType) then
-      begin
-        if ThisClass.AncestorType.InheritsFrom(TPasClassType) then
-          ThisClass := TPasClassType(ThisClass.AncestorType)
-        else
+      if Assigned(ThisTreeNode) then
+        if Assigned(ThisTreeNode.ParentNode) then
         begin
-          if thisclass.ancestortype is TPasUnresolvedTypeRef then
-            thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype);
           TDEl := CreateTD(CreateTR(TableEl));
           TDEl['align'] := 'center';
-          AppendText(CreateCode(CreatePara(TDEl)), UTF8Decode(ThisClass.AncestorType.Name));
-          if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then
-            HaveSeenTObject := True
+          AppendText(TDEl, '|');
+          ThisClass := ThisTreeNode.ParentNode.Element;
+          ThisTreeNode := ThisTreeNode.ParentNode;
+        end
           else
-          begin
-            TDEl := CreateTD(CreateTR(TableEl));
-            TDEl['align'] := 'center';
-            AppendText(TDEl, '?');
-          end;
+        begin
+          ThisClass := nil;
+          ThisTreeNode:= nil;
           break;
         end
-      end else
+      else
         break;
     end;
-
-    if not HaveSeenTObject then
-    begin
-      TDEl := CreateTD(CreateTR(TableEl));
-      TDEl['align'] := 'center';
-      AppendText(CreateCode(CreatePara(TDEl)), 'TObject');
-    end;
-
     FinishElementPage(AClass);
   end;
 
@@ -3847,11 +3832,12 @@ begin
   FinishElementPage(AProc);
 end;
 
-Function THTMLWriter.InterPretOption(Const Cmd,Arg : String) : boolean;
+function THTMLWriter.InterPretOption ( const Cmd, Arg: String ) : boolean;
 
   Function ReadFile(aFileName : string) : TstringStream;
 
   begin
+    aFileName:= SetDirSeparators(aFileName);
     try
       if copy(aFileName,1,1)<>'@' then
         Result:=TStringStream.Create(aFileName)
@@ -3942,7 +3928,7 @@ begin
     end;
 end;
 
-Class Function THTMLWriter.FileNameExtension : String; 
+class function THTMLWriter.FileNameExtension: String;
 begin
   result:='';
 end;

+ 10 - 9
utils/fpdoc/dw_txt.pp

@@ -158,18 +158,19 @@ Function FindSpace(Const S : String; P : Integer) : Integer;
 
 Var
   I,L : Integer;
-
+  SP: set of char;
 begin
   Result:=0;
+  SP := [#10,#13,' ',#9];
   I:=P;
   L:=Length(S);
-  While (I>0) and (I<=L) and not (S[i] in [#10,#13,' ',#9]) do
-    Dec(i);
+  While (I>0) and (I<=L) and not (S[i] in SP) do
+    Dec(I);
   If (I=0) then
     begin
-    I:=P;
-    While (I<=L) and not (S[i] in [#10,#13,' ',#9]) do
-      Inc(i);
+    Inc(I);
+    While (I<=L) and not (S[I] in SP) do
+      Inc(I);
     end;
   Result:=I;
 end;
@@ -186,7 +187,7 @@ begin
     exit;
   N:=S;
   Repeat
-    If ((FCurrentPos+Length(N))>LineWidth) then
+    If ((FCurrentPos+Length(N)+1)>LineWidth) then
       begin
       L:=FindSpace(N,LineWidth-FCurrentPos+1);
       inherited Write(Copy(N,1,L-1));
@@ -195,8 +196,8 @@ begin
       end
     else
       begin
-      L:=Length(N)+1;
-      inherited Write(Copy(N,1,L-1));
+      L:=Length(N);
+      inherited Write(Copy(N,1,L));
       Inc(FCurrentPos,L);
       If FCheckEOL then
         If (L>=LEOL) then

+ 67 - 7
utils/fpdoc/dwriter.pp

@@ -25,7 +25,7 @@ unit dWriter;
 {$WARN 5024 off : Parameter "$1" not used}
 interface
 
-uses Classes, DOM, dGlobals, PasTree, SysUtils;
+uses Classes, DOM, dGlobals, PasTree, SysUtils, fpdocclasstree;
 
 resourcestring
   SErrFileWriting = 'An error occurred during writing of file "%s": %s';
@@ -80,8 +80,12 @@ type
     FImgExt : String;
     FBeforeEmitNote : TWriterNoteEvent;
     procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
-    
+    procedure CreateClassTree;
   protected
+    TreeClass: TClassTreeBuilder;      // Global class tree
+    TreeInterface: TClassTreeBuilder;  // Global interface tree
+
+    procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
     Procedure DoLog(Const Msg : String);
     Procedure DoLog(Const Fmt : String; Args : Array of const);
     procedure Warning(AContext: TPasElement; const AMsg: String);
@@ -339,7 +343,8 @@ end;
 
 
 }
-Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
+constructor TFPDocWriter.Create ( APackage: TPasPackage; AEngine: TFPDocEngine
+  ) ;
 
 begin
   inherited Create;
@@ -347,6 +352,9 @@ begin
   FPackage := APackage;
   FTopics:=Tlist.Create;
   FImgExt:='.png';
+  TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass);
+  TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface);
+  CreateClassTree;
 end;
 
 destructor TFPDocWriter.Destroy;
@@ -358,6 +366,8 @@ begin
   For I:=0 to FTopics.Count-1 do
     TTopicElement(FTopics[i]).Free;
   FTopics.Free;
+  TreeClass.free;
+  TreeInterface.Free;
   Inherited;
 end;
 
@@ -390,7 +400,7 @@ begin
     end;
 end;
 
-Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement;
+function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
 
 Var
   I : Integer;
@@ -713,6 +723,55 @@ begin
   DescrEndURL;
 end;
 
+procedure TFPDocWriter.AddElementsFromList ( L: TStrings; List: TFPList;
+  UsePathName: Boolean ) ;
+Var
+  I : Integer;
+  El : TPasElement;
+  N : TDocNode;
+
+begin
+  For I:=0 to List.Count-1 do
+    begin
+    El:=TPasElement(List[I]);
+    N:=Engine.FindDocNode(El);
+    if (N=Nil) or (not N.IsSkipped) then
+      begin
+      if UsePathName then
+        L.AddObject(El.PathName,El)
+      else
+        L.AddObject(El.Name,El);
+      If el is TPasEnumType then
+        AddElementsFromList(L,TPasEnumType(el).Values);
+      end;
+    end;
+end;
+
+procedure TFPDocWriter.CreateClassTree;
+var
+   L: TStringList;
+   M: TPasModule;
+   I:Integer;
+begin
+  L:=TStringList.Create;
+  try
+    For I:=0 to Package.Modules.Count-1 do
+      begin
+      M:=TPasModule(Package.Modules[i]);
+      if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
+        Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
+      end;
+      TreeClass.BuildTree(L);
+      TreeInterface.BuildTree(L);
+      {$IFDEF TREE_TEST}
+      TreeClass.SaveToXml('TreeClass.xml');
+      TreeInterface.SaveToXml('TreeInterface.xml');
+      {$ENDIF}
+  Finally
+    L.Free;
+  end;
+end;
+
 procedure TFPDocWriter.DoLog(const Msg: String);
 begin
   If Assigned(FEngine.OnLog) then
@@ -1126,7 +1185,7 @@ begin
     Result := False;
 end;
 
-Procedure TFPDocWriter.ConvertImage(El : TDomElement);
+procedure TFPDocWriter.ConvertImage ( El: TDomElement ) ;
 
 Var
   FN,Cap,LinkName : DOMString;
@@ -1169,7 +1228,7 @@ begin
   Inherited;
 end;
 
-Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode;
+function TFPDocWriter.WriteDescr ( Element: TPasElement ) : TDocNode;
 
 begin
   Result:=Engine.FindDocNode(Element);
@@ -1211,7 +1270,8 @@ begin
     Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
 end;
 
-Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList);
+procedure TFPDocWriter.GetMethodList ( ClassDecl: TPasClassType;
+  List: TStringList ) ;
 
 Var
   I : Integer;

+ 1 - 1
utils/fpdoc/fpclasschart.pp

@@ -447,7 +447,7 @@ Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPa
 
 begin
   FPackage:=TPasPackage.Create('dummy',Nil);
-  FTree:=TClassTreeBuilder.Create(FPackage,AObjectKind);
+  FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKind);
   FObjects:=TStringList.Create;
   Inherited Create;
 end;

+ 2 - 3
utils/fpdoc/fpdoc.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <General>
       <Flags>
         <SaveClosedFiles Value="False"/>
@@ -10,9 +10,9 @@
         <MainUnitHasTitleStatement Value="False"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="FPDoc Documentation generator"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
@@ -65,7 +65,6 @@
       <Unit3>
         <Filename Value="dw_html.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="dw_HTML"/>
       </Unit3>
       <Unit4>
         <Filename Value="dw_ipflin.pas"/>

+ 2 - 0
utils/fpdoc/fpdoc.pp

@@ -428,6 +428,8 @@ begin
 end;
 
 begin
+  //AssignFile(Output, 'fpdoc.log');
+  //rewrite(Output);
   With TFPDocApplication.Create(Nil) do
     try
       Run;

+ 106 - 23
utils/fpdoc/fpdocclasstree.pp

@@ -5,7 +5,7 @@ unit fpdocclasstree;
 interface
 
 uses
-  Classes, SysUtils, DOM, pastree, contnrs;
+  Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
 
 Type
 
@@ -13,16 +13,18 @@ Type
 
   TPasElementNode = Class
   Private
-    FElement : TPasElement;
+    FElement : TPasClassType;
+    FParentNode: TPasElementNode;
     FChildren : TFPObjectList;
     function GetChild(aIndex : Integer): TPasElementNode;
     function GetChildCount: Integer;
   Public
-    Constructor Create (aElement : TPaselement);
+    Constructor Create (aElement : TPasClassType);
     Destructor Destroy; override;
     Procedure AddChild(C : TPasElementNode);
     Procedure SortChildren;
-    Property Element : TPasElement Read FElement;
+    Property Element : TPasClassType Read FElement;
+    Property ParentNode : TPasElementNode read  FParentNode;
     Property Children [aIndex : Integer] : TPasElementNode Read GetChild;
     Property ChildCount : Integer Read GetChildCount;
   end;
@@ -31,20 +33,27 @@ Type
 
   TClassTreeBuilder = Class
   Private
-    // Full name -> TDomElement;
+    FEngine:TFPDocEngine;
     FElementList : TFPObjectHashTable;
     FObjectKind : TPasObjKind;
     FPackage: TPasPackage;
     FParentObject : TPasClassType;
     FRootNode : TPasElementNode;
     FRootObjectName : string;
+    FRootObjectPathName : string;
   Protected
     function AddToList(aElement: TPasClassType): TPasElementNode;
   Public
-    Constructor Create(APackage : TPasPackage; AObjectKind : TPasObjKind = okClass);
+    Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
+                          AObjectKind : TPasObjKind = okClass);
     Destructor Destroy; override;
     Function BuildTree(AObjects : TStringList) : Integer;
+{$IFDEF TREE_TEST}
+    Procedure SaveToXml(AFileName: String);
+{$ENDIF}
     Property RootNode : TPasElementNode Read FRootNode;
+    Property PasElToNodes: TFPObjectHashTable read FElementList;
+    function GetPasElNode (APasEl: TPasElement) : TPasElementNode;
   end;
 
 implementation
@@ -72,7 +81,7 @@ begin
     Result:=0
 end;
 
-constructor TPasElementNode.Create(aElement: TPaselement);
+constructor TPasElementNode.Create(aElement: TPasClassType);
 begin
   FElement:=aElement;
 end;
@@ -96,24 +105,38 @@ begin
     FChildren.Sort(@SortOnElementName);
 end;
 
-constructor TClassTreeBuilder.Create(APackage : TPasPackage;
+constructor TClassTreeBuilder.Create(AEngine:TFPDocEngine; APackage : TPasPackage;
   AObjectKind: TPasObjKind);
 
 begin
-  FPackage:=APAckage;
+  FEngine:= AEngine;
+  FPackage:= APAckage;
   FObjectKind:=AObjectKind;
   Case FObjectkind of
-    okInterface : FRootObjectName:='#rtl.System.IInterface';
-    okObject,
-    okClass    : FRootObjectName:='#rtl.System.TObject';
+    okInterface :
+      begin
+        FRootObjectPathName:='#rtl.System.IInterface';
+        FRootObjectName:= 'IInterface';
+      end;
+    okObject, okClass :
+      begin
+        FRootObjectPathName:='#rtl.System.TObject';
+        FRootObjectName:= 'TObject';
+      end
   else
-    FRootObjectName:='#rtl.System.TObject';
+    begin
+      FRootObjectPathName:='#rtl.System.TObject';
+      FRootObjectName:= 'TObject';
+    end;
   end;
-  FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
+  FParentObject:=TPasClassType.Create(FRootObjectName,FEngine.FindModule('System'));
+  if not Assigned(FParentObject) then
+    FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
   FParentObject.ObjKind:=FObjectKind;
   FRootNode:=TPasElementNode.Create(FParentObject);
+  FRootNode.FParentNode := nil;
   FElementList:=TFPObjectHashTable.Create(False);
-  FElementList.Add(FRootObjectName,FRootNode);
+  FElementList.Add(FRootObjectPathName,FRootNode);
 end;
 
 destructor TClassTreeBuilder.Destroy;
@@ -124,34 +147,37 @@ begin
   Inherited;
 end;
 
-Function TClassTreeBuilder.AddToList(aElement : TPasClassType) : TPasElementNode;
+function TClassTreeBuilder.AddToList ( aElement: TPasClassType
+  ) : TPasElementNode;
 
 Var
   aParentNode : TPasElementNode;
   aName : String;
 
 begin
+  Result:= nil;
+  if (aElement.ObjKind <> FObjectKind) then exit;
+  aParentNode:= nil;
   if aElement=Nil then
     aName:=FRootObjectName
   else
-    begin
     aName:=aElement.PathName;
-    end;
   Result:=TPasElementNode(FElementList.Items[aName]);
   if (Result=Nil) then
-    begin
+  begin
     if aElement.AncestorType is TPasClassType then
-      aParentNode:=AddToList(aElement.AncestorType as TPasClassType)
-    else
+      aParentNode:=AddToList(aElement.AncestorType as TPasClassType);
+    if not Assigned(aParentNode) then
       aParentNode:=FRootNode;
     Result:=TPasElementNode.Create(aElement);
     aParentNode.AddChild(Result);
+    Result.FParentNode := aParentNode;
     FElementList.Add(aName,Result);
-    end;
+  end;
 end;
 
 
-Function TClassTreeBuilder.BuildTree(AObjects : TStringList) : Integer;
+function TClassTreeBuilder.BuildTree ( AObjects: TStringList ) : Integer;
 
 (*
 Procedure DumpNode(Prefix : String; N : TPasElementNode);
@@ -182,7 +208,64 @@ begin
       end;
 end;
 
+function TClassTreeBuilder.GetPasElNode ( APasEl: TPasElement
+  ) : TPasElementNode;
+begin
+  Result:= TPasElementNode(FElementList.Items[APasEl.PathName]);
+end;
 
+{$IFDEF TREE_TEST}
+procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ;
+
+  procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ;
+  var
+    CounterVar: Integer;
+    PasElNode: TPasElementNode;
+    AXmlDoc: TDOMDocument;
+    xmlEl: TDOMElement;
+    M: TPasModule;
+  begin
+    if not Assigned(ParentPasEl) or (ParentPasEl.ChildCount = 0) then exit;
+    AXmlDoc:= ParentxmlEl.OwnerDocument;
+    for CounterVar := 0 to ParentPasEl.ChildCount-1 do
+    begin
+      PasElNode:= ParentPasEl.Children[CounterVar];
+      xmlEl:= AXmlDoc.CreateElement(UnicodeString(PasElNode.Element.Name));
+      M:= PasElNode.Element.GetModule;
+      xmlEl['unit'] := UnicodeString(M.Name);
+      xmlEl['package'] := UnicodeString(M.PackageName);
+      ParentxmlEl.AppendChild(xmlEl);
+      AddPasElChildsToXml(xmlEl, PasElNode);
+    end;
+  end;
+
+var
+  XmlDoc: TXMLDocument;
+  XmlRootEl: TDOMElement;
+  M: TPasModule;
+begin
+  XmlDoc:= TXMLDocument.Create;
+  try
+    XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
+    M:= FRootNode.Element.GetModule;
+    if Assigned(M) then
+    begin
+      XmlRootEl['unit'] := UnicodeString(M.Name);
+      XmlRootEl['package'] := UnicodeString(M.PackageName);
+    end
+      else
+    begin
+      XmlRootEl['unit'] := 'system';
+      XmlRootEl['package'] := 'rtl';
+    end;
+    XmlDoc.AppendChild(XmlRootEl);
+    AddPasElChildsToXml(XmlRootEl, FRootNode);
+    WriteXMLFile(XmlDoc, AFileName);
+  finally
+    XmlDoc.Free;
+  end;
+end;
+{$ENDIF}
 
 end.
 

+ 25 - 0
utils/fpdoc/mkfpdoc.pp

@@ -42,6 +42,8 @@ Type
     procedure SetVerbose(AValue: Boolean); virtual;
     Procedure DoLog(Const Msg : String);
     procedure DoLog(Const Fmt : String; Args : Array of Const);
+    Procedure DoLogSender(Sender : TObject; Const Msg : String);
+    // Create documetation by specified Writer class
     procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual;
   Public
     Constructor Create(AOwner : TComponent); override;
@@ -96,6 +98,14 @@ begin
   DoLog(Format(Fmt,Args));
 end;
 
+procedure TFPDocCreator.DoLogSender ( Sender: TObject; const Msg: String ) ;
+begin
+  if Assigned(Sender) then
+    DoLog(Format('%s - Sender: %s', [Msg, Sender.ClassName]))
+  else
+    DoLog(Msg);
+end;
+
 procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject;
   const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
 
@@ -208,7 +218,9 @@ Var
   Cmd,Arg : String;
 
 begin
+  // Now is used the specified writer
   WriterClass:=GetWriterClass(Options.Backend);
+  // ALL CONTENT CREATED HERE
   Writer:=WriterClass.Create(Engine.Package,Engine);
   With Writer do
     Try
@@ -225,10 +237,12 @@ begin
           If not InterPretOption(Cmd,Arg) then
             DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
           end;
+      // Output created Documentation
       WriteDoc;
     Finally
       Free;
     end;
+  // Output content files
   Writeln('Content file : ',APackage.ContentFile);
   if Length(APackage.ContentFile) > 0 then
     Engine.WriteContentFile(APackage.ContentFile);
@@ -247,16 +261,21 @@ begin
   Cmd:='';
   FCurPackage:=APackage;
   Engine:=TFPDocEngine.Create;
+  Engine.OnLog:= @DoLogSender;
   try
+    // get documentation Writer html, latex, and other
     WriterClass:=GetWriterClass(Options.Backend);
     For J:=0 to Apackage.Imports.Count-1 do
       begin
       Arg:=Apackage.Imports[j];
+      // conversion import FilePathes
       WriterClass.SplitImport(Arg,Cmd);
+      // create tree of imported objects
       Engine.ReadContentFile(Arg, Cmd);
       end;
     for i := 0 to APackage.Descriptions.Count - 1 do
       Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim);
+    // set engine options
     Engine.SetPackageName(APackage.Name);
     Engine.Output:=APackage.Output;
     Engine.OnLog:=Self.OnLog;
@@ -268,13 +287,18 @@ begin
     Engine.WarnNoNode:=Options.WarnNoNode;
     if Length(Options.Language) > 0 then
       TranslateDocStrings(Options.Language);
+    // scan the input source files
     for i := 0 to APackage.Inputs.Count - 1 do
       try
+        // get options from input packages
         SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
+        // make absolute filepath
         Cmd:=FixInputFile(Cmd);
         if FProcessedUnits.IndexOf(Cmd)=-1 then
           begin
           FProcessedUnits.Add(Cmd);
+          // Parce sources for OS Target
+          //WriteLn(Format('Parcing unit: %s', [ExtractFilenameOnly(Cmd)]));
           ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
           end;
       except
@@ -290,6 +314,7 @@ begin
     if Not ParseOnly then
       begin
       Engine.StartDocumenting;
+      // Create documentation
       CreateOutput(APackage,Engine);
       end;
   finally

+ 1 - 1
utils/pas2js/pas2js.pp

@@ -48,7 +48,7 @@ begin
       on E: Exception do
       begin
         {AllowWriteln}
-        writeln(E.Message);
+        writeln('Error: Unhandled exception '+E.ClassName+': '+E.Message);
         {AllowWriteln-}
         if ExitCode=0 then
           ExitCode:=ExitCodeErrorInternal;