+ added n8086cal.pas, based on n386cal.pas; this pulls in nx86cal.pas as well and fixes compilation of the system unit on i8086 after the merge of the i8086 branch to trunk

git-svn-id: trunk@24335 -

.gitattributes

@@ -244,6 +244,7 @@ compiler/i8086/i8086op.inc svneol=native#text/plain
 compiler/i8086/i8086prop.inc svneol=native#text/plain
 compiler/i8086/i8086tab.inc svneol=native#text/plain
 compiler/i8086/n8086add.pas svneol=native#text/plain
+compiler/i8086/n8086cal.pas svneol=native#text/plain
 compiler/i8086/n8086inl.pas svneol=native#text/plain
 compiler/i8086/n8086mat.pas svneol=native#text/plain
 compiler/i8086/r8086ari.inc svneol=native#text/plain
@@ -10597,7 +10598,7 @@ tests/test/jvm/trange3.pp svneol=native#text/plain
 tests/test/jvm/tset1.pp svneol=native#text/plain
 tests/test/jvm/tset3.pp svneol=native#text/plain
 tests/test/jvm/tset7.pp svneol=native#text/plain
-tests/test/jvm/tsetansistr.pp -text svneol=native#text/plain
+tests/test/jvm/tsetansistr.pp svneol=native#text/plain
 tests/test/jvm/tstr.pp svneol=native#text/plain
 tests/test/jvm/tstring1.pp svneol=native#text/plain
 tests/test/jvm/tstring9.pp svneol=native#text/plain
@@ -13156,7 +13157,7 @@ tests/webtbs/tw19548.pp svneol=native#text/pascal
 tests/webtbs/tw19555.pp svneol=native#text/pascal
 tests/webtbs/tw19581.pp svneol=native#text/plain
 tests/webtbs/tw19610.pp svneol=native#text/plain
-tests/webtbs/tw19622.pp -text svneol=native#text/plain
+tests/webtbs/tw19622.pp svneol=native#text/plain
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19700.pp svneol=native#text/plain
@@ -13224,7 +13225,7 @@ tests/webtbs/tw20872c.pp svneol=native#text/pascal
 tests/webtbs/tw20873.pp svneol=native#text/plain
 tests/webtbs/tw20874a.pp svneol=native#text/pascal
 tests/webtbs/tw20874b.pp svneol=native#text/pascal
-tests/webtbs/tw20880.pp -text svneol=native#text/plain
+tests/webtbs/tw20880.pp svneol=native#text/plain
 tests/webtbs/tw20889.pp svneol=native#text/pascal
 tests/webtbs/tw20909.pp svneol=native#text/pascal
 tests/webtbs/tw20940.pp svneol=native#text/pascal
@@ -13357,7 +13358,7 @@ tests/webtbs/tw2317.pp svneol=native#text/plain
 tests/webtbs/tw2318.pp svneol=native#text/plain
 tests/webtbs/tw23185.pp svneol=native#text/pascal
 tests/webtbs/tw2318b.pp svneol=native#text/plain
-tests/webtbs/tw23204.pp -text svneol=native#text/plain
+tests/webtbs/tw23204.pp svneol=native#text/plain
 tests/webtbs/tw23212.pp svneol=native#text/plain
 tests/webtbs/tw2323.pp svneol=native#text/plain
 tests/webtbs/tw23270.pp svneol=native#text/pascal
@@ -13370,17 +13371,17 @@ tests/webtbs/tw23447.pp svneol=native#text/pascal
 tests/webtbs/tw23486.pp svneol=native#text/pascal
 tests/webtbs/tw23503.pp svneol=native#text/pascal
 tests/webtbs/tw2351.pp svneol=native#text/plain
-tests/webtbs/tw23568.pp -text svneol=native#text/plain
+tests/webtbs/tw23568.pp svneol=native#text/plain
 tests/webtbs/tw2363.pp svneol=native#text/plain
 tests/webtbs/tw23667.pp svneol=native#text/plain
 tests/webtbs/tw23725.pp svneol=native#text/pascal
 tests/webtbs/tw23744.pp svneol=native#text/plain
 tests/webtbs/tw2377.pp svneol=native#text/plain
 tests/webtbs/tw2378.pp svneol=native#text/plain
