

/*
  RTL64.inc

  OxygenBasic RunTime Library
  ===========================

  For creating standalon executables and dynamic link libraries which
  will run independently of Oxygen.dll

  Version 0.9.0

  31/01/2025

  Charles Pegge
  cevpegge (at) oxygenbasic.org
*/



/*
  ==========================

  EXAMPLE:
  ========
                        'ENTER THESE LINES AT THE START OF YOUR PROGRAM

  $ dll                'THIS PRODUCES A DYNAMIC LINK LIBRARY INSTEAD OF AN EXE FILE
  $ FileName "t.dll"   'SPECIFIES THE COMPILED FILENAME
  include "RTL64.inc"  'INCLUDES THIS FILE

  ==========================

*/


  $ rtlversion "0.9.0"
  '
  #if not match(rtlversion,o2version)
     #error "RTL version mismatches o2 version "+o2version
  #endif

  #file FileName independent 64 bit

  % mode64bit



  '=========
  #ifdef dll
  '=========
  '
  'DLL EQUATES
  '
  % DLL_PROCESS_DETACH   0
  % DLL_PROCESS_ATTACH   1
  % DLL_THREAD_ATTACH    2
  % DLL_THREAD_DETACH    3
  % DLL_PROCESS_VERIFIER 4
  '
  select edx 'second param of DLLmain
    case DLL_PROCESS_ATTACH
      jmp fwd prolog
    case DLL_PROCESS_DETACH
      ! finish()
      finish()
      mov eax,0
    case DLL_THREAD_ATTACH
      mov eax,1
    case DLL_THREAD_DETACH
      mov eax,0
  end select
  ret

  def _epilog 'FOR DLL
  ====================
    
    ._end_

    'lea rdi,[rbp-16]   'temp list
    'call delbuf
    mov rsp,rbp
    pop rbp
    add rsp,8
    pop rdi
    pop rsi
    pop rbx
    mov rax,1
    ret

   ._error_

    "MISSING OR UNLOADABLE"
    mov r9,0x30
    mov r8,rax
    mov rdx,rcx
    mov rcx,0
    sub rsp,32
    call [rbx+472]
    add rsp,32
    'lea rdi,[rbp-16]   'temp list
    'call delbuf
    mov rsp,rbp
    pop rbp
    add rsp,8
    pop rdi
    pop rsi
    pop rbx
    mov rax,0
    ret

  end def '_epilog


  '=========
  #else 'EXE
  '=========

    def _epilog 'FOR EXE
    ====================

    ._end_

    'mov rdi,rax 'hld exit value in edi
    'push 0 'place for exit code
    'mov rcx,rsp 
    'sub rsp,40
    'call getModuleHandle
    'mov rcx,rax
    'call GetExitCodeProcess
    'add rsp,48
    'mov rax,rdi 'return exit value in rax
    mov rcx,rax
    call ExitProcess

    ._error_

    "MISSING OR UNLOADABLE"
    mov r9,0x30
    mov r8,rax
    mov rdx,rcx
    mov rcx,0
    sub rsp,32
    call [rbx+472]
    add rsp,32
    mov rax,0
    jmp _end_
    end def


  '==============
  #endif 'DLL/EXE
  '==============

  '------
  Prolog:
  '======

  push rbx : push rsi : push rdi : push rax : push rbp
  mov rbp,rsp
  '
  'TOP LEVEL LOCALS
  '
  push 0      '[rbp-8 ] local
  push 0      '[rbp-16] temp
  push 0      '[rbp-24] concat
  push 0      '[rbp-32] unused
  sub rsp,224 '[rbp-40] other local space uninitialised


  lea rip rdx,import_address_table
  lea rip rbx,bssdata

  '--------------------------------
  'COPY BOOTSTRAP LIBRARY ADDRESSES
  '================================
  '
  '
  mov rax,[rdx+00] : mov [rbx+024],rax 'LoadLibrary
  mov rax,[rdx+08] : mov [rbx+040],rax 'GetProcAddress
  mov rax,[rdx+16] : mov [rbx+032],rax 'FreeLibrary
  mov rax,[rdx+24] : mov [rbx+440],rax 'GetModuleHandle
  mov rax,[rdx+32] : mov [rbx+448],rax 'GetGetCommandLine
  mov rax,[rdx+40] : mov [rbx+456],rax 'GetExitCodeProcess
  mov rax,[rdx+48] : mov [rbx+464],rax 'ExitProcess
  mov rax,[rdx+56] : mov [rbx+480],rax 'CreateFileA
  mov rax,[rdx+64] : mov [rbx+488],rax 'Readfile
  mov rax,[rdx+72] : mov [rbx+496],rax 'CloseHandle
  mov rax,[rdx+88] : mov [rbx+472],rax 'MessageBoxA
  mov rax,[rdx+96] : mov [rbx+504],rax 'MessageBoxW

/*
  def LoadLibrary         call [rbx+024]
  def GetProcAddress      call [rbx+040]
  def FreeLibrary         call [rbx+032]
  def GetModuleHandle     call [rbx+440]
  def GetGetCommandLine   call [rbx+448]
  def GetExitCodeProcess  call [rbx+456]
  def ExitProcess         call [rbx+464]
  def CreateFile          call [rbx+480]
  def ReadFile            call [rbx+488]
  def CloseHandle         call [rbx+496]
  def MessageBox          call [rbx+472]
  def MessageBoxW         call [rbx+504]

  def GetLastError        call [rbx+88]
  def SetLastError        call [rbx+96]
  def WriteFile           call [rbx+512]
  def GetFileSize         call [rbx+520]
  def SetFilePointer      call [rbx+528]
*/

'/*
  extern
  ! LoadLibrary         at [rbx+024]
  ! GetProcAddress      at [rbx+040]
  ! FreeLibrary         at [rbx+032]
  ! GetModuleHandle     at [rbx+440]
  ! GetGetCommandLine   at [rbx+448]
  ! GetExitCodeProcess  at [rbx+456]
  ! ExitProcess         at [rbx+464]
  ! CreateFile          at [rbx+480]
  ! ReadFile            at [rbx+488]
  ! CloseHandle         at [rbx+496]
  ! MessageBox          at [rbx+472]
  ! MessageBoxW         at [rbx+504]
  '
  ! GetLastError        at [rbx+88]
  ! SetLastError        at [rbx+96]
  ! WriteFile           at [rbx+512]
  ! GetFileSize         at [rbx+520]
  ! SetFilePointer      at [rbx+528]
  end extern
'*/
  'indexers rbx offset 4096 ascending
  '

  '---------------------------
  'ADDITIONAL OS CALLS GO HERE
  '===========================
  '
  def SysAllocStringByteLen call [rbx+160]
  def SysFreeString         call [rbx+168]
  '
  rdi=LoadLibrary "oleaut32.dll"
  [rbx+160]=GetProcAddress rdi,"SysAllocStringByteLen"
  [rbx+168]=GetProcAddress rdi,"SysFreeString"
  '
  '
  rdi=LoadLibrary "kernel32.dll"
  [rbx+88]=GetProcAddress rdi,"GetLastError"
  [rbx+96]=GetProcAddress rdi,"SetLastError"
  [rbx+512]=GetProcAddress rdi,"WriteFile"
  [rbx+520]=GetProcAddress rdi,"GetFileSize"
  [rbx+528]=GetProcAddress rdi,"SetFilePointer"
  '
  '
  'numberformat
  type numformat
    int dp   ' DECIMAL PLACES
    int trz  ' STRIP TRAILING ZEROS
    int sn   ' SCIENTIFIC NOTATION BY DEFAULT
    int sdp  ' INHIBIT ZERO BEFORE DECIMAL POINT
    int sns  ' LEADING SPACE FOR NON NEGATIVE NUMBERS
    int lps  ' LEAD PADDING SPACES
  end type

  'const
  'string cr=chr(13,10)
  'ert     error number
  'ers     error description
  'num     number to ascii format specifier

  sys ert
  numformat num
  string ers,wdg

  '=============
  jmp fwd endlib
  '=============
  '
  '
  '
  '================
  'RUN TIME GLOBALS
  '================
  '

  '=================
  'LIBRARY FUNCTIONS
  '=================

  _mem:
  lea rip rbx,bssdata
  ret

  
  noof:
  ret


  '------------------------------------------------------------------------------
  function float_to_ascii(fpu df, sys dpp) as sys, label, external 'at [rbx+200]
  '==============================================================================
  '
  zstring s[32],t[64],bcd[16] 'BUFFERS
  sys esize,tempdw,dp,dpl,sn,snv,b,nzero,oldcw,truncw,a,b,i,pt,pa
  '
  '
  'OPTIONAL PADDING
  '----------------
  '
  if num.lps then
    pt= @t
    r8=0x20202020
    shl r8,32
    add r8,0x20202020
    mov rcx,pt
    mov [rcx],r8
    mov [rcx+8],r8
    mov [rcx+16],r8
    mov [rcx+24],r8
  end if
  '
  pt= @t + 32
  pa= @bcd
  '
  'DECIMAL PLACES
  '
  mov rax,dpp
  (
    cmp rax,0
    jge exit
    mov rax,num.dp 'default if rax was -1
  )
  mov dpl,rax
  '
  fstpt [bcd] 'pop store ext number from fpu

  '
  mov rax,0
  mov [snv],rax
  mov [sn],rax
  mov [nzero],rax
  '
  '
  'CHECK FOR ZERO INFINITY AND NAN
  '-------------------------------
  '
  mov rcx,[pa]

  mov rax,[rcx+8]

  (
    and rax,0x7fff
    '
    'TEST FOR ZERO
    '
    (
      cmp rax,0
      jnz exit 'EXCLUDE NON ZERO
      cmp [num.trz],0
      jz exit 'ZERO STRIPPER FLAG
      or rax,[rcx]
      jnz exit
      (
        test byte [rcx+9],0x80
        jz exit
        '
        '*pt="-0"
        '
        mov rax,[pt]
        mov word [rax],0x302d
        lea rdx,[rax+2]
        jmp fwd fadonez 'NEGATIVE ZERO
      )
      '
      '*pt="0"
      '
      mov rax,[pt]
      mov byte [rax],0x30
      lea rdx,[rax+1]
      (
        cmp num.sns,0
        jz exit
        mov word [rax],0x3020 'SPACE ZERO
        inc rdx
      )
      jmp fadonez 'POSITIVE ZERO
    )

    cmp eax,0x7fff
    jnz exit
    mov [nzero],1
    '
    mov eax,[rcx+4]
    and eax,0x7fffffff 'exclude bit 63
    or  eax,[rcx]
    '
    'CHECK FOR NAN OR INFINITY
    '
    (
      cmp rax,0
      jz exit
      '
      'sNAN OR qNAN
      '
      (
        test byte ptr [rcx+7],0x40
        jnz exit
        '
        '*pt="#sNAN"
        '
        mov rax,[pt]
        mov dword [rax],0x414E7323
        mov dword [rax+4],0x4E
        lea rdx,[rax+5]
        jmp fwd fadonez 'SIGNALLING NAN
      )
      '
      '*pt="#qNAN"
      '
      mov rax,[pt]
      mov dword [rax],0x414E7123
      mov dword [rax+4],0x4E
      lea rdx,[rax+5]
      jmp fwd fadonez 'QUIET NAN
    )
    '
    'NEGATIVE / POSITIVE INFINITY
    '
    (
      test byte ptr [rcx+9],0x80
      jz exit
      '
      '*pt="#-INF"
      '
      mov rax,[pt]
      mov dword [rax],0x4E492D23
      mov dword [rax+4],0x46
      lea rdx,[rax+5]
      jmp fwd fadonez 'NEGATIVE INFINITY
    )
    '
    '*pt="#INF"
    '
    mov rax,[pt]
    mov dword [rax],0x464E4923
    mov dword [rax+4],0x00
    lea rdx,[rax+4]
    jmp fwd fadonez 'POSITIVE INFINITY
  )


  fldt [bcd]

  '---------------------------
  ' get the size of the number
  '---------------------------
  (
    '
    'CHECK FOR ZERO
    '
    mov [esize],0
    fldz
    fcomip st(0),st(1)
    jz exit
    '
    mov [nzero],1
    

    fldlg2                    'log10(2)
    fld   st(1)               'copy Src
    fabs                      'insures a positive value
    fyl2x                     '->[log2(Src)]*[log10(2)] = log10(Src)
      
    fstcw [oldcw]             'get current control word
    fwait
    mov   ax,[oldcw]
    or    ax,0xc00            'code it for truncating
    mov   [truncw],ax
    fldcw [truncw]            'insure rounding code of FPU to truncating
    fld st0
    fistp qword [esize]        'store characteristic of logarithm
    fldcw [oldcw]             'load back the former control word

    ftst                      'test logarithm for its sign
    fstsw ax                  'get result
    fwait
    sahf                      'transfer to CPU flags
    sbb  [esize],0            'decrement esize if log is negative
    fstp  st(0)               'get rid of the logarithm
  )
  '
  'DECIMAL PLACES LIMIT
  '---------------------
  '
  mov rax,[dpl]
  (
   cmp rax,16
   jle exit
   mov rax,16 'LIMIT DECIMAL PLACES
  )

  mov [dp],rax


  'IS SCIENTIFIC NOTATION ALWAYS REQUIRED

  cmp byte ptr [num.sn],0
  jnz ENotation

  '
  'VERY LARGE NUMBERS
  '
  (
    mov rcx,[esize]
    'add rcx,dp
    cmp rcx,17
    jl exit
    jmp ENotation
  )
  '
  'SMALL NUMBERS
  '
  (
    cmp [esize],0
    jge exit
    mov rcx,[dp]
    mov rdx,[esize]
    neg rdx
    cmp rdx,4
    jg ENotation 'LIMIT FOR SIMPLE FORMAT
    mov rax,rcx
    mov [dp],rcx
    jmp PowerAdjust
  )
  '
  'NUMBERS NOT REQUIRING SCIENTIFIC NOTATION
  '
  (
    mov rax,[dp]
    mov rcx,rax   'DECIMAL PLACES
    add rcx,[esize] 'INTEGER DIGITS 
    sub rcx,16
    jle exit
    '
    'TOO MANY DIGITS? (ecx contains excess digits)
    '
    '
    sub rax,rcx 'REDUCE MULTIPLIER PLACES IF NECESSARY
    sub [dp],rcx  'REDUCE DECIMAL PLACES ALSO
  )
  '
  '
  jmp PowerAdjust
  '
  ENotation:
  '---------

    mov rcx,[esize]
    mov [snv],rcx
    mov rax,[dp]
    sub rax,rcx
    mov [sn],1 'SCIENTIFIC NOTATION FLAG

  PowerAdjust:
  '-----------

  mov [tempdw],rax 'ADJUSTED MULTIPLIER


  'Multiply the number by the power of 10
  '---------------------------------------
  (
    mov rax,[tempdw]
    cmp rax,0
    jz exit
    '
    fild qword [tempdw]
    fldl2t
    fmulp st(1),st(0)       '->log2(10)*exponent
    fld st(0)
    frndint                 'get the characteristic of the log
    fxch st(1)
    fsub st(0),st(1)        'get only the fractional part but keep the characteristic
    f2xm1                   '->2^(fractional part)-1
    fld1
    faddp st(1),st(0)                    'add 1 back
    fscale                  're-adjust the exponent part of the REAL number
    fstp  st(1)             'get rid of the characteristic of the log
    fmulp st(1),st(0)       '->16-digit integer
  )


  fbstp [bcd] 'SAVE AS PACKED BINARY CODED DECIMAL


