* synchronized with trunk

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

.gitattributes

@@ -13983,6 +13983,7 @@ tests/test/cg/tderef.pp svneol=native#text/plain
 tests/test/cg/tdivz1.pp svneol=native#text/plain
 tests/test/cg/tdivz2.pp svneol=native#text/plain
 tests/test/cg/texit.pp svneol=native#text/plain
+tests/test/cg/texit2.pp svneol=native#text/plain
 tests/test/cg/tfor.pp svneol=native#text/plain
 tests/test/cg/tfor2.pp svneol=native#text/pascal
 tests/test/cg/tformfnc.pp svneol=native#text/plain
@@ -18638,10 +18639,12 @@ tests/webtbs/tw38069.pp svneol=native#text/pascal
 tests/webtbs/tw38074.pp svneol=native#text/pascal
 tests/webtbs/tw38083.pp svneol=native#text/pascal
 tests/webtbs/tw38122.pp svneol=native#text/pascal
+tests/webtbs/tw38122b.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/tw38202.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

compiler/m68k/aoptcpu.pas

@@ -40,6 +40,8 @@ unit aoptcpu;
 
         function TryToOptimizeMove(var p: tai): boolean;
         function MaybeRealConstOperSimplify(var p: tai): boolean;
+        function OptPass1LEA(var p: tai): Boolean;
+        function OptPass1MOVEM(var p: tai): Boolean;
 
         { outputs a debug message into the assembler file }
         procedure DebugMsg(const s: string; p: tai);
@@ -48,7 +50,8 @@ unit aoptcpu;
   Implementation
 
     uses
-      cutils, aasmcpu, cgutils, globals, verbose, cpuinfo, itcpugas;
+      cutils, aasmcpu, cgutils, globtype, globals, verbose, cpuinfo, itcpugas, procinfo, cpupi,
+      aoptutils;
 
 { Range check must be disabled explicitly as conversions between signed and unsigned
   32-bit values are done without explicit typecasts }
@@ -88,6 +91,32 @@ unit aoptcpu;
           end
       end;
 
+    function MatchInstruction(const instr: tai; const op: TAsmOp; const opsize: topsizes): boolean;
+      begin
+        result :=
+          (instr.typ = ait_instruction) and
+          (taicpu(instr).opcode = op) and
+          ((opsize = []) or (taicpu(instr).opsize in opsize));
+      end;
+
+    function MatchInstruction(const instr : tai;const ops : array of TAsmOp;
+     const opsize : topsizes) : boolean;
+      var
+        op : TAsmOp;
+      begin
+        result:=false;
+        for op in ops do
+          begin
+            if (instr.typ = ait_instruction) and
+               (taicpu(instr).opcode = op) and
+               ((opsize = []) or (taicpu(instr).opsize in opsize)) then
+               begin
+                 result:=true;
+                 exit;
+               end;
+          end;
+      end;
+
     function TCpuAsmOptimizer.MaybeRealConstOperSimplify(var p: tai): boolean;
       var
         tmpint64: int64;
@@ -195,7 +224,23 @@ unit aoptcpu;
     begin
       result:=false;
 
-      if GetNextInstruction(p,next) and 
+      if (taicpu(p).opcode=A_MOVE) and
+        GetNextInstruction(p,next) and
+        MatchInstruction(next,A_TST,[taicpu(p).opsize]) and
+        MatchOperand(taicpu(p).oper[1]^,taicpu(next).oper[0]^) and
+        { for movea, it won't work }
+        not((taicpu(p).oper[1]^.typ=top_reg) and isaddressregister(taicpu(p).oper[1]^.reg)) and
+        GetNextInstruction(next,next2) and
+        MatchInstruction(next2,[A_BXX,A_SXX],[S_NO]) and
+        (taicpu(next2).condition in [C_NE,C_EQ,C_PL,C_MI]) then
+        begin
+          DebugMsg('Optimizer: MOVE, TST, Jxx/Sxx to MOVE, Jxx',p);
+          asml.remove(next);
+          next.free;
+          result:=true;
+          exit;
+        end;
+      if GetNextInstruction(p,next) and
          (next.typ = ait_instruction) and
          (taicpu(next).opcode = taicpu(p).opcode) and
          (taicpu(p).opsize = taicpu(next).opsize) and
@@ -302,6 +347,79 @@ unit aoptcpu;
         end;
     end;
 
+  function TCpuAsmOptimizer.OptPass1LEA(var p: tai): Boolean;
+    var
+      next: tai;
+    begin
+      Result:=false;
+      { LEA (Ax),Ax is a NOP if src and dest reg is equal, so remove it. }
+      if not assigned(taicpu(p).oper[0]^.ref^.symbol) and
+         (((taicpu(p).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+         (taicpu(p).oper[0]^.ref^.index = NR_NO)) or
+         ((taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+         (taicpu(p).oper[0]^.ref^.base = NR_NO))) and
+         (taicpu(p).oper[0]^.ref^.offset = 0) then
+        begin
+          DebugMsg('Optimizer: LEA 0(Ax),Ax removed',p);
+          GetNextInstruction(p,next);
+          asml.remove(p);
+          p.free;
+          p:=next;
+          result:=true;
+          exit;
+        end;
+      if (taicpu(p).oper[1]^.reg=NR_A7) and
+        (taicpu(p).oper[0]^.ref^.base=NR_A7) and
+        (taicpu(p).oper[0]^.ref^.index=NR_NO) and
+        (taicpu(p).oper[0]^.ref^.symbol=nil) and
+        (taicpu(p).oper[0]^.ref^.direction=dir_none) and
+        GetNextInstruction(p,next) and
+        MatchInstruction(next,A_MOVEM,[S_L]) and
+        MatchOpType(taicpu(next),top_regset,top_ref) and
+        ((taicpu(p).oper[0]^.ref^.offset=-(PopCnt(Byte(taicpu(next).oper[0]^.dataregset))+PopCnt(Byte(taicpu(next).oper[0]^.addrregset)))*4)) and
+        (taicpu(next).oper[1]^.ref^.base=NR_A7) and
+        (taicpu(next).oper[1]^.ref^.index=NR_NO) and
+        (taicpu(next).oper[1]^.ref^.symbol=nil) and
+        (taicpu(next).oper[1]^.ref^.direction=dir_none) then
+        begin
+          DebugMsg('Optimizer: LEA, MOVE(M) to MOVE(M) predecremented',p);
+          taicpu(next).oper[1]^.ref^.direction:=dir_dec;
+          asml.remove(p);
+          p.free;
+          p:=next;
+          result:=true;
+          exit;
+        end;
+    end;
+
+  function TCpuAsmOptimizer.OptPass1MOVEM(var p: tai): Boolean;
+    var
+      next: tai;
+    begin
+      Result:=false;
+      if MatchOpType(taicpu(p),top_ref,top_regset) and
+        (taicpu(p).oper[0]^.ref^.base=NR_A7) and
+        (taicpu(p).oper[0]^.ref^.index=NR_NO) and
+        (taicpu(p).oper[0]^.ref^.symbol=nil) and
+        (taicpu(p).oper[0]^.ref^.direction=dir_none) and
+        GetNextInstruction(p,next) and
+        MatchInstruction(next,A_LEA,[S_L]) and
+        (taicpu(next).oper[1]^.reg=NR_A7) and
+        (taicpu(next).oper[0]^.ref^.base=NR_A7) and
+        (taicpu(next).oper[0]^.ref^.index=NR_NO) and
+        (taicpu(next).oper[0]^.ref^.symbol=nil) and
+        (taicpu(next).oper[0]^.ref^.direction=dir_none) and
+        ((taicpu(next).oper[0]^.ref^.offset=(PopCnt(Byte(taicpu(p).oper[1]^.dataregset))+PopCnt(Byte(taicpu(p).oper[1]^.addrregset)))*4)) then
+        begin
+          DebugMsg('Optimizer: MOVE(M), LEA to MOVE(M) postincremented',p);
+          taicpu(p).oper[0]^.ref^.direction:=dir_inc;
+          asml.remove(next);
+          next.free;
+          result:=true;
+          exit;
+        end;
+    end;
+
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
       next: tai;
@@ -316,22 +434,10 @@ unit aoptcpu;
             case taicpu(p).opcode of
               A_MOVE:
                 result:=TryToOptimizeMove(p);
-              { LEA (Ax),Ax is a NOP if src and dest reg is equal, so remove it. }
+              A_MOVEM:
+                result:=OptPass1MOVEM(p);
               A_LEA:
-                if not assigned(taicpu(p).oper[0]^.ref^.symbol) and
-                   (((taicpu(p).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
-                   (taicpu(p).oper[0]^.ref^.index = NR_NO)) or
-                   ((taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
-                   (taicpu(p).oper[0]^.ref^.base = NR_NO))) and
-                   (taicpu(p).oper[0]^.ref^.offset = 0) then
-                  begin
-                    DebugMsg('Optimizer: LEA 0(Ax),Ax removed',p);
-                    GetNextInstruction(p,next);
-                    asml.remove(p);
-                    p.free;
-                    p:=next;
-                    result:=true;
-                  end;
+                Result:=OptPass1LEA(p);
               { Address register sub/add can be replaced with ADDQ/SUBQ or LEA if the value is in the
                 SmallInt range, which is shorter to encode and faster to execute on most 68k }
               A_SUB,A_SUBA,A_ADD,A_ADDA:
@@ -386,6 +492,27 @@ unit aoptcpu;
                     taicpu(p).ops:=2;
                     result:=true;
                   end;
+              A_JSR:
+                begin
+                  if (cs_opt_level4 in current_settings.optimizerswitches) and
+                    GetNextInstruction(p,next) and
+                    MatchInstruction(next,A_RTS,[S_NO]) and
+                    { play safe: if any parameter is pushed on the stack, we cannot to this optimization
+                      as the bottom stack element might be a parameter and not the return address as it is expected
+                      after a call (which we simulate by a jmp)
+
+                      Actually, as in this case the stack pointer is no used as a frame pointer and
+                      there will be more instructions to restore the stack frame before jsr, so this
+                      is unlikedly to happen }
+                    (current_procinfo.maxpushedparasize=0) then
+                    begin
+                      DebugMsg('Optimizer: JSR, RTS to JMP',p);
+                      taicpu(p).opcode:=A_JMP;
+                      asml.remove(next);
+                      next.free;
+                      result:=true;
+                    end;
+                end;
               { CMP #0,<ea> equals to TST <ea>, just shorter and TST is more flexible anyway }
               A_CMP,A_CMPI:
                 if (taicpu(p).oper[0]^.typ = top_const) and

compiler/m68k/cgcpu.pas

@@ -1737,7 +1737,10 @@ unit cgcpu;
          srcrefp,dstrefp : treference;
          srcref,dstref : treference;
       begin
-         if (len = 1) or ((len in [2,4]) and (current_settings.cputype <> cpu_mc68000)) then
+         if (len = 1) or
+            ((len in [2,4]) and
+             not needs_unaligned(source.alignment,lentocgsize[len]) and
+             not needs_unaligned(dest.alignment,lentocgsize[len])) then
            begin
              //list.concat(tai_comment.create(strpnew('g_concatcopy: small')));
              a_load_ref_ref(list,lentocgsize[len],lentocgsize[len],source,dest);

compiler/m68k/cpubase.pas

@@ -67,13 +67,13 @@ unit cpubase;
       NR_SP = NR_A7;
 
       { Integer Super registers first and last }
-      first_int_imreg = RS_D7+1;
+      first_int_imreg = 8;
 
       { Float Super register first and last }
-      first_fpu_imreg     = RS_FP7+1;
+      first_fpu_imreg     = 8;
 
       { Integer Super registers first and last }
-      first_addr_imreg = RS_SP+1;
+      first_addr_imreg = 8;
 
       { MM Super register first and last }
       first_mm_supreg    = 0;
@@ -158,6 +158,8 @@ unit cpubase;
        { S_FX  = Extended type      }
        topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX,S_IQ);
 
+       TOpSizes = set of topsize;
+
 {*****************************************************************************
                                  Constants
 *****************************************************************************}

compiler/ncal.pas

@@ -4014,8 +4014,27 @@ implementation
 
               if methodpointer.nodetype<>typen then
                begin
-                  { Remove all postfix operators }
+                 { if the value a type helper works on is a derefentiation (before
+                   removing postix operators) we need to pass the original pointer
+                   as Self as the Self value might be changed by the helper }
+                 if is_objectpascal_helper(tdef(procdefinition.owner.defowner)) and
+                    not is_implicit_pointer_object_type(tobjectdef(procdefinition.owner.defowner).extendeddef) then
+                   begin
+                     hpt:=methodpointer;
+
+                     hpt:=actualtargetnode(@hpt)^;
+                     if hpt.nodetype=derefn then
+                       begin
+                         tmp:=tderefnode(hpt).left;
+                         tderefnode(hpt).left:=nil;
+                         methodpointer.free;
+                         methodpointer:=tmp;
+                       end;
+                   end;
+
                   hpt:=methodpointer;
+
+                  { Remove all postfix operators }
                   while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
                     hpt:=tunarynode(hpt).left;
 
@@ -4038,19 +4057,6 @@ implementation
                    e.g. class reference types account }
                  hpt:=actualtargetnode(@hpt)^;
 
-                 { if the value a type helper works on is a derefentiation we need to
-                   pass the original pointer as Self as the Self value might be
-                   changed by the helper }
-                 if is_objectpascal_helper(tdef(procdefinition.owner.defowner)) and
-                    not is_implicit_pointer_object_type(tobjectdef(procdefinition.owner.defowner).extendeddef) and
-                    (hpt.nodetype=derefn) then
-                   begin
-                     tmp:=tderefnode(hpt).left;
-                     tderefnode(hpt).left:=nil;
-                     methodpointer.free;
-                     methodpointer:=tmp;
-                   end;
-
                  { R.Init then R will be initialized by the constructor,
                    Also allow it for simple loads }
                  if (procdefinition.proctypeoption=potype_constructor) or
@@ -4232,11 +4238,11 @@ implementation
                                 (hpcurr.parasym.paraloc[callerside].location^.reference.offset>
                                  hp.parasym.paraloc[callerside].location^.reference.offset)) or
                                (paramanager.use_fixed_stack and
-                                (node_complexity(hpcurr)<node_complexity(hp))) then
+                                (node_complexity(hpcurr.left)<node_complexity(hp.left))) then
 {$elseif defined(jvm) or defined(wasm)}
                             if (hpcurr.parasym.paraloc[callerside].location^.reference.offset<hp.parasym.paraloc[callerside].location^.reference.offset) then
 {$else jvm}
-                            if (node_complexity(hpcurr)<node_complexity(hp)) then
+                            if (node_complexity(hpcurr.left)<node_complexity(hp.left)) then
 {$endif jvm}
                               break;
                           end;
@@ -4253,7 +4259,7 @@ implementation
                   LOC_REGISTER :
                     begin
                       if (hp.parasym.paraloc[callerside].location^.loc<>LOC_REFERENCE) and
-                         (node_complexity(hpcurr)>node_complexity(hp)) then
+                         (node_complexity(hpcurr.left)>node_complexity(hp.left)) then
                         break;
                     end;
                   else

compiler/ncgbas.pas

@@ -443,7 +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);
+            include(flowcontrol,fc_no_direct_exit);
           end;
 
         { do second pass on left node }
@@ -469,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,fc_block_with_exit]);
+            flowcontrol:=oldflowcontrol+(flowcontrol - [fc_exit,fc_no_direct_exit]);
           end;
       end;
 

