Merge branch 'main' into wasm_goto

compiler/dbgdwarf.pas

@@ -663,10 +663,10 @@ implementation
                   begin
                     if not assigned(def.typesym) then
                       internalerror(200610011);
-                    result^.lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_METADATA);
-                    result^.ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_METADATA);
+                    result^.lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.typesym.owner,symname(def.typesym, true)),AT_METADATA);
+                    result^.ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.typesym.owner,symname(def.typesym, true)),AT_METADATA);
                     if needstructdeflab then
-                      result^.struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_METADATA);
+                      result^.struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.typesym.owner,symname(def.typesym, true)),AT_METADATA);
                     def.dbg_state:=dbg_state_written;
                   end
                 else
@@ -677,10 +677,10 @@ implementation
                        (def.owner.symtabletype=globalsymtable) and
                        (def.owner.iscurrentunit) then
                       begin
-                        result^.lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
-                        result^.ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
+                        result^.lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.typesym.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
+                        result^.ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.typesym.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
                         if needstructdeflab then
-                          result^.struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
+                          result^.struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.typesym.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
                         include(def.defstates,ds_dwarf_dbg_info_written);
                       end
                     else
@@ -3434,7 +3434,7 @@ implementation
       end;
 
 
-        procedure TDebugInfoDwarf.append_visibility(vis: tvisibility);
+    procedure TDebugInfoDwarf.append_visibility(vis: tvisibility);
       begin
         case vis of
           vis_hidden,

compiler/fppu.pas

@@ -2370,7 +2370,7 @@ var
           we create an entry and register the unit }
         if not assigned(hp) then
          begin
-           Message1(unit_u_registering_new_unit,Upper(s));
+           Message1(unit_u_registering_new_unit,ups);
            hp:=tppumodule.create(callermodule,s,fn,true);
            hp.loaded_from:=callermodule;
            addloadedunit(hp);

compiler/pexpr.pas

@@ -4485,7 +4485,7 @@ implementation
               end;
             procdef:
               begin
-                if block_type<>bt_body then
+                if not (block_type in [bt_body,bt_except]) then
                   begin
                     message(parser_e_illegal_expression);
                     gensym:=generrorsym;

compiler/ptype.pas

@@ -1339,6 +1339,9 @@ implementation
                    else
                      Message(sym_e_ill_type_decl_set);
                  end;
+               { generic parameter? }
+               undefineddef:
+                ;
                else
                  Message(sym_e_ill_type_decl_set);
              end;

compiler/x86/rax86att.pas

@@ -306,6 +306,7 @@ Implementation
 
       var
         expr : string;
+        tmp : tx86operand;
       begin
         oper.InitRef;
         Consume(AS_LPAREN);
@@ -357,35 +358,53 @@ Implementation
             begin
               expr:=actasmpattern;
               Consume(AS_ID);
-              if not oper.SetupVar(expr,false) then
+              tmp:=Tx86Operand.create;
+              if not tmp.SetupVar(expr,false) then
                 begin
                   { look for special symbols ... }
                   if expr= '__HIGH' then
                     begin
                       consume(AS_LPAREN);
-                      if not oper.setupvar('high'+actasmpattern,false) then
+                      if not tmp.setupvar('high'+actasmpattern,false) then
                         Message1(sym_e_unknown_id,'high'+actasmpattern);
                       consume(AS_ID);
                       consume(AS_RPAREN);
                     end
                   else
                     if expr = '__SELF' then
-                      oper.SetupSelf
+                      tmp.SetupSelf
                   else
                     begin
                       message1(sym_e_unknown_id,expr);
                       RecoverConsume(false);
+                      tmp.free;
                       Exit;
                     end;
                 end;
               { convert OPR_LOCAL register para into a reference base }
-              if (oper.opr.typ=OPR_LOCAL) and
-                 AsmRegisterPara(oper.opr.localsym) then
-                oper.InitRefConvertLocal
+              if (tmp.opr.typ=OPR_LOCAL) and
+                 AsmRegisterPara(tmp.opr.localsym) then
+                begin
+                  tmp.InitRefConvertLocal;
+                  if (tmp.opr.ref.index<>NR_NO) or
+                      (tmp.opr.ref.offset<>0) or
+                      (tmp.opr.ref.scalefactor<>0) or
+                      (tmp.opr.ref.segment<>NR_NO) or
+                      (tmp.opr.ref.base=NR_NO) then
+                    begin
+                      message(asmr_e_invalid_reference_syntax);
+                      RecoverConsume(false);
+                      tmp.free;
+                      Exit;
+                    end;
+                  oper.opr.ref.base:=tmp.opr.ref.base;
+                  tmp.free;
+                end
               else
                 begin
                   message(asmr_e_invalid_reference_syntax);
                   RecoverConsume(false);
+                  tmp.free;
                   Exit;
                 end;
               { can either be a register, an identifier or a right parenthesis }

packages/fcl-base/src/gettext.pp

@@ -81,6 +81,11 @@ type
   procedure TranslateResourceStrings(const AFilename: AnsiString);
   procedure TranslateUnitResourceStrings(const AUnitName:AnsiString; const AFilename: AnsiString);
 
+Type
+  TTranslationErrorHandler = Procedure (const aFileName, aUnitName : String; aError : Exception; Out ReRaise : Boolean);
+
+Var
+  OnTranslationError : TTranslationErrorHandler = Nil;
 
 implementation
 
@@ -350,7 +355,17 @@ begin
 end;
 {$endif}
 
+Function DoReRaise(const aFileName, aUnitName : String; E : Exception) : boolean;
+
+begin
+  Result:=False;
+  if Assigned(OnTranslationError) then
+    OnTranslationError(aFileName,aUnitName,E,Result);
+end;
+
 procedure TranslateResourceStrings(const AFilename: AnsiString);
+
+  
 var
   mo: TMOFile;
   lang, FallbackLang: AnsiString;
@@ -369,7 +384,9 @@ begin
           mo.Free;
         end;
       except
-        on e: Exception do;
+        on e: Exception do 
+          if DoReRaise(FN,'',E) then
+            Raise ;
       end;
     end;
   lang := Copy(lang, 1, 5);
@@ -384,7 +401,9 @@ begin
           mo.Free;
         end;
       except
-        on e: Exception do;
+        on e: Exception do
+          if DoReRaise(FN,'',E) then
+            Raise ;
       end;
     end;
 end;
@@ -393,30 +412,38 @@ end;
 procedure TranslateUnitResourceStrings(const AUnitName:AnsiString; const AFilename: AnsiString);
 var
   mo: TMOFile;
+  FN : String;
   lang, FallbackLang: AnsiString;
 begin
   GetLanguageIDs(Lang, FallbackLang);
   try
-    mo := TMOFile.Create(Format(AFilename, [FallbackLang]));
+    FN := Format(AFilename, [FallbackLang]);
+    mo := TMOFile.Create(FN);
     try
       TranslateUnitResourceStrings(AUnitName,mo);
     finally
       mo.Free;
     end;
   except
-    on e: Exception do;
+    on e: Exception do
+      if DoReRaise(FN,aUnitName,E) then
+        Raise ;
   end;
 
   lang := Copy(lang, 1, 5);
   try
-    mo := TMOFile.Create(Format(AFilename, [lang]));
+    FN := Format(AFilename, [FallbackLang]);
+    mo := TMOFile.Create(FN);
     try
       TranslateUnitResourceStrings(AUnitName,mo);
     finally
       mo.Free;
     end;
   except
-    on e: Exception do;
+    on e: Exception do
+      if DoReRaise(FN,aUnitName,E) then
+        Raise ;
+
   end;
 end;
 

packages/fcl-css/src/fpcssresolver.pas

@@ -135,14 +135,14 @@ const
   CSSPseudoID_FirstOfType = CSSPseudoID_OnlyChild+1; // :first-of-type
   CSSPseudoID_LastOfType = CSSPseudoID_FirstOfType+1; // :last-of-type
   CSSPseudoID_OnlyOfType = CSSPseudoID_LastOfType+1; // :only-of-type
-  CSSCallID_Not = CSSPseudoID_OnlyOfType+1; // :nth-child
-  CSSCallID_Is = CSSCallID_Not+1; // :nth-child
-  CSSCallID_Where = CSSCallID_Is+1; // :nth-child
-  CSSCallID_Has = CSSCallID_Where+1; // :nth-child
-  CSSCallID_NthChild = CSSCallID_Has+1; // :nth-child
-  CSSCallID_NthLastChild = CSSCallID_NthChild+1; // :nth-child
-  CSSCallID_NthOfType = CSSCallID_NthLastChild+1; // :nth-child
-  CSSCallID_NthLastOfType = CSSCallID_NthOfType+1; // :nth-child
+  CSSCallID_Not = CSSPseudoID_OnlyOfType+1; // :not()
+  CSSCallID_Is = CSSCallID_Not+1; // :is()
+  CSSCallID_Where = CSSCallID_Is+1; // :where()
+  CSSCallID_Has = CSSCallID_Where+1; // :has()
+  CSSCallID_NthChild = CSSCallID_Has+1; // :nth-child(n)
+  CSSCallID_NthLastChild = CSSCallID_NthChild+1; // :nth-last-child(n)
+  CSSCallID_NthOfType = CSSCallID_NthLastChild+1; // :nth-of-type(n)
+  CSSCallID_NthLastOfType = CSSCallID_NthOfType+1; // :nth-last-of-type(n)
   CSSLastPseudoID = CSSCallID_NthLastOfType;
 
 const
@@ -201,8 +201,7 @@ type
     function GetCSSPreviousOfType: ICSSNode;
     function HasCSSAttribute(const AttrID: TCSSNumericalID): boolean;
     function GetCSSAttribute(const AttrID: TCSSNumericalID): TCSSString;
-    function HasCSSPseudo(const AttrID: TCSSNumericalID): boolean;
-    function GetCSSPseudo(const AttrID: TCSSNumericalID): TCSSString;
+    function HasCSSPseudoClass(const AttrID: TCSSNumericalID): boolean;
     function GetCSSEmpty: boolean;
     function GetCSSDepth: integer;
     procedure SetCSSValue(AttrID: TCSSNumericalID; Value: TCSSElement);
@@ -213,7 +212,7 @@ type
   TCSSNumericalIDKind = (
     nikType,
     nikAttribute,
-    nikPseudoAttribute
+    nikPseudoClass
     );
   TCSSNumericalIDKinds = set of TCSSNumericalIDKind;
 
@@ -221,7 +220,7 @@ const
   CSSNumericalIDKindNames: array[TCSSNumericalIDKind] of TCSSString = (
     'Type',
     'Attribute',
-    'PseudoAttribute'
+    'PseudoClass'
     );
 
 type
@@ -732,7 +731,7 @@ begin
   if OnlySpecifity then
     exit(CSSSpecifityClass);
   Result:=CSSSpecifityNoMatch;
-  PseudoID:=ResolveIdentifier(aPseudoClass,nikPseudoAttribute);
+  PseudoID:=ResolveIdentifier(aPseudoClass,nikPseudoClass);
   case PseudoID of
   CSSIDNone:
     LogWarning(croErrorOnUnknownName in Options,20220911205605,'Unknown CSS selector pseudo attribute name "'+aPseudoClass.Name+'"',aPseudoClass);
@@ -763,7 +762,7 @@ begin
         and (TestNode.GetCSSPreviousOfType=nil) then
       Result:=CSSSpecifityClass;
   else
-    if TestNode.GetCSSPseudo(PseudoID)<>'' then
+    if TestNode.HasCSSPseudoClass(PseudoID) then
       Result:=CSSSpecifityClass;
   end;
 end;
@@ -1763,7 +1762,7 @@ begin
       'class': Result:=CSSAttributeID_Class;
       'all': Result:=CSSAttributeID_All;
       end;
-    nikPseudoAttribute:
+    nikPseudoClass:
       begin
       aName:=lowercase(aName); // pseudo attributes are ASCII case insensitive
       case aName of

packages/fcl-css/tests/tccssresolver.pp

@@ -47,6 +47,7 @@ const
     );
 
   DemoAttrIDBase = 100;
+  DemoPseudoClassIDBase = 100;
 
 type
   TDemoPseudoClass = (
@@ -55,6 +56,13 @@ type
     );
   TDemoPseudoClasses = set of TDemoPseudoClass;
 
+const
+  DemoPseudoClassNames: array[TDemoPseudoClass] of string = (
+    // case sensitive!
+    ':active',
+    ':hover'
+    );
+
 type
 
   { TDemoNode }
@@ -63,7 +71,9 @@ type
   private
     class var FAttributeInitialValues: array[TDemoNodeAttribute] of string;
   private
+    FActive: boolean;
     FAttributeValues: array[TDemoNodeAttribute] of string;
+    FHover: boolean;
     FNodes: TFPObjectList; // list of TDemoNode
     FCSSClasses: TStrings;
     FParent: TDemoNode;
@@ -72,7 +82,9 @@ type
     function GetAttribute(AIndex: TDemoNodeAttribute): string;
     function GetNodeCount: integer;
     function GetNodes(Index: integer): TDemoNode;
+    procedure SetActive(const AValue: boolean);
     procedure SetAttribute(AIndex: TDemoNodeAttribute; const AValue: string);
+    procedure SetHover(const AValue: boolean);
     procedure SetParent(const AValue: TDemoNode);
     procedure SetStyleElements(const AValue: TCSSElement);
     procedure SetStyle(const AValue: string);
@@ -104,8 +116,7 @@ type
     function GetCSSAttributeClass: TCSSString; virtual;
     function HasCSSAttribute(const AttrID: TCSSNumericalID): boolean; virtual;
     function GetCSSAttribute(const AttrID: TCSSNumericalID): TCSSString; virtual;
-    function HasCSSPseudo(const {%H-}AttrID: TCSSNumericalID): boolean; virtual;
-    function GetCSSPseudo(const {%H-}AttrID: TCSSNumericalID): TCSSString; virtual;
+    function HasCSSPseudoClass(const {%H-}AttrID: TCSSNumericalID): boolean; virtual;
     function GetCSSEmpty: boolean; virtual;
     function GetCSSDepth: integer; virtual;
     property Parent: TDemoNode read FParent write SetParent;
@@ -123,6 +134,10 @@ type
     property Display: string index naDisplay read GetAttribute write SetAttribute;
     property Color: string index naColor read GetAttribute write SetAttribute;
     property Attribute[Attr: TDemoNodeAttribute]: string read GetAttribute write SetAttribute;
+    // CSS pseudo classes
+    property Active: boolean read FActive write SetActive;
+    property Hover: boolean read FHover write SetHover;
+    function HasPseudoClass(PseudoClass: TDemoPseudoClass): boolean;
   end;
   TDemoNodeClass = class of TDemoNode;
 
@@ -208,9 +223,9 @@ type
     // Test list spaces "div, button ,span {}"
     procedure Test_Selector_Id;
     procedure Test_Selector_Class;
-    procedure Test_Selector_ClassClass; // ToDo and combinator
-    procedure Test_Selector_ClassSpaceClass; // ToDo descendant combinator
-    procedure Test_Selector_TypeCommaType; // or combinator
+    procedure Test_Selector_ClassClass; // AND combinator
+    procedure Test_Selector_ClassSpaceClass; // Descendant combinator
+    procedure Test_Selector_TypeCommaType; // OR combinator
     procedure Test_Selector_ClassGTClass; // child combinator
     procedure Test_Selector_TypePlusType; // adjacent sibling combinator
     procedure Test_Selector_TypeTildeType; // general sibling combinator
@@ -224,7 +239,7 @@ type
     procedure Test_Selector_AttributeContainsSubstring;
     // ToDo: "all"
 
-    // pseudo attributes
+    // pseudo classes
     procedure Test_Selector_Root;
     procedure Test_Selector_Empty;
     procedure Test_Selector_FirstChild;
@@ -243,8 +258,12 @@ type
     procedure Test_Selector_Where;
     // ToDo: div:has(>img)
     // ToDo: div:has(+img)
+    // ToDo: :dir()
     // ToDo: :lang()
 
+    // custom pseudo classes
+    procedure Test_Selector_Hover;
+
     // inline style
     procedure Test_InlineStyle;
 
@@ -1232,6 +1251,39 @@ begin
   AssertEquals('Div2.Left','2px',Div2.Left);
 end;
 
+procedure TTestCSSResolver.Test_Selector_Hover;
+var
+  Div1, Div11: TDemoDiv;
+  Button1: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+
+  Div1:=TDemoDiv.Create(Doc);
+  Div1.Parent:=Doc.Root;
+  Div1.Hover:=true;
+
+  Button1:=TDemoButton.Create(Doc);
+  Button1.Parent:=Div1;
+  Button1.Hover:=true;
+
+  Div11:=TDemoDiv.Create(Doc);
+  Div11.Parent:=Div1;
+
+  Doc.Style:=LinesToStr([
+  ':hover { left: 1px; }',
+  'button:hover { top: 2px; }',
+  '']);
+  Doc.ApplyStyle;
+  AssertEquals('Root.Left','',Doc.Root.Left);
+  AssertEquals('Root.Top','',Doc.Root.Top);
+  AssertEquals('Div1.Left','1px',Div1.Left);
+  AssertEquals('Div1.Top','',Div1.Top);
+  AssertEquals('Button1.Left','1px',Button1.Left);
+  AssertEquals('Button1.Top','2px',Button1.Top);
+  AssertEquals('Div11.Left','',Div11.Left);
+  AssertEquals('Div11.Top','',Div11.Top);
+end;
+
 procedure TTestCSSResolver.Test_InlineStyle;
 var
   Div1: TDemoDiv;
@@ -1356,14 +1408,17 @@ end;
 constructor TDemoDocument.Create(AOwner: TComponent);
 var
   Attr: TDemoNodeAttribute;
-  TypeIDs, AttributeIDs: TCSSNumericalIDs;
+  TypeIDs, AttributeIDs, PseudoClassIDs: TCSSNumericalIDs;
   NumKind: TCSSNumericalIDKind;
   AttrID: TCSSNumericalID;
+  PseudoClass: TDemoPseudoClass;
 begin
   inherited Create(AOwner);
 
   for NumKind in TCSSNumericalIDKind do
     FNumericalIDs[NumKind]:=TCSSNumericalIDs.Create(NumKind);
+
+  // register all css types
   TypeIDs:=FNumericalIDs[nikType];
   TypeIDs['*']:=CSSTypeID_Universal;
   if TypeIDs['*']<>CSSTypeID_Universal then
@@ -1373,22 +1428,38 @@ begin
   TypeIDs[TDemoDiv.CSSTypeName]:=TDemoDiv.CSSTypeID;
   TypeIDs[TDemoButton.CSSTypeName]:=TDemoButton.CSSTypeID;
 
+  // register all css attribute
   AttributeIDs:=FNumericalIDs[nikAttribute];
   AttributeIDs['all']:=CSSAttributeID_All;
+  // add basic element attributes
   AttrID:=DemoAttrIDBase;
   for Attr in TDemoNodeAttribute do
   begin
     AttributeIDs[DemoAttributeNames[Attr]]:=AttrID;
     inc(AttrID);
   end;
+  // add button caption attribute
   TDemoButton.CSSCaptionID:=AttrID;
   AttributeIDs['caption']:=AttrID;
   inc(AttrID);
 
+  // register css pseudo attributes
+  PseudoClassIDs:=FNumericalIDs[nikPseudoClass];
+  AttrID:=DemoPseudoClassIDBase;
+  for PseudoClass in TDemoPseudoClass do
+  begin
+    PseudoClassIDs[DemoPseudoClassNames[PseudoClass]]:=AttrID;
+    inc(AttrID);
+  end;
+  if PseudoClassIDs[DemoPseudoClassNames[pcHover]]<>DemoPseudoClassIDBase+ord(pcHover) then
+    raise Exception.Create('20231008232201');
+
+  // create the css resolver
   FCSSResolver:=TCSSResolver.Create(nil);
   for NumKind in TCSSNumericalIDKind do
     CSSResolver.NumericalIDs[NumKind]:=FNumericalIDs[NumKind];
 
+  // create a demo root node
   Root:=TDemoNode.Create(Self);
   Root.Name:='Root';
 end;
@@ -1453,6 +1524,12 @@ begin
   FAttributeValues[AIndex]:=AValue;
 end;
 
+procedure TDemoNode.SetHover(const AValue: boolean);
+begin
+  if FHover=AValue then Exit;
+  FHover:=AValue;
+end;
+
 procedure TDemoNode.SetParent(const AValue: TDemoNode);
 begin
   if FParent=AValue then Exit;
@@ -1471,6 +1548,12 @@ begin
   end;
 end;
 
+procedure TDemoNode.SetActive(const AValue: boolean);
+begin
+  if FActive=AValue then Exit;
+  FActive:=AValue;
+end;
+
 procedure TDemoNode.SetStyleElements(const AValue: TCSSElement);
 begin
   if FStyleElements=AValue then Exit;
@@ -1701,16 +1784,12 @@ begin
   Result:=Attribute[Attr];
 end;
 
-function TDemoNode.HasCSSPseudo(const AttrID: TCSSNumericalID
-  ): boolean;
-begin
-  Result:=false;
-end;
-
-function TDemoNode.GetCSSPseudo(const AttrID: TCSSNumericalID
-  ): TCSSString;
+function TDemoNode.HasCSSPseudoClass(const AttrID: TCSSNumericalID): boolean;
 begin
-  Result:='';
+  if (AttrID>=DemoPseudoClassIDBase) and (AttrID<=DemoPseudoClassIDBase+ord(High(TDemoPseudoClass))) then
+    Result:=HasPseudoClass(TDemoPseudoClass(AttrID-DemoPseudoClassIDBase))
+  else
+    Result:=false;
 end;
 
 function TDemoNode.GetCSSEmpty: boolean;
@@ -1731,6 +1810,14 @@ begin
   end;
 end;
 
+function TDemoNode.HasPseudoClass(PseudoClass: TDemoPseudoClass): boolean;
+begin
+  case PseudoClass of
+    pcActive: Result:=Active;
+    pcHover: Result:=Hover;
+  end;
+end;
+
 function TDemoNode.GetCSSTypeName: TCSSString;
 begin
   Result:=CSSTypeName;

packages/fcl-css/tests/testcss.lpi

@@ -45,9 +45,6 @@
       <OtherUnitFiles Value="../src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Other>
-      <CustomOptions Value="-tunicodertl"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions>

packages/fcl-db/src/base/bufdataset.pas

@@ -1407,6 +1407,7 @@ var
   i : integer;
   aPacketReader : TDataPacketReader;
   aStream : TFileStream;
+  doBind : boolean;
 
 begin
   aPacketReader:=Nil;
@@ -1421,8 +1422,23 @@ begin
         aPacketReader := GetPacketReader(dfDefault, aStream);
         end;
       IntLoadFieldDefsFromPacket(aPacketReader);
+      end
+    else
+      begin
+      // Issue 40450: At design time, create a dataset, set to active.
+      // At runtime, open is called, but fields are not bound (this happens in createdataset)
+      // So we check for unbound fields and bind them if needed.
+      // Do not call bindfields unconditonally, because descendants may have called it.
+      I:=0;
+      DoBind:=False;
+      While (Not DoBind) and (I<Fields.Count) do
+        begin
+        DoBind:=Fields[i].FieldNo=0;
+        Inc(I);
+        end;
+      if DoBind then
+        BindFields(True);
       end;
-
     // This checks if the dataset is actually created (by calling CreateDataset,
     // or reading from a stream in some other way implemented by a descendent)
     // If there are less fields than FieldDefs we know for sure that the dataset
@@ -1436,7 +1452,6 @@ begin
     //  if Fields.Count<FieldDefs.Count then
     if (Fields.Count = 0) or (FieldDefs.Count=0) then
       DatabaseError(SErrNoDataset);
-
     // search for autoinc field
     FAutoIncField:=nil;
     if FAutoIncValue>-1 then
@@ -3676,17 +3691,15 @@ var
 
 begin
   CheckInactive;
+  if ((Fields.Count=0) and (FieldDefs.Count=0)) then
+    raise Exception.Create(SErrNoFieldsDefined);
   if ((Fields.Count=0) or (FieldDefs.Count=0)) then
     begin
     if (FieldDefs.Count>0) then
       CreateFields
     else if (Fields.Count>0) then
-      begin
       InitFieldDefsFromFields;
-      BindFields(True);
-      end
-    else
-      raise Exception.Create(SErrNoFieldsDefined);
+    BindFields(True);
     end;
   if FAutoIncValue<0 then  
     FAutoIncValue:=1;

packages/fcl-db/src/base/database.inc

@@ -66,7 +66,7 @@ end;
 destructor TDatabase.Destroy;
 
 begin
-  Connected:=False;
+  CloseForDestroy;
   RemoveDatasets;
   RemoveTransactions;
   FDatasets.Free;
@@ -485,7 +485,12 @@ begin
   Result:=Assigned(DS);
 end;
 
-procedure TDBTransaction.CloseDataSets;
+procedure TDBTransaction.CloseDataset(DS: TDBDataset; InCommit : Boolean);
+begin
+  DS.Close;
+end;
+
+procedure TDBTransaction.CloseDataSets(InCommit: Boolean);
 
 Var
   I : longint;
@@ -501,7 +506,7 @@ begin
         begin
         DS:=TDBDataset(L[i]);
         If AllowClose(DS) then
-          DS.Close;
+          CloseDataset(DS,InCommit);
         end;
     finally
       FDatasets.UnlockList;
@@ -509,6 +514,12 @@ begin
     end;
 end;
 
+procedure TDBTransaction.CloseDataSets;
+
+begin
+  CloseDatasets(Active);
+end;
+
 destructor TDBTransaction.Destroy;
 
 begin
@@ -650,6 +661,18 @@ begin
   FBeforeDisconnect:=AValue;
 end;
 
+procedure TCustomConnection.SetForcedClose(AValue: Boolean);
+begin
+  if FForcedClose=AValue then Exit;
+  FForcedClose:=AValue;
+end;
+
+procedure TCustomConnection.DoCloseError(aError: Exception);
+begin
+  if Assigned(FOnCloseError) then
+    FOnCloseError(Self,aError);
+end;
+
 procedure TCustomConnection.DoLoginPrompt;
 
 var
@@ -764,9 +787,34 @@ begin
   end;
 end;
 
+procedure TCustomConnection.CloseForDestroy;
+
+Const
+  MaxCount = 2;
+
+var
+  Force : Boolean;
+  aCount : Integer;
+begin
+  Force:=False;
+  aCount:=0;
+  While Connected and (aCount<MaxCount) do
+    try
+      Inc(aCount);
+      // Will set connected to false
+      Close(Force);
+    except
+      On E : Exception do
+        begin
+        Force:=True;
+        DoCloseError(E);
+        end;
+    end;
+end;
+
 destructor TCustomConnection.Destroy;
 begin
-  Connected:=False;
+  CloseForDestroy;
   Inherited Destroy;
 end;
 

packages/fcl-db/src/base/db.pas

@@ -2178,21 +2178,23 @@ type
 
   { TDBTransaction }
 
-  TDBTransactionClass = Class of TDBTransaction;
+
   TDBTransaction = Class(TComponent)
   Private
     FActive        : boolean;
     FDatabase      : TDatabase;
     FDataSets      : TThreadList;
+    FClients      : TThreadList;
     FOpenAfterRead : boolean;
-    Function GetDataSetCount : Longint;
-    Function GetDataset(Index : longint) : TDBDataset;
-    procedure RegisterDataset (DS : TDBDataset);
-    procedure UnRegisterDataset (DS : TDBDataset);
+    function GetDataSet(Index: Longint): TDBDataset;
+    function GetDatasetCount: Integer;
     procedure RemoveDataSets;
     procedure SetActive(Value : boolean);
   Protected
+    procedure RegisterDataset (DS : TDBDataset); virtual;
+    procedure UnRegisterDataset (DS : TDBDataset); virtual;
     Function AllowClose(DS: TDBDataset): Boolean; virtual;
+    procedure CloseDataset(DS: TDBDataset; InCommit : Boolean); virtual;
     Procedure SetDatabase (Value : TDatabase); virtual;
     procedure CloseTrans;
     procedure OpenTrans;
@@ -2207,10 +2209,13 @@ type
     procedure StartTransaction; virtual; abstract;
     procedure InternalHandleException; virtual;
     procedure Loaded; override;
+    Property DatasetCount : Integer Read GetDatasetCount;
+    property Datasets[Index: Longint]: TDBDataset read GetDataSet;
   Public
     constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
     procedure CloseDataSets;
+    procedure CloseDataSets(InCommit : Boolean);
     Property DataBase : TDatabase Read FDatabase Write SetDatabase;
   published
     property Active : boolean read FActive write setactive;
@@ -2219,6 +2224,7 @@ type
   { TCustomConnection }
 
   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
+  TCloseErrorEvent = procedure(Sender : TObject; aError : Exception) of object;
 
   TCustomConnection = class(TComponent)
   private
@@ -2228,6 +2234,7 @@ type
     FBeforeDisconnect: TNotifyEvent;
     FForcedClose: Boolean;
     FLoginPrompt: Boolean;
+    FOnCloseError: TCloseErrorEvent;
     FOnLogin: TLoginEvent;
     FStreamedConnected: Boolean;
     procedure SetAfterConnect(const AValue: TNotifyEvent);
@@ -2235,6 +2242,9 @@ type
     procedure SetBeforeConnect(const AValue: TNotifyEvent);
     procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
   protected
+    Procedure DoCloseError(aError : Exception); virtual;
+    procedure SetForcedClose(AValue: Boolean); virtual;
+    procedure CloseForDestroy;
     procedure DoLoginPrompt; virtual;
     procedure DoConnect; virtual;
     procedure DoDisconnect; virtual;
@@ -2246,7 +2256,7 @@ type
     procedure Loaded; override;
     procedure SetConnected (Value : boolean); virtual;
     procedure SetLoginParams(const ADatabaseName, AUserName, APassword: string); virtual;
-    property ForcedClose : Boolean read FForcedClose write FForcedClose;
+    property ForcedClose : Boolean read FForcedClose write SetForcedClose;
     property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
   public
     procedure Close(ForceClose: Boolean=False);
@@ -2263,6 +2273,7 @@ type
     property BeforeConnect : TNotifyEvent read FBeforeConnect write SetBeforeConnect;
     property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
     property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
+    Property OnCloseError : TCloseErrorEvent Read FOnCloseError Write FOnCloseError;
   end;
 
 

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

@@ -67,7 +67,6 @@ type
     FSeps : Array of string;
     procedure SetDefines(const Value: TStrings);
     function  FindNextSeparator(ASeps: Array of string; Out IsExtended : Boolean): AnsiString;
-    procedure AddToStatement(value: AnsiString; ForceNewLine : boolean);
     procedure SetDirectives(value: TStrings);
     procedure SetDollarStrings(AValue: TStrings);
     procedure SetSQL(value: TStrings);
@@ -78,20 +77,31 @@ type
     Procedure RecalcSeps;
     function GetLine: Integer;
   protected
-    procedure ClearStatement; virtual;
     procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean); virtual;
     procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean); virtual;
     // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
     procedure InternalCommit(CommitRetaining: boolean=true); virtual;
     Function ProcessConditional(const Directive : String; const Param : String) : Boolean; virtual;
-    function NextStatement: AnsiString; virtual;
     procedure ProcessStatement; virtual;
-    function Available: Boolean; virtual;
     procedure DefaultDirectives; virtual;
     procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract;
     procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract;
     // Executes commit. If possible and CommitRetaining, use CommitRetaining, else
     procedure ExecuteCommit(CommitRetaining: boolean=true); virtual; abstract;
+    // Useful when you want to add your own parsing routines.
+    // Get next statement. This must also use AddToCurrentStatement  to add the statement.
+    function NextStatement: AnsiString; virtual;
+    // Add text to current statement. If InComment is false, strippedstatement will also be updated.
+    procedure AddToCurrentStatement(value: AnsiString; ForceNewLine : boolean); virtual;
+    // Clear current statement
+    procedure ClearStatement; virtual;
+    // Is a next statement available ?
+    function Available: Boolean; virtual;
+    // Current state
+    Property CurrentStatement : TStrings Read FCurrentStatement;
+    Property CurrentStrippedStatement : TStrings Read FCurrentStripped;
+    Property InComment : Boolean Read FComment Write FComment;
+    Property EmitLine : Boolean Read FEmitline Write FEmitline;
   public
     constructor Create (AnOwner: TComponent); override;
     destructor Destroy; override;
@@ -297,8 +307,7 @@ begin
   Result:=FLine - 1;
 end;
 
-procedure TCustomSQLScript.AddToStatement(value: AnsiString;
-  ForceNewLine: boolean);
+procedure TCustomSQLScript.AddToCurrentStatement(value: AnsiString;  ForceNewLine: boolean);
 
   Procedure DA(L : TStrings);
 
@@ -336,7 +345,7 @@ begin
     if (I=-1) then
       begin
       if FEmitLine then
-        AddToStatement(S,(FCol<=1));
+        AddToCurrentStatement(S,(FCol<=1));
       FCol:=1;
       FLine:=FLine+1;
       end
@@ -345,7 +354,7 @@ begin
       Result:=ASeps[i];
       IsExtended:=I>=MinSQLSeps;
       if FEmitLine then
-        AddToStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
+        AddToCurrentStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
       FCol:=(FCol-1)+Pos(Result,S);
       break;
       end;
@@ -545,13 +554,13 @@ begin
       begin
       FComment:=True;
       if FCommentsInSQL then
-        AddToStatement(pnt,false)
+        AddToCurrentStatement(pnt,false)
       else
         FEmitLine:=False;
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator(['*/'],b);
       if FCommentsInSQL then
-        AddToStatement(pnt,false)
+        AddToCurrentStatement(pnt,false)
       else
         FEmitLine:=True;
       FCol:=FCol + length(pnt);
@@ -561,33 +570,33 @@ begin
       begin
       FComment:=True;
       if FCommentsInSQL then
-        AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
+        AddToCurrentStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
       Inc(Fline);
       FCol:=1;
       FComment:=False;
       end
     else if pnt = '"' then
       begin
-      AddToStatement(pnt,false);
+      AddToCurrentStatement(pnt,false);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator(['"'],b);
-      AddToStatement(pnt,false);
+      AddToCurrentStatement(pnt,false);
       FCol:=FCol + length(pnt);
       end
     else if pnt = '''' then
       begin
-      AddToStatement(pnt,False);
+      AddToCurrentStatement(pnt,False);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator([''''],b);
-      AddToStatement(pnt,false);
+      AddToCurrentStatement(pnt,false);
       FCol:=FCol + length(pnt);
       end
     else if IsExtra then
       begin
-        AddToStatement(pnt,false);
+        AddToCurrentStatement(pnt,false);
         FCol:=FCol + length(pnt);
         pnt:=FindNextSeparator([pnt],b);
-        AddToStatement(pnt,false);
+        AddToCurrentStatement(pnt,false);
         FCol:=FCol + length(pnt);
       end;
     end;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -450,7 +450,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning,sqSequences];
+  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning,sqSequences] - [sqCommitEndsPrepared];
   FieldNameQuoteChars:=DoubleQuotes;
   VerboseErrors:=True;
   FHandlePool:=TThreadlist.Create;
@@ -798,7 +798,7 @@ begin
   // unprepare statements associated with given transaction
   L:=FCursorList.LockList;
   try
-    For I:=0 to L.Count-1 do
+    For I:=L.Count-1 downto 0 do
       begin
       C:=TPQCursor(L[i]);
       UnprepareStatement(C,False);

packages/fcl-db/src/sqldb/sqldb.pp

@@ -180,7 +180,7 @@ type
   
   TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
 
-  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences);
+  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences, sqCommitEndsPrepared, sqRollbackEndsPrepared);
   TConnOptions= set of TConnOption;
 
   TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);
@@ -243,7 +243,7 @@ type
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
     Procedure RegisterStatement(S : TCustomSQLStatement);
     Procedure UnRegisterStatement(S : TCustomSQLStatement);
-
+    Procedure UnPrepareStatements(aTransaction : TSQLTransaction);
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
     Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
     function StrToStatementType(s : string) : TStatementType; virtual;
@@ -286,6 +286,7 @@ type
     // Unified version
     function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
     // Older versions.
+    Function HasTable(const aTable : String; SearchSystemTables : Boolean = false) : Boolean;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
     procedure GetProcedureNames(List : TStrings); virtual;
     procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
@@ -336,8 +337,10 @@ type
     procedure SetParams(const AValue: TStringList);
     procedure SetSQLConnection(AValue: TSQLConnection);
   protected
+    Procedure UnPrepareStatements; virtual;
     Procedure MaybeStartTransaction;
     Function AllowClose(DS: TDBDataset): Boolean; override;
+    procedure CloseDataset(DS: TDBDataset; InCommit : Boolean); override;
     function GetHandle : Pointer; virtual;
     Procedure SetDatabase (Value : TDatabase); override;
     Function LogEvent(EventType : TDBEventType) : Boolean;
@@ -368,6 +371,7 @@ type
   Private
     FCursor : TSQLCursor;
     FDatabase: TSQLConnection;
+    FOnSQLChanged: TNotifyEvent;
     FParamCheck: Boolean;
     FParams: TParams;
     FMacroCheck: Boolean;
@@ -428,6 +432,7 @@ type
     Property ParamCheck : Boolean Read FParamCheck Write FParamCheck default true;
     Property MacroCheck : Boolean Read FMacroCheck Write SetMacroCheck default false;
     Property InfoQuery : Boolean Read FInfoQuery Write FInfoQuery;
+    Property OnSQLChanged : TNotifyEvent Read FOnSQLChanged Write FOnSQLChanged;
   Public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
@@ -479,7 +484,7 @@ type
 
   { TCustomSQLQuery }
 
-  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoRefreshUsingSelect);
+  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoRefreshUsingSelect, sqoNoCloseOnSQLChange);
   TSQLQueryOptions = Set of TSQLQueryOption;
 
   TCustomSQLQuery = class (TCustomBufDataset)
@@ -529,6 +534,7 @@ type
     function HasMacros: Boolean;
     Function HasParams : Boolean;
     Function NeedLastInsertID: TField;
+    procedure OnChangeSelectSQL(Sender: TObject);
     procedure SetMacroChar(AValue: AnsiChar);
     procedure SetOptions(AValue: TSQLQueryOptions);
     procedure SetParamCheck(AValue: Boolean);
@@ -778,6 +784,7 @@ type
     FConnectorType: String;
     procedure SetConnectorType(const AValue: String);
   protected
+    procedure SetForcedClose(AValue: Boolean); override;
     procedure SetTransaction(Value : TSQLTransaction);override;
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -941,6 +948,8 @@ var
   NewParams: TSQLDBParams;
 
 begin
+  if Assigned(FOnSQLChanged) then
+    FOnSQLChanged(Self);
   UnPrepare;
   RecreateMacros;
   if not ParamCheck then
@@ -1405,12 +1414,13 @@ begin
   FLogEvents:=LogAllEvents; //match Property LogEvents...Default LogAllEvents
   FStatements:=TThreadList.Create;
   FStatements.Duplicates:=dupIgnore;
+  FConnOptions:=[sqCommitEndsPrepared, sqRollbackEndsPrepared];
 end;
 
 destructor TSQLConnection.Destroy;
 begin
   try
-    Connected:=False; // needed because we want to de-allocate statements
+    CloseForDestroy; // needed because we want to de-allocate statements
   Finally  
     FreeAndNil(FStatements);
     inherited Destroy;
@@ -1488,14 +1498,17 @@ Var
   L : TList;
 
 begin
-  L:=FStatements.LockList;
-  try
-    For I:=0 to L.Count-1 do
-      TCustomSQLStatement(L[i]).Unprepare;
-    L.Clear;
-  finally
-    FStatements.UnlockList;
-  end;
+  If Assigned(FStatements) then
+    begin
+    L:=FStatements.LockList;
+    try
+      For I:=0 to L.Count-1 do
+        TCustomSQLStatement(L[i]).Unprepare;
+      L.Clear;
+    finally
+      FStatements.UnlockList;
+    end;
+    end;
 end;
 
 procedure TSQLConnection.StartTransaction;
@@ -1729,6 +1742,22 @@ begin
   end;
 end;
 
+function TSQLConnection.HasTable(const aTable: String; SearchSystemTables: Boolean) : Boolean;
+
+var
+  L : TStrings;
+
+begin
+  L:=TStringList.Create;
+  try
+    TStringList(L).Sorted:=True;
+    GetTableNames(L,SearchSystemTables);
+    Result:=L.IndexOf(aTable)<>-1;
+  Finally
+    L.Free;
+  end;
+end;
+
 function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
 var i: TConnInfoType;
 begin
@@ -2027,6 +2056,29 @@ begin
     FStatements.Remove(S);
 end;
 
+procedure TSQLConnection.UnPrepareStatements(aTransaction: TSQLTransaction);
+Var
+  I : integer;
+  L : TList;
+  S : TCustomSQLStatement;
+
+begin
+  if not Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
+    exit;
+  L:=FStatements.LockList;
+  try
+    For I:=0 to L.Count-1 do
+      begin
+      S:=TCustomSQLStatement(L[i]);
+      if (S.Transaction=aTransaction) then
+        S.Unprepare;
+      end;
+    L.Clear;
+  finally
+    FStatements.UnlockList;
+  end;
+end;
+
 function TSQLConnection.CreateCustomQuery(aOwner : TComponent) : TCustomSQLQuery;
 
 begin
@@ -2430,6 +2482,14 @@ begin
   Database:=AValue;
 end;
 
+
+procedure TSQLTransaction.UnPrepareStatements;
+
+begin
+  if Assigned(SQLConnection) then
+    SQLConnection.UnPrepareStatements(Self);
+end;
+
 Procedure TSQLTransaction.MaybeStartTransaction;
 begin
   if not Active then
@@ -2447,10 +2507,24 @@ end;
 
 Function TSQLTransaction.AllowClose(DS: TDBDataset): Boolean;
 begin
-  if (DS is TSQLQuery) then
-    Result:=not (sqoKeepOpenOnCommit in TSQLQuery(DS).Options)
-  else
-    Result:=Inherited AllowClose(DS);
+  Result:=(DS is TSQLQuery);
+end;
+
+procedure TSQLTransaction.CloseDataset(DS: TDBDataset; InCommit : Boolean);
+
+Const
+  UnPrepOptions : Array[Boolean] of TConnOption
+                = (sqRollBackEndsPrepared, sqCommitEndsPrepared);
+
+var
+  Q : TSQLQuery;
+
+begin
+  Q:=DS as TSQLQuery;
+  if not (sqoKeepOpenOnCommit in Q.Options) then
+    inherited CloseDataset(Q,InCommit);
+  if UnPrepOptions[InCommit] in SQLConnection.ConnOptions then
+   Q.UnPrepare;
 end;
 
 procedure TSQLTransaction.Commit;
@@ -2458,6 +2532,8 @@ begin
   if Active  then
     begin
     CloseDataSets;
+    if sqCommitEndsPrepared in SQLConnection.ConnOptions then
+      UnPrepareStatements;
     If LogEvent(detCommit) then
       Log(detCommit,SCommitting);
     // The inherited closetrans must always be called.
@@ -2489,6 +2565,8 @@ begin
     if (stoUseImplicit in Options) then
       DatabaseError(SErrImplicitNoRollBack);
     CloseDataSets;
+    if sqRollbackEndsPrepared in SQLConnection.ConnOptions then
+      UnPrepareStatements;
     If LogEvent(detRollback) then
       Log(detRollback,SRollingBack);
     // The inherited closetrans must always be called.
@@ -2720,6 +2798,7 @@ begin
   If ParamCheck and Assigned(FDataLink) then
     (FDataLink as TMasterParamsDataLink).RefreshParamNames;
   FQuery.ServerIndexDefs.Updated:=false;
+
 end;
 
 { TCustomSQLQuery }
@@ -2736,6 +2815,7 @@ constructor TCustomSQLQuery.Create(AOwner : TComponent);
 begin
   inherited Create(AOwner);
   FStatement:=CreateSQLStatement(Self);
+  FStatement.OnSQLChanged:=@OnChangeSelectSQL;
 
   FInsertSQL := TStringList.Create;
   FInsertSQL.OnChange := @OnChangeModifySQL;
@@ -3348,6 +3428,13 @@ begin
     end
 end;
 
+procedure TCustomSQLQuery.OnChangeSelectSQL(Sender: TObject);
+begin
+  if (sqoNoCloseOnSQLChange in Options) then
+    exit;
+  Close;
+end;
+
 procedure TCustomSQLQuery.SetMacroChar(AValue: AnsiChar);
 begin
   FStatement.MacroChar:=AValue;
@@ -3803,6 +3890,12 @@ begin
     end;
 end;
 
+procedure TSQLConnector.SetForcedClose(AValue: Boolean);
+begin
+  inherited SetForcedClose(AValue);
+  FProxy.ForcedClose:=aValue;
+end;
+
 procedure TSQLConnector.SetTransaction(Value: TSQLTransaction);
 begin
   inherited SetTransaction(Value);

packages/fcl-db/tests/dbtestframework.lpi

@@ -26,13 +26,13 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="--suite=TTestFieldTypes.TestBlobParamQuery"/>
+        <CommandLineParams Value="--suite=TTestTSQLConnection.TestRollBackUnprepares"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="--suite=TTestFieldTypes.TestBlobParamQuery"/>
+            <CommandLineParams Value="--suite=TTestTSQLConnection.TestRollBackUnprepares"/>
           </local>
         </Mode0>
       </Modes>
@@ -129,9 +129,11 @@
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
-    <Other>
-      <CustomOptions Value="-tunicodertl"/>
-    </Other>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -580,15 +580,23 @@ begin
   if assigned(FTransaction) then
     begin
     try
-      if Ftransaction.Active then Ftransaction.Rollback;
-      Ftransaction.StartTransaction;
+      if Ftransaction.Active and not (stoUseImplicit in FTransaction.Options) then
+        begin
+        Ftransaction.Rollback;
+        Ftransaction.StartTransaction;
+        end;
       Fconnection.ExecuteDirect('DROP TABLE FPDEV');
-      Ftransaction.Commit;
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.Commit;
+      Fconnection.ExecuteDirect('DROP TABLE  FPDEV2');
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.Commit;
     Except
       on E: Exception do begin
         if dblogfilename<>'' then
           DoLogEvent(nil,detCustom,'Exception running DropNDatasets: '+E.Message);
-        if Ftransaction.Active then Ftransaction.Rollback
+        if Ftransaction.Active and not (stoUseImplicit in FTransaction.Options) then
+           Ftransaction.Rollback
       end;
     end;
     end;
@@ -599,10 +607,16 @@ begin
   if assigned(FTransaction) then
     begin
     try
-      if Ftransaction.Active then Ftransaction.Rollback;
-      Ftransaction.StartTransaction;
+      if Ftransaction.Active and not (stoUseImplicit in FTransaction.Options) then
+        begin
+        Ftransaction.Rollback;
+        Ftransaction.StartTransaction;
+        end;
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.StartTransaction;
       Fconnection.ExecuteDirect('DROP TABLE FPDEV_FIELD');
-      Ftransaction.Commit;
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.Commit;
     Except
       on E: Exception do begin
         if dblogfilename<>'' then

packages/fcl-db/tests/tcparser.pas

@@ -1293,7 +1293,7 @@ begin
   CreateParser(ASOURCE);
   Parser.GetNextToken;
   Parser.ParseStringDef(dt,l,cs);
-  AssertEquals('Datatype is AnsiChar',ExpectDT,Dt);
+  AssertEquals('Datatype is Char',ExpectDT,Dt);
   AssertEquals('Length is 1',ExpectLen,l);
   AssertEquals('End of Stream reached',tsqlEOF,Parser.CurrentToken);
   AssertEquals('Correct character set',ExpectCharset,CS);

packages/fcl-db/tests/testfieldtypes.pas

@@ -1671,7 +1671,7 @@ end;
 
 procedure TTestFieldTypes.TestFixedStringParamQuery;
 begin
-  TestXXParamQuery(ftFixedChar,'AnsiChar(10)',testValuesCount);
+  TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
 end;
 
 procedure TTestFieldTypes.TestXXParamQuery(ADataType : TFieldType; ASQLTypeDecl : string;

packages/fcl-db/tests/testsqldb.pas

@@ -63,6 +63,8 @@ type
     Procedure TestPrepareCount;
     Procedure TestPrepareCount2;
     Procedure TestNullTypeParam;
+    procedure TestChangeSQLCloseUnprepare;
+    procedure TestChangeSQLCloseUnprepareDisabled;
   end;
 
   { TTestTSQLConnection }
@@ -75,12 +77,15 @@ type
     procedure TestImplicitTransactionNotAssignable;
     procedure TestImplicitTransactionOK;
     procedure TryOpen;
+    procedure TestUnprepare(DoCommit : Boolean);
   published
     procedure TestUseImplicitTransaction;
     procedure TestUseExplicitTransaction;
     procedure TestExplicitConnect;
     procedure TestGetStatementInfo;
     procedure TestGetNextValue;
+    Procedure TestCommitUnprepares;
+    Procedure TestRollBackUnprepares;
   end;
 
   { TTestTSQLScript }
@@ -863,6 +868,38 @@ begin
     SQLDBConnector.Connection.OnLog:=Nil;
   end;
 end;
+procedure TTestTSQLQuery.TestChangeSQLCloseUnprepare;
+begin
+  with SQLDBConnector.GetNDataset(10) as TSQLQuery do
+    begin
+    Open;
+    AssertTrue('Prepared after open', Prepared);
+    SQL.Text := 'SELECT * FROM FPDEV WHERE ID<0';
+    // statement must be unprepared when SQL is changed
+    AssertFalse('Prepared after SQL changed', Prepared);
+    // dataset remained active in FPC <= 3.2.2
+    AssertFalse('Active after SQL changed', Active);
+    SQL.Text := 'UPDATE FPDEV SET NAME=''Test'' WHERE ID>100';
+    ExecSQL;
+    end;
+end;
+procedure TTestTSQLQuery.TestChangeSQLCloseUnprepareDisabled;
+begin
+  with SQLDBConnector.GetNDataset(10) as TSQLQuery do
+    begin
+    OPtions:=OPtions+[sqoNoCloseOnSQLChange];
+    Open;
+    AssertTrue('Prepared after open', Prepared);
+    SQL.Text := 'SELECT * FROM FPDEV WHERE ID<0';
+    // statement must be unprepared when SQL is changed
+    AssertFalse('Prepared after SQL changed', Prepared);
+    // dataset remained active in FPC <= 3.2.2
+    AssertTrue('Active after SQL changed', Active);
+    Close;
+    SQL.Text := 'UPDATE FPDEV SET NAME=''Test'' WHERE ID>100';
+    ExecSQL;
+    end;
+end;
 
 
 { TTestTSQLConnection }
@@ -964,6 +1001,63 @@ begin
   SQLDBConnector.Query.Open;
 end;
 
+procedure TTestTSQLConnection.TestUnprepare(DoCommit: Boolean);
+
+Var
+  Q1,Q2 : TSQLQuery;
+  S1,S2 : TSQLStatement;
+  PrepState : Boolean;
+begin
+  S1:=Nil;
+  S2:=Nil;
+  Q2:=Nil;
+  try
+    // Only prepared, not open
+    Q1:=TSQLQuery.Create(Nil);
+    Q1.DataBase:=SQLDBConnector.Connection;
+    Q1.Transaction:=SQLDBConnector.Transaction;
+    Q1.SQL.text:='SELECT COUNT(*) from FPDEV where (ID<:MaxID)';
+    Q1.Prepare;
+    // Explicitly prepared and opened
+    Q2:=TSQLQuery.Create(Nil);
+    Q2.DataBase:=SQLDBConnector.Connection;
+    Q2.Transaction:=SQLDBConnector.Transaction;
+    Q2.SQL.text:='SELECT COUNT(*) from FPDEV where (ID>:MinID)';
+    Q2.Prepare;
+    Q2.Open;
+    // A prepared statement;
+    S1:=TSQLStatement.Create(Nil);
+    S1.DataBase:=SQLDBConnector.Connection;
+    S1.Transaction:=SQLDBConnector.Transaction;
+    S1.SQL.Text:='update fpdev set id=id+1 where (id<:MaxID);';
+    S1.Prepare;
+    // A prepared and exected statement;
+    S2:=TSQLStatement.Create(Nil);
+    S2.DataBase:=SQLDBConnector.Connection;
+    S2.Transaction:=SQLDBConnector.Transaction;
+    S2.SQL.Text:='update fpdev set id=id+1 where (id<:MaxID);';
+    S2.Prepare;
+    S2.Execute;
+    if DoCommit then
+      begin
+      SQLDBConnector.Transaction.Commit;
+      PrepState:=Not (sqCommitEndsPrepared in SQLDBConnector.Connection.ConnOptions);
+      end
+    else
+      begin
+      SQLDBConnector.Transaction.RollBack;
+      PrepState:=Not (sqRollbackEndsPrepared in SQLDBConnector.Connection.ConnOptions);
+      end;
+    AssertEquals('Q1 prepared state',PrepState,Q1.Prepared);
+    AssertEquals('Q2 prepared state',PrepState,Q2.Prepared);
+    AssertEquals('S prepared state',PrepState,S1.Prepared);
+    AssertEquals('S prepared state',PrepState,S2.Prepared);
+  finally
+    Q1.Free;
+    Q2.Free;
+  end;
+end;
+
 procedure TTestTSQLConnection.TestUseExplicitTransaction;
 begin
   SQLDBConnector.Transaction.Active:=False;
@@ -1029,6 +1123,16 @@ begin
   AssertTrue('Get value',SQLDBConnector.Connection.GetNextValue('me',1)>0);
 end;
 
+procedure TTestTSQLConnection.TestCommitUnprepares;
+begin
+  TestUnprepare(True);
+end;
+
+procedure TTestTSQLConnection.TestRollBackUnprepares;
+begin
+  TestUnprepare(False);
+end;
+
 
 { TTestTSQLScript }
 

packages/fcl-hash/src/fpasn.pp

@@ -974,8 +974,10 @@ var
   P, EndP: PByte;
   O : Tbytes;
 begin
+  {$IFDEF ASN1_DEBUG}
   ASNDebug(Buffer,O);
   Writeln(TEncoding.UTF8.GetAnsiString(O));
+  {$ENDIF}
   if length(Buffer)=0 then exit;
   P:=@Buffer[0];
   EndP:=P+length(Buffer);

packages/fcl-hash/src/fppem.pp

@@ -169,7 +169,7 @@ begin
   ASNParsePemSection(Buffer, List, _BEGIN_EC_PRIVATE_KEY, _END_EC_PRIVATE_KEY);
   if List.Count < 7 then
     Exit;
-  Writeln(List.Text);
+//  Writeln(List.Text);
   CurveOID := List.Strings[4];
   Result := (CurveOID=ASN_secp256r1);
 end;

packages/fcl-image/namespaced/FpImage.ColorSpace.pp

@@ -1,3 +1,3 @@
-{$DEFINE FPC_DOTTEDUNITS}
 unit FpImage.ColorSpace;
-{$i fpcolorspace.pas}
+{$DEFINE FPC_DOTTEDUNITS}
+{$i fpcolorspace.pas}

packages/fcl-image/src/ellipses.pp

@@ -20,9 +20,9 @@ unit Ellipses;
 interface
 
 {$IFDEF FPC_DOTTEDUNITS}
-uses System.Classes, FpImage, FpImage.Canvas;
+uses System.Classes, FpImage, FpImage.Canvas, System.Math;
 {$ELSE FPC_DOTTEDUNITS}
-uses classes, FpImage, FPCanvas;
+uses classes, FpImage, FPCanvas, Math;
 {$ENDIF FPC_DOTTEDUNITS}
 
 procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
@@ -177,6 +177,8 @@ var infoP, infoM : PEllipseInfoData;
     halfnumber,
     r, NumberPixels, xtemp,yt,yb : integer;
     pPy, pMy, x,y, rx,ry, xd,yd,ra, rdelta : real;
+    ras,rac : single;
+    
 begin
   ClearList;
   CalculateCircular (bounds, x,y,rx,ry);
@@ -204,8 +206,9 @@ begin
     infoM := NewInfoRec (round(x - rx));
     for r := 0 to NumberPixels do
       begin
-      xd := rx * cos(ra);
-      yd := ry * sin(ra);
+      sincos(ra,ras,rac);
+      xd := rx * rac;
+      yd := ry * ras;
       // take all 4 quarters
       yt := round(y - yd);
       yb := round(y + yd);

packages/fcl-image/src/fpbrush.inc

@@ -30,6 +30,7 @@ begin
     begin
     self.Style := Style;
     self.Image := Image;
+    self.Pattern := Pattern;
     end;
   inherited DoCopyProps(From);
 end;

packages/fcl-image/src/fpcolorspace.pas

@@ -1921,10 +1921,16 @@ end;
 { TLChAHelper }
 
 function TLChAHelper.ToLabA: TLabA;
+
+Var
+  rh,rhs,rhc : single;
+
 begin
   result.L := self.L;
-  result.a := cos(DegToRad(self.h)) * self.C;
-  result.b := sin(DegToRad(self.h)) * self.C;
+  rh:=DegToRad(self.h);
+  sincos(rh,rhs,rhc);
+  result.a := rhc * self.C;
+  result.b := rhs * self.C;
   result.Alpha:= self.alpha;
 end;
 

packages/fcl-image/src/fpfont.inc

@@ -37,13 +37,14 @@ end;
 
 procedure TFPCustomFont.DoCopyProps (From:TFPCanvasHelper);
 begin
-  with from as TFPCustomFont do
-    begin
-    self.FName := FName;
-    self.FSize := FSize;
-    self.FFPColor := FFPColor;
-    self.FFlags := FFlags;
-    end;
+  if From is TFPCustomFont then
+   with from as TFPCustomFont do
+     begin
+     self.FName := FName;
+     self.FSize := FSize;
+     self.FOrientation := FOrientation
+     end;
+  Inherited;  
 end;
 
 function TFPCustomFont.CopyFont : TFPCustomFont;

packages/fcl-image/src/fppen.inc

@@ -57,6 +57,8 @@ begin
     self.Width := Width;
     self.Mode := Mode;
     self.pattern := pattern;
+    self.EndCap := EndCap;
+    self.JoinStyle := JoinStyle;
     end;
   inherited;
 end;

packages/fcl-image/src/fpreadjpeg.pas

@@ -109,7 +109,11 @@ type
 
 implementation
 
+{$IFDEF FPC_DOTTEDUNITS}
+uses FpImage.ColorSpace;
+{$ELSE}
 uses FPColorSpace;
+{$ENDIF}
 
 type
   int_Color_Table = array[0..MAXJSAMPLE+1-1] of int;

packages/fcl-js/src/jswriter.pp

@@ -622,21 +622,30 @@ begin
         #10 : R:=R+'\n';
         #12 : R:=R+'\f';
         #13 : R:=R+'\r';
-        #$D800..#$DFFF:
+        #$D800..#$DBFF:
           begin
           if (I<L) then
             begin
             c:=S[I+1];
-            if (c>=#$D000) and (c<=#$DFFF) then
+            if (c>=#$DC00) and (c<=#$DFFF) then
               begin
-              inc(I,2); // surrogate, two AnsiChar codepoint
-              continue;
+              // surrogate, two WideChar codepoint
+              R:=R+Copy(S,I,2);
+              inc(I);
+              end
+            else
+              begin
+              // invalid UTF-16, cannot be encoded as UTF-8 -> encode as hex
+              R:=R+'\u'+TJSString(HexStr(ord(S[i]),4));
               end;
-            // invalid UTF-16, cannot be encoded as UTF-8 -> encode as hex
-            R:=R+'\u'+TJSString(HexStr(ord(S[i]),4));
             end
           else
-            // invalid UTF-16 at end of string, cannot be encoded as UTF-8 -> encode as hex
+            // high surrogate without low surrogate at end of string, cannot be encoded as UTF-8 -> encode as hex
+            R:=R+'\u'+TJSString(HexStr(ord(c),4));
+          end;
+        #$DC00..#$DFFF:
+          begin
+            // low surrogate without high surrogate, cannot be encoded as UTF-8 -> encode as hex
             R:=R+'\u'+TJSString(HexStr(ord(c),4));
           end;
         #$FF00..#$FFFF: R:=R+'\u'+TJSString(HexStr(ord(c),4));

packages/fcl-json/src/fpjson.pp

@@ -81,7 +81,8 @@ type
                    foDoNotQuoteMembers, // Do not quote object member names.
                    foUseTabchar,        // Use tab characters instead of spaces.
                    foSkipWhiteSpace,    // Do not use whitespace at all
-                   foSkipWhiteSpaceOnlyLeading   //  When foSkipWhiteSpace is active, skip whitespace for object members only before :
+                   foSkipWhiteSpaceOnlyLeading,   //  When foSkipWhiteSpace is active, skip whitespace for object members only before :
+                   foForceLF            // On Windows, use this to force use of LF instead of CR/LF
                    );
   TFormatOptions = set of TFormatOption;
 
@@ -654,9 +655,9 @@ Type
     {$IFNDEF PAS2JS}
     function GetInt64s(const AName : String): Int64;
     function GetUnicodeStrings(const AName : String): TJSONUnicodeStringType;
-    function GetQWords(AName : String): QWord;
+    function GetQWords(const AName : String): QWord;
     procedure SetInt64s(const AName : String; const AValue: Int64);
-    procedure SetQWords(AName : String; AValue: QWord);
+    procedure SetQWords(const AName : String; AValue: QWord);
     procedure SetUnicodeStrings(const AName : String; const AValue: TJSONUnicodeStringType);
     {$ELSE}
     function GetNativeInts(const AName : String): NativeInt;
@@ -1507,7 +1508,7 @@ end;
 
 procedure TJSONData.DumpJSON(S: TFPJSStream);
 
-  Procedure W(T : String);
+  Procedure W(const T : String);
   begin
     if T='' then exit;
     {$IFDEF PAS2JS}
@@ -2742,14 +2743,19 @@ Var
   MultiLine : Boolean;
   SkipWhiteSpace : Boolean;
   Ind : String;
+  LB : String;
   
 begin
   Result:='[';
   MultiLine:=Not (foSingleLineArray in Options);
+  if foForceLF in Options then
+    LB:=#10
+  else
+    LB:=sLineBreak;
   SkipWhiteSpace:=foSkipWhiteSpace in Options;
   Ind:=IndentString(Options, CurrentIndent+Indent);
   if MultiLine then
-    Result:=Result+sLineBreak;
+    Result:=Result+LB;
   For I:=0 to Count-1 do
     begin
     if MultiLine then
@@ -2764,7 +2770,7 @@ begin
       else
         Result:=Result+ElementSeps[SkipWhiteSpace];
     if MultiLine then
-      Result:=Result+sLineBreak
+      Result:=Result+LB
     end;
   if MultiLine then
     Result:=Result+IndentString(Options, CurrentIndent);
@@ -3219,7 +3225,7 @@ begin
   Result:=GetElements(AName).AsInt64;
 end;
 
-function TJSONObject.GetQWords(AName : String): QWord;
+function TJSONObject.GetQWords(const AName : String): QWord;
 begin
   Result:=GetElements(AName).AsQWord;
 end;
@@ -3235,7 +3241,7 @@ begin
   SetElements(AName,CreateJSON(AVAlue));
 end;
 
-procedure TJSONObject.SetQWords(AName : String; AValue: QWord);
+procedure TJSONObject.SetQWords(const AName : String; AValue: QWord);
 begin
   SetElements(AName,CreateJSON(AVAlue));
 end;
@@ -3705,11 +3711,16 @@ Var
   NSep,Sep,Ind : String;
   V : TJSONStringType;
   D : TJSONData;
+  LB : String;
 
 begin
   Result:='';
   UseQuotes:=Not (foDoNotQuoteMembers in options);
   MultiLine:=Not (foSingleLineObject in Options);
+  if foForceLF in Options then
+    LB:=#10
+  else
+    LB:=sLineBreak;
   SkipWhiteSpace:=foSkipWhiteSpace in Options;
   SkipWhiteSpaceOnlyLeading:=foSkipWhiteSpaceOnlyLeading in Options;
   CurrentIndent:=CurrentIndent+Indent;
@@ -3724,7 +3735,7 @@ begin
   else
     NSep:=' : ';
   If MultiLine then
-    Sep:=','+SLineBreak+Ind
+    Sep:=','+LB+Ind
   else if SkipWhiteSpace then
     Sep:=','
   else
@@ -3748,7 +3759,7 @@ begin
   If (Result<>'') then
     begin
     if MultiLine then
-      Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
+      Result:='{'+LB+Result+LB+indentString(options,CurrentIndent-Indent)+'}'
     else
       Result:=ObjStartSeps[SkipWhiteSpace]+Result+ObjEndSeps[SkipWhiteSpace]
     end

packages/fcl-json/src/fpjsonapply.pp

@@ -56,7 +56,7 @@ Type
     procedure SetSourceJSON(AValue: TJSONObject);
   Protected
     procedure Apply(aSrc, aApply: TJSONObject); virtual;
-    procedure SaveDestJSON(aFileName : string);
+    procedure SaveDestJSON(const aFileName : string);
     procedure SaveDestJSON(aStream : TStream);
   Public
     destructor destroy; override;
@@ -201,7 +201,7 @@ begin
     end;
 end;
 
-procedure TJSONApplier.SaveDestJSON(aFileName: string);
+procedure TJSONApplier.SaveDestJSON(const aFileName: string);
 
 Var
   F : TFileStream;

packages/fcl-json/src/fpjsonrtti.pp

@@ -152,7 +152,7 @@ Type
     procedure SetCaseInsensitive(AValue: Boolean);
   protected
     // Try to parse a date.
-    Function ExtractDateTime(S : String): TDateTime;
+    Function ExtractDateTime(const S : String): TDateTime;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
     procedure DoClearProperty(AObject: TObject; PropInfo: PPropInfo); virtual;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
@@ -380,7 +380,7 @@ begin
     Exclude(Foptions,jdoCaseInsensitive);
 end;
 
-function TJSONDeStreamer.ExtractDateTime(S: String): TDateTime;
+function TJSONDeStreamer.ExtractDateTime(const S: String): TDateTime;
 
 Var
   Fmt : String;

packages/fcl-json/tests/testjsondata.pas

@@ -267,6 +267,7 @@ type
     Procedure TestNonExistingAccessError;
     Procedure TestFormat;
     Procedure TestFormatNil;
+    Procedure TestFormatForceLF;
     Procedure TestFind;
     Procedure TestIfFind;
     Procedure TestDuplicate;
@@ -3470,6 +3471,21 @@ begin
   AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineObject],1));
 end;
 
+procedure TTestObject.TestFormatForceLF;
+Var
+  O : TJSONObject;
+begin
+  if sLineBreak=#10 then
+    Ignore('Not relevant when linebreak is LF');
+  O:=TJSONObject.Create(['x',1,'y',2]);
+  try
+    TestJSON(O,'{ "x" : 1, "y" : 2 }');
+    AssertEquals('FormatJSON, forced LF','{'+#10+'  "x" : 1,'+#10+'  "y" : 2'+#10+'}',O.FormatJSON([foForceLF]));
+  finally
+    O.Free;
+  end;
+end;
+
 procedure TTestObject.TestFind;
 
 Const

packages/fcl-net/examples/testverify.pp

@@ -0,0 +1,61 @@
+{
+  Program to demonstrate verification of a certificate.
+  Created by Bernd K. for issue:
+  https://gitlab.com/freepascal.org/fpc/source/-/issues/39998
+}
+program testverify;
+
+uses
+  Sysutils, Classes, sockets, ssockets, sslsockets, openssl, opensslsockets;
+
+
+type
+
+  { TApp }
+
+  TApp = class
+    Sock: TInetSocket;
+    SSLHandler: TSSLSocketHandler;
+    constructor Create;
+    destructor Destroy; override;
+    procedure OnVerify(Sender: TObject; var Allow: Boolean);
+  end;
+
+var
+  App: TApp;
+
+{ TApp }
+
+constructor TApp.Create;
+begin
+  SSLHandler := TSSLSocketHandler.GetDefaultHandler;
+  SSLHandler.OnVerifyCertificate := @OnVerify;
+  //SSLHandler.VerifyPeerCert := True;
+  Sock := TInetSocket.Create('test.mosquitto.org', 8883, 1000, SSLHandler);
+
+  writeln('begin connect');
+  Sock.Connect;
+  writeln('end connect');
+
+end;
+
+destructor TApp.Destroy;
+begin
+  Sock.Free;
+  inherited Destroy;
+end;
+
+procedure TApp.OnVerify(Sender: TObject; var Allow: Boolean);
+var
+  S: TOpenSSLSocketHandler;
+begin
+  Writeln('OnVerify');
+  S := Sender as TOpenSSLSocketHandler;
+  writeln('cert assigned: ', Assigned(S.SSL.PeerCertificate));
+  writeln('cert info:     ', S.SSL.CertInfo);
+end;
+
+begin
+  App := TApp.Create;
+  App.Free;
+end.

packages/fcl-passrc/src/pasresolveeval.pas

@@ -217,6 +217,7 @@ const
   nAwaitWithoutPromise = 3144;
   nSymbolCannotBeExportedFromALibrary = 3145;
   nForLoopControlVarMustBeSimpleLocalVar = 3146;
+  nIllegalCharConst = 3147;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -374,6 +375,7 @@ resourcestring
   sAwaitWithoutPromise = 'Await without promise';
   sSymbolCannotBeExportedFromALibrary = 'The symbol cannot be exported from a library';
   sForLoopControlVarMustBeSimpleLocalVar = 'For loop control variable must be simple local variable';
+  sIllegalCharConst = 'Illegal char constant';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -98,6 +98,7 @@ type
     procedure TestGen_Class_List;
     procedure TestGen_Class_Typecast;
     // ToDo: different modeswitches at parse time and specialize time
+    procedure TestGen_Class_TypeAliasAssignFail; // todo
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -1683,6 +1684,28 @@ begin
   // Delphi: no warning
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_TypeAliasAssignFail;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TDate = type double;',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  end;',
+  'var',
+  '  a: specialize TBird<double>;',
+  '  b: specialize TBird<TDate>;',
+  'begin',
+  '  a:=b;',
+  '']);
+  CheckResolverException('Incompatible types: got  expected',
+    nGenericsWithoutSpecializationAsType);
+end;
+
 procedure TTestResolveGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -99,6 +99,7 @@ type
     procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
     procedure TestM_Hint_UnitUsed;
     procedure TestM_Hint_UnitUsedVarArgs;
+    procedure TestM_Hint_UnitNotUsed_ClassInterfacesList;
     procedure TestM_Hint_ParameterNotUsed;
     procedure TestM_Hint_ParameterNotUsedOff;
     procedure TestM_Hint_ParameterInOverrideNotUsed;
@@ -1629,6 +1630,39 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_ClassInterfacesList;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type',
+    '  IUnknown = interface',
+    '  end;',
+    '  IBird = interface(IUnknown)',
+    '  end;',
+    '']),
+    LinesToStr(['']));
+
+  AddModuleWithIntfImplSrc('unit3.pp',
+    LinesToStr([
+    'uses unit2;',
+    'type',
+    '  IBird2 = unit2.IBird;',
+    '']),
+    LinesToStr(['']));
+
+  StartUnit(true,[supTObject]);
+  Add([
+  'interface',
+  'uses unit3;',
+  'type',
+  '  TBird = class(TObject,IBird2)',
+  '  end;',
+  'implementation',
+  '']);
+  AnalyzeUnit;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
 begin
   StartProgram(true);

packages/fcl-pdf/examples/.gitignore

@@ -5,3 +5,4 @@ testfppdf
 fonts
 lib
 pdfdump
+fonts

packages/fcl-pdf/examples/testfontmap.pp

@@ -0,0 +1,34 @@
+program testfontmap;
+
+{$ifndef FPC}
+{$apptype CONSOLE}
+{$endif}
+
+uses dynlibs,types,fpttf;
+
+var
+  lst:TStringDynArray;
+
+procedure dump(const lst:TStringDynArray);
+var i:integer;
+begin
+  for i:=0 to high(lst) do
+  writeln('#',i,' ',lst[i]);
+  writeln();
+end;
+
+begin
+  if TFontmapper.find('Courier New','bold italic',lst) then
+    dump(lst);
+  
+  if TFontmapper.find('Arial','',lst) then
+    dump(lst);
+
+  if TFontmapper.find('Verdana','bold',lst) then
+    dump(lst);
+
+  if TFontmapper.find('FreeSans','italic',lst) then
+    dump(lst);
+ 
+
+end.

packages/fcl-pdf/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Description := 'PDF generating and TTF file info library';
     P.NeedLibC:= false;
-    P.OSes:=P.OSes-[embedded,win16,msdos,nativent,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql];
+    P.OSes:=P.OSes-[embedded,win16,wince,msdos,nativent,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql];
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
 
@@ -34,6 +34,7 @@ begin
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('paszlib');
     P.Dependencies.add('winunits-base',AllWindowsOSes-[wince]);
+    P.Dependencies.add('libfontconfig',[linux] + AllBSDOses);
     P.Version:='3.3.1';
     T:=P.Targets.AddUnit('src/fpttfencodings.pp');
     T:=P.Targets.AddUnit('src/fpparsettf.pp');

packages/fcl-pdf/src/fppdf.pp

@@ -82,6 +82,7 @@ type
   TPDFPaperOrientation = (ppoPortrait,ppoLandscape);
   TPDFPenStyle = (ppsSolid,ppsDash,ppsDot,ppsDashDot,ppsDashDotDot);
   TPDFLineCapStyle = (plcsButtCap, plcsRoundCap, plcsProjectingSquareCap);
+  TPDFLineJoinStyle = (pljsMiterJoin, pljsRoundJoin, pljsBevelJoin);
   TPDFPageLayout = (lSingle, lTwo, lContinuous);
   TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels);
 
@@ -147,6 +148,7 @@ type
   // CharWidth array of standard PDF fonts
   TPDFFontWidthArray = array[0..255] of integer;
 
+  TDashArray = array of TPDFFloat;
 
   TPDFObject = class(TObject)
   Protected
@@ -396,16 +398,22 @@ type
     FTxtFont: integer;
     FTxtSize: string;
     FPage: TPDFPage;
+    FSimulateBold, FSimulateItalic: Boolean;
     function    GetPointSize: integer;
+    function    GetFontSize: TPDFFloat;
   protected
     procedure Write(const AStream: TStream); override;
     class function WriteEmbeddedFont(const ADocument: TPDFDocument; const Src: TMemoryStream; const AStream: TStream): int64;
     class function WriteEmbeddedSubsetFont(const ADocument: TPDFDocument; const AFontNum: integer; const AOutStream: TStream): int64;
   public
     constructor Create(const ADocument: TPDFDocument;const APage: TPDFPage; const AFont: integer; const ASize: string); overload;
+    constructor Create(const ADocument: TPDFDocument;const APage: TPDFPage; const AFont: integer; const ASize: TPDFFloat; const ASimulateBold, ASimulateItalic: Boolean); overload;
     property    FontIndex: integer read FTxtFont;
     property    PointSize: integer read GetPointSize;
+    property    FontSize: TPDFFloat read GetFontSize;
     property    Page: TPDFPage read FPage;
+    property    SimulateBold: Boolean read FSimulateBold;
+    property    SimulateItalic: Boolean read FSimulateItalic;
   end;
 
 
@@ -595,10 +603,42 @@ type
     FStyle: TPDFPenStyle;
     FPhase: integer;
     FLineWidth: TPDFFloat;
+    FLineMask: string;
   protected
     procedure Write(const AStream: TStream);override;
   public
     constructor Create(Const ADocument : TPDFDocument; AStyle: TPDFPenStyle; APhase: integer; ALineWidth: TPDFFloat); overload;
+    constructor Create(const ADocument : TPDFDocument; ADashArray: TDashArray; APhase: integer; ALineWidth: TPDFFloat); overload;
+  end;
+
+
+  TPDFCapStyle = class(TPDFDocumentObject)
+  private
+    FStyle: TPDFLineCapStyle;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; AStyle: TPDFLineCapStyle); overload;
+  end;
+
+
+  TPDFJoinStyle = class(TPDFDocumentObject)
+  private
+    FStyle: TPDFLineJoinStyle;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; AStyle: TPDFLineJoinStyle); overload;
+  end;
+
+
+  TPDFMiterLimit = class(TPDFDocumentObject)
+  private
+    FMiterLimit: TPDFFloat;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; AMiterLimit: TPDFFloat); overload;
   end;
 
 
@@ -731,10 +771,15 @@ type
     Destructor Destroy; override;
     Procedure AddObject(AObject : TPDFObject);
     // Commands. These will create objects in the objects list of the page.
-    Procedure SetFont(AFontIndex : Integer; AFontSize : Integer); virtual;
+    Procedure SetFont(AFontIndex : Integer; AFontSize : TPDFFloat; const
+      ASimulateBold: Boolean = False; const ASimulateItalic: Boolean = False); virtual;
     // used for stroking and nonstroking colors - purpose determined by the AStroke parameter
     Procedure SetColor(AColor : TARGBColor; AStroke : Boolean = True); virtual;
     Procedure SetPenStyle(AStyle : TPDFPenStyle; const ALineWidth: TPDFFloat = 1.0); virtual;
+    procedure SetPenStyle(ADashArray: TDashArray; const ALineWidth: TPDFFloat = 1.0);
+    procedure SetLineCapStyle(AStyle: TPDFLineCapStyle); virtual;
+    procedure SetLineJoinStyle(AStyle: TPDFLineJoinStyle); virtual;
+    procedure SetMiterLimit(AMiterLimit: TPDFFloat); virtual;
     // Set color and pen style from line style
     Procedure SetLineStyle(AIndex : Integer; AStroke : Boolean = True); overload;
     Procedure SetLineStyle(S : TPDFLineStyleDef; AStroke : Boolean = True); overload;
@@ -1042,12 +1087,14 @@ type
     FColor: TARGBColor;
     FLineWidth: TPDFFloat;
     FPenStyle: TPDFPenStyle;
+    FDashArray: TDashArray;
   Public
     Procedure Assign(Source : TPersistent); override;
   Published
     Property LineWidth : TPDFFloat Read FLineWidth Write FLineWidth;
     Property Color : TARGBColor Read FColor Write FColor Default clBlack;
     Property PenStyle : TPDFPenStyle Read FPenStyle Write FPenStyle Default ppsSolid;
+    property DashArray : TDashArray read FDashArray write FDashArray;
   end;
 
 
@@ -1163,7 +1210,8 @@ type
     Procedure SaveToFile(Const AFileName : String);
     function  IsStandardPDFFont(AFontName: string): boolean;
     // Create objects, owned by this document.
-    Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
+    Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex : Integer; AFontSize : TPDFFloat;
+      const ASimulateBold: Boolean = False; const ASimulateItalic: Boolean = False) : TPDFEmbeddedFont;
     Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFText; overload;
     Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF8Text; overload;
     Function CreateText(X,Y : TPDFFloat; AText : UnicodeString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF16Text; overload;
@@ -1174,6 +1222,10 @@ type
     Function CreateInteger(AValue : Integer) : TPDFInteger;
     Function CreateReference(AValue : Integer) : TPDFReference;
     Function CreateLineStyle(APenStyle: TPDFPenStyle; const ALineWidth: TPDFFloat) : TPDFLineStyle;
+    function CreateLineStyle(ADashArray: TDashArray; const ALineWidth: TPDFFloat): TPDFLineStyle;
+    function CreateLineCapStyle(ALineCapStyle: TPDFLineCapStyle): TPDFCapStyle;
+    function CreateLineJoinStyle(ALineJoinStyle: TPDFLineJoinStyle): TPDFJoinStyle;
+    function CreateMiterLimit(AMiterLimit: TPDFFloat): TPDFMiterLimit;
     Function CreateName(AValue : String; const AMustEscape: boolean = True) : TPDFName;
     Function CreateStream(OwnsObjects : Boolean = True) : TPDFStream;
     Function CreateDictionary : TPDFDictionary;
@@ -1183,6 +1235,7 @@ type
     Function AddFont(AName : String) : Integer; overload;
     Function AddFont(AFontFile: String; AName : String) : Integer; overload;
     Function AddLineStyleDef(ALineWidth : TPDFFloat; AColor : TARGBColor = clBlack; APenStyle : TPDFPenStyle = ppsSolid) : Integer;
+    function AddLineStyleDef(ALineWidth : TPDFFloat; AColor : TARGBColor = clBlack; ADashArray : TDashArray = []) : Integer;
     procedure AddOutputIntent(const Subtype, OutputConditionIdentifier, Info: string; ICCProfile: TStream);
     procedure AddPDFA1sRGBOutputIntent;virtual;
     Property Fonts : TPDFFontDefs Read FFonts Write SetFonts;
@@ -1264,6 +1317,7 @@ function cmToPDF(cm: single): TPDFFloat;
 function PDFtoCM(APixels: TPDFFloat): single;
 function InchesToPDF(Inches: single): TPDFFloat;
 function PDFtoInches(APixels: TPDFFloat): single;
+function FontUnitsTomm(AUnits, APointSize: TPDFFloat; AUnitsPerEm: Integer): single;
 
 function PDFCoord(x, y: TPDFFloat): TPDFCoord;
 
@@ -1498,6 +1552,12 @@ begin
   Result := APixels / cDefaultDPI;
 end;
 
+function FontUnitsTomm(AUnits, APointSize: TPDFFloat; AUnitsPerEm: Integer): single;
+begin
+  Result := AUnits * APointSize * gTTFontCache.DPI / (72 * AUnitsPerEm);
+  Result := Result * cInchToMM / gTTFontCache.DPI;
+end;
+
 function XMLEscape(const Data: string): string;
 var
   iPos, i: Integer;
@@ -2108,6 +2168,7 @@ begin
     LineWidth:=L.LineWidth;
     Color:=L.Color;
     PenStyle:=L.PenStyle;
+    DashArray:=L.DashArray;
     end
   else
     Inherited;
@@ -2410,11 +2471,12 @@ begin
   FObjects.Add(AObject);
 end;
 
-procedure TPDFPage.SetFont(AFontIndex: Integer; AFontSize: Integer);
+procedure TPDFPage.SetFont(AFontIndex: Integer; AFontSize: TPDFFloat;
+  const ASimulateBold: Boolean; const ASimulateItalic: Boolean);
 Var
   F : TPDFEmbeddedFont;
 begin
-  F:=Document.CreateEmbeddedFont(self, AFontIndex, AFontSize);
+  F:=Document.CreateEmbeddedFont(self, AFontIndex, AFontSize, ASimulateBold, ASimulateItalic);
   AddObject(F);
   FLastFont := F;
 end;
@@ -2437,6 +2499,40 @@ begin
   AddObject(L);
 end;
 
+procedure TPDFPage.SetPenStyle(ADashArray: TDashArray; const
+  ALineWidth: TPDFFloat);
+var
+  L: TPDFLineStyle;
+begin
+  L := Document.CreateLineStyle(ADashArray, ALineWidth);
+  AddObject(L);
+end;
+
+procedure TPDFPage.SetLineCapStyle(AStyle: TPDFLineCapStyle);
+var
+  C: TPDFCapStyle;
+begin
+  Document.LineCapStyle := AStyle;
+  C := Document.CreateLineCapStyle(AStyle);
+  AddObject(C);
+end;
+
+procedure TPDFPage.SetLineJoinStyle(AStyle: TPDFLineJoinStyle);
+var
+  J: TPDFJoinStyle;
+begin
+  J := Document.CreateLineJoinStyle(AStyle);
+  AddObject(J);
+end;
+
+procedure TPDFPage.SetMiterLimit(AMiterLimit: TPDFFloat);
+var
+  M: TPDFMiterLimit;
+begin
+  M := Document.CreateMiterLimit(AMiterLimit);
+  AddObject(M);
+end;
+
 procedure TPDFPage.SetLineStyle(AIndex: Integer; AStroke : Boolean = True);
 begin
   SetLineStyle(Document.LineStyles[Aindex],AStroke);
@@ -2445,7 +2541,10 @@ end;
 procedure TPDFPage.SetLineStyle(S: TPDFLineStyleDef; AStroke: Boolean = True);
 begin
   SetColor(S.Color,AStroke);
-  SetPenStyle(S.PenStyle,S.LineWidth);
+  if Length(S.DashArray) = 0 then
+    SetPenStyle(S.PenStyle, S.LineWidth)
+  else
+    SetPenStyle(S.DashArray, S.LineWidth);
 end;
 
 procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String; const ADegrees: single;
@@ -2508,7 +2607,7 @@ var
   R: TPDFRectangle;
   p1, p2: TPDFCoord;
   t1, t2, t3: string;
-  rad: single;
+  rad, rads,radc: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
@@ -2519,9 +2618,10 @@ begin
   if ADegrees <> 0.0 then
   begin
     rad := DegToRad(-ADegrees);
-    t1 := FormatFloat(PDF_NUMBER_MASK, Cos(rad), PDFFormatSettings);
-    t2 := FormatFloat(PDF_NUMBER_MASK, -Sin(rad), PDFFormatSettings);
-    t3 := FormatFloat(PDF_NUMBER_MASK, Sin(rad), PDFFormatSettings);
+    sincos(rad,rads,radc);
+    t1 := FormatFloat(PDF_NUMBER_MASK, radc, PDFFormatSettings);
+    t2 := FormatFloat(PDF_NUMBER_MASK, -rads, PDFFormatSettings);
+    t3 := FormatFloat(PDF_NUMBER_MASK, rads, PDFFormatSettings);
     AddObject(TPDFPushGraphicsStack.Create(Document));
     // PDF v1.3 page 132 & 143
     AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm',
@@ -2550,7 +2650,7 @@ var
   R: TPDFRoundedRectangle;
   p1, p2, p3: TPDFCoord;
   t1, t2, t3: string;
-  rad: single;
+  rad, rads, radc: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
@@ -2563,9 +2663,10 @@ begin
   if ADegrees <> 0.0 then
   begin
     rad := DegToRad(-ADegrees);
-    t1 := FormatFloat(PDF_NUMBER_MASK, Cos(rad), PDFFormatSettings);
-    t2 := FormatFloat(PDF_NUMBER_MASK, -Sin(rad), PDFFormatSettings);
-    t3 := FormatFloat(PDF_NUMBER_MASK, Sin(rad), PDFFormatSettings);
+    sincos(rad,rads,radc);
+    t1 := FormatFloat(PDF_NUMBER_MASK, radc, PDFFormatSettings);
+    t2 := FormatFloat(PDF_NUMBER_MASK, -rads, PDFFormatSettings);
+    t3 := FormatFloat(PDF_NUMBER_MASK, rads, PDFFormatSettings);
     AddObject(TPDFPushGraphicsStack.Create(Document));
     // PDF v1.3 page 132 & 143
     AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm',
@@ -2587,16 +2688,17 @@ procedure TPDFPage.DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, AP
 var
   p1: TPDFCoord;
   t1, t2, t3: string;
-  rad: single;
+  rad, rads,radc: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
   if ADegrees <> 0.0 then
   begin
     rad := DegToRad(-ADegrees);
-    t1 := FormatFloat(PDF_NUMBER_MASK, Cos(rad), PDFFormatSettings);
-    t2 := FormatFloat(PDF_NUMBER_MASK, -Sin(rad), PDFFormatSettings);
-    t3 := FormatFloat(PDF_NUMBER_MASK, Sin(rad), PDFFormatSettings);
+    sincos(rad,rads,radc);
+    t1 := FormatFloat(PDF_NUMBER_MASK, radc, PDFFormatSettings);
+    t2 := FormatFloat(PDF_NUMBER_MASK, -rads, PDFFormatSettings);
+    t3 := FormatFloat(PDF_NUMBER_MASK, rads, PDFFormatSettings);
     AddObject(TPDFPushGraphicsStack.Create(Document));
     // PDF v1.3 page 132 & 143
     AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm',
@@ -2622,7 +2724,7 @@ procedure TPDFPage.DrawImage(const X, Y: TPDFFloat; const AWidth, AHeight: TPDFF
 var
   p1, p2: TPDFCoord;
   t1, t2, t3: string;
-  rad: single;
+  rad, rads, radc: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
@@ -2633,9 +2735,10 @@ begin
   if ADegrees <> 0.0 then
   begin
     rad := DegToRad(-ADegrees);
-    t1 := FormatFloat(PDF_NUMBER_MASK, Cos(rad), PDFFormatSettings);
-    t2 := FormatFloat(PDF_NUMBER_MASK, -Sin(rad), PDFFormatSettings);
-    t3 := FormatFloat(PDF_NUMBER_MASK, Sin(rad), PDFFormatSettings);
+    sincos(rad,rads,radc);
+    t1 := FormatFloat(PDF_NUMBER_MASK, radc, PDFFormatSettings);
+    t2 := FormatFloat(PDF_NUMBER_MASK, -rads, PDFFormatSettings);
+    t3 := FormatFloat(PDF_NUMBER_MASK, rads, PDFFormatSettings);
     AddObject(TPDFPushGraphicsStack.Create(Document));
     // PDF v1.3 page 132 & 143
     AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm',
@@ -2661,7 +2764,7 @@ procedure TPDFPage.DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth:
 var
   p1, p2: TPDFCoord;
   t1, t2, t3: string;
-  rad: single;
+  rad, rads, radc: single;
 begin
   p1 := Matrix.Transform(APosX, APosY);
   DoUnitConversion(p1);
@@ -2672,9 +2775,10 @@ begin
   if ADegrees <> 0.0 then
   begin
     rad := DegToRad(-ADegrees);
-    t1 := FormatFloat(PDF_NUMBER_MASK, Cos(rad), PDFFormatSettings);
-    t2 := FormatFloat(PDF_NUMBER_MASK, -Sin(rad), PDFFormatSettings);
-    t3 := FormatFloat(PDF_NUMBER_MASK, Sin(rad), PDFFormatSettings);
+    sincos(rad, rads, radc);
+    t1 := FormatFloat(PDF_NUMBER_MASK, radc, PDFFormatSettings);
+    t2 := FormatFloat(PDF_NUMBER_MASK, -rads, PDFFormatSettings);
+    t3 := FormatFloat(PDF_NUMBER_MASK, rads, PDFFormatSettings);
     AddObject(TPDFPushGraphicsStack.Create(Document));
     // PDF v1.3 page 132 & 143
     AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm',
@@ -3727,7 +3831,12 @@ end;
 
 function TPDFEmbeddedFont.GetPointSize: integer;
 begin
-  Result := StrToInt(FTxtSize);
+  Result := Round(StrToFloatDef(FTxtSize, 10));
+end;
+
+function TPDFEmbeddedFont.GetFontSize: TPDFFloat;
+begin
+  Result := StrToFloatDef(FTxtSize, 10);
 end;
 
 procedure TPDFEmbeddedFont.Write(const AStream: TStream);
@@ -3798,6 +3907,17 @@ begin
   FPage := APage;
 end;
 
+constructor TPDFEmbeddedFont.Create(const ADocument: TPDFDocument; const APage: TPDFPage; const AFont: integer;
+  const ASize: TPDFFloat; const ASimulateBold, ASimulateItalic: Boolean);
+begin
+  inherited Create(ADocument);
+  FTxtFont := AFont;
+  FTxtSize := FloatStr(ASize);
+  FPage := APage;
+  FSimulateBold := ASimulateBold;
+  FSimulateItalic := ASimulateItalic;
+end;
+
 { TPDFBaseText }
 
 constructor TPDFBaseText.Create(const ADocument: TPDFDocument);
@@ -3863,7 +3983,7 @@ end;
 procedure TPDFText.Write(const AStream: TStream);
 var
   t1, t2, t3: string;
-  rad: single;
+  rad, rads, radc: single;
   lWidth: single;
   lTextWidthInMM: single;
   lHeight: single;
@@ -3876,9 +3996,10 @@ begin
   if Degrees <> 0.0 then
   begin
     rad := DegToRad(-Degrees);
-    t1 := FloatStr(Cos(rad));
-    t2 := FloatStr(-Sin(rad));
-    t3 := FloatStr(Sin(rad));
+    sincos(rad, rads, radc);
+    t1 := FloatStr(radc);
+    t2 := FloatStr(-rads);
+    t3 := FloatStr(rads);
     WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
   end
   else
@@ -3946,7 +4067,6 @@ end;
 
 procedure TPDFUTF8Text.Write(const AStream: TStream);
 var
-  t1, t2, t3: string;
   rad: single;
   lFC: TFPFontCacheItem;
   lWidth: single;
@@ -3956,61 +4076,119 @@ var
   lColor: string;
   lLineWidth: string;
   lDescender: single;
+  lUnderlinePos, lUnderlineSize, lStrikeOutPos, lStrikeOutSize: Single;
+  a1, b1, c1, d1, a2, b2, c2, d2: Single;
 begin
   inherited Write(AStream);
-  WriteString('BT'+CRLF, AStream);
-  if Degrees <> 0.0 then
-  begin
-    rad := DegToRad(-Degrees);
-    t1 := FloatStr(Cos(rad));
-    t2 := FloatStr(-Sin(rad));
-    t3 := FloatStr(Sin(rad));
-    WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
-  end
-  else
-  begin
-    WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
-  end;
-  FString.Write(AStream);
-  WriteString(' Tj'+CRLF, AStream);
-  WriteString('ET'+CRLF, AStream);
+  WriteString('q' + CRLF, AStream);
+  try
+    WriteString('BT'+CRLF, AStream);
 
-  if (not Underline) and (not StrikeThrough) then
-    Exit;
+    a1 := 1; b1 := 0; c1 := 0; d1 := 1;
+    if Degrees <> 0.0 then
+    begin
+      rad := DegToRad(-Degrees);
+      a1 := Cos(rad); b1 := -Sin(rad);
+      c1 := Sin(rad); d1 := a1;
+    end
+    else
+      WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
 
-  // implement Underline and Strikethrough here
-  lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
-  if not Assigned(lFC) then
-    Exit;  // we can't do anything further
+    lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
 
-  // result is in Font Units
-  lWidth := lFC.TextWidth(FString.Value, Font.PointSize);
-  lHeight := lFC.TextHeight(FString.Value, Font.PointSize, lDescender);
-  { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
-  lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
-  lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+    { set up a pen stroke color }
+    lColor := TPDFColor.Command(True, Color);
 
-  if Degrees <> 0.0 then
-    // angled text
-    WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
-  else
-    // horizontal text
-    WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+    // do simulated bold/italic here
+    if Assigned(lFC) then
+    begin
+      if Font.SimulateBold and not lFC.IsBold then
+      begin
+        WriteString(lColor + CRLF, AStream);
+        // stroke ptSize/30 outline to simulate bold
+        WriteString(Format('2 Tr %s w', [FloatStr(Font.PointSize / 30)]) + CRLF, AStream);
+      end;
+      if Font.SimulateItalic and not lFC.IsItalic then
+      begin
+        // skew by 12 degrees
+        a2 := 1;                 b2 := 0;
+        c2 := Tan(DegToRad(12)); d2 := 1;
+        // combine matrices: skew x rotate (skew first, then rotate)
+        a1 := a2 * a1 + b2 * c1;
+        b1 := a2 * b1 + b2 * d1;
+        c1 := c2 * a1 + d2 * c1;
+        d1 := c2 * b1 + d2 * d1;
+      end;
+    end;
+    // write transformation matrix (Tm)
+    if (Degrees <> 0.0) or (Font.SimulateItalic and not lFC.IsItalic) then
+      WriteString(Format('%s %s %s %s %s %s Tm',
+        [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1),
+         FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
 
-  { set up a pen width and stroke color }
-  lColor := TPDFColor.Command(True, Color);
-  lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
-  WriteString(lLineWidth + lColor + CRLF, AStream);
+    FString.Write(AStream);
+    WriteString(' Tj'+CRLF, AStream);
+    WriteString('ET'+CRLF, AStream);
 
-  { line segment is relative to matrix translation coordinate, set above }
-  if Underline then
-    WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
-  if StrikeThrough then
-    WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+    if (not Underline) and (not StrikeThrough) then
+      Exit;
 
-  { restore graphics state to before the translation matrix adjustment }
-  WriteString('Q' + CRLF, AStream);
+    // implement Underline and Strikethrough here
+    if not Assigned(lFC) then
+      Exit;  // we can't do anything further
 
+    // result is in Font Units
+    lWidth := lFC.TextWidth(FString.Value, Font.PointSize);
+    lHeight := lFC.TextHeight(FString.Value, Font.PointSize, lDescender);
+    { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+    lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+    lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+    if Degrees <> 0.0 then
+      // angled text
+      WriteString(Format('%s %s %s %s %s %s cm', [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1), FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+    else
+      // horizontal text
+      WriteString(Format('1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+    with lFC.FontData do
+    begin
+      { line segment is relative to matrix translation coordinate, set above }
+      if Underline then
+      begin
+        // fallback default values
+        lUnderlinePos := PDFTomm(-1.5);
+        lUnderlineSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if PostScript.UnderlinePosition <> 0 then
+          lUnderlinePos := FontUnitsTomm(PostScript.UnderlinePosition, Font.PointSize, Head.UnitsPerEm);
+        if PostScript.underlineThickness <> 0 then
+          lUnderlineSize := FontUnitsTomm(PostScript.underlineThickness, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lUnderlineSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lUnderlinePos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+      if StrikeThrough then
+      begin
+        // fallback default values
+        lStrikeOutPos := lTextHeightInMM / 2;
+        lStrikeOutSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if OS2Data.yStrikeoutPosition <> 0 then
+          lStrikeOutPos := FontUnitsTomm(OS2Data.yStrikeoutPosition, Font.PointSize, Head.UnitsPerEm);
+        if OS2Data.yStrikeoutSize <> 0 then
+          lStrikeOutSize := FontUnitsTomm(OS2Data.yStrikeoutSize, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lStrikeOutSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lStrikeOutPos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+    end;
+  finally
+    { restore graphics state to before the translation matrix adjustment }
+    WriteString('Q' + CRLF, AStream);
+  end;
 end;
 
 constructor TPDFUTF8Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String;
@@ -4039,7 +4217,7 @@ end;
 procedure TPDFUTF16Text.Write(const AStream: TStream);
 var
   t1, t2, t3: string;
-  rad: single;
+  rad, rads, radc: single;
   lFC: TFPFontCacheItem;
   lWidth: single;
   lTextWidthInMM: single;
@@ -4048,64 +4226,122 @@ var
   lColor: string;
   lLineWidth: string;
   lDescender: single;
+  lUnderlinePos, lUnderlineSize, lStrikeOutPos, lStrikeOutSize: Single;
+  a1, b1, c1, d1, a2, b2, c2, d2: Single;
   v : UTF8String;
   
 begin
   inherited Write(AStream);
-  WriteString('BT'+CRLF, AStream);
-  if Degrees <> 0.0 then
-  begin
-    rad := DegToRad(-Degrees);
-    t1 := FloatStr(Cos(rad));
-    t2 := FloatStr(-Sin(rad));
-    t3 := FloatStr(Sin(rad));
-    WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
-  end
-  else
-  begin
-    WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
-  end;
-  FString.Write(AStream);
-  WriteString(' Tj'+CRLF, AStream);
-  WriteString('ET'+CRLF, AStream);
+  WriteString('q' + CRLF, AStream);
+  try
+    WriteString('BT'+CRLF, AStream);
 
-  if (not Underline) and (not StrikeThrough) then
-    Exit;
+    a1 := 1; b1 := 0; c1 := 0; d1 := 1;
+    if Degrees <> 0.0 then
+    begin
+      rad := DegToRad(-Degrees);
+      a1 := Cos(rad); b1 := -Sin(rad);
+      c1 := Sin(rad); d1 := a1;
+    end
+    else
+      WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
 
-  // implement Underline and Strikethrough here
-  lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
-  if not Assigned(lFC) then
-    Exit;  // we can't do anything further
+    lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
 
-  // result is in Font Units
-  v:=UTF8Encode(FString.Value);
-  lWidth := lFC.TextWidth(v, Font.PointSize);
-  lHeight := lFC.TextHeight(v, Font.PointSize, lDescender);
-  { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
-  lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
-  lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+    { set up a pen stroke color }
+    lColor := TPDFColor.Command(True, Color);
 
-  if Degrees <> 0.0 then
-    // angled text
-    WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
-  else
-    // horizontal text
-    WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+    // do simulated bold/italic here
+    if Assigned(lFC) then
+    begin
+      if Font.SimulateBold and not lFC.IsBold then
+      begin
+        WriteString(lColor + CRLF, AStream);
+        // stroke ptSize/30 outline to simulate bold
+        WriteString(Format('2 Tr %s w', [FloatStr(Font.PointSize / 30)]) + CRLF, AStream);
+      end;
+      if Font.SimulateItalic and not lFC.IsItalic then
+      begin
+        // skew by 12 degrees
+        a2 := 1;                 b2 := 0;
+        c2 := Tan(DegToRad(12)); d2 := 1;
+        // combine matrices: skew x rotate (skew first, then rotate)
+        a1 := a2 * a1 + b2 * c1;
+        b1 := a2 * b1 + b2 * d1;
+        c1 := c2 * a1 + d2 * c1;
+        d1 := c2 * b1 + d2 * d1;
+      end;
+    end;
+    // write transformation matrix (Tm)
+    if (Degrees <> 0.0) or (Font.SimulateItalic and not lFC.IsItalic) then
+      WriteString(Format('%s %s %s %s %s %s Tm',
+        [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1),
+         FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
 
-  { set up a pen width and stroke color }
-  lColor := TPDFColor.Command(True, Color);
-  lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
-  WriteString(lLineWidth + lColor + CRLF, AStream);
+    FString.Write(AStream);
+    WriteString(' Tj'+CRLF, AStream);
+    WriteString('ET'+CRLF, AStream);
 
-  { line segment is relative to matrix translation coordinate, set above }
-  if Underline then
-    WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
-  if StrikeThrough then
-    WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+    if (not Underline) and (not StrikeThrough) then
+      Exit;
 
-  { restore graphics state to before the translation matrix adjustment }
-  WriteString('Q' + CRLF, AStream);
+    // implement Underline and Strikethrough here
+    if not Assigned(lFC) then
+      Exit;  // we can't do anything further
+
+    // result is in Font Units
+    v:=UTF8Encode(FString.Value);
+    lWidth := lFC.TextWidth(v, Font.PointSize);
+    lHeight := lFC.TextHeight(v, Font.PointSize, lDescender);
+    { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+    lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+    lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+    if Degrees <> 0.0 then
+      // angled text
+      WriteString(Format('%s %s %s %s %s %s cm', [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1), FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+    else
+      // horizontal text
+      WriteString(Format('1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
 
+    with lFC.FontData do
+    begin
+      { line segment is relative to matrix translation coordinate, set above }
+      if Underline then
+      begin
+        // fallback default values
+        lUnderlinePos := PDFTomm(-1.5);
+        lUnderlineSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if PostScript.UnderlinePosition <> 0 then
+          lUnderlinePos := FontUnitsTomm(PostScript.UnderlinePosition, Font.PointSize, Head.UnitsPerEm);
+        if PostScript.underlineThickness <> 0 then
+          lUnderlineSize := FontUnitsTomm(PostScript.underlineThickness, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lUnderlineSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lUnderlinePos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+      if StrikeThrough then
+      begin
+        // fallback default values
+        lStrikeOutPos := lTextHeightInMM / 2;
+        lStrikeOutSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if OS2Data.yStrikeoutPosition <> 0 then
+          lStrikeOutPos := FontUnitsTomm(OS2Data.yStrikeoutPosition, Font.PointSize, Head.UnitsPerEm);
+        if OS2Data.yStrikeoutSize <> 0 then
+          lStrikeOutSize := FontUnitsTomm(OS2Data.yStrikeoutSize, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lStrikeOutSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lStrikeOutPos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+    end;
+  finally
+    { restore graphics state to before the translation matrix adjustment }
+    WriteString('Q' + CRLF, AStream);
+  end;
 end;
 
 constructor TPDFUTF16Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UnicodeString;
@@ -4309,6 +4545,9 @@ var
   w: TPDFFloat;
 begin
   w := FLineWidth;
+  if FLineMask <> '' then
+    lMask := FLineMask
+  else
   case FStyle of
     ppsSolid:
       begin
@@ -4341,6 +4580,58 @@ begin
   FStyle := AStyle;
   FPhase := APhase;
   FLineWidth := ALineWidth;
+  FLineMask := '';
+end;
+
+constructor TPDFLineStyle.Create(const ADocument : TPDFDocument;
+  ADashArray: TDashArray; APhase: integer; ALineWidth: TPDFFloat);
+var
+  i: Integer;
+begin
+  Create(ADocument, ppsSolid, APhase, ALineWidth);
+  // custom line style
+  for i := Low(ADashArray) to High(ADashArray) do
+  begin
+    if FLineMask <> '' then FLineMask := FLineMask + ' ';
+    FLineMask := FLineMask + FloatStr(ADashArray[i] * ALineWidth);
+  end;
+end;
+
+procedure TPDFCapStyle.Write(const AStream: TStream);
+begin
+  inherited Write(AStream);
+  WriteString(IntToStr(Ord(FStyle)) + ' J' + CRLF, AStream);
+end;
+
+constructor TPDFCapStyle.Create(const ADocument: TPDFDocument;
+  AStyle: TPDFLineCapStyle);
+begin
+  inherited Create(ADocument);
+  FStyle := AStyle;
+end;
+
+procedure TPDFJoinStyle.Write(const AStream: TStream);
+begin
+  inherited Write(AStream);
+  WriteString(IntToStr(Ord(FStyle)) + ' j' + CRLF, AStream);
+end;
+
+constructor TPDFJoinStyle.Create(const ADocument: TPDFDocument; AStyle: TPDFLineJoinStyle);
+begin
+  inherited Create(ADocument);
+  FStyle := AStyle;
+end;
+
+procedure TPDFMiterLimit.Write(const AStream: TStream);
+begin
+  inherited Write(AStream);
+  WriteString(FloatStr(FMiterLimit) + ' M' + CRLF, AStream);
+end;
+
+constructor TPDFMiterLimit.Create(const ADocument: TPDFDocument; AMiterLimit: TPDFFloat);
+begin
+  inherited Create(ADocument);
+  FMiterLimit := AMiterLimit;
 end;
 
 Function ARGBGetRed(AColor : TARGBColor) : Byte;
@@ -6112,9 +6403,11 @@ begin
     Result := False;
 end;
 
-function TPDFDocument.CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize: Integer): TPDFEmbeddedFont;
+function TPDFDocument.CreateEmbeddedFont(const APage: TPDFPage; AFontIndex: Integer;
+  AFontSize: TPDFFloat; const ASimulateBold: Boolean;
+  const ASimulateItalic: Boolean): TPDFEmbeddedFont;
 begin
-  Result:=TPDFEmbeddedFont.Create(Self, APage, AFontIndex, IntToStr(AFontSize))
+  Result:=TPDFEmbeddedFont.Create(Self, APage, AFontIndex, AFontSize, ASimulateBold, ASimulateItalic);
 end;
 
 function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont;
@@ -6186,6 +6479,27 @@ begin
   Result := TPDFLineStyle.Create(Self, APenStyle, 0, ALineWidth);
 end;
 
+function TPDFDocument.CreateLineStyle(ADashArray: TDashArray; const
+  ALineWidth: TPDFFloat): TPDFLineStyle;
+begin
+  Result := TPDFLineStyle.Create(Self, ADashArray, 0, ALineWidth);
+end;
+
+function TPDFDocument.CreateLineCapStyle(ALineCapStyle: TPDFLineCapStyle): TPDFCapStyle;
+begin
+  Result := TPDFCapStyle.Create(Self, ALineCapStyle);
+end;
+
+function TPDFDocument.CreateLineJoinStyle(ALineJoinStyle: TPDFLineJoinStyle): TPDFJoinStyle;
+begin
+  Result := TPDFJoinStyle.Create(Self, ALineJoinStyle);
+end;
+
+function TPDFDocument.CreateMiterLimit(AMiterLimit: TPDFFloat): TPDFMiterLimit;
+begin
+  Result := TPDFMiterLimit.Create(Self, AMiterLimit);
+end;
+
 function TPDFDocument.CreateName(AValue: String; const AMustEscape: boolean = True): TPDFName;
 begin
   Result:=TPDFName.Create(Self,AValue,AMustEscape);
@@ -6264,9 +6578,17 @@ begin
   F.LineWidth:=ALineWidth;
   F.Color:=AColor;
   F.PenStyle:=APenStyle;
+  F.DashArray:=[];
   Result:=FLineStyleDefs.Count-1;
 end;
 
+function TPDFDocument.AddLineStyleDef(ALineWidth: TPDFFloat; AColor: TARGBColor;
+  ADashArray: TDashArray) : Integer;
+begin
+  Result := AddLineStyleDef(ALineWidth, AColor, ppsSolid);
+  if Result >= 0 then
+    LineStyles[Result].DashArray := ADashArray;
+end;
 
 initialization
   PDFFormatSettings:= DefaultFormatSettings;

packages/fcl-pdf/src/fpttf.pp

@@ -21,8 +21,9 @@
 unit fpTTF;
 {$ENDIF FPC_DOTTEDUNITS}
 
-{$mode objfpc}{$H+}
-
+{$mode objfpc}
+{$H+}
+{$modeswitch advancedrecords}
 {.$define ttfdebug}
 
 interface
@@ -32,9 +33,11 @@ uses
   System.Classes,
   System.SysUtils,
   System.Contnrs,
+  System.Types,
   FpPdf.Ttf.Parser;
 {$ELSE FPC_DOTTEDUNITS}
 uses
+  Types,
   Classes,
   SysUtils,
   contnrs,
@@ -141,29 +144,51 @@ type
     Property    BuildFontCacheIgnoresErrors : Boolean Read FBuildFontCacheIgnoresErrors Write FBuildFontCacheIgnoresErrors;
   end;
 
-
 function gTTFontCache: TFPFontCacheList;
 
+type
+  { TFontMapper }
+
+  TFontMapper = class
+    class function find(const family, style:string; List:TStrings):boolean; overload;
+    class function find(const family, style:string; out List: TStringDynArray):boolean;
+  end;
+
+const
+  style_regular = 'regular';
+  style_bold = 'bold';
+  style_italic = 'italic';
+
+
 implementation
 
 {$IFDEF FPC_DOTTEDUNITS}
 uses
   Xml.Dom
-  ,Xml.Read
+  , Xml.Read
+  , System.StrUtils
   {$ifdef mswindows}
   ,WinApi.Windows  // for SHGetFolderPath API call used by gTTFontCache.ReadStandardFonts() method
   ,WinApi.Shlobj
   ,WinApi.Activex
   {$endif}
+  {$if (defined(LINUX) or defined(BSD)) and not defined(DARWIN)}
+  , Api.Libfontconfig
+  , UnixApi.types
+  {$endif}
   ;
 {$ELSE FPC_DOTTEDUNITS}
 uses
   DOM
-  ,XMLRead
+  , XMLRead
+  , Strutils
   {$ifdef mswindows}
   ,Windows,  // for SHGetFolderPath API call used by gTTFontCache.ReadStandardFonts() method
-  Shlobj,activex
+  Shlobj, activex, registry
   {$endif}
+  {$if (defined(LINUX) or defined(BSD)) and not defined(DARWIN)}
+  , libfontconfig, unixtype
+  {$ifend}
   ;
 {$ENDIF FPC_DOTTEDUNITS}
 
@@ -537,50 +562,70 @@ end;
     This is definitely not a perfect solution, especially due to the inconsistent
     implementations and locations of files under various Linux distros. But it's
     the best we can do for now. }
-procedure TFPFontCacheList.ReadStandardFonts;
 
-  {$ifdef linux}
-    {$define HasFontsConf}
-    const
-      cFontsConf = '/etc/fonts/fonts.conf';
+{$ifdef mswindows}
+function GetWinFontsDir: string;
+
+var
+  {$if FPC_FULLVERSION < 30400}
+  w :  Array[0..MaxPathLen] of AnsiChar;
+  {$ELSE}
+  w : pwidechar;
+  {$ENDIF}
+
+begin
+  {$if FPC_FULLVERSION < 30400}
+  SHGetSpecialFolderPath(0,w,CSIDL_FONTS,false);
+  {$else}
+  SHGetKnownFolderPath(FOLDERID_Fonts,0,0,w);
+  {$endif}
+  Result := w;
+  {$if FPC_FULLVERSION > 30400}
+  CoTaskMemFree(w);
   {$endif}
+end;
+{$endif}
+
+procedure TFPFontCacheList.ReadStandardFonts;
 
   {$ifdef freebsd}
     {$define HasFontsConf}
     const
       cFontsConf = '/usr/local/etc/fonts/fonts.conf';
   {$endif}
+  { Use same default for Linux and other BSD non-Darwin systems. }
+  {$if (defined(linux) or (defined(bsd) and not(defined(darwin)) and not defined(HasFontsConf)))}
+    {$define HasFontsConf}
+    const
+      cFontsConf = '/etc/fonts/fonts.conf';
+  {$ifend}
+
 
-  {$ifdef mswindows}
-  function GetWinFontsDir: string;
-  var
-    {$if FPC_FULLVERSION < 30400}
-    w :  Array[0..MaxPathLen] of AnsiChar;
-    {$ELSE}
-    w : pwidechar;
-    {$ENDIF}
-  begin
-    {$if FPC_FULLVERSION < 30400}
-    SHGetSpecialFolderPath(0,w,CSIDL_FONTS,false);
-    {$else}
-    SHGetKnownFolderPath(FOLDERID_Fonts,0,0,w);
-    {$endif}
-    Result := w;
-    {$if FPC_FULLVERSION > 30400}
-    CoTaskMemFree(w);
-    {$endif}
-  end;
-{$endif}
 
 {$ifdef HasFontsConf}
 var
   doc: TXMLDocument;
   lChild: TDOMNode;
+  FN : PFcChar8;
   lDir: string;
+  config: PfcConfig;
+const
+  is_fc_loaded:integer=0;
 {$endif}
 begin
-  {$ifdef HasFontsConf} // Linux & FreeBSD
-  ReadXMLFile(doc, cFontsConf);
+  {$ifdef HasFontsConf} // Linux & BSD
+  if (is_fc_loaded=0) then
+    is_fc_loaded:=loadfontconfiglib('');
+
+  config := FcInitLoadConfigAndFonts();
+
+  if assigned(FcConfigGetFilename) then
+    FN:=FcConfigGetFilename(config,Nil)
+  else if assigned(FcConfigFilename) then
+    FN:=FcConfigFilename(Nil)
+  else
+    FN:=cFontsConf;
+  ReadXMLFile(doc, FN);
   try
     lChild := doc.DocumentElement.FirstChild;
     while Assigned(lChild) do
@@ -774,13 +819,357 @@ begin
   Result := APointSize * DPI / 72;
 end;
 
+{ ----------------------------------------------------------------------
+  TFontMapper
+  ----------------------------------------------------------------------}
+
+class function TFontMapper.find(const family, style:string; out List: TStringDynArray):boolean;
+
+var
+  L : TStrings;
+
+begin
+  L:=TStringList.Create;
+  try
+    Result:=Find(family,style,L);
+    if Result then
+      List:=L.ToStringArray();
+  finally
+    L.Free;
+  end;
+end;
+
+{$if (defined(LINUX) or defined(BSD)) and not defined(DARWIN)}
+
+//https://stackoverflow.com/questions/10542832/how-to-use-fontconfig-to-get-font-list-c-c
+class function TFontMapper.find(const family, style: string; list: TStrings): boolean;
+
+var
+  res:utf8string;
+  // libfontconfig version
+  config: PfcConfig;
+  pat, font: PfcPattern;
+  ffile: PfcChar8;
+  mres:TFcResult;
+const
+  is_fc_loaded:integer=0;
+begin
+  Result:=false;
+  res:='';
+
+  if (is_fc_loaded=0) then
+    is_fc_loaded:=loadfontconfiglib('');
+
+  config := FcInitLoadConfigAndFonts();
+
+  // configure the search pattern,
+  // assume "name" is a std::string with the desired font name in it
+  res:=family+':style='+style;
+  pat := FcNameParse(PChar(res));
+  FcConfigSubstitute(config, pat, FcMatchPattern);
+  FcDefaultSubstitute(pat);
+
+  // find the font
+  font := FcFontMatch(config, pat, @mres);
+  if Assigned(font) then
+    begin
+    FFile:=nil;
+    res:=FC_FILE;
+    if (FcPatternGetString(font,PcChar(res),0,@ffile) = FcResultMatch) then
+      begin
+      if FFile<>'' then
+        List.Add(StrPas(ffile));
+      Result:=true;
+     end;
+    FcPatternDestroy(font);
+    end;
+  FcPatternDestroy(pat);
+end;
+{$define tfontmapper_find_implemented}
+{$endif}
+
+
+{$IF DEFINED(MSWINDOWS) or DEFINED(DARWIN)}
+Type
+
+  { TFontItem }
+
+  TFontItem = class
+    weight : integer;
+    name : UTF8String;
+    Constructor Create(aWeight : Integer; aName : UTF8String);
+  end;
+  TMatchList = array of TFontItem;
+
+  { TFontEnumerator }
+
+  TFontEnumerator = Record
+  public
+    family,fstyle:string;
+    lstyle: TStringDynArray;
+    matches: TFPObjectList;
+    procedure init;
+    procedure done;
+    procedure clear;
+    procedure AddDesc(const fi:TFontItem);
+    function MatchFont(const fdesc:utf8string):integer;
+    function get_lst(lst: TStrings):boolean;
+    procedure set_style(const str:string);
+    property style:string read fstyle write set_style;
+  end;
+
+{ TFontItem }
+
+constructor TFontItem.Create(aWeight: Integer; aName: UTF8String);
+begin
+  Weight:=aWeight;
+  Name:=aName;
+end;
+
+Procedure TFontEnumerator.init;
+begin
+  family:='';
+  fstyle:='';
+  lstyle:=[];
+  Matches:=TFPObjectList.Create(True);
+  Clear;
+end;
+
+procedure TFontEnumerator.done;
+begin
+  lstyle:=[];
+  FreeAndNil(matches);
+end;
+
+procedure TFontEnumerator.clear;
+
+begin
+  Matches.Clear;
+end;
+
+procedure TFontEnumerator.set_style(const str:string);
+begin
+  fstyle:=str;
+  if fstyle='' then fstyle:='normal regular';
+  lstyle:=SplitString(fstyle,' ');
+end;
+
+procedure TFontEnumerator.AddDesc(const fi:TFontItem);
+begin
+  matches.Add(fi);
+end;
+
+function TFontEnumerator.MatchFont(const fdesc:utf8string):integer;
+var
+  pn,i,pa:integer;
+  slfn,satt:string;
+begin
+  Result:=0;
+  pn:=pos(family,fdesc); // position of name
+  if pn=1 then
+    inc(Result,100)
+  else if pn>0 then
+    inc(Result,50)
+  else
+    exit;
+  satt:=copy(fdesc,pn+length(family)+1,length(fdesc));
+  slfn:=lowercase(satt);
+  if (pn=1) and (pos(style_regular,fstyle)>0) then
+    begin
+    if (satt='') then
+      exit;
+    end;
+  for i:=0 to high(lstyle) do
+    begin
+    pa:=pos(lstyle[i],slfn);
+    if pa>0 then
+      begin
+      delete(slfn,pa,length(lstyle[i]));
+      slfn:=trim(slfn);
+      inc(Result,50)
+      end
+    else
+      dec(result,10);
+  end;
+  // there is unmatched attrs
+  if length(slfn)>0 then
+     dec(result,10);
+
+  if Result>0 then
+    exit;
+  Result:=0;
+end;
+
+function CompareWeight(Left,Right : Pointer): Integer;
+begin
+  Result := (TFontItem(Right).weight - TFontItem(Left).weight);
+end;
+
+function TFontEnumerator.get_lst(lst:TStrings):boolean;
+var i:integer;
+begin
+  // sort
+  Result:=Matches.Count>0;
+  if not Result then exit;
+  Matches.Sort(@CompareWeight);
+  //QuickSort_PtrList_NoContext(PPointer(Matches),Matches),@CompareWeight);
+  for i:=0 to Matches.Count-1 do
+    lst.Add(TFontItem(matches[i]).name);
+end;
+{$ENDIF}
+
+{$IFDEF WINDOWS}
+class function TFontMapper.find(const family, style: string; list: TStrings): boolean;
+
+var
+  I: Integer;
+  reg: TRegistry;
+  enum : TFontEnumerator;
+  fpath :string;
+  FI : TFontItem;
+
+  procedure HandleValue(const AParam: UTF8String);
+
+  var
+    ptt,aweight:integer;
+    spar : UTF8String;
+
+
+  begin
+    Result:=true;
+    ptt:=pos(' (TrueType)',AParam);
+    if ptt<=0 then
+      exit;
+    spar:=copy(AParam,1,ptt-1);
+    aWeight:=Enum.MatchFont(spar);
+    if aWeight>0 then
+      enum.AddDesc(TFontItem.Create(aWeight,AParam));
+  end;
+
+  procedure ProcessValues;
+  var
+    n : Unicodestring;
+  begin
+    For N in reg.GetValueNames do
+      HandleValue(UTF8Encode(N));
+  end;
+
+begin
+  Result:=false;
+  enum:=Default(TFontEnumerator);
+  reg:=TRegistry.Create;
+  try
+    reg.RootKey:=HKEY_LOCAL_MACHINE;
+    reg.Access:=KEY_READ;
+    if not reg.OpenKey('Software\Microsoft\Windows NT\CurrentVersion\Fonts',false) then
+      exit;
+    enum.init;
+    enum.family:=family;
+    enum.style:=style;
+    ProcessValues;
+    if (enum.matches.Count=0) then // no matches
+      begin
+      enum.clear;
+      if (pos('Sans',enum.family)>0) then
+         enum.family:='Arial'
+      else if (pos('Mono',enum.family)>0) then
+         enum.family:='Courier New';
+      ProcessValues;
+      end;
+    if enum.matches.Count>0 then // there are matches
+      begin
+      fpath:=IncludeTrailingPathDelimiter(GetWinFontsDir);
+      for i:=enum.matches.Count-1 downto 0 do
+        begin
+        FI:=TFontItem(enum.matches[i]);
+        FI.name:=fpath+reg.ReadString(FI.name);
+        if not FileExists(FI.Name) then
+          Enum.matches.Delete(i)
+        end;
+      Result:=enum.get_lst(list);
+      end;
+  finally
+    enum.done;
+    reg.Free;
+  end;
+end;
+{$define tfontmapper_find_implemented}
+{$endif}
+
+{$ifdef DARWIN}
+class function TFontMapper.find(const family, style: string; list: TStrings): boolean;
+
+var
+  enum : TFontEnumerator;
+  procedure HandleValue(const AParam:string);
+
+  var
+    spar :string;
+    aweight : integer;
+
+  begin
+    Result:=true;
+    spar:=ChangeFileExt(ExtractFileName(AParam),'');
+    spar:=StringReplace(spar,'_',' ',[rfReplaceAll]);
+    aWeight:=Enum.MatchFont(spar);
+    if (aweight>0) then
+      enum.Matches.Add(TFontItem.Create(aWeight,AParam));
+  end;
+
+  Procedure DoDir(aDir : string);
+
+  var
+    sr : TSearchRec;
+  begin
+    if FindFirst(aDir+'*',faAnyFile,sr)=0 then
+      try
+        enum.family:=family;
+        enum.style:=style;
+        repeat
+           if (sr.Attr and faDirectory)=0 then
+             HandleValue(aDir+sr.Name);
+        until (FindNext(sr)<>0);
+      finally
+        FindClose(sr);
+      end;
+   end;
+
+const
+  syspath1 = '/System/Library/Fonts/Supplemental/';
+  syspath2 = '/System/Library/Fonts/';
+  syspath3 = '/Library/Fonts/';
+  syspath4 = '~/Library/Fonts/';
+
+
+begin
+  Result:=false;
+  enum:=Default(TFontEnumerator);
+  enum.init;
+  try
+    DoDir(SysPath1);
+    DoDir(SysPath2);
+    DoDir(SysPath3);
+    DoDir(ExpandFileName(SysPath4));
+    Result:=enum.get_lst(list);
+  finally
+    enum.done;
+  end;
+end;
+{$define tfontmapper_find_implemented}
+{$endif}
+
+{$ifndef tfontmapper_find_implemented}
+class function TFontMapper.find(const family, style: string; list: TStrings): boolean;
+begin
+  Result:=false;
+end;
+{$endif}
 
 initialization
   uFontCacheList := nil;
 
 finalization
   uFontCacheList.Free;
-
 end.
 
 

packages/fcl-process/src/dbugintf.pp

@@ -118,6 +118,8 @@ var
 Procedure WriteMessage(Const Msg : TDebugMessage);
 
 begin
+  if not Assigned(MsgBuffer) then
+    exit;
   MsgBuffer.Seek(0,soFrombeginning);
   WriteDebugMessageToStream(MsgBuffer,Msg);
   DebugClient.SendMessage(mtUnknown,MsgBuffer);
@@ -343,25 +345,25 @@ begin
   AlwaysDisplayPID:= ShowPID;
   DebugClient:=TSimpleIPCClient.Create(Nil);
   DebugClient.ServerID:=DebugServerID;
-  If not DebugClient.ServerRunning then
-    begin
-    ServerID:=StartDebugServer(ADebugServerExe,ARaiseExceptionOnSendError,ServerLogFileName);
-    if ServerID = 0 then
-      begin
-      DebugDisabled := True;
-      FreeAndNil(DebugClient);
-      Exit;
-      end
-    else
-      DebugDisabled := False;
-    I:=0;
-    While (I<100) and not DebugClient.ServerRunning do
+  try
+    If not DebugClient.ServerRunning then
       begin
-      Inc(I);
-      Sleep(100);
+      ServerID:=StartDebugServer(ADebugServerExe,ARaiseExceptionOnSendError,ServerLogFileName);
+      if ServerID = 0 then
+        begin
+        DebugDisabled := True;
+        FreeAndNil(DebugClient);
+        Exit;
+        end
+      else
+        DebugDisabled := False;
+      I:=0;
+      While (I<100) and not DebugClient.ServerRunning do
+        begin
+        Inc(I);
+        Sleep(100);
+        end;
       end;
-    end;
-  try
     DebugClient.Connect;
   except
     FreeAndNil(DebugClient);

packages/fcl-web/src/base/fphttpclient.pp

@@ -108,6 +108,8 @@ Type
     FAfterSocketHandlerCreated : TSocketHandlerCreatedEvent;
     FProxy : TProxyData;
     FVerifySSLCertificate: Boolean;
+    FCertCAFileName: String;
+    FTrustedCertsDir: String;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
     function GetCookies: TStrings;
@@ -358,6 +360,16 @@ Type
     Property KeepConnectionReconnectLimit: Integer Read FKeepConnectionReconnectLimit Write FKeepConnectionReconnectLimit;
     // SSL certificate validation.
     Property VerifySSLCertificate : Boolean Read FVerifySSLCertificate Write FVerifySSLCertificate;
+    // Certificate validation will only succeed if trusted CA certificates are known.
+    // These can be provided to the SSL library (e.g. OpenSSL, GnuTLS)
+    // in a file containing trusted certificates (e.g. PEM format file)
+    // or by providing a directory containing trusted certificates
+    // (e.g. /etc/ssl/certs on various Linux distributions).
+    // A file containing trusted certificates in PEM format can for example
+    // be created using the mk-ca-bundle script from the Curl project
+    // (https://curl.se/docs/mk-ca-bundle.html).
+    Property CertCAFileName : String Read FCertCAFileName Write FCertCAFileName;
+    Property TrustedCertsDir : String Read FTrustedCertsDir Write FTrustedCertsDir;
     // Called On redirect. Dest URL can be edited.
     // If The DEST url is empty on return, the method is aborted (with redirect status).
     Property OnRedirect : TRedirectEvent Read FOnRedirect Write FOnRedirect;
@@ -405,6 +417,8 @@ Type
     Property OnGetSocketHandler;
     Property Proxy;
     Property VerifySSLCertificate;
+    Property CertCAFileName;
+    Property TrustedCertsDir;
     Property AfterSocketHandlerCreate;
     Property OnVerifySSLCertificate;
 
@@ -669,6 +683,8 @@ begin
       SSLHandler:=TSSLSocketHandler.GetDefaultHandler;
       SSLHandler.VerifyPeerCert:=FVerifySSLCertificate;
       SSLHandler.OnVerifyCertificate:=@DoVerifyCertificate;
+      SSLHandler.CertificateData.CertCA.FileName:=FCertCAFileName;
+      SSLHandler.CertificateData.TrustedCertsDir:=FTrustedCertsDir;
       Result:=SSLHandler;
       end
     else

packages/fcl-xml/src/dom.pp

@@ -522,6 +522,8 @@ type
     // Extensions to DOM interface:
     constructor Create; virtual;
     destructor Destroy; override;
+    procedure RebuildIDsOfElement(aRoot: TDOMElement);
+    procedure RebuildIDList;
     function CloneNode(deep: Boolean): TDOMNode; overload; override;
     property Names: THashTable read FNames;
     property IDs: THashTable read FIDList write FIDList;
@@ -2261,6 +2263,43 @@ begin
                          // (because children reference the nametable)
 end;
 
+procedure TDOMDocument.RebuildIDsOfElement(aRoot: TDOMElement);
+var
+  i: Integer;
+  AttribNode: TDOMNode;
+  id: DOMString;
+  Item: PHashItem;
+begin
+  if aRoot=Nil then 
+    exit;
+  for i := 0 to aRoot.Attributes.Length - 1 do
+  begin
+    AttribNode := aRoot.Attributes.Item[i];
+    if LowerCase(AttribNode.NodeName) = 'id' then
+    begin
+      id := AttribNode.TextContent;
+      Item := FIDList.FindOrAdd(PWideChar(id), Length(id));
+      Item^.Data := aRoot;
+      break;
+    end;
+  end;
+
+  for i := 0 to aRoot.ChildNodes.Count - 1 do
+  begin
+    if aroot.ChildNodes[i] is TDOMElement then
+      RebuildIDsOfElement(TDOMElement(aroot.ChildNodes[i]));
+  end;
+end;
+
+procedure TDOMDocument.RebuildIDList;
+begin
+  if not Assigned(FIDList) then
+    FIDList := THashTable.Create(256, False);
+  FIDList.Clear;
+  RebuildIDsOfElement(Self.DocumentElement);
+end;    
+
+
 function TDOMDocument.CloneNode(deep: Boolean): TDOMNode;
 type
   TDOMDocumentClass = class of TDOMDocument;

packages/fcl-xml/src/sax_html.pp

@@ -114,6 +114,7 @@ type
     constructor Create(AReader: THTMLReader; ADocument: TDOMDocument);
     constructor CreateFragment(AReader: THTMLReader; AFragmentRoot: TDOMNode);
     destructor Destroy; override;
+    Property Document : TDOMDocument Read FDocument;
   end;
 
 
@@ -781,6 +782,7 @@ begin
     Converter := THTMLToDOMConverter.Create(Reader, ADoc);
     try
       Reader.ParseStream(f);
+      Converter.Document.RebuildIDList;
     finally
       Converter.Free;
     end;
@@ -811,6 +813,10 @@ begin
     Converter := THTMLToDOMConverter.CreateFragment(Reader, AParentNode);
     try
       Reader.ParseStream(f);
+      if aParentNode is TDOMElement then
+        Converter.Document.RebuildIDsOfElement(aParentNode as TDOMElement)
+      else
+        Converter.Document.RebuildIDList;
     finally
       Converter.Free;
     end;

packages/fpmkunit/src/fpmkunit.pp

@@ -7415,6 +7415,13 @@ begin
       exit;
     end;
   DD:=FileAge(Dest);
+  { Return true if dest file not found or not accessible }
+  if DD=-1 then
+    begin
+      Result:=True;
+      exit;
+    end;
+
   D1:=FileDateToDateTime(DS);
   D2:=FileDateToDateTime(DD);
   Log(vlDebug,SDbgComparingFileTimes,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);

packages/hash/examples/md5performancetest.pas

@@ -15,6 +15,7 @@ var
   StartTime: TDateTime;
   EndTime: TDateTime;
   i: integer;
+  TimeTaken: string;
   s,ss: RawByteString;
 begin
   writeln('MD5 of a million "a" symbols');
@@ -27,6 +28,7 @@ begin
     ss := LowerCase(MDPrint(MDString(s, MD_VERSION_5)));
   EndTime:=now;
   writeln('Performance test finished. Elapsed time:');
-  writeln(TimeToStr(EndTime-StartTime));
+  DateTimeToString(TimeTaken, 'S.ZZ', EndTime-StartTime);
+  WriteLn('Average time taken = ', TimeTaken, ' ms');
 end.
 

packages/hash/fpmake.pp

@@ -32,7 +32,7 @@ begin
 
     P.Version:='3.3.1';
     T:=P.Targets.AddUnit('src/md5.pp');
-    T.Dependencies.AddInclude('src/md5i386.inc', [i386], AllOSes-[darwin]);
+    T.Dependencies.AddInclude('src/md5i386.inc', [i386], AllOSes);
     T:=P.Targets.AddUnit('src/sha1.pp');
     T.Dependencies.AddInclude('src/sha1i386.inc', [i386], AllOSes);
     T:=P.Targets.AddUnit('src/crc.pas');
@@ -43,8 +43,6 @@ begin
     
     T.OSes:=[Linux];
     T:=P.Targets.AddExampleunit('examples/mdtest.pas');
-    T:=P.Targets.AddExampleunit('examples/crctest.pas');
-    T:=P.Targets.AddExampleunit('examples/sha1test.pp');
     T:=P.Targets.AddExampleunit('examples/hmd5.pp');
     T:=P.Targets.AddExampleunit('examples/hsha1.pp');
     T:=P.Targets.AddExampleunit('examples/md5performancetest.pas');

packages/hash/src/md5.pp

@@ -42,12 +42,9 @@ These notices must be retained in any copies of any part of this
 documentation and/or software.
 }
 
-// Define to use original MD5 code on i386 processors.
-// Undefine to use original implementation.
-{ the assembler implementation does not work on Darwin }
-{$ifdef darwin}
-{$DEFINE MD5PASCAL}
-{$endif darwin}
+// Normally, if an optimized version is available for OS/CPU, that will be used
+// Define to use generic implementation
+{ $DEFINE MD5PASCAL}
 
 {$IFNDEF FPC_DOTTEDUNITS}
 unit md5;
@@ -341,21 +338,40 @@ begin
 end;
 
 
-{$IF (NOT(DEFINED(MD5PASCAL))) and (DEFINED(CPUI386)) }
-{$i md5i386.inc}
-{$ENDIF}
-{$IF (NOT(DEFINED(MD5PASCAL))) and (DEFINED(CPUX86_64)) }
-{$OPTIMIZATION USERBP} //PEEPHOLE
+// Use assembler version if we have a suitable CPU as well
+// Define MD5PASCAL to force use of original reference code
+{$ifndef MD5PASCAL}
+  {$if defined(CPU386)}
+    {$i md5i386.inc}
+    {$define MD5ASM}
+  {$elseif defined(CPUX64)}
+    {$ifdef MSWINDOWS}
+      // Microsoft Windows uses a different calling convention to the System V ABI
+      {$i md5x64_win.inc}
+      {$define MD5ASM}
+    {$else}
+      {$i md5x64_sysv.inc}
+      {$define MD5ASM}
+    {$endif MSWINDOWS}
+  {$endif}
+{$endif not MD5PASCAL}
+
+{$if not defined(MD5ASM)}
+// Pascal version
 procedure MD5Transform(var Context: TMDContext; Buffer: Pointer);
-type
-  TBlock = array[0..15] of Cardinal;
-  PBlock = ^TBlock;
 var
   a, b, c, d: Cardinal;
-  //Block: array[0..15] of Cardinal absolute Buffer;
-  Block: PBlock absolute Buffer;
+{$if defined(endian_little) and not defined(fpc_requires_proper_alignment)}
+  Block: PCardinal absolute Buffer;
+{$else}
+  Block: array[0..15] of Cardinal;
+{$endif}
 begin
-  //Invert(Buffer, @Block, 64);
+{$if not defined(endian_little)}
+  Invert(Buffer, @Block, 64);
+{$elseif defined(fpc_requires_proper_alignment)}
+  Move(Buffer^, Block, 64);
+{$endif}
   a := Context.State[0];
   b := Context.State[1];
   c := Context.State[2];
@@ -365,153 +381,74 @@ begin
 {$r-,q-}
 
   // Round 1
-  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block^[0]  + $d76aa478),  7);
-  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block^[1]  + $e8c7b756), 12);
-  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block^[2]  + $242070db), 17);
-  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block^[3]  + $c1bdceee), 22);
-  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block^[4]  + $f57c0faf),  7);
-  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block^[5]  + $4787c62a), 12);
-  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block^[6]  + $a8304613), 17);
-  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block^[7]  + $fd469501), 22);
-  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block^[8]  + $698098d8),  7);
-  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block^[9]  + $8b44f7af), 12);
-  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block^[10] + $ffff5bb1), 17);
-  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block^[11] + $895cd7be), 22);
-  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block^[12] + $6b901122),  7);
-  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block^[13] + $fd987193), 12);
-  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block^[14] + $a679438e), 17);
-  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block^[15] + $49b40821), 22);
-  // Round 2
-  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block^[1]  + $f61e2562),  5);
-  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block^[6]  + $c040b340),  9);
-  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block^[11] + $265e5a51), 14);
-  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block^[0]  + $e9b6c7aa), 20);
-  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block^[5]  + $d62f105d),  5);
-  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block^[10] + $02441453),  9);
-  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block^[15] + $d8a1e681), 14);
-  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block^[4]  + $e7d3fbc8), 20);
-  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block^[9]  + $21e1cde6),  5);
-  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block^[14] + $c33707d6),  9);
-  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block^[3]  + $f4d50d87), 14);
-  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block^[8]  + $455a14ed), 20);
-  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block^[13] + $a9e3e905),  5);
-  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block^[2]  + $fcefa3f8),  9);
-  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block^[7]  + $676f02d9), 14);
-  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block^[12] + $8d2a4c8a), 20);
-  // Round 3
-  a := b + roldword(dword(a + (b xor c xor d) + Block^[5]  + $fffa3942),  4);
-  d := a + roldword(dword(d + (a xor b xor c) + Block^[8]  + $8771f681), 11);
-  c := d + roldword(dword(c + (d xor a xor b) + Block^[11] + $6d9d6122), 16);
-  b := c + roldword(dword(b + (c xor d xor a) + Block^[14] + $fde5380c), 23);
-  a := b + roldword(dword(a + (b xor c xor d) + Block^[1]  + $a4beea44),  4);
-  d := a + roldword(dword(d + (a xor b xor c) + Block^[4]  + $4bdecfa9), 11);
-  c := d + roldword(dword(c + (d xor a xor b) + Block^[7]  + $f6bb4b60), 16);
-  b := c + roldword(dword(b + (c xor d xor a) + Block^[10] + $bebfbc70), 23);
-  a := b + roldword(dword(a + (b xor c xor d) + Block^[13] + $289b7ec6),  4);
-  d := a + roldword(dword(d + (a xor b xor c) + Block^[0]  + $eaa127fa), 11);
-  c := d + roldword(dword(c + (d xor a xor b) + Block^[3]  + $d4ef3085), 16);
-  b := c + roldword(dword(b + (c xor d xor a) + Block^[6]  + $04881d05), 23);
-  a := b + roldword(dword(a + (b xor c xor d) + Block^[9]  + $d9d4d039),  4);
-  d := a + roldword(dword(d + (a xor b xor c) + Block^[12] + $e6db99e5), 11);
-  c := d + roldword(dword(c + (d xor a xor b) + Block^[15] + $1fa27cf8), 16);
-  b := c + roldword(dword(b + (c xor d xor a) + Block^[2]  + $c4ac5665), 23);
-  // Round 4
-  a := b + roldword(dword(a + (c xor (b or (not d))) + Block^[0]  + $f4292244),  6);
-  d := a + roldword(dword(d + (b xor (a or (not c))) + Block^[7]  + $432aff97), 10);
-  c := d + roldword(dword(c + (a xor (d or (not b))) + Block^[14] + $ab9423a7), 15);
-  b := c + roldword(dword(b + (d xor (c or (not a))) + Block^[5]  + $fc93a039), 21);
-  a := b + roldword(dword(a + (c xor (b or (not d))) + Block^[12] + $655b59c3),  6);
-  d := a + roldword(dword(d + (b xor (a or (not c))) + Block^[3]  + $8f0ccc92), 10);
-  c := d + roldword(dword(c + (a xor (d or (not b))) + Block^[10] + $ffeff47d), 15);
-  b := c + roldword(dword(b + (d xor (c or (not a))) + Block^[1]  + $85845dd1), 21);
-  a := b + roldword(dword(a + (c xor (b or (not d))) + Block^[8]  + $6fa87e4f),  6);
-  d := a + roldword(dword(d + (b xor (a or (not c))) + Block^[15] + $fe2ce6e0), 10);
-  c := d + roldword(dword(c + (a xor (d or (not b))) + Block^[6]  + $a3014314), 15);
-  b := c + roldword(dword(b + (d xor (c or (not a))) + Block^[13] + $4e0811a1), 21);
-  a := b + roldword(dword(a + (c xor (b or (not d))) + Block^[4]  + $f7537e82),  6);
-  d := a + roldword(dword(d + (b xor (a or (not c))) + Block^[11] + $bd3af235), 10);
-  c := d + roldword(dword(c + (a xor (d or (not b))) + Block^[2]  + $2ad7d2bb), 15);
-  b := c + roldword(dword(b + (d xor (c or (not a))) + Block^[9]  + $eb86d391), 21);
-
-
-  inc(Context.State[0],a);
-  inc(Context.State[1],b);
-  inc(Context.State[2],c);
-  inc(Context.State[3],d);
-{$pop}
-  inc(Context.Length,64);
-end;
-{$OPTIMIZATION DEFAULT}
-{$ENDIF}
-{$IF DEFINED(MD5PASCAL) or (NOT ((DEFINED(CPUX86_64)) or (DEFINED(CPUI386))))}
-// Original version
-procedure MD5Transform(var Context: TMDContext; Buffer: Pointer);
-
-{$push}
-{$r-,q-}
-
-  procedure R1(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal);
-  // F(x,y,z) = (x and y) or ((not x) and z)
-  begin
-    a := b + roldword(dword(a + {F(b,c,d)}((b and c) or ((not b) and d)) + x + ac), s);
-  end;
-
-  procedure R2(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal);
-  // G(x,y,z) = (x and z) or (y and (not z))
-  begin
-    a := b + roldword(dword(a + {G(b,c,d)}((b and d) or (c and (not d))) + x + ac), s);
-  end;
-
-  procedure R3(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal);
-  // H(x,y,z) = x xor y xor z;
-  begin
-    a := b + roldword(dword(a + {H(b,c,d)}(b xor c xor d) + x + ac), s);
-  end;
-
-  procedure R4(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal);
-  // I(x,y,z) = y xor (x or (not z));
-  begin
-    a := b + roldword(dword(a + {I(b,c,d)}(c xor (b or (not d))) + x + ac), s);
-  end;
-
-{$pop}
-
-var
-  a, b, c, d: Cardinal;
-  Block: array[0..15] of Cardinal;
-begin
-  Invert(Buffer, @Block, 64);
-  a := Context.State[0];
-  b := Context.State[1];
-  c := Context.State[2];
-  d := Context.State[3];
-
-  // Round 1
-  R1(a,b,c,d,Block[0] , 7,$d76aa478); R1(d,a,b,c,Block[1] ,12,$e8c7b756); R1(c,d,a,b,Block[2] ,17,$242070db); R1(b,c,d,a,Block[3] ,22,$c1bdceee);
-  R1(a,b,c,d,Block[4] , 7,$f57c0faf); R1(d,a,b,c,Block[5] ,12,$4787c62a); R1(c,d,a,b,Block[6] ,17,$a8304613); R1(b,c,d,a,Block[7] ,22,$fd469501);
-  R1(a,b,c,d,Block[8] , 7,$698098d8); R1(d,a,b,c,Block[9] ,12,$8b44f7af); R1(c,d,a,b,Block[10],17,$ffff5bb1); R1(b,c,d,a,Block[11],22,$895cd7be);
-  R1(a,b,c,d,Block[12], 7,$6b901122); R1(d,a,b,c,Block[13],12,$fd987193); R1(c,d,a,b,Block[14],17,$a679438e); R1(b,c,d,a,Block[15],22,$49b40821);
-
+  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block[0]  + $d76aa478),  7);
+  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block[1]  + $e8c7b756), 12);
+  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block[2]  + $242070db), 17);
+  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block[3]  + $c1bdceee), 22);
+  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block[4]  + $f57c0faf),  7);
+  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block[5]  + $4787c62a), 12);
+  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block[6]  + $a8304613), 17);
+  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block[7]  + $fd469501), 22);
+  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block[8]  + $698098d8),  7);
+  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block[9]  + $8b44f7af), 12);
+  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block[10] + $ffff5bb1), 17);
+  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block[11] + $895cd7be), 22);
+  a := b + roldword(dword(a + ((b and c) or ((not b) and d)) + Block[12] + $6b901122),  7);
+  d := a + roldword(dword(d + ((a and b) or ((not a) and c)) + Block[13] + $fd987193), 12);
+  c := d + roldword(dword(c + ((d and a) or ((not d) and b)) + Block[14] + $a679438e), 17);
+  b := c + roldword(dword(b + ((c and d) or ((not c) and a)) + Block[15] + $49b40821), 22);
   // Round 2
-  R2(a,b,c,d,Block[1] , 5,$f61e2562); R2(d,a,b,c,Block[6] , 9,$c040b340); R2(c,d,a,b,Block[11],14,$265e5a51); R2(b,c,d,a,Block[0] ,20,$e9b6c7aa);
-  R2(a,b,c,d,Block[5] , 5,$d62f105d); R2(d,a,b,c,Block[10], 9,$02441453); R2(c,d,a,b,Block[15],14,$d8a1e681); R2(b,c,d,a,Block[4] ,20,$e7d3fbc8);
-  R2(a,b,c,d,Block[9] , 5,$21e1cde6); R2(d,a,b,c,Block[14], 9,$c33707d6); R2(c,d,a,b,Block[3] ,14,$f4d50d87); R2(b,c,d,a,Block[8] ,20,$455a14ed);
-  R2(a,b,c,d,Block[13], 5,$a9e3e905); R2(d,a,b,c,Block[2] , 9,$fcefa3f8); R2(c,d,a,b,Block[7] ,14,$676f02d9); R2(b,c,d,a,Block[12],20,$8d2a4c8a);
-
+  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block[1]  + $f61e2562),  5);
+  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block[6]  + $c040b340),  9);
+  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block[11] + $265e5a51), 14);
+  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block[0]  + $e9b6c7aa), 20);
+  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block[5]  + $d62f105d),  5);
+  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block[10] + $02441453),  9);
+  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block[15] + $d8a1e681), 14);
+  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block[4]  + $e7d3fbc8), 20);
+  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block[9]  + $21e1cde6),  5);
+  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block[14] + $c33707d6),  9);
+  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block[3]  + $f4d50d87), 14);
+  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block[8]  + $455a14ed), 20);
+  a := b + roldword(dword(a + ((b and d) or (c and (not d))) + Block[13] + $a9e3e905),  5);
+  d := a + roldword(dword(d + ((a and c) or (b and (not c))) + Block[2]  + $fcefa3f8),  9);
+  c := d + roldword(dword(c + ((d and b) or (a and (not b))) + Block[7]  + $676f02d9), 14);
+  b := c + roldword(dword(b + ((c and a) or (d and (not a))) + Block[12] + $8d2a4c8a), 20);
   // Round 3
-  R3(a,b,c,d,Block[5] , 4,$fffa3942); R3(d,a,b,c,Block[8] ,11,$8771f681); R3(c,d,a,b,Block[11],16,$6d9d6122); R3(b,c,d,a,Block[14],23,$fde5380c);
-  R3(a,b,c,d,Block[1] , 4,$a4beea44); R3(d,a,b,c,Block[4] ,11,$4bdecfa9); R3(c,d,a,b,Block[7] ,16,$f6bb4b60); R3(b,c,d,a,Block[10],23,$bebfbc70);
-  R3(a,b,c,d,Block[13], 4,$289b7ec6); R3(d,a,b,c,Block[0] ,11,$eaa127fa); R3(c,d,a,b,Block[3] ,16,$d4ef3085); R3(b,c,d,a,Block[6] ,23,$04881d05);
-  R3(a,b,c,d,Block[9] , 4,$d9d4d039); R3(d,a,b,c,Block[12],11,$e6db99e5); R3(c,d,a,b,Block[15],16,$1fa27cf8); R3(b,c,d,a,Block[2] ,23,$c4ac5665);
-
+  a := b + roldword(dword(a + (b xor c xor d) + Block[5]  + $fffa3942),  4);
+  d := a + roldword(dword(d + (a xor b xor c) + Block[8]  + $8771f681), 11);
+  c := d + roldword(dword(c + (d xor a xor b) + Block[11] + $6d9d6122), 16);
+  b := c + roldword(dword(b + (c xor d xor a) + Block[14] + $fde5380c), 23);
+  a := b + roldword(dword(a + (b xor c xor d) + Block[1]  + $a4beea44),  4);
+  d := a + roldword(dword(d + (a xor b xor c) + Block[4]  + $4bdecfa9), 11);
+  c := d + roldword(dword(c + (d xor a xor b) + Block[7]  + $f6bb4b60), 16);
+  b := c + roldword(dword(b + (c xor d xor a) + Block[10] + $bebfbc70), 23);
+  a := b + roldword(dword(a + (b xor c xor d) + Block[13] + $289b7ec6),  4);
+  d := a + roldword(dword(d + (a xor b xor c) + Block[0]  + $eaa127fa), 11);
+  c := d + roldword(dword(c + (d xor a xor b) + Block[3]  + $d4ef3085), 16);
+  b := c + roldword(dword(b + (c xor d xor a) + Block[6]  + $04881d05), 23);
+  a := b + roldword(dword(a + (b xor c xor d) + Block[9]  + $d9d4d039),  4);
+  d := a + roldword(dword(d + (a xor b xor c) + Block[12] + $e6db99e5), 11);
+  c := d + roldword(dword(c + (d xor a xor b) + Block[15] + $1fa27cf8), 16);
+  b := c + roldword(dword(b + (c xor d xor a) + Block[2]  + $c4ac5665), 23);
   // Round 4
-  R4(a,b,c,d,Block[0] , 6,$f4292244); R4(d,a,b,c,Block[7] ,10,$432aff97); R4(c,d,a,b,Block[14],15,$ab9423a7); R4(b,c,d,a,Block[5] ,21,$fc93a039);
-  R4(a,b,c,d,Block[12], 6,$655b59c3); R4(d,a,b,c,Block[3] ,10,$8f0ccc92); R4(c,d,a,b,Block[10],15,$ffeff47d); R4(b,c,d,a,Block[1] ,21,$85845dd1);
-  R4(a,b,c,d,Block[8] , 6,$6fa87e4f); R4(d,a,b,c,Block[15],10,$fe2ce6e0); R4(c,d,a,b,Block[6] ,15,$a3014314); R4(b,c,d,a,Block[13],21,$4e0811a1);
-  R4(a,b,c,d,Block[4] , 6,$f7537e82); R4(d,a,b,c,Block[11],10,$bd3af235); R4(c,d,a,b,Block[2] ,15,$2ad7d2bb); R4(b,c,d,a,Block[9] ,21,$eb86d391);
+  a := b + roldword(dword(a + (c xor (b or (not d))) + Block[0]  + $f4292244),  6);
+  d := a + roldword(dword(d + (b xor (a or (not c))) + Block[7]  + $432aff97), 10);
+  c := d + roldword(dword(c + (a xor (d or (not b))) + Block[14] + $ab9423a7), 15);
+  b := c + roldword(dword(b + (d xor (c or (not a))) + Block[5]  + $fc93a039), 21);
+  a := b + roldword(dword(a + (c xor (b or (not d))) + Block[12] + $655b59c3),  6);
+  d := a + roldword(dword(d + (b xor (a or (not c))) + Block[3]  + $8f0ccc92), 10);
+  c := d + roldword(dword(c + (a xor (d or (not b))) + Block[10] + $ffeff47d), 15);
+  b := c + roldword(dword(b + (d xor (c or (not a))) + Block[1]  + $85845dd1), 21);
+  a := b + roldword(dword(a + (c xor (b or (not d))) + Block[8]  + $6fa87e4f),  6);
+  d := a + roldword(dword(d + (b xor (a or (not c))) + Block[15] + $fe2ce6e0), 10);
+  c := d + roldword(dword(c + (a xor (d or (not b))) + Block[6]  + $a3014314), 15);
+  b := c + roldword(dword(b + (d xor (c or (not a))) + Block[13] + $4e0811a1), 21);
+  a := b + roldword(dword(a + (c xor (b or (not d))) + Block[4]  + $f7537e82),  6);
+  d := a + roldword(dword(d + (b xor (a or (not c))) + Block[11] + $bd3af235), 10);
+  c := d + roldword(dword(c + (a xor (d or (not b))) + Block[2]  + $2ad7d2bb), 15);
+  b := c + roldword(dword(b + (d xor (c or (not a))) + Block[9]  + $eb86d391), 21);
 
-{$push}
-{$r-,q-}
   inc(Context.State[0],a);
   inc(Context.State[1],b);
   inc(Context.State[2],c);
@@ -519,8 +456,7 @@ begin
 {$pop}
   inc(Context.Length,64);
 end;
-{$ENDIF}
-
+{$ENDIF MD5ASM}
 
 procedure MDInit(out Context: TMDContext; const Version: TMDVersion);
 begin

packages/hash/src/md5i386.inc

@@ -1,747 +1,721 @@
 // i386 assembler optimized version
-procedure MD5Transform(var Context: TMDContext; Buffer: Pointer);assembler;
-var
-  pContext: ^TMDContext;
-  pBuffer: Pointer;
-  a, b, c, d: Cardinal;
-  //Block: array[0..15] of Cardinal;
+procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); assembler; nostackframe;
+// eax = Context, edx = Buffer
 {$asmmode intel}
 asm
-    push EAX
     push EBX
-    push ECX
-    push EDX
     push ESI
     push EDI
-    push EBP
-
-    mov pContext, eax
-    mov pBuffer, edx
-
-    mov ESI, pContext
-    mov ebp, edx
-
-// A := Context.State[0];
-    mov EAX, [ESI+12+4*0]
-// B := Context.State[1];
-    mov EBX, [ESI+12+4*1]
-// C := Context.State[2];
-    mov ECX, [ESI+12+4*2]
-// D := Context.State[3];
-    mov EDX, [ESI+12+4*3]
+    push EAX // save Context
+
+    // EBX = A, ECX = B, ESI = C, EDI = D
+    mov EBX, TMDContext.State[EAX + 4*0] // A, B, C, D := Context.State[0 .. 3];
+    mov ECX, TMDContext.State[EAX + 4*1]
+    mov ESI, TMDContext.State[EAX + 4*2]
+    mov EDI, TMDContext.State[EAX + 4*3] // From now on, EAX is used as a temporary.
 // Round 1
-//EAX := EBX + roldword(dword(EAX + ((EBX and ECX) or ((not EBX) and EDX)) + Data[0] + $d76aa478),  7);
-    mov ESI, ECX
-    add EAX, $d76aa478
-    xor ESI, EDX
-    add EAX, [ebp + 4*0]
-    and ESI, EBX
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  7
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and EBX) or ((not EAX) and ECX)) + Data[1] + $e8c7b756), 12);
-    mov ESI, EBX
-    add EDX, $e8c7b756
-    xor ESI, ECX
-    add EDX, [ebp + 4*1]
-    and ESI, EAX
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 12
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EAX) or ((not EDX) and EBX)) + Data[2] + $242070db), 17);
-    mov ESI, EAX
-    add ECX, $242070db
-    xor ESI, EBX
-    add ECX, [ebp + 4*2]
-    and ESI, EDX
-    xor ESI, EBX
-    add ECX, ESI
-    rol ECX, 17
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EDX) or ((not ECX) and EAX)) + Data[3] + $c1bdceee), 22);
-    mov ESI, EDX
-    add EBX, $c1bdceee
-    xor ESI, EAX
-    add EBX, [ebp + 4*3]
-    and ESI, ECX
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 22
+//EBX := ECX + roldword(dword(EBX + ((ECX and ESI) or ((not ECX) and EDI)) + Data[0] + $d76aa478),  7);
+    mov EAX, ESI
+    add EBX, $d76aa478
+    xor EAX, EDI
+    add EBX, [EDX + 4*0]
+    and EAX, ECX
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  7
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + ((EBX and ECX) or ((not EBX) and EDX)) + Data[4] + $f57c0faf),  7);
-    mov ESI, ECX
-    add EAX, $f57c0faf
-    xor ESI, EDX
-    add EAX, [ebp + 4*4]
-    and ESI, EBX
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  7
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and EBX) or ((not EAX) and ECX)) + Data[5] + $4787c62a), 12);
-    mov ESI, EBX
-    add EDX, $4787c62a
-    xor ESI, ECX
-    add EDX, [ebp + 4*5]
-    and ESI, EAX
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 12
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EAX) or ((not EDX) and EBX)) + Data[6] + $a8304613), 17);
-    mov ESI, EAX
-    add ECX, $a8304613
-    xor ESI, EBX
-    add ECX, [ebp + 4*6]
-    and ESI, EDX
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ECX) or ((not EBX) and ESI)) + Data[1] + $e8c7b756), 12);
+    mov EAX, ECX
+    add EDI, $e8c7b756
+    xor EAX, ESI
+    add EDI, [EDX + 4*1]
+    and EAX, EBX
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 12
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and EBX) or ((not EDI) and ECX)) + Data[2] + $242070db), 17);
+    mov EAX, EBX
+    add ESI, $242070db
+    xor EAX, ECX
+    add ESI, [EDX + 4*2]
+    and EAX, EDI
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 17
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EDI) or ((not ESI) and EBX)) + Data[3] + $c1bdceee), 22);
+    mov EAX, EDI
+    add ECX, $c1bdceee
+    xor EAX, EBX
+    add ECX, [EDX + 4*3]
+    and EAX, ESI
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 22
     add ECX, ESI
-    rol ECX, 17
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EDX) or ((not ECX) and EAX)) + Data[7] + $fd469501), 22);
-    mov ESI, EDX
-    add EBX, $fd469501
-    xor ESI, EAX
-    add EBX, [ebp + 4*7]
-    and ESI, ECX
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 22
+
+//EBX := ECX + roldword(dword(EBX + ((ECX and ESI) or ((not ECX) and EDI)) + Data[4] + $f57c0faf),  7);
+    mov EAX, ESI
+    add EBX, $f57c0faf
+    xor EAX, EDI
+    add EBX, [EDX + 4*4]
+    and EAX, ECX
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  7
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + ((EBX and ECX) or ((not EBX) and EDX)) + Data[8] + $698098d8),  7);
-    mov ESI, ECX
-    add EAX, $698098d8
-    xor ESI, EDX
-    add EAX, [ebp + 4*8]
-    and ESI, EBX
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  7
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and EBX) or ((not EAX) and ECX)) + Data[9] + $8b44f7af), 12);
-    mov ESI, EBX
-    add EDX, $8b44f7af
-    xor ESI, ECX
-    add EDX, [ebp + 4*9]
-    and ESI, EAX
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 12
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EAX) or ((not EDX) and EBX)) + Data[10] + $ffff5bb1), 17);
-    mov ESI, EAX
-    add ECX, $ffff5bb1
-    xor ESI, EBX
-    add ECX, [ebp + 4*10]
-    and ESI, EDX
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ECX) or ((not EBX) and ESI)) + Data[5] + $4787c62a), 12);
+    mov EAX, ECX
+    add EDI, $4787c62a
+    xor EAX, ESI
+    add EDI, [EDX + 4*5]
+    and EAX, EBX
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 12
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and EBX) or ((not EDI) and ECX)) + Data[6] + $a8304613), 17);
+    mov EAX, EBX
+    add ESI, $a8304613
+    xor EAX, ECX
+    add ESI, [EDX + 4*6]
+    and EAX, EDI
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 17
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EDI) or ((not ESI) and EBX)) + Data[7] + $fd469501), 22);
+    mov EAX, EDI
+    add ECX, $fd469501
+    xor EAX, EBX
+    add ECX, [EDX + 4*7]
+    and EAX, ESI
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 22
     add ECX, ESI
-    rol ECX, 17
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EDX) or ((not ECX) and EAX)) + Data[11] + $895cd7be), 22);
-    mov ESI, EDX
-    add EBX, $895cd7be
-    xor ESI, EAX
-    add EBX, [ebp + 4*11]
-    and ESI, ECX
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 22
+
+//EBX := ECX + roldword(dword(EBX + ((ECX and ESI) or ((not ECX) and EDI)) + Data[8] + $698098d8),  7);
+    mov EAX, ESI
+    add EBX, $698098d8
+    xor EAX, EDI
+    add EBX, [EDX + 4*8]
+    and EAX, ECX
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  7
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + ((EBX and ECX) or ((not EBX) and EDX)) + Data[12] + $6b901122),  7);
-    mov ESI, ECX
-    add EAX, $6b901122
-    xor ESI, EDX
-    add EAX, [ebp + 4*12]
-    and ESI, EBX
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  7
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and EBX) or ((not EAX) and ECX)) + Data[13] + $fd987193), 12);
-    mov ESI, EBX
-    add EDX, $fd987193
-    xor ESI, ECX
-    add EDX, [ebp + 4*13]
-    and ESI, EAX
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 12
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EAX) or ((not EDX) and EBX)) + Data[14] + $a679438e), 17);
-    mov ESI, EAX
-    add ECX, $a679438e
-    xor ESI, EBX
-    add ECX, [ebp + 4*14]
-    and ESI, EDX
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ECX) or ((not EBX) and ESI)) + Data[9] + $8b44f7af), 12);
+    mov EAX, ECX
+    add EDI, $8b44f7af
+    xor EAX, ESI
+    add EDI, [EDX + 4*9]
+    and EAX, EBX
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 12
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and EBX) or ((not EDI) and ECX)) + Data[10] + $ffff5bb1), 17);
+    mov EAX, EBX
+    add ESI, $ffff5bb1
+    xor EAX, ECX
+    add ESI, [EDX + 4*10]
+    and EAX, EDI
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 17
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EDI) or ((not ESI) and EBX)) + Data[11] + $895cd7be), 22);
+    mov EAX, EDI
+    add ECX, $895cd7be
+    xor EAX, EBX
+    add ECX, [EDX + 4*11]
+    and EAX, ESI
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 22
     add ECX, ESI
-    rol ECX, 17
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EDX) or ((not ECX) and EAX)) + Data[15] + $49b40821), 22);
-    mov ESI, EDX
-    add EBX, $49b40821
-    xor ESI, EAX
-    add EBX, [ebp + 4*15]
-    and ESI, ECX
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 22
+
+//EBX := ECX + roldword(dword(EBX + ((ECX and ESI) or ((not ECX) and EDI)) + Data[12] + $6b901122),  7);
+    mov EAX, ESI
+    add EBX, $6b901122
+    xor EAX, EDI
+    add EBX, [EDX + 4*12]
+    and EAX, ECX
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  7
     add EBX, ECX
 
-// Round 2
-//EAX := EBX + roldword(dword(EAX + ((EBX and EDX) or (ECX and (not EDX))) + Data[1] + $f61e2562),  5);
-    mov ESI, EBX
-    add EAX, $f61e2562
-    xor ESI, ECX
-    add EAX, [ebp + 4*1]
-    and ESI, EDX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  5
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and ECX) or (EBX and (not ECX))) + Data[6] + $c040b340),  9);
-    mov ESI, EAX
-    add EDX, $c040b340
-    xor ESI, EBX
-    add EDX, [ebp + 4*6]
-    and ESI, ECX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX,  9
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EBX) or (EAX and (not EBX))) + Data[11] + $265e5a51), 14);
-    mov ESI, EDX
-    add ECX, $265e5a51
-    xor ESI, EAX
-    add ECX, [ebp + 4*11]
-    and ESI, EBX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ECX) or ((not EBX) and ESI)) + Data[13] + $fd987193), 12);
+    mov EAX, ECX
+    add EDI, $fd987193
+    xor EAX, ESI
+    add EDI, [EDX + 4*13]
+    and EAX, EBX
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 12
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and EBX) or ((not EDI) and ECX)) + Data[14] + $a679438e), 17);
+    mov EAX, EBX
+    add ESI, $a679438e
+    xor EAX, ECX
+    add ESI, [EDX + 4*14]
+    and EAX, EDI
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 17
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EDI) or ((not ESI) and EBX)) + Data[15] + $49b40821), 22);
+    mov EAX, EDI
+    add ECX, $49b40821
+    xor EAX, EBX
+    add ECX, [EDX + 4*15]
+    and EAX, ESI
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 22
     add ECX, ESI
-    rol ECX, 14
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EAX) or (EDX and (not EAX))) + Data[0] + $e9b6c7aa), 20);
-    mov ESI, ECX
-    add EBX, $e9b6c7aa
-    xor ESI, EDX
-    add EBX, [ebp + 4*0]
-    and ESI, EAX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 20
+
+// Round 2
+//EBX := ECX + roldword(dword(EBX + ((ECX and EDI) or (ESI and (not EDI))) + Data[1] + $f61e2562),  5);
+    mov EAX, ECX
+    add EBX, $f61e2562
+    xor EAX, ESI
+    add EBX, [EDX + 4*1]
+    and EAX, EDI
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  5
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + ((EBX and EDX) or (ECX and (not EDX))) + Data[5] + $d62f105d),  5);
-    mov ESI, EBX
-    add EAX, $d62f105d
-    xor ESI, ECX
-    add EAX, [ebp + 4*5]
-    and ESI, EDX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  5
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and ECX) or (EBX and (not ECX))) + Data[10] + $02441453),  9);
-    mov ESI, EAX
-    add EDX, $02441453
-    xor ESI, EBX
-    add EDX, [ebp + 4*10]
-    and ESI, ECX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX,  9
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EBX) or (EAX and (not EBX))) + Data[15] + $d8a1e681), 14);
-    mov ESI, EDX
-    add ECX, $d8a1e681
-    xor ESI, EAX
-    add ECX, [ebp + 4*15]
-    and ESI, EBX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ESI) or (ECX and (not ESI))) + Data[6] + $c040b340),  9);
+    mov EAX, EBX
+    add EDI, $c040b340
+    xor EAX, ECX
+    add EDI, [EDX + 4*6]
+    and EAX, ESI
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI,  9
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and ECX) or (EBX and (not ECX))) + Data[11] + $265e5a51), 14);
+    mov EAX, EDI
+    add ESI, $265e5a51
+    xor EAX, EBX
+    add ESI, [EDX + 4*11]
+    and EAX, ECX
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 14
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EBX) or (EDI and (not EBX))) + Data[0] + $e9b6c7aa), 20);
+    mov EAX, ESI
+    add ECX, $e9b6c7aa
+    xor EAX, EDI
+    add ECX, [EDX + 4*0]
+    and EAX, EBX
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 20
     add ECX, ESI
-    rol ECX, 14
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EAX) or (EDX and (not EAX))) + Data[4] + $e7d3fbc8), 20);
-    mov ESI, ECX
-    add EBX, $e7d3fbc8
-    xor ESI, EDX
-    add EBX, [ebp + 4*4]
-    and ESI, EAX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 20
+
+//EBX := ECX + roldword(dword(EBX + ((ECX and EDI) or (ESI and (not EDI))) + Data[5] + $d62f105d),  5);
+    mov EAX, ECX
+    add EBX, $d62f105d
+    xor EAX, ESI
+    add EBX, [EDX + 4*5]
+    and EAX, EDI
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  5
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + ((EBX and EDX) or (ECX and (not EDX))) + Data[9] + $21e1cde6),  5);
-    mov ESI, EBX
-    add EAX, $21e1cde6
-    xor ESI, ECX
-    add EAX, [ebp + 4*9]
-    and ESI, EDX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  5
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and ECX) or (EBX and (not ECX))) + Data[14] + $c33707d6),  9);
-    mov ESI, EAX
-    add EDX, $c33707d6
-    xor ESI, EBX
-    add EDX, [ebp + 4*14]
-    and ESI, ECX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX,  9
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EBX) or (EAX and (not EBX))) + Data[3] + $f4d50d87), 14);
-    mov ESI, EDX
-    add ECX, $f4d50d87
-    xor ESI, EAX
-    add ECX, [ebp + 4*3]
-    and ESI, EBX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ESI) or (ECX and (not ESI))) + Data[10] + $02441453),  9);
+    mov EAX, EBX
+    add EDI, $02441453
+    xor EAX, ECX
+    add EDI, [EDX + 4*10]
+    and EAX, ESI
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI,  9
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and ECX) or (EBX and (not ECX))) + Data[15] + $d8a1e681), 14);
+    mov EAX, EDI
+    add ESI, $d8a1e681
+    xor EAX, EBX
+    add ESI, [EDX + 4*15]
+    and EAX, ECX
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 14
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EBX) or (EDI and (not EBX))) + Data[4] + $e7d3fbc8), 20);
+    mov EAX, ESI
+    add ECX, $e7d3fbc8
+    xor EAX, EDI
+    add ECX, [EDX + 4*4]
+    and EAX, EBX
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 20
     add ECX, ESI
-    rol ECX, 14
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EAX) or (EDX and (not EAX))) + Data[8] + $455a14ed), 20);
-    mov ESI, ECX
-    add EBX, $455a14ed
-    xor ESI, EDX
-    add EBX, [ebp + 4*8]
-    and ESI, EAX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 20
+
+//EBX := ECX + roldword(dword(EBX + ((ECX and EDI) or (ESI and (not EDI))) + Data[9] + $21e1cde6),  5);
+    mov EAX, ECX
+    add EBX, $21e1cde6
+    xor EAX, ESI
+    add EBX, [EDX + 4*9]
+    and EAX, EDI
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  5
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + ((EBX and EDX) or (ECX and (not EDX))) + Data[13] + $a9e3e905),  5);
-    mov ESI, EBX
-    add EAX, $a9e3e905
-    xor ESI, ECX
-    add EAX, [ebp + 4*13]
-    and ESI, EDX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  5
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + ((EAX and ECX) or (EBX and (not ECX))) + Data[2] + $fcefa3f8),  9);
-    mov ESI, EAX
-    add EDX, $fcefa3f8
-    xor ESI, EBX
-    add EDX, [ebp + 4*2]
-    and ESI, ECX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX,  9
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + ((EDX and EBX) or (EAX and (not EBX))) + Data[7] + $676f02d9), 14);
-    mov ESI, EDX
-    add ECX, $676f02d9
-    xor ESI, EAX
-    add ECX, [ebp + 4*7]
-    and ESI, EBX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ESI) or (ECX and (not ESI))) + Data[14] + $c33707d6),  9);
+    mov EAX, EBX
+    add EDI, $c33707d6
+    xor EAX, ECX
+    add EDI, [EDX + 4*14]
+    and EAX, ESI
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI,  9
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and ECX) or (EBX and (not ECX))) + Data[3] + $f4d50d87), 14);
+    mov EAX, EDI
+    add ESI, $f4d50d87
+    xor EAX, EBX
+    add ESI, [EDX + 4*3]
+    and EAX, ECX
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 14
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EBX) or (EDI and (not EBX))) + Data[8] + $455a14ed), 20);
+    mov EAX, ESI
+    add ECX, $455a14ed
+    xor EAX, EDI
+    add ECX, [EDX + 4*8]
+    and EAX, EBX
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 20
     add ECX, ESI
-    rol ECX, 14
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + ((ECX and EAX) or (EDX and (not EAX))) + Data[12] + $8d2a4c8a), 20);
-    mov ESI, ECX
-    add EBX, $8d2a4c8a
-    xor ESI, EDX
-    add EBX, [ebp + 4*12]
-    and ESI, EAX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 20
+
+//EBX := ECX + roldword(dword(EBX + ((ECX and EDI) or (ESI and (not EDI))) + Data[13] + $a9e3e905),  5);
+    mov EAX, ECX
+    add EBX, $a9e3e905
+    xor EAX, ESI
+    add EBX, [EDX + 4*13]
+    and EAX, EDI
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  5
     add EBX, ECX
 
-// Round 3
-//EAX := EBX + roldword(dword(EAX + (EBX xor ECX xor EDX) + Data[5] + $fffa3942),  4);
-    mov ESI, EBX
-    add EAX, $fffa3942
-    xor ESI, ECX
-    add EAX, [ebp + 4*5]
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  4
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EAX xor EBX xor ECX) + Data[8] + $8771f681), 11);
-    mov ESI, EAX
-    add EDX, $8771f681
-    xor ESI, EBX
-    add EDX, [ebp + 4*8]
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 11
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EDX xor EAX xor EBX) + Data[11] + $6d9d6122), 16);
-    mov ESI, EDX
-    add ECX, $6d9d6122
-    xor ESI, EAX
-    add ECX, [ebp + 4*11]
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + ((EBX and ESI) or (ECX and (not ESI))) + Data[2] + $fcefa3f8),  9);
+    mov EAX, EBX
+    add EDI, $fcefa3f8
+    xor EAX, ECX
+    add EDI, [EDX + 4*2]
+    and EAX, ESI
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI,  9
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + ((EDI and ECX) or (EBX and (not ECX))) + Data[7] + $676f02d9), 14);
+    mov EAX, EDI
+    add ESI, $676f02d9
+    xor EAX, EBX
+    add ESI, [EDX + 4*7]
+    and EAX, ECX
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 14
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + ((ESI and EBX) or (EDI and (not EBX))) + Data[12] + $8d2a4c8a), 20);
+    mov EAX, ESI
+    add ECX, $8d2a4c8a
+    xor EAX, EDI
+    add ECX, [EDX + 4*12]
+    and EAX, EBX
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 20
     add ECX, ESI
-    rol ECX, 16
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (ECX xor EDX xor EAX) + Data[14] + $fde5380c), 23);
-    mov ESI, ECX
-    add EBX, $fde5380c
-    xor ESI, EDX
-    add EBX, [ebp + 4*14]
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 23
+
+// Round 3
+//EBX := ECX + roldword(dword(EBX + (ECX xor ESI xor EDI) + Data[5] + $fffa3942),  4);
+    mov EAX, ECX
+    add EBX, $fffa3942
+    xor EAX, ESI
+    add EBX, [EDX + 4*5]
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  4
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + (EBX xor ECX xor EDX) + Data[1] + $a4beea44),  4);
-    mov ESI, EBX
-    add EAX, $a4beea44
-    xor ESI, ECX
-    add EAX, [ebp + 4*1]
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  4
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EAX xor EBX xor ECX) + Data[4] + $4bdecfa9), 11);
-    mov ESI, EAX
-    add EDX, $4bdecfa9
-    xor ESI, EBX
-    add EDX, [ebp + 4*4]
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 11
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EDX xor EAX xor EBX) + Data[7] + $f6bb4b60), 16);
-    mov ESI, EDX
-    add ECX, $f6bb4b60
-    xor ESI, EAX
-    add ECX, [ebp + 4*7]
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + (EBX xor ECX xor ESI) + Data[8] + $8771f681), 11);
+    mov EAX, EBX
+    add EDI, $8771f681
+    xor EAX, ECX
+    add EDI, [EDX + 4*8]
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 11
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EDI xor EBX xor ECX) + Data[11] + $6d9d6122), 16);
+    mov EAX, EDI
+    add ESI, $6d9d6122
+    xor EAX, EBX
+    add ESI, [EDX + 4*11]
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 16
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (ESI xor EDI xor EBX) + Data[14] + $fde5380c), 23);
+    mov EAX, ESI
+    add ECX, $fde5380c
+    xor EAX, EDI
+    add ECX, [EDX + 4*14]
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 23
     add ECX, ESI
-    rol ECX, 16
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (ECX xor EDX xor EAX) + Data[10] + $bebfbc70), 23);
-    mov ESI, ECX
-    add EBX, $bebfbc70
-    xor ESI, EDX
-    add EBX, [ebp + 4*10]
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 23
+
+//EBX := ECX + roldword(dword(EBX + (ECX xor ESI xor EDI) + Data[1] + $a4beea44),  4);
+    mov EAX, ECX
+    add EBX, $a4beea44
+    xor EAX, ESI
+    add EBX, [EDX + 4*1]
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  4
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + (EBX xor ECX xor EDX) + Data[13] + $289b7ec6),  4);
-    mov ESI, EBX
-    add EAX, $289b7ec6
-    xor ESI, ECX
-    add EAX, [ebp + 4*13]
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  4
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EAX xor EBX xor ECX) + Data[0] + $eaa127fa), 11);
-    mov ESI, EAX
-    add EDX, $eaa127fa
-    xor ESI, EBX
-    add EDX, [ebp + 4*0]
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 11
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EDX xor EAX xor EBX) + Data[3] + $d4ef3085), 16);
-    mov ESI, EDX
-    add ECX, $d4ef3085
-    xor ESI, EAX
-    add ECX, [ebp + 4*3]
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + (EBX xor ECX xor ESI) + Data[4] + $4bdecfa9), 11);
+    mov EAX, EBX
+    add EDI, $4bdecfa9
+    xor EAX, ECX
+    add EDI, [EDX + 4*4]
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 11
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EDI xor EBX xor ECX) + Data[7] + $f6bb4b60), 16);
+    mov EAX, EDI
+    add ESI, $f6bb4b60
+    xor EAX, EBX
+    add ESI, [EDX + 4*7]
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 16
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (ESI xor EDI xor EBX) + Data[10] + $bebfbc70), 23);
+    mov EAX, ESI
+    add ECX, $bebfbc70
+    xor EAX, EDI
+    add ECX, [EDX + 4*10]
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 23
     add ECX, ESI
-    rol ECX, 16
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (ECX xor EDX xor EAX) + Data[6] + $04881d05), 23);
-    mov ESI, ECX
-    add EBX, $04881d05
-    xor ESI, EDX
-    add EBX, [ebp + 4*6]
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 23
+
+//EBX := ECX + roldword(dword(EBX + (ECX xor ESI xor EDI) + Data[13] + $289b7ec6),  4);
+    mov EAX, ECX
+    add EBX, $289b7ec6
+    xor EAX, ESI
+    add EBX, [EDX + 4*13]
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  4
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + (EBX xor ECX xor EDX) + Data[9] + $d9d4d039),  4);
-    mov ESI, EBX
-    add EAX, $d9d4d039
-    xor ESI, ECX
-    add EAX, [ebp + 4*9]
-    xor ESI, EDX
-    add EAX, ESI
-    rol EAX,  4
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EAX xor EBX xor ECX) + Data[12] + $e6db99e5), 11);
-    mov ESI, EAX
-    add EDX, $e6db99e5
-    xor ESI, EBX
-    add EDX, [ebp + 4*12]
-    xor ESI, ECX
-    add EDX, ESI
-    rol EDX, 11
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EDX xor EAX xor EBX) + Data[15] + $1fa27cf8), 16);
-    mov ESI, EDX
-    add ECX, $1fa27cf8
-    xor ESI, EAX
-    add ECX, [ebp + 4*15]
-    xor ESI, EBX
+//EDI := EBX + roldword(dword(EDI + (EBX xor ECX xor ESI) + Data[0] + $eaa127fa), 11);
+    mov EAX, EBX
+    add EDI, $eaa127fa
+    xor EAX, ECX
+    add EDI, [EDX + 4*0]
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 11
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EDI xor EBX xor ECX) + Data[3] + $d4ef3085), 16);
+    mov EAX, EDI
+    add ESI, $d4ef3085
+    xor EAX, EBX
+    add ESI, [EDX + 4*3]
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 16
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (ESI xor EDI xor EBX) + Data[6] + $04881d05), 23);
+    mov EAX, ESI
+    add ECX, $04881d05
+    xor EAX, EDI
+    add ECX, [EDX + 4*6]
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 23
     add ECX, ESI
-    rol ECX, 16
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (ECX xor EDX xor EAX) + Data[2] + $c4ac5665), 23);
-    mov ESI, ECX
-    add EBX, $c4ac5665
-    xor ESI, EDX
-    add EBX, [ebp + 4*2]
-    xor ESI, EAX
-    add EBX, ESI
-    rol EBX, 23
+
+//EBX := ECX + roldword(dword(EBX + (ECX xor ESI xor EDI) + Data[9] + $d9d4d039),  4);
+    mov EAX, ECX
+    add EBX, $d9d4d039
+    xor EAX, ESI
+    add EBX, [EDX + 4*9]
+    xor EAX, EDI
+    add EBX, EAX
+    rol EBX,  4
     add EBX, ECX
 
-// Round 4
-//EAX := EBX + roldword(dword(EAX + (ECX xor (EBX or (not EDX))) + Data[0] + $f4292244),  6);
-    mov ESI, EDX
-    add EAX, $f4292244
-    not ESI
-    add EAX, [ebp + 4*0]
-    or ESI, EBX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  6
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EBX xor (EAX or (not ECX))) + Data[7] + $432aff97), 10);
-    mov ESI, ECX
-    add EDX, $432aff97
-    not ESI
-    add EDX, [ebp + 4*7]
-    or ESI, EAX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX, 10
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EAX xor (EDX or (not EBX))) + Data[14] + $ab9423a7), 15);
-    mov ESI, EBX
-    add ECX, $ab9423a7
-    not ESI
-    add ECX, [ebp + 4*14]
-    or ESI, EDX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + (EBX xor ECX xor ESI) + Data[12] + $e6db99e5), 11);
+    mov EAX, EBX
+    add EDI, $e6db99e5
+    xor EAX, ECX
+    add EDI, [EDX + 4*12]
+    xor EAX, ESI
+    add EDI, EAX
+    rol EDI, 11
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EDI xor EBX xor ECX) + Data[15] + $1fa27cf8), 16);
+    mov EAX, EDI
+    add ESI, $1fa27cf8
+    xor EAX, EBX
+    add ESI, [EDX + 4*15]
+    xor EAX, ECX
+    add ESI, EAX
+    rol ESI, 16
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (ESI xor EDI xor EBX) + Data[2] + $c4ac5665), 23);
+    mov EAX, ESI
+    add ECX, $c4ac5665
+    xor EAX, EDI
+    add ECX, [EDX + 4*2]
+    xor EAX, EBX
+    add ECX, EAX
+    rol ECX, 23
     add ECX, ESI
-    rol ECX, 15
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (EDX xor (ECX or (not EAX))) + Data[5] + $fc93a039), 21);
-    mov ESI, EAX
-    add EBX, $fc93a039
-    not ESI
-    add EBX, [ebp + 4*5]
-    or ESI, ECX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 21
+
+// Round 4
+//EBX := ECX + roldword(dword(EBX + (ESI xor (ECX or (not EDI))) + Data[0] + $f4292244),  6);
+    mov EAX, EDI
+    add EBX, $f4292244
+    not EAX
+    add EBX, [EDX + 4*0]
+    or EAX, ECX
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  6
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + (ECX xor (EBX or (not EDX))) + Data[12] + $655b59c3),  6);
-    mov ESI, EDX
-    add EAX, $655b59c3
-    not ESI
-    add EAX, [ebp + 4*12]
-    or ESI, EBX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  6
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EBX xor (EAX or (not ECX))) + Data[3] + $8f0ccc92), 10);
-    mov ESI, ECX
-    add EDX, $8f0ccc92
-    not ESI
-    add EDX, [ebp + 4*3]
-    or ESI, EAX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX, 10
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EAX xor (EDX or (not EBX))) + Data[10] + $ffeff47d), 15);
-    mov ESI, EBX
-    add ECX, $ffeff47d
-    not ESI
-    add ECX, [ebp + 4*10]
-    or ESI, EDX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + (ECX xor (EBX or (not ESI))) + Data[7] + $432aff97), 10);
+    mov EAX, ESI
+    add EDI, $432aff97
+    not EAX
+    add EDI, [EDX + 4*7]
+    or EAX, EBX
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI, 10
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EBX xor (EDI or (not ECX))) + Data[14] + $ab9423a7), 15);
+    mov EAX, ECX
+    add ESI, $ab9423a7
+    not EAX
+    add ESI, [EDX + 4*14]
+    or EAX, EDI
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 15
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (EDI xor (ESI or (not EBX))) + Data[5] + $fc93a039), 21);
+    mov EAX, EBX
+    add ECX, $fc93a039
+    not EAX
+    add ECX, [EDX + 4*5]
+    or EAX, ESI
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 21
     add ECX, ESI
-    rol ECX, 15
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (EDX xor (ECX or (not EAX))) + Data[1] + $85845dd1), 21);
-    mov ESI, EAX
-    add EBX, $85845dd1
-    not ESI
-    add EBX, [ebp + 4*1]
-    or ESI, ECX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 21
+
+//EBX := ECX + roldword(dword(EBX + (ESI xor (ECX or (not EDI))) + Data[12] + $655b59c3),  6);
+    mov EAX, EDI
+    add EBX, $655b59c3
+    not EAX
+    add EBX, [EDX + 4*12]
+    or EAX, ECX
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  6
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + (ECX xor (EBX or (not EDX))) + Data[8] + $6fa87e4f),  6);
-    mov ESI, EDX
-    add EAX, $6fa87e4f
-    not ESI
-    add EAX, [ebp + 4*8]
-    or ESI, EBX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  6
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EBX xor (EAX or (not ECX))) + Data[15] + $fe2ce6e0), 10);
-    mov ESI, ECX
-    add EDX, $fe2ce6e0
-    not ESI
-    add EDX, [ebp + 4*15]
-    or ESI, EAX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX, 10
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EAX xor (EDX or (not EBX))) + Data[6] + $a3014314), 15);
-    mov ESI, EBX
-    add ECX, $a3014314
-    not ESI
-    add ECX, [ebp + 4*6]
-    or ESI, EDX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + (ECX xor (EBX or (not ESI))) + Data[3] + $8f0ccc92), 10);
+    mov EAX, ESI
+    add EDI, $8f0ccc92
+    not EAX
+    add EDI, [EDX + 4*3]
+    or EAX, EBX
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI, 10
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EBX xor (EDI or (not ECX))) + Data[10] + $ffeff47d), 15);
+    mov EAX, ECX
+    add ESI, $ffeff47d
+    not EAX
+    add ESI, [EDX + 4*10]
+    or EAX, EDI
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 15
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (EDI xor (ESI or (not EBX))) + Data[1] + $85845dd1), 21);
+    mov EAX, EBX
+    add ECX, $85845dd1
+    not EAX
+    add ECX, [EDX + 4*1]
+    or EAX, ESI
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 21
     add ECX, ESI
-    rol ECX, 15
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (EDX xor (ECX or (not EAX))) + Data[13] + $4e0811a1), 21);
-    mov ESI, EAX
-    add EBX, $4e0811a1
-    not ESI
-    add EBX, [ebp + 4*13]
-    or ESI, ECX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 21
+
+//EBX := ECX + roldword(dword(EBX + (ESI xor (ECX or (not EDI))) + Data[8] + $6fa87e4f),  6);
+    mov EAX, EDI
+    add EBX, $6fa87e4f
+    not EAX
+    add EBX, [EDX + 4*8]
+    or EAX, ECX
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  6
     add EBX, ECX
 
-//EAX := EBX + roldword(dword(EAX + (ECX xor (EBX or (not EDX))) + Data[4] + $f7537e82),  6);
-    mov ESI, EDX
-    add EAX, $f7537e82
-    not ESI
-    add EAX, [ebp + 4*4]
-    or ESI, EBX
-    xor ESI, ECX
-    add EAX, ESI
-    rol EAX,  6
-    add EAX, EBX
-
-//EDX := EAX + roldword(dword(EDX + (EBX xor (EAX or (not ECX))) + Data[11] + $bd3af235), 10);
-    mov ESI, ECX
-    add EDX, $bd3af235
-    not ESI
-    add EDX, [ebp + 4*11]
-    or ESI, EAX
-    xor ESI, EBX
-    add EDX, ESI
-    rol EDX, 10
-    add EDX, EAX
-
-//ECX := EDX + roldword(dword(ECX + (EAX xor (EDX or (not EBX))) + Data[2] + $2ad7d2bb), 15);
-    mov ESI, EBX
-    add ECX, $2ad7d2bb
-    not ESI
-    add ECX, [ebp + 4*2]
-    or ESI, EDX
-    xor ESI, EAX
+//EDI := EBX + roldword(dword(EDI + (ECX xor (EBX or (not ESI))) + Data[15] + $fe2ce6e0), 10);
+    mov EAX, ESI
+    add EDI, $fe2ce6e0
+    not EAX
+    add EDI, [EDX + 4*15]
+    or EAX, EBX
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI, 10
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EBX xor (EDI or (not ECX))) + Data[6] + $a3014314), 15);
+    mov EAX, ECX
+    add ESI, $a3014314
+    not EAX
+    add ESI, [EDX + 4*6]
+    or EAX, EDI
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 15
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (EDI xor (ESI or (not EBX))) + Data[13] + $4e0811a1), 21);
+    mov EAX, EBX
+    add ECX, $4e0811a1
+    not EAX
+    add ECX, [EDX + 4*13]
+    or EAX, ESI
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 21
     add ECX, ESI
-    rol ECX, 15
-    add ECX, EDX
-
-//EBX := ECX + roldword(dword(EBX + (EDX xor (ECX or (not EAX))) + Data[9] + $eb86d391), 21);
-    mov ESI, EAX
-    add EBX, $eb86d391
-    not ESI
-    add EBX, [ebp + 4*9]
-    or ESI, ECX
-    xor ESI, EDX
-    add EBX, ESI
-    rol EBX, 21
-    add EBX, ECX
 
+//EBX := ECX + roldword(dword(EBX + (ESI xor (ECX or (not EDI))) + Data[4] + $f7537e82),  6);
+    mov EAX, EDI
+    add EBX, $f7537e82
+    not EAX
+    add EBX, [EDX + 4*4]
+    or EAX, ECX
+    xor EAX, ESI
+    add EBX, EAX
+    rol EBX,  6
+    add EBX, ECX
 
-    pop EBP
+//EDI := EBX + roldword(dword(EDI + (ECX xor (EBX or (not ESI))) + Data[11] + $bd3af235), 10);
+    mov EAX, ESI
+    add EDI, $bd3af235
+    not EAX
+    add EDI, [EDX + 4*11]
+    or EAX, EBX
+    xor EAX, ECX
+    add EDI, EAX
+    rol EDI, 10
+    add EDI, EBX
+
+//ESI := EDI + roldword(dword(ESI + (EBX xor (EDI or (not ECX))) + Data[2] + $2ad7d2bb), 15);
+    mov EAX, ECX
+    add ESI, $2ad7d2bb
+    not EAX
+    add ESI, [EDX + 4*2]
+    or EAX, EDI
+    xor EAX, EBX
+    add ESI, EAX
+    rol ESI, 15
+    add ESI, EDI
+
+//ECX := ESI + roldword(dword(ECX + (EDI xor (ESI or (not EBX))) + Data[9] + $eb86d391), 21);
+    mov EAX, EBX
+    add ECX, $eb86d391
+    not EAX
+    add ECX, [EDX + 4*9]
+    or EAX, ESI
+    xor EAX, EDI
+    add ECX, EAX
+    rol ECX, 21
+    add ECX, ESI
 
-    mov EDI, [pContext{.State}]
-//  Inc(Context.State[0], A);
-    add [EDI+12+4*0], EAX
-//  Inc(Context.State[1], B);
-    add [EDI+12+4*1], EBX
-//  Inc(Context.State[2], C);
-    add [EDI+12+4*2], ECX
-//  Inc(Context.State[3], D);
-    add [EDI+12+4*3], EDX
+    pop EAX // EAX = Context
+    add TMDContext.State[EAX + 4*0], EBX //  Context.State[0 .. 3] += A, B, C, D
+    add TMDContext.State[EAX + 4*1], ECX
+    add TMDContext.State[EAX + 4*2], ESI
+    add TMDContext.State[EAX + 4*3], EDI
 
 //Inc(Context.Length,64);
-    add	dword ptr [EDI+104],64
-    adc	dword ptr [EDI+108],0
+    add	dword ptr TMDContext.Length[EAX],64
+    adc	dword ptr TMDContext.Length[EAX + 4],0
 
     pop EDI
     pop ESI
-    pop EDX
-    pop ECX
     pop EBX
-    pop EAX
 end;

packages/hash/src/md5x64_sysv.inc

@@ -0,0 +1,1408 @@
+// x86_64 (Windows) assembly optimized version
+{$ifdef CPUX86_HAS_BMI1}
+procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); assembler; nostackframe;
+// RDI = Context, RSI = Buffer
+{$asmmode intel}
+asm
+  // R8D = A, R9D = B, ECX = C, EDX = D
+  MOV  R8D, TMDContext.State[RDI + 4*0] // A, B, C, D := Context.State[0 .. 3];
+  MOV  R9D, TMDContext.State[RDI + 4*1]
+  MOV  ECX, TMDContext.State[RDI + 4*2]
+  MOV  EDX, TMDContext.State[RDI + 4*3]
+
+// Round 1
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[0] + $d76aa478), 7);
+  ADD  R8D, [RSI + 4*0]
+  MOV  EAX, R9D
+  ANDN R10D,R9D, EDX
+  ADD  R8D, $d76aa478
+  AND  EAX, ECX
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[1] + $e8c7b756), 12);
+  ADD  EDX, [RSI + 4*1]
+  ANDN R10D,R8D, ECX
+  AND  EAX, R9D
+  ADD  EDX, $e8c7b756
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 12
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[2] + $242070db), 17);
+  ADD  ECX, [RSI + 4*2]
+  ANDN R10D,EDX, R9D
+  AND  EAX, R8D
+  ADD  ECX, $242070db
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 17
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[3] + $c1bdceee), 22);
+  ADD  R9D, [RSI + 4*3]
+  ANDN R10D,ECX, R8D
+  AND  EAX, EDX
+  ADD  R9D, $c1bdceee
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[4] + $f57c0faf), 7);
+  ADD  R8D, [RSI + 4*4]
+  ANDN R10D,R9D, EDX
+  AND  EAX, ECX
+  ADD  R8D, $f57c0faf
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[5] + $4787c62a), 12);
+  ADD  EDX, [RSI + 4*5]
+  ANDN R10D,R8D, ECX
+  AND  EAX, R9D
+  ADD  EDX, $4787c62a
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 12
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[6] + $a8304613), 17);
+  ADD  ECX, [RSI + 4*6]
+  ANDN R10D,EDX, R9D
+  AND  EAX, R8D
+  ADD  ECX, $a8304613
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 17
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[7] + $fd469501), 22);
+  ADD  R9D, [RSI + 4*7]
+  ANDN R10D,ECX, R8D
+  AND  EAX, EDX
+  ADD  R9D, $fd469501
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[8] + $698098d8), 7);
+  ADD  R8D, [RSI + 4*8]
+  ANDN R10D,R9D, EDX
+  AND  EAX, ECX
+  ADD  R8D, $698098d8
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[9] + $8b44f7af), 12);
+  ADD  EDX, [RSI + 4*9]
+  ANDN R10D,R8D, ECX
+  AND  EAX, R9D
+  ADD  EDX, $8b44f7af
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 12
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[10] + $ffff5bb1), 17);
+  ADD  ECX, [RSI + 4*10]
+  ANDN R10D,EDX, R9D
+  AND  EAX, R8D
+  ADD  ECX, $ffff5bb1
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 17
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[11] + $895cd7be), 22);
+  ADD  R9D, [RSI + 4*11]
+  ANDN R10D,ECX, R8D
+  AND  EAX, EDX
+  ADD  R9D, $895cd7be
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[12] + $6b901122), 7);
+  ADD  R8D, [RSI + 4*12]
+  ANDN R10D,R9D, EDX
+  AND  EAX, ECX
+  ADD  R8D, $6b901122
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[13] + $fd987193), 12);
+  ADD  EDX, [RSI + 4*13]
+  ANDN R10D,R8D, ECX
+  AND  EAX, R9D
+  ADD  EDX, $fd987193
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 12
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[14] + $a679438e), 17);
+  ADD  ECX, [RSI + 4*14]
+  ANDN R10D,EDX, R9D
+  AND  EAX, R8D
+  ADD  ECX, $a679438e
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 17
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[15] + $49b40821), 22);
+  ADD  R9D, [RSI + 4*15]
+  ANDN R10D,ECX, R8D
+  AND  EAX, EDX
+  ADD  R9D, $49b40821
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+// Round 2
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or ((not EDX) and ECX)) + Data[1] + $f61e2562), 5);
+  ADD  R8D, [RSI + 4*1]
+  ANDN R10D,EDX, ECX
+  AND  EAX, EDX
+  ADD  R8D, $f61e2562
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or ((not ECX) and R9D)) + Data[6] + $c040b340), 9);
+  ADD  EDX, [RSI + 4*6]
+  ANDN R10D,ECX, R9D
+  AND  EAX, ECX
+  ADD  EDX, $c040b340
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 9
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or ((not R9D) and R8D)) + Data[11] + $265e5a51), 14);
+  ADD  ECX, [RSI + 4*11]
+  ANDN R10D,R9D, R8D
+  AND  EAX, R9D
+  ADD  ECX, $265e5a51
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 14
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or ((not R8D) and EDX)) + Data[0] + $e9b6c7aa), 20);
+  ADD  R9D, [RSI + 4*0]
+  ANDN R10D,R8D, EDX
+  AND  EAX, R8D
+  ADD  R9D, $e9b6c7aa
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or ((not EDX) and ECX)) + Data[5] + $d62f105d), 5);
+  ADD  R8D, [RSI + 4*5]
+  ANDN R10D,EDX, ECX
+  AND  EAX, EDX
+  ADD  R8D, $d62f105d
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or ((not ECX) and R9D)) + Data[10] + $02441453), 9);
+  ADD  EDX, [RSI + 4*10]
+  ANDN R10D,ECX, R9D
+  AND  EAX, ECX
+  ADD  EDX, $02441453
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 9
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or ((not R9D) and R8D)) + Data[15] + $d8a1e681), 14);
+  ADD  ECX, [RSI + 4*15]
+  ANDN R10D,R9D, R8D
+  AND  EAX, R9D
+  ADD  ECX, $d8a1e681
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 14
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or ((not R8D) and EDX)) + Data[4] + $e7d3fbc8), 20);
+  ADD  R9D, [RSI + 4*4]
+  ANDN R10D,R8D, EDX
+  AND  EAX, R8D
+  ADD  R9D, $e7d3fbc8
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or (ECX and (not EDX))) + Data[9] + $21e1cde6), 5);
+  ADD  R8D, [RSI + 4*9]
+  ANDN R10D,EDX, ECX
+  AND  EAX, EDX
+  ADD  R8D, $21e1cde6
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or (R9D and (not ECX))) + Data[14] + $c33707d6), 9);
+  ADD  EDX, [RSI + 4*14]
+  ANDN R10D,ECX, R9D
+  AND  EAX, ECX
+  ADD  EDX, $c33707d6
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 9
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or (R8D and (not R9D))) + Data[3] + $f4d50d87), 14);
+  ADD  ECX, [RSI + 4*3]
+  ANDN R10D,R9D, R8D
+  AND  EAX, R9D
+  ADD  ECX, $f4d50d87
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 14
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or (EDX and (not R8D))) + Data[8] + $455a14ed), 20);
+  ADD  R9D, [RSI + 4*8]
+  ANDN R10D,R8D, EDX
+  AND  EAX, R8D
+  ADD  R9D, $455a14ed
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  LEA  EAX, [R9D + ECX]
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or (ECX and (not EDX))) + Data[13] + $a9e3e905), 5);
+  ADD  R8D, [RSI + 4*13]
+  ANDN R10D,EDX, ECX
+  AND  EAX, EDX
+  ADD  R8D, $a9e3e905
+  OR   EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or (R9D and (not ECX))) + Data[2] + $fcefa3f8), 9);
+  ADD  EDX, [RSI + 4*2]
+  ANDN R10D,ECX, R9D
+  AND  EAX, ECX
+  ADD  EDX, $fcefa3f8
+  OR   EAX, R10D
+  ADD  EDX, EAX
+  ROL  EDX, 9
+  LEA  EAX, [EDX + R8D]
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or (R8D and (not R9D))) + Data[7] + $676f02d9), 14);
+  ADD  ECX, [RSI + 4*7]
+  ANDN R10D,R9D, R8D
+  AND  EAX, R9D
+  ADD  ECX, $676f02d9
+  OR   EAX, R10D
+  ADD  ECX, EAX
+  ROL  ECX, 14
+  LEA  EAX, [ECX + EDX]
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or (EDX and (not R8D))) + Data[12] + $8d2a4c8a), 20);
+  ADD  R9D, [RSI + 4*12]
+  ANDN R10D,R8D, EDX
+  AND  EAX, R8D
+  ADD  R9D, $8d2a4c8a
+  OR   EAX, R10D
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  ADD  R9D, ECX
+
+// Round 3
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[5] + $fffa3942), 4);
+  ADD R8D, [RSI + 4*5]
+  MOV EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, $fffa3942
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[8] + $8771f681), 11);
+  ADD EDX, [RSI + 4*8]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, $8771f681
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[11] + $6d9d6122), 16);
+  ADD ECX, [RSI + 4*11]
+  MOV EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, $6d9d6122
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[14] + $fde5380c), 23);
+  ADD R9D, [RSI + 4*14]
+  MOV EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, $fde5380c
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[1] + $a4beea44), 4);
+  ADD R8D, [RSI + 4*1]
+  MOV EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, $a4beea44
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[4] + $4bdecfa9), 11);
+  ADD EDX, [RSI + 4*4]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, $4bdecfa9
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[7] + $f6bb4b60), 16);
+  ADD ECX, [RSI + 4*7]
+  MOV EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, $f6bb4b60
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[10] + $bebfbc70), 23);
+  ADD R9D, [RSI + 4*10]
+  MOV EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, $bebfbc70
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[13] + $289b7ec6), 4);
+  ADD R8D, [RSI + 4*13]
+  MOV EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, $289b7ec6
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[0] + $eaa127fa), 11);
+  ADD EDX, [RSI + 4*0]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, $eaa127fa
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[3] + $d4ef3085), 16);
+  ADD ECX, [RSI + 4*3]
+  MOV EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, $d4ef3085
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[6] + $04881d05), 23);
+  ADD R9D, [RSI + 4*6]
+  MOV EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, $04881d05
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[9] + $d9d4d039), 4);
+  ADD R8D, [RSI + 4*9]
+  MOV EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, $d9d4d039
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[12] + $e6db99e5), 11);
+  ADD EDX, [RSI + 4*12]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, $e6db99e5
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[15] + $1fa27cf8), 16);
+  ADD ECX, [RSI + 4*15]
+  MOV EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, $1fa27cf8
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  MOV R10D,-1 // Prepare a register of all 1s for Round 4.
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[2] + $c4ac5665), 23);
+  ADD R9D, [RSI + 4*2]
+  MOV EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, $c4ac5665
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+// Round 4 (throughout this round, "ANDN EAX, reg, R10D" stands in for "EAX := not reg")
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[0] + $f4292244), 6);
+  ADD  R8D, [RSI + 4*0]
+  ANDN EAX, EDX, R10D
+  ADD  R8D, $f4292244
+  OR   EAX, R9D
+  XOR  EAX, ECX
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[7] + $432aff97), 10);
+  ADD  EDX, [RSI + 4*7]
+  ANDN EAX, ECX, R10D
+  ADD  EDX, $432aff97
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  EDX, EAX
+  ROL  EDX, 10
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[14] + $ab9423a7), 15);
+  ADD  ECX, [RSI + 4*14]
+  ANDN EAX, R9D, R10D
+  ADD  ECX, $ab9423a7
+  OR   EAX, EDX
+  XOR  EAX, R8D
+  ADD  ECX, EAX
+  ROL  ECX, 15
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[5] + $fc93a039), 21);
+  ADD  R9D, [RSI + 4*5]
+  ANDN EAX, R8D, R10D
+  ADD  R9D, $fc93a039
+  OR   EAX, ECX
+  XOR  EAX, EDX
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[12] + $655b59c3), 6);
+  ADD  R8D, [RSI + 4*12]
+  ANDN EAX, EDX, R10D
+  ADD  R8D, $655b59c3
+  OR   EAX, R9D
+  XOR  EAX, ECX
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[3] + $8f0ccc92), 10);
+  ADD  EDX, [RSI + 4*3]
+  ANDN EAX, ECX, R10D
+  ADD  EDX, $8f0ccc92
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  EDX, EAX
+  ROL  EDX, 10
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[10] + $ffeff47d), 15);
+  ADD  ECX, [RSI + 4*10]
+  ANDN EAX, R9D, R10D
+  ADD  ECX, $ffeff47d
+  OR   EAX, EDX
+  XOR  EAX, R8D
+  ADD  ECX, EAX
+  ROL  ECX, 15
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[1] + $85845dd1), 21);
+  ADD  R9D, [RSI + 4*1]
+  ANDN EAX, R8D, R10D
+  ADD  R9D, $85845dd1
+  OR   EAX, ECX
+  XOR  EAX, EDX
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[8] + $6fa87e4f), 6);
+  ADD  R8D, [RSI + 4*8]
+  ANDN EAX, EDX, R10D
+  ADD  R8D, $6fa87e4f
+  OR   EAX, R9D
+  XOR  EAX, ECX
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[15] + $fe2ce6e0), 10);
+  ADD  EDX, [RSI + 4*15]
+  ANDN EAX, ECX, R10D
+  ADD  EDX, $fe2ce6e0
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  EDX, EAX
+  ROL  EDX, 10
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[6] + $a3014314), 15);
+  ADD  ECX, [RSI + 4*6]
+  ANDN EAX, R9D, R10D
+  ADD  ECX, $a3014314
+  OR   EAX, EDX
+  XOR  EAX, R8D
+  ADD  ECX, EAX
+  ROL  ECX, 15
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[13] + $4e0811a1), 21);
+  ADD  R9D, [RSI + 4*13]
+  ANDN EAX, R8D, R10D
+  ADD  R9D, $4e0811a1
+  OR   EAX, ECX
+  XOR  EAX, EDX
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[4] + $f7537e82), 6);
+  ADD  R8D, [RSI + 4*4]
+  ANDN EAX, EDX, R10D
+  ADD  R8D, $f7537e82
+  OR   EAX, R9D
+  XOR  EAX, ECX
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[11] + $bd3af235), 10);
+  ADD  EDX, [RSI + 4*11]
+  ANDN EAX, ECX, R10D
+  ADD  EDX, $bd3af235
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  EDX, EAX
+  ROL  EDX, 10
+  ADD  EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[2] + $2ad7d2bb), 15);
+  ADD  ECX, [RSI + 4*2]
+  ANDN EAX, R9D, R10D
+  ADD  ECX, $2ad7d2bb
+  OR   EAX, EDX
+  XOR  EAX, R8D
+  ADD  ECX, EAX
+  ROL  ECX, 15
+  ADD  ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[9] + $eb86d391), 21);
+  ADD  R9D, [RSI + 4*9]
+  ANDN EAX, R8D, R10D
+  ADD  R9D, $eb86d391
+  OR   EAX, ECX
+  XOR  EAX, EDX
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, ECX
+
+  ADD TMDContext.State[RDI + 4*0], R8D //  Context.State[0 .. 3] += A, B, C, D
+  ADD TMDContext.State[RDI + 4*1], R9D
+  ADD TMDContext.State[RDI + 4*2], ECX
+  ADD TMDContext.State[RDI + 4*3], EDX
+
+//Inc(Context.Length,64);
+  ADD QWORD PTR TMDContext.Length[RDI],64
+end;
+{$else CPUX86_HAS_BMI1}
+procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); assembler; nostackframe;
+// RDI = Context, RSI = Buffer
+{$asmmode intel}
+asm
+  // R8D = A, R9D = B, ECX = C, EDX = D
+  MOV R8D, TMDContext.State[RDI + 4*0] // A, B, C, D := Context.State[0 .. 3];
+  MOV R9D, TMDContext.State[RDI + 4*1]
+  MOV ECX, TMDContext.State[RDI + 4*2]
+  MOV EDX, TMDContext.State[RDI + 4*3]
+// Round 1
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[0] + $d76aa478), 7);
+  MOV EAX, ECX
+  ADD R8D, $d76aa478
+  XOR EAX, EDX
+  ADD R8D, [RSI + 4*0]
+  AND EAX, R9D
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[1] + $e8c7b756), 12);
+  MOV EAX, R9D
+  ADD EDX, $e8c7b756
+  XOR EAX, ECX
+  ADD EDX, [RSI + 4*1]
+  AND EAX, R8D
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 12
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[2] + $242070db), 17);
+  MOV EAX, R8D
+  ADD ECX, $242070db
+  XOR EAX, R9D
+  ADD ECX, [RSI + 4*2]
+  AND EAX, EDX
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 17
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[3] + $c1bdceee), 22);
+  MOV EAX, EDX
+  ADD R9D, $c1bdceee
+  XOR EAX, R8D
+  ADD R9D, [RSI + 4*3]
+  AND EAX, ECX
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[4] + $f57c0faf), 7);
+  MOV EAX, ECX
+  ADD R8D, $f57c0faf
+  XOR EAX, EDX
+  ADD R8D, [RSI + 4*4]
+  AND EAX, R9D
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[5] + $4787c62a), 12);
+  MOV EAX, R9D
+  ADD EDX, $4787c62a
+  XOR EAX, ECX
+  ADD EDX, [RSI + 4*5]
+  AND EAX, R8D
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 12
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[6] + $a8304613), 17);
+  MOV EAX, R8D
+  ADD ECX, $a8304613
+  XOR EAX, R9D
+  ADD ECX, [RSI + 4*6]
+  AND EAX, EDX
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 17
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[7] + $fd469501), 22);
+  MOV EAX, EDX
+  ADD R9D, $fd469501
+  XOR EAX, R8D
+  ADD R9D, [RSI + 4*7]
+  AND EAX, ECX
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[8] + $698098d8), 7);
+  MOV EAX, ECX
+  ADD R8D, $698098d8
+  XOR EAX, EDX
+  ADD R8D, [RSI + 4*8]
+  AND EAX, R9D
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[9] + $8b44f7af), 12);
+  MOV EAX, R9D
+  ADD EDX, $8b44f7af
+  XOR EAX, ECX
+  ADD EDX, [RSI + 4*9]
+  AND EAX, R8D
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 12
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[10] + $ffff5bb1), 17);
+  MOV EAX, R8D
+  ADD ECX, $ffff5bb1
+  XOR EAX, R9D
+  ADD ECX, [RSI + 4*10]
+  AND EAX, EDX
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 17
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[11] + $895cd7be), 22);
+  MOV EAX, EDX
+  ADD R9D, $895cd7be
+  XOR EAX, R8D
+  ADD R9D, [RSI + 4*11]
+  AND EAX, ECX
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and ECX) or ((not R9D) and EDX)) + Data[12] + $6b901122), 7);
+  MOV EAX, ECX
+  ADD R8D, $6b901122
+  XOR EAX, EDX
+  ADD R8D, [RSI + 4*12]
+  AND EAX, R9D
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and R9D) or ((not R8D) and ECX)) + Data[13] + $fd987193), 12);
+  MOV EAX, R9D
+  ADD EDX, $fd987193
+  XOR EAX, ECX
+  ADD EDX, [RSI + 4*13]
+  AND EAX, R8D
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 12
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R8D) or ((not EDX) and R9D)) + Data[14] + $a679438e), 17);
+  MOV EAX, R8D
+  ADD ECX, $a679438e
+  XOR EAX, R9D
+  ADD ECX, [RSI + 4*14]
+  AND EAX, EDX
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 17
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and EDX) or ((not ECX) and R8D)) + Data[15] + $49b40821), 22);
+  MOV EAX, EDX
+  ADD R9D, $49b40821
+  XOR EAX, R8D
+  ADD R9D, [RSI + 4*15]
+  AND EAX, ECX
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, ECX
+
+// Round 2
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or (ECX and (not EDX))) + Data[1] + $f61e2562), 5);
+  MOV EAX, R9D
+  ADD R8D, $f61e2562
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*1]
+  AND EAX, EDX
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or (R9D and (not ECX))) + Data[6] + $c040b340), 9);
+  MOV EAX, R8D
+  ADD EDX, $c040b340
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*6]
+  AND EAX, ECX
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 9
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or (R8D and (not R9D))) + Data[11] + $265e5a51), 14);
+  MOV EAX, EDX
+  ADD ECX, $265e5a51
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*11]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 14
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or (EDX and (not R8D))) + Data[0] + $e9b6c7aa), 20);
+  MOV EAX, ECX
+  ADD R9D, $e9b6c7aa
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*0]
+  AND EAX, R8D
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or (ECX and (not EDX))) + Data[5] + $d62f105d), 5);
+  MOV EAX, R9D
+  ADD R8D, $d62f105d
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*5]
+  AND EAX, EDX
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or (R9D and (not ECX))) + Data[10] + $02441453), 9);
+  MOV EAX, R8D
+  ADD EDX, $02441453
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*10]
+  AND EAX, ECX
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 9
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or (R8D and (not R9D))) + Data[15] + $d8a1e681), 14);
+  MOV EAX, EDX
+  ADD ECX, $d8a1e681
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*15]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 14
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or (EDX and (not R8D))) + Data[4] + $e7d3fbc8), 20);
+  MOV EAX, ECX
+  ADD R9D, $e7d3fbc8
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*4]
+  AND EAX, R8D
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or (ECX and (not EDX))) + Data[9] + $21e1cde6), 5);
+  MOV EAX, R9D
+  ADD R8D, $21e1cde6
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*9]
+  AND EAX, EDX
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or (R9D and (not ECX))) + Data[14] + $c33707d6), 9);
+  MOV EAX, R8D
+  ADD EDX, $c33707d6
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*14]
+  AND EAX, ECX
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 9
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or (R8D and (not R9D))) + Data[3] + $f4d50d87), 14);
+  MOV EAX, EDX
+  ADD ECX, $f4d50d87
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*3]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 14
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or (EDX and (not R8D))) + Data[8] + $455a14ed), 20);
+  MOV EAX, ECX
+  ADD R9D, $455a14ed
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*8]
+  AND EAX, R8D
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and EDX) or (ECX and (not EDX))) + Data[13] + $a9e3e905), 5);
+  MOV EAX, R9D
+  ADD R8D, $a9e3e905
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*13]
+  AND EAX, EDX
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + ((R8D and ECX) or (R9D and (not ECX))) + Data[2] + $fcefa3f8), 9);
+  MOV EAX, R8D
+  ADD EDX, $fcefa3f8
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*2]
+  AND EAX, ECX
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 9
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + ((EDX and R9D) or (R8D and (not R9D))) + Data[7] + $676f02d9), 14);
+  MOV EAX, EDX
+  ADD ECX, $676f02d9
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*7]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 14
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + ((ECX and R8D) or (EDX and (not R8D))) + Data[12] + $8d2a4c8a), 20);
+  MOV EAX, ECX
+  ADD R9D, $8d2a4c8a
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*12]
+  AND EAX, R8D
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, ECX
+
+// Round 3
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[5] + $fffa3942), 4);
+  MOV EAX, R9D
+  ADD R8D, $fffa3942
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*5]
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[8] + $8771f681), 11);
+  MOV EAX, R8D
+  ADD EDX, $8771f681
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*8]
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[11] + $6d9d6122), 16);
+  MOV EAX, EDX
+  ADD ECX, $6d9d6122
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*11]
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[14] + $fde5380c), 23);
+  MOV EAX, ECX
+  ADD R9D, $fde5380c
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*14]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[1] + $a4beea44), 4);
+  MOV EAX, R9D
+  ADD R8D, $a4beea44
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*1]
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[4] + $4bdecfa9), 11);
+  MOV EAX, R8D
+  ADD EDX, $4bdecfa9
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*4]
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[7] + $f6bb4b60), 16);
+  MOV EAX, EDX
+  ADD ECX, $f6bb4b60
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*7]
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[10] + $bebfbc70), 23);
+  MOV EAX, ECX
+  ADD R9D, $bebfbc70
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*10]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[13] + $289b7ec6), 4);
+  MOV EAX, R9D
+  ADD R8D, $289b7ec6
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*13]
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[0] + $eaa127fa), 11);
+  MOV EAX, R8D
+  ADD EDX, $eaa127fa
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*0]
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[3] + $d4ef3085), 16);
+  MOV EAX, EDX
+  ADD ECX, $d4ef3085
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*3]
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[6] + $04881d05), 23);
+  MOV EAX, ECX
+  ADD R9D, $04881d05
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*6]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor ECX xor EDX) + Data[9] + $d9d4d039), 4);
+  MOV EAX, R9D
+  ADD R8D, $d9d4d039
+  XOR EAX, ECX
+  ADD R8D, [RSI + 4*9]
+  XOR EAX, EDX
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R8D xor R9D xor ECX) + Data[12] + $e6db99e5), 11);
+  MOV EAX, R8D
+  ADD EDX, $e6db99e5
+  XOR EAX, R9D
+  ADD EDX, [RSI + 4*12]
+  XOR EAX, ECX
+  ADD EDX, EAX
+  ROL EDX, 11
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (EDX xor R8D xor R9D) + Data[15] + $1fa27cf8), 16);
+  MOV EAX, EDX
+  ADD ECX, $1fa27cf8
+  XOR EAX, R8D
+  ADD ECX, [RSI + 4*15]
+  XOR EAX, R9D
+  ADD ECX, EAX
+  ROL ECX, 16
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (ECX xor EDX xor R8D) + Data[2] + $c4ac5665), 23);
+  MOV EAX, ECX
+  ADD R9D, $c4ac5665
+  XOR EAX, EDX
+  ADD R9D, [RSI + 4*2]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, ECX
+
+// Round 4
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[0] + $f4292244), 6);
+  MOV EAX, EDX
+  ADD R8D, $f4292244
+  NOT EAX
+  ADD R8D, [RSI + 4*0]
+  OR  EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[7] + $432aff97), 10);
+  MOV EAX, ECX
+  ADD EDX, $432aff97
+  NOT EAX
+  ADD EDX, [RSI + 4*7]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 10
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[14] + $ab9423a7), 15);
+  MOV EAX, R9D
+  ADD ECX, $ab9423a7
+  NOT EAX
+  ADD ECX, [RSI + 4*14]
+  OR  EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 15
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[5] + $fc93a039), 21);
+  MOV EAX, R8D
+  ADD R9D, $fc93a039
+  NOT EAX
+  ADD R9D, [RSI + 4*5]
+  OR  EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[12] + $655b59c3), 6);
+  MOV EAX, EDX
+  ADD R8D, $655b59c3
+  NOT EAX
+  ADD R8D, [RSI + 4*12]
+  OR  EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[3] + $8f0ccc92), 10);
+  MOV EAX, ECX
+  ADD EDX, $8f0ccc92
+  NOT EAX
+  ADD EDX, [RSI + 4*3]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 10
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[10] + $ffeff47d), 15);
+  MOV EAX, R9D
+  ADD ECX, $ffeff47d
+  NOT EAX
+  ADD ECX, [RSI + 4*10]
+  OR  EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 15
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[1] + $85845dd1), 21);
+  MOV EAX, R8D
+  ADD R9D, $85845dd1
+  NOT EAX
+  ADD R9D, [RSI + 4*1]
+  OR  EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[8] + $6fa87e4f), 6);
+  MOV EAX, EDX
+  ADD R8D, $6fa87e4f
+  NOT EAX
+  ADD R8D, [RSI + 4*8]
+  OR  EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[15] + $fe2ce6e0), 10);
+  MOV EAX, ECX
+  ADD EDX, $fe2ce6e0
+  NOT EAX
+  ADD EDX, [RSI + 4*15]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 10
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[6] + $a3014314), 15);
+  MOV EAX, R9D
+  ADD ECX, $a3014314
+  NOT EAX
+  ADD ECX, [RSI + 4*6]
+  OR  EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 15
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[13] + $4e0811a1), 21);
+  MOV EAX, R8D
+  ADD R9D, $4e0811a1
+  NOT EAX
+  ADD R9D, [RSI + 4*13]
+  OR  EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, ECX
+
+//R8D := R9D + roldword(dword(R8D + (ECX xor (R9D or (not EDX))) + Data[4] + $f7537e82), 6);
+  MOV EAX, EDX
+  ADD R8D, $f7537e82
+  NOT EAX
+  ADD R8D, [RSI + 4*4]
+  OR  EAX, R9D
+  XOR EAX, ECX
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//EDX := R8D + roldword(dword(EDX + (R9D xor (R8D or (not ECX))) + Data[11] + $bd3af235), 10);
+  MOV EAX, ECX
+  ADD EDX, $bd3af235
+  NOT EAX
+  ADD EDX, [RSI + 4*11]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD EDX, EAX
+  ROL EDX, 10
+  ADD EDX, R8D
+
+//ECX := EDX + roldword(dword(ECX + (R8D xor (EDX or (not R9D))) + Data[2] + $2ad7d2bb), 15);
+  MOV EAX, R9D
+  ADD ECX, $2ad7d2bb
+  NOT EAX
+  ADD ECX, [RSI + 4*2]
+  OR  EAX, EDX
+  XOR EAX, R8D
+  ADD ECX, EAX
+  ROL ECX, 15
+  ADD ECX, EDX
+
+//R9D := ECX + roldword(dword(R9D + (EDX xor (ECX or (not R8D))) + Data[9] + $eb86d391), 21);
+  MOV EAX, R8D
+  ADD R9D, $eb86d391
+  NOT EAX
+  ADD R9D, [RSI + 4*9]
+  OR  EAX, ECX
+  XOR EAX, EDX
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, ECX
+
+  ADD TMDContext.State[RDI + 4*0], R8D //  Context.State[0 .. 3] += A, B, C, D
+  ADD TMDContext.State[RDI + 4*1], R9D
+  ADD TMDContext.State[RDI + 4*2], ECX
+  ADD TMDContext.State[RDI + 4*3], EDX
+
+//Inc(Context.Length,64);
+  ADD QWORD PTR TMDContext.Length[RDI],64
+end;
+{$endif CPUX86_HAS_BMI1}

packages/hash/src/md5x64_win.inc

@@ -0,0 +1,1414 @@
+// x86_64 (Windows) assembly optimized version
+{$ifdef CPUX86_HAS_BMI1}
+procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); assembler; nostackframe;
+// RCX = Context, RDX = Buffer
+{$asmmode intel}
+asm
+.seh_pushreg RBX
+  PUSH RBX
+.seh_endprologue
+
+  // R8D = A, R9D = B, R10D = C, R11D = D
+  MOV  R8D, TMDContext.State[RCX + 4*0] // A, B, C, D := Context.State[0 .. 3];
+  MOV  R9D, TMDContext.State[RCX + 4*1]
+  MOV  R10D,TMDContext.State[RCX + 4*2]
+  MOV  R11D,TMDContext.State[RCX + 4*3]
+
+// Round 1
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[0] + $d76aa478), 7);
+  ADD  R8D, [RDX + 4*0]
+  MOV  EAX, R9D
+  ANDN EBX, R9D, R11D
+  ADD  R8D, $d76aa478
+  AND  EAX, R10D
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[1] + $e8c7b756), 12);
+  ADD  R11D,[RDX + 4*1]
+  ANDN EBX, R8D, R10D
+  AND  EAX, R9D
+  ADD  R11D,$e8c7b756
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,12
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[2] + $242070db), 17);
+  ADD  R10D,[RDX + 4*2]
+  ANDN EBX, R11D,R9D
+  AND  EAX, R8D
+  ADD  R10D,$242070db
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,17
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[3] + $c1bdceee), 22);
+  ADD  R9D, [RDX + 4*3]
+  ANDN EBX, R10D,R8D
+  AND  EAX, R11D
+  ADD  R9D, $c1bdceee
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[4] + $f57c0faf), 7);
+  ADD  R8D, [RDX + 4*4]
+  ANDN EBX, R9D, R11D
+  AND  EAX, R10D
+  ADD  R8D, $f57c0faf
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[5] + $4787c62a), 12);
+  ADD  R11D,[RDX + 4*5]
+  ANDN EBX, R8D, R10D
+  AND  EAX, R9D
+  ADD  R11D,$4787c62a
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,12
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[6] + $a8304613), 17);
+  ADD  R10D,[RDX + 4*6]
+  ANDN EBX, R11D,R9D
+  AND  EAX, R8D
+  ADD  R10D,$a8304613
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,17
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[7] + $fd469501), 22);
+  ADD  R9D, [RDX + 4*7]
+  ANDN EBX, R10D,R8D
+  AND  EAX, R11D
+  ADD  R9D, $fd469501
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[8] + $698098d8), 7);
+  ADD  R8D, [RDX + 4*8]
+  ANDN EBX, R9D, R11D
+  AND  EAX, R10D
+  ADD  R8D, $698098d8
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[9] + $8b44f7af), 12);
+  ADD  R11D,[RDX + 4*9]
+  ANDN EBX, R8D, R10D
+  AND  EAX, R9D
+  ADD  R11D,$8b44f7af
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,12
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[10] + $ffff5bb1), 17);
+  ADD  R10D,[RDX + 4*10]
+  ANDN EBX, R11D,R9D
+  AND  EAX, R8D
+  ADD  R10D,$ffff5bb1
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,17
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[11] + $895cd7be), 22);
+  ADD  R9D, [RDX + 4*11]
+  ANDN EBX, R10D,R8D
+  AND  EAX, R11D
+  ADD  R9D, $895cd7be
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[12] + $6b901122), 7);
+  ADD  R8D, [RDX + 4*12]
+  ANDN EBX, R9D, R11D
+  AND  EAX, R10D
+  ADD  R8D, $6b901122
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 7
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[13] + $fd987193), 12);
+  ADD  R11D,[RDX + 4*13]
+  ANDN EBX, R8D, R10D
+  AND  EAX, R9D
+  ADD  R11D,$fd987193
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,12
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[14] + $a679438e), 17);
+  ADD  R10D,[RDX + 4*14]
+  ANDN EBX, R11D,R9D
+  AND  EAX, R8D
+  ADD  R10D,$a679438e
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,17
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[15] + $49b40821), 22);
+  ADD  R9D, [RDX + 4*15]
+  ANDN EBX, R10D,R8D
+  AND  EAX, R11D
+  ADD  R9D, $49b40821
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 22
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+// Round 2
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or ((not R11D) and R10D)) + Data[1] + $f61e2562), 5);
+  ADD  R8D, [RDX + 4*1]
+  ANDN EBX, R11D,R10D
+  AND  EAX, R11D
+  ADD  R8D, $f61e2562
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or ((not R10D) and R9D)) + Data[6] + $c040b340), 9);
+  ADD  R11D,[RDX + 4*6]
+  ANDN EBX, R10D,R9D
+  AND  EAX, R10D
+  ADD  R11D,$c040b340
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,9
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or ((not R9D) and R8D)) + Data[11] + $265e5a51), 14);
+  ADD  R10D,[RDX + 4*11]
+  ANDN EBX, R9D, R8D
+  AND  EAX, R9D
+  ADD  R10D,$265e5a51
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,14
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or ((not R8D) and R11D)) + Data[0] + $e9b6c7aa), 20);
+  ADD  R9D, [RDX + 4*0]
+  ANDN EBX, R8D, R11D
+  AND  EAX, R8D
+  ADD  R9D, $e9b6c7aa
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or ((not R11D) and R10D)) + Data[5] + $d62f105d), 5);
+  ADD  R8D, [RDX + 4*5]
+  ANDN EBX, R11D,R10D
+  AND  EAX, R11D
+  ADD  R8D, $d62f105d
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or ((not R10D) and R9D)) + Data[10] + $02441453), 9);
+  ADD  R11D,[RDX + 4*10]
+  ANDN EBX, R10D,R9D
+  AND  EAX, R10D
+  ADD  R11D,$02441453
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,9
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or ((not R9D) and R8D)) + Data[15] + $d8a1e681), 14);
+  ADD  R10D,[RDX + 4*15]
+  ANDN EBX, R9D, R8D
+  AND  EAX, R9D
+  ADD  R10D,$d8a1e681
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,14
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or ((not R8D) and R11D)) + Data[4] + $e7d3fbc8), 20);
+  ADD  R9D, [RDX + 4*4]
+  ANDN EBX, R8D, R11D
+  AND  EAX, R8D
+  ADD  R9D, $e7d3fbc8
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or (R10D and (not R11D))) + Data[9] + $21e1cde6), 5);
+  ADD  R8D, [RDX + 4*9]
+  ANDN EBX, R11D,R10D
+  AND  EAX, R11D
+  ADD  R8D, $21e1cde6
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or (R9D and (not R10D))) + Data[14] + $c33707d6), 9);
+  ADD  R11D,[RDX + 4*14]
+  ANDN EBX, R10D,R9D
+  AND  EAX, R10D
+  ADD  R11D,$c33707d6
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,9
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or (R8D and (not R9D))) + Data[3] + $f4d50d87), 14);
+  ADD  R10D,[RDX + 4*3]
+  ANDN EBX, R9D, R8D
+  AND  EAX, R9D
+  ADD  R10D,$f4d50d87
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,14
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or (R11D and (not R8D))) + Data[8] + $455a14ed), 20);
+  ADD  R9D, [RDX + 4*8]
+  ANDN EBX, R8D, R11D
+  AND  EAX, R8D
+  ADD  R9D, $455a14ed
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  LEA  EAX, [R9D + R10D]
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or (R10D and (not R11D))) + Data[13] + $a9e3e905), 5);
+  ADD  R8D, [RDX + 4*13]
+  ANDN EBX, R11D,R10D
+  AND  EAX, R11D
+  ADD  R8D, $a9e3e905
+  OR   EAX, EBX
+  ADD  R8D, EAX
+  ROL  R8D, 5
+  LEA  EAX, [R8D + R9D]
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or (R9D and (not R10D))) + Data[2] + $fcefa3f8), 9);
+  ADD  R11D,[RDX + 4*2]
+  ANDN EBX, R10D,R9D
+  AND  EAX, R10D
+  ADD  R11D,$fcefa3f8
+  OR   EAX, EBX
+  ADD  R11D,EAX
+  ROL  R11D,9
+  LEA  EAX, [R11D + R8D]
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or (R8D and (not R9D))) + Data[7] + $676f02d9), 14);
+  ADD  R10D,[RDX + 4*7]
+  ANDN EBX, R9D, R8D
+  AND  EAX, R9D
+  ADD  R10D,$676f02d9
+  OR   EAX, EBX
+  ADD  R10D,EAX
+  ROL  R10D,14
+  LEA  EAX, [R10D + R11D]
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or (R11D and (not R8D))) + Data[12] + $8d2a4c8a), 20);
+  ADD  R9D, [RDX + 4*12]
+  ANDN EBX, R8D, R11D
+  AND  EAX, R8D
+  ADD  R9D, $8d2a4c8a
+  OR   EAX, EBX
+  ADD  R9D, EAX
+  ROL  R9D, 20
+  ADD  R9D, R10D
+
+// Round 3
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[5] + $fffa3942), 4);
+  ADD R8D, [RDX + 4*5]
+  MOV EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, $fffa3942
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[8] + $8771f681), 11);
+  ADD R11D,[RDX + 4*8]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,$8771f681
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[11] + $6d9d6122), 16);
+  ADD R10D,[RDX + 4*11]
+  MOV EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,$6d9d6122
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[14] + $fde5380c), 23);
+  ADD R9D, [RDX + 4*14]
+  MOV EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, $fde5380c
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[1] + $a4beea44), 4);
+  ADD R8D, [RDX + 4*1]
+  MOV EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, $a4beea44
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[4] + $4bdecfa9), 11);
+  ADD R11D,[RDX + 4*4]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,$4bdecfa9
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[7] + $f6bb4b60), 16);
+  ADD R10D,[RDX + 4*7]
+  MOV EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,$f6bb4b60
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[10] + $bebfbc70), 23);
+  ADD R9D, [RDX + 4*10]
+  MOV EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, $bebfbc70
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[13] + $289b7ec6), 4);
+  ADD R8D, [RDX + 4*13]
+  MOV EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, $289b7ec6
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[0] + $eaa127fa), 11);
+  ADD R11D,[RDX + 4*0]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,$eaa127fa
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[3] + $d4ef3085), 16);
+  ADD R10D,[RDX + 4*3]
+  MOV EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,$d4ef3085
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[6] + $04881d05), 23);
+  ADD R9D, [RDX + 4*6]
+  MOV EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, $04881d05
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[9] + $d9d4d039), 4);
+  ADD R8D, [RDX + 4*9]
+  MOV EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, $d9d4d039
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[12] + $e6db99e5), 11);
+  ADD R11D,[RDX + 4*12]
+  MOV EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,$e6db99e5
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[15] + $1fa27cf8), 16);
+  ADD R10D,[RDX + 4*15]
+  MOV EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,$1fa27cf8
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  MOV EBX, -1 // Prepare a register of all 1s for Round 4.
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[2] + $c4ac5665), 23);
+  ADD R9D, [RDX + 4*2]
+  MOV EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, $c4ac5665
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+// Round 4 (throughout this round, "ANDN EAX, reg, EBX" stands in for "EAX := not reg")
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[0] + $f4292244), 6);
+  ADD  R8D, [RDX + 4*0]
+  ANDN EAX, R11D,EBX
+  ADD  R8D, $f4292244
+  OR   EAX, R9D
+  XOR  EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[7] + $432aff97), 10);
+  ADD  R11D,[RDX + 4*7]
+  ANDN EAX, R10D,EBX
+  ADD  R11D,$432aff97
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  R11D,EAX
+  ROL  R11D,10
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[14] + $ab9423a7), 15);
+  ADD  R10D,[RDX + 4*14]
+  ANDN EAX, R9D, EBX
+  ADD  R10D,$ab9423a7
+  OR   EAX, R11D
+  XOR  EAX, R8D
+  ADD  R10D,EAX
+  ROL  R10D,15
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[5] + $fc93a039), 21);
+  ADD  R9D, [RDX + 4*5]
+  ANDN EAX, R8D, EBX
+  ADD  R9D, $fc93a039
+  OR   EAX, R10D
+  XOR  EAX, R11D
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[12] + $655b59c3), 6);
+  ADD  R8D, [RDX + 4*12]
+  ANDN EAX, R11D,EBX
+  ADD  R8D, $655b59c3
+  OR   EAX, R9D
+  XOR  EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[3] + $8f0ccc92), 10);
+  ADD  R11D,[RDX + 4*3]
+  ANDN EAX, R10D,EBX
+  ADD  R11D,$8f0ccc92
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  R11D,EAX
+  ROL  R11D,10
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[10] + $ffeff47d), 15);
+  ADD  R10D,[RDX + 4*10]
+  ANDN EAX, R9D, EBX
+  ADD  R10D,$ffeff47d
+  OR   EAX, R11D
+  XOR  EAX, R8D
+  ADD  R10D,EAX
+  ROL  R10D,15
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[1] + $85845dd1), 21);
+  ADD  R9D, [RDX + 4*1]
+  ANDN EAX, R8D, EBX
+  ADD  R9D, $85845dd1
+  OR   EAX, R10D
+  XOR  EAX, R11D
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[8] + $6fa87e4f), 6);
+  ADD  R8D, [RDX + 4*8]
+  ANDN EAX, R11D,EBX
+  ADD  R8D, $6fa87e4f
+  OR   EAX, R9D
+  XOR  EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[15] + $fe2ce6e0), 10);
+  ADD  R11D,[RDX + 4*15]
+  ANDN EAX, R10D,EBX
+  ADD  R11D,$fe2ce6e0
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  R11D,EAX
+  ROL  R11D,10
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[6] + $a3014314), 15);
+  ADD  R10D,[RDX + 4*6]
+  ANDN EAX, R9D, EBX
+  ADD  R10D,$a3014314
+  OR   EAX, R11D
+  XOR  EAX, R8D
+  ADD  R10D,EAX
+  ROL  R10D,15
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[13] + $4e0811a1), 21);
+  ADD  R9D, [RDX + 4*13]
+  ANDN EAX, R8D, EBX
+  ADD  R9D, $4e0811a1
+  OR   EAX, R10D
+  XOR  EAX, R11D
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[4] + $f7537e82), 6);
+  ADD  R8D, [RDX + 4*4]
+  ANDN EAX, R11D,EBX
+  ADD  R8D, $f7537e82
+  OR   EAX, R9D
+  XOR  EAX, R10D
+  ADD  R8D, EAX
+  ROL  R8D, 6
+  ADD  R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[11] + $bd3af235), 10);
+  ADD  R11D,[RDX + 4*11]
+  ANDN EAX, R10D,EBX
+  ADD  R11D,$bd3af235
+  OR   EAX, R8D
+  XOR  EAX, R9D
+  ADD  R11D,EAX
+  ROL  R11D,10
+  ADD  R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[2] + $2ad7d2bb), 15);
+  ADD  R10D,[RDX + 4*2]
+  ANDN EAX, R9D, EBX
+  ADD  R10D,$2ad7d2bb
+  OR   EAX, R11D
+  XOR  EAX, R8D
+  ADD  R10D,EAX
+  ROL  R10D,15
+  ADD  R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[9] + $eb86d391), 21);
+  ADD  R9D, [RDX + 4*9]
+  ANDN EAX, R8D, EBX
+  ADD  R9D, $eb86d391
+  OR   EAX, R10D
+  XOR  EAX, R11D
+  ADD  R9D, EAX
+  ROL  R9D, 21
+  ADD  R9D, R10D
+
+  ADD TMDContext.State[RCX + 4*0], R8D //  Context.State[0 .. 3] += A, B, C, D
+  ADD TMDContext.State[RCX + 4*1], R9D
+  ADD TMDContext.State[RCX + 4*2], R10D
+  ADD TMDContext.State[RCX + 4*3], R11D
+
+//Inc(Context.Length,64);
+  ADD QWORD PTR TMDContext.Length[RCX],64
+
+  POP  RBX
+end;
+{$else CPUX86_HAS_BMI1}
+procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); assembler; nostackframe;
+// RCX = Context, RDX = Buffer
+{$asmmode intel}
+asm
+  // R8D = A, R9D = B, R10D = C, R11D = D
+  MOV R8D, TMDContext.State[RCX + 4*0] // A, B, C, D := Context.State[0 .. 3];
+  MOV R9D, TMDContext.State[RCX + 4*1]
+  MOV R10D,TMDContext.State[RCX + 4*2]
+  MOV R11D,TMDContext.State[RCX + 4*3]
+// Round 1
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[0] + $d76aa478), 7);
+  MOV EAX, R10D
+  ADD R8D, $d76aa478
+  XOR EAX, R11D
+  ADD R8D, [RDX + 4*0]
+  AND EAX, R9D
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[1] + $e8c7b756), 12);
+  MOV EAX, R9D
+  ADD R11D,$e8c7b756
+  XOR EAX, R10D
+  ADD R11D,[RDX + 4*1]
+  AND EAX, R8D
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,12
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[2] + $242070db), 17);
+  MOV EAX, R8D
+  ADD R10D,$242070db
+  XOR EAX, R9D
+  ADD R10D,[RDX + 4*2]
+  AND EAX, R11D
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,17
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[3] + $c1bdceee), 22);
+  MOV EAX, R11D
+  ADD R9D, $c1bdceee
+  XOR EAX, R8D
+  ADD R9D, [RDX + 4*3]
+  AND EAX, R10D
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[4] + $f57c0faf), 7);
+  MOV EAX, R10D
+  ADD R8D, $f57c0faf
+  XOR EAX, R11D
+  ADD R8D, [RDX + 4*4]
+  AND EAX, R9D
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[5] + $4787c62a), 12);
+  MOV EAX, R9D
+  ADD R11D,$4787c62a
+  XOR EAX, R10D
+  ADD R11D,[RDX + 4*5]
+  AND EAX, R8D
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,12
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[6] + $a8304613), 17);
+  MOV EAX, R8D
+  ADD R10D,$a8304613
+  XOR EAX, R9D
+  ADD R10D,[RDX + 4*6]
+  AND EAX, R11D
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,17
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[7] + $fd469501), 22);
+  MOV EAX, R11D
+  ADD R9D, $fd469501
+  XOR EAX, R8D
+  ADD R9D, [RDX + 4*7]
+  AND EAX, R10D
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[8] + $698098d8), 7);
+  MOV EAX, R10D
+  ADD R8D, $698098d8
+  XOR EAX, R11D
+  ADD R8D, [RDX + 4*8]
+  AND EAX, R9D
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[9] + $8b44f7af), 12);
+  MOV EAX, R9D
+  ADD R11D,$8b44f7af
+  XOR EAX, R10D
+  ADD R11D,[RDX + 4*9]
+  AND EAX, R8D
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,12
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[10] + $ffff5bb1), 17);
+  MOV EAX, R8D
+  ADD R10D,$ffff5bb1
+  XOR EAX, R9D
+  ADD R10D,[RDX + 4*10]
+  AND EAX, R11D
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,17
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[11] + $895cd7be), 22);
+  MOV EAX, R11D
+  ADD R9D, $895cd7be
+  XOR EAX, R8D
+  ADD R9D, [RDX + 4*11]
+  AND EAX, R10D
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R10D) or ((not R9D) and R11D)) + Data[12] + $6b901122), 7);
+  MOV EAX, R10D
+  ADD R8D, $6b901122
+  XOR EAX, R11D
+  ADD R8D, [RDX + 4*12]
+  AND EAX, R9D
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 7
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R9D) or ((not R8D) and R10D)) + Data[13] + $fd987193), 12);
+  MOV EAX, R9D
+  ADD R11D,$fd987193
+  XOR EAX, R10D
+  ADD R11D,[RDX + 4*13]
+  AND EAX, R8D
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,12
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R8D) or ((not R11D) and R9D)) + Data[14] + $a679438e), 17);
+  MOV EAX, R8D
+  ADD R10D,$a679438e
+  XOR EAX, R9D
+  ADD R10D,[RDX + 4*14]
+  AND EAX, R11D
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,17
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R11D) or ((not R10D) and R8D)) + Data[15] + $49b40821), 22);
+  MOV EAX, R11D
+  ADD R9D, $49b40821
+  XOR EAX, R8D
+  ADD R9D, [RDX + 4*15]
+  AND EAX, R10D
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 22
+  ADD R9D, R10D
+
+// Round 2
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or (R10D and (not R11D))) + Data[1] + $f61e2562), 5);
+  MOV EAX, R9D
+  ADD R8D, $f61e2562
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*1]
+  AND EAX, R11D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or (R9D and (not R10D))) + Data[6] + $c040b340), 9);
+  MOV EAX, R8D
+  ADD R11D,$c040b340
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*6]
+  AND EAX, R10D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,9
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or (R8D and (not R9D))) + Data[11] + $265e5a51), 14);
+  MOV EAX, R11D
+  ADD R10D,$265e5a51
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*11]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,14
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or (R11D and (not R8D))) + Data[0] + $e9b6c7aa), 20);
+  MOV EAX, R10D
+  ADD R9D, $e9b6c7aa
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*0]
+  AND EAX, R8D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or (R10D and (not R11D))) + Data[5] + $d62f105d), 5);
+  MOV EAX, R9D
+  ADD R8D, $d62f105d
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*5]
+  AND EAX, R11D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or (R9D and (not R10D))) + Data[10] + $02441453), 9);
+  MOV EAX, R8D
+  ADD R11D,$02441453
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*10]
+  AND EAX, R10D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,9
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or (R8D and (not R9D))) + Data[15] + $d8a1e681), 14);
+  MOV EAX, R11D
+  ADD R10D,$d8a1e681
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*15]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,14
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or (R11D and (not R8D))) + Data[4] + $e7d3fbc8), 20);
+  MOV EAX, R10D
+  ADD R9D, $e7d3fbc8
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*4]
+  AND EAX, R8D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or (R10D and (not R11D))) + Data[9] + $21e1cde6), 5);
+  MOV EAX, R9D
+  ADD R8D, $21e1cde6
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*9]
+  AND EAX, R11D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or (R9D and (not R10D))) + Data[14] + $c33707d6), 9);
+  MOV EAX, R8D
+  ADD R11D,$c33707d6
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*14]
+  AND EAX, R10D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,9
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or (R8D and (not R9D))) + Data[3] + $f4d50d87), 14);
+  MOV EAX, R11D
+  ADD R10D,$f4d50d87
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*3]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,14
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or (R11D and (not R8D))) + Data[8] + $455a14ed), 20);
+  MOV EAX, R10D
+  ADD R9D, $455a14ed
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*8]
+  AND EAX, R8D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + ((R9D and R11D) or (R10D and (not R11D))) + Data[13] + $a9e3e905), 5);
+  MOV EAX, R9D
+  ADD R8D, $a9e3e905
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*13]
+  AND EAX, R11D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 5
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + ((R8D and R10D) or (R9D and (not R10D))) + Data[2] + $fcefa3f8), 9);
+  MOV EAX, R8D
+  ADD R11D,$fcefa3f8
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*2]
+  AND EAX, R10D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,9
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + ((R11D and R9D) or (R8D and (not R9D))) + Data[7] + $676f02d9), 14);
+  MOV EAX, R11D
+  ADD R10D,$676f02d9
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*7]
+  AND EAX, R9D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,14
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + ((R10D and R8D) or (R11D and (not R8D))) + Data[12] + $8d2a4c8a), 20);
+  MOV EAX, R10D
+  ADD R9D, $8d2a4c8a
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*12]
+  AND EAX, R8D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 20
+  ADD R9D, R10D
+
+// Round 3
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[5] + $fffa3942), 4);
+  MOV EAX, R9D
+  ADD R8D, $fffa3942
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*5]
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[8] + $8771f681), 11);
+  MOV EAX, R8D
+  ADD R11D,$8771f681
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*8]
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[11] + $6d9d6122), 16);
+  MOV EAX, R11D
+  ADD R10D,$6d9d6122
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*11]
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[14] + $fde5380c), 23);
+  MOV EAX, R10D
+  ADD R9D, $fde5380c
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*14]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[1] + $a4beea44), 4);
+  MOV EAX, R9D
+  ADD R8D, $a4beea44
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*1]
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[4] + $4bdecfa9), 11);
+  MOV EAX, R8D
+  ADD R11D,$4bdecfa9
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*4]
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[7] + $f6bb4b60), 16);
+  MOV EAX, R11D
+  ADD R10D,$f6bb4b60
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*7]
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[10] + $bebfbc70), 23);
+  MOV EAX, R10D
+  ADD R9D, $bebfbc70
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*10]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[13] + $289b7ec6), 4);
+  MOV EAX, R9D
+  ADD R8D, $289b7ec6
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*13]
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[0] + $eaa127fa), 11);
+  MOV EAX, R8D
+  ADD R11D,$eaa127fa
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*0]
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[3] + $d4ef3085), 16);
+  MOV EAX, R11D
+  ADD R10D,$d4ef3085
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*3]
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[6] + $04881d05), 23);
+  MOV EAX, R10D
+  ADD R9D, $04881d05
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*6]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R9D xor R10D xor R11D) + Data[9] + $d9d4d039), 4);
+  MOV EAX, R9D
+  ADD R8D, $d9d4d039
+  XOR EAX, R10D
+  ADD R8D, [RDX + 4*9]
+  XOR EAX, R11D
+  ADD R8D, EAX
+  ROL R8D, 4
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R8D xor R9D xor R10D) + Data[12] + $e6db99e5), 11);
+  MOV EAX, R8D
+  ADD R11D,$e6db99e5
+  XOR EAX, R9D
+  ADD R11D,[RDX + 4*12]
+  XOR EAX, R10D
+  ADD R11D,EAX
+  ROL R11D,11
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R11D xor R8D xor R9D) + Data[15] + $1fa27cf8), 16);
+  MOV EAX, R11D
+  ADD R10D,$1fa27cf8
+  XOR EAX, R8D
+  ADD R10D,[RDX + 4*15]
+  XOR EAX, R9D
+  ADD R10D,EAX
+  ROL R10D,16
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R10D xor R11D xor R8D) + Data[2] + $c4ac5665), 23);
+  MOV EAX, R10D
+  ADD R9D, $c4ac5665
+  XOR EAX, R11D
+  ADD R9D, [RDX + 4*2]
+  XOR EAX, R8D
+  ADD R9D, EAX
+  ROL R9D, 23
+  ADD R9D, R10D
+
+// Round 4
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[0] + $f4292244), 6);
+  MOV EAX, R11D
+  ADD R8D, $f4292244
+  NOT EAX
+  ADD R8D, [RDX + 4*0]
+  OR  EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[7] + $432aff97), 10);
+  MOV EAX, R10D
+  ADD R11D,$432aff97
+  NOT EAX
+  ADD R11D,[RDX + 4*7]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,10
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[14] + $ab9423a7), 15);
+  MOV EAX, R9D
+  ADD R10D,$ab9423a7
+  NOT EAX
+  ADD R10D,[RDX + 4*14]
+  OR  EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,15
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[5] + $fc93a039), 21);
+  MOV EAX, R8D
+  ADD R9D, $fc93a039
+  NOT EAX
+  ADD R9D, [RDX + 4*5]
+  OR  EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[12] + $655b59c3), 6);
+  MOV EAX, R11D
+  ADD R8D, $655b59c3
+  NOT EAX
+  ADD R8D, [RDX + 4*12]
+  OR  EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[3] + $8f0ccc92), 10);
+  MOV EAX, R10D
+  ADD R11D,$8f0ccc92
+  NOT EAX
+  ADD R11D,[RDX + 4*3]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,10
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[10] + $ffeff47d), 15);
+  MOV EAX, R9D
+  ADD R10D,$ffeff47d
+  NOT EAX
+  ADD R10D,[RDX + 4*10]
+  OR  EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,15
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[1] + $85845dd1), 21);
+  MOV EAX, R8D
+  ADD R9D, $85845dd1
+  NOT EAX
+  ADD R9D, [RDX + 4*1]
+  OR  EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[8] + $6fa87e4f), 6);
+  MOV EAX, R11D
+  ADD R8D, $6fa87e4f
+  NOT EAX
+  ADD R8D, [RDX + 4*8]
+  OR  EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[15] + $fe2ce6e0), 10);
+  MOV EAX, R10D
+  ADD R11D,$fe2ce6e0
+  NOT EAX
+  ADD R11D,[RDX + 4*15]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,10
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[6] + $a3014314), 15);
+  MOV EAX, R9D
+  ADD R10D,$a3014314
+  NOT EAX
+  ADD R10D,[RDX + 4*6]
+  OR  EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,15
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[13] + $4e0811a1), 21);
+  MOV EAX, R8D
+  ADD R9D, $4e0811a1
+  NOT EAX
+  ADD R9D, [RDX + 4*13]
+  OR  EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, R10D
+
+//R8D := R9D + roldword(dword(R8D + (R10D xor (R9D or (not R11D))) + Data[4] + $f7537e82), 6);
+  MOV EAX, R11D
+  ADD R8D, $f7537e82
+  NOT EAX
+  ADD R8D, [RDX + 4*4]
+  OR  EAX, R9D
+  XOR EAX, R10D
+  ADD R8D, EAX
+  ROL R8D, 6
+  ADD R8D, R9D
+
+//R11D := R8D + roldword(dword(R11D + (R9D xor (R8D or (not R10D))) + Data[11] + $bd3af235), 10);
+  MOV EAX, R10D
+  ADD R11D,$bd3af235
+  NOT EAX
+  ADD R11D,[RDX + 4*11]
+  OR  EAX, R8D
+  XOR EAX, R9D
+  ADD R11D,EAX
+  ROL R11D,10
+  ADD R11D,R8D
+
+//R10D := R11D + roldword(dword(R10D + (R8D xor (R11D or (not R9D))) + Data[2] + $2ad7d2bb), 15);
+  MOV EAX, R9D
+  ADD R10D,$2ad7d2bb
+  NOT EAX
+  ADD R10D,[RDX + 4*2]
+  OR  EAX, R11D
+  XOR EAX, R8D
+  ADD R10D,EAX
+  ROL R10D,15
+  ADD R10D,R11D
+
+//R9D := R10D + roldword(dword(R9D + (R11D xor (R10D or (not R8D))) + Data[9] + $eb86d391), 21);
+  MOV EAX, R8D
+  ADD R9D, $eb86d391
+  NOT EAX
+  ADD R9D, [RDX + 4*9]
+  OR  EAX, R10D
+  XOR EAX, R11D
+  ADD R9D, EAX
+  ROL R9D, 21
+  ADD R9D, R10D
+
+  ADD TMDContext.State[RCX + 4*0], R8D //  Context.State[0 .. 3] += A, B, C, D
+  ADD TMDContext.State[RCX + 4*1], R9D
+  ADD TMDContext.State[RCX + 4*2], R10D
+  ADD TMDContext.State[RCX + 4*3], R11D
+
+//Inc(Context.Length,64);
+  ADD QWORD PTR TMDContext.Length[RCX],64
+end;
+{$endif CPUX86_HAS_BMI1}

packages/libfontconfig/examples/testfc.pp

@@ -4,7 +4,7 @@ Var
   FC : PFcConfig;
   FL : PFcStrList;
   P : PAnsiChar;
-
+  FN,FN2 : PAnsiChar;
 begin
   Writeln('Load 1: ',loadfontconfiglib(''));
   Writeln('Load 2: ',loadfontconfiglib(''));
@@ -14,6 +14,31 @@ begin
     Writeln('Failed to load config');
     Halt(1);
     end;
+  if assigned(FcGetVersion) then
+    writeln('FontConfig version: ',FcGetVersion);
+
+  if assigned(FcConfigFilename) then
+    begin
+      FN:=FcConfigFilename(Nil);
+      Writeln('Default config file is: ',FN,' using deprecated FcConfigFilename function');
+    end;
+  if assigned(FcConfigGetFilename) then
+    begin
+      FN2:=FcConfigGetFilename(FC,Nil);
+      Writeln('Default config file is: ',FN2,' using FcConfigGetFilename function');
+    end;
+  FL:=FcConfigGetConfigFiles(FC);
+  if FL<>Nil then
+    begin
+    P:=FcStrListNext(FL);
+    While P<>Nil do
+      begin
+      Writeln('Config file: ',P);
+      P:=FcStrListNext(FL);
+      end;
+    FcStrListDone(FL);
+    end;
+
   FL:=FcConfigGetFontDirs(FC);
   if FL<>Nil then
     begin

packages/libfontconfig/fpmake.pp

@@ -20,7 +20,7 @@ begin
     P.Version:='3.3.1';
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');
-    P.OSes := [linux,freebsd, darwin]; // Darwin was tested!
+    P.OSes := [linux] + AllBSDOses; // Darwin was tested!
     T:=P.Targets.AddUnit('libfontconfig.pp');
     P.ExamplePath.Add('examples');
     P.Targets.AddExampleProgram('testfc.pp');

packages/libfontconfig/src/libfontconfig.pp

@@ -34,6 +34,11 @@ Const
 {$else}  
   DefaultLibName = 'libfontconfig.dylib';
 {$endif}  
+{$ifdef MSWINDOWS}
+  {$calling stdcall}
+{$else}
+  {$calling cdecl}
+{$endif}
 
 const
   FC_MAJOR = 2;    
@@ -336,7 +341,8 @@ var
   FcCacheCreateTagFile : procedure(config:PFcConfig);
   FcConfigHome : function:PFcChar8;
   FcConfigEnableHome : function(enable:TFcBool):TFcBool;
-  FcConfigFilename : function(url:PFcChar8):PFcChar8;
+  FcConfigFilename : function(name:PFcChar8):PFcChar8;
+  FcConfigGetFilename : function(config:PFcConfig; name:PFcChar8):PFcChar8;
   FcConfigCreate : function:PFcConfig;
   FcConfigReference : function(config:PFcConfig):PFcConfig;
   FcConfigDestroy : procedure(config:PFcConfig);
@@ -620,6 +626,7 @@ begin
   FcConfigHome:=nil;
   FcConfigEnableHome:=nil;
   FcConfigFilename:=nil;
+  FcConfigGetFilename:=nil;
   FcConfigCreate:=nil;
   FcConfigReference:=nil;
   FcConfigDestroy:=nil;
@@ -838,6 +845,7 @@ begin
   pointer(FcConfigHome):=GetProcAddress(hlib,'FcConfigHome');
   pointer(FcConfigEnableHome):=GetProcAddress(hlib,'FcConfigEnableHome');
   pointer(FcConfigFilename):=GetProcAddress(hlib,'FcConfigFilename');
+  pointer(FcConfigGetFilename):=GetProcAddress(hlib,'FcConfigGetFilename');
   pointer(FcConfigCreate):=GetProcAddress(hlib,'FcConfigCreate');
   pointer(FcConfigReference):=GetProcAddress(hlib,'FcConfigReference');
   pointer(FcConfigDestroy):=GetProcAddress(hlib,'FcConfigDestroy');

packages/libusb/src/libusb.pp

@@ -781,6 +781,7 @@ type
         end;
 
       plibusb_device=^libusb_device;
+      pplibusb_device=^plibusb_device;
       libusb_device = record
           {undefined structure}
         end;
@@ -1156,8 +1157,8 @@ function libusb_error_name(errcode:integer):pansichar;LIBUSB_CALL;external libus
 function libusb_setlocale(const locale:pansichar):integer;LIBUSB_CALL;external libusb1;
 
 function libusb_strerror(errcode:libusb_error):pansichar;LIBUSB_CALL;external libusb1;
-function libusb_get_device_list(ctx:plibusb_context;var list:plibusb_device):ssize_t;LIBUSB_CALL;external libusb1;
-procedure libusb_free_device_list(list:plibusb_device;unref_devices:integer);LIBUSB_CALL;external libusb1;
+function libusb_get_device_list(ctx:plibusb_context;var list:pplibusb_device):ssize_t;LIBUSB_CALL;external libusb1;
+procedure libusb_free_device_list(list:pplibusb_device;unref_devices:integer);LIBUSB_CALL;external libusb1;
 function libusb_ref_device(dev:plibusb_device):plibusb_device;LIBUSB_CALL;external libusb1;
 procedure libusb_unref_device(dev:plibusb_device);LIBUSB_CALL;external libusb1;
 function libusb_get_configuration(dev:plibusb_device_handle;

packages/pastojs/src/fppas2js.pp

@@ -6750,8 +6750,65 @@ function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
     Note that invalid UTF-8 sequences are checked by the scanner
 }
 var
-  p, StartP, i, l: integer;
+  p, StartP, l: integer;
+
+  procedure Err(id: TMaxPrecInt);
+  begin
+    RaiseMsg(id,nIllegalCharConst,sIllegalCharConst,[],El);
+  end;
+
+  function ReadNumber: integer;
+  var
+    c: AnsiChar;
+  begin
+    Result:=0;
+    inc(p);
+    if p>l then
+      Err(20170207155121);
+    if S[p]='$' then
+      begin
+      // #$hexnumber
+      inc(p);
+      StartP:=p;
+      while p<=l do
+        begin
+        c:=S[p];
+        case c of
+        '0'..'9': Result:=Result*16+ord(c)-ord('0');
+        'a'..'f': Result:=Result*16+ord(c)-ord('a')+10;
+        'A'..'F': Result:=Result*16+ord(c)-ord('A')+10;
+        else break;
+        end;
+        if Result>$10ffff then
+          Err(20170207164657);
+        inc(p);
+        end;
+      if p=StartP then
+        Err(20170207164956);
+      end
+    else
+      begin
+      // #decimalnumber
+      StartP:=p;
+      while p<=l do
+        begin
+        c:=S[p];
+        case c of
+        '0'..'9': Result:=Result*10+ord(c)-ord('0');
+        else break;
+        end;
+        if Result>$10ffff then
+          Err(20170207171140);
+        inc(p);
+        end;
+      if p=StartP then
+        Err(20170207171148);
+      end;
+  end;
+
+var
   c: AnsiChar;
+  i, j: Integer;
 begin
   Result:='';
   {$IFDEF VerbosePas2JS}
@@ -6769,7 +6826,7 @@ begin
       StartP:=p;
       repeat
         if p>l then
-          RaiseInternalError(20170207155120);
+          Err(20170207155120);
         c:=S[p];
         case c of
         '''':
@@ -6793,69 +6850,37 @@ begin
       end;
     '#':
       begin
-      // word sequence
-      inc(p);
-      if p>l then
-        RaiseInternalError(20170207155121);
-      if S[p]='$' then
+      // number
+      i:=ReadNumber;
+      if (i>=$D800) and (i<=$DFFF) and (p<l) and (S[p]='#') then
         begin
-        // #$hexnumber
-        inc(p);
-        StartP:=p;
-        i:=0;
-        while p<=l do
-          begin
-          c:=S[p];
-          case c of
-          '0'..'9': i:=i*16+ord(c)-ord('0');
-          'a'..'f': i:=i*16+ord(c)-ord('a')+10;
-          'A'..'F': i:=i*16+ord(c)-ord('A')+10;
-          else break;
-          end;
-          if i>$10ffff then
-            RaiseNotYetImplemented(20170207164657,El,'maximum codepoint is $10ffff');
-          inc(p);
-          end;
-        if p=StartP then
-          RaiseInternalError(20170207164956);
+        // surrogate
+        j:=ReadNumber;
+        if (j>=$DC00) and (j<$DFFF) then
+          Result:=Result+CodePointToJSString((i and $3FF) shl 10 + (j and $3ff) + $10000)
+        else
+          // invalid surrogate -> write as two \u
+          Result:=Result+CodePointToJSString(i)+CodePointToJSString(j)
         end
       else
-        begin
-        // #decimalnumber
-        StartP:=p;
-        i:=0;
-        while p<=l do
-          begin
-          c:=S[p];
-          case c of
-          '0'..'9': i:=i*10+ord(c)-ord('0');
-          else break;
-          end;
-          if i>$10ffff then
-            RaiseNotYetImplemented(20170207171140,El,'maximum codepoint is $10ffff');
-          inc(p);
-          end;
-        if p=StartP then
-          RaiseInternalError(20170207171148);
-        end;
-      Result:=Result+CodePointToJSString(i);
+        Result:=Result+CodePointToJSString(i);
       end;
     '^':
       begin
       // ^A is #1
       inc(p);
       if p>l then
-        RaiseInternalError(20181025125920);
+        Err(20181025125920);
       c:=S[p];
       case c of
       'a'..'z': Result:=Result+TJSChar(ord(c)-ord('a')+1);
       'A'..'Z': Result:=Result+TJSChar(ord(c)-ord('A')+1);
-      else RaiseInternalError(20170207160412);
+      else Err(20170207160412);
       end;
       inc(p);
       end;
     else
-      RaiseNotYetImplemented(20170207154653,El,'ord='+IntToStr(ord(S[p])));
+      Err(20170207154653);
     end;
   {$IFDEF VerbosePas2JS}
   {AllowWriteln}
@@ -21215,7 +21240,15 @@ begin
       // check visibility
       case mt of
       mtClass:
-        if (P.Visibility<>visPublished) and (not P.InheritsFrom(TPasConstructor) or (P.Visibility <> visPublic)) then continue;
+        if (P.Visibility=visPublished) then
+          // published member
+        else if (P is TPasConstructor) and (P.Visibility = visPublic)
+            and (pcsfPublished in TPas2JSClassScope(El.CustomData).Flags) then
+          // this class supports published members -> add public constructor to RTTI
+          // workaround til extended RTTI
+          // see issue #37752
+        else
+          continue;
       mtInterface: ; // all members of an interface are published
       mtRecord:
         // a published record publishes all non private members

packages/pastojs/tests/tcmodules.pas

@@ -8847,6 +8847,7 @@ begin
   '  s: string;',
   'begin',
   '  s:=''😊'';', // 1F60A
+  '  s:=''Hello ''#55357#56841', // #$D83D#$DE09
   '']);
   ConvertProgram;
   CheckSource('TestStringConstSurrogate',
@@ -8854,7 +8855,8 @@ begin
     'this.s="";'
     ]),
     LinesToStr([
-    '$mod.s="😊";'
+    '$mod.s="😊";',
+    '$mod.s="Hello 😉";'
     ]));
 end;
 

packages/regexpr/patch/current.diff

@@ -0,0 +1,50 @@
+0a1
+> {$IFNDEF FPC_DOTTEDUNITS}
+1a3
+> {$ENDIF FPC_DOTTEDUNITS}
+67c69
+< {$I regexpr_compilers.inc}
+---
+> 
+72d73
+< {$IFDEF FPC}
+75c76
+< {$ENDIF}
+---
+> {$DEFINE COMPAT}
+77c78
+< {$DEFINE UnicodeRE} // Use WideChar for characters and UnicodeString/WideString for strings
+---
+> { off $DEFINE UnicodeRE} // Use WideChar for characters and UnicodeString/WideString for strings
+79,89c80,83
+< { off $DEFINE UseWordChars} // Use WordChars property, otherwise fixed list 'a'..'z','A'..'Z','0'..'9','_' 
+< { off $DEFINE UseSpaceChars} // Use SpaceChars property, otherwise fixed list
+< { off $DEFINE UseLineSep} // Use LineSeparators property, otherwise fixed line-break chars
+< {$IFDEF UNICODE}
+<   {$IFNDEF UnicodeRE}
+<   {$MESSAGE ERROR 'You cannot undefine UnicodeRE for Unicode Delphi versions'}
+<   {$ENDIF}
+< {$ENDIF}
+< {$IFDEF FPC}
+<   {$DEFINE FastUnicodeData} // Use arrays for UpperCase/LowerCase/IsWordChar, they take 320K more memory
+< {$ENDIF}
+---
+> {$DEFINE UseWordChars} // Use WordChars property, otherwise fixed list 'a'..'z','A'..'Z','0'..'9','_'
+> {$DEFINE UseSpaceChars} // Use SpaceChars property, otherwise fixed list
+> {$DEFINE UseLineSep} // Use LineSeparators property, otherwise fixed line-break chars
+> { off $DEFINE FastUnicodeData} // Use arrays for UpperCase/LowerCase/IsWordChar, they take 320K more memory
+116a111,122
+> {$IFDEF FPC_DOTTEDUNITS}
+> uses
+>   System.SysUtils, // Exception
+>   {$IFDEF D2009}
+>     {$IFDEF D_XE2}
+>     System.System.Character,
+>     {$ELSE}
+>     System.Character,
+>     {$ENDIF}
+>   {$ENDIF}
+>   System.Classes; // TStrings in Split method
+> {$ELSE FPC_DOTTEDUNITS}
+126a133
+> {$ENDIF FPC_DOTTEDUNITS}

packages/regexpr/patch/current.txt

@@ -0,0 +1,6 @@
+
+Original TRegexpr repo is at https://github.com/andgineer/TRegExpr.git
+
+Diff between our code and original was last taken on rev. 4ff33af23055c03757761ea6df351f7a57eac8c4
+
+Please update the revision when you update the regexpr unit.

packages/rtl-objpas/fpmake.pp

@@ -65,7 +65,12 @@ begin
     P.IncludePath.Add('src/common',CommonSrcOSes);
 
     T:=P.Targets.AddUnit('system.uitypes.pp',uitypesOses);
+    T:=P.Targets.AddUnit('system.uiconsts.pp',uitypesOses);
+      T.Dependencies.AddUnit('system.uitypes');
     T:=P.Targets.AddUnit('system.timespan.pp',uitypesOses);
+    
+    T:=P.Targets.AddUnit('system.actions.pp',UItypesOSes);
+      T.Dependencies.AddUnit('system.uitypes');
 
     T:=P.Targets.AddUnit('strutils.pp',StrUtilsOses);
       T.ResourceStrings:=true;

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

@@ -622,7 +622,7 @@ end;
 
 Function DateOf(const AValue: TDateTime): TDateTime; inline;
 begin
-  Result:=Trunc(AValue);
+  Result:=Int(AValue);
 end;
 
 

packages/rtl-objpas/src/inc/system.actions.pp

@@ -0,0 +1,1486 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2023 by Michael Van Canneyt
+        member of the Free Pascal development team.
+
+    Delphi compatibility unit with action(list) related types.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit System.Actions;
+
+{$MODE OBJFPC}
+{$H+}
+{$modeswitch functionreferences}
+{$modeswitch anonymousfunctions}
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils, System.Classes, System.UITypes;
+{$ELSE}
+  SysUtils, Classes , system.uitypes;
+{$ENDIF}
+
+type
+  EActionError = class(Exception);
+
+  // Some aliases to avoid confusion
+  TShortCut = {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Classes.TShortCut;
+  TImageIndex = System.UITypes.TImageIndex;
+
+  TStatusAction = (
+    saNone,
+    saTrivial,
+    saDefault,
+    saRequiredEmpty,
+    saRequired,
+    saValid,
+    saInvalid,
+    saWaiting,
+    saWarning,
+    saUnused,
+    saCalculated,
+    saError,
+    saOther);
+
+  TContainedActionList = class;
+  TContainedActionListClass = class of TContainedActionList;
+
+  TCustomShortCutList = class(TStringList)
+  private
+    function GetShortCut(Index: Integer): TShortCut; inline;
+  public
+    function IndexOfShortCut(const ShortCut: TShortCut): Integer; overload;
+    function IndexOfShortCut(const ShortCut: string): Integer; overload;
+    property ShortCuts[Index: Integer]: TShortCut read GetShortCut;
+  end;
+
+  { TContainedAction }
+
+  TContainedAction = class(TBasicAction)
+  private
+    FActionList: TContainedActionList;
+    FAutoCheck: Boolean;
+    FCaption: string;
+    FCategory: string;
+    FChecked: Boolean;
+    FDisableIfNoHandler: Boolean;
+    FEnabled: Boolean;
+    FGroupIndex: Integer;
+    FHelpContext: THelpContext;
+    FHelpKeyword: string;
+    FHelpType: THelpType;
+    FHint: string;
+    FImageIndex: Integer;
+    FOnHint: THintEvent;
+    FSavedEnabledState: Boolean;
+    FShortCut: TShortCut;
+    FStatusAction: TStatusAction;
+    FVisible: Boolean;
+    FSecondaryShortCuts : TCustomShortCutList;
+    function GetIndex: Integer;
+    function GetSecondaryShortCuts: TCustomShortCutList;
+    function IsSecondaryShortCutsStored: Boolean;
+    procedure SetActionList(AValue: TContainedActionList);
+    procedure SetCategory(AValue: string);
+    procedure SetIndex(AValue: Integer);
+    procedure SetSecondaryShortCuts(AValue: TCustomShortCutList);
+  protected
+    procedure ReadState(Reader: TReader); override;
+    function SecondaryShortCutsCreated: boolean;
+    function CreateShortCutList: TCustomShortCutList; virtual;
+    property SavedEnabledState: Boolean read FSavedEnabledState write FSavedEnabledState;
+    function HandleShortCut: Boolean; virtual;
+
+    procedure SetAutoCheck(Value: Boolean); virtual;
+    procedure SetCaption(const Value: string); virtual;
+    procedure SetName(const Value: TComponentName); override;
+    procedure SetChecked(Value: Boolean); virtual;
+    procedure SetEnabled(Value: Boolean); virtual;
+    procedure SetGroupIndex(const Value: Integer); virtual;
+    procedure SetHelpContext(Value: THelpContext); virtual;
+    procedure SetHelpKeyword(const Value: string); virtual;
+    procedure SetHelpType(Value: THelpType); virtual;
+    procedure SetHint(const Value: string); virtual;
+    procedure SetVisible(Value: Boolean); virtual;
+    procedure SetShortCut(Value: TShortCut); virtual;
+    procedure SetImageIndex(Value: TImageIndex); virtual;
+    procedure SetStatusAction(const Value: TStatusAction); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Assign(Source: TPersistent); override;
+    function GetParentComponent: TComponent; override;
+    function HasParent: Boolean; override;
+    procedure SetParentComponent(AParent: TComponent); override;
+    property ActionList: TContainedActionList read FActionList write SetActionList;
+    function Suspended: Boolean; override;
+    property Index: Integer read GetIndex write SetIndex stored False;
+    property DisableIfNoHandler: Boolean read FDisableIfNoHandler write FDisableIfNoHandler default True;
+    property AutoCheck: Boolean read FAutoCheck write SetAutoCheck default False;
+    property Caption: string read FCaption write SetCaption;
+    property Checked: Boolean read FChecked write SetChecked default False;
+    property Enabled: Boolean read FEnabled write SetEnabled default True;
+    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
+    property HelpContext: THelpContext read FHelpContext write SetHelpContext default 0;
+    property HelpKeyword: string read FHelpKeyword write SetHelpKeyword;
+    property HelpType: THelpType read FHelpType write SetHelpType default htKeyword;
+    property Hint: string read FHint write SetHint;
+    property Visible: Boolean read FVisible write SetVisible default True;
+    property ShortCut: TShortCut read FShortCut write SetShortCut default 0;
+    property SecondaryShortCuts: TCustomShortCutList read GetSecondaryShortCuts  write SetSecondaryShortCuts stored IsSecondaryShortCutsStored;
+    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
+    function DoHint(var HintStr: string): Boolean; dynamic;
+    property OnHint: THintEvent read FOnHint write FOnHint;
+    property StatusAction: TStatusAction read FStatusAction write SetStatusAction;
+  published
+    property Category: string read FCategory write SetCategory;
+  end;
+
+  TContainedActionLink = class(TBasicActionLink)
+  protected
+    procedure DefaultIsLinked(var Result: Boolean); virtual;
+    function IsCaptionLinked: Boolean; virtual;
+    function IsCheckedLinked: Boolean; virtual;
+    function IsEnabledLinked: Boolean; virtual;
+    function IsGroupIndexLinked: Boolean; virtual;
+    function IsHelpContextLinked: Boolean; virtual;
+    function IsHelpLinked: Boolean; virtual;
+    function IsHintLinked: Boolean; virtual;
+    function IsImageIndexLinked: Boolean; virtual;
+    function IsShortCutLinked: Boolean; virtual;
+    function IsVisibleLinked: Boolean; virtual;
+    function IsStatusActionLinked: Boolean; virtual;
+    procedure SetAutoCheck(Value: Boolean); virtual;
+    procedure SetCaption(const Value: string); virtual;
+    procedure SetChecked(Value: Boolean); virtual;
+    procedure SetEnabled(Value: Boolean); virtual;
+    procedure SetGroupIndex(Value: Integer); virtual;
+    procedure SetHelpContext(Value: THelpContext); virtual;
+    procedure SetHelpKeyword(const Value: string); virtual;
+    procedure SetHelpType(Value: THelpType); virtual;
+    procedure SetHint(const Value: string); virtual;
+    procedure SetImageIndex(Value: Integer); virtual;
+    procedure SetShortCut(Value: TShortCut); virtual;
+    procedure SetVisible(Value: Boolean); virtual;
+    procedure SetStatusAction(const Value: TStatusAction); virtual;
+  end;
+
+  TContainedActionLinkClass = class of TContainedActionLink;
+  TContainedActionClass = class of TContainedAction;
+
+  TActionListState = (asNormal,asSuspended,asSuspendedEnabled);
+
+  TActionListEnumerator = class
+  private
+    FPosition: Integer;
+    FList: TContainedActionList;
+  Protected  
+    function GetCurrent: TContainedAction; inline;
+  public
+    constructor Create(AList: TContainedActionList);
+    function MoveNext: Boolean; inline;
+    property Current: TContainedAction read GetCurrent;
+  end;
+
+  TEnumActionListEvent = procedure(const Action: TContainedAction; var Done: boolean) of object;
+  TEnumActionListRef = reference to procedure(const Action: TContainedAction; var Done: boolean);
+
+  { TContainedActionList }
+
+  TContainedActionList = class(TComponent)
+  private
+    FList: TFPList;
+    FOnChange: TNotifyEvent;
+    FOnExecute: TActionEvent;
+    FOnUpdate: TActionEvent;
+    FState: TActionListState;
+    FOnStateChange: TNotifyEvent;
+    procedure CorrectActionStates(ReEnabled: Boolean);
+    function GetAction(Index: Integer): TContainedAction;
+    procedure SetAction(Index: Integer; aValue: TContainedAction);
+    function GetActionCount: Integer;
+  protected
+    Procedure SetActionIndex(Action : TContainedAction; aValue: Integer);
+    procedure AddAction(const aAction: TContainedAction);
+    procedure RemoveAction(const aAction: TContainedAction);
+    procedure Change; virtual;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure SetChildOrder(Component: TComponent; Order: Integer); override;
+    procedure SetState(const aValue: TActionListState); virtual;
+    procedure GetActionsInCategory(const ACategory: string; aList: TFPList; IncludeSubCategory: Boolean);
+    function SameCategory(const Source, Dest: string;
+                          const IncludeSubCategory: Boolean = True): Boolean;
+    function Suspended : Boolean;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnExecute: TActionEvent read FOnExecute write FOnExecute;
+    property OnUpdate: TActionEvent read FOnUpdate write FOnUpdate;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    Function IndexOfAction(Action : TBasicAction) : Integer;
+    function ExecuteAction(Action: TBasicAction): Boolean; override;
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+    function GetEnumerator: TActionListEnumerator;
+    function UpdateAction(Action: TBasicAction): Boolean; override;
+    function EnumByCategory(Proc: TEnumActionListEvent; const Category: string; const IncludeSubCategory: Boolean = True): boolean;
+    function EnumByCategory(Proc: TEnumActionListRef; const Category: string;  const IncludeSubCategory: Boolean = True): boolean; 
+    property Actions[Index: Integer]: TContainedAction read GetAction write SetAction; default;
+    property ActionCount: Integer read GetActionCount;
+    property State: TActionListState read FState write SetState default asNormal;
+    property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
+  end;
+
+type
+  TEnumActionProcInfo = Pointer;
+  TEnumActionProc = procedure(const Category: string; ActionClass: TBasicActionClass; Info: TEnumActionProcInfo) of object;
+
+procedure RegisterActions(const CategoryName: string; const AClasses: array of TBasicActionClass; Resource: TComponentClass);
+procedure UnRegisterActions(const AClasses: array of TBasicActionClass);
+procedure EnumRegisteredActions(Proc: TEnumActionProc; Info: TEnumActionProcInfo; FrameworkType: string = '');
+function CreateAction(AOwner: TComponent; ActionClass: TBasicActionClass; FrameworkType: string = ''): TBasicAction;
+
+Type
+  TRegisterActionsProc = procedure(const aCategoryName: string; const aClasses: array of TBasicActionClass; aResource: TComponentClass);
+  TUnRegisterActionsProc = procedure(const AClasses: array of TBasicActionClass);
+  TEnumRegisteredActionsProc = procedure(Proc: TEnumActionProc; aInfo: Pointer; const aFrameworkType: string);
+  TCreateActionProc = function(AOwner: TComponent; aActionClass: TBasicActionClass; const aFrameworkType: string): TBasicAction;
+                             
+var
+  vDesignAction: boolean;
+  RegisterActionsProc: TRegisterActionsProc = nil;
+  UnRegisterActionsProc: TUnRegisterActionsProc = Nil;
+  EnumRegisteredActionsProc: TEnumRegisteredActionsProc = Nil;
+  CreateActionProc: TCreateActionProc = Nil;
+
+function RegisterShortCut(aShortCut: TShortCut; Index: integer = -1): integer;
+function UnregisterShortCut(aShortCut: TShortCut): boolean;
+function RegisteredShortCutCount: integer;
+function RegisteredShortCut(Idx: integer): TShortCut;
+
+implementation
+
+Resourcestring
+  SErrNoRegisterActionsProc = 'No register actions handler';
+  SErrNoUnRegisterActionsProc = 'No register actions handler';
+  SErrNoEnumActionsProc = 'No enumerate actions handler';
+  SErrNoCreateActionsProc = 'No action creation handler';
+  SErrIndexOutOfBounds = 'Index %d out of bounds [%d,%d]';
+
+{ ---------------------------------------------------------------------
+  Action registry hooks
+  ---------------------------------------------------------------------}
+
+procedure RegisterActions(const CategoryName: string; const AClasses: array of TBasicActionClass;
+  Resource: TComponentClass);
+begin
+  if not Assigned(RegisterActionsProc) then
+    raise EActionError.Create(SErrNoRegisterActionsProc);
+  RegisterActionsProc(CategoryName, AClasses, Resource);
+end;
+
+procedure UnRegisterActions(const AClasses: array of TBasicActionClass);
+begin
+  if not Assigned(UnRegisterActionsProc) then
+    raise EActionError.Create(SErrNoUnRegisterActionsProc);
+  UnRegisterActionsProc(AClasses)
+end;
+
+procedure EnumRegisteredActions(Proc: TEnumActionProc; Info: TEnumActionProcInfo; FrameworkType: string = '');
+begin
+  if not Assigned(EnumRegisteredActionsProc) then
+    raise EActionError.Create(SErrNoEnumActionsProc);
+  EnumRegisteredActionsProc(Proc, Info, FrameworkType)
+end;
+
+function CreateAction(AOwner: TComponent; ActionClass: TBasicActionClass; FrameworkType: string = ''): TBasicAction;
+
+var
+  Old: boolean;
+  
+begin
+  if not Assigned(CreateActionProc) then
+    raise EActionError.Create(SErrNoCreateActionsProc);  
+  Old:=vDesignAction;
+  try
+    vDesignAction:=True;
+    Result:=CreateActionProc(AOwner,ActionClass,FrameworkType)
+  finally
+    vDesignAction:=old;
+  end;
+end;
+
+{ ---------------------------------------------------------------------
+  TCustomShortCutList 
+  ---------------------------------------------------------------------}
+
+function TCustomShortCutList.GetShortCut(Index: Integer): TShortCut;
+begin
+  Result:=TShortCut(PtrInt(Objects[Index]));
+end;
+
+function TCustomShortCutList.IndexOfShortCut(const ShortCut: TShortCut): Integer;
+var
+  I: Integer;
+begin
+  Result := -1;
+  for I := 0 to Count - 1 do
+    if TShortCut(PtrInt(Objects[I])) = ShortCut then
+    begin
+      Result := I;
+      break;
+    end;
+end;
+
+function TCustomShortCutList.IndexOfShortCut(const ShortCut: string): Integer;
+
+  function Normalize(S: string): string;
+  begin
+    Result:=UpperCase(StringReplace(S, ' ', '', [rfReplaceAll]));
+  end;
+  
+var
+  S: string;
+  I: Integer;
+
+
+begin
+  Result:=-1;
+  if Trim(ShortCut)='' then
+    exit;
+  S:=Normalize(Shortcut);
+  for I:=Count-1 downto 0 do
+    if Normalize(Strings[I])=S then
+      Exit(I);
+end;
+
+
+{ ---------------------------------------------------------------------
+  TActionListEnumerator
+  ---------------------------------------------------------------------}
+
+constructor TActionListEnumerator.Create(AList: TContainedActionList);
+begin
+  inherited Create;
+  FPosition:=-1;
+  FList:=aList;
+end;
+
+function TActionListEnumerator.GetCurrent: TContainedAction;
+begin
+  Result:=FList[FPosition];
+end;
+
+function TActionListEnumerator.MoveNext: Boolean;
+begin
+  Inc(FPosition);
+  Result:=(FPosition<FList.ActionCount);
+end;
+
+{ ---------------------------------------------------------------------
+  TContainedActionList
+  ---------------------------------------------------------------------}
+
+constructor TContainedActionList.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FList:=TFPList.Create;
+  FState:=asNormal;
+end;
+
+destructor TContainedActionList.Destroy;
+begin
+  while (FList.Count>0) do
+    TObject(FList[Flist.Count-1]).Free;
+  FreeAndNil(FList);
+  inherited;
+end;
+
+function TContainedActionList.IndexOfAction(Action: TBasicAction): Integer;
+begin
+  Result:=FList.IndexOf(Action);
+end;
+
+procedure TContainedActionList.SetActionIndex(Action: TContainedAction;
+  aValue: Integer);
+
+var
+  aMax,Curr : Integer;
+
+begin
+  aMax:=FList.Count;
+  if aValue>aMax then
+    aValue:=aMax-1;
+  if aValue<0 then
+   aValue:=0;
+  Curr:=IndexOfAction(Action);
+  if Curr<>aValue then
+    FList.Move(Curr,aValue);
+end;
+
+procedure TContainedActionList.AddAction(const aAction: TContainedAction);
+begin
+  if aAction=nil then
+    Exit;
+  aAction.FreeNotification(Self);
+  aAction.FActionList:=Self;
+  FList.Add(aAction);
+end;
+
+procedure TContainedActionList.Change;
+
+var
+  I: Integer;
+
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+  for I:=FList.Count-1 downto 0 do
+    TContainedAction(FList[I]).Change;
+end;
+
+function TContainedActionList.SameCategory(const Source, Dest: string;
+                                           const IncludeSubCategory: Boolean = True): Boolean;
+
+var
+  Len : integer;
+  Dst : String;
+
+begin
+  Dst:=Dest;
+  Len:=Length(Source);
+  if IncludeSubCategory and (Len<Length(Dst)) and (Dst[Len+1]='.') then
+    Dst:=Copy(Dest,1,Len);
+  Result:=SameText(Source,Dst);
+end;
+
+function TContainedActionList.Suspended: Boolean;
+begin
+  Result:=State<>asNormal;
+end;
+
+procedure TContainedActionList.GetActionsInCategory(const ACategory: string; aList: TFPList; IncludeSubCategory : Boolean);
+
+var
+  A: TContainedAction;
+begin
+  for A in self do
+    if SameCategory(aCategory,A.Category,IncludeSubCategory) then
+      aList.Add(A);
+end;
+
+function TContainedActionList.EnumByCategory(Proc: TEnumActionListEvent;
+                                       const Category: string;
+                                       const IncludeSubCategory: Boolean = True): boolean;
+
+var
+  P : Pointer;
+  A: TContainedAction absolute P;
+  Tmp: TFPList;
+
+begin
+  Result:=False;
+  If Not Assigned(Proc) then
+    exit;
+  Tmp:=TFPList.Create;
+  try
+    GetActionsInCategory(Category,Tmp,IncludeSubCategory);
+    for P in Tmp do
+      begin
+      Proc(A,Result);
+      if Result then
+        exit;
+      end;
+  finally
+    FreeAndNil(Tmp);
+  end;
+end;
+
+function TContainedActionList.EnumByCategory(Proc: TEnumActionListRef;
+                                       const Category: string;
+                                       const IncludeSubCategory: Boolean = True): boolean;
+
+var
+  P : Pointer;
+  A: TContainedAction absolute P;
+  Tmp: TFPList;
+
+begin
+  Result:=False;
+  If Not Assigned(Proc) then
+    exit;
+  Tmp:=TFPList.Create;
+  try
+    GetActionsInCategory(Category,Tmp,IncludeSubCategory);
+    for P in Tmp do
+      begin
+      Proc(A,Result);
+      if Result then
+        exit;
+      end;
+  finally
+    FreeAndNil(Tmp);
+  end;
+end;
+
+
+function TContainedActionList.ExecuteAction(Action: TBasicAction): Boolean;
+
+begin
+  Result:=False;
+  if Assigned(FOnUpdate) then FOnUpdate(Action, Result);
+end;
+
+
+function TContainedActionList.UpdateAction(Action: TBasicAction): Boolean;
+
+begin
+  Result:=False;
+  if Assigned(FOnUpdate) then
+    FOnUpdate(Action, Result);
+end;
+
+
+function TContainedActionList.GetAction(Index: Integer): TContainedAction;
+
+begin
+  Result:=TContainedAction(FList[Index]);
+end;
+
+
+procedure TContainedActionList.SetAction(Index: Integer; aValue: TContainedAction);
+
+begin
+  FList[Index]:=aValue;
+end;
+
+
+function TContainedActionList.GetActionCount: Integer;
+
+begin
+  Result:=FList.Count;
+end;
+
+
+procedure TContainedActionList.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+var
+  A: TContainedAction;
+
+begin
+  for A in Self do
+    if (Root=A.Owner) then
+      Proc(A);
+end;
+
+
+function TContainedActionList.GetEnumerator: TActionListEnumerator;
+
+begin
+  Result:=TActionListEnumerator.Create(Self);
+end;
+
+
+procedure TContainedActionList.Notification(AComponent: TComponent; Operation: TOperation);
+
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation<>opRemove) then
+    exit;
+  if (AComponent is TContainedAction) then
+    RemoveAction(TContainedAction(AComponent));
+end;
+
+
+procedure TContainedActionList.RemoveAction(const aAction: TContainedAction);
+
+begin
+  if Not Assigned(aAction) then
+    exit;
+  aAction.RemoveFreeNotification(Self); // just in case
+  if FList.Remove(aAction)<0 then
+    exit; // not our action...
+  aAction.FActionList:=nil;
+end;
+
+
+procedure TContainedActionList.SetChildOrder(Component: TComponent; Order: Integer);
+
+var
+  A : TContainedAction absolute Component;
+
+begin
+  if Component is TContainedAction then
+    if (IndexOfAction(A)>=0) then
+      SetActionIndex(A,Order);
+end;
+
+
+procedure TContainedActionList.CorrectActionStates(ReEnabled: Boolean);
+
+var
+  I: Integer;
+  A: TContainedAction;
+
+begin
+  for I:=ActionCount-1 downto 0 do
+    begin
+    A:=Actions[I];
+    case State of
+      asNormal:
+        begin
+        if ReEnabled then
+          A.Enabled:=A.SavedEnabledState;
+        A.Update;
+        end;
+      asSuspendedEnabled:
+        begin
+        A.SavedEnabledState:=A.Enabled;
+        A.Enabled:=True;
+        end;
+      else
+        //
+      end;
+    end;
+end;
+
+procedure TContainedActionList.SetState(const aValue: TActionListState);
+
+var
+  Old: TActionListState;
+
+begin
+  Old:=FState;
+  if Old=aValue then exit;
+  FState:=aValue;
+  try
+    if (aValue<>asSuspended) then
+      CorrectActionStates(Old=asSuspendedEnabled);
+  finally
+    if Assigned(FOnStateChange) then
+     FOnStateChange(Self);
+  end;
+end;
+
+{ ---------------------------------------------------------------------
+  TContainedAction
+  ---------------------------------------------------------------------}
+
+
+function TContainedAction.GetIndex: Integer;
+
+begin
+  if Assigned(ActionList) then
+    Result:=ActionList.IndexOfAction(Self)
+  else
+    Result:=-1;
+end;
+
+
+function TContainedAction.GetSecondaryShortCuts: TCustomShortCutList;
+
+begin
+  if Not SecondaryShortCutsCreated then
+    FSecondaryShortCuts:=CreateShortCutList;
+  Result:=FSecondaryShortCuts;
+end;
+
+
+function TContainedAction.IsSecondaryShortCutsStored: Boolean;
+
+begin
+  Result:=SecondaryShortCutsCreated and (FSecondaryShortCuts.Count>0);
+end;
+
+
+procedure TContainedAction.SetActionList(AValue: TContainedActionList);
+
+begin
+  if FActionList=AValue then Exit;
+  if Assigned(FActionList) then
+    ActionList.RemoveAction(Self);
+  if Assigned(aValue) then
+    aValue.AddAction(Self); // will set FActionList
+end;
+
+
+procedure TContainedAction.SetCategory(AValue: string);
+
+begin
+  if FCategory=AValue then Exit;
+  FCategory:=AValue;
+  if Assigned(ActionList) then
+    ActionList.Change;
+end;
+
+
+procedure TContainedAction.SetIndex(AValue: Integer);
+
+begin
+  If Assigned(ActionList) then
+    ActionList.SetActionIndex(Self,aValue);
+end;
+
+
+procedure TContainedAction.SetSecondaryShortCuts(AValue: TCustomShortCutList);
+
+begin
+  if aValue=FSecondaryShortCuts then
+    exit;
+  if Assigned(aValue) and (aValue.Count>0) then
+    SecondaryShortCuts.Assign(aValue) // will create
+  else
+    FreeAndNil(FSecondaryShortCuts);
+end;
+
+
+procedure TContainedAction.ReadState(Reader: TReader);
+
+begin
+  inherited ReadState(Reader);
+  if Reader.Parent is TContainedActionList then
+    ActionList:=TContainedActionList(Reader.Parent);
+end;
+
+
+function TContainedAction.SecondaryShortCutsCreated: boolean;
+begin
+  Result:=Assigned(FSecondaryShortCuts);
+end;
+
+
+function TContainedAction.CreateShortCutList: TCustomShortCutList;
+begin
+  Result:=TCustomShortCutList.Create;
+end;
+
+
+procedure TContainedAction.Assign(Source: TPersistent);
+
+var
+  Src : TContainedAction absolute Source;
+
+begin
+  if Source is TContainedAction then
+    begin
+    AutoCheck:=Src.AutoCheck;
+    Caption:=Src.Caption;
+    Checked:=Src.Checked;
+    Enabled:=Src.Enabled;
+    GroupIndex:=Src.GroupIndex;
+    HelpContext:=Src.HelpContext;
+    HelpKeyword:=Src.HelpKeyword;
+    HelpType:=Src.HelpType;
+    Hint:=Src.Hint;
+    Visible:=Src.Visible;
+    ShortCut:=Src.ShortCut;
+    if Src.SecondaryShortCutsCreated then
+      SecondaryShortCuts.Assign(Src.SecondaryShortCuts)
+    else
+      FreeAndNil(FSecondaryShortCuts);
+    ImageIndex:=Src.ImageIndex;
+    OnHint:=Src.OnHint;
+    StatusAction:=Src.StatusAction;
+    Category:=Src.Category;
+    end;
+  inherited Assign(Source);
+end;
+
+
+function TContainedAction.HandleShortCut: Boolean;
+begin
+  Result:=Execute;
+end;
+
+
+procedure TContainedAction.SetAutoCheck(Value: Boolean);
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FAutoCheck then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetAutoCheck(Value);
+    end;
+  FAutoCheck:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetCaption(const Value: string);
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FCaption then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetCaption(Value);
+    end;
+  FCaption:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetName(const Value: TComponentName);
+
+var
+  DoCaption : Boolean;
+
+begin
+  // Should we change caption as well ?
+  DoCaption:=(Name=Caption) and (ClientCount=0);
+  inherited SetName(Value);
+  // No need to set caption.
+  if Not DoCaption then
+    exit;
+  // Don't do anything when loading
+  if (csLoading in Owner.ComponentState) then
+    exit;
+  Caption:=Name;
+end;
+
+procedure TContainedAction.SetChecked(Value: Boolean);
+
+var
+  I: Integer;
+  Obj : TObject;
+  A: TContainedAction;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FChecked then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetChecked(Value);
+    end;
+  FChecked:=Value;
+  // Uncheck all others in group.
+  if Not (Value and (GroupIndex>0) and Assigned(ActionList)) then
+    exit;
+  For A in ActionList do
+    begin
+    if (A<>Self) and (A.GroupIndex=GroupIndex) then
+      A.Checked:=False;
+    end;
+  Change;
+end;
+
+
+procedure TContainedAction.SetEnabled(Value: Boolean);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FEnabled then
+    exit;
+  if Assigned(ActionList) then
+    case ActionList.State of
+      asSuspendedEnabled:
+        Value:=True;
+      asSuspended:
+        begin
+        FEnabled:=Value;
+        exit;
+        end;
+      else
+        //
+      end;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetEnabled(Value);
+    end;
+  FEnabled:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetGroupIndex(const Value: Integer);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+  A : TContainedAction;
+
+begin
+  if Value=FGroupIndex then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetGroupIndex(Value);
+    end;
+  FGroupIndex:=Value;
+  // Uncheck others.
+  if FChecked and (Value>0) and Assigned(ActionList) then
+    For A in ActionList do
+      if (A.GroupIndex=Value) then
+        A.Checked:=False;
+  Change;
+end;
+
+
+procedure TContainedAction.SetHelpContext(Value: THelpContext);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FHelpContext then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetHelpContext(Value);
+    end;
+  FHelpContext:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetHelpKeyword(const Value: string);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FHelpKeyword then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetHelpKeyword(Value);
+    end;
+  FHelpKeyword:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetHelpType(Value: THelpType);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FHelpType then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetHelpType(Value);
+    end;
+  FHelpType:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetHint(const Value: string);
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FHint then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetHint(Value);
+    end;
+  FHint:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetVisible(Value: Boolean);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FVisible then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetVisible(Value);
+    end;
+  FVisible:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetShortCut(Value: TShortCut);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FImageIndex then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetShortCut(Value);
+    end;
+  FShortCut:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetImageIndex(Value: TImageIndex);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FImageIndex then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetImageIndex(Value);
+    end;
+  FImageIndex:=Value;
+  Change;
+end;
+
+
+procedure TContainedAction.SetStatusAction(const Value: TStatusAction);
+
+var
+  I: Integer;
+  Obj : TObject;
+  L : TContainedActionLink absolute obj;
+
+begin
+  if Value=FStatusAction then
+    exit;
+  for I:=0 to ClientCount-1 do
+    begin
+    Obj:=GetClient(I);
+    if Obj is TContainedActionLink then
+      L.SetStatusAction(Value);
+    end;
+  FStatusAction:=Value;
+  Change;
+end;
+
+
+constructor TContainedAction.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FEnabled:=True;
+  FVisible:=True;
+  FImageIndex:=-1;
+end;
+
+
+destructor TContainedAction.Destroy;
+begin
+  ActionList:=Nil; // Remove ourselves from action list
+  FreeAndNil(FSecondaryShortCuts);
+  inherited Destroy;
+end;
+
+
+function TContainedAction.GetParentComponent: TComponent;
+begin
+  if Assigned(ActionList) then
+    Result:=ActionList
+  else
+    Result:=inherited GetParentComponent;
+end;
+
+
+function TContainedAction.HasParent: Boolean;
+
+begin
+  Result:=Assigned(ActionList);
+  If not Result then
+    Result:=Inherited HasParent;
+end;
+
+
+procedure TContainedAction.SetParentComponent(AParent: TComponent);
+
+begin
+  Inherited;
+  if not (csLoading in ComponentState) and (AParent is TContainedActionList) then
+    ActionList:=TContainedActionList(AParent);
+end;
+
+
+function TContainedAction.Suspended: Boolean;
+
+begin
+  if Assigned(ActionList) then
+    Result:=ActionList.Suspended
+  else
+    Result:=False;
+end;
+
+
+function TContainedAction.DoHint(var HintStr: string): Boolean;
+begin
+  Result:=True;
+  if Assigned(FOnHint) then
+    FOnHint(HintStr,Result);
+end;
+
+
+{ TContainedActionLink }
+
+procedure TContainedActionLink.DefaultIsLinked(var Result: Boolean);
+
+begin
+  Result:=Action is TContainedAction;
+end;
+
+
+function TContainedActionLink.IsCaptionLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsCheckedLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsEnabledLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+function TContainedActionLink.IsGroupIndexLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsHelpContextLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsHelpLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsHintLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsImageIndexLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsShortCutLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsVisibleLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+function TContainedActionLink.IsStatusActionLinked: Boolean;
+
+begin
+  Result:=False;
+  DefaultIsLinked(Result);
+end;
+
+
+procedure TContainedActionLink.SetAutoCheck(Value: Boolean);
+
+begin
+  if Value then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetCaption(const Value: string);
+
+begin
+  if Value<>'' then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetChecked(Value: Boolean);
+
+begin
+  if Value then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetEnabled(Value: Boolean);
+
+begin
+  if Value then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetGroupIndex(Value: Integer);
+
+begin
+  if Value<>0 then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetHelpContext(Value: THelpContext);
+
+begin
+  if Ord(Value)<>0 then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetHelpKeyword(const Value: string);
+
+begin
+  if Value<>'' then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetHelpType(Value: THelpType);
+
+begin
+  if Ord(Value)<>0 then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetHint(const Value: string);
+
+begin
+  if Value<>'' then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetImageIndex(Value: Integer);
+
+begin
+  if Value<>0 then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetShortCut(Value: TShortCut);
+
+begin
+  if Value<>0 then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetVisible(Value: Boolean);
+
+begin
+  if Value then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+procedure TContainedActionLink.SetStatusAction(const Value: TStatusAction);
+begin
+  if Ord(Value)<>0 then ; // Silence compiler
+  // Needs to be implemented in descendants
+end;
+
+
+Type
+  TShortCutList = Class(TFPList)
+  private
+    function GetS(I : Integer): TShortCut;
+    procedure SetS(I : Integer; AValue: TShortCut);
+  Public
+    Property ShortCuts[I : Integer] : TShortCut Read GetS Write SetS; default;
+  end;
+
+function ShToPtr(S : TShortCut) : Pointer; inline;
+
+begin
+  Result:=Pointer(PtrInt(S));
+end;
+
+
+function PtrToSh(P : Pointer) : TShortCut; inline;
+
+begin
+  Result:=TShortCut(PtrUint(P) and $FFFF);
+end;
+
+
+var
+  _ShortCuts : TShortCutList;
+
+function RegisterShortCut(aShortCut: TShortCut; Index: integer = -1): integer;
+
+var
+  Ptr : Pointer;
+
+begin
+  Result:=-1;
+  if aShortCut<=0 then
+    exit;
+  if not Assigned(_ShortCuts) then
+    exit;
+  Ptr:=ShToPtr(aShortCut);
+  if _ShortCuts.IndexOf(Ptr)>=0 then
+    Exit;
+  if (Index<0) or (Index>=_ShortCuts.Count) then
+    Result:=_ShortCuts.Add(Ptr)
+  else
+    begin
+    _ShortCuts.Insert(Index,Ptr);
+    Result:=Index;
+    end;
+end;
+
+
+function UnregisterShortCut(aShortCut: TShortCut): boolean;
+
+var
+  Idx: integer;
+
+begin
+  Result:=False;
+  if (Integer(aShortCut)<0) then
+    exit;
+  if Not Assigned(_ShortCuts) then
+    exit;
+  Idx:=_ShortCuts.IndexOf(ShToPtr(aShortCut));
+  if (Idx<0) then
+    exit;
+  _ShortCuts.Delete(Idx);
+  Result:=True;
+end;
+
+
+function RegisteredShortCutCount: integer;
+begin
+  Result:=_ShortCuts.Count;
+end;
+
+
+function RegisteredShortCut(Idx: integer): TShortCut;
+begin
+  if (Idx>=0) and (Idx<_ShortCuts.Count) then
+    Result:=PtrToSh(_ShortCuts.Items[Idx])
+  else
+    EListError.CreateFmt(SErrIndexOutOfBounds,[Idx, 0, RegisteredShortCutCount-1]);
+end;
+
+
+{ TShortCutList }
+
+function TShortCutList.GetS(I : Integer): TShortCut;
+begin
+  Result:=PtrToSh(Items[i]);
+end;
+
+
+procedure TShortCutList.SetS(I : Integer; AValue: TShortCut);
+begin
+  Items[i]:=ShToPtr(aValue);
+end;
+
+
+
+initialization
+  _ShortCuts:=TShortCutList.Create;
+  vDesignAction:=False;
+
+finalization
+  FreeAndNil(_ShortCuts);
+
+end.

packages/rtl-objpas/src/inc/system.uiconsts.pp

@@ -0,0 +1,994 @@
+unit System.UIConsts;
+{
+   This file is part of the Free Pascal run time library.
+    Copyright (c) 2023 the Free Pascal development team
+
+   FPC/Lazarus Replacement for UIConsts from Delphi 10.x
+
+   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+}
+{$R-}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses System.UITypes, System.Classes;
+{$ELSE}
+uses System.UITypes, Classes;
+{$ENDIF}
+
+const
+  MaxColorChannel = $FF;
+
+const
+  claAliceblue = TAlphaColors.AliceBlue;
+  claAntiquewhite = TAlphaColors.Antiquewhite;
+  claAqua = TAlphaColors.Aqua;
+  claAquamarine = TAlphaColors.Aquamarine;
+  claAzure = TAlphaColors.Azure;
+  claBeige = TAlphaColors.Beige;
+  claBisque = TAlphaColors.Bisque;
+  claBlack = TAlphaColors.Black;
+  claBlanchedalmond = TAlphaColors.Blanchedalmond;
+  claBlue = TAlphaColors.Blue;
+  claBlueviolet = TAlphaColors.Blueviolet;
+  claBrown = TAlphaColors.Brown;
+  claBurlywood = TAlphaColors.Burlywood;
+  claCadetblue = TAlphaColors.Cadetblue;
+  claChartreuse = TAlphaColors.Chartreuse;
+  claChocolate = TAlphaColors.Chocolate;
+  claCoral = TAlphaColors.Coral;
+  claCornflowerblue = TAlphaColors.Cornflowerblue;
+  claCornsilk = TAlphaColors.Cornsilk;
+  claCrimson = TAlphaColors.Crimson;
+  claCyan = TAlphaColors.Cyan;
+  claDarkblue = TAlphaColors.Darkblue;
+  claDarkcyan = TAlphaColors.Darkcyan;
+  claDarkgoldenrod = TAlphaColors.Darkgoldenrod;
+  claDarkgray = TAlphaColors.Darkgray;
+  claDarkgreen = TAlphaColors.Darkgreen;
+  claDarkgrey = TAlphaColors.Darkgrey;
+  claDarkkhaki = TAlphaColors.Darkkhaki;
+  claDarkmagenta = TAlphaColors.Darkmagenta;
+  claDarkolivegreen = TAlphaColors.Darkolivegreen;
+  claDarkorange = TAlphaColors.Darkorange;
+  claDarkorchid = TAlphaColors.Darkorchid;
+  claDarkred = TAlphaColors.Darkred;
+  claDarksalmon = TAlphaColors.Darksalmon;
+  claDarkseagreen = TAlphaColors.Darkseagreen;
+  claDarkslateblue = TAlphaColors.Darkslateblue;
+  claDarkslategray = TAlphaColors.Darkslategray;
+  claDarkslategrey = TAlphaColors.Darkslategrey;
+  claDarkturquoise = TAlphaColors.Darkturquoise;
+  claDarkviolet = TAlphaColors.Darkviolet;
+  claDeeppink = TAlphaColors.Deeppink;
+  claDeepskyblue = TAlphaColors.Deepskyblue;
+  claDimgray = TAlphaColors.Dimgray;
+  claDimgrey = TAlphaColors.Dimgrey;
+  claDodgerblue = TAlphaColors.Dodgerblue;
+  claFirebrick = TAlphaColors.Firebrick;
+  claFloralwhite = TAlphaColors.Floralwhite;
+  claForestgreen = TAlphaColors.Forestgreen;
+  claFuchsia = TAlphaColors.Fuchsia;
+  claGainsboro = TAlphaColors.Gainsboro;
+  claGhostwhite = TAlphaColors.Ghostwhite;
+  claGold = TAlphaColors.Gold;
+  claGoldenrod = TAlphaColors.Goldenrod;
+  claGray = TAlphaColors.Gray;
+  claGreen = TAlphaColors.Green;
+  claGreenyellow = TAlphaColors.Greenyellow;
+  claGrey = TAlphaColors.Grey;
+  claHoneydew = TAlphaColors.Honeydew;
+  claHotpink = TAlphaColors.Hotpink;
+  claIndianred = TAlphaColors.Indianred;
+  claIndigo = TAlphaColors.Indigo;
+  claIvory = TAlphaColors.Ivory;
+  claKhaki = TAlphaColors.Khaki;
+  claLavender = TAlphaColors.Lavender;
+  claLavenderblush = TAlphaColors.Lavenderblush;
+  claLawngreen = TAlphaColors.Lawngreen;
+  claLemonchiffon = TAlphaColors.Lemonchiffon;
+  claLightblue = TAlphaColors.Lightblue;
+  claLightcoral = TAlphaColors.Lightcoral;
+  claLightcyan = TAlphaColors.Lightcyan;
+  claLightgoldenrodyellow = TAlphaColors.Lightgoldenrodyellow;
+  claLightgray = TAlphaColors.Lightgray;
+  claLightgreen = TAlphaColors.Lightgreen;
+  claLightgrey = TAlphaColors.Lightgrey;
+  claLightpink = TAlphaColors.Lightpink;
+  claLightsalmon = TAlphaColors.Lightsalmon;
+  claLightseagreen = TAlphaColors.Lightseagreen;
+  claLightskyblue = TAlphaColors.Lightskyblue;
+  claLightslategray = TAlphaColors.Lightslategray;
+  claLightslategrey = TAlphaColors.Lightslategrey;
+  claLightsteelblue = TAlphaColors.Lightsteelblue;
+  claLightyellow = TAlphaColors.Lightyellow;
+  claLime = TAlphaColors.Lime;
+  claLimegreen = TAlphaColors.Limegreen;
+  claLinen = TAlphaColors.Linen;
+  claMagenta = TAlphaColors.Magenta;
+  claMaroon = TAlphaColors.Maroon;
+  claMediumaquamarine = TAlphaColors.Mediumaquamarine;
+  claMediumblue = TAlphaColors.Mediumblue;
+  claMediumorchid = TAlphaColors.Mediumorchid;
+  claMediumpurple = TAlphaColors.Mediumpurple;
+  claMediumseagreen = TAlphaColors.Mediumseagreen;
+  claMediumslateblue = TAlphaColors.Mediumslateblue;
+  claMediumspringgreen = TAlphaColors.Mediumspringgreen;
+  claMediumturquoise = TAlphaColors.Mediumturquoise;
+  claMediumvioletred = TAlphaColors.Mediumvioletred;
+  claMidnightblue = TAlphaColors.Midnightblue;
+  claMintcream = TAlphaColors.Mintcream;
+  claMistyrose = TAlphaColors.Mistyrose;
+  claMoccasin = TAlphaColors.Moccasin;
+  claNavajowhite = TAlphaColors.Navajowhite;
+  claNavy = TAlphaColors.Navy;
+  claOldlace = TAlphaColors.Oldlace;
+  claOlive = TAlphaColors.Olive;
+  claOlivedrab = TAlphaColors.Olivedrab;
+  claOrange = TAlphaColors.Orange;
+  claOrangered = TAlphaColors.Orangered;
+  claOrchid = TAlphaColors.Orchid;
+  claPalegoldenrod = TAlphaColors.Palegoldenrod;
+  claPalegreen = TAlphaColors.Palegreen;
+  claPaleturquoise = TAlphaColors.Paleturquoise;
+  claPalevioletred = TAlphaColors.Palevioletred;
+  claPapayawhip = TAlphaColors.Papayawhip;
+  claPeachpuff = TAlphaColors.Peachpuff;
+  claPeru = TAlphaColors.Peru;
+  claPink = TAlphaColors.Pink;
+  claPlum = TAlphaColors.Plum;
+  claPowderblue = TAlphaColors.Powderblue;
+  claPurple = TAlphaColors.Purple;
+  claRed = TAlphaColors.Red;
+  claRosybrown = TAlphaColors.Rosybrown;
+  claRoyalblue = TAlphaColors.Royalblue;
+  claSaddlebrown = TAlphaColors.Saddlebrown;
+  claSalmon = TAlphaColors.Salmon;
+  claSandybrown = TAlphaColors.Sandybrown;
+  claSeagreen = TAlphaColors.Seagreen;
+  claSeashell = TAlphaColors.Seashell;
+  claSienna = TAlphaColors.Sienna;
+  claSilver = TAlphaColors.Silver;
+  claSkyblue = TAlphaColors.Skyblue;
+  claSlateblue = TAlphaColors.Slateblue;
+  claSlategray = TAlphaColors.Slategray;
+  claSlategrey = TAlphaColors.Slategrey;
+  claSnow = TAlphaColors.Snow;
+  claSpringgreen = TAlphaColors.Springgreen;
+  claSteelblue = TAlphaColors.Steelblue;
+  claTan = TAlphaColors.Tan;
+  claTeal = TAlphaColors.Teal;
+  claThistle = TAlphaColors.Thistle;
+  claTomato = TAlphaColors.Tomato;
+  claTurquoise = TAlphaColors.Turquoise;
+  claViolet = TAlphaColors.Violet;
+  claWheat = TAlphaColors.Wheat;
+  claWhite = TAlphaColors.White;
+  claWhitesmoke = TAlphaColors.Whitesmoke;
+  claYellow = TAlphaColors.Yellow;
+  claYellowgreen = TAlphaColors.Yellowgreen;
+  claNull = TAlphaColors.Null;
+
+{ Cursor string functions }
+
+function CursorToString(Cursor: TCursor): string;
+function StringToCursor(const S: string): TCursor;
+procedure GetCursorValues(const Proc: TGetStrProc);
+function CursorToIdent(Cursor: LongInt; var Ident: string): Boolean; inline;
+function IdentToCursor(const Ident: string; var Cursor: LongInt): Boolean; inline;
+procedure RegisterCursorIntegerConsts;
+
+{ TColor string functions }
+
+function ColorToString(Color: TColor): string;
+function StringToColor(const S: string): TColor;
+procedure GetColorValues(Proc: TGetStrProc);
+function ColorToIdent(Color: Longint; var Ident: string): Boolean; inline;
+function IdentToColor(const Ident: string; var Color: LongInt): Boolean; inline;
+procedure RegisterColorIntegerConsts;
+
+{ TAlphaColor string functions }
+
+procedure GetAlphaColorValues(Proc: TGetStrProc);
+function AlphaColorToString(Value: TAlphaColor): string;
+function StringToAlphaColor(const Value: string): TAlphaColor;
+function AlphaColorToIdent(Color: LongInt; var Ident: string): Boolean;
+function IdentToAlphaColor(const Ident: string; var Color: Longint): Boolean;
+procedure RegisterAlphaColorIntegerConsts;
+
+{ TAlphaColor function's }
+
+/// <summary>Converts TAlphaColor into TColor structure, exchanging red and blue channels while losing alpha channel. </summary>
+function AlphaColorToColor(const Color: TAlphaColor): TColor;
+function AppendColor(Start, Stop: TAlphaColor): TAlphaColor;
+function SubtractColor(Start, Stop: TAlphaColor): TAlphaColor;
+function RGBtoBGR(const C: TAlphaColor): TAlphaColor;
+function CorrectColor(const C: TAlphaColor): TAlphaColor;
+function PremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
+function UnpremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
+function MakeColor(R, G, B: Byte; A: Byte = MaxColorChannel): TAlphaColor; overload;
+function MakeColor(const C: TAlphaColor; const AOpacity: Single): TAlphaColor; overload;
+function HSLtoRGB(H, S, L: Single): TAlphaColor;
+procedure RGBtoHSL(RGB: TAlphaColor; out H, S, L: Single);
+function ChangeHSL(const C: TAlphaColor; dH, dS, dL: Single): TAlphaColor;
+
+const
+
+  // Please keep these sorted.
+  CursorNames: array[0..30] of TIdentMapEntry = (
+    (Value: crAppStart;   Name: 'crAppStart'),
+    (Value: crArrow;      Name: 'crArrow'),
+    (Value: crCross;      Name: 'crCross'),
+    (Value: crDefault;    Name: 'crDefault'),
+    (Value: crDrag;       Name: 'crDrag'),
+    (Value: crHandPoint;  Name: 'crHandPoint'),
+    (Value: crHelp;       Name: 'crHelp'),
+    (Value: crHourGlass;  Name: 'crHourGlass'),
+    (Value: crHSplit;     Name: 'crHSplit'),
+    (Value: crIBeam;      Name: 'crIBeam'),
+    (Value: crMultiDrag;  Name: 'crMultiDrag'),
+    (Value: crNoDrop;     Name: 'crNoDrop'),
+    (Value: crNo;         Name: 'crNo'),
+    (Value: crSizeAll;    Name: 'crSizeAll'),
+    (Value: crSizeE;      Name: 'crSizeE'),
+    (Value: crSizeNE;     Name: 'crSizeNE'),
+    (Value: crSizeNESW;   Name: 'crSizeNESW'),
+    (Value: crSizeN;      Name: 'crSizeN'),
+    (Value: crSizeNS;     Name: 'crSizeNS'),
+    (Value: crSizeNW;     Name: 'crSizeNW'),
+    (Value: crSizeNWSE;   Name: 'crSizeNWSE'),
+    (Value: crSizeSE;     Name: 'crSizeSE'),
+    (Value: crSizeS;      Name: 'crSizeS'),
+    (Value: crSizeSW;     Name: 'crSizeSW'),
+    (Value: crSizeWE;     Name: 'crSizeWE'),
+    (Value: crSizeW;      Name: 'crSizeW'),
+    (Value: crSQLWait;    Name: 'crSQLWait'),
+    (Value: crUpArrow;    Name: 'crUpArrow'),
+    (Value: crVSplit;     Name: 'crVSplit'),
+    // These must be last, duplicates!
+    (Value: crSize;       Name: 'crSize'),
+    (Value: crLow;        Name: 'crLow') 
+  );    
+
+  // Please keep these sorted.
+  ColorNames: array[0..51] of TIdentMapEntry = (
+    (Value: TColors.Aqua;                       Name: 'clAqua'),
+    (Value: TColors.Black;                      Name: 'clBlack'),
+    (Value: TColors.Blue;                       Name: 'clBlue'),
+    (Value: TColors.Cream;                      Name: 'clCream'),
+    (Value: TColors.Fuchsia;                    Name: 'clFuchsia'),
+    (Value: TColors.Gray;                       Name: 'clGray'),
+    (Value: TColors.Green;                      Name: 'clGreen'),
+    (Value: TColors.Lime;                       Name: 'clLime'),
+    (Value: TColors.Maroon;                     Name: 'clMaroon'),
+    (Value: TColors.MedGray;                    Name: 'clMedGray'),
+    (Value: TColors.MoneyGreen;                 Name: 'clMoneyGreen'),
+    (Value: TColors.Navy;                       Name: 'clNavy'),
+    (Value: TColors.Olive;                      Name: 'clOlive'),
+    (Value: TColors.Purple;                     Name: 'clPurple'),
+    (Value: TColors.Red;                        Name: 'clRed'),
+    (Value: TColors.Silver;                     Name: 'clSilver'),
+    (Value: TColors.SkyBlue;                    Name: 'clSkyBlue'),
+    (Value: TColors.Sys3DDkShadow;              Name: 'cl3DDkShadow'),
+    (Value: TColors.Sys3DLight;                 Name: 'cl3DLight'),
+    (Value: TColors.SysActiveBorder;            Name: 'clActiveBorder'),
+    (Value: TColors.SysActiveCaption;           Name: 'clActiveCaption'),
+    (Value: TColors.SysAppWorkSpace;            Name: 'clAppWorkSpace'),
+    (Value: TColors.SysBackground;              Name: 'clBackground'),
+    (Value: TColors.SysBtnFace;                 Name: 'clBtnFace'),
+    (Value: TColors.SysBtnHighlight;            Name: 'clBtnHighlight'),
+    (Value: TColors.SysBtnShadow;               Name: 'clBtnShadow'),
+    (Value: TColors.SysBtnText;                 Name: 'clBtnText'),
+    (Value: TColors.SysCaptionText;             Name: 'clCaptionText'),
+    (Value: TColors.SysDefault;                 Name: 'clDefault'),
+    (Value: TColors.SysGradientActiveCaption;   Name: 'clGradientActiveCaption'),
+    (Value: TColors.SysGradientInactiveCaption; Name: 'clGradientInactiveCaption'),
+    (Value: TColors.SysGrayText;                Name: 'clGrayText'),
+    (Value: TColors.SysHighlight;               Name: 'clHighlight'),
+    (Value: TColors.SysHighlightText;           Name: 'clHighlightText'),
+    (Value: TColors.SysHotLight;                Name: 'clHotLight'),
+    (Value: TColors.SysInactiveBorder;          Name: 'clInactiveBorder'),
+    (Value: TColors.SysInactiveCaption;         Name: 'clInactiveCaption'),
+    (Value: TColors.SysInactiveCaptionText;     Name: 'clInactiveCaptionText'),
+    (Value: TColors.SysInfoBk;                  Name: 'clInfoBk'),
+    (Value: TColors.SysInfoText;                Name: 'clInfoText'),
+    (Value: TColors.SysMenuBar;                 Name: 'clMenuBar'),
+    (Value: TColors.SysMenuHighlight;           Name: 'clMenuHighlight'),
+    (Value: TColors.SysMenu;                    Name: 'clMenu'),
+    (Value: TColors.SysMenuText;                Name: 'clMenuText'),
+    (Value: TColors.SysNone;                    Name: 'clNone'),
+    (Value: TColors.SysScrollBar;               Name: 'clScrollBar'),
+    (Value: TColors.SysWindowFrame;             Name: 'clWindowFrame'),
+    (Value: TColors.SysWindow;                  Name: 'clWindow'),
+    (Value: TColors.SysWindowText;              Name: 'clWindowText'),
+    (Value: TColors.Teal;                       Name: 'clTeal'),
+    (Value: TColors.White;                      Name: 'clWhite'),
+    (Value: TColors.Yellow;                     Name: 'clYellow')
+  );
+
+  AlphaColorNames: array [0..154] of TIdentMapEntry = (
+      (Value: TAlphaColors.AliceBlue; Name: 'claAliceBlue'),
+      (Value: TAlphaColors.Alpha; Name: 'claAlpha'),
+      (Value: TAlphaColors.AntiqueWhite; Name: 'claAntiqueWhite'),
+      (Value: TAlphaColors.AquaMarine; Name: 'claAquaMarine'),
+      (Value: TAlphaColors.Aqua; Name: 'claAqua'),
+      (Value: TAlphaColors.Azure; Name: 'claAzure'),
+      (Value: TAlphaColors.Beige; Name: 'claBeige'),
+      (Value: TAlphaColors.Bisque; Name: 'claBisque'),
+      (Value: TAlphaColors.Black; Name: 'claBlack'),
+      (Value: TAlphaColors.BlanchedAlmond; Name: 'claBlanchedAlmond'),
+      (Value: TAlphaColors.Blue; Name: 'claBlue'),
+      (Value: TAlphaColors.BlueViolet; Name: 'claBlueViolet'),
+      (Value: TAlphaColors.Brown; Name: 'claBrown'),
+      (Value: TAlphaColors.BurlyWood; Name: 'claBurlyWood'),
+      (Value: TAlphaColors.CadetBlue; Name: 'claCadetBlue'),
+      (Value: TAlphaColors.Chartreuse; Name: 'claChartreuse'),
+      (Value: TAlphaColors.Chocolate; Name: 'claChocolate'),
+      (Value: TAlphaColors.Coral; Name: 'claCoral'),
+      (Value: TAlphaColors.CornflowerBlue; Name: 'claCornflowerBlue'),
+      (Value: TAlphaColors.CornSilk; Name: 'claCornSilk'),
+      (Value: TAlphaColors.Cream; Name: 'claCream'),
+      (Value: TAlphaColors.Crimson; Name: 'claCrimson'),
+      (Value: TAlphaColors.Cyan; Name: 'claCyan'),
+      (Value: TAlphaColors.DarkBlue; Name: 'claDarkBlue'),
+      (Value: TAlphaColors.DarkCyan; Name: 'claDarkCyan'),
+      (Value: TAlphaColors.DarkGoldenRod; Name: 'claDarkGoldenRod'),
+      (Value: TAlphaColors.DarkGray; Name: 'claDarkGray'),
+      (Value: TAlphaColors.DarkGreen; Name: 'claDarkGreen'),
+      (Value: TAlphaColors.DarkGrey; Name: 'claDarkGrey'),
+      (Value: TAlphaColors.DarkKhaki; Name: 'claDarkKhaki'),
+      (Value: TAlphaColors.DarkMagenta; Name: 'claDarkMagenta'),
+      (Value: TAlphaColors.DarkOliveGreen; Name: 'claDarkOliveGreen'),
+      (Value: TAlphaColors.DarkOrange; Name: 'claDarkOrange'),
+      (Value: TAlphaColors.DarkOrchid; Name: 'claDarkOrchid'),
+      (Value: TAlphaColors.DarkRed; Name: 'claDarkRed'),
+      (Value: TAlphaColors.DarkSalmon; Name: 'claDarkSalmon'),
+      (Value: TAlphaColors.DarkSeaGreen; Name: 'claDarkSeaGreen'),
+      (Value: TAlphaColors.DarkSlateBlue; Name: 'claDarkSlateBlue'),
+      (Value: TAlphaColors.DarkSlateGray; Name: 'claDarkSlateGray'),
+      (Value: TAlphaColors.DarkSlateGrey; Name: 'claDarkSlateGrey'),
+      (Value: TAlphaColors.DarkTurquoise; Name: 'claDarkTurquoise'),
+      (Value: TAlphaColors.DarkViolet; Name: 'claDarkViolet'),
+      (Value: TAlphaColors.DeepPink; Name: 'claDeepPink'),
+      (Value: TAlphaColors.DeepSkyBlue; Name: 'claDeepSkyBlue'),
+      (Value: TAlphaColors.DimGray; Name: 'claDimGray'),
+      (Value: TAlphaColors.DimGrey; Name: 'claDimGrey'),
+      (Value: TAlphaColors.DkGray; Name: 'claDkGray'),
+      (Value: TAlphaColors.DodgerBlue; Name: 'claDodgerBlue'),
+      (Value: TAlphaColors.Firebrick; Name: 'claFirebrick'),
+      (Value: TAlphaColors.FloralWhite; Name: 'claFloralWhite'),
+      (Value: TAlphaColors.ForestGreen; Name: 'claForestGreen'),
+      (Value: TAlphaColors.Fuchsia; Name: 'claFuchsia'),
+      (Value: TAlphaColors.Gainsboro; Name: 'claGainsboro'),
+      (Value: TAlphaColors.GhostWhite; Name: 'claGhostWhite'),
+      (Value: TAlphaColors.GoldenRod; Name: 'claGoldenRod'),
+      (Value: TAlphaColors.Gold; Name: 'claGold'),
+      (Value: TAlphaColors.Gray; Name: 'claGray'),
+      (Value: TAlphaColors.Green; Name: 'claGreen'),
+      (Value: TAlphaColors.GreenYellow; Name: 'claGreenYellow'),
+      (Value: TAlphaColors.Grey; Name: 'claGrey'),
+      (Value: TAlphaColors.HoneyDew; Name: 'claHoneyDew'),
+      (Value: TAlphaColors.HotPink; Name: 'claHotPink'),
+      (Value: TAlphaColors.IndianRed; Name: 'claIndianRed'),
+      (Value: TAlphaColors.Indigo; Name: 'claIndigo'),
+      (Value: TAlphaColors.Ivory; Name: 'claIvory'),
+      (Value: TAlphaColors.Khaki; Name: 'claKhaki'),
+      (Value: TAlphaColors.LavenderBlush; Name: 'claLavenderBlush'),
+      (Value: TAlphaColors.Lavender; Name: 'claLavender'),
+      (Value: TAlphaColors.LawnGreen; Name: 'claLawnGreen'),
+      (Value: TAlphaColors.LegacySkyBlue; Name: 'claLegacySkyBlue'),
+      (Value: TAlphaColors.LemonChiffon; Name: 'claLemonChiffon'),
+      (Value: TAlphaColors.LightBlue; Name: 'claLightBlue'),
+      (Value: TAlphaColors.LightCoral; Name: 'claLightCoral'),
+      (Value: TAlphaColors.LightCyan; Name: 'claLightCyan'),
+      (Value: TAlphaColors.LightGoldenRodYellow; Name: 'claLightGoldenRodYellow'),
+      (Value: TAlphaColors.LightGray; Name: 'claLightGray'),
+      (Value: TAlphaColors.LightGreen; Name: 'claLightGreen'),
+      (Value: TAlphaColors.LightGrey; Name: 'claLightGrey'),
+      (Value: TAlphaColors.LightPink; Name: 'claLightPink'),
+      (Value: TAlphaColors.LightSalmon; Name: 'claLightSalmon'),
+      (Value: TAlphaColors.LightSeaGreen; Name: 'claLightSeaGreen'),
+      (Value: TAlphaColors.LightSkyBlue; Name: 'claLightSkyBlue'),
+      (Value: TAlphaColors.LightSlateGray; Name: 'claLightSlateGray'),
+      (Value: TAlphaColors.LightSlateGrey; Name: 'claLightSlateGrey'),
+      (Value: TAlphaColors.LightSteelBlue; Name: 'claLightSteelBlue'),
+      (Value: TAlphaColors.LightYellow; Name: 'claLightYellow'),
+      (Value: TAlphaColors.LimeGreen; Name: 'claLimeGreen'),
+      (Value: TAlphaColors.Lime; Name: 'claLime'),
+      (Value: TAlphaColors.Linen; Name: 'claLinen'),
+      (Value: TAlphaColors.LtGray; Name: 'claLtGray'),
+      (Value: TAlphaColors.Magenta; Name: 'claMagenta'),
+      (Value: TAlphaColors.Maroon; Name: 'claMaroon'),
+      (Value: TAlphaColors.MedGray; Name: 'claMedGray'),
+      (Value: TAlphaColors.MediumAquaMarine; Name: 'claMediumAquaMarine'),
+      (Value: TAlphaColors.MediumBlue; Name: 'claMediumBlue'),
+      (Value: TAlphaColors.MediumOrchid; Name: 'claMediumOrchid'),
+      (Value: TAlphaColors.MediumPurple; Name: 'claMediumPurple'),
+      (Value: TAlphaColors.MediumSeaGreen; Name: 'claMediumSeaGreen'),
+      (Value: TAlphaColors.MediumSlateBlue; Name: 'claMediumSlateBlue'),
+      (Value: TAlphaColors.MediumSpringGreen; Name: 'claMediumSpringGreen'),
+      (Value: TAlphaColors.MediumTurquoise; Name: 'claMediumTurquoise'),
+      (Value: TAlphaColors.MediumVioletRed; Name: 'claMediumVioletRed'),
+      (Value: TAlphaColors.MidnightBlue; Name: 'claMidnightBlue'),
+      (Value: TAlphaColors.MintCream; Name: 'claMintCream'),
+      (Value: TAlphaColors.MistyRose; Name: 'claMistyRose'),
+      (Value: TAlphaColors.Moccasin; Name: 'claMoccasin'),
+      (Value: TAlphaColors.MoneyGreen; Name: 'claMoneyGreen'),
+      (Value: TAlphaColors.NavajoWhite; Name: 'claNavajoWhite'),
+      (Value: TAlphaColors.Navy; Name: 'claNavy'),
+      (Value: TAlphaColors.Null; Name: 'claNull'),
+      (Value: TAlphaColors.OldLace; Name: 'claOldLace'),
+      (Value: TAlphaColors.OliveDrab; Name: 'claOliveDrab'),
+      (Value: TAlphaColors.Olive; Name: 'claOlive'),
+      (Value: TAlphaColors.Orange; Name: 'claOrange'),
+      (Value: TAlphaColors.OrangeRed; Name: 'claOrangeRed'),
+      (Value: TAlphaColors.Orchid; Name: 'claOrchid'),
+      (Value: TAlphaColors.PaleGoldenRod; Name: 'claPaleGoldenRod'),
+      (Value: TAlphaColors.PaleGreen; Name: 'claPaleGreen'),
+      (Value: TAlphaColors.PaleTurquoise; Name: 'claPaleTurquoise'),
+      (Value: TAlphaColors.PaleVioletRed; Name: 'claPaleVioletRed'),
+      (Value: TAlphaColors.PapayaWhip; Name: 'claPapayaWhip'),
+      (Value: TAlphaColors.PeachPuff; Name: 'claPeachPuff'),
+      (Value: TAlphaColors.Peru; Name: 'claPeru'),
+      (Value: TAlphaColors.Pink; Name: 'claPink'),
+      (Value: TAlphaColors.Plum; Name: 'claPlum'),
+      (Value: TAlphaColors.PowderBlue; Name: 'claPowderBlue'),
+      (Value: TAlphaColors.Purple; Name: 'claPurple'),
+      (Value: TAlphaColors.Red; Name: 'claRed'),
+      (Value: TAlphaColors.RosyBrown; Name: 'claRosyBrown'),
+      (Value: TAlphaColors.RoyalBlue; Name: 'claRoyalBlue'),
+      (Value: TAlphaColors.SaddleBrown; Name: 'claSaddleBrown'),
+      (Value: TAlphaColors.Salmon; Name: 'claSalmon'),
+      (Value: TAlphaColors.SandyBrown; Name: 'claSandyBrown'),
+      (Value: TAlphaColors.SeaGreen; Name: 'claSeaGreen'),
+      (Value: TAlphaColors.SeaShell; Name: 'claSeaShell'),
+      (Value: TAlphaColors.Sienna; Name: 'claSienna'),
+      (Value: TAlphaColors.Silver; Name: 'claSilver'),
+      (Value: TAlphaColors.SkyBlue; Name: 'claSkyBlue'),
+      (Value: TAlphaColors.SlateBlue; Name: 'claSlateBlue'),
+      (Value: TAlphaColors.SlateGray; Name: 'claSlateGray'),
+      (Value: TAlphaColors.SlateGrey; Name: 'claSlateGrey'),
+      (Value: TAlphaColors.Snow; Name: 'claSnow'),
+      (Value: TAlphaColors.SpringGreen; Name: 'claSpringGreen'),
+      (Value: TAlphaColors.SteelBlue; Name: 'claSteelBlue'),
+      (Value: TAlphaColors.Tan; Name: 'claTan'),
+      (Value: TAlphaColors.Teal; Name: 'claTeal'),
+      (Value: TAlphaColors.Thistle; Name: 'claThistle'),
+      (Value: TAlphaColors.Tomato; Name: 'claTomato'),
+      (Value: TAlphaColors.Turquoise; Name: 'claTurquoise'),
+      (Value: TAlphaColors.Violet; Name: 'claViolet'),
+      (Value: TAlphaColors.Wheat; Name: 'claWheat'),
+      (Value: TAlphaColors.White; Name: 'claWhite'),
+      (Value: TAlphaColors.WhiteSmoke; Name: 'claWhiteSmoke'),
+      (Value: TAlphaColors.YellowGreen; Name: 'claYellowGreen'),
+      (Value: TAlphaColors.Yellow; Name: 'claYellow')
+  );
+
+implementation
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses System.SysUtils;
+{$ELSE}
+uses SysUtils;
+{$ENDIF}
+
+
+{ ****************************************************************************
+  Colors
+  ****************************************************************************}
+
+function ColorToIdent(Color: LongInt;var Ident: string): Boolean;
+begin
+  Result:=IntToIdent(Color,Ident,ColorNames);
+end;
+
+
+function IdentToColor(const Ident: string;var Color: LongInt): Boolean;
+begin
+  Result:=IdentToInt(Ident,Color,ColorNames);
+end;
+
+
+function ColorToString(Color: TColor): string;
+begin
+  if ColorToIdent(Color,Result) then
+    exit;
+  Result:=Format('$%0.8x',[Integer(Color)]);
+end;
+
+
+function StringToColor(const S: string): TColor;
+
+begin
+  if IdentToColor(S,LongInt(Result)) then
+    exit;
+  Result:=TColor(StrToIntDef(S,Integer(TColorRec.Black)));
+end;
+
+
+procedure GetColorValues(Proc: TGetStrProc);
+
+var
+  C: Integer;
+
+begin
+  for C:=Low(ColorNames) to High(ColorNames) do 
+    Proc(ColorNames[C].Name);
+end;
+
+procedure RegisterColorIntegerConsts;
+
+begin
+  if Assigned(FindIntToIdent(TypeInfo(TColor))) then
+    exit;
+  RegisterIntegerConsts(TypeInfo(TColor),@IdentToColor,@ColorToIdent);
+end;
+
+
+{ ****************************************************************************
+  AlphaColors
+  ****************************************************************************}
+
+function AlphaColorToIdent(Color: LongInt; var Ident: string): Boolean;
+
+begin
+  Result:=IntToIdent(Color,Ident,AlphaColorNames);
+  if not Result then
+    begin
+    Ident:='x'+IntToHex(Color,8);
+    Result:=True;
+    end;
+end;
+
+
+function IdentToAlphaColor(const Ident: string; var Color: LongInt): Boolean;
+
+var
+  S: string;
+  
+begin
+  S:=Ident;
+  Result:=(Length(S)>1) and (S[1]='x');
+  if Result then
+    Color:=Integer(StringToAlphaColor(S))
+  else
+    begin
+    Result:=IdentToInt(S,Color,AlphaColorNames);
+    if not Result and (Length(S)>2) and (S[1]='c') and (S[2]='l') then
+      begin
+      Insert('a',S,3);
+      Result:=IdentToInt(S,Color,AlphaColorNames);
+      end;
+    end;  
+end;
+
+
+procedure GetAlphaColorValues(Proc: TGetStrProc);
+
+var
+  AC: Integer;
+  
+begin
+  for AC:=Low(AlphaColorNames) to High(AlphaColorNames) do
+    Proc(Copy(AlphaColorNames[AC].Name,4));
+end;
+
+function AlphaColorToString(Value: TAlphaColor): string;
+begin
+  Result:='';
+  if AlphaColorToIdent(Integer(Value),Result) then
+    begin
+    if Result[1]='x' then
+      Result[1]:='#'
+    else
+      Delete(Result,1,3); // Strip cla...
+    end;  
+end;
+
+function StringToAlphaColor(const Value: string): TAlphaColor;
+
+var
+  S: string;
+  
+begin
+  S:=Value;
+  if (S=#0) or (S='') then
+    Result:=TAlphaColors.Black
+  else if (Length(S)>0) and (S[1] in ['#','x']) then
+    begin
+    S:='$'+Copy(S,2);
+    Result:=TAlphaColor(StrToIntDef(S,TAlphaColors.Black));
+    end
+  else 
+    if not IdentToAlphaColor(S,LongInt(Result)) then
+      if not IdentToAlphaColor('cla'+S,LongInt(Result)) then
+        Result:=TAlphaColor(StrToIntDef(S,TAlphaColors.Black));
+end;
+
+
+procedure RegisterAlphaColorIntegerConsts;
+begin
+  if not Assigned(FindIntToIdent(TypeInfo(TAlphaColor))) then
+    RegisterIntegerConsts(TypeInfo(TAlphaColor),@IdentToAlphaColor,@AlphaColorToIdent);
+end;
+
+function AlphaColorToColor(const Color: TAlphaColor): TColor;
+
+Var
+  R : TColorRec;
+  
+begin
+  R.A:=0;
+  R.R:=TAlphaColorRec(Color).R;
+  R.G:=TAlphaColorRec(Color).G;
+  R.B:=TAlphaColorRec(Color).B;
+  Result:=TColor(R);
+end;
+
+function AppendColor(Start, Stop: TAlphaColor): TAlphaColor;
+
+  function Channel(aStart,aStop : Byte) : byte;
+  
+  var
+    R : Integer;
+  
+  begin
+    Result:=MaxColorChannel;
+    R:=aStart+aStop;
+    if R<Result then
+      Result:=R;
+  end;
+  
+var
+  RSA : TAlphaColorRec absolute start;
+  RSS : TAlphaColorRec absolute stop;  
+  R : TAlphaColorRec;
+  
+begin
+  R.A:=Channel(RSA.A,RSS.A);
+  R.R:=Channel(RSA.R,RSS.R);
+  R.G:=Channel(RSA.G,RSS.G);
+  R.B:=Channel(RSA.B,RSS.B);
+  Result:=TAlphaColor(R);
+end;
+
+function SubtractColor(Start, Stop: TAlphaColor): TAlphaColor;
+
+  function Channel(aStart,aStop : Byte) : byte;
+  
+  var
+    R : Integer;
+  
+  begin
+    Result:=MaxColorChannel;
+    R:=aStart-aStop;
+    if R>=0 then
+      Result:=R;
+  end;
+  
+var
+  RSA : TAlphaColorRec absolute start;
+  RSS : TAlphaColorRec absolute stop;  
+  R : TAlphaColorRec absolute Result;
+  
+begin
+  R.A:=Channel(RSA.A,RSS.A);
+  R.R:=Channel(RSA.R,RSS.R);
+  R.G:=Channel(RSA.G,RSS.G);
+  R.B:=Channel(RSA.B,RSS.B);
+end;
+
+function RGBtoBGR(const C: TAlphaColor): TAlphaColor;
+
+Var
+  R : TAlphaColorRec absolute result;
+  CR : TAlphaColorRec absolute c;
+  
+begin
+  Result:=C;
+  R.R:=CR.B;
+  R.B:=CR.R;
+end;
+
+function CorrectColor(const C: TAlphaColor): TAlphaColor;
+
+begin
+{$IFNDEF WINDOWS}
+  Result:=RGBtoBGR(C);
+{$ELSE}  
+  Result:=C;
+{$ENDIF}
+end;
+
+
+function PremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
+
+  Function Mul(C,A : Byte) : Byte; inline;
+  
+  begin
+    Result:=Trunc(C*A/MaxColorChannel);
+  end;
+
+var
+  CR :  TAlphaColorRec absolute C;
+  R : TAlphaColorRec absolute Result;
+  
+begin
+  if CR.A=0 then
+    Result:=0
+  else if CR.A=MaxColorChannel then
+    Result:=C
+  else
+    begin
+    R.A:=CR.A;
+    R.R:=Mul(CR.R,CR.A);
+    R.G:=Mul(CR.G,CR.A);
+    R.B:=Mul(CR.B,CR.A);
+    end;
+end;
+
+function UnpremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
+
+  Function CDiv(C,A : Byte) : Byte; inline;
+  
+  begin
+    Result:=Trunc(C/A/MaxColorChannel);
+  end;
+  
+var
+  CR :  TAlphaColorRec absolute C;
+  R : TAlphaColorRec absolute Result;
+
+begin
+  if CR.A=0 then
+    Result:=0
+  else if CR.A=MaxColorChannel then
+    Result:=C
+  else
+    begin
+    R.A:=CR.A;
+    R.R:=CDiv(CR.R,CR.A);
+    R.G:=CDiv(CR.G,CR.A);
+    R.B:=CDiv(CR.B,CR.A);
+    end;
+end;
+
+
+function MakeColor(const C: TAlphaColor; const AOpacity: Single): TAlphaColor;
+
+var
+  CR :  TAlphaColorRec absolute C;
+  R : TAlphaColorRec absolute Result;
+
+begin
+  Result:=C;
+  if AOpacity<1 then
+    R.A:=trunc(CR.A*AOpacity);
+end;
+
+function MakeColor(R, G, B: Byte; A: Byte = MaxColorChannel): TAlphaColor;
+
+var
+  RC : TAlphaColorRec absolute Result;
+
+begin
+  RC.A:=A;
+  RC.R:=R;
+  RC.G:=G;
+  RC.B:=B;
+end;
+
+
+function LimitRange01(v : single):single;inline;
+
+begin
+  if V<0 then
+    V:=0
+  else if V>1 then
+    V:=1;
+  Result:=V;
+end;
+
+// Only valid for -1<=V<=2
+function ToRange01(v : single):single;inline;
+
+begin
+  if V<0 then
+    V:=V+1
+  else if V>1 then
+    V:=V-1;
+  Result:=V;
+end;
+
+function Max(A,B: Single):Single;inline;
+begin
+  if (A>B) then Result:=A else Result:=B;
+end;
+
+function Min(A,B: Single):Single;inline;
+begin
+  if (A<B) then Result:=A else Result:=B;
+end;
+
+
+function ChangeHSL(const C: TAlphaColor; dH, dS, dL: Single): TAlphaColor;
+
+var
+  H,S,L: Single;
+  CR : TAlphaColorRec absolute C;
+  R : TAlphaColorRec absolute Result;
+  
+begin
+  RGBtoHSL(C,H,S,L);
+  H:=ToRange01(H+dH);
+  S:=LimitRange01(S+dS);
+  L:=LimitRange01(S+dL);
+  Result:=HSLtoRGB(H,S,L);
+  R.A:=CR.A;
+end;
+
+function Hue2RGBChannel(P,Q,T: Single): Single;
+begin
+  T:=ToRange01(T);
+  if (t<1/6) then
+    Exit(P+(Q-P)*6*t);
+  if (t<1/2) then
+    Exit(Q);
+  if (t<2/3) then
+    Exit(P+(Q-P)*(2/3-t)*6);
+  Result:=LimitRange01(P);
+end;
+
+// Adapted from https://www.delphipraxis.net/157099-fast-integer-rgb-hsl.html
+function HSLtoRGB(H, S, L: Single): TAlphaColor;
+
+const
+  Fact = 1/3;
+  
+  Function UpScale(S : Single) : Byte; inline;
+  
+  begin
+    Result:=round(S*MaxColorChannel);
+  end;
+
+var
+  R, G, B: Single;
+  Q, P: Single;
+  
+begin
+  if (S = 0) then
+    begin
+    L:=LimitRange01(L);
+    R:=L;
+    G:=L;
+    B:=L;
+    end 
+  else
+    begin
+    if (L < 0.5) then
+      Q:=L*(1+S)
+    else
+      Q:=L+S*(1-L);
+    P:=2*L-q;
+    G:=Hue2RGBChannel(P,Q,H);
+    B:=Hue2RGBChannel(P,Q,H-Fact);
+    R:=Hue2RGBChannel(P,Q,H+Fact);
+    end;
+  Result:=MakeColor(UpScale(R),UpScale(G),UpScale(B));
+end;
+
+procedure RGBtoHSL(RGB: TAlphaColor; out H, S, L: Single);
+
+var
+  R,G,B,MA,MI,Su,Diff: Single;
+  RGBR : TAlphaColorRec absolute RGB;
+
+begin
+  R:=RGBR.R/$FF;
+  G:=RGBR.G/$FF;
+  B:=RGBR.B/$FF;
+  MA:=Max(Max(R,G),B);
+  MI:=Min(Min(R,G),B);
+  Su:=(MI+MA);
+  H:=Su/2;
+  L:=H;
+  if (MI=MA) then
+    begin
+    S:=0;
+    H:=0;
+    end
+  else
+    begin
+    S:=H;
+    Diff:=MA-MI;
+    if L<=0.5 then
+      S:=Diff/Su
+    else
+      S:=Diff/(2-Su);
+    if (MA=R) then
+      H:=(G-B)/Diff
+    else if (MA=G) then
+      H:=((B-R)/Diff)+2
+    else
+      H:=((R-G)/Diff)+4;
+    H:=H/6;
+    if H<0 then
+      H:=H+1;
+    end;
+end;
+
+function AlphaColorToIntColor(Color: TAlphaColor): Longint;
+begin
+  Result:=AlphaColorToColor(Color);
+end;
+
+{ ****************************************************************************
+  Cursors
+  ****************************************************************************}
+
+procedure RegisterCursorIntegerConsts;
+
+begin
+  if Assigned(FindIntToIdent(TypeInfo(TCursor))) then
+    exit;
+  RegisterIntegerConsts(TypeInfo(TCursor),@IdentToCursor,@CursorToIdent);
+end;
+
+
+function CursorToIdent(Cursor: LongInt;var Ident: string): Boolean;
+begin
+  Result:=IntToIdent(Cursor,Ident,CursorNames);
+end;
+
+
+function IdentToCursor(const Ident: string;var Cursor: LongInt): Boolean;
+begin
+  Result:=IdentToInt(Ident, Cursor, CursorNames);
+end;
+
+
+function CursorToString(Cursor: TCursor): string;
+
+begin
+  if CursorToIdent(Cursor,Result) then
+    exit;
+  Result:=Format('%d',[Cursor]);
+end;
+
+
+function StringToCursor(const S: string): TCursor;
+
+var
+  C : Longint;
+begin
+  if IdentToCursor(S,C) then 
+    Exit(TCursor(C));
+  Result:=StrToIntDef(S, Integer(crDefault));
+end;
+
+
+procedure GetCursorValues(const Proc: TGetStrProc);
+
+var
+  C: Integer;
+  
+begin
+  // Last 2 are duplicates
+  for C:=Low(CursorNames) to High(CursorNames)-2 do 
+    Proc(CursorNames[C].Name);
+end;
+
+
+initialization
+  System.UITypes.TAlphaColorRec.ColorToRGB:=@AlphaColorToIntColor;
+end.

packages/rtl-objpas/src/inc/system.uitypes.pp

@@ -29,6 +29,7 @@ Type
     PColorRef   = ^TColorRef;
     TAlphaColor = Cardinal;
     PAlphaColor = ^TAlphaColor;
+    TImageIndex = type Integer;
 
     TColorRec = record
                  class operator := (AColor : TColor): TColorRec; inline;
@@ -190,6 +191,39 @@ Type
       // aliases
       LtGray             = TColor($C0C0C0); // clSilver alias
       DkGray             = TColor($808080); // clGray alias
+      // Windows system colors
+      SysScrollBar               = TColor($FF000000) platform;
+      SysBackground              = TColor($FF000001) platform;
+      SysActiveCaption           = TColor($FF000002) platform;
+      SysInactiveCaption         = TColor($FF000003) platform;
+      SysMenu                    = TColor($FF000004) platform;
+      SysWindow                  = TColor($FF000005) platform;
+      SysWindowFrame             = TColor($FF000006) platform;
+      SysMenuText                = TColor($FF000007) platform;
+      SysWindowText              = TColor($FF000008) platform;
+      SysCaptionText             = TColor($FF000009) platform;
+      SysActiveBorder            = TColor($FF00000A) platform;
+      SysInactiveBorder          = TColor($FF00000B) platform;
+      SysAppWorkSpace            = TColor($FF00000C) platform;
+      SysHighlight               = TColor($FF00000D) platform;
+      SysHighlightText           = TColor($FF00000E) platform;
+      SysBtnFace                 = TColor($FF00000F) platform;
+      SysBtnShadow               = TColor($FF000010) platform;
+      SysGrayText                = TColor($FF000011) platform;
+      SysBtnText                 = TColor($FF000012) platform;
+      SysInactiveCaptionText     = TColor($FF000013) platform;
+      SysBtnHighlight            = TColor($FF000014) platform;
+      Sys3DDkShadow              = TColor($FF000015) platform;
+      Sys3DLight                 = TColor($FF000016) platform;
+      SysInfoText                = TColor($FF000017) platform;
+      SysInfoBk                  = TColor($FF000018) platform;
+      SysHotLight                = TColor($FF00001A) platform;
+      SysGradientActiveCaption   = TColor($FF00001B) platform;
+      SysGradientInactiveCaption = TColor($FF00001C) platform;
+      SysMenuHighlight           = TColor($FF00001D) platform;
+      SysMenuBar                 = TColor($FF00001E) platform;
+      SysNone                    = TColor($1FFFFFFF) platform;
+      SysDefault                 = TColor($20000000) platform;
       var
         case Integer of
           0:  {$IFDEF ENDIAN_BIG}

packages/rtl-objpas/tests/tdateof.pp

@@ -0,0 +1,12 @@
+uses
+  Sysutils,DateUtils;
+var
+  d1,d2 : TDateTime;
+begin
+  d1:=EncodeDateDay(2023,1);
+  d2:=EncodeDate(2023,1,1);
+  d1:=d1+0.6;
+  d2:=d2+0.3;
+  if DateOf(d1)<>DateOf(d2) then
+    halt(1);
+end.

packages/sdl/src/sdlutils.pas

@@ -2362,8 +2362,7 @@ begin
 
   maxx := DstSurface.w;
   maxy := DstSurface.h;
-  aCos := cos( Angle );
-  aSin := sin( Angle );
+  SinCos(Angle, aSin, aCos);
 
   Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
   Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );

packages/tosunits/src/xbios.pas

@@ -296,6 +296,8 @@ const
 
     NUMCOLS     = 7;
 
+    VM_INQUIRE  = -1;
+
 {* Values returned by VgetMonitor() *}
     MON_MONO        = 0;
     MON_COLOR       = 1;
@@ -303,7 +305,6 @@ const
     MON_TV          = 3;
 
 {* VsetSync flags - 0=internal, 1=external *}
-
     VID_CLOCK   = 1;
     VID_VSYNC   = 2;
     VID_HSYNC   = 4;
@@ -687,8 +688,8 @@ function xbios_Vsetmode(modecode: smallint): smallint; syscall 14 88;
 function xbios_mon_type: smallint; syscall 14 89;
 procedure xbios_VsetSync(flag: smallint); syscall 14 90;
 function xbios_VgetSize(mode: smallint): LongInt; syscall 14 91;
-procedure xbios_VsetRGB(index, count: smallint; xrgbArray: Array of TRGB); syscall 14 93;
-procedure xbios_VgetRGB(index, count: smallint; var xrgbArray: Array of TRGB); syscall 14 94;
+procedure xbios_VsetRGB(index, count: smallint; xrgbArray: PRGB); syscall 14 93;
+procedure xbios_VgetRGB(index, count: smallint; xrgbArray: PRGB); syscall 14 94;
 function xbios_Validmode(mode: smallint): smallint; syscall 14 95;
 procedure xbios_Dsp_DoBlock(data_in: Pointer; size_in: LongInt; data_out: Pointer; size_out: LongInt); syscall 14 96;
 procedure xbios_Dsp_BlkHandShake(data_in: Pointer; size_in: LongInt; data_out: Pointer; size_out: LongInt); syscall 14 97;

rtl/aix/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -898,7 +900,6 @@ TERMIO_DEPS_OS=$(UNIXTYPEUNIT)$(PPUEXT) $(CTYPESUNIT)$(PPUEXT)
 DOSDIR=$(UNIXINC)
 SYSUTILSDIR=$(UNIXINC)
 SYSUTILS_DEPS_OS = $(UNIXUNIT)$(PPUEXT) $(ERRORSUNIT)$(PPUEXT)
-SYSTEMUNIT=system
 ifeq ($(ARCH),i386)
 CPU_UNITS=$(CPUUNIT) $(MMXUNIT)
 endif

rtl/aix/Makefile.fpc

@@ -70,7 +70,6 @@ SYSUTILSDIR=$(UNIXINC)
 SYSUTILS_DEPS_OS = $(UNIXUNIT)$(PPUEXT) $(ERRORSUNIT)$(PPUEXT)
 
 
-SYSTEMUNIT=system
 
 
 ifeq ($(ARCH),i386)

rtl/amiga/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -889,7 +891,6 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 AMIINC=$(RTL)/amicommon
 UNITPREFIX=rtl
 LOADERS=prt0
-SYSTEMUNIT=system
 OBJPASDIR=$(RTL)/objpas
 ifeq ($(ARCH),m68k)
 override LOADERS=

rtl/amiga/Makefile.fpc

@@ -40,7 +40,6 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 AMIINC=$(RTL)/amicommon
 UNITPREFIX=rtl
 LOADERS=prt0
-SYSTEMUNIT=system
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

rtl/android/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -910,7 +912,6 @@ endif
 ifeq ($(ARCH),i386)
 CPU_UNITS+=$(MMXUNIT)
 endif
-SYSTEMUNIT=system
 ifdef RELEASE
 override FPCOPT+=-Ur
 endif

rtl/android/Makefile.fpc

@@ -81,7 +81,6 @@ ifeq ($(ARCH),i386)
 CPU_UNITS+=$(MMXUNIT)
 endif
 
-SYSTEMUNIT=system
 
 # Causes release PPU files not to be recompiled
 ifdef RELEASE

rtl/aros/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -889,7 +891,6 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 AMIINC=$(RTL)/amicommon
 UNITPREFIX=rtl
 LOADERS=prt0
-SYSTEMUNIT=system
 SYSINITUNITS=si_prc
 OBJPASDIR=$(RTL)/objpas
 ifeq ($(ARCH),i386)

rtl/aros/Makefile.fpc

@@ -42,7 +42,6 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 AMIINC=$(RTL)/amicommon
 UNITPREFIX=rtl
 LOADERS=prt0
-SYSTEMUNIT=system
 SYSINITUNITS=si_prc
 
 # Paths

rtl/atari/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -888,7 +890,6 @@ COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
 LOADERS=
-SYSTEMUNIT=system
 OBJPASDIR=$(RTL)/objpas
 ifeq ($(CPU_OS_TARGET),m68k-atari)
 override TARGET_UNITS+=$(SYSTEMUNIT) fpextres $(UUCHARUNIT) $(OBJPASUNIT) $(MACPASUNIT) $(ISO7185UNIT) buildrtl $(CPALLUNIT)

rtl/atari/Makefile.fpc

@@ -38,7 +38,6 @@ COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
 LOADERS=
-SYSTEMUNIT=system
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

rtl/beos/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -887,7 +889,6 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 BASEUNIXDIR=.
 ifndef FPC_DOTTEDUNITS
 RTLCONSTSUNIT=rtlconst

rtl/beos/Makefile.fpc

@@ -53,7 +53,6 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 BASEUNIXDIR=.
 ifndef FPC_DOTTEDUNITS
 RTLCONSTSUNIT=rtlconst

rtl/darwin/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -905,7 +907,6 @@ CTYPES_DEPS_OS=$(UNIXTYPEUNIT)$(PPUEXT)
 EXEINFO_DEPS_OS=$(BASEUNIXUNIT)$(PPUEXT) $(CTYPESUNIT)$(PPUEXT) $(DLUNIT)$(PPUEXT)
 FPEXTRES_DEPS_OS=$(BASEUNIXUNIT)$(PPUEXT)
 DOS_DEPS_OS=$(BASEUNIXUNIT)$(PPUEXT) $(UNIXUTILUNIT)$(PPUEXT) $(UNIXUNIT)$(PPUEXT)
-SYSTEMUNIT=system
 override FPCOPT+=-dFPC_USE_LIBC
 OBJPASDIR=$(RTL)/objpas
 ifeq ($(CPU_OS_TARGET),i386-darwin)

rtl/darwin/Makefile.fpc

@@ -75,7 +75,6 @@ EXEINFO_DEPS_OS=$(BASEUNIXUNIT)$(PPUEXT) $(CTYPESUNIT)$(PPUEXT) $(DLUNIT)$(PPUEX
 FPEXTRES_DEPS_OS=$(BASEUNIXUNIT)$(PPUEXT)
 DOS_DEPS_OS=$(BASEUNIXUNIT)$(PPUEXT) $(UNIXUTILUNIT)$(PPUEXT) $(UNIXUNIT)$(PPUEXT)
 
-SYSTEMUNIT=system
 
 # Darwin requires libc, no syscalls
 override FPCOPT+=-dFPC_USE_LIBC

rtl/dragonfly/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -898,9 +900,9 @@ DYNLIBS_DEPS_OS=$(DLUNIT)$(PPUEXT)
 DYNLIBSINCDIR=$(UNIXINC)
 SYSCALL_DEPS_OS=sysnr.inc $(BSDPROCINC)/syscallh.inc
 BASEUNIX_DEPS_OS=$(SYSCTLUNIT)$(PPUEXT)
+SYSTEMDIR = $(BSDINC)
 SYSUTILSDIR=$(UNIXINC)
 SYSUTILS_DEPS_OS = $(UNIXUNIT)$(PPUEXT) $(ERRORSUNIT)$(PPUEXT)
-SYSTEMUNIT=system
 loaders+=gprt0
 ifeq ($(ARCH),x86_64)
 CPU_UNITS=$(X86UNIT) $(PORTSUNIT) $(CPUUNIT)
@@ -2934,7 +2936,6 @@ SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 SYSDEPS = unxconst.inc $(SYSINCDEPS) $(SYSCPUDEPS)
-SYSTEMDIR = $(BSDINC)
 prt0$(OEXT) : $(CPU_TARGET)/prt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as

rtl/dragonfly/Makefile.fpc

@@ -69,10 +69,12 @@ DYNLIBS_DEPS_OS=$(DLUNIT)$(PPUEXT)
 DYNLIBSINCDIR=$(UNIXINC)
 SYSCALL_DEPS_OS=sysnr.inc $(BSDPROCINC)/syscallh.inc
 BASEUNIX_DEPS_OS=$(SYSCTLUNIT)$(PPUEXT)
+
+SYSTEMDIR = $(BSDINC)
+
 SYSUTILSDIR=$(UNIXINC)
 SYSUTILS_DEPS_OS = $(UNIXUNIT)$(PPUEXT) $(ERRORSUNIT)$(PPUEXT)
 
-SYSTEMUNIT=system
 loaders+=gprt0
 
 ifeq ($(ARCH),x86_64)
@@ -98,7 +100,6 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
 # Put system unit dependencies together.
 SYSDEPS = unxconst.inc $(SYSINCDEPS) $(SYSCPUDEPS)
-SYSTEMDIR = $(BSDINC)
 
 #
 # Loaders

rtl/embedded/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -886,7 +888,6 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 LOADERS=
 ifeq ($(ARCH),mipsel)
 ifeq ($(SUBARCH),pic32mx)
@@ -1083,7 +1084,7 @@ $(error No CPUs enabled for given SUBARCH, pass either a SUBARCH or set CPU_UNIT
 endif
 endif
 ifeq ($(ARCH),wasm32)
-CPU_SPECIFIC_COMMON_UNITS:=$(filter-out $(LINEINFOUNIT), $(CPU_SPECIFIC_COMMON_UNITS))
+CPU_SPECIFIC_COMMON_UNITS:=$(filter-out $(SOFTFPUUNIT), $(filter-out $(LINEINFOUNIT), $(CPU_SPECIFIC_COMMON_UNITS)))
 endif
 OBJPASDIR=$(RTL)/objpas
 ifeq ($(CPU_OS_TARGET),i386-embedded)

rtl/embedded/Makefile.fpc

@@ -43,7 +43,6 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 LOADERS=
 ifeq ($(ARCH),mipsel)
 ifeq ($(SUBARCH),pic32mx)
@@ -263,7 +262,7 @@ endif
 endif
 
 ifeq ($(ARCH),wasm32)
-CPU_SPECIFIC_COMMON_UNITS:=$(filter-out $(LINEINFOUNIT), $(CPU_SPECIFIC_COMMON_UNITS))
+CPU_SPECIFIC_COMMON_UNITS:=$(filter-out $(SOFTFPUUNIT), $(filter-out $(LINEINFOUNIT), $(CPU_SPECIFIC_COMMON_UNITS)))
 endif
 
 # Paths

rtl/emx/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -891,7 +893,6 @@ DOS_DEPS_OS=$(DOSCALLSUNIT)$(PPUEXT)
 SYSUTILS_DEPS_OS=$(DOSUNIT)$(PPUEXT)
 DYNLIBS_DEPS_OS=$(DOSCALLSUNIT)$(PPUEXT)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 ifndef FPC_DOTTEDUNITS
 RTLCONSTSUNIT=rtlconst
 endif

rtl/emx/Makefile.fpc

@@ -49,7 +49,6 @@ DYNLIBS_DEPS_OS=$(DOSCALLSUNIT)$(PPUEXT)
 
 UNITPREFIX=rtl
 
-SYSTEMUNIT=system
 ifndef FPC_DOTTEDUNITS
 RTLCONSTSUNIT=rtlconst
 endif

rtl/freebsd/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -899,9 +901,9 @@ DOSDIR=$(UNIXINC)
 DYNLIBS_DEPS_OS=$(DLUNIT)$(PPUEXT)
 DYNLIBSINCDIR=$(UNIXINC)
 SYSCALL_DEPS_OS = sysnr.inc $(BSDPROCINC)/syscallh.inc
+SYSTEMDIR = $(BSDINC)
 SYSUTILSDIR=$(UNIXINC)
 SYSUTILS_DEPS_OS = $(UNIXUNIT)$(PPUEXT) $(ERRORSUNIT)$(PPUEXT)
-SYSTEMUNIT=system
 loaders+=gprt0
 ifeq ($(ARCH),i386)
 CPU_UNITS=$(X86UNIT) $(PORTSUNIT) $(CPUUNIT) $(MMXUNIT)
@@ -2976,7 +2978,6 @@ SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 SYSDEPS = unxconst.inc $(SYSINCDEPS) $(SYSCPUDEPS)
-SYSTEMDIR = $(BSDINC)
 prt0$(OEXT) : $(CPU_TARGET)/prt0.as
 	$(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as

rtl/freebsd/Makefile.fpc

@@ -69,10 +69,10 @@ DYNLIBS_DEPS_OS=$(DLUNIT)$(PPUEXT)
 DYNLIBSINCDIR=$(UNIXINC)
 
 SYSCALL_DEPS_OS = sysnr.inc $(BSDPROCINC)/syscallh.inc
+SYSTEMDIR = $(BSDINC)
 SYSUTILSDIR=$(UNIXINC)
 SYSUTILS_DEPS_OS = $(UNIXUNIT)$(PPUEXT) $(ERRORSUNIT)$(PPUEXT)
 
-SYSTEMUNIT=system
 loaders+=gprt0
 
 ifeq ($(ARCH),i386)
@@ -104,7 +104,6 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
 # Put system unit dependencies together.
 SYSDEPS = unxconst.inc $(SYSINCDEPS) $(SYSCPUDEPS)
-SYSTEMDIR = $(BSDINC)
 
 #
 # Loaders

rtl/freertos/Makefile

@@ -586,6 +586,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -832,6 +833,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -886,7 +888,6 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 LOADERS=
 ifeq ($(ARCH),mipsel)
 ifeq ($(SUBARCH),pic32mx)

rtl/freertos/Makefile.fpc

@@ -44,7 +44,6 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 LOADERS=
 ifeq ($(ARCH),mipsel)
 ifeq ($(SUBARCH),pic32mx)

rtl/gba/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -887,7 +889,6 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 LOADERS=prt0 cprt0
 OBJPASDIR=$(RTL)/objpas
 SYSUTILS_DEPS_OS=$(DOSUNIT)$(PPUEXT)

rtl/gba/Makefile.fpc

@@ -37,7 +37,6 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 LOADERS=prt0 cprt0
 
 # Paths

rtl/go32v2/Makefile

@@ -587,6 +587,7 @@ SYSCONSTUNIT=System.SysConst
 SYSCTLUNIT=BsdApi.SysCtl
 SYSEMXUNIT=DOSApi.Sysemx
 SYSOS2UNIT=OS2Api.sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=PalmApi.Systraps
 SYSUTILSUNIT=System.SysUtils
 TERMIOUNIT=UnixApi.TermIO
@@ -833,6 +834,7 @@ SYSCONSTUNIT=sysconst
 SYSCTLUNIT=sysctl
 SYSEMXUNIT=sysemx
 SYSOS2UNIT=sysos2
+SYSTEMUNIT=system
 SYSTRAPSUNIT=systraps
 SYSUTILSUNIT=sysutils
 TERMIOUNIT=termio
@@ -887,7 +889,6 @@ INC=../inc
 COMMON=$(RTL)/common
 PROCINC=../$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 ifndef FPC_DOTTEDUNITS
 RTLCONSTSUNIT=rtlconst
 endif

rtl/go32v2/Makefile.fpc

@@ -32,7 +32,6 @@ INC=../inc
 COMMON=$(RTL)/common
 PROCINC=../$(CPU_TARGET)
 UNITPREFIX=rtl
-SYSTEMUNIT=system
 ifndef FPC_DOTTEDUNITS
 RTLCONSTSUNIT=rtlconst
 endif