[rdd][dbfcdx] Flush stream before unlock in shared mode

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Globalization
USING System.Collections.Generic
USING XSharp.RDD.Enums
USING XSharp.RDD.Support
USING System.Text
USING System.IO
USING System.Linq
USING System.Diagnostics

BEGIN NAMESPACE XSharp.RDD.CDX
    /// <summary>
    /// Orderbag = CDX file. Contains one or more orders = Tags
    /// </summary>
    INTERNAL SEALED CLASS CdxOrderBag INHERIT BaseIndex
#region constants
    INTERNAL CONST CDX_EXTENSION := ".CDX" AS STRING

#endregion
        INTERNAL _hFile     AS IntPtr
        INTERNAL _stream    AS FileStream
        INTERNAL _OpenInfo	AS DbOpenInfo
        INTERNAL _Encoding  AS Encoding
        INTERNAL _PageList  AS CdxPageList
        INTERNAL PROPERTY Shared    AS LOGIC GET _OpenInfo:Shared
        INTERNAL PROPERTY ReadOnly  AS LOGIC GET _OpenInfo:ReadOnly
        INTERNAL _oRdd              AS DBFCDX
        INTERNAL _root              AS CdxFileHeader
        INTERNAL _tagList           AS CdxTagList
        INTERNAL CONST CDXPAGE_SIZE := 512 AS WORD

        //INTERNAL PROPERTY FileName AS STRING AUTO
        INTERNAL PROPERTY FullPath AS STRING AUTO
        INTERNAL PROPERTY Name AS STRING GET Path.GetFileNameWithoutExtension(FullPath)
        INTERNAL PROPERTY Handle AS IntPtr GET _hFile
        INTERNAL PROPERTY Stream AS FileStream GET _stream
        INTERNAL PROPERTY Tags AS IList<CdxTag> GET IIF(_tagList == NULL, NULL, _tagList:Tags)
        INTERNAL PROPERTY TagList AS CdxTagList GET _tagList
        INTERNAL PROPERTY Structural AS LOGIC AUTO
        INTERNAL PROPERTY Root      AS CdxFileHeader GET _root
        INTERNAL PROPERTY Encoding AS System.Text.Encoding GET _oRdd:_Encoding
        INTERNAL CONSTRUCTOR(oRDD AS DBFCDX )
            SUPER( oRDD )
            SELF:_oRdd     := oRDD
            SELF:_PageList := CdxPageList{SELF}
            SELF:_OpenInfo := oRDD:_OpenInfo
            SELF:_useFoxLock := XSharp.RuntimeState.GetValue<LOGIC>(Set.FoxLock)

        #region RDD Overloads
            /// <inheritdoc />
        OVERRIDE METHOD OrderCondition(info AS DbOrderCondInfo) AS LOGIC
            THROW NotImplementedException{}

        INTERNAL STATIC METHOD GetIndexExtFromDbfExt(cDbfName AS STRING) AS STRING
            SWITCH System.IO.Path.GetExtension(cDbfName:ToLower())
            CASE ".vcx"         // Control Library
            CASE ".scx"         // Screen
            CASE ".pjx"         // Project
            CASE ".mnx"         // Menu
            CASE ".frx"         // Report
                RETURN ""
            CASE ".dbc"         // database container
                RETURN ".dcx"
            END SWITCH
            RETURN CDX_EXTENSION
            /// <inheritdoc />
        OVERRIDE METHOD OrderCreate(info AS DbOrderCreateInfo) AS LOGIC
            LOCAL cTag AS STRING
            IF info:Order IS STRING VAR strOrder .and. ! String.IsNullOrWhiteSpace(strOrder)
                cTag := strOrder
            ELSE
                cTag := Path.GetFileNameWithoutExtension(info:BagName)
                IF cTag:Length > 10
                    cTag := cTag:Substring(0, 10)
                ENDIF
                info:Order := cTag
            ENDIF
            IF String.IsNullOrEmpty(cTag)
                // Exception ?
                RETURN FALSE
            ENDIF
            VAR oTag := SELF:_FindTagByName(cTag)
            VAR lOk := TRUE
            IF oTag != NULL_OBJECT
                VAR last := SELF:_tagList:Tags:Count == 1
                SELF:Destroy(oTag)
                IF last
                    SELF:CreateBag(SELF:FullPath)
                    SELF:_oRdd:_indexList:_AddBag(SELF)
                ENDIF
            ENDIF
            oTag := CdxTag{SELF}
            lOk := oTag:Create(info)
            IF lOk
                // Read the tag from disk to get all the normal stuff
                oTag  := CdxTag{SELF,oTag:Header:PageNo, oTag:OrderName}
                SELF:AddTag(oTag)
            ENDIF
            RETURN lOk

        METHOD AddTag(oTag AS CdxTag) AS LOGIC
            _tagList:Add(oTag)
            RETURN TRUE

        METHOD Destroy(oParam AS CdxTag) AS LOGIC
            LOCAL found := FALSE AS LOGIC
            VAR aTags   := SELF:Tags:ToArray()
            FOREACH tag AS CdxTag IN aTags
                IF String.Compare(tag:OrderName, oParam:OrderName, StringComparison.OrdinalIgnoreCase) == 0
                    oParam := tag
                    found := TRUE
                    EXIT
                ENDIF
            NEXT
            IF found
                // rewrite the taglist
                SELF:_tagList:Remove(oParam)
                // We do not Delete the pages from the tag. Comix also does not do that
                IF SELF:_tagList:Tags:Count == 0
                    LOCAL cFileName := SELF:FullPath AS STRING
                    SELF:_oRdd:_indexList:_CloseBag(SELF)
                    FErase(cFileName)
                ENDIF
            ENDIF
            RETURN found

            /// <inheritdoc />
        OVERRIDE METHOD OrderDestroy(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderInfo(nOrdinal AS DWORD, info AS DbOrderInfo) AS OBJECT
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderListAdd(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderListDelete(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderListFocus(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />

        OVERRIDE METHOD OrderListRebuild( ) AS LOGIC
            LOCAL aTags AS CdxTag[]
            LOCAL cBagName AS STRING
            LOCAL lOk AS LOGIC
            aTags := SELF:_tagList:Tags:ToArray()
            cBagName := SELF:FullPath
            lOk := TRUE
            lOk := SELF:Close()
            IF lOk
                FErase(cBagName)
                lOk := SELF:CreateBag(cBagName)
            ENDIF
            IF lOk
                FOREACH oTag AS CdxTag IN aTags
                    lOk := oTag:Rebuild()
                    IF ! lOk
                        EXIT
                    ENDIF
                    SELF:AddTag(oTag)
                NEXT
            ENDIF
            SELF:GoCold()
            RETURN lOk

            /// <inheritdoc />
        OVERRIDE METHOD Seek(info AS DbSeekInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE PROPERTY Found AS LOGIC
            GET
                THROW NotImplementedException{}
            END GET
        END PROPERTY
        #endregion

        #region Open and Close etc
        METHOD CreateBag(cBagName AS STRING) AS LOGIC
            LOCAL cPath     AS STRING
            LOCAL cFullName AS STRING
            LOCAL cDbf      AS STRING
            cFullName := cBagName
            cDbf      := SELF:_oRdd:FileName
            VAR cExt  := GetIndexExtFromDbfExt(cDbf)
            IF String.IsNullOrEmpty(cFullName)
                cFullName := Path.ChangeExtension(cDbf, cExt)
            ELSEIF String.IsNullOrEmpty(Path.GetExtension(cFullName))
                cFullName := Path.ChangeExtension(cFullName, cExt)
            ELSEIF String.Compare(cDbf, cFullName, StringComparison.OrdinalIgnoreCase) == 0
                 cFullName := Path.ChangeExtension(cFullName, cExt)
            ENDIF
            cPath := Path.GetDirectoryName(cFullName)
            IF String.IsNullOrEmpty(cPath)
                cPath := Path.GetDirectoryName(cDbf)
                cFullName := Path.Combine(cPath, cFullName)
            ENDIF
            IF File(cFullName)
                LOCAL openInfo AS DbOrderInfo
                openInfo := DbOrderInfo{}
                openInfo:BagName := FPathName()
                SELF:Open(openInfo)
                RETURN TRUE
            ENDIF
            SELF:_hFile    := FCreate(cFullName)
            SELF:_stream   := FGetStream(SELF:_hFile)
            IF File(cFullName)
                // Make sure the full name is returned and not the DOS Short Name
                SELF:FullPath :=FPathName()
            ENDIF
            // Allocate Root Page
            _root   := CdxFileHeader{SELF}
            _root:Initialize()
            _PageList:Add(_root)
            SELF:Write(_root)
            // taglist page
            VAR buffer := SELF:AllocBuffer()
            _tagList := CdxTagList{SELF,  _root:RootPage, buffer, _root:KeySize}
            _tagList:InitBlank(NULL)
            SELF:Write(_tagList)
            RETURN TRUE

        METHOD _FindTagByName(cName AS STRING) AS CdxTag
            IF SELF:Tags != NULL
                FOREACH oTag AS CdxTag IN SELF:Tags
                    IF String.Compare(oTag:OrderName, cName,StringComparison.OrdinalIgnoreCase) == 0
                        RETURN oTag
                    ENDIF
                NEXT
            ENDIF
            RETURN NULL

        METHOD Close() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH tag AS CdxTag IN Tags
                IF ! tag:Close()
                    lOk := FALSE
                ENDIF
            NEXT
            IF ! SELF:_PageList:Flush(FALSE)
                lOk := FALSE
            ENDIF
            IF ! FClose(SELF:_hFile)
                lOk := FALSE
            ENDIF
            SELF:_stream := NULL
            SELF:_hFile  := F_ERROR
            RETURN lOk

        INTERNAL METHOD Open(info AS DbOrderInfo) AS LOGIC
            // Filename may have path or not
            // When the filename does not have a path then we look in the path of the DBF
            LOCAL cPath     AS STRING
            LOCAL cFileName AS STRING
            LOCAL cFullName AS STRING
            IF info == NULL
                RETURN FALSE
            ENDIF
            cFullName := cFileName := info:BagName
            IF String.IsNullOrEmpty(Path.GetExtension(cFullName))
                VAR cExt  := GetIndexExtFromDbfExt(cFullName)
                cFullName := Path.ChangeExtension(cFullName, cExt)
            ENDIF
            cPath := Path.GetDirectoryName(cFullName)
            IF String.IsNullOrEmpty(cPath)
                cPath := SELF:_oRdd:FileName
                cPath := Path.GetDirectoryName(cPath)
                cFullName := Path.Combine(cPath, cFileName)
            ENDIF
            IF !File(cFullName)
                RETURN FALSE
            ENDIF
            // Adjust Filename to handle 8 char DOS names
            cFullName := FPathName()
            SELF:FullPath := cFullName
            SELF:_OpenInfo := _oRdd:_OpenInfo
            SELF:_hFile    := FOpen(cFullName, _OpenInfo:FileMode)
            SELF:_stream   := FGetStream(SELF:_hFile)
            SELF:_Encoding := _oRdd:_Encoding
            IF SELF:_hFile == F_ERROR
                RETURN FALSE
            ENDIF
            _root := CdxFileHeader{SELF}
            _root:Read()
            SELF:SetPage(_root)
            VAR nTagList := SELF:_root:RootPage
            VAR page     := SELF:GetPage(nTagList, _root:KeySize, NULL)
            _tagList := CdxTagList{SELF,  page, _root:KeySize}
            SELF:SetPage(_tagList)
            _tagList:ReadTags()
            // No need to Compile expressions again. Is done in ReadTags already
            // If we do want to do it again, then remember to save the LastRddError !
            // FOREACH VAR tag IN Tags
            //    tag:EvaluateExpressions()
            // NEXT
            RETURN TRUE
        #endregion

         METHOD MatchesFileName(cFileName AS STRING) AS LOGIC
            VAR cExt := Path.GetExtension(cFileName)
            IF String.IsNullOrEmpty(cExt)
                cFileName := Path.ChangeExtension(cFileName, CDX_EXTENSION)
            ENDIF
            IF String.Compare(SELF:FullPath, cFileName, StringComparison.OrdinalIgnoreCase) == 0
                RETURN TRUE
            ENDIF
            VAR cPath := Path.GetDirectoryName(cFileName)
            IF String.IsNullOrEmpty(cPath)
                IF String.Compare(Path.GetFileName(FullPath), cFileName, StringComparison.OrdinalIgnoreCase) == 0
                    RETURN TRUE
                ENDIF
            ENDIF
            RETURN FALSE

         OVERRIDE METHOD Flush() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH tag AS CdxTag IN SELF:Tags
                IF ! tag:Flush()
                    lOk := FALSE
                ENDIF
            NEXT
            lOk := SELF:FlushPages() .and. lOk
            RETURN lOk

         INTERNAL METHOD FlushPages() AS LOGIC
            RETURN SELF:_PageList:Flush(FALSE)

         INTERNAL METHOD SavePages() AS LOGIC
            RETURN SELF:_PageList:Flush(TRUE)

         METHOD GoCold() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH tag AS CdxTag IN SELF:Tags
                IF ! tag:GoCold()
                    lOk := FALSE
                ENDIF
            NEXT
            RETURN lOk

        METHOD GoHot() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH VAR tag IN SELF:Tags
                IF ! tag:GoHot()
                    lOk := FALSE
                ENDIF
            NEXT
            RETURN lOk

        METHOD FindFreePage() AS LONG
            LOCAL nPage AS LONG
            LOCAL nNext AS LONG
            IF SELF:_root:FreeList > 0
                nPage := SELF:_root:FreeList
                VAR oPage := SELF:_PageList:GetPage(nPage, 0, NULL)
                IF oPage IS CdxTreePage VAR tPage
                    nNext := tPage:LeftPtr
                    IF nNext < 0
                        nNext := 0
                    ENDIF
                    SELF:_root:FreeList := nNext
                    SELF:_root:Write()
                ENDIF
                SELF:_PageList:Delete(nPage)
            ELSE
                IF _stream:Length >= Int32.MaxValue
                    var cMessage := "Maximum file size of 2 Gb for CDX file exceeded"
                    DebOut32(cMessage)
                    throw IOException{cMessage}
                ENDIF
                nPage   := (LONG) _stream:Length
            ENDIF
            RETURN nPage

         METHOD AddFreePage(oPage AS CdxTreePage) AS LOGIC
            VAR nPage := oPage:PageNo
            oPage:Clear()
            oPage:LeftPtr   := SELF:_root:FreeList
            oPage:RightPtr  := 0
            oPage:Write()
            SELF:_root:FreeList := nPage
            SELF:_root:Write()
            SELF:_PageList:Delete(nPage)
            RETURN TRUE

        METHOD AllocBuffer(nSize := 1 AS LONG)  AS BYTE[]
            RETURN BYTE[]{CDXPAGE_SIZE *nSize}

        METHOD Read(nPage AS LONG, buffer AS BYTE[]) AS LOGIC
            RETURN SELF:_stream:SafeReadAt(nPage, buffer)

        METHOD Read(oPage AS CdxPage) AS LOGIC
            IF SELF:_root != NULL
                oPage:Generation := SELF:_root:RootVersion
            ENDIF
            RETURN SELF:_stream:SafeReadAt(oPage:PageNo, oPage:Buffer, oPage:Buffer:Length)

        METHOD Write(oPage AS CdxPage) AS LOGIC
            LOCAL isOk AS LOGIC
            SELF:_PageList:CheckVersion(SELF:Root:RootVersion)
            IF oPage:PageNo == -1
                oPage:PageNo := SELF:FindFreePage()
                oPage:IsHot  := TRUE
                SELF:_PageList:SetPage(oPage:PageNo, oPage)
            ENDIF
            if oPage:PageNo < 0
                var cMessage := i"Trying to write to negative pageno {oPage:PageNo} in CDX"
                DebOut32(cMessage)
                THROW IOException{cMessage}
            ENDIF
            IF oPage:IsHot
                isOk := SELF:_stream:SafeWriteAt(oPage:PageNo, oPage:Buffer)
            ELSE
                isOk := TRUE
            ENDIF
            RETURN isOk

        METHOD GetPage(nPage AS Int32, nKeyLen AS WORD,tag AS CdxTag) AS CdxPage
           IF nPage == -1
                RETURN NULL
           ENDIF
           VAR page := SELF:_PageList:GetPage(nPage, nKeyLen,tag)
           IF page != NULL
                SELF:SetPage( page)
           ENDIF
           RETURN page

         METHOD SetPage(page AS CdxPage) AS VOID
            SELF:_PageList:SetPage(page:PageNo, page)
#ifdef DEBUG
            page:Generation := SELF:Root:RootVersion
#endif

        #region properties

        PROPERTY Count AS LONG GET SELF:Tags:Count
        PROPERTY BagHasChanged AS LOGIC
            GET
                LOCAL nVersion AS DWORD
                nVersion := _root:RootVersion
                SELF:Read(SELF:_root)
                RETURN nVersion != _root:RootVersion

            END GET
        END PROPERTY

        INTERNAL METHOD CheckForChangedBag() AS LOGIC
            LOCAL lChanged := FALSE AS LOGIC
            IF SELF:BagHasChanged
                lChanged := TRUE
                SELF:_PageList:Clear()
                // Add new versions of Root and Taglist to the cache
                SELF:Root:Read()
                SELF:_tagList:Read()
                SELF:_PageList:Add(SELF:Root)
                SELF:_PageList:Add(SELF:_tagList)
            ENDIF
            RETURN lChanged

        PROPERTY IsHot AS LOGIC
        GET
            // return true as soon as one tag is hot
            FOREACH oTag AS CdxTag IN SELF:Tags
                IF oTag:IsHot
                    RETURN TRUE
                ENDIF
            NEXT
            RETURN FALSE
        END GET
        END PROPERTY
        #endregion

#region Common Locking code
        PRIVATE _useFoxLock     := FALSE AS LOGIC
        PRIVATE _sharedLocks    := 0 AS LONG
        PRIVATE _exclusiveLocks := 0 AS LONG
        STATIC PRIVATE rand := Random{100} AS System.Random

        PRIVATE METHOD _LockRetry(nOffSet AS INT64, nLen AS INT64,sPrefix AS STRING) AS VOID
            LOCAL result := FALSE AS LOGIC
            // note that there is no wait here. Research showed that the VO/Vulcan drivers
            // also did not wait
            REPEAT
                result := SELF:_stream:SafeLock(nOffSet, nLen)
            UNTIL result
            //DebOut32( "Locked " +nOffSet:ToString()+" "+nLen:ToString())

        PRIVATE METHOD _Unlock(nOffSet AS INT64, nLen AS INT64) AS LOGIC
            VAR res := SELF:_stream:SafeUnlock(nOffSet, nLen)
            //IF res
            //    NOP // DebOut32( "UnLocked " +nOffSet:ToString()+" "+nLen:ToString())
            //ELSE
            //    //DebOut32( "UnLock FAILED " +nOffSet:ToString()+" "+nLen:ToString())
            //ENDIF
            RETURN res

        INTERNAL METHOD SLock() AS LOGIC
            IF !SELF:Shared
                RETURN TRUE
            ENDIF
            //DebOut32( System.Threading.Thread.CurrentThread:Name+__ENTITY__ )
            BEGIN LOCK SELF
                SELF:_sharedLocks += 1
                IF SELF:_exclusiveLocks == 0  .AND. SELF:_sharedLocks == 1
                    IF SELF:_useFoxLock
                        SELF:_SLockFox()
                    ELSE
                        SELF:_SLockComix()
                    ENDIF
                    SELF:CheckForChangedBag()
                ENDIF
            END LOCK
            RETURN TRUE

        INTERNAL METHOD XLock() AS LOGIC
            IF !SELF:Shared
                RETURN TRUE
            ENDIF
            //DebOut32( System.Threading.Thread.CurrentThread:Name+__ENTITY__ )
            BEGIN LOCK SELF
                SELF:_exclusiveLocks += 1
                IF SELF:_exclusiveLocks == 1
                    IF _useFoxLock
                        SELF:_xLockFox()
                    ELSE
                        SELF:_xLockComix()
                    ENDIF
                    IF SELF:CheckForChangedBag()
                        FOREACH VAR oTag IN SELF:Tags
                            oTag:Stack:Clear()
                        NEXT
                    ENDIF
                ENDIF
            END LOCK
            RETURN TRUE

        INTERNAL METHOD UnLock() AS VOID
            IF !SELF:Shared
                RETURN
            ENDIF
            //DebOut32( System.Threading.Thread.CurrentThread:Name+__ENTITY__ )
            BEGIN LOCK SELF
                IF _useFoxLock
                    SELF:_UnLockFox()
                ELSE
                    SELF:_UnLockComix()
                ENDIF
            END LOCK
            RETURN
#endregion
    #region FoxPro compatible locking
        PRIVATE CONST FoxXLockOfs		:= 0x7ffffffe AS INT64
        PRIVATE CONST FoxXLockLen		:= 1          AS INT64
        PRIVATE CONST FoxSLockOfs		:= 0x7ffffffe AS INT64
        PRIVATE CONST FoxSLockLen		:= 1 AS DWORD

        PRIVATE METHOD _SLockFox() AS VOID
            SELF:_LockRetry(FoxSLockOfs, FoxSLockLen,"S")
            RETURN

        PRIVATE METHOD _xLockFox() AS VOID
            SELF:_LockRetry(FoxXLockOfs, FoxXLockLen,"X")
            RETURN

        PRIVATE METHOD _UnLockFox() AS VOID
            IF SELF:_sharedLocks > 0
                SELF:_sharedLocks -= 1
                IF SELF:_sharedLocks == 0
                    SELF:_Unlock(FoxSLockOfs, FoxSLockLen)
                ENDIF
            ELSEIF SELF:_exclusiveLocks > 0
                SELF:_exclusiveLocks -= 1
                IF SELF:_exclusiveLocks == 0
                    SELF:_UpdateRootVersion()
                    SELF:_Unlock(FoxXLockOfs, FoxXLockLen)
                ENDIF
            ENDIF
            RETURN

    #endregion
    #region Comix Compatible locking
        PRIVATE _sLockGate      := 0 AS LONG        // For CmxLock
        PRIVATE _sLockOffSet    := 0 AS DWORD       // For CmxLock
        PRIVATE _xLockedInOne   := FALSE AS LOGIC
        INTERNAL _LockOffSet    := 0 AS LONG
        PRIVATE CONST SLockGateCount    := 10 AS LONG
        PRIVATE CONST ComixXLockOfs		:= 0xfffeffff AS INT64
        PRIVATE CONST ComixSLockOfs		:= 0xffff0000 AS INT64
        PRIVATE CONST ComixXLockLen		:= 0x00010000 AS INT64
        STATIC PRIVATE randVal := 0 AS DWORD
        STATIC PRIVATE randInc, randDec AS LONG

        PRIVATE METHOD randNum () AS DWORD
            randInc -= randDec
            IF randInc <= 0
                randInc := DateTime.Now:Millisecond
                randDec := (randInc >> 8) + (randInc & 0xFF) + 1
            ENDIF
            randVal += (DWORD) randInc
            RETURN randVal

        PRIVATE METHOD _SLockComix() AS VOID
            //Debout32("_SlockComix() ")
            IF ++_sLockGate >= SLockGateCount
                _sLockGate := 0
                SELF:_LockRetry(ComixXLockOfs, 1,"S")
                SELF:_Unlock(ComixXLockOfs, 1)
            ENDIF
            SELF:_sLockOffSet := SELF:randNum()
            SELF:_LockRetry( _OR(ComixSLockOfs, _sLockOffSet),1,"S")

        PRIVATE METHOD _xLockComix() AS VOID
            //Debout32("_xLockComix() ")
            SELF:_sLockGate := 0
            Debug.Assert(_sharedLocks == 0)
            IF ! SELF:_stream:SafeLock(ComixXLockOfs, ComixXLockLen+1)
                SELF:_xLockedInOne := FALSE
                SELF:_LockRetry(ComixXLockOfs, 1,"X")
                SELF:_LockRetry(ComixSLockOfs, ComixXLockLen,"X")
            ELSE
                SELF:_xLockedInOne := TRUE
            ENDIF

        PRIVATE METHOD _UnLockComix() AS VOID

            IF SELF:_sharedLocks > 0
                SELF:_sharedLocks -= 1
                IF SELF:_sharedLocks == 0
                    SELF:_Unlock(ComixSLockOfs| SELF:_sLockOffSet, 1)
                ENDIF
            ELSEIF SELF:_exclusiveLocks > 0
                SELF:_exclusiveLocks -= 1
                IF SELF:_exclusiveLocks == 0
                    SELF:_UpdateRootVersion()
                    IF SELF:_xLockedInOne
                        SELF:_Unlock(ComixXLockOfs, ComixXLockLen+1)
                    ELSE
                        SELF:_Unlock(ComixXLockOfs, 1)
                        SELF:_Unlock(ComixSLockOfs, ComixXLockLen)
                    ENDIF
                ENDIF
            ENDIF
            RETURN

        PRIVATE METHOD _UpdateRootVersion() AS VOID
            var version := SELF:_root:RootVersion +1
            SELF:_root:RootVersion := version
            // Update the pagelist first. otherwise writing the _root will fail.
#ifdef DEBUG
            SELF:_PageList:SetVersion(version)
#endif
            SELF:_root:Write()
            SELF:_stream:Flush(TRUE)

    #endregion

    END CLASS
END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Globalization
USING System.Collections.Generic
USING XSharp.RDD.Enums
USING XSharp.RDD.Support
USING System.Text
USING System.IO
USING System.Linq
USING System.Diagnostics

BEGIN NAMESPACE XSharp.RDD.CDX
    /// <summary>
    /// Orderbag = CDX file. Contains one or more orders = Tags
    /// </summary>
    INTERNAL SEALED CLASS CdxOrderBag INHERIT BaseIndex
#region constants
    INTERNAL CONST CDX_EXTENSION := ".CDX" AS STRING

#endregion
        INTERNAL _hFile     AS IntPtr
        INTERNAL _stream    AS FileStream
        INTERNAL _OpenInfo	AS DbOpenInfo
        INTERNAL _Encoding  AS Encoding
        INTERNAL _PageList  AS CdxPageList
        INTERNAL PROPERTY Shared    AS LOGIC GET _OpenInfo:Shared
        INTERNAL PROPERTY ReadOnly  AS LOGIC GET _OpenInfo:ReadOnly
        INTERNAL _oRdd              AS DBFCDX
        INTERNAL _root              AS CdxFileHeader
        INTERNAL _tagList           AS CdxTagList
        INTERNAL CONST CDXPAGE_SIZE := 512 AS WORD

        //INTERNAL PROPERTY FileName AS STRING AUTO
        INTERNAL PROPERTY FullPath AS STRING AUTO
        INTERNAL PROPERTY Name AS STRING GET Path.GetFileNameWithoutExtension(FullPath)
        INTERNAL PROPERTY Handle AS IntPtr GET _hFile
        INTERNAL PROPERTY Stream AS FileStream GET _stream
        INTERNAL PROPERTY Tags AS IList<CdxTag> GET IIF(_tagList == NULL, NULL, _tagList:Tags)
        INTERNAL PROPERTY TagList AS CdxTagList GET _tagList
        INTERNAL PROPERTY Structural AS LOGIC AUTO
        INTERNAL PROPERTY Root      AS CdxFileHeader GET _root
        INTERNAL PROPERTY Encoding AS System.Text.Encoding GET _oRdd:_Encoding
        INTERNAL CONSTRUCTOR(oRDD AS DBFCDX )
            SUPER( oRDD )
            SELF:_oRdd     := oRDD
            SELF:_PageList := CdxPageList{SELF}
            SELF:_OpenInfo := oRDD:_OpenInfo
            SELF:_useFoxLock := XSharp.RuntimeState.GetValue<LOGIC>(Set.FoxLock)

        #region RDD Overloads
            /// <inheritdoc />
        OVERRIDE METHOD OrderCondition(info AS DbOrderCondInfo) AS LOGIC
            THROW NotImplementedException{}

        INTERNAL STATIC METHOD GetIndexExtFromDbfExt(cDbfName AS STRING) AS STRING
            SWITCH System.IO.Path.GetExtension(cDbfName:ToLower())
            CASE ".vcx"         // Control Library
            CASE ".scx"         // Screen
            CASE ".pjx"         // Project
            CASE ".mnx"         // Menu
            CASE ".frx"         // Report
                RETURN ""
            CASE ".dbc"         // database container
                RETURN ".dcx"
            END SWITCH
            RETURN CDX_EXTENSION
            /// <inheritdoc />
        OVERRIDE METHOD OrderCreate(info AS DbOrderCreateInfo) AS LOGIC
            LOCAL cTag AS STRING
            IF info:Order IS STRING VAR strOrder .and. ! String.IsNullOrWhiteSpace(strOrder)
                cTag := strOrder
            ELSE
                cTag := Path.GetFileNameWithoutExtension(info:BagName)
                IF cTag:Length > 10
                    cTag := cTag:Substring(0, 10)
                ENDIF
                info:Order := cTag
            ENDIF
            IF String.IsNullOrEmpty(cTag)
                // Exception ?
                RETURN FALSE
            ENDIF
            VAR oTag := SELF:_FindTagByName(cTag)
            VAR lOk := TRUE
            IF oTag != NULL_OBJECT
                VAR last := SELF:_tagList:Tags:Count == 1
                SELF:Destroy(oTag)
                IF last
                    SELF:CreateBag(SELF:FullPath)
                    SELF:_oRdd:_indexList:_AddBag(SELF)
                ENDIF
            ENDIF
            oTag := CdxTag{SELF}
            lOk := oTag:Create(info)
            IF lOk
                // Read the tag from disk to get all the normal stuff
                oTag  := CdxTag{SELF,oTag:Header:PageNo, oTag:OrderName}
                SELF:AddTag(oTag)
            ENDIF
            RETURN lOk

        METHOD AddTag(oTag AS CdxTag) AS LOGIC
            _tagList:Add(oTag)
            RETURN TRUE

        METHOD Destroy(oParam AS CdxTag) AS LOGIC
            LOCAL found := FALSE AS LOGIC
            VAR aTags   := SELF:Tags:ToArray()
            FOREACH tag AS CdxTag IN aTags
                IF String.Compare(tag:OrderName, oParam:OrderName, StringComparison.OrdinalIgnoreCase) == 0
                    oParam := tag
                    found := TRUE
                    EXIT
                ENDIF
            NEXT
            IF found
                // rewrite the taglist
                SELF:_tagList:Remove(oParam)
                // We do not Delete the pages from the tag. Comix also does not do that
                IF SELF:_tagList:Tags:Count == 0
                    LOCAL cFileName := SELF:FullPath AS STRING
                    SELF:_oRdd:_indexList:_CloseBag(SELF)
                    FErase(cFileName)
                ENDIF
            ENDIF
            RETURN found

            /// <inheritdoc />
        OVERRIDE METHOD OrderDestroy(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderInfo(nOrdinal AS DWORD, info AS DbOrderInfo) AS OBJECT
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderListAdd(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderListDelete(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE METHOD OrderListFocus(info AS DbOrderInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />

        OVERRIDE METHOD OrderListRebuild( ) AS LOGIC
            LOCAL aTags AS CdxTag[]
            LOCAL cBagName AS STRING
            LOCAL lOk AS LOGIC
            aTags := SELF:_tagList:Tags:ToArray()
            cBagName := SELF:FullPath
            lOk := TRUE
            lOk := SELF:Close()
            IF lOk
                FErase(cBagName)
                lOk := SELF:CreateBag(cBagName)
            ENDIF
            IF lOk
                FOREACH oTag AS CdxTag IN aTags
                    lOk := oTag:Rebuild()
                    IF ! lOk
                        EXIT
                    ENDIF
                    SELF:AddTag(oTag)
                NEXT
            ENDIF
            SELF:GoCold()
            RETURN lOk

            /// <inheritdoc />
        OVERRIDE METHOD Seek(info AS DbSeekInfo) AS LOGIC
            THROW NotImplementedException{}
            /// <inheritdoc />
        OVERRIDE PROPERTY Found AS LOGIC
            GET
                THROW NotImplementedException{}
            END GET
        END PROPERTY
        #endregion

        #region Open and Close etc
        METHOD CreateBag(cBagName AS STRING) AS LOGIC
            LOCAL cPath     AS STRING
            LOCAL cFullName AS STRING
            LOCAL cDbf      AS STRING
            cFullName := cBagName
            cDbf      := SELF:_oRdd:FileName
            VAR cExt  := GetIndexExtFromDbfExt(cDbf)
            IF String.IsNullOrEmpty(cFullName)
                cFullName := Path.ChangeExtension(cDbf, cExt)
            ELSEIF String.IsNullOrEmpty(Path.GetExtension(cFullName))
                cFullName := Path.ChangeExtension(cFullName, cExt)
            ELSEIF String.Compare(cDbf, cFullName, StringComparison.OrdinalIgnoreCase) == 0
                 cFullName := Path.ChangeExtension(cFullName, cExt)
            ENDIF
            cPath := Path.GetDirectoryName(cFullName)
            IF String.IsNullOrEmpty(cPath)
                cPath := Path.GetDirectoryName(cDbf)
                cFullName := Path.Combine(cPath, cFullName)
            ENDIF
            IF File(cFullName)
                LOCAL openInfo AS DbOrderInfo
                openInfo := DbOrderInfo{}
                openInfo:BagName := FPathName()
                SELF:Open(openInfo)
                RETURN TRUE
            ENDIF
            SELF:_hFile    := FCreate(cFullName)
            SELF:_stream   := FGetStream(SELF:_hFile)
            IF File(cFullName)
                // Make sure the full name is returned and not the DOS Short Name
                SELF:FullPath :=FPathName()
            ENDIF
            // Allocate Root Page
            _root   := CdxFileHeader{SELF}
            _root:Initialize()
            _PageList:Add(_root)
            SELF:Write(_root)
            // taglist page
            VAR buffer := SELF:AllocBuffer()
            _tagList := CdxTagList{SELF,  _root:RootPage, buffer, _root:KeySize}
            _tagList:InitBlank(NULL)
            SELF:Write(_tagList)
            RETURN TRUE

        METHOD _FindTagByName(cName AS STRING) AS CdxTag
            IF SELF:Tags != NULL
                FOREACH oTag AS CdxTag IN SELF:Tags
                    IF String.Compare(oTag:OrderName, cName,StringComparison.OrdinalIgnoreCase) == 0
                        RETURN oTag
                    ENDIF
                NEXT
            ENDIF
            RETURN NULL

        METHOD Close() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH tag AS CdxTag IN Tags
                IF ! tag:Close()
                    lOk := FALSE
                ENDIF
            NEXT
            IF ! SELF:_PageList:Flush(FALSE)
                lOk := FALSE
            ENDIF
            IF ! FClose(SELF:_hFile)
                lOk := FALSE
            ENDIF
            SELF:_stream := NULL
            SELF:_hFile  := F_ERROR
            RETURN lOk

        INTERNAL METHOD Open(info AS DbOrderInfo) AS LOGIC
            // Filename may have path or not
            // When the filename does not have a path then we look in the path of the DBF
            LOCAL cPath     AS STRING
            LOCAL cFileName AS STRING
            LOCAL cFullName AS STRING
            IF info == NULL
                RETURN FALSE
            ENDIF
            cFullName := cFileName := info:BagName
            IF String.IsNullOrEmpty(Path.GetExtension(cFullName))
                VAR cExt  := GetIndexExtFromDbfExt(cFullName)
                cFullName := Path.ChangeExtension(cFullName, cExt)
            ENDIF
            cPath := Path.GetDirectoryName(cFullName)
            IF String.IsNullOrEmpty(cPath)
                cPath := SELF:_oRdd:FileName
                cPath := Path.GetDirectoryName(cPath)
                cFullName := Path.Combine(cPath, cFileName)
            ENDIF
            IF !File(cFullName)
                RETURN FALSE
            ENDIF
            // Adjust Filename to handle 8 char DOS names
            cFullName := FPathName()
            SELF:FullPath := cFullName
            SELF:_OpenInfo := _oRdd:_OpenInfo
            SELF:_hFile    := FOpen(cFullName, _OpenInfo:FileMode)
            SELF:_stream   := FGetStream(SELF:_hFile)
            SELF:_Encoding := _oRdd:_Encoding
            IF SELF:_hFile == F_ERROR
                RETURN FALSE
            ENDIF
            _root := CdxFileHeader{SELF}
            _root:Read()
            SELF:SetPage(_root)
            VAR nTagList := SELF:_root:RootPage
            VAR page     := SELF:GetPage(nTagList, _root:KeySize, NULL)
            _tagList := CdxTagList{SELF,  page, _root:KeySize}
            SELF:SetPage(_tagList)
            _tagList:ReadTags()
            // No need to Compile expressions again. Is done in ReadTags already
            // If we do want to do it again, then remember to save the LastRddError !
            // FOREACH VAR tag IN Tags
            //    tag:EvaluateExpressions()
            // NEXT
            RETURN TRUE
        #endregion

         METHOD MatchesFileName(cFileName AS STRING) AS LOGIC
            VAR cExt := Path.GetExtension(cFileName)
            IF String.IsNullOrEmpty(cExt)
                cFileName := Path.ChangeExtension(cFileName, CDX_EXTENSION)
            ENDIF
            IF String.Compare(SELF:FullPath, cFileName, StringComparison.OrdinalIgnoreCase) == 0
                RETURN TRUE
            ENDIF
            VAR cPath := Path.GetDirectoryName(cFileName)
            IF String.IsNullOrEmpty(cPath)
                IF String.Compare(Path.GetFileName(FullPath), cFileName, StringComparison.OrdinalIgnoreCase) == 0
                    RETURN TRUE
                ENDIF
            ENDIF
            RETURN FALSE

         OVERRIDE METHOD Flush() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH tag AS CdxTag IN SELF:Tags
                IF ! tag:Flush()
                    lOk := FALSE
                ENDIF
            NEXT
            lOk := SELF:FlushPages() .and. lOk
            RETURN lOk

         INTERNAL METHOD FlushPages() AS LOGIC
            RETURN SELF:_PageList:Flush(FALSE)

         INTERNAL METHOD SavePages() AS LOGIC
            RETURN SELF:_PageList:Flush(TRUE)

         METHOD GoCold() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH tag AS CdxTag IN SELF:Tags
                IF ! tag:GoCold()
                    lOk := FALSE
                ENDIF
            NEXT
            RETURN lOk

        METHOD GoHot() AS LOGIC
            LOCAL lOk AS LOGIC
            // Process all tags even if one fails
            lOk := TRUE
            FOREACH VAR tag IN SELF:Tags
                IF ! tag:GoHot()
                    lOk := FALSE
                ENDIF
            NEXT
            RETURN lOk

        METHOD FindFreePage() AS LONG
            LOCAL nPage AS LONG
            LOCAL nNext AS LONG
            IF SELF:_root:FreeList > 0
                nPage := SELF:_root:FreeList
                VAR oPage := SELF:_PageList:GetPage(nPage, 0, NULL)
                IF oPage IS CdxTreePage VAR tPage
                    nNext := tPage:LeftPtr
                    IF nNext < 0
                        nNext := 0
                    ENDIF
                    SELF:_root:FreeList := nNext
                    SELF:_root:Write()
                ENDIF
                SELF:_PageList:Delete(nPage)
            ELSE
                IF _stream:Length >= Int32.MaxValue
                    var cMessage := "Maximum file size of 2 Gb for CDX file exceeded"
                    DebOut32(cMessage)
                    throw IOException{cMessage}
                ENDIF
                nPage   := (LONG) _stream:Length
            ENDIF
            RETURN nPage

         METHOD AddFreePage(oPage AS CdxTreePage) AS LOGIC
            VAR nPage := oPage:PageNo
            oPage:Clear()
            oPage:LeftPtr   := SELF:_root:FreeList
            oPage:RightPtr  := 0
            oPage:Write()
            SELF:_root:FreeList := nPage
            SELF:_root:Write()
            SELF:_PageList:Delete(nPage)
            RETURN TRUE

        METHOD AllocBuffer(nSize := 1 AS LONG)  AS BYTE[]
            RETURN BYTE[]{CDXPAGE_SIZE *nSize}

        METHOD Read(nPage AS LONG, buffer AS BYTE[]) AS LOGIC
            RETURN SELF:_stream:SafeReadAt(nPage, buffer)

        METHOD Read(oPage AS CdxPage) AS LOGIC
            IF SELF:_root != NULL
                oPage:Generation := SELF:_root:RootVersion
            ENDIF
            RETURN SELF:_stream:SafeReadAt(oPage:PageNo, oPage:Buffer, oPage:Buffer:Length)

        METHOD Write(oPage AS CdxPage) AS LOGIC
            LOCAL isOk AS LOGIC
            SELF:_PageList:CheckVersion(SELF:Root:RootVersion)
            IF oPage:PageNo == -1
                oPage:PageNo := SELF:FindFreePage()
                oPage:IsHot  := TRUE
                SELF:_PageList:SetPage(oPage:PageNo, oPage)
            ENDIF
            if oPage:PageNo < 0
                var cMessage := i"Trying to write to negative pageno {oPage:PageNo} in CDX"
                DebOut32(cMessage)
                THROW IOException{cMessage}
            ENDIF
            IF oPage:IsHot
                isOk := SELF:_stream:SafeWriteAt(oPage:PageNo, oPage:Buffer)
                IF isOk .and. SELF:Shared
                    SELF:_stream:Flush(TRUE)
                ENDIF
            ELSE
                isOk := TRUE
            ENDIF
            RETURN isOk

        METHOD GetPage(nPage AS Int32, nKeyLen AS WORD,tag AS CdxTag) AS CdxPage
           IF nPage == -1
                RETURN NULL
           ENDIF
           VAR page := SELF:_PageList:GetPage(nPage, nKeyLen,tag)
           IF page != NULL
                SELF:SetPage( page)
           ENDIF
           RETURN page

         METHOD SetPage(page AS CdxPage) AS VOID
            SELF:_PageList:SetPage(page:PageNo, page)
#ifdef DEBUG
            page:Generation := SELF:Root:RootVersion
#endif

        #region properties

        PROPERTY Count AS LONG GET SELF:Tags:Count
        PROPERTY BagHasChanged AS LOGIC
            GET
                LOCAL nVersion AS DWORD
                nVersion := _root:RootVersion
                SELF:Read(SELF:_root)
                RETURN nVersion != _root:RootVersion

            END GET
        END PROPERTY

        INTERNAL METHOD CheckForChangedBag() AS LOGIC
            LOCAL lChanged := FALSE AS LOGIC
            IF SELF:BagHasChanged
                lChanged := TRUE
                SELF:_PageList:Clear()
                // Add new versions of Root and Taglist to the cache
                SELF:Root:Read()
                SELF:_tagList:Read()
                SELF:_PageList:Add(SELF:Root)
                SELF:_PageList:Add(SELF:_tagList)
            ENDIF
            RETURN lChanged

        PROPERTY IsHot AS LOGIC
        GET
            // return true as soon as one tag is hot
            FOREACH oTag AS CdxTag IN SELF:Tags
                IF oTag:IsHot
                    RETURN TRUE
                ENDIF
            NEXT
            RETURN FALSE
        END GET
        END PROPERTY
        #endregion

#region Common Locking code
        PRIVATE _useFoxLock     := FALSE AS LOGIC
        PRIVATE _sharedLocks    := 0 AS LONG
        PRIVATE _exclusiveLocks := 0 AS LONG
        STATIC PRIVATE rand := Random{100} AS System.Random

        PRIVATE METHOD _LockRetry(nOffSet AS INT64, nLen AS INT64,sPrefix AS STRING) AS VOID
            LOCAL result := FALSE AS LOGIC
            // note that there is no wait here. Research showed that the VO/Vulcan drivers
            // also did not wait
            REPEAT
                result := SELF:_stream:SafeLock(nOffSet, nLen)
            UNTIL result
            //DebOut32( "Locked " +nOffSet:ToString()+" "+nLen:ToString())

        PRIVATE METHOD _Unlock(nOffSet AS INT64, nLen AS INT64) AS LOGIC
            VAR res := SELF:_stream:SafeUnlock(nOffSet, nLen)
            //IF res
            //    NOP // DebOut32( "UnLocked " +nOffSet:ToString()+" "+nLen:ToString())
            //ELSE
            //    //DebOut32( "UnLock FAILED " +nOffSet:ToString()+" "+nLen:ToString())
            //ENDIF
            RETURN res

        INTERNAL METHOD SLock() AS LOGIC
            IF !SELF:Shared
                RETURN TRUE
            ENDIF
            //DebOut32( System.Threading.Thread.CurrentThread:Name+__ENTITY__ )
            BEGIN LOCK SELF
                SELF:_sharedLocks += 1
                IF SELF:_exclusiveLocks == 0  .AND. SELF:_sharedLocks == 1
                    IF SELF:_useFoxLock
                        SELF:_SLockFox()
                    ELSE
                        SELF:_SLockComix()
                    ENDIF
                    SELF:CheckForChangedBag()
                ENDIF
            END LOCK
            RETURN TRUE

        INTERNAL METHOD XLock() AS LOGIC
            IF !SELF:Shared
                RETURN TRUE
            ENDIF
            //DebOut32( System.Threading.Thread.CurrentThread:Name+__ENTITY__ )
            BEGIN LOCK SELF
                SELF:_exclusiveLocks += 1
                IF SELF:_exclusiveLocks == 1
                    IF _useFoxLock
                        SELF:_xLockFox()
                    ELSE
                        SELF:_xLockComix()
                    ENDIF
                    IF SELF:CheckForChangedBag()
                        FOREACH VAR oTag IN SELF:Tags
                            oTag:Stack:Clear()
                        NEXT
                    ENDIF
                ENDIF
            END LOCK
            RETURN TRUE

        INTERNAL METHOD UnLock() AS VOID
            IF !SELF:Shared
                RETURN
            ENDIF
            //DebOut32( System.Threading.Thread.CurrentThread:Name+__ENTITY__ )
            BEGIN LOCK SELF
                IF _useFoxLock
                    SELF:_UnLockFox()
                ELSE
                    SELF:_UnLockComix()
                ENDIF
            END LOCK
            RETURN
#endregion
    #region FoxPro compatible locking
        PRIVATE CONST FoxXLockOfs		:= 0x7ffffffe AS INT64
        PRIVATE CONST FoxXLockLen		:= 1          AS INT64
        PRIVATE CONST FoxSLockOfs		:= 0x7ffffffe AS INT64
        PRIVATE CONST FoxSLockLen		:= 1 AS DWORD

        PRIVATE METHOD _SLockFox() AS VOID
            SELF:_LockRetry(FoxSLockOfs, FoxSLockLen,"S")
            RETURN

        PRIVATE METHOD _xLockFox() AS VOID
            SELF:_LockRetry(FoxXLockOfs, FoxXLockLen,"X")
            RETURN

        PRIVATE METHOD _UnLockFox() AS VOID
            IF SELF:_sharedLocks > 0
                SELF:_sharedLocks -= 1
                IF SELF:_sharedLocks == 0
                    SELF:_Unlock(FoxSLockOfs, FoxSLockLen)
                ENDIF
            ELSEIF SELF:_exclusiveLocks > 0
                SELF:_exclusiveLocks -= 1
                IF SELF:_exclusiveLocks == 0
                    SELF:_UpdateRootVersion()
                    SELF:_Unlock(FoxXLockOfs, FoxXLockLen)
                ENDIF
            ENDIF
            RETURN

    #endregion
    #region Comix Compatible locking
        PRIVATE _sLockGate      := 0 AS LONG        // For CmxLock
        PRIVATE _sLockOffSet    := 0 AS DWORD       // For CmxLock
        PRIVATE _xLockedInOne   := FALSE AS LOGIC
        INTERNAL _LockOffSet    := 0 AS LONG
        PRIVATE CONST SLockGateCount    := 10 AS LONG
        PRIVATE CONST ComixXLockOfs		:= 0xfffeffff AS INT64
        PRIVATE CONST ComixSLockOfs		:= 0xffff0000 AS INT64
        PRIVATE CONST ComixXLockLen		:= 0x00010000 AS INT64
        STATIC PRIVATE randVal := 0 AS DWORD
        STATIC PRIVATE randInc, randDec AS LONG

        PRIVATE METHOD randNum () AS DWORD
            randInc -= randDec
            IF randInc <= 0
                randInc := DateTime.Now:Millisecond
                randDec := (randInc >> 8) + (randInc & 0xFF) + 1
            ENDIF
            randVal += (DWORD) randInc
            RETURN randVal

        PRIVATE METHOD _SLockComix() AS VOID
            //Debout32("_SlockComix() ")
            IF ++_sLockGate >= SLockGateCount
                _sLockGate := 0
                SELF:_LockRetry(ComixXLockOfs, 1,"S")
                SELF:_Unlock(ComixXLockOfs, 1)
            ENDIF
            SELF:_sLockOffSet := SELF:randNum()
            SELF:_LockRetry( _OR(ComixSLockOfs, _sLockOffSet),1,"S")

        PRIVATE METHOD _xLockComix() AS VOID
            //Debout32("_xLockComix() ")
            SELF:_sLockGate := 0
            Debug.Assert(_sharedLocks == 0)
            IF ! SELF:_stream:SafeLock(ComixXLockOfs, ComixXLockLen+1)
                SELF:_xLockedInOne := FALSE
                SELF:_LockRetry(ComixXLockOfs, 1,"X")
                SELF:_LockRetry(ComixSLockOfs, ComixXLockLen,"X")
            ELSE
                SELF:_xLockedInOne := TRUE
            ENDIF

        PRIVATE METHOD _UnLockComix() AS VOID

            IF SELF:_sharedLocks > 0
                SELF:_sharedLocks -= 1
                IF SELF:_sharedLocks == 0
                    SELF:_Unlock(ComixSLockOfs| SELF:_sLockOffSet, 1)
                ENDIF
            ELSEIF SELF:_exclusiveLocks > 0
                SELF:_exclusiveLocks -= 1
                IF SELF:_exclusiveLocks == 0
                    SELF:_UpdateRootVersion()
                    IF SELF:_xLockedInOne
                        SELF:_Unlock(ComixXLockOfs, ComixXLockLen+1)
                    ELSE
                        SELF:_Unlock(ComixXLockOfs, 1)
                        SELF:_Unlock(ComixSLockOfs, ComixXLockLen)
                    ENDIF
                ENDIF
            ENDIF
            RETURN

        PRIVATE METHOD _UpdateRootVersion() AS VOID
            var version := SELF:_root:RootVersion +1
            SELF:_root:RootVersion := version
            // Update the pagelist first. otherwise writing the _root will fail.
#ifdef DEBUG
            SELF:_PageList:SetVersion(version)
#endif
            SELF:_root:Write()

    #endregion

    END CLASS
END NAMESPACE


codegen/QtGui/QGraphicsSceneHelpEvent.prg: updated

Modified:
codegen/QtGui/QGraphicsSceneHelpEvent.prg

%%
%% Qt4xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 4
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QPOINTF
REQUEST QPOINT
#endif

$beginClassFrom=QGraphicsSceneEvent

   METHOD delete
   METHOD scenePos
   METHOD screenPos

$endClass

$destructor

#pragma BEGINDUMP

$includes

$deleteMethod

$prototype=QPointF scenePos () const
$method=|QPointF|scenePos|

$prototype=QPoint screenPos () const
$method=|QPoint|screenPos|

#pragma ENDDUMP

%%
%% Qt4xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 4
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QPOINTF
REQUEST QPOINT
#endif

$beginClassFrom=QGraphicsSceneEvent

   METHOD delete
   METHOD scenePos
   METHOD screenPos

$endClass

$destructor

#pragma BEGINDUMP

$includes

$deleteMethod

$prototype=QPointF scenePos () const
HB_FUNC_STATIC( QGRAPHICSSCENEHELPEVENT_SCENEPOS )
{
  QGraphicsSceneHelpEvent * obj = (QGraphicsSceneHelpEvent *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QPointF * ptr = new QPointF( obj->scenePos () );
    _qt4xhb_createReturnClass ( ptr, "QPOINTF", true );
  }
}

$prototype=QPoint screenPos () const
HB_FUNC_STATIC( QGRAPHICSSCENEHELPEVENT_SCREENPOS )
{
  QGraphicsSceneHelpEvent * obj = (QGraphicsSceneHelpEvent *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QPoint * ptr = new QPoint( obj->screenPos () );
    _qt4xhb_createReturnClass ( ptr, "QPOINT", true );
  }
}

#pragma ENDDUMP


these sigs are not necessary

these sigs are not necessary

import "../src/LangPrelude.prg"

data TwoBits = OO | OI | IO | II

data Mark = FullStop | Stop TwoBits | Digit TwoBits

data Way = Arrived | Step Mark Way deriving List(w)

etalon = "qrs101qrs30qrs13qrs3rsS"
-- acc:   55555544455444443332221

w1 = [FullStop]w
w2 = [Stop OI, FullStop]w
w3 = [Stop IO, Stop OI, FullStop]w
w4 = [Digit II, Stop IO, Stop OI, FullStop]w
w5 = [Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w6 = [Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w7 = [Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w9 = [Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w12 = [Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w13 = [Digit OO, Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w14 = [Digit II, Digit OO, Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w15 = [Stop OI, Digit II, Digit OO, Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w

countSteps (way@[_;_]w) = howmanysteps 0 way
  where howmanysteps 0 []w = 0
        howmanysteps corr [FullStop]w = corr + 1
        howmanysteps corr [Stop OI; way]w = pickupMarks (corr + 1) way 0
        howmanysteps corr [Stop IO, Stop OI; way]w = pickupMarks (corr + 2) way 0
        howmanysteps corr [Stop II, Stop IO, Stop OI; way]w = pickupMarks (corr + 3) way 0
        howmanysteps corr [Digit _,_,_; more]w = howmanysteps (corr + 3) more
        pickupMarks corr [FullStop]w acc = corr + 1
        pickupMarks corr [Stop _; _]w acc = corr + acc
        pickupMarks corr [Digit OO; more]w acc = pickupMarks (corr + 1) more $ 4 * acc
        pickupMarks corr [Digit OI; more]w acc = pickupMarks (corr + 1) more $ 4 * acc + 1
        pickupMarks corr [Digit IO; more]w acc = pickupMarks (corr + 1) more $ 4 * acc + 2
        pickupMarks corr [Digit II; more]w acc = pickupMarks (corr + 1) more $ 4 * acc + 3

l2w = foldr (Step . c2m) Arrived
  where c2m 'S' = FullStop
        c2m 's' = Stop OI
        c2m 'r' = Stop IO
        c2m 'q' = Stop II
        c2m '0' = Digit OO
        c2m '1' = Digit OI
        c2m '2' = Digit IO
        c2m '3' = Digit II

foldw :: (Mark -> b -> b) -> b -> Way -> b
foldw _ b []w = b
foldw f b [m; ms]w = f m $ foldw f b ms

w2l = foldw ((:) . m2c) []
  where m2c FullStop = 'S'
        m2c (Stop OI) = 's'
        m2c (Stop IO) = 'r'
        m2c (Stop II) = 'q'
        m2c (Digit OO) = '0'
        m2c (Digit OI) = '1'
        m2c (Digit IO) = '2'
        m2c (Digit II) = '3'

waylen = foldw (\_ n->n+1) 0

etalon' = l2w etalon

countAlongTheWay = foldw tupled [(0,[]w)]
  where tupled m (l@[(_,w);_]) = (countSteps [m;w]w,[m;w]w) : l

-- builds a way of length at least 'min'
-- maintains the invariant, that the way starts with 'Stop II'
--
construct :: Int -> Way -> Way
construct min (acc@[Stop II; _]w) = if len < min
                                    then construct min $ [Stop II, Stop IO, Stop OI; prepend len acc]w
                                    else acc
  where len = waylen acc
        prepend 0 acc = acc
        prepend n acc | n `mod` 4 == 0 = prepend (n `div` 4) [Digit OO; acc]w
        prepend n acc | n `mod` 4 == 1 = prepend (n `div` 4) [Digit OI; acc]w
        prepend n acc | n `mod` 4 == 2 = prepend (n `div` 4) [Digit IO; acc]w
        prepend n acc | n `mod` 4 == 3 = prepend (n `div` 4) [Digit II; acc]w

import "../src/LangPrelude.prg"

data TwoBits = OO | OI | IO | II

data Mark = FullStop | Stop TwoBits | Digit TwoBits

data Way = Arrived | Step Mark Way deriving List(w)

etalon = "qrs101qrs30qrs13qrs3rsS"
-- acc:   55555544455444443332221

w1 = [FullStop]w
w2 = [Stop OI, FullStop]w
w3 = [Stop IO, Stop OI, FullStop]w
w4 = [Digit II, Stop IO, Stop OI, FullStop]w
w5 = [Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w6 = [Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w7 = [Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w9 = [Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w12 = [Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w13 = [Digit OO, Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w14 = [Digit II, Digit OO, Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w
w15 = [Stop OI, Digit II, Digit OO, Stop II, Stop IO, Stop OI, Digit OI, Digit II, Stop II, Stop IO, Stop OI, Digit II, Stop IO, Stop OI, FullStop]w

countSteps (way@[_;_]w) = howmanysteps 0 way
  where howmanysteps :: Int -> Way -> Int
        howmanysteps 0 []w = 0
        howmanysteps corr [FullStop]w = corr + 1
        howmanysteps corr [Stop OI; way]w = pickupMarks (corr + 1) way 0
        howmanysteps corr [Stop IO, Stop OI; way]w = pickupMarks (corr + 2) way 0
        howmanysteps corr [Stop II, Stop IO, Stop OI; way]w = pickupMarks (corr + 3) way 0
        howmanysteps corr [Digit _,_,_; more]w = howmanysteps (corr + 3) more
        pickupMarks corr [FullStop]w acc = corr + 1
        pickupMarks corr [Stop _; _]w acc = corr + acc
        pickupMarks corr [Digit OO; more]w acc = pickupMarks (corr + 1) more $ 4 * acc
        pickupMarks corr [Digit OI; more]w acc = pickupMarks (corr + 1) more $ 4 * acc + 1
        pickupMarks corr [Digit IO; more]w acc = pickupMarks (corr + 1) more $ 4 * acc + 2
        pickupMarks corr [Digit II; more]w acc = pickupMarks (corr + 1) more $ 4 * acc + 3

l2w = foldr (Step . c2m) Arrived
  where c2m 'S' = FullStop
        c2m 's' = Stop OI
        c2m 'r' = Stop IO
        c2m 'q' = Stop II
        c2m '0' = Digit OO
        c2m '1' = Digit OI
        c2m '2' = Digit IO
        c2m '3' = Digit II

foldw :: (Mark -> b -> b) -> b -> Way -> b
foldw _ b []w = b
foldw f b [m; ms]w = f m $ foldw f b ms

w2l = foldw ((:) . m2c) []
  where m2c FullStop = 'S'
        m2c (Stop OI) = 's'
        m2c (Stop IO) = 'r'
        m2c (Stop II) = 'q'
        m2c (Digit OO) = '0'
        m2c (Digit OI) = '1'
        m2c (Digit IO) = '2'
        m2c (Digit II) = '3'

waylen = foldw (\_ n->n+1) 0

etalon' = l2w etalon

countAlongTheWay = foldw tupled [(0,[]w)]
  where tupled m (l@[(_,w);_]) = (countSteps [m;w]w,[m;w]w) : l

-- builds a way of length at least 'min'
-- maintains the invariant, that the way starts with 'Stop II'
--
construct :: Int -> Way -> Way
construct min (acc@[Stop II; _]w) = if len < min
                                    then construct min $ [Stop II, Stop IO, Stop OI; prepend len acc]w
                                    else acc
  where len = waylen acc
        prepend :: Int -> Way -> Way
        prepend 0 acc = acc
        prepend n acc | n `mod` 4 == 0 = prepend (n `div` 4) [Digit OO; acc]w
        prepend n acc | n `mod` 4 == 1 = prepend (n `div` 4) [Digit OI; acc]w
        prepend n acc | n `mod` 4 == 2 = prepend (n `div` 4) [Digit IO; acc]w
        prepend n acc | n `mod` 4 == 3 = prepend (n `div` 4) [Digit II; acc]w


QtScriptTools: data for code generation updated

Modified:
codegen/QtScriptTools/QScriptEngineDebugger.prg

$header

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QACTION
REQUEST QMENU
REQUEST QTOOLBAR
REQUEST QMAINWINDOW
REQUEST QWIDGET
#endif

CLASS QScriptEngineDebugger INHERIT QObject

   METHOD new
   METHOD delete
   METHOD action
   METHOD attachTo
   METHOD autoShowStandardWindow
   METHOD createStandardMenu
   METHOD createStandardToolBar
   METHOD detach
   METHOD setAutoShowStandardWindow
   METHOD standardWindow
   METHOD state
   METHOD widget

   METHOD onEvaluationResumed
   METHOD onEvaluationSuspended

   DESTRUCTOR destroyObject

END CLASS

$destructor

#pragma BEGINDUMP

#include <QScriptEngineDebugger>

#include "qt4xhb_common.h"
#include "qt4xhb_macros.h"
#include "qt4xhb_utils.h"

$prototype=QScriptEngineDebugger ( QObject * parent = 0 )
$constructor=|new|QObject *=0

$deleteMethod

$prototype=QAction * action ( DebuggerAction action ) const
$method=|QAction *|action|QScriptEngineDebugger::DebuggerAction

$prototype=void attachTo ( QScriptEngine * engine )
$method=|void|attachTo|QScriptEngine *

$prototype=bool autoShowStandardWindow () const
$method=|bool|autoShowStandardWindow|

$prototype=QMenu * createStandardMenu ( QWidget * parent = 0 )
$method=|QMenu *|createStandardMenu|QWidget *=0

$prototype=QToolBar * createStandardToolBar ( QWidget * parent = 0 )
$method=|QToolBar *|createStandardToolBar|QWidget *=0

$prototype=void detach ()
$method=|void|detach|

$prototype=void setAutoShowStandardWindow ( bool autoShow )
$method=|void|setAutoShowStandardWindow|bool

$prototype=QMainWindow * standardWindow () const
$method=|QMainWindow *|standardWindow|

$prototype=DebuggerState state () const
$method=|QScriptEngineDebugger::DebuggerState|state|

$prototype=QWidget * widget ( DebuggerWidget widget ) const
$method=|QWidget *|widget|QScriptEngineDebugger::DebuggerWidget

#pragma ENDDUMP

$header

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QACTION
REQUEST QMENU
REQUEST QTOOLBAR
REQUEST QMAINWINDOW
REQUEST QWIDGET
#endif

CLASS QScriptEngineDebugger INHERIT QObject

   METHOD new
   METHOD delete
   METHOD action
   METHOD attachTo
   METHOD autoShowStandardWindow
   METHOD createStandardMenu
   METHOD createStandardToolBar
   METHOD detach
   METHOD setAutoShowStandardWindow
   METHOD standardWindow
   METHOD state
   METHOD widget

   METHOD onEvaluationResumed
   METHOD onEvaluationSuspended

   DESTRUCTOR destroyObject

END CLASS

$destructor

#pragma BEGINDUMP

#include <QScriptEngineDebugger>

#include "qt4xhb_common.h"
#include "qt4xhb_macros.h"
#include "qt4xhb_utils.h"

$prototype=QScriptEngineDebugger ( QObject * parent = 0 )
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_NEW )
{
  QScriptEngineDebugger * o = new QScriptEngineDebugger ( OPQOBJECT(1,0) );
  _qt4xhb_storePointerAndFlag ( o, false );
}

$deleteMethod

$prototype=QAction * action ( DebuggerAction action ) const
$method=|QAction *|action|QScriptEngineDebugger::DebuggerAction

$prototype=void attachTo ( QScriptEngine * engine )
$method=|void|attachTo|QScriptEngine *

$prototype=bool autoShowStandardWindow () const
$method=|bool|autoShowStandardWindow|

$prototype=QMenu * createStandardMenu ( QWidget * parent = 0 )
$method=|QMenu *|createStandardMenu|QWidget *=0

$prototype=QToolBar * createStandardToolBar ( QWidget * parent = 0 )
$method=|QToolBar *|createStandardToolBar|QWidget *=0

$prototype=void detach ()
$method=|void|detach|

$prototype=void setAutoShowStandardWindow ( bool autoShow )
$method=|void|setAutoShowStandardWindow|bool

$prototype=QMainWindow * standardWindow () const
$method=|QMainWindow *|standardWindow|

$prototype=DebuggerState state () const
$method=|QScriptEngineDebugger::DebuggerState|state|

$prototype=QWidget * widget ( DebuggerWidget widget ) const
$method=|QWidget *|widget|QScriptEngineDebugger::DebuggerWidget

#pragma ENDDUMP