compiler/ncgflw.pas

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

compiler/nflw.pas

@@ -1614,8 +1614,10 @@ implementation
            (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
+            if ((left.nodetype in [gtn,gten]) and
+              tassignmentnode(thenstmnt).right.isequal(taddnode(left).left)) or
+              ((left.nodetype in [ltn,lten]) and
+              tassignmentnode(thenstmnt).right.isequal(taddnode(left).right)) then
               begin
                 if is_double(paratype) then
                   in_nr:=in_max_double
@@ -1637,9 +1639,14 @@ implementation
                 else if is_s32bitint(paratype) then
                   in_nr:=in_min_longint;
               end;
+            { for inline nodes, the first parameter is the last one in the linked list
+
+              Due to the defined behaviour for the min/max intrinsics that in case of a NaN
+              the second parameter is taken, we have to put the else part into the second parameter
+              thus pass it to the first callparanode call }
             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)))
+              cinlinenode.create(in_nr,false,ccallparanode.create(tassignmentnode(elsestmnt).right.getcopy,
+                    ccallparanode.create(tassignmentnode(thenstmnt).right.getcopy,nil)))
               );
           end;
 {$endif defined(i386) or defined(x86_64) or defined(xtensa)}

compiler/node.pas

@@ -896,7 +896,9 @@ implementation
                 first:=false;
               write(t, i);
             end;
-        write(t,'], cmplx = ',node_complexity(self));
+        write(t,']');
+        if (nf_pass1_done in flags) then
+          write(t,', cmplx = ',node_complexity(self));
       end;
 
 
@@ -941,8 +943,9 @@ implementation
               else
                 Write(T, ',', i)
             end;
-
-        write(t,'" complexity="',node_complexity(self),'"');
+        write(t,'"');
+        if (nf_pass1_done in flags) then
+          write(t,' complexity="',node_complexity(self),'"');
       end;
 
     procedure tnode.XMLPrintNodeData(var T: Text);

compiler/pass_2.pas

@@ -44,8 +44,9 @@ uses
          { the left side of an expression is already handled, so we are
            not allowed to do ssl }
          fc_lefthandled,
-         { in block which contains the exit statement }
-         fc_block_with_exit);
+         { in block where the exit statement jumps to an extra code instead of
+           immediately finishing execution of the current routine. }
+         fc_no_direct_exit);
 
        tflowcontrol = set of tenumflowcontrol;
 

compiler/pdecsub.pas

@@ -2241,7 +2241,8 @@ begin
     end;
 
   if consume_sym(sym,symtable) then
-    if (sym.typ=staticvarsym) and
+    if ((sym.typ=staticvarsym) or
+        (sym.typ=absolutevarsym) and (tabsolutevarsym(sym).abstyp=toaddr)) and
        ((tabstractvarsym(sym).vardef.typ=pointerdef) or
         is_32bitint(tabstractvarsym(sym).vardef)) then
       begin

compiler/psub.pas

@@ -927,6 +927,11 @@ implementation
         exitlabel_asmnode:=casmnode.create_get_position;
         temps_finalized:=false;
         bodyexitcode:=generate_bodyexit_block;
+        { Check if bodyexitcode is not empty }
+        with tstatementnode(tblocknode(bodyexitcode).statements) do
+          if (statement.nodetype<>nothingn) or assigned(next) then
+            { Indicate that the extra code is executed after the exit statement }
+            include(flowcontrol,fc_no_direct_exit);
 
         { Generate procedure by combining init+body+final,
           depending on the implicit finally we need to add

compiler/systems/t_amiga.pas

@@ -82,7 +82,7 @@ begin
      end
     else
      begin
-      ExeCmd[1]:='vlink -b amigahunk $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
+      ExeCmd[1]:='vlink -b amigahunk -e_start $MAP $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
      end;
    end;
 end;
@@ -97,7 +97,7 @@ begin
      end
     else
      begin
-      ExeCmd[1]:='vlink -q -n -b elf32amigaos -P_start -P__amigaos4__ -nostdlib $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
+      ExeCmd[1]:='vlink -q -n -b elf32amigaos -P_start -P__amigaos4__ -nostdlib $MAP $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
      end;
   end;
 end;
@@ -349,11 +349,15 @@ var
   StripStr: string[40];
   DynLinkStr : string;
   GCSectionsStr : string;
+  MapStr: string;
 begin
   StripStr:='';
   GCSectionsStr:='';
   DynLinkStr:='';
+  MapStr:='';
 
+  if UseVlink and (cs_link_map in current_settings.globalswitches) then
+    MapStr:='-M'+Unix2AmigaPath(maybequoted(ScriptFixFilename(current_module.mapfilename)));
   if (cs_link_strip in current_settings.globalswitches) then
     StripStr:='-s';
   if rlinkpath<>'' Then
@@ -370,6 +374,7 @@ begin
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$EXE',Unix2AmigaPath(maybequoted(ScriptFixFileName(current_module.exefilename))));
   Replace(cmdstr,'$RES',Unix2AmigaPath(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
+  Replace(cmdstr,'$MAP',MapStr);
   Replace(cmdstr,'$STRIP',StripStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);

compiler/utils/gppc386.pp

@@ -82,28 +82,51 @@ end;
 var
    fpcgdbini : text;
    CompilerName : String;
+   FullCompilerName : String;
+{$ifdef linux}
+   argv0 : pchar;
+{$endif}
    Dir,Name,Ext : ShortString;
    GDBError,GDBExitCode,i : longint;
 
 begin
 
   fsplit(paramstr(0),Dir,Name,Ext);
+{$ifdef linux}
+  argv0:=argv[0];
+  if (argv0 <> '') then
+    fsplit(argv0,Dir,Name,Ext);
+{$endif}
   if (length(Name)>3) and (UpCase(Name[1])='G') then
     CompilerName:=Copy(Name,2,255)+Ext
   else
-    CompilerName:=DefaultCompilerName;
+    begin
+      if (Name+ext = DefaultCompilerName) then
+        begin
+          writeln(stderr,'Avoiding infinite recursion with ',Name+Ext,' binary');
+          halt(1);
+        end;
+      CompilerName:=DefaultCompilerName;
+    end;
+
+  FullCompilerName:=filesearch(CompilerName,Dir+PathSep+GetEnvironmentVariable('PATH'));
+
+  if FullCompilerName='' then
+    begin
+      writeln(stderr,'Unable to find ',CompilerName,' binary');
+      halt(2);
+    end;
 
-  CompilerName:=filesearch(CompilerName,Dir+PathSep+GetEnvironmentVariable('PATH'));
 
   { support for info functions directly : used in makefiles }
   if (paramcount=1) and (pos('-i',Paramstr(1))=1) then
     begin
-      Exec(CompilerName,Paramstr(1));
+      Exec(FullCompilerName,Paramstr(1));
       exit;
     end;
 
   {$ifdef EXTDEBUG}
-  writeln(stderr,'Using compiler "',CompilerName,'"');
+  writeln(stderr,'Using compiler "',FullCompilerName,'"');
   flush(stderr);
   {$endif}
   if fsearch(GDBIniTempName,'.')<>'' then
@@ -166,6 +189,11 @@ begin
   if GDBExeName='' then
     GDBExeName:=filesearch(GDBAltExeName,Dir+PathSep+GetEnvironmentVariable('PATH'));
 
+  if GDBExeName='' then
+    begin
+      writeln('Unable to find ',GDBExeName,' and ',GDBAltExeName);
+      halt(3);
+    end;
   AdaptToGDB(CompilerName);
   AdaptToGDB(GDBIniTempName);
   {$ifdef EXTDEBUG}
@@ -173,7 +201,7 @@ begin
 {$ifdef win32}
     '--nw '+
 {$endif win32}
-    '--nx --command='+GDBIniTempName+' '+CompilerName);
+    '--nx --command='+GDBIniTempName+' '+FullCompilerName);
   flush(stderr);
   {$endif}
    DosError:=0;
@@ -181,7 +209,7 @@ begin
 {$ifdef win32}
     '--nw '+
 {$endif win32}
-    '--nx --command='+GDBIniTempName+' '+CompilerName);
+    '--nx --command='+GDBIniTempName+' '+FullCompilerName);
   GDBError:=DosError;
   GDBExitCode:=DosExitCode;
   if (GDBError<>0) or (GDBExitCode<>0) then

compiler/wasm32/rgcpu.pas

@@ -430,6 +430,12 @@ implementation
                       ra_alloc :
                         begin
                           ttgwasm(tg).allocLocalVarToRef(wbt, spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)]);