'  /*
'  'TRAP ERRORS
'  '
'  fstsw ax                'retrieve exception flags from FPU
'  fwait
'  shr   rax,1             'test for invalid operation
'  jc    srcerr            'clean-up and return error
'  */


  '
  'EXPAND DIGITS
  '
  lea rdx,[bcd]
  lea rcx,[s]
'sub rsp,8
'push rsi
  '
  mov rsi,10
  '
  'looping
  (
    dec rsi
    jl exit
    '
    mov ah,[rdx]
    inc rdx
    '
    mov al,ah
    and al,15
    add al,48
    mov [rcx],al
    inc rcx
    '
    mov al,ah
    shr al,4
    and al,15
    add al,48
    mov [rcx],al
    inc rcx
    repeat
  )


  mov byte ptr [rcx],0
  '
  'COPY FORMATTED
  '--------------
  '
  'NEGATIVE SIGN NEEDED?
  '
  mov rdx,[pt]
  
  '
  (
    and al,0xf
    jz exit
    mov byte [rdx],45
    inc rdx
    jmp fwd nex
  )
  '
  'PADDING FOR NON-NEGATIVE NUMBERS
  '
  cmp num.sns,0
  jz fwd nex
  mov byte ptr [rdx],32
  inc rdx
  '
  nex:
  '
  lea rsi,[s]
  add rsi,18
  mov cl,19
  mov ah,0
  mov ch,[dp]
  dec ch
  '
  'TRANSFER DIGITS
  '
  (
    dec cl
    jl exit
    '
    'INSERT DECIMAL POINT
    '
    (
      cmp cl,ch
      jnz exit
      '
      'PLACE LEADING ZERO
      '
      (
        cmp [num.sdp],0
        jnz exit 'SDP FLAG TO INHIBIT
        cmp ah,0
        jnz exit
        mov byte ptr [rdx],48
        inc rdx
      )
      mov byte ptr [rdx],46
      inc rdx
      mov ah,1 'STOP STRIPPING ZEROS
    )
    mov al,[rsi]
    dec rsi
    (
      (
        cmp ah,0
        jnz fwd faok
      )
      cmp al,48 'CHECK FOR ZERO
      jz exit   'STRIP LEADING ZEROS
      mov ah,1  'INHIBIT FUTURE STRIPPING
      faok:
      mov [rdx],al
      inc rdx
    )
    repeat
  )