-tests/webtbs/tw23819.pp -text svneol=native#text/plain
+tests/webtbs/tw23819.pp svneol=native#text/plain
 tests/webtbs/tw2382.pp svneol=native#text/plain
 tests/webtbs/tw2388.pp svneol=native#text/plain
-tests/webtbs/tw23912.pp -text svneol=native#text/plain
+tests/webtbs/tw23912.pp svneol=native#text/plain
 tests/webtbs/tw23962.pp svneol=native#text/plain
 tests/webtbs/tw2397.pp svneol=native#text/plain
 tests/webtbs/tw24007.pp svneol=native#text/plain
@@ -14168,7 +14169,7 @@ tests/webtbs/uw2266b.pas svneol=native#text/plain
 tests/webtbs/uw2269.inc svneol=native#text/plain
 tests/webtbs/uw22741a.pp svneol=native#text/plain
 tests/webtbs/uw22741b.pp svneol=native#text/plain
-tests/webtbs/uw23204.pp -text svneol=native#text/plain
+tests/webtbs/uw23204.pp svneol=native#text/plain
 tests/webtbs/uw2364.pp svneol=native#text/plain
 tests/webtbs/uw2706a.pp svneol=native#text/plain
 tests/webtbs/uw2706b.pp svneol=native#text/plain

compiler/i8086/cpunode.pas

@@ -49,8 +49,8 @@ unit cpunode;
        nx86con,
        nx86cnv,
 
-       n8086add{,
-       n386cal,
+       n8086add,
+       n8086cal{,
        n386mem,
        n386set},
        n8086inl,

compiler/i8086/n8086cal.pas

@@ -0,0 +1,97 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate i8086 assembler for in call nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit n8086cal;
+
+{$i fpcdefs.inc}
+
+interface
+
+{ $define AnsiStrRef}
+
+    uses
+      nx86cal;
+
+    type
+       ti8086callnode = class(tx86callnode)
+       protected
+          procedure pop_parasize(pop_size:longint);override;
+          procedure extra_interrupt_code;override;
+       end;
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,
+      cgbase,cgutils,
+      cpubase,paramgr,
+      aasmtai,aasmdata,aasmcpu,
+      ncal,nbas,nmem,nld,ncnv,
+      cga,cgobj,cpuinfo;
+
+
+{*****************************************************************************
+                             TI8086CALLNODE
+*****************************************************************************}
+
+
+    procedure ti8086callnode.extra_interrupt_code;
+      begin
+        emit_none(A_PUSHF,S_W);
+        emit_reg(A_PUSH,S_W,NR_CS);
+      end;
+
+
+    procedure ti8086callnode.pop_parasize(pop_size:longint);
+      var
+        hreg : tregister;
+      begin
+        if (paramanager.use_fixed_stack) then
+          begin
+            { very weird: in this case the callee does a "ret $4" and the }
+            { caller immediately a "subl $4,%esp". Possibly this is for   }
+            { use_fixed_stack code to be able to transparently call       }
+            { old-style code (JM)                                         }
+            dec(pop_size,pushedparasize);
+            if (pop_size < 0) then
+              current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_SUB,S_W,-pop_size,NR_SP));
+            exit;
+          end;
+
+        { better than an add on all processors }
+        if pop_size=2 then
+          begin
+            hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_POP,S_W,hreg));
+          end
+        { the pentium has two pipes and pop reg is pairable }
+        { but the registers must be different!        }
+        else
+          if pop_size<>0 then
+            current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_ADD,S_W,pop_size,NR_SP));
+      end;
+
+
+begin
+   ccallnode:=ti8086callnode;
+end.

compiler/ppc8086.lpi

@@ -28,7 +28,7 @@
         <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="pp.pas"/>
         <IsPartOfProject Value="True"/>
@@ -103,6 +103,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="n8086inl"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="i8086\n8086cal.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="n8086cal"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

tests/test/jvm/tsetansistr.pp

