Merge branch 'main' into mos6502

compiler/aoptobj.pas

@@ -2766,6 +2766,7 @@ Unit AoptObj;
         PassCount := 0;
 
         { Pass 2 is only executed multiple times under -O3 and above }
+        NotFirstIteration := False;
         repeat
           stoploop := True;
           p := BlockStart;
@@ -2787,6 +2788,9 @@ Unit AoptObj;
 
           Inc(PassCount);
 
+          if not stoploop then
+            NotFirstIteration := True;
+
         until stoploop or not (cs_opt_level3 in current_settings.optimizerswitches) or (PassCount >= MaxPasses_Pass2);
       end;
 

compiler/defcmp.pas

@@ -149,6 +149,11 @@ interface
     }
     function compare_paras(para1,para2 : TFPObjectList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
 
+    { Compares the compatibility of two return types (in contrast to
+      compare_defs the cdo_strict_undefined_check will be passed to
+      compare_defs_ext as well) }
+    function compare_rettype(def1,def2:tdef):tequaltype;
+
     { True if a function can be assigned to a procvar }
     { changed first argument type to pabstractprocdef so that it can also be }
     { used to test compatibility between two pprocvardefs (JM)               }
@@ -2543,6 +2548,15 @@ implementation
       end;
 
 
+    function compare_rettype(def1,def2:tdef):tequaltype;
+      var
+        doconv : tconverttype;
+        pd : tprocdef;
+      begin
+        result:=compare_defs_ext(def1,def2,nothingn,doconv,pd,[cdo_check_operator,cdo_allow_variant,cdo_strict_undefined_check]);
+      end;
+
+
     function proc_to_procvar_equal_internal(def1:tabstractprocdef;def2:tabstractprocdef;checkincompatibleuniv,ignoreself: boolean):tequaltype;
       var
         eq: tequaltype;

compiler/globtype.pas

@@ -834,7 +834,9 @@ interface
          { x86 only: subroutine uses ymm registers, requires vzeroupper call }
          pi_uses_ymm,
          { set if no frame pointer is needed, the rules when this applies is target specific }
-         pi_no_framepointer_needed
+         pi_no_framepointer_needed,
+         { procedure has been normalized so no expressions contain block nodes }
+         pi_normalized
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/hlcgobj.pas

@@ -404,6 +404,19 @@ unit hlcgobj;
           procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); virtual; abstract;
 {$endif cpuflags}
 
+          {
+             This routine tries to optimize the op_const_reg/ref opcode, and should be
+             called at the start of a_op_const_reg/ref. It returns the actual opcode
+             to emit, and the constant value to emit. This function can opcode OP_NONE to
+             remove the opcode and OP_MOVE to replace it with a simple load
+
+             @param(size Size of the operand in constant)
+             @param(op The opcode to emit, returns the opcode which must be emitted)
+             @param(a  The constant which should be emitted, returns the constant which must
+                    be emitted)
+          }
+          procedure optimize_op_const(size: tdef; var op: topcg; var a : tcgint);virtual;
+
           {#
               This routine is used in exception management nodes. It should
               save the exception reason currently in the reg. The
@@ -1552,8 +1565,8 @@ implementation
       loadbitsize:=loadsize.size*8;
 
       { load the (first part) of the bit sequence }
-      valuereg:=getintregister(list,osuinttype);
-      a_load_ref_reg(list,loadsize,osuinttype,sref.ref,valuereg);
+      valuereg:=getintregister(list,aluuinttype);
+      a_load_ref_reg(list,loadsize,aluuinttype,sref.ref,valuereg);
 
       if not extra_load then
         begin
@@ -1562,7 +1575,7 @@ implementation
             begin
               { use subsetreg routine, it may have been overridden with an optimized version }
               tosreg.subsetreg:=valuereg;
-              tosreg.subsetregsize:=def_cgsize(osuinttype);
+              tosreg.subsetregsize:=def_cgsize(aluuinttype);
               { subsetregs always count bits from right to left }
               if (target_info.endian=endian_big) then
                 tosreg.startbit:=loadbitsize-(sref.startbit+sref.bitlen)
@@ -1578,40 +1591,40 @@ implementation
                 internalerror(2006081510);
               if (target_info.endian=endian_big) then
                 begin
-                  a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,valuereg);
+                  a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,valuereg);
                   if is_signed(fromsubsetsize) then
                     begin
                       { sign extend to entire register }
-                      a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize,valuereg);
-                      a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
+                      a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-loadbitsize,valuereg);
+                      a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,valuereg);
                     end
                   else
-                    a_op_const_reg(list,OP_SHR,osuinttype,loadbitsize-sref.bitlen,valuereg);
+                    a_op_const_reg(list,OP_SHR,aluuinttype,loadbitsize-sref.bitlen,valuereg);
                 end
               else
                 begin
-                  a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,valuereg);
+                  a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,valuereg);
                   if is_signed(fromsubsetsize) then
                     begin
-                      a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen,valuereg);
-                      a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
+                      a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-sref.bitlen,valuereg);
+                      a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,valuereg);
                     end
                 end;
               { mask other bits/sign extend }
               if not is_signed(fromsubsetsize) then
-                a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
+                a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
             end
         end
       else
         begin
           { load next value as well }
-          extra_value_reg:=getintregister(list,osuinttype);
+          extra_value_reg:=getintregister(list,aluuinttype);
 
           if (sref.bitindexreg=NR_NO) then
             begin
               tmpref:=sref.ref;
               inc(tmpref.offset,loadbitsize div 8);
-              a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
+              a_load_ref_reg(list,loadsize,aluuinttype,tmpref,extra_value_reg);
               { can be overridden to optimize }
               a_load_subsetref_regs_noindex(list,fromsubsetsize,loadbitsize,sref,valuereg,extra_value_reg)
             end
@@ -1633,7 +1646,7 @@ implementation
 {$else}
       { can't juggle with register sizes, they are actually typed entities
         here }
-      a_load_reg_reg(list,osuinttype,tosize,valuereg,destreg);
+      a_load_reg_reg(list,aluuinttype,tosize,valuereg,destreg);
 {$endif}
     end;
 
@@ -1648,13 +1661,13 @@ implementation
             internalerror(2019052901);
           tmpsref:=sref;
           tmpsref.bitlen:=AIntBits;
-          fromreg1:=hlcg.getintregister(list,uinttype);
-          a_load_reg_reg(list,fromsize,uinttype,fromreg,fromreg1);
+          fromreg1:=hlcg.getintregister(list,aluuinttype);
+          a_load_reg_reg(list,fromsize,aluuinttype,fromreg,fromreg1);
           if target_info.endian=endian_big then
             begin
               inc(tmpsref.ref.offset,sref.bitlen-AIntBits);
             end;
-          a_load_reg_subsetref(list,uinttype,uinttype,fromreg1,tmpsref);
+          a_load_reg_subsetref(list,aluuinttype,aluuinttype,fromreg1,tmpsref);
           if target_info.endian=endian_big then
             begin
               tmpsref.ref.offset:=sref.ref.offset;
@@ -2112,37 +2125,37 @@ implementation
           if is_signed(subsetsize) then
             begin
               { sign extend }
-              a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize+sref.startbit,valuereg);
-              a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
+              a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-loadbitsize+sref.startbit,valuereg);
+              a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,valuereg);
             end
           else
             begin
-              a_op_const_reg(list,OP_SHL,osuinttype,restbits,valuereg);
+              a_op_const_reg(list,OP_SHL,aluuinttype,restbits,valuereg);
               { mask other bits }
               if (sref.bitlen<>AIntBits) then
-                a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
+                a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
             end;
-          a_op_const_reg(list,OP_SHR,osuinttype,loadbitsize-restbits,extra_value_reg)
+          a_op_const_reg(list,OP_SHR,aluuinttype,loadbitsize-restbits,extra_value_reg)
         end
       else
         begin
           { valuereg contains the lower bits, extra_value_reg the upper }
-          a_op_const_reg(list,OP_SHR,osuinttype,sref.startbit,valuereg);
+          a_op_const_reg(list,OP_SHR,aluuinttype,sref.startbit,valuereg);
           if is_signed(subsetsize) then
             begin
-              a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen+loadbitsize-sref.startbit,extra_value_reg);
-              a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,extra_value_reg);
+              a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-sref.bitlen+loadbitsize-sref.startbit,extra_value_reg);
+              a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,extra_value_reg);
             end
           else
             begin
-              a_op_const_reg(list,OP_SHL,osuinttype,loadbitsize-sref.startbit,extra_value_reg);
+              a_op_const_reg(list,OP_SHL,aluuinttype,loadbitsize-sref.startbit,extra_value_reg);
               { mask other bits }
               if (sref.bitlen <> AIntBits) then
-                a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),extra_value_reg);
+                a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),extra_value_reg);
             end;
         end;
       { merge }
-      a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
+      a_op_reg_reg(list,OP_OR,aluuinttype,extra_value_reg,valuereg);
     end;
 
   procedure thlcgobj.a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister);
@@ -2152,10 +2165,10 @@ implementation
       extra_value_reg,
       tmpreg: tregister;
     begin
-      tmpreg:=getintregister(list,osuinttype);
+      tmpreg:=getintregister(list,aluuinttype);
       tmpref:=sref.ref;
       inc(tmpref.offset,loadbitsize div 8);
-      extra_value_reg:=getintregister(list,osuinttype);
+      extra_value_reg:=getintregister(list,aluuinttype);
 
       if (target_info.endian=endian_big) then
         begin
@@ -2163,71 +2176,71 @@ implementation
           { is entirely in valuereg.                                      }
 
           { get the data in valuereg in the right place }
-          a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,valuereg);
+          a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,valuereg);
           if is_signed(subsetsize) then
             begin
-              a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize,valuereg);
-              a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg)
+              a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-loadbitsize,valuereg);
+              a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,valuereg)
             end
           else
             begin
-              a_op_const_reg(list,OP_SHR,osuinttype,loadbitsize-sref.bitlen,valuereg);
+              a_op_const_reg(list,OP_SHR,aluuinttype,loadbitsize-sref.bitlen,valuereg);
               if (loadbitsize<>AIntBits) then
                 { mask left over bits }
-                a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
+                a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
             end;
-          tmpreg := getintregister(list,osuinttype);
+          tmpreg := getintregister(list,aluuinttype);
 
           { ensure we don't load anything past the end of the array }
           current_asmdata.getjumplabel(hl);
-          a_cmp_const_reg_label(list,osuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
+          a_cmp_const_reg_label(list,aluuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
 
           { the bits in extra_value_reg (if any) start at the most significant bit =>         }
           { extra_value_reg must be shr by (loadbitsize-sref.bitlen)+(loadsize-sref.bitindex) }
           { => = -(sref.bitindex+(sref.bitlen-2*loadbitsize))                                 }
-          a_op_const_reg_reg(list,OP_ADD,osuinttype,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpreg);
-          a_op_reg_reg(list,OP_NEG,osuinttype,tmpreg,tmpreg);
+          a_op_const_reg_reg(list,OP_ADD,aluuinttype,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpreg);
+          a_op_reg_reg(list,OP_NEG,aluuinttype,tmpreg,tmpreg);
 
           { load next "loadbitsize" bits of the array }
-          a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),osuinttype,tmpref,extra_value_reg);
+          a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),aluuinttype,tmpref,extra_value_reg);
 
-          a_op_reg_reg(list,OP_SHR,osuinttype,tmpreg,extra_value_reg);
+          a_op_reg_reg(list,OP_SHR,aluuinttype,tmpreg,extra_value_reg);
           { if there are no bits in extra_value_reg, then sref.bitindex was      }
           { < loadsize-sref.bitlen, and therefore tmpreg will now be >= loadsize }
           { => extra_value_reg is now 0                                          }
           { merge }
-          a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
+          a_op_reg_reg(list,OP_OR,aluuinttype,extra_value_reg,valuereg);
           { no need to mask, necessary masking happened earlier on }
           a_label(list,hl);
         end
       else
         begin
-          a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,valuereg);
+          a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,valuereg);
 
           { ensure we don't load anything past the end of the array }
           current_asmdata.getjumplabel(hl);
-          a_cmp_const_reg_label(list,osuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
+          a_cmp_const_reg_label(list,aluuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
 
           { Y-x = -(Y-x) }
-          a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpreg);
-          a_op_reg_reg(list,OP_NEG,osuinttype,tmpreg,tmpreg);
+          a_op_const_reg_reg(list,OP_SUB,aluuinttype,loadbitsize,sref.bitindexreg,tmpreg);
+          a_op_reg_reg(list,OP_NEG,aluuinttype,tmpreg,tmpreg);
 
           { load next "loadbitsize" bits of the array }
-          a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),osuinttype,tmpref,extra_value_reg);
+          a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),aluuinttype,tmpref,extra_value_reg);
 
           { tmpreg is in the range 1..<cpu_bitsize>-1 -> always ok }
-          a_op_reg_reg(list,OP_SHL,osuinttype,tmpreg,extra_value_reg);
+          a_op_reg_reg(list,OP_SHL,aluuinttype,tmpreg,extra_value_reg);
           { merge }
-          a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
+          a_op_reg_reg(list,OP_OR,aluuinttype,extra_value_reg,valuereg);
           a_label(list,hl);
           { sign extend or mask other bits }
           if is_signed(subsetsize) then
             begin
-              a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen,valuereg);
-              a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
+              a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-sref.bitlen,valuereg);
+              a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,valuereg);
             end
           else
-            a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
+            a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
         end;
     end;
 
@@ -2250,8 +2263,8 @@ implementation
       loadbitsize:=loadsize.size*8;
 
       { load the (first part) of the bit sequence }
-      valuereg:=getintregister(list,osuinttype);
-      a_load_ref_reg(list,loadsize,osuinttype,sref.ref,valuereg);
+      valuereg:=getintregister(list,aluuinttype);
+      a_load_ref_reg(list,loadsize,aluuinttype,sref.ref,valuereg);
 
       { constant offset of bit sequence? }
       if not extra_load then
@@ -2260,7 +2273,7 @@ implementation
             begin
               { use subsetreg routine, it may have been overridden with an optimized version }
               tosreg.subsetreg:=valuereg;
-              tosreg.subsetregsize:=def_cgsize(osuinttype);
+              tosreg.subsetregsize:=def_cgsize(aluuinttype);
               { subsetregs always count bits from right to left }
               if (target_info.endian=endian_big) then
                 tosreg.startbit:=loadbitsize-(sref.startbit+sref.bitlen)
@@ -2283,86 +2296,86 @@ implementation
                 begin
                   if (slopt=SL_SETZERO) and (sref.bitlen=1) and (target_info.endian=endian_little) then
                     begin
-                      a_bit_set_reg_reg(list,false,osuinttype,osuinttype,sref.bitindexreg,valuereg);
+                      a_bit_set_reg_reg(list,false,aluuinttype,aluuinttype,sref.bitindexreg,valuereg);
 
                       { store back to memory }
                       tmpreg:=getintregister(list,loadsize);
-                      a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+                      a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
                       a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
                       exit;
                     end
                   else
                     begin
-                      maskreg:=getintregister(list,osuinttype);
+                      maskreg:=getintregister(list,aluuinttype);
                       if (target_info.endian = endian_big) then
                         begin
-                          a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg);
-                          a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,maskreg);
+                          a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg);
+                          a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,maskreg);
                         end
                       else
                         begin
-                          a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                          a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
+                          a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                          a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,maskreg);
                         end;
-                      a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                      a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
+                      a_op_reg_reg(list,OP_NOT,aluuinttype,maskreg,maskreg);
+                      a_op_reg_reg(list,OP_AND,aluuinttype,maskreg,valuereg);
                     end;
                 end;
 
               { insert the value }
               if (slopt<>SL_SETZERO) then
                 begin
-                  tmpreg:=getintregister(list,osuinttype);
+                  tmpreg:=getintregister(list,aluuinttype);
                   if (slopt<>SL_SETMAX) then
-                    a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                    a_load_reg_reg(list,fromsize,aluuinttype,fromreg,tmpreg)
                   { setting of a single bit?
                     then we might take advantage of the CPU's bit set instruction }
                   else if (sref.bitlen=1) and (target_info.endian=endian_little) then
                     begin
-                      a_bit_set_reg_reg(list,true,osuinttype,osuinttype,sref.bitindexreg,valuereg);
+                      a_bit_set_reg_reg(list,true,aluuinttype,aluuinttype,sref.bitindexreg,valuereg);
 
                       { store back to memory }
                       tmpreg:=getintregister(list,loadsize);
-                      a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+                      a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
                       a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
                       exit;
                     end
                   else if (sref.bitlen<>AIntBits) then
-                    a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
+                    a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
                   else
-                    a_load_const_reg(list,osuinttype,-1,tmpreg);
+                    a_load_const_reg(list,aluuinttype,-1,tmpreg);
                   if (target_info.endian=endian_big) then
                     begin
-                      a_op_const_reg(list,OP_SHL,osuinttype,loadbitsize-sref.bitlen,tmpreg);
+                      a_op_const_reg(list,OP_SHL,aluuinttype,loadbitsize-sref.bitlen,tmpreg);
                       if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
                         begin
                           if (loadbitsize<>AIntBits) then
                             bitmask:=(((aword(1) shl loadbitsize)-1) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1))
                           else
                             bitmask:=(high(aword) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1));
-                          a_op_const_reg(list,OP_AND,osuinttype,bitmask,tmpreg);
+                          a_op_const_reg(list,OP_AND,aluuinttype,bitmask,tmpreg);
                         end;
-                      a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,tmpreg);
+                      a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,tmpreg);
                     end
                   else
                     begin
                       if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
-                        a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
-                      a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
+                        a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
+                      a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,tmpreg);
                     end;
-                  a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
+                  a_op_reg_reg(list,OP_OR,aluuinttype,tmpreg,valuereg);
                 end;
             end;
           { store back to memory }
           tmpreg:=getintregister(list,loadsize);
-          a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+          a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
           a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
           exit;
         end
       else
         begin
           { load next value }
-          extra_value_reg:=getintregister(list,osuinttype);
+          extra_value_reg:=getintregister(list,aluuinttype);
           tmpref:=sref.ref;
           inc(tmpref.offset,loadbitsize div 8);
 
@@ -2370,12 +2383,12 @@ implementation
           { on e.g. i386 with shld/shrd                                 }
           if (sref.bitindexreg = NR_NO) then
             begin
-              a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
+              a_load_ref_reg(list,loadsize,aluuinttype,tmpref,extra_value_reg);
 
               fromsreg.subsetreg:=fromreg;
               fromsreg.subsetregsize:=def_cgsize(fromsize);
               tosreg.subsetreg:=valuereg;
-              tosreg.subsetregsize:=def_cgsize(osuinttype);
+              tosreg.subsetregsize:=def_cgsize(aluuinttype);
 
               { transfer first part }
               fromsreg.bitlen:=loadbitsize-sref.startbit;
@@ -2410,7 +2423,7 @@ implementation
               a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref);
 {$else}
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
 {$endif}
 
@@ -2444,7 +2457,7 @@ implementation
                   a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
               end;
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,extra_value_reg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
               exit;
             end
@@ -2460,114 +2473,114 @@ implementation
               { generate mask to zero the bits we have to insert }
               if (slopt <> SL_SETMAX) then
                 begin
-                  maskreg := getintregister(list,osuinttype);
+                  maskreg := getintregister(list,aluuinttype);
                   if (target_info.endian = endian_big) then
                     begin
-                      a_load_const_reg(list,osuinttype,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),maskreg);
-                      a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,maskreg);
+                      a_load_const_reg(list,aluuinttype,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),maskreg);
+                      a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,maskreg);
                     end
                   else
                     begin
-                      a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                      a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
+                      a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                      a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,maskreg);
                     end;
 
-                  a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                  a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
+                  a_op_reg_reg(list,OP_NOT,aluuinttype,maskreg,maskreg);
+                  a_op_reg_reg(list,OP_AND,aluuinttype,maskreg,valuereg);
                 end;
 
               { insert the value }
               if (slopt <> SL_SETZERO) then
                 begin
-                  tmpreg := getintregister(list,osuinttype);
+                  tmpreg := getintregister(list,aluuinttype);
                   if (slopt <> SL_SETMAX) then
-                    a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                    a_load_reg_reg(list,fromsize,aluuinttype,fromreg,tmpreg)
                   else if (sref.bitlen <> AIntBits) then
-                    a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
+                    a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
                   else
-                    a_load_const_reg(list,osuinttype,-1,tmpreg);
+                    a_load_const_reg(list,aluuinttype,-1,tmpreg);
                   if (target_info.endian = endian_big) then
                     begin
-                      a_op_const_reg(list,OP_SHL,osuinttype,loadbitsize-sref.bitlen,tmpreg);
+                      a_op_const_reg(list,OP_SHL,aluuinttype,loadbitsize-sref.bitlen,tmpreg);
                       if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
                         { mask left over bits }
-                        a_op_const_reg(list,OP_AND,osuinttype,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),tmpreg);
-                      a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,tmpreg);
+                        a_op_const_reg(list,OP_AND,aluuinttype,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),tmpreg);
+                      a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,tmpreg);
                     end
                   else
                     begin
                       if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
                         { mask left over bits }
-                        a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
-                      a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
+                        a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
+                      a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,tmpreg);
                     end;
-                  a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
+                  a_op_reg_reg(list,OP_OR,aluuinttype,tmpreg,valuereg);
                 end;
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
 
               { make sure we do not read/write past the end of the array }
               current_asmdata.getjumplabel(hl);
-              a_cmp_const_reg_label(list,osuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
+              a_cmp_const_reg_label(list,aluuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
 
-              a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
-              tmpindexreg:=getintregister(list,osuinttype);
+              a_load_ref_reg(list,loadsize,aluuinttype,tmpref,extra_value_reg);
+              tmpindexreg:=getintregister(list,aluuinttype);
 
               { load current array value }
               if (slopt<>SL_SETZERO) then
                 begin
-                  tmpreg:=getintregister(list,osuinttype);
+                  tmpreg:=getintregister(list,aluuinttype);
                   if (slopt<>SL_SETMAX) then
-                     a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                     a_load_reg_reg(list,fromsize,aluuinttype,fromreg,tmpreg)
                   else if (sref.bitlen<>AIntBits) then
-                    a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
+                    a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
                   else
-                    a_load_const_reg(list,osuinttype,-1,tmpreg);
+                    a_load_const_reg(list,aluuinttype,-1,tmpreg);
                 end;
 
               { generate mask to zero the bits we have to insert }
               if (slopt<>SL_SETMAX) then
                 begin
-                  maskreg:=getintregister(list,osuinttype);
+                  maskreg:=getintregister(list,aluuinttype);
                   if (target_info.endian=endian_big) then
                     begin
-                      a_op_const_reg_reg(list,OP_ADD,osuinttype,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpindexreg);
-                      a_op_reg_reg(list,OP_NEG,osuinttype,tmpindexreg,tmpindexreg);
-                      a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                      a_op_reg_reg(list,OP_SHL,osuinttype,tmpindexreg,maskreg);
+                      a_op_const_reg_reg(list,OP_ADD,aluuinttype,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpindexreg);
+                      a_op_reg_reg(list,OP_NEG,aluuinttype,tmpindexreg,tmpindexreg);
+                      a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                      a_op_reg_reg(list,OP_SHL,aluuinttype,tmpindexreg,maskreg);
                     end
                   else
                     begin
                       { Y-x = -(x-Y) }
-                      a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpindexreg);
-                      a_op_reg_reg(list,OP_NEG,osuinttype,tmpindexreg,tmpindexreg);
-                      a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                      a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,maskreg);
+                      a_op_const_reg_reg(list,OP_SUB,aluuinttype,loadbitsize,sref.bitindexreg,tmpindexreg);
+                      a_op_reg_reg(list,OP_NEG,aluuinttype,tmpindexreg,tmpindexreg);
+                      a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                      a_op_reg_reg(list,OP_SHR,aluuinttype,tmpindexreg,maskreg);
                     end;
 
-                  a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                  a_op_reg_reg(list,OP_AND,osuinttype,maskreg,extra_value_reg);
+                  a_op_reg_reg(list,OP_NOT,aluuinttype,maskreg,maskreg);
+                  a_op_reg_reg(list,OP_AND,aluuinttype,maskreg,extra_value_reg);
                 end;
 
               if (slopt<>SL_SETZERO) then
                 begin
                   if (target_info.endian=endian_big) then
-                    a_op_reg_reg(list,OP_SHL,osuinttype,tmpindexreg,tmpreg)
+                    a_op_reg_reg(list,OP_SHL,aluuinttype,tmpindexreg,tmpreg)
                   else
                     begin
                       if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
-                        a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
-                      a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,tmpreg);
+                        a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
+                      a_op_reg_reg(list,OP_SHR,aluuinttype,tmpindexreg,tmpreg);
                     end;
-                  a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,extra_value_reg);
+                  a_op_reg_reg(list,OP_OR,aluuinttype,tmpreg,extra_value_reg);
                 end;
 {$ifndef cpuhighleveltarget}
               extra_value_reg:=cg.makeregsize(list,extra_value_reg,def_cgsize(loadsize));
               a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref);
 {$else}
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,extra_value_reg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
 {$endif}
 
@@ -2679,9 +2692,9 @@ implementation
           reference_reset_base(result.ref,refptrdef,newbase,0,result.ref.temppos,result.ref.alignment,[]);
         end;
       result.ref.index:=tmpreg;
-      tmpreg:=getintregister(list,ptruinttype);
-      a_load_reg_reg(list,bitnumbersize,ptruinttype,bitnumber,tmpreg);
-      a_op_const_reg(list,OP_AND,ptruinttype,7,tmpreg);
+      tmpreg:=getintregister(list,aluuinttype);
+      a_load_reg_reg(list,bitnumbersize,aluuinttype,bitnumber,tmpreg);
+      a_op_const_reg(list,OP_AND,aluuinttype,7,tmpreg);
       result.bitindexreg:=tmpreg;
     end;
 
@@ -3416,6 +3429,128 @@ implementation
       a_jmp_always(list,l);
     end;
 
+  procedure thlcgobj.optimize_op_const(size: tdef; var op: topcg; var a: tcgint);
+    var
+      powerval : longint;
+      signext_a, zeroext_a: tcgint;
+      cgsize: TCgSize;
+    begin
+      cgsize:=def_cgsize(size);
+      case cgsize of
+        OS_64,OS_S64:
+          begin
+            signext_a:=int64(a);
+            zeroext_a:=int64(a);
+          end;
+        OS_32,OS_S32:
+          begin
+            signext_a:=longint(a);
+            zeroext_a:=dword(a);
+          end;
+        OS_16,OS_S16:
+          begin
+            signext_a:=smallint(a);
+            zeroext_a:=word(a);
+          end;
+        OS_8,OS_S8:
+          begin
+            signext_a:=shortint(a);
+            zeroext_a:=byte(a);
+          end
+        else
+          begin
+            { Should we internalerror() here instead? }
+            signext_a:=a;
+            zeroext_a:=a;
+          end;
+      end;
+      case op of
+        OP_OR :
+          begin
+            { or with zero returns same result }
+            if a = 0 then
+              op:=OP_NONE
+            else
+            { or with max returns max }
+              if signext_a = -1 then
+                op:=OP_MOVE;
+          end;
+        OP_AND :
+          begin
+            { and with max returns same result }
+            if (signext_a = -1) then
+              op:=OP_NONE
+            else
+            { and with 0 returns 0 }
+              if a=0 then
+                op:=OP_MOVE;
+          end;
+        OP_XOR :
+          begin
+            { xor with zero returns same result }
+            if a = 0 then
+              op:=OP_NONE;
+          end;
+        OP_DIV :
+          begin
+            { division by 1 returns result }
+            if a = 1 then
+              op:=OP_NONE
+            else if ispowerof2(int64(zeroext_a), powerval) and not(cs_check_overflow in current_settings.localswitches) then
+              begin
+                a := powerval;
+                op:= OP_SHR;
+              end;
+          end;
+        OP_IDIV:
+          begin
+            if a = 1 then
+              op:=OP_NONE;
+          end;
+       OP_MUL,OP_IMUL:
+          begin
+             if a = 1 then
+               op:=OP_NONE
+             else
+               if a=0 then
+                 op:=OP_MOVE
+             else if ispowerof2(int64(zeroext_a), powerval) and not(cs_check_overflow in current_settings.localswitches)  then
+               begin
+                 a := powerval;
+                 op:= OP_SHL;
+               end;
+          end;
+      OP_ADD,OP_SUB:
+          begin
+             if a = 0 then
+               op:=OP_NONE;
+          end;
+      OP_SAR,OP_SHL,OP_SHR:
+         begin
+           if a = 0 then
+             op:=OP_NONE;
+         end;
+      OP_ROL,OP_ROR:
+        begin
+          case cgsize of
+            OS_64,OS_S64:
+              a:=a and 63;
+            OS_32,OS_S32:
+              a:=a and 31;
+            OS_16,OS_S16:
+              a:=a and 15;
+            OS_8,OS_S8:
+              a:=a and 7;
+            else
+              internalerror(2019050521);
+          end;
+          if a = 0 then
+            op:=OP_NONE;
+        end;
+      else
+        ;
+      end;
+    end;
 
   procedure thlcgobj.g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference);
     begin

compiler/i386/i386nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-6968;
+6968;

compiler/i386/i386prop.inc

@@ -1523,10 +1523,10 @@
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/i8086/i8086nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-7000;
+7000;

compiler/i8086/i8086prop.inc

@@ -1537,10 +1537,10 @@
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/ncal.pas

@@ -4266,6 +4266,9 @@ implementation
                    { if the final procedure definition is not yet owned,
                      ensure that it is }
                    procdefinition.register_def;
+                   if (procdefinition.typ=procdef) and assigned(tprocdef(procdefinition).procsym) then
+                     tprocdef(procdefinition).procsym.register_sym;
+
                    if procdefinition.is_specialization and (procdefinition.typ=procdef) then
                      maybe_add_pending_specialization(procdefinition,candidates.para_anon_syms);
 

compiler/ncgmem.pas

@@ -720,17 +720,17 @@ implementation
            warning }
 {$push}
 {$warn 6018 off}
-         { we can reuse hreg only if OS_INT and OS_ADDR have the same size/type }
-         if OS_INT<>OS_ADDR then
+         { we can reuse hreg only if aluuinttype and get_address_type have the same size/type }
+         if aluuinttype.size<>get_address_type.size then
            begin
-             sref.bitindexreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-             cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_INT,hreg,sref.bitindexreg);
+             sref.bitindexreg := hlcg.getintregister(current_asmdata.CurrAsmList,aluuinttype);
+             hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,get_address_type,aluuinttype,hreg,sref.bitindexreg);
            end
          else
            sref.bitindexreg:=hreg;
 {$pop}
 
-         hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,ossinttype,(1 shl (3+alignpower))-1,sref.bitindexreg);
+         hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,aluuinttype,(1 shl (3+alignpower))-1,sref.bitindexreg);
          sref.startbit := 0;
          sref.bitlen := resultdef.packedbitsize;
          if (left.location.loc = LOC_REFERENCE) then

compiler/nflw.pas

@@ -1368,17 +1368,18 @@ implementation
                   taddnode(left).left.isequal(tcallparanode(tinlinenode(p).left).left) and
                   not(assigned(tcallparanode(tinlinenode(p).left).right)) then
                   begin
-                    result:=cifnode.create_internal(left.getcopy,getcopy,nil);
-                    include(twhilerepeatnode(tifnode(result).right).loopflags,lnf_checknegate);
-                    exclude(twhilerepeatnode(tifnode(result).right).loopflags,lnf_testatbegin);
+                    result:=cifnode.create_internal(left.getcopy,cwhilerepeatnode.create(left,right,false,true),nil);
+                    left:=nil;
+                    right:=nil;
                     twhilerepeatnode(tifnode(result).right).left.nodetype:=equaln;
                   end;
               end
             else if not(cs_opt_size in current_settings.optimizerswitches) and
               (node_complexity(left)<=3) then
               begin
-                result:=cifnode.create_internal(left.getcopy,getcopy,nil);
-                exclude(twhilerepeatnode(tifnode(result).right).loopflags,lnf_testatbegin);
+                result:=cifnode.create_internal(left.getcopy,cwhilerepeatnode.create(left,right,false,false),nil);
+                left:=nil;
+                right:=nil;
               end;
           end;
       end;

compiler/nobj.pas

@@ -91,7 +91,16 @@ implementation
           descendent Objective-C class }
         if not allowoverridingmethod and
            (po_overridingmethod in pd.procoptions) then
-          MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
+          begin
+            MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(true));
+            for i:=0 to _class.vmtentries.count-1 do
+              begin
+                vmtentry:=pvmtentry(_class.vmtentries[i]);
+                vmtpd:=tprocdef(vmtentry^.procdef);
+                if (upper(vmtpd.procsym.realname)=upper(pd.procsym.realname)) then
+                  MessagePos1(vmtpd.fileinfo,sym_h_param_list,vmtpd.fullprocname(true));
+	      end;
+          end;
 
         { check that all methods have overload directive }
         if not(m_fpc in current_settings.modeswitches) then

compiler/opttree.pas

@@ -0,0 +1,227 @@
+{
+    General tree transformations
+
+    Copyright (c) 2013 by Florian Klaempfl
+
+    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.
+
+ ****************************************************************************
+}
+
+{ $define DEBUG_NORMALIZE}
+
+{ this unit implements routines to perform all-purpose tree transformations }
+unit opttree;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      node,optutils;
+
+    { tries to bring the tree in a normalized form:
+       - expressions are free of control statements
+       - callinitblock/callcleanupblocks are converted into statements
+
+      rationale is that this simplifies data flow analysis
+
+      returns true, if this was successful
+    }
+    function normalize(var n : tnode) : Boolean;
+
+  implementation
+
+    uses
+      verbose,
+      globtype,
+      defutil,
+      nbas,nld,ncal,
+      nutils,
+      pass_1;
+
+    function searchstatements(var n : tnode;arg : pointer) : foreachnoderesult;forward;
+
+    function hasblock(var n : tnode;arg : pointer) : foreachnoderesult;
+      begin
+        result:=fen_false;
+        if n.nodetype=blockn then
+          result:=fen_norecurse_true;
+      end;
+
+    function searchblock(var n : tnode;arg : pointer) : foreachnoderesult;
+      var
+        hp,
+        statements,
+        stmnt : tstatementnode;
+        res : pnode;
+        tempcreatenode : ttempcreatenode;
+        newblock : tnode;
+      begin
+        result:=fen_true;
+        if n.nodetype in [addn,orn] then
+          begin
+            { so far we cannot fiddle with short boolean evaluations containing blocks }
+            if doshortbooleval(n) and foreachnodestatic(n,@hasblock,nil) then
+              begin
+                result:=fen_norecurse_false;
+                exit;
+              end;
+          end;
+        case n.nodetype of
+          calln:
+            begin
+              if assigned(tcallnode(n).callinitblock) then
+                begin
+                  { create a new statement node and insert it }
+                  hp:=cstatementnode.create(tcallnode(n).callinitblock,pnode(arg)^);
+                  pnode(arg)^:=hp;
+                  { tree moved }
+                  tcallnode(n).callinitblock:=nil;
+                  { process the newly generated block }
+                  foreachnodestatic(pnode(arg)^,@searchstatements,nil);
+                end;
+              if assigned(tcallnode(n).callcleanupblock) then
+                begin
+                  { create a new statement node and append it }
+                  hp:=cstatementnode.create(tcallnode(n).callcleanupblock,tstatementnode(pnode(arg)^).right);
+                  tstatementnode(pnode(arg)^).right:=hp;
+                  { tree moved }
+                  tcallnode(n).callcleanupblock:=nil;
+                  { process the newly generated block }
+                  foreachnodestatic(tstatementnode(pnode(arg)^).right,@searchstatements,nil);
+                end;
+            end;
+          blockn:
+            begin
+              if assigned(tblocknode(n).left) and (tblocknode(n).left.nodetype<>statementn) then
+                internalerror(2013120502);
+
+              stmnt:=tstatementnode(tblocknode(n).left);
+              { search for the result of the block node }
+              if assigned(stmnt) then
+                begin
+                  res:=nil;
+                  hp:=tstatementnode(stmnt);
+                  while assigned(hp) do
+                    begin
+                      if assigned(hp.left) then
+                        res:[email protected];
+                      hp:=tstatementnode(hp.right);
+                    end;
+                  { did we find a last node? }
+                  if assigned(res^) then
+                    begin
+                      case res^.nodetype of
+                        ordconstn,
+                        realconstn,
+                        stringconstn,
+                        pointerconstn,
+                        setconstn,
+                        temprefn:
+                          begin
+                            { create a new statement node and insert it }
+                            hp:=cstatementnode.create(n,pnode(arg)^);
+                            pnode(arg)^:=hp;
+                            { use the result node instead of the block node }
+                            n:=res^;
+                            { the old statement is not used anymore }
+                            res^:=cnothingnode.create;
+                            { process the newly generated statement }
+                            foreachnodestatic(pnode(arg)^,@searchstatements,nil);
+                          end
+                        else if assigned(res^.resultdef) and not(is_void(res^.resultdef)) then
+                          begin
+                            { replace the last node of the block by an assignment to a temp, and move the block out
+                              of the expression }
+                            newblock:=internalstatements(statements);
+                            tempcreatenode:=ctempcreatenode.create(res^.resultdef,res^.resultdef.size,tt_persistent,true);
+                            addstatement(statements,tempcreatenode);
+                            addstatement(statements,n);
+
+                            { replace the old result node of the block by an assignement to the newly generated temp }
+                            res^:=cassignmentnode.create_internal(ctemprefnode.create(tempcreatenode),res^);
+                            do_firstpass(res^);
+                            addstatement(statements,ctempdeletenode.create_normal_temp(tempcreatenode));
+                            addstatement(statements,pnode(arg)^);
+
+                            { use the temp. ref instead of the block node }
+                            n:=ctemprefnode.create(tempcreatenode);
+                            { replace the statement with the block }
+                            pnode(arg)^:=newblock;
+                            { first pass the newly generated block }
+                            do_firstpass(newblock);
+                            { ... and the inserted temp. }
+                            do_firstpass(n);
+                            { process the newly generated block }
+                            foreachnodestatic(pnode(arg)^,@searchstatements,nil);
+                          end;
+                      end;
+                    end;
+                end;
+            end;
+          else
+            ;
+        end;
+      end;
+
+    var
+      searchstatementsproc : staticforeachnodefunction;
+
+    function searchstatements(var n : tnode;arg : pointer) : foreachnoderesult;
+      begin
+        if n.nodetype=statementn then
+          begin
+            if not(foreachnodestatic(tstatementnode(n).left,@searchblock,@n)) then
+              begin
+                pboolean(arg)^:=false;
+                result:=fen_norecurse_false;
+                exit;
+              end;
+            { do not recurse automatically, but continue with the next statement }
+            result:=fen_norecurse_false;
+            foreachnodestatic(tstatementnode(n).right,searchstatementsproc,arg);
+          end
+        else
+          result:=fen_false;
+      end;
+
+
+    function normalize(var n: tnode) : Boolean;
+      var
+        success : Boolean;
+      begin
+        success:=true;
+{$ifdef DEBUG_NORMALIZE}
+        writeln('******************************************** Before ********************************************');
+        printnode(n);
+{$endif DEBUG_NORMALIZE}
+        searchstatementsproc:=@searchstatements;
+        foreachnodestatic(n,@searchstatements,@success);
+{$ifdef DEBUG_NORMALIZE}
+        if success then
+          begin
+            writeln('******************************************** After ********************************************');
+            printnode(n);
+          end
+        else
+          writeln('************************* Normalization not possible ********************************');
+{$endif DEBUG_NORMALIZE}
+        Result:=success;
+      end;
+
+
+end.
+

compiler/pdecl.pas

@@ -853,6 +853,8 @@ implementation
                       Include(sym.symoptions,sp_generic_dummy);
                       ttypesym(sym).typedef.typesym:=sym;
                       sym.visibility:=symtablestack.top.currentvisibility;
+                      { add as dummy symbol before adding it to the symtable stack }
+                      add_generic_dummysym(sym,typename);
                       symtablestack.top.insertsym(sym);
                       ttypesym(sym).typedef.owner:=sym.owner;
                     end
@@ -865,7 +867,7 @@ implementation
                         { we need to find this symbol even if it's a variable or
                           something else when doing an inline specialization }
                         Include(sym.symoptions,sp_generic_dummy);
-                        add_generic_dummysym(sym);
+                        add_generic_dummysym(sym,'');
                       end;
                 end
               else
@@ -959,7 +961,7 @@ implementation
                     begin
                       hdef.typesym:=newtype;
                       if sp_generic_dummy in newtype.symoptions then
-                        add_generic_dummysym(newtype);
+                        add_generic_dummysym(newtype,'');
                     end;
                 end;
               { in non-Delphi modes we need a reference to the generic def

compiler/pdecsub.pas

@@ -1235,7 +1235,7 @@ implementation
                 if not (sp_generic_dummy in dummysym.symoptions) then
                   begin
                     include(dummysym.symoptions,sp_generic_dummy);
-                    add_generic_dummysym(dummysym);
+                    add_generic_dummysym(dummysym,'');
                   end;
                 if dummysym.typ=procsym then
                   tprocsym(dummysym).add_generic_overload(aprocsym);

compiler/pgenutil.pas

@@ -51,7 +51,7 @@ uses
     procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
     function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:ansistring):tidstring;
     procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
-    procedure add_generic_dummysym(sym:tsym);
+    procedure add_generic_dummysym(sym:tsym;const name:tidstring);
     function resolve_generic_dummysym(const name:tidstring):tsym;
     function could_be_generic(const name:tidstring):boolean;inline;
     function try_implicit_specialization(sym:tsym;para:tnode;pdoverloadlist:tfpobjectlist;var unnamed_syms:tfplist;var first_procsym:tsym;var hasoverload:boolean):boolean;
@@ -2674,21 +2674,25 @@ uses
       end;
 
 
-    procedure add_generic_dummysym(sym:tsym);
+    procedure add_generic_dummysym(sym:tsym;const name:tidstring);
       var
         list: TFPObjectList;
         srsym : tsym;
         srsymtable : tsymtable;
         entry : tgenericdummyentry;
+        n : tidstring;
       begin
         if sp_generic_dummy in sym.symoptions then
           begin
+            n:=sym.name;
+            if n='' then
+              n:=name;
             { did we already search for a generic with that name? }
-            list:=tfpobjectlist(current_module.genericdummysyms.find(sym.name));
+            list:=tfpobjectlist(current_module.genericdummysyms.find(n));
             if not assigned(list) then
               begin
                 list:=tfpobjectlist.create(true);
-                current_module.genericdummysyms.add(sym.name,list);
+                current_module.genericdummysyms.add(n,list);
               end;
             { is the dummy sym still "dummy"? }
             if (sym.typ=typesym) and
@@ -2701,7 +2705,7 @@ uses
               begin
                 { do we have a non-generic type of the same name
                   available? }
-                if not searchsym_with_flags(sym.name,srsym,srsymtable,[ssf_no_addsymref]) then
+                if not searchsym_with_flags(n,srsym,srsymtable,[ssf_no_addsymref]) then
                   srsym:=nil;
               end
             else if sym.typ=procsym then

compiler/pparautl.pas

@@ -817,7 +817,7 @@ implementation
       function equal_signature(fwpd,currpd:tprocdef;out sameparas,sameret:boolean):boolean;
         begin
           sameparas:=compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact;
-          sameret:=compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact;
+          sameret:=compare_rettype(fwpd.returndef,currpd.returndef)=te_exact;
           result:=sameparas and sameret;
         end;
 

compiler/ppu.pas

@@ -466,7 +466,7 @@ begin
              do_comment(CRC_implementation_Change_Message_Level,'implementation CRC changed at index '+tostr(implementation_read_crc_index));
              {$IFDEF TEST_CRC_ERROR}
              if CRC_implementation_Change_Message_Level=V_Error then
-               do_internalerror(2020113001);
+               do_internalerrorex(2020113001,'');
              {$ENDIF}
 {$ifdef Test_Double_checksum_write}
              Write(CRCFile,'!!!imp_crc ',implementation_read_crc_index:5,' $',hexstr(crc,8),'<>$',hexstr(implementation_crc_array^[implementation_read_crc_index],8),' ',len);
@@ -517,7 +517,7 @@ begin
                 do_comment(CRC_Interface_Change_Message_Level,'interface CRC changed at index '+tostr(interface_read_crc_index));
                 {$IFDEF TEST_CRC_ERROR}
                 if CRC_interface_Change_Message_Level=V_Error then
-                  do_internalerror(2020113002);
+                  do_internalerrorex(2020113002,'');
                 {$ENDIF}
 {$ifdef Test_Double_checksum_write}
                 Write(CRCFile,'!!!int_crc ',interface_read_crc_index:5,' $',hexstr(interface_crc,8),'<>$',hexstr(interface_crc_array^[interface_read_crc_index],8),' ',len);
@@ -571,7 +571,7 @@ begin
                      do_comment(CRC_Indirect_Change_Message_Level,'Indirect CRC changed at index '+tostr(indirect_read_crc_index));
                      {$IFDEF TEST_CRC_ERROR}
                      if CRC_indirect_Change_Message_Level=V_Error then
-                       do_internalerror(2020113003);
+                       do_internalerrorex(2020113003,'');
                      {$ENDIF}
 {$ifdef Test_Double_checksum_write}
                      Write(CRCFile,'!!!ind_crc ',indirect_read_crc_index:5,' $',hexstr(indirect_crc,8),'<>$',hexstr(indirect_crc_array^[indirect_read_crc_index],8),' ',len);

compiler/procdefutil.pas

@@ -358,6 +358,14 @@ implementation
 
   {.$define DEBUG_CAPTURER}
 
+  function acceptable_typ(sym:tabstractvarsym;typ :tsymtyp) : boolean;
+    begin
+      acceptable_typ:=false;
+      if (sym.typ=typ) then
+        acceptable_typ:=true
+      else if (sym.typ=absolutevarsym) and (tabsolutevarsym(sym).reftyp=typ) then
+        acceptable_typ:=true;
+    end;
 
   function get_capturer(pd:tprocdef):tabstractvarsym;
 
@@ -366,7 +374,7 @@ implementation
         result:=tabstractvarsym(st.find(capturer_var_name));
         if not assigned(result) then
           internalerror(2022010703);
-        if result.typ<>typ then
+       if not acceptable_typ(result,typ) then
           internalerror(2022010704);
         if not is_class(result.vardef) then
           internalerror(2022010705);
@@ -401,7 +409,7 @@ implementation
         result:=tabstractvarsym(st.find(capturer_var_name+keepalive_suffix));
         if not assigned(result) then
           internalerror(2022051703);
-        if result.typ<>typ then
+        if not acceptable_typ(result,typ) then
           internalerror(2022051704);
         if not is_interfacecom(result.vardef) then
           internalerror(2022051705);

compiler/psub.pas

@@ -156,6 +156,7 @@ implementation
        ncgutil,
 
        optbase,
+       opttree,
        opttail,
        optcse,
        optloop,
@@ -1262,15 +1263,16 @@ implementation
 
            if cs_opt_dead_store_eliminate in current_settings.optimizerswitches then
              begin
-               do_optdeadstoreelim(code,RedoDFA);
-               if RedoDFA then
-                 dfabuilder.redodfainfo(code);
+               if normalize(code) then
+                 begin
+                   do_optdeadstoreelim(code,RedoDFA);
+                   if RedoDFA then
+                     dfabuilder.redodfainfo(code);
+                 end;
              end;
          end
        else
-         begin
-           ConvertForLoops(code);
-         end;
+         ConvertForLoops(code);
 
        if (cs_opt_remove_empty_proc in current_settings.optimizerswitches) and
          (procdef.proctypeoption in [potype_operator,potype_procedure,potype_function]) and

compiler/rgobj.pas

@@ -1952,22 +1952,33 @@ unit rgobj;
                 { Insert live end deallocation before reg allocations
                   to reduce conflicts }
                 p:=live_end;
-                while assigned(p) and
-                      assigned(p.previous) and
+                if assigned(p) then
+                  begin
+                    while assigned(p.previous) and
                       (
-                        (tai(p.previous).typ in [ait_comment,ait_tempalloc,ait_varloc]) or
                         (
                           (tai(p.previous).typ=ait_regalloc) and
-                          (tai_regalloc(p.previous).ratype=ra_alloc) and
-                          (tai_regalloc(p.previous).reg<>r)
-                        )
+                          (
+                            (
+                              (tai_regalloc(p.previous).ratype=ra_alloc) and
+                              (tai_regalloc(p.previous).reg<>r)
+                            ) or (
+                              (tai_regalloc(p.previous).ratype=ra_resize)
+                              { Don't worry if a resize for the same supreg as
+                                r appears - it won't cause issues in the end
+                                since it's stripped out anyway and the deallocs
+                                are adjusted after graph colouring }
+                            )
+                          )
+                        ) or
+                        (tai(p.previous).typ in [ait_comment,ait_tempalloc,ait_varloc])
                       ) do
-                  p:=tai(p.previous);
-                { , but add release after a reg_a_sync }
-                if assigned(p) and
-                   (p.typ=ait_regalloc) and
-                   (tai_regalloc(p).ratype=ra_sync) then
-                  p:=tai(p.next);
+                      p:=tai(p.previous);
+                    { , but add release after a reg_a_sync }
+                    if (p.typ=ait_regalloc) and
+                      (tai_regalloc(p).ratype=ra_sync) then
+                    p:=tai(p.next);
+                  end;
                 if assigned(p) then
                   list.insertbefore(pdealloc,p)
                 else

compiler/riscv/agrvgas.pas

@@ -231,10 +231,10 @@ unit agrvgas;
 
     function TRVGNUAssembler.MakeCmdLine: TCmdStr;
       const
-        arch_str: array[boolean,tcputype] of string[18] = (
+        arch_str: array[boolean,tcputype] of string[26] = (
 {$ifdef RISCV32}
-          ('','rv32imac','rv32ima','rv32im','rv32i','rv32e','rv32imc','rv32imafdc','rv32imaf','rv32imafc','rv32imafd','rv32ec','rv32gc','rv32gc_zba_zbb_zbs'),
-          ('','rv32imafdc','rv32imafd','rv32imfd','rv32ifd','rv32efd','rv32imcfd','rv32imafdc','rv32imaf','rv32imafc','rv32imafd','rv32ecfd','rv32gc','rv32gc_zba_zbb_zbs')
+          ('','rv32imac','rv32imac_zicsr_zifencei','rv32ima','rv32im','rv32i','rv32e','rv32imc','rv32imc_zicsr_zifencei','rv32imafdc','rv32imaf','rv32imafc','rv32imafd','rv32ec','rv32gc','rv32gc_zba_zbb_zbs'),
+          ('','rv32imafdc','rv32imafdc_zicsr_zifencei','rv32imafd','rv32imfd','rv32ifd','rv32efd','rv32imcfd','rv32imcfd_zicsr_zifencei','rv32imafdc','rv32imafc','rv32imaf','rv32imafd','rv32ecfd','rv32gc','rv32gc_zba_zbb_zbs')
 {$endif RISCV32}
 {$ifdef RISCV64}
           ('','rv64imac','rv64ima','rv64im','rv64i','rv64imafdc','rv64imafd','rv64gc','rv64gc_zba_zbb_zbs'),

compiler/riscv32/cgcpu.pas

@@ -53,6 +53,9 @@ unit cgcpu;
        procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
        procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
        procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
+       procedure a_load64_ref_cgpara(list: TAsmList; const r: treference; const paraloc: tcgpara);override;
+       procedure a_load64_ref_reg(list: TAsmList; const ref: treference; reg: tregister64);override;
+       procedure a_load64_reg_ref(list: TAsmList; reg: tregister64; const ref: treference);override;
      end;
 
   procedure create_codegen;
@@ -485,6 +488,45 @@ unit cgcpu;
       end;
 
 
+    procedure tcg64frv.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
+      var
+        hreg64 : tregister64;
+      begin
+        { Override this function to prevent loading the reference twice.
+          Use here some extra registers, but those are optimized away by the RA }
+        hreg64.reglo:=cg.GetIntRegister(list,OS_32);
+        hreg64.reghi:=cg.GetIntRegister(list,OS_32);
+        a_load64_ref_reg(list,r,hreg64);
+        a_load64_reg_cgpara(list,hreg64,paraloc);
+      end;
+
+
+    procedure tcg64frv.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
+      var
+        tmpref: treference;
+      begin
+        { Override this function to prevent loading the reference twice }
+        tmpref:=ref;
+        tcgrv32(cg).fixref(list,tmpref);
+        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
+        inc(tmpref.offset,4);
+        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
+      end;
+
+
+    procedure tcg64frv.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
+      var
+        tmpref: treference;
+      begin
+        { Override this function to prevent loading the reference twice }
+        tmpref:=ref;
+        tcgrv32(cg).fixref(list,tmpref);
+        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
+        inc(tmpref.offset,4);
+        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
+      end;
+
+
     procedure create_codegen;
       begin
         cg := tcgrv32.create;

compiler/riscv32/cpuinfo.pas

@@ -36,11 +36,13 @@ Type
    tcputype =
       (cpu_none,
        cpu_rv32imac,
+       cpu_rv32imac_csr_fence,
        cpu_rv32ima,
        cpu_rv32im,
        cpu_rv32i,
        cpu_rv32e,
        cpu_rv32imc,
+       cpu_rv32imc_csr_fence,
        cpu_rv32imafdc,
        cpu_rv32imaf,
        cpu_rv32imafc,
@@ -117,12 +119,12 @@ Const
    embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
    (
       (controllertypestr:''            ; controllerunitstr:''; cputype:cpu_none; fputype:fpu_none; flashbase:0; flashsize:0; srambase:0; sramsize:0),
-      (controllertypestr:'FE310G000'   ; controllerunitstr:'FE310G000';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$20400000; flashsize:$01000000; srambase:$80000000; sramsize:$00004000),
-      (controllertypestr:'FE310G002'   ; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$20010000; flashsize:$00400000; srambase:$80000000; sramsize:$00004000),
-      (controllertypestr:'HIFIVE1'     ; controllerunitstr:'FE310G000';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$20400000; flashsize:$01000000; srambase:$80000000; sramsize:$00004000),
-      (controllertypestr:'HIFIVE1REVB' ; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$20010000; flashsize:$00400000; srambase:$80000000; sramsize:$00004000),
-      (controllertypestr:'REDFIVE'     ; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$20010000; flashsize:$00400000; srambase:$80000000; sramsize:$00004000),
-      (controllertypestr:'REDFIVETHING'; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$20010000; flashsize:$02400000; srambase:$80000000; sramsize:$00004000),
+      (controllertypestr:'FE310G000'   ; controllerunitstr:'FE310G000';   cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$20400000; flashsize:$01000000; srambase:$80000000; sramsize:$00004000),
+      (controllertypestr:'FE310G002'   ; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$20010000; flashsize:$00400000; srambase:$80000000; sramsize:$00004000),
+      (controllertypestr:'HIFIVE1'     ; controllerunitstr:'FE310G000';   cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$20400000; flashsize:$01000000; srambase:$80000000; sramsize:$00004000),
+      (controllertypestr:'HIFIVE1REVB' ; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$20010000; flashsize:$00400000; srambase:$80000000; sramsize:$00004000),
+      (controllertypestr:'REDFIVE'     ; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$20010000; flashsize:$00400000; srambase:$80000000; sramsize:$00004000),
+      (controllertypestr:'REDFIVETHING'; controllerunitstr:'FE310G002';   cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$20010000; flashsize:$02400000; srambase:$80000000; sramsize:$00004000),
 
       (controllertypestr:'GD32VF103C4' ; controllerunitstr:'GD32VF103XX'; cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001800),
       (controllertypestr:'GD32VF103C6' ; controllerunitstr:'GD32VF103XX'; cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00002800),
@@ -147,9 +149,9 @@ Const
       (controllertypestr:'CH32V307RC'; controllerunitstr:'CH32V307';    cputype:cpu_rv32imac; fputype:fpu_fd; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'CH32V307WC'; controllerunitstr:'CH32V307';    cputype:cpu_rv32imac; fputype:fpu_fd; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'CH32V307VC'; controllerunitstr:'CH32V307';    cputype:cpu_rv32imac; fputype:fpu_fd; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
-      (controllertypestr:'ESP32C2'; controllerunitstr:'ESP32C2';    cputype:cpu_rv32imc;  fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:272*1024),
-      (controllertypestr:'ESP32C3'; controllerunitstr:'ESP32C3';    cputype:cpu_rv32imc;  fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:400*1024),
-      (controllertypestr:'ESP32C6'; controllerunitstr:'ESP32C6';    cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:512*1024),
+      (controllertypestr:'ESP32C2'; controllerunitstr:'ESP32C2';    cputype:cpu_rv32imc_csr_fence;  fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:272*1024),
+      (controllertypestr:'ESP32C3'; controllerunitstr:'ESP32C3';    cputype:cpu_rv32imc_csr_fence;  fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:400*1024),
+      (controllertypestr:'ESP32C6'; controllerunitstr:'ESP32C6';    cputype:cpu_rv32imac_csr_fence; fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:512*1024),
       (controllertypestr:'CH32V0X' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32e; fputype:fpu_none; flashbase:$00000000; flashsize:$00004000; srambase:$20000000; sramsize:$00000800; eeprombase:0; eepromsize:0;BootBase:$1FFFF000; BootSize:1920),
       (controllertypestr:'CH32VXXXX6' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:$00008000; srambase:$20000000; sramsize:$00002800),
       (controllertypestr:'CH32VXXXX8' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:$00010000; srambase:$20000000; sramsize:$00008000),
@@ -171,13 +173,15 @@ Const
      pocall_mwpascal
    ];
 
-   cputypestr : array[tcputype] of string[10] = ('',
+   cputypestr : array[tcputype] of string[24] = ('',
      'RV32IMAC',
+     'RV32IMAC_ZICSR_ZIFENCEI',
      'RV32IMA',
      'RV32IM',
      'RV32I',
      'RV32E',
      'RV32IMC',
+     'RV32IMC_ZICSR_ZIFENCEI',
      'RV32IMAFDC',
      'RV32IMAF',
      'RV32IMAFC',
@@ -242,18 +246,20 @@ Const
    cpu_capabilities : array[tcputype] of set of tcpuflags =
      ( { cpu_none      } [],
        { cpu_rv32imac  } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT],
+       { cpu_rv32imac_csr_fence } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT,CPURV_HAS_CSR_INSTRUCTIONS,CPURV_HAS_FETCH_FENCE],
        { cpu_rv32ima   } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC],
        { cpu_rv32im    } [CPURV_HAS_MUL],
        { cpu_rv32i     } [],
        { cpu_rv32e     } [CPURV_HAS_16REGISTERS],
        { cpu_rv32imc   } [CPURV_HAS_MUL,CPURV_HAS_COMPACT],
+       { cpu_rv32imc_csr_fence } [CPURV_HAS_MUL,CPURV_HAS_COMPACT,CPURV_HAS_CSR_INSTRUCTIONS,CPURV_HAS_FETCH_FENCE],
        { cpu_rv32imafdc} [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT,CPURV_HAS_F,CPURV_HAS_D],
        { cpu_rv32imaf  } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_F],
        { cpu_rv32imafc } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_F,CPURV_HAS_COMPACT],
        { cpu_rv32imafd } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_F,CPURV_HAS_D],
        { cpu_rv32ec    } [CPURV_HAS_16REGISTERS,CPURV_HAS_COMPACT],
-       { cpu_rv32gc    } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT,CPURV_HAS_F,CPURV_HAS_D],
-       { cpu_rv32gc    } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT,CPURV_HAS_F,CPURV_HAS_D,CPURV_HAS_ZBA,CPURV_HAS_ZBB,CPURV_HAS_ZBS]
+       { cpu_rv32gc    } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT,CPURV_HAS_F,CPURV_HAS_D,CPURV_HAS_CSR_INSTRUCTIONS,CPURV_HAS_FETCH_FENCE],
+       { cpu_rv32gcb   } [CPURV_HAS_MUL,CPURV_HAS_ATOMIC,CPURV_HAS_COMPACT,CPURV_HAS_F,CPURV_HAS_D,CPURV_HAS_ZBA,CPURV_HAS_ZBB,CPURV_HAS_ZBS,CPURV_HAS_CSR_INSTRUCTIONS,CPURV_HAS_FETCH_FENCE]
      );
 
 Implementation

compiler/scandir.pas

@@ -2154,8 +2154,6 @@ unit scandir;
 
     procedure dir_region;
       begin
-        current_scanner.skipspace;
-        current_scanner.readquotedstring;
       end;
 
     procedure dir_endregion;

compiler/symdef.pas

@@ -1850,7 +1850,7 @@ implementation
             else
               begin
                 if addgenerics then
-                  add_generic_dummysym(sym);
+                  add_generic_dummysym(sym,'');
                 { add nested helpers as well }
                 if assigned(def) and
                     (def.typ in [recorddef,objectdef]) and
@@ -2675,11 +2675,24 @@ implementation
      var
        gst : tgetsymtable;
        st : tsymtable;
+       tmod : tmodule;
      begin
        if registered then
          exit;
+       if assigned(owner) then
+         begin
+           tmod:=find_module_from_symtable(owner);
+            if assigned(tmod) and assigned(current_module) and (tmod<>current_module) then
+              begin
+                comment(v_error,'Definition '+fullownerhierarchyname(false)+' from module '+tmod.mainsource+' regitered with current module '+current_module.mainsource);
+              end;
+           if not assigned(tmod) then
+             tmod:=current_module;
+         end
+       else
+         tmod:=current_module;
        { Register in current_module }
-       if assigned(current_module) then
+       if assigned(tmod) then
          begin
            exclude(defoptions,df_not_registered_no_free);
            for gst:=low(tgetsymtable) to high(tgetsymtable) do
@@ -2692,9 +2705,9 @@ implementation
              defid:=deflist_index
            else
              begin
-               current_module.deflist.Add(self);
-               defid:=current_module.deflist.Count-1;
-               registered_in_module:=current_module;
+               tmod.deflist.Add(self);
+               defid:=tmod.deflist.Count-1;
+               registered_in_module:=tmod;
              end;
            maybe_put_in_symtable_stack;
          end

compiler/symsym.pas

@@ -363,6 +363,9 @@ interface
          { do not override this routine in platform-specific subclasses,
            override ppuwrite_platform instead }
          procedure ppuwrite(ppufile:tcompilerppufile);override;final;
+         { returns the symbol type of the local variable or local parameter
+           referenced by the absolute symbol }
+         function reftyp : tsymtyp;
       end;
       tabsolutevarsymclass = class of tabsolutevarsym;
 
@@ -738,14 +741,28 @@ implementation
 
 
     procedure tstoredsym.register_sym;
+      var
+        tmod : tmodule;
       begin
         if registered then
           exit;
+        if assigned(owner) then
+          begin
+            tmod:=find_module_from_symtable(owner);
+            if assigned(tmod) and assigned(current_module) and (tmod<>current_module) then
+              begin
+                comment(v_error,'Symbol '+realname+' from module '+tmod.mainsource+' regitered with current module '+current_module.mainsource);
+              end;
+	    if not assigned(tmod) then
+              tmod:=current_module;
+          end
+	else
+          tmod:=current_module;
         { Register in current_module }
-        if assigned(current_module) then
+        if assigned(tmod) then
           begin
-            current_module.symlist.Add(self);
-            SymId:=current_module.symlist.Count-1;
+            tmod.symlist.Add(self);
+            SymId:=tmod.symlist.Count-1;
           end
         else
           SymId:=symid_registered_nost;
@@ -2606,6 +2623,21 @@ implementation
          end;
       end;
 
+         { returns the symbol type of the local variable or local parameter
+           referenced by the absolute symbol }
+    function tabsolutevarsym.reftyp : tsymtyp;
+      var
+        plist : ppropaccesslistitem;
+      begin
+        reftyp:=typ;
+        if abstyp=tovar then
+          begin
+            plist:=ref.firstsym;
+            if assigned(plist) and (plist^.sltype=sl_load) and
+               assigned(plist^.sym) and not(assigned(plist^.next)) then
+              reftyp:=plist^.sym.typ;
+          end;
+      end;
 
 {****************************************************************************
                                   TCONSTSYM

compiler/utils/ppuutils/ppudump.pp

@@ -1710,8 +1710,9 @@ const
          (mask:pi_uses_ymm;
          str:' uses ymm register (x86 only)'),
          (mask:pi_no_framepointer_needed;
-         str:' set if no frame pointer is needed, the rules when this applies is target specific'
-         )
+         str:' set if no frame pointer is needed, the rules when this applies is target specific'), 
+         (mask:pi_normalized;
+         str:'  has been normalized so no expressions contain block nodes ')
   );
 var
   procinfooptions : tprocinfoflags;

compiler/wasm32/hlcgcpu.pas

@@ -728,13 +728,25 @@ implementation
 
   procedure thlcgwasm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: tcgint);
     begin
+      optimize_op_const(size,op,a);
+
       case op of
+        OP_NONE:
+          ;
+        OP_MOVE:
+          begin
+            list.concat(taicpu.op_none(a_drop));
+            decstack(list,1);
+            a_load_const_stack(list,size,a,R_INTREGISTER);
+          end;
         OP_NEG,OP_NOT:
           internalerror(2011010801);
         else
-          a_load_const_stack(list,size,a,R_INTREGISTER);
+          begin
+            a_load_const_stack(list,size,a,R_INTREGISTER);
+            a_op_stack(list,op,size);
+          end;
       end;
-      a_op_stack(list,op,size);
     end;
 
   procedure thlcgwasm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
@@ -965,13 +977,13 @@ implementation
         LOC_SUBSETREG, LOC_CSUBSETREG:
           begin
             tmpreg:=getintregister(list,size);
-            a_load_ref_reg(list,size,size,loc.reference,tmpreg);
+            a_load_ref_reg(list,size,size,ref,tmpreg);
             a_cmp_subsetreg_reg_stack(list,size,size,swap_opcmp(cmp_op),loc.sreg,tmpreg);
           end;
         LOC_SUBSETREF, LOC_CSUBSETREF:
           begin
             tmpreg:=getintregister(list,size);
-            a_load_ref_reg(list,size,size,loc.reference,tmpreg);
+            a_load_ref_reg(list,size,size,ref,tmpreg);
             a_cmp_subsetref_reg_stack(list,size,size,swap_opcmp(cmp_op),loc.sref,tmpreg);
           end;
         else
@@ -1435,9 +1447,18 @@ implementation
     end;
 
   procedure thlcgwasm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
+    var
+      fromcgsize, tocgsize: TCgSize;
     begin
+      fromcgsize:=def_cgsize(fromsize);
+      tocgsize:=def_cgsize(tosize);
+      if (reg1=reg2) and ((fromcgsize=tocgsize) or
+                          ((fromcgsize in [OS_S32,OS_32]) and (tocgsize in [OS_S32,OS_32]) and (getsubreg(reg1)=R_SUBD)) or
+                          ((fromcgsize in [OS_S64,OS_64]) and (tocgsize in [OS_S64,OS_64]))) then
+        exit;
+
       a_load_reg_stack(list,fromsize,reg1);
-      if def2regtyp(fromsize)=R_INTREGISTER then
+      if def2regtyp(fromsize) in [R_INTREGISTER,R_ADDRESSREGISTER] then
         resize_stack_int_val(list,fromsize,tosize,false);
       a_load_stack_reg(list,tosize,reg2);
     end;
@@ -1523,41 +1544,41 @@ implementation
       extra_value_reg,
       tmpreg: tregister;
     begin
-      tmpreg:=getintregister(list,osuinttype);
+      tmpreg:=getintregister(list,aluuinttype);
       tmpref:=sref.ref;
       inc(tmpref.offset,loadbitsize div 8);
-      extra_value_reg:=getintregister(list,osuinttype);
+      extra_value_reg:=getintregister(list,aluuinttype);
 
-      a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,valuereg);
+      a_op_reg_reg(list,OP_SHR,aluuinttype,sref.bitindexreg,valuereg);
 
       { ensure we don't load anything past the end of the array }
-      a_cmp_const_reg_stack(list,osuinttype,OC_A,loadbitsize-sref.bitlen,sref.bitindexreg);
+      a_cmp_const_reg_stack(list,aluuinttype,OC_A,loadbitsize-sref.bitlen,sref.bitindexreg);
 
       current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
       decstack(current_asmdata.CurrAsmList,1);
 
       { Y-x = -(Y-x) }
-      a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpreg);
-      a_op_reg_reg(list,OP_NEG,osuinttype,tmpreg,tmpreg);
+      a_op_const_reg_reg(list,OP_SUB,aluuinttype,loadbitsize,sref.bitindexreg,tmpreg);
+      a_op_reg_reg(list,OP_NEG,aluuinttype,tmpreg,tmpreg);
 
       { load next "loadbitsize" bits of the array }
-      a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),osuinttype,tmpref,extra_value_reg);
+      a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),aluuinttype,tmpref,extra_value_reg);
 
       { tmpreg is in the range 1..<cpu_bitsize>-1 -> always ok }
-      a_op_reg_reg(list,OP_SHL,osuinttype,tmpreg,extra_value_reg);
+      a_op_reg_reg(list,OP_SHL,aluuinttype,tmpreg,extra_value_reg);
       { merge }
-      a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
+      a_op_reg_reg(list,OP_OR,aluuinttype,extra_value_reg,valuereg);
 
       current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
 
       { sign extend or mask other bits }
       if is_signed(subsetsize) then
         begin
-          a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen,valuereg);
-          a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
+          a_op_const_reg(list,OP_SHL,aluuinttype,AIntBits-sref.bitlen,valuereg);
+          a_op_const_reg(list,OP_SAR,aluuinttype,AIntBits-sref.bitlen,valuereg);
         end
       else
-        a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
+        a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
     end;
 
   procedure thlcgwasm.a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt);
@@ -1578,8 +1599,8 @@ implementation
       loadbitsize:=loadsize.size*8;
 
       { load the (first part) of the bit sequence }
-      valuereg:=getintregister(list,osuinttype);
-      a_load_ref_reg(list,loadsize,osuinttype,sref.ref,valuereg);
+      valuereg:=getintregister(list,aluuinttype);
+      a_load_ref_reg(list,loadsize,aluuinttype,sref.ref,valuereg);
 
       { constant offset of bit sequence? }
       if not extra_load then
@@ -1588,7 +1609,7 @@ implementation
             begin
               { use subsetreg routine, it may have been overridden with an optimized version }
               tosreg.subsetreg:=valuereg;
-              tosreg.subsetregsize:=def_cgsize(osuinttype);
+              tosreg.subsetregsize:=def_cgsize(aluuinttype);
               { subsetregs always count bits from right to left }
               tosreg.startbit:=sref.startbit;
               tosreg.bitlen:=sref.bitlen;
@@ -1606,39 +1627,39 @@ implementation
               { zero the bits we have to insert }
               if (slopt<>SL_SETMAX) then
                 begin
-                  maskreg:=getintregister(list,osuinttype);
-                  a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                  a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
-                  a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                  a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
+                  maskreg:=getintregister(list,aluuinttype);
+                  a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                  a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,maskreg);
+                  a_op_reg_reg(list,OP_NOT,aluuinttype,maskreg,maskreg);
+                  a_op_reg_reg(list,OP_AND,aluuinttype,maskreg,valuereg);
                 end;
 
               { insert the value }
               if (slopt<>SL_SETZERO) then
                 begin
-                  tmpreg:=getintregister(list,osuinttype);
+                  tmpreg:=getintregister(list,aluuinttype);
                   if (slopt<>SL_SETMAX) then
-                    a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                    a_load_reg_reg(list,fromsize,aluuinttype,fromreg,tmpreg)
                   else if (sref.bitlen<>AIntBits) then
-                    a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
+                    a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
                   else
-                    a_load_const_reg(list,osuinttype,-1,tmpreg);
+                    a_load_const_reg(list,aluuinttype,-1,tmpreg);
                   if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
-                    a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
-                  a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
-                  a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
+                    a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
+                  a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,tmpreg);
+                  a_op_reg_reg(list,OP_OR,aluuinttype,tmpreg,valuereg);
                 end;
             end;
           { store back to memory }
           tmpreg:=getintregister(list,loadsize);
-          a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+          a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
           a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
           exit;
         end
       else
         begin
           { load next value }
-          extra_value_reg:=getintregister(list,osuinttype);
+          extra_value_reg:=getintregister(list,aluuinttype);
           tmpref:=sref.ref;
           inc(tmpref.offset,loadbitsize div 8);
 
@@ -1646,12 +1667,12 @@ implementation
           { on e.g. i386 with shld/shrd                                 }
           if (sref.bitindexreg = NR_NO) then
             begin
-              a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
+              a_load_ref_reg(list,loadsize,aluuinttype,tmpref,extra_value_reg);
 
               fromsreg.subsetreg:=fromreg;
               fromsreg.subsetregsize:=def_cgsize(fromsize);
               tosreg.subsetreg:=valuereg;
-              tosreg.subsetregsize:=def_cgsize(osuinttype);
+              tosreg.subsetregsize:=def_cgsize(aluuinttype);
 
               { transfer first part }
               fromsreg.bitlen:=loadbitsize-sref.startbit;
@@ -1675,7 +1696,7 @@ implementation
               a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref);
 {$else}
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
 {$endif}
 
@@ -1696,7 +1717,7 @@ implementation
                   a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
               end;
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,extra_value_reg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
               exit;
             end
@@ -1712,82 +1733,82 @@ implementation
               { generate mask to zero the bits we have to insert }
               if (slopt <> SL_SETMAX) then
                 begin
-                  maskreg := getintregister(list,osuinttype);
-                  a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                  a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
+                  maskreg := getintregister(list,aluuinttype);
+                  a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                  a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,maskreg);
 
-                  a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                  a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
+                  a_op_reg_reg(list,OP_NOT,aluuinttype,maskreg,maskreg);
+                  a_op_reg_reg(list,OP_AND,aluuinttype,maskreg,valuereg);
                 end;
 
               { insert the value }
               if (slopt <> SL_SETZERO) then
                 begin
-                  tmpreg := getintregister(list,osuinttype);
+                  tmpreg := getintregister(list,aluuinttype);
                   if (slopt <> SL_SETMAX) then
-                    a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                    a_load_reg_reg(list,fromsize,aluuinttype,fromreg,tmpreg)
                   else if (sref.bitlen <> AIntBits) then
-                    a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
+                    a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
                   else
-                    a_load_const_reg(list,osuinttype,-1,tmpreg);
+                    a_load_const_reg(list,aluuinttype,-1,tmpreg);
                   if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
                     { mask left over bits }
-                    a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
-                  a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
-                  a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
+                    a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
+                  a_op_reg_reg(list,OP_SHL,aluuinttype,sref.bitindexreg,tmpreg);
+                  a_op_reg_reg(list,OP_OR,aluuinttype,tmpreg,valuereg);
                 end;
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,valuereg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
 
               { make sure we do not read/write past the end of the array }
-              a_cmp_const_reg_stack(list,osuinttype,OC_A,loadbitsize-sref.bitlen,sref.bitindexreg);
+              a_cmp_const_reg_stack(list,aluuinttype,OC_A,loadbitsize-sref.bitlen,sref.bitindexreg);
               current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
               decstack(current_asmdata.CurrAsmList,1);
 
-              a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
-              tmpindexreg:=getintregister(list,osuinttype);
+              a_load_ref_reg(list,loadsize,aluuinttype,tmpref,extra_value_reg);
+              tmpindexreg:=getintregister(list,aluuinttype);
 
               { load current array value }
               if (slopt<>SL_SETZERO) then
                 begin
-                  tmpreg:=getintregister(list,osuinttype);
+                  tmpreg:=getintregister(list,aluuinttype);
                   if (slopt<>SL_SETMAX) then
-                     a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                     a_load_reg_reg(list,fromsize,aluuinttype,fromreg,tmpreg)
                   else if (sref.bitlen<>AIntBits) then
-                    a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
+                    a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
                   else
-                    a_load_const_reg(list,osuinttype,-1,tmpreg);
+                    a_load_const_reg(list,aluuinttype,-1,tmpreg);
                 end;
 
               { generate mask to zero the bits we have to insert }
               if (slopt<>SL_SETMAX) then
                 begin
-                  maskreg:=getintregister(list,osuinttype);
+                  maskreg:=getintregister(list,aluuinttype);
 
                   { Y-x = -(x-Y) }
-                  a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpindexreg);
-                  a_op_reg_reg(list,OP_NEG,osuinttype,tmpindexreg,tmpindexreg);
-                  a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                  a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,maskreg);
+                  a_op_const_reg_reg(list,OP_SUB,aluuinttype,loadbitsize,sref.bitindexreg,tmpindexreg);
+                  a_op_reg_reg(list,OP_NEG,aluuinttype,tmpindexreg,tmpindexreg);
+                  a_load_const_reg(list,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                  a_op_reg_reg(list,OP_SHR,aluuinttype,tmpindexreg,maskreg);
 
-                  a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                  a_op_reg_reg(list,OP_AND,osuinttype,maskreg,extra_value_reg);
+                  a_op_reg_reg(list,OP_NOT,aluuinttype,maskreg,maskreg);
+                  a_op_reg_reg(list,OP_AND,aluuinttype,maskreg,extra_value_reg);
                 end;
 
               if (slopt<>SL_SETZERO) then
                 begin
                   if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
-                    a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
-                  a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,tmpreg);
-                  a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,extra_value_reg);
+                    a_op_const_reg(list,OP_AND,aluuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
+                  a_op_reg_reg(list,OP_SHR,aluuinttype,tmpindexreg,tmpreg);
+                  a_op_reg_reg(list,OP_OR,aluuinttype,tmpreg,extra_value_reg);
                 end;
 {$ifndef cpuhighleveltarget}
               extra_value_reg:=cg.makeregsize(list,extra_value_reg,def_cgsize(loadsize));
               a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref);
 {$else}
               tmpreg:=getintregister(list,loadsize);
-              a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
+              a_load_reg_reg(list,aluuinttype,loadsize,extra_value_reg,tmpreg);
               a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
 {$endif}
 
@@ -1803,9 +1824,20 @@ implementation
 
   procedure thlcgwasm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
     begin
-      a_load_reg_stack(list,size,src);
-      a_op_const_stack(list,op,size,a);
-      a_load_stack_reg(list,size,dst);
+      optimize_op_const(size,op,a);
+
+      case op of
+        OP_NONE:
+          a_load_reg_reg(list,size,size,src,dst);
+        OP_MOVE:
+          a_load_const_reg(list,size,a,dst);
+        else
+          begin
+            a_load_reg_stack(list,size,src);
+            a_op_const_stack(list,op,size,a);
+            a_load_stack_reg(list,size,dst);
+          end;
+      end;
     end;
 
   procedure thlcgwasm.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference);
@@ -1813,16 +1845,27 @@ implementation
       extra_slots: longint;
       tmpref: treference;
     begin
-      tmpref:=ref;
-      extra_slots:=prepare_stack_for_ref(list,tmpref,true);
-      { TODO, here or in peepholeopt: use iinc when possible }
-      a_load_ref_stack(list,size,tmpref,extra_slots);
-      a_op_const_stack(list,op,size,a);
-      { for android verifier }
-      if (def2regtyp(size)=R_INTREGISTER) and
-         (assigned(tmpref.symbol)) then
-        resize_stack_int_val(list,size,size,true);
-      a_load_stack_ref(list,size,tmpref,extra_slots);
+      optimize_op_const(size,op,a);
+
+      case op of
+        OP_NONE:
+          ;
+        OP_MOVE:
+          a_load_const_ref(list,size,a,ref);
+        else
+          begin
+            tmpref:=ref;
+            extra_slots:=prepare_stack_for_ref(list,tmpref,true);
+            { TODO, here or in peepholeopt: use iinc when possible }
+            a_load_ref_stack(list,size,tmpref,extra_slots);
+            a_op_const_stack(list,op,size,a);
+            { for android verifier }
+            if (def2regtyp(size)=R_INTREGISTER) and
+               (assigned(tmpref.symbol)) then
+              resize_stack_int_val(list,size,size,true);
+            a_load_stack_ref(list,size,tmpref,extra_slots);
+          end;
+      end;
     end;
 
   procedure thlcgwasm.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
@@ -1836,7 +1879,11 @@ implementation
   procedure thlcgwasm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
     begin
       if not(op in [OP_NOT,OP_NEG]) then
-        a_load_reg_stack(list,size,src2);
+        begin
+          a_load_reg_stack(list,size,src2);
+          if getsubreg(src1)<>getsubreg(src2) then
+            internalerror(2025100701);
+        end;
       a_op_reg_stack(list,op,size,src1);
       a_load_stack_reg(list,size,dst);
     end;
@@ -2796,7 +2843,7 @@ implementation
                   internalerror(2021010302);
               end;
             end
-          else if tcgsize2size[fromcgsize]>=tcgsize2size[tocgsize] then
+          else if (tcgsize2size[fromcgsize]>=tcgsize2size[tocgsize]) and (fromcgsize<>tocgsize) then
             begin
               { truncate }
               case tocgsize of

compiler/x86/aoptx86.pas

@@ -42,7 +42,8 @@ unit aoptx86;
       TOptsToCheck = (
         aoc_MovAnd2Mov_3,
         aoc_ForceNewIteration,
-        aoc_DoPass2JccOpts
+        aoc_DoPass2JccOpts,
+        aoc_MovlMovq2MovlMovl
       );
 
       TX86AsmOptimizer = class(TAsmOptimizer)
@@ -10612,55 +10613,71 @@ unit aoptx86;
 
       var
         NewRef: TReference;
-        hp1, hp2, hp3, hp4: Tai;
+        hp1, hp2, hp3: Tai;
 {$ifndef x86_64}
+        hp4: tai;
         OperIdx: Integer;
 {$endif x86_64}
         NewInstr : Taicpu;
-        NewAligh : Tai_align;
         DestLabel: TAsmLabel;
         TempTracking: TAllUsedRegs;
 
         function TryMovArith2Lea(InputInstr: tai): Boolean;
           var
             NextInstr: tai;
+            NextPresent: Boolean;
           begin
             Result := False;
-            UpdateUsedRegs(TmpUsedRegs, tai(InputInstr.Next));
 
-            if not GetNextInstruction(InputInstr, NextInstr) or
-              (
-                { The FLAGS register isn't always tracked properly, so do not
-                  perform this optimisation if a conditional statement follows }
-                not RegReadByInstruction(NR_DEFAULTFLAGS, NextInstr) and
-                not RegUsedAfterInstruction(NR_DEFAULTFLAGS, NextInstr, TmpUsedRegs)
-              ) then
+            { be lazy, checking separately for sub would be slightly better }
+            if (taicpu(InputInstr).oper[0]^.typ = top_const) and
+              (abs(taicpu(InputInstr).oper[0]^.val)<=$7fffffff) then
               begin
-                reference_reset(NewRef, 1, []);
-                NewRef.base := taicpu(p).oper[0]^.reg;
-                NewRef.scalefactor := 1;
-
-                if taicpu(InputInstr).opcode = A_ADD then
-                  begin
-                    DebugMsg(SPeepholeOptimization + 'MovAdd2Lea', p);
-                    NewRef.offset := taicpu(InputInstr).oper[0]^.val;
-                  end
-                else
+                NextPresent := GetNextInstruction(InputInstr, NextInstr);
+                if NextPresent then
                   begin
-                    DebugMsg(SPeepholeOptimization + 'MovSub2Lea', p);
-                    NewRef.offset := -taicpu(InputInstr).oper[0]^.val;
+                    { Try to avoid using TmpUsedRegs if possible (it's slow!) }
+                    TransferUsedRegs(TmpUsedRegs);
+                    UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
+                    UpdateUsedRegs(TmpUsedRegs, tai(InputInstr.Next));
                   end;
 
-                taicpu(p).opcode := A_LEA;
-                taicpu(p).loadref(0, NewRef);
+                if (
+                    not NextPresent or
+                    (
+                      { The FLAGS register isn't always tracked properly, so do not
+                        perform this optimisation if a conditional statement follows }
+                      not RegReadByInstruction(NR_DEFAULTFLAGS, NextInstr) and
+                      not RegUsedAfterInstruction(NR_DEFAULTFLAGS, NextInstr, TmpUsedRegs)
+                    )
+                  ) then
+                  begin
+                    reference_reset(NewRef, 1, []);
+                    NewRef.base := taicpu(p).oper[0]^.reg;
+                    NewRef.scalefactor := 1;
 
-                { For the sake of debugging, have the line info match the
-                  arithmetic instruction rather than the MOV instruction }
-                taicpu(p).fileinfo := taicpu(InputInstr).fileinfo;
+                    if taicpu(InputInstr).opcode = A_ADD then
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'MovAdd2Lea', p);
+                        NewRef.offset := taicpu(InputInstr).oper[0]^.val;
+                      end
+                    else
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'MovSub2Lea', p);
+                        NewRef.offset := -taicpu(InputInstr).oper[0]^.val;
+                      end;
 
-                RemoveInstruction(InputInstr);
+                    taicpu(p).opcode := A_LEA;
+                    taicpu(p).loadref(0, NewRef);
 
-                Result := True;
+                    { For the sake of debugging, have the line info match the
+                      arithmetic instruction rather than the MOV instruction }
+                    taicpu(p).fileinfo := taicpu(InputInstr).fileinfo;
+
+                    RemoveInstruction(InputInstr);
+
+                    Result := True;
+                  end;
               end;
           end;
 
@@ -10916,36 +10933,32 @@ unit aoptx86;
               To:
                 leal/q x(%reg1),%reg2   leal/q -x(%reg1),%reg2
             }
-            if (taicpu(hp1).oper[0]^.typ = top_const) and
-              { be lazy, checking separately for sub would be slightly better }
-              (abs(taicpu(hp1).oper[0]^.val)<=$7fffffff) then
+            if TryMovArith2Lea(hp1) then
               begin
-                TransferUsedRegs(TmpUsedRegs);
-                UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
-                if TryMovArith2Lea(hp1) then
-                  begin
-                    Result := True;
-                    Exit;
-                  end
+                Result := True;
+                Exit;
               end
-            else if not RegInOp(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[0]^) and
-              GetNextInstructionUsingReg(hp1, hp2, taicpu(p).oper[1]^.reg) and
+            else if
               { Same as above, but also adds or subtracts to %reg2 in between.
                 It's still valid as long as the flags aren't in use }
+              (
+                (
+                  MatchInstruction(hp1,A_ADD,A_SUB,A_LEA,[]) and
+                  not RegInOp(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[0]^)
+                ) or
+                (
+                  not RegModifiedByInstruction(taicpu(p).oper[1]^.reg, taicpu(hp1)) and
+                  { If it's not modified, make sure it isn't read as is }
+                  not RegReadByInstruction(taicpu(p).oper[1]^.reg, taicpu(hp1))
+                )
+              ) and
+              GetNextInstructionUsingReg(hp1, hp2, taicpu(p).oper[1]^.reg) and
               MatchInstruction(hp2,A_ADD,A_SUB,[taicpu(p).opsize]) and
-              MatchOpType(taicpu(hp2), top_const, top_reg) and
-              (taicpu(hp2).oper[1]^.reg = taicpu(p).oper[1]^.reg) and
-              { be lazy, checking separately for sub would be slightly better }
-              (abs(taicpu(hp2).oper[0]^.val)<=$7fffffff) then
+              MatchOperand(taicpu(hp2).oper[1]^, taicpu(p).oper[1]^.reg) and
+              TryMovArith2Lea(hp2) then
               begin
-                TransferUsedRegs(TmpUsedRegs);
-                UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
-                UpdateUsedRegs(TmpUsedRegs, tai(hp1.Next));
-                if TryMovArith2Lea(hp2) then
-                  begin
-                    Result := True;
-                    Exit;
-                  end;
+                Result := True;
+                Exit;
               end;
           end;
 
@@ -11441,59 +11454,74 @@ unit aoptx86;
         if MatchOpType(taicpu(p), top_reg, top_reg) and
           (taicpu(p).opsize = S_L) then
           begin
-            TransferUsedRegs(TmpUsedRegs);
-             { Mark the start point for sequential calls to
-               GetNextInstructionUsingReg, RegModifiedBetween and
-               UpdateUsedRegsBetween in case this optimisation is run multiple
-               times }
-            hp2 := p;
-            repeat
-              if (
-                  not(cs_opt_level3 in current_settings.optimizerswitches) or
-                  { Look further ahead for this one }
-                  GetNextInstructionUsingReg(hp2, hp1, taicpu(p).oper[1]^.reg)
-                ) and
-                MatchInstruction(hp1,A_MOV,[S_Q]) and
-                not RegModifiedBetween(taicpu(p).oper[0]^.reg, hp2, hp1) and
-                MatchOpType(taicpu(hp1), top_reg, top_reg) and
-                SuperRegistersEqual(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[0]^.reg) then
-                begin
-                  UpdateUsedRegsBetween(TmpUsedRegs, tai(hp2.Next), hp1);
-
-                  taicpu(hp1).opsize := S_L;
-                  taicpu(hp1).loadreg(0, taicpu(p).oper[0]^.reg);
-                  setsubreg(taicpu(hp1).oper[1]^.reg, R_SUBD);
+            { If the movq instruction is followed by addq or subq, it
+              might be possible to convert them to a leaq instruction
+              whose opportunity might be lost if it's changed to a movl
+              first, so we can't do this optimisation on a first iteration }
+            if not (aoc_MovlMovq2MovlMovl in OptsToCheck) and
+              not NotFirstIteration and
+              { If -O2 and under, do the optimisation anyway because Pass 2
+                won't run more than once }
+              (cs_opt_level3 in current_settings.optimizerswitches) then
+              begin
+                { Flag that we need to run Pass 2 again }
+                Include(OptsToCheck, aoc_ForceNewIteration);
+              end
+            else
+              begin
+                TransferUsedRegs(TmpUsedRegs);
+                 { Mark the start point for sequential calls to
+                   GetNextInstructionUsingReg, RegModifiedBetween and
+                   UpdateUsedRegsBetween in case this optimisation is run multiple
+                   times }
+                hp2 := p;
+                repeat
+                  if (
+                      not(cs_opt_level3 in current_settings.optimizerswitches) or
+                      { Look further ahead for this one }
+                      GetNextInstructionUsingReg(hp2, hp1, taicpu(p).oper[1]^.reg)
+                    ) and
+                    MatchInstruction(hp1,A_MOV,[S_Q]) and
+                    not RegModifiedBetween(taicpu(p).oper[0]^.reg, hp2, hp1) and
+                    MatchOpType(taicpu(hp1), top_reg, top_reg) and
+                    SuperRegistersEqual(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[0]^.reg) then
+                    begin
+                      UpdateUsedRegsBetween(TmpUsedRegs, tai(hp2.Next), hp1);
 
-                  AllocRegBetween(taicpu(p).oper[0]^.reg, p, hp1, UsedRegs);
+                      taicpu(hp1).opsize := S_L;
+                      taicpu(hp1).loadreg(0, taicpu(p).oper[0]^.reg);
+                      setsubreg(taicpu(hp1).oper[1]^.reg, R_SUBD);
 
-                  DebugMsg(SPeepholeOptimization + 'Made 32-to-64-bit zero extension more efficient (MovlMovq2MovlMovl 1)', hp1);
+                      AllocRegBetween(taicpu(p).oper[0]^.reg, p, hp1, TmpUsedRegs);
 
-                  if not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs) then
-                    begin
-                      DebugMsg(SPeepholeOptimization + 'Mov2Nop 8 done', p);
-                      RemoveCurrentP(p);
-                      Result := True;
-                      Exit;
-                    end;
+                      DebugMsg(SPeepholeOptimization + 'Made 32-to-64-bit zero extension more efficient (MovlMovq2MovlMovl 1)', hp1);
 
-                  { Initial instruction wasn't actually changed }
-                  Include(OptsToCheck, aoc_ForceNewIteration);
+                      if not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs) then
+                        begin
+                          DebugMsg(SPeepholeOptimization + 'Mov2Nop 8 done', p);
+                          RemoveCurrentP(p);
+                          Result := True;
+                          Exit;
+                        end;
 
-                  if (cs_opt_level3 in current_settings.optimizerswitches) then
-                    begin
-                      { GetNextInstructionUsingReg will return a different
-                        instruction, so check this optimisation again }
+                      { Initial instruction wasn't actually changed }
+                      Include(OptsToCheck, aoc_ForceNewIteration);
 
-                      { Update the start point for the next calls to
-                        GetNextInstructionUsingReg, RegModifiedBetween and
-                        UpdateUsedRegsBetween to grant a speed boost }
-                      hp2 := hp1;
-                      Continue; { Jump back to "repeat" }
+                      if (cs_opt_level3 in current_settings.optimizerswitches) then
+                        begin
+                          { GetNextInstructionUsingReg will return a different
+                            instruction, so check this optimisation again }
+
+                          { Update the start point for the next calls to
+                            GetNextInstructionUsingReg, RegModifiedBetween and
+                            UpdateUsedRegsBetween to grant a speed boost }
+                          hp2 := hp1;
+                          Continue; { Jump back to "repeat" }
+                        end;
                     end;
-                end;
-
-              Break;
-            until False;
+                  Break;
+                until False;
+              end;
           end;
 {$endif x86_64}
 
@@ -16294,8 +16322,10 @@ unit aoptx86;
                   UpdateUsedRegs(UsedRegs, tai(p.Next));
 
                 hp2 := hp1;
+                Include(OptsToCheck, aoc_MovlMovq2MovlMovl);
                 if OptPass2MOV(hp1) then
                   Include(OptsToCheck, aoc_ForceNewIteration);
+                Exclude(OptsToCheck, aoc_MovlMovq2MovlMovl);
 
                 { Reset the tracking to the current instruction }
                 RestoreUsedRegs(TempTracking);
@@ -16643,8 +16673,10 @@ unit aoptx86;
                   UpdateUsedRegs(UsedRegs, tai(p.Next));
 
                 hp2 := hp1;
+                Include(OptsToCheck, aoc_MovlMovq2MovlMovl);
                 if OptPass2MOV(hp1) then
                   Include(OptsToCheck, aoc_ForceNewIteration);
+                Exclude(OptsToCheck, aoc_MovlMovq2MovlMovl);
 
                 { Reset the tracking to the current instruction }
                 RestoreUsedRegs(TempTracking);

compiler/x86/x86ins.dat

@@ -10363,26 +10363,26 @@ xmmreg_mz,xmmreg,mem32                    \350\361\371\1\x2D\75\120
 xmmreg_mz,xmmreg,xmmreg_er                \350\361\371\1\x2D\75\120                 AVX512
 
 [VSCATTERDPD]
-(Ch_All)
+(Ch_Rop1, Ch_Wop2)
 xmem64_m,xmmreg                           \350\352\361\371\1\xA2\101                AVX512,T1S,DISTINCT,DALL
 xmem64_m,ymmreg                           \350\352\361\364\371\1\xA2\101            AVX512,T1S,DISTINCT,DALL
 ymem64_m,zmmreg                           \350\351\352\361\371\1\xA2\101            AVX512,T1S,DISTINCT,DALL
 
 [VSCATTERDPS]
-(Ch_All)
+(Ch_Rop1, Ch_Wop2)
 xmem32_m,xmmreg                           \350\361\371\1\xA2\101                    AVX512,T1S,DISTINCT,DALL
 ymem32_m,ymmreg                           \350\361\364\371\1\xA2\101                AVX512,T1S,DISTINCT,DALL
 zmem32_m,zmmreg                           \350\351\361\371\1\xA2\101                AVX512,T1S,DISTINCT,DALL
 
 
 [VSCATTERQPD]
-(Ch_All)
+(Ch_Rop1, Ch_Wop2)
 xmem64_m,xmmreg                           \350\352\361\371\1\xA3\101                AVX512,T1S,DISTINCT,DALL
 ymem64_m,ymmreg                           \350\352\361\364\371\1\xA3\101            AVX512,T1S,DISTINCT,DALL
 zmem64_m,zmmreg                           \350\351\352\361\371\1\xA3\101            AVX512,T1S,DISTINCT,DALL
 
 [VSCATTERQPS]
-(Ch_All)
+(Ch_Rop1, Ch_Wop2)
 xmem32_m,xmmreg                           \350\361\371\1\xA3\101                    AVX512,T1S,DISTINCT,DALL
 ymem32_m,xmmreg                           \350\361\364\371\1\xA3\101                AVX512,T1S,DISTINCT,DALL
 zmem32_m,ymmreg                           \350\351\361\371\1\xA3\101                AVX512,T1S,DISTINCT,DALL

compiler/x86_64/x8664nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-7169;
+7169;

compiler/x86_64/x8664pro.inc

@@ -1524,10 +1524,10 @@
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

packages/fcl-base/src/base64.pp

@@ -36,6 +36,8 @@ uses classes, sysutils;
 
 type
 
+  { TBase64EncodingStream }
+
   TBase64EncodingStream = class(TOwnerStream)
   private type
     TWriteBuffer = array[0..3] of AnsiChar;
@@ -49,11 +51,12 @@ type
     LineLength: Integer;
     Buf: array[0..2] of Byte;
     BufSize: Integer;    // # of bytes used in Buf
+    FEncodingTable : PAnsiChar;
 
     procedure DoWriteBuf(var Buffer: TWriteBuffer; BufferLength: TWriteBufferLength);
   public
     constructor Create(ASource: TStream); overload;
-    constructor Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: RawByteString; APadEnd: Boolean); overload;
+    constructor Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: RawByteString; APadEnd: Boolean); virtual; overload;
     constructor Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: UnicodeString; APadEnd: Boolean); overload;
     destructor Destroy; override;
     Function Flush : Boolean;
@@ -61,6 +64,12 @@ type
     function Seek(Offset: Longint; Origin: Word): Longint; override;
   end;
 
+  { TBase64URLEncodingStream }
+
+  TBase64URLEncodingStream = Class(TBase64EncodingStream)
+    constructor Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: RawByteString; APadEnd: Boolean); override; overload;
+  end;
+
   (* The TBase64DecodingStream supports two modes:
    * - 'strict mode':
    *    - follows RFC3548
@@ -72,6 +81,8 @@ type
    *    - ignores any characters outside of base64 alphabet
    *    - takes any '=' as end of
    *    - handles apparently truncated input streams gracefully
+   * - 'URL':
+   *    Like Strict, but
    *)
   TBase64DecodingMode = (bdmStrict, bdmMIME);
 
@@ -90,6 +101,7 @@ type
     Buf: array[0..2] of Byte; // last 3 decoded bytes
     BufPos: Integer;          // offset in Buf of byte which is to be read next; if >2, next block must be read from Source & decoded
     FEOF: Boolean;            // if true, all decoded bytes have been read
+    function converturl(c : ansichar) : ansichar; virtual;
   public
     constructor Create(ASource: TStream);
     constructor Create(ASource: TStream; AMode: TBase64DecodingMode);
@@ -102,6 +114,12 @@ type
     property Mode: TBase64DecodingMode read FMode write SetMode;
   end;
 
+  { TBase64URLDecodingStream }
+
+  TBase64URLDecodingStream = class(TBase64DecodingStream)
+    function converturl(c : ansichar) : ansichar; override;
+  end;
+
   EBase64DecodingException = class(Exception)
   end;
 
@@ -125,12 +143,17 @@ const
 
   EncodingTable: PAnsiChar =
     'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+  URLEncodingTable: PAnsiChar =
+    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
+
+Type
+  TByteDict = Array[Byte] of Byte;
 
 const
   NA =  85; // not in base64 alphabet at all; binary: 01010101
   PC = 255; // padding character                      11111111
 
-  DecTable: array[Byte] of Byte =
+  DecTable: TByteDict =
     (NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,  // 0-15
      NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,  // 16-31
      NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 62, NA, NA, NA, 63,  // 32-47
@@ -149,6 +172,7 @@ const
      NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA);
 
   Alphabet = ['a'..'z','A'..'Z','0'..'9','+','/','=']; // all 65 chars that are in the base64 encoding alphabet
+  URLAlphabet = ['a'..'z','A'..'Z','0'..'9','-','_','=']; // all 65 chars that are in the base64 encoding alphabet
 
 function TBase64EncodingStream.Flush : Boolean;
 
@@ -158,16 +182,16 @@ begin
   // Fill output to multiple of 4
   case (TotalBytesProcessed mod 3) of
     1: begin
-        WriteBuf[0] := EncodingTable[Buf[0] shr 2];
-        WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4];
+        WriteBuf[0] := FEncodingTable[Buf[0] shr 2];
+        WriteBuf[1] := FEncodingTable[(Buf[0] and 3) shl 4];
         DoWriteBuf(WriteBuf, 2);
         Result:=True;
         Inc(TotalBytesProcessed,2);
       end;
     2: begin
-        WriteBuf[0] := EncodingTable[Buf[0] shr 2];
-        WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
-        WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2];
+        WriteBuf[0] := FEncodingTable[Buf[0] shr 2];
+        WriteBuf[1] := FEncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
+        WriteBuf[2] := FEncodingTable[(Buf[1] and 15) shl 2];
         DoWriteBuf(WriteBuf, 3);
         Result:=True;
         Inc(TotalBytesProcessed,1);
@@ -185,7 +209,7 @@ end;
 constructor TBase64EncodingStream.Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: RawByteString; APadEnd: Boolean);
 begin
   inherited Create(ASource);
-
+  FEncodingTable:=EncodingTable;
   CharsPerLine := ACharsPerLine;
   LineSeparator := ALineSeparator;
   PadEnd := APadEnd;
@@ -261,10 +285,10 @@ begin
     Dec(Count, ReadNow);
 
     // Encode the 3 bytes in Buf
-    WriteBuf[0] := EncodingTable[Buf[0] shr 2];
-    WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
-    WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)];
-    WriteBuf[3] := EncodingTable[Buf[2] and 63];
+    WriteBuf[0] := FEncodingTable[Buf[0] shr 2];
+    WriteBuf[1] := FEncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
+    WriteBuf[2] := FEncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)];
+    WriteBuf[3] := FEncodingTable[Buf[2] and 63];
     DoWriteBuf(WriteBuf, 4);
   end;
   Move(p^, Buf[BufSize], count);
@@ -301,6 +325,20 @@ begin
     raise EStreamError.Create('Invalid stream operation');
 end;
 
+{ TBase64URLEncodingStream }
+
+constructor TBase64URLEncodingStream.Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: RawByteString;
+  APadEnd: Boolean);
+begin
+  inherited Create(ASource, ACharsPerLine, ALineSeparator, APadEnd);
+  FEncodingTable:=URLEncodingTable;
+end;
+
+function TBase64DecodingStream.converturl(c: ansichar): ansichar;
+begin
+  Result:=c;
+end;
+
 procedure TBase64DecodingStream.SetMode(const AValue: TBase64DecodingMode);
 begin
   if FMode = AValue then exit;
@@ -327,7 +365,7 @@ begin
       repeat
         count := Source.Read(scanBuf, SizeOf(scanBuf));
         for i := 0 to count-1 do begin
-          c := scanBuf[i];
+          c := ConvertURL(scanBuf[i]);
           if c in Alphabet-['='] then // base64 encoding characters except '='
             Inc(Result)
           else if c = '=' then // end marker '='
@@ -429,7 +467,7 @@ begin
         //WriteLn('ToRead = ', ToRead, ', HaveRead = ', HaveRead, ', ReadOK=', ReadOk);
         if HaveRead > 0 then begin // if any new bytes; in ReadBuf[ReadOK .. ReadOK + HaveRead-1]
           for i := ReadOK to ReadOK + HaveRead - 1 do begin
-            b := DecTable[ReadBuf[i]];
+            b := DecTable[Ord(ConvertURL(Char(ReadBuf[i])))];
             if b <> NA then begin // valid base64 alphabet character ('=' inclusive)
               ReadBuf[ReadOK] := b;
               Inc(ReadOK);
@@ -444,7 +482,7 @@ begin
           //WriteLn('End: ReadOK=', ReadOK, ', count=', Count);
           for i := ReadOK to 3 do
             ReadBuf[i] := 0; // pad buffer with zeros so decoding of 4-bytes will be correct
-          if (Mode = bdmStrict) and (ReadOK > 0) then
+          if (Mode=bdmStrict) and (ReadOK > 0) then
             raise EBase64DecodingException.CreateFmt(SStrictInputTruncated,[]);
           Break;
         end;
@@ -513,6 +551,18 @@ begin
   raise EStreamError.Create('Invalid stream operation');
 end;
 
+{ TBase64URLDecodingStream }
+
+function TBase64URLDecodingStream.converturl(c: ansichar): ansichar;
+begin
+  case c of
+    '-' : result:='+';
+    '_' : Result:='/';
+  else
+    result:=c;
+  end;
+end;
+
 function DecodeStringBase64(const s: AnsiString;strict:boolean=false): AnsiString;
 
 var

packages/fcl-image/src/fpreadqoi.pas

@@ -80,8 +80,8 @@ begin
   if Result then
     begin
    {$IFDEF ENDIAN_LITTLE}
-    QoiHeader.width:=Swap32(QoiHeader.width);
-    QoiHeader.height:=Swap32(QoiHeader.height);
+    QoiHeader.width:=SwapEndian(QoiHeader.width);
+    QoiHeader.height:=SwapEndian(QoiHeader.height);
    {$ENDIF}
     Result := (QoiHeader.magic = 'qoif'); // Just check magic number
     end;
@@ -127,7 +127,7 @@ begin
      px.a:=255;
 
      {initalize previosly seen pixel array}
-     //fillchar(arr,sizeof(arr),0);
+     FillQWord(arr,sizeof(arr) div sizeof(QWord),0);
      iA:=QoiPixelIndex(px);
      //for iA:=0 to 63 do
      arr[iA]:=px;

packages/fcl-image/src/fpwriteqoi.pas

@@ -75,16 +75,16 @@ begin
     end;
 
   {$IFDEF ENDIAN_LITTLE}
-  QoiHeader.width:=Swap32(QoiHeader.width);
-  QoiHeader.height:=Swap32(QoiHeader.height);
+  QoiHeader.width:=SwapEndian(QoiHeader.width);
+  QoiHeader.height:=SwapEndian(QoiHeader.height);
   {$ENDIF}
 
   //writeln('Save width 2 ',QoiHeader.width, '   height  ', QoiHeader.height);
   Stream.Write(QoiHeader,sizeof(TQoiHeader));
 
   {$IFDEF ENDIAN_LITTLE}
-  QoiHeader.width:=Swap32(QoiHeader.width);
-  QoiHeader.height:=Swap32(QoiHeader.height);
+  QoiHeader.width:=SwapEndian(QoiHeader.width);
+  QoiHeader.height:=SwapEndian(QoiHeader.height);
   {$ENDIF}
   Result:=true;
 end;
@@ -123,7 +123,7 @@ begin
     px.a:=255;
 
     {initalize previosly seen pixel array}
-    fillchar(arr,sizeof(arr),0);
+    FillQWord(arr,sizeof(arr) div sizeof(QWord),0);
     iA:=QoiPixelIndex(px);
      //for iA:=0 to 63 do
      //arr[iA]:=px;

packages/fcl-image/src/qoicomn.pas

@@ -38,28 +38,14 @@ type  PQoiPixel = ^TQoiPixel;
 const qoChannelRGB  = 3;
       qoChannelRGBA = 4;
 
-function swap32 (a : dword):dword;
 function QoiPixelIndex (px : TQoiPixel):dword;
 
 implementation
 
-function swap32 (a : dword):dword;
-var h, l : dword;
-begin
-     a:=roldword(a,16);
-     h:=a shr 8;
-     h:= h and $ff00ff;
-     l:= a and $ff00ff;
-     l:= l shl 8;
-
-     swap32:=h or l;
-end;
-
 function QoiPixelIndex (px : TQoiPixel):dword;
 begin
      QoiPixelIndex:= (dword(px.r)*3+dword(px.g)*5+dword(px.b)*7+dword(px.a)*11) and 63;
 end;
 
 
-
 end.

packages/fcl-passrc/src/pasresolver.pp

@@ -2242,6 +2242,8 @@ type
       Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
     procedure ComputeResultElement(El: TPasResultElement; out ResolvedEl: TPasResolverResult;
       Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
+    function ComputeProcAsyncResult(El: TPasElement; var ResolvedEl: TPasResolverResult;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil): boolean; virtual; // for descendants to return the promise
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
     function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
     // checking compatibilility
@@ -14019,7 +14021,11 @@ begin
   else if IsProcedureType(ArgResolved,true)
       or (ArgResolved.BaseType=btPointer)
       or ((ArgResolved.LoTypeEl=nil) and (ArgResolved.IdentEl is TPasArgument)) then
+  begin
     Include(RHSFlags,rcNoImplicitProcType);
+    if msDelphi in GetElModeSwitches(Expr) then
+      Include(RHSFlags,rcNoImplicitProc);
+  end;
   if SetReferenceFlags then
     Include(RHSFlags,rcSetReferenceFlags);
   ComputeElement(Expr,ExprResolved,RHSFlags);
@@ -14241,11 +14247,8 @@ begin
         // function call => return result
         ComputeResultElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
           Flags+[rcCall],StartEl)
-      else if Proc.IsAsync then
-        begin
+      else if Proc.IsAsync and ComputeProcAsyncResult(Proc,ResolvedEl,Flags,StartEl) then
         // async proc => return promise
-        ComputeElement(Proc,ResolvedEl,Flags+[rcCall],StartEl);
-        end
       else if (Proc.ClassType=TPasConstructor) then
         begin
         // constructor -> return value of type class
@@ -14272,6 +14275,10 @@ begin
           // function call => return result
           ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
             ResolvedEl,Flags+[rcCall],StartEl)
+        else if (ResolvedEl.LoTypeEl is TPasProcedureType)
+            and TPasProcedureType(ResolvedEl.LoTypeEl).IsAsync
+            and ComputeProcAsyncResult(ResolvedEl.LoTypeEl,ResolvedEl,Flags,StartEl) then
+          // async proc => return promise
         else
           // procedure call, result is neither readable nor writable
           SetResolverTypeExpr(ResolvedEl,btProc,
@@ -27842,11 +27849,9 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
               ResolvedEl,Flags+[rcCall],StartEl);
             end
           else if (ResolvedEl.IdentEl is TPasProcedure)
-              and TPasProcedure(ResolvedEl.IdentEl).IsAsync then
-            begin
+              and TPasProcedure(ResolvedEl.IdentEl).IsAsync
+              and ComputeProcAsyncResult(ResolvedEl.IdentEl,ResolvedEl,Flags,StartEl) then
             // async proc => return promise
-            ComputeElement(ResolvedEl.IdentEl,ResolvedEl,Flags+[rcCall],StartEl);
-            end
           else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
             begin
             // constructor -> return value of type class
@@ -27885,6 +27890,10 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
             // function => return result
             ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
               ResolvedEl,Flags+[rcCall],StartEl)
+          else if (ResolvedEl.LoTypeEl is TPasProcedureType)
+              and TPasProcedureType(ResolvedEl.LoTypeEl).IsAsync
+              and ComputeProcAsyncResult(ResolvedEl.LoTypeEl,ResolvedEl,Flags,StartEl) then
+            // async proc => return promise
           else if ParentNeedsExprResult(Expr) then
             begin
             // a procedure has no result
@@ -28418,6 +28427,16 @@ begin
   ResolvedEl.Flags:=[rrfReadable,rrfWritable];
 end;
 
+function TPasResolver.ComputeProcAsyncResult(El: TPasElement; var ResolvedEl: TPasResolverResult;
+  Flags: TPasResolverComputeFlags; StartEl: TPasElement): boolean;
+begin
+  Result:=false;
+  if El=nil then ;
+  if Flags=[] then ;
+  if StartEl=nil then ;
+  if ResolvedEl.IdentEl=nil then ;
+end;
+
 function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
   Store: boolean): TResEvalValue;
 // Important: Caller must free result with ReleaseEvalValue(Result)

packages/fcl-passrc/tests/tcresolver.pas

@@ -902,6 +902,8 @@ type
     Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail1;
     Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail2;
     Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail3;
+    Procedure TestProcType_PassAsArg_NoAtFPC_Fail;
+    Procedure TestProcType_PassAsArg_NoAtDelphi;
     Procedure TestProcType_WhileListCompare;
     Procedure TestProcType_IsNested;
     Procedure TestProcType_IsNested_AssignProcFail;
@@ -1372,7 +1374,7 @@ var
 
   procedure AddLabel;
   var
-    Identifier, Param: String;
+    Identifier: String;
     p: PChar;
   begin
     p:=CommentStartP+2;
@@ -16635,6 +16637,38 @@ begin
     nWrongNumberOfParametersForCallTo);
 end;
 
+procedure TTestResolver.TestProcType_PassAsArg_NoAtFPC_Fail;
+begin
+  StartProgram(false);
+  Add('{$mode objfpc}');
+  Add('type');
+  Add('  TProc = procedure;');
+  Add('procedure Run;');
+  Add('begin end;');
+  Add('procedure Fly(p: TProc);');
+  Add('begin end;');
+  Add('begin');
+  Add('  Fly(Run);');
+  CheckResolverException(
+    'Incompatible type for arg no. 1: Got "procedural type", expected "TProc"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestProcType_PassAsArg_NoAtDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode delphi}');
+  Add('type');
+  Add('  TFunc = function: word;');
+  Add('function Run: word;');
+  Add('begin end;');
+  Add('procedure Fly(p: TFunc);');
+  Add('begin end;');
+  Add('begin');
+  Add('  Fly(Run);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcType_WhileListCompare;
 begin
   StartProgram(false);

packages/fcl-syntax/Makefile

@@ -0,0 +1,2991 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql m68k-human68k powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mipsel-ps1 mips64-linux mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-embedded aarch64-iphonesim aarch64-android aarch64-ios wasm32-embedded wasm32-wasip1 wasm32-wasip1threads wasm32-wasip2 sparc64-linux riscv32-linux riscv32-embedded riscv32-freertos riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc loongarch64-linux
+BSDs = freebsd netbsd openbsd darwin dragonfly
+UNIXs = linux $(BSDs) solaris qnx haiku aix
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari human68k
+OSNeedsComspecToRunBatch = go32v2 watcom
+FORCE:
+.PHONY: FORCE
+lc = $(subst A,a,$(subst B,b,$(subst C,c,$(subst D,d,$(subst E,e,$(subst F,f,$(subst G,g,$(subst H,h,$(subst I,i,$(subst J,j,$(subst K,k,$(subst L,l,$(subst M,m,$(subst N,n,$(subst O,o,$(subst P,p,$(subst Q,q,$(subst R,r,$(subst S,s,$(subst T,t,$(subst U,u,$(subst V,v,$(subst W,w,$(subst X,x,$(subst Y,y,$(subst Z,z,$1))))))))))))))))))))))))))
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef COMSPEC
+ifneq ($(filter $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
+FPC:=$(shell $(FPCPROG) -PB)
+endif
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+else
+ifeq ($(strip $(wildcard $(FPC))),)
+FPC:=$(firstword $(FPCPROG))
+endif
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+CPU_OS_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+ifdef SUB_TARGET
+L_SUB_TARGET=$(call lc,$(SUB_TARGET))
+FULL_TARGET:=$(CPU_TARGET)-$(OS_TARGET)-$(L_SUB_TARGET)
+else
+FULL_TARGET:=$(CPU_TARGET)-$(OS_TARGET)
+endif
+CPU_OS_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifdef SUB_SOURCE
+L_SUB_SOURCE=$(call lc,$(SUB_SOURCE))
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)-$(L_SUB_SOURCE)
+else
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+endif
+ifeq ($(CPU_TARGET),armeb)
+ARCH=arm
+override FPCOPT+=-Cb
+else
+ifeq ($(CPU_TARGET),armel)
+ARCH=arm
+override FPCOPT+=-CaEABI
+else
+ARCH=$(CPU_TARGET)
+endif
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-embedded)
+endif
+ifdef SUB_TARGET 
+FPCOPT+=-t$(SUB_TARGET)
+FPMAKE_OPT+=--subtarget=$(SUB_TARGET)
+endif
+ifeq ($(CPU_OS_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(CPU_OS_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(CPU_OS_TARGET),mipsel-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(CPU_OS_TARGET),xtensa-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for xtensa-embedded, a sub-architecture (e.g. SUBARCH=lx106 or SUBARCH=lx6) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(CPU_OS_TARGET),xtensa-freertos)
+ifeq ($(SUBARCH),)
+$(error When compiling for xtensa-freertos, a sub-architecture (e.g. SUBARCH=lx106 or SUBARCH=lx6) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(CPU_OS_TARGET),arm-freertos)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-freertos, a sub-architecture (e.g. SUBARCH=armv6m or SUBARCH=armv7em) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifneq ($(filter $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+ifneq ($(filter $(OS_TARGET),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+endif
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(CPU_OS_TARGET),$(CPU_OS_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(filter $(CPU_OS_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(filter $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE SUB_TARGET SUB_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE CPU_OS_TARGET CPU_OS_SOURCE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifneq ($(filter $(OS_TARGET),darwin iphonesim ios),)
+ifneq ($(filter $(OS_SOURCE),darwin ios),)
+DARWIN2DARWIN=1
+endif
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+ifneq ($(OS_TARGET),msdos)
+ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+endif
+endif
+endif
+endif
+endif
+else
+BINUTILSPREFIX=$(OS_TARGET)-
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+ifndef FPCFPMAKE
+ifdef CROSSCOMPILE
+ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPCFPMAKE:=$(shell $(FPCPROG) -PB)
+ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
+FPCFPMAKE:=$(firstword $(FPCPROG))
+endif
+else
+override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
+FPMAKE_SKIP_CONFIG=-n
+export FPCFPMAKE
+export FPMAKE_SKIP_CONFIG
+endif
+else
+FPMAKE_SKIP_CONFIG=-n
+FPCFPMAKE=$(FPC)
+endif
+endif
+override PACKAGE_NAME=fcl
+override PACKAGE_VERSION=3.3.1
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(filter $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(filter $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+ifeq ($(OS_SOURCE),linux)
+ifndef GCCLIBDIR
+ifeq ($(CPU_TARGET),i386)
+ifneq ($(filter x86_64,$(shell uname -a)),)
+ifeq ($(BINUTILSPREFIX),)
+GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
+else
+CROSSGCCOPT=-m32
+endif
+endif
+endif
+ifeq ($(CPU_TARGET),powerpc)
+ifeq ($(BINUTILSPREFIX),)
+GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
+else
+CROSSGCCOPT=-m32
+endif
+endif
+ifeq ($(CPU_TARGET),powerpc64)
+ifeq ($(BINUTILSPREFIX),)
+GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`)
+else
+CROSSGCCOPT=-m64
+endif
+endif
+ifeq ($(CPU_TARGET),sparc)
+ifneq ($(filter sparc64,$(shell uname -a)),)
+ifeq ($(BINUTILSPREFIX),)
+GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
+else
+CROSSGCCOPT=-m32
+endif
+endif
+endif
+ifneq ($(filter $(CPU_TARGET),mips64 mipsel64),)
+ifeq ($(BINUTILSPREFIX),)
+GCCLIBDIR:=$(shell dirname `gcc -mabi=64 -print-libgcc-file-name`)
+else
+CROSSGCCOPT=-mabi=64
+endif
+endif
+ifneq ($(filter $(CPU_TARGET),mips mipsel),)
+ifeq ($(BINUTILSPREFIX),)
+GCCLIBDIR:=$(shell dirname `gcc -mabi=32 -print-libgcc-file-name`)
+else
+CROSSGCCOPT=-mabi=32
+endif
+endif
+ifeq ($(BINUTILSPREFIX),)
+ifeq ($(GCCLIBDIR),)
+GCCLIBDIR:=$(shell dirname `gcc -print-libgcc-file-name`)
+endif
+else
+ifeq ($(CROSSGCCOPT),)
+CROSSGCCOPT=-g
+endif
+endif
+endif
+ifdef FPCFPMAKE
+FPCFPMAKE_CPU_TARGET=$(shell $(FPCFPMAKE) -iTP)
+ifeq ($(CPU_TARGET),$(FPCFPMAKE_CPU_TARGET))
+FPCMAKEGCCLIBDIR:=$(GCCLIBDIR)
+else
+ifneq ($(filter $(FPCFPMAKE_CPU_TARGET),aarch64 powerpc64 riscv64 sparc64 x86_64 loongarch64),)
+FPCMAKE_CROSSGCCOPT=-m64
+else
+ifneq ($(filter $(FPCFPMAKE_CPU_TARGET),mips64 mips64el),)
+FPCMAKE_CROSSGCCOPT=-mabi=64
+else
+ifneq ($(filter $(FPCFPMAKE_CPU_TARGET),mips mipsel),)
+FPCMAKE_CROSSGCCOPT=-mabi=32
+else
+ifeq ($(FPCFPMAKE_CPU_TARGET),riscv64)
+FPCMAKE_CROSSGCCOPT=-mabi=lp64
+else
+ifeq ($(FPCFPMAKE_CPU_TARGET),riscv32)
+FPCMAKE_CROSSGCCOPT=-mabi=ilp32
+else
+ifeq ($(FPCFPMAKE_CPU_TARGET),loongarch64)
+FPCMAKE_CROSSGCCOPT=-mabi=lp64d
+else
+FPCMAKE_CROSSGCCOPT=-m32
+endif
+endif
+endif
+endif
+endif
+endif
+FPCMAKEGCCLIBDIR:=$(shell dirname `gcc $(FPCMAKE_CROSSGCCOPT) -print-libgcc-file-name`)
+endif
+endif
+ifndef FPCMAKEGCCLIBDIR
+FPCMAKEGCCLIBDIR:=$(shell dirname `gcc -print-libgcc-file-name`)
+endif
+ifndef GCCLIBDIR
+CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(CROSSGCC),)
+GCCLIBDIR:=$(shell dirname `$(CROSSGCC) $(CROSSGCCOPT) -print-libgcc-file-name`)
+endif
+endif
+endif
+ifdef inUnix
+ifeq ($(OS_SOURCE),netbsd)
+OTHERLIBDIR:=/usr/pkg/lib
+endif
+export GCCLIBDIR FPCMAKEGCCLIBDIR OTHERLIBDIR
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+LTOEXT=.bc
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rsj
+EXEDBGEXT=.dbg
+ALL_EXEEXT=.exe
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
+endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ALL_EXEEXT+=.ttp
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
+endif
+ALL_EXEEXT+=.nlm
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),macosclassic)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
+endif
+ifneq ($(filter $(OS_TARGET),darwin iphonesim ios),)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ALL_EXEEXT+=.gba
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
+ifeq ($(OS_TARGET),wii)
+EXEEXT=.dol
+SHAREDLIBEXT=.so
+SHORTSUFFIX=wii
+endif
+ALL_EXEEXT+=.dol
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHAREDLIBEXT=.a
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
+ifeq ($(OS_TARGET),msdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=d16
+endif
+ifeq ($(OS_TARGET),msxdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=msd
+endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+ifeq ($(CPU_TARGET),z80)
+OEXT=.rel
+endif
+SHORTSUFFIX=emb
+endif
+ALL_EXEEXT+=.bin
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
+ifeq ($(OS_TARGET),zxspectrum)
+OEXT=.rel
+endif
+ifeq ($(OS_TARGET),wasip1)
+EXEEXT=.wasm
+endif
+ALL_EXEEXT+=.wasm
+ifeq ($(OS_TARGET),wasip1threads)
+EXEEXT=.wasm
+endif
+ifeq ($(OS_TARGET),wasip2)
+EXEEXT=.wasm
+endif
+ifneq ($(filter $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+NASM=$(NASMPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
+PPAS=ppas$(SRCBATCHEXT)
+endif
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl fpmkunit
+ifeq ($(CPU_OS_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-macosclassic)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-sinclairql)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),m68k-human68k)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-macosclassic)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-wii)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-gba)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-freertos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),arm-ios)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),avr-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),armeb-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),armeb-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mipsel-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mipsel-ps1)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mips64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),mips64el-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i8086-msdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),aarch64-ios)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),wasm32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),wasm32-wasip1)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),wasm32-wasip1threads)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),wasm32-wasip2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),sparc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),riscv32-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),riscv32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),riscv32-freertos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),riscv64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),riscv64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),xtensa-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),xtensa-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),xtensa-freertos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),z80-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),z80-zxspectrum)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),z80-msxdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),z80-amstradcpc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(CPU_OS_TARGET),loongarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile,,$(strip $(wildcard $(addsuffix /rtl/Makefile,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(subst /fpmake.pp,,$(strip $(wildcard $(addsuffix /rtl/fpmake.pp,$(PACKAGESDIR))))))
+endif
+endif
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+ifdef UNITDIR_FPMAKE_RTL
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_PASZLIB
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(PACKAGEDIR_PASZLIB),)
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile,,$(strip $(wildcard $(addsuffix /paszlib/Makefile,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_PASZLIB),)
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /fpmake.pp,,$(strip $(wildcard $(addsuffix /paszlib/fpmake.pp,$(PACKAGESDIR))))))
+endif
+endif
+ifneq ($(PACKAGEDIR_PASZLIB),)
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),)
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)
+else
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_PASZLIB)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_PASZLIB=
+UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_PASZLIB),)
+UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB))
+else
+UNITDIR_PASZLIB=
+endif
+endif
+ifdef UNITDIR_PASZLIB
+override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB)
+endif
+ifdef UNITDIR_FPMAKE_PASZLIB
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_PASZLIB)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(PACKAGEDIR_FCL-PROCESS),)
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /fpmake.pp,,$(strip $(wildcard $(addsuffix /fcl-process/fpmake.pp,$(PACKAGESDIR))))))
+endif
+endif
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+ifdef UNITDIR_FPMAKE_FCL-PROCESS
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-PROCESS)
+endif
+endif
+ifdef REQUIRE_PACKAGES_HASH
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(PACKAGEDIR_HASH),)
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile,,$(strip $(wildcard $(addsuffix /hash/Makefile,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_HASH),)
+PACKAGEDIR_HASH:=$(firstword $(subst /fpmake.pp,,$(strip $(wildcard $(addsuffix /hash/fpmake.pp,$(PACKAGESDIR))))))
+endif
+endif
+ifneq ($(PACKAGEDIR_HASH),)
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),)
+UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)
+else
+UNITDIR_HASH=$(PACKAGEDIR_HASH)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_HASH)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_HASH=
+UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_HASH),)
+UNITDIR_HASH:=$(firstword $(UNITDIR_HASH))
+else
+UNITDIR_HASH=
+endif
+endif
+ifdef UNITDIR_HASH
+override COMPILER_UNITDIR+=$(UNITDIR_HASH)
+endif
+ifdef UNITDIR_FPMAKE_HASH
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_HASH)
+endif
+endif
+ifdef REQUIRE_PACKAGES_LIBTAR
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libtar/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(PACKAGEDIR_LIBTAR),)
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile,,$(strip $(wildcard $(addsuffix /libtar/Makefile,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_LIBTAR),)
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /fpmake.pp,,$(strip $(wildcard $(addsuffix /libtar/fpmake.pp,$(PACKAGESDIR))))))
+endif
+endif
+ifneq ($(PACKAGEDIR_LIBTAR),)
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)),)
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)
+else
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_LIBTAR)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_LIBTAR) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBTAR)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_LIBTAR=
+UNITDIR_LIBTAR:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libtar/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_LIBTAR),)
+UNITDIR_LIBTAR:=$(firstword $(UNITDIR_LIBTAR))
+else
+UNITDIR_LIBTAR=
+endif
+endif
+ifdef UNITDIR_LIBTAR
+override COMPILER_UNITDIR+=$(UNITDIR_LIBTAR)
+endif
+ifdef UNITDIR_FPMAKE_LIBTAR
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_LIBTAR)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FPMKUNIT
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(PACKAGEDIR_FPMKUNIT),)
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /fpmake.pp,,$(strip $(wildcard $(addsuffix /fpmkunit/fpmake.pp,$(PACKAGESDIR))))))
+endif
+endif
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)),)
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FPMKUNIT=
+UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FPMKUNIT),)
+UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
+else
+UNITDIR_FPMKUNIT=
+endif
+endif
+ifdef UNITDIR_FPMKUNIT
+override COMPILER_UNITDIR+=$(UNITDIR_FPMKUNIT)
+endif
+ifdef UNITDIR_FPMAKE_FPMKUNIT
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(ARCH)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(ARCH)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX)
+ifneq ($(RLINKPATH),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+FPCCPUOPT:=-O2
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef SYSROOTPATH
+override FPCOPT+=-XR$(SYSROOTPATH)
+else
+ifeq ($(OS_TARGET),$(OS_SOURCE))
+ifeq ($(OS_TARGET),darwin)
+ifeq ($(CPU_TARGET),aarch64)
+ifneq ($(wildcard /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk),)
+override FPCOPT+=-XR/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk
+endif
+endif
+endif
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+endif
+ifneq ($(filter $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(filter $(CPU_TARGET),x86_64 mips mipsel mips64 mips64el riscv64 powerpc64),)
+override FPCOPT+=-Cg
+endif
+endif
+ifneq ($(filter $(CPU_TARGET),z80),)
+override FPCOPT+=-CX -XX
+endif
+ifdef LINKSHARED
+endif
+ifdef GCCLIBDIR
+override FPCOPT+=-Fl$(GCCLIBDIR)
+ifdef FPCMAKEGCCLIBDIR
+override FPCMAKEOPT+=-Fl$(FPCMAKEGCCLIBDIR)
+else
+override FPCMAKEOPT+=-Fl$(GCCLIBDIR)
+endif
+endif
+ifdef OTHERLIBDIR
+override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR))
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(filter -sh,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(filter -s,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
+EXECPPAS=
+else
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILENAMES:=$(notdir $(INSTALLPPUFILES))
+override INSTALLPPULINKFILENAMES:=$(notdir $(INSTALLPPULINKFILES))
+override INSTALLPPUFILES=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILENAMES))
+override INSTALLPPULINKFILES=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILENAMES)))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ifdef FPCMAKENEW
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(FPCMAKENEW) -o $(INSTALL_UNITDIR)/Package.fpc -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+else
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+ifdef RUNBATCH
+	$(RUNBATCH) $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
+endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override ALL_CLEANEXEFILES+=$(foreach lEXEEXT,$(ALL_EXEEXT),$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(lEXEEXT), $(CLEAN_PROGRAMS))))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILENAMES:=$(CLEANPPUFILES)
+override CLEANPPUFILES=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILENAMES))
+override CLEANPPULINKFILENAMES:=$(CLEANPPULINKFILES)
+override CLEANPPULINKFILES=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILENAMES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) *$(FULL_TARGET).fpm Package.fpc *$(ASMEXT)
+	-$(DEL) $(FPCEXTFILE) $(REDIRFILE) script*.res link*.res *_script.res *_link.res symbol_order*.fpc
+	-$(DEL) $(PPAS) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef ALL_CLEANEXEFILES
+	-$(DEL) $(ALL_CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+	-$(DELTREE) units
+	-$(DELTREE) bin
+	-$(DEL) *$(OEXT) *$(LTOEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package*.fpc *.fpm
+	-$(DEL) $(FPCEXTFILE) $(REDIRFILE) script*.res link*.res *_script.res *_link.res symbol_order*.fpc
+	-$(DEL) $(PPAS) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)  FPC fpmake... $(FPCFPMAKE)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+units:
+examples:
+shared:
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+zipexampleinstall: fpc_zipexampleinstall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: units examples shared sourceinstall exampleinstall zipexampleinstall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+ifdef FPC_DOTTEDUNITS
+FPMAKE_OPT+=-ns
+FPMAKE_OPT+=-o -dFPC_DOTTEDUNITS
+endif
+.NOTPARALLEL:
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+	{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+	$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

packages/fcl-syntax/examples/demo_asm.pp

@@ -0,0 +1,40 @@
+program test_asm;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, syntax.highlighter, syntax.pascal;
+
+procedure TestASM;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  highlighter: TSyntaxHighlighter;
+begin
+  highlighter := TSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute('asm'#13#10'end');
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn('Testing ASM block: ''asm'#13#10'end''');
+  WriteLn('Token count: ', Length(tokens));
+  WriteLn;
+
+  for i := 0 to High(tokens) do begin
+    WriteLn('Token ', i, ': "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind));
+  end;
+end;
+
+begin
+  WriteLn('ASM Block Test');
+  WriteLn('==============');
+  WriteLn;
+
+  TestASM;
+
+  WriteLn;
+  WriteLn('Test completed. Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_bash.pp

@@ -0,0 +1,179 @@
+program test_bash;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.bash;
+
+procedure TestBashKeywords;
+const
+  BashKeywords: array[0..19] of string = (
+    'if', 'then', 'else', 'fi', 'case', 'esac', 'for', 'do', 'done', 'while',
+    'function', 'return', 'break', 'continue', 'declare', 'local', 'export', 'set', 'test', 'eval'
+  );
+var
+  highlighter: TBashSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  WriteLn('Testing Bash Keywords:');
+  WriteLn('=====================');
+
+  highlighter := TBashSyntaxHighlighter.Create;
+  try
+    for i := 0 to High(BashKeywords) do begin
+      tokens := highlighter.Execute(BashKeywords[i]);
+
+      if (Length(tokens) = 1) and (tokens[0].Kind = shKeyword) then
+        WriteLn(BashKeywords[i] + ': PASS - recognized as keyword')
+      else
+        WriteLn(BashKeywords[i] + ': FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+    end;
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestBashTokenTypes;
+var
+  highlighter: TBashSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+begin
+  WriteLn('Testing Bash Token Types:');
+  WriteLn('========================');
+
+  highlighter := TBashSyntaxHighlighter.Create;
+  try
+
+    // Test single-quoted string
+    tokens := highlighter.Execute('''hello world''');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('Single-quoted string: PASS')
+    else
+      WriteLn('Single-quoted string: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test double-quoted string
+    tokens := highlighter.Execute('"hello $USER"');
+    if (Length(tokens) >= 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('Double-quoted string: PASS')
+    else
+      WriteLn('Double-quoted string: FAIL');
+
+
+    // Test comment
+    tokens := highlighter.Execute('# This is a comment');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shComment) then
+      WriteLn('Comment: PASS')
+    else
+      WriteLn('Comment: FAIL');
+
+
+    // Test variable
+    tokens := highlighter.Execute('$USER');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shDefault) then
+      WriteLn('Variable: PASS')
+    else
+      WriteLn('Variable: FAIL');
+
+
+    // Test number
+    tokens := highlighter.Execute('123');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Number: PASS')
+    else
+      WriteLn('Number: FAIL');
+
+
+    // Test operator
+    tokens := highlighter.Execute('==');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shOperator) then
+      WriteLn('Operator: PASS')
+    else
+      WriteLn('Operator: FAIL');
+
+
+    // Test backquote command substitution
+    tokens := highlighter.Execute('`date`');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shInterpolation) then
+      WriteLn('Command substitution: PASS')
+    else
+      WriteLn('Command substitution: FAIL');
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestBashScript;
+var
+  highlighter: TBashSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  script: string;
+begin
+  WriteLn('Testing Complete Bash Script:');
+  WriteLn('============================');
+
+  script := '|';
+
+  highlighter := TBashSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(script);
+
+    WriteLn('Script: ', script);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+              ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCategorySystem;
+var
+  categories: TStringList;
+  bashCategoryID: Integer;
+  i: Integer;
+begin
+  WriteLn('Testing Category System for Bash:');
+  WriteLn('=================================');
+
+  bashCategoryID := TSyntaxHighlighter.RegisterCategory('Bash');
+  WriteLn('Bash category ID: ', bashCategoryID);
+
+  categories := TStringList.Create;
+  try
+    TSyntaxHighlighter.GetRegisteredCategories(categories);
+    WriteLn('All registered categories:');
+    for i := 0 to categories.Count - 1 do
+      WriteLn('  ', categories[i], ' = ', PtrInt(categories.Objects[i]));
+  finally
+    categories.Free;
+  end;
+
+  WriteLn;
+end;
+
+begin
+  WriteLn('Bash Syntax Highlighter Test');
+  WriteLn('=============================');
+  WriteLn;
+
+  TestCategorySystem;
+  TestBashKeywords;
+  TestBashTokenTypes;
+  TestBashScript;
+
+  WriteLn('Test completed. Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_categories.pp

@@ -0,0 +1,79 @@
+program test_categories;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.pascal;
+
+procedure TestCategorySystem;
+var
+  highlighter: TSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  categories: TStringList;
+  i: Integer;
+  pascalCategoryID: Integer;
+begin
+  WriteLn('Testing Category System');
+  WriteLn('=======================');
+  WriteLn;
+
+  // Test category registration
+  pascalCategoryID := TSyntaxHighlighter.RegisterCategory('Pascal');
+  WriteLn('Pascal category registered with ID: ', pascalCategoryID);
+
+  // Test duplicate registration
+  if TSyntaxHighlighter.RegisterCategory('Pascal') = pascalCategoryID then
+    WriteLn('PASS - Duplicate registration returns same ID')
+  else
+    WriteLn('FAIL - Duplicate registration issue');
+
+  // Test category retrieval
+  if TSyntaxHighlighter.GetRegisteredCategoryID('Pascal') = pascalCategoryID then
+    WriteLn('PASS - Category ID retrieval works')
+  else
+    WriteLn('FAIL - Category ID retrieval failed');
+
+  // Test non-existent category
+  if TSyntaxHighlighter.GetRegisteredCategoryID('NonExistent') = -1 then
+    WriteLn('PASS - Non-existent category returns -1')
+  else
+    WriteLn('FAIL - Non-existent category handling');
+
+  WriteLn;
+
+  // Test category listing
+  categories := TStringList.Create;
+  try
+    TSyntaxHighlighter.GetRegisteredCategories(categories);
+    WriteLn('Registered categories:');
+    for i := 0 to categories.Count - 1 do
+      WriteLn('  ', categories[i], ' = ', PtrInt(categories.Objects[i]));
+  finally
+    categories.Free;
+  end;
+
+  WriteLn;
+
+  // Test token categorization
+  highlighter := TSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute('begin end');
+
+    WriteLn('Token categorization test:');
+    for i := 0 to High(tokens) do begin
+      if tokens[i].HasCategory(pascalCategoryID) then
+        WriteLn('  Token "', tokens[i].Text, '" has correct Pascal category ID')
+      else
+        WriteLn('  Token "', tokens[i].Text, '" has wrong category ID: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+end;
+
+begin
+  TestCategorySystem;
+  WriteLn;
+  WriteLn('Category test completed.');
+end.

packages/fcl-syntax/examples/demo_compatibility.pp

@@ -0,0 +1,21 @@
+program test_compatibility;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, syntax.highlighter, syntax.pascal;
+
+var
+  tokens: TSyntaxTokenArray;
+begin
+  WriteLn('Testing backward compatibility function...');
+
+  tokens := DoPascalHighlighting('begin end');
+
+  if (Length(tokens) = 3) and (tokens[0].Kind = shKeyword) and (tokens[2].Kind = shKeyword) then
+    WriteLn('PASS - Backward compatibility function works correctly')
+  else
+    WriteLn('FAIL - Backward compatibility function not working');
+
+  WriteLn('Test completed.');
+end.

packages/fcl-syntax/examples/demo_css.pp

@@ -0,0 +1,265 @@
+program test_css;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.css;
+
+procedure TestCssAtRules;
+const
+  CssAtRules: array[0..9] of string = (
+    '@charset', '@import', '@media', '@keyframes', '@font-face',
+    '@supports', '@page', '@namespace', '@viewport', '@layer'
+  );
+var
+  highlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  WriteLn('Testing CSS At-Rules:');
+  WriteLn('====================');
+
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+    for i := 0 to High(CssAtRules) do begin
+      tokens := highlighter.Execute(CssAtRules[i]);
+
+      if (Length(tokens) = 1) and (tokens[0].Kind = shDirective) then
+        WriteLn(CssAtRules[i] + ': PASS - recognized as directive')
+      else
+        WriteLn(CssAtRules[i] + ': FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+    end;
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCssProperties;
+const
+  CssProperties: array[0..9] of string = (
+    'color', 'background', 'margin', 'padding', 'border',
+    'font', 'width', 'height', 'position', 'display'
+  );
+var
+  highlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  WriteLn('Testing CSS Properties:');
+  WriteLn('======================');
+
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+    for i := 0 to High(CssProperties) do begin
+      tokens := highlighter.Execute(CssProperties[i]);
+
+      if (Length(tokens) = 1) and (tokens[0].Kind = shKeyword) then
+        WriteLn(CssProperties[i] + ': PASS - recognized as property')
+      else
+        WriteLn(CssProperties[i] + ': FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+    end;
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCssTokenTypes;
+var
+  highlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+begin
+  WriteLn('Testing CSS Token Types:');
+  WriteLn('=======================');
+
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+
+    // Test single-quoted string
+    tokens := highlighter.Execute('''Arial''');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('Single-quoted string: PASS')
+    else
+      WriteLn('Single-quoted string: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test double-quoted string
+    tokens := highlighter.Execute('"Helvetica"');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('Double-quoted string: PASS')
+    else
+      WriteLn('Double-quoted string: FAIL');
+
+
+    // Test hex color
+    tokens := highlighter.Execute('#FF0000');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Hex color: PASS')
+    else
+      WriteLn('Hex color: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test 3-digit hex color
+    tokens := highlighter.Execute('#F00');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('3-digit hex color: PASS')
+    else
+      WriteLn('3-digit hex color: FAIL');
+
+
+    // Test multi-line comment
+    tokens := highlighter.Execute('/* This is a comment */');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shComment) then
+      WriteLn('Multi-line comment: PASS')
+    else
+      WriteLn('Multi-line comment: FAIL');
+
+
+    // Test number with unit
+    tokens := highlighter.Execute('16px');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Number with unit: PASS')
+    else
+      WriteLn('Number with unit: FAIL');
+
+
+    // Test percentage
+    tokens := highlighter.Execute('100%');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Percentage: PASS')
+    else
+      WriteLn('Percentage: FAIL');
+
+
+    // Test URL function
+    tokens := highlighter.Execute('url(image.png)');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('URL function: PASS')
+    else
+      WriteLn('URL function: FAIL');
+
+
+    // Test class selector
+    tokens := highlighter.Execute('.myClass');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shDefault) then
+      WriteLn('Class selector: PASS')
+    else
+      WriteLn('Class selector: FAIL');
+
+
+    // Test ID selector
+    tokens := highlighter.Execute('#myId');
+    if (Length(tokens) = 1) then
+      WriteLn('ID selector: PASS')
+    else
+      WriteLn('ID selector: FAIL');
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCssRule;
+var
+  highlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  cssRule: string;
+begin
+  WriteLn('Testing Complete CSS Rule:');
+  WriteLn('=========================');
+
+  cssRule := '.container { width: 100%; color: #333; }';
+
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(cssRule);
+
+    WriteLn('Rule: ', cssRule);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCssMediaQuery;
+var
+  highlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  mediaQuery: string;
+begin
+  WriteLn('Testing CSS Media Query:');
+  WriteLn('=======================');
+
+  mediaQuery := '@media (max-width: 768px) { body { font-size: 14px; } }';
+
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(mediaQuery);
+
+    WriteLn('Media Query: ', mediaQuery);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCategorySystem;
+var
+  categories: TStringList;
+  cssCategoryID: Integer;
+  i: Integer;
+begin
+  WriteLn('Testing Category System for CSS:');
+  WriteLn('================================');
+
+  cssCategoryID := TSyntaxHighlighter.RegisterCategory('CSS');
+  WriteLn('CSS category ID: ', cssCategoryID);
+
+  categories := TStringList.Create;
+  try
+    TSyntaxHighlighter.GetRegisteredCategories(categories);
+    WriteLn('All registered categories:');
+    for i := 0 to categories.Count - 1 do
+      WriteLn('  ', categories[i], ' = ', PtrInt(categories.Objects[i]));
+  finally
+    categories.Free;
+  end;
+
+  WriteLn;
+end;
+
+begin
+  WriteLn('CSS Syntax Highlighter Test');
+  WriteLn('============================');
+  WriteLn;
+
+  TestCategorySystem;
+  TestCssAtRules;
+  TestCssProperties;
+  TestCssTokenTypes;
+  TestCssRule;
+  TestCssMediaQuery;
+end.

packages/fcl-syntax/examples/demo_extraclasses.pp

@@ -0,0 +1,63 @@
+program test_extraclasses;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.javascript, syntax.htmlrender;
+
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: string;
+  jsCode: string;
+begin
+  WriteLn('Testing ExtraClasses Property:');
+  WriteLn('=============================');
+
+  jsCode := 'var x = 42;';
+  WriteLn('Original JavaScript: ', jsCode);
+  WriteLn;
+
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  try
+    tokens := jsHighlighter.Execute(jsCode);
+
+    // Test default (no extra classes)
+    renderer.ExtraClasses := '';
+    renderer.RenderTokensToString(tokens, output);
+    WriteLn('Default (no extra classes):');
+    WriteLn(output);
+    WriteLn;
+
+    // Test with single extra class
+    renderer.ExtraClasses := 'syntax-highlight';
+    renderer.RenderTokensToString(tokens, output);
+    WriteLn('With single extra class "syntax-highlight":');
+    WriteLn(output);
+    WriteLn;
+
+    // Test with multiple extra classes
+    renderer.ExtraClasses := 'code-block theme-dark line-1';
+    renderer.RenderTokensToString(tokens, output);
+    WriteLn('With multiple extra classes "code-block theme-dark line-1":');
+    WriteLn(output);
+    WriteLn;
+
+    // Test with hroNoDefaultSpan option
+    renderer.Options := [hroNoDefaultSpan];
+    renderer.ExtraClasses := 'no-default-spans';
+    renderer.RenderTokensToString(tokens, output);
+    WriteLn('With hroNoDefaultSpan + extra classes "no-default-spans":');
+    WriteLn(output);
+    WriteLn;
+
+  finally
+    renderer.Free;
+    jsHighlighter.Free;
+  end;
+
+  WriteLn('Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_html.pp

@@ -0,0 +1,266 @@
+program test_html;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.html;
+
+procedure TestHtmlBasicTags;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML Basic Tags:');
+  WriteLn('=======================');
+
+  htmlCode := '<html><head><title>Test</title></head><body><p>Hello</p></body></html>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestHtmlAttributes;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML Attributes:');
+  WriteLn('=======================');
+
+  htmlCode := '<div class="container" id="main" style="color: red;">Content</div>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestHtmlComments;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML Comments:');
+  WriteLn('=====================');
+
+  htmlCode := '<!-- This is a comment --><p>Text</p>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestHtmlEntities;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML Entities:');
+  WriteLn('=====================');
+
+  htmlCode := '<p>&lt;div&gt; &amp; &quot;test&quot; &#123; &#x41;</p>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestHtmlEmbeddedCss;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML Embedded CSS:');
+  WriteLn('==========================');
+
+  htmlCode := '<style>body { color: red; font-size: 16px; }</style>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestHtmlEmbeddedJavaScript;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML Embedded JavaScript:');
+  WriteLn('=================================');
+
+  htmlCode := '<script>function test() { console.log("hello"); }</script>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestHtmlDoctype;
+var
+  highlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  htmlCode: string;
+begin
+  WriteLn('Testing HTML DOCTYPE:');
+  WriteLn('====================');
+
+  htmlCode := '<!DOCTYPE html><html><head></head></html>';
+
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(htmlCode);
+
+    WriteLn('HTML: ', htmlCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCategorySystem;
+var
+  categories: TStringList;
+  htmlCategoryID: Integer;
+  i: Integer;
+begin
+  WriteLn('Testing Category System for HTML:');
+  WriteLn('=================================');
+
+  htmlCategoryID := TSyntaxHighlighter.RegisterCategory('HTML');
+  WriteLn('HTML category ID: ', htmlCategoryID);
+
+  categories := TStringList.Create;
+  try
+    TSyntaxHighlighter.GetRegisteredCategories(categories);
+    WriteLn('All registered categories:');
+    for i := 0 to categories.Count - 1 do
+      WriteLn('  ', categories[i], ' = ', PtrInt(categories.Objects[i]));
+  finally
+    categories.Free;
+  end;
+
+  WriteLn;
+end;
+
+begin
+  WriteLn('HTML Syntax Highlighter Test');
+  WriteLn('============================');
+  WriteLn;
+
+  TestCategorySystem;
+  TestHtmlBasicTags;
+  TestHtmlAttributes;
+  TestHtmlComments;
+  TestHtmlEntities;
+  TestHtmlEmbeddedCss;
+  TestHtmlEmbeddedJavaScript;
+  TestHtmlDoctype;
+
+  WriteLn('Test completed. Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_htmlrender.pp

@@ -0,0 +1,253 @@
+program test_htmlrender;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.javascript, syntax.css,
+  syntax.html, syntax.htmlrender;
+
+procedure TestJavaScriptRendering;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: TStringList;
+  jsCode: string;
+  i: Integer;
+begin
+  WriteLn('Testing JavaScript HTML Rendering:');
+  WriteLn('==================================');
+
+  jsCode := 'function test() { return "hello"; }';
+
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  output := TStringList.Create;
+  try
+    tokens := jsHighlighter.Execute(jsCode);
+
+    WriteLn('Original JavaScript: ', jsCode);
+    WriteLn;
+
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Rendered HTML:');
+    for i := 0 to output.Count - 1 do
+      WriteLn(output[i]);
+
+  finally
+    output.Free;
+    renderer.Free;
+    jsHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn;
+end;
+
+procedure TestCssRendering;
+var
+  cssHighlighter: TCssSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: TStringList;
+  cssCode: string;
+  i: Integer;
+begin
+  WriteLn('Testing CSS HTML Rendering:');
+  WriteLn('===========================');
+
+  cssCode := 'body { color: #FF0000; font-size: 16px; }';
+
+  cssHighlighter := TCssSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  output := TStringList.Create;
+  try
+    tokens := cssHighlighter.Execute(cssCode);
+
+    WriteLn('Original CSS: ', cssCode);
+    WriteLn;
+
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Rendered HTML:');
+    for i := 0 to output.Count - 1 do
+      WriteLn(output[i]);
+
+  finally
+    output.Free;
+    renderer.Free;
+    cssHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn;
+end;
+
+procedure TestHtmlRendering;
+var
+  htmlHighlighter: THtmlSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: TStringList;
+  htmlCode: string;
+  i: Integer;
+begin
+  WriteLn('Testing HTML HTML Rendering:');
+  WriteLn('============================');
+
+  htmlCode := '<div class="container">&lt;Hello&gt;</div>';
+
+  htmlHighlighter := THtmlSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  output := TStringList.Create;
+  try
+    tokens := htmlHighlighter.Execute(htmlCode);
+
+    WriteLn('Original HTML: ', htmlCode);
+    WriteLn;
+
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Rendered HTML:');
+    for i := 0 to output.Count - 1 do
+      WriteLn(output[i]);
+
+  finally
+    output.Free;
+    renderer.Free;
+    htmlHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn;
+end;
+
+procedure TestEmbeddedHtmlRendering;
+var
+  htmlHighlighter: THtmlSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: TStringList;
+  htmlCode: string;
+  i: Integer;
+begin
+  WriteLn('Testing Embedded HTML Rendering:');
+  WriteLn('================================');
+
+  htmlCode := '<style>body { color: red; }</style><script>alert("test");</script>';
+
+  htmlHighlighter := THtmlSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  output := TStringList.Create;
+  try
+    tokens := htmlHighlighter.Execute(htmlCode);
+
+    WriteLn('Original HTML: ', htmlCode);
+    WriteLn;
+
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Rendered HTML:');
+    for i := 0 to output.Count - 1 do
+      WriteLn(output[i]);
+
+  finally
+    output.Free;
+    renderer.Free;
+    htmlHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn;
+end;
+
+procedure TestStringOutput;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: string;
+  jsCode: string;
+begin
+  WriteLn('Testing String Output:');
+  WriteLn('=====================');
+
+  jsCode := 'var x = 42;';
+
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  try
+    tokens := jsHighlighter.Execute(jsCode);
+
+    WriteLn('Original JavaScript: ', jsCode);
+    WriteLn;
+
+    renderer.RenderTokensToString(tokens, output);
+
+    WriteLn('Rendered HTML (single string):');
+    WriteLn(output);
+
+  finally
+    renderer.Free;
+    jsHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn;
+end;
+
+procedure TestSpecialCharacters;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: TStringList;
+  jsCode: string;
+  i: Integer;
+begin
+  WriteLn('Testing Special Character Escaping:');
+  WriteLn('===================================');
+
+  jsCode := 'var html = "<div>\"Hello & Welcome\"</div>";';
+
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  output := TStringList.Create;
+  try
+    tokens := jsHighlighter.Execute(jsCode);
+
+    WriteLn('Original JavaScript: ', jsCode);
+    WriteLn;
+
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Rendered HTML (with escaping):');
+    for i := 0 to output.Count - 1 do
+      WriteLn(output[i]);
+
+  finally
+    output.Free;
+    renderer.Free;
+    jsHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn;
+end;
+
+begin
+  WriteLn('HTML Syntax Renderer Test');
+  WriteLn('=========================');
+  WriteLn;
+
+  TestJavaScriptRendering;
+  TestCssRendering;
+  TestHtmlRendering;
+  TestEmbeddedHtmlRendering;
+  TestStringOutput;
+  TestSpecialCharacters;
+
+  WriteLn('Test completed. Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_javascript.pp

@@ -0,0 +1,270 @@
+program test_javascript;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.javascript;
+
+procedure TestJavaScriptKeywords;
+const
+  JSKeywords: array[0..19] of string = (
+    'var', 'let', 'const', 'function', 'if', 'else', 'for', 'while', 'do', 'switch',
+    'case', 'default', 'break', 'continue', 'return', 'try', 'catch', 'finally', 'throw', 'new'
+  );
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  WriteLn('Testing JavaScript Keywords:');
+  WriteLn('===========================');
+
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    for i := 0 to High(JSKeywords) do begin
+      tokens := highlighter.Execute(JSKeywords[i]);
+
+      if (Length(tokens) = 1) and (tokens[0].Kind = shKeyword) then
+        WriteLn(JSKeywords[i] + ': PASS - recognized as keyword')
+      else
+        WriteLn(JSKeywords[i] + ': FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+    end;
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestJavaScriptTokenTypes;
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+begin
+  WriteLn('Testing JavaScript Token Types:');
+  WriteLn('==============================');
+
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+
+    // Test single-quoted string
+    tokens := highlighter.Execute('''hello world''');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('Single-quoted string: PASS')
+    else
+      WriteLn('Single-quoted string: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test double-quoted string
+    tokens := highlighter.Execute('"hello world"');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('Double-quoted string: PASS')
+    else
+      WriteLn('Double-quoted string: FAIL');
+
+
+    // Test template literal
+    tokens := highlighter.Execute('`hello ${name}`');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shRawString) then
+      WriteLn('Template literal: PASS')
+    else
+      WriteLn('Template literal: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test regex literal
+    tokens := highlighter.Execute('/[a-z]+/gi');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shRegex) then
+      WriteLn('Regex literal: PASS')
+    else
+      WriteLn('Regex literal: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test single-line comment
+    tokens := highlighter.Execute('// This is a comment');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shComment) then
+      WriteLn('Single-line comment: PASS')
+    else
+      WriteLn('Single-line comment: FAIL');
+
+
+    // Test multi-line comment
+    tokens := highlighter.Execute('/* This is a comment */');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shComment) then
+      WriteLn('Multi-line comment: PASS')
+    else
+      WriteLn('Multi-line comment: FAIL');
+
+
+    // Test number
+    tokens := highlighter.Execute('123.45');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Decimal number: PASS')
+    else
+      WriteLn('Decimal number: FAIL');
+
+
+    // Test hex number
+    tokens := highlighter.Execute('0xFF');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Hex number: PASS')
+    else
+      WriteLn('Hex number: FAIL');
+
+
+    // Test operator
+    tokens := highlighter.Execute('===');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shOperator) then
+      WriteLn('Operator: PASS')
+    else
+      WriteLn('Operator: FAIL');
+
+
+    // Test identifier
+    tokens := highlighter.Execute('myVariable');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shDefault) then
+      WriteLn('Identifier: PASS')
+    else
+      WriteLn('Identifier: FAIL');
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestJavaScriptNumbers;
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+begin
+  WriteLn('Testing JavaScript Number Formats:');
+  WriteLn('==================================');
+
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    // Test scientific notation
+    tokens := highlighter.Execute('1.23e-4');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Scientific notation: PASS')
+    else
+      WriteLn('Scientific notation: FAIL');
+
+    // Test binary number
+    tokens := highlighter.Execute('0b1010');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Binary number: PASS')
+    else
+      WriteLn('Binary number: FAIL');
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestJavaScriptFunction;
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  jsCode: string;
+begin
+  WriteLn('Testing Complete JavaScript Function:');
+  WriteLn('====================================');
+
+  jsCode := '/* This is a comment */';
+
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(jsCode);
+
+    WriteLn('Code: ', jsCode);
+    WriteLn('Tokens (', Length(tokens), '):');
+    for i := 0 to High(tokens) do begin
+      if Trim(tokens[i].Text) <> '' then
+        WriteLn('  "', tokens[i].Text, '" - Kind: ', Ord(tokens[i].Kind),
+                ' (', tokens[i].Kind, ') - Category: ', tokens[i].CategoriesAsString);
+    end;
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestRegexContext;
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+begin
+  WriteLn('Testing Regex vs Division Context:');
+  WriteLn('==================================');
+
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    // This should be recognized as regex (after =)
+    tokens := highlighter.Execute('var pattern = /test/;');
+    WriteLn('Code: var pattern = /test/;');
+    if (Length(tokens) >= 5) and (tokens[4].Kind = shRegex) then
+      WriteLn('  Regex after = : PASS')
+    else
+      WriteLn('  Regex after = : FAIL');
+
+    // This should be division (after variable)
+    tokens := highlighter.Execute('result = a / b;');
+    WriteLn('Code: result = a / b;');
+    if (Length(tokens) >= 5) and (tokens[4].Kind = shOperator) then
+      WriteLn('  Division: PASS')
+    else
+      WriteLn('  Division: FAIL - kind=' + IntToStr(Ord(tokens[4].Kind)));
+
+  finally
+    highlighter.Free;
+  end;
+
+  WriteLn;
+end;
+
+procedure TestCategorySystem;
+var
+  categories: TStringList;
+  jsCategoryID: Integer;
+  i: Integer;
+begin
+  WriteLn('Testing Category System for JavaScript:');
+  WriteLn('======================================');
+
+  jsCategoryID := TSyntaxHighlighter.RegisterCategory('JavaScript');
+  WriteLn('JavaScript category ID: ', jsCategoryID);
+
+  categories := TStringList.Create;
+  try
+    TSyntaxHighlighter.GetRegisteredCategories(categories);
+    WriteLn('All registered categories:');
+    for i := 0 to categories.Count - 1 do
+      WriteLn('  ', categories[i], ' = ', PtrInt(categories.Objects[i]));
+  finally
+    categories.Free;
+  end;
+
+  WriteLn;
+end;
+
+begin
+  WriteLn('JavaScript Syntax Highlighter Test');
+  WriteLn('===================================');
+  WriteLn;
+
+  TestCategorySystem;
+  TestJavaScriptKeywords;
+  TestJavaScriptTokenTypes;
+  TestJavaScriptNumbers;
+  TestRegexContext;
+  TestJavaScriptFunction;
+
+  WriteLn('Test completed. Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_multiline.pp

@@ -0,0 +1,76 @@
+program test_multiline;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.javascript, syntax.htmlrender;
+
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  renderer: THtmlSyntaxRenderer;
+  tokens: TSyntaxTokenArray;
+  output: TStringList;
+  jsCode: string;
+  i: Integer;
+begin
+  WriteLn('Testing Multiline JavaScript Rendering:');
+  WriteLn('=======================================');
+
+  jsCode := 'function test() {' + #10 + '  return "hello";' + #10 + '}';
+
+  WriteLn('Original JavaScript:');
+  WriteLn(jsCode);
+  WriteLn;
+
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  renderer := THtmlSyntaxRenderer.Create;
+  output := TStringList.Create;
+  try
+    tokens := jsHighlighter.Execute(jsCode);
+
+    WriteLn('Tokens found: ', Length(tokens));
+    for i := 0 to High(tokens) do begin
+      WriteLn('Token ', i, ': "', StringReplace(tokens[i].Text, #10, '\n', [rfReplaceAll]), '" Kind: ', Ord(tokens[i].Kind));
+    end;
+    WriteLn;
+
+    // Test default behavior
+    renderer.Options := [];
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Default Rendering (', output.Count, ' lines):');
+    for i := 0 to output.Count - 1 do
+      WriteLn('Line ', i, ': ', output[i]);
+
+    WriteLn;
+
+    // Test with hroPreserveLineStructure
+    output.Clear;
+    renderer.Options := [hroPreserveLineStructure];
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Preserved Line Structure (', output.Count, ' lines):');
+    for i := 0 to output.Count - 1 do
+      WriteLn('Line ', i, ': ', output[i]);
+
+    WriteLn;
+
+    // Test with both options
+    output.Clear;
+    renderer.Options := [hroPreserveLineStructure, hroNoDefaultSpan];
+    renderer.RenderTokens(tokens, output);
+
+    WriteLn('Preserved + No Default Spans (', output.Count, ' lines):');
+    for i := 0 to output.Count - 1 do
+      WriteLn('Line ', i, ': ', output[i]);
+
+  finally
+    output.Free;
+    renderer.Free;
+    jsHighlighter.Free;
+  end;
+
+  WriteLn;
+  WriteLn('Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/examples/demo_multiple_categories.pp

@@ -0,0 +1,52 @@
+program test_multiple_categories;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, syntax.highlighter, syntax.pascal;
+
+procedure TestMultipleCategories;
+var
+  categories: TStringList;
+  i: Integer;
+  javaID, pythonID, cppID, pascalID: Integer;
+begin
+  WriteLn('Testing Multiple Categories');
+  WriteLn('===========================');
+  WriteLn;
+
+  // Register various language categories
+  javaID := TSyntaxHighlighter.RegisterCategory('Java');
+  pythonID := TSyntaxHighlighter.RegisterCategory('Python');
+  cppID := TSyntaxHighlighter.RegisterCategory('C++');
+
+  // Pascal will already be registered from the previous test/highlighter usage
+  pascalID := TSyntaxHighlighter.RegisterCategory('Pascal');
+
+  WriteLn('Category IDs:');
+  WriteLn('  Java: ', javaID);
+  WriteLn('  Python: ', pythonID);
+  WriteLn('  C++: ', cppID);
+  WriteLn('  Pascal: ', pascalID);
+  WriteLn;
+
+  // List all registered categories
+  categories := TStringList.Create;
+  try
+    TSyntaxHighlighter.GetRegisteredCategories(categories);
+    WriteLn('All registered categories (', categories.Count, ' total):');
+    for i := 0 to categories.Count - 1 do
+      WriteLn('  ', categories[i], ' = ', PtrInt(categories.Objects[i]));
+  finally
+    categories.Free;
+  end;
+
+  WriteLn;
+  WriteLn('Category registration system working correctly!');
+end;
+
+begin
+  TestMultipleCategories;
+  WriteLn;
+  WriteLn('Multiple categories test completed.');
+end.

packages/fcl-syntax/examples/demo_simple.pp

@@ -0,0 +1,153 @@
+program test_simple;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, syntax.highlighter, syntax.pascal;
+
+procedure TestKeyword(const keyword: string);
+var
+  tokens: TSyntaxTokenArray;
+  highlighter: TSyntaxHighlighter;
+begin
+  highlighter := TSyntaxHighlighter.Create;
+  try
+    tokens := highlighter.Execute(keyword);
+  finally
+    highlighter.Free;
+  end;
+
+  if Length(tokens) = 1 then begin
+    if tokens[0].Kind = shKeyword then
+      WriteLn(keyword + ': PASS - recognized as keyword')
+    else
+      WriteLn(keyword + ': FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+  end else
+    WriteLn(keyword + ': FAIL - token count=' + IntToStr(Length(tokens)));
+end;
+
+procedure TestAllKeywords;
+const
+  Keywords: array[0..60] of string = (
+    'AND', 'ARRAY', 'ASM', 'ASSEMBLER',
+    'BEGIN', 'BREAK',
+    'CASE', 'CONST', 'CONSTRUCTOR', 'CLASS',
+    'DEFAULT', 'DESTRUCTOR', 'DIV', 'DO', 'DOWNTO',
+    'ELSE', 'END', 'EXCEPT', 'EXIT',
+    'FINALIZATION', 'FINALLY', 'FOR', 'FUNCTION',
+    'GOTO',
+    'IF', 'IMPLEMENTATION', 'IN', 'INHERITED', 'INITIALIZATION', 'INTERFACE',
+    'NIL', 'NOT',
+    'OBJECT', 'OF', 'ON', 'OR', 'OVERRIDE',
+    'PACKED', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PROPERTY', 'PROTECTED',
+      'PUBLIC', 'PUBLISHED',
+    'RAISE', 'RECORD', 'REPEAT', 'RESOURCESTRING',
+    'SET',
+    'THEN', 'TRY', 'TYPE',
+    'UNIT', 'UNTIL', 'USES',
+    'VAR', 'VIRTUAL',
+    'WHILE', 'WITH',
+    'XOR'
+  );
+var
+  i: Integer;
+begin
+  WriteLn('Testing all keywords:');
+  WriteLn('====================');
+
+  for i := 0 to High(Keywords) do
+    TestKeyword(LowerCase(Keywords[i]));
+
+  WriteLn;
+  WriteLn('Testing other token types:');
+  WriteLn('==========================');
+end;
+
+procedure TestOtherTokens;
+var
+  tokens: TSyntaxTokenArray;
+  highlighter: TSyntaxHighlighter;
+begin
+  highlighter := TSyntaxHighlighter.Create;
+  try
+
+    // Test comment
+    tokens := highlighter.Execute('{ comment }');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shComment) then
+      WriteLn('Comment: PASS')
+    else
+      WriteLn('Comment: FAIL');
+
+
+    // Test string
+    tokens := highlighter.Execute('''hello''');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shStrings) then
+      WriteLn('String: PASS')
+    else
+      WriteLn('String: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test character
+    tokens := highlighter.Execute('''A''');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shCharacters) then
+      WriteLn('Character: PASS')
+    else
+      WriteLn('Character: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test number
+    tokens := highlighter.Execute('123');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Number: PASS')
+    else
+      WriteLn('Number: FAIL');
+
+
+    // Test hex number
+    tokens := highlighter.Execute('$FF');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shNumbers) then
+      WriteLn('Hex number: PASS')
+    else
+      WriteLn('Hex number: FAIL');
+
+
+    // Test symbol
+    tokens := highlighter.Execute(':=');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shSymbol) then
+      WriteLn('Symbol: PASS')
+    else
+      WriteLn('Symbol: FAIL');
+
+
+    // Test directive
+    tokens := highlighter.Execute('{$MODE OBJFPC}');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shDirective) then
+      WriteLn('Directive: PASS')
+    else
+      WriteLn('Directive: FAIL - kind=' + IntToStr(Ord(tokens[0].Kind)));
+
+
+    // Test identifier
+    tokens := highlighter.Execute('MyVariable');
+    if (Length(tokens) = 1) and (tokens[0].Kind = shDefault) then
+      WriteLn('Identifier: PASS')
+    else
+      WriteLn('Identifier: FAIL');
+
+  finally
+    highlighter.Free;
+  end;
+end;
+
+begin
+  WriteLn('Pascal Syntax Highlighter Test');
+  WriteLn('==============================');
+  WriteLn;
+
+  TestAllKeywords;
+  TestOtherTokens;
+
+  WriteLn;
+  WriteLn('Test completed. Press Enter to exit.');
+  ReadLn;
+end.

packages/fcl-syntax/fpmake.pp

@@ -0,0 +1,68 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses {$ifdef unix}cthreads,{$endif} fpmkunit;
+
+Var
+  T : TTarget;
+  P : TPackage;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('fcl-syntax');
+    P.ShortName:='fclsh';
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='3.3.1';
+    P.Dependencies.Add('fcl-base');
+    P.Dependencies.Add('rtl-objpas');
+    P.Dependencies.Add('fcl-fpcunit');
+    P.Author := 'Michael van Canneyt';
+    P.License := 'LGPL with modification, ';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Syntax highlighter.';
+    P.NeedLibC:= false;
+    P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql,human68k,ps1,wasip2];
+    if Defaults.CPU=jvm then
+      P.OSes := P.OSes - [java,android];
+
+    P.SourcePath.Add('src');
+
+    T:=P.Targets.AddUnit('syntax.highlighter.pp');
+    T:=P.Targets.AddUnit('syntax.pascal.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.bash.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.json.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.css.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.javascript.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.ini.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.sql.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+    T:=P.Targets.AddUnit('syntax.html.pp');
+    With T.Dependencies do
+      begin
+      AddUnit('syntax.highlighter');
+      AddUnit('syntax.css');
+      AddUnit('syntax.javascript');
+      end;
+    T:=P.Targets.AddUnit('syntax.htmlrender.pp');
+    T.Dependencies.AddUnit('syntax.highlighter');
+
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}
+
+
+

packages/fcl-syntax/src/syntax.bash.pp

@@ -0,0 +1,368 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Bash syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.bash;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Types, syntax.highlighter;
+
+type
+
+  { TBashSyntaxHighlighter }
+
+  TBashSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+  protected
+    procedure ProcessSingleQuoteString(var endPos: integer);
+    procedure ProcessDoubleQuoteString(var endPos: integer);
+    procedure ProcessBackquoteString(var endPos: integer);
+    procedure ProcessVariable(var endPos: integer);
+    procedure ProcessComment(var endPos: integer);
+    function CheckForKeyword(var endPos: integer): boolean;
+    procedure ProcessNumber(var endPos: integer);
+    procedure ProcessOperator(var endPos: integer);
+    function IsWordChar(ch: char): boolean;
+    class function GetLanguages: TStringDynArray; override;
+    procedure checkcategory; virtual;
+  public
+    constructor create; override;
+    class var CategoryBash : Integer;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+  end;
+
+const
+  MaxKeywordLength = 15;
+  MaxKeyword = 39;
+
+  BashKeywordTable: array[0..MaxKeyword] of string = (
+    'case', 'do', 'done', 'elif', 'else', 'esac', 'fi', 'for', 'function', 'if',
+    'in', 'select', 'then', 'until', 'while', 'break', 'continue', 'return', 'exit', 'declare',
+    'local', 'readonly', 'export', 'alias', 'unalias', 'type', 'which', 'command', 'builtin', 'enable',
+    'help', 'let', 'eval', 'exec', 'source', 'trap', 'umask', 'ulimit', 'set', 'shift'
+    );
+
+function DoBashHighlighting(const Source: string): TSyntaxTokenArray;
+
+implementation
+
+
+  { TBashSyntaxHighlighter }
+
+procedure TBashSyntaxHighlighter.ProcessSingleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> '''') do
+    Inc(FPos);
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '''') then
+    Inc(FPos); // Include closing quote
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TBashSyntaxHighlighter.ProcessDoubleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+  while FPos <= Length(FSource) do
+    begin
+    if FSource[FPos] = '"' then
+      begin
+      Inc(FPos);
+      break;
+      end
+    else if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then
+        Inc(FPos); // Skip escaped character
+      end;
+    Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TBashSyntaxHighlighter.ProcessBackquoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening backquote
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> '`') do
+    begin
+    if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then
+        Inc(FPos); // Skip escaped character
+      end;
+    Inc(FPos);
+    end;
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '`') then
+    Inc(FPos); // Include closing backquote
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInterpolation);
+end;
+
+procedure TBashSyntaxHighlighter.ProcessVariable(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip $
+
+  // Handle special variables like $?, $$, $!, etc.
+  if (FPos <= Length(FSource)) and (FSource[FPos] in ['?', '$', '!', '#', '*', '@', '-', '0'..'9']) then
+    begin
+    Inc(FPos);
+    end
+  // Handle ${variable} syntax
+  else if (FPos <= Length(FSource)) and (FSource[FPos] = '{') then
+    begin
+    Inc(FPos); // Skip {
+    while (FPos <= Length(FSource)) and (FSource[FPos] <> '}') do
+      Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = '}') then
+      Inc(FPos); // Include }
+    end
+  // Handle regular variable names
+  else
+    begin
+    while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+      Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault); // Variables as default for now
+end;
+
+procedure TBashSyntaxHighlighter.ProcessComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) do
+    Inc(FPos);
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+function TBashSyntaxHighlighter.CheckForKeyword(var endPos: integer): boolean;
+var
+  i, j: integer;
+  keyword: string;
+begin
+  i := 0;
+  while (FPos+i<=Length(FSource)) and (i < MaxKeywordLength) and IsWordChar(FSource[FPos + i]) do
+    Inc(i);
+  keyword:=Copy(FSource,FPos,i);
+  Result := False;
+
+  for j := 0 to MaxKeyword do
+    if BashKeywordTable[j] = keyword then
+      begin
+      Result := True;
+      break;
+      end;
+
+  if not Result then
+    Exit;
+
+  Inc(FPos, i);
+  endPos := FPos - 1;
+  AddToken(keyword, shKeyword);
+end;
+
+procedure TBashSyntaxHighlighter.ProcessNumber(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+    Inc(FPos);
+  // Handle decimal point
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '.') then
+    begin
+    Inc(FPos);
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+      Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+end;
+
+procedure TBashSyntaxHighlighter.ProcessOperator(var endPos: integer);
+var
+  startPos: integer;
+  ch: char;
+begin
+  startPos := FPos;
+  ch := FSource[FPos];
+
+  // Handle multi-character operators
+  case ch of
+  '=':
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = '=') then
+      Inc(FPos);
+    end;
+  '!':
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = '=') then
+      Inc(FPos);
+    end;
+  '<':
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] in ['=', '<']) then
+      Inc(FPos);
+    end;
+  '>':
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] in ['=', '>']) then Inc(FPos);
+    end;
+  '&':
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = '&') then Inc(FPos);
+    end;
+  '|':
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = '|') then Inc(FPos);
+    end;
+  else
+    Inc(FPos);
+  end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shOperator);
+end;
+
+function TBashSyntaxHighlighter.IsWordChar(ch: char): boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+end;
+
+class function TBashSyntaxHighlighter.GetLanguages: TStringDynArray;
+begin
+  Result:=['bash','sh','zsh']
+end;
+
+procedure TBashSyntaxHighlighter.checkcategory;
+begin
+  if CategoryBash=0 then
+    CategoryBash:=RegisterCategory('bash');
+end;
+
+constructor TBashSyntaxHighlighter.create;
+begin
+  inherited create;
+  CheckCategory;
+  DefaultCategory:=CategoryBash;
+end;
+
+function TBashSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  lLen,startPos,endPos: integer;
+  ch: char;
+begin
+  Result:=Nil;
+  if Length(Source) = 0 then
+    Exit;
+  FSource := Source;
+  lLen:=Length(FSource);
+  FPos := 1;
+  endpos:=0;
+  while FPos <= lLen do
+    begin
+    ch := FSource[FPos];
+    case ch of
+      '#':
+        ProcessComment(endPos);
+      '''':
+        ProcessSingleQuoteString(endPos);
+      '"':
+        ProcessDoubleQuoteString(endPos);
+      '`':
+        ProcessBackquoteString(endPos);
+      '$':
+        ProcessVariable(endPos);
+      '0'..'9':
+        ProcessNumber(endPos);
+      'a'..'z', 'A'..'Z', '_':
+        begin
+        if not CheckForKeyword(endPos) then
+          begin
+          startPos := FPos;
+          while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+            Inc(FPos);
+          endPos := FPos - 1;
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+          end;
+        end;
+      '=', '!', '<', '>', '&', '|', '+', '-', '*', '/', '%', '^': ProcessOperator(endPos);
+      ';', '(', ')', '[', ']', '{', '}', ',':
+        begin
+        AddToken(ch, shSymbol);
+        endPos := FPos;
+        Inc(FPos);
+        end;
+      ' ', #9, #10, #13:
+        begin
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+        end;
+    else
+      AddToken(ch, shInvalid);
+      endPos := FPos;
+      Inc(FPos);
+    end;
+    if FPos = endPos then
+      Inc(FPos);
+    end;
+  Result := FTokens.GetTokens;
+end;
+
+function DoBashHighlighting(const Source: string): TSyntaxTokenArray;
+var
+  highlighter: TBashSyntaxHighlighter;
+begin
+  highlighter := TBashSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  TBashSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.css.pp

@@ -0,0 +1,508 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    CSS syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.css;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter;
+  {$ELSE}
+  Types, SysUtils, syntax.highlighter;
+  {$ENDIF}
+
+type
+
+  { TCssSyntaxHighlighter }
+
+  TCssSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+  protected
+    procedure ProcessSingleQuoteString(var endPos: integer);
+    procedure ProcessDoubleQuoteString(var endPos: integer);
+    procedure ProcessMultiLineComment(var endPos: integer);
+    procedure ProcessSelector(var endPos: integer);
+    procedure ProcessProperty(var endPos: integer);
+    procedure ProcessColor(var endPos: integer);
+    function CheckForAtRule(var endPos: integer): boolean;
+    function CheckForProperty(var endPos: integer): boolean;
+    procedure ProcessNumber(var endPos: integer);
+    procedure ProcessUrl(var endPos: integer);
+    function IsWordChar(ch: char): boolean;
+    function IsHexChar(ch: char): boolean;
+    class procedure CheckCategories;
+    class procedure RegisterDefaultCategories; override;
+    class function GetLanguages : TStringDynarray; override;
+  public
+    constructor Create; override;
+    class var
+      CategoryCSS : Integer;
+      CategoryEmbeddedCSS : Integer;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+  end;
+
+const
+  MaxKeywordLength = 20;
+  MaxKeyword = 41;
+
+  CssAtRuleTable: array[0..MaxKeyword] of string = (
+    '@charset', '@import', '@namespace', '@media', '@supports', '@page', '@font-face',
+    '@keyframes', '@webkit-keyframes', '@moz-keyframes', '@ms-keyframes', '@o-keyframes',
+    '@document', '@font-feature-values', '@viewport', '@counter-style', '@property',
+    '@layer', '@container', '@scope', '@starting-style', '@position-try',
+    'animation', 'background', 'border', 'color', 'display', 'font', 'height',
+    'margin', 'padding', 'position', 'width', 'flex', 'grid', 'transform',
+    'transition', 'opacity', 'z-index', 'top', 'right', 'bottom'
+    );
+
+function DoCssHighlighting(const Source: string): TSyntaxTokenArray;
+
+implementation
+
+  { TCssSyntaxHighlighter }
+
+
+procedure TCssSyntaxHighlighter.ProcessSingleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+  while FPos <= Length(FSource) do
+  begin
+    if FSource[FPos] = '''' then
+    begin
+      Inc(FPos);
+      break;
+    end
+    else if FSource[FPos] = '\' then
+    begin
+      if FPos < Length(FSource) then Inc(FPos); // Skip escaped character
+    end;
+    Inc(FPos);
+  end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TCssSyntaxHighlighter.ProcessDoubleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+  while FPos <= Length(FSource) do
+    begin
+    if FSource[FPos] = '"' then
+      begin
+      Inc(FPos);
+      break;
+      end
+    else if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then
+        Inc(FPos); // Skip escaped character
+      end;
+    Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TCssSyntaxHighlighter.ProcessMultiLineComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos, 2); // Skip the opening /*
+  while FPos < Length(FSource) do
+    begin
+    if (FSource[FPos] = '*') and (FSource[FPos + 1] = '/') then
+      begin
+      Inc(FPos, 2);
+      break;
+      end;
+    Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+procedure TCssSyntaxHighlighter.ProcessSelector(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+
+  // Handle class selectors (.class)
+  if FSource[FPos] = '.' then
+    begin
+    Inc(FPos);
+    while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+      Inc(FPos);
+    end
+  // Handle ID selectors (#id)
+  else if FSource[FPos] = '#' then
+    begin
+    Inc(FPos);
+    while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+      Inc(FPos);
+    end
+  // Handle attribute selectors ([attr])
+  else if FSource[FPos] = '[' then
+    begin
+    Inc(FPos);
+    while (FPos <= Length(FSource)) and (FSource[FPos] <> ']') do
+      Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = ']') then
+      Inc(FPos);
+    end
+  // Handle pseudo-selectors (:hover, ::before)
+  else if FSource[FPos] = ':' then
+    begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] = ':') then
+      Inc(FPos); // Handle ::
+    while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+      Inc(FPos);
+    end
+  // Handle element selectors
+  else
+    begin
+    while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+      Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+end;
+
+procedure TCssSyntaxHighlighter.ProcessProperty(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  while (FPos <= Length(FSource)) and (FSource[FPos] in ['a'..'z', 'A'..'Z', '0'..'9', '-', '_']) do
+    Inc(FPos);
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shKeyword);
+end;
+
+procedure TCssSyntaxHighlighter.ProcessColor(var endPos: integer);
+var
+  startPos: integer;
+  digitCount: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip #
+  digitCount := 0;
+
+  while (FPos <= Length(FSource)) and IsHexChar(FSource[FPos]) and (digitCount < 8) do
+    begin
+    Inc(FPos);
+    Inc(digitCount);
+    end;
+
+  // Valid hex colors are 3, 4, 6, or 8 digits
+  if digitCount in [3, 4, 6, 8] then
+    begin
+    endPos := FPos - 1;
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+    end
+  else
+    begin
+    // Not a valid color, treat as selector
+    FPos := startPos;
+    ProcessSelector(endPos);
+    end;
+end;
+
+function TCssSyntaxHighlighter.CheckForAtRule(var endPos: integer): boolean;
+var
+  i, j: integer;
+  atRule: string;
+begin
+  Result := False;
+  if FSource[FPos] <> '@' then Exit;
+
+  i := 0;
+  while (FPos + i <= Length(FSource)) and (i < MaxKeywordLength) and
+    (FSource[FPos + i] in ['@', 'a'..'z', 'A'..'Z', '0'..'9', '-', '_']) do
+  begin
+    Inc(i);
+  end;
+
+  atRule := Copy(FSource, FPos, i);
+
+  for j := 0 to 21 do // Only check @-rules (first 22 entries)
+    if CssAtRuleTable[j] = atRule then
+    begin
+      Result := True;
+      break;
+    end;
+
+  if Result then
+  begin
+    Inc(FPos, i);
+    endPos := FPos - 1;
+    AddToken(atRule, shDirective);
+  end;
+end;
+
+function TCssSyntaxHighlighter.CheckForProperty(var endPos: integer): boolean;
+var
+   i, j: integer;
+  prop: string;
+begin
+  Result := False;
+  i := 0;
+
+  while (FPos + i <= Length(FSource)) and (i < MaxKeywordLength) and
+    (FSource[FPos + i] in ['a'..'z', 'A'..'Z', '0'..'9', '-', '_']) do
+  begin
+    Inc(i);
+  end;
+
+  prop := Copy(FSource, FPos, i);
+
+  for j := 22 to MaxKeyword do // Check properties (from index 22 onwards)
+    if CssAtRuleTable[j] = prop then
+    begin
+      Result := True;
+      break;
+    end;
+
+  if Result then
+  begin
+    Inc(FPos, i);
+    endPos := FPos - 1;
+    AddToken(prop, shKeyword);
+  end;
+end;
+
+procedure TCssSyntaxHighlighter.ProcessNumber(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+
+  // Handle numbers (including decimals)
+  while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+    Inc(FPos);
+
+  // Handle decimal point
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '.') then
+  begin
+    Inc(FPos);
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+      Inc(FPos);
+  end;
+
+  // Handle CSS units (px, em, rem, %, etc.)
+  if (FPos <= Length(FSource)) and (FSource[FPos] in ['a'..'z', 'A'..'Z', '%']) then
+  begin
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['a'..'z', 'A'..'Z', '%']) do
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+end;
+
+procedure TCssSyntaxHighlighter.ProcessUrl(var endPos: integer);
+var
+  startPos: integer;
+  parenCount: integer;
+begin
+  startPos := FPos;
+  Inc(FPos, 4); // Skip 'url('
+  parenCount := 1;
+
+  while (FPos <= Length(FSource)) and (parenCount > 0) do
+  begin
+    if FSource[FPos] = '(' then
+      Inc(parenCount)
+    else if FSource[FPos] = ')' then
+      Dec(parenCount);
+    Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+function TCssSyntaxHighlighter.IsWordChar(ch: char): boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-'];
+end;
+
+function TCssSyntaxHighlighter.IsHexChar(ch: char): boolean;
+begin
+  Result := ch in ['0'..'9', 'A'..'F', 'a'..'f'];
+end;
+
+class procedure TCssSyntaxHighlighter.CheckCategories;
+begin
+  if CategoryCSS=0 then
+    RegisterDefaultCategories;
+end;
+
+class procedure TCssSyntaxHighlighter.RegisterDefaultCategories;
+begin
+  CategoryCSS:=RegisterCategory('CSS');
+  CategoryEmbeddedCSS:=RegisterCategory('EmbeddedCSS');
+end;
+
+class function TCssSyntaxHighlighter.GetLanguages: TStringDynarray;
+begin
+  Result:=['css']
+end;
+
+constructor TCssSyntaxHighlighter.Create;
+begin
+  inherited Create;
+  CheckCategories;
+  DefaultCategory:=CategoryCSS;
+end;
+
+function TCssSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  lLen, endPos, startPos: integer;
+  ch: char;
+begin
+  Result:=Nil;
+  CheckCategories;
+  lLen:=Length(Source);
+  if lLen = 0 then
+    Exit;
+  FSource := Source;
+  FTokens.Reset;
+  FPos := 1;
+  EndPos:=0;
+
+  while FPos <= lLen do
+    begin
+    ch := FSource[FPos];
+    case ch of
+    '''':
+      ProcessSingleQuoteString(endPos);
+    '"':
+      ProcessDoubleQuoteString(endPos);
+    '/':
+      begin
+      if (FPos < Length(FSource)) and (FSource[FPos + 1] = '*') then
+        ProcessMultiLineComment(endPos)
+      else
+        begin
+        AddToken('/', shOperator);
+        endPos := FPos;
+        Inc(FPos);
+        end;
+      end;
+    '#':
+      begin
+      if (FPos < Length(FSource)) and IsHexChar(FSource[FPos + 1]) then
+        ProcessColor(endPos)
+      else
+        ProcessSelector(endPos);
+      end;
+    '@':
+      begin
+      if not CheckForAtRule(endPos) then
+        begin
+        AddToken('@', shSymbol);
+        endPos := FPos;
+        Inc(FPos);
+        end;
+      end;
+    '0'..'9':
+      ProcessNumber(endPos);
+    'a'..'t', 'v'..'z', 'A'..'Z':
+      begin
+      if not CheckForProperty(endPos) then
+        begin
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+        end;
+      end;
+    'u':
+      begin
+      if (FPos + 3 <= Length(FSource)) and
+        (Copy(FSource, FPos, 4) = 'url(') then
+        ProcessUrl(endPos)
+      else if not CheckForProperty(endPos) then
+        begin
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+        end;
+      end;
+    '.', ':', '[', ']': ProcessSelector(endPos);
+    '{', '}', ';', '(', ')', ',':
+      begin
+      AddToken(ch, shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      end;
+    '>', '+', '~', '*', '=', '!':
+      begin
+      AddToken(ch, shOperator);
+      endPos := FPos;
+      Inc(FPos);
+      end;
+    ' ', #9, #10, #13:
+      begin
+      startPos := FPos;
+      while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+        Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      end;
+    else
+      AddToken(ch, shInvalid);
+      endPos := FPos;
+      Inc(FPos);
+    end;
+    if FPos = endPos then Inc(FPos);
+  end;
+  Result := FTokens.GetTokens;
+end;
+
+function DoCssHighlighting(const Source: string): TSyntaxTokenArray;
+var
+  highlighter: TCssSyntaxHighlighter;
+begin
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  TCssSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.highlighter.pp

@@ -0,0 +1,519 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Basic syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+unit syntax.highlighter;
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.Classes, System.SysUtils, System.Contnrs;
+{$ELSE}
+  Types, Classes, SysUtils, contnrs;
+{$ENDIF}
+
+type
+  ESyntaxHighlighter = class(Exception);
+
+  // Various token kinds
+  TSyntaxHighlightKind = (
+    shDefault,
+    shInvalid,
+    shSymbol,
+    shKeyword,
+    shComment,
+    shDirective,
+    shNumbers,
+    shCharacters,
+    shStrings,
+    shAssembler,
+    shRegex,
+    shInterpolation,
+    shEscape,
+    shRawString,
+    shTemplate,
+    shLambda,
+    shOperator,
+    shError,
+    shWarning,
+    shAttribute,
+    shSection,
+    shKey
+  );
+
+  TSyntaxHighlightKindHelper = type helper for TSyntaxHighlightKind
+    function toString : string;
+  end;
+  
+  { TSyntaxToken }
+
+  // One syntax token
+  TSyntaxToken = record
+  Private
+    FCategoryCount : integer;
+    FCategories: TIntegerDynArray;  // Registered category IDs
+  Public
+    Text: string;
+    Kind: TSyntaxHighlightKind;
+    // Create a syntax token
+    Constructor create (const aText : string; aKind : TSyntaxHighlightKind; const aCategories : Array of Integer); overload;
+    Constructor create (const aText : string; aKind : TSyntaxHighlightKind; const aCategory : Integer); overload;
+    Constructor create (const aText : string; aKind : TSyntaxHighlightKind); overload;
+    // Categories for this token
+    Function Categories : TIntegerDynArray;
+    // Categories as strings
+    function CategoriesAsString : String;
+    // Add a category
+    Procedure AddCategory(aCategoryID : integer);
+    // Check if a particular category is present
+    function HasCategory(aCategoryID : integer) : Boolean;
+    // Number of categories associated to this token
+    Property CategoryCount : Integer read FCategoryCount;
+  end;
+  TSyntaxTokenArray = array of TSyntaxToken;
+
+  { TSyntaxTokenList }
+
+  TSyntaxTokenList = record
+  private
+    FList : TSyntaxTokenArray;
+    FTokenCount : integer;
+    function GetToken(aIndex : Integer): TSyntaxToken;
+  Public
+    // Create an empty token list
+    class function Create : TSyntaxTokenList; static;
+    // Add a token
+    Procedure AddToken(aToken : TSyntaxToken);
+    // Clear the token list
+    procedure reset;
+    // Get the actual list of tokens
+    Function GetTokens : TSyntaxTokenArray;
+    // Indexed access to the tokens
+    Property Tokens[aIndex : Integer] : TSyntaxToken Read GetToken;
+    // Number of tokens in the list
+    Function Count : Integer;
+  end;
+
+  { TSyntaxHighlighter }
+
+  TSyntaxHighlighter = class
+  private
+    FDefaultCategory: Integer;
+    class var
+      FCategories: TStringList;
+      FNextCategoryID: Integer;
+  protected
+    FTokens : TSyntaxTokenList;
+    class function GetCategoryID(const category: string): Integer;
+    class function GetLanguages : TStringDynArray; virtual; abstract;
+    class procedure RegisterDefaultCategories; virtual;
+    class constructor init;
+    class destructor done;
+    procedure AddToken(const aText: string; akind: TSyntaxHighlightKind; aCategory : Integer = 0);
+  public
+    class procedure Register;
+    class function RegisterCategory(const category: string): Integer;
+    class function GetRegisteredCategoryID(const category: string): Integer;
+    class procedure GetRegisteredCategories(categories: TStringList);
+    class function GetCategoryName(const aCategoryId: Integer): string;
+  public
+    constructor Create; virtual;
+    // Reset the token list and other attributes
+    procedure reset; virtual;
+    // Start the tokenizing process, returns array of syntax tokens.
+    function Execute(const source: string): TSyntaxTokenArray; virtual; abstract;
+    // Set this to zero if you don't want a default category to be added
+    property DefaultCategory : Integer Read FDefaultCategory Write FDefaultCategory;
+  end;
+  TSyntaxHighlighterClass = class of TSyntaxHighlighter;
+
+  { TSyntaxHighlighterRegistry }
+
+  TSyntaxHighlighterRegistry = class
+  protected
+    Type
+    TLanguageDef = class
+      language : string;
+      highlighter : TSyntaxHighlighterClass;
+      constructor create(aLanguage : string; aHighlighter :TSyntaxHighlighterClass);
+    end;
+  private
+    class var _instance : TSyntaxHighlighterRegistry;
+  private
+    FDefs : TFPObjectHashTable;
+  protected
+    Function FindLanguageDef(const aLanguage : String) : TLanguageDef;
+    class constructor init;
+    class destructor done;
+  public
+    constructor create;
+    destructor destroy; override;
+    Function FindSyntaxHighlighterClass(const aLanguage : String) : TSyntaxHighlighterClass;
+    Function GetSyntaxHighlighterClass(const aLanguage : String) : TSyntaxHighlighterClass;
+    function CreateSyntaxHighlighter(const aLanguage : string) : TSyntaxHighlighter;
+    Procedure RegisterSyntaxHighlighter(aClass : TSyntaxHighlighterClass; const aLanguages : Array of string);
+    Procedure UnRegisterSyntaxHighlighter(aClass : TSyntaxHighlighterClass);
+    class property Instance : TSyntaxHighlighterRegistry Read _Instance;
+  end;
+
+implementation
+
+const
+  HighlightKindNames : Array[TSyntaxHighlightKind] of string = (
+    'Default',
+    'Invalid',
+    'Symbol',
+    'Keyword',
+    'Comment',
+    'Directive',
+    'Numbers',
+    'Characters',
+    'Strings',
+    'Assembler',
+    'Regex',
+    'Interpolation',
+    'Escape',
+    'RawString',
+    'Template',
+    'Lambda',
+    'Operator',
+    'Error',
+    'Warning',
+    'Attribute',
+    'Section',
+    'Key'
+  );
+
+function TSyntaxHighlightKindHelper.toString : string;
+
+begin
+  Result:=HighlightKindNames[Self];
+end;
+
+{ TSyntaxToken }
+
+constructor TSyntaxToken.create(const aText: string; aKind: TSyntaxHighlightKind; const aCategories: array of Integer);
+var
+  I : integer;
+begin
+  Text:=aText;
+  Kind:=aKind;
+  FCategoryCount:=Length(aCategories);
+  SetLength(FCategories,FCategoryCount+1);
+  For I:=0 to Length(aCategories)-1 do
+    FCategories[I]:=aCategories[i];
+end;
+
+constructor TSyntaxToken.create(const aText: string; aKind: TSyntaxHighlightKind; const aCategory: Integer);
+
+begin
+  Text:=aText;
+  Kind:=aKind;
+  FCategoryCount:=1;
+  SetLength(FCategories,2);
+  FCategories[0]:=aCategory;
+end;
+
+constructor TSyntaxToken.create(const aText: string; aKind: TSyntaxHighlightKind);
+begin
+  Text:=aText;
+  Kind:=aKind;
+  FCategoryCount:=0;
+end;
+
+function TSyntaxToken.Categories: TIntegerDynArray;
+begin
+  Result:=Copy(FCategories,0,CategoryCount);
+end;
+
+function TSyntaxToken.CategoriesAsString: String;
+var
+  I : integer;
+begin
+  Result:='';
+  For I:=0 to FCategoryCount-1 do
+    begin
+    if i>0 then
+      Result:=Result+' ';
+    Result:=Result+TSyntaxHighlighter.GetCategoryName(FCategories[i]);
+    end;
+end;
+
+procedure TSyntaxToken.AddCategory(aCategoryID: integer);
+begin
+  if FCategoryCount=Length(Categories) then
+    SetLength(FCategories,FCategoryCount+3);
+  FCategories[FCategoryCount]:=aCategoryID;
+  inc(FCategoryCount);
+end;
+
+function TSyntaxToken.HasCategory(aCategoryID: integer): Boolean;
+var
+  I : integer;
+begin
+  Result:=False;
+  I:=FCategoryCount-1;
+  While (not Result) and (I>=0) do
+    begin
+    Result:=FCategories[I]=aCategoryID;
+    Dec(I);
+    end;
+end;
+
+{ TSyntaxTokenList }
+
+function TSyntaxTokenList.GetToken(aIndex : Integer): TSyntaxToken;
+begin
+  if (aIndex<0) or (aIndex>=FTokenCount) then
+    Raise ESyntaxHighlighter.CreateFmt('Index %d out of bounds [0..%d[',[aIndex,FTokenCount]);
+  Result:=FList[aIndex];
+end;
+
+class function TSyntaxTokenList.Create: TSyntaxTokenList;
+begin
+  Result:=Default(TSyntaxTokenList);
+end;
+
+procedure TSyntaxTokenList.AddToken(aToken: TSyntaxToken);
+begin
+  if FTokenCount=Length(FList) then
+    SetLength(FList,FTokenCount+100);
+  FList[FTokenCount]:=aToken;
+  Inc(FTokenCount);
+end;
+
+procedure TSyntaxTokenList.reset;
+begin
+  FList:=[];
+  FTokenCount:=0;
+end;
+
+function TSyntaxTokenList.GetTokens: TSyntaxTokenArray;
+begin
+  SetLength(FList,FTokenCount);
+  Result:=Flist;
+  Reset;
+end;
+
+function TSyntaxTokenList.Count: Integer;
+begin
+  Result:=FTokenCount;
+end;
+
+class constructor TSyntaxHighlighter.init;
+begin
+  FCategories := TStringList.Create;
+  FCategories.Sorted := True;
+  FCategories.Duplicates := dupIgnore;
+  FNextCategoryID := 1;
+end;
+
+class destructor TSyntaxHighlighter.done;
+begin
+  FCategories.Free;
+end;
+
+procedure TSyntaxHighlighter.AddToken(const aText: string; akind: TSyntaxHighlightKind; aCategory: Integer);
+var
+  lCat1,lCat2 : Integer;
+  lToken : TSyntaxToken;
+
+begin
+  if Length(aText) = 0 then Exit;
+  lCat2:=0;
+  lCat1:=DefaultCategory;
+  if aCategory<>0 then
+    if lCat1=0 then
+      lCat1:=aCategory
+    else
+      lCat2:=aCategory;
+ if lCat2>0 then
+    lToken:=TSyntaxToken.Create(aText,aKind,[lCat1,lCat2])
+ else if lCat1>0 then
+    lToken:=TSyntaxToken.Create(aText,aKind,lCat1)
+ else
+    lToken:=TSyntaxToken.Create(aText,aKind);
+  FTokens.AddToken(ltoken);
+end;
+
+class function TSyntaxHighlighter.GetCategoryID(const category: string): Integer;
+var
+  index: Integer;
+begin
+  if FCategories.Find(category, index) then
+    Result := PtrInt(FCategories.Objects[index])
+  else
+    Result := -1;
+end;
+
+class procedure TSyntaxHighlighter.RegisterDefaultCategories;
+begin
+  // Do nothing
+end;
+
+constructor TSyntaxHighlighter.Create;
+begin
+  Inherited;
+  Reset;
+end;
+
+procedure TSyntaxHighlighter.reset;
+begin
+  FTokens.Reset;
+end;
+
+class procedure TSyntaxHighlighter.Register;
+begin
+  TSyntaxHighlighterRegistry.Instance.RegisterSyntaxHighlighter(Self,GetLanguages);
+end;
+
+class function TSyntaxHighlighter.RegisterCategory(const category: string): Integer;
+var
+  existingID: Integer;
+begin
+  existingID := GetCategoryID(category);
+  if existingID <> -1 then
+    Result := existingID
+  else
+    begin
+    Result := FNextCategoryID;
+    FCategories.AddObject(category, TObject(PtrInt(Result)));
+    Inc(FNextCategoryID);
+    end;
+end;
+
+class function TSyntaxHighlighter.GetRegisteredCategoryID(const category: string): Integer;
+begin
+  Result := GetCategoryID(category);
+end;
+
+class procedure TSyntaxHighlighter.GetRegisteredCategories(categories: TStringList);
+var
+  i: Integer;
+begin
+  categories.Clear;
+  for i := 0 to FCategories.Count - 1 do
+    categories.AddObject(FCategories[i], FCategories.Objects[i]);
+end;
+
+class function TSyntaxHighlighter.GetCategoryName(const aCategoryId: Integer): string;
+var
+  i: Integer;
+begin
+  Result:='';
+  if aCategoryID=0 then
+    exit;
+  for i := FCategories.Count - 1 downto 0 do
+    begin
+    if PtrInt(FCategories.Objects[i]) = aCategoryID then
+       Exit(FCategories[i]);
+    end;
+end;
+
+{ TSyntaxHighlighterRegistry }
+
+
+class constructor TSyntaxHighlighterRegistry.init;
+begin
+  _instance:=TSyntaxHighlighterRegistry.Create;
+end;
+
+class destructor TSyntaxHighlighterRegistry.done;
+begin
+  FreeAndNil(_instance);
+end;
+
+constructor TSyntaxHighlighterRegistry.create;
+begin
+  FDefs:=TFPObjectHashTable.Create(True);
+end;
+
+destructor TSyntaxHighlighterRegistry.destroy;
+begin
+  FReeAndNil(FDefs);
+  inherited destroy;
+end;
+
+function TSyntaxHighlighterRegistry.FindLanguageDef(const aLanguage: String): TLanguageDef;
+
+begin
+  Result:=TLanguageDef(FDefs.Items[aLanguage]);
+end;
+
+function TSyntaxHighlighterRegistry.FindSyntaxHighlighterClass(const aLanguage: String): TSyntaxHighlighterClass;
+var
+  lDef : TLanguageDef;
+begin
+  lDef:=FindLanguageDef(aLanguage);
+  if assigned(lDef) then
+    Result:=lDef.highlighter;
+end;
+
+function TSyntaxHighlighterRegistry.GetSyntaxHighlighterClass(const aLanguage: String): TSyntaxHighlighterClass;
+
+begin
+  Result:=FindSyntaxHighlighterClass(aLanguage);
+  if (Result=Nil) then
+    Raise ESyntaxHighlighter.CreateFmt('No highlighter for language "%s"',[aLanguage]);
+end;
+
+function TSyntaxHighlighterRegistry.CreateSyntaxHighlighter(const aLanguage: string): TSyntaxHighlighter;
+var
+  lClass : TSyntaxHighlighterClass;
+begin
+  lClass:=GetSyntaxHighlighterClass(aLanguage);
+  Result:=lClass.Create;
+end;
+
+procedure TSyntaxHighlighterRegistry.RegisterSyntaxHighlighter(aClass: TSyntaxHighlighterClass; const aLanguages: array of string);
+var
+  lLanguage : String;
+  lDef : TLanguageDef;
+begin
+  aClass.RegisterDefaultCategories;
+  For lLanguage in aLanguages do
+    begin
+    lDef:=FindLanguageDef(lLanguage);
+    if lDef=Nil then
+      begin
+      lDef:=TLanguageDef.Create(lLanguage,aClass);
+      FDefs.Add(lLanguage,lDef);
+      end
+    else
+      lDef.highlighter:=aClass;
+    end;
+end;
+
+procedure TSyntaxHighlighterRegistry.UnRegisterSyntaxHighlighter(aClass: TSyntaxHighlighterClass);
+var
+  lLanguage : string;
+begin
+  For lLanguage in aClass.GetLanguages do
+    FDefs.Delete(lLanguage);
+end;
+
+{ TSyntaxHighlighterRegistry.TLanguageDef }
+
+constructor TSyntaxHighlighterRegistry.TLanguageDef.create(aLanguage: string; aHighlighter: TSyntaxHighlighterClass);
+begin
+  Language:=aLanguage;
+  HighLighter:=aHighlighter;
+end;
+
+end.

packages/fcl-syntax/src/syntax.html.pp

@@ -0,0 +1,660 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    HTML syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.html;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter, syntax.css, syntax.javascript;
+  {$ELSE}
+  Types, SysUtils, syntax.highlighter, syntax.css, syntax.javascript;
+  {$ENDIF}
+
+type
+  THtmlParseState = (
+    hsText,           // Outside tags - regular text content
+    hsTagOpen,        // Inside opening tag < >
+    hsTagClose,       // Inside closing tag </ >
+    hsComment,        // Inside <!-- -->
+    hsDoctype,        // Inside <!DOCTYPE >
+    hsCDATA,          // Inside <![CDATA[ ]]>
+    hsScript,         // Inside <script> - JavaScript content
+    hsStyle           // Inside <style> - CSS content
+  );
+
+  { THtmlSyntaxHighlighter }
+
+  THtmlSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FSourceLen : integer;
+    FPos: Integer;
+    FState: THtmlParseState;
+    FCurrentTag: string;
+    FCssHighlighter: TCssSyntaxHighlighter;
+    FJsHighlighter: TJavaScriptSyntaxHighlighter;
+
+  protected
+    procedure ProcessText(var endPos: Integer);
+    procedure ProcessTagOpen(var endPos: Integer);
+    procedure ProcessTagClose(var endPos: Integer);
+    procedure ProcessComment(var endPos: Integer);
+    procedure ProcessDoctype(var endPos: Integer);
+    procedure ProcessCDATA(var endPos: Integer);
+    procedure ProcessScript(var endPos: Integer);
+    procedure ProcessStyle(var endPos: Integer);
+    procedure ProcessEntity(var endPos: Integer);
+    function IsWordChar(ch: Char): Boolean;
+    function IsTagChar(ch: Char): Boolean;
+    function PeekString(const s: string): Boolean;
+    function ExtractTagName(const tagContent: string): string;
+    class function GetLanguages: TStringDynArray; override;
+    class procedure RegisterDefaultCategories; override;
+    procedure CheckCategories;
+    property CssHighlighter: TCssSyntaxHighlighter read FCssHighlighter;
+    property JsHighlighter: TJavaScriptSyntaxHighlighter read FJsHighlighter;
+  public
+    class var
+     CategoryHTML : Integer;
+     CategoryHTMLStyleAttr : Integer;
+     CategoryHTMLAttribute : Integer;
+     CategoryHTMLComment : integer;
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure reset; override;
+    function Execute(const source: string): TSyntaxTokenArray; override;
+  end;
+
+const
+  MaxKeywordLength = 15;
+  MaxKeyword = 46;
+
+  HtmlTagTable: array[0..MaxKeyword] of String = (
+    'a', 'abbr', 'address', 'area', 'article', 'aside', 'audio', 'b', 'base', 'bdi',
+    'bdo', 'blockquote', 'body', 'br', 'button', 'canvas', 'caption', 'cite', 'code', 'col',
+    'colgroup', 'data', 'datalist', 'dd', 'del', 'details', 'dfn', 'dialog', 'div', 'dl',
+    'dt', 'em', 'embed', 'fieldset', 'figure', 'footer', 'form', 'h1', 'h2', 'h3',
+    'h4', 'h5', 'h6', 'head', 'header', 'hr', 'html'
+  );
+
+function DoHtmlHighlighting(const source: string): TSyntaxTokenArray;
+
+implementation
+
+{ THtmlSyntaxHighlighter }
+
+constructor THtmlSyntaxHighlighter.Create;
+
+begin
+  inherited Create;
+  CheckCategories;
+  DefaultCategory:=CategoryHTML;
+  // Create them first so they are available in reset
+  FCssHighlighter := TCssSyntaxHighlighter.Create;
+  FCssHighlighter.DefaultCategory:=TSyntaxHighlighter.GetRegisteredCategoryID('EmbeddedCSS');
+  FJsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  FJsHighlighter.DefaultCategory:=TSyntaxHighlighter.GetRegisteredCategoryID('EmbeddedJS');
+end;
+
+
+destructor THtmlSyntaxHighlighter.Destroy;
+
+begin
+  FCssHighlighter.Free;
+  FJsHighlighter.Free;
+  inherited Destroy;
+end;
+
+
+procedure THtmlSyntaxHighlighter.reset;
+
+begin
+  inherited reset;
+  FState:=hsText;
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessText(var endPos: Integer);
+
+var
+  startPos: Integer;
+
+begin
+  startPos := FPos;
+  while (FPos <= FSourceLen) do
+    begin
+    if FSource[FPos] = '<' then
+      break;
+    if FSource[FPos] = '&' then
+      begin
+      // Save text before entity
+      if FPos > startPos then
+        begin
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+        FPos := endPos + 1;
+        end;
+      ProcessEntity(endPos);
+      Exit;
+      end;
+    Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  if endPos >= startPos then
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessTagOpen(var endPos: Integer);
+
+var
+  startPos, nameStart, nameEnd: Integer;
+  tagName, attrName: string;
+  quoteChar: Char;
+
+begin
+  startPos := FPos;
+
+  // Process opening <
+  AddToken('<', shSymbol);
+  Inc(FPos);
+
+  // Skip whitespace
+  while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9, #10, #13]) do
+    Inc(FPos);
+
+  // Process tag name
+  nameStart := FPos;
+  while (FPos <= FSourceLen) and IsTagChar(FSource[FPos]) do
+    Inc(FPos);
+
+  if FPos > nameStart then
+    begin
+    nameEnd := FPos - 1;
+    tagName := LowerCase(Copy(FSource, nameStart, nameEnd - nameStart + 1));
+    FCurrentTag := tagName;
+    AddToken(Copy(FSource, nameStart, nameEnd - nameStart + 1), shKeyword);
+    end;
+
+  // Process attributes
+  while (FPos <= FSourceLen) and (FSource[FPos] <> '>') do
+    begin
+    // Skip whitespace
+    while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9, #10, #13]) do
+      begin
+      startPos := FPos;
+      while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9, #10, #13]) do
+        Inc(FPos);
+      AddToken(Copy(FSource, startPos, FPos - startPos), shDefault);
+      end;
+    if (FPos <= FSourceLen) and (FSource[FPos] = '>') then
+      break;
+    // Self-closing tag
+    if (FPos <= FSourceLen) and (FSource[FPos] = '/') then
+      begin
+      AddToken('/', shSymbol);
+      Inc(FPos);
+      continue;
+      end;
+    // Process attribute name
+    startPos := FPos;
+    while (FPos <= FSourceLen) and IsWordChar(FSource[FPos]) do
+      Inc(FPos);
+
+    if FPos > startPos then
+      begin
+      attrName := Copy(FSource, startPos, FPos - startPos);
+      if attrName = 'style' then
+        AddToken(attrName, shDefault, CategoryHTMLStyleAttr)
+      else
+        AddToken(attrName, shDefault, CategoryHTMLAttribute);
+      end;
+
+    // Skip whitespace around =
+    while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9]) do
+      begin
+      AddToken(FSource[FPos], shDefault);
+      Inc(FPos);
+      end;
+
+    // Process = sign
+    if (FPos <= FSourceLen) and (FSource[FPos] = '=') then
+      begin
+      AddToken('=', shSymbol);
+      Inc(FPos);
+
+      // Skip whitespace after =
+      while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9]) do
+        begin
+        AddToken(FSource[FPos], shDefault);
+        Inc(FPos);
+        end;
+
+      // Process attribute value
+      if (FPos <= FSourceLen) and (FSource[FPos] in ['"', '''']) then
+        begin
+        quoteChar := FSource[FPos];
+        startPos := FPos;
+        Inc(FPos);
+
+        while (FPos <= FSourceLen) and (FSource[FPos] <> quoteChar) do
+          Inc(FPos);
+
+        if (FPos <= FSourceLen) and (FSource[FPos] = quoteChar) then
+          Inc(FPos);
+
+        if (attrName = 'style') and (FPos > startPos + 2) then
+          begin
+          // Delegate CSS content to CSS highlighter (excluding quotes)
+          AddToken(FSource[startPos], shSymbol); // Opening quote
+          if FPos > startPos + 2 then
+            AddToken(Copy(FSource, startPos + 1, FPos - startPos - 2), shDefault, TCssSyntaxHighlighter.CategoryEmbeddedCSS);
+          AddToken(FSource[FPos - 1], shSymbol); // Closing quote
+          end
+        else
+          AddToken(Copy(FSource, startPos, FPos - startPos), shStrings);
+      end;
+      end;
+    end;
+
+  // Process closing >
+  if (FPos <= FSourceLen) and (FSource[FPos] = '>') then
+    begin
+    AddToken('>', shSymbol);
+    Inc(FPos);
+
+    // Check if we're entering script or style context
+    Case FCurrentTag of
+    'script':
+      FState := hsScript;
+    'style':
+      FState := hsStyle;
+    else
+      FState := hsText;
+    end;
+    end;
+
+  endPos := FPos - 1;
+end;
+
+procedure THtmlSyntaxHighlighter.ProcessTagClose(var endPos: Integer);
+
+var
+  nameStart, nameEnd: Integer;
+
+begin
+
+  // Process </
+  AddToken('</', shSymbol);
+  Inc(FPos, 2);
+
+  // Skip whitespace
+  while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9, #10, #13]) do
+    Inc(FPos);
+
+  // Process tag name
+  nameStart := FPos;
+  while (FPos <= FSourceLen) and IsTagChar(FSource[FPos]) do
+    Inc(FPos);
+
+  if FPos > nameStart then
+    begin
+    nameEnd := FPos - 1;
+    AddToken(Copy(FSource, nameStart, nameEnd - nameStart + 1), shKeyword);
+    end;
+
+  // Skip whitespace
+  while (FPos <= FSourceLen) and (FSource[FPos] in [' ', #9, #10, #13]) do
+    Inc(FPos);
+
+  // Process closing >
+  if (FPos <= FSourceLen) and (FSource[FPos] = '>') then
+    begin
+    AddToken('>', shSymbol);
+    Inc(FPos);
+    end;
+
+  FState := hsText;
+  endPos := FPos - 1;
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessComment(var endPos: Integer);
+
+var
+  startPos: Integer;
+
+begin
+  startPos := FPos;
+
+  while (FPos + 2 <= FSourceLen) do
+    begin
+    if (FSource[FPos] = '-') and (FSource[FPos + 1] = '-') and (FSource[FPos + 2] = '>') then
+      begin
+      Inc(FPos, 3);
+      FState := hsText;
+      break;
+      end;
+    Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment, CategoryHTMLComment);
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessDoctype(var endPos: Integer);
+
+var
+  startPos: Integer;
+
+begin
+  startPos := FPos;
+  while (FPos <= FSourceLen) and (FSource[FPos] <> '>') do
+    Inc(FPos);
+  if (FPos <= FSourceLen) and (FSource[FPos] = '>') then
+    Inc(FPos);
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDirective);
+  FState := hsText;
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessCDATA(var endPos: Integer);
+
+var
+  startPos: Integer;
+
+begin
+  startPos := FPos;
+
+  while (FPos + 2 <= FSourceLen) do
+    begin
+    if (FSource[FPos] = ']') and (FSource[FPos + 1] = ']') and (FSource[FPos + 2] = '>') then
+      begin
+      Inc(FPos, 3);
+      FState := hsText;
+      break;
+      end;
+    Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shRawString);
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessScript(var endPos: Integer);
+
+var
+  startPos: Integer;
+  scriptContent: string;
+  jsTokens: TSyntaxTokenArray;
+  i: Integer;
+
+begin
+  startPos := FPos;
+
+  // Find </script>
+  while (FPos + 8 <= FSourceLen) do
+    begin
+    if (LowerCase(Copy(FSource, FPos, 9)) = '</script>') then
+      break;
+    Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  if endPos >= startPos then
+    begin
+    scriptContent := Copy(FSource, startPos, endPos - startPos + 1);
+
+    if Trim(scriptContent) <> '' then
+      begin
+      // Delegate to JavaScript highlighter
+      jsTokens := FJsHighlighter.Execute(scriptContent);
+
+      // Add JavaScript tokens with EmbeddedJS category
+      for i := 0 to High(jsTokens) do
+        FTokens.AddToken(jsTokens[i]);
+      end;
+    end;
+
+  FState := hsText;
+end;
+
+procedure THtmlSyntaxHighlighter.ProcessStyle(var endPos: Integer);
+
+var
+  startPos: Integer;
+  styleContent: string;
+  cssTokens: TSyntaxTokenArray;
+  i: Integer;
+
+begin
+  startPos := FPos;
+
+  // Find </style>
+  while (FPos + 7 <= FSourceLen) do
+    begin
+    if (LowerCase(Copy(FSource, FPos, 8)) = '</style>') then
+      break;
+    Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  if endPos >= startPos then
+    begin
+    styleContent := Copy(FSource, startPos, endPos - startPos + 1);
+
+    if Trim(styleContent) <> '' then
+      begin
+      // Delegate to CSS highlighter
+      cssTokens := FCssHighlighter.Execute(styleContent);
+      // Add CSS tokens with EmbeddedCSS category
+      for i := 0 to High(cssTokens) do
+        FTokens.AddToken(cssTokens[i]);
+      end;
+    end;
+  FState := hsText;
+end;
+
+
+procedure THtmlSyntaxHighlighter.ProcessEntity(var endPos: Integer);
+
+var
+  startPos: Integer;
+
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip &
+
+  // Numeric entity &#123; or &#xABC;
+  if (FPos <= FSourceLen) and (FSource[FPos] = '#') then
+    begin
+    Inc(FPos);
+    if (FPos <= FSourceLen) and (FSource[FPos] = 'x') then
+      Inc(FPos); // Hex entity
+    while (FPos <= FSourceLen) and (FSource[FPos] in ['0'..'9', 'A'..'F', 'a'..'f']) do
+      Inc(FPos);
+    end
+  // Named entity &amp; &lt; etc.
+  else
+    begin
+    while (FPos <= FSourceLen) and (FSource[FPos] in ['a'..'z', 'A'..'Z', '0'..'9']) do
+      Inc(FPos);
+    end;
+
+  // Skip closing ;
+  if (FPos <= FSourceLen) and (FSource[FPos] = ';') then
+    Inc(FPos);
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shEscape);
+end;
+
+
+function THtmlSyntaxHighlighter.IsWordChar(ch: Char): Boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-'];
+end;
+
+function THtmlSyntaxHighlighter.IsTagChar(ch: Char): Boolean;
+
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '-', ':'];
+end;
+
+
+function THtmlSyntaxHighlighter.PeekString(const s: string): Boolean;
+
+begin
+  Result := (FPos + Length(s) - 1 <= FSourceLen) and
+            (LowerCase(Copy(FSource, FPos, Length(s))) = LowerCase(s));
+end;
+
+
+function THtmlSyntaxHighlighter.ExtractTagName(const tagContent: string): string;
+
+var
+  i: Integer;
+
+begin
+  Result := '';
+  i := 1;
+  while (i <= Length(tagContent)) and (tagContent[i] in [' ', #9, #10, #13]) do
+    Inc(i);
+
+  while (i <= Length(tagContent)) and IsTagChar(tagContent[i]) do
+    begin
+    Result := Result + tagContent[i];
+    Inc(i);
+    end;
+
+  Result := LowerCase(Result);
+end;
+
+class function THtmlSyntaxHighlighter.GetLanguages: TStringDynArray;
+begin
+  Result:=['html','htm']
+end;
+
+
+class procedure THtmlSyntaxHighlighter.RegisterDefaultCategories;
+
+begin
+  CategoryHTML:=RegisterCategory('HTML');
+  CategoryHTMLStyleAttr:=RegisterCategory('HTMLStyleAttr');
+  CategoryHTMLAttribute:=RegisterCategory('HTMLAttribute');
+  inherited ;
+end;
+
+
+procedure THtmlSyntaxHighlighter.CheckCategories;
+begin
+  if CategoryHTML=0 then
+    RegisterDefaultCategories;
+end;
+
+
+function THtmlSyntaxHighlighter.Execute(const source: string): TSyntaxTokenArray;
+var
+  endPos: Integer;
+begin
+  Result:=[];
+  FSourceLen:=Length(source);
+  if FSourceLen=0 then
+    Exit;
+  FTokens.Reset;
+  FSource := source;
+  FPos := 1;
+  endpos:=0;
+  FState := hsText;
+  while FPos <= FSourceLen do
+    begin
+    case FState of
+      hsText:
+        begin
+        if (FPos <= FSourceLen) and (FSource[FPos] = '<') then
+          begin
+          if PeekString('<!--') then
+            begin
+            AddToken('<!--', shSymbol);
+            Inc(FPos, 4);
+            FState := hsComment;
+            ProcessComment(endPos);
+            end
+          else if PeekString('<!DOCTYPE') then
+            begin
+            FState := hsDoctype;
+            ProcessDoctype(endPos);
+            end
+          else if PeekString('<![CDATA[') then
+            begin
+            AddToken('<![CDATA[', shSymbol);
+            Inc(FPos, 9);
+            FState := hsCDATA;
+            ProcessCDATA(endPos);
+            end
+          else if (FPos < FSourceLen) and (FSource[FPos + 1] = '/') then
+            begin
+            FState := hsTagClose;
+            ProcessTagClose(endPos);
+            end
+          else
+            begin
+            FState := hsTagOpen;
+            ProcessTagOpen(endPos);
+            end;
+          end
+        else
+          ProcessText(endPos);
+        end;
+      hsComment: ProcessComment(endPos);
+      hsScript: ProcessScript(endPos);
+      hsStyle: ProcessStyle(endPos);
+      hsCDATA: ProcessCDATA(endPos);
+      hsDoctype: ProcessDoctype(endPos);
+      hsTagOpen: ProcessTagOpen(endPos);
+      hsTagClose: ProcessTagClose(endPos);
+    end;
+    if FPos = endPos then
+      Inc(FPos);
+    end;
+  Result := FTokens.GetTokens;
+end;
+
+
+function DoHtmlHighlighting(const source: string): TSyntaxTokenArray;
+
+var
+  highlighter: THtmlSyntaxHighlighter;
+
+begin
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  THtmlSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.htmlrender.pp

@@ -0,0 +1,231 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Annotated Token stream to HTML renderer
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$MODE objfpc}
+{$H+}
+
+unit syntax.htmlrender;
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, syntax.highlighter;
+{$ELSE}  
+  Classes, SysUtils, syntax.highlighter;
+{$ENDIF}
+
+type
+  THTMLRenderOption = (hroNoDefaultSpan, hroPreserveLineStructure);
+  THTMLRenderOptions = set of THTMLRenderOption;
+
+  { THtmlSyntaxRenderer }
+
+  THtmlSyntaxRenderer = class
+  private
+    FOptions: THTMLRenderOptions;
+    FExtraClasses: string;
+  protected
+    function GetCategoryName(category: Integer): string;
+    function EscapeHtml(const text: string): string; virtual;
+    function GetKindClassName(kind: TSyntaxHighlightKind): string; virtual;
+    function BuildClassNames(kind: TSyntaxHighlightKind; categories : Array of Integer): string; virtual;
+    procedure RenderTokensWithLineBreaks(const tokens: TSyntaxTokenArray; output: TStrings); virtual;
+    procedure RenderTokensWithoutLineBreaks(const tokens: TSyntaxTokenArray; output: TStrings); virtual;
+  public
+    constructor Create;
+    property Options: THTMLRenderOptions read FOptions write FOptions;
+    property ExtraClasses: string read FExtraClasses write FExtraClasses;
+    procedure RenderTokens(const tokens: TSyntaxTokenArray; output: TStrings);
+    procedure RenderTokensToString(const tokens: TSyntaxTokenArray; var output: string);
+  end;
+
+implementation
+
+{ THtmlSyntaxRenderer }
+
+constructor THtmlSyntaxRenderer.Create;
+begin
+  inherited Create;
+  FOptions := [];
+  FExtraClasses := '';
+end;
+
+function THtmlSyntaxRenderer.EscapeHtml(const text: string): string;
+var
+  i: Integer;
+  ch: Char;
+begin
+  Result := '';
+  for i := 1 to Length(text) do
+    begin
+    ch := text[i];
+    case ch of
+      '<': Result := Result + '&lt;';
+      '>': Result := Result + '&gt;';
+      '&': Result := Result + '&amp;';
+      '"': Result := Result + '&quot;';
+      '''': Result := Result + '&#39;';
+      else
+        Result := Result + ch;
+    end;
+    end;
+end;
+
+function THtmlSyntaxRenderer.GetKindClassName(kind: TSyntaxHighlightKind): string;
+begin
+  Result:=LowerCase(Kind.ToString);
+end;
+
+function THtmlSyntaxRenderer.GetCategoryName(category: Integer): string;
+begin
+  Result := '';
+  if category = 0 then Exit;
+  Result:=LowerCase(TSyntaxHighlighter.GetCategoryName(category));
+end;
+
+function THtmlSyntaxRenderer.BuildClassNames(kind: TSyntaxHighlightKind; categories: array of Integer): string;
+var
+  kindName, lName, categoryNames: string;
+  category : integer;
+
+begin
+  kindName := GetKindClassName(kind);
+  categoryNames:='';
+  for category in categories do
+    begin
+    lName:=GetCategoryName(category);
+    if lName<>'' then
+      categoryNames := categoryNames + ' ' + kindName + '-' + lName;
+    end;
+
+  Result := kindName;
+  if categoryNames<>'' then
+    Result:=Result+categoryNames;
+
+  // Add extra classes if specified
+  if FExtraClasses <> '' then
+    Result := Result + ' ' + FExtraClasses;
+end;
+
+procedure THtmlSyntaxRenderer.RenderTokensWithLineBreaks(const tokens: TSyntaxTokenArray; output: TStrings);
+var
+  i: Integer;
+  token: TSyntaxToken;
+  escapedText, classNames, result, currentLine: string;
+  lines: TStringArray;
+begin
+  // Build complete HTML first
+  result := '';
+  for i := 0 to High(tokens) do
+    begin
+    token := tokens[i];
+    escapedText := EscapeHtml(token.Text);
+
+    // Skip span wrapping for default tokens if hroNoDefaultSpan is set
+    if (hroNoDefaultSpan in FOptions) and (token.Kind = shDefault) then
+      result := result + escapedText
+    else
+      begin
+      classNames := BuildClassNames(token.Kind, token.Categories);
+
+      if classNames <> '' then
+        result := result + '<span class="' + classNames + '">' + escapedText + '</span>'
+      else
+        result := result + escapedText;
+      end;
+    end;
+
+  // Split by newlines and add each line separately
+  if result <> '' then
+    begin
+    lines := result.Split([#10]);
+    for i := 0 to High(lines) do
+      begin
+      currentLine := lines[i];
+      // Remove trailing #13 if present (for #13#10 line endings)
+      if (Length(currentLine) > 0) and (currentLine[Length(currentLine)] = #13) then
+        Delete(currentLine, Length(currentLine), 1);
+      output.Add(currentLine);
+      end;
+    end;
+end;
+
+procedure THtmlSyntaxRenderer.RenderTokensWithoutLineBreaks(const tokens: TSyntaxTokenArray; output: TStrings);
+var
+  i: Integer;
+  token: TSyntaxToken;
+  escapedText, classNames, result : string;
+
+begin
+  result := '';
+  for i := 0 to High(tokens) do
+    begin
+    token := tokens[i];
+    escapedText := EscapeHtml(token.Text);
+
+    // Skip span wrapping for default tokens if hroNoDefaultSpan is set
+    if (hroNoDefaultSpan in FOptions) and (token.Kind = shDefault) then
+      result := result + escapedText
+    else
+      begin
+      classNames := BuildClassNames(token.Kind, token.Categories);
+      if classNames <> '' then
+        result := result + '<span class="' + classNames + '">' + escapedText + '</span>'
+      else
+        result := result + escapedText;
+      end;
+    end;
+
+  // Add the complete result as a single line
+  if result <> '' then
+    output.Add(result);
+end;
+
+
+procedure THtmlSyntaxRenderer.RenderTokens(const tokens: TSyntaxTokenArray; output: TStrings);
+begin
+  if (output=nil) then
+    Exit;
+  if hroPreserveLineStructure in FOptions then
+    RenderTokensWithLineBreaks(Tokens,Output)
+  else
+    RenderTokensWithOutLineBreaks(Tokens,Output);
+end;
+
+procedure THtmlSyntaxRenderer.RenderTokensToString(const tokens: TSyntaxTokenArray; var output: string);
+var
+  i: Integer;
+  token: TSyntaxToken;
+  escapedText, classNames: string;
+  SkipSpan : Boolean;
+begin
+  SkipSpan:=(hroNoDefaultSpan in FOptions);
+  output := '';
+  for i := 0 to High(tokens) do
+    begin
+    token := tokens[i];
+    escapedText := EscapeHtml(token.Text);
+    // Skip span wrapping for default tokens if hroNoDefaultSpan is set
+    if not ((token.Kind = shDefault) and SkipSpan) then
+      begin
+      classNames := BuildClassNames(token.Kind, token.Categories);
+      if classNames <> '' then
+        EscapedText := '<span class="' + classNames + '">' + escapedText + '</span>'
+      end;
+    output := output + escapedText;
+    end;
+end;
+
+end.

packages/fcl-syntax/src/syntax.ini.pp

@@ -0,0 +1,303 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    INI syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.ini;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter;
+  {$ELSE}
+  Types, SysUtils, syntax.highlighter;
+  {$ENDIF}
+
+type
+
+  { TIniSyntaxHighlighter }
+
+  TIniSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+  protected
+    procedure ProcessSection(var endPos: integer);
+    procedure ProcessKey(var endPos: integer);
+    procedure ProcessComment(var endPos: integer);
+    procedure ProcessValue(var endPos: integer);
+    function IsWordChar(ch: char): boolean;
+    function IsKeyChar(ch: char): boolean;
+    class procedure CheckCategories;
+    class procedure RegisterDefaultCategories; override;
+    class function GetLanguages : TStringDynarray; override;
+  public
+    constructor Create; override;
+    class var
+      CategoryINI : Integer;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+  end;
+
+function DoIniHighlighting(const Source: string): TSyntaxTokenArray;
+
+implementation
+
+{ TIniSyntaxHighlighter }
+
+procedure TIniSyntaxHighlighter.ProcessSection(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening [
+
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> ']') and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) do
+    Inc(FPos);
+
+  if (FPos <= Length(FSource)) and (FSource[FPos] = ']') then
+    Inc(FPos); // Include closing ]
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shSection);
+end;
+
+procedure TIniSyntaxHighlighter.ProcessKey(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+
+  while (FPos <= Length(FSource)) and IsKeyChar(FSource[FPos]) do
+    Inc(FPos);
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shKey);
+end;
+
+procedure TIniSyntaxHighlighter.ProcessComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+
+  // Process until end of line
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) do
+    Inc(FPos);
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+procedure TIniSyntaxHighlighter.ProcessValue(var endPos: integer);
+var
+  startPos: integer;
+  inQuotes: boolean;
+  quoteChar: char;
+begin
+  startPos := FPos;
+  inQuotes := False;
+  quoteChar := #0;
+
+  // Skip leading whitespace
+  while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9]) do
+    Inc(FPos);
+
+  // Check if value starts with quotes
+  if (FPos <= Length(FSource)) and (FSource[FPos] in ['"', '''']) then
+  begin
+    inQuotes := True;
+    quoteChar := FSource[FPos];
+    Inc(FPos);
+  end;
+
+  if inQuotes then
+  begin
+    // Process quoted value
+    while (FPos <= Length(FSource)) and (FSource[FPos] <> quoteChar) do
+    begin
+      if (FSource[FPos] = '\') and (FPos < Length(FSource)) then
+        Inc(FPos); // Skip escaped character
+      Inc(FPos);
+    end;
+    if (FPos <= Length(FSource)) and (FSource[FPos] = quoteChar) then
+      Inc(FPos); // Include closing quote
+  end
+  else
+  begin
+    // Process unquoted value until end of line or comment
+    while (FPos <= Length(FSource)) and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) and (FSource[FPos] <> ';') and (FSource[FPos] <> '#') do
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  if inQuotes then
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings)
+  else
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+end;
+
+function TIniSyntaxHighlighter.IsWordChar(ch: char): boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.'];
+end;
+
+function TIniSyntaxHighlighter.IsKeyChar(ch: char): boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.', ' '];
+end;
+
+class procedure TIniSyntaxHighlighter.CheckCategories;
+begin
+  if CategoryINI = 0 then
+    RegisterDefaultCategories;
+end;
+
+class procedure TIniSyntaxHighlighter.RegisterDefaultCategories;
+begin
+  CategoryINI := RegisterCategory('INI');
+end;
+
+class function TIniSyntaxHighlighter.GetLanguages: TStringDynarray;
+begin
+  Result := ['ini', 'cfg', 'conf'];
+end;
+
+constructor TIniSyntaxHighlighter.Create;
+begin
+  inherited Create;
+  CheckCategories;
+  DefaultCategory := CategoryINI;
+end;
+
+function TIniSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  lLen, endPos, startPos: integer;
+  ch: char;
+  atLineStart: boolean;
+begin
+  Result := Nil;
+  CheckCategories;
+  lLen := Length(Source);
+  if lLen = 0 then
+    Exit;
+  FSource := Source;
+  FTokens.Reset;
+  FPos := 1;
+  EndPos := 0;
+  atLineStart := True;
+
+  while FPos <= lLen do
+  begin
+    ch := FSource[FPos];
+    case ch of
+    '[':
+      begin
+      if atLineStart then
+        ProcessSection(endPos)
+      else
+      begin
+        AddToken('[', shSymbol);
+        endPos := FPos;
+        Inc(FPos);
+      end;
+      atLineStart := False;
+      end;
+    ';', '#':
+      begin
+      ProcessComment(endPos);
+      atLineStart := False;
+      end;
+    '=':
+      begin
+      AddToken('=', shOperator);
+      endPos := FPos;
+      Inc(FPos);
+      // Process value after =
+      if FPos <= Length(FSource) then
+        ProcessValue(endPos);
+      atLineStart := False;
+      end;
+    '"', '''':
+      begin
+      FPos := FPos - 1; // Back up one to include quote in ProcessValue
+      ProcessValue(endPos);
+      Inc(FPos); // Move past the value
+      atLineStart := False;
+      end;
+    #10, #13:
+      begin
+      startPos := FPos;
+      if (FSource[FPos] = #13) and (FPos < Length(FSource)) and (FSource[FPos + 1] = #10) then
+        Inc(FPos, 2) // CRLF
+      else
+        Inc(FPos); // LF or CR only
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      atLineStart := True;
+      end;
+    ' ', #9:
+      begin
+      startPos := FPos;
+      while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9]) do
+        Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      end;
+    'a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.':
+      begin
+      if atLineStart then
+      begin
+        // This could be a key
+        ProcessKey(endPos);
+      end
+      else
+      begin
+        // Regular text
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      end;
+      atLineStart := False;
+      end;
+    else
+      AddToken(ch, shDefault);
+      endPos := FPos;
+      Inc(FPos);
+      atLineStart := False;
+    end;
+    if FPos = endPos then Inc(FPos);
+  end;
+  Result := FTokens.GetTokens;
+end;
+
+function DoIniHighlighting(const Source: string): TSyntaxTokenArray;
+var
+  highlighter: TIniSyntaxHighlighter;
+begin
+  highlighter := TIniSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  TIniSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.javascript.pp

@@ -0,0 +1,575 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Javascript syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.javascript;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter;
+  {$ELSE}
+  Types, SysUtils, syntax.highlighter;
+  {$ENDIF}
+
+type
+
+  { TJavaScriptSyntaxHighlighter }
+
+  TJavaScriptSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+  protected
+    procedure ProcessSingleQuoteString(var endPos: integer);
+    procedure ProcessDoubleQuoteString(var endPos: integer);
+    procedure ProcessTemplateString(var endPos: integer);
+    procedure ProcessRegexLiteral(var endPos: integer);
+    procedure ProcessSingleLineComment(var endPos: integer);
+    procedure ProcessMultiLineComment(var endPos: integer);
+    function CheckForComment(var endPos: integer): boolean;
+    function CheckForKeyword(var endPos: integer): boolean;
+    procedure ProcessNumber(var endPos: integer);
+    procedure ProcessOperator(var endPos: integer);
+    function IsWordChar(ch: char): boolean;
+    function IsRegexContext: boolean;
+    class function GetLanguages: TStringDynArray; override;
+    procedure CheckCategory;
+    class procedure RegisterDefaultCategories; override;
+  public
+    class var CategoryJavascript : integer;
+              CategoryEmbeddedJS : Integer;
+    constructor create; override;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+    procedure reset; override;
+    end;
+
+const
+  LF_SH_Valid = $01;
+  LF_SH_Multiline1 = $02;
+  LF_SH_Multiline2 = $04;
+  LF_SH_Multiline3 = $08;
+  LF_SH_Multiline4 = $10;
+  LF_SH_Multiline5 = $20;
+  LF_SH_Multiline6 = $40;
+  LF_SH_Multiline7 = $80;
+
+  LF_SH_MLComment = LF_SH_Multiline1;  { Multi-line comments }
+  LF_SH_Template = LF_SH_Multiline2;  { Template literals }
+
+  MaxKeywordLength = 15;
+  MaxKeyword = 62;
+
+  JavaScriptKeywordTable: array[0..MaxKeyword] of string = (
+    'abstract', 'arguments', 'async', 'await', 'boolean', 'break', 'byte', 'case', 'catch', 'char',
+    'class', 'const', 'continue', 'debugger', 'default', 'delete', 'do', 'double', 'else', 'enum',
+    'eval', 'export', 'extends', 'false', 'final', 'finally', 'float', 'for', 'function', 'goto',
+    'if', 'implements', 'import', 'in', 'instanceof', 'int', 'interface', 'let', 'long', 'native',
+    'new', 'null', 'package', 'private', 'protected', 'public', 'return', 'short', 'static', 'super',
+    'switch', 'synchronized', 'this', 'throw', 'throws', 'transient', 'true', 'try', 'typeof', 'undefined',
+    'var', 'void', 'while'
+    );
+
+function DoJavaScriptHighlighting(const Source: string): TSyntaxTokenArray;
+
+implementation
+
+  { TJavaScriptSyntaxHighlighter }
+
+
+procedure TJavaScriptSyntaxHighlighter.ProcessSingleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+  while FPos <= Length(FSource) do
+    begin
+    if FSource[FPos] = '''' then
+      begin
+      Inc(FPos);
+      break;
+      end
+    else if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then Inc(FPos); // Skip escaped character
+      end;
+    Inc(FPos);
+    end;
+    endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessDoubleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+  while FPos <= Length(FSource) do
+    begin
+    if FSource[FPos] = '"' then
+      begin
+      Inc(FPos);
+      break;
+      end
+    else if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then Inc(FPos); // Skip escaped character
+      end;
+    Inc(FPos);
+    end;
+    endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessTemplateString(var endPos: integer);
+var
+  startPos: integer;
+  braceCount: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening backtick
+  braceCount := 0;
+
+  while FPos <= Length(FSource) do
+    begin
+    if FSource[FPos] = '`' then
+      begin
+      if braceCount = 0 then
+        begin
+        Inc(FPos);
+        break;
+        end;
+      end
+    else if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then Inc(FPos); // Skip escaped character
+      end
+    else if (FPos < Length(FSource)) and (FSource[FPos] = '$') and (FSource[FPos + 1] = '{') then
+      begin
+      Inc(braceCount);
+      Inc(FPos); // Skip the $
+      end
+    else if FSource[FPos] = '{' then
+      begin
+      Inc(braceCount);
+      end
+    else if FSource[FPos] = '}' then
+      begin
+      Dec(braceCount);
+      if braceCount < 0 then
+        braceCount := 0;
+      end;
+    Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shRawString);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessRegexLiteral(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening /
+
+  while FPos <= Length(FSource) do
+    begin
+    if FSource[FPos] = '/' then
+      begin
+      Inc(FPos);
+      // Handle regex flags (g, i, m, etc.)
+      while (FPos <= Length(FSource)) and (FSource[FPos] in ['g', 'i', 'm', 's', 'u', 'y']) do
+        Inc(FPos);
+      break;
+      end
+    else if FSource[FPos] = '\' then
+      begin
+      if FPos < Length(FSource) then Inc(FPos); // Skip escaped character
+      end
+    else if FSource[FPos] in [#10, #13] then
+      begin
+      break; // Regex can't span lines
+      end;
+    Inc(FPos);
+    end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shRegex);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessSingleLineComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) do
+    Inc(FPos);
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessMultiLineComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos, 2); // Skip the opening /*
+  while FPos < Length(FSource) do
+    begin
+    if (FSource[FPos] = '*') and (FSource[FPos + 1] = '/') then
+      begin
+      Inc(FPos, 2);
+      break;
+      end;
+    Inc(FPos);
+    end;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+function TJavaScriptSyntaxHighlighter.CheckForComment(var endPos: integer): boolean;
+begin
+  Result := True;
+
+  if (FPos < Length(FSource)) and (FSource[FPos] = '/') and (FSource[FPos + 1] = '/') then
+    begin
+    ProcessSingleLineComment(endPos);
+    end
+  else if (FPos < Length(FSource)) and (FSource[FPos] = '/') and (FSource[FPos + 1] = '*') then
+    begin
+    ProcessMultiLineComment(endPos);
+    end
+  else
+    Result := False;
+end;
+
+function TJavaScriptSyntaxHighlighter.CheckForKeyword(var endPos: integer): boolean;
+var
+  i, j: integer;
+  keyword: string;
+begin
+
+  i := 0;
+  while (FPos + i <= Length(FSource)) and (i < MaxKeywordLength) and
+    IsWordChar(FSource[FPos + i]) do
+    begin
+    Inc(i);
+    end;
+
+  keyword := Copy(FSource, FPos, i);
+  Result := False;
+
+  for j := 0 to MaxKeyword do
+    if JavaScriptKeywordTable[j] = keyword then
+      begin
+      Result := True;
+      break;
+      end;
+
+  if not Result then Exit;
+
+  Inc(FPos, i);
+    endPos := FPos - 1;
+  AddToken(keyword, shKeyword);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessNumber(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+
+  // Handle hex numbers (0x...)
+  if (FPos < Length(FSource)) and (FSource[FPos] = '0') and
+    (UpCase(FSource[FPos + 1]) = 'X') then
+    begin
+    Inc(FPos, 2);
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9', 'A'..'F', 'a'..'f']) do
+      Inc(FPos);
+    end
+  // Handle binary numbers (0b...)
+  else if (FPos < Length(FSource)) and (FSource[FPos] = '0') and
+    (UpCase(FSource[FPos + 1]) = 'B') then
+    begin
+    Inc(FPos, 2);
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0', '1']) do
+      Inc(FPos);
+    end
+  // Handle octal numbers (0o...) or regular numbers
+  else
+    begin
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+      Inc(FPos);
+
+    // Handle decimal point
+    if (FPos <= Length(FSource)) and (FSource[FPos] = '.') then
+      begin
+      Inc(FPos);
+      while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+        Inc(FPos);
+      end;
+
+    // Handle scientific notation (e/E)
+    if (FPos <= Length(FSource)) and (UpCase(FSource[FPos]) = 'E') then
+      begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['+', '-']) then
+        Inc(FPos);
+      while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+        Inc(FPos);
+      end;
+    end;
+
+    endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+end;
+
+procedure TJavaScriptSyntaxHighlighter.ProcessOperator(var endPos: integer);
+var
+  startPos: integer;
+  ch: char;
+begin
+  startPos := FPos;
+  ch := FSource[FPos];
+
+  // Handle multi-character operators
+  case ch of
+    '=': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['=', '>']) then Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos - 1] = '=') and (FSource[FPos] = '=') then Inc(FPos);
+      end;
+    '!': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] = '=') then
+        begin
+        Inc(FPos);
+        if (FPos <= Length(FSource)) and (FSource[FPos] = '=') then Inc(FPos);
+        end;
+      end;
+    '<': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['=', '<']) then Inc(FPos);
+      end;
+    '>': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['=', '>']) then
+        begin
+        Inc(FPos);
+        if (FPos <= Length(FSource)) and (FSource[FPos] = '>') then Inc(FPos);
+        end;
+      end;
+    '&': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] = '&') then Inc(FPos);
+      end;
+    '|': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] = '|') then Inc(FPos);
+      end;
+    '+': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['+', '=']) then Inc(FPos);
+      end;
+    '-': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['-', '=']) then Inc(FPos);
+      end;
+    '*': begin
+      Inc(FPos);
+      if (FPos <= Length(FSource)) and (FSource[FPos] in ['*', '=']) then
+        begin
+        Inc(FPos);
+        if (FPos <= Length(FSource)) and (FSource[FPos - 1] = '*') and (FSource[FPos] = '=') then Inc(FPos);
+        end;
+      end;
+    '.': begin
+      Inc(FPos);
+      if (FPos < Length(FSource)) and (FSource[FPos] = '.') and (FSource[FPos + 1] = '.') then
+        Inc(FPos, 2);
+      end;
+    else
+      Inc(FPos);
+    end;
+
+    endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shOperator);
+end;
+
+function TJavaScriptSyntaxHighlighter.IsWordChar(ch: char): boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_', '$'];
+end;
+
+function TJavaScriptSyntaxHighlighter.IsRegexContext: boolean;
+
+var
+  i: integer;
+  lastToken: TSyntaxToken;
+  lText : String;
+  lLen : integer;
+
+begin
+  Result := True; // Default to allowing regex
+
+  if FTokens.Count = 0 then Exit;
+
+  // Look at the last meaningful token
+  i := FTokens.Count - 1;
+  while (i >= 0) and (FTokens.Tokens[i].Kind = shDefault) and
+    (Trim(FTokens.Tokens[i].Text) = '') do
+    Dec(i);
+
+  if i < 0 then Exit;
+
+  lastToken := FTokens.Tokens[i];
+  lText:=lastToken.text;
+  lLen:=Length(lText);
+
+  // After these tokens, / is likely division, not regex
+  Result := not ((lText = ')') or (lText = ']') or (lText = '}')) and
+            not (LastToken.Kind = shNumbers) and
+            not (
+                 (LastToken.Kind = shDefault)
+                 and (llen > 0)
+                 and IsWordChar(lText[llen])
+                );
+end;
+
+class function TJavaScriptSyntaxHighlighter.GetLanguages: TStringDynArray;
+begin
+  Result := ['js', 'javascript'];
+end;
+
+procedure TJavaScriptSyntaxHighlighter.CheckCategory;
+begin
+  if CategoryJavascript=0 then
+    RegisterDefaultCategories;
+end;
+
+class procedure TJavaScriptSyntaxHighlighter.RegisterDefaultCategories;
+begin
+  CategoryJavascript:=RegisterCategory('javascript');
+  CategoryEmbeddedJS:=RegisterCategory('EmbeddedJS');
+  inherited RegisterDefaultCategories;
+end;
+
+constructor TJavaScriptSyntaxHighlighter.create;
+begin
+  Inherited ;
+  CheckCategory;
+  DefaultCategory:=CategoryJavascript;
+end;
+
+function TJavaScriptSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  lLen,endPos, startPos: integer;
+  ch: char;
+begin
+  Result:=Nil;
+  CheckCategory;
+  lLen:=Length(Source);
+  if lLen = 0 then
+    Exit;
+  endPos:=0;
+  FSource:=Source;
+  FTokens.Reset;
+  FPos := 1;
+  while FPos <= lLen do
+    begin
+    ch := FSource[FPos];
+    if not CheckForComment(endPos) then
+      begin
+      case ch of
+      '''':
+        ProcessSingleQuoteString(endPos);
+      '"':
+        ProcessDoubleQuoteString(endPos);
+      '`':
+        ProcessTemplateString(endPos);
+      '/':
+        begin
+        if IsRegexContext then
+          ProcessRegexLiteral(endPos)
+        else
+          ProcessOperator(endPos);
+        end;
+      '0'..'9': ProcessNumber(endPos);
+      'a'..'z', 'A'..'Z', '_', '$':
+        begin
+        if not CheckForKeyword(endPos) then
+          begin
+          startPos := FPos;
+          while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+            Inc(FPos);
+              endPos := FPos - 1;
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+          end;
+        end;
+      '=', '!', '<', '>', '&', '|', '+', '-', '*', '%', '^', '~', '?', ':', '.':
+        ProcessOperator(endPos);
+      ';', '(', ')', '[', ']', '{', '}', ',':
+        begin
+        AddToken(ch, shSymbol);
+            endPos := FPos;
+        Inc(FPos);
+        end;
+      ' ', #9, #10, #13:
+        begin
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+        end;
+      else
+        AddToken(ch, shInvalid);
+        endPos := FPos;
+        Inc(FPos);
+      end;
+      end;
+    if FPos = endPos then
+      Inc(FPos);
+    end;
+  Result := FTokens.GetTokens;
+end;
+
+procedure TJavaScriptSyntaxHighlighter.reset;
+begin
+  inherited reset;
+  FPos := 0;
+end;
+
+function DoJavaScriptHighlighting(const Source: string): TSyntaxTokenArray;
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+begin
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  TJavaScriptSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.json.pp

@@ -0,0 +1,443 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    JSON syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.json;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter;
+  {$ELSE}
+  Types, SysUtils, syntax.highlighter;
+  {$ENDIF}
+
+type
+
+  { TJsonSyntaxHighlighter }
+
+  TJsonSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+    FExpectingKey: boolean; // Track context to distinguish keys from string values
+  protected
+    procedure ProcessString(var endPos: integer; isKey: boolean);
+    procedure ProcessNumber(var endPos: integer);
+    function CheckForKeyword(var endPos: integer): boolean;
+    function IsHexChar(ch: char): boolean;
+    function IsDigitChar(ch: char): boolean;
+    procedure SkipWhitespace;
+    class procedure CheckCategories;
+    class procedure RegisterDefaultCategories; override;
+    class function GetLanguages : TStringDynarray; override;
+  public
+    constructor Create; override;
+    class var
+      CategoryJSON : Integer;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+  end;
+
+function DoJsonHighlighting(const Source: string): TSyntaxTokenArray;
+
+implementation
+
+{ TJsonSyntaxHighlighter }
+
+procedure TJsonSyntaxHighlighter.ProcessString(var endPos: integer; isKey: boolean);
+var
+  startPos: integer;
+  ch: char;
+  kind: TSyntaxHighlightKind;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+
+  while FPos <= Length(FSource) do
+  begin
+    ch := FSource[FPos];
+
+    if ch = '"' then
+    begin
+      Inc(FPos); // Include closing quote
+      break;
+    end
+    else if ch = '\' then
+    begin
+      // Handle escape sequences
+      Inc(FPos);
+      if FPos <= Length(FSource) then
+      begin
+        ch := FSource[FPos];
+        case ch of
+          '"', '\', '/', 'b', 'f', 'n', 'r', 't':
+            Inc(FPos); // Valid single-char escape
+          'u':
+            begin
+            // Unicode escape sequence \uXXXX
+            Inc(FPos);
+            if FPos + 3 <= Length(FSource) then
+            begin
+              if IsHexChar(FSource[FPos]) and IsHexChar(FSource[FPos + 1]) and
+                 IsHexChar(FSource[FPos + 2]) and IsHexChar(FSource[FPos + 3]) then
+                Inc(FPos, 4)
+              else
+              begin
+                // Invalid unicode escape - mark as invalid
+                endPos := FPos - 1;
+                AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+                Exit;
+              end;
+            end
+            else
+            begin
+              // Incomplete unicode escape
+              endPos := Length(FSource);
+              AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+              FPos := Length(FSource) + 1;
+              Exit;
+            end;
+            end;
+        else
+          // Invalid escape sequence
+          endPos := FPos - 1;
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+          Exit;
+        end;
+      end
+      else
+      begin
+        // String ends with backslash
+        endPos := Length(FSource);
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+        FPos := Length(FSource) + 1;
+        Exit;
+      end;
+    end
+    else if Ord(ch) < 32 then
+    begin
+      // Control characters must be escaped in JSON
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+      Exit;
+    end
+    else
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+
+  // Check if we reached end of input without finding closing quote
+  if (FPos > Length(FSource)) or (FSource[FPos - 1] <> '"') then
+  begin
+    // Unterminated string - mark as invalid
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+    Exit;
+  end;
+
+  // Determine if this is a key or a string value
+  if isKey then
+    kind := shKey
+  else
+    kind := shStrings;
+
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), kind);
+end;
+
+procedure TJsonSyntaxHighlighter.ProcessNumber(var endPos: integer);
+var
+  startPos: integer;
+  hasDecimal, hasExponent: boolean;
+  ch: char;
+begin
+  startPos := FPos;
+  hasDecimal := False;
+  hasExponent := False;
+
+  // Handle optional minus sign
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '-') then
+    Inc(FPos);
+
+  // Must have at least one digit
+  if (FPos > Length(FSource)) or not IsDigitChar(FSource[FPos]) then
+  begin
+    endPos := FPos - 1;
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+    Exit;
+  end;
+
+  // Handle leading zero (JSON doesn't allow leading zeros except for "0")
+  if FSource[FPos] = '0' then
+  begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and IsDigitChar(FSource[FPos]) then
+    begin
+      // Invalid: leading zero followed by another digit
+      while (FPos <= Length(FSource)) and (IsDigitChar(FSource[FPos]) or (FSource[FPos] in ['.', 'e', 'E', '+', '-'])) do
+        Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+      Exit;
+    end;
+  end
+  else
+  begin
+    // Handle integer part (non-zero leading digit)
+    while (FPos <= Length(FSource)) and IsDigitChar(FSource[FPos]) do
+      Inc(FPos);
+  end;
+
+  // Handle decimal part
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '.') then
+  begin
+    hasDecimal := True;
+    Inc(FPos);
+
+    // Must have at least one digit after decimal point
+    if (FPos > Length(FSource)) or not IsDigitChar(FSource[FPos]) then
+    begin
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+      Exit;
+    end;
+
+    while (FPos <= Length(FSource)) and IsDigitChar(FSource[FPos]) do
+      Inc(FPos);
+  end;
+
+  // Handle exponent part
+  if (FPos <= Length(FSource)) and (FSource[FPos] in ['e', 'E']) then
+  begin
+    hasExponent := True;
+    Inc(FPos);
+
+    // Optional sign
+    if (FPos <= Length(FSource)) and (FSource[FPos] in ['+', '-']) then
+      Inc(FPos);
+
+    // Must have at least one digit after exponent
+    if (FPos > Length(FSource)) or not IsDigitChar(FSource[FPos]) then
+    begin
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+      Exit;
+    end;
+
+    while (FPos <= Length(FSource)) and IsDigitChar(FSource[FPos]) do
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+end;
+
+function TJsonSyntaxHighlighter.CheckForKeyword(var endPos: integer): boolean;
+var
+  startPos: integer;
+  keyword: string;
+begin
+  Result := False;
+  startPos := FPos;
+
+  // Check for 'true'
+  if (FPos + 3 <= Length(FSource)) and
+     (Copy(FSource, FPos, 4) = 'true') then
+  begin
+    Inc(FPos, 4);
+    endPos := FPos - 1;
+    AddToken('true', shKeyword);
+    Result := True;
+  end
+  // Check for 'false'
+  else if (FPos + 4 <= Length(FSource)) and
+          (Copy(FSource, FPos, 5) = 'false') then
+  begin
+    Inc(FPos, 5);
+    endPos := FPos - 1;
+    AddToken('false', shKeyword);
+    Result := True;
+  end
+  // Check for 'null'
+  else if (FPos + 3 <= Length(FSource)) and
+          (Copy(FSource, FPos, 4) = 'null') then
+  begin
+    Inc(FPos, 4);
+    endPos := FPos - 1;
+    AddToken('null', shKeyword);
+    Result := True;
+  end;
+end;
+
+function TJsonSyntaxHighlighter.IsHexChar(ch: char): boolean;
+begin
+  Result := ch in ['0'..'9', 'A'..'F', 'a'..'f'];
+end;
+
+function TJsonSyntaxHighlighter.IsDigitChar(ch: char): boolean;
+begin
+  Result := ch in ['0'..'9'];
+end;
+
+procedure TJsonSyntaxHighlighter.SkipWhitespace;
+begin
+  while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+    Inc(FPos);
+end;
+
+class procedure TJsonSyntaxHighlighter.CheckCategories;
+begin
+  if CategoryJSON = 0 then
+    RegisterDefaultCategories;
+end;
+
+class procedure TJsonSyntaxHighlighter.RegisterDefaultCategories;
+begin
+  CategoryJSON := RegisterCategory('JSON');
+end;
+
+class function TJsonSyntaxHighlighter.GetLanguages: TStringDynarray;
+begin
+  Result := ['json'];
+end;
+
+constructor TJsonSyntaxHighlighter.Create;
+begin
+  inherited Create;
+  CheckCategories;
+  DefaultCategory := CategoryJSON;
+end;
+
+function TJsonSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  lLen, endPos, startPos: integer;
+  ch: char;
+begin
+  Result := Nil;
+  CheckCategories;
+  lLen := Length(Source);
+  if lLen = 0 then
+    Exit;
+  FSource := Source;
+  FTokens.Reset;
+  FPos := 1;
+  EndPos := 0;
+  FExpectingKey := True; // Start expecting a key in root object
+
+  while FPos <= lLen do
+  begin
+    ch := FSource[FPos];
+    case ch of
+    '"':
+      begin
+      ProcessString(endPos, FExpectingKey);
+      // After processing a string, update context
+      if FExpectingKey then
+        FExpectingKey := False; // Next string will be a value
+      end;
+    '0'..'9', '-':
+      ProcessNumber(endPos);
+    't', 'f', 'n': // true, false, null
+      begin
+      if not CheckForKeyword(endPos) then
+      begin
+        // Invalid identifier
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and (FSource[FPos] in ['a'..'z', 'A'..'Z']) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid);
+      end;
+      end;
+    '{':
+      begin
+      AddToken('{', shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      FExpectingKey := True; // After opening brace, expect a key
+      end;
+    '}':
+      begin
+      AddToken('}', shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      FExpectingKey := False; // After closing brace, context depends on parent
+      end;
+    '[':
+      begin
+      AddToken('[', shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      FExpectingKey := False; // Arrays contain values, not keys
+      end;
+    ']':
+      begin
+      AddToken(']', shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      FExpectingKey := False; // After closing array, context depends on parent
+      end;
+    ':':
+      begin
+      AddToken(':', shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      FExpectingKey := False; // After colon, expect a value
+      end;
+    ',':
+      begin
+      AddToken(',', shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      // After comma, context depends on whether we're in object or array
+      // For simplicity, we'll assume we might be expecting a key
+      // (This is a limitation - proper JSON parsing would maintain a stack)
+      FExpectingKey := True;
+      end;
+    ' ', #9, #10, #13:
+      begin
+      startPos := FPos;
+      while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+        Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      end;
+    else
+      AddToken(ch, shInvalid);
+      endPos := FPos;
+      Inc(FPos);
+    end;
+    if FPos = endPos then Inc(FPos);
+  end;
+  Result := FTokens.GetTokens;
+end;
+
+function DoJsonHighlighting(const Source: string): TSyntaxTokenArray;
+var
+  highlighter: TJsonSyntaxHighlighter;
+begin
+  highlighter := TJsonSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  TJsonSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.pascal.pp

@@ -0,0 +1,397 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Pascal syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$MODE objfpc}
+{$H+}
+
+unit syntax.pascal;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter;
+  {$ELSE}
+  types, sysutils, syntax.highlighter;
+  {$ENDIF}
+
+type
+
+  { TPascalSyntaxHighlighter }
+
+  TPascalSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+  protected
+    procedure CheckCategories;
+    procedure ProcessComment1(var endPos: integer; akind : TSyntaxHighlightKind);
+    procedure ProcessComment2(var endPos: integer);
+    function CheckForComment(var endPos: integer): boolean;
+    procedure ProcessAsm(var endPos: integer);
+    function CheckForKeyword(var endPos: integer): boolean;
+    procedure ProcessSymbol(var endPos: integer);
+    class function GetLanguages: TStringDynArray; override;
+  public
+    constructor Create; override;
+    class var
+       CategoryPascal,
+       CategoryIdentifier : Integer;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+  end;
+
+function DoPascalHighlighting(const Source: string): TSyntaxTokenArray;
+
+
+implementation
+
+const
+  MaxKeywordLength = 15;
+  MaxKeyword = 60;
+
+  KeywordTable: array[0..MaxKeyword] of string =
+    ('AND', 'ARRAY', 'ASM', 'ASSEMBLER',
+    'BEGIN', 'BREAK',
+    'CASE', 'CONST', 'CONSTRUCTOR', 'CLASS',
+    'DEFAULT', 'DESTRUCTOR', 'DIV', 'DO', 'DOWNTO',
+    'ELSE', 'END', 'EXCEPT', 'EXIT',
+    'FINALIZATION', 'FINALLY', 'FOR', 'FUNCTION',
+    'GOTO',
+    'IF', 'IMPLEMENTATION', 'IN', 'INHERITED', 'INITIALIZATION', 'INTERFACE',
+    'NIL', 'NOT',
+    'OBJECT', 'OF', 'ON', 'OR', 'OVERRIDE',
+    'PACKED', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PROPERTY', 'PROTECTED',
+    'PUBLIC', 'PUBLISHED',
+    'RAISE', 'RECORD', 'REPEAT', 'RESOURCESTRING',
+    'SET',
+    'THEN', 'TRY', 'TYPE',
+    'UNIT', 'UNTIL', 'USES',
+    'VAR', 'VIRTUAL',
+    'WHILE', 'WITH',
+    'XOR');
+
+  KeywordAsmIndex = 2;
+
+
+  { TPascalSyntaxHighlighter }
+
+procedure TPascalSyntaxHighlighter.CheckCategories;
+begin
+  if CategoryPascal=0 then
+    begin
+    CategoryPascal:=RegisterCategory('pascal');
+    CategoryIdentifier:=RegisterCategory('identifier');
+    end;
+end;
+
+
+procedure TPascalSyntaxHighlighter.ProcessComment1(var endPos: integer; akind: TSyntaxHighlightKind);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos);  // Skip the opening '{'
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> '}') do
+    Inc(FPos);
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '}') then
+    Inc(FPos);
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), aKind);
+end;
+
+procedure TPascalSyntaxHighlighter.ProcessComment2(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos, 2);  // Skip the opening '(*'
+  while (FPos < Length(FSource)) and not ((FSource[FPos] = '*') and (FSource[FPos + 1] = ')')) do
+    Inc(FPos);
+  if (FPos < Length(FSource)) and (FSource[FPos] = '*') and (FSource[FPos + 1] = ')') then
+    begin
+    Inc(FPos, 2);
+    end
+  else
+    FPos := Length(FSource) + 1;
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+function TPascalSyntaxHighlighter.CheckForComment(var endPos: integer): boolean;
+var
+  startPos: integer;
+  kind: TSyntaxHighlightKind;
+begin
+  Result := True;
+  startPos := FPos;
+
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '{') then
+    begin
+    if (FPos < Length(FSource)) and (FSource[FPos + 1] = '$') then
+      kind := shDirective
+    else
+      kind := shComment;
+    ProcessComment1(endPos,kind);
+    end
+  else if (FPos < Length(FSource)) and (FSource[FPos] = '(') and (FSource[FPos + 1] = '*') then
+    begin
+    ProcessComment2(endPos);
+    end
+  else if (FPos < Length(FSource)) and (FSource[FPos] = '/') and (FSource[FPos + 1] = '/') then
+    begin
+    while (FPos <= Length(FSource)) and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) do
+      Inc(FPos);
+    endPos := FPos - 1;
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+    end
+  else
+    Result := False;
+end;
+
+procedure TPascalSyntaxHighlighter.ProcessAsm(var endPos: integer);
+var
+  startPos: integer;
+  lastChar: char;
+begin
+  startPos := FPos;
+  lastChar := ' ';
+  while FPos <= Length(FSource) do
+    begin
+    if (lastChar in [' ', #9, #10, #13]) and
+      (FPos + 2 <= Length(FSource)) and
+      (UpCase(FSource[FPos]) = 'E') and (UpCase(FSource[FPos + 1]) = 'N') and
+      (UpCase(FSource[FPos + 2]) = 'D') then
+      begin
+      endPos := FPos - 1;
+      if endPos >= startPos then
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shAssembler);
+      AddToken('END', shKeyword);
+      Inc(FPos, 3);
+      Exit;
+      end
+    else
+      begin
+      if CheckForComment(endPos) then
+        lastChar := ' '
+      else
+        begin
+        lastChar := FSource[FPos];
+        Inc(FPos);
+        end;
+      end;
+    end;
+  endPos := FPos - 1;
+  if endPos >= startPos then
+    AddToken(Copy(FSource, startPos, endPos - startPos + 1), shAssembler);
+end;
+
+function TPascalSyntaxHighlighter.CheckForKeyword(var endPos: integer): boolean;
+
+const
+  IdentifierChars = ['0'..'9', 'A'..'Z', 'a'..'z', '_'];
+
+var
+  i, lIdx: integer;
+  keyword, ukeyword: string;
+
+begin
+  i := 0;
+  while (FPos + i <= Length(FSource))
+        and (i < MaxKeywordLength)
+        and (FSource[FPos + i] in IdentifierChars) do
+    Inc(i);
+  keyword := Copy(FSource, FPos, i);
+  ukeyword := UpperCase(keyword);
+
+  Result := False;
+  lIdx:=MaxKeyWord;
+  While (Not Result) and (lIdx>=0) do
+    begin
+    Result:=KeywordTable[lIdx] = ukeyword;
+    Dec(lIdx);
+    end;
+
+  if not Result then
+    Exit;
+
+  Inc(lIdx); // Index of actual keyword
+  Inc(FPos,i);
+  endPos:=FPos - 1;
+  AddToken(keyword,shKeyword);
+  if lIdx=KeywordAsmIndex then
+    ProcessAsm(endPos);
+end;
+
+procedure TPascalSyntaxHighlighter.ProcessSymbol(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  if (FPos < Length(FSource)) and (FSource[FPos] = ':') and (FSource[FPos + 1] = '=') then
+    Inc(FPos, 2)
+  else
+    Inc(FPos);
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shSymbol);
+end;
+
+class function TPascalSyntaxHighlighter.GetLanguages: TStringDynArray;
+begin
+  Result:=['pascal','delphi','objectpascal']
+end;
+
+constructor TPascalSyntaxHighlighter.Create;
+begin
+  inherited Create;
+  CheckCategories;
+  DefaultCategory:=CategoryPascal;
+end;
+
+function TPascalSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  endPos: integer;
+  StringLength: integer;
+  lLen,startPos: integer;
+  ch: char;
+begin
+  Result:=Nil;
+  CheckCategories;
+  if Length(Source) = 0 then
+    Exit;
+  FSource:=Source;
+  lLen:=Length(FSource);
+  FTokens.Reset;
+  FPos := 1;
+  EndPos:=0;
+  while FPos <= llen do
+    begin
+    ch := FSource[FPos];
+    if CheckForComment(endPos) then
+      begin
+      FPos := endPos + 1;
+      continue;
+      end;
+
+    case ch of
+      ',', ';', ':', '.', '(', ')', '[', ']', '<', '>', '=',
+      '*', '/', '+', '-', '^', '&', '@':
+        ProcessSymbol(endPos);
+      '#':
+        begin
+        startPos := FPos;
+        Inc(FPos);
+        if (FPos <= Length(FSource)) and (FSource[FPos] = '$') then
+        Inc(FPos);
+        while (FPos <= Length(FSource)) and (FSource[FPos] >= '0') and (FSource[FPos] <= '9') do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shCharacters);
+        end;
+      '$':
+        begin
+        startPos := FPos;
+        Inc(FPos);
+        while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9', 'A'..'F', 'a'..'f']) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+        end;
+      '0'..'9':
+        begin
+        startPos := FPos;
+        Inc(FPos);
+        while (FPos <= Length(FSource)) and (FSource[FPos] >= '0') and (FSource[FPos] <= '9') do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+        end;
+      '''':
+        begin
+        startPos := FPos;
+        Inc(FPos);
+        StringLength := 0;
+        while (FPos <= Length(FSource)) do
+          begin
+          if FSource[FPos] = '''' then
+            if (FPos < Length(FSource)) and (FSource[FPos + 1] = '''') then
+              begin
+              Inc(FPos, 2);
+              Inc(StringLength);
+              end
+            else
+              begin
+              Inc(FPos);
+              break;
+              end
+          else
+            begin
+            Inc(StringLength);
+            Inc(FPos);
+            end;
+          end;
+        endPos := FPos - 1;
+        if StringLength = 1 then
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shCharacters)
+        else if (FPos > Length(FSource)) and (FSource[endPos] <> '''') then
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shInvalid)
+        else
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+        end;
+      '_', 'A'..'Z', 'a'..'z':
+        begin
+        if not CheckForKeyword(endPos) then
+          begin
+          startPos := FPos;
+          while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9', '_', 'A'..'Z', 'a'..'z']) do
+            Inc(FPos);
+          endPos := FPos - 1;
+          AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+          end;
+        end;
+      ' ', #9, #10, #13:
+        begin
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+        end;
+      else
+        AddToken(ch, shInvalid);
+        Inc(FPos);
+      end;
+    if FPos = endPos then
+      Inc(FPos);
+  end;
+  Result := FTokens.GetTokens;
+end;
+
+function DoPascalHighlighting(const Source: string): TSyntaxTokenArray;
+
+var
+  highlighter: TPascalSyntaxHighlighter;
+
+begin
+  highlighter := TPascalSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+
+initialization
+  TPascalSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/src/syntax.sql.pp

@@ -0,0 +1,466 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    SQL syntax highlighter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit syntax.sql;
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Types, System.SysUtils, syntax.highlighter;
+  {$ELSE}
+  types, sysutils, syntax.highlighter;
+  {$ENDIF}
+
+type
+  // String escaping modes for SQL
+  TSqlStringEscapeMode = (
+    semBackslash,  // Backslash escaping: 'I\'m here'
+    semDoubled     // Doubled character escaping: 'I''m here' (Firebird, standard SQL)
+  );
+
+  { TSqlSyntaxHighlighter }
+
+  TSqlSyntaxHighlighter = class(TSyntaxHighlighter)
+  private
+    FSource: string;
+    FPos: integer;
+    FStringEscapeMode: TSqlStringEscapeMode;
+  protected
+    procedure ProcessSingleQuoteString(var endPos: integer);
+    procedure ProcessDoubleQuoteString(var endPos: integer);
+    procedure ProcessSingleLineComment(var endPos: integer);
+    procedure ProcessMultiLineComment(var endPos: integer);
+    procedure ProcessNumber(var endPos: integer);
+    function CheckForKeyword(var endPos: integer): boolean;
+    function IsWordChar(ch: char): boolean;
+    function IsHexChar(ch: char): boolean;
+    class procedure CheckCategories;
+    class procedure RegisterDefaultCategories; override;
+    class function GetLanguages : TStringDynarray; override;
+  public
+    constructor Create; override;
+    class var
+      CategorySQL : Integer;
+    function Execute(const Source: string): TSyntaxTokenArray; override;
+    property StringEscapeMode: TSqlStringEscapeMode read FStringEscapeMode write FStringEscapeMode;
+  end;
+
+const
+  MaxKeywordLength = 20;
+  MaxKeyword = 113;
+
+  SqlKeywordTable: array[0..MaxKeyword] of string = (
+    // Basic SQL keywords
+    'SELECT', 'FROM', 'WHERE', 'INSERT', 'UPDATE', 'DELETE', 'CREATE', 'DROP', 'ALTER',
+    'TABLE', 'DATABASE', 'INDEX', 'VIEW', 'PROCEDURE', 'FUNCTION', 'TRIGGER',
+    // Data types
+    'INTEGER', 'INT', 'BIGINT', 'SMALLINT', 'DECIMAL', 'NUMERIC', 'FLOAT', 'REAL', 'DOUBLE',
+    'VARCHAR', 'CHAR', 'TEXT', 'BLOB', 'CLOB', 'DATE', 'TIME', 'TIMESTAMP', 'BOOLEAN',
+    // Constraints and modifiers
+    'PRIMARY', 'FOREIGN', 'KEY', 'REFERENCES', 'CONSTRAINT', 'UNIQUE', 'NOT', 'NULL',
+    'DEFAULT', 'CHECK', 'AUTO_INCREMENT', 'IDENTITY',
+    // Joins and set operations
+    'JOIN', 'INNER', 'LEFT', 'RIGHT', 'FULL', 'OUTER', 'CROSS', 'ON', 'USING',
+    'UNION', 'INTERSECT', 'EXCEPT', 'MINUS',
+    // Clauses and operators
+    'AND', 'OR', 'IN', 'EXISTS', 'BETWEEN', 'LIKE', 'IS', 'AS', 'DISTINCT', 'ALL', 'ANY', 'SOME',
+    'ORDER', 'BY', 'GROUP', 'HAVING', 'LIMIT', 'OFFSET', 'TOP',
+    // Functions and aggregates
+    'COUNT', 'SUM', 'AVG', 'MIN', 'MAX', 'CASE', 'WHEN', 'THEN', 'ELSE', 'END',
+    'CAST', 'CONVERT', 'COALESCE', 'NULLIF',
+    // Transaction control
+    'BEGIN', 'COMMIT', 'ROLLBACK', 'TRANSACTION', 'SAVEPOINT',
+    // Privileges and security
+    'GRANT', 'REVOKE', 'ROLE', 'USER', 'PRIVILEGES',
+    // Conditional and flow control
+    'IF', 'ELSIF', 'ELSEIF', 'WHILE', 'FOR', 'LOOP', 'DECLARE', 'SET',
+    // Schema operations
+    'SCHEMA', 'CATALOG', 'DOMAIN', 'SEQUENCE'
+  );
+
+function DoSqlHighlighting(const Source: string): TSyntaxTokenArray;
+function DoSqlHighlighting(const Source: string; EscapeMode: TSqlStringEscapeMode): TSyntaxTokenArray;
+
+implementation
+
+{ TSqlSyntaxHighlighter }
+
+procedure TSqlSyntaxHighlighter.ProcessSingleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+
+  while FPos <= Length(FSource) do
+  begin
+    if FSource[FPos] = '''' then
+    begin
+      if FStringEscapeMode = semDoubled then
+      begin
+        // Standard SQL doubled quote escaping
+        if (FPos < Length(FSource)) and (FSource[FPos + 1] = '''') then
+          Inc(FPos, 2) // Skip escaped quote
+        else
+        begin
+          Inc(FPos); // Skip closing quote
+          break;
+        end;
+      end
+      else
+      begin
+        // Single quote always ends the string in backslash mode
+        Inc(FPos);
+        break;
+      end;
+    end
+    else if (FStringEscapeMode = semBackslash) and (FSource[FPos] = '\') then
+    begin
+      if FPos < Length(FSource) then
+        Inc(FPos); // Skip escaped character
+      Inc(FPos);
+    end
+    else
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TSqlSyntaxHighlighter.ProcessDoubleQuoteString(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos); // Skip opening quote
+
+  while FPos <= Length(FSource) do
+  begin
+    if FSource[FPos] = '"' then
+    begin
+      if FStringEscapeMode = semDoubled then
+      begin
+        // Standard SQL doubled quote escaping
+        if (FPos < Length(FSource)) and (FSource[FPos + 1] = '"') then
+          Inc(FPos, 2) // Skip escaped quote
+        else
+        begin
+          Inc(FPos); // Skip closing quote
+          break;
+        end;
+      end
+      else
+      begin
+        // Double quote always ends the string in backslash mode
+        Inc(FPos);
+        break;
+      end;
+    end
+    else if (FStringEscapeMode = semBackslash) and (FSource[FPos] = '\') then
+    begin
+      if FPos < Length(FSource) then
+        Inc(FPos); // Skip escaped character
+      Inc(FPos);
+    end
+    else
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shStrings);
+end;
+
+procedure TSqlSyntaxHighlighter.ProcessSingleLineComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos, 2); // Skip '--'
+
+  // Process until end of line
+  while (FPos <= Length(FSource)) and (FSource[FPos] <> #10) and (FSource[FPos] <> #13) do
+    Inc(FPos);
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+procedure TSqlSyntaxHighlighter.ProcessMultiLineComment(var endPos: integer);
+var
+  startPos: integer;
+begin
+  startPos := FPos;
+  Inc(FPos, 2); // Skip the opening /*
+
+  while FPos < Length(FSource) do
+  begin
+    if (FSource[FPos] = '*') and (FSource[FPos + 1] = '/') then
+    begin
+      Inc(FPos, 2);
+      break;
+    end;
+    Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shComment);
+end;
+
+procedure TSqlSyntaxHighlighter.ProcessNumber(var endPos: integer);
+var
+  startPos: integer;
+  hasDecimalPoint: boolean;
+begin
+  startPos := FPos;
+  hasDecimalPoint := False;
+
+  // Handle numbers (including decimals and scientific notation)
+  while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+    Inc(FPos);
+
+  // Handle decimal point
+  if (FPos <= Length(FSource)) and (FSource[FPos] = '.') and not hasDecimalPoint then
+  begin
+    hasDecimalPoint := True;
+    Inc(FPos);
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+      Inc(FPos);
+  end;
+
+  // Handle scientific notation (E or e)
+  if (FPos <= Length(FSource)) and (FSource[FPos] in ['E', 'e']) then
+  begin
+    Inc(FPos);
+    if (FPos <= Length(FSource)) and (FSource[FPos] in ['+', '-']) then
+      Inc(FPos);
+    while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
+      Inc(FPos);
+  end;
+
+  endPos := FPos - 1;
+  AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+end;
+
+function TSqlSyntaxHighlighter.CheckForKeyword(var endPos: integer): boolean;
+var
+  i, j: integer;
+  keyword, ukeyword: string;
+begin
+  Result := False;
+  i := 0;
+
+  while (FPos + i <= Length(FSource)) and (i < MaxKeywordLength) and
+    IsWordChar(FSource[FPos + i]) do
+    Inc(i);
+
+  keyword := Copy(FSource, FPos, i);
+  ukeyword := UpperCase(keyword);
+
+  for j := 0 to MaxKeyword do
+    if SqlKeywordTable[j] = ukeyword then
+    begin
+      Result := True;
+      break;
+    end;
+
+  if Result then
+  begin
+    Inc(FPos, i);
+    endPos := FPos - 1;
+    AddToken(keyword, shKeyword);
+  end;
+end;
+
+function TSqlSyntaxHighlighter.IsWordChar(ch: char): boolean;
+begin
+  Result := ch in ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+end;
+
+function TSqlSyntaxHighlighter.IsHexChar(ch: char): boolean;
+begin
+  Result := ch in ['0'..'9', 'A'..'F', 'a'..'f'];
+end;
+
+class procedure TSqlSyntaxHighlighter.CheckCategories;
+begin
+  if CategorySQL = 0 then
+    RegisterDefaultCategories;
+end;
+
+class procedure TSqlSyntaxHighlighter.RegisterDefaultCategories;
+begin
+  CategorySQL := RegisterCategory('SQL');
+end;
+
+class function TSqlSyntaxHighlighter.GetLanguages: TStringDynarray;
+begin
+  Result := ['sql', 'mysql', 'postgresql', 'sqlite', 'firebird', 'oracle', 'mssql', 'tsql'];
+end;
+
+constructor TSqlSyntaxHighlighter.Create;
+begin
+  inherited Create;
+  CheckCategories;
+  DefaultCategory := CategorySQL;
+  FStringEscapeMode := semDoubled; // Default to standard SQL escaping
+end;
+
+function TSqlSyntaxHighlighter.Execute(const Source: string): TSyntaxTokenArray;
+var
+  lLen, endPos, startPos: integer;
+  ch: char;
+begin
+  Result := Nil;
+  CheckCategories;
+  lLen := Length(Source);
+  if lLen = 0 then
+    Exit;
+  FSource := Source;
+  FTokens.Reset;
+  FPos := 1;
+  EndPos := 0;
+
+  while FPos <= lLen do
+  begin
+    ch := FSource[FPos];
+    case ch of
+    '''':
+      ProcessSingleQuoteString(endPos);
+    '"':
+      ProcessDoubleQuoteString(endPos);
+    '-':
+      begin
+      if (FPos < Length(FSource)) and (FSource[FPos + 1] = '-') then
+        ProcessSingleLineComment(endPos)
+      else
+      begin
+        AddToken('-', shOperator);
+        endPos := FPos;
+        Inc(FPos);
+      end;
+      end;
+    '/':
+      begin
+      if (FPos < Length(FSource)) and (FSource[FPos + 1] = '*') then
+        ProcessMultiLineComment(endPos)
+      else
+      begin
+        AddToken('/', shOperator);
+        endPos := FPos;
+        Inc(FPos);
+      end;
+      end;
+    '0'..'9':
+      ProcessNumber(endPos);
+    '$': // Hexadecimal numbers (some SQL dialects)
+      begin
+      startPos := FPos;
+      Inc(FPos);
+      while (FPos <= Length(FSource)) and IsHexChar(FSource[FPos]) do
+        Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shNumbers);
+      end;
+    'a'..'z', 'A'..'Z', '_':
+      begin
+      if not CheckForKeyword(endPos) then
+      begin
+        startPos := FPos;
+        while (FPos <= Length(FSource)) and IsWordChar(FSource[FPos]) do
+          Inc(FPos);
+        endPos := FPos - 1;
+        AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      end;
+      end;
+    '(', ')', '[', ']', '{', '}', ';', ',':
+      begin
+      AddToken(ch, shSymbol);
+      endPos := FPos;
+      Inc(FPos);
+      end;
+    '=', '<', '>', '!', '+', '*', '%', '&', '|', '^', '~':
+      begin
+      startPos := FPos;
+      // Handle multi-character operators
+      if ch = '<' then
+      begin
+        if (FPos < Length(FSource)) and (FSource[FPos + 1] in ['=', '>', '<']) then
+          Inc(FPos);
+      end
+      else if ch = '>' then
+      begin
+        if (FPos < Length(FSource)) and (FSource[FPos + 1] in ['=', '<']) then
+          Inc(FPos);
+      end
+      else if ch = '!' then
+      begin
+        if (FPos < Length(FSource)) and (FSource[FPos + 1] = '=') then
+          Inc(FPos);
+      end;
+      Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shOperator);
+      end;
+    ' ', #9, #10, #13:
+      begin
+      startPos := FPos;
+      while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9, #10, #13]) do
+        Inc(FPos);
+      endPos := FPos - 1;
+      AddToken(Copy(FSource, startPos, endPos - startPos + 1), shDefault);
+      end;
+    else
+      AddToken(ch, shInvalid);
+      endPos := FPos;
+      Inc(FPos);
+    end;
+    if FPos = endPos then Inc(FPos);
+  end;
+  Result := FTokens.GetTokens;
+end;
+
+function DoSqlHighlighting(const Source: string): TSyntaxTokenArray;
+var
+  highlighter: TSqlSyntaxHighlighter;
+begin
+  highlighter := TSqlSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+function DoSqlHighlighting(const Source: string; EscapeMode: TSqlStringEscapeMode): TSyntaxTokenArray;
+var
+  highlighter: TSqlSyntaxHighlighter;
+begin
+  highlighter := TSqlSyntaxHighlighter.Create;
+  try
+    highlighter.StringEscapeMode := EscapeMode;
+    Result := highlighter.Execute(Source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+initialization
+  TSqlSyntaxHighlighter.Register;
+end.

packages/fcl-syntax/tests/testsyntax.lpi

@@ -0,0 +1,108 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testsyntax"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="FCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="testsyntax.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testpassrc"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.assembler.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.pascal.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.html.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.bash.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.css.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.htmlrender.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.javascript.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.ini.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.sql.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unittest.json.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testsyntax"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-syntax/tests/testsyntax.lpr

@@ -0,0 +1,50 @@
+program testpassrc;
+
+{$mode objfpc}{$H+}
+
+uses
+{$IFDEF UNIX}
+  cwstring,
+{$ENDIF}
+  Classes,
+  syntax.highlighter,
+  syntax.pascal,
+  syntax.bash,
+  syntax.javascript,
+  syntax.html,
+  syntax.css,
+  syntax.ini,
+  syntax.sql,
+  syntax.json,
+  unittest.pascal,
+  unittest.assembler,
+  unittest.bash,
+  unittest.javascript,
+  unittest.css,
+  unittest.html,
+  unittest.ini,
+  unittest.sql,
+  unittest.json,
+  unittest.htmlrender,
+  consoletestrunner;
+
+type
+
+  { TLazTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  Application:=TMyTestRunner.Create(nil);
+  DefaultFormat:=fplain;
+  DefaultRunAllTests:=True;
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.

packages/fcl-syntax/tests/unittest.assembler.pp

@@ -0,0 +1,218 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    pascal embedded assembler highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unittest.assembler;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.pascal;
+
+type
+  TTestAsmHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    flags: Byte;
+  published
+    procedure TestBasicAsmBlock;
+    procedure TestAsmWithInstructions;
+    procedure TestAsmWithRegisters;
+    procedure TestAsmWithComments;
+    procedure TestAsmWithDirectives;
+    procedure TestAsmMultiline;
+    procedure TestEmptyAsm;
+  end;
+
+implementation
+
+procedure TTestAsmHighlighter.SetUp;
+begin
+  flags := 0;
+end;
+
+procedure TTestAsmHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+procedure TTestAsmHighlighter.TestBasicAsmBlock;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting( 'asm end');
+  AssertTrue('Should have at least 2 tokens', Length(tokens) >= 2);
+  AssertEquals('First token should be ASM', 'asm', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  AssertEquals('Last token should be END', 'END', tokens[High(tokens)].Text);
+  AssertEquals('Last token should be keyword', Ord(shKeyword), Ord(tokens[High(tokens)].Kind));
+end;
+
+procedure TTestAsmHighlighter.TestAsmWithInstructions;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundAsmToken: Boolean;
+begin
+  tokens := DoPascalHighlighting( 'asm mov eax, ebx end');
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 3);
+
+  // First token should be ASM keyword
+  AssertEquals('First token should be ASM', 'asm', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+  // Should have assembler content between asm and end
+  foundAsmToken := False;
+  for i := 1 to Length(tokens) - 2 do
+    begin
+    if tokens[i].Kind = shAssembler then
+      begin
+      foundAsmToken := True;
+      break;
+      end;
+    end;
+  AssertTrue('Should contain assembler tokens', foundAsmToken);
+
+  // Last token should be END keyword
+  AssertEquals('Last token should be END', 'END', tokens[High(tokens)].Text);
+  AssertEquals('Last token should be keyword', Ord(shKeyword), Ord(tokens[High(tokens)].Kind));
+end;
+
+procedure TTestAsmHighlighter.TestAsmWithRegisters;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundAsmToken: Boolean;
+begin
+  tokens := DoPascalHighlighting( 'asm push eax; pop ebx; end');
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 3);
+
+  // Should have assembler content
+  foundAsmToken := False;
+  for i := 1 to Length(tokens) - 2 do
+    begin
+    if tokens[i].Kind = shAssembler then
+      begin
+      foundAsmToken := True;
+      break;
+      end;
+    end;
+  AssertTrue('Should contain assembler tokens with registers', foundAsmToken);
+end;
+
+procedure TTestAsmHighlighter.TestAsmWithComments;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundComment: Boolean;
+begin
+  tokens := DoPascalHighlighting( 'asm { comment } mov eax, ebx end');
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 3);
+
+  // Should have a comment token
+  foundComment := False;
+  for i := 0 to High(tokens) do
+    begin
+    if tokens[i].Kind = shComment then
+      begin
+      foundComment := True;
+      AssertEquals('Comment should include braces', '{ comment }', tokens[i].Text);
+      break;
+      end;
+    end;
+  AssertTrue('Should contain comment token', foundComment);
+end;
+
+procedure TTestAsmHighlighter.TestAsmWithDirectives;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundDirective: Boolean;
+begin
+  tokens := DoPascalHighlighting( 'asm {$ASMMODE INTEL} mov eax, ebx end');
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 3);
+
+  // Should have a directive token
+  foundDirective := False;
+  for i := 0 to High(tokens) do
+    begin
+    if tokens[i].Kind = shDirective then
+      begin
+      foundDirective := True;
+      AssertEquals('Directive should include braces', '{$ASMMODE INTEL}', tokens[i].Text);
+      break;
+      end;
+    end;
+  AssertTrue('Should contain directive token', foundDirective);
+end;
+
+procedure TTestAsmHighlighter.TestAsmMultiline;
+var
+  tokens: TSyntaxTokenArray;
+  source: String;
+  i: Integer;
+  foundAsmToken: Boolean;
+begin
+  source := 'asm' + #13#10 + '  mov eax, ebx' + #13#10 + '  add eax, 1' + #13#10 + 'end';
+  tokens := DoPascalHighlighting( source);
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 3);
+
+  // First token should be ASM keyword
+  AssertEquals('First token should be ASM', 'asm', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+  // Should have assembler content
+  foundAsmToken := False;
+  for i := 1 to Length(tokens) - 2 do
+    begin
+    if tokens[i].Kind = shAssembler then
+      begin
+      foundAsmToken := True;
+      break;
+      end;
+    end;
+  AssertTrue('Should contain assembler tokens in multiline', foundAsmToken);
+
+  // Last token should be END keyword
+  AssertEquals('Last token should be END', 'END', tokens[High(tokens)].Text);
+  AssertEquals('Last token should be keyword', Ord(shKeyword), Ord(tokens[High(tokens)].Kind));
+end;
+
+procedure TTestAsmHighlighter.TestEmptyAsm;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting( 'asm'#13#10'end');
+  AssertTrue('Should have at least 3 tokens', Length(tokens) >= 3);
+
+  // First token should be ASM keyword
+  AssertEquals('First token should be ASM', 'asm', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+  // Should have assembler token (whitespace is treated as assembler inside asm block)
+  AssertEquals('Second token should be whitespace', #13#10, tokens[1].Text);
+  AssertEquals('Second token should be assembler', Ord(shAssembler), Ord(tokens[1].Kind));
+
+  // Last token should be END keyword
+  AssertEquals('Last token should be END', 'END', tokens[High(tokens)].Text);
+  AssertEquals('Last token should be keyword', Ord(shKeyword), Ord(tokens[High(tokens)].Kind));
+end;
+
+initialization
+  RegisterTest(TTestAsmHighlighter);
+end.

packages/fcl-syntax/tests/unittest.bash.pp

@@ -0,0 +1,283 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Bash highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit unittest.bash;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.bash;
+
+type
+  TTestBashHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoBashHighlighting(const source: string): TSyntaxTokenArray;
+  published
+    procedure TestBashKeywords;
+    procedure TestNonKeywordCommands;
+    procedure TestBashStrings;
+    procedure TestBashComments;
+    procedure TestBashVariables;
+    procedure TestBashNumbers;
+    procedure TestBashOperators;
+    procedure TestBashCommandSubstitution;
+    procedure TestBashSymbols;
+    procedure TestComplexBashScript;
+    procedure TestBashStringTypes;
+  end;
+
+implementation
+
+procedure TTestBashHighlighter.SetUp;
+begin
+
+end;
+
+procedure TTestBashHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestBashHighlighter.DoBashHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: TBashSyntaxHighlighter;
+begin
+  highlighter := TBashSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestBashHighlighter.TestBashKeywords;
+const
+  Keywords: array[0..18] of string = (
+    'if', 'then', 'else', 'fi', 'case', 'esac', 'for', 'do', 'done', 'while',
+    'function', 'return', 'break', 'continue', 'declare', 'local', 'export', 'set', 'eval'
+  );
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(Keywords) do
+    begin
+    tokens := DoBashHighlighting(Keywords[i]);
+    AssertEquals('Should have 1 token for ' + Keywords[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + Keywords[i], Keywords[i], tokens[0].Text);
+    AssertEquals(Keywords[i] + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+    end;
+end;
+
+procedure TTestBashHighlighter.TestNonKeywordCommands;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // 'test' is not recognized as a keyword in the bash highlighter
+  tokens := DoBashHighlighting('test');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be test', 'test', tokens[0].Text);
+  AssertEquals('test should be default (not keyword)', Ord(shDefault), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashStrings;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test single-quoted string
+  tokens := DoBashHighlighting('''hello world''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be single-quoted string', '''hello world''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test double-quoted string (may have variable expansion)
+  tokens := DoBashHighlighting('"hello $USER"');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  AssertEquals('First token should be string type', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test simple double-quoted string
+  tokens := DoBashHighlighting('"hello world"');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be double-quoted string', '"hello world"', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashComments;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoBashHighlighting('# This is a comment');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be comment', '# This is a comment', tokens[0].Text);
+  AssertEquals('Token should be comment type', Ord(shComment), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashVariables;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoBashHighlighting('$USER');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be variable', '$USER', tokens[0].Text);
+  AssertEquals('Token should be default type', Ord(shDefault), Ord(tokens[0].Kind));
+
+  // Test variable in braces
+  tokens := DoBashHighlighting('${HOME}');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be braced variable', '${HOME}', tokens[0].Text);
+  AssertEquals('Token should be default type', Ord(shDefault), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashNumbers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoBashHighlighting('123');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be number', '123', tokens[0].Text);
+  AssertEquals('Token should be number type', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test floating point
+  tokens := DoBashHighlighting('3.14');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  // First token should be the integer part
+  AssertEquals('First token should be number type', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashOperators;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoBashHighlighting('==');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be equality operator', '==', tokens[0].Text);
+  AssertEquals('Token should be operator type', Ord(shOperator), Ord(tokens[0].Kind));
+
+  tokens := DoBashHighlighting('!=');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be inequality operator', '!=', tokens[0].Text);
+  AssertEquals('Token should be operator type', Ord(shOperator), Ord(tokens[0].Kind));
+
+  tokens := DoBashHighlighting('&&');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be logical AND', '&&', tokens[0].Text);
+  AssertEquals('Token should be operator type', Ord(shOperator), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashCommandSubstitution;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoBashHighlighting('`date`');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be command substitution', '`date`', tokens[0].Text);
+  AssertEquals('Token should be interpolation type', Ord(shInterpolation), Ord(tokens[0].Kind));
+
+  // Test $(command) syntax
+  tokens := DoBashHighlighting('$(whoami)');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  // Should contain interpolation tokens
+end;
+
+procedure TTestBashHighlighter.TestBashSymbols;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoBashHighlighting('[');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be opening bracket', '[', tokens[0].Text);
+  AssertEquals('Token should be symbol type', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  tokens := DoBashHighlighting(';');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be semicolon', ';', tokens[0].Text);
+  AssertEquals('Token should be symbol type', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  tokens := DoBashHighlighting('|');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be pipe', '|', tokens[0].Text);
+  AssertEquals('Token should be operator type', Ord(shOperator), Ord(tokens[0].Kind));
+end;
+
+procedure TTestBashHighlighter.TestComplexBashScript;
+var
+  tokens: TSyntaxTokenArray;
+  script: string;
+  i: Integer;
+  hasKeywords, hasStrings, hasOperators, hasSymbols: Boolean;
+begin
+  script := 'if [ "$USER" == "root" ]; then echo "Admin user"; fi';
+  tokens := DoBashHighlighting(script);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 10);
+
+  // Check that we have different token types
+  hasKeywords := False;
+  hasStrings := False;
+  hasOperators := False;
+  hasSymbols := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    case tokens[i].Kind of
+      shKeyword: hasKeywords := True;
+      shStrings: hasStrings := True;
+      shOperator: hasOperators := True;
+      shSymbol: hasSymbols := True;
+    end;
+    end;
+
+  AssertTrue('Should contain keyword tokens', hasKeywords);
+  AssertTrue('Should contain string tokens', hasStrings);
+  AssertTrue('Should contain operator tokens', hasOperators);
+  AssertTrue('Should contain symbol tokens', hasSymbols);
+
+  // First token should be 'if' keyword
+  AssertEquals('First token should be if', 'if', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+  // Last token should be 'fi' keyword
+  AssertEquals('Last token should be fi', 'fi', tokens[High(tokens)].Text);
+  AssertEquals('Last token should be keyword', Ord(shKeyword), Ord(tokens[High(tokens)].Kind));
+end;
+
+procedure TTestBashHighlighter.TestBashStringTypes;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test heredoc-style strings or other bash string features
+  tokens := DoBashHighlighting('echo "test"');
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 3);
+
+  // Should have echo as default (command), space as default, and "test" as string
+  AssertEquals('First token should be echo', 'echo', tokens[0].Text);
+  AssertEquals('First token should be default', Ord(shDefault), Ord(tokens[0].Kind));
+
+  AssertEquals('Second token should be space', ' ', tokens[1].Text);
+  AssertEquals('Second token should be default', Ord(shDefault), Ord(tokens[1].Kind));
+
+  AssertEquals('Third token should be quoted string', '"test"', tokens[2].Text);
+  AssertEquals('Third token should be string', Ord(shStrings), Ord(tokens[2].Kind));
+end;
+
+initialization
+  RegisterTest(TTestBashHighlighter);
+end.

packages/fcl-syntax/tests/unittest.css.pp

@@ -0,0 +1,385 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    CSS highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unittest.css;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.css;
+
+type
+  TTestCssHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoCssHighlighting(const source: string): TSyntaxTokenArray;
+  published
+    procedure TestCssAtRules;
+    procedure TestCssProperties;
+    procedure TestCssStrings;
+    procedure TestCssNumbers;
+    procedure TestCssColors;
+    procedure TestCssComments;
+    procedure TestCssSelectors;
+    procedure TestCssSymbols;
+    procedure TestCssUrls;
+    procedure TestComplexCssRule;
+    procedure TestCssMediaQuery;
+    procedure TestCssUnits;
+  end;
+
+implementation
+
+procedure TTestCssHighlighter.SetUp;
+begin
+end;
+
+procedure TTestCssHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestCssHighlighter.DoCssHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: TCssSyntaxHighlighter;
+begin
+  highlighter := TCssSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestCssHighlighter.TestCssAtRules;
+const
+  AtRules: array[0..9] of string = (
+    '@charset', '@import', '@media', '@keyframes', '@font-face',
+    '@supports', '@page', '@namespace', '@viewport', '@layer'
+  );
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(AtRules) do
+    begin
+    tokens := DoCssHighlighting(AtRules[i]);
+    AssertEquals('Should have 1 token for ' + AtRules[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + AtRules[i], AtRules[i], tokens[0].Text);
+    AssertEquals(AtRules[i] + ' should be directive', Ord(shDirective), Ord(tokens[0].Kind));
+    end;
+end;
+
+procedure TTestCssHighlighter.TestCssProperties;
+const
+  Properties: array[0..9] of string = (
+    'color', 'background', 'margin', 'padding', 'border',
+    'font', 'width', 'height', 'position', 'display'
+  );
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(Properties) do
+    begin
+    tokens := DoCssHighlighting(Properties[i]);
+    AssertEquals('Should have 1 token for ' + Properties[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + Properties[i], Properties[i], tokens[0].Text);
+    AssertEquals(Properties[i] + ' should be keyword (property)', Ord(shKeyword), Ord(tokens[0].Kind));
+    end;
+end;
+
+procedure TTestCssHighlighter.TestCssStrings;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test single-quoted string
+  tokens := DoCssHighlighting('''Arial''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be single-quoted string', '''Arial''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test double-quoted string
+  tokens := DoCssHighlighting('"Helvetica"');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be double-quoted string', '"Helvetica"', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test string with escapes
+  tokens := DoCssHighlighting('"Font with \"quotes\""');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped string', '"Font with \"quotes\""', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+end;
+
+procedure TTestCssHighlighter.TestCssNumbers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test percentage
+  tokens := DoCssHighlighting('100%');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be percentage', '100%', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test number with px unit
+  tokens := DoCssHighlighting('16px');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be pixel value', '16px', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test decimal number
+  tokens := DoCssHighlighting('1.5em');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be em value', '1.5em', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test zero value
+  tokens := DoCssHighlighting('0');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be zero', '0', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestCssHighlighter.TestCssColors;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test 6-digit hex color
+  tokens := DoCssHighlighting('#FF0000');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be hex color', '#FF0000', tokens[0].Text);
+  AssertEquals('Token should be number (color)', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test 3-digit hex color
+  tokens := DoCssHighlighting('#F00');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be 3-digit hex color', '#F00', tokens[0].Text);
+  AssertEquals('Token should be number (color)', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test lowercase hex color
+  tokens := DoCssHighlighting('#ff0000');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be lowercase hex color', '#ff0000', tokens[0].Text);
+  AssertEquals('Token should be number (color)', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestCssHighlighter.TestCssComments;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test multi-line comment
+  tokens := DoCssHighlighting('/* This is a comment */');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be multi-line comment', '/* This is a comment */', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+
+  // Test multi-line comment with newlines
+  tokens := DoCssHighlighting('/* Line 1' + #10 + 'Line 2 */');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be multi-line comment with newlines', '/* Line 1' + #10 + 'Line 2 */', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+
+  // Test comment with CSS inside
+  tokens := DoCssHighlighting('/* color: red; */');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be comment with CSS', '/* color: red; */', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+end;
+
+procedure TTestCssHighlighter.TestCssSelectors;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test class selector
+  tokens := DoCssHighlighting('.myClass');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be class selector', '.myClass', tokens[0].Text);
+  AssertEquals('Token should be default (selector)', Ord(shDefault), Ord(tokens[0].Kind));
+
+  // Test element selector
+  tokens := DoCssHighlighting('div');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be element selector', 'div', tokens[0].Text);
+  AssertEquals('Token should be default (selector)', Ord(shDefault), Ord(tokens[0].Kind));
+
+  // Test pseudo-class
+  tokens := DoCssHighlighting(':hover');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  // First part should be the colon or the complete pseudo-class
+end;
+
+procedure TTestCssHighlighter.TestCssSymbols;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test opening brace
+  tokens := DoCssHighlighting('{');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be opening brace', '{', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test closing brace
+  tokens := DoCssHighlighting('}');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be closing brace', '}', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test semicolon
+  tokens := DoCssHighlighting(';');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be semicolon', ';', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test colon
+  tokens := DoCssHighlighting(':');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be colon', ':', tokens[0].Text);
+  AssertEquals('Token should be default', Ord(shDefault), Ord(tokens[0].Kind));
+end;
+
+procedure TTestCssHighlighter.TestCssUrls;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test URL function
+  tokens := DoCssHighlighting('url(image.png)');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be URL function', 'url(image.png)', tokens[0].Text);
+  AssertEquals('Token should be string (URL)', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test URL with quotes
+  tokens := DoCssHighlighting('url("image.png")');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  // Should be tokenized as URL function
+end;
+
+procedure TTestCssHighlighter.TestComplexCssRule;
+var
+  tokens: TSyntaxTokenArray;
+  cssRule: string;
+  i: Integer;
+  hasSelectors, hasProperties, hasSymbols, hasValues: Boolean;
+begin
+  cssRule := '.container { width: 100%; color: #333; }';
+  tokens := DoCssHighlighting(cssRule);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 5);
+
+  // Check that we have different token types
+  hasSelectors := False;
+  hasProperties := False;
+  hasSymbols := False;
+  hasValues := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    case tokens[i].Kind of
+      shDefault: hasSelectors := True;
+      shKeyword: hasProperties := True;
+      shSymbol: hasSymbols := True;
+      shNumbers: hasValues := True;
+    end;
+    end;
+
+  AssertTrue('Should contain selector tokens', hasSelectors);
+  AssertTrue('Should contain property tokens', hasProperties);
+  AssertTrue('Should contain symbol tokens', hasSymbols);
+  AssertTrue('Should contain value tokens', hasValues);
+
+  // First token should be the selector
+  AssertEquals('First token should be .container', '.container', tokens[0].Text);
+  AssertEquals('First token should be default (selector)', Ord(shDefault), Ord(tokens[0].Kind));
+
+  // Should contain braces
+  for i := 0 to High(tokens) do
+    begin
+    if tokens[i].Text = '{' then
+      begin
+      AssertEquals('Opening brace should be symbol', Ord(shSymbol), Ord(tokens[i].Kind));
+      Break;
+      end;
+    end;
+end;
+
+procedure TTestCssHighlighter.TestCssMediaQuery;
+var
+  tokens: TSyntaxTokenArray;
+  mediaQuery: string;
+  i: Integer;
+  HasProperties,hasDirective, hasSelectors: Boolean;
+begin
+  mediaQuery := '@media (max-width: 768px) { body { font-size: 14px; } }';
+  tokens := DoCssHighlighting(mediaQuery);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 10);
+
+  // Check that we have different token types
+  hasDirective := False;
+  hasSelectors := False;
+  hasProperties := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    case tokens[i].Kind of
+      shDirective: hasDirective := True;
+      shDefault: hasSelectors := True;
+      shKeyword: hasProperties := True;
+    end;
+    end;
+
+  AssertTrue('Should contain directive tokens', hasDirective);
+  AssertTrue('Should contain selector tokens', hasSelectors);
+  // Note: Properties inside media queries may not be recognized as keywords
+  // depending on the CSS highlighter's context-sensitivity implementation
+
+  // First token should be @media directive
+  AssertEquals('First token should be @media', '@media', tokens[0].Text);
+  AssertEquals('First token should be directive', Ord(shDirective), Ord(tokens[0].Kind));
+end;
+
+procedure TTestCssHighlighter.TestCssUnits;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test various CSS units
+  tokens := DoCssHighlighting('10rem');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be rem value', '10rem', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  tokens := DoCssHighlighting('2vh');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be vh value', '2vh', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  tokens := DoCssHighlighting('50vw');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be vw value', '50vw', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  tokens := DoCssHighlighting('1.2fr');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be fr value', '1.2fr', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+initialization
+  RegisterTest(TTestCssHighlighter);
+end.

packages/fcl-syntax/tests/unittest.html.pp

@@ -0,0 +1,363 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    HTML highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit unittest.html;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.html;
+
+type
+  TTestHtmlHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoHtmlHighlighting(const source: string): TSyntaxTokenArray;
+  published
+    procedure TestHtmlBasicTags;
+    procedure TestHtmlAttributes;
+    procedure TestHtmlComments;
+    procedure TestHtmlEntities;
+    procedure TestHtmlEmbeddedCSS;
+    procedure TestHtmlEmbeddedJavaScript;
+    procedure TestHtmlDoctype;
+    procedure TestHtmlSelfClosingTags;
+    procedure TestHtmlNestedTags;
+    procedure TestComplexHtmlDocument;
+    procedure TestHtmlCDATA;
+    procedure TestCategorySystem;
+  end;
+
+implementation
+
+procedure TTestHtmlHighlighter.SetUp;
+begin
+
+end;
+
+procedure TTestHtmlHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestHtmlHighlighter.DoHtmlHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: THtmlSyntaxHighlighter;
+begin
+  highlighter := THtmlSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlBasicTags;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple div tag
+  tokens := DoHtmlHighlighting('<div>');
+  AssertTrue('Should have at least 3 tokens', Length(tokens) >= 3);
+  AssertEquals('First token should be opening bracket', '<', tokens[0].Text);
+  AssertEquals('Opening bracket should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+  AssertEquals('Tag name should be div', 'div', tokens[1].Text);
+  AssertEquals('Tag name should be keyword', Ord(shKeyword), Ord(tokens[1].Kind));
+  AssertEquals('Closing bracket should be >', '>', tokens[2].Text);
+  AssertEquals('Closing bracket should be symbol', Ord(shSymbol), Ord(tokens[2].Kind));
+
+  // Test closing tag
+  tokens := DoHtmlHighlighting('</div>');
+  AssertTrue('Should have at least 3 tokens', Length(tokens) >= 3);
+  AssertEquals('First token should be opening bracket with slash', '</', tokens[0].Text);
+  AssertEquals('Tag name should be div', 'div', tokens[1].Text);
+  AssertEquals('Closing bracket should be >', '>', tokens[2].Text);
+
+  // Test self-closing tag
+  tokens := DoHtmlHighlighting('<br/>');
+  AssertTrue('Should have at least 4 tokens', Length(tokens) >= 4);
+  AssertEquals('First token should be <', '<', tokens[0].Text);
+  AssertEquals('Tag name should be br', 'br', tokens[1].Text);
+  AssertEquals('Slash should be symbol', Ord(shSymbol), Ord(tokens[2].Kind));
+  AssertEquals('Closing bracket should be >', '>', tokens[3].Text);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlAttributes;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  hasAttribute, hasValue: Boolean;
+begin
+  tokens := DoHtmlHighlighting('<div class="container">');
+  AssertTrue('Should have multiple tokens', Length(tokens) > 5);
+
+  hasAttribute := False;
+  hasValue := False;
+  for i := 0 to High(tokens) do
+    begin
+    if tokens[i].Text = 'class' then
+      hasAttribute := True;
+    if tokens[i].Text = '"container"' then
+      hasValue := True;
+    end;
+
+  AssertTrue('Should contain class attribute', hasAttribute);
+  AssertTrue('Should contain attribute value', hasValue);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlComments;
+var
+  tokens: TSyntaxTokenArray;
+  foundComment: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<!-- This is a comment -->');
+  foundComment := False;
+
+  for i := 0 to High(tokens) do
+    if (tokens[i].Kind = shComment) or (tokens[i].Kind = shSymbol) then
+      foundComment := True;
+
+  AssertTrue('Should contain comment tokens', foundComment);
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 1);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlEntities;
+var
+  tokens: TSyntaxTokenArray;
+  foundEntity: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('&amp;');
+  foundEntity := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    if (tokens[i].Text = '&amp;') and (tokens[i].Kind = shEscape) then
+      foundEntity := True;
+    end;
+
+  AssertTrue('Should recognize HTML entity', foundEntity);
+
+  // Test numeric entity
+  tokens := DoHtmlHighlighting('&#123;');
+  foundEntity := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    if (tokens[i].Text = '&#123;') and (tokens[i].Kind = shEscape) then
+      foundEntity := True;
+    end;
+
+  AssertTrue('Should recognize numeric HTML entity', foundEntity);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlEmbeddedCSS;
+var
+  tokens: TSyntaxTokenArray;
+  lToken : TSyntaxToken;
+  hasStyleTag, hasCSS: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<style>body { color: red; }</style>');
+  hasStyleTag := False;
+  hasCSS := False;
+
+  for i := 0 to High(tokens) do
+  begin
+    lToken:=tokens[i];
+    if (lToken.Text = 'style') and (lToken.Kind = shKeyword) then
+      hasStyleTag := True;
+    if (lToken.CategoryCount> 0) and (lToken.Text = 'body') then
+      hasCSS := True;
+  end;
+
+  AssertTrue('Should contain style tag', hasStyleTag);
+  AssertTrue('Should have multiple tokens', Length(tokens) > 5);
+  AssertTrue('Should have CSS', hasCSS);
+  // Note: CSS parsing depends on embedded highlighter
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlEmbeddedJavaScript;
+var
+  tokens: TSyntaxTokenArray;
+  hasScriptTag: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<script>var x = 5;</script>');
+  hasScriptTag := False;
+
+  for i := 0 to High(tokens) do
+    if (tokens[i].Text = 'script') and (tokens[i].Kind = shKeyword) then
+      hasScriptTag := True;
+
+  AssertTrue('Should contain script tag', hasScriptTag);
+  AssertTrue('Should have multiple tokens', Length(tokens) > 5);
+  // Note: JavaScript parsing depends on embedded highlighter
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlDoctype;
+var
+  tokens: TSyntaxTokenArray;
+  foundDoctype: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<!DOCTYPE html>');
+  foundDoctype := False;
+
+  for i := 0 to High(tokens) do
+    if (tokens[i].Kind = shDirective) and (Pos('DOCTYPE', tokens[i].Text) > 0) then
+      foundDoctype := True;
+
+  AssertTrue('Should recognize DOCTYPE as directive', foundDoctype);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlSelfClosingTags;
+var
+  tokens: TSyntaxTokenArray;
+  hasImg, hasSlash: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<img src="test.jpg" />');
+  hasImg := False;
+  hasSlash := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    if (tokens[i].Text = 'img') and (tokens[i].Kind = shKeyword) then
+      hasImg := True;
+    if (tokens[i].Text = '/') and (tokens[i].Kind = shSymbol) then
+      hasSlash := True;
+    end;
+
+  AssertTrue('Should contain img tag', hasImg);
+  AssertTrue('Should contain closing slash', hasSlash);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlNestedTags;
+var
+  tokens: TSyntaxTokenArray;
+  tagCount: Integer;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<div><p>Hello</p></div>');
+  tagCount := 0;
+
+  for i := 0 to High(tokens) do
+    begin
+    if tokens[i].Kind = shKeyword then
+      Inc(tagCount);
+    end;
+
+  AssertTrue('Should contain multiple tags', tagCount >= 4); // div, p, p, div
+  AssertTrue('Should have many tokens', Length(tokens) > 10);
+end;
+
+procedure TTestHtmlHighlighter.TestComplexHtmlDocument;
+var
+  tokens: TSyntaxTokenArray;
+  document: string;
+  hasHtml, hasHead, hasBody, hasTitle: Boolean;
+  i: Integer;
+begin
+  document := '<html><head><title>Test</title></head><body><h1>Hello</h1></body></html>';
+  tokens := DoHtmlHighlighting(document);
+
+  hasHtml := False;
+  hasHead := False;
+  hasBody := False;
+  hasTitle := False;
+
+  for i := 0 to High(tokens) do
+    begin
+    if (tokens[i].Text = 'html') and (tokens[i].Kind = shKeyword) then
+      hasHtml := True;
+    if (tokens[i].Text = 'head') and (tokens[i].Kind = shKeyword) then
+      hasHead := True;
+    if (tokens[i].Text = 'body') and (tokens[i].Kind = shKeyword) then
+      hasBody := True;
+    if (tokens[i].Text = 'title') and (tokens[i].Kind = shKeyword) then
+      hasTitle := True;
+    end;
+
+  AssertTrue('Should contain html tag', hasHtml);
+  AssertTrue('Should contain head tag', hasHead);
+  AssertTrue('Should contain body tag', hasBody);
+  AssertTrue('Should contain title tag', hasTitle);
+  AssertTrue('Should have many tokens for complex document', Length(tokens) > 20);
+end;
+
+procedure TTestHtmlHighlighter.TestHtmlCDATA;
+var
+  tokens: TSyntaxTokenArray;
+  foundCDATA: Boolean;
+  i: Integer;
+begin
+  tokens := DoHtmlHighlighting('<![CDATA[Some data here]]>');
+  foundCDATA := False;
+
+  for i := 0 to High(tokens) do
+    if (tokens[i].Kind = shRawString) or
+       ((tokens[i].Kind = shSymbol) and (tokens[i].Text = '<![CDATA[')) then
+      foundCDATA := True;
+
+  AssertTrue('Should recognize CDATA section', foundCDATA);
+end;
+
+procedure TTestHtmlHighlighter.TestCategorySystem;
+var
+  tokens: TSyntaxTokenArray;
+  htmlCategoryFound, cssCategoryFound, jsCategoryFound: Boolean;
+  lCat,i: Integer;
+begin
+  // Test basic HTML category
+  tokens := DoHtmlHighlighting('<div>text</div>');
+  htmlCategoryFound := False;
+
+  for i := 0 to High(tokens) do
+    if tokens[i].HasCategory(THtmlSyntaxHighlighter.CategoryHTML) then
+      htmlCategoryFound := True;
+
+  AssertTrue('Should have HTML category tokens', htmlCategoryFound);
+
+  // Test embedded CSS category
+  tokens := DoHtmlHighlighting('<style>body { color: red; }</style>');
+  cssCategoryFound := False;
+  lCat:=TSyntaxHighLighter.GetRegisteredCategoryID('EmbeddedCSS');
+  for i := 0 to High(tokens) do
+    if tokens[i].HasCategory(lCat) then
+      cssCategoryFound := True;
+
+  AssertTrue('Should have category tokens for CSS', cssCategoryFound);
+
+  // Test embedded JavaScript category
+  tokens := DoHtmlHighlighting('<script>var x = 5;</script>');
+  jsCategoryFound := False;
+  lCat:=TSyntaxHighlighter.GetRegisteredCategoryID('EmbeddedJS');
+  for i := 0 to High(tokens) do
+    if tokens[i].HasCategory(lCat) then
+      jsCategoryFound := True;
+
+  AssertTrue('Should have category tokens for JavaScript', jsCategoryFound);
+end;
+
+initialization
+  RegisterTest(TTestHtmlHighlighter);
+end.

packages/fcl-syntax/tests/unittest.htmlrender.pp

@@ -0,0 +1,607 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    HTML renderer unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit unittest.htmlrender;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.javascript, syntax.css, syntax.html,
+  syntax.htmlrender;
+
+type
+  TTestHtmlRenderer = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    renderer: THtmlSyntaxRenderer;
+    function RenderToString(const tokens: TSyntaxTokenArray): string;
+    function RenderToStringList(const tokens: TSyntaxTokenArray): TStringList;
+  published
+    procedure TestJavaScriptRendering;
+    procedure TestCssRendering;
+    procedure TestHtmlRendering;
+    procedure TestEmbeddedHtmlRendering;
+    procedure TestStringOutput;
+    procedure TestSpecialCharacterEscaping;
+    procedure TestEmptyTokenArray;
+    procedure TestClassNameGeneration;
+    procedure TestCategoryMapping;
+    procedure TestHtmlEscaping;
+    procedure TestTokensWithoutCategory;
+    procedure TestComplexJavaScript;
+    procedure TestNoDefaultSpanOption;
+    procedure TestMultilineRendering;
+    procedure TestPreserveLineStructureOption;
+    procedure TestExtraClassesProperty;
+  end;
+
+implementation
+
+procedure TTestHtmlRenderer.SetUp;
+begin
+  renderer := THtmlSyntaxRenderer.Create;
+end;
+
+procedure TTestHtmlRenderer.TearDown;
+begin
+  renderer.Free;
+end;
+
+function TTestHtmlRenderer.RenderToString(const tokens: TSyntaxTokenArray): string;
+begin
+  Result:='';
+  renderer.RenderTokensToString(tokens, Result);
+end;
+
+function TTestHtmlRenderer.RenderToStringList(const tokens: TSyntaxTokenArray): TStringList;
+begin
+  Result := TStringList.Create;
+  renderer.RenderTokens(tokens, Result);
+end;
+
+procedure TTestHtmlRenderer.TestJavaScriptRendering;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'function test() { return "hello"; }');
+    output := RenderToString(tokens);
+
+    // Check for essential elements
+    AssertTrue('Should contain function keyword', Pos('<span class="keyword keyword-javascript">function</span>', output) > 0);
+    AssertTrue('Should contain string literal', Pos('<span class="strings strings-javascript">&quot;hello&quot;</span>', output) > 0);
+    AssertTrue('Should contain return keyword', Pos('<span class="keyword keyword-javascript">return</span>', output) > 0);
+    AssertTrue('Should contain symbols', Pos('<span class="symbol symbol-javascript">', output) > 0);
+
+  finally
+    jsHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestCssRendering;
+var
+  cssHighlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  cssHighlighter := TCssSyntaxHighlighter.Create;
+  try
+    tokens := cssHighlighter.Execute( 'body { color: #FF0000; font-size: 16px; }');
+    output := RenderToString(tokens);
+
+    // Check for essential CSS elements
+    AssertTrue('Should contain color property', Pos('<span class="keyword keyword-css">color</span>', output) > 0);
+    AssertTrue('Should contain hex color', Pos('<span class="numbers numbers-css">#FF0000</span>', output) > 0);
+    AssertTrue('Should contain pixel value', Pos('<span class="numbers numbers-css">16px</span>', output) > 0);
+    AssertTrue('Should contain CSS symbols', Pos('<span class="symbol symbol-css">{</span>', output) > 0);
+
+  finally
+    cssHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestHtmlRendering;
+var
+  htmlHighlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  htmlHighlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := htmlHighlighter.Execute( '<div class="container">&lt;Hello&gt;</div>');
+    output := RenderToString(tokens);
+
+    // Check for essential HTML elements
+    AssertTrue('Should contain div keyword', Pos('<span class="keyword keyword-html">div</span>', output) > 0);
+    AssertTrue('Should contain class attribute', Pos('<span class="default default-html default-htmlattribute">class</span>', output) > 0);
+    AssertTrue('Should contain string value', Pos('<span class="strings strings-html">&quot;container&quot;</span>', output) > 0);
+    AssertTrue('Should contain HTML symbols', Pos('<span class="symbol symbol-html">&lt;</span>', output) > 0);
+    AssertTrue('Should contain escaped entities', Pos('<span class="escape escape-html">&amp;lt;</span>', output) > 0);
+
+  finally
+    htmlHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestEmbeddedHtmlRendering;
+var
+  htmlHighlighter: THtmlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  htmlHighlighter := THtmlSyntaxHighlighter.Create;
+  try
+    tokens := htmlHighlighter.Execute( '<style>body { color: red; }</style><script>alert("test");</script>');
+    output := RenderToString(tokens);
+
+    // Check for embedded CSS
+    // Writeln('output ',output);
+    AssertTrue('Should contain CSS color property', Pos('<span class="keyword keyword-embeddedcss">color</span>', output) > 0);
+    AssertTrue('Should contain CSS category', Pos('embeddedcss', output) > 0);
+
+    // Check for embedded JavaScript
+    AssertTrue('Should contain JS alert function', Pos('<span class="default default-embeddedjs">alert</span>', output) > 0);
+    AssertTrue('Should contain JS category', Pos('embeddedjs', output) > 0);
+
+    // Check for HTML tags
+    AssertTrue('Should contain style tag', Pos('<span class="keyword keyword-html">style</span>', output) > 0);
+    AssertTrue('Should contain script tag', Pos('<span class="keyword keyword-html">script</span>', output) > 0);
+
+  finally
+    htmlHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestStringOutput;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'var x = 42;');
+    output := RenderToString(tokens);
+
+    // Should be single continuous string without line breaks
+    AssertTrue('Should not contain line breaks', Pos(#10, output) = 0);
+    AssertTrue('Should not contain line breaks', Pos(#13, output) = 0);
+
+    // Should contain all expected elements in sequence
+    AssertTrue('Should contain var keyword', Pos('<span class="keyword keyword-javascript">var</span>', output) > 0);
+    AssertTrue('Should contain number', Pos('<span class="numbers numbers-javascript">42</span>', output) > 0);
+    AssertTrue('Should contain operator', Pos('<span class="operator operator-javascript">=</span>', output) > 0);
+
+  finally
+    jsHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestSpecialCharacterEscaping;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'var html = "<div>\"Hello & Welcome\"</div>";');
+    output := RenderToString(tokens);
+
+    // Check that special characters are properly escaped
+    AssertTrue('Should escape < character', Pos('&lt;', output) > 0);
+    AssertTrue('Should escape > character', Pos('&gt;', output) > 0);
+    AssertTrue('Should escape & character', Pos('&amp;', output) > 0);
+    AssertTrue('Should escape " character', Pos('&quot;', output) > 0);
+
+    // Should not contain unescaped special characters in content
+    AssertFalse('Should not contain raw < in content', Pos('>"<', output) > 0);
+    AssertFalse('Should not contain raw > in content', Pos('>>', output) > 0);
+
+  finally
+    jsHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestEmptyTokenArray;
+var
+  tokens: TSyntaxTokenArray;
+  output: string;
+  stringList: TStringList;
+begin
+  tokens:=[];
+  SetLength(tokens, 0);
+
+  // Test string output
+  output := RenderToString(tokens);
+  AssertEquals('Empty token array should produce empty string', '', output);
+
+  // Test string list output
+  stringList := RenderToStringList(tokens);
+  try
+    AssertEquals('Empty token array should produce empty string list', 0, stringList.Count);
+  finally
+    stringList.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestClassNameGeneration;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'var');
+    output := RenderToString(tokens);
+
+    // Should have both base class and category-specific class
+    AssertTrue('Should contain base keyword class', Pos('class="keyword keyword-javascript"', output) > 0);
+
+  finally
+    jsHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestCategoryMapping;
+var
+  cssHighlighter: TCssSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  cssHighlighter := TCssSyntaxHighlighter.Create;
+  try
+    tokens := cssHighlighter.Execute( 'color');
+    output := RenderToString(tokens);
+
+    // Should map CSS category correctly
+    AssertTrue('Should contain CSS category', Pos('keyword-css', output) > 0);
+
+  finally
+    cssHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestHtmlEscaping;
+var
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  // Create a simple token with special characters
+  tokens:=[];
+  SetLength(tokens, 1);
+  tokens[0] := TSyntaxToken.Create('<script>alert("test");</script>',shDefault);
+  output := RenderToString(tokens);
+
+  // All HTML special characters should be escaped
+  AssertTrue('Should escape <script>', Pos('&lt;script&gt;', output) > 0);
+  AssertTrue('Should escape quotes', Pos('&quot;test&quot;', output) > 0);
+  AssertTrue('Should escape closing tag', Pos('&lt;/script&gt;', output) > 0);
+end;
+
+procedure TTestHtmlRenderer.TestTokensWithoutCategory;
+var
+  tokens: TSyntaxTokenArray;
+  output: string;
+begin
+  tokens:=[];
+  // Create tokens without category
+  SetLength(tokens, 2);
+  tokens[0] := TSyntaxToken.Create('hello',shKeyword);
+  tokens[1] := TSyntaxToken.Create('world',shDefault);
+  output := RenderToString(tokens);
+
+  // Should have basic class names without category suffix
+  AssertTrue('Should contain keyword class without category', Pos('<span class="keyword">hello</span>', output) > 0);
+  AssertTrue('Should contain default class without category', Pos('<span class="default">world</span>', output) > 0);
+end;
+
+procedure TTestHtmlRenderer.TestComplexJavaScript;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  stringList: TStringList;
+  output, fullOutput: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'function add(a, b) { return a + b; }');
+
+    // Test string list output
+    stringList := RenderToStringList(tokens);
+    try
+      AssertEquals('Should have exactly one output line', 1, stringList.Count);
+
+      // Get the single line of output
+      fullOutput := stringList[0];
+
+      AssertTrue('Should contain function keyword', Pos('keyword keyword-javascript">function', fullOutput) > 0);
+      AssertTrue('Should contain return keyword', Pos('keyword keyword-javascript">return', fullOutput) > 0);
+      AssertTrue('Should contain operator', Pos('operator operator-javascript">+', fullOutput) > 0);
+
+    finally
+      stringList.Free;
+    end;
+
+    // Compare with single string output
+    output := RenderToString(tokens);
+    AssertEquals('String and concatenated string list should be equal', fullOutput, output);
+
+  finally
+    jsHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestNoDefaultSpanOption;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  outputDefault, outputNoSpan: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'var x = 42;');
+
+    // Test default behavior (with default spans)
+    renderer.Options := [];
+    outputDefault := RenderToString(tokens);
+
+    // Test with hroNoDefaultSpan option
+    renderer.Options := [hroNoDefaultSpan];
+    outputNoSpan := RenderToString(tokens);
+
+    // Default behavior should contain default spans
+    AssertTrue('Default output should contain default spans',
+      Pos('<span class="default default-javascript">', outputDefault) > 0);
+
+    // With hroNoDefaultSpan, default tokens should not be wrapped in spans
+    AssertFalse('NoDefaultSpan output should not contain default spans',
+      Pos('<span class="default default-javascript">', outputNoSpan) > 0);
+
+    // Both outputs should still contain non-default spans
+    AssertTrue('Default output should contain keyword spans',
+      Pos('<span class="keyword keyword-javascript">var</span>', outputDefault) > 0);
+    AssertTrue('NoDefaultSpan output should contain keyword spans',
+      Pos('<span class="keyword keyword-javascript">var</span>', outputNoSpan) > 0);
+
+    // Both outputs should still contain number spans
+    AssertTrue('Default output should contain number spans',
+      Pos('<span class="numbers numbers-javascript">42</span>', outputDefault) > 0);
+    AssertTrue('NoDefaultSpan output should contain number spans',
+      Pos('<span class="numbers numbers-javascript">42</span>', outputNoSpan) > 0);
+
+    // NoDefaultSpan output should contain raw whitespace and identifier text
+    AssertTrue('NoDefaultSpan output should contain raw whitespace', Pos(' x ', outputNoSpan) > 0);
+
+    // Verify that default tokens are still HTML-escaped even when not wrapped in spans
+    renderer.Options := [hroNoDefaultSpan];
+    tokens := jsHighlighter.Execute( 'var html = "<test>";');
+    outputNoSpan := RenderToString(tokens);
+
+    // Should contain escaped < and > characters even in unwrapped default tokens
+    AssertTrue('Should escape < character in unwrapped default tokens', Pos('&lt;', outputNoSpan) > 0);
+    AssertTrue('Should escape > character in unwrapped default tokens', Pos('&gt;', outputNoSpan) > 0);
+
+  finally
+    jsHighlighter.Free;
+    // Reset options to default for other tests
+    renderer.Options := [];
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestMultilineRendering;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  output: string;
+  multilineCode: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    // Test multiline JavaScript code
+    multilineCode := 'function test() {' + #10 + '  return "hello";' + #10 + '}';
+    tokens := jsHighlighter.Execute( multilineCode);
+
+    // Default behavior should preserve newlines in single line output
+    renderer.Options := [];
+    output := RenderToString(tokens);
+
+    // Should contain the newlines from original code
+    AssertTrue('Should contain newline characters', Pos(#10, output) > 0);
+    AssertTrue('Should contain function keyword', Pos('<span class="keyword keyword-javascript">function</span>', output) > 0);
+    AssertTrue('Should contain return keyword', Pos('<span class="keyword keyword-javascript">return</span>', output) > 0);
+    AssertTrue('Should contain indentation spaces', Pos('  ', output) > 0);
+
+  finally
+    jsHighlighter.Free;
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestPreserveLineStructureOption;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  stringListDefault, stringListPreserved: TStringList;
+  outputDefault, outputPreserved: string;
+  multilineCode: string;
+  i: Integer;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    multilineCode := 'function test() {' + #10 + '  return "hello";' + #10 + '}';
+    tokens := jsHighlighter.Execute( multilineCode);
+
+    // Test default behavior (single line)
+    renderer.Options := [];
+    stringListDefault := RenderToStringList(tokens);
+    try
+      AssertEquals('Default should have 1 line', 1, stringListDefault.Count);
+      outputDefault := stringListDefault[0];
+      AssertTrue('Default output should contain newlines', Pos(#10, outputDefault) > 0);
+    finally
+      stringListDefault.Free;
+    end;
+
+    // Test with hroPreserveLineStructure (multiple lines)
+    renderer.Options := [hroPreserveLineStructure];
+    stringListPreserved := RenderToStringList(tokens);
+    try
+      AssertTrue('Preserved should have multiple lines', stringListPreserved.Count > 1);
+      AssertEquals('Should have exactly 3 lines', 3, stringListPreserved.Count);
+
+      // First line should contain function declaration
+      AssertTrue('First line should contain function',
+        Pos('<span class="keyword keyword-javascript">function</span>', stringListPreserved[0]) > 0);
+
+      // Second line should contain return statement with indentation
+      AssertTrue('Second line should contain return',
+        Pos('<span class="keyword keyword-javascript">return</span>', stringListPreserved[1]) > 0);
+      AssertTrue('Second line should contain indentation',
+        Pos('  ', stringListPreserved[1]) > 0);
+
+      // Third line should contain closing brace
+      AssertTrue('Third line should contain closing brace',
+        Pos('<span class="symbol symbol-javascript">}</span>', stringListPreserved[2]) > 0);
+
+      // When concatenated, should be equivalent to single-line version
+      outputPreserved := '';
+      for i := 0 to stringListPreserved.Count - 1 do
+        begin
+        if i > 0 then
+          outputPreserved := outputPreserved + #10;
+        outputPreserved := outputPreserved + stringListPreserved[i];
+        end;
+
+      AssertEquals('Concatenated preserved output should equal default output',
+        outputDefault, outputPreserved);
+
+    finally
+      stringListPreserved.Free;
+    end;
+
+    // Test combination with hroNoDefaultSpan
+    renderer.Options := [hroPreserveLineStructure, hroNoDefaultSpan];
+    stringListPreserved := RenderToStringList(tokens);
+    try
+      AssertTrue('Combined options should have multiple lines', stringListPreserved.Count > 1);
+
+      // Should not contain default spans
+      AssertFalse('Should not contain default spans with combined options',
+        Pos('<span class="default default-javascript">', stringListPreserved.Text) > 0);
+
+      // Should still contain keyword spans
+      AssertTrue('Should still contain keyword spans with combined options',
+        Pos('<span class="keyword keyword-javascript">function</span>', stringListPreserved.Text) > 0);
+
+    finally
+      stringListPreserved.Free;
+    end;
+
+  finally
+    jsHighlighter.Free;
+    // Reset options to default for other tests
+    renderer.Options := [];
+  end;
+end;
+
+procedure TTestHtmlRenderer.TestExtraClassesProperty;
+var
+  jsHighlighter: TJavaScriptSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+  outputDefault, outputWithExtra: string;
+begin
+  jsHighlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    tokens := jsHighlighter.Execute( 'var x = 42;');
+
+    // Test default behavior (no extra classes)
+    renderer.ExtraClasses := '';
+    outputDefault := RenderToString(tokens);
+
+    // Test with single extra class
+    renderer.ExtraClasses := 'my-extra-class';
+    outputWithExtra := RenderToString(tokens);
+
+    // Default output should not contain extra class
+    AssertFalse('Default output should not contain extra class',
+      Pos('my-extra-class', outputDefault) > 0);
+
+    // Output with extra classes should contain the extra class
+    AssertTrue('Output with extra classes should contain my-extra-class',
+      Pos('my-extra-class', outputWithExtra) > 0);
+
+    // Should contain extra class in keyword spans
+    AssertTrue('Should contain extra class in keyword spans',
+      Pos('<span class="keyword keyword-javascript my-extra-class">var</span>', outputWithExtra) > 0);
+
+    // Should contain extra class in number spans
+    AssertTrue('Should contain extra class in number spans',
+      Pos('<span class="numbers numbers-javascript my-extra-class">42</span>', outputWithExtra) > 0);
+
+    // Should contain extra class in operator spans
+    AssertTrue('Should contain extra class in operator spans',
+      Pos('<span class="operator operator-javascript my-extra-class">=</span>', outputWithExtra) > 0);
+
+    // Test with multiple extra classes
+    renderer.ExtraClasses := 'class1 class2 class3';
+    outputWithExtra := RenderToString(tokens);
+
+    // Should contain all extra classes
+    AssertTrue('Should contain all extra classes',
+      Pos('class1 class2 class3', outputWithExtra) > 0);
+
+    AssertTrue('Should contain multiple extra classes in keyword spans',
+      Pos('<span class="keyword keyword-javascript class1 class2 class3">var</span>', outputWithExtra) > 0);
+
+    // Test empty extra classes (should behave like default)
+    renderer.ExtraClasses := '';
+    outputWithExtra := RenderToString(tokens);
+    AssertEquals('Empty extra classes should equal default output',
+      outputDefault, outputWithExtra);
+
+    // Test extra classes with hroNoDefaultSpan option
+    renderer.Options := [hroNoDefaultSpan];
+    renderer.ExtraClasses := 'no-default-extra';
+    outputWithExtra := RenderToString(tokens);
+
+    // Should not contain extra classes for default tokens (they're not wrapped)
+    AssertFalse('Should not contain extra classes for unwrapped default tokens',
+      Pos('<span class="default default-javascript no-default-extra">', outputWithExtra) > 0);
+
+    // But should contain extra classes for non-default tokens
+    AssertTrue('Should contain extra classes in non-default spans with hroNoDefaultSpan',
+      Pos('<span class="keyword keyword-javascript no-default-extra">var</span>', outputWithExtra) > 0);
+
+  finally
+    jsHighlighter.Free;
+    // Reset properties to default for other tests
+    renderer.Options := [];
+    renderer.ExtraClasses := '';
+  end;
+end;
+
+initialization
+  RegisterTest(TTestHtmlRenderer);
+end.

packages/fcl-syntax/tests/unittest.ini.pp

@@ -0,0 +1,375 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    INI highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unittest.ini;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.ini;
+
+type
+  TTestIniHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoIniHighlighting(const source: string): TSyntaxTokenArray;
+  published
+    procedure TestIniSections;
+    procedure TestIniKeys;
+    procedure TestIniComments;
+    procedure TestIniValues;
+    procedure TestIniQuotedValues;
+    procedure TestIniSymbols;
+    procedure TestCompleteIniFile;
+    procedure TestEmptyLines;
+    procedure TestSemicolonComment;
+    procedure TestHashComment;
+    procedure TestKeyWithSpaces;
+  end;
+
+implementation
+
+procedure TTestIniHighlighter.SetUp;
+begin
+end;
+
+procedure TTestIniHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestIniHighlighter.DoIniHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: TIniSyntaxHighlighter;
+begin
+  highlighter := TIniSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestIniHighlighter.TestIniSections;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple section
+  tokens := DoIniHighlighting('[General]');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  AssertEquals('Token should be [General]', '[General]', tokens[0].Text);
+  AssertEquals('Token should be section', Ord(shSection), Ord(tokens[0].Kind));
+
+  // Test section with spaces
+  tokens := DoIniHighlighting('[My Section]');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  AssertEquals('Token should be [My Section]', '[My Section]', tokens[0].Text);
+  AssertEquals('Token should be section', Ord(shSection), Ord(tokens[0].Kind));
+
+  // Test section with numbers
+  tokens := DoIniHighlighting('[Section123]');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  AssertEquals('Token should be [Section123]', '[Section123]', tokens[0].Text);
+  AssertEquals('Token should be section', Ord(shSection), Ord(tokens[0].Kind));
+end;
+
+procedure TTestIniHighlighter.TestIniKeys;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundKey: Boolean;
+begin
+  // Test simple key
+  tokens := DoIniHighlighting('username=admin');
+  foundKey := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = 'username') and (tokens[i].Kind = shKey) then
+    begin
+      foundKey := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find key token', foundKey);
+
+  // Test key with spaces
+  tokens := DoIniHighlighting('user name=admin');
+  foundKey := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = 'user name') and (tokens[i].Kind = shKey) then
+    begin
+      foundKey := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find key token with spaces', foundKey);
+
+  // Test key with underscore
+  tokens := DoIniHighlighting('user_name=admin');
+  foundKey := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = 'user_name') and (tokens[i].Kind = shKey) then
+    begin
+      foundKey := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find key token with underscore', foundKey);
+end;
+
+procedure TTestIniHighlighter.TestIniComments;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundComment: Boolean;
+begin
+  // Test semicolon comment
+  tokens := DoIniHighlighting('; This is a comment');
+  foundComment := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '; This is a comment') and (tokens[i].Kind = shComment) then
+    begin
+      foundComment := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find semicolon comment', foundComment);
+
+  // Test hash comment
+  tokens := DoIniHighlighting('# This is also a comment');
+  foundComment := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '# This is also a comment') and (tokens[i].Kind = shComment) then
+    begin
+      foundComment := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find hash comment', foundComment);
+end;
+
+procedure TTestIniHighlighter.TestIniValues;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundValue: Boolean;
+begin
+  // Test simple value
+  tokens := DoIniHighlighting('key=value');
+  foundValue := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Text = 'value' then
+    begin
+      foundValue := True;
+      AssertEquals('Value should be default token', Ord(shDefault), Ord(tokens[i].Kind));
+      break;
+    end;
+  end;
+  AssertTrue('Should find value token', foundValue);
+
+  // Test numeric value
+  tokens := DoIniHighlighting('port=8080');
+  foundValue := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Text = '8080' then
+    begin
+      foundValue := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find numeric value', foundValue);
+end;
+
+procedure TTestIniHighlighter.TestIniQuotedValues;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundQuotedValue: Boolean;
+begin
+  // Test double-quoted value
+  tokens := DoIniHighlighting('name="John Doe"');
+  foundQuotedValue := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"John Doe"') and (tokens[i].Kind = shStrings) then
+    begin
+      foundQuotedValue := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find double-quoted value as string', foundQuotedValue);
+
+  // Test single-quoted value
+  tokens := DoIniHighlighting('path=''C:\Program Files''');
+  foundQuotedValue := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '''C:\Program Files''') and (tokens[i].Kind = shStrings) then
+    begin
+      foundQuotedValue := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find single-quoted value as string', foundQuotedValue);
+end;
+
+procedure TTestIniHighlighter.TestIniSymbols;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundEquals: Boolean;
+begin
+  // Test equals sign
+  tokens := DoIniHighlighting('key=value');
+  foundEquals := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '=') and (tokens[i].Kind = shOperator) then
+    begin
+      foundEquals := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find equals sign as operator', foundEquals);
+end;
+
+procedure TTestIniHighlighter.TestCompleteIniFile;
+var
+  tokens: TSyntaxTokenArray;
+  iniContent: string;
+  i: Integer;
+  hasSections, hasKeys, hasValues, hasComments: Boolean;
+begin
+  iniContent := '[Database]' + #13#10 +
+                'host=localhost' + #13#10 +
+                'port=3306' + #13#10 +
+                '; Connection timeout in seconds' + #13#10 +
+                'timeout=30' + #13#10 +
+                #13#10 +
+                '[Application]' + #13#10 +
+                'name="My App"' + #13#10 +
+                'debug=true';
+
+  tokens := DoIniHighlighting(iniContent);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 10);
+
+  // Check that we have different token types
+  hasSections := False;
+  hasKeys := False;
+  hasValues := False;
+  hasComments := False;
+
+  for i := 0 to High(tokens) do
+  begin
+    case tokens[i].Kind of
+      shSection: hasSections := True;
+      shKey: hasKeys := True;
+      shDefault: hasValues := True;
+      shComment: hasComments := True;
+    end;
+  end;
+
+  AssertTrue('Should contain section tokens', hasSections);
+  AssertTrue('Should contain key tokens', hasKeys);
+  AssertTrue('Should contain value tokens', hasValues);
+  AssertTrue('Should contain comment tokens', hasComments);
+end;
+
+procedure TTestIniHighlighter.TestEmptyLines;
+var
+  tokens: TSyntaxTokenArray;
+  iniContent: string;
+begin
+  iniContent := '[Section1]' + #13#10 +
+                'key1=value1' + #13#10 +
+                #13#10 +  // Empty line
+                'key2=value2';
+
+  tokens := DoIniHighlighting(iniContent);
+  AssertTrue('Should handle empty lines without crashing', Length(tokens) > 0);
+end;
+
+procedure TTestIniHighlighter.TestSemicolonComment;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundComment: Boolean;
+begin
+  tokens := DoIniHighlighting('; Configuration file');
+  foundComment := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Kind = shComment) and (Pos(';', tokens[i].Text) = 1) then
+    begin
+      foundComment := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should recognize semicolon comments', foundComment);
+end;
+
+procedure TTestIniHighlighter.TestHashComment;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundComment: Boolean;
+begin
+  tokens := DoIniHighlighting('# This is a hash comment');
+  foundComment := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Kind = shComment) and (Pos('#', tokens[i].Text) = 1) then
+    begin
+      foundComment := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should recognize hash comments', foundComment);
+end;
+
+procedure TTestIniHighlighter.TestKeyWithSpaces;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundKey: Boolean;
+begin
+  tokens := DoIniHighlighting('display name = John Doe');
+  foundKey := False;
+  for i := 0 to High(tokens) do
+  begin
+    // Writeln('*',tokens[i].Text,'*');
+    if (tokens[i].Kind = shKey) and (tokens[i].Text = 'display name ') then
+    begin
+      foundKey := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle keys with spaces', foundKey);
+end;
+
+initialization
+  RegisterTest(TTestIniHighlighter);
+end.

packages/fcl-syntax/tests/unittest.javascript.pp

@@ -0,0 +1,370 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Javascript highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit unittest.javascript;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.javascript;
+
+type
+  TTestJavaScriptHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoJavaScriptHighlighting(const source: string): TSyntaxTokenArray;
+  published
+    procedure TestJavaScriptKeywords;
+    procedure TestJavaScriptStrings;
+    procedure TestJavaScriptNumbers;
+    procedure TestJavaScriptComments;
+    procedure TestJavaScriptOperators;
+    procedure TestJavaScriptSymbols;
+    procedure TestJavaScriptIdentifiers;
+    procedure TestJavaScriptRegexLiterals;
+    procedure TestJavaScriptTemplateLiterals;
+    procedure TestJavaScriptNumericFormats;
+    procedure TestComplexJavaScriptFunction;
+    procedure TestJavaScriptContextSensitive;
+  end;
+
+implementation
+
+procedure TTestJavaScriptHighlighter.SetUp;
+begin
+end;
+
+procedure TTestJavaScriptHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestJavaScriptHighlighter.DoJavaScriptHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: TJavaScriptSyntaxHighlighter;
+begin
+  highlighter := TJavaScriptSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptKeywords;
+const
+  Keywords: array[0..19] of string = (
+    'var', 'let', 'const', 'function', 'if', 'else', 'for', 'while', 'do', 'switch',
+    'case', 'default', 'break', 'continue', 'return', 'try', 'catch', 'finally', 'throw', 'new'
+  );
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(Keywords) do
+    begin
+    tokens := DoJavaScriptHighlighting(Keywords[i]);
+    AssertEquals('Should have 1 token for ' + Keywords[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + Keywords[i], Keywords[i], tokens[0].Text);
+    AssertEquals(Keywords[i] + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+    end;
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptStrings;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test single-quoted string
+  tokens := DoJavaScriptHighlighting('''hello world''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be single-quoted string', '''hello world''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test double-quoted string
+  tokens := DoJavaScriptHighlighting('"hello world"');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be double-quoted string', '"hello world"', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test string with escapes
+  tokens := DoJavaScriptHighlighting('"hello\nworld"');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped string', '"hello\nworld"', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptNumbers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test integer
+  tokens := DoJavaScriptHighlighting('123');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be integer', '123', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test decimal
+  tokens := DoJavaScriptHighlighting('123.45');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be decimal', '123.45', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test hex number
+  tokens := DoJavaScriptHighlighting('0xFF');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be hex', '0xFF', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptComments;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test single-line comment
+  tokens := DoJavaScriptHighlighting('// This is a comment');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be single-line comment', '// This is a comment', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+
+  // Test multi-line comment
+  tokens := DoJavaScriptHighlighting('/* This is a comment */');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be multi-line comment', '/* This is a comment */', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+
+  // Test multi-line comment with newlines
+  tokens := DoJavaScriptHighlighting('/* Line 1' + #10 + 'Line 2 */');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be multi-line comment with newlines', '/* Line 1' + #10 + 'Line 2 */', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptOperators;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test strict equality
+  tokens := DoJavaScriptHighlighting('===');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be strict equality', '===', tokens[0].Text);
+  AssertEquals('Token should be operator', Ord(shOperator), Ord(tokens[0].Kind));
+
+  // Test inequality
+  tokens := DoJavaScriptHighlighting('!==');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be strict inequality', '!==', tokens[0].Text);
+  AssertEquals('Token should be operator', Ord(shOperator), Ord(tokens[0].Kind));
+
+  // Test arrow function
+  tokens := DoJavaScriptHighlighting('=>');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be arrow operator', '=>', tokens[0].Text);
+  AssertEquals('Token should be operator', Ord(shOperator), Ord(tokens[0].Kind));
+
+  // Test logical AND
+  tokens := DoJavaScriptHighlighting('&&');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be logical AND', '&&', tokens[0].Text);
+  AssertEquals('Token should be operator', Ord(shOperator), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptSymbols;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test parentheses
+  tokens := DoJavaScriptHighlighting('(');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be opening paren', '(', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test braces
+  tokens := DoJavaScriptHighlighting('{');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be opening brace', '{', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test semicolon
+  tokens := DoJavaScriptHighlighting(';');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be semicolon', ';', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test comma
+  tokens := DoJavaScriptHighlighting(',');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be comma', ',', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptIdentifiers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple identifier
+  tokens := DoJavaScriptHighlighting('myVariable');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be identifier', 'myVariable', tokens[0].Text);
+  AssertEquals('Token should be default', Ord(shDefault), Ord(tokens[0].Kind));
+
+  // Test identifier with underscore
+  tokens := DoJavaScriptHighlighting('_private');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be underscore identifier', '_private', tokens[0].Text);
+  AssertEquals('Token should be default', Ord(shDefault), Ord(tokens[0].Kind));
+
+  // Test identifier with dollar sign
+  tokens := DoJavaScriptHighlighting('$element');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be dollar identifier', '$element', tokens[0].Text);
+  AssertEquals('Token should be default', Ord(shDefault), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptRegexLiterals;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple regex
+  tokens := DoJavaScriptHighlighting('/[a-z]+/gi');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be regex', '/[a-z]+/gi', tokens[0].Text);
+  AssertEquals('Token should be regex type', Ord(shRegex), Ord(tokens[0].Kind));
+
+  // Test regex with escape sequences
+  tokens := DoJavaScriptHighlighting('/\\d+\\.\\d*/');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped regex', '/\\d+\\.\\d*/', tokens[0].Text);
+  AssertEquals('Token should be regex type', Ord(shRegex), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptTemplateLiterals;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple template literal
+  tokens := DoJavaScriptHighlighting('`hello world`');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be template literal', '`hello world`', tokens[0].Text);
+  AssertEquals('Token should be raw string type', Ord(shRawString), Ord(tokens[0].Kind));
+
+  // Test template literal with interpolation
+  tokens := DoJavaScriptHighlighting('`hello ${name}`');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be template with interpolation', '`hello ${name}`', tokens[0].Text);
+  AssertEquals('Token should be raw string type', Ord(shRawString), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptNumericFormats;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test scientific notation
+  tokens := DoJavaScriptHighlighting('1.23e-4');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be scientific notation', '1.23e-4', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test binary number
+  tokens := DoJavaScriptHighlighting('0b1010');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be binary number', '0b1010', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test octal number
+  tokens := DoJavaScriptHighlighting('0o755');
+  AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+  AssertEquals('First token should be number type', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestJavaScriptHighlighter.TestComplexJavaScriptFunction;
+var
+  tokens: TSyntaxTokenArray;
+  jsCode: string;
+  i: Integer;
+  hasKeywords, hasStrings, hasSymbols, hasIdentifiers: Boolean;
+begin
+  jsCode := 'function greet(name) { return `Hello ${name}!`; }';
+  tokens := DoJavaScriptHighlighting(jsCode);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 5);
+
+  // Check that we have different token types
+  hasKeywords := False;
+  hasStrings := False;
+  hasSymbols := False;
+  hasIdentifiers := False;
+
+  for i := 0 to High(tokens) do
+    case tokens[i].Kind of
+      shKeyword: hasKeywords := True;
+      shRawString: hasStrings := True;
+      shSymbol: hasSymbols := True;
+      shDefault: hasIdentifiers := True;
+    end;
+
+
+  AssertTrue('Should contain keyword tokens', hasKeywords);
+  AssertTrue('Should contain string tokens', hasStrings);
+  AssertTrue('Should contain symbol tokens', hasSymbols);
+  AssertTrue('Should contain identifier tokens', hasIdentifiers);
+
+  // First token should be 'function' keyword
+  AssertEquals('First token should be function', 'function', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+  // Should contain template literal
+  for i := 0 to High(tokens) do
+    if tokens[i].Kind = shRawString then
+      begin
+      AssertEquals('Should have template literal', '`Hello ${name}!`', tokens[i].Text);
+      Break;
+      end;
+end;
+
+procedure TTestJavaScriptHighlighter.TestJavaScriptContextSensitive;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test that context-sensitive features work at least partially
+  // Note: Full context sensitivity for regex vs division is complex
+  // and may not be fully implemented in all cases
+
+  // Test assignment context - this should work well
+  tokens := DoJavaScriptHighlighting('var x = 42;');
+  AssertTrue('Should have multiple tokens', Length(tokens) >= 5);
+
+  // Should have var keyword
+  AssertEquals('First token should be var', 'var', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+  // Should have identifier
+  AssertEquals('Second token should be space', ' ', tokens[1].Text);
+  AssertEquals('Third token should be identifier', 'x', tokens[2].Text);
+  AssertEquals('Third token should be default', Ord(shDefault), Ord(tokens[2].Kind));
+
+  // Should have assignment and number
+  AssertEquals('Fourth token should be space', ' ', tokens[3].Text);
+  AssertEquals('Fifth token should be assignment', '=', tokens[4].Text);
+  AssertEquals('Fifth token should be operator', Ord(shOperator), Ord(tokens[4].Kind));
+end;
+
+initialization
+  RegisterTest(TTestJavaScriptHighlighter);
+end.

packages/fcl-syntax/tests/unittest.json.pp

@@ -0,0 +1,609 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    JSON highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unittest.json;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.json;
+
+type
+  TTestJsonHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoJsonHighlighting(const source: string): TSyntaxTokenArray;
+  published
+    procedure TestJsonKeys;
+    procedure TestJsonStrings;
+    procedure TestJsonNumbers;
+    procedure TestJsonKeywords;
+    procedure TestJsonSymbols;
+    procedure TestJsonEscapeSequences;
+    procedure TestJsonUnicodeEscapes;
+    procedure TestJsonInvalidStrings;
+    procedure TestJsonInvalidNumbers;
+    procedure TestComplexJsonObject;
+    procedure TestJsonArray;
+    procedure TestNestedJsonStructures;
+    procedure TestJsonWhitespace;
+    procedure TestJsonScientificNotation;
+    procedure TestJsonEdgeCases;
+    procedure TestJsonEmpty;
+  end;
+
+implementation
+
+procedure TTestJsonHighlighter.SetUp;
+begin
+end;
+
+procedure TTestJsonHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestJsonHighlighter.DoJsonHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: TJsonSyntaxHighlighter;
+begin
+  highlighter := TJsonSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestJsonHighlighter.TestJsonKeys;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundKey: Boolean;
+begin
+  // Test simple object with key
+  tokens := DoJsonHighlighting('{"name": "value"}');
+  foundKey := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"name"') and (tokens[i].Kind = shKey) then
+    begin
+      foundKey := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find key token', foundKey);
+
+  // Test multiple keys
+  tokens := DoJsonHighlighting('{"firstName": "John", "lastName": "Doe"}');
+  foundKey := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"firstName"') and (tokens[i].Kind = shKey) then
+    begin
+      foundKey := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find firstName key', foundKey);
+end;
+
+procedure TTestJsonHighlighter.TestJsonStrings;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundString: Boolean;
+begin
+  // Test string value (not key)
+  tokens := DoJsonHighlighting('{"name": "John Doe"}');
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"John Doe"') and (tokens[i].Kind = shStrings) then
+    begin
+      foundString := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find string value token', foundString);
+
+  // Test empty string
+  tokens := DoJsonHighlighting('{"empty": ""}');
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '""') and (tokens[i].Kind = shStrings) then
+    begin
+      foundString := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find empty string token', foundString);
+end;
+
+procedure TTestJsonHighlighter.TestJsonNumbers;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundNumber: Boolean;
+begin
+  // Test integer
+  tokens := DoJsonHighlighting('{"age": 25}');
+  foundNumber := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '25') and (tokens[i].Kind = shNumbers) then
+    begin
+      foundNumber := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find integer number', foundNumber);
+
+  // Test decimal
+  tokens := DoJsonHighlighting('{"price": 19.99}');
+  foundNumber := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '19.99') and (tokens[i].Kind = shNumbers) then
+    begin
+      foundNumber := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find decimal number', foundNumber);
+
+  // Test negative number
+  tokens := DoJsonHighlighting('{"temperature": -15}');
+  foundNumber := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '-15') and (tokens[i].Kind = shNumbers) then
+    begin
+      foundNumber := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find negative number', foundNumber);
+
+  // Test zero
+  tokens := DoJsonHighlighting('{"zero": 0}');
+  foundNumber := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '0') and (tokens[i].Kind = shNumbers) then
+    begin
+      foundNumber := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find zero', foundNumber);
+end;
+
+procedure TTestJsonHighlighter.TestJsonKeywords;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundKeyword: Boolean;
+begin
+  // Test true
+  tokens := DoJsonHighlighting('{"valid": true}');
+  foundKeyword := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = 'true') and (tokens[i].Kind = shKeyword) then
+    begin
+      foundKeyword := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find true keyword', foundKeyword);
+
+  // Test false
+  tokens := DoJsonHighlighting('{"valid": false}');
+  foundKeyword := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = 'false') and (tokens[i].Kind = shKeyword) then
+    begin
+      foundKeyword := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find false keyword', foundKeyword);
+
+  // Test null
+  tokens := DoJsonHighlighting('{"value": null}');
+  foundKeyword := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = 'null') and (tokens[i].Kind = shKeyword) then
+    begin
+      foundKeyword := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find null keyword', foundKeyword);
+end;
+
+procedure TTestJsonHighlighter.TestJsonSymbols;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundSymbol: Boolean;
+begin
+  tokens := DoJsonHighlighting('{"key": "value"}');
+
+  // Test opening brace
+  foundSymbol := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '{') and (tokens[i].Kind = shSymbol) then
+    begin
+      foundSymbol := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find opening brace', foundSymbol);
+
+  // Test colon
+  foundSymbol := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = ':') and (tokens[i].Kind = shSymbol) then
+    begin
+      foundSymbol := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find colon', foundSymbol);
+
+  // Test closing brace
+  foundSymbol := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '}') and (tokens[i].Kind = shSymbol) then
+    begin
+      foundSymbol := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find closing brace', foundSymbol);
+end;
+
+procedure TTestJsonHighlighter.TestJsonEscapeSequences;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundString: Boolean;
+begin
+  // Test basic escape sequences
+  tokens := DoJsonHighlighting('{"message": "Hello\nWorld"}');
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"Hello\nWorld"') and (tokens[i].Kind = shStrings) then
+    begin
+      foundString := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle newline escape', foundString);
+
+  // Test quote escape
+  tokens := DoJsonHighlighting('{"quote": "Say \"Hello\""}');
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"Say \"Hello\""') and (tokens[i].Kind = shStrings) then
+    begin
+      foundString := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle quote escape', foundString);
+
+  // Test backslash escape
+  tokens := DoJsonHighlighting('{"path": "C:\\Windows"}');
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"C:\\Windows"') and (tokens[i].Kind = shStrings) then
+    begin
+      foundString := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle backslash escape', foundString);
+end;
+
+procedure TTestJsonHighlighter.TestJsonUnicodeEscapes;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundString: Boolean;
+begin
+  // Test unicode escape
+  tokens := DoJsonHighlighting('{"unicode": "\u0048\u0065\u006C\u006C\u006F"}');
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"\u0048\u0065\u006C\u006C\u006F"') and (tokens[i].Kind = shStrings) then
+    begin
+      foundString := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle unicode escapes', foundString);
+end;
+
+procedure TTestJsonHighlighter.TestJsonInvalidStrings;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundInvalid: Boolean;
+begin
+  // Test invalid escape sequence
+  tokens := DoJsonHighlighting('{"invalid": "\x"}');
+  foundInvalid := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Kind = shInvalid then
+    begin
+      foundInvalid := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find invalid escape sequence', foundInvalid);
+
+  // Test unterminated string
+  tokens := DoJsonHighlighting('{"unterminated": "hello');
+  foundInvalid := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Kind = shInvalid then
+    begin
+      foundInvalid := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find unterminated string', foundInvalid);
+end;
+
+procedure TTestJsonHighlighter.TestJsonInvalidNumbers;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundInvalid: Boolean;
+begin
+  // Test leading zero (invalid in JSON)
+  tokens := DoJsonHighlighting('{"invalid": 01}');
+  foundInvalid := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Kind = shInvalid then
+    begin
+      foundInvalid := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find invalid leading zero', foundInvalid);
+
+  // Test incomplete decimal
+  tokens := DoJsonHighlighting('{"incomplete": 12.}');
+  foundInvalid := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Kind = shInvalid then
+    begin
+      foundInvalid := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find incomplete decimal', foundInvalid);
+end;
+
+procedure TTestJsonHighlighter.TestComplexJsonObject;
+var
+  tokens: TSyntaxTokenArray;
+  jsonText: string;
+  i: Integer;
+  hasKeys, hasStrings, hasNumbers, hasKeywords, hasSymbols: Boolean;
+begin
+  jsonText := '{"name": "John", "age": 30, "married": true, "children": null}';
+  tokens := DoJsonHighlighting(jsonText);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 10);
+
+  // Check for different token types
+  hasKeys := False;
+  hasStrings := False;
+  hasNumbers := False;
+  hasKeywords := False;
+  hasSymbols := False;
+
+  for i := 0 to High(tokens) do
+  begin
+    case tokens[i].Kind of
+      shKey: hasKeys := True;
+      shStrings: hasStrings := True;
+      shNumbers: hasNumbers := True;
+      shKeyword: hasKeywords := True;
+      shSymbol: hasSymbols := True;
+    end;
+  end;
+
+  AssertTrue('Should contain key tokens', hasKeys);
+  AssertTrue('Should contain string tokens', hasStrings);
+  AssertTrue('Should contain number tokens', hasNumbers);
+  AssertTrue('Should contain keyword tokens', hasKeywords);
+  AssertTrue('Should contain symbol tokens', hasSymbols);
+end;
+
+procedure TTestJsonHighlighter.TestJsonArray;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundBrackets: Boolean;
+begin
+  tokens := DoJsonHighlighting('[1, 2, 3]');
+
+  foundBrackets := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '[') and (tokens[i].Kind = shSymbol) then
+    begin
+      foundBrackets := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find opening bracket', foundBrackets);
+
+  foundBrackets := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = ']') and (tokens[i].Kind = shSymbol) then
+    begin
+      foundBrackets := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find closing bracket', foundBrackets);
+end;
+
+procedure TTestJsonHighlighter.TestNestedJsonStructures;
+var
+  tokens: TSyntaxTokenArray;
+  jsonText: string;
+  i: Integer;
+  hasKeys, hasNumbers: Boolean;
+begin
+  jsonText := '{"person": {"name": "John", "address": {"city": "New York", "zip": 10001}}}';
+  tokens := DoJsonHighlighting(jsonText);
+
+  AssertTrue('Should handle nested structures', Length(tokens) > 15);
+
+  // Verify we have both keys and numbers in nested structure
+  hasKeys := False;
+  hasNumbers := False;
+
+  for i := 0 to High(tokens) do
+  begin
+    case tokens[i].Kind of
+      shKey: hasKeys := True;
+      shNumbers: hasNumbers := True;
+    end;
+  end;
+
+  AssertTrue('Should contain keys in nested structure', hasKeys);
+  AssertTrue('Should contain numbers in nested structure', hasNumbers);
+end;
+
+procedure TTestJsonHighlighter.TestJsonWhitespace;
+var
+  tokens: TSyntaxTokenArray;
+  jsonText: string;
+  i: Integer;
+  foundWhitespace: Boolean;
+begin
+  jsonText := '{' + #10 + '  "name": "John"' + #10 + '}';
+  tokens := DoJsonHighlighting(jsonText);
+
+  foundWhitespace := False;
+  for i := 0 to High(tokens) do
+  begin
+    if tokens[i].Kind = shDefault then
+    begin
+      foundWhitespace := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle whitespace', foundWhitespace);
+end;
+
+procedure TTestJsonHighlighter.TestJsonScientificNotation;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundNumber: Boolean;
+begin
+  // Test scientific notation
+  tokens := DoJsonHighlighting('{"scientific": 1.23e-4}');
+  foundNumber := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '1.23e-4') and (tokens[i].Kind = shNumbers) then
+    begin
+      foundNumber := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle scientific notation', foundNumber);
+
+  // Test with capital E
+  tokens := DoJsonHighlighting('{"scientific": 2.5E+10}');
+  foundNumber := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '2.5E+10') and (tokens[i].Kind = shNumbers) then
+    begin
+      foundNumber := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should handle capital E notation', foundNumber);
+end;
+
+procedure TTestJsonHighlighter.TestJsonEdgeCases;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundKey, foundString: Boolean;
+begin
+  // Test single character key and value
+  tokens := DoJsonHighlighting('{"a": "b"}');
+  foundKey := False;
+  foundString := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '"a"') and (tokens[i].Kind = shKey) then
+      foundKey := True;
+    if (tokens[i].Text = '"b"') and (tokens[i].Kind = shStrings) then
+      foundString := True;
+  end;
+  AssertTrue('Should handle single character key', foundKey);
+  AssertTrue('Should handle single character string', foundString);
+end;
+
+procedure TTestJsonHighlighter.TestJsonEmpty;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test empty object
+  tokens := DoJsonHighlighting('{}');
+  AssertTrue('Should handle empty object', Length(tokens) >= 2);
+
+  // Test empty array
+  tokens := DoJsonHighlighting('[]');
+  AssertTrue('Should handle empty array', Length(tokens) >= 2);
+end;
+
+initialization
+  RegisterTest(TTestJsonHighlighter);
+end.

packages/fcl-syntax/tests/unittest.pascal.pp

@@ -0,0 +1,832 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    Pascal highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unittest.pascal;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.pascal;
+
+type
+  TTestPascalHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+  published
+    procedure TestBasicKeywords;
+    procedure TestANDKeyword;
+    procedure TestARRAYKeyword;
+    procedure TestASMKeyword;
+    procedure TestASSEMBLERKeyword;
+    procedure TestBEGINKeyword;
+    procedure TestBREAKKeyword;
+    procedure TestCASEKeyword;
+    procedure TestCONSTKeyword;
+    procedure TestCONSTRUCTORKeyword;
+    procedure TestCLASSKeyword;
+    procedure TestDEFAULTKeyword;
+    procedure TestDESTRUCTORKeyword;
+    procedure TestDIVKeyword;
+    procedure TestDOKeyword;
+    procedure TestDOWNTOKeyword;
+    procedure TestELSEKeyword;
+    procedure TestENDKeyword;
+    procedure TestEXCEPTKeyword;
+    procedure TestEXITKeyword;
+    procedure TestFINALIZATIONKeyword;
+    procedure TestFINALLYKeyword;
+    procedure TestFORKeyword;
+    procedure TestFUNCTIONKeyword;
+    procedure TestGOTOKeyword;
+    procedure TestIFKeyword;
+    procedure TestIMPLEMENTATIONKeyword;
+    procedure TestINKeyword;
+    procedure TestINHERITEDKeyword;
+    procedure TestINITIALIZATIONKeyword;
+    procedure TestINTERFACEKeyword;
+    procedure TestNILKeyword;
+    procedure TestNOTKeyword;
+    procedure TestOBJECTKeyword;
+    procedure TestOFKeyword;
+    procedure TestONKeyword;
+    procedure TestORKeyword;
+    procedure TestOVERRIDEKeyword;
+    procedure TestPACKEDKeyword;
+    procedure TestPRIVATEKeyword;
+    procedure TestPROCEDUREKeyword;
+    procedure TestPROGRAMKeyword;
+    procedure TestPROPERTYKeyword;
+    procedure TestPROTECTEDKeyword;
+    procedure TestPUBLICKeyword;
+    procedure TestPUBLISHEDKeyword;
+    procedure TestRAISEKeyword;
+    procedure TestRECORDKeyword;
+    procedure TestREPEATKeyword;
+    procedure TestRESOURCESTRINGKeyword;
+    procedure TestSETKeyword;
+    procedure TestTHENKeyword;
+    procedure TestTRYKeyword;
+    procedure TestTYPEKeyword;
+    procedure TestUNITKeyword;
+    procedure TestUNTILKeyword;
+    procedure TestUSESKeyword;
+    procedure TestVARKeyword;
+    procedure TestVIRTUALKeyword;
+    procedure TestWHILEKeyword;
+    procedure TestWITHKeyword;
+    procedure TestXORKeyword;
+    procedure TestComments;
+    procedure TestStrings;
+    procedure TestNumbers;
+    procedure TestSymbols;
+    procedure TestDirectives;
+    procedure TestIdentifiers;
+  end;
+
+implementation
+
+procedure TTestPascalHighlighter.SetUp;
+begin
+
+end;
+
+procedure TTestPascalHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+procedure TTestPascalHighlighter.TestBasicKeywords;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('begin end');
+  AssertEquals('Should have 3 tokens', 3, Length(tokens));
+  AssertEquals('First token should be BEGIN', 'begin', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  AssertEquals('Second token should be space', ' ', tokens[1].Text);
+  AssertEquals('Second token should be default', Ord(shDefault), Ord(tokens[1].Kind));
+  AssertEquals('Third token should be END', 'end', tokens[2].Text);
+  AssertEquals('Third token should be keyword', Ord(shKeyword), Ord(tokens[2].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestANDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('and');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be AND', 'and', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestARRAYKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('array');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be ARRAY', 'array', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestASMKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('asm end');
+  AssertTrue('Should have at least 2 tokens', Length(tokens) >= 2);
+  AssertEquals('First token should be ASM', 'asm', tokens[0].Text);
+  AssertEquals('First token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  // After ASM keyword, we should have assembler highlighting until END
+end;
+
+procedure TTestPascalHighlighter.TestASSEMBLERKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('assembler');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be ASSEMBLER', 'assembler', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestBEGINKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('begin');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be BEGIN', 'begin', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestBREAKKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('break');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be BREAK', 'break', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestCASEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('case');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be CASE', 'case', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestCONSTKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('const');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be CONST', 'const', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestCONSTRUCTORKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('constructor');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be CONSTRUCTOR', 'constructor', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestCLASSKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('class');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be CLASS', 'class', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestDEFAULTKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('default');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be DEFAULT', 'default', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestDESTRUCTORKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('destructor');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be DESTRUCTOR', 'destructor', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestDIVKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('div');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be DIV', 'div', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestDOKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('do');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be DO', 'do', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestDOWNTOKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('downto');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be DOWNTO', 'downto', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestELSEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('else');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be ELSE', 'else', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestENDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('end');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be END', 'end', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestEXCEPTKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('except');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be EXCEPT', 'except', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestEXITKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('exit');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be EXIT', 'exit', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestFINALIZATIONKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('finalization');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be FINALIZATION', 'finalization', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestFINALLYKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('finally');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be FINALLY', 'finally', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestFORKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('for');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be FOR', 'for', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestFUNCTIONKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('function');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be FUNCTION', 'function', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestGOTOKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('goto');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be GOTO', 'goto', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestIFKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('if');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be IF', 'if', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestIMPLEMENTATIONKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('implementation');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be IMPLEMENTATION', 'implementation', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestINKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('in');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be IN', 'in', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestINHERITEDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('inherited');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be INHERITED', 'inherited', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestINITIALIZATIONKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('initialization');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be INITIALIZATION', 'initialization', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestINTERFACEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('interface');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be INTERFACE', 'interface', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestNILKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('nil');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be NIL', 'nil', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestNOTKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('not');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be NOT', 'not', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestOBJECTKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('object');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be OBJECT', 'object', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestOFKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('of');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be OF', 'of', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestONKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('on');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be ON', 'on', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestORKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('or');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be OR', 'or', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestOVERRIDEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('override');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be OVERRIDE', 'override', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPACKEDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('packed');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PACKED', 'packed', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPRIVATEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('private');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PRIVATE', 'private', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPROCEDUREKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('procedure');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PROCEDURE', 'procedure', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPROGRAMKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('program');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PROGRAM', 'program', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPROPERTYKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('property');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PROPERTY', 'property', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPROTECTEDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('protected');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PROTECTED', 'protected', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPUBLICKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('public');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PUBLIC', 'public', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestPUBLISHEDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('published');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be PUBLISHED', 'published', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestRAISEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('raise');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be RAISE', 'raise', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestRECORDKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('record');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be RECORD', 'record', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestREPEATKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('repeat');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be REPEAT', 'repeat', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestRESOURCESTRINGKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('resourcestring');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be RESOURCESTRING', 'resourcestring', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestSETKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('set');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be SET', 'set', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestTHENKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('then');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be THEN', 'then', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestTRYKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('try');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be TRY', 'try', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestTYPEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('type');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be TYPE', 'type', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestUNITKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('unit');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be UNIT', 'unit', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestUNTILKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('until');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be UNTIL', 'until', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestUSESKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('uses');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be USES', 'uses', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestVARKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('var');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be VAR', 'var', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestVIRTUALKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('virtual');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be VIRTUAL', 'virtual', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestWHILEKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('while');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be WHILE', 'while', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestWITHKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('with');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be WITH', 'with', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestXORKeyword;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('xor');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be XOR', 'xor', tokens[0].Text);
+  AssertEquals('Token should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestComments;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test { } comment
+  tokens := DoPascalHighlighting('{ this is a comment }');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be comment text', '{ this is a comment }', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+
+  // Test (* *) comment
+  tokens := DoPascalHighlighting('(* this is a comment *)');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be comment text', '(* this is a comment *)', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+
+  // Test // comment
+  tokens := DoPascalHighlighting('// this is a comment');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be comment text', '// this is a comment', tokens[0].Text);
+  AssertEquals('Token should be comment', Ord(shComment), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestStrings;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('''Hello World''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be string', '''Hello World''', tokens[0].Text);
+  AssertEquals('Token should be string type', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test character literal
+  tokens := DoPascalHighlighting('''A''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be char', '''A''', tokens[0].Text);
+  AssertEquals('Token should be character type', Ord(shCharacters), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestNumbers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test decimal number
+  tokens := DoPascalHighlighting('123');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be number', '123', tokens[0].Text);
+  AssertEquals('Token should be number type', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test hex number
+  tokens := DoPascalHighlighting('$FF');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be hex number', '$FF', tokens[0].Text);
+  AssertEquals('Token should be number type', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestSymbols;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting(':=');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be assignment', ':=', tokens[0].Text);
+  AssertEquals('Token should be symbol type', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  tokens := DoPascalHighlighting(';');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be semicolon', ';', tokens[0].Text);
+  AssertEquals('Token should be symbol type', Ord(shSymbol), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestDirectives;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('{$MODE OBJFPC}');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be directive', '{$MODE OBJFPC}', tokens[0].Text);
+  AssertEquals('Token should be directive type', Ord(shDirective), Ord(tokens[0].Kind));
+end;
+
+procedure TTestPascalHighlighter.TestIdentifiers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  tokens := DoPascalHighlighting('MyVariable');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be identifier', 'MyVariable', tokens[0].Text);
+  AssertEquals('Token should be default type', Ord(shDefault), Ord(tokens[0].Kind));
+end;
+
+initialization
+  RegisterTest(TTestPascalHighlighter);
+end.

packages/fcl-syntax/tests/unittest.sql.pp

@@ -0,0 +1,472 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2025 by Michael Van Canneyt
+
+    SQL highlighter unit test
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unittest.sql;
+
+interface
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  syntax.highlighter, syntax.sql;
+
+type
+  TTestSqlHighlighter = class(TTestCase)
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  private
+    function DoSqlHighlighting(const source: string): TSyntaxTokenArray;
+    function DoSqlHighlightingWithMode(const source: string; mode: TSqlStringEscapeMode): TSyntaxTokenArray;
+  published
+    procedure TestSqlKeywords;
+    procedure TestSqlStringsDoubledEscape;
+    procedure TestSqlStringsBackslashEscape;
+    procedure TestSqlStringEscapeModeProperty;
+    procedure TestSqlNumbers;
+    procedure TestSqlComments;
+    procedure TestSqlOperators;
+    procedure TestSqlSymbols;
+    procedure TestComplexSqlQuery;
+    procedure TestSqlDataTypes;
+    procedure TestSqlFunctions;
+    procedure TestSqlJoins;
+    procedure TestHexNumbers;
+    procedure TestScientificNotation;
+    procedure TestMultiCharOperators;
+    procedure TestNestedComments;
+  end;
+
+implementation
+
+procedure TTestSqlHighlighter.SetUp;
+begin
+end;
+
+procedure TTestSqlHighlighter.TearDown;
+begin
+  // Nothing to do
+end;
+
+function TTestSqlHighlighter.DoSqlHighlighting(const source: string): TSyntaxTokenArray;
+var
+  highlighter: TSqlSyntaxHighlighter;
+begin
+  highlighter := TSqlSyntaxHighlighter.Create;
+  try
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+function TTestSqlHighlighter.DoSqlHighlightingWithMode(const source: string; mode: TSqlStringEscapeMode): TSyntaxTokenArray;
+var
+  highlighter: TSqlSyntaxHighlighter;
+begin
+  highlighter := TSqlSyntaxHighlighter.Create;
+  try
+    highlighter.StringEscapeMode := mode;
+    Result := highlighter.Execute(source);
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestSqlHighlighter.TestSqlKeywords;
+const
+  Keywords: array[0..9] of string = (
+    'SELECT', 'FROM', 'WHERE', 'INSERT', 'UPDATE', 'DELETE', 'CREATE', 'TABLE', 'JOIN', 'ORDER'
+  );
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(Keywords) do
+  begin
+    tokens := DoSqlHighlighting(Keywords[i]);
+    AssertEquals('Should have 1 token for ' + Keywords[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + Keywords[i], Keywords[i], tokens[0].Text);
+    AssertEquals(Keywords[i] + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+
+    // Test lowercase version
+    tokens := DoSqlHighlighting(LowerCase(Keywords[i]));
+    AssertEquals('Should have 1 token for ' + LowerCase(Keywords[i]), 1, Length(tokens));
+    AssertEquals('Token should be ' + LowerCase(Keywords[i]), LowerCase(Keywords[i]), tokens[0].Text);
+    AssertEquals(LowerCase(Keywords[i]) + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  end;
+end;
+
+procedure TTestSqlHighlighter.TestSqlStringsDoubledEscape;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple single-quoted string with doubled escaping (default mode)
+  tokens := DoSqlHighlighting('''Hello World''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be single-quoted string', '''Hello World''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test string with escaped single quote (doubled)
+  tokens := DoSqlHighlighting('''Can''''t do it''');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped string', '''Can''''t do it''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test double-quoted string with escaped double quote (doubled)
+  tokens := DoSqlHighlighting('"Say ""Hello"""');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped double-quoted string', '"Say ""Hello"""', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+end;
+
+procedure TTestSqlHighlighter.TestSqlStringsBackslashEscape;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test simple single-quoted string with backslash escaping
+  tokens := DoSqlHighlightingWithMode('''Hello World''', semBackslash);
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be single-quoted string', '''Hello World''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test string with escaped single quote (backslash)
+  tokens := DoSqlHighlightingWithMode('''Can\''t do it''', semBackslash);
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped string', '''Can\''t do it''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+
+  // Test string with escaped backslash
+  tokens := DoSqlHighlightingWithMode('''Path\\to\\file''', semBackslash);
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be escaped string', '''Path\\to\\file''', tokens[0].Text);
+  AssertEquals('Token should be string', Ord(shStrings), Ord(tokens[0].Kind));
+end;
+
+procedure TTestSqlHighlighter.TestSqlStringEscapeModeProperty;
+var
+  highlighter: TSqlSyntaxHighlighter;
+  tokens: TSyntaxTokenArray;
+begin
+  highlighter := TSqlSyntaxHighlighter.Create;
+  try
+    // Test default mode
+    AssertEquals('Default should be doubled escaping', Ord(semDoubled), Ord(highlighter.StringEscapeMode));
+
+    // Test setting backslash mode
+    highlighter.StringEscapeMode := semBackslash;
+    AssertEquals('Should be backslash escaping', Ord(semBackslash), Ord(highlighter.StringEscapeMode));
+
+    // Test that mode affects string parsing
+    tokens := highlighter.Execute('''Can\''t''');
+    AssertTrue('Should have at least 1 token', Length(tokens) >= 1);
+    AssertEquals('Should parse as single string token', '''Can\''t''', tokens[0].Text);
+    AssertEquals('Should be string token', Ord(shStrings), Ord(tokens[0].Kind));
+  finally
+    highlighter.Free;
+  end;
+end;
+
+procedure TTestSqlHighlighter.TestSqlNumbers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test integer
+  tokens := DoSqlHighlighting('123');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be integer', '123', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test decimal
+  tokens := DoSqlHighlighting('123.45');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be decimal', '123.45', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test scientific notation
+  tokens := DoSqlHighlighting('1.23E-4');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be scientific notation', '1.23E-4', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestSqlHighlighter.TestSqlComments;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundComment: Boolean;
+begin
+  // Test single-line comment
+  tokens := DoSqlHighlighting('-- This is a comment');
+  foundComment := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Kind = shComment) and (Pos('--', tokens[i].Text) = 1) then
+    begin
+      foundComment := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find single-line comment', foundComment);
+
+  // Test multi-line comment
+  tokens := DoSqlHighlighting('/* Multi-line comment */');
+  foundComment := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Kind = shComment) and (Pos('/*', tokens[i].Text) = 1) then
+    begin
+      foundComment := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find multi-line comment', foundComment);
+end;
+
+procedure TTestSqlHighlighter.TestSqlOperators;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundOperator: Boolean;
+begin
+  // Test equals operator
+  tokens := DoSqlHighlighting('=');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be equals', '=', tokens[0].Text);
+  AssertEquals('Token should be operator', Ord(shOperator), Ord(tokens[0].Kind));
+
+  // Test not equals operator
+  tokens := DoSqlHighlighting('!=');
+  foundOperator := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '!=') and (tokens[i].Kind = shOperator) then
+    begin
+      foundOperator := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find != operator', foundOperator);
+
+  // Test less than or equal
+  tokens := DoSqlHighlighting('<=');
+  foundOperator := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '<=') and (tokens[i].Kind = shOperator) then
+    begin
+      foundOperator := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find <= operator', foundOperator);
+end;
+
+procedure TTestSqlHighlighter.TestSqlSymbols;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test parentheses
+  tokens := DoSqlHighlighting('(');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be opening parenthesis', '(', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+
+  // Test semicolon
+  tokens := DoSqlHighlighting(';');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be semicolon', ';', tokens[0].Text);
+  AssertEquals('Token should be symbol', Ord(shSymbol), Ord(tokens[0].Kind));
+end;
+
+procedure TTestSqlHighlighter.TestComplexSqlQuery;
+var
+  tokens: TSyntaxTokenArray;
+  sqlQuery: string;
+  i: Integer;
+  hasKeywords, hasStrings, hasSymbols, hasNumbers: Boolean;
+begin
+  sqlQuery := 'SELECT name, age FROM users WHERE age > 18 AND name = ''John'';';
+  tokens := DoSqlHighlighting(sqlQuery);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 10);
+
+  // Check that we have different token types
+  hasKeywords := False;
+  hasStrings := False;
+  hasSymbols := False;
+  hasNumbers := False;
+
+  for i := 0 to High(tokens) do
+  begin
+    case tokens[i].Kind of
+      shKeyword: hasKeywords := True;
+      shStrings: hasStrings := True;
+      shSymbol: hasSymbols := True;
+      shNumbers: hasNumbers := True;
+    end;
+  end;
+
+  AssertTrue('Should contain keyword tokens', hasKeywords);
+  AssertTrue('Should contain string tokens', hasStrings);
+  AssertTrue('Should contain symbol tokens', hasSymbols);
+  AssertTrue('Should contain number tokens', hasNumbers);
+end;
+
+procedure TTestSqlHighlighter.TestSqlDataTypes;
+const
+  DataTypes: array[0..4] of string = ('INTEGER', 'VARCHAR', 'DATE', 'DECIMAL', 'BOOLEAN');
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(DataTypes) do
+  begin
+    tokens := DoSqlHighlighting(DataTypes[i]);
+    AssertEquals('Should have 1 token for ' + DataTypes[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + DataTypes[i], DataTypes[i], tokens[0].Text);
+    AssertEquals(DataTypes[i] + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  end;
+end;
+
+procedure TTestSqlHighlighter.TestSqlFunctions;
+const
+  Functions: array[0..4] of string = ('COUNT', 'SUM', 'MAX', 'MIN', 'AVG');
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(Functions) do
+  begin
+    tokens := DoSqlHighlighting(Functions[i]);
+    AssertEquals('Should have 1 token for ' + Functions[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + Functions[i], Functions[i], tokens[0].Text);
+    AssertEquals(Functions[i] + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  end;
+end;
+
+procedure TTestSqlHighlighter.TestSqlJoins;
+const
+  JoinKeywords: array[0..4] of string = ('JOIN', 'INNER', 'LEFT', 'RIGHT', 'OUTER');
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+begin
+  for i := 0 to High(JoinKeywords) do
+  begin
+    tokens := DoSqlHighlighting(JoinKeywords[i]);
+    AssertEquals('Should have 1 token for ' + JoinKeywords[i], 1, Length(tokens));
+    AssertEquals('Token should be ' + JoinKeywords[i], JoinKeywords[i], tokens[0].Text);
+    AssertEquals(JoinKeywords[i] + ' should be keyword', Ord(shKeyword), Ord(tokens[0].Kind));
+  end;
+end;
+
+procedure TTestSqlHighlighter.TestHexNumbers;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test hexadecimal number (some SQL dialects support $-prefixed hex)
+  tokens := DoSqlHighlighting('$DEADBEEF');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be hex number', '$DEADBEEF', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test shorter hex number
+  tokens := DoSqlHighlighting('$FF');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be hex number', '$FF', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestSqlHighlighter.TestScientificNotation;
+var
+  tokens: TSyntaxTokenArray;
+begin
+  // Test positive exponent
+  tokens := DoSqlHighlighting('1.23E+10');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be scientific notation', '1.23E+10', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+
+  // Test lowercase e
+  tokens := DoSqlHighlighting('2.5e-3');
+  AssertEquals('Should have 1 token', 1, Length(tokens));
+  AssertEquals('Token should be scientific notation', '2.5e-3', tokens[0].Text);
+  AssertEquals('Token should be number', Ord(shNumbers), Ord(tokens[0].Kind));
+end;
+
+procedure TTestSqlHighlighter.TestMultiCharOperators;
+var
+  tokens: TSyntaxTokenArray;
+  i: Integer;
+  foundOperator: Boolean;
+begin
+  // Test >= operator
+  tokens := DoSqlHighlighting('>=');
+  foundOperator := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '>=') and (tokens[i].Kind = shOperator) then
+    begin
+      foundOperator := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find >= operator', foundOperator);
+
+  // Test <> operator (not equal in some SQL dialects)
+  tokens := DoSqlHighlighting('<>');
+  foundOperator := False;
+  for i := 0 to High(tokens) do
+  begin
+    if (tokens[i].Text = '<>') and (tokens[i].Kind = shOperator) then
+    begin
+      foundOperator := True;
+      break;
+    end;
+  end;
+  AssertTrue('Should find <> operator', foundOperator);
+end;
+
+procedure TTestSqlHighlighter.TestNestedComments;
+var
+  tokens: TSyntaxTokenArray;
+  sqlWithComment: string;
+  i: Integer;
+  hasKeywords, hasComments: Boolean;
+begin
+  sqlWithComment := 'SELECT * /* This is a comment */ FROM table1;';
+  tokens := DoSqlHighlighting(sqlWithComment);
+
+  AssertTrue('Should have multiple tokens', Length(tokens) > 5);
+
+  hasKeywords := False;
+  hasComments := False;
+
+  for i := 0 to High(tokens) do
+  begin
+    case tokens[i].Kind of
+      shKeyword: hasKeywords := True;
+      shComment: hasComments := True;
+    end;
+  end;
+
+  AssertTrue('Should contain keyword tokens', hasKeywords);
+  AssertTrue('Should contain comment tokens', hasComments);
+end;
+
+initialization
+  RegisterTest(TTestSqlHighlighter);
+end.

packages/fpmake_add.inc

@@ -34,6 +34,7 @@
   add_fcl_web(ADirectory+IncludeTrailingPathDelimiter('fcl-web'));
   add_fcl_xml(ADirectory+IncludeTrailingPathDelimiter('fcl-xml'));
   add_fcl_pdf(ADirectory+IncludeTrailingPathDelimiter('fcl-pdf'));
+  add_fcl_syntax(ADirectory+IncludeTrailingPathDelimiter('fcl-syntax'));
   add_fcl_md(ADirectory+IncludeTrailingPathDelimiter('fcl-md'));
   add_fcl_css(ADirectory+IncludeTrailingPathDelimiter('fcl-css'));
   add_fcl_jsonschema(ADirectory+IncludeTrailingPathDelimiter('fcl-jsonschema'));

packages/fpmake_proc.inc

@@ -144,6 +144,12 @@ begin
 {$include fcl-json/fpmake.pp}
 end;
 
+procedure add_fcl_syntax(const ADirectory: string);
+begin
+  with Installer do
+{$include fcl-syntax/fpmake.pp}
+end;
+
 procedure add_fcl_md(const ADirectory: string);
 begin
   with Installer do

packages/fv/examples/keytest.pas

@@ -0,0 +1,230 @@
+PROGRAM KeyTest;
+
+{ Set source file encoding to UTF-8 for correct handling of Unicode strings }
+{$codepage UTF8}
+
+USES
+  {$ifdef unix}BaseUnix,{$endif}
+  Objects,    { Base objects, TObject }
+  UDrivers,   { System drivers (keyboard, mouse, video), Unicode version }
+  UViews,     { Base classes for views (TView, TWindow), Unicode version }
+  UMenus,     { Menu elements (TMenuBar, TMenu), Unicode version }
+  UApp,       { Main application class TApplication, Unicode version }
+  cwstring,   { Unicode string handling }
+  SysUtils;   { For the Format function }
+
+TYPE
+  PKeyInfoView = ^TKeyInfoView;
+  {
+    TKeyInfoView is a special view that will display
+    information about the last keyboard event.
+  }
+  TKeyInfoView = OBJECT(TView)
+    LastKeyEvent: TEvent; { Store the last event here }
+    TVInputValue: UnicodeString;
+    CONSTRUCTOR Init(VAR Bounds: TRect);
+    PROCEDURE Draw; VIRTUAL;
+    PROCEDURE UpdateInfo(CONST Event: TEvent);
+  END;
+
+  PKeyTestApp = ^TKeyTestApp;
+  {
+    TKeyTestApp is the main class of our application.
+  }
+  TKeyTestApp = OBJECT(TApplication)
+    KeyInfoView: PKeyInfoView; { Pointer to our view for displaying information }
+    CONSTRUCTOR Init;
+    PROCEDURE HandleEvent(VAR Event: TEvent); VIRTUAL;
+    PROCEDURE InitMenuBar; VIRTUAL;
+    PROCEDURE InitStatusLine; VIRTUAL;
+  END;
+
+VAR
+  Cnt: Integer;
+
+{---------------------------------------------------------------------------}
+{                        TKeyInfoView OBJECT METHODS                        }
+{---------------------------------------------------------------------------}
+
+CONSTRUCTOR TKeyInfoView.Init(VAR Bounds: TRect);
+BEGIN
+  Inherited Init(Bounds);
+  Options := Options OR ofSelectable; { Make the View selectable so it can get focus }
+  EventMask := $FFFF;                 { Accept all event types }
+  FillChar(LastKeyEvent, SizeOf(TEvent), 0); { Initialize with zeros }
+  LastKeyEvent.What := evNothing;     { No events initially }
+END;
+
+{ Function to format the modifier key state byte into a readable string }
+FUNCTION FormatShiftState(State: Byte): UnicodeString;
+VAR S: UnicodeString;
+BEGIN
+  S := '';
+  IF (State AND kbRightShift) <> 0 THEN S := S + 'RightShift ';
+  IF (State AND kbLeftShift) <> 0 THEN S := S + 'LeftShift ';
+  IF (State AND kbCtrlShift) <> 0 THEN S := S + 'Ctrl ';
+  IF (State AND kbAltShift) <> 0 THEN S := S + 'Alt ';
+  IF (State AND kbScrollState) <> 0 THEN S := S + 'ScrollLock ';
+  IF (State AND kbNumState) <> 0 THEN S := S + 'NumLock ';
+  IF (State AND kbCapsState) <> 0 THEN S := S + 'CapsLock ';
+  IF (State AND kbInsState) <> 0 THEN S := S + 'Insert ';
+  IF S = '' THEN S := '(none)';
+  FormatShiftState := S;
+END;
+
+PROCEDURE TKeyInfoView.Draw;
+VAR
+  B: TDrawBuffer;
+  Line: UnicodeString;
+  Y: Integer;
+  Color: Byte;
+BEGIN
+  Color := GetColor(1);
+  { Fill the view's background with spaces using the current color }
+  MoveChar(B, ' ', Color, Size.X);
+  FOR Y := 0 TO Size.Y - 1 DO
+    WriteLine(0, Y, Size.X, 1, B);
+
+  { Set the color for the text }
+  Color := GetColor(2);
+
+  { If no key has been pressed yet, display a prompt }
+  IF LastKeyEvent.What = evNothing THEN
+  BEGIN
+    Line := 'Press any key to analyze...';
+    MoveStr(B, Line, Color);
+    WriteLine(1, 1, StrWidth(Line), 1, B);
+    Exit;
+  END;
+
+  Cnt := Cnt + 1;
+
+  { Display all information from the TEvent record }
+  Line := Format('Event.What: $%4.4x (evKeyDown)', [LastKeyEvent.What]);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 1, StrWidth(Line), 1, B);
+
+  Line := Format('KeyCode:     $%4.4x', [LastKeyEvent.KeyCode]);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 2, StrWidth(Line), 1, B);
+
+  Line := Format('CharCode:    ''%s'' ($%2.2x)', [LastKeyEvent.CharCode, Ord(LastKeyEvent.CharCode)]);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 3, StrWidth(Line), 1, B);
+
+  Line := Format('ScanCode:    $%2.2x', [LastKeyEvent.ScanCode]);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 4, StrWidth(Line), 1, B);
+
+  Line := Format('UnicodeChar: ''%s'' (U+%4.4x)', [LastKeyEvent.UnicodeChar, Ord(LastKeyEvent.UnicodeChar)]);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 5, StrWidth(Line), 1, B);
+
+  Line := 'KeyShift:    $' + IntToHex(LastKeyEvent.KeyShift, 2);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 6, StrWidth(Line), 1, B);
+
+  Line := '             ' + FormatShiftState(LastKeyEvent.KeyShift);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 7, StrWidth(Line), 1, B);
+
+  Line := 'TV_INPUT Env Var: ';
+  if TVInputValue <> '' then
+    Line := Line + TVInputValue
+  else
+    Line := Line + '(not set)';
+  MoveStr(B, Line, Color);
+  WriteLine(1, 9, StrWidth(Line), 1, B);
+
+  Line := 'Count: ' + IntToStr(Cnt);
+  MoveStr(B, Line, Color);
+  WriteLine(1, 11, StrWidth(Line), 1, B);
+END;
+
+PROCEDURE TKeyInfoView.UpdateInfo(CONST Event: TEvent);
+BEGIN
+  LastKeyEvent := Event;
+  DrawView; { Request a redraw }
+END;
+
+{---------------------------------------------------------------------------}
+{                        TKeyTestApp OBJECT METHODS                         }
+{---------------------------------------------------------------------------}
+
+CONSTRUCTOR TKeyTestApp.Init;
+VAR
+  R, ViewRect: TRect;
+  MainWindow: PWindow;
+BEGIN
+  Inherited Init;
+
+  { Create the main window that will contain our View }
+  GetExtent(R);
+  R.Grow(-5, -5); { Shrink it a bit to have a margin from the screen edges }
+  MainWindow := New(PWindow, Init(R, 'Keyboard Event Inspector', wnNoNumber));
+
+  { Create our View for displaying information. Its coordinates must be relative
+    to the parent window. To fill the entire client area, its size should be
+    2 chars less in width and height, and its origin should be at (1,1). }
+  ViewRect.Assign(1, 1, MainWindow^.Size.X - 1, MainWindow^.Size.Y - 1);
+  KeyInfoView := New(PKeyInfoView, Init(ViewRect));
+  KeyInfoView^.TVInputValue := {$ifdef unix}fpgetenv('TV_INPUT'){$else unix}''{$endif};
+  MainWindow^.Insert(KeyInfoView);
+
+  { Insert the window into the Desktop }
+  DeskTop^.Insert(MainWindow);
+END;
+
+PROCEDURE TKeyTestApp.HandleEvent(VAR Event: TEvent);
+BEGIN
+  { First, call the ancestor's handler so standard things like menus work }
+  Inherited HandleEvent(Event);
+
+  { If the event is a key press, update the info in our View }
+  IF Event.What = evKeyDown THEN
+  BEGIN
+    IF Assigned(KeyInfoView) THEN
+      KeyInfoView^.UpdateInfo(Event);
+    { Don't clear the event, so standard handlers (like Alt+X) also get to process it }
+  END;
+END;
+
+PROCEDURE TKeyTestApp.InitMenuBar;
+VAR R: TRect;
+BEGIN
+  GetExtent(R);
+  R.B.Y := R.A.Y + 1;
+  MenuBar := New(PMenuBar, Init(R, NewMenu(
+    NewSubMenu('~F~ile', hcNoContext, NewMenu(
+      NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcNoContext, NIL)
+    ), NIL)
+  )));
+END;
+
+PROCEDURE TKeyTestApp.InitStatusLine;
+var
+   R: TRect;
+begin
+  GetExtent(R);
+  R.A.Y := R.B.Y - 1;
+  New(StatusLine,
+    Init(R,
+      NewStatusDef(0, $FFFF,
+        NewStatusKey('~Alt+X~ Exit', kbAltX, cmQuit, nil),
+        nil
+      )
+    )
+  );
+end;
+
+{---------------------------------------------------------------------------}
+{                           MAIN PROGRAM BLOCK                              }
+{---------------------------------------------------------------------------}
+VAR
+  MyApp: TKeyTestApp;
+BEGIN
+  Cnt := 0;
+  MyApp.Init;
+  MyApp.Run;
+  MyApp.Done;
+END.

packages/fv/examples/testapp.pas

@@ -1,5 +1,7 @@
 PROGRAM testapp;
 
+{$ifdef unix}{$DEFINE FV_UNICODE}{$endif}
+
 { $UNDEF OS2PM}
 
 {$IFDEF OS2PM}
@@ -41,10 +43,16 @@ PROGRAM testapp;
 {$IFDEF OS2PM}
      {$IFDEF OS_OS2} Os2Def, os2PmApi,  {$ENDIF}
 {$ENDIF OS2PM}
-     Objects, Drivers, Views, Editors, Menus, Dialogs, App,             { Standard GFV units }
+
+{$ifdef FV_UNICODE}
+     Objects, UDrivers, UViews, UEditors, UMenus, UDialogs, UApp,             { Standard GFV units }
+     FVConsts, UAsciiTab,
+     UGadgets, UTimedDlg, UMsgBox, UStdDlg, cwstring;
+{$else FV_UNICODE}
+     Objects, Drivers, Views, Editors, Menus, Dialogs, App,                   { Standard GFV units }
      FVConsts, AsciiTab,
      Gadgets, TimedDlg, MsgBox, StdDlg;
-
+{$endif FV_UNICODE}
 
 CONST cmAppToolbar = 1000;
       cmWindow1    = 1001;
@@ -384,7 +392,12 @@ END;
 
 PROCEDURE TTvDemo.Window3;
 VAR R: TRect; P: PGroup; B: PScrollBar;
-    List: PStrCollection; Lb: PListBox;
+{$ifdef FV_UNICODE}
+    List: PUnicodeStringCollection;
+{$else FV_UNICODE}
+    List: PStrCollection;
+{$endif FV_UNICODE}
+    Lb: PListBox;
 BEGIN
    { Create a basic dialog box. In it are buttons,  }
    { list boxes, scrollbars, inputlines, checkboxes }
@@ -412,6 +425,19 @@ BEGIN
      R.Assign(25, 8, 40, 14);                         { Assign area }
      Lb := New(PListBox, Init(R, 1, B));              { Create listbox }
      P^.Insert(Lb);                                   { Insert listbox }
+{$ifdef FV_UNICODE}
+     List := New(PUnicodeStringCollection, Init(10, 5));        { Create string list }
+     List^.AtInsert(0, 'Zebra');              { Insert text }
+     List^.AtInsert(1, 'Apple');              { Insert text }
+     List^.AtInsert(2, 'Third');              { Insert text }
+     List^.AtInsert(3, 'Peach');              { Insert text }
+     List^.AtInsert(4, 'Rabbit');             { Insert text }
+     List^.AtInsert(5, 'Item six');           { Insert text }
+     List^.AtInsert(6, 'Jaguar');             { Insert text }
+     List^.AtInsert(7, 'Melon');              { Insert text }
+     List^.AtInsert(8, 'Ninth');              { Insert text }
+     List^.AtInsert(9, 'Last item');          { Insert text }
+{$else FV_UNICODE}
      List := New(PStrCollection, Init(10, 5));        { Create string list }
      List^.AtInsert(0, NewStr('Zebra'));              { Insert text }
      List^.AtInsert(1, NewStr('Apple'));              { Insert text }
@@ -423,6 +449,7 @@ BEGIN
      List^.AtInsert(7, NewStr('Melon'));              { Insert text }
      List^.AtInsert(8, NewStr('Ninth'));              { Insert text }
      List^.AtInsert(9, NewStr('Last item'));          { Insert text }
+{$endif FV_UNICODE}
      Lb^.Newlist(List);                               { Give list to listbox }
      R.Assign(30, 2, 40, 4);                          { Assign area }
      P^.Insert(New(PButton, Init(R, '~O~k', 100, bfGrabFocus)));{ Create okay button }

packages/fv/src/dialogs.inc

@@ -1082,15 +1082,15 @@ resourcestring  slCancel='Cancel';
 
 {$IFDEF FPC_DOTTEDUNITS}
 {$ifdef FV_UNICODE}
-USES FreeVision.Uapp,FreeVision.Uhistlist;                             { Standard GFV unit }
+USES FreeVision.Uapp,FreeVision.Uhistlist,FreeVision.Ufvclip;                            { Standard GFV unit }
 {$else FV_UNICODE}
-USES FreeVision.App,FreeVision.Histlist;                               { Standard GFV unit }
+USES FreeVision.App,FreeVision.Histlist,FreeVision.Fvclip;                               { Standard GFV unit }
 {$endif FV_UNICODE}
 {$ELSE FPC_DOTTEDUNITS}
 {$ifdef FV_UNICODE}
-USES UApp,UHistList;                             { Standard GFV unit }
+USES UApp,UHistList,UFVClip;                            { Standard GFV unit }
 {$else FV_UNICODE}
-USES App,HistList;                               { Standard GFV unit }
+USES App,HistList,FVClip;                               { Standard GFV unit }
 {$endif FV_UNICODE}
 {$ENDIF FPC_DOTTEDUNITS}
 
@@ -1698,8 +1698,27 @@ END;
 {---------------------------------------------------------------------------}
 PROCEDURE TInputLine.HandleEvent (Var Event: TEvent);
 CONST PadKeys = [$47, $4B, $4D, $4F, $73, $74];
-VAR WasAppending: Boolean; ExtendBlock: Boolean; OldData: String;
+CONST
+  DelimiterChars: SET OF AnsiChar =
+    [' ', '.', ',', ';', ':', '!', '?', '-', '_', '/', '\',
+     '(', ')', '[', ']', '{', '}', '<', '>',
+     '"', '''', '`', '|', '@', '#', '$', '%', '^', '&',
+     '*', '+', '=', '~', #9, #10, #13];
+VAR WasAppending: Boolean; ExtendBlock: Boolean; OldData: Sw_String;
 Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Sw_Integer;
+SelectedTextAnsi: AnsiString; // For SetGlobalClipboardData
+S: Sw_String;
+Len, I: Integer;
+
+  FUNCTION IsDelimiter(Ch: Sw_Char): Boolean;
+  BEGIN
+    // Check if the character is in the predefined set of delimiters.
+    // This is safe for Unicode chars as punctuation is in the AnsiChar range.
+    IF Ch <= #255 THEN
+      Result := AnsiChar(Ch) IN DelimiterChars
+    ELSE
+      Result := False;
+  END;
 
    FUNCTION MouseDelta: Sw_Integer;
    VAR Mouse : TPOint;
@@ -1918,25 +1937,91 @@ BEGIN
              ExtendBlock := True;                     { Extended block true }
          End Else ExtendBlock := False;               { No extended block }
          Case Event.KeyCode Of
+           kbCtrlIns: // COPY command
+             begin
+               if (Data <> Sw_PString_Empty) and (SelStart < SelEnd) then
+               begin
+                 // Copy selected text to OSC 52 clipboard
+                 SelectedTextAnsi := AnsiString(Copy(Data Sw_PString_DeRef, SelStart + 1, SelEnd - SelStart));
+                 if Length(SelectedTextAnsi) > 0 then
+                 begin
+                   SetGlobalClipboardData(PAnsiChar(SelectedTextAnsi), Length(SelectedTextAnsi));
+                 end;
+               end;
+             end;
+           kbShiftDel: // CUT command
+             begin
+               if (Data <> Sw_PString_Empty) and (SelStart < SelEnd) then
+               begin
+                 // Copy selected text to OSC 52 clipboard
+                 SelectedTextAnsi := AnsiString(Copy(Data Sw_PString_DeRef, SelStart + 1, SelEnd - SelStart));
+                 if Length(SelectedTextAnsi) > 0 then
+                 begin
+                     SetGlobalClipboardData(PAnsiChar(SelectedTextAnsi), Length(SelectedTextAnsi));
+                 end;
+                 DeleteSelect; // Then delete the selection
+                 CheckValid(True); // Validate after deletion
+               end;
+             end;
            kbLeft: If (CurPos > 0) Then Dec(CurPos);  { Move cursor left }
            kbRight: If (Data <> Sw_PString_Empty) AND   { Move right cursor }
            (CurPos < Length(Data Sw_PString_DeRef)) Then Begin        { Check not at end }
              Inc(CurPos);                             { Move cursor }
              CheckValid(True);                        { Check if valid }
            End;
+           kbCtrlLeft: Begin
+             if (Data <> Sw_PString_Empty) and (CurPos > 0) then
+             begin
+               S := Data Sw_PString_DeRef;
+               I := 1;
+               while (I <= Length(S)) and IsDelimiter(S[I]) do Inc(I);
+               if CurPos = I - 1 then
+                 CurPos := 0
+               else
+               begin
+                 I := CurPos;
+                 // Skip any delimiters immediately to the left
+                 while (I > 0) and IsDelimiter(S[I]) do Dec(I);
+                 // Skip any word characters to the left
+                 while (I > 0) and not IsDelimiter(S[I]) do Dec(I);
+                 CurPos := I;
+               end;
+             end;
+           End;
+           kbCtrlRight: Begin
+             if Data <> Sw_PString_Empty then
+             begin
+               S := Data Sw_PString_DeRef;
+               Len := Length(S);
+               I := Len;
+               while (I > 0) and IsDelimiter(S[I]) do Dec(I);
+               if CurPos = I then
+                 CurPos := Len
+               else
+               begin
+                 I := CurPos;
+                 while (I < Len) and IsDelimiter(S[I+1]) do Inc(I);
+                 while (I < Len) and not IsDelimiter(S[I+1]) do Inc(I);
+                 CurPos := I;
+               end;
+             end;
+           End;
            kbHome: CurPos := 0;                       { Move to line start }
            kbEnd: Begin                               { Move to line end }
              If Data = Sw_PString_Empty Then CurPos := 0  { Invalid data ptr }
                Else CurPos := Length(Data Sw_PString_DeRef);  { Set cursor position }
              CheckValid(True);                        { Check if valid }
            End;
-           kbBack: If (Data <> Sw_PString_Empty) AND (CurPos > 0)  { Not at line start }
-           Then Begin
-             Delete(Data Sw_PString_DeRef, CurPos, 1);  { Backspace over AnsiChar }
-             Dec(CurPos);                             { Move cursor back one }
-             If (FirstPos > 0) Then Dec(FirstPos);    { Move first position }
-             CheckValid(True);                        { Check if valid }
-           End;
+           kbBack: If Data <> Sw_PString_Empty Then
+             Begin
+               If (SelStart = SelEnd) AND (CurPos > 0) Then
+               Begin
+                 SelStart := CurPos - 1;
+                 SelEnd := CurPos;
+               End;
+               DeleteSelect;
+               CheckValid(True);
+             End;
            kbDel: If Data <> Sw_PString_Empty Then Begin  { Delete character }
              If (SelStart = SelEnd) Then              { Select all on }
                If (CurPos < Length(Data Sw_PString_DeRef)) Then Begin { Cursor not at end }
@@ -1951,6 +2036,7 @@ BEGIN
 {$ifdef FV_UNICODE}
            Else Case Event.UnicodeChar Of
              ' '..#$FFFF:   { Character key }
+               if (NOT (GetShiftState AND $04 <> 0)) then { Only insert if Ctrl is not pressed }
                Begin
                  If (State AND sfCursorIns <> 0) Then
                    Delete(Data Sw_PString_DeRef, CurPos + 1, 1) Else    { Overwrite character }
@@ -1975,22 +2061,26 @@ BEGIN
            End
 {$else FV_UNICODE}
            Else Case Event.CharCode Of
-             ' '..#255: If Data <> Sw_PString_Empty Then Begin   { Character key }
-               If (State AND sfCursorIns <> 0) Then
-                 Delete(Data Sw_PString_DeRef, CurPos + 1, 1) Else    { Overwrite character }
-                 DeleteSelect;                        { Deselect selected }
-               If CheckValid(True) Then Begin         { Check data valid }
-                 If (Length(Data Sw_PString_DeRef) < MaxLen) Then     { Must not exceed maxlen }
-                 Begin
-                   If (FirstPos > CurPos) Then
-                     FirstPos := CurPos;              { Advance first position }
-                   Inc(CurPos);                       { Increment cursor }
-                   Insert(Event.CharCode, Data Sw_PString_DeRef,
-                     CurPos);                         { Insert the character }
+             ' '..#255:
+               If (NOT (GetShiftState AND $04 <> 0)) Then { Only insert if Ctrl is not pressed }
+               Begin
+                 If Data <> Sw_PString_Empty Then Begin   { Character key }
+                   If (State AND sfCursorIns <> 0) Then
+                     Delete(Data Sw_PString_DeRef, CurPos + 1, 1) Else    { Overwrite character }
+                     DeleteSelect;                        { Deselect selected }
+                   If CheckValid(True) Then Begin         { Check data valid }
+                     If (Length(Data Sw_PString_DeRef) < MaxLen) Then     { Must not exceed maxlen }
+                     Begin
+                       If (FirstPos > CurPos) Then
+                         FirstPos := CurPos;              { Advance first position }
+                       Inc(CurPos);                       { Increment cursor }
+                       Insert(Event.CharCode, Data Sw_PString_DeRef,
+                         CurPos);                         { Insert the character }
+                     End;
+                     CheckValid(False);                   { Check data valid }
+                   End;
                  End;
-                 CheckValid(False);                   { Check data valid }
                End;
-             End;
              ^Y: If Data <> Sw_PString_Empty Then Begin          { Clear all data }
                 Data Sw_PString_DeRef := '';          { Set empty string }
                 CurPos := 0;                          { Cursor to start }
@@ -3674,6 +3764,7 @@ BEGIN
    Inherited Init(Bounds, '', wnNoNumber);            { Call ancestor }
    Flags := wfClose;                                  { Close flag only }
    InitViewer(HistoryId);                             { Create list view }
+   SelectNext(False);
 END;
 
 {--THistoryWindow-----------------------------------------------------------}

packages/fv/src/drivers.inc

@@ -1358,6 +1358,13 @@ begin
            $e00d : keycode:=kbEnter;
          end;
        end;
+     if (essAlt in key.ShiftState) and (key.UnicodeChar <> #0) then
+     begin
+       // FIX: For Alt+Key combinations, build the KeyCode using the Unicode character
+       // instead of relying on the scancode-based character, which is wrong for non-latin layouts.
+       // The high byte keeps the scan code, the low byte gets the actual character code.
+       keycode := (keycode and $FF00) or (ord(key.UnicodeChar) and $FF);
+     end;
      Event.What:=evKeyDown;
      Event.KeyCode:=keycode;
      Event.CharCode:=chr(keycode and $ff);

packages/fv/src/editors.inc

@@ -246,6 +246,7 @@ type
     PendingWChar   : Sw_Char;  { hold first part of double wide char until next InsertChar }
 {$endif FV_UNICODE}
 
+    function   IsDelimiter(Ch: AnsiChar): Boolean;
     function   BuildLookups(LinePtr : Sw_Word; lookUpCharToPosX, lookUpPosXToChar : PLineLookup):Sw_Word;
     procedure  Center_Text (Select_Mode : Byte);
     function   CharPos (P, Target : Sw_Word) : Sw_Integer;
@@ -486,17 +487,17 @@ implementation
 uses
   TP.DOS,
 {$ifdef FV_UNICODE}
-  System.Console.Video, System.Unicode.Graphemebreakproperty, FreeVision.Uapp, FreeVision.Ustddlg, FreeVision.Umsgbox;
+  System.Console.Video, System.Unicode.Graphemebreakproperty, FreeVision.Uapp, FreeVision.Ustddlg, FreeVision.Umsgbox, FreeVision.Ufvclip;
 {$else FV_UNICODE}
-  FreeVision.App, FreeVision.Stddlg, FreeVision.Msgbox;
+  FreeVision.App, FreeVision.Stddlg, FreeVision.Msgbox, FreeVision.Fvclip;
 {$ENDIF}
 {$ELSE FPC_DOTTEDUNITS}
 uses
   Dos,
 {$ifdef FV_UNICODE}
-  Video, Graphemebreakproperty, uApp, uStdDlg, uMsgBox;
+  Video, Graphemebreakproperty, uApp, uStdDlg, uMsgBox, UFVClip;
 {$else FV_UNICODE}
-  App, StdDlg, MsgBox;
+  App, StdDlg, MsgBox, FVClip;
 {$ENDIF}
 {$ENDIF FPC_DOTTEDUNITS}
 
@@ -555,7 +556,9 @@ CONST
   sfSearchFailed = NotFoundValue;
 
   { Arrays that hold all the command keys and options. }
-  FirstKeys : array[0..46 * 2] of Word = (46, Ord (^A),    cmWordLeft,
+  { Editor command constants for new features. }
+  cmSelectAll   = 250;
+  FirstKeys : array[0..46 * 2] of Word = (46, Ord (^A),    cmSelectAll,
                                               Ord (^B),    cmReformPara,
                                               Ord (^C),    cmPageDown,
                                               Ord (^D),    cmCharRight,
@@ -1722,7 +1725,30 @@ end; {Check_For_Word_Wrap}
 
 
 function TEditor.ClipCopy : Boolean;
+var
+  SelectedTextAnsi: AnsiString;
+  Len: Sw_Word;
 begin
+  if HasSelection then
+  begin
+    Len := SelEnd - SelStart;
+    SetLength(SelectedTextAnsi, Len);
+    if Len > 0 then
+    begin
+      if SelEnd <= CurPtr then
+        Move(Buffer^[SelStart], SelectedTextAnsi[1], Len)
+      else if SelStart >= CurPtr then
+        Move(Buffer^[SelStart + GapLen], SelectedTextAnsi[1], Len)
+      else
+      begin
+        Move(Buffer^[SelStart], SelectedTextAnsi[1], CurPtr - SelStart);
+        Move(Buffer^[CurPtr + GapLen], SelectedTextAnsi[1 + (CurPtr - SelStart)], SelEnd - CurPtr);
+      end;
+      if Length(SelectedTextAnsi) > 0 then
+        SetGlobalClipboardData(PAnsiChar(SelectedTextAnsi), Length(SelectedTextAnsi));
+    end;
+  end;
+
   ClipCopy := False;
   if Assigned(Clipboard) and (Clipboard <> @Self) then
    begin
@@ -2113,6 +2139,17 @@ end; { TEditor.Find }
 { Functon have functionality only in unicode version of fv. }
 { It mimic FormatLine but instead of drawing line gather }
 { information on character posisionings }
+const
+  DelimiterChars: SET OF AnsiChar =
+    [' ', '.', ',', ';', ':', '!', '?', '-', '_', '/', '\',
+     '(', ')', '[', ']', '{', '}', '<', '>',
+     '"', '''', '`', '|', '@', '#', '$', '%', '^', '&',
+     '*', '+', '=', '~', #9, #10, #13];
+
+function TEditor.IsDelimiter(Ch: AnsiChar): Boolean;
+begin
+  Result := Ch in DelimiterChars;
+end;
 function TEditor.BuildLookups(LinePtr : Sw_Word; lookUpCharToPosX, lookUpPosXToChar : PLineLookup):Sw_Word;
 var idxpos : sw_word;
     Width  : Sw_Integer;
@@ -2595,47 +2632,50 @@ begin
       end; { evMouseDown }
 
     evKeyDown:
-{$ifdef FV_UNICODE}
-      Case Event.UnicodeChar Of
-        ' '..#$FFFF:   { Character key }
-          Begin
-            Lock;
-            if Overwrite and not HasSelection then
-              if CurPtr <> LineEnd (CurPtr) then
-                SelEnd := NextChar (CurPtr);
-            InsertChar(Event.UnicodeChar);
-            if Word_Wrap then
-              Check_For_Word_Wrap (SelectMode, CenterCursor);
-            TrackCursor (CenterCursor);
-            Unlock;
+      if (NOT (GetShiftState AND $04 <> 0)) then { Only insert if Ctrl is not pressed }
+      begin
+    {$ifdef FV_UNICODE}
+        Case Event.UnicodeChar Of
+          ' '..#$FFFF:   { Character key }
+            Begin
+              Lock;
+              if Overwrite and not HasSelection then
+                if CurPtr <> LineEnd (CurPtr) then
+                  SelEnd := NextChar (CurPtr);
+              InsertChar(Event.UnicodeChar);
+              if Word_Wrap then
+                Check_For_Word_Wrap (SelectMode, CenterCursor);
+              TrackCursor (CenterCursor);
+              Unlock;
+            End;
+     {
+          ^Y: If Data <> Sw_PString_Empty Then Begin          { Clear all data }
+             Data Sw_PString_DeRef := '';          { Set empty string }
+             CurPos := 0;                          { Cursor to start }
           End;
-   {
-        ^Y: If Data <> Sw_PString_Empty Then Begin          { Clear all data }
-           Data Sw_PString_DeRef := '';          { Set empty string }
-           CurPos := 0;                          { Cursor to start }
+      }
+          Else Exit;                               { Unused key }
         End;
-    }
-        Else Exit;                               { Unused key }
-      End;
-{$else FV_UNICODE}
-      case Event.CharCode of
-        #32..#255:
-          begin
-            Lock;
-            if Overwrite and not HasSelection then
-              if CurPtr <> LineEnd (CurPtr) then
-                SelEnd := NextChar (CurPtr);
-            InsertText (@Event.CharCode, 1, False);
-            if Word_Wrap then
-              Check_For_Word_Wrap (SelectMode, CenterCursor);
-            TrackCursor (CenterCursor);
-            Unlock;
-          end;
+    {$else FV_UNICODE}
+        case Event.CharCode of
+          #32..#255:
+            begin
+              Lock;
+              if Overwrite and not HasSelection then
+                if CurPtr <> LineEnd (CurPtr) then
+                  SelEnd := NextChar (CurPtr);
+              InsertText (@Event.CharCode, 1, False);
+              if Word_Wrap then
+                Check_For_Word_Wrap (SelectMode, CenterCursor);
+              TrackCursor (CenterCursor);
+              Unlock;
+            end;
 
-      else
-        Exit;
-      end; { evKeyDown }
-{$endif}
+        else
+          Exit;
+        end; { evKeyDown }
+    {$endif}
+      end;
 
     evCommand:
       case Event.Command of
@@ -2646,6 +2686,7 @@ begin
         begin
           Lock;
           case Event.Command of
+            cmSelectAll   : begin SetSelect(0, BufLen, False); TrackCursor(True); end;
             cmCut         : ClipCut;
             cmCopy        : ClipCopy;
             cmPaste       : ClipPaste;
@@ -2731,6 +2772,7 @@ begin
           if (Event.Command <> cmNewLine)   and
              (Event.Command <> cmBackSpace) and
              (Event.Command <> cmTabKey)    and
+             (Event.Command <> cmSelectAll) and
               Modified then
             Remove_EOL_Spaces (SelectMode);
           Unlock;
@@ -3225,13 +3267,36 @@ end; { TEditor.NextLine }
 
 
 function TEditor.NextWord (P : Sw_Word) : Sw_Word;
+var
+  LineStartPtr, LineEndPtr, LastSignificantPtr: Sw_Word;
 begin
-  { skip word }
-  while (P < BufLen) and (BufChar (P) in WordChars) do
-    P := NextChar (P);
-  { skip spaces }
-  while (P < BufLen) and not (BufChar (P) in WordChars) do
-    P := NextChar (P);
+  LineEndPtr   := LineEnd(P);
+
+  // Special case: if cursor is on the last word of the line, jump to the end of the line.
+  if P < LineEndPtr then
+  begin
+    LineStartPtr := LineStart(P);
+    // Find the position of the last significant character on the line.
+    LastSignificantPtr := LineEndPtr;
+    if LastSignificantPtr > LineStartPtr then
+      LastSignificantPtr := PrevChar(LastSignificantPtr); // Move before any EOL characters.
+
+    while (LastSignificantPtr > LineStartPtr) and IsDelimiter(BufChar(LastSignificantPtr)) do
+      LastSignificantPtr := PrevChar(LastSignificantPtr);
+
+    // If cursor is at or after the last significant character, the next word is the end of the line.
+    if P >= LastSignificantPtr then
+    begin
+      NextWord := LineEndPtr;
+      exit;
+    end;
+  end;
+
+  // Default to original behavior (which can cross lines).
+  while (P < BufLen) and IsDelimiter(BufChar(P)) do
+    P := NextChar(P);
+  while (P < BufLen) and not IsDelimiter(BufChar(P)) do
+    P := NextChar(P);
   NextWord := P;
 end; { TEditor.NextWord }
 
@@ -3301,13 +3366,34 @@ end; { TEditor.PrevLine }
 
 
 function TEditor.PrevWord (P : Sw_Word) : Sw_Word;
+var
+  LineStartPtr, FirstSignificantPtr: Sw_Word;
 begin
-  { skip spaces }
-  while (P > 0) and not (BufChar (PrevChar (P)) in WordChars) do
-    P := PrevChar (P);
-  { skip word }
-  while (P > 0) and (BufChar (PrevChar (P)) in WordChars) do
-    P := PrevChar (P);
+  LineStartPtr := LineStart(P);
+
+  // Special case: if cursor is on the first word of the line, jump to the start of the line.
+  if P > LineStartPtr then
+  begin
+    // Find the first significant character on the current line.
+    FirstSignificantPtr := LineStartPtr;
+    while (FirstSignificantPtr < P) and IsDelimiter(BufChar(FirstSignificantPtr)) do
+      FirstSignificantPtr := NextChar(FirstSignificantPtr);
+
+    // If the cursor is at or before the first significant character, move to the absolute beginning of the line.
+    if P <= FirstSignificantPtr then
+    begin
+      PrevWord := LineStartPtr;
+      exit;
+    end;
+  end;
+
+  // Default to original behavior (which can cross lines).
+  // Skip any delimiters immediately to the left
+  while (P > 0) and IsDelimiter(BufChar(PrevChar(P))) do
+    P := PrevChar(P);
+  // Skip any word characters to the left
+  while (P > 0) and not IsDelimiter(BufChar(PrevChar(P))) do
+    P := PrevChar(P);
   PrevWord := P;
 end; { TEditor.PrevWord }
 
@@ -4011,6 +4097,7 @@ begin
       SetCmdState (cmPaste, assigned(Clipboard) and (Clipboard^.HasSelection));
     end;
   SetCmdState (cmClear, HasSelection);
+  SetCmdState (cmSelectAll, True);
   SetCmdState (cmFind, True);
   SetCmdState (cmReplace, True);
   SetCmdState (cmSearchAgain, True);

packages/fv/src/menus.inc

@@ -79,9 +79,9 @@ USES
    {$ENDIF}
 
 {$ifdef FV_UNICODE}
-   System.Objects, FreeVision.Udrivers, FreeVision.Uviews, FreeVision.Ufvcommon, FreeVision.Fvconsts;               { GFV standard units }
+   System.Objects, FreeVision.Udrivers, FreeVision.Uviews, FreeVision.Ufvcommon, FreeVision.Fvconsts, System.SysUtils; { GFV standard units }
 {$else FV_UNICODE}
-   System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.Fvcommon, FreeVision.Fvconsts;                 { GFV standard units }
+   System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.Fvcommon, FreeVision.Fvconsts;                     { GFV standard units }
 {$endif FV_UNICODE}
 {$ELSE FPC_DOTTEDUNITS}
 USES
@@ -98,7 +98,7 @@ USES
    {$ENDIF}
 
 {$ifdef FV_UNICODE}
-   objects, udrivers, uviews, UFVCommon, fvconsts;               { GFV standard units }
+   objects, udrivers, uviews, UFVCommon, fvconsts, SysUtils;               { GFV standard units }
 {$else FV_UNICODE}
    objects, drivers, views, fvcommon, fvconsts;                 { GFV standard units }
 {$endif FV_UNICODE}
@@ -214,7 +214,11 @@ TYPE
       FUNCTION Execute: Word; Virtual;
       FUNCTION GetHelpCtx: Word; Virtual;
       FUNCTION GetPalette: PPalette; Virtual;
+      {$ifdef FV_UNICODE}
+      FUNCTION FindItem (Ch: WideChar): PMenuItem;
+      {$else}
       FUNCTION FindItem (Ch: AnsiChar): PMenuItem;
+      {$endif}
       FUNCTION HotKey (KeyCode: Word): PMenuItem;
       FUNCTION NewSubView (Var Bounds: TRect; AMenu: PMenu;
         AParentMenu: PMenuView): PMenuView; Virtual;
@@ -533,8 +537,13 @@ END;
 {---------------------------------------------------------------------------}
 FUNCTION TMenuView.Execute: Word;
 TYPE MenuAction = (DoNothing, DoSelect, DoReturn);
-VAR AutoSelect: Boolean; Action: MenuAction; Ch: AnsiChar; Res: Word; R: TRect;
+VAR AutoSelect: Boolean; Action: MenuAction; Res: Word; R: TRect;
   ItemShown, P: PMenuItem; Target: PMenuView; E: TEvent; MouseActive: Boolean;
+  {$ifdef FV_UNICODE}
+  searchChar: WideChar;
+  {$else}
+  searchChar: AnsiChar;
+  {$endif}
 
    PROCEDURE TrackMouse;
    VAR Mouse: TPoint; R: TRect;
@@ -645,48 +654,88 @@ BEGIN
            AND MouseInMenus Then Action := DoReturn;  { Set return action }
          End;
        evKeyDown:
-         Case CtrlToArrow(E.KeyCode) Of               { Check arrow keys }
-           kbUp, kbDown: If (Size.Y <> 1) Then
-             TrackKey(CtrlToArrow(E.KeyCode) = kbDown){ Track keyboard }
-             Else If (E.KeyCode = kbDown) Then        { Down arrow }
-             AutoSelect := True;                      { Select item }
-           kbLeft, kbRight: If (ParentMenu = Nil) Then
-             TrackKey(CtrlToArrow(E.KeyCode)=kbRight) { Track keyboard }
-             Else Action := DoReturn;                 { Set return action }
-           kbHome, kbEnd: If (Size.Y <> 1) Then Begin
-               Current := Menu^.Items;                { Set to first item }
-               If (E.KeyCode = kbEnd) Then            { If the 'end' key }
-                 TrackKey(False);                     { Move to last item }
+         begin
+           Case CtrlToArrow(E.KeyCode) Of
+             kbUp, kbDown: If (Size.Y <> 1) Then
+               TrackKey(CtrlToArrow(E.KeyCode) = kbDown)
+               Else If (E.KeyCode = kbDown) Then AutoSelect := True;
+             kbLeft, kbRight: If (ParentMenu = Nil) Then
+               TrackKey(CtrlToArrow(E.KeyCode)=kbRight)
+               Else Action := DoReturn;
+             kbHome, kbEnd: If (Size.Y <> 1) Then Begin
+                 Current := Menu^.Items;
+                 If (E.KeyCode = kbEnd) Then TrackKey(False);
+               End;
+             kbEnter: Begin
+                 If Size.Y = 1 Then AutoSelect := True;
+                 Action := DoSelect;
+               End;
+             kbEsc: Begin
+                 Action := DoReturn;
+                 If (ParentMenu = Nil) OR (ParentMenu^.Size.Y <> 1) Then ClearEvent(E);
+               End;
+           Else
+             Begin
+               P := nil;
+
+               // CASE 1: Alt key is pressed. Use the new logic for layout-awareness.
+               if (E.KeyShift and kbAltShift <> 0) then
+               Begin
+                 Target := TopMenu; // Alt-hotkeys always target the top menu bar.
+
+                 // Path 1: Character-based search (for correct layouts like Russian)
+                 {$ifdef FV_UNICODE}
+                 searchChar := E.UnicodeChar;
+                 {$else}
+                 searchChar := E.CharCode;
+                 {$endif}
+                 if searchChar <> #0 then P := Target^.FindItem(searchChar);
+
+                 // Path 2: Scancode-based search (fallback for EN hotkeys in RU layout)
+                 if P = nil then
+                 Begin
+                   {$ifdef FV_UNICODE}
+                   searchChar := WideChar(GetAltChar(E.ScanCode shl 8));
+                   {$else}
+                   searchChar := GetAltChar(E.ScanCode shl 8);
+                   {$endif}
+                   if searchChar <> #0 then P := Target^.FindItem(searchChar);
+                 End;
+               End
+               // CASE 2: No Alt key. This is a standard menu hotkey (like 'F' for File, or '1' for item 1).
+               else
+               Begin
+                 Target := @Self; // Standard hotkeys target the current menu.
+                 {$ifdef FV_UNICODE}
+                 searchChar := E.UnicodeChar;
+                 {$else}
+                 searchChar := E.CharCode;
+                 {$endif}
+                 if searchChar <> #0 then P := Target^.FindItem(searchChar);
+               End;
+
+               // Now, act on the result of the search (P)
+               if P <> nil then
+               Begin
+                 // Item was found via FindItem (either with Alt or without)
+                 If Target = @Self Then Begin
+                   If Size.Y = 1 Then AutoSelect := True;
+                   Action := DoSelect;
+                   Current := P;
+                 End Else If (ParentMenu <> Target) OR (ParentMenu^.Current <> P) Then
+                    Action := DoReturn;
+               End
+               else
+               Begin
+                 // CASE 3: Fallback for global shortcuts like F-keys that are not found by character.
+                 P := TopMenu^.HotKey(E.KeyCode);
+                 If (P <> Nil) AND CommandEnabled(P^.Command) Then Begin
+                   Res := P^.Command;
+                   Action := DoReturn;
+                 End
+               End;
              End;
-           kbEnter: Begin
-               If Size.Y = 1 Then AutoSelect := True; { Select item }
-               Action := DoSelect;                    { Return the item }
-             End;
-           kbEsc: Begin
-               Action := DoReturn;                    { Set return action }
-               If (ParentMenu = Nil) OR
-               (ParentMenu^.Size.Y <> 1) Then         { Check parent }
-                 ClearEvent(E);                       { Kill the event }
-             End;
-           Else Target := @Self;                      { Set target as self }
-           Ch := GetAltChar(E.KeyCode);
-           If (Ch = #0) Then Ch := E.CharCode Else
-             Target := TopMenu;                       { Target is top menu }
-           P := Target^.FindItem(Ch);                 { Check for item }
-           If (P = Nil) Then Begin
-             P := TopMenu^.HotKey(E.KeyCode);         { Check for hot key }
-             If (P <> Nil) AND                        { Item valid }
-             CommandEnabled(P^.Command) Then Begin    { Command enabled }
-               Res := P^.Command;                     { Set return command }
-               Action := DoReturn;                    { Set return action }
-             End
-           End Else If Target = @Self Then Begin
-             If Size.Y = 1 Then AutoSelect := True;   { Set auto select }
-             Action := DoSelect;                      { Select item }
-             Current := P;                            { Set current item }
-           End Else If (ParentMenu <> Target) OR
-           (ParentMenu^.Current <> P) Then            { Item different }
-              Action := DoReturn;                     { Set return action }
+           End;
          End;
        evCommand: If (E.Command = cmMenu) Then Begin  { Menu command }
            AutoSelect := False;                       { Dont select item }
@@ -766,25 +815,57 @@ END;
 {--TMenuView----------------------------------------------------------------}
 {  FindItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB          }
 {---------------------------------------------------------------------------}
+{$ifndef FV_UNICODE}
 FUNCTION TMenuView.FindItem (Ch: AnsiChar): PMenuItem;
-VAR I: SmallInt; P: PMenuItem;
+VAR I: SmallInt; P: PMenuItem; itemHotkey: AnsiChar;
 BEGIN
-   Ch := UpCase(Ch);                                  { Upper case of AnsiChar }
-   P := Menu^.Items;                                  { First menu item }
-   While (P <> Nil) Do Begin                          { While item valid }
-     If (P^.Name <> Sw_PString_Empty) AND (NOT P^.Disabled)  { Valid enabled cmd }
+   if Ch = #0 then begin FindItem := nil; Exit; end;
+   Ch := UpCase(Ch);
+   P := Menu^.Items;
+   While (P <> Nil) Do Begin
+     If (P^.Name <> Sw_PString_Empty) AND (NOT P^.Disabled)
      Then Begin
-       I := Pos('~', P^.Name Sw_PString_Deref);  { Scan for highlight }
-       If (I <> 0) AND (Ch = UpCase(P^.Name Sw_PString_Deref[I+1]))   { Hotkey AnsiChar found }
-       Then Begin
-         FindItem := P;                               { Return item }
-         Exit;                                        { Now exit }
-       End;
+       I := Pos('~', P^.Name^);
+       If (I > 0) AND (I < Length(P^.Name^)) then
+       begin
+         itemHotkey := UpCase(P^.Name^[I+1]);
+         If Ch = itemHotkey Then
+         Begin
+           FindItem := P;
+           Exit;
+         End;
+       end;
      End;
-     P := P^.Next;                                    { Next item }
+     P := P^.Next;
    End;
-   FindItem := Nil;                                   { No item found }
+   FindItem := Nil;
 END;
+{$else}
+FUNCTION TMenuView.FindItem (Ch: WideChar): PMenuItem;
+VAR I: SmallInt; P: PMenuItem; itemHotkey: WideChar; menuName: UnicodeString;
+BEGIN
+   if Ch = #0 then begin FindItem := nil; Exit; end;
+   P := Menu^.Items;
+   While (P <> Nil) Do Begin
+     If (P^.Name <> Sw_PString_Empty) AND (NOT P^.Disabled)
+     Then Begin
+       menuName := P^.Name;
+       I := Pos('~', menuName);
+       If (I > 0) AND (I < Length(menuName)) then
+       begin
+         itemHotkey := menuName[I+1];
+         If WideUpperCase(String(Ch)) = WideUpperCase(String(itemHotkey)) Then
+         Begin
+           FindItem := P;
+           Exit;
+         End;
+       end;
+     End;
+     P := P^.Next;
+   End;
+   FindItem := Nil;
+END;
+{$endif}
 
 {--TMenuView----------------------------------------------------------------}
 {  HotKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB            }
@@ -910,18 +991,43 @@ BEGIN
      Case Event.What Of
        evMouseDown: DoSelect;                         { Select menu item }
        evKeyDown:
-         If (FindItem(GetAltChar(Event.KeyCode)) <> Nil)
-         Then DoSelect Else Begin                     { Select menu item }
-           P := HotKey(Event.KeyCode);                { Check for hotkey }
-           If (P <> Nil) AND
-           (CommandEnabled(P^.Command)) Then Begin
-             Event.What := evCommand;                 { Command event }
-             Event.Command := P^.Command;             { Set command event }
-             Event.InfoPtr := Nil;                    { Clear info ptr }
-             PutEvent(Event);                         { Put event on queue }
-             ClearEvent(Event);                       { Clear the event }
-           End;
-         End;
+         begin
+           P := nil;
+           // Only perform hotkey search (both paths) if Alt is actually pressed.
+           if (Event.KeyShift and kbAltShift <> 0) then
+           begin
+             // Path 1: Character-based search
+             {$ifdef FV_UNICODE}
+             if Event.UnicodeChar <> #0 then P := FindItem(Event.UnicodeChar);
+             {$else}
+             if Event.CharCode <> #0 then P := FindItem(Event.CharCode);
+             {$endif}
+
+             // Path 2: Fallback to scancode-based search
+             if P = nil then
+             begin
+               {$ifdef FV_UNICODE}
+               P := FindItem(WideChar(GetAltChar(Event.ScanCode shl 8)));
+               {$else}
+               P := FindItem(GetAltChar(Event.ScanCode shl 8));
+               {$endif}
+             end;
+           end;
+
+           if P <> nil then
+             DoSelect
+           else
+           begin // Fallback for global shortcuts (F-keys)
+             P := HotKey(Event.KeyCode);
+             If (P <> Nil) AND (CommandEnabled(P^.Command)) Then Begin
+               Event.What := evCommand;
+               Event.Command := P^.Command;
+               Event.InfoPtr := Nil;
+               PutEvent(Event);
+               ClearEvent(Event);
+             End;
+           end;
+         end;
        evCommand:
          If Event.Command = cmMenu Then DoSelect;     { Select menu item }
        evBroadcast:

packages/pastojs/src/fppas2js.pp

@@ -1696,11 +1696,11 @@ type
     procedure CheckDispatchField(Proc: TPasProcedure; Switch: TValueSwitch);
     procedure AddMessageStr(var MsgToProc: TMessageIdToProc_List; const S: string; Proc: TPasProcedure);
     procedure AddMessageIdToClassScope(Proc: TPasProcedure; EmitHints: boolean); virtual;
-    procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
-      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); override;
     procedure ComputeResultElement(El: TPasResultElement; out
       ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       StartEl: TPasElement = nil); override;
+    function ComputeProcAsyncResult(El: TPasElement; var ResolvedEl: TPasResolverResult;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement=nil): boolean; override;
     // CustomData
     function GetElementData(El: TPasElementBase;
       DataClass: TPas2JsElementDataClass): TPas2JsElementData; virtual;
@@ -7320,52 +7320,53 @@ begin
   end;
 end;
 
-procedure TPas2JSResolver.ComputeElement(El: TPasElement; out
+procedure TPas2JSResolver.ComputeResultElement(El: TPasResultElement; out
   ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
   StartEl: TPasElement);
 var
   Proc: TPasProcedure;
+  ProcType: TPasProcedureType;
   JSPromiseClass: TPasClassType;
 begin
-  if (rcCall in Flags) and (El is TPasProcedure) then
+  if (rcCall in Flags) and (El.Parent is TPasProcedureType) then
     begin
-    Proc:=TPasProcedure(El);
-    if Proc.IsAsync then
+    ProcType:=TPasProcedureType(El.Parent);
+    if ProcType.Parent is TPasProcedure then
       begin
-      // an async function call returns a TJSPromise if available
-      JSPromiseClass:=FindTJSPromise(nil);
-      if JSPromiseClass<>nil then
+      Proc:=TPasProcedure(ProcType.Parent);
+      if Proc.IsAsync then
         begin
-         SetResolverIdentifier(ResolvedEl, btContext, El, JSPromiseClass,
-           JSPromiseClass, [rrfReadable, rrfWritable]);
-         Exit;
+        // an async function returns a TJSPromise if available
+        JSPromiseClass:=FindTJSPromise(nil); // nil for no error on fail
+        if JSPromiseClass<>nil then
+          begin
+           SetResolverIdentifier(ResolvedEl, btContext, El, JSPromiseClass,
+             JSPromiseClass, [rrfReadable, rrfWritable]);
+           Exit;
+          end;
         end;
       end;
     end;
-  inherited ComputeElement(El,ResolvedEl,Flags,StartEl);
+  inherited ComputeResultElement(El, ResolvedEl, Flags, StartEl);
 end;
 
-procedure TPas2JSResolver.ComputeResultElement(El: TPasResultElement; out
-  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
-  StartEl: TPasElement);
+function TPas2JSResolver.ComputeProcAsyncResult(El: TPasElement;
+  var ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags; StartEl: TPasElement
+  ): boolean;
 var
-  FuncType: TPasFunctionType;
-  Proc: TPasProcedure;
+  JSPromiseClass: TPasClassType;
 begin
-  if (rcCall in Flags) and (El.Parent is TPasFunctionType) then
+  JSPromiseClass:=FindTJSPromise(nil); // nil for no error on fail
+  if JSPromiseClass=nil then
+    exit(false)
+  else
     begin
-    FuncType:=TPasFunctionType(El.Parent);
-    if FuncType.Parent is TPasProcedure then
-      begin
-      Proc:=TPasProcedure(FuncType.Parent);
-      if Proc.IsAsync then
-        begin
-        ComputeElement(Proc, ResolvedEl, Flags, StartEl);
-        Exit;
-        end;
-      end;
+    SetResolverIdentifier(ResolvedEl, btContext, El, JSPromiseClass,
+      JSPromiseClass, [rrfReadable, rrfWritable]);
+    exit(true);
     end;
-  inherited ComputeResultElement(El, ResolvedEl, Flags, StartEl);
+  if StartEl=nil then ;
+  if Flags=[] then ;
 end;
 
 function TPas2JSResolver.GetElementData(El: TPasElementBase;

packages/pastojs/tests/tcmodules.pas

@@ -944,22 +944,22 @@ type
     Procedure TestAttributes_InterfacesList;
 
     // Assertions, checks
-    procedure TestAssert;
-    procedure TestAssert_SysUtils;
-    procedure TestObjectChecks;
-    procedure TestOverflowChecks_Int;
-    procedure TestRangeChecks_AssignInt;
-    procedure TestRangeChecks_AssignIntRange;
-    procedure TestRangeChecks_AssignEnum;
-    procedure TestRangeChecks_AssignEnumRange;
-    procedure TestRangeChecks_AssignChar;
-    procedure TestRangeChecks_AssignCharRange;
-    procedure TestRangeChecks_ArrayIndex;
-    procedure TestRangeChecks_ArrayOfRecIndex;
-    procedure TestRangeChecks_StringIndex;
-    procedure TestRangeChecks_TypecastInt;
-    procedure TestRangeChecks_TypeHelperInt;
-    procedure TestRangeChecks_AssignCurrency;
+    Procedure TestAssert;
+    Procedure TestAssert_SysUtils;
+    Procedure TestObjectChecks;
+    Procedure TestOverflowChecks_Int;
+    Procedure TestRangeChecks_AssignInt;
+    Procedure TestRangeChecks_AssignIntRange;
+    Procedure TestRangeChecks_AssignEnum;
+    Procedure TestRangeChecks_AssignEnumRange;
+    Procedure TestRangeChecks_AssignChar;
+    Procedure TestRangeChecks_AssignCharRange;
+    Procedure TestRangeChecks_ArrayIndex;
+    Procedure TestRangeChecks_ArrayOfRecIndex;
+    Procedure TestRangeChecks_StringIndex;
+    Procedure TestRangeChecks_TypecastInt;
+    Procedure TestRangeChecks_TypeHelperInt;
+    Procedure TestRangeChecks_AssignCurrency;
 
     // Async/AWait
     Procedure TestAsync_Proc;
@@ -979,6 +979,8 @@ type
     Procedure TestAsync_AnonymousProc_PromiseViaDotContext;
     Procedure TestAsync_ProcType;
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
+    Procedure TestAsync_ProcTypeDelphi_NoTJSPromise;
+    Procedure TestAsync_ProcTypeDelphi_TJSPromise;
     Procedure TestAsync_Inherited;
     Procedure TestAsync_ClassInterface;
     Procedure TestAsync_ClassInterface_AsyncMissmatchFail;
@@ -36587,6 +36589,47 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestAsync_ProcTypeDelphi_NoTJSPromise;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TRefProc = reference to procedure; async;',
+  'procedure Run(p: TRefProc);',
+  'begin',
+  'end;',
+  'procedure Fly; async;',
+  'begin',
+  'end;',
+  'begin',
+  '  Run(Fly);',
+  '  ']);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestAsync_ProcTypeDelphi_TJSPromise;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  '  TRefProc = reference to procedure; async;',
+  'procedure Run(p: TRefProc);',
+  'begin',
+  'end;',
+  'procedure Fly; async;',
+  'begin',
+  'end;',
+  'begin',
+  '  Run(Fly);',
+  '  ']);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestAsync_Inherited;
 begin
   StartProgram(false);

packages/rtl-console/src/inc/video.inc

@@ -709,6 +709,11 @@ begin
     Result := DefaultSystemCodePage;
 end;
 
+function GetLegacyCodePage: TSystemCodePage;
+begin
+  Result := CurrentLegacy2EnhancedTranslationCodePage;
+end;
+
 { disallowed codepages (variable length), code points larger than an 8-bit byte, etc. }
 function IsDisallowedCodePage(CodePage: TSystemCodePage): Boolean;
 const

packages/rtl-console/src/inc/videoh.inc

@@ -231,6 +231,8 @@ function StringDisplayWidth(const S: UnicodeString): Integer;
 { Returns the number of display columns needed for the given string }
 function GetActiveCodePage: TSystemCodePage;
 { Returns the current active legacy code page }
+function GetLegacyCodePage: TSystemCodePage;
+{ Returns the current legacy code page }
 procedure ActivateCodePage(CodePage: TSystemCodePage);
 { Activates a specified legacy code page (if supported) }
 function GetSupportedCodePageCount: Integer;

packages/rtl-console/src/unix/keyboard.pp

@@ -29,6 +29,21 @@ const
   AltPrefix : byte = 0;
   ShiftPrefix : byte = 0;
   CtrlPrefix : byte = 0;
+  // Constants for win32-input-mode
+  const
+    RIGHT_ALT_PRESSED       = $0001;
+    LEFT_ALT_PRESSED        = $0002;
+    RIGHT_CTRL_PRESSED      = $0004;
+    LEFT_CTRL_PRESSED       = $0008;
+    SHIFT_PRESSED           = $0010;
+    NUMLOCK_ON              = $0020;
+    SCROLLLOCK_ON           = $0040;
+    CAPSLOCK_ON             = $0080;
+    ENHANCED_KEY            = $0100;
+    kbBack        = $0E08;
+    kbTab         = $0F09;
+    kbEnter       = $1C0D;
+    kbSpaceBar    = $3920;
 
 type
   Tprocedure = procedure;
@@ -62,12 +77,12 @@ function AddSpecialSequence(const St : Shortstring;Proc : Tprocedure) : PTreeEle
 uses
   System.Console.Mouse,  System.Strings,System.Console.Unixkvmbase,
   UnixApi.TermIO,UnixApi.Base
-  {$ifdef Linux},LinuxApi.Vcs{$endif};
+  {$ifdef Linux},LinuxApi.Vcs{$endif},System.Console.Video,System.CharSet;
 {$ELSE FPC_DOTTEDUNITS}
 uses
   Mouse,  Strings,unixkvmbase,
   termio,baseUnix
-  {$ifdef linux},linuxvcs{$endif};
+  {$ifdef linux},linuxvcs{$endif},video,charset;
 {$ENDIF FPC_DOTTEDUNITS}
 
 {$i keyboard.inc}
@@ -125,6 +140,33 @@ const
 
 {$endif Unused}
 
+function UnicodeToSingleByte(CodePoint: Cardinal): AnsiChar;
+var
+  UStr: UnicodeString;
+  TempStr: RawByteString;
+begin
+  if CodePoint > $FFFF then
+  begin
+    UnicodeToSingleByte := '?';
+    Exit;
+  end;
+  UStr := UnicodeString(WideChar(CodePoint));
+
+  TempStr := UTF8Encode(UStr);
+
+  SetCodePage(TempStr, GetLegacyCodePage, True);
+
+  if Length(TempStr) = 1 then
+  begin
+    if (TempStr[1] = '?') and (CodePoint <> ord('?')) then
+      UnicodeToSingleByte := '?'
+    else
+      UnicodeToSingleByte := TempStr[1];
+  end
+  else
+    UnicodeToSingleByte := '?';
+end;
+
 procedure SetRawMode(b:boolean);
 
 var Tio:Termios;
@@ -1701,10 +1743,27 @@ begin
       ScanValue :=cScanValue[Key];
 
     if essCtrl in SState then
-      nKey:=Ord(k.AsciiChar); { if Ctrl+key then no normal UnicodeChar. Mimic Windows keyboard driver. }
+      begin
+        // For modern protocols (kitty, modifyOtherKeys), Ctrl+<letter> should
+        // generate the letter itself, not a C0 control character.
+        // Therefore, we do not overwrite nKey (which becomes UnicodeChar)
+        // with the control character's code if a letter was pressed.
+        if not (((Key >= $41) and (Key <= $5A)) or ((Key >= $61) and (Key <= $7A))) then
+          nKey := Ord(k.AsciiChar);
+      end;
 
     k.VirtualScanCode := (ScanValue shl 8) or Ord(k.AsciiChar);
 
+    // This is a dirty hack. Unfortunately, our hotkey mapping code
+    // (everywhere except for the recently fixed code for the top menu)
+    // for some reason (this is to be debugged) cannot handle events
+    // with nonzero _character_ codes. So until all those code paths are fixed,
+    // we zero out the character codes here to make Alt hotkeys work properly.
+    // However, we do this only for Latin hotkeys, so that non-Latin ones
+    // can continue working with the new top menu code. Latin hotkeys,
+    // on the other hand, will be recognized by their _key_ codes.
+    if (essAlt in SState) and (nKey < 128) then nKey := 0;
+
     if nKey <= $FFFF then
       begin
         k.UnicodeChar := WideChar(nKey);
@@ -1713,9 +1772,10 @@ begin
     else
       PushUnicodeKey (k,nKey,char(k.AsciiChar));
 
-    if byte(k.AsciiChar) = 27 then PushKey(k);
+    // This line caused duplicate ESC key press events in kitty mode
+    // if byte(k.AsciiChar) = 27 then PushKey(k);
   end else
-    PushUnicodeKey (k,nKey,'?');
+    PushUnicodeKey (k,nKey,UnicodeToSingleByte(nKey));
 end;
 
 procedure xterm_ModifyOtherKeys;
@@ -2205,15 +2265,145 @@ begin
   end else if (essCtrl in CurrentShiftState) then CurrentShiftState:=CurrentShiftState-[essRightCtrl,essCtrl,essLeftCtrl];
 end;
 
-
 function ReadKey:TEnhancedKeyEvent;
-const
-  ReplacementAsciiChar='?';
 var
   store    : array [0..31] of AnsiChar;
   arrayind : byte;
   SState: TEnhancedShiftState;
 
+    procedure DecodeAndPushWin32Key(const store: array of AnsiChar; arrayind: byte);
+
+      function VKToScanCode(vk: Word): Byte;
+      begin
+        case vk of
+          // Standard keys
+          $41..$5A : VKToScanCode := cScanValue[vk]; // 'A'..'Z'
+          $30..$39 : VKToScanCode := cScanValue[vk]; // '0'..'9'
+          $08: VKToScanCode := kbBack;
+          $09: VKToScanCode := kbTab;
+          $0D: VKToScanCode := kbEnter;
+          $1B: VKToScanCode := kbEsc;
+          $20: VKToScanCode := kbSpaceBar;
+          // Function keys
+          $70..$79: VKToScanCode := vk - $70 + kbF1; // F1-F10
+          $7A..$7B: VKToScanCode := vk - $7A + kbF11; // F11-F12
+          // Navigation keys
+          $2D: VKToScanCode := kbIns;
+          $2E: VKToScanCode := kbDel;
+          $24: VKToScanCode := kbHome;
+          $23: VKToScanCode := kbEnd;
+          $21: VKToScanCode := kbPgUp;
+          $22: VKToScanCode := kbPgDn;
+          $26: VKToScanCode := kbUp;
+          $28: VKToScanCode := kbDown;
+          $25: VKToScanCode := kbLeft;
+          $27: VKToScanCode := kbRight;
+          // Modifier keys (scancodes for L/R versions)
+          $10: VKToScanCode := $2A; // VK_SHIFT -> Left shift
+          $11: VKToScanCode := $1D; // VK_CONTROL -> Left control
+          $12: VKToScanCode := $38; // VK_MENU -> Left alt
+          // Lock keys
+          $14: VKToScanCode := $3A; // VK_CAPITAL
+          $90: VKToScanCode := $45; // VK_NUMLOCK
+          $91: VKToScanCode := $46; // VK_SCROLL
+          // OEM Keys
+          $BA: VKToScanCode := $27; // VK_OEM_1 (;)
+          $BB: VKToScanCode := $0D; // VK_OEM_PLUS (=)
+          $BC: VKToScanCode := $33; // VK_OEM_COMMA (,)
+          $BD: VKToScanCode := $0C; // VK_OEM_MINUS (-)
+          $BE: VKToScanCode := $34; // VK_OEM_PERIOD (.)
+          $BF: VKToScanCode := $35; // VK_OEM_2 (/)
+          $C0: VKToScanCode := $29; // VK_OEM_3 (`)
+          $DB: VKToScanCode := $1A; // VK_OEM_4 ([)
+          $DC: VKToScanCode := $2B; // VK_OEM_5 (\)
+          $DD: VKToScanCode := $1B; // VK_OEM_6 (])
+          $DE: VKToScanCode := $28; // VK_OEM_7 (')
+        else
+          VKToScanCode := 0;
+        end;
+      end;
+
+    var
+      params: array[0..5] of LongInt; // Vk, Sc, Uc, Kd, Cs, Rc
+      i, p_idx, code: Integer;
+      st: string;
+      ch: AnsiChar;
+      ScanCode: Byte;
+      k: TEnhancedKeyEvent;
+    begin
+      // 1. Parse the parameters: Vk;Sc;Uc;Kd;Cs;Rc
+      for i := 0 to 5 do params[i] := 0; // Clear params
+      params[5] := 1; // Default repeat count is 1
+
+      p_idx := 0;
+      st := '';
+      // Start from after the CSI: ^[[
+      for i := 2 to arrayind - 2 do
+      begin
+        ch := store[i];
+        if ch = ';' then
+        begin
+          if st <> '' then Val(st, params[p_idx], code);
+          st := '';
+          Inc(p_idx);
+          if p_idx > 5 then Break;
+        end
+        else if ch in ['0'..'9'] then
+          st := st + ch;
+      end;
+      // Last parameter
+      if (p_idx <= 5) and (st <> '') then
+        Val(st, params[p_idx], code);
+
+      // For non-printable command keys, we must ignore any character code provided
+      // by the terminal (like #127 for Del) and force it to 0. This ensures the
+      // application interprets the key event as a command (via its scancode)
+      // rather than as a character to be printed.
+      case params[0] of // Check Virtual Key Code (wVirtualKeyCode)
+        // Function keys F1-F12
+        $70..$7B,
+        // Arrow keys (Left, Up, Right, Down)
+        $25..$28,
+        // Navigation keys (PgUp, PgDn, End, Home, Ins, Del)
+        $21..$24, $2D, $2E:
+          params[2] := 0; // Force UnicodeChar to be 0
+      end;
+
+      // 2. Process only key down and repeat events (param[3] must be non-zero)
+      if params[3] = 0 then exit; // Ignore key up events completely for now.
+                                  // The sequence is considered "handled".
+
+      // 3. Create a new key event
+      k := NilEnhancedKeyEvent;
+
+      // 4. Map ControlKeyState (Cs) to ShiftState
+      if (params[4] and SHIFT_PRESSED) <> 0 then Include(k.ShiftState, essShift);
+      if (params[4] and LEFT_CTRL_PRESSED) <> 0 then Include(k.ShiftState, essLeftCtrl);
+      if (params[4] and RIGHT_CTRL_PRESSED) <> 0 then Include(k.ShiftState, essRightCtrl);
+      if (params[4] and (LEFT_CTRL_PRESSED or RIGHT_CTRL_PRESSED)) <> 0 then Include(k.ShiftState, essCtrl);
+      if (params[4] and LEFT_ALT_PRESSED) <> 0 then Include(k.ShiftState, essLeftAlt);
+      if (params[4] and RIGHT_ALT_PRESSED) <> 0 then Include(k.ShiftState, essRightAlt);
+      if (params[4] and (LEFT_ALT_PRESSED or RIGHT_ALT_PRESSED)) <> 0 then Include(k.ShiftState, essAlt);
+
+      // 5. Map Uc, Sc, and Vk
+      k.UnicodeChar := WideChar(params[2]);
+      if params[2] <= 127 then
+        k.AsciiChar := AnsiChar(params[2])
+      else
+        k.AsciiChar := UnicodeToSingleByte(params[2]);
+
+      ScanCode := params[1]; // wVirtualScanCode
+      if ScanCode = 0 then
+        ScanCode := VKToScanCode(params[0]); // wVirtualKeyCode
+
+      // If we have a char but no special scancode, use the char's scancode
+      if (ScanCode = 0) and (Ord(k.AsciiChar) > 0) and (Ord(k.AsciiChar) < 128) then
+        ScanCode := cScanValue[Ord(k.AsciiChar)];
+
+      k.VirtualScanCode := (ScanCode shl 8) or Ord(k.AsciiChar);
+      PushKey(k);
+    end;
+
     procedure DecodeKittyKey(var k :TEnhancedKeyEvent; var NPT : PTreeElement);
     var i : dword;
         wc: wideChar;
@@ -2231,6 +2421,7 @@ var
         kbDown : byte;
         nKey : longint;
         modifier: longint;
+        shortCutKey: LongInt;
     begin   {
          if arrayind>0 then
          for i:= 0 to arrayind-1 do
@@ -2371,7 +2562,11 @@ var
               nKey:=unicodeCodePoint;
               if (enh[1]>=0) then
                 nKey:=enh[1];
-              BuildKeyEvent(modifier,nKey,nKey);
+
+              shortCutKey := enh[2];
+              if shortCutKey < 0 then
+                shortCutKey := nKey;
+              BuildKeyEvent(modifier, nKey, shortCutKey);
            end;
            arrayind:=0;
         end;
@@ -2455,6 +2650,10 @@ var
   k: TEnhancedKeyEvent;
   UnicodeCodePoint: LongInt;
   i : dword;
+  // Variables for Alt+UTF8 sequence handling
+  ch1: AnsiChar;
+  utf8_bytes_to_read, loop_idx: Integer;
+  full_sequence_ok: boolean;
 begin
 {Check Buffer first}
   if KeySend<>KeyPut then
@@ -2486,7 +2685,7 @@ begin
       if Utf8KeyboardInputEnabled then
         begin
           UnicodeCodePoint:=ReadUtf8(ch);
-          PushUnicodeKey(k,UnicodeCodePoint,ReplacementAsciiChar);
+          PushUnicodeKey(k,UnicodeCodePoint,UnicodeToSingleByte(UnicodeCodePoint));
         end
       else
         PushKey(k);
@@ -2526,6 +2725,26 @@ begin
           {save char later use }
           store[arrayind]:=ch;
           inc(arrayind);
+
+          // Switch to blocking read if found win32-input-mode-encoded ESC key
+          // This fixes that key behavior in that mode
+          if (arrayind = 5) and (store[0]=#27) and (store[1]='[') and (store[2]='2') and (store[3]='7') and (store[4]=';')
+          then
+          begin
+            // Enter blocking read loop with a safety break
+            while (arrayind < 31) do
+            begin
+              // This is a blocking read, it will wait for the next character
+              ch := ttyRecvChar;
+              store[arrayind] := ch;
+              inc(arrayind);
+              // Check for known terminators for win32, kitty, xterm, and other CSI sequences.
+              if (ch = '_') or (ch = 'u') or (ch = '~') or (ch in ['A'..'Z']) or (ch in ['a'..'z']) then
+                break; // Exit this inner blocking loop
+            end;
+            break; // We have the full sequence, so exit the outer `while syskeypressed` loop
+          end;
+
           if arrayind >= 31 then break;
           {check tree for maching sequence}
           if assigned(NPT) then
@@ -2550,9 +2769,16 @@ begin
             dec(arrayind);
             break;
           end;
-          if (arrayind>3) and not (ch in [';',':','0'..'9']) then break; {end of escape sequence}
+          if (arrayind>3) and not (ch in [';',':','0'..'9']) and (ch <> '_') then break; {end of escape sequence}
         end;
 
+        ch := store[arrayind-1];
+
+        if (ch = '_') and (arrayind > 2) and (store[0]=#27) and (store[1]='[') then
+        begin
+          DecodeAndPushWin32Key(store, arrayind);
+          exit;
+        end else
         if (arrayind>3) then
           if (ch = 'u'  )   { for sure kitty keys  or }
               or ( isKittyKeys and  not assigned(FoundNPT) ) {probally kitty keys}
@@ -2565,29 +2791,69 @@ begin
                 end;
             end;
 
-       NPT:=FoundNPT;
-       if assigned(NPT) and NPT^.CanBeTerminal then
+        if not assigned(FoundNPT) then
         begin
-          if assigned(NPT^.SpecialHandler) then
-            begin
-              NPT^.SpecialHandler;
-              k.AsciiChar := #0;
-              k.UnicodeChar := WideChar(#0);
-              k.VirtualScanCode := 0;
-              PushKey(k);
-            end
-          else if (NPT^.CharValue<>0) or (NPT^.ScanValue<>0) then
+          // This handles the case for non-kitty terminals sending ESC + UTF-8 bytes for Alt+key
+          if (arrayind > 1) and (store[0] = #27) and not isKittyKeys then
+          begin
+            ch1 := store[1];
+            utf8_bytes_to_read := DetectUtf8ByteSequenceStart(ch1) - 1;
+            full_sequence_ok := (arrayind - 1) = (utf8_bytes_to_read + 1);
+
+            if full_sequence_ok then
             begin
-              k.AsciiChar := chr(NPT^.CharValue);
-              k.UnicodeChar := WideChar(NPT^.CharValue);
-              k.VirtualScanCode := (NPT^.ScanValue shl 8) or Ord(k.AsciiChar);
-              k.ShiftState:=k.ShiftState+NPT^.ShiftValue;
-              PushKey(k);
+              // Push continuation bytes back to be re-read by ReadUtf8
+              for loop_idx := arrayind - 1 downto 2 do
+                PutBackIntoInBuf(store[loop_idx]);
+
+              UnicodeCodePoint := ReadUtf8(ch1);
+
+              if UnicodeCodePoint > 0 then
+              begin
+                k.ShiftState := [essAlt];
+                k.VirtualScanCode := 0;
+
+                PushUnicodeKey(k, UnicodeCodePoint, UnicodeToSingleByte(UnicodeCodePoint));
+                ReadKey := PopKey;
+                exit;
+              end
+              else
+              begin
+                // Failed to parse, push everything back as-is
+                PutBackIntoInBuf(ch1);
+                for loop_idx := 2 to arrayind - 1 do
+                  PutBackIntoInBuf(store[loop_idx]);
+              end;
             end;
+          end;
+          // This line caused duplicate ESC key press events in legacy mode
+          // RestoreArray;
         end
-      else
-        RestoreArray;
-   end;
+        else
+          NPT:=FoundNPT;
+
+        if assigned(NPT) and NPT^.CanBeTerminal then
+         begin
+           if assigned(NPT^.SpecialHandler) then
+             begin
+               NPT^.SpecialHandler;
+               k.AsciiChar := #0;
+               k.UnicodeChar := WideChar(#0);
+               k.VirtualScanCode := 0;
+               PushKey(k);
+             end
+           else if (NPT^.CharValue<>0) or (NPT^.ScanValue<>0) then
+             begin
+               k.AsciiChar := chr(NPT^.CharValue);
+               k.UnicodeChar := WideChar(NPT^.CharValue);
+               k.VirtualScanCode := (NPT^.ScanValue shl 8) or Ord(k.AsciiChar);
+               k.ShiftState:=k.ShiftState+NPT^.ShiftValue;
+               PushKey(k);
+             end;
+         end
+       else
+         RestoreArray;
+    end;
 {$ifdef logging}
        writeln(f);
 {$endif logging}
@@ -2647,6 +2913,8 @@ end;
 { Exported functions }
 
 procedure SysInitKeyboard;
+var
+  envInput: string;
 begin
   isKittyKeys:=false;
   CurrentShiftState:=[];
@@ -2666,9 +2934,6 @@ begin
   else
     begin
 {$endif}
-      { default for Shift prefix is ^ A}
-      if ShiftPrefix = 0 then
-        ShiftPrefix:=1;
       {default for Alt prefix is ^Z }
       if AltPrefix=0 then
         AltPrefix:=26;
@@ -2684,11 +2949,30 @@ begin
         end;
       {kitty_keys_no:=true;}
       isKittyKeys:=kitty_keys_yes;
-      if kitty_keys_yes or (kitty_keys_yes=kitty_keys_no) then
-         write(#27'[>31u'); { try to set up kitty keys }
-      KittyKeyAvailability;
-      if not isKittyKeys then
-        write(#27'[>4;2m'); { xterm ->  modifyOtherKeys }
+
+      envInput := LowerCase(fpgetenv('TV_INPUT'));
+      if envInput = 'win32' then
+        begin
+          write(#27'[?9001h');
+        end
+      else if envInput = 'kitty' then
+        begin
+          write(#27'[>31u');
+          KittyKeyAvailability;
+        end
+      else if envInput = 'legacy' then
+        begin
+          // Do nothing
+        end
+      else // TV_INPUT not set or incorrect, use default logic
+        begin
+          if kitty_keys_yes or (kitty_keys_yes=kitty_keys_no) then
+             write(#27'[>31u'); { try to set up kitty keys }
+          KittyKeyAvailability;
+          if not isKittyKeys then
+            write(#27'[>4;2m'); { xterm ->  modifyOtherKeys }
+          write(#27'[?9001h'); // Try to enable win32-input-mode
+        end;
 {$ifdef linux}
     end;
 {$endif}
@@ -2703,6 +2987,7 @@ begin
   if is_console then
   unpatchkeyboard;
 {$endif linux}
+  write(#27'[?9001l'); // Disable win32-input-mode
   if not isKittyKeys then
     write(#27'[>4m'); { xterm -> reset to default modifyOtherKeys }
   if kitty_keys_yes then
@@ -2783,6 +3068,7 @@ var
   MyKey: TEnhancedKeyEvent;
   EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,Again : boolean;
   SState: TEnhancedShiftState;
+  i: integer;
 
 begin {main}
   if PendingEnhancedKeyEvent<>NilEnhancedKeyEvent then
@@ -2794,6 +3080,15 @@ begin {main}
     end;
   SysGetEnhancedKeyEvent:=NilEnhancedKeyEvent;
   MyKey:=ReadKey;
+
+  // FAST PATH for pre-constructed events from ReadKey's Alt+UTF8 logic
+  if (MyKey.ShiftState <> []) and (Ord(MyKey.UnicodeChar) > 0) and (Ord(MyKey.UnicodeChar) <> Ord(MyKey.AsciiChar)) then
+  begin
+    SysGetEnhancedKeyEvent := MyKey;
+    LastShiftState := MyKey.ShiftState;
+    exit;
+  end;
+
   MyChar:=MyKey.AsciiChar;
   MyUniChar:=MyKey.UnicodeChar;
   MyScan:=MyKey.VirtualScanCode shr 8;
@@ -2849,17 +3144,6 @@ begin {main}
         LastShiftState:=SysGetEnhancedKeyEvent.ShiftState; {to fake shift state later}
         exit;
       end
-    else if MyChar=#27 then
-      begin
-        if EscUsed then
-          SState:=SState-[essAlt,essLeftAlt,essRightAlt]
-        else
-          begin
-            Include(SState,essAlt);
-            Again:=true;
-            EscUsed:=true;
-          end;
-      end
     else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
       begin { ^Z - replace Alt for Linux OS }
         if AltPrefixUsed then
@@ -2903,6 +3187,34 @@ begin {main}
   until not Again;
   if MyScan = 0 then
       MyScan:=EvalScan(ord(MyChar));
+  // Legacy mode fix: interpret single-byte C0 control characters. This logic
+  // applies only when a raw character was read, not a pre-parsed sequence.
+  if (MyKey.VirtualScanCode and $FF00 = 0) and (Ord(MyChar) >= 1) and (Ord(MyChar) <= 31) and not (essCtrl in SState) then
+  begin
+    case Ord(MyChar) of
+      8, 9, 10, 13, 27: // Backspace, Tab, LF, CR, Esc are their own keys
+        begin
+          // Do not treat these as Ctrl+<key> combinations in this context.
+        end;
+      else // This is a Ctrl+<key> combination (e.g., Ctrl+A = #1).
+      begin
+        Include(SState, essCtrl);
+        // The application expects the actual character ('A'), not the control
+        // code (#1). We must find the original character based on the scan code
+        // to mimic the behavior of the win32 input mode.
+        // Search for the corresponding character in the scan code table.
+        for i := Ord('A') to Ord('Z') do
+        begin
+          if (cScanValue[i] = MyScan) then
+          begin
+            MyChar := AnsiChar(i);
+            MyUniChar := WideChar(i);
+            break;
+          end;
+        end;
+      end;
+    end;
+  end;
   if (essCtrl in SState) and (not (essAlt in SState)) then
     begin
       if (MyChar=#9) and (MyScan <> $17) then
@@ -2940,7 +3252,15 @@ begin {main}
       SysGetEnhancedKeyEvent.AsciiChar:=MyChar;
       SysGetEnhancedKeyEvent.UnicodeChar:=MyUniChar;
       SysGetEnhancedKeyEvent.ShiftState:=SState;
-      SysGetEnhancedKeyEvent.VirtualScanCode:=(MyScan shl 8) or Ord(MyChar);
+
+      // For Ctrl+<letter>, KeyCode must be 1..26 for A..Z.
+      // This ensures backward compatibility with older code.
+      // We check for Ctrl without Alt to avoid interfering with AltGr.
+      if (essCtrl in SState) and not (essAlt in SState) and (UpCase(MyChar) in ['A'..'Z']) then
+        SysGetEnhancedKeyEvent.VirtualScanCode := Ord(UpCase(MyChar)) - Ord('A') + 1
+      else
+        // Default behavior for all other key combinations.
+        SysGetEnhancedKeyEvent.VirtualScanCode := (MyScan shl 8) or Ord(MyChar);
     end;
   LastShiftState:=SysGetEnhancedKeyEvent.ShiftState; {to fake shift state later}
 end;

packages/rtl-console/src/unix/video.pp

@@ -930,6 +930,172 @@ begin
   TCSetAttr(1,TCSANOW,tio);
 end;
 
+function DeduceOemCodePageFromLocale: TSystemCodePage;
+var
+  lc: PAnsiChar;
+  lc_str: AnsiString;
+
+  function IsLocaleMatches(const current, wanted: AnsiString): boolean;
+  var
+    wanted_len: integer;
+  begin
+    wanted_len := length(wanted);
+    if length(current) < wanted_len then
+      begin
+        IsLocaleMatches:=false;
+        exit;
+      end;
+    if StrLComp(PAnsiChar(current), PAnsiChar(wanted), wanted_len) <> 0 then
+      begin
+        IsLocaleMatches:=false;
+        exit;
+      end;
+    if length(current) = wanted_len then
+      IsLocaleMatches:=true
+    else
+      IsLocaleMatches:=(current[wanted_len + 1] = '.');
+  end;
+
+begin
+  DeduceOemCodePageFromLocale := 437;
+
+  lc := fpgetenv('LANG');
+
+  if lc = nil then
+    exit;
+
+  lc_str := lc;
+
+  if IsLocaleMatches(lc_str, 'af_ZA') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'ar_SA') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_LB') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_EG') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_DZ') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_BH') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_IQ') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_JO') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_KW') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_LY') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_MA') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_OM') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_QA') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_SY') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_TN') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_AE') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ar_YE') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'ast_ES') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'az_AZ') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'be_BY') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'bg_BG') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'br_FR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'ca_ES') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'zh_CN') then DeduceOemCodePageFromLocale := 936
+  else if IsLocaleMatches(lc_str, 'zh_TW') then DeduceOemCodePageFromLocale := 950
+  else if IsLocaleMatches(lc_str, 'kw_GB') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'cs_CZ') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'cy_GB') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'da_DK') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'de_AT') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'de_LI') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'de_LU') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'de_CH') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'de_DE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'el_GR') then DeduceOemCodePageFromLocale := 737
+  else if IsLocaleMatches(lc_str, 'en_AU') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_CA') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_GB') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_IE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_JM') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_BZ') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_PH') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'en_ZA') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'en_TT') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'en_US') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'en_ZW') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'en_NZ') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_PA') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_BO') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_CR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_DO') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_SV') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_EC') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_GT') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_HN') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_NI') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_CL') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_MX') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_ES') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_CO') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_PE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_AR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_PR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_VE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_UY') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'es_PY') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'et_EE') then DeduceOemCodePageFromLocale := 775
+  else if IsLocaleMatches(lc_str, 'eu_ES') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fa_IR') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'fi_FI') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fo_FO') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fr_FR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fr_BE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fr_CA') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fr_LU') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fr_MC') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'fr_CH') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'ga_IE') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'gd_GB') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'gv_IM') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'gl_ES') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'he_IL') then DeduceOemCodePageFromLocale := 862
+  else if IsLocaleMatches(lc_str, 'hr_HR') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'hu_HU') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'id_ID') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'is_IS') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'it_IT') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'it_CH') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'iv_IV') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'ja_JP') then DeduceOemCodePageFromLocale := 932
+  else if IsLocaleMatches(lc_str, 'kk_KZ') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'ko_KR') then DeduceOemCodePageFromLocale := 949
+  else if IsLocaleMatches(lc_str, 'ky_KG') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'lt_LT') then DeduceOemCodePageFromLocale := 775
+  else if IsLocaleMatches(lc_str, 'lv_LV') then DeduceOemCodePageFromLocale := 775
+  else if IsLocaleMatches(lc_str, 'mk_MK') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'mn_MN') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'ms_BN') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'ms_MY') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'nl_BE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'nl_NL') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'nl_SR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'nn_NO') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'nb_NO') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'pl_PL') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'pt_BR') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'pt_PT') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'rm_CH') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'ro_RO') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'ru_RU') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'sk_SK') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'sl_SI') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'sq_AL') then DeduceOemCodePageFromLocale := 852
+  else if IsLocaleMatches(lc_str, 'sr_RS') then DeduceOemCodePageFromLocale := 855
+  else if IsLocaleMatches(lc_str, 'sv_SE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'sv_FI') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'sw_KE') then DeduceOemCodePageFromLocale := 437
+  else if IsLocaleMatches(lc_str, 'th_TH') then DeduceOemCodePageFromLocale := 874
+  else if IsLocaleMatches(lc_str, 'tr_TR') then DeduceOemCodePageFromLocale := 857
+  else if IsLocaleMatches(lc_str, 'tt_RU') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'uk_UA') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'ur_PK') then DeduceOemCodePageFromLocale := 720
+  else if IsLocaleMatches(lc_str, 'uz_UZ') then DeduceOemCodePageFromLocale := 866
+  else if IsLocaleMatches(lc_str, 'vi_VN') then DeduceOemCodePageFromLocale := 1258
+  else if IsLocaleMatches(lc_str, 'wa_BE') then DeduceOemCodePageFromLocale := 850
+  else if IsLocaleMatches(lc_str, 'zh_HK') then DeduceOemCodePageFromLocale := 950
+  else if IsLocaleMatches(lc_str, 'zh_SG') then DeduceOemCodePageFromLocale := 936
+  else if IsLocaleMatches(lc_str, 'zh_MO') then DeduceOemCodePageFromLocale := 950;
+end;
+
 procedure decide_codepages;
 
 var s:shortstring;
@@ -953,7 +1119,7 @@ begin
     CP_ISO05:            {Cyrillic}
       CurrentLegacy2EnhancedTranslationCodePage:=866;
     CP_UTF8:
-      CurrentLegacy2EnhancedTranslationCodePage:=437;
+      CurrentLegacy2EnhancedTranslationCodePage:=DeduceOemCodePageFromLocale;
     else
       if is_vga_code_page(external_codepage) then
         CurrentLegacy2EnhancedTranslationCodePage:=external_codepage
@@ -1009,6 +1175,7 @@ var
 {$ifdef freebsd}
   ThisTTY: String[30];
 {$endif}
+  envInput: string;
 
 const font_vga:array[0..11] of AnsiChar=#15#27'%@'#27'(U'#27'[3h';
       font_lat1:array[0..5] of AnsiChar=#27'%@'#27'(B';
@@ -1165,7 +1332,10 @@ begin
      videoInitDone;
 
      decide_codepages;
-     SendEscapeSeq(#27'[>31u');{Entering alternativ screen we have to set up kitty keys}
+
+     envInput := LowerCase(fpgetenv('TV_INPUT'));
+     if (envInput = '') or (envInput = 'kitty') then
+       SendEscapeSeq(#27'[>31u');{Entering alternativ screen we have to set up kitty keys}
    end
   else
    ErrorCode:=errVioInit; { not a TTY }

packages/vcl-compat/src/system.netencoding.pp

@@ -22,9 +22,9 @@ unit System.NetEncoding;
 interface
 
 {$IFDEF FPC_DOTTEDUNITS}
-uses System.SysUtils, System.Classes, System.Types;
+uses System.SysUtils, System.Classes, System.Types, System.Hash.Base64;
 {$ELSE FPC_DOTTEDUNITS}
-uses Sysutils, Classes, Types;
+uses Sysutils, Classes, Types, Base64;
 {$ENDIF FPC_DOTTEDUNITS}
 
 type
@@ -43,6 +43,7 @@ type
       TStandardEncoding = (
         seBase64,
         seBase64String,
+        seBase64URL,
         seHTML,
         seURL);
     Class var
@@ -90,6 +91,7 @@ type
     Function EncodeBytesToString(const aInput: Pointer; Size: Integer): UnicodeString; overload;
     // Default instances
     class property Base64: TNetEncoding Index seBase64 read GetStdEncoding;
+    class property Base64URL: TNetEncoding Index seBase64URL read GetStdEncoding;
     class property Base64String: TNetEncoding Index seBase64String read GetStdEncoding;
     class property HTML: TNetEncoding Index seHTML read GetStdEncoding;
     class property URL: TURLEncoding read GetURLEncoding;
@@ -105,6 +107,8 @@ type
     FCharsPerline: Integer;
     FLineSeparator: UnicodeString;
     FPadEnd: Boolean;
+    function CreateDecoder(const aInput: TStream) : TBase64DecodingStream; virtual;
+    function CreateEncoder(const aOutput: TStream) : TBase64EncodingStream; virtual;
   protected
     Function DoDecode(const aInput, aOutput: TStream): Integer; overload; override;
     Function DoEncode(const aInput, aOutput: TStream): Integer; overload; override;
@@ -126,6 +130,13 @@ type
     constructor Create(CharsPerLine: Integer; LineSeparator: RawByteString); overload;
   end;
 
+  { TBase64URLEncoding }
+
+  TBase64URLEncoding = class(TBase64Encoding)
+    function CreateDecoder(const aInput: TStream) : TBase64DecodingStream; override;
+    function CreateEncoder(const aOutput: TStream) : TBase64EncodingStream; override;
+  end;
+
   { TBase64StringEncoding }
 
   TBase64StringEncoding = class(TCustomBase64Encoding)
@@ -165,9 +176,9 @@ type
 implementation
 
 {$IFDEF FPC_DOTTEDUNITS}
-uses System.Hash.Base64, FpWeb.Http.Protocol, Html.Defs, Xml.Read;
+uses FpWeb.Http.Protocol, Html.Defs, Xml.Read;
 {$ELSE FPC_DOTTEDUNITS}
-uses base64, httpprotocol, HTMLDefs, xmlread;
+uses httpprotocol, HTMLDefs, xmlread;
 {$ENDIF FPC_DOTTEDUNITS}
 
 Resourcestring
@@ -175,13 +186,27 @@ Resourcestring
 
 { TCustomBase64Encoding }
 
+function TCustomBase64Encoding.CreateDecoder(const aInput: TStream) : TBase64DecodingStream;
+
+begin
+  Result:=TBase64DecodingStream.Create(aInput,bdmMIME);
+end;
+
+
+function TCustomBase64Encoding.CreateEncoder(const aOutput: TStream) : TBase64EncodingStream;
+
+begin
+  Result:=TBase64EncodingStream.Create(aOutput,FCharsPerline,FLineSeparator,FPadEnd);
+end;
+
+
 function TCustomBase64Encoding.DoDecode(const aInput, aOutput: TStream): Integer;
 
 Var
   S : TBase64DecodingStream;
 
 begin
-  S:=TBase64DecodingStream.Create(aInput,bdmMIME);
+  S:=CreateDecoder(aInput);
   try
     Result:=S.Size;
     aOutput.CopyFrom(S,Result);
@@ -208,7 +233,7 @@ begin
     Instream.Position:=0;
     Outstream:=TBytesStream.Create;
     try
-      Decoder:=TBase64DecodingStream.Create(Instream,bdmMIME);
+      Decoder:=CreateDecoder(Instream);
       try
          Outstream.CopyFrom(Decoder,Decoder.Size);
          Result:=Outstream.Bytes;
@@ -229,7 +254,7 @@ Var
   S : TBase64EncodingStream;
 
 begin
-  S:=TBase64EncodingStream.Create(aOutput,FCharsPerline,FLineSeparator,FPadEnd);
+  S:=CreateEncoder(aOutput); //,FCharsPerline,FLineSeparator,FPadEnd);
   try
     Result:=S.CopyFrom(aInput,0);
   finally
@@ -246,7 +271,7 @@ begin
     Exit(nil);
   Outstream:=TBytesStream.Create;
   try
-    Encoder:=TBase64EncodingStream.create(outstream,FCharsPerline,FLineSeparator,FPadEnd);
+    Encoder:=CreateEncoder(outstream);
     try
       Encoder.Write(aInput[0],Length(aInput));
     finally
@@ -273,7 +298,7 @@ begin
     Exit('');
   Outstream:=TStringStream.Create('');
   try
-    Encoder:=TBase64EncodingStream.create(outstream,FCharsPerline,FLineSeparator,FPadEnd);
+    Encoder:=CreateEncoder(outstream);
     try
       Encoder.Write(aInput[1],Length(aInput));
     finally
@@ -310,6 +335,18 @@ begin
   Create(kCharsPerLine, kLineSeparator);
 end;
 
+{ TBase64URLEncoding }
+
+function TBase64URLEncoding.CreateDecoder(const aInput: TStream): TBase64DecodingStream;
+begin
+  Result:=TBase64URLDecodingStream.Create(aInput,bdmMIME);
+end;
+
+function TBase64URLEncoding.CreateEncoder(const aOutput: TStream): TBase64EncodingStream;
+begin
+  Result:=TBase64URLEncodingStream.Create(aOutput,FCharsPerline,FLineSeparator,FPadEnd);
+end;
+
 { TBase64StringEncoding }
 
 constructor TBase64StringEncoding.Create;
@@ -358,6 +395,7 @@ begin
   case aIndex of
     seBase64: Result:=TBase64Encoding.Create;
     seBase64String: Result:=TBase64StringEncoding.Create;
+    seBase64URL: Result:=TBase64URLEncoding.Create;
     seHTML: Result:=THTMLEncoding.Create;
     seURL: Result:=TURLEncoding.Create;
   end;

rtl/embedded/Makefile

@@ -1122,7 +1122,12 @@ CPU_UNITS_DEFINED=1
 endif
 ifeq ($(SUBARCH),rv32imac)
 override FPCOPT+=-Cprv32imac
-CPU_UNITS=CH32VxBootstrap $(FE310G000UNIT) $(FE310G002UNIT) $(GD32VF103XXUNIT)
+CPU_UNITS=CH32VxBootstrap $(GD32VF103XXUNIT)
+CPU_UNITS_DEFINED=1
+endif
+ifeq ($(SUBARCH),rv32imac_zicsr_zifencei)
+override FPCOPT+=-Cprv32imac
+CPU_UNITS=CH32VxBootstrap $(FE310G000UNIT) $(FE310G002UNIT)
 CPU_UNITS_DEFINED=1
 endif
 ifeq ($(SUBARCH),rv32i)

rtl/embedded/Makefile.fpc

@@ -267,7 +267,12 @@ CPU_UNITS_DEFINED=1
 endif
 ifeq ($(SUBARCH),rv32imac)
 override FPCOPT+=-Cprv32imac
-CPU_UNITS=CH32VxBootstrap $(FE310G000UNIT) $(FE310G002UNIT) $(GD32VF103XXUNIT)
+CPU_UNITS=CH32VxBootstrap $(GD32VF103XXUNIT)
+CPU_UNITS_DEFINED=1
+endif
+ifeq ($(SUBARCH),rv32imac_zicsr_zifencei)
+override FPCOPT+=-Cprv32imac
+CPU_UNITS=CH32VxBootstrap $(FE310G000UNIT) $(FE310G002UNIT)
 CPU_UNITS_DEFINED=1
 endif
 ifeq ($(SUBARCH),rv32i)

rtl/freertos/Makefile

@@ -949,11 +949,21 @@ ifeq ($(ARCH),riscv32)
 CPU_SPECIFIC_COMMON_UNITS=$(SYSUTILSUNIT) $(MATHUNIT) $(CLASSESUNIT) $(FGLUNIT) $(MACPASUNIT) $(TYPINFOUNIT) $(TYPESUNIT) $(RTLCONSTSUNIT) $(GETOPTSUNIT) $(LINEINFOUNIT)
 ifeq ($(SUBARCH),rv32imc)
 override FPCOPT+=-Cprv32imc
-CPU_UNITS=esp32c2 esp32c2idf_50000 esp32c2idf_50200 esp32c3 esp32c3idf_40400 esp32c3idf_50000 esp32c3idf_50200 esp32c3idf_50300
+CPU_UNITS=
 CPU_UNITS_DEFINED=1
 endif
 ifeq ($(SUBARCH),rv32imac)
 override FPCOPT+=-Cprv32imac
+CPU_UNITS=
+CPU_UNITS_DEFINED=1
+endif
+ifeq ($(SUBARCH),rv32imc_zicsr_zifencei)
+override FPCOPT+=-Cprv32imc_zicsr_zifencei
+CPU_UNITS=esp32c2 esp32c2idf_50000 esp32c2idf_50200 esp32c3 esp32c3idf_40400 esp32c3idf_50000 esp32c3idf_50200 esp32c3idf_50300
+CPU_UNITS_DEFINED=1
+endif
+ifeq ($(SUBARCH),rv32imac_zicsr_zifencei)
+override FPCOPT+=-Cprv32imac_zicsr_zifencei
 CPU_UNITS=esp32c6 esp32c6idf_50200
 CPU_UNITS_DEFINED=1
 endif

rtl/freertos/Makefile.fpc

@@ -82,11 +82,21 @@ ifeq ($(ARCH),riscv32)
 CPU_SPECIFIC_COMMON_UNITS=$(SYSUTILSUNIT) $(MATHUNIT) $(CLASSESUNIT) $(FGLUNIT) $(MACPASUNIT) $(TYPINFOUNIT) $(TYPESUNIT) $(RTLCONSTSUNIT) $(GETOPTSUNIT) $(LINEINFOUNIT)
 ifeq ($(SUBARCH),rv32imc)
 override FPCOPT+=-Cprv32imc
-CPU_UNITS=esp32c2 esp32c2idf_50000 esp32c2idf_50200 esp32c3 esp32c3idf_40400 esp32c3idf_50000 esp32c3idf_50200 esp32c3idf_50300
+CPU_UNITS=
 CPU_UNITS_DEFINED=1
 endif
 ifeq ($(SUBARCH),rv32imac)
 override FPCOPT+=-Cprv32imac
+CPU_UNITS=
+CPU_UNITS_DEFINED=1
+endif
+ifeq ($(SUBARCH),rv32imc_zicsr_zifencei)
+override FPCOPT+=-Cprv32imc_zicsr_zifencei
+CPU_UNITS=esp32c2 esp32c2idf_50000 esp32c2idf_50200 esp32c3 esp32c3idf_40400 esp32c3idf_50000 esp32c3idf_50200 esp32c3idf_50300
+CPU_UNITS_DEFINED=1
+endif
+ifeq ($(SUBARCH),rv32imac_zicsr_zifencei)
+override FPCOPT+=-Cprv32imac_zicsr_zifencei
 CPU_UNITS=esp32c6 esp32c6idf_50200
 CPU_UNITS_DEFINED=1
 endif

rtl/inc/except.inc

@@ -325,6 +325,10 @@ Procedure SysInitExceptions;
   Initialize exceptionsupport
 }
 begin
+  // These are here, because they need to be initialized for every thread.
+  CastErrorFrom:='';
+  CastErrorTo:='';
+
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
 end;

rtl/inc/objpas.inc

@@ -42,12 +42,31 @@
            aobject.inheritsfrom(aclass);
       end;
 
+{$IFDEF FPC_HAS_FEATURE_THREADING}
+threadvar
+  CastErrorFrom : ShortString;
+  CastErrorTo : ShortString;
+{$ELSE}
+var
+  CastErrorFrom : ShortString = '';
+  CastErrorTo : ShortString = '';
+{$ENDIF}
+
+
+    procedure SetCastErrorInfo(const aFrom,aTo : shortstring);
+    begin
+      CastErrorFrom:=aFrom;
+      CastErrorTo:=aTo;
+    end;
 
     { the reverse order of the parameters make code generation easier }
     function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; compilerproc;
       begin
          if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
+           begin
+           SetCastErrorInfo(aObject.ClassName,aClass.ClassName);
            handleerroraddrframeInd(219,get_pc_addr,get_frame);
+           end;
          result := aobject;
       end;
 
@@ -205,12 +224,19 @@
     function fpc_intf_as(const S: pointer; const iid: TGUID): IInterface;[public,alias: 'FPC_INTF_AS']; compilerproc;
       var
         tmpi: pointer; // _AddRef before _Release
+        errObj : TObject;
       begin
         if assigned(S) then
           begin
              tmpi:=nil;
              if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
+               begin
+               if (IUnknown(S).QueryInterface(IObjectInstance,errObj)=S_OK) then
+                 SetCastErrorInfo(errObj.ClassName,iid.AsString)
+               else
+                 SetCastErrorInfo('External interface',iid.AsString);
                handleerror(219);
+               end;
              // decrease reference count
              fpc_intf_as:=nil;
              pointer(fpc_intf_as):=tmpi;
@@ -223,11 +249,18 @@
     function fpc_intf_as_class(const S: pointer; const aclass: tclass): pointer;[public,alias: 'FPC_INTF_AS_CLASS']; compilerproc;
       var
         tmpo: tobject;
+        errObj : TObject;
       begin
         if assigned(S) then
           begin
             if not ((IUnknown(S).QueryInterface(IObjectInstance,tmpo)=S_OK) and tmpo.inheritsfrom(aclass)) then
+              begin
+              if (IUnknown(S).QueryInterface(IObjectInstance,errObj)=S_OK) then
+                SetCastErrorInfo(errObj.ClassName,aClass.ClassName)
+              else
+                SetCastErrorInfo('External interface',aClass.ClassName);
               handleerror(219);
+              end;
             fpc_intf_as_class:=tmpo;
           end
         else
@@ -239,13 +272,17 @@
       var
         tmpi: pointer; // _AddRef before _Release
         tmpi2: pointer; // weak!
+        errObj : TObject;
       begin
         if assigned(S) then
           begin
              tmpi:=nil;
              tmpi2:=nil;
              if not ((TObject(S).GetInterfaceWeak(IUnknown,tmpi2) and (IUnknown(tmpi2).QueryInterface(IID,tmpi)=S_OK)) or TObject(S).GetInterface(IID,tmpi)) then
+               begin
+               SetCastErrorInfo(TObject(S).ClassName,iid.AsString);
                handleerror(219);
+               end;
              // decrease reference count
              fpc_class_as_intf:=nil;
              pointer(fpc_class_as_intf):=tmpi;
@@ -263,7 +300,10 @@
           begin
              tmpi:=nil;
              if not TObject(S).GetInterface(iid,tmpi) then
+               begin
+               SetCastErrorInfo(TObject(S).ClassName,iid);
                handleerror(219);
+               end;
              fpc_class_as_corbaintf:=tmpi;
           end
         else
@@ -353,8 +393,18 @@ begin
   Result:=(P[0]=0) and (P[1]=0) and (P[2]=0) and (P[3]=0)
 end;
 
+function TGUID.AsString : ShortString;
 
 
+begin
+  WriteStr(Result,'{',hexstr(Longint(D1),8),
+                      '-',HexStr(D2,4),
+                      '-',HexStr(D3,4),
+                      '-',HexStr(D4[0],2), HexStr(D4[1],2),
+                      '-',HexStr(D4[2],2), HexStr(D4[3],2), HexStr(D4[4],2), HexStr(D4[5],2), HexStr(D4[6],2), HexStr(D4[7],2),
+                   '}');
+end;
+
 {****************************************************************************
                            TINTERFACEENTRY
 ****************************************************************************}
@@ -1055,6 +1105,15 @@ end;
           getinterfacetable:=PVmt(Self)^.vIntfTable;
         end;
 
+      class procedure TObject.GetLastCastErrorInfo(out aFrom,aTo : shortstring);
+
+      begin
+        aFrom:=CastErrorFrom;
+        aTo:=CastErrorTo;
+        CastErrorFrom:='';
+        CastErrorTo:='';
+      end;
+
       class function TObject.UnitName : RTLString;
 {$ifdef FPC_HAS_FEATURE_RTTI}
 

rtl/inc/objpash.inc

@@ -45,6 +45,7 @@
         class function Create(const aData: array of Byte; aStartIndex: Cardinal; aBigEndian: Boolean = False): TGUID; overload; static;
         class function Create(const aData : PByte; aBigEndian: Boolean = False): TGUID; overload; static;
         function IsEmpty: Boolean;
+        function AsString : ShortString;
       Public
          case integer of
             1 : (
@@ -278,6 +279,8 @@
 
           class function MethodAddress(const name : shortstring) : codepointer;
           class function MethodName(address : codepointer) : shortstring;
+          class procedure GetLastCastErrorInfo(out aFrom,aTo : shortstring); static;
+
           function FieldAddress(const name : shortstring) : pointer;
 
           { new since Delphi 4 }

rtl/objpas/sysconst.pp

@@ -89,6 +89,7 @@ const
   SInvalidUnaryVarOp     = 'Invalid variant operation %s %s';
   SInvalidVarOpWithHResultWithPrefix = 'Invalid variant operation (%s%.8x)'+LineEnding+'%s';
   SNoError               = 'No error.';
+  SInstanceIsNotA        = ': %s is not a %s';
   SNoThreadSupport       = 'Threads not supported. Recompile program with thread driver.';
   SNoDynLibsSupport      = 'Dynamic libraries not supported. Recompile program with dynamic library driver.';
   SMissingWStringManager = 'Widestring manager not available. Recompile program with appropriate manager.';

rtl/objpas/sysutils/sysutils.inc

@@ -453,6 +453,7 @@ var
   E: Exception;
   HS: PResStringRec;
   Entry: PExceptMapEntry;
+  CastFrom,CastTo : ShortString;
 begin
   Case Errno of
    1,203 : E:=OutOfMemory;
@@ -460,7 +461,14 @@ begin
   else
     Entry:=FindExceptMapEntry(ErrNo);
     if Assigned(Entry) then
-      E:=Entry^.cls.CreateRes(Entry^.msg)
+    begin
+      E:=Entry^.cls.CreateRes(Entry^.msg);
+      if (ErrNo=219) then
+        begin
+        TObject.GetLastCastErrorInfo(CastFrom,CastTo);
+        E.Message:=E.Message+Format(SInstanceIsNotA,[CastFrom,CastTo]);
+        end;
+    end
     else
     begin
      HS:=nil;

tests/tbs/tb0722.pp

@@ -0,0 +1,9 @@
+program tb0722;
+
+{$mode delphi}
+
+{$region 'foobar}
+
+begin
+
+end.