'pop rsi
'add rsp,8
  '
  '
  'REMOVE ENDING ZEROS
  '
  (
    cmp [num.trz],0
    jz exit
    cmp [dp],0
    jz exit
    lea rcx,[t] 'BASE ADDRESS OF NUMBER STRING

    'looping
    (
      dec rdx
      cmp rdx,rcx      
      jle xit1 'exit LEAVE FIRST CHARACTER ALONE
      mov al,[rdx]
      (
       cmp al,46
       jnz exit
       dec rdx
       jmp xit1 'STRIP DOT AND EXIT
      )

      cmp al,48
      jnz exit 'ONLY 'LOOK AT RIGHT HAND ZEROS
      repeat 'STRIP ZERO AND CONTINUE
    )

    '----
    xit1:
    '----
    '
    inc rdx
  )
  '
  'ENSURE AT LEAST ONE DIGIT
  '
  lea rcx,[t]
  mov al,[rcx]
  (
    cmp al,45
    jnz exit
    inc rcx
  )
  '
  (
    cmp rcx,rdx
    jnz exit
    (
      cmp num.sns,0
      jz exit
      mov byte ptr [rdx],32
      inc rdx
    )
    mov byte ptr [rdx],48
    inc rdx
  )
  '
  'CHECK FOR SCIENTIC NOTATION
  '
  (
    cmp [sn],0
    jz exit
    cmp [nzero],0
    jz exit
    mov rax,[snv]
    cmp rax,0
    jz exit 'E VALUE ZERO SO OMIT
    mov byte ptr [rdx],69
    inc rdx 'E'
    mov cl,43
    (
      cmp rax,0
      jge exit
      neg rax
      mov cl,45
    )
    '
    mov [rdx],cl
    inc rdx 'SIGN
    mov cl,100
    div cl
    push rax
    and rax,0xff
    mov cl,10
    div cl
    (
      cmp ax,0
      jz exit
      or eax,0x3030 'TO ASCII THOUSANDS AND HUNDREDS
      ( 
        cmp al,48
        jz exit
        mov [rdx],al
        inc rdx
      )

      mov [rdx],ah
      inc rdx
    )

    pop rax
    shr rax,8
    div cl
    or rax,0x3030 'TO ASCII TENS AND UNITS
    mov [rdx],ax
    add rdx,2
  )
  '
  mov byte ptr [rdx],0 'APPEND NULL TERMINATOR
  '
  fadonez:
  '
  'PADDING IF SPECIFIED
  '
  a=32                'offset
  b=rdx-pt            'length
  '
  if num.lps then
    if b<num.lps then
      a=a-num.lps+pt  'padding
      b=b+num.lpS-pt  'extra length
    end if
  end if
  '
  'ASSIGN RESULT TO BSTRING
  '
  lea rcx,t
  add rcx,a
  mov rdx,b
  sub rsp,32
  SysAllocStringByteLen
  add rsp,32
  mov r10l,1
  return rax
  '
  end function 'float_to_ascii



  '-------
  hexaval:
  '=======
  '
  'ECX POINTS TO LEFT BOUNDARY OF TEXT NUMBER
  '
  push rsi
  xor rdx,rdx
  xor rsi,rsi
  '
  ( 'rhexconv:
    inc rcx
    mov al,[rcx]
    cmp al,48 '0
    jb exit 'boundary reached
    '
    'CONVERT TO UPPERCASE
    '
    (
      cmp al,96
      jbe exit
      cmp al,122
      ja exit
      sub al,32
    )
    '
    cmp al,70 'F
    ja exit
    cmp al,57 '9
    jbe nadjal
      cmp al,65
      jb exit 'boundary character
      sub al,7
    nadjal:
    sub al,48 'ascii to hex number
    shld esi,edx,4 'shift nybble
    'o2 0f a4 d6 04 
    shl edx,4
    add dl,al
    '
    'itr overflow
    '
    repeat 'jmp rhexconv
  '
  ) 'nhexconv: 'done conversion 'result in edx
  '
  mov eax,edx 'return lower dword
  mov edx,esi 'possible upper dword
  pop rsi
  ret

  '-----------------------------------------------
  sub ascii_to_float(sys s) external 'at [rbx+192]
  '===============================================
  '
  sys stt,dpf,dpl,enf,eno,digi,sgf,sgg,ten=10
  sys p=s
  'messagebox 0,s,"ascii_to_float",0
  mov rcx,[p]
  '
  '
  'SKIP LEADING WHITE SPACE ETC
  '
  (
    mov al,[rcx]
    cmp al,0
    jz numnok 'end of string (error)
    (
     cmp al,43 'ignore '+'
     jnz exit
     mov al,32
    )
    cmp al,32
    jg exit 'start of word
    inc rcx
    repeat
  )
  '
  mov [stt],rcx 'START OF NUMBER
  '
  cmp al,0x26 '&
  jz n0xn
  cmp al,0x3a '>9
  jae numnok
  '
  'Lookahead for endings h o
  '=========================
  '
  push rcx
  '
  (
    inc rcx
    mov ah,[rcx]
    cmp ah,45 '-' and above
    jae repeat
    '
    'check ending
    '
    dec rcx
    mov ah,[rcx]
    cmp ah,0x3a
    jb exit 'skip numbers
    '
    'uppercase conversion
    '
    (
      cmp ah,0x60
      jbe exit
       sub ah,32
    )
    '
    (
      cmp ah,0x48 'h
      jnz exit
      mov byte ptr [rcx],32
      pop rcx
      dec rcx
      jmp gohexadecimal
    )
    '
    (
      cmp ah,0x4f 'o
      jnz exit
      mov byte ptr [rcx],32
      pop rcx
      dec rcx
      jmp octad
    )
    '
    'cmp ah,0x42 'b itr: incompatible with hexadecimal
    'jnz nafb
    'mov byte ptr [rcx],32
    'pop rcx
    'dec rcx
    'jmp binad
    'nafb:
    '
    '(
    '  cmp ah,0x40
    '  jbe exit 'below 'A'
    '  cmp ah,0x5a
    '  ja exit 'above 'Z'
    '  mov byte ptr [rcx],32 'blank out other suffix 'u' 'l' etc
    ')
    '
  )
  '
  '
  pop rcx
  '
  'Check for 0x 0o 0b
  '==================
  '
  cmp al,0x30
  jnz n0xn
  '
  mov ah,[rcx+1]
  (
    cmp ah,0x60
    jbe exit
    sub ah,0x20
  )
  cmp ah,0x3a
  jb n0xn
  mov al,0x26
  jmp numhok  
  '
  '
  'filter word types
  '=================
  '
  n0xn:
  '----
  '
  cmp al,0x23 'include #  special numbers
  jz spnums
  cmp al,0x26 'include &  hex number
  jz numhok
  cmp al,0x2d 'include -  neg number
  jz normf
  cmp al,0x2e 'include .  decimal point
  jz normf
  cmp al,0x30 'exclude below 0
  jb numnok
  cmp al,0x3a 'include below :
  jb normf
  '
  '--------------------------
  numnok: 'cannot be a number
  '==========================
  '
  fldz
  jmp NumErr
  '  
  '---------------------------------
  numhok: 'HEX OCTAL OR BINARY MAYBE
  '=================================
  '
  '
  cmp al,38 '&
  jnz spnums
  '
  inc rcx
  mov al,[rcx]
  (
    cmp al,32
    jg exit
    fldz
    jmp ParseHExit
  )
  '
  'CONVERT TO UPPERCASE
  '
  (
    cmp al,96
    jbe exit
    cmp al,122
    ja exit
    sub al,32
  )
  '
  cmp al,0x48 'H
  jz gohexadecimal
  cmp al,0x58 'X 
  jnz tryoctal
  '
  '
  'HEXADECIMAL
  '-----------
  '
  gohexadecimal:
  '
  call hexaval
  jmp cputofpu
  '
  '
  tryoctal: 'OCTAL
  '--------------
  '
  cmp al,0x4f 'o
  jnz trybinary
  '
  octad:
  '
  xor rdx,rdx 'zero lower accum
  xor rsi,rsi 'zero upper accum
  (
    inc rcx
    mov al,[rcx]
    cmp al,48 '0
    jb exit
    cmp al,55 '7
    ja exit
    sub al,48 'ascii to hex number
    shl rdx
    rcl rsi
    shl rdx
    rcl rsi
    shl rdx
    rcl rsi
    add dl,al
    '
    'itr overflow
    repeat    
  )
  noctconv: 'done conversion
  mov rax,rdx
  mov rdx,rsi
  jmp fwd cputofpu
  '
  '
  '
  '
  trybinary: 'BINARY BITS
  '----------------------
  '
  cmp al,0x42 'b
  jz binad
  fldz
  jmp fwd ParseHExit
  '
  binad:
  '
  xor rdx,rdx 'zero lower accum
  xor rsi,rsi 'zero upper accum
  (
    inc rcx
    mov al,[rcx]
    cmp al,48 '0
    jb exit
    cmp al,49 '1
    ja exit
    sub al,48 'ascii to hex number
    shl rdx
    rcl rsi
    add dl,al
    '
    'itr overflow
    '    
    repeat
  )
  'done conversion
  mov rax,rdx
  mov rdx,rsi
  jmp cputofpu
  '
  '
  'TREAT AS UNSIGNED INTEGER
  '
  cputofpu:
  '
  sub rsp,16
  mov [rsp],eax
  mov [rsp+4],rdx
  fild qword ptr [rsp]
  add rsp,16
  '
  '
  ParseHExit:
  '
  exit sub
  '
  '---------------
  'SPECIAL NUMBERS
  '---------------
  '
  spnums:
  '
  cmp al,35 '#
  jnz normf 'NORMAL NUMBERS
  '
  inc rcx
  mov eax,[rcx]
  add rcx,4
  or eax,0x20202020 'QUICK LOWERCASE
  '
  (
    cmp eax,0x666e692d '#-INF
    jnz exit
    fld1
    fchs
    fldz
    jmp fwd xitsn
  )
  '
  and eax,0xffffff 'IGNORE 4TH CHAR
  '
  (  
    cmp eax,0x666e69 '#INF
    jnz exit
    fld1
    fldz
    jmp fwd xitsn
  )
  '
  fldz
  fldz
  '
  xitsn:
  '
  fdivp st1
  exit sub
  '
  '
  '-------------------------------------
  normf: 'OTHERWISE CONVENTIONAL NUMBERS
  '-------------------------------------
  '
  fldz
  dec rcx     'PRE DECR
  '
  '---------
  ParseLoop:
  '---------
  '
  (
    inc rcx
    mov al,[rcx]
    cmp al,47
    jz ParseExit
    cmp al,44
    jbe ParseExit
    '
    'TEST FOR E
    '
    ( 'raf3:
      cmp al,0x65 'e
      jz exit
      cmp al,0x45 'E
      jz exit
      jmp fwd nexne
    )
    '
    'E ENCOUNTERED
    '
    mov rax,rcx
    inc rax
    mov [enf],rax
    fldz 'FOR E NUMBER
    mov al,[sgf]
    mov [sgg],al
    mov byte [sgf],0
    jmp ParseLoop
    '
    '-------------------
    nexne: 'BYPASS E SETUP
    '-------------------
    '
    'NEGATIVE SIGN
    '
    (
      cmp al,45
      jnz exit
      cmp byte [sgf],0
      jnz NumErrNeg 'NEG SIGN ALREADY ENCOUNTERED
      mov byte [sgf],1 'SET SIGN FLAG
      jmp ParseLoop
    )
    '
    (
      cmp al,43
      jnz exit
      cmp rcx,[stt]
      jz ParseLoop 'PLUS SIGN AT START OF NUMBER
      cmp byte [sgf],0
      jnz ParseExit 'PLUS SIGN MARKING BOUNDARY OF NUMBER
      cmp [enf],rcx
      jz ParseLoop 'PLUS SIGN IMMEDIATELY FOLLOWING E
      jmp ParseExit
    )
    '
    'CHECK FOR DECIMAL POINT
    '
    ( 'raf7:
      cmp al,46
      jnz exit
      cmp [enf],0
      jnz NumErrDae 'DECIMAL POINT AFTER E
      cmp byte ptr [dpf],0
      jnz NumErrDap 'DECIMAL POINT ALREADY PRESENT
      mov byte ptr [dpf],1
      jmp ParseLoop
    )
    '
    'VALIDATE DIGIT
    '
    sub al,48
    jb ParseExit 'ASCII BELOW '0'
    cmp al,9
    ja ParseExit 'exit  'ASCII ABOVE '9'
    '
    'ACCUM * 10 + DIGIT
    '
    fimul dword [ten]
    mov [digi],al
    fiadd dword ptr [digi]
    '
    (
      cmp byte [dpf],0
      jz exit  'NO DECIMAL POINT
      cmp [enf],0
      jnz exit 'EXCLUDING E NUMBER
      inc [dpl]
    )
    '
    jmp ParseLoop
  )
  '
  '---------
  ParseExit:
  '---------
  '
  'CHECK FOR NEG SIGN
  '
  (
    cmp byte [sgf],0
    jz exit
    fchs
  )
  '
  'NO E NUMBER
  '
  (
    cmp [enf],0
    jnz exit
    cmp [dpl],0
    jz fwd nscale
    fldz
  )
  '
  'SCALE VALUE PRESENT?
  '
  fisub dword [dpl] 'ADJUST SCALER FOR DECIMAL PLACES
  fldl2t
  fmulp  st(1),st(0)   '->log2(10)*exponent
  fld   st(0)
  frndint              'get the characteristic of the log
  fxch
  fsub st,st(1)        'get only the fractional part but keep the characteristic
  f2xm1                '->2^(fractional part)-1
  fld1
  faddp st(1),st(0)    'add 1 back
  fscale               're-adjust the exponent part of the REAL number
  fstp  st(1)          'get rid of the characteristic of the log
  fmulp st(1),st(0)    '->16-digit integer
  '
  nscale:
  '
  'CHECK FOR NEG SIGN
  '
  (
    cmp byte [sgg],0
    jz exit
    fchs
  )
  '
  numokay: 'NUMBER COMPLETED
  '-------------------------
  '
  'result remains on fpu stack.
  '
  return
  '
  NumErr: 'NUMBER ERRORS
  '------
  'messagebox 0,"Number error","val",0
  return
  NumerrNeg:
  'messagebox 0,"Neg sign already present","val",0
  return
  NumerrDap:
  'messagebox 0,"Decimal point already present","val",0
  return
  NumerrDae:
  'messagebox 0,"Decimal point after E","val",0
  return
  '
  end sub 'ascii to float


  type guid
    a as long
    b as short
    c as short
    d(8) as byte
  end type


  '--------
  guidvals:
  '========
  '
  '(byref g as guid, byval s as string) external 'at [rbx+352]
  '
  '{dddddddd-wwww-wwww-bbbb-bbbbbbbbbbbb}
  '
  push rdi
  push rcx
  mov rdi,rcx 'g
  mov rcx,rdx 's
  mov al,[rcx]
  (
    cmp al,123
    jz exit
    dec rcx
  )
  call hexaval
  mov [rdi],eax
  call hexaval
  mov [rdi+4],ax
  call hexaval
  mov [rdi+6],ax
  call hexaval
  mov [rdi+8],ah
  mov [rdi+9],al
  '-----------
  call hexaval
  '-----------
  'mov rdx,rax
  'shr rdx,32
  mov [rdi+10],dh
  mov [rdi+11],dl
  mov edx,eax
  shr edx,16
  mov [rdi+12],dh
  mov [rdi+13],dl
  mov [rdi+14],ah
  mov [rdi+15],al
  inc rcx 'move to txtguid boundary
  pop rax 'g push rcx
  pop rdi
  ret


  '----
  ghex:
  '====
  mov dh,al
  and dh,15
  add dh,48
  (
    cmp dh,57
    jle exit
    add dh,7
  )
  shr rax,4
  mov dl,al
  and dl,15
  add dl,48
  (
    cmp dl,57
    jle exit
    add dl,7
  )
  shr rax,4
  ret


  '--------
  guidtxts:
  '========
  '
  '(byref g as guid) as sys external ' as string at [rbx+360]
  '
  push rsi
  push rdi
  mov rsi,rcx
  mov rdx,38
  mov rcx,0
  sub rsp,40
  call SysAllocStringByteLen
  add rsp,40
  mov rdi,rax
  push rax
  mov rcx,rsi 'guid pointer g
  mov byte ptr [rdi],123
  mov byte ptr [rdi+37],125
  inc rdi
  '--------
  'dddddddd
  '--------
  mov rax,[rcx]
  call ghex
  mov [rdi+6],dx
  call ghex
  mov [rdi+4],dx
  call ghex
  mov [rdi+2],dx
  call ghex
  mov [rdi],dx
  mov byte ptr [rdi+8],45
  add rdi,9
  '----
  'wwww
  '----
  mov ax,[rcx+4]
  call ghex
  mov [rdi+2],dx
  call ghex
  mov [rdi],dx
  mov byte ptr [rdi+4],45
  add rdi,5
  '----
  'wwww
  '----
  mov ax,[rcx+6]
  call ghex
  mov [rdi+2],dx
  call ghex
  mov [rdi],dx
  mov byte ptr [rdi+4],45
  add rdi,5
  '----
  'bbbb
  '----
  mov ax,[rcx+8]
  call ghex
  mov [edi],dx
  call ghex
  mov [rdi+2],dx
  mov byte ptr [rdi+4],45
  add rdi,5
  '------------
  'bbbbbbbbbbbb
  '------------
  add rcx,10
  mov rsi,6
  rghexb:
    mov al,[rcx]
    call ghex
    mov [rdi],dx
    inc rcx
    add rdi,2
    dec rsi
  ja rghexb
  '--------
  pop rax
  pop rdi
  pop rsi
  ret



  '------------------------
  Init1: 'initialise meory
  '========================
  'stepping 8 bytes
  '1  rcx 'pointer
  '2 rdx 'length in bytes
  '3  r8  'inititialising value
  '
  mov rax,r8
  (
    sub rdx,8
    jl exit
    mov [rcx],rax
    add rcx,8
    repeat
  )
  add rdx,8
  (
    dec rdx
    jl exit
    mov [rcx],al
    inc rcx
    repeat
  )
  ret


  '-------------------
  copys0: 'at [rbx+56]
  '===================
  '
  'rcx 'dest
  'rdx 'source
  (
    mov al,[rdx]
    mov [rcx],al
    inc rcx
    inc rdx
    cmp al,0
    jnz repeat
  )
  ret


  '--------------------
  copys00: 'at [rbx+64]
  '====================
  '
  'rcx 'dest
  'rdx 'source
  (
    mov ax,[rdx]
    mov [rcx],ax
    add rcx,2
    add rdx,2
    cmp ax,0
    jnz repeat
  )
  ret



  '-------------------
  copysn: 'at [rbx+72]
  '===================
  '
  'rcx 'dest
  'rdx 'source
  'r8  'bytes to copy (include terminator)
  (
    sub r8,8
    jl  exit
    mov rax,[rdx]
    mov [rcx],rax
    add rcx,8
    add rdx,8
    repeat
  )
  add r8,8
  (
    dec r8
    jl  exit
    mov al,[rdx]
    mov [rcx],al
    inc rcx
    inc rdx
    repeat
  )
  ret




  '-----------------------
  getmem: 'bstr at [rbx+8]
  '=======================
  sub rsp,8
  mov rdx,rcx 'requested size
  mov rcx,0   'no copy
  sub rsp,32
  call SysAllocStringByteLen
  add rsp,32
  '
  'initialise
  '----------
  '
  mov rdx,rax     'pointer
  mov ecx,[rax-4] 'length

  'INIT STRING WITH NULLS
  '
  'STEP 4 BYTES
  (
    sub ecx,4
    jl exit
    mov dword [rdx],0
    add rdx,4
    repeat
  )
  add ecx,4
  '
  'STEP SINGLE BYTES REMAINDER
  (
    dec ecx
    jl exit
    mov byte ptr [rdx],0
    inc rdx
    repeat
  )
  add rsp,8
  ret



  '-------------------------
  FreeMem: 'bstr at [rbx+16]
  '=========================
  sub rsp,8
  cmp rcx,0
  jz nfreestr
    sub rsp,32
    'call SysFreeString
    call [rbx+168]
    add rsp,32
  nfreestr:
  add rsp,8
  ret




  '##############################
  '
  '     #####    #####   #     #
  '    #     #  #     #  #     #
  '    #     #        #  #     #
  '    #     #   #####   #######
  '    #     #  #        #     #
  '    #     #  #        #     #
  '     #####   #######  #     #
  '
  '##############################


  '-------------------
  hexsl: 'at [rbx+216]
  '===================
  mov r8,rdx 'padding
  sub rsp,64 'workspace
  mov rsi,rsp
  fistp qword [rsi]
  mov rdx,[rsi]
  add rsi,60  'offset for working backwards
  mov rdi,rsi 'hold end position
  inc rdi
  mov byte ptr [rdi],32 'endstop space
  mov rcx,16   'down count
  (
    mov al,dl
    shr rdx,4
    and al,15
    add al,48
    (
      cmp al,58
      jb exit
      add al,7
    )
    mov [rsi],al
    dec rsi 'move to left
    dec rcx 'downcount
    jg repeat
  )
  rtrimzer:  'trim leading zeros
  (
    inc rsi
    mov al,[rsi]
    cmp al,48 'is it a leading zero?
    jz repeat
  )
  '
  (
    cmp esi,edi
    jl exit 'leave at least 1 digit
    dec esi
  )
  '
  sub rdi,rsi 'calc length
  (
    cmp r8,0
    jz exit
    sub r8,rdi
    cmp r8,0
      jle exit
      sub rsi,r8
    add rdi,r8
  )
  mov rdx,rdi 'length
  mov rcx,rsi 'pointer
  sub rsp,8
  SysAllocStringByteLen
  add rsp,72
  ret


  '------------------
  hexs: 'at [rbx+208]
  '==================
  mov rdx,0
  sub rsp,8
  call hexsl
  add rsp,8
  ret


  '---------------------
  instrsh: 'at [rbx+320]
  '=====================
  '
  'rcx offset
  'rdx main string
  'r8  key string
  '
  push rsi
  push rdi
  push r12
  '
  mov r9,rcx      'offset
  mov r10,rdx     'main string
  mov r11,r8      'key string
  '
  dec r9
  cmp r9,0
  jl  fwd xninstr 'invalid offset
  '
  mov rdi,r10     'main string
  cmp rdi,0
  jz xninstr      'empty string
  mov rdx,r11     'keyword
  cmp rdx,0
  jz fwd xninstr      'empty keyword
  xor rcx,rcx
  mov ecx,[r11-4] 'length of keyword
  '
  mov rsi,rdi
  xor rax,rax
  mov eax,[rdi-4]  'main string boundary
  add rsi,rax      '
  sub rsi,rcx      'minus length of keyword
  mov rax,rsi      'search limit
  sub rax,r9       'offset
  cmp rax,rdi      '
  jl fwd xninstr        'no room for keyword
  '
  add rdi,r9       'add offset
  mov ah,[rdx]     'keyword 1st char
  '
  (
    cmp rdi,rsi    'boundary check
    jg fwd xninstr     'finish with no match
    mov al,[rdi]   'main string char
    inc rdi
    cmp al,ah
    jnz repeat     'check 1st letter against next
    '
    push rdi       'main string char pointer
    push rdx       'keyword base pointer
    push rcx       'keyword length
    inc rdx        'pointer for second keyword letter
    (
      '
      'check match done?
      '
      (
        dec rcx        'downcount (second letter onward)
        jg exit        'continue matching
        jmp fwd ninstr 'match complete
      )
      mov al,[rdi] 'main string char
      cmp al,[rdx] 'keyword char
      jnz exit     'mismatch
      inc rdx      'next keyword char
      inc rdi      'next main string char
      repeat       'continue matching
    )
    pop rcx   'restore keyword length
    pop rdx   'restore keyword base pounter
    pop rdi   'restore main string char pointer
    repeat    'carry on searching
  )
  '
  '------------
  ninstr: 'done
  '------------
  '
  add rsp,16      'discard
  pop rax     'main string char pointer
  sub rax,r10 'deduct main string base pointer
  '
  '--------------
  xinstr: 'finish
  '--------------
  '
  pop r12
  pop rdi
  pop rsi
  ret

  '---------------
  xninstr: 'finish
  '---------------
  '
  mov rax,0
  pop r12
  pop rdi
  pop rsi
  ret



  function getfiles(sys w) as sys external 'at [rbx+336]
  '=====================================================
  '
  dim as sys b,h,p,pf,ph,le,leh
  '
  '
  'CHECK VALID NAME
  '
  cmp [w],0
  jz fwd ngetfile
  '
  'OPEN FILE
  '
  'push 0             'HANDLE hTemplateFile OPT
  'push 128           'FILE_ATTRIBUTE_NORMAL
  'push 3             'CREATE (NEW 1) (ALWAYS 2) (OPEN 4) (OPEN EXISTING 3)
  'push 0             'LP SECURITY  ATTRIBUTES OPT
  'push 1             'SHARE MODE read(1) write(2)
  'push 0x80000000    'GENERIC_READ (0x80000000) GENERIC_WRITE (0x40000000)
  'push [w] 'name
  '
  h=call Createfile w,0x80000000,1,0,3,128,0
  '
  'SET FILE POINTER
  '
  'push 0              'DWORD dwMoveMethod 0,FILE_BEGIN(0) FILE_CURRENT(1) FILE_END (2) 
  'lea eax,[ph]        'PLONG lpDistanceToMoveHigh
  'push eax
  'push 0              'LONG lDistanceToMove
  'push [h]            'DWORD HANDLE
  '
  pf=call SetFilePointer h,0,@ph,0
  '
  'GET FILE SIZE
  '
  'lea eax,[leh]       'PLONG lpFileSizeHigh
  'push eax            '
  'push [h]            'DWORD HANDLE
  '
  le=call GetFileSize h,@leh
  '
  'CREATE STRING BUFFER
  '
  'push [le]          'FILE LENGTH
  'push 0             'OPTIONAL COPY POINTER
  '
  p=call SysAllocStringByteLen 0,le 'CREATE BSTR
  '
  'READ FILE
  '
  'push 0              'LPOVERLAPPED lpOverlapped
  'lea eax,[b]         'lpNumberOfBytesRead
  'push eax            '
  'push [le]           'DWORD nNumberOfBytesToRead
  'push [p]            'LPVOID lpBuffer
  'push [h]            'DWORD HANDLE
  call ReadFile h,p,le,@b,0
  '
  'CLOSE HANDLE
  '
  call CloseHandle h
  return p
  '
  ngetfile:
  '
  end function



  function putfilen(sys w,s,le) as sys external
  '============================================
  '
  dim as sys b,h,p,pf,ph,leh
  '
  '
  'CHECK VALID NAME
  '
  xor rax,rax
  cmp [w],0
  jz nputfile
  '
  'OPEN FILE
  '---------
  '
  'push 0             'HANDLE hTemplateFile OPT
  'push 128           'FILE_ATTRIBUTE_NORMAL
  'push 2             'CREATE (NEW 1) (ALWAYS 2) (OPEN 4) (OPEN EXISTING 3)
  'mov r9,0           'LP SECURITY  ATTRIBUTES OPT
  'mov r8,0           'SHARE MODE read(1) write(2)
  'mov rdx,0x40000000 'GENERIC_READ (0x80000000) GENERIC_WRITE (0x40000000)
  'mov rcx,[w]        'name
  '
  h=call Createfile w,0x40000000,0,0,2,128,0
  '
  'SET FILE POINTER
  '----------------
  '
  'mov r9,0            'DWORD dwMoveMethod 0,FILE_BEGIN(0) FILE_CURRENT(1) FILE_END (2) 
  'lea r8,[ph]         'PLONG lpDistanceToMoveHigh
  'mov rdx,0           'LONG lDistanceToMove
  'mov rcx,[h]         'DWORD HANDLE
  '
  pf=call SetFilePointer h,0,@ph,0
  'returns File Pointer position low
  '
  'WRITEFILE
  '
  'push 0              'LPOVERLAPPED lpOverlapped
  'lea r9,[b]          'lpNumberOfBytesWritten
  'mov r8,[le]         'DWORD nNumberOfBytesToWrite
  'mov rdx,[s]         'LPVOID lpBuffer
  'mov rcx,[h]         'DWORD HANDLE
  '
  function=call WriteFile h,s,le,@b,0
  '
  'CLOSE HANDLE
  '
  call CloseHandle h
  '
  nputfile:
  '
  end function



  function putfiles(sys w,s) as sys external 'at [rbx+344]
  '=======================================================
  '
  'FIRST GET LENGTH of BSTR TO WRITE
  '
  mov rax,s
  xor r8,r8
  mov r8l,[rax-4]
  '
  return putfilen w,s,r8
  '
  end function




  Function errors() as string external 'at [rbx+128]
  '=================================================
  '
  function=ers
  ers="" 'clear the error buffer
  end function



  '--------------------
  mboxs: 'at [rbx+2048]
  '===================
  mov r9,0
  push 0x42324f ' title: O2B
  mov r8,rsp
  mov rdx,rcx
  mov rcx,0
  sub rsp,32
  call messagebox
  add rsp,40
  ret


  '----------------------
  addlist: 'at [rbx+2064] ' ( eax strptr edi list pointer ) retains string pointer in eax : return ptr edi for dyn string
  '=====================
  addlisti:
  push rcx         'save reg
  push rdi         'address of list ptr
  mov rdi,[rdi]    'address of list 'lea edi,[rbx+...]
  cmp rdi,0
  jnz nnewbuf
    push rax
    mov rcx,1024    'buffer size
    call getmem
    mov rdi,rax
    mov rax,[rsp+8]
    mov [rax],rdi    'store new root buffer pointer
    pop rax
  nnewbuf:
  '
  mov rcx,[rdi+8]  '
  add rcx,16       '
  cmp rcx,1024      'check against list length 1024
  jl addsok        'skip if within list
    '
    'CREATE NEW LIST AND ADD TO CHAIN OF LISTS
    '
    push rax       'save BSTR
    '
    mov rcx,1024   'list block size
    call getmem    'space filled with nulls
    '
    mov rcx,[rsp+8]'get base list ptr 2nd up on stack
    mov [rcx],rax  'assign as current list in .. to [rbx+ ...]
    mov [rax],rdi  'link chain backward from new list to previous list
    mov rdi,rax    'make this list current in edi
    mov rcx,16
    '
    pop rax        ' restore BSTR
    '
  '------------------'
  addsok:           '
  add [rdi+8],8    ' new ubound offset
  add rdi,rcx      'new edi for dynamic string
  mov [rdi],rax    'save BSTR
  pop rcx          'discard main list ptr
  pop rcx          'restore original string pointer
  ret              '



  'DELETE STRINGS IN LIST
  '======================


  '---------------------
  delist: 'at [rbx+2072]      ' (ecx index_limit edi list pointer)
  '====================
  '
  delisti:
  '---------
  '
  push rsi
  '
  delisti1:
  '--------
  '
  mov rsi,[rdi+8]  'ubound
  '
  ( 
    sub rsi,8      'in reverse order
    jl xdofreem    'done or empty
    mov rcx,[rdi+rsi+16] 'get bstring
    call freemem   'free the string
    repeat
  )
  '
  xdofreem: 'list completed
  '
  mov rsi,[rdi]    'check for back link
  cmp rsi,0        '
  jz xdofreem1     'no more lists
  mov rcx,rdi      'as param for freemem
  call freemem     'free original list (already on stack)
  mov rdi,rsi      'back link
  jmp delisti1     'go for next list
  '
  xdofreem1:
  '
  mov [rdi+8],0    'zero records
  pop rsi          'restore esi
  ret              '



  'DELETE CHAINED LISTS OF STRINGS BACKWARDS
  '=========================================
                   
  '-----------------------
  delchain: 'at [rbx+2080]
  '=======================
  '
  delchaini:
  '       '
  cmp [rdi],0 'no list available
  jz ndelchain
  '
  push rax
  push rdx         '
  '
  push rdi         'address of list chain
  mov rdi,[rdi]    'first list in the chain
  call delisti     'delete current list bstrs
  pop rdx          '
  mov [rdx],rdi    'make current base list
  mov rdi,rdx      'restore list chain base
  '
  pop rdx
  pop rax
  ndelchain:
  ret


  '===============================
  'SYSTEM BUFFERS FOR STRING LISTS
  '===============================
  '...at startup

  '-------------------------
  sysdelbufs: 'at [rbx+2144]
  '=========================
  '
  push rax
  #ifndef dll
    'lea rdi,[rbp-16]   'temp list
    'call delbuf
    'lea rdi,[rbp-8]  'local list
    'call delbuf
  #endif
  lea rdi,[rbx+664] 'global list
  call delbuf
  mov rcx,[rbx+680]    'lib handle buffer
  call freemem
  pop rax
  ret

   delbuf:
  '=======
  '
  cmp [rdi],0
  jz ndempty
  sub rsp,8
  call delchaini 'delete strings in list
  add rsp,8
  mov rcx,[rdi]
  sub rsp,8
  call freemem     'free this final list
  add rsp,8
  mov [rdi],0
  ndempty:
  ret


  '---------------------
  deltmp: 'at [rbx+2104]
  '=====================
  '
  deltmpi:
  lea rdi,[rbp-16]
  sub rsp,8
  call delchaini 'delete temp strings
  add rsp,8
  ret


  '---------------------
  delloc: 'at [rbx+2112]
  '=====================
  '
  lea rdi,[rbp-8]
  sub rsp,8
  call delbuf 'delete local strings and buffer
  add rsp,8
  ret
 
 
   'ADD BSTR TO LOCAL LIST

  '---------------------
  assglo: 'at [rbx+2208]
  '=====================
  '
  lea rdi,[rbx+664]
  sub rsp,8
  call addlisti
  add rsp,8
  ret


   'ADD BSTR TO LOCAL LIST

  '---------------------
  assloc: 'at [rbx+2216]
  '=====================
  '
  lea rdi,[rbp-8]
  sub rsp,8
  call addlisti
  add rsp,8
  ret


  'ADD BSTR TO TEMP LIST

  '---------------------
  asstmp: 'at [rbx+2224]
  '=====================
  '
  asstmpi:
  sub rsp,8
  lea rdi,[rbp-16]
  call addlisti
  add rsp,8
  ret
  

  'ASSIGN LOCAL BSTRING

  '---------------------
  asstrl: 'at [rbx+2240] 'dyn addr in ecx, bstr in eax
  '=====================
  '
  mov rdi,[rcx]    '
  cmp rdi,0        ' pointer exists?
  jnz naddl        '
    lea rdi,[rbp-8]'
    sub rsp,8
    call addlisti  ' add to chainable list
    add rsp,8
    mov [rcx],rdi  ' assign pointer to variable
    ret
  naddl:           '
  cmp [rdi],0 ' bstring already exists?
  jz nwipe         '
    push rax       '
    mov rcx,[rdi]     '
    call freemem   ' release original bstr
    pop rax        '
  nwipe:           '
  mov [rdi],rax    ' assign bstr to pointer
  ret                '


  'ASSIGN GLOBAL/STATIC BSTR

  '---------------------
  asstrg: 'at [rbx+2248] 'dyn addr in ecx, bstr in eax
  '=====================
  '
  mov rdi,[rcx]    '
  cmp rdi,0        ' pointer exists?
  jnz naddlg       '
    lea rdi,[rbx+664]
    sub rsp,8
    call addlisti  ' add to chainable list
    add rsp,8
    mov [rcx],rdi  ' assign pointer to variable
     ret
  naddlg:          '
  cmp [rdi],0' bstring already exists?
  jz nwipeg        '
    push rax
    mov rcx,[rdi]  '
    call freemem   ' release original bstr
    pop rax        '
  nwipeg:          '
  mov [rdi],rax    ' assign bstr to pointer
  ret              '


  'TRANSFER BSTRING (return value in function)

 
 '-----------------------
  strinstl: 'at [rbx+2088]
  '=======================
  '
  cmp [rcx],0
  (
    jz exit
    ret
  )
  push rcx
  mov rcx,0
  call getmem
  pop rcx
  lea edi,[ebp-8]
  sub rsp,8
  call addlisti
  add rsp,8
  mov [rcx],rdi  ' assign pointer to variable
  ret


  '-----------------------
  strinstg: 'at [rbx+2096]
  '=======================
  '
  cmp [rcx],0
  (
    jz exit
    ret
  )
  push rcx
  mov rcx,0
  call getmem
  pop rcx
  lea edi,[rbx+664]
  sub rsp,8
  call addlisti
  add rsp,8
  mov [rcx],rdi  ' assign pointer to variable
  ret

  '---------------------
  trbstr: 'at [rbx+2256] 'transfer dyn string for returning BSTR
  '=====================
  '
  cmp rdi,0        '
  jnz nxis1        '
    xor rax,rax    '
    ret            '
  nxis1:           '
  cmp [rdi],0 ' string already exists?
  jnz nxis2        '
    xor rax,rax    '
    ret            '
  nxis2:           '
  mov rax,[rdi]    '
  mov [rdi],0 ' null record on del list
  ret              '


  '-----------------------
  compnnul: 'at [rbx+2128]
  '=======================
  '
  'rcx address
  'rdx length
  '
  mov rax,-1
  mov rdi,rcx
  mov rcx,rdx
  cmp rdi,0        ' test null pointer
  jz fwd xit      '
  '
  ' compare each char
  (
    dec rcx
    (
    jge exit
      '
      'end string zero flag
      '
      xor rax,rax
      ret
    )
    cmp byte ptr [rdi],0
    jnz exit    '
    inc rdi        '
    repeat       '
  )
  xit:
  ret


  'PREPARE JOIN-BUFFER
  '
  '------------------------
  catbufprp: 'at [rbx+2152]
  '========================
  'for max 64 strings
  push r10
  push rdi
  push rcx
  push rax
  'mov rdi,[rbx+640]
  mov rdi,[rbp-24]
  cmp rdi,0
  jnz ncatbufmem
    mov rcx,2048
    sub rsp,8
    call getmem
    add rsp,8
    mov [rbp-24],rax
    mov rdi,rax
    mov [rdi],16 
    mov [rdi+16],-1
  ncatbufmem:
  '
  add [rdi],32 'stride
  add rdi,[rdi]
  mov [rdi-32],-1 'PLACE STOP MARKER AT OFFSET 32 OR MORE
  pop rax
  pop rcx
  pop rdi
  pop r10
  ret
  
    'ADD BSTR TO LIST  ' byref ptr in eax, list in edi


  '-------------
  badcatl: '2160     ' ptr in eax, list in edi
  '=============
  cmp rax,0         'pointer exist?
  jnz badcatl1      '
  ret
  '
  badcatl1:        '
  '--------
  '
  mov rax,[rax]    'deref
  cmp rax,0        'check pointer
  jnz badcatl2     '
  ret
  '
  badcatl2:
  '--------
  '
  xor rcx,rcx
  mov ecx,[rax-4]   'get length
  cmp rcx,0
  jg badcatl3
  ret
  '
  badcatl3:
  '--------
  '
  push rsi
  push rdi
  'mov rdi,[rbx+640] 'catlist
  mov rdi,[rbp-24]  'cat list 
  mov rsi,[rdi]     'next place
  add [rdi],32      'stride increment
  add rdi,rsi       'location
  '
  mov [rdi],rcx     'store byte length
  mov [rdi+8],rax   'store pointer
  mov [rdi+16],r10  'store type
  pop rdi
  pop rsi
  ret
  '
  '
  'ADD BSTR TO LIST  ' byval bstr in eax, list in edi
  '
  '-------------
  sadcatl: '2168     'bstr byval in eax
  '============='
  cmp rax,0
  jnz badcatl2
  ret
  '
  '
  'ADD ZSTR TO LIST  '

  '-------------
  zadcatl: '2176     ' ptr in eax
  '=============
  '
  cmp rax,0 'check for null pointer
  jnz nzad
  ret
  nzad:
  sub rsp,8
  call lenzi
  add rsp,8
  cmp rcx,0
  jg badcatl3
  ret


  '-------------
  madcatl: '2264     ' ptr in eax len in ecx
  '=============
  '
  cmp rax,0 'check for null pointer
  jnz nmad
  ret
  nmad:
  cmp ecx,0
  jg badcatl3
  ret

  ---------------
  midstrs: '2272 '
  ===============
  '
  cmp rcx,0
  (
   jnz exit
   mov ecx,0
   mov rax,0
   ret
  )
  mov rax,rcx 'pointer
  mov rcx,r8  'char count
  mov esi,edx 'offset
  dec esi 'base 0
  (
   cmp r10,2
   jnz exit
   shl esi,1
   shl ecx,1
  )
  add rax,rsi
  ret


  '----------
  lenz: '2408
  '==========
  mov rax, rcx
  call lenzi
  mov rax,rcx
  cmp r10,2
  jnz nwidelen
  shr rax,1
  nwidelen:
  ret


  '-----
  lenzi:
  '=====
  '
  cmp r10,2
  jz lenz2
  '
  push rax        ' save string base pointer
  xor rcx,rcx     ' clear counter
  rlenz1:         '
    mov dl,[rax]  ' get character
    inc rcx       ' add to count
    inc rax       ' add to pointer
    cmp dl,0      ' is it a null char
  jnz rlenz1      ' repeat if not
  pop rax         ' restore string base pointer
  dec rcx         ' count excluding null terminator char
  ret
  '
  '-----
  lenz2:
  '-----
  '
  push rax        ' save string base pointer
  xor rcx,rcx     ' clear counter         ' 
  rlenz2:         '
    mov dx,[rax]  ' get character
    add rcx,2     ' add to count
    add rax,2     ' add to pointer
    cmp dx,0      ' is it a null char
    jnz rlenz2    ' repeat if not
  pop rax         ' restore string base pointer
  sub rcx,2       ' count excluding null terminator char
  ret
  '
  '
  '
    'JOIN STRINGS TOGETHER
  '