@@ -1,31 +1,31 @@
-program tsetansistr;
-
-{$mode delphi}
-{$modeswitch unicodestrings}
-
-type
-  ByteArray = array of byte;
-
-const
-  AnsiStrOffset = 1;
-
-function AnsiStringOfBytes(const Src : ByteArray) : AnsiString;
-var
- i : integer;
-begin
- SetLength(Result, Length(Src));
-
- for i := 0 to Length(Src) - 1 do
-   Result[i + AnsiStrOffset] := Chr(Src[i]);
-end;
-
-var
- A : ByteArray;
- B : AnsiString;
-begin
- DefaultSystemCodePage:=20127; // ASCII
- SetLength(A, 1); A[0] := $98;
- B := AnsiStringOfBytes(A);
- if ord(B[1]) <> $98 then
-   halt(1);
-end.
+program tsetansistr;
+
+{$mode delphi}
+{$modeswitch unicodestrings}
+
+type
+  ByteArray = array of byte;
+
+const
+  AnsiStrOffset = 1;
+
+function AnsiStringOfBytes(const Src : ByteArray) : AnsiString;
+var
+ i : integer;
+begin
+ SetLength(Result, Length(Src));
+
+ for i := 0 to Length(Src) - 1 do
+   Result[i + AnsiStrOffset] := Chr(Src[i]);
+end;
+
+var
+ A : ByteArray;
+ B : AnsiString;
+begin
+ DefaultSystemCodePage:=20127; // ASCII
+ SetLength(A, 1); A[0] := $98;
+ B := AnsiStringOfBytes(A);
+ if ord(B[1]) <> $98 then
+   halt(1);
+end.

tests/webtbs/tw19622.pp

@@ -1,33 +1,33 @@
-Var a,b:qword;
-      c:boolean;
-      aa,bb:longword;      
-Begin
-    a:=qword($FFFFFFFFFFFFFFFF);
-    b:=9223372036854775807;
-    c:=a>b;
-    if not c then
-      halt(1);
-    if not(qword($FFFFFFFFFFFFFFFF)>9223372036854775807) then
-      halt(2);
-    c:=qword($FFFFFFFFFFFFFFFF)>b;
-    if not c then
-      halt(3);
-    c:=18446744073709551615>=9223372036854775807;  
-    if not c then
-      halt(4);
-    
-    
-    aa:=$FFFFFFFF;
-    bb:=2147483647;
-    c:=aa>bb;
-    if not c then
-      halt(5);
-    if not ($FFFFFFFF>2147483647) then
-      halt(6);
-    c:=$FFFFFFFF>bb;
-    if not c then
-      halt(7);
-    c:=4294967295>=2147483647;
-    if not c then
-      halt(8);
-End.
+Var a,b:qword;
+      c:boolean;
+      aa,bb:longword;      
+Begin
+    a:=qword($FFFFFFFFFFFFFFFF);
+    b:=9223372036854775807;
+    c:=a>b;
+    if not c then
+      halt(1);
+    if not(qword($FFFFFFFFFFFFFFFF)>9223372036854775807) then
+      halt(2);
+    c:=qword($FFFFFFFFFFFFFFFF)>b;
+    if not c then
+      halt(3);
+    c:=18446744073709551615>=9223372036854775807;  
+    if not c then
+      halt(4);
+    
+    
+    aa:=$FFFFFFFF;
+    bb:=2147483647;
+    c:=aa>bb;
+    if not c then
+      halt(5);
+    if not ($FFFFFFFF>2147483647) then
+      halt(6);
+    c:=$FFFFFFFF>bb;
+    if not c then
+      halt(7);
+    c:=4294967295>=2147483647;
+    if not c then
+      halt(8);
+End.

tests/webtbs/tw20880.pp

@@ -1,21 +1,21 @@
-{ %interactive }
-
-program CrtBug;
-
-uses Crt;
-
-begin
-  ClrScr;
-  Window(windmaxx - 25, 5, windmaxx, 20);
-  TextColor(LightRed);
-  TextBackground(Cyan); 
-  ClrScr;  
-  
-  while not KeyPressed do
-  begin
-    Write('R=', Random(256), ' ');
-    Delay(100);
-  end;
-  
-  ReadKey;
-end.
+{ %interactive }
+
+program CrtBug;
+
+uses Crt;
+
+begin
+  ClrScr;
+  Window(windmaxx - 25, 5, windmaxx, 20);
+  TextColor(LightRed);
+  TextBackground(Cyan); 
+  ClrScr;  
+  
+  while not KeyPressed do
+  begin
+    Write('R=', Random(256), ' ');
+    Delay(100);
+  end;
+  
+  ReadKey;
+end.

