#include once "crt.bi"

Dim a As Integer = Any
Dim p As Integer Ptr = @a

Dim q As Integer Ptr = Any
memcpy(@q, @p, SizeOf(Integer Ptr))

Print Hex(p), Hex(q), p = q

ASM
    MOV rbx, q
END ASM

IIF((CINT(p) XOR CINT(q)) > 0 , 0, -1)

Print Hex(p), Hex(q), cint(p) = cint(q)

DIM a AS INTEGER
DIM b AS INTEGER
DIM s1 AS STRING, s2 AS STRING

DIM p AS INTEGER PTR = @a
DIM q AS INTEGER PTR = @b + 1

s1 = HEX(p): s2 = HEX(q)
PRINT " HEXes:"
PRINT " "; s1, s2
IF s1 = s2 THEN COLOR 10: PRINT " EQUAL": COLOR 7: ELSE COLOR 12: PRINT " NOT EQUAL!!!": COLOR 7
PRINT " Result 1     : "; CINT(p) = CINT(q)
PRINT " Result 2     : "; IIF((CINT(p) XOR CINT(q)) > 0 , 0, -1)

SLEEP

#include once "windows.bi"

Private Function FindFreeAddress( _
      ByVal dwSize As UInteger _
   )As LPVOID
   
   Dim lpBaseAddress As LPVOID = VirtualAlloc( _
      NULL, _
      dwSize, _
      MEM_RESERVE, _
      PAGE_READWRITE _
   )
   
   If lpBaseAddress Then
      VirtualFree(lpBaseAddress, 0, MEM_RELEASE)
   End If
   
   Return lpBaseAddress
   
End Function

Private Function GetAllocationGranularity() As DWORD
   
   ' узнаём размер гранулы
   Dim info As SYSTEM_INFO = Any
   GetSystemInfo(@info)
   
   Return info.dwAllocationGranularity
   
End Function

Private Function RingBufferInitialize( _
      ByVal DesiredCapacity As UInteger, _
      ByVal ppFirstPage As UByte Ptr Ptr, _
      ByVal ppSecondPage As UByte Ptr Ptr _
   )As HRESULT
   
   ' VirtualAlloc создаёт память с округлением до гранулы
   
   Dim dwGranularity As DWORD = GetAllocationGranularity()
   
   Dim Capacity As UInteger = ((DesiredCapacity \ Cast(size_t, dwGranularity)) + 1) * dwGranularity
   
   Dim hMapFile As HANDLE = Any
   Scope
      Dim ulBufferSize As ULARGE_INTEGER = Any
      ulBufferSize.QuadPart = Capacity * 2
      
      hMapFile = CreateFileMapping( _
         INVALID_HANDLE_VALUE, _
         NULL, _
         PAGE_READWRITE, _
         ulBufferSize.HighPart, ulBufferSize.LowPart, _
         NULL _
      )
      If hMapFile = NULL Then
         Dim dwError As DWORD = GetLastError()
         *ppFirstPage = NULL
         *ppSecondPage = NULL
         
         Return HRESULT_FROM_WIN32(dwError)
      End If
   End Scope
   
   ' Ищем свободный адрес (несколько попыток)
   Const StepsCount = 10
   
   For i As Integer = 0 To StepsCount - 1
      Dim lpBaseAddress1 As LPVOID = FindFreeAddress( _
         Capacity * 2 _
      )
      
      If lpBaseAddress1 Then
         
         Dim pFirstRegion As UByte Ptr = MapViewOfFileEx( _
            hMapFile, _
            FILE_MAP_READ Or FILE_MAP_WRITE, _
            0, 0, _
            Cast(DWORD, Capacity), _
            lpBaseAddress1 _
         )
         
         If pFirstRegion Then
            
            Dim lpBaseAddress2 As LPVOID = Cast(LPVOID, (CPtr(UByte Ptr, lpBaseAddress1) + Capacity))
            
            Dim pSecondRegion As UByte Ptr = MapViewOfFileEx( _
               hMapFile, _
               FILE_MAP_READ Or FILE_MAP_WRITE, _
               0, 0, _
               Cast(DWORD, Capacity), _
               lpBaseAddress2 _
            )
            
            If pSecondRegion Then
               
               *ppFirstPage = pFirstRegion
               *ppSecondPage = pSecondRegion
               
               Return S_OK
            End If
            
            UnmapViewOfFile(pFirstRegion)
         End If
         
      End If
      
   Next
   
   *ppFirstPage = NULL
   *ppSecondPage = NULL
   
   CloseHandle(hMapFile)
   
   Return E_OUTOFMEMORY
   
End Function

Const HelloWorld = __TEXT("Hello World")

Dim pFirstPage As Any Ptr = Any
Dim pSecondPage As Any Ptr = Any
Dim hr As HRESULT = RingBufferInitialize( _
   100, _
   @pFirstPage, _
   @pSecondPage _
)
If FAILED(hr) Then
   End(1)
End If

' Записываем данные во вторую страницу
memcpy(pSecondPage, @HelloWorld, (Len(HelloWorld) + 1) * SizeOf(TCHAR))

' и читаем данные из первой страницы
' проверяем: данные совпадают
Print *(Cast(LPTSTR, pFirstPage))
Print *(Cast(LPTSTR, pSecondPage))

' однако указатели разные
Print Hex(pFirstPage), Hex(pSecondPage)

Const HelloWorld = "Hello World" 
dim as Integer iLen = len(HelloWorld) 
 
Dim pFirstPage As zstring Ptr = callocate(iLen+1) 
Dim pSecondPage As zstring Ptr = callocate(iLen+1) 
 
*pFirstPage = HelloWorld 
*pSecondPage = HelloWorld 
 
Print *pFirstPage 
Print *pSecondPage 
 
Print Hex(pFirstPage), Hex(pSecondPage)