sys rrct,rr10,rrsi
  '-----------
  joins: '2184        ' ( eax destptr if exists, edi list of strings to) eax new string ptr
  '==========='
  '                 '
  joinsi:           '
  '                 '
  push rsi          'save reg
  push rdi          'save reg
  '
  'mov rdi,[rbx+640] 'the join string list
  mov rdi,[rbp-24]  'the join string list
  mov rsi,[rdi]     'count step
'mov rrct,rsi
  '
  add rdi,rsi       'boundary of data
  mov [rdi],-1      'set end stop
  sub rsi,32        'base zero
  xor rcx,rcx       'zero the byte counter
  '
mov rrct,0
  (     'iterate through strings in reverse
    '
    sub rdi,32      'last data downward
    sub rsi,32      'down counter
    jl exit         'end of string list
    mov rdx,[rdi]   'byte count for each string
    cmp rdx,-1      'check for stop marker
    jz exit         'finished tallying
    '
    'ADJUSTMENT FOR WIDE CHARACTERS
    '
add rrct,rdx
    (
      cmp byte ptr [rdi+16],2 'wide string?
      jnz exit
      shr rdx,1 'convert byte count to wide character count
    )
    add rcx,rdx     'add length of string
    repeat
  )
  '
  xdocount:         'finished counting bytes
  '
  mov rsi,rcx       'byte total req
  (
    cmp r10,2
    jnz exit
    shl rsi,1 'SCALE FOR WIDE STRING DEST
  )