tests/webtbs/tw23204.pp

@@ -1,21 +1,21 @@
-program tw23204;
-
-{$mode Delphi}{$H+}
-
-uses
-  uw23204;
-
-var
-  cur_p: TP;
-
-function DropP:TPs;
-begin
-  result := [cur_p.AType];
-end;
-
-
-begin
-  cur_p.AType:=pt_1;
-  if DropP<>[pt_1] then
-    halt(1);
-end.
+program tw23204;
+
+{$mode Delphi}{$H+}
+
+uses
+  uw23204;
+
+var
+  cur_p: TP;
+
+function DropP:TPs;
+begin
+  result := [cur_p.AType];
+end;
+
+
+begin
+  cur_p.AType:=pt_1;
+  if DropP<>[pt_1] then
+    halt(1);
+end.

tests/webtbs/tw23568.pp

@@ -1,59 +1,59 @@
-program tw23568;
-
-{$MODE DELPHI}
-
-type
-  TInteger32Boolean = record
-  public
-    Value: Integer;
-    
-    class operator Implicit(const Operand: TInteger32Boolean): Boolean;
-  end;
-  
-{ TInteger32Boolean }
-
-class operator TInteger32Boolean.Implicit(const Operand: TInteger32Boolean): Boolean;
-begin
-  Result := Operand.Value <> 0;
-  WriteLn('In TInteger32Boolean.Implicit()');
-end;
-
-var
-  Value:        TInteger32Boolean;
-  Intermediate: Boolean;
-
-begin
-  // Assign True to TInteger32Boolean
-  Value.Value := 1;
-  
-  // If statement using intermediate assignment through Intermediate
-  Intermediate := Value;
-
-  if Intermediate then
-    WriteLn('True')
-  else
-    halt(1);
-    
-  // If statement should perform implicit type conversion from TInteger32Boolean to Boolean
-  if Value then
-    WriteLn('True')
-  else
-    halt(2);
-    
-  // While statement should perform implicit type conversion as well
-  while Value do
-  begin
-    if Value.Value=0 then
-      halt(3);
-    Value.Value := 0;
-    WriteLn('While');
-  end;
-  
-  // Repeat until statement should perform implicit type conversion as well
-  repeat 
-    if Value.Value=1 then
-      halt(4);
-    Value.Value := 1;
-    WriteLn('Repeat until');
-  until Value;
-end.
+program tw23568;
+
+{$MODE DELPHI}
+
+type
+  TInteger32Boolean = record
+  public
+    Value: Integer;
+    
+    class operator Implicit(const Operand: TInteger32Boolean): Boolean;
+  end;
+  
+{ TInteger32Boolean }
+
+class operator TInteger32Boolean.Implicit(const Operand: TInteger32Boolean): Boolean;
+begin
+  Result := Operand.Value <> 0;
+  WriteLn('In TInteger32Boolean.Implicit()');
+end;
+
+var
+  Value:        TInteger32Boolean;
+  Intermediate: Boolean;
+
+begin
+  // Assign True to TInteger32Boolean
+  Value.Value := 1;
+  
+  // If statement using intermediate assignment through Intermediate
+  Intermediate := Value;
+
+  if Intermediate then
+    WriteLn('True')
+  else
+    halt(1);
+    
+  // If statement should perform implicit type conversion from TInteger32Boolean to Boolean
+  if Value then
+    WriteLn('True')
+  else
+    halt(2);
+    
+  // While statement should perform implicit type conversion as well
+  while Value do
+  begin
+    if Value.Value=0 then
+      halt(3);
+    Value.Value := 0;
+    WriteLn('While');
+  end;
+  
+  // Repeat until statement should perform implicit type conversion as well
+  repeat 
+    if Value.Value=1 then
+      halt(4);
+    Value.Value := 1;
+    WriteLn('Repeat until');
+  until Value;
+end.