+                          {
+                          tg.gettemp(templist,
+                                   size,1,
+                                   tt_regallocator,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+
+                          }
                           (*wasmloc.
                           pidx := fidx;
                           idx := wasmloc.alloc(wbt);

packages/fcl-js/src/jswriter.pp

@@ -46,6 +46,7 @@ Type
     FCurElement: TJSElement;
     FCurLine: integer;
     FCurColumn: integer;
+    FLineBreak: string;
     FOnWriting: TTextWriterWriting;
   protected
     Function DoWrite(Const S : TJSWriterString) : Integer; virtual; abstract;
@@ -70,6 +71,7 @@ Type
     Property CurColumn: integer read FCurColumn write FCurColumn;// char index, not codepoint
     Property CurElement: TJSElement read FCurElement write SetCurElement;
     Property OnWriting: TTextWriterWriting read FOnWriting write FOnWriting;
+    Property LineBreak: string read FLineBreak write FLineBreak;
   end;
 
   {$ifdef HasFileWriter}
@@ -652,6 +654,15 @@ const
     p:=h;
   end;
 
+  function SkipToNextLineEnd(const S: TJSString; p: integer): integer;
+  var
+    l: SizeInt;
+  begin
+    l:=length(S);
+    while (p<=l) and not (S[p] in [#10,#13]) do inc(p);
+    Result:=p;
+  end;
+
   function SkipToNextLineStart(const S: TJSString; p: integer): integer;
   var
     l: Integer;
@@ -711,9 +722,11 @@ begin
     GetLineIndent(JS,p); // the first line is already indented, skip
     repeat
       StartP:=p;
-      p:=SkipToNextLineStart(JS,StartP);
+      p:=SkipToNextLineEnd(JS,StartP);
       Write(copy(JS,StartP,p-StartP));
       if p>length(JS) then break;
+      Write(sLineBreak);
+      p:=SkipToNextLineStart(JS,p);
       CurLineIndent:=GetLineIndent(JS,p);
       Write(StringOfChar(FIndentChar,FCurIndent+CurLineIndent-MinIndent));
     until false;
@@ -2017,6 +2030,7 @@ constructor TTextWriter.Create;
 begin
   FCurLine:=1;
   FCurColumn:=1;
+  FLineBreak:=sLineBreak;
 end;
 
 {$ifdef FPC_HAS_CPSTRING}
@@ -2085,7 +2099,7 @@ end;
 
 function TTextWriter.WriteLn(const S: TJSWriterString): Integer;
 begin
-  Result:=Write(S)+Write(sLineBreak);
+  Result:=Write(S)+Write(LineBreak);
 end;
 
 function TTextWriter.Write(const Fmt: TJSWriterString;

packages/fcl-net/src/cnetdb.pp

@@ -230,7 +230,7 @@ type
   PProtoEnt = ^TProtoEnt;
   PPProtoEnt = ^PProtoEnt;
 
-{$if defined(LINUX) or defined(OPENBSD)}
+{$if defined(LINUX) or defined(OPENBSD) or defined(DARWIN)}
 {$define FIRST_ADDR_THEN_CANONNAME}
 {$endif}
 {$if defined(FREEBSD) or defined(NETBSD) or defined(DRAGONFLY) or defined(SOLARIS) or defined(ANDROID)}

packages/fcl-passrc/src/pasresolver.pp

@@ -5830,7 +5830,8 @@ begin
     begin
     // unit
     FinishSection(CurModule.InterfaceSection);
-    FinishSection(CurModule.ImplementationSection);
+    if CurModule.ImplementationSection<>nil then
+      FinishSection(CurModule.ImplementationSection);
     if CurModule.FinalizationSection<>nil then
       // finalization section finished -> resolve
       ResolveImplBlock(CurModule.FinalizationSection);

packages/fcl-passrc/src/pastree.pp

@@ -120,7 +120,7 @@ type
                         ccMS_ABI_Default,ccMS_ABI_CDecl,
                         ccVectorCall);
   TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,
-                       ptmReferenceTo,ptmAsync,ptmFar);
+                       ptmReferenceTo,ptmAsync,ptmFar,ptmCblock);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -1770,7 +1770,7 @@ const
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'VectorCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs','reference to','async','far');
+      ('of Object', 'is nested','static','varargs','reference to','async','far','cblock');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1313,6 +1313,9 @@ begin
   UseElement(El,rraNone,true);
 
   UseAttributes(El);
+
+  if El.Parent is TPasMembersType then
+    UseTypeInfo(El.Parent);
 end;
 
 procedure TPasAnalyzer.UseAttributes(El: TPasElement);
@@ -2677,6 +2680,7 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
   {$ENDIF}
+  if Section=nil then exit;
   // initialization, program or library sections
   aModule:=Section.GetModule;
   UsesClause:=Section.UsesClause;

packages/fcl-passrc/src/pparser.pp

@@ -1403,6 +1403,11 @@ begin
     Result:=true;
     PTM:=ptmStatic;
     end
+  else if CompareText(S,ProcTypeModifiers[ptmCblock])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmCblock;
+    end
   else if (CompareText(S,ProcTypeModifiers[ptmAsync])=0) and (po_AsyncProcs in Options) then
     begin
     Result:=true;
@@ -4917,6 +4922,21 @@ end;
 
 // Starts after the opening bracket token
 procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
+
+  Function GetParamName : string;
+
+  begin
+    if ([msDelphi,msDelphiUnicode,msObjfpc]* CurrentModeswitches)<>[] then
+      Result := ExpectIdentifier
+    else
+      begin
+      NextToken;
+      if CurToken in [tkProperty,tkIdentifier,tkClass] then
+        Result:=CurTokenString
+      else
+        ParseExcTokenError('identifier')
+      end;
+  end;
 var
   IsUntyped, ok, LastHadDefaultValue: Boolean;
   Name : String;
@@ -4934,22 +4954,37 @@ begin
     IsUntyped := False;
     ArgType := nil;
     NextToken;
-    if CurToken = tkConst then
+    if CurToken = tkDotDotDot then
+    begin
+      expectToken(endToken);
+      Break;
+    end else  if CurToken = tkConst then
     begin
       Access := argConst;
-      Name := ExpectIdentifier;
+      Name := GetParamName;
     end else if CurToken = tkConstRef then
     begin
       Access := argConstref;
-      Name := ExpectIdentifier;
+      Name := getParamName;
     end else if CurToken = tkVar then
     begin
       Access := ArgVar;
-      Name := ExpectIdentifier;
+      Name:=GetParamName;
     end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then
     begin
-      Access := ArgOut;
-      Name := ExpectIdentifier;
+      if  ([msObjfpc, msDelphi, msDelphiUnicode, msOut] * CurrentModeswitches)<>[] then
+        begin
+        Access := ArgOut;
+        Name := ExpectIdentifier
+        end
+      else
+        Name := CurTokenString
+    end else if (CurToken = tkproperty) or (CurToken=tkClass) then
+      begin
+      if ([msDelphi,msDelphiUnicode,msObjfpc]* CurrentModeswitches)<>[] then
+        ParseExcTokenError('identifier')
+      else
+        Name := CurTokenString
     end else if CurToken = tkIdentifier then
       Name := CurTokenString
     else

packages/fcl-passrc/src/pscanner.pp

@@ -68,6 +68,7 @@ const
   nErrWrongSwitchToggle = 1032;
   nNoResourceSupport = 1033;
   nResourceFileNotFound = 1034;
+  nErrInvalidMultiLineLineEnding = 1035;
 
 // resourcestring patterns of messages
 resourcestring
@@ -107,6 +108,7 @@ resourcestring
   SInvalidDispatchFieldName = 'Invalid Dispatch field name';
   SErrWrongSwitchToggle = 'Wrong switch toggle, use ON/OFF or +/-';
   SNoResourceSupport = 'No support for resources of type "%s"';
+  SErrInvalidMultiLineLineEnding = 'Invalid multilinestring line ending type: use one of CR/LF/CRLF/SOURCE/PLATFORM' ;
 
 type
   TMessageType = (
@@ -162,6 +164,8 @@ type
     tkAssignMul,             // *=
     tkAssignDivision,        // /=
     tkAtAt,                  // @@
+    // Three-character tokens
+    tkDotDotDot,             // ... (mac mode)
     // Reserved words
     tkabsolute,
     tkand,
@@ -294,7 +298,8 @@ type
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
     msOmitRTTI,            { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
     msMultiHelpers,        { off=only one helper per type, on=all }
-    msImplicitFunctionSpec { implicit function specialization }
+    msImplicitFunctionSpec, { implicit function specialization }
+    msMultiLineStrings      { Multiline strings }
     );
   TModeSwitches = Set of TModeSwitch;
 
@@ -417,14 +422,18 @@ type
   end;
 
   { TLineReader }
+  TEOLStyle = (elPlatform,elSource,elLF,elCR,elCRLF);
 
   TLineReader = class
   Private
     FFilename: string;
+  Protected
+    EOLStyle : TEOLStyle;
   public
     constructor Create(const AFilename: string); virtual;
     function IsEOF: Boolean; virtual; abstract;
     function ReadLine: string; virtual; abstract;
+    function LastEOLStyle: TEOLStyle; virtual;
     property Filename: string read FFilename;
   end;
 
@@ -569,6 +578,11 @@ const
     '0', // false
     '1'  // true  Note: True is <>'0'
     );
+  MACDirectiveBool: array[boolean] of string = (
+    'FALSE', // false
+    'TRUE'  // true  Note: True is <>'0'
+    );
+
 type
   TMaxPrecInt = {$ifdef fpc}int64{$else}NativeInt{$endif};
   TMaxFloat = {$ifdef fpc}extended{$else}double{$endif};
@@ -628,11 +642,13 @@ type
     procedure Push(const AnOperand: String; OperandPosition: integer);
   public
     Expression: String;
+    MsgCurLine : Integer;
     MsgPos: integer;
     MsgNumber: integer;
     MsgType: TMessageType;
     MsgPattern: String; // Format parameter
-    constructor Create;
+    isMac : Boolean;
+    constructor Create(aIsMac : Boolean = False);
     destructor Destroy; override;
     function Eval(const Expr: string): boolean;
     property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
@@ -730,6 +746,8 @@ type
     FModuleRow: Integer;
     FMacros: TStrings; // Objects are TMacroDef
     FDefines: TStrings;
+    FMultilineLineFeedStyle: TEOLStyle;
+    FMultilineLineTrimLeft: Integer;
     FNonTokens: TTokens;
     FOnComment: TPScannerCommentEvent;
     FOnDirective: TPScannerDirectiveEvent;
@@ -794,17 +812,21 @@ type
     procedure Error(MsgNumber: integer; const Msg: string);overload;
     procedure Error(MsgNumber: integer; const Fmt: string; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});overload;
     procedure PushSkipMode;
+    function GetMultiLineStringLineEnd(aReader: TLineReader): string;
+
     function HandleDirective(const ADirectiveText: String): TToken; virtual;
     function HandleLetterDirective(Letter: char; Enable: boolean): TToken; virtual;
     procedure HandleBoolDirective(bs: TBoolSwitch; const Param: String); virtual;
     procedure DoHandleComment(Sender: TObject; const aComment : string); virtual;
     procedure DoHandleDirective(Sender: TObject; Directive, Param: String;
       var Handled: boolean); virtual;
+    procedure HandleMultilineStringTrimLeft(const AParam : String);
+    procedure HandleMultilineStringLineEnding(const AParam : string);
     procedure HandleIFDEF(const AParam: String);
     procedure HandleIFNDEF(const AParam: String);
     procedure HandleIFOPT(const AParam: String);
-    procedure HandleIF(const AParam: String);
-    procedure HandleELSEIF(const AParam: String);
+    procedure HandleIF(const AParam: String; aIsMac : Boolean);
+    procedure HandleELSEIF(const AParam: String; aIsMac : Boolean);
     procedure HandleELSE(const AParam: String);
     procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