mov rr10,r10
mov rrsi,rsi
  '
  '
  'CHECK EMPTY (NO CHARS COUNTED)
  '
  cmp rsi,0
  jnz nejoinsi
    cmp rax,0
    jz nejoinsi 'to create a null Bstring
    mov word ptr [rax],0 ' PLACE NULL TERMINATION: (2 NULL BYTES)
    jmp ajoinsi 'finish early    
  nejoinsi:
  '
  'accepts 0 byte requests
  '
  cmp rax,0         'request new Bstring or use existing Zstring
  '
  'itr check overflow before
  '
  jnz nnews
    push r10        'save wide string flag
    mov rcx,rsi     'req n bytes
    call getmem     'create new string
    pop r10         'restore wide string flag
    cmp rax,0       'test for success
    jz ajoinsi      'failure so exit with null bstr
    cmp dword ptr [rax-4],0
    jz ajoinsi      'no bytes to transfer so exit with valid bstr
    jmp dnews       'otherwise prepare for copy joining
  '
  nnews: 'for Zstrings
  '
  mov word ptr [rax+rsi],0 'insert double null into target boundary
  '
  '-----
  dnews: 'entry point for copy joining
  '-----
  '
  '
  mov rsi,rrsi
  mov r10,rr10
  push rax          'target base
  push rdi          'save stop point
  '
  cmp r10,2         'check for wide dest
  'mov rcx,rsi       'byte count
  jz rcopa2
  '
  '------------------------------------------
  rcopa1: 'append each string to ascii string
  '==========================================
  '
  add rdi,32       'step forward for next string
  mov rcx,[rdi]    'LENGTH OR STOP MARKER
  cmp rcx,-1       'end stop
  jz xcopa         'copied all the bytes so exit
  '
  cmp rcx,0        'check for null strings
  jle rcopa1       'next string
  '
  mov rsi,[rdi+8] 'pointer    
  cmp byte ptr [rdi+16],2 'wide strings
  jz rcops12
  '
  '------------------------------
  rcops11: 'asc to asc string copy
  '------------------------------
  '             'copy over
  mov dl,[rsi]  'source byte
  mov [rax],dl  'dest
  inc rax       'inc dest
  inc rsi       'inc src
  dec rcx       'downcount souce bytes to copy
  jg rcops11    'continue copying
  jmp rcopa1    'next string
  '
  '
  '-----------------------------------
  rcops12: ' wide to ascii string copy
  '-----------------------------------
  ' 
  mov dl,[rsi]  'source byte
  mov [rax],dl  'dest
  inc rax       'inc dest
  add rsi,2     'inc src
  sub rcx,2     'downcount source bytes to copy
  jg rcops12    'continue copying
  jmp rcopa1    'next string
  '
  '
  '-----------------------------------------
  rcopa2: 'append each string to wide string
  '=========================================
  '
  add edi,32       'step forward for next string
  mov rcx,[rdi]    'LENGTH OR STOP MARKER
  cmp rcx,-1       'end stop
  jz xcopa         'copied all the bytes so exit
  cmp rcx,0        'check for null strings
  jle rcopa2       'next string
  '
  mov rsi,[rdi+8] 'pointer    
  cmp byte ptr [rdi+16],2 'wide strings
  jz rcops22
  '
  '--------------------------------
  rcops21: 'asc to wide string copy
  '--------------------------------
  '
  xor rdx,rdx   'clear transfer reg
  mov dl,[rsi]  'source byte
  mov [rax],dx  'dest wide string
  add rax,2     'inc dest
  inc rsi       'inc src
  dec rcx       'downcount source bytes to copy
  jg rcops21    'continue copying
  jmp rcopa2    'next string
  '
  '
  '----------------------------------
  rcops22: ' wide to wide string copy
  '----------------------------------
  ' 
  mov dx,[rsi]  'source byte
  mov [rax],dx  'dest
  add rax,2     'inc dest
  add rsi,2     'inc src
  sub rcx,2     'downcount source bytes to copy
  jg rcops22    'continue copying
  jmp rcopa2    'next string
  '
  '
  '(null string or Bstring denied)
  '
  '
  '-----
  xcopa: 'terminate join procedure
  '-----
  '
  pop rdi           'restore stop point
  pop rax           'restore target base
  '
  '
  '-------
  ajoinsi: 'cleardown for zero byte strings (or Bstring denied)
  '-------
  '
  'mov rdx,[rbx+640]
  mov rdx,[rbp-24] 'cat buffer
  sub rdi,rdx
  mov [rdx],rdi    'boundary for prior concatenation segment
  '
  '
  '-------
  xjoinsi:
  '-------
  '
  pop rdi          'restore edi
  pop rsi          'restore esi
  ret     

  

  'COMPARE DYNAMIC STRINGS

  '--------------------
  comps: 'at [rbx+2192] '(compare {rdx}-{rcx} )
  '====================
  '
  compsi:          ' select least length
  '
  'rcx right string1 ptr
  'rdx left wstring ptr
  '
  xor r8,r8        '
  xor r9,r9
  (        '
    cmp rdx,0        ' test null ptr
    jz exit          '
    mov r8l,[rdx-4]  ' left string length
  )
  (         '
    cmp rcx,0        ' test null ptr
    jz exit          '
    mov r9l,[rcx-4]  ' right string length
  )
  (
    cmp r9,0         ' test zero length
    jz exit          '
    cmp r8,0         ' test zero length
    jz exit
    mov r10,r8
    cmp r9,r8        '
    cmovl r10,r9
    (                ' compare each char
      mov al,[rdx]   ' from L string 
      cmp al,[rcx]   ' from R string
      jnz cmpxr1     '
      inc rcx        '
      inc rdx        '
      dec r10        '
      jg repeat      '
    )
  )
                   ' tie break: which string is longer
  cmp r9,r8        ' null ptrs, null lengths or tie breaks
  cmpxr1:          ' flags hold result
  ret           '




  'COMPARE Z STRINGS


  '--------------------
  compz: 'at [rbx+2200]
  '====================
  '
  'rdx             'L string
  'rcx             'R string
  cmp rdx,0        ' test null pointers
  jz fwd cmpznok   '
  cmp rcx,0        '
  jz fwd cmpznok   '
  cmpzdo:          ' compare each char
    mov al,[rdx]   ' from L string
    mov ah,[rcx]   ' from R string
    cmp al,ah      'al/ah interferes with r8
    jnz fwd cmpzxr '
    cmp al,0       '
    jz fwd cmpzxr  '
    inc rdx        '
    inc rcx        '
  jmp cmpzdo       '
  cmpzxr:          ' flags hold result
  ret              '
  cmpznok:         '
  cmp rdx,rcx      'null string
  ret


  '--------------------
  compw: 'at [rbx+2232]
  '====================
  '
  'rdx             'L string
  'rcx             'R string
  cmp rdx,0        ' test null pointers
  jz fwd cmpznok   '
  cmp rcx,0        '
  jz fwd cmpznok   '
  cmpzdo:          ' compare each wchar
    mov ax,[rdx]   ' from L string
    cmp ax,[rcx]   ' with R tring
    jnz fwd cmpzxr '
    cmp al,0       '
    jz fwd cmpzxr  '
    add rdx,2      '
    add rcx,2      '
  jmp cmpzdo       '
  cmpzxr:          ' flags hold result
  ret              '
  cmpznok:         '
  cmp rdx,rcx      'null string
  ret


 
   'BSTRING BYREF COMPARE

  '---------------------
  compis: 'at [rbx+2280] 'bstr byref compare operand with accum
  '=====================
  '
  cmp rdx,0          '
  jz ncompis         '
  mov rdx,[rdx]      '
  ncompis:           '
  jmp compsi         '


 

  '----------------------
  compris: 'at [rbx+2288] 'bstr byref compare with accum with operand
  '======================
  '
  mov rax,rdx        ' operand
  cmp rax,0          '
  jz ncompris        '
  mov rax,[rax]      '
  ncompris:          '
  mov rdx,rcx       ' swap so that accum is compared with operand
  mov rcx,rax
  jmp compsi         '