tests/webtbs/tw23819.pp

@@ -1,38 +1,38 @@
-{ %norun }
-
-program tw23819;
-
-  type
-    fixstring = string [ 255 ] ;
-    t9496 = ( t94, t96 ) ;
-    tSD = ( sdSingle94, sdSingle96, sdDOuble94, sdDouble96 ) ;
-    tg = ( G0, G1, G2, G3 ) ;
-    tG13 = G1..G3 ;
-    tl = #$40..#$7f ;
-    ESCstring = string [ 7 ] ;
-    tgl9496 = {packed} object
-                sd : tSD ;
-                g : tg ;
-                l : tl ;
-                n : t9496 ;
-                procedure Put ( const pESCseq : ESCstring ) ;
-               end ;
-
-  procedure tgl9496.Put ( const pESCseq : ESCstring ) ;
-
-    var
-      yp : tgl9496 ;
-      locals : record
-                 Lst : FixString ;
-                 gc : Char ;
-                 gp,
-                 letp : LongInt ;
-                 xp : tgl9496 ;
-                end ;
-
-    begin
-    end ;
-
-
-begin
-end.
+{ %norun }
+
+program tw23819;
+
+  type
+    fixstring = string [ 255 ] ;
+    t9496 = ( t94, t96 ) ;
+    tSD = ( sdSingle94, sdSingle96, sdDOuble94, sdDouble96 ) ;
+    tg = ( G0, G1, G2, G3 ) ;
+    tG13 = G1..G3 ;
+    tl = #$40..#$7f ;
+    ESCstring = string [ 7 ] ;
+    tgl9496 = {packed} object
+                sd : tSD ;
+                g : tg ;
+                l : tl ;
+                n : t9496 ;
+                procedure Put ( const pESCseq : ESCstring ) ;
+               end ;
+
+  procedure tgl9496.Put ( const pESCseq : ESCstring ) ;
+
+    var
+      yp : tgl9496 ;
+      locals : record
+                 Lst : FixString ;
+                 gc : Char ;
+                 gp,
+                 letp : LongInt ;
+                 xp : tgl9496 ;
+                end ;
+
+    begin
+    end ;
+
+
+begin
+end.

tests/webtbs/tw23912.pp