@@ -812,6 +834,7 @@ type
     procedure HandleError(Param: String); virtual;
     procedure HandleMessageDirective(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
+    procedure HandleIncludeString(Param: String); virtual;
     procedure HandleResource(Param : string); virtual;
     procedure HandleOptimizations(Param : string); virtual;
     procedure DoHandleOptimization(OptName, OptValue: string); virtual;
@@ -828,6 +851,7 @@ type
     procedure PushStackItem; virtual;
     procedure PopStackItem; virtual;
     function DoFetchTextToken: TToken;
+    function DoFetchMultilineTextToken: TToken;
     function DoFetchToken: TToken;
     procedure ClearFiles;
     Procedure ClearMacros;
@@ -901,7 +925,8 @@ type
     property SkipGlobalSwitches: Boolean read FSkipGlobalSwitches write FSkipGlobalSwitches;
     property MaxIncludeStackDepth: integer read FMaxIncludeStackDepth write FMaxIncludeStackDepth default DefaultMaxIncludeStackDepth;
     property ForceCaret : Boolean read GetForceCaret;
-
+    Property MultilineLineFeedStyle : TEOLStyle Read FMultilineLineFeedStyle Write FMultilineLineFeedStyle;
+    Property MultilineLineTrimLeft : Integer Read FMultilineLineTrimLeft Write FMultilineLineTrimLeft;
     property LogEvents : TPScannerLogEvents read FLogEvents write FLogEvents;
     property OnLog : TPScannerLogHandler read FOnLog write FOnLog;
     property OnFormatPath: TPScannerFormatPathEvent read FOnFormatPath write FOnFormatPath;
@@ -960,6 +985,7 @@ const
     '*=',
     '/=',
     '@@',
+    '...',
     // Reserved words
     'absolute',
     'and',
@@ -1093,7 +1119,8 @@ const
     'PREFIXEDATTRIBUTES',
     'OMITRTTI',
     'MULTIHELPERS',
-    'IMPLICITFUNCTIONSPECIALIZATION'
+    'IMPLICITFUNCTIONSPECIALIZATION',
+    'MULTILINESTRINGS'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(
@@ -1461,12 +1488,16 @@ end;
 function TCondDirectiveEvaluator.IsFalse(const Value: String): boolean;
 begin
   Result:=Value=CondDirectiveBool[false];
+  if (not Result) and isMac then
+    Result:=Value=MacDirectiveBool[false];
 end;
 
 // inline
 function TCondDirectiveEvaluator.IsTrue(const Value: String): boolean;
 begin
   Result:=Value<>CondDirectiveBool[false];
+  if Result and isMac then
+    Result:=Value<>MacDirectiveBool[False];
 end;
 
 function TCondDirectiveEvaluator.IsInteger(const Value: String; out i: TMaxPrecInt
@@ -1786,7 +1817,7 @@ begin
     OnLog(Self,Args);
     if not (aMsgType in [mtError,mtFatal]) then exit;
     end;
-  raise EScannerError.CreateFmt(MsgPattern+' at '+IntToStr(MsgPos),Args);
+  raise EScannerError.CreateFmt(MsgPattern+' at pos '+IntToStr(MsgPos)+' line '+IntToStr(MsgCurLine),Args);
 end;
 
 procedure TCondDirectiveEvaluator.LogXExpectedButTokenFound(const X: String;
@@ -1810,6 +1841,12 @@ procedure TCondDirectiveEvaluator.ReadOperand(Skip: boolean);
    'Abc'
    (expression)
 }
+
+  Function IsMacNoArgFunction(aName : string) : Boolean;
+  begin
+    Result:=SameText(aName,'DEFINED') or SameText(aName,'UNDEFINED');
+  end;
+
 var
   i: TMaxPrecInt;
   e: extended;
@@ -1817,6 +1854,7 @@ var
   Code: integer;
   NameStartP: {$ifdef UsePChar}PChar{$else}integer{$endif};
   p, Lvl: integer;
+
 begin
   {$IFDEF VerbosePasDirectiveEval}
   writeln('TCondDirectiveEvaluator.ReadOperand START Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken,BoolToStr(Skip,' SKIP',''));
@@ -1886,7 +1924,9 @@ begin
     tkIdentifier:
       if Skip then
         begin
+        aName:=GetTokenString;
         NextToken;
+        // for macpas IFC we can have DEFINED A or DEFINED(A)...
         if FToken=tkBraceOpen then
           begin
           // only one parameter is supported
@@ -1896,6 +1936,10 @@ begin
           if FToken<>tkBraceClose then
             LogXExpectedButTokenFound(')');
           NextToken;
+          end
+        else if (IsMac and IsMacNoArgFunction(aName)) then
+          begin
+          NextToken;
           end;
         end
       else
@@ -1926,6 +1970,14 @@ begin
           Push(S,p);
           NextToken;
           end
+        else if (IsMac and IsMacNoArgFunction(aName)) then
+          begin
+          if FToken<>tkIdentifier then
+            LogXExpectedButTokenFound('identifier');
+          aName:=GetTokenString;
+          Push(CondDirectiveBool[OnEvalVariable(Self,aName,S)],p);
+          NextToken;
+          end
         else
           begin
           // variable
@@ -2289,9 +2341,9 @@ begin
   {$ENDIF}
 end;
 
-constructor TCondDirectiveEvaluator.Create;
+constructor TCondDirectiveEvaluator.Create(aIsMac: Boolean);
 begin
-
+  IsMac:=aIsMac
 end;
 
 destructor TCondDirectiveEvaluator.Destroy;
@@ -2315,6 +2367,9 @@ begin
   NextToken;
   ReadExpression;
   Result:=IsTrue(FStack[0].Operand);
+  {$IFDEF VerbosePasDirectiveEval}
+  Writeln('COND Eval: ', Expr,' -> ',Result);
+  {$ENDIF}
 end;
 
 { TMacroDef }
@@ -2330,6 +2385,17 @@ end;
 constructor TLineReader.Create(const AFilename: string);
 begin
   FFileName:=AFileName;
+  if LineEnding=#13 then
+    {%H-}EOLStyle:=elCR
+  else if LineEnding=#13#10 then
+    {%H-}EOLStyle:=elCRLF
+   else
+    EOLStyle:=elLF
+end;
+
+function TLineReader.LastEOLStyle: TEOLStyle;
+begin
+  Result:=EOLStyle;
 end;
 
 { ---------------------------------------------------------------------
@@ -2418,11 +2484,20 @@ begin
     EOL:=(FContent[FPos] in [#10,#13]);
   until isEOF or EOL;
   If EOL then
+    begin
+    if FContent[FPOS]=#10 then
+      EOLSTYLE:=elLF
+    else
+      EOLStyle:=elCR;
     Result:=Copy(FContent,LPos,FPos-LPos)
+    end
   else
     Result:=Copy(FContent,LPos,FPos-LPos+1);
   If (not isEOF) and (FContent[FPos]=#13) and (FContent[FPos+1]=#10) then
+    begin
     inc(FPos);
+    EOLStyle:=elCRLF;
+    end;
 end;
 
 { TFileStreamLineReader }
@@ -3007,7 +3082,7 @@ begin
       Result:=tkoperator;
 end;
 
-Procedure TPascalScanner.PopStackItem;
+procedure TPascalScanner.PopStackItem;
 
 var
   IncludeStackItem: TIncludeStackItem;
@@ -3262,6 +3337,167 @@ begin
     [FormatPath(CurFilename),CurRow,CurColumn,FLastMsg]);
 end;
 
+function TPascalScanner.GetMultiLineStringLineEnd(aReader : TLineReader) : string;
+
+Var
+  aLF : String;
+  aStyle: TEOLStyle;
+
+
+begin
+  aStyle:=MultilineLineFeedStyle;
+  if aStyle=elSource then
+    aStyle:=aReader.LastEOLStyle;
+  case aStyle of
+    elCR : aLF:=#13;
+    elCRLF : aLF:=#13#10;
+    elLF : aLF:=#10;
+    elPlatform : alf:=sLineBreak;
+  else
+    aLF:=#10;
+  end;
+  Result:=aLF;
+end;
+
+function TPascalScanner.DoFetchMultilineTextToken:TToken;
+
+var
+  StartPos,OldLength     : Integer;
+  TokenStart    : {$ifdef UsePChar}PChar{$else}integer{$endif};
+  {$ifndef UsePChar}
+  s: String;
+  l: integer;
+  {$endif}
+
+
+  Procedure AddToCurString(addLF : Boolean);
+  var
+    SectionLength,i : Integer;
+    aLF : String;
+
+  begin
+    i:=MultilineLineTrimLeft;
+    if I=-1 then
+      I:=StartPos+1;
+    if I>0 then
+      begin
+      While ({$ifdef UsePChar} TokenStart^{$ELSE}FCurLine[TokenStart]{$ENDIF} in [' ',#9]) and (TokenStart<=FTokenPos) and (I>0) do
+        begin
+        Inc(TokenStart);
+        Dec(I);
+        end;
+      end
+    else if I=-2 then
+      begin
+      While ({$ifdef UsePChar} TokenStart^{$ELSE}FCurLine[TokenStart]{$ENDIF} in [' ',#9]) and (TokenStart<=FTokenPos) do
+        Inc(TokenStart);
+      end;
+
+    SectionLength := FTokenPos - TokenStart+Ord(AddLF);
+    {$ifdef UsePChar}
+    SetLength(FCurTokenString, OldLength + SectionLength);
+    if SectionLength > 0 then
+      Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
+    {$else}
+    FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength);
+    {$endif}
+    if AddLF then
+      begin
+      alf:=GetMultiLineStringLineEnd(FCurSourceFile);
+      FCurTokenString:=FCurTokenString+aLF;
+      Inc(OldLength,Length(aLF));
+      end;
+    Inc(OldLength, SectionLength);
+  end;
+
+begin
+  Result:=tkEOF;
+  OldLength:=0;
+  FCurTokenString := '';
+  {$ifndef UsePChar}
+  s:=FCurLine;
+  l:=length(s);
+  StartPos:=FTokenPos;
+  {$ELSE}
+  StartPos:=FTokenPos-PChar(FCurLine);
+  {$endif}
+
+  repeat
+    {$ifndef UsePChar}
+    if FTokenPos>l then break;
+    {$endif}
+    case {$ifdef UsePChar}FTokenPos[0]{$else}s[FTokenPos]{$endif} of
+      '^' :
+        begin
+        TokenStart := FTokenPos;
+        Inc(FTokenPos);
+        if {$ifdef UsePChar}FTokenPos[0] in Letters{$else}(FTokenPos<l) and (s[FTokenPos] in Letters){$endif} then
+          Inc(FTokenPos);
+        if Result=tkEOF then Result := tkChar else Result:=tkString;
+        end;
+      '#':
+        begin
+        TokenStart := FTokenPos;
+        Inc(FTokenPos);
+        if {$ifdef UsePChar}FTokenPos[0]='$'{$else}(FTokenPos<l) and (s[FTokenPos]='$'){$endif} then
+        begin
+          Inc(FTokenPos);
+          repeat
+            Inc(FTokenPos);
+          until {$ifdef UsePChar}not (FTokenPos[0] in HexDigits){$else}(FTokenPos>l) or not (s[FTokenPos] in HexDigits){$endif};
+        end else
+          repeat
+            Inc(FTokenPos);
+          until {$ifdef UsePChar}not (FTokenPos[0] in Digits){$else}(FTokenPos>l) or not (s[FTokenPos] in Digits){$endif};
+        if Result=tkEOF then Result := tkChar else Result:=tkString;
+        end;
+      '`':
+        begin
+          TokenStart := FTokenPos;
+          Inc(FTokenPos);
+
+          while true do
+          begin
+            if {$ifdef UsePChar}FTokenPos[0] = '`'{$else}(FTokenPos<=l) and (s[FTokenPos]=''''){$endif} then
+              if {$ifdef UsePChar}FTokenPos[1] = '`'{$else}(FTokenPos<l) and (s[FTokenPos+1]=''''){$endif} then
+                Inc(FTokenPos)
+              else
+                break;
+
+            if {$ifdef UsePChar}FTokenPos[0] = #0{$else}FTokenPos>l{$endif} then
+              begin
+              FTokenPos:=FTokenPos-1;
+              AddToCurString(true);
+              // Writeln('Curtokenstring : >>',FCurTOkenString,'<<');
+              if not Self.FetchLine then
+                Error(nErrOpenString,SErrOpenString);
+              // Writeln('Current line is now : ',FCurLine);
+              {$ifndef UsePChar}
+              s:=FCurLine;
+              l:=length(s);
+              {$ELSE}
+              FTokenPos:=PChar(FCurLine);
+              {$endif}
+              TokenStart:=FTokenPos;
+              end
+            else
+              Inc(FTokenPos);
+          end;
+          Inc(FTokenPos);
+          Result := tkString;
+        end;
+    else
+      Break;
+    end;
+    AddToCurString(false);
+  until false;
+  if length(FCurTokenString)>1 then
+    begin
+    FCurTokenString[1]:='''';
+    FCurTokenString[Length(FCurTokenString)]:='''';
+    end;
+end;
+
 function TPascalScanner.DoFetchTextToken:TToken;
 var
   OldLength     : Integer;
@@ -3407,6 +3643,42 @@ begin
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(FCurFileName)],True);
 end;
 
+procedure TPascalScanner.HandleIncludeString(Param: String);
+
+var
+  NewSourceFile: TLineReader;
+  aString,aLine: string;
+
+begin
+  Param:=Trim(Param);
+  if Length(Param)>1 then
+    begin
+    if (Param[1]='''') then
+      begin
+      if Param[length(Param)]<>'''' then
+        Error(nErrOpenString,SErrOpenString,[]);
+      Param:=copy(Param,2,length(Param)-2);
+      end;
+    end;
+  NewSourceFile := FileResolver.FindIncludeFile(Param);
+  if not Assigned(NewSourceFile) then
+    Error(nErrIncludeFileNotFound, SErrIncludeFileNotFound, [Param]);
+  try
+    AString:='';
+    While not NewSourceFile.IsEOF Do
+      begin
+      ALine:=NewSourceFile.ReadLine;
+      if aString<>'' then
+        aString:=aString+GetMultiLineStringLineEnd(NewSourceFile);
+      AString:=aString+aLine;
+      end;
+  finally
+    NewSourceFile.Free;
+  end;
+  FCurTokenString:=''''+AString+'''';
+  FCurToken:=tkString;
+end;
+
 procedure TPascalScanner.HandleResource(Param: string);
 
 Var
@@ -3631,7 +3903,7 @@ begin
     MValue:=Trim(Param);
     MName:=Trim(Copy(MValue,1,Index-1));
     Delete(MValue,1,Index+1);
-    AddMacro(MName,MValue);
+    AddMacro(MName,Trim(MValue));
     end;
 end;
 
@@ -3964,7 +4236,7 @@ begin
     end;
 end;
 
-procedure TPascalScanner.HandleIF(const AParam: String);
+procedure TPascalScanner.HandleIF(const AParam: String; aIsMac: Boolean);
 
 begin
   PushSkipMode;
@@ -3972,6 +4244,8 @@ begin
     PPSkipMode := ppSkipAll
   else
     begin
+    ConditionEval.MsgCurLine:=CurTokenPos.Row;
+    ConditionEval.isMac:=aIsMac;
     if ConditionEval.Eval(AParam) then
       PPSkipMode := ppSkipElseBranch
     else
@@ -3987,12 +4261,13 @@ begin
     end;
 end;
 
-procedure TPascalScanner.HandleELSEIF(const AParam: String);
+procedure TPascalScanner.HandleELSEIF(const AParam: String; aIsMac : Boolean);
 begin
   if PPSkipStackIndex = 0 then
     Error(nErrInvalidPPElse,sErrInvalidPPElse);
   if PPSkipMode = ppSkipIfBranch then
     begin
+    ConditionEval.isMac:=aIsMac;
     if ConditionEval.Eval(AParam) then
       begin
       PPSkipMode := ppSkipElseBranch;
@@ -4058,7 +4333,11 @@ begin
   Result:=tkComment;
   P:=Pos(' ',ADirectiveText);
   If P=0 then
-    P:=Length(ADirectiveText)+1;
+    begin
+    P:=Pos(#9,ADirectiveText);
+    If P=0 then
+      P:=Length(ADirectiveText)+1;
+    end;
   Directive:=Copy(ADirectiveText,2,P-2); // 1 is $
   Param:=ADirectiveText;
   Delete(Param,1,P);
@@ -4073,12 +4352,16 @@ begin
      HandleIFNDEF(Param);
   'IFOPT':
      HandleIFOPT(Param);
+  'IFC',   
   'IF':
-     HandleIF(Param);
+     HandleIF(Param,UpperCase(Directive)='IFC');
+  'ELIFC',
   'ELSEIF':
-     HandleELSEIF(Param);
+     HandleELSEIF(Param,UpperCase(Directive)='ELIFC');
+  'ELSEC',   
   'ELSE':
      HandleELSE(Param);
+  'ENDC',
   'ENDIF':
     HandleENDIF(Param);
   'IFEND':
@@ -4102,7 +4385,9 @@ begin
       Case UpperCase(Directive) of
       'ASSERTIONS':
         DoBoolDirective(bsAssertions);
-      'DEFINE':
+      'DEFINE',
+      'DEFINEC',
+      'SETC':
         HandleDefine(Param);
       'GOTO':
         DoBoolDirective(bsGoto);
@@ -4118,6 +4403,11 @@ begin
         DoBoolDirective(bsHints);
       'I','INCLUDE':
         Result:=HandleInclude(Param);
+      'INCLUDESTRING','INCLUDESTRINGFILE':
+        begin
+        HandleIncludeString(Param);
+        Result:=tkString;
+        end;
       'INTERFACES':
         HandleInterfaces(Param);
       'LONGSTRINGS':
@@ -4130,6 +4420,10 @@ begin
         HandleMode(Param);
       'MODESWITCH':
         HandleModeSwitch(Param);
+      'MULTILINESTRINGLINEENDING':
+        HandleMultilineStringLineEnding(Param);
+      'MULTILINESTRINGTRIMLEFT':
+        HandleMultilineStringTrimLeft(Param);
       'NOTE':
         DoLog(mtNote,nUserDefined,SUserDefined,[Param]);
       'NOTES':
@@ -4163,6 +4457,11 @@ begin
         DoBoolDirective(bsWarnings);
       'WRITEABLECONST':
         DoBoolDirective(bsWriteableConst);
+      'ALIGN',
+      'CALLING',
+      'INLINE',
+      'PACKRECORDS',
+      'PACKENUM' : ;
       else
         Handled:=false;
       end;
@@ -4250,6 +4549,44 @@ begin
     OnDirective(Sender,Directive,Param,Handled);
 end;
 
+procedure TPascalScanner.HandleMultilineStringTrimLeft(const AParam: String);
+
+Var
+  S : String;
+  i : integer;
+
+begin
+  S:=UpperCase(Trim(aParam));
+  Case UpperCase(S) of
+    'ALL'  : I:=-2;
+    'AUTO' : I:=-1;
+    'NONE' : I:=0;
+  else
+    If not TryStrToInt(S,I) then
+      I:=0;
+  end;
+  MultilineLineTrimLeft:=I;
+
+end;
+
+procedure TPascalScanner.HandleMultilineStringLineEnding(const AParam: string);
+
+Var
+  S : TEOLStyle;
+
+begin
+  Case UpperCase(Trim(aParam)) of
+    'CR' : s:=elCR;
+    'LF' : s:=elLF;
+    'CRLF' : s:=elCRLF;
+    'SOURCE' : s:=elSource;
+    'PLATFORM' : s:=elPlatform;
+  else
+    Error(nErrInvalidMultiLineLineEnding,sErrInvalidMultiLineLineEnding);
+  end;
+  MultilineLineFeedStyle:=S;
+end;
+
 function TPascalScanner.DoFetchToken: TToken;
 
 var
@@ -4347,6 +4684,13 @@ begin
       end;
     '#', '''':
       Result:=DoFetchTextToken;
+    '`' :
+      begin
+      If not (msMultiLineStrings in CurrentModeSwitches) then
+         Error(nErrInvalidCharacter, SErrInvalidCharacter,
+        [{$ifdef UsePChar}FTokenPos[0]{$else}s[FTokenPos]{$endif}]);
+      Result:=DoFetchMultilineTextToken;
+      end;
     '&':
       begin
       TokenStart := FTokenPos;
@@ -4534,7 +4878,13 @@ begin
       else if {$ifdef UsePChar}FTokenPos[0]='.'{$else}(FTokenPos<=l) and (s[FTokenPos]='.'){$endif} then
         begin
         Inc(FTokenPos);
-        Result := tkDotDot;
+        if {$ifdef UsePChar}FTokenPos[0]='.'{$else}(FTokenPos<=l) and (s[FTokenPos]='.'){$endif} then
+          begin
+          Inc(FTokenPos);
+          Result:=tkDotDotDot;
+          end
+        else  
+          Result := tkDotDot;
         end
       else
         Result := tkDot;
@@ -4932,6 +5282,10 @@ end;
 
 procedure TPascalScanner.OnCondEvalLog(Sender: TCondDirectiveEvaluator;
   Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
+
+Var
+  Msg : String;
+
 begin
   {$IFDEF VerbosePasDirectiveEval}
   writeln('TPascalScanner.OnCondEvalLog "',Sender.MsgPattern,'"');
@@ -4940,7 +5294,8 @@ begin
   if Sender.MsgType<=mtError then
     begin
     SetCurMsg(Sender.MsgType,Sender.MsgNumber,Sender.MsgPattern,Args);
-    raise EScannerError.Create(FLastMsg);
+    Msg:=Format('%s(%d,%d) : %s',[FormatPath(FCurFileName),CurRow,CurColumn,FLastMsg]);
+    raise EScannerError.Create(Msg);
     end
   else
     DoLog(Sender.MsgType,Sender.MsgNumber,Sender.MsgPattern,Args,true);

packages/fcl-passrc/tests/tcpaswritestatements.pas

@@ -2500,7 +2500,7 @@ begin
     AddStatements(['@Proc:=Nil']);
     ParseModule;
     AssertPasWriteOutput('output', BuildString(['program afile;',
-        '', '', 'begin', '  @Proc:=Nil;', 'end.', '']), PasProgram);
+        '', '', 'begin', '  @ Proc := Nil;', 'end.', '']), PasProgram);
 end;
 
 procedure TTestStatementWriterSpecials.TestFinalizationNoSemicolon;
@@ -2585,7 +2585,7 @@ begin
 end;
 
 initialization
-    RegisterTests('TestPassWriter',
+    RegisterTests('TestPasSrcWriter',
         [TTestStatementWriterEmpty, TTestStatementWriterBlock, TTestStatementWriterAssignment,
         TTestStatementWriterCall, TTestStatementWriterIf, TTestStatementWriterCase,
         TTestStatementWriterWith, TTestStatementWriterLoops, TTestStatementWriterRaise,
@@ -2593,733 +2593,3 @@ initialization
 
 end.
 
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -518,6 +518,7 @@ end;
 
 procedure TTestProcedureFunction.TestProcedureOneOutArg;
 begin
+  Parser.CurrentModeswitches:=[msObjfpc];
   ParseProcedure('(Out B : Integer)');
   AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argOut,'Integer','');
@@ -525,6 +526,7 @@ end;
 
 procedure TTestProcedureFunction.TestFunctionOneOutArg;
 begin
+  Parser.CurrentModeswitches:=[msObjfpc];
   ParseFunction('(Out B : Integer)');
   AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argOut,'Integer','');

packages/fcl-passrc/tests/tcresolver.pas

@@ -1069,6 +1069,7 @@ begin
   FHub:=TPasResolverHub.Create(Self);
   inherited SetUp;
   Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
+  Parser.CurrentModeswitches:=[msObjfpc];
   Scanner.OnDirective:=@OnScannerDirective;
   Scanner.OnLog:=@OnScannerLog;
 end;
@@ -2195,7 +2196,8 @@ function TCustomTestResolver.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
 var
   Src: String;
 begin
-  Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
+  Src:='{$mode objfpc}';
+  Src+='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
   Src+=LineEnding;
   Src+='interface'+LineEnding;
   Src+=LineEnding;

packages/fcl-passrc/tests/tcscanner.pas

@@ -58,10 +58,12 @@ type
     FDoCommentCalled : Boolean;
     FComment: string;
     FPathPrefix : String;
+    FTestTokenString: String;
   protected
     procedure DoComment(Sender: TObject; aComment: String);
     procedure SetUp; override;
     procedure TearDown; override;
+    Procedure DoMultilineError;
     Function TokenToString(tk : TToken) : string;
     Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload;
     Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitch); overload;
@@ -75,6 +77,7 @@ type
     Property Scanner : TPascalScanner Read FScanner;
     // Path for source filename.
     Property PathPrefix : String Read FPathPrefix Write FPathPrefix;
+    Property TestTokenString : String Read FTestTokenString;
   published
     Procedure TestEmpty;
     procedure TestEOF;
@@ -98,6 +101,17 @@ type
     procedure TestSelf;
     procedure TestSelfNoToken;
     procedure TestString;
+    procedure TestMultilineStringError;
+    procedure TestMultilineStringSource;
+    Procedure TestMultilineStringLF;
+    Procedure TestMultilineStringCR;
+    Procedure TestMultilineStringCRLF;
+    Procedure TestMultilineStringPlatform;
+    Procedure TestMultilineLineEndingDirective;
+    Procedure TestMultilineTrimLeftDirective;
+    procedure TestMultilineStringTrimAll;
+    procedure TestMultilineStringTrimAuto;
+    procedure TestMultilineStringTrim2;
     procedure TestNumber;
     procedure TestChar;
     procedure TestCharString;
@@ -240,6 +254,9 @@ type
     Procedure TestInclude;
     Procedure TestInclude2;
     Procedure TestInclude3;
+    Procedure TestIncludeString;
+    Procedure TestIncludeStringFile;
+    Procedure TestIncludeString2Lines;
     Procedure TestUnDefine1;
     Procedure TestMacro1;
     procedure TestMacro2;
@@ -261,6 +278,10 @@ type
     procedure TestIFLesserEqualThan;
     procedure TestIFDefinedElseIf;
     procedure TestIfError;
+    procedure TestIFCDefined;
+    procedure TestIFCNotDefined;
+    procedure TestIFCAndDefined;
+    procedure TestIFCFalse;
     Procedure TestModeSwitch;
     Procedure TestOperatorIdentifier;
     Procedure TestUTF8BOM;
@@ -397,6 +418,7 @@ end;
 
 procedure TTestScanner.SetUp;
 begin
+  FTestTokenString:='';
   FDoCommentCalled:=False;
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
@@ -410,6 +432,11 @@ begin
   FreeAndNil(FResolver);
 end;
 
+procedure TTestScanner.DoMultilineError;
+begin
+  TestToken(pscanner.tkString,'`A '#10'multiline string`');
+end;
+
 function TTestScanner.TokenToString(tk: TToken): string;
 begin
   Result:=GetEnumName(TypeInfo(TToken),Ord(tk));
@@ -480,6 +507,7 @@ begin
   NewSource(ASource);
   tk:=FScanner.FetchToken;
   AssertEquals('Read token equals expected token.',t,tk);
+  FTestTokenString:=FScanner.CurTokenString;
   if CheckEOF then
     begin
     tk:=FScanner.FetchToken;
@@ -518,7 +546,9 @@ begin
     tk:=FScanner.FetchToken;
     AssertEquals(Format('Read token %d equals expected token.',[i]),t[i],tk);
     if tk=tkIdentifier then
-      LastIdentifier:=FScanner.CurtokenString;
+      LastIdentifier:=FScanner.CurtokenString
+    else if tk=tkString then
+      fTestTokenString:=FScanner.CurTokenString;
     end;
   if CheckEOF then
     begin
@@ -659,6 +689,142 @@ begin
   TestToken(pscanner.tkString,'''A string''');
 end;
 
+procedure TTestScanner.TestMultilineStringError;
+begin
+  AssertException('Need modeswitch',EScannerError,@DoMultilineError);
+end;
+
+procedure TTestScanner.TestMultilineStringSource;
+
+const
+  S = '''AB'#13#10'CD''';
+
+begin
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elSource;
+  DoTestToken(pscanner.tkString,'`AB'#13#10'CD`');
+  AssertEquals('Correct lineending',S,TestTokenString);
+end;
+
+procedure TTestScanner.TestMultilineStringLF;
+
+const
+  S = '''AB'#10'CD''';
+
+begin
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elLF;
+  DoTestToken(pscanner.tkString,'`AB'#13#10'CD`');
+  AssertEquals('Correct lineending',S,TestTokenString);
+end;
+
+procedure TTestScanner.TestMultilineStringCR;
+const
+  S = '''AB'#13'CD''';
+
+begin
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elCR;
+  DoTestToken(pscanner.tkString,'`AB'#10'CD`');
+  AssertEquals('Correct lineending',S,TestTokenString);
+end;
+
+procedure TTestScanner.TestMultilineStringCRLF;
+const
+  S = '''AB'#13#10'CD''';
+
+begin
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elCRLF;
+  DoTestToken(pscanner.tkString,'`AB'#10'CD`');
+  AssertEquals('Correct lineending',S,TestTokenString);
+end;
+
+procedure TTestScanner.TestMultilineStringPlatform;
+
+const
+  S = '''AB'+sLineBreak+'CD''';
+
+begin
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elPlatform;
+  DoTestToken(pscanner.tkString,'`AB'#13#10'CD`');
+  AssertEquals('Correct lineending',S,TestTokenString);
+end;
+
+procedure TTestScanner.TestMultilineLineEndingDirective;
+begin
+  AssertTrue('Default platform', FSCanner.MultilineLineFeedStyle=elPlatform);
+  TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING CR}');
+  AssertTrue('CR', FSCanner.MultilineLineFeedStyle=elCR);
+  TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING LF}');
+  AssertTrue('LF', FSCanner.MultilineLineFeedStyle=elLF);
+  TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING CRLF}');
+  AssertTrue('CRLF', FSCanner.MultilineLineFeedStyle=elCRLF);
+  TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING SOURCE}');
+  AssertTrue('SOURCE', FSCanner.MultilineLineFeedStyle=elSOURCE);
+  TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING PLATFORM}');
+  AssertTrue('Platform', FSCanner.MultilineLineFeedStyle=elPlatform);
+
+end;
+
+procedure TTestScanner.TestMultilineTrimLeftDirective;
+begin
+  AssertTrue('Default', FSCanner.MultilineLineTrimLeft=0);
+  TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT 1}');
+  AssertTrue('1', FSCanner.MultilineLineTrimLeft=1);
+  TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT 2}');
+  AssertTrue('2', FSCanner.MultilineLineTrimLeft=2);
+  TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT ALL}');
+  AssertTrue('ALL', FSCanner.MultilineLineTrimLeft=-2);
+  TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT AUTO}');
+  AssertTrue('AUTO', FSCanner.MultilineLineTrimLeft=-1);
+end;
+
+procedure TTestScanner.TestMultilineStringTrimAll;
+
+const
+   S = '''AB'#10'CD''';
+
+begin
+  SCanner.MultilineLineTrimLeft:=-2;
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elLF;
+  DoTestToken(pscanner.tkString,'`AB'#13#10'    CD`');
+  AssertEquals('Correct trim',S,TestTokenString);
+
+end;
+
+procedure TTestScanner.TestMultilineStringTrimAuto;
+const
+   S = '''AB'#10' CD''';
+
+begin
+  SCanner.MultilineLineTrimLeft:=-1;
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elLF;
+  Scanner.SkipWhiteSpace:=True;
+  DoTestToken(pscanner.tkString,' `AB'#13#10'   CD`');
+  AssertEquals('Correct trim',S,TestTokenString);
+end;
+
+procedure TTestScanner.TestMultilineStringTrim2;
+
+const
+  S = '''AB'#10' CD''';
+  S2 = '''AB'#10'CD''';
+
+begin
+  SCanner.MultilineLineTrimLeft:=2;
+  Scanner.CurrentModeSwitches:=[msMultiLineStrings];
+  Scanner.MultilineLineFeedStyle:=elLF;
+  Scanner.SkipWhiteSpace:=True;
+  DoTestToken(pscanner.tkString,' `AB'#13#10'   CD`');
+  AssertEquals('Correct trim',S,TestTokenString);
+  DoTestToken(pscanner.tkString,' `AB'#13#10' CD`');
+  AssertEquals('Correct trim 2',S2,TestTokenString);
+end;
+
 procedure TTestScanner.TestCharString;
 
 begin
@@ -1648,6 +1814,34 @@ begin
   TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I src/myinclude1.inc} else',True,False);
 end;
 
+procedure TTestScanner.TestIncludeString;
+begin
+  FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkString],'{$INCLUDESTRING myinclude.inc}',False,False);
+  AssertEquals('Correct string','''if true then''',TestTokenString)
+end;
+
+procedure TTestScanner.TestIncludeStringFile;
+begin
+  FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkString],'{$INCLUDESTRINGFILE myinclude.inc}',False,False);
+  AssertEquals('Correct string','''if true then''',TestTokenString)
+end;
+
+procedure TTestScanner.TestIncludeString2Lines;
+begin
+  FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'#10'else'));
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.MultilineLineFeedStyle:=elCRLF;
+  TestTokens([tkString],'{$INCLUDESTRING myinclude.inc}',False,False);
+  AssertEquals('Correct string','''if true then'#13#10'else''',TestTokenString)
+end;
+
 procedure TTestScanner.TestUnDefine1;
 begin
   FSCanner.Defines.Add('ALWAYS');
@@ -1834,6 +2028,61 @@ begin
     +'end.',True,False);
 end;
 
+procedure TTestScanner.TestIFCDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkString,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$ifc defined cpu32} ''x86'''+LineEnding
+    +'{$elseif defined(cpu64)} 1 '+LineEnding
+    +'{$else} {$error unknown platform} {$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
+procedure TTestScanner.TestIFCNotDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkNumber,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$ifc not defined cpu32} ''x86'''+LineEnding
+    +'{$else} 1 '+LineEnding
+    +'{$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
+procedure TTestScanner.TestIFCAndDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  FScanner.AddDefine('alpha');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkstring,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$ifc defined cpu32 and defined alpha} ''x86'''+LineEnding
+    +'{$else} 1 '+LineEnding
+    +'{$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
+procedure TTestScanner.TestIFCFalse;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  FScanner.AddDefine('alpha');
+  FScanner.AddMacro('MY','FALSE');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkNumber,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$IFC MY} ''x86'''+LineEnding
+    +'{$else} 1 '+LineEnding
+    +'{$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
 procedure TTestScanner.TestModeSwitch;
 
 Const
@@ -1869,7 +2118,7 @@ begin
   DoTestToken(tkLineEnding,#$EF+#$BB+#$BF);
 end;
 
-Procedure TTestScanner.TestBooleanSwitch;
+procedure TTestScanner.TestBooleanSwitch;
 
 begin
   Scanner.CurrentBoolSwitches:=[bsHints];

packages/fcl-passrc/tests/tctypeparser.pas

@@ -465,6 +465,11 @@ type
     Procedure TestFunctionOneArg;
     Procedure TestFunctionOfObject;
     Procedure TestFunctionOneArgOfObject;
+    Procedure TestCBlock;
+    Procedure TestMacPasoutArg;
+    Procedure TestMacPasPropertyArg;
+    Procedure TestMacPasPropertyVarArg;
+    Procedure TestMacPasClassArg;
   end;
 
 
@@ -1181,6 +1186,48 @@ begin
 
 end;
 
+procedure TTestProcedureTypeParser.TestCBlock;
+
+
+begin
+  ParseType('reference to procedure (a: integer); cblock;',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  AssertEquals('Is cblock',True,ptmCblock in Proc.Modifiers);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasoutArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (out: integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasPropertyArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (property : integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasPropertyVarArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (var property : integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasClassArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (class : integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
 { TTestRecordTypeParser }
 
 function TTestRecordTypeParser.GetC(AIndex: Integer): TPasConst;
@@ -2825,6 +2872,7 @@ begin
   FErrorSource:='';
   FHint:='';
   FType:=Nil;
+  Parser.CurrentModeswitches:=[msObjfpc];
 end;
 
 Procedure TBaseTestTypeParser.TearDown;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -2685,7 +2685,9 @@ procedure TTestUseAnalyzer.TestWP_Published;
 begin
   StartProgram(false);
   Add('type');
-  Add('  {#tobject_used}TObject = class');
+  Add('  {#tobject_notypeinfo}TObject = class');
+  Add('  end;');
+  Add('  {#tobject_typeinfo}TBird = class');
   Add('  private');
   Add('    {#fcol_used}FCol: string;');
   Add('    {#fbird_notused}FBird: string;');
@@ -2695,9 +2697,9 @@ begin
   Add('    property {#col_used}Col: string read FCol;');
   Add('  end;');
   Add('var');
-  Add('  {#o_used}o: TObject;');
+  Add('  {#b_used}b: TBird;');
   Add('begin');
-  Add('  o:=nil;');
+  Add('  b:=nil;');
   AnalyzeWholeProgram;
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -1303,7 +1303,8 @@ const
     msPrefixedAttributes,
     msOmitRTTI,
     msMultiHelpers,
-    msImplicitFunctionSpec];
+    msImplicitFunctionSpec,
+    msMultilineStrings];
 
   bsAllPas2jsBoolSwitchesReadOnly = [
     bsLongStrings
@@ -2072,7 +2073,7 @@ type
     Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
     Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
-    // set
+    // enum and sets
     Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
     // record
     Function CreateRecordInit(aRecord: TPasRecordType; Expr: TPasExpr;
@@ -8185,7 +8186,8 @@ begin
           RemoveFromSourceElements(Src,ImplVarSt);
           // remove unneeded $mod.$implcode = function(){}
           RemoveFromSourceElements(Src,AssignSt);
-          HasImplUsesClause:=length(El.ImplementationSection.UsesClause)>0;
+          HasImplUsesClause:=(El.ImplementationSection<>nil)
+                         and (length(El.ImplementationSection.UsesClause)>0);
           end
         else
           begin
@@ -9659,6 +9661,12 @@ begin
         DoError(20190211111038,nNoMemberIsProvidedToAccessProperty,sNoMemberIsProvidedToAccessProperty,[],RightEl);
       end;
     end;
+    end
+  else if RightRefDecl.ClassType=TPasEnumValue then
+    begin
+    // enum value
+    Result:=ConvertIdentifierExpr(RightEl,'',aContext);
+    exit;
     end;
   if (AContext.Access=caAssign)
       and aResolver.IsClassField(RightRefDecl) then
@@ -15229,6 +15237,7 @@ Var
     SectionScope: TPas2JSSectionScope;
     SectionCtx: TSectionContext;
     Src: TJSSourceElements;
+    ImplSect: TImplementationSection;
   begin
     SectionScope:=Section.CustomData as TPas2JSSectionScope;
     AContext.ScannerBoolSwitches:=SectionScope.BoolSwitches;
@@ -15247,8 +15256,9 @@ Var
       InitForwards(Section.Declarations,TSectionContext(AContext));
       if Section is TInterfaceSection then
         begin
-        InitForwards(TPasModule(Section.Parent).ImplementationSection.Declarations,
-                     TSectionContext(AContext));
+        ImplSect:=TPasModule(Section.Parent).ImplementationSection;
+        if ImplSect<>nil then
+          InitForwards(ImplSect.Declarations,TSectionContext(AContext));
         end;
       end;
   end;
@@ -17552,9 +17562,12 @@ begin
       end;
 
     // create implementation declarations
-    ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
-    if ImplDecl<>nil then
-      RaiseInconsistency(20170910175032,El); // elements should have been added directly
+    if El.ImplementationSection<>nil then
+      begin
+      ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
+      if ImplDecl<>nil then
+        RaiseInconsistency(20170910175032,El); // elements should have been added directly
+      end;
     IntfContext.ImplHeaderIndex:=ImplContext.HeaderIndex;
     Result:=FunDecl;
   finally
@@ -19496,6 +19509,7 @@ begin
     aJSWriter.Options:=DefaultJSWriterOptions;
     aJSWriter.IndentSize:=2;
     aJSWriter.SkipCurlyBrackets:=true;
+    aJSWriter.Writer.LineBreak:=#10;
     aJSWriter.WriteJS(El);
     Result:=aWriter.AsString;
   finally
@@ -24444,15 +24458,6 @@ var
     Result:=(C=TPasFunction) or (C=TPasProcedure) or (C=TPasConstructor) or (C=TPasDestructor);
   end;
 
-  function ProcHasNoSelf(Proc: TPasProcedure): boolean;
-  begin
-    if Proc=nil then exit(false);
-    if not (Proc.Parent is TPasMembersType) then
-      exit(true);
-    if Proc.IsStatic then exit(true);
-    Result:=false;
-  end;
-
   procedure Append_GetClass(Member: TPasElement);
   var
     P: TPasElement;
@@ -26315,14 +26320,14 @@ begin
         end
       else if C=TPasConst then
         begin
-        NewEl:=ConvertConst(TPasConst(P),aContext);
+        NewEl:=ConvertConst(TPasConst(P),FuncContext);
         IsComplex:=true;
         end
       else if C=TPasProperty then
-        NewEl:=ConvertProperty(TPasProperty(P),AContext)
+        NewEl:=ConvertProperty(TPasProperty(P),FuncContext)
       else if C.InheritsFrom(TPasType) then
         begin
-        NewEl:=CreateTypeDecl(TPasType(P),aContext);
+        NewEl:=CreateTypeDecl(TPasType(P),FuncContext);
         if (C=TPasRecordType) or (C=TPasClassType) then
           IsComplex:=true;
         end
@@ -26330,7 +26335,7 @@ begin
         begin
         if (C=TPasClassConstructor)
            or (C=TPasClassDestructor) then
-          AddGlobalClassMethod(AContext,TPasProcedure(P))
+          AddGlobalClassMethod(FuncContext,TPasProcedure(P))
         else
           begin
           Methods.Add(P);

packages/pastojs/src/pas2jsfiler.pp

@@ -206,7 +206,8 @@ const
     'PrefixedAttributes',
     'OmitRTTI',
     'MultiHelpers',
-    'ImplicitFunctionSpecialization'
+    'ImplicitFunctionSpecialization',
+    'MultilineStrings'
     ); // Dont forget to update ModeSwitchToInt !
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
@@ -448,7 +449,8 @@ const
     'Varargs',
     'ReferenceTo',
     'Async',
-    'Far'
+    'Far',
+    'CBlock'
     );
 
   PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = (
@@ -1635,6 +1637,7 @@ begin
     msOmitRTTI: Result:=48;
     msMultiHelpers: Result:=49;
     msImplicitFunctionSpec: Result:=50;
+    msMultiLineStrings: Result:=51;
   end;
 end;
 
@@ -8197,12 +8200,16 @@ var
   aModule: TPasModule;
 
   function CreateOrContinueSection(const PropName: string; var Section: TPasSection;
-     SectionClass: TPasSectionClass): boolean;
+     SectionClass: TPasSectionClass; MustExist: boolean): boolean;
   var
     SubObj: TJSONObject;
   begin
     if not ReadObject(Obj,PropName,SubObj,aModule) then
-      RaiseMsg(20180308142146,aModule);
+      begin
+      if MustExist then
+        RaiseMsg(20180308142146,aModule);
+      exit;
+      end;
     if Section=nil then
       Section:=TPasSection(CreateElement(SectionClass,'',aModule));
     ReadSection(SubObj,Section,aContext);
@@ -8256,7 +8263,7 @@ begin
       // start or continue ProgramSection
       Prog:=TPasProgram(aModule);
       if not CreateOrContinueSection('Program',TPasSection(Prog.ProgramSection),
-          TProgramSection) then
+          TProgramSection,true) then
         exit; // pending uses interfaces -> pause
       end
     else if aModule.ClassType=TPasLibrary then
@@ -8264,7 +8271,7 @@ begin
       // start or continue LibrarySection
       Lib:=TPasLibrary(aModule);
       if not CreateOrContinueSection('Library',TPasSection(Lib.LibrarySection),
-          TLibrarySection) then
+          TLibrarySection,true) then
         exit; // pending uses interfaces -> pause
       end
     else
@@ -8274,12 +8281,12 @@ begin
         begin
         // start or continue unit Interface
         if not CreateOrContinueSection('Interface',TPasSection(aModule.InterfaceSection),
-            TInterfaceSection) then
+            TInterfaceSection,true) then
           exit; // pending uses interfaces -> pause
         end;
       // start or continue unit Implementation
       if not CreateOrContinueSection('Implementation',TPasSection(aModule.ImplementationSection),
-          TImplementationSection) then
+          TImplementationSection,false) then
         exit; // pending uses interfaces -> pause
       end;
     if (Obj.Find('Init')<>nil)

packages/pastojs/tests/tcmodules.pas

@@ -53,7 +53,8 @@ type
     supTObject,
     supTVarRec,
     supTypeInfo,
-    supTInterfacedObject
+    supTInterfacedObject,
+    supWriteln
     );
   TSystemUnitParts = set of TSystemUnitPart;
 
@@ -830,6 +831,7 @@ type
     Procedure TestRTTI_ClassOf;
     Procedure TestRTTI_Record;
     Procedure TestRTTI_RecordAnonymousArray;
+    Procedure TestRTTI_Record_ClassVarType;
     Procedure TestRTTI_LocalTypes;
     Procedure TestRTTI_TypeInfo_BaseTypes;
     Procedure TestRTTI_TypeInfo_Type_BaseTypes;
@@ -1748,6 +1750,9 @@ begin
     '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
     '']);
     end;
+  if supWriteln in Parts then
+    Intf.Add('procedure writeln; varargs; external name ''console.log'';');
+
   Intf.Add('var');
   Intf.Add('  ExitCode: Longint = 0;');
 
@@ -12155,7 +12160,7 @@ begin
     '  };',
     '});',
     'rtl.recNewT(this, "TPoint", function () {',
-    '  rtl.createClass(this, "TBird", this.TObject, function () {',
+    '  rtl.createClass(this, "TBird", $mod.TObject, function () {',
     '    this.DoIt = function () {',
     '      this.DoIt();',
     '      this.DoIt();',
@@ -30341,6 +30346,41 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRTTI_Record_ClassVarType;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  TPoint = record',
+  '    type TProc = procedure(w: word);',
+  '    class var p: TProc;',
+  '  end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRTTI_Record_ClassVarType',
+    LinesToStr([ // statements
+    'rtl.recNewT(this, "TPoint", function () {',
+    '  $mod.$rtti.$ProcVar("TPoint.TProc", {',
+    '    procsig: rtl.newTIProcSig([["w", rtl.word]])',
+    '  });',
+    '  this.p = null;',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '  var $r = $mod.$rtti.$Record("TPoint", {});',
+    '  $r.addField("p", $mod.$rtti["TPoint.TProc"]);',
+    '}, true);',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_LocalTypes;
 begin
   WithTypeInfo:=true;

packages/pastojs/tests/tcoptimizations.pas

@@ -59,6 +59,7 @@ type
     // unit optimization: jsshortrefglobals
     procedure TestOptShortRefGlobals_Program;
     procedure TestOptShortRefGlobals_Unit_FromIntfImpl_ToIntfImpl;
+    procedure TestOptShortRefGlobals_Enums;
     procedure TestOptShortRefGlobals_Property;
     procedure TestOptShortRefGlobals_ExternalAbstract;
     procedure TestOptShortRefGlobals_Class;
@@ -414,6 +415,77 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestOptShortRefGlobals_Enums;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TColor = (red,green,blue);',
+    '',
+    '']),
+  LinesToStr([
+    '']));
+  AddModuleWithIntfImplSrc('UnitB.pas',
+  LinesToStr([
+    'type',
+    '  TSize = (small,big);',
+    '',
+    '']),
+  LinesToStr([
+    '']));
+  StartUnit(true,[supWriteln]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'const',
+  '  ColorRed = TColor.Red;',
+  'procedure Fly;',
+  'implementation',
+  'uses unitb;',
+  'const',
+  '  SizeSmall = TSize.Small;',
+  'procedure Fly;',
+  'begin',
+  '  writeln(ColorRed);',
+  '  writeln(TColor.Blue);',
+  '  writeln(SizeSmall);',
+  '  writeln(TSize.Big);',
+  '  writeln(unitb.TSize.Big);',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_Enums',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'var $lm = pas.UnitA;',
+    'var $lt = $lm.TColor;',
+    'var $lt1 = $lt.red;',
+    'var $lt2 = $lt.blue;',
+    'var $lm1 = null;',
+    'var $lt3 = null;',
+    'var $lt4 = null;',
+    'var $lt5 = null;',
+    'this.ColorRed = $lt1;',
+    'this.Fly = function () {',
+    '  console.log($lt1);',
+    '  console.log($lt2);',
+    '  console.log($lt4);',
+    '  console.log($lt5);',
+    '  console.log($lt5);',
+    '};',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '$lm1 = pas.UnitB;',
+    '$lt3 = $lm1.TSize;',
+    '$lt4 = $lt3.small;',
+    '$lt5 = $lt3.big;',
+    '$impl.SizeSmall = $lt4;',
+    '']));
+end;
+
 procedure TTestOptimizations.TestOptShortRefGlobals_Property;
 begin
   AddModuleWithIntfImplSrc('UnitA.pas',
@@ -1424,7 +1496,7 @@ begin
     'var $lt2 = null;',
     'rtl.recNewT(this, "TAnt", function () {',
     '  $lt = this;',
-    '  rtl.recNewT($lt, "TLeg", function () {',
+    '  rtl.recNewT(this, "TLeg", function () {',
     '    $lt1 = this;',
     '    this.l = 0;',
     '    this.$eq = function (b) {',

packages/pastojs/tests/tcprecompile.pas

@@ -54,6 +54,7 @@ type
   TTestCLI_Precompile = class(TCustomTestCLI_Precompile)
   published
     procedure TestPCU_EmptyUnit;
+    procedure TestPCU_UnitWithoutImplementation;
     procedure TestPCU_UTF8BOM;
     procedure TestPCU_ParamNS;
     procedure TestPCU_Overloads;
@@ -173,6 +174,25 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
+procedure TTestCLI_Precompile.TestPCU_UnitWithoutImplementation;
+begin
+  AddUnit('src/system.pp',[''],['']);
+  AddFile('src/unit1.pas',
+    'unit unit1;'+LineEnding
+    +'interface'+LineEnding
+    +'end.'+LineEnding);
+  AddFile('src/unit2.pas',
+    'unit unit2;'+LineEnding
+    +'interface'+LineEnding
+    +'uses unit1;'+LineEnding
+    +'end.'+LineEnding);
+  AddFile('test1.pas',[
+    'uses unit2;',
+    'begin',
+    'end.']);
+  CheckPrecompile('test1.pas','src');
+end;
+
 procedure TTestCLI_Precompile.TestPCU_UTF8BOM;
 var
   aFile: TCLIFile;

rtl/inc/genmath.inc

@@ -2087,7 +2087,7 @@ function TDoubleRec.GetFrac : QWord;
 
 procedure TDoubleRec.SetFrac(e : QWord);
   begin
-    Data:=(Data and $7ff0000000000000) or (e and $fffffffffffff);
+    Data:=(Data and $fff0000000000000) or (e and $fffffffffffff);
   end;
 
 {

rtl/win/sysutils.pp

@@ -1317,25 +1317,26 @@ end;
 ****************************************************************************}
 
 function SysErrorMessage(ErrorCode: Integer): String;
-const
-  MaxMsgSize = Format_Message_Max_Width_Mask;
 var
-  MsgBuffer: unicodestring;
+  MsgBuffer: PWideChar;
+  Msg: UnicodeString;
   len: longint;
 begin
-  SetLength(MsgBuffer, MaxMsgSize);
-  len := FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM,
+  len := FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM or
+                        FORMAT_MESSAGE_IGNORE_INSERTS or
+                        FORMAT_MESSAGE_ALLOCATE_BUFFER,
                         nil,
                         ErrorCode,
                         MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
-                        PUnicodeChar(MsgBuffer),
-                        MaxMsgSize,
+                        PWideChar(@MsgBuffer),
+                        0,
                         nil);
   // Remove trailing #13#10
-  if (len > 1) and (MsgBuffer[len - 1] = #13) and (MsgBuffer[len] = #10) then
+  if (len > 1) and (MsgBuffer[len - 2] = #13) and (MsgBuffer[len - 1] = #10) then
     Dec(len, 2);
-  SetLength(MsgBuffer, len);
-  Result := MsgBuffer;
+  SetString(Msg, PUnicodeChar(MsgBuffer), len);
+  LocalFree(HLOCAL(MsgBuffer));
+  Result := Msg;
 end;
 
 {****************************************************************************

tests/test/cg/texit2.pp

@@ -0,0 +1,106 @@
+{$mode objfpc}
+
+{ Tests proper setting of fc_no_direct_exit in flowcontrol when the exit statement jumps
+  to an extra code instead of immediately finishing execution of the current routine. }
+
+type
+  TSymtable = class
+  public
+    name      : pshortstring;
+    realname  : pshortstring;
+    DefList   : TObject;
+    SymList   : TObject;
+    refcount  : smallint;
+    destructor  destroy;override;
+    procedure clear;virtual;
+    procedure freeinstance;override;
+    procedure test_inline_with_exit;virtual;
+  end;
+
+var
+  st: TSymtable;
+
+  procedure stringdispose(var p : pshortstring); inline;
+  begin
+   if assigned(p) then
+     begin
+       freemem(p);
+       p:=nil;
+     end;
+  end;
+
+  procedure cproc(a,b,c: longint); cdecl;
+  begin
+  end;
+
+  procedure inline_with_exit(a,b,c: longint); inline;
+  begin
+    if a = 12345 then
+      exit;
+    cproc(a,b,c);
+  end;
+
+  procedure inline_error;
+  begin
+    writeln('Inline with exit error.');
+    halt(3);
+  end;
+
+  procedure TSymtable.test_inline_with_exit;
+  var
+    i,j: integer;
+  begin
+    i:=12345;
+    j:=1;
+    stringdispose(name);
+    inline_with_exit(i,j,i+j);
+    if i<>12345 then
+      inline_error;
+    Inc(i);
+    Inc(j);
+    stringdispose(name);
+  end;
+
+  procedure TSymtable.clear;
+  begin
+  end;
+
+  destructor TSymtable.destroy;
+    var i: longint;
+    begin
+      i:=1;
+      if refcount=0 then
+        exit;
+      Clear;
+      DefList.Free;
+      SymList.Free;
+      stringdispose(name);
+      stringdispose(realname);
+      refcount:=i;
+      { freeinstance is implicitly called here even when 'exit' is executed }
+    end;
+
+    procedure TSymtable.freeinstance;
+      begin
+        writeln('freeinstance');
+        if Self <> st then
+          begin
+            writeln('Incorrect self.');
+            Halt(1);
+          end;
+
+        inherited freeinstance;
+        st:=nil;
+      end;
+
+begin
+  st:=TSymtable.Create;
+  st.test_inline_with_exit;
+  st.Free;
+  if st <> nil then
+    begin
+      writeln('freeinstance has not called.');
+      Halt(1);
+    end;
+  writeln('OK');
+end.

tests/test/tminmax.pp

@@ -1,4 +1,9 @@
+{ %opt=-O- -Oonofastmath }  { with fast math, the operands of min/max might be swapped and this breaks the tests using NaN }
+
 {$mode objfpc}
+uses
+  Math;
+
 procedure TestSingle;
 
   function Min1(a, b: Single): Single; inline;
@@ -36,7 +41,7 @@ procedure TestSingle;
     end;
 
   var
-    v1,v3 : Single;
+    v1,v3,vNaN : Single;
 
   begin
     v1:=1;
@@ -73,6 +78,25 @@ procedure TestSingle;
       halt(33);
     if Max2(v1,v3)<>v3 then
       halt(34);
+    SetExceptionMask([exInvalidOp]);
+    vNaN:=NaN;
+    if not(IsNaN(Min1(v1,vNaN))) then
+      halt(41);
+    if Min1(NaN,v1)<>v1 then
+      halt(42);
+    if not(IsNaN(Max1(v1,vNaN))) then
+      halt(43);
+    if Max1(vNaN,v3)<>v3 then
+      halt(44);
+    if not(IsNaN(Min2(v1,vNaN))) then
+      halt(45);
+    if Min2(vNaN,v3)<>v3 then
+      halt(46);
+    if not(IsNaN(Max2(v1,vNaN))) then
+      halt(47);
+    if Max2(vNaN,v3)<>v3 then
+      halt(48);
+    SetExceptionMask([]);
   end;
 
 procedure TestDouble;
@@ -112,7 +136,7 @@ procedure TestDouble;
     end;
 
   var
-    v1,v3 : Double;
+    v1,v3,vNaN : Double;
 
   begin
     v1:=1;
@@ -149,6 +173,25 @@ procedure TestDouble;
       halt(133);
     if Max2(v1,v3)<>v3 then
       halt(134);
+    SetExceptionMask([exInvalidOp]);
+    vNaN:=NaN;
+    if not(IsNaN(Min1(v1,vNaN))) then
+      halt(141);
+    if Min1(NaN,v1)<>v1 then
+      halt(142);
+    if not(IsNaN(Max1(v1,vNaN))) then
+      halt(143);
+    if Max1(vNaN,v3)<>v3 then
+      halt(144);
+    if not(IsNaN(Min2(v1,vNaN))) then
+      halt(145);
+    if Min2(vNaN,v3)<>v3 then
+      halt(146);
+    if not(IsNaN(Max2(v1,vNaN))) then
+      halt(147);
+    if Max2(vNaN,v3)<>v3 then
+      halt(148);
+    SetExceptionMask([]);
   end;
 
 

tests/webtbs/tw38122b.pp

@@ -0,0 +1,19 @@
+program tw38122b;
+{$mode delphi}
+uses sysutils;
+type trec=record
+  i:integer;
+ end;
+
+ var rec:trec;
+     prec:^trec;
+     s: string;
+begin
+  rec.i:=20;
+  prec:=@rec;
+  s:=prec.i.tostring;
+  //writeln(s);
+  if s<>'20' then
+    halt(1);
+end.
+

tests/webtbs/tw38202.pp

@@ -0,0 +1,21 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils;
+
+var
+  D: Double;
+  Q: QWord;
+
+begin
+  D := -1;
+
+  Q := D.Frac;
+  D.Frac := Q; // the sign is lost!
+
+  if D<>-1 then
+    halt(1);
+  WriteLn('ok');
+end.

utils/fpdoc/dw_html.pp

@@ -19,7 +19,7 @@ unit dw_html;
 {$WARN 5024 off : Parameter "$1" not used}
 interface
 
-uses Classes, DOM, DOM_HTML, dGlobals, PasTree, dWriter, ChmWriter;
+uses Classes, DOM, DOM_HTML, dGlobals, PasTree, dWriter, ChmWriter, chmtypes;
 
 const
   // Subpage indices for modules

utils/fpdoc/dw_htmlchm.inc

@@ -2,12 +2,19 @@
 {$IFDEF chmInterface}
 type
 
+  { TFpDocChmWriter }
+
+  TFpDocChmWriter = class (TChmWriter)
+  protected
+    procedure FileAdded(AStream: TStream; const AEntry: TFileEntryRec); override;
+  end;
+
   { TCHMHTMLWriter }
 
   TCHMHTMLWriter = class(THTMLWriter)
   private
     FOutChm: TStream;
-    FChm: TChmWriter;
+    FChm: TFpDocChmWriter;
     FTempUncompressed: TStream;
     FTempUncompressedName: String;
     FChmTitle: String;
@@ -37,6 +44,17 @@ type
   end;
 {$ELSE} // implementation
 
+{ TFpDocChmWriter }
+
+procedure TFpDocChmWriter.FileAdded ( AStream: TStream;
+  const AEntry: TFileEntryRec ) ;
+begin
+  // Exclude Full text index for files starting from the dot
+  if Pos('.', AEntry.Name) <> 1 then
+    inherited FileAdded(AStream, AEntry);
+
+end;
+
 { TCHMHTMLWriter }
 
 function TCHMHTMLWriter.ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString;
@@ -466,7 +484,7 @@ begin
 
   FTempUncompressedName := GetTempFileName+IntToStr(GetProcessID) +'.raw';
   FTempUncompressed := TFileStream.Create(FTempUncompressedName, fmOpenReadWrite  or fmCreate);
-  FChm := TChmWriter.Create(FOutChm, False);
+  FChm := TFpDocChmWriter.Create(FOutChm, False);
   FChm.Title := FChmTitle;
   FChm.TempRawStream := FTempUncompressed;
   FChm.OnGetFileData := @RetrieveOtherFiles;

utils/fpdoc/fpdocproj.pas

@@ -51,6 +51,7 @@ Type
     FCPUTarget: String;
     FDefaultPackageName: String;
     FEmitNotes: Boolean;
+    FEndianNess: String;
     FFormat: String;
     FHidePrivate: Boolean;
     FHideProtected: Boolean;
@@ -69,6 +70,7 @@ Type
   Published
     Property OSTarget : String Read FOSTarget Write FOStarget;
     Property CPUTarget : String Read FCPUTarget Write FCPUTarget;
+    Property EndianNess : String Read FEndianNess Write FEndianNess;
     Property Language : String Read FLanguage Write fLanguage;
     Property Backend : String Read FFormat Write FFormat;
     Property BackendOptions : TStrings Read FBackEndoptions Write SetBackendOptions;
@@ -81,6 +83,7 @@ Type
     Property DefaultPackageName : String Read FDefaultPackageName Write FDefaultPackageName;
     Property DontTrim : Boolean Read FDontTrim Write FDontTrim;
     Property EmitNotes : Boolean Read FEmitNotes Write FEmitNotes;
+
   end;
 
   { TFPDocProject }

utils/fpdoc/mkfpdoc.pp

@@ -12,6 +12,11 @@ const
   DefCPUTarget   = {$I %FPCTARGETCPU%};
   DefFPCVersion  = {$I %FPCVERSION%};
   DefFPCDate     = {$I %FPCDATE%};
+{$IFDEF FPC_BIG_ENDIAN}
+  DefEndianNess = 'FPC_BIG_ENDIAN';
+{$ELSE}
+  DefEndianNess = 'FPC_LITTLE_ENDIAN';
+{$ENDIF}
 
 Type
 
@@ -126,7 +131,7 @@ begin
        SplitInputFIleOption(S,UN,Opts);
        if CompareText(ChangeFileExt(ExtractFileName(Un),''),AUnitName)=0 then
          begin
-         AInputFile:=FixInputFile(UN)+' '+Opts;
+         AInputFile:=FixInputFile(UN)+' '+Opts+' -d'+Options.EndianNess;
          OSTarget:=FProject.Options.OSTarget;
          CPUTarget:=FProject.Options.CPUTarget;
          FProcessedUnits.Add(UN);
@@ -197,6 +202,7 @@ begin
   FProject.Options.StopOnParseError:=False;
   FProject.Options.CPUTarget:=DefCPUTarget;
   FProject.Options.OSTarget:=DefOSTarget;
+  FProject.Options.EndianNess:=DefEndianNess;
   FProcessedUnits:=TStringList.Create;
   FProjectMacros:=TStringList.Create;
 end;
@@ -243,7 +249,8 @@ begin
       Free;
     end;
   // Output content files
-  Writeln('Content file : ',APackage.ContentFile);
+  if FVerbose then
+    DoLog('Content file : '+APackage.ContentFile);
   if Length(APackage.ContentFile) > 0 then
     Engine.WriteContentFile(APackage.ContentFile);
 end;
@@ -292,13 +299,15 @@ begin
       try
         // get options from input packages
         SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
+        arg:=Arg+' -d'+Options.EndianNess;
         // 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)]));
+          //WriteLn(Format('Parsing unit: %s', [ExtractFilenameOnly(Cmd)]));
           ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
           end;
       except

utils/pas2js/webfilecache.pp

@@ -94,7 +94,7 @@ type
     function CreateResolver: TPas2jsFSResolver; override;
     function FileExists(const aFileName: String): Boolean; override;
     function FindCustomJSFileName(const aFilename: string): String; override;
-    function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
+    function FindIncludeFileName(const aFilename, SrcDir, ModuleDir: string; Mode: TModeSwitch): String; override;
     function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
     function LoadFile(Filename: string; Binary: boolean=false): TPas2jsFile; override;
@@ -330,7 +330,7 @@ begin
 {$ENDIF}
 end;
 
-function TPas2jsWebFS.FindIncludeFileName(const aFilename, ModuleDir: string
+function TPas2jsWebFS.FindIncludeFileName(const aFilename, SrcDir, ModuleDir: string; Mode: TModeSwitch
   ): String;
 begin
 {$IFDEF VERBOSEWEBCACHE}