'====
  'DEREF IF POSSIBLE OR RETURN 0

  '---------------------
  deref0: 'at [rbx+2296]
  '=====================
  '
  cmp rax,0
  (
    jnz exit
    ret
  )
  mov rax,[rax]
  ret


  '--------------------
  compn: 'at [rbx+2304]  'COMPARE {r8} WITH {rcx} NSTRING
  '====================
  '
  'r8              ' lstring ptr
  'rcx             ' rstring ptr
  cmp r8,0         ' test null pointer
  jz cmpnnok       '
  cmp rcx,0        ' test null pointer
  jz cmpnnok       '
  'r9              ' length lstring
  mov r10,r9
  cmp r9,rdx       ' compare length of rstring
  cmovg r10,rdx    'least length
  '
  (           ' compare each char
    dec r10
    (    
      jge exit
      '
      'tie break on length
      '
      cmp r9,rdx  'r length
      ret
    )
    mov al,[r8]    ' from L string
    cmp al,[rcx]   ' from R string
    jnz cmpnxr     '
    inc rdx        '
    inc rcx        '
    repeat
  )
  cmpnxr:          ' flags hold result
  ret
  '
  'tie break on null ptr
  '
  cmpnnok:
  cmp rdx,rcx 'compare left with right
  ret

 

'
'                                      ####
'         ###                        ###   ####
'       ##   ##                    ##          ####STRINGS
'     ##       ##                 ##
'   ##          ##               ##
'  ##            ##            ##
'  ##             ##         ##
'                   ##     ##
'                     #####


  '------------
  ltrims: '2312
  '============
  '
  cmp rcx,0
  jle fwd emptystr
  '
  mov r9,rcx 'pointer
  xor rdx,rdx
  mov edx,[rcx-4]
  '
  cmp edx,0 'length
  jle fwd emptystr
  '
  mov r8,rdx 'length
  '
  and r10,2   'wide string ?
  jnz ltrimr2
  '
  (
    dec r8
    jl ltrimx
    mov al,[r9]
    inc r9
    cmp al,32
    jle repeat
    jmp fwd ltrimx
  )
  '
  'WIDE STRINGS
  '
  '-------
  ltrimr2: 'wide strings
  '-------
  (
    sub r8,2
    jl exit
    mov eax,[r9]
    add r9,2
    cmp ax,0x20
    jle repeat
  )
  inc r8 'length
  dec r9 'pointer
  '
  '------
  ltrimx:
  '------
  '
  inc r8 'length
  dec r9 'pointer
  '
  '-------
  xltrim2:
  '-------
  '
  mov rdi,r9 'preserve pointer pos
  push r8    'preserve / also align stack
  mov rdx,r8
  mov rcx,0
  sub rsp,32
  SysAllocStringByteLen
  add rsp,32
  'call [rbx+160] 'AllocString
  pop r8
  push rax    ' new string / also align stack
  '
  'r8         ' remaining length
  mov rdx,rdi ' start of str
  mov rcx,rax ' new string dest
  call copyn
  '
  pop rax 'return new string with data
  ret

  ---------
  EmptyStr:
  =========
  mov rdx,0
  mov rcx,0
  sub rsp,32
  SysAllocStringByteLen
  add rsp,32
  ret



  '------------
  rtrims: '2320
  '============
  '
  'rcx         'pointer
  cmp rcx,0    'check null ptr
  jle emptystr
  mov r9,rcx
  xor rdx,rdx
  mov edx,[rcx-4]
  mov r8,rdx   'length
  '
  cmp rdx,0    'zero length?
  jle emptystr
  '
  add r9,r8    'end of string
  '
  and r10,2    'wide strings
  jnz rtrimr2

  (
    dec r8
    jl rtrimx
    dec r9
    mov al,[r9]
    cmp al,0x20
    jbe repeat
  )
  jmp rtrimx
  '
  rtrimr2:
  (
    sub r8,2
    jl exit
    sub r9,2
    mov eax,[r9]
    cmp ax,0x20
    jbe repeat
  )
  inc r8
  '
  '------
  rtrimx:
  '------
  '
  inc r8
  mov r9,rcx 'restore pointer
  '
  '-------
  xrtrim2:
  '-------
  '
  push r9 'src pointer
  push r8
  mov rdx,r8
  mov rcx,0
  sub rsp,40
  SysAllocStringByteLen
  'call [rbx+160]
  add rsp,40
  pop r8        'src
  pop r9        'remaining length
  mov rdx,r9    'start of str
  mov rcx,rax   'new string dest
  push rax
  call copyn
  pop eax
  ret



  '------------
  lcases: '2328
  '============
  '
  'rcx ptr
  'rdx length
  'r10 char width
  xor rdx,rdx
  (
    cmp rcx,0
    jz exit
    mov edx,[rcx-4]
  )
  push rcx  'preserve src ptr
  push rdx  'preserve length
  push r10  'preserve width
  mov rcx,0
  sub rsp,32
  SysAllocStringByteLen
  add rsp,32
  pop r10
  pop rdx
  pop rcx
  mov r8,rax
  mov r9,rax
  (
    sub rdx,r10 'down count length
    jl exit
    mov al,[rcx] 'src
    (
      cmp al,65
      jl exit
      cmp al,90
      jg exit
      add al,32
    )
    mov [r8],al 'dest
    add r8,r10  'step char width
    add rcx,r10 'step char width
    repeat
  )
  mov rax,r9 'base pointer
  ret


  '------------
  ucases: '2336
  '============
  '
  'rcx ptr
  'rdx length
  'r10 char width
  xor rdx,rdx
  (
    cmp rcx,0
    jz exit
    mov edx,[rcx-4]
  )
  push rcx  'preserve length
  push rdx  'preserve src ptr
  push r10  'preserve width
  mov rcx,0
  sub rsp,32
  SysAllocStringByteLen
  add rsp,32
  pop r10
  pop rdx
  pop rcx
  mov r8,rax
  mov r9,rax
  (
    sub rdx,r10 'down count length
    jl exit
    mov al,[rcx] 'src
    (
      cmp al,97
      jl exit
      cmp al,122
      jg exit
      sub al,32
    )
    mov [r8],al 'dest
    add r8,r10  'step char width
    add rcx,r10 'step char width
    repeat
  )
  mov rax,r9 'base pointer
  ret


  '-----------
  lefts: '2344
  '===========
  '
  mov r8,rdx
  mov rdx,1
  jmp midsi