@@ -1,93 +1,93 @@
-program crash_2_7_1;
-
-{$mode objfpc}{$H+}
-
-//uses
-
-type
-  TSynCommentType = (sctAnsi, sctBor, sctSlash);
-  TSynCommentIndentFlag = (
-    // * For Matching lines (FCommentMode)
-      // By default indent is the same as for none comment lines (none overrides sciAlignOpen)
-      sciNone,      // Does not Indent comment lines (Prefix may contain a fixed indent)
-      sciAlignOpen, // Indent to real opening pos on first line, if comment does not start at BOL "Foo(); (*"
-      sciAddTokenLen,        // add 1 or 2 spaces to indent (for the length of the token)
-      sciAddPastTokenIndent, // Adds any indent found past the opening token  "(*", "{" or "//".
-      sciMatchOnlyTokenLen,        // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified)
-      sciMatchOnlyPastTokenIndent,
-      sciAlignOnlyTokenLen,        // Apply the Above only if sciAlignOpen was used (include via max)
-      sciAlignOnlyPastTokenIndent,
-      sciApplyIndentForNoMatch  // Apply above rules For NONE Matching lines (FCommentMode),
-                                // includes FIndentFirstLineExtra
-    );
-  TSynCommentIndentFlags = set of TSynCommentIndentFlag;
-  TSynCommentContineMode = (
-      sccNoPrefix,      // May still do indent, if matched
-      sccPrefixAlways,  // If the pattern did not match all will be done, except the indent AFTER the prefix (can not be detected)
-      sccPrefixMatch
-    );
-  TSynCommentMatchMode = (
-      scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after
-      scmMatchOpening,      // will include (*,{,//. The ^ will match the ({/
-      scmMatchWholeLine,    // Match the entire line
-      scmMatchAtAsterisk    // AnsiComment only, will match the * of (*, but not the (
-    );
-  TSynCommentMatchLine = (
-      sclMatchFirst, // Match the first line of the comment to get substitutes for Prefix ($1)
-      sclMatchPrev   // Match the previous line of the comment to get substitutes for Prefix ($1)
-    );
-  TSynBeautifierIndentType = (sbitSpace, sbitCopySpaceTab, sbitPositionCaret);
-  TSynCommentExtendMode = (
-      sceNever,                // Never Extend
-      sceAlways,               // Always
-      sceSplitLine,            // If the line was split (caret was not at EOL, when enter was pressed
-      sceMatching,             // If the line matched (even if sccPrefixAlways or sccNoPrefix
-      sceMatchingSplitLine
-    );
-
-
-function dbgs(AIndentFlag: TSynCommentIndentFlag): String;
-begin
-  Result := ''; WriteStr(Result, AIndentFlag);
-end;
-
-function dbgs(AIndentFlags: TSynCommentIndentFlags): String;
-var
-  i: TSynCommentIndentFlag;
-begin
-  Result := '';
-  for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do
-    if i in AIndentFlags then
-      if Result = ''
-      then Result := dbgs(i)
-      else Result := Result + ',' + dbgs(i);
-  if Result <> '' then
-    Result := '[' + Result + ']';
-end;
-
-
-procedure Foo(Atype: TSynCommentType;
-    AIndentMode: TSynCommentIndentFlags;
-    AIndentFirstLineMax:   Integer; AIndentFirstLineExtra: String;
-    ACommentMode: TSynCommentContineMode; AMatchMode: TSynCommentMatchMode;
-    AMatchLine: TSynCommentMatchLine; ACommentIndent: TSynBeautifierIndentType;
-    AMatch: String;  APrefix: String;
-    AExtenbSlash: TSynCommentExtendMode = sceNever);
-var
-  s: String;
-begin
-    writestr(s, AType,':',
-             ' IMode=', dbgs(AIndentMode), ' IMax=', AIndentFirstLineMax, ' IExtra=', AIndentFirstLineExtra,
-             ' CMode=', ACommentMode, ' CMatch=', AMatchMode, ' CLine=', AMatchLine,
-             ' M=''', AMatch, ''' R=''', APrefix, ''' CIndent=', ACommentIndent
-            );
-    if s<>'sctAnsi: IMode=[sciAddTokenLen] IMax=5 IExtra=   CMode=sccPrefixMatch CMatch=scmMatchOpening CLine=sclMatchPrev M=''.'' R=''+'' CIndent=sbitCopySpaceTab' then
-      halt(1);
-end;
-
-begin
-  Foo(sctAnsi, [sciAddTokenLen], 5, '  ', sccPrefixMatch, scmMatchOpening,
-      sclMatchPrev, sbitCopySpaceTab, '.', '+');
-
-end.
-
+program crash_2_7_1;
+
+{$mode objfpc}{$H+}
+
+//uses
+
+type
+  TSynCommentType = (sctAnsi, sctBor, sctSlash);
+  TSynCommentIndentFlag = (
+    // * For Matching lines (FCommentMode)
+      // By default indent is the same as for none comment lines (none overrides sciAlignOpen)
+      sciNone,      // Does not Indent comment lines (Prefix may contain a fixed indent)
+      sciAlignOpen, // Indent to real opening pos on first line, if comment does not start at BOL "Foo(); (*"
+      sciAddTokenLen,        // add 1 or 2 spaces to indent (for the length of the token)
+      sciAddPastTokenIndent, // Adds any indent found past the opening token  "(*", "{" or "//".
+      sciMatchOnlyTokenLen,        // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified)
+      sciMatchOnlyPastTokenIndent,
+      sciAlignOnlyTokenLen,        // Apply the Above only if sciAlignOpen was used (include via max)
+      sciAlignOnlyPastTokenIndent,
+      sciApplyIndentForNoMatch  // Apply above rules For NONE Matching lines (FCommentMode),
+                                // includes FIndentFirstLineExtra
+    );
+  TSynCommentIndentFlags = set of TSynCommentIndentFlag;
+  TSynCommentContineMode = (
+      sccNoPrefix,      // May still do indent, if matched
+      sccPrefixAlways,  // If the pattern did not match all will be done, except the indent AFTER the prefix (can not be detected)
+      sccPrefixMatch
+    );
+  TSynCommentMatchMode = (
+      scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after
+      scmMatchOpening,      // will include (*,{,//. The ^ will match the ({/
+      scmMatchWholeLine,    // Match the entire line
+      scmMatchAtAsterisk    // AnsiComment only, will match the * of (*, but not the (
+    );
+  TSynCommentMatchLine = (
+      sclMatchFirst, // Match the first line of the comment to get substitutes for Prefix ($1)
+      sclMatchPrev   // Match the previous line of the comment to get substitutes for Prefix ($1)
+    );
+  TSynBeautifierIndentType = (sbitSpace, sbitCopySpaceTab, sbitPositionCaret);
+  TSynCommentExtendMode = (
+      sceNever,                // Never Extend
+      sceAlways,               // Always
+      sceSplitLine,            // If the line was split (caret was not at EOL, when enter was pressed
+      sceMatching,             // If the line matched (even if sccPrefixAlways or sccNoPrefix
+      sceMatchingSplitLine
+    );
+
+
+function dbgs(AIndentFlag: TSynCommentIndentFlag): String;
+begin
+  Result := ''; WriteStr(Result, AIndentFlag);
+end;
+
+function dbgs(AIndentFlags: TSynCommentIndentFlags): String;
+var
+  i: TSynCommentIndentFlag;
+begin
+  Result := '';
+  for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do
+    if i in AIndentFlags then
+      if Result = ''
+      then Result := dbgs(i)
+      else Result := Result + ',' + dbgs(i);
+  if Result <> '' then
+    Result := '[' + Result + ']';
+end;
+
+
+procedure Foo(Atype: TSynCommentType;
+    AIndentMode: TSynCommentIndentFlags;
+    AIndentFirstLineMax:   Integer; AIndentFirstLineExtra: String;
+    ACommentMode: TSynCommentContineMode; AMatchMode: TSynCommentMatchMode;
+    AMatchLine: TSynCommentMatchLine; ACommentIndent: TSynBeautifierIndentType;
+    AMatch: String;  APrefix: String;
+    AExtenbSlash: TSynCommentExtendMode = sceNever);
+var
+  s: String;
+begin
+    writestr(s, AType,':',
+             ' IMode=', dbgs(AIndentMode), ' IMax=', AIndentFirstLineMax, ' IExtra=', AIndentFirstLineExtra,
+             ' CMode=', ACommentMode, ' CMatch=', AMatchMode, ' CLine=', AMatchLine,
+             ' M=''', AMatch, ''' R=''', APrefix, ''' CIndent=', ACommentIndent
+            );
+    if s<>'sctAnsi: IMode=[sciAddTokenLen] IMax=5 IExtra=   CMode=sccPrefixMatch CMatch=scmMatchOpening CLine=sclMatchPrev M=''.'' R=''+'' CIndent=sbitCopySpaceTab' then
+      halt(1);
+end;
+
+begin
+  Foo(sctAnsi, [sciAddTokenLen], 5, '  ', sccPrefixMatch, scmMatchOpening,
+      sclMatchPrev, sbitCopySpaceTab, '.', '+');
+
+end.
+

tests/webtbs/uw23204.pp

@@ -1,18 +1,18 @@
-unit uw23204;
-
-//{$mode Delphi}{$H+} // error disappears!
-{$mode objfpc}{$H+}
-
-interface
-
-type
-//  TPColor = (pc1, pc2);
-  TPType = (pt_0, pt_1);
-  TP = record
-//    AColor: TPColor;
-    AType: TPType;
-  end;
-  TPs = set of TPType;
-
-implementation
-end.
+unit uw23204;
+
+//{$mode Delphi}{$H+} // error disappears!
+{$mode objfpc}{$H+}
+
+interface
+
+type
+//  TPColor = (pc1, pc2);
+  TPType = (pt_0, pt_1);
+  TP = record
+//    AColor: TPColor;
+    AType: TPType;
+  end;
+  TPs = set of TPType;
+
+implementation
+end.