'2352 ?



  '----------
  mids: '2360
  '==========
  '
  midsi: 'entry point for bstrings
  '
  'rcx string ptr
  'rdx offset
  'r8  length required
  'r9  for length of string
  'r10 char width
  '
  mov r9,0            ' default source length is 0
  mov rdi,rcx         ' ptr
  cmp rdi,0
  (
    jz exit
    mov r9l,[rcx-4]       'get source length

  ) 'the length of source
  '
  '------------------------------                   '
  astrin: 'entry point for asciiz
  '------------------------------

  dec rdx 'rebase offsets
  '
  'WIDE STRINGS
  (
    cmp r10,2
    jnz exit
    shl rdx,1
    shl r8,1
  )
  'NEG OFFSETS
  (
    cmp rdx,-2
    jg exit
    add rdx,r9      'add length to negative offset to obtain offset
    add rdx,r10
    'inc rdx     
  )
  'NULL OFFSET
  (
    cmp rdx,0
    jge exit
    mov rdx,0
  )
  'CLAMP LENGTH
  (
    (
      sub r9,rdx 'subtract offset
      cmp r9,0
      jg exit
      mov r9,0 'clamp min length to 0
    )
    cmp r8,r9
    jle exit
    mov r8,r9 'clamp max length to length available
  )
  '
  (
    cmp rcx,0          'null or empty source string
    jz exit
    cmp r8,0
    jle exit           ' zero or negative length
    jmp fwd midok3     'not past end end of source string
  )
  '
  midnul: 'no bytes are available so a null string is to be returned
  '------
  '
  mov rdx,0
  mov rcx,0
  sub rsp,40
  SysAllocStringByteLen
  'call [rbx+160]    'AllocString
  add rsp,40
  ret           'null string allocation done
  '
  midok3: 'at least one byte is available to return
  '
  add rcx,rdx 'offset
  '
  push rcx
  push rdx
  push r8
  mov rcx,0
  mov rdx,r8
  sub rsp,32
  SysAllocStringByteLen
  'call [rbx+160]    'AllocString
  add rsp,32
  pop r8
  pop rdx
  pop rcx
  push rax 'new string
  'r8 length to copy
  mov rdx,rcx 'src pointer
  mov rcx,rax 'dest pointer
  call copyn
  pop rax
  ret



  '----------
  ascs: '2368
  '==========
  '
  '
  ascsi:
  '
  xor rax,rax
  '
  'rcx pointer
  'rdx offset
  cmp rcx,0
  jz ascx
  '
  xor r9,r9
  mov r9l,[ecx-4]  'length
  cmp r9,0
  jle ascx

  ascsi1:
  '------
  '
  dec rdx  'base 0
  (
    cmp rdx,-2
    jg exit       'neg spec
    add rdx,1
    add rdx,r9
  )
  cmp rdx,0        'lower limit check
  jl ascx          'leave as null
  cmp r9,rdx       'upper limit check
  jle ascx         'leave as null
  add rcx,rdx      '
  mov al,[rcx]
  '
  ascx:
  ret


  '----------
  lens: '2376
  '==========
  '
  xor rax,rax
  cmp rcx,0
  jz nlens
  mov eax,[rcx-4]
  (
    cmp r10,2
    jnz exit
    shr rax,1
  )
  nlens:
  ret



  '----------
  chrs: '2384
  '==========
  '             '
  push rcx
  mov rcx,0
  mov rdx,1
  sub rsp,32
  SysAllocStringByteLen
  'call [rbx+160] 'AllocString
  add rsp,32
  pop rcx
  mov [rax],cl
  ret


  'mid for asciiz

  '----------
  midz: '2392
  '==========
  '
  midzi:
  mov rdi,rcx 'pass base in edi
  cmp r10,2
  jz rmidz2
  (
    mov al,[rdi]
    inc rdi
    cmp al,0
    jnz repeat
  )
  dec rdi     'exclude null term in count
  sub rdi,rcx '
  mov r9,rdi  'length available
  jmp astrin

  rmidz2:
  (
    mov ax,[rdi]
    add rdi,2
    cmp ax,0
    jnz repeat
  )
  sub rdi,2        'exclude null term in count
  sub rdi,rcx      '
  mov r9,rdi       'length available
  jmp astrin


  '-----------
  leftz: '2400
  '===========
  '
  mov r8,rdx
  mov rdx,1
  jmp midzi


  '2 PARAM MID
  '
  '-----------
  mids2: '2416
  '===========
  '
  (
    cmp rcx,0
    jnz exit
    mov r8,0
    jmp midsi
  )
  xor r8,r8
  mov r8l,[rcx-4]
  jmp midsi
  '


  '-----------
  midz2: '2424
  '===========
  '
  mov r8,0x7fffffff  'req max length
  jmp midzi        '


  'SINGLE PARAM ASCII
  '
  '-----------
  ascs1: '2432
  '===========
  '
  mov rdx,1
  jmp ascsi          '2 term asc


  'RUNTIME BIND TO IMPORTED DLLS

  '------------
  'COMMAND BYTE
  '============
  '00 NULL TERMINATOR
  '01 NEW LIBRARY NAME
  '02 PROCADDRESS
  '03 END

  '---------------------
  bindls: 'at [rbx+2440]
  '=====================
  '
  '
  'STORE BINDING DATA
  '------------------
  '
  mov rdi,rax
  mov [rbx+672],rdi 'ATTACH BINDING DATA
  '
  'PREPARE LIST FOR LIBRARY HANDLES (512)
  '--------------------------------------
  '
  'this list is used for unloading libraries with FREELIBRARY
  '
  mov rax,[rbx+680]     'LIBRARY HANDLE BUFFER
  add rax,[rax]         '1ST DWORD HOLDS OFFSET FOR NEXT DATA
  add rax,8
  mov [rax],1           'SET MARKER
  add rax,8
  push rax  'HOLD LIBRARY LIST BASE ON STACK [RSP] (1)
  '
  '
  '
  '========
  rbindlsa: 'LOOP POINT
  '========
  '
  'CHECK FOR TERMINATORS
  '---------------------
  '
  mov al,[rdi]
  cmp al,0
  jz xbindls 'NULL TERMINATION OF LIST
  cmp al,3
  jz xbindls 'FORMAL END OF LIST
  '
  'CHECK FOR LOAD LIBRARY
  '----------------------
  '
  (
    cmp al,1
    jz exit
    mov rax,100 'REPORT INVALID COMMAND
    jmp xbindls
  )
  '
  inc rdi
  mov rcx,rdi
  sub rsp,32
  call LoadLibrary
  'call [rbx+24] 'library
  add rsp,32
  '
  'CHECK VALID LIBRARY HANDLE
  '--------------------------
  '
  (
    cmp rax,0
    jnz exit
    mov rcx,rdi
    mov rax,101    'REPORT INVALID LIBRARY NAME
    jmp xbindls
  )
  '
  'HOLD/SAVE LIBRARY HANDLE
  '------------------------
  '
  mov rsi,rax    'LIBRARY HANDLE
  '
  pop rax '(0)  
  mov [rax],rsi  'STORE LIBRARY HANDLE
  add rax,8      'NEXT HANDLE STORAGE ADDRESS
  push rax '(1)  'STORE ADDRESS
  '
  '
  'SKIP LIBRARY NAME
  '-----------------
  (
    mov al,[rdi]
    inc rdi
    cmp al,0
    jnz repeat
  )
  '
  'CHECK FOR GETPROCADDRESS
  '------------------------
  '
  (
    mov al,[rdi]
    cmp al,2
    jnz rbindlsa 'NEXT PROC ADDRESS OR NEXT LIBRARY
    '
    '
    add rdi,9        'POINT TO PROC NAME
    mov rdx,rdi      'PROCNAME PTR
    mov rcx,rsi      'LIBRARY HANDLE
    sub rsp,32
    call GetProcAddress
    add rsp,32
    '
    'CHECK VALID PROC ADDRESS
    '------------------------
    '
    (
      cmp rax,0
      jnz exit
      mov rax,102      'REPORT PROCADDRESS ERROR
      jmp fwd xbindls
    )
    '
    '
    'STORE PROCADDRESS IN TABLE
    '--------------------------
    '
    mov rcx,[rdi-8]  'GET OFFSET
    add rcx,rbx      'ADD STATIC VARIABLE BASE [RBX]
    mov [rcx],rax    'STORE ADDRESS
    '

    '
    'SKIP PROC NAME
    (
      mov al,[rdi]
      inc rdi
      cmp al,0
      jnz repeat
    )
    '
    'ANOTHER PROC?
    '-------------
    '
    mov al,[rdi]
    cmp al,2
    jz repeat        'ANOTHER PROCADRESS ENTRY
  )
  '
  'NEXT LIB OR EXIT
  '----------------
  '
  jmp rbindlsa       'OTHERWISE NEXT LIB OR FINISH
  '
  '
  'EXIT POINT
  '----------
  '
  '=======
  xbindls:
  '=======
  '
  'AL RETURNING ERROR CODE 100 101 102 OR FINAL CODE 3
  '
  and rax,255
  '
  pop rsi           'NEXT LIB HANDLE STORAGE ADDRESS (1)
  mov rdx,[rbx+680] '
  sub rsi,rdx       '
  sub rsi,8         '
  mov [rdx],rsi     'STORE NUMBER OF LIBRARY ADDRESSES *8
  ret               'RETURN




  'FREE DLLS USING LIST

  '---------------------
  freels: 'at [rbx+2448]
  '====================
  '
  push rax
  '
  'LOCATE END POSITION
  '
  mov rdi,[rbx+680]
  mov rax,[rdi]
  cmp rax,0      'CHECK IF EMPTY
  jz xfreels
  add rdi,rax
  add rdi,8
  '
  '
  '--------------------------
  'REPEAT TILL MARKER OR NULL
  '--------------------------
  '
  'FREE LIBS WORKING BACKWARDS TILL BOUNDARY MARKER
  '
  sub rsp,48
  (
    sub rdi,8
    'cmp [rdi],0
    'jz exit
    cmp [rdi],1 'EXIT AT MARKER
    jz exit
    mov rcx,rdi
    'FreeLibrary
    call [rbx+32] 'FreeLibrary
    repeat
  )
  add rsp,48
  '
  xfreels:
  '
  mov rax,[rbx+680]
  sub rdi,rax
  sub rdi,8
  mov [rax],rdi
  '
  xxfreels:
  '
  pop rax
  ret


  'COMMAND FORMAT:
  '
  'MID()=
  '  
  '-------------
  midbufz: '2352
  '=============
  xor r9,r9
  dec rdx 'offset base 0
  cmp r10,2
  jz midbufzw
  '
  cmp rcx,0
  jz xmidbuf
  '
  mov r9,rcx
  (
    mov al,[r9]
    inc r9
    cmp al,0
    jnz repeat
  )
  dec r9
  sub r9,rcx
  jmp midbuflres

  midbufzw:
  '========
  xor r9,r9
  shl rdx 'wide character offset
  cmp ecx,0
  jz xmidbuf
  
  (
    mov eax,[r9]
    add r9,2
    cmp ax,0
    jnz repeat
  )
  sub r9,2
  sub r9,rcx
  jmp midbuflres
 
  '------------
  midbuf: '2456
  '============
  xor r9,r9
  dec rdx 'offset base 0
  cmp r10,2
  jnz nmidbufwid
  shl rdx 'wide character offset
  '
  nmidbufwid:
  '
  'cmp rcx,0
  'jz xmidbuf        'null buffer
  'mov rcx,[rcx]     'deref
  cmp rcx,0
  jz xmidbuf
  mov r9l,[rcx-4]   'length of buffer
  '
  midbuflres:
  '==========
  '
  mov r10,0
  sub r9,rdx        'sub offset to get length
  mov rdi,r8        'source
  cmp rdi,0
  jz  xmidbuf       'nul source
  xor rax,rax
  mov eax,[rdi-4]
  cmp r9,rax       'check length of source
  jle nmidbuf1      '
    mov r9,rax     'least qty to transfer
  nmidbuf1:
  mov r10,r9
  cmp r9,0         'check if any to transfer
  jle xmidbuf
  add rcx,rdx   ' add offset to target
  mov r8,rcx
  (
    mov al,[rdi] 'source
    inc rdi
    mov [rcx],al 'dest
    inc rcx
    dec r9       'check n
    jg repeat
  )
  xmidbuf:
  '
  mov rax,r8  'pointer
  mov rcx,r10 'length copied
  ret



  'STRING(N,CHAR)


  '-------------
  stringa: '2464
  '=============
  '
  stringi:
  
  'rcx length
  cmp r10,2
  jz fwd stringwide
  '
  push rcx
  push rdx
  mov rdx,rcx
  mov rcx,0
  sub rsp,40
  SysAllocStringByteLen
  'call [rbx+160]  'AllocString
  add rsp,40
  pop rdx
  pop rcx
  push rax         'addr
  '
  'fill qword
  '
  mov r8,3
  mov dh,dl
  mov rax,rdx
  (
    shl rdx,16
    add dx,ax
    dec r8
    jg repeat
  )
  mov r8,rdx       'byte fill
  mov rdx,rcx      'length  
  mov rcx,[rsp]    'pointer
  call init1       'fill
  pop rax 'BSTR addr
  ret
  '
  '----------
  stringwide:
  '----------
  '
  shl rcx,1
  push rcx
  push rdx
  mov rdx,rcx
  mov rcx,0
  sub rsp,40
  SysAllocStringByteLen
  'call [rbx+160]  'AllocString
  add rsp,40
  pop rdx          'character
  pop rcx          'byte length
  push rax         'addr
  mov r8,3
  mov rax,rdx
  (
    shl rdx,16
    add dx,ax
    dec r8
    jg repeat
  )
  mov r8,rdx       'word fill
  mov rdx,rcx      'length  
  mov rcx,[rsp]    'pointer
  call init1       'fill
  pop rax          'BSTR addr
  ret
  '
  '-------------
  stringz: '2472
  '=============
  '
  jmp stringi
  '
  '-------------
  strings: '2480
  '=============
  '
  (
    cmp rdx,0
    jz exit
    mov rdx,[rdx] 'deref to get byte or word
  )
  jmp stringi

  '------------
  spaces: '2488
  '=============
  '
  mov rdx,32
  jmp stringi

  '------------
  prints: '2496
  '============
  '
  cmp r10,2
  jz printsw 'WIDE STRINGS
  sub rsp,8
  call [rbx+2048]
  add rsp,8
  ret
  '
  '-------
  printsw:
  '-------
  '
  sub rsp,8
  mov dword [rsp+4],0x48
  mov dword [rsp],0x0032004f
  mov rdx,rcx 'MESSAGE
  mov r8,rsp  'TITLE
  mov r9,0    'STYLE
  mov rcx,0   'HANDLE
  sub rsp,32
  call MessageBoxW
  add rsp,40            'unstack title string
  ret




  '-------------
  instrs2: '2504
  '=============
  '
  mov r8,rdx
  mov rdx,rcx
  mov rcx,1
  jmp [rbx+320]


  'GETFILE "T.TXT",F

  var sys gfs
  '
  '--------------
  getfile2: '2512
  '==============
  '
  push rcx
  mov gfs,rdx
  mov rcx,[rdx]
  call freemem 'dump existing string
  pop rcx
  sub rsp,40
  call getfiles
  add rsp,40
  mov rcx,gfs
  mov [rcx],rax 'assign to dynamic string
  ret  



  '----------
  strs: '2520
  '==========
  '
  'VALUE IN FPU
  '
  mov rdx,-1      'signal default decimal places
  jmp [rbx+200] 'float_to_ascii external
  ret




  '-----------
  unics: '2528
  '===========
  '
  unicsi:
  '
  'rcx             'pointer
  'rdx             'req char pos
  shl rdx,1        'convert to bytes
  xor rax,rax
  cmp rcx,0
  jz unicx
  xor rdi,rdi
  mov edi,[rcx-4]  'byte length
  '
  cmp rdi,0
  jle unicx
  '
  cmp rdx,0        '
  (
    jnz exit       '
    mov rdx,2      'set to 1
  )
  (
    jge exit       'neg spec
    add rdx,2      'base adjust
    add rdx,rdi    '
  )
  '
  (
    sub rdx,2
    jl exit         'below so leave as null
    cmp rdi,rdx     'upper limit check
    jle exit        'above so leave as null
    add rcx,rdx     '
    mov ax,[rcx]    '
  )
  '
  unicx:
  '-----
  ret           '



  '------------
  unics1: '2536
  '============
  '
  mov rdx,1
  jmp unicsi


  '-----------
  wchrs: '2544
  '===========
  '
  push rcx
  mov rdx,2
  mov rcx,0
  sub rsp,32
  call SysAllocStringByteLen
  'call [rbx+160] 'AllocString
  add rsp,32
  pop rcx
  mov [rax],cx
  ret



  '-------------
  numform: '2552
  '============= 
  'numberformat
  mov rdi,[rbx+688]
  mov [rdi],ecx
  mov [rdi+4],edx
  mov [rdi+8],r8d
  mov [rdi+12],r9d
  mov eax,[rsp+40]
  mov [rdi+16],eax
  mov eax,[rsp+48]
  mov [rdi+20],eax
  ret


  '--------------
  numformd: '2560
  '==============
  'numberformat
  '
  mov rdi,[rbx+688]
  mov [rdi],16
  mov [rdi+4],1
  mov eax,0
  mov [rdi+8],eax
  mov [rdi+12],eax
  mov [rdi+16],eax
  mov [rdi+20],eax
  ret

  '================================================
  'STUB FUNCTIONS (UNIMPLEMENTED PROCEDURES IN RTL)
  '================================================


  '----------------------------------------------
  function getvarptr(s as string) as sys external
  '==============================================
  static sys a[4]
  return & a
  end function

  ''----------------------------------------------------


  '===================
  'End Run Time Procs:
  '===================


  '------------------
  DisplayCommandLine:
  '==================
  '
  mov rdx,0
  "COMMAND LINE"
  mov rcx,rax
  sub rsp,40
  call [rbx+448] 'commandline
  mov rdx,rax
  mov rcx,0
  call [rbx+472] 'messagebox
  add rsp,40
  ret


  'string cr=chr(13)+chr(10)

  '-------------------------------
  _newbuf: 'CREATE A SYSTEM BUFFER
  '===============================
  '
  mov rdx,rsi
  mov rcx,0
  sub rsp,40
  SysAllocStringByteLen
  add rsp,40
  mov rcx,rsi
  mov rdx,rax
  xor r8,r8
  (
    mov [rdx],r8
    add rdx,8
    sub rcx,8
    jg repeat
  )
  mov [rdi],rax : add rdi,8 'ready for next buffer
  ret


   '======
  endlib:
  '======
  '
  '
  'GET ABSOLUTE ADDRESSES
  '======================
  '
  lea rip rbx,bssdata
  '
  def adrf
  {
    [rbx+%2]=@%1
  }
  '
  adrf mboxs      2048 'display string in message box
  adrf noof       2056 'was newlist. create a generic list (header of 16)
  adrf addlist    2064 'add to list
  adrf delist     2072 'delete
  adrf delchain   2080 'delete chain of lists
  adrf strinstl   2088 'check string instance local
  adrf strinstg   2096 'check string instance global
  adrf deltmp     2104 
  adrf delloc     2112 
  adrf noof       2120
  adrf compnnul   2128 
  adrf noof       2136 '
  adrf sysdelbufs 2144 'del system buffs
  adrf catbufprp  2152 'clear string lists
  adrf badcatl    2160 'add byref bstr to cat list [640]
  adrf sadcatl    2168 'add byval bstr to list (bstr params passed byva
  adrf zadcatl    2176 'add z string to cat list   [640]
  adrf joins      2184 'join strings: copy into one
  adrf comps      2192 'compare bstring
  adrf compz      2200 'compare zstrings
  adrf assglo     2208 'assign to global bstr list [rbx+664]
  adrf assloc     2216 'assign to local bstr list [ebp-8]
  adrf asstmp     2224 'assign to temp bstr list [ebp-16]
  adrf compw      2232 'compare wzstrings
  adrf asstrl     2240 'assign bstring [local list 656]
  adrf asstrg     2248 'assign bstring [global list 664]
  adrf trbstr     2256 'transfer bstr
  adrf madcatl    2264 '
  adrf midstrs    2272 '
  adrf compis     2280 'compare with bstr byref with byval
  adrf compris    2288 'compare with bstr byref with byval
  adrf deref0     2296 'dereference if possible or return 0
  adrf compn      2304 'compare n bytes
  adrf ltrims     2312 'ltrim
  adrf rtrims     2320 'rtrim
  adrf lcases     2328 'lcase
  adrf ucases     2336 'ucase
  adrf lefts      2344 'left
  adrf midbufz    2352 '
  adrf mids       2360 'mid
  adrf ascs       2368 'asc
  adrf lens       2376 'len
  adrf chrs       2384 'chr
  adrf midz       2392 'mid for asciiz string literals
  adrf leftz      2400 'left for asciiz
  adrf lenz       2408 'len for zstring and wzstring
  adrf mids2      2416 '2 param mid
  adrf midz2      2424 '2 param mid for asciiz
  adrf ascs1      2432 '1 param asc
  adrf bindls     2440 'bind imported ibs and procs
  adrf freels     2448 'free dlls
  adrf midbuf     2456 'mid(s,i)=t
  adrf stringa    2464 'string byte
  adrf stringz    2472 'string string
  adrf strings    2480 'string zstring
  adrf spaces     2488 'space zstring
  adrf prints     2496 'print string
  adrf instrs2    2504 '2 parm instr(s,u)
  adrf getfile2   2512 'getfile "t.txt",f
  adrf strs       2520 'str(n)
  adrf unics      2528 'unicode (wide string)
  adrf unics1     2536 'unicode (wide string)
  adrf wchrs      2544 'wide chr
  adrf numform    2552 'numberformat
  adrf numformd   2560 'numberformat default
  adrf getmem                08 'new nulled memory block
  adrf freemem               16 'free memory block
  adrf copys0                56 'copy nul terminated string
  adrf copys00               64 'copy null terminated wide string (2 byte characters)
  adrf copysn                72 'copy string of n bytes
  adrf getvarptr#string      80 'O2 GET HOST VAR ADDRESS
  '
  '
  [rbx+128]=@errors
  [rbx+192]=@ascii_to_float
  [rbx+200]=@float_to_ascii
  [rbx+208]=@hexs
  [rbx+216]=@hexsl
  [rbx+320]=@instrsh
  [rbx+328]=@noof
  [rbx+336]=@getfiles
  [rbx+344]=@putfiles
  [rbx+352]=@guidvals
  [rbx+360]=@guidtxts
  '
  finit 'initialise FPU
  '
  'SET UP QWORD COMPLEMENT/2
  mov dword [rbx+712],0x5f000000
  '0x5f000000 is float represenation of '0x8000,0000,0000,0000
  '
  'SET FPU TO 64BIT FLOAT (53BIT PRECISION)
  'int cw
  'fstcw cw
  'and cw,0xfffcff
  'or cw,0x200
  'fldcw cw
   
 
  lea rdi,[rbx+664] 'CREATE GLOBAL STRING BUFFER 
  mov rsi,1024
  call _newbuf
  lea rdi,[rbx+680]
  mov rsi,4096
  call _newbuf 'SET UP BUFFER FOR  LIB HANDLES


  'VACANT BUFFER POINTERS
  '======================
  '
  '[rbx+648]
  '[rbx+656]
  '[rbx+640]



  '---------------------------
  'KEYWORD INTRINSIC OVERRIDES
  '===========================

  defx terminate
  push rax
  sub rsp,8
  call [rbx+2448]
  call [rbx+2144]
  add rsp,8
  pop rax
  end defx

  defx freestrings
  push rax
  sub rsp,8
  call [rbx+2144]
  add rsp,8
  pop rax
  end defx

  defx freelibs
  push rax
  sub rsp,8
  call [rbx+2448]
  add rsp,8
  pop rax
  end defx



  '---------------------
  'NUMBER FORMAT CONTROL
  '=====================
  '
  num.dp =16 ' DECIMAL PLACES
  num.trz= 1 ' STRIP TRAILING ZEROS
  num.sn = 0 ' SCIENTIFIC NOTATION BY DEFAULT
  num.sdp= 0 ' INHIBIT ZERO BEFORE DECIMAL POINT
  [rbx+688]=@num
  '

  '----------------------------------------------------
  'INSERTION POINT LIBRARY BINDINGS AND STATIC ENTITIES
  '====================================================
  '
  ._statics_


  '==========
  'END OF RTL